dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

org.el (833881B)


      1 ;;; org.el --- Outline-based notes management and organizer -*- lexical-binding: t; -*-
      2 
      3 ;; Carstens outline-mode for keeping track of everything.
      4 ;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
      5 ;;
      6 ;; Author: Carsten Dominik <carsten.dominik@gmail.com>
      7 ;; Maintainer: Bastien Guerry <bzg@gnu.org>
      8 ;; Keywords: outlines, hypermedia, calendar, wp
      9 ;; Homepage: https://orgmode.org
     10 ;; Package-Requires: ((emacs "25.1"))
     11 
     12 ;; Version: 9.5
     13 
     14 ;; This file is part of GNU Emacs.
     15 ;;
     16 ;; GNU Emacs is free software: you can redistribute it and/or modify
     17 ;; it under the terms of the GNU General Public License as published by
     18 ;; the Free Software Foundation, either version 3 of the License, or
     19 ;; (at your option) any later version.
     20 
     21 ;; GNU Emacs is distributed in the hope that it will be useful,
     22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     24 ;; GNU General Public License for more details.
     25 
     26 ;; You should have received a copy of the GNU General Public License
     27 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     28 ;;
     29 ;;; Commentary:
     30 ;;
     31 ;; Org is a mode for keeping notes, maintaining ToDo lists, and doing
     32 ;; project planning with a fast and effective plain-text system.
     33 ;;
     34 ;; Org mode develops organizational tasks around NOTES files that
     35 ;; contain information about projects as plain text.  Org mode is
     36 ;; implemented on top of outline-mode, which makes it possible to keep
     37 ;; the content of large files well structured.  Visibility cycling and
     38 ;; structure editing help to work with the tree.  Tables are easily
     39 ;; created with a built-in table editor.  Org mode supports ToDo
     40 ;; items, deadlines, time stamps, and scheduling.  It dynamically
     41 ;; compiles entries into an agenda that utilizes and smoothly
     42 ;; integrates much of the Emacs calendar and diary.  Plain text
     43 ;; URL-like links connect to websites, emails, Usenet messages, BBDB
     44 ;; entries, and any files related to the projects.  For printing and
     45 ;; sharing of notes, an Org file can be exported as a structured ASCII
     46 ;; file, as HTML, or (todo and agenda items only) as an iCalendar
     47 ;; file.  It can also serve as a publishing tool for a set of linked
     48 ;; webpages.
     49 ;;
     50 ;; Installation and Activation
     51 ;; ---------------------------
     52 ;; See the corresponding sections in the manual at
     53 ;;
     54 ;;   https://orgmode.org/org.html#Installation
     55 ;;
     56 ;; Documentation
     57 ;; -------------
     58 ;; The documentation of Org mode can be found in the TeXInfo file.  The
     59 ;; distribution also contains a PDF version of it.  At the homepage of
     60 ;; Org mode, you can read the same text online as HTML.  There is also an
     61 ;; excellent reference card made by Philip Rooke.  This card can be found
     62 ;; in the doc/ directory.
     63 ;;
     64 ;; A list of recent changes can be found at
     65 ;; https://orgmode.org/Changes.html
     66 ;;
     67 ;;; Code:
     68 
     69 (defvar org-inhibit-highlight-removal nil) ; dynamically scoped param
     70 (defvar org-inlinetask-min-level)
     71 
     72 ;;;; Require other packages
     73 
     74 (require 'cl-lib)
     75 
     76 (eval-when-compile (require 'gnus-sum))
     77 
     78 (require 'calendar)
     79 (require 'find-func)
     80 (require 'format-spec)
     81 
     82 (or (eq this-command 'eval-buffer)
     83     (condition-case nil
     84 	(load (concat (file-name-directory load-file-name)
     85 		      "org-loaddefs.el")
     86 	      nil t t t)
     87       (error
     88        (message "WARNING: No org-loaddefs.el file could be found from where org.el is loaded.")
     89        (sit-for 3)
     90        (message "You need to run \"make\" or \"make autoloads\" from Org lisp directory")
     91        (sit-for 3))))
     92 
     93 (eval-and-compile (require 'org-macs))
     94 (require 'org-compat)
     95 (require 'org-keys)
     96 (require 'ol)
     97 (require 'oc)
     98 (require 'org-table)
     99 
    100 ;; `org-outline-regexp' ought to be a defconst but is let-bound in
    101 ;; some places -- e.g. see the macro `org-with-limited-levels'.
    102 (defvar org-outline-regexp "\\*+ "
    103   "Regexp to match Org headlines.")
    104 
    105 (defvar org-outline-regexp-bol "^\\*+ "
    106   "Regexp to match Org headlines.
    107 This is similar to `org-outline-regexp' but additionally makes
    108 sure that we are at the beginning of the line.")
    109 
    110 (defvar org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
    111   "Matches a headline, putting stars and text into groups.
    112 Stars are put in group 1 and the trimmed body in group 2.")
    113 
    114 (declare-function calendar-check-holidays "holidays" (date))
    115 (declare-function cdlatex-environment "ext:cdlatex" (environment item))
    116 (declare-function cdlatex-math-symbol "ext:cdlatex")
    117 (declare-function Info-goto-node "info" (nodename &optional fork strict-case))
    118 (declare-function isearch-no-upper-case-p "isearch" (string regexp-flag))
    119 (declare-function org-add-archive-files "org-archive" (files))
    120 (declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom))
    121 (declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour))
    122 (declare-function org-agenda-redo "org-agenda" (&optional all))
    123 (declare-function org-agenda-remove-restriction-lock "org-agenda" (&optional noupdate))
    124 (declare-function org-archive-subtree "org-archive" (&optional find-done))
    125 (declare-function org-archive-subtree-default "org-archive" ())
    126 (declare-function org-archive-to-archive-sibling "org-archive" ())
    127 (declare-function org-attach "org-attach" ())
    128 (declare-function org-attach-dir "org-attach"
    129 		  (&optional create-if-not-exists-p no-fs-check))
    130 (declare-function org-babel-do-in-edit-buffer "ob-core" (&rest body) t)
    131 (declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang))
    132 (declare-function org-beamer-mode "ox-beamer" (&optional prefix) t)
    133 (declare-function org-clock-auto-clockout "org-clock" ())
    134 (declare-function org-clock-cancel "org-clock" ())
    135 (declare-function org-clock-display "org-clock" (&optional arg))
    136 (declare-function org-clock-get-last-clock-out-time "org-clock" ())
    137 (declare-function org-clock-goto "org-clock" (&optional select))
    138 (declare-function org-clock-in "org-clock" (&optional select start-time))
    139 (declare-function org-clock-in-last "org-clock" (&optional arg))
    140 (declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time))
    141 (declare-function org-clock-out-if-current "org-clock" ())
    142 (declare-function org-clock-remove-overlays "org-clock" (&optional beg end noremove))
    143 (declare-function org-clock-report "org-clock" (&optional arg))
    144 (declare-function org-clock-sum "org-clock" (&optional tstart tend headline-filter propname))
    145 (declare-function org-clock-sum-current-item "org-clock" (&optional tstart))
    146 (declare-function org-clock-timestamps-down "org-clock" (&optional n))
    147 (declare-function org-clock-timestamps-up "org-clock" (&optional n))
    148 (declare-function org-clock-update-time-maybe "org-clock" ())
    149 (declare-function org-clocktable-shift "org-clock" (dir n))
    150 (declare-function org-columns-quit "org-colview" ())
    151 (declare-function org-columns-insert-dblock "org-colview" ())
    152 (declare-function org-duration-from-minutes "org-duration" (minutes &optional fmt canonical))
    153 (declare-function org-duration-to-minutes "org-duration" (duration &optional canonical))
    154 (declare-function org-element-at-point "org-element" ())
    155 (declare-function org-element-cache-refresh "org-element" (pos))
    156 (declare-function org-element-cache-reset "org-element" (&optional all))
    157 (declare-function org-element-contents "org-element" (element))
    158 (declare-function org-element-context "org-element" (&optional element))
    159 (declare-function org-element-copy "org-element" (datum))
    160 (declare-function org-element-create "org-element" (type &optional props &rest children))
    161 (declare-function org-element-extract-element "org-element" (element))
    162 (declare-function org-element-insert-before "org-element" (element location))
    163 (declare-function org-element-interpret-data "org-element" (data))
    164 (declare-function org-element-lineage "org-element" (blob &optional types with-self))
    165 (declare-function org-element-link-parser "org-element" ())
    166 (declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
    167 (declare-function org-element-nested-p "org-element" (elem-a elem-b))
    168 (declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only))
    169 (declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent))
    170 (declare-function org-element-property "org-element" (property element))
    171 (declare-function org-element-put-property "org-element" (element property value))
    172 (declare-function org-element-restriction "org-element" (element))
    173 (declare-function org-element-swap-A-B "org-element" (elem-a elem-b))
    174 (declare-function org-element-timestamp-parser "org-element" ())
    175 (declare-function org-element-type "org-element" (element))
    176 (declare-function org-export-dispatch "ox" (&optional arg))
    177 (declare-function org-export-get-backend "ox" (name))
    178 (declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist))
    179 (declare-function org-feed-goto-inbox "org-feed" (feed))
    180 (declare-function org-feed-update-all "org-feed" ())
    181 (declare-function org-goto "org-goto" (&optional alternative-interface))
    182 (declare-function org-id-find-id-file "org-id" (id))
    183 (declare-function org-id-get-create "org-id" (&optional force))
    184 (declare-function org-inlinetask-at-task-p "org-inlinetask" ())
    185 (declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
    186 (declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
    187 (declare-function org-latex-make-preamble "ox-latex" (info &optional template snippet?))
    188 (declare-function org-num-mode "org-num" (&optional arg))
    189 (declare-function org-plot/gnuplot "org-plot" (&optional params))
    190 (declare-function org-tags-view "org-agenda" (&optional todo-only match))
    191 (declare-function org-timer "org-timer" (&optional restart no-insert))
    192 (declare-function org-timer-item "org-timer" (&optional arg))
    193 (declare-function org-timer-pause-or-continue "org-timer" (&optional stop))
    194 (declare-function org-timer-set-timer "org-timer" (&optional opt))
    195 (declare-function org-timer-start "org-timer" (&optional offset))
    196 (declare-function org-timer-stop "org-timer" ())
    197 (declare-function org-toggle-archive-tag "org-archive" (&optional find-done))
    198 (declare-function org-update-radio-target-regexp "ol" ())
    199 
    200 (defvar org-element-paragraph-separate)
    201 (defvar org-indent-indentation-per-level)
    202 (defvar org-radio-target-regexp)
    203 (defvar org-target-link-regexp)
    204 (defvar org-target-regexp)
    205 (defvar org-id-overriding-file-name)
    206 
    207 ;; load languages based on value of `org-babel-load-languages'
    208 (defvar org-babel-load-languages)
    209 
    210 (defvar crm-separator)  ; dynamically scoped param
    211 
    212 ;;;###autoload
    213 (defun org-babel-do-load-languages (sym value)
    214   "Load the languages defined in `org-babel-load-languages'."
    215   (set-default sym value)
    216   (dolist (pair org-babel-load-languages)
    217     (let ((active (cdr pair)) (lang (symbol-name (car pair))))
    218       (if active
    219 	  (require (intern (concat "ob-" lang)))
    220 	(fmakunbound
    221 	 (intern (concat "org-babel-execute:" lang)))
    222 	(fmakunbound
    223 	 (intern (concat "org-babel-expand-body:" lang)))))))
    224 
    225 
    226 ;;;###autoload
    227 (defun org-babel-load-file (file &optional compile)
    228   "Load Emacs Lisp source code blocks in the Org FILE.
    229 This function exports the source code using `org-babel-tangle'
    230 and then loads the resulting file using `load-file'.  With
    231 optional prefix argument COMPILE, the tangled Emacs Lisp file is
    232 byte-compiled before it is loaded."
    233   (interactive "fFile to load: \nP")
    234   (let ((tangled-file (concat (file-name-sans-extension file) ".el")))
    235     ;; Tangle only if the Org file is newer than the Elisp file.
    236     (unless (org-file-newer-than-p
    237 	     tangled-file
    238 	     (file-attribute-modification-time
    239 	      (file-attributes (file-truename file))))
    240       (org-babel-tangle-file file
    241                              tangled-file
    242                              (rx string-start
    243                                  (or "emacs-lisp" "elisp")
    244                                  string-end)))
    245     (if compile
    246 	(progn
    247 	  (byte-compile-file tangled-file)
    248 	  (load tangled-file)
    249 	  (message "Compiled and loaded %s" tangled-file))
    250       (load-file tangled-file)
    251       (message "Loaded %s" tangled-file))))
    252 
    253 (defcustom org-babel-load-languages '((emacs-lisp . t))
    254   "Languages which can be evaluated in Org buffers.
    255 \\<org-mode-map>
    256 This list can be used to load support for any of the languages
    257 below.  Each language will depend on a different set of system
    258 executables and/or Emacs modes.
    259 
    260 When a language is \"loaded\", code blocks in that language can
    261 be evaluated with `org-babel-execute-src-block', which is bound
    262 by default to \\[org-ctrl-c-ctrl-c].
    263 
    264 The `org-babel-no-eval-on-ctrl-c-ctrl-c' option can be set to
    265 remove code block evaluation from \\[org-ctrl-c-ctrl-c].  By
    266 default, only Emacs Lisp is loaded, since it has no specific
    267 requirement."
    268   :group 'org-babel
    269   :set 'org-babel-do-load-languages
    270   :version "24.1"
    271   :type '(alist :tag "Babel Languages"
    272 		:key-type
    273 		(choice
    274 		 (const :tag "Awk" awk)
    275 		 (const :tag "C" C)
    276 		 (const :tag "R" R)
    277                  (const :tag "Calc" calc)
    278 		 (const :tag "Clojure" clojure)
    279 		 (const :tag "CSS" css)
    280 		 (const :tag "Ditaa" ditaa)
    281 		 (const :tag "Dot" dot)
    282                  (const :tag "Emacs Lisp" emacs-lisp)
    283 		 (const :tag "Forth" forth)
    284 		 (const :tag "Fortran" fortran)
    285 		 (const :tag "Gnuplot" gnuplot)
    286 		 (const :tag "Haskell" haskell)
    287                  (const :tag "Java" java)
    288 		 (const :tag "Javascript" js)
    289 		 (const :tag "LaTeX" latex)
    290                  (const :tag "Lilypond" lilypond)
    291 		 (const :tag "Lisp" lisp)
    292 		 (const :tag "Makefile" makefile)
    293 		 (const :tag "Maxima" maxima)
    294 		 (const :tag "Matlab" matlab)
    295                  (const :tag "Ocaml" ocaml)
    296 		 (const :tag "Octave" octave)
    297 		 (const :tag "Org" org)
    298 		 (const :tag "Perl" perl)
    299 		 (const :tag "Pico Lisp" picolisp)
    300 		 (const :tag "PlantUML" plantuml)
    301 		 (const :tag "Python" python)
    302 		 (const :tag "Ruby" ruby)
    303 		 (const :tag "Sass" sass)
    304 		 (const :tag "Scala" scala)
    305 		 (const :tag "Scheme" scheme)
    306 		 (const :tag "Screen" screen)
    307 		 (const :tag "Shell Script" shell)
    308                  (const :tag "Sql" sql)
    309 		 (const :tag "Sqlite" sqlite)
    310 		 (const :tag "Stan" stan))
    311 		:value-type (boolean :tag "Activate" :value t)))
    312 
    313 ;;;; Customization variables
    314 (defcustom org-clone-delete-id nil
    315   "Remove ID property of clones of a subtree.
    316 When non-nil, clones of a subtree don't inherit the ID property.
    317 Otherwise they inherit the ID property with a new unique
    318 identifier."
    319   :type 'boolean
    320   :version "24.1"
    321   :group 'org-id)
    322 
    323 ;;; Version
    324 (org-check-version)
    325 
    326 ;;;###autoload
    327 (defun org-version (&optional here full message)
    328   "Show the Org version.
    329 Interactively, or when MESSAGE is non-nil, show it in echo area.
    330 With prefix argument, or when HERE is non-nil, insert it at point.
    331 In non-interactive uses, a reduced version string is output unless
    332 FULL is given."
    333   (interactive (list current-prefix-arg t (not current-prefix-arg)))
    334   (let ((org-dir (ignore-errors (org-find-library-dir "org")))
    335 	(save-load-suffixes (when (boundp 'load-suffixes) load-suffixes))
    336 	(load-suffixes (list ".el"))
    337 	(org-install-dir
    338 	 (ignore-errors (org-find-library-dir "org-loaddefs"))))
    339     (unless (and (fboundp 'org-release) (fboundp 'org-git-version))
    340       (org-load-noerror-mustsuffix (concat org-dir "org-version")))
    341     (let* ((load-suffixes save-load-suffixes)
    342 	   (release (org-release))
    343 	   (git-version (org-git-version))
    344 	   (version (format "Org mode version %s (%s @ %s)"
    345 			    release
    346 			    git-version
    347 			    (if org-install-dir
    348 				(if (string= org-dir org-install-dir)
    349 				    org-install-dir
    350 				  (concat "mixed installation! "
    351 					  org-install-dir
    352 					  " and "
    353 					  org-dir))
    354 			      "org-loaddefs.el can not be found!")))
    355 	   (version1 (if full version release)))
    356       (when here (insert version1))
    357       (when message (message "%s" version1))
    358       version1)))
    359 
    360 (defconst org-version (org-version))
    361 
    362 
    363 ;;; Syntax Constants
    364 ;;;; Comments
    365 (defconst org-comment-regexp
    366   (rx (seq bol (zero-or-more (any "\t ")) "#" (or " " eol)))
    367   "Regular expression for comment lines.")
    368 
    369 ;;;; Keyword
    370 (defconst org-keyword-regexp "^[ \t]*#\\+\\(\\S-+?\\):[ \t]*\\(.*\\)$"
    371   "Regular expression for keyword-lines.")
    372 
    373 ;;;; Block
    374 
    375 (defconst org-block-regexp
    376   "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$"
    377   "Regular expression for hiding blocks.")
    378 
    379 (defconst org-dblock-start-re
    380   "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?"
    381   "Matches the start line of a dynamic block, with parameters.")
    382 
    383 (defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)"
    384   "Matches the end of a dynamic block.")
    385 
    386 ;;;; Timestamp
    387 
    388 (defconst org-ts--internal-regexp
    389   (rx (seq
    390        (= 4 digit) "-" (= 2 digit) "-" (= 2 digit)
    391        (optional " " (*? nonl))))
    392   "Regular expression matching the innards of a time stamp.")
    393 
    394 (defconst org-ts-regexp (format "<\\(%s\\)>" org-ts--internal-regexp)
    395   "Regular expression for fast time stamp matching.")
    396 
    397 (defconst org-ts-regexp-inactive
    398   (format "\\[\\(%s\\)\\]" org-ts--internal-regexp)
    399   "Regular expression for fast inactive time stamp matching.")
    400 
    401 (defconst org-ts-regexp-both (format "[[<]\\(%s\\)[]>]" org-ts--internal-regexp)
    402   "Regular expression for fast time stamp matching.")
    403 
    404 (defconst org-ts-regexp0
    405   "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
    406   "Regular expression matching time strings for analysis.
    407 This one does not require the space after the date, so it can be used
    408 on a string that terminates immediately after the date.")
    409 
    410 (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
    411   "Regular expression matching time strings for analysis.")
    412 
    413 (defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>")
    414   "Regular expression matching time stamps, with groups.")
    415 
    416 (defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]")
    417   "Regular expression matching time stamps (also [..]), with groups.")
    418 
    419 (defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp)
    420   "Regular expression matching a time stamp range.")
    421 
    422 (defconst org-tr-regexp-both
    423   (concat org-ts-regexp-both "--?-?" org-ts-regexp-both)
    424   "Regular expression matching a time stamp range.")
    425 
    426 (defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?"
    427 				 org-ts-regexp "\\)?")
    428   "Regular expression matching a time stamp or time stamp range.")
    429 
    430 (defconst org-tsr-regexp-both
    431   (concat org-ts-regexp-both "\\(--?-?"
    432 	  org-ts-regexp-both "\\)?")
    433   "Regular expression matching a time stamp or time stamp range.
    434 The time stamps may be either active or inactive.")
    435 
    436 (defconst org-repeat-re
    437   "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\
    438 \\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)"
    439   "Regular expression for specifying repeated events.
    440 After a match, group 1 contains the repeat expression.")
    441 
    442 (defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
    443   "Formats for `format-time-string' which are used for time stamps.")
    444 
    445 ;;;; Clock and Planning
    446 
    447 (defconst org-clock-string "CLOCK:"
    448   "String used as prefix for timestamps clocking work hours on an item.")
    449 
    450 (defvar org-closed-string "CLOSED:"
    451   "String used as the prefix for timestamps logging closing a TODO entry.")
    452 
    453 (defvar org-deadline-string "DEADLINE:"
    454   "String to mark deadline entries.
    455 \\<org-mode-map>
    456 A deadline is this string, followed by a time stamp.  It must be
    457 a word, terminated by a colon.  You can insert a schedule keyword
    458 and a timestamp with `\\[org-deadline]'.")
    459 
    460 (defvar org-scheduled-string "SCHEDULED:"
    461   "String to mark scheduled TODO entries.
    462 \\<org-mode-map>
    463 A schedule is this string, followed by a time stamp.  It must be
    464 a word, terminated by a colon.  You can insert a schedule keyword
    465 and a timestamp with `\\[org-schedule]'.")
    466 
    467 (defconst org-ds-keyword-length
    468   (+ 2
    469      (apply #'max
    470 	    (mapcar #'length
    471 		    (list org-deadline-string org-scheduled-string
    472 			  org-clock-string org-closed-string))))
    473   "Maximum length of the DEADLINE and SCHEDULED keywords.")
    474 
    475 (defconst org-planning-line-re
    476   (concat "^[ \t]*"
    477 	  (regexp-opt
    478 	   (list org-closed-string org-deadline-string org-scheduled-string)
    479 	   t))
    480   "Matches a line with planning info.
    481 Matched keyword is in group 1.")
    482 
    483 (defconst org-clock-line-re
    484   (concat "^[ \t]*" org-clock-string)
    485   "Matches a line with clock info.")
    486 
    487 (defconst org-deadline-regexp (concat "\\<" org-deadline-string)
    488   "Matches the DEADLINE keyword.")
    489 
    490 (defconst org-deadline-time-regexp
    491   (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
    492   "Matches the DEADLINE keyword together with a time stamp.")
    493 
    494 (defconst org-deadline-time-hour-regexp
    495   (concat "\\<" org-deadline-string
    496 	  " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9+:hdwmy/ \t.-]*\\)>")
    497   "Matches the DEADLINE keyword together with a time-and-hour stamp.")
    498 
    499 (defconst org-deadline-line-regexp
    500   (concat "\\<\\(" org-deadline-string "\\).*")
    501   "Matches the DEADLINE keyword and the rest of the line.")
    502 
    503 (defconst org-scheduled-regexp (concat "\\<" org-scheduled-string)
    504   "Matches the SCHEDULED keyword.")
    505 
    506 (defconst org-scheduled-time-regexp
    507   (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
    508   "Matches the SCHEDULED keyword together with a time stamp.")
    509 
    510 (defconst org-scheduled-time-hour-regexp
    511   (concat "\\<" org-scheduled-string
    512 	  " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9+:hdwmy/ \t.-]*\\)>")
    513   "Matches the SCHEDULED keyword together with a time-and-hour stamp.")
    514 
    515 (defconst org-closed-time-regexp
    516   (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
    517   "Matches the CLOSED keyword together with a time stamp.")
    518 
    519 (defconst org-keyword-time-regexp
    520   (concat "\\<"
    521 	  (regexp-opt
    522 	   (list org-scheduled-string org-deadline-string org-closed-string
    523 		 org-clock-string)
    524 	   t)
    525 	  " *[[<]\\([^]>]+\\)[]>]")
    526   "Matches any of the 4 keywords, together with the time stamp.")
    527 
    528 (defconst org-keyword-time-not-clock-regexp
    529   (concat
    530    "\\<"
    531    (regexp-opt
    532     (list org-scheduled-string org-deadline-string org-closed-string) t)
    533    " *[[<]\\([^]>]+\\)[]>]")
    534   "Matches any of the 3 keywords, together with the time stamp.")
    535 
    536 (defconst org-all-time-keywords
    537   (mapcar (lambda (w) (substring w 0 -1))
    538 	  (list org-scheduled-string org-deadline-string
    539 		org-clock-string org-closed-string))
    540   "List of time keywords.")
    541 
    542 ;;;; Drawer
    543 
    544 (defconst org-drawer-regexp "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$"
    545   "Matches first or last line of a hidden block.
    546 Group 1 contains drawer's name or \"END\".")
    547 
    548 (defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$"
    549   "Regular expression matching the first line of a property drawer.")
    550 
    551 (defconst org-property-end-re "^[ \t]*:END:[ \t]*$"
    552   "Regular expression matching the last line of a property drawer.")
    553 
    554 (defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$"
    555   "Regular expression matching the first line of a clock drawer.")
    556 
    557 (defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$"
    558   "Regular expression matching the last line of a clock drawer.")
    559 
    560 (defconst org-logbook-drawer-re
    561   (rx (seq bol (0+ (any "\t ")) ":LOGBOOK:" (0+ (any "\t ")) "\n"
    562 	   (*? (0+ nonl) "\n")
    563 	   (0+ (any "\t ")) ":END:" (0+ (any "\t ")) eol))
    564   "Matches an entire LOGBOOK drawer.")
    565 
    566 (defconst org-property-drawer-re
    567   (concat "^[ \t]*:PROPERTIES:[ \t]*\n"
    568 	  "\\(?:[ \t]*:\\S-+:\\(?: .*\\)?[ \t]*\n\\)*?"
    569 	  "[ \t]*:END:[ \t]*$")
    570   "Matches an entire property drawer.")
    571 
    572 (defconst org-clock-drawer-re
    573   (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*?\\("
    574 	  org-clock-drawer-end-re "\\)\n?")
    575   "Matches an entire clock drawer.")
    576 
    577 ;;;; Headline
    578 
    579 (defconst org-heading-keyword-regexp-format
    580   "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
    581   "Printf format for a regexp matching a headline with some keyword.
    582 This regexp will match the headline of any node which has the
    583 exact keyword that is put into the format.  The keyword isn't in
    584 any group by default, but the stars and the body are.")
    585 
    586 (defconst org-heading-keyword-maybe-regexp-format
    587   "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$"
    588   "Printf format for a regexp matching a headline, possibly with some keyword.
    589 This regexp can match any headline with the specified keyword, or
    590 without a keyword.  The keyword isn't in any group by default,
    591 but the stars and the body are.")
    592 
    593 (defconst org-archive-tag "ARCHIVE"
    594   "The tag that marks a subtree as archived.
    595 An archived subtree does not open during visibility cycling, and does
    596 not contribute to the agenda listings.")
    597 
    598 (defconst org-tag-re "[[:alnum:]_@#%]+"
    599   "Regexp matching a single tag.")
    600 
    601 (defconst org-tag-group-re "[ \t]+\\(:\\([[:alnum:]_@#%:]+\\):\\)[ \t]*$"
    602   "Regexp matching the tag group at the end of a line, with leading spaces.
    603 Tags are stored in match group 1.  Match group 2 stores the tags
    604 without the enclosing colons.")
    605 
    606 (defconst org-tag-line-re
    607   "^\\*+ \\(?:.*[ \t]\\)?\\(:\\([[:alnum:]_@#%:]+\\):\\)[ \t]*$"
    608   "Regexp matching tags in a headline.
    609 Tags are stored in match group 1.  Match group 2 stores the tags
    610 without the enclosing colons.")
    611 
    612 (eval-and-compile
    613   (defconst org-comment-string "COMMENT"
    614     "Entries starting with this keyword will never be exported.
    615 \\<org-mode-map>
    616 An entry can be toggled between COMMENT and normal with
    617 `\\[org-toggle-comment]'."))
    618 
    619 
    620 ;;;; LaTeX Environments and Fragments
    621 
    622 (defconst org-latex-regexps
    623   '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t)
    624     ;; ("$" "\\([ \t(]\\|^\\)\\(\\(\\([$]\\)\\([^ \t\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \t\n,.$]\\)\\4\\)\\)\\([ \t.,?;:'\")]\\|$\\)" 2 nil)
    625     ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
    626     ("$1" "\\([^$]\\|^\\)\\(\\$[^ \t\r\n,;.$]\\$\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil)
    627     ("$"  "\\([^$]\\|^\\)\\(\\(\\$\\([^ \t\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \t\n,.$]\\)\\$\\)\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil)
    628     ("\\(" "\\\\([^\000]*?\\\\)" 0 nil)
    629     ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil)
    630     ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil))
    631   "Regular expressions for matching embedded LaTeX.")
    632 
    633 ;;;; Node Property
    634 
    635 (defconst org-effort-property "Effort"
    636   "The property that is being used to keep track of effort estimates.
    637 Effort estimates given in this property need to be in the format
    638 defined in org-duration.el.")
    639 
    640 
    641 ;;; The custom variables
    642 
    643 (defgroup org nil
    644   "Outline-based notes management and organizer."
    645   :tag "Org"
    646   :group 'outlines
    647   :group 'calendar)
    648 
    649 (defcustom org-mode-hook nil
    650   "Mode hook for Org mode, run after the mode was turned on."
    651   :group 'org
    652   :type 'hook)
    653 
    654 (defcustom org-load-hook nil
    655   "Hook that is run after org.el has been loaded."
    656   :group 'org
    657   :type 'hook)
    658 
    659 (make-obsolete-variable
    660  'org-load-hook
    661  "use `with-eval-after-load' instead." "9.5")
    662 
    663 (defcustom org-log-buffer-setup-hook nil
    664   "Hook that is run after an Org log buffer is created."
    665   :group 'org
    666   :version "24.1"
    667   :type 'hook)
    668 
    669 (defvar org-modules)  ; defined below
    670 (defvar org-modules-loaded nil
    671   "Have the modules been loaded already?")
    672 
    673 ;;;###autoload
    674 (defun org-load-modules-maybe (&optional force)
    675   "Load all extensions listed in `org-modules'."
    676   (when (or force (not org-modules-loaded))
    677     (dolist (ext org-modules)
    678       (condition-case nil (require ext)
    679 	(error (message "Problems while trying to load feature `%s'" ext))))
    680     (setq org-modules-loaded t)))
    681 
    682 (defun org-set-modules (var value)
    683   "Set VAR to VALUE and call `org-load-modules-maybe' with the force flag."
    684   (set var value)
    685   (when (featurep 'org)
    686     (org-load-modules-maybe 'force)
    687     (org-element-cache-reset 'all)))
    688 
    689 (defcustom org-modules '(ol-doi ol-w3m ol-bbdb ol-bibtex ol-docview ol-gnus ol-info ol-irc ol-mhe ol-rmail ol-eww)
    690   "Modules that should always be loaded together with org.el.
    691 
    692 If a description starts with <C>, the file is not part of Emacs and Org mode,
    693 so loading it will require that you have properly installed org-contrib
    694 package from NonGNU Emacs Lisp Package Archive
    695 http://elpa.nongnu.org/nongnu/org-contrib.html
    696 
    697 You can also use this system to load external packages (i.e. neither Org
    698 core modules, nor org-contrib modules).  Just add symbols
    699 to the end of the list.  If the package is called org-xyz.el, then you need
    700 to add the symbol `xyz', and the package must have a call to:
    701 
    702    (provide \\='org-xyz)
    703 
    704 For export specific modules, see also `org-export-backends'."
    705   :group 'org
    706   :set 'org-set-modules
    707   :package-version '(Org . "9.5")
    708   :type
    709   '(set :greedy t
    710 	(const :tag "   bbdb:              Links to BBDB entries" ol-bbdb)
    711 	(const :tag "   bibtex:            Links to BibTeX entries" ol-bibtex)
    712 	(const :tag "   crypt:             Encryption of subtrees" org-crypt)
    713 	(const :tag "   ctags:             Access to Emacs tags with links" org-ctags)
    714 	(const :tag "   docview:           Links to Docview buffers" ol-docview)
    715         (const :tag "   doi:               Links to DOI references" ol-doi)
    716 	(const :tag "   eww:               Store link to URL of Eww" ol-eww)
    717 	(const :tag "   gnus:              Links to GNUS folders/messages" ol-gnus)
    718 	(const :tag "   habit:             Track your consistency with habits" org-habit)
    719 	(const :tag "   id:                Global IDs for identifying entries" org-id)
    720 	(const :tag "   info:              Links to Info nodes" ol-info)
    721 	(const :tag "   inlinetask:        Tasks independent of outline hierarchy" org-inlinetask)
    722 	(const :tag "   irc:               Links to IRC/ERC chat sessions" ol-irc)
    723 	(const :tag "   mhe:               Links to MHE folders/messages" ol-mhe)
    724 	(const :tag "   mouse:             Additional mouse support" org-mouse)
    725 	(const :tag "   protocol:          Intercept calls from emacsclient" org-protocol)
    726 	(const :tag "   rmail:             Links to RMAIL folders/messages" ol-rmail)
    727 	(const :tag "   tempo:             Fast completion for structures" org-tempo)
    728 	(const :tag "   w3m:               Special cut/paste from w3m to Org mode." ol-w3m)
    729 	(const :tag "   eshell:            Links to working directories in Eshell" ol-eshell)
    730 
    731 	(const :tag "C  annotate-file:     Annotate a file with Org syntax" org-annotate-file)
    732 	(const :tag "C  bookmark:          Links to bookmarks" ol-bookmark)
    733 	(const :tag "C  checklist:         Extra functions for checklists in repeated tasks" org-checklist)
    734 	(const :tag "C  choose:            Use TODO keywords to mark decisions states" org-choose)
    735 	(const :tag "C  collector:         Collect properties into tables" org-collector)
    736 	(const :tag "C  depend:            TODO dependencies for Org mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend)
    737 	(const :tag "C  elisp-symbol:      Links to emacs-lisp symbols" ol-elisp-symbol)
    738 	(const :tag "C  eval-light:        Evaluate inbuffer-code on demand" org-eval-light)
    739 	(const :tag "C  eval:              Include command output as text" org-eval)
    740 	(const :tag "C  expiry:            Expiry mechanism for Org entries" org-expiry)
    741 	(const :tag "C  git-link:          Links to specific file version" ol-git-link)
    742 	(const :tag "C  interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query)
    743         (const :tag "C  invoice:           Help manage client invoices in Org mode" org-invoice)
    744 	(const :tag "C  learn:             SuperMemo's incremental learning algorithm" org-learn)
    745 	(const :tag "C  mac-iCal:          Imports events from iCal.app to the Emacs diary" org-mac-iCal)
    746 	(const :tag "C  mac-link:          Grab links and url from various mac Applications" org-mac-link)
    747 	(const :tag "C  mairix:            Hook mairix search into Org for different MUAs" org-mairix)
    748 	(const :tag "C  man:               Links to man pages in Org mode" ol-man)
    749 	(const :tag "C  mew:               Links to Mew folders/messages" ol-mew)
    750 	(const :tag "C  notify:            Notifications for Org mode" org-notify)
    751 	(const :tag "C  notmuch:           Provide Org links to notmuch searches or messages" ol-notmuch)
    752 	(const :tag "C  panel:             Simple routines for us with bad memory" org-panel)
    753 	(const :tag "C  registry:          A registry for Org links" org-registry)
    754 	(const :tag "C  screen:            Visit screen sessions through links" org-screen)
    755 	(const :tag "C  screenshot:        Take and manage screenshots in Org files" org-screenshot)
    756 	(const :tag "C  secretary:         Team management with Org" org-secretary)
    757 	(const :tag "C  sqlinsert:         Convert Org tables to SQL insertions" orgtbl-sqlinsert)
    758 	(const :tag "C  toc:               Table of contents for Org buffer" org-toc)
    759 	(const :tag "C  track:             Keep up with Org mode development" org-track)
    760 	(const :tag "C  velocity           Something like Notational Velocity for Org" org-velocity)
    761 	(const :tag "C  vm:                Links to VM folders/messages" ol-vm)
    762 	(const :tag "C  wikinodes:         CamelCase wiki-like links" org-wikinodes)
    763 	(const :tag "C  wl:                Links to Wanderlust folders/messages" ol-wl)
    764 	(repeat :tag "External packages" :inline t (symbol :tag "Package"))))
    765 
    766 (defvar org-export-registered-backends) ; From ox.el.
    767 (declare-function org-export-derived-backend-p "ox" (backend &rest backends))
    768 (declare-function org-export-backend-name "ox" (backend) t)
    769 (defcustom org-export-backends '(ascii html icalendar latex odt)
    770   "List of export back-ends that should be always available.
    771 
    772 If a description starts with <C>, the file is not part of Emacs and Org mode,
    773 so loading it will require that you have properly installed org-contrib
    774 package from NonGNU Emacs Lisp Package Archive
    775 http://elpa.nongnu.org/nongnu/org-contrib.html
    776 
    777 Unlike to `org-modules', libraries in this list will not be
    778 loaded along with Org, but only once the export framework is
    779 needed.
    780 
    781 This variable needs to be set before org.el is loaded.  If you
    782 need to make a change while Emacs is running, use the customize
    783 interface or run the following code, where VAL stands for the new
    784 value of the variable, after updating it:
    785 
    786   (progn
    787     (setq org-export-registered-backends
    788           (cl-remove-if-not
    789            (lambda (backend)
    790              (let ((name (org-export-backend-name backend)))
    791                (or (memq name val)
    792                    (catch \\='parentp
    793                      (dolist (b val)
    794                        (and (org-export-derived-backend-p b name)
    795                             (throw \\='parentp t)))))))
    796            org-export-registered-backends))
    797     (let ((new-list (mapcar #\\='org-export-backend-name
    798                             org-export-registered-backends)))
    799       (dolist (backend val)
    800         (cond
    801          ((not (load (format \"ox-%s\" backend) t t))
    802           (message \"Problems while trying to load export back-end \\=`%s\\='\"
    803                    backend))
    804          ((not (memq backend new-list)) (push backend new-list))))
    805       (set-default \\='org-export-backends new-list)))
    806 
    807 Adding a back-end to this list will also pull the back-end it
    808 depends on, if any."
    809   :group 'org
    810   :group 'org-export
    811   :version "26.1"
    812   :package-version '(Org . "9.0")
    813   :initialize 'custom-initialize-set
    814   :set (lambda (var val)
    815 	 (if (not (featurep 'ox)) (set-default var val)
    816 	   ;; Any back-end not required anymore (not present in VAL and not
    817 	   ;; a parent of any back-end in the new value) is removed from the
    818 	   ;; list of registered back-ends.
    819 	   (setq org-export-registered-backends
    820 		 (cl-remove-if-not
    821 		  (lambda (backend)
    822 		    (let ((name (org-export-backend-name backend)))
    823 		      (or (memq name val)
    824 			  (catch 'parentp
    825 			    (dolist (b val)
    826 			      (and (org-export-derived-backend-p b name)
    827 				   (throw 'parentp t)))))))
    828 		  org-export-registered-backends))
    829 	   ;; Now build NEW-LIST of both new back-ends and required
    830 	   ;; parents.
    831 	   (let ((new-list (mapcar #'org-export-backend-name
    832 				   org-export-registered-backends)))
    833 	     (dolist (backend val)
    834 	       (cond
    835 		((not (load (format "ox-%s" backend) t t))
    836 		 (message "Problems while trying to load export back-end `%s'"
    837 			  backend))
    838 		((not (memq backend new-list)) (push backend new-list))))
    839 	     ;; Set VAR to that list with fixed dependencies.
    840 	     (set-default var new-list))))
    841   :type '(set :greedy t
    842 	      (const :tag "   ascii       Export buffer to ASCII format" ascii)
    843 	      (const :tag "   beamer      Export buffer to Beamer presentation" beamer)
    844 	      (const :tag "   html        Export buffer to HTML format" html)
    845 	      (const :tag "   icalendar   Export buffer to iCalendar format" icalendar)
    846 	      (const :tag "   latex       Export buffer to LaTeX format" latex)
    847 	      (const :tag "   man         Export buffer to MAN format" man)
    848 	      (const :tag "   md          Export buffer to Markdown format" md)
    849 	      (const :tag "   odt         Export buffer to ODT format" odt)
    850 	      (const :tag "   org         Export buffer to Org format" org)
    851 	      (const :tag "   texinfo     Export buffer to Texinfo format" texinfo)
    852 	      (const :tag "C  confluence  Export buffer to Confluence Wiki format" confluence)
    853 	      (const :tag "C  deck        Export buffer to deck.js presentations" deck)
    854 	      (const :tag "C  freemind    Export buffer to Freemind mindmap format" freemind)
    855 	      (const :tag "C  groff       Export buffer to Groff format" groff)
    856 	      (const :tag "C  koma-letter Export buffer to KOMA Scrlttrl2 format" koma-letter)
    857 	      (const :tag "C  RSS 2.0     Export buffer to RSS 2.0 format" rss)
    858 	      (const :tag "C  s5          Export buffer to s5 presentations" s5)
    859 	      (const :tag "C  taskjuggler Export buffer to TaskJuggler format" taskjuggler)))
    860 
    861 (eval-after-load 'ox
    862   '(dolist (backend org-export-backends)
    863      (condition-case nil (require (intern (format "ox-%s" backend)))
    864        (error (message "Problems while trying to load export back-end `%s'"
    865 		       backend)))))
    866 
    867 (defcustom org-support-shift-select nil
    868   "Non-nil means make shift-cursor commands select text when possible.
    869 \\<org-mode-map>
    870 In Emacs 23, when `shift-select-mode' is on, shifted cursor keys
    871 start selecting a region, or enlarge regions started in this way.
    872 In Org mode, in special contexts, these same keys are used for
    873 other purposes, important enough to compete with shift selection.
    874 Org tries to balance these needs by supporting `shift-select-mode'
    875 outside these special contexts, under control of this variable.
    876 
    877 The default of this variable is nil, to avoid confusing behavior.  Shifted
    878 cursor keys will then execute Org commands in the following contexts:
    879 - on a headline, changing TODO state (left/right) and priority (up/down)
    880 - on a time stamp, changing the time
    881 - in a plain list item, changing the bullet type
    882 - in a property definition line, switching between allowed values
    883 - in the BEGIN line of a clock table (changing the time block).
    884 - in a table, moving the cell in the specified direction.
    885 Outside these contexts, the commands will throw an error.
    886 
    887 When this variable is t and the cursor is not in a special
    888 context, Org mode will support shift-selection for making and
    889 enlarging regions.  To make this more effective, the bullet
    890 cycling will no longer happen anywhere in an item line, but only
    891 if the cursor is exactly on the bullet.
    892 
    893 If you set this variable to the symbol `always', then the keys
    894 will not be special in headlines, property lines, item lines, and
    895 table cells, to make shift selection work there as well.  If this is
    896 what you want, you can use the following alternative commands:
    897 `\\[org-todo]' and `\\[org-priority]' \
    898 to change TODO state and priority,
    899 `\\[universal-argument] \\[universal-argument] \\[org-todo]' \
    900 can be used to switch TODO sets,
    901 `\\[org-ctrl-c-minus]' to cycle item bullet types,
    902 and properties can be edited by hand or in column view.
    903 
    904 However, when the cursor is on a timestamp, shift-cursor commands
    905 will still edit the time stamp - this is just too good to give up."
    906   :group 'org
    907   :type '(choice
    908 	  (const :tag "Never" nil)
    909 	  (const :tag "When outside special context" t)
    910 	  (const :tag "Everywhere except timestamps" always)))
    911 
    912 (defcustom org-loop-over-headlines-in-active-region t
    913   "Shall some commands act upon headlines in the active region?
    914 
    915 When set to t, some commands will be performed in all headlines
    916 within the active region.
    917 
    918 When set to `start-level', some commands will be performed in all
    919 headlines within the active region, provided that these headlines
    920 are of the same level than the first one.
    921 
    922 When set to a string, those commands will be performed on the
    923 matching headlines within the active region.  Such string must be
    924 a tags/property/todo match as it is used in the agenda tags view.
    925 
    926 The list of commands is: `org-schedule', `org-deadline',
    927 `org-todo', `org-set-tags-command', `org-archive-subtree',
    928 `org-archive-set-tag', `org-toggle-archive-tag' and
    929 `org-archive-to-archive-sibling'.  The archiving commands skip
    930 already archived entries.
    931 
    932 See `org-agenda-loop-over-headlines-in-active-region' for the
    933 equivalent option for agenda views."
    934   :type '(choice (const :tag "Don't loop" nil)
    935 		 (const :tag "All headlines in active region" t)
    936 		 (const :tag "In active region, headlines at the same level than the first one" start-level)
    937 		 (string :tag "Tags/Property/Todo matcher"))
    938   :package-version '(Org . "9.4")
    939   :group 'org-todo
    940   :group 'org-archive)
    941 
    942 (defcustom org-startup-folded 'showeverything
    943   "Non-nil means entering Org mode will switch to OVERVIEW.
    944 
    945 This can also be configured on a per-file basis by adding one of
    946 the following lines anywhere in the buffer:
    947 
    948    #+STARTUP: fold              (or `overview', this is equivalent)
    949    #+STARTUP: nofold            (or `showall', this is equivalent)
    950    #+STARTUP: content
    951    #+STARTUP: show<n>levels (<n> = 2..5)
    952    #+STARTUP: showeverything
    953 
    954 Set `org-agenda-inhibit-startup' to a non-nil value if you want
    955 to ignore this option when Org opens agenda files for the first
    956 time."
    957   :group 'org-startup
    958   :package-version '(Org . "9.4")
    959   :type '(choice
    960 	  (const :tag "nofold: show all" nil)
    961 	  (const :tag "fold: overview" t)
    962 	  (const :tag "fold: show two levels" show2levels)
    963 	  (const :tag "fold: show three levels" show3levels)
    964 	  (const :tag "fold: show four levels" show4evels)
    965 	  (const :tag "fold: show five levels" show5levels)
    966 	  (const :tag "content: all headlines" content)
    967 	  (const :tag "show everything, even drawers" showeverything)))
    968 
    969 (defcustom org-startup-truncated t
    970   "Non-nil means entering Org mode will set `truncate-lines'.
    971 This is useful since some lines containing links can be very long and
    972 uninteresting.  Also tables look terrible when wrapped.
    973 
    974 The variable `org-startup-truncated' allows to configure
    975 truncation for Org mode different to the other modes that use the
    976 variable `truncate-lines' and as a shortcut instead of putting
    977 the variable `truncate-lines' into the `org-mode-hook'.  If one
    978 wants to configure truncation for Org mode not statically but
    979 dynamically e.g. in a hook like `ediff-prepare-buffer-hook' then
    980 the variable `truncate-lines' has to be used because in such a
    981 case it is too late to set the variable `org-startup-truncated'."
    982   :group 'org-startup
    983   :type 'boolean)
    984 
    985 (defcustom org-startup-indented nil
    986   "Non-nil means turn on `org-indent-mode' on startup.
    987 This can also be configured on a per-file basis by adding one of
    988 the following lines anywhere in the buffer:
    989 
    990    #+STARTUP: indent
    991    #+STARTUP: noindent"
    992   :group 'org-structure
    993   :type '(choice
    994 	  (const :tag "Not" nil)
    995 	  (const :tag "Globally (slow on startup in large files)" t)))
    996 
    997 (defcustom org-startup-numerated nil
    998   "Non-nil means turn on `org-num-mode' on startup.
    999 This can also be configured on a per-file basis by adding one of
   1000 the following lines anywhere in the buffer:
   1001 
   1002    #+STARTUP: num
   1003    #+STARTUP: nonum"
   1004   :group 'org-structure
   1005   :package-version '(Org . "9.4")
   1006   :type '(choice
   1007 	  (const :tag "Not" nil)
   1008 	  (const :tag "Globally" t)))
   1009 
   1010 (defcustom org-use-sub-superscripts t
   1011   "Non-nil means interpret \"_\" and \"^\" for display.
   1012 
   1013 If you want to control how Org exports those characters, see
   1014 `org-export-with-sub-superscripts'.
   1015 
   1016 When this option is turned on, you can use TeX-like syntax for
   1017 sub- and superscripts within the buffer.  Several characters after
   1018 \"_\" or \"^\" will be considered as a single item - so grouping
   1019 with {} is normally not needed.  For example, the following things
   1020 will be parsed as single sub- or superscripts:
   1021 
   1022  10^24   or   10^tau     several digits will be considered 1 item.
   1023  10^-12  or   10^-tau    a leading sign with digits or a word
   1024  x^2-y^3                 will be read as x^2 - y^3, because items are
   1025 			 terminated by almost any nonword/nondigit char.
   1026  x_{i^2} or   x^(2-i)    braces or parenthesis do grouping.
   1027 
   1028 Still, ambiguity is possible.  So when in doubt, use {} to enclose
   1029 the sub/superscript.  If you set this variable to the symbol `{}',
   1030 the braces are *required* in order to trigger interpretations as
   1031 sub/superscript.  This can be helpful in documents that need \"_\"
   1032 frequently in plain text."
   1033   :group 'org-startup
   1034   :version "24.4"
   1035   :package-version '(Org . "8.0")
   1036   :type '(choice
   1037 	  (const :tag "Always interpret" t)
   1038 	  (const :tag "Only with braces" {})
   1039 	  (const :tag "Never interpret" nil)))
   1040 
   1041 (defcustom org-startup-with-beamer-mode nil
   1042   "Non-nil means turn on `org-beamer-mode' on startup.
   1043 This can also be configured on a per-file basis by adding one of
   1044 the following lines anywhere in the buffer:
   1045 
   1046    #+STARTUP: beamer"
   1047   :group 'org-startup
   1048   :version "24.1"
   1049   :type 'boolean)
   1050 
   1051 (defcustom org-startup-align-all-tables nil
   1052   "Non-nil means align all tables when visiting a file.
   1053 This can also be configured on a per-file basis by adding one of
   1054 the following lines anywhere in the buffer:
   1055    #+STARTUP: align
   1056    #+STARTUP: noalign"
   1057   :group 'org-startup
   1058   :type 'boolean)
   1059 
   1060 (defcustom org-startup-shrink-all-tables nil
   1061   "Non-nil means shrink all table columns with a width cookie.
   1062 This can also be configured on a per-file basis by adding one of
   1063 the following lines anywhere in the buffer:
   1064    #+STARTUP: shrink"
   1065   :group 'org-startup
   1066   :type 'boolean
   1067   :version "27.1"
   1068   :package-version '(Org . "9.2")
   1069   :safe #'booleanp)
   1070 
   1071 (defcustom org-startup-with-inline-images nil
   1072   "Non-nil means show inline images when loading a new Org file.
   1073 This can also be configured on a per-file basis by adding one of
   1074 the following lines anywhere in the buffer:
   1075    #+STARTUP: inlineimages
   1076    #+STARTUP: noinlineimages"
   1077   :group 'org-startup
   1078   :version "24.1"
   1079   :type 'boolean)
   1080 
   1081 (defcustom org-startup-with-latex-preview nil
   1082   "Non-nil means preview LaTeX fragments when loading a new Org file.
   1083 
   1084 This can also be configured on a per-file basis by adding one of
   1085 the following lines anywhere in the buffer:
   1086    #+STARTUP: latexpreview
   1087    #+STARTUP: nolatexpreview"
   1088   :group 'org-startup
   1089   :version "24.4"
   1090   :package-version '(Org . "8.0")
   1091   :type 'boolean)
   1092 
   1093 (defcustom org-insert-mode-line-in-empty-file nil
   1094   "Non-nil means insert the first line setting Org mode in empty files.
   1095 When the function `org-mode' is called interactively in an empty file, this
   1096 normally means that the file name does not automatically trigger Org mode.
   1097 To ensure that the file will always be in Org mode in the future, a
   1098 line enforcing Org mode will be inserted into the buffer, if this option
   1099 has been set."
   1100   :group 'org-startup
   1101   :type 'boolean)
   1102 
   1103 (defcustom org-ellipsis nil
   1104   "The ellipsis to use in the Org mode outline.
   1105 
   1106 When nil, just use the standard three dots.  When a non-empty string,
   1107 use that string instead.
   1108 
   1109 The change affects only Org mode (which will then use its own display table).
   1110 Changing this requires executing `\\[org-mode]' in a buffer to become
   1111 effective.  It cannot be set as a local variable."
   1112   :group 'org-startup
   1113   :type '(choice (const :tag "Default" nil)
   1114 		 (string :tag "String" :value "...#")))
   1115 
   1116 (defvar org-display-table nil
   1117   "The display table for Org mode, in case `org-ellipsis' is non-nil.")
   1118 
   1119 (defcustom org-directory "~/org"
   1120   "Directory with Org files.
   1121 This is just a default location to look for Org files.  There is no need
   1122 at all to put your files into this directory.  It is used in the
   1123 following situations:
   1124 
   1125 1. When a capture template specifies a target file that is not an
   1126    absolute path.  The path will then be interpreted relative to
   1127    `org-directory'
   1128 2. When the value of variable `org-agenda-files' is a single file, any
   1129    relative paths in this file will be taken as relative to
   1130    `org-directory'."
   1131   :group 'org-refile
   1132   :group 'org-capture
   1133   :type 'directory)
   1134 
   1135 (defcustom org-default-notes-file (convert-standard-filename "~/.notes")
   1136   "Default target for storing notes.
   1137 Used as a fall back file for org-capture.el, for templates that
   1138 do not specify a target file."
   1139   :group 'org-refile
   1140   :group 'org-capture
   1141   :type 'file)
   1142 
   1143 (defcustom org-reverse-note-order nil
   1144   "Non-nil means store new notes at the beginning of a file or entry.
   1145 When nil, new notes will be filed to the end of a file or entry.
   1146 This can also be a list with cons cells of regular expressions that
   1147 are matched against file names, and values."
   1148   :group 'org-capture
   1149   :group 'org-refile
   1150   :type '(choice
   1151 	  (const :tag "Reverse always" t)
   1152 	  (const :tag "Reverse never" nil)
   1153 	  (repeat :tag "By file name regexp"
   1154 		  (cons regexp boolean))))
   1155 
   1156 (defgroup org-keywords nil
   1157   "Keywords in Org mode."
   1158   :tag "Org Keywords"
   1159   :group 'org)
   1160 
   1161 (defcustom org-closed-keep-when-no-todo nil
   1162   "Remove CLOSED: time-stamp when switching back to a non-todo state?"
   1163   :group 'org-todo
   1164   :group 'org-keywords
   1165   :version "24.4"
   1166   :package-version '(Org . "8.0")
   1167   :type 'boolean)
   1168 
   1169 (defgroup org-structure nil
   1170   "Options concerning the general structure of Org files."
   1171   :tag "Org Structure"
   1172   :group 'org)
   1173 
   1174 (defgroup org-reveal-location nil
   1175   "Options about how to make context of a location visible."
   1176   :tag "Org Reveal Location"
   1177   :group 'org-structure)
   1178 
   1179 (defcustom org-show-context-detail '((agenda . local)
   1180 				     (bookmark-jump . lineage)
   1181 				     (isearch . lineage)
   1182 				     (default . ancestors))
   1183   "Alist between context and visibility span when revealing a location.
   1184 
   1185 \\<org-mode-map>Some actions may move point into invisible
   1186 locations.  As a consequence, Org always exposes a neighborhood
   1187 around point.  How much is shown depends on the initial action,
   1188 or context.  Valid contexts are
   1189 
   1190   agenda         when exposing an entry from the agenda
   1191   org-goto       when using the command `org-goto' (`\\[org-goto]')
   1192   occur-tree     when using the command `org-occur' (`\\[org-sparse-tree] /')
   1193   tags-tree      when constructing a sparse tree based on tags matches
   1194   link-search    when exposing search matches associated with a link
   1195   mark-goto      when exposing the jump goal of a mark
   1196   bookmark-jump  when exposing a bookmark location
   1197   isearch        when exiting from an incremental search
   1198   default        default for all contexts not set explicitly
   1199 
   1200 Allowed visibility spans are
   1201 
   1202   minimal        show current headline; if point is not on headline,
   1203                  also show entry
   1204 
   1205   local          show current headline, entry and next headline
   1206 
   1207   ancestors      show current headline and its direct ancestors; if
   1208                  point is not on headline, also show entry
   1209 
   1210   ancestors-full show current subtree and its direct ancestors
   1211 
   1212   lineage        show current headline, its direct ancestors and all
   1213                  their children; if point is not on headline, also show
   1214                  entry and first child
   1215 
   1216   tree           show current headline, its direct ancestors and all
   1217                  their children; if point is not on headline, also show
   1218                  entry and all children
   1219 
   1220   canonical      show current headline, its direct ancestors along with
   1221                  their entries and children; if point is not located on
   1222                  the headline, also show current entry and all children
   1223 
   1224 As special cases, a nil or t value means show all contexts in
   1225 `minimal' or `canonical' view, respectively.
   1226 
   1227 Some views can make displayed information very compact, but also
   1228 make it harder to edit the location of the match.  In such
   1229 a case, use the command `org-reveal' (`\\[org-reveal]') to show
   1230 more context."
   1231   :group 'org-reveal-location
   1232   :version "26.1"
   1233   :package-version '(Org . "9.0")
   1234   :type '(choice
   1235 	  (const :tag "Canonical" t)
   1236 	  (const :tag "Minimal" nil)
   1237 	  (repeat :greedy t :tag "Individual contexts"
   1238 		  (cons
   1239 		   (choice :tag "Context"
   1240 			   (const agenda)
   1241 			   (const org-goto)
   1242 			   (const occur-tree)
   1243 			   (const tags-tree)
   1244 			   (const link-search)
   1245 			   (const mark-goto)
   1246 			   (const bookmark-jump)
   1247 			   (const isearch)
   1248 			   (const default))
   1249 		   (choice :tag "Detail level"
   1250 			   (const minimal)
   1251 			   (const local)
   1252 			   (const ancestors)
   1253                            (const ancestors-full)
   1254 			   (const lineage)
   1255 			   (const tree)
   1256 			   (const canonical))))))
   1257 
   1258 (defcustom org-indirect-buffer-display 'other-window
   1259   "How should indirect tree buffers be displayed?
   1260 
   1261 This applies to indirect buffers created with the commands
   1262 `org-tree-to-indirect-buffer' and `org-agenda-tree-to-indirect-buffer'.
   1263 
   1264 Valid values are:
   1265 current-window   Display in the current window
   1266 other-window     Just display in another window.
   1267 dedicated-frame  Create one new frame, and re-use it each time.
   1268 new-frame        Make a new frame each time.  Note that in this case
   1269                  previously-made indirect buffers are kept, and you need to
   1270                  kill these buffers yourself."
   1271   :group 'org-structure
   1272   :group 'org-agenda-windows
   1273   :type '(choice
   1274 	  (const :tag "In current window" current-window)
   1275 	  (const :tag "In current frame, other window" other-window)
   1276 	  (const :tag "Each time a new frame" new-frame)
   1277 	  (const :tag "One dedicated frame" dedicated-frame)))
   1278 
   1279 (defconst org-file-apps-gnu
   1280   '((remote . emacs)
   1281     (system . mailcap)
   1282     (t . mailcap))
   1283   "Default file applications on a UNIX or GNU/Linux system.
   1284 See `org-file-apps'.")
   1285 
   1286 (defconst org-file-apps-macos
   1287   '((remote . emacs)
   1288     (system . "open %s")
   1289     ("ps.gz"  . "gv %s")
   1290     ("eps.gz" . "gv %s")
   1291     ("dvi"    . "xdvi %s")
   1292     ("fig"    . "xfig %s")
   1293     (t . "open %s"))
   1294   "Default file applications on a macOS system.
   1295 The system \"open\" is known as a default, but we use X11 applications
   1296 for some files for which the OS does not have a good default.
   1297 See `org-file-apps'.")
   1298 
   1299 (defconst org-file-apps-windowsnt
   1300   (list '(remote . emacs)
   1301 	(cons 'system (lambda (file _path)
   1302 			(with-no-warnings (w32-shell-execute "open" file))))
   1303 	(cons t (lambda (file _path)
   1304 		  (with-no-warnings (w32-shell-execute "open" file)))))
   1305   "Default file applications on a Windows NT system.
   1306 The system \"open\" is used for most files.
   1307 See `org-file-apps'.")
   1308 
   1309 (defcustom org-file-apps
   1310   '((auto-mode . emacs)
   1311     (directory . emacs)
   1312     ("\\.mm\\'" . default)
   1313     ("\\.x?html?\\'" . default)
   1314     ("\\.pdf\\'" . default))
   1315   "Applications for opening `file:path' items in a document.
   1316 
   1317 \\<org-mode-map>
   1318 Org mode uses system defaults for different file types, but you
   1319 can use this variable to set the application for a given file
   1320 extension.  The entries in this list are cons cells where the car
   1321 identifies files and the cdr the corresponding command.
   1322 
   1323 Possible values for the file identifier are:
   1324 
   1325  \"string\"    A string as a file identifier can be interpreted in different
   1326                ways, depending on its contents:
   1327 
   1328                - Alphanumeric characters only:
   1329                  Match links with this file extension.
   1330                  Example: (\"pdf\" . \"evince %s\")
   1331                           to open PDFs with evince.
   1332 
   1333                - Regular expression: Match links where the
   1334                  filename matches the regexp.  If you want to
   1335                  use groups here, use shy groups.
   1336 
   1337                  Example: (\"\\\\.x?html\\\\\\='\" . \"firefox %s\")
   1338                           (\"\\\\(?:xhtml\\\\|html\\\\)\\\\\\='\" . \"firefox %s\")
   1339                           to open *.html and *.xhtml with firefox.
   1340 
   1341                - Regular expression which contains (non-shy) groups:
   1342                  Match links where the whole link, including \"::\", and
   1343                  anything after that, matches the regexp.
   1344                  In a custom command string, %1, %2, etc. are replaced with
   1345                  the parts of the link that were matched by the groups.
   1346                  For backwards compatibility, if a command string is given
   1347                  that does not use any of the group matches, this case is
   1348                  handled identically to the second one (i.e. match against
   1349                  file name only).
   1350                  In a custom function, you can access the group matches with
   1351                  (match-string n link).
   1352 
   1353                  Example: (\"\\\\.pdf::\\\\([0-9]+\\\\)\\\\\\='\" . \
   1354 \"evince -p %1 %s\")
   1355                      to open [[file:document.pdf::5]] with evince at page 5.
   1356 
   1357  `directory'   Matches a directory
   1358  `remote'      Matches a remote file, accessible through tramp or efs.
   1359                Remote files most likely should be visited through Emacs
   1360                because external applications cannot handle such paths.
   1361 `auto-mode'    Matches files that are matched by any entry in `auto-mode-alist',
   1362                so all files Emacs knows how to handle.  Using this with
   1363                command `emacs' will open most files in Emacs.  Beware that this
   1364                will also open html files inside Emacs, unless you add
   1365                (\"html\" . default) to the list as well.
   1366  `system'      The system command to open files, like `open' on Windows
   1367                and macOS, and mailcap under GNU/Linux.  This is the command
   1368                that will be selected if you call `org-open-at-point' with a
   1369                double prefix argument (`\\[universal-argument] \
   1370 \\[universal-argument] \\[org-open-at-point]').
   1371  t             Default for files not matched by any of the other options.
   1372 
   1373 Possible values for the command are:
   1374 
   1375  `emacs'       The file will be visited by the current Emacs process.
   1376  `default'     Use the default application for this file type, which is the
   1377                association for t in the list, most likely in the system-specific
   1378                part.  This can be used to overrule an unwanted setting in the
   1379                system-specific variable.
   1380  `system'      Use the system command for opening files, like \"open\".
   1381                This command is specified by the entry whose car is `system'.
   1382                Most likely, the system-specific version of this variable
   1383                does define this command, but you can overrule/replace it
   1384                here.
   1385 `mailcap'      Use command specified in the mailcaps.
   1386  string        A command to be executed by a shell; %s will be replaced
   1387                by the path to the file.
   1388  function      A Lisp function, which will be called with two arguments:
   1389                the file path and the original link string, without the
   1390                \"file:\" prefix.
   1391 
   1392 For more examples, see the system specific constants
   1393 `org-file-apps-macos'
   1394 `org-file-apps-windowsnt'
   1395 `org-file-apps-gnu'."
   1396   :group 'org
   1397   :package-version '(Org . "9.4")
   1398   :type '(repeat
   1399 	  (cons (choice :value ""
   1400 			(string :tag "Extension")
   1401 			(const :tag "System command to open files" system)
   1402 			(const :tag "Default for unrecognized files" t)
   1403 			(const :tag "Remote file" remote)
   1404 			(const :tag "Links to a directory" directory)
   1405 			(const :tag "Any files that have Emacs modes"
   1406 			       auto-mode))
   1407 		(choice :value ""
   1408 			(const :tag "Visit with Emacs" emacs)
   1409 			(const :tag "Use default" default)
   1410 			(const :tag "Use the system command" system)
   1411 			(string :tag "Command")
   1412 			(function :tag "Function")))))
   1413 
   1414 (defcustom org-open-non-existing-files nil
   1415   "Non-nil means `org-open-file' opens non-existing files.
   1416 
   1417 When nil, an error is thrown.
   1418 
   1419 This variable applies only to external applications because they
   1420 might choke on non-existing files.  If the link is to a file that
   1421 will be opened in Emacs, the variable is ignored."
   1422   :group 'org
   1423   :type 'boolean
   1424   :safe #'booleanp)
   1425 
   1426 (defcustom org-open-directory-means-index-dot-org nil
   1427   "When non-nil a link to a directory really means to \"index.org\".
   1428 When nil, following a directory link runs Dired or opens
   1429 a finder/explorer window on that directory."
   1430   :group 'org
   1431   :type 'boolean
   1432   :safe #'booleanp)
   1433 
   1434 (defcustom org-bookmark-names-plist
   1435   '(:last-capture "org-capture-last-stored"
   1436 		  :last-refile "org-refile-last-stored"
   1437 		  :last-capture-marker "org-capture-last-stored-marker")
   1438   "Names for bookmarks automatically set by some Org commands.
   1439 This can provide strings as names for a number of bookmarks Org sets
   1440 automatically.  The following keys are currently implemented:
   1441   :last-capture
   1442   :last-capture-marker
   1443   :last-refile
   1444 When a key does not show up in the property list, the corresponding bookmark
   1445 is not set."
   1446   :group 'org-structure
   1447   :type 'plist)
   1448 
   1449 (defgroup org-cycle nil
   1450   "Options concerning visibility cycling in Org mode."
   1451   :tag "Org Cycle"
   1452   :group 'org-structure)
   1453 
   1454 (defcustom org-cycle-skip-children-state-if-no-children t
   1455   "Non-nil means skip CHILDREN state in entries that don't have any."
   1456   :group 'org-cycle
   1457   :type 'boolean)
   1458 
   1459 (defcustom org-cycle-max-level nil
   1460   "Maximum level which should still be subject to visibility cycling.
   1461 Levels higher than this will, for cycling, be treated as text, not a headline.
   1462 When `org-odd-levels-only' is set, a value of N in this variable actually
   1463 means 2N-1 stars as the limiting headline.
   1464 When nil, cycle all levels.
   1465 Note that the limiting level of cycling is also influenced by
   1466 `org-inlinetask-min-level'.  When `org-cycle-max-level' is not set but
   1467 `org-inlinetask-min-level' is, cycling will be limited to levels one less
   1468 than its value."
   1469   :group 'org-cycle
   1470   :type '(choice
   1471 	  (const :tag "No limit" nil)
   1472 	  (integer :tag "Maximum level")))
   1473 
   1474 (defcustom org-hide-block-startup nil
   1475   "Non-nil means entering Org mode will fold all blocks.
   1476 This can also be set in on a per-file basis with
   1477 
   1478 #+STARTUP: hideblocks
   1479 #+STARTUP: showblocks"
   1480   :group 'org-startup
   1481   :group 'org-cycle
   1482   :type 'boolean)
   1483 
   1484 (defcustom org-cycle-global-at-bob nil
   1485   "Cycle globally if cursor is at beginning of buffer and not at a headline.
   1486 
   1487 This makes it possible to do global cycling without having to use `S-TAB'
   1488 or `\\[universal-argument] TAB'.  For this special case to work, the first \
   1489 line of the buffer
   1490 must not be a headline -- it may be empty or some other text.
   1491 
   1492 When used in this way, `org-cycle-hook' is disabled temporarily to make
   1493 sure the cursor stays at the beginning of the buffer.
   1494 
   1495 When this option is nil, don't do anything special at the beginning of
   1496 the buffer."
   1497   :group 'org-cycle
   1498   :type 'boolean)
   1499 
   1500 (defcustom org-cycle-level-after-item/entry-creation t
   1501   "Non-nil means cycle entry level or item indentation in new empty entries.
   1502 
   1503 When the cursor is at the end of an empty headline, i.e., with only stars
   1504 and maybe a TODO keyword, TAB will then switch the entry to become a child,
   1505 and then all possible ancestor states, before returning to the original state.
   1506 This makes data entry extremely fast:  M-RET to create a new headline,
   1507 on TAB to make it a child, two or more tabs to make it a (grand-)uncle.
   1508 
   1509 When the cursor is at the end of an empty plain list item, one TAB will
   1510 make it a subitem, two or more tabs will back up to make this an item
   1511 higher up in the item hierarchy."
   1512   :group 'org-cycle
   1513   :type 'boolean)
   1514 
   1515 (defcustom org-cycle-emulate-tab t
   1516   "Where should `org-cycle' emulate TAB.
   1517 nil         Never
   1518 white       Only in completely white lines
   1519 whitestart  Only at the beginning of lines, before the first non-white char
   1520 t           Everywhere except in headlines
   1521 exc-hl-bol  Everywhere except at the start of a headline
   1522 If TAB is used in a place where it does not emulate TAB, the current subtree
   1523 visibility is cycled."
   1524   :group 'org-cycle
   1525   :type '(choice (const :tag "Never" nil)
   1526 		 (const :tag "Only in completely white lines" white)
   1527 		 (const :tag "Before first char in a line" whitestart)
   1528 		 (const :tag "Everywhere except in headlines" t)
   1529 		 (const :tag "Everywhere except at bol in headlines" exc-hl-bol)))
   1530 
   1531 (defcustom org-cycle-separator-lines 2
   1532   "Number of empty lines needed to keep an empty line between collapsed trees.
   1533 If you leave an empty line between the end of a subtree and the following
   1534 headline, this empty line is hidden when the subtree is folded.
   1535 Org mode will leave (exactly) one empty line visible if the number of
   1536 empty lines is equal or larger to the number given in this variable.
   1537 So the default 2 means at least 2 empty lines after the end of a subtree
   1538 are needed to produce free space between a collapsed subtree and the
   1539 following headline.
   1540 
   1541 If the number is negative, and the number of empty lines is at least -N,
   1542 all empty lines are shown.
   1543 
   1544 Special case: when 0, never leave empty lines in collapsed view."
   1545   :group 'org-cycle
   1546   :type 'integer)
   1547 (put 'org-cycle-separator-lines 'safe-local-variable 'integerp)
   1548 
   1549 (defcustom org-pre-cycle-hook nil
   1550   "Hook that is run before visibility cycling is happening.
   1551 The function(s) in this hook must accept a single argument which indicates
   1552 the new state that will be set right after running this hook.  The
   1553 argument is a symbol.  Before a global state change, it can have the values
   1554 `overview', `content', or `all'.  Before a local state change, it can have
   1555 the values `folded', `children', or `subtree'."
   1556   :group 'org-cycle
   1557   :type 'hook)
   1558 
   1559 (defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
   1560 			    org-cycle-hide-drawers
   1561 			    org-cycle-show-empty-lines
   1562 			    org-optimize-window-after-visibility-change)
   1563   "Hook that is run after `org-cycle' has changed the buffer visibility.
   1564 The function(s) in this hook must accept a single argument which indicates
   1565 the new state that was set by the most recent `org-cycle' command.  The
   1566 argument is a symbol.  After a global state change, it can have the values
   1567 `overview', `contents', or `all'.  After a local state change, it can have
   1568 the values `folded', `children', or `subtree'."
   1569   :group 'org-cycle
   1570   :package-version '(Org . "9.4")
   1571   :type 'hook)
   1572 
   1573 (defgroup org-edit-structure nil
   1574   "Options concerning structure editing in Org mode."
   1575   :tag "Org Edit Structure"
   1576   :group 'org-structure)
   1577 
   1578 (defcustom org-odd-levels-only nil
   1579   "Non-nil means skip even levels and only use odd levels for the outline.
   1580 This has the effect that two stars are being added/taken away in
   1581 promotion/demotion commands.  It also influences how levels are
   1582 handled by the exporters.
   1583 Changing it requires restart of `font-lock-mode' to become effective
   1584 for fontification also in regions already fontified.
   1585 You may also set this on a per-file basis by adding one of the following
   1586 lines to the buffer:
   1587 
   1588    #+STARTUP: odd
   1589    #+STARTUP: oddeven"
   1590   :group 'org-edit-structure
   1591   :group 'org-appearance
   1592   :type 'boolean)
   1593 
   1594 (defcustom org-adapt-indentation nil
   1595   "Non-nil means adapt indentation to outline node level.
   1596 
   1597 When set to t, Org assumes that you write outlines by indenting
   1598 text in each node to align with the headline, after the stars.
   1599 
   1600 When this variable is set to `headline-data', Org only adapts the
   1601 indentation of the data lines right below the headline, such as
   1602 planning/clock lines and property/logbook drawers.
   1603 
   1604 The following issues are influenced by this variable:
   1605 
   1606 - The indentation is increased by one space in a demotion
   1607   command, and decreased by one in a promotion command.  However,
   1608   in the latter case, if shifting some line in the entry body
   1609   would alter document structure (e.g., insert a new headline),
   1610   indentation is not changed at all.
   1611 
   1612 - Property drawers and planning information is inserted indented
   1613   when this variable is set.  When nil, they will not be indented.
   1614 
   1615 - TAB indents a line relative to current level.  The lines below
   1616   a headline will be indented when this variable is set to t.
   1617 
   1618 Note that this is all about true indentation, by adding and
   1619 removing space characters.  See also \"org-indent.el\" which does
   1620 level-dependent indentation in a virtual way, i.e. at display
   1621 time in Emacs."
   1622   :group 'org-edit-structure
   1623   :type '(choice
   1624 	  (const :tag "Adapt indentation for all lines" t)
   1625 	  (const :tag "Adapt indentation for headline data lines"
   1626 		 headline-data)
   1627 	  (const :tag "Do not adapt indentation at all" nil))
   1628   :safe (lambda (x) (memq x '(t nil headline-data))))
   1629 
   1630 (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)
   1631 
   1632 (defcustom org-special-ctrl-a/e nil
   1633   "Non-nil means `C-a' and `C-e' behave specially in headlines and items.
   1634 
   1635 When t, `C-a' will bring back the cursor to the beginning of the
   1636 headline text, i.e. after the stars and after a possible TODO
   1637 keyword.  In an item, this will be the position after bullet and
   1638 check-box, if any.  When the cursor is already at that position,
   1639 another `C-a' will bring it to the beginning of the line.
   1640 
   1641 `C-e' will jump to the end of the headline, ignoring the presence
   1642 of tags in the headline.  A second `C-e' will then jump to the
   1643 true end of the line, after any tags.  This also means that, when
   1644 this variable is non-nil, `C-e' also will never jump beyond the
   1645 end of the heading of a folded section, i.e. not after the
   1646 ellipses.
   1647 
   1648 When set to the symbol `reversed', the first `C-a' or `C-e' works
   1649 normally, going to the true line boundary first.  Only a directly
   1650 following, identical keypress will bring the cursor to the
   1651 special positions.
   1652 
   1653 This may also be a cons cell where the behavior for `C-a' and
   1654 `C-e' is set separately."
   1655   :group 'org-edit-structure
   1656   :type '(choice
   1657 	  (const :tag "off" nil)
   1658 	  (const :tag "on: after stars/bullet and before tags first" t)
   1659 	  (const :tag "reversed: true line boundary first" reversed)
   1660 	  (cons :tag "Set C-a and C-e separately"
   1661 		(choice :tag "Special C-a"
   1662 			(const :tag "off" nil)
   1663 			(const :tag "on: after  stars/bullet first" t)
   1664 			(const :tag "reversed: before stars/bullet first" reversed))
   1665 		(choice :tag "Special C-e"
   1666 			(const :tag "off" nil)
   1667 			(const :tag "on: before tags first" t)
   1668 			(const :tag "reversed: after tags first" reversed)))))
   1669 
   1670 (defcustom org-special-ctrl-k nil
   1671   "Non-nil means `C-k' will behave specially in headlines.
   1672 When nil, `C-k' will call the default `kill-line' command.
   1673 When t, the following will happen while the cursor is in the headline:
   1674 
   1675 - When at the beginning of a headline, kill the entire subtree.
   1676 - When in the middle of the headline text, kill the text up to the tags.
   1677 - When after the headline text and before the tags, kill all the tags."
   1678   :group 'org-edit-structure
   1679   :type 'boolean)
   1680 
   1681 (defcustom org-ctrl-k-protect-subtree nil
   1682   "Non-nil means, do not delete a hidden subtree with `C-k'.
   1683 When set to the symbol `error', simply throw an error when `C-k' is
   1684 used to kill (part-of) a headline that has hidden text behind it.
   1685 Any other non-nil value will result in a query to the user, if it is
   1686 OK to kill that hidden subtree.  When nil, kill without remorse."
   1687   :group 'org-edit-structure
   1688   :version "24.1"
   1689   :type '(choice
   1690 	  (const :tag "Do not protect hidden subtrees" nil)
   1691 	  (const :tag "Protect hidden subtrees with a security query" t)
   1692 	  (const :tag "Never kill a hidden subtree with C-k" error)))
   1693 
   1694 (defcustom org-special-ctrl-o t
   1695   "Non-nil means, make `C-o' insert a row in tables."
   1696   :group 'org-edit-structure
   1697   :type 'boolean)
   1698 
   1699 (defcustom org-catch-invisible-edits nil
   1700   "Check if in invisible region before inserting or deleting a character.
   1701 Valid values are:
   1702 
   1703 nil              Do not check, so just do invisible edits.
   1704 error            Throw an error and do nothing.
   1705 show             Make point visible, and do the requested edit.
   1706 show-and-error   Make point visible, then throw an error and abort the edit.
   1707 smart            Make point visible, and do insertion/deletion if it is
   1708                  adjacent to visible text and the change feels predictable.
   1709                  Never delete a previously invisible character or add in the
   1710                  middle or right after an invisible region.  Basically, this
   1711                  allows insertion and backward-delete right before ellipses.
   1712                  FIXME: maybe in this case we should not even show?"
   1713   :group 'org-edit-structure
   1714   :version "24.1"
   1715   :type '(choice
   1716 	  (const :tag "Do not check" nil)
   1717 	  (const :tag "Throw error when trying to edit" error)
   1718 	  (const :tag "Unhide, but do not do the edit" show-and-error)
   1719 	  (const :tag "Show invisible part and do the edit" show)
   1720 	  (const :tag "Be smart and do the right thing" smart)))
   1721 
   1722 (defcustom org-yank-folded-subtrees t
   1723   "Non-nil means when yanking subtrees, fold them.
   1724 If the kill is a single subtree, or a sequence of subtrees, i.e. if
   1725 it starts with a heading and all other headings in it are either children
   1726 or siblings, then fold all the subtrees.  However, do this only if no
   1727 text after the yank would be swallowed into a folded tree by this action."
   1728   :group 'org-edit-structure
   1729   :type 'boolean)
   1730 
   1731 (defcustom org-yank-adjusted-subtrees nil
   1732   "Non-nil means when yanking subtrees, adjust the level.
   1733 With this setting, `org-paste-subtree' is used to insert the subtree, see
   1734 this function for details."
   1735   :group 'org-edit-structure
   1736   :type 'boolean)
   1737 
   1738 (defcustom org-M-RET-may-split-line '((default . t))
   1739   "Non-nil means M-RET will split the line at the cursor position.
   1740 When nil, it will go to the end of the line before making a
   1741 new line.
   1742 You may also set this option in a different way for different
   1743 contexts.  Valid contexts are:
   1744 
   1745 headline  when creating a new headline
   1746 item      when creating a new item
   1747 table     in a table field
   1748 default   the value to be used for all contexts not explicitly
   1749           customized"
   1750   :group 'org-structure
   1751   :group 'org-table
   1752   :type '(choice
   1753 	  (const :tag "Always" t)
   1754 	  (const :tag "Never" nil)
   1755 	  (repeat :greedy t :tag "Individual contexts"
   1756 		  (cons
   1757 		   (choice :tag "Context"
   1758 			   (const headline)
   1759 			   (const item)
   1760 			   (const table)
   1761 			   (const default))
   1762 		   (boolean)))))
   1763 
   1764 
   1765 (defcustom org-insert-heading-respect-content nil
   1766   "Non-nil means insert new headings after the current subtree.
   1767 \\<org-mode-map>
   1768 When nil, the new heading is created directly after the current line.
   1769 The commands `\\[org-insert-heading-respect-content]' and \
   1770 `\\[org-insert-todo-heading-respect-content]' turn this variable on
   1771 for the duration of the command."
   1772   :group 'org-structure
   1773   :type 'boolean)
   1774 
   1775 (defcustom org-blank-before-new-entry '((heading . auto)
   1776 					(plain-list-item . auto))
   1777   "Should `org-insert-heading' leave a blank line before new heading/item?
   1778 The value is an alist, with `heading' and `plain-list-item' as CAR,
   1779 and a boolean flag as CDR.  The cdr may also be the symbol `auto', in
   1780 which case Org will look at the surrounding headings/items and try to
   1781 make an intelligent decision whether to insert a blank line or not."
   1782   :group 'org-edit-structure
   1783   :type '(list
   1784 	  (cons (const heading)
   1785 		(choice (const :tag "Never" nil)
   1786 			(const :tag "Always" t)
   1787 			(const :tag "Auto" auto)))
   1788 	  (cons (const plain-list-item)
   1789 		(choice (const :tag "Never" nil)
   1790 			(const :tag "Always" t)
   1791 			(const :tag "Auto" auto)))))
   1792 
   1793 (defcustom org-insert-heading-hook nil
   1794   "Hook being run after inserting a new heading."
   1795   :group 'org-edit-structure
   1796   :type 'hook)
   1797 
   1798 (defgroup org-sparse-trees nil
   1799   "Options concerning sparse trees in Org mode."
   1800   :tag "Org Sparse Trees"
   1801   :group 'org-structure)
   1802 
   1803 (defcustom org-highlight-sparse-tree-matches t
   1804   "Non-nil means highlight all matches that define a sparse tree.
   1805 The highlights will automatically disappear the next time the buffer is
   1806 changed by an edit command."
   1807   :group 'org-sparse-trees
   1808   :type 'boolean)
   1809 
   1810 (defcustom org-remove-highlights-with-change t
   1811   "Non-nil means any change to the buffer will remove temporary highlights.
   1812 \\<org-mode-map>\
   1813 Such highlights are created by `org-occur' and `org-clock-display'.
   1814 When nil, `\\[org-ctrl-c-ctrl-c]' needs to be used \
   1815 to get rid of the highlights.
   1816 The highlights created by `org-latex-preview' always need
   1817 `\\[org-latex-preview]' to be removed."
   1818   :group 'org-sparse-trees
   1819   :group 'org-time
   1820   :type 'boolean)
   1821 
   1822 (defcustom org-occur-case-fold-search t
   1823   "Non-nil means `org-occur' should be case-insensitive.
   1824 If set to `smart' the search will be case-insensitive only if it
   1825 doesn't specify any upper case character."
   1826   :group 'org-sparse-trees
   1827   :version "26.1"
   1828   :type '(choice
   1829 	  (const :tag "Case-sensitive" nil)
   1830 	  (const :tag "Case-insensitive" t)
   1831 	  (const :tag "Case-insensitive for lower case searches only" smart)))
   1832 
   1833 (defcustom org-occur-hook '(org-first-headline-recenter)
   1834   "Hook that is run after `org-occur' has constructed a sparse tree.
   1835 This can be used to recenter the window to show as much of the structure
   1836 as possible."
   1837   :group 'org-sparse-trees
   1838   :type 'hook)
   1839 
   1840 (defcustom org-self-insert-cluster-for-undo nil
   1841   "Non-nil means cluster self-insert commands for undo when possible.
   1842 If this is set, then, like in the Emacs command loop, 20 consecutive
   1843 characters will be undone together.
   1844 This is configurable, because there is some impact on typing performance."
   1845   :group 'org-table
   1846   :type 'boolean)
   1847 
   1848 (defvaralias 'org-activate-links 'org-highlight-links)
   1849 (defcustom org-highlight-links '(bracket angle plain radio tag date footnote)
   1850   "Types of links that should be highlighted in Org files.
   1851 
   1852 This is a list of symbols, each one of them leading to the
   1853 highlighting of a certain link type.
   1854 
   1855 You can still open links that are not highlighted.
   1856 
   1857 In principle, it does not hurt to turn on highlighting for all
   1858 link types.  There may be a small gain when turning off unused
   1859 link types.  The types are:
   1860 
   1861 bracket   The recommended [[link][description]] or [[link]] links with hiding.
   1862 angle     Links in angular brackets that may contain whitespace like
   1863           <bbdb:Carsten Dominik>.
   1864 plain     Plain links in normal text, no whitespace, like https://gnu.org.
   1865 radio     Text that is matched by a radio target, see manual for details.
   1866 tag       Tag settings in a headline (link to tag search).
   1867 date      Time stamps (link to calendar).
   1868 footnote  Footnote labels.
   1869 
   1870 If you set this variable during an Emacs session, use `org-mode-restart'
   1871 in the Org buffer so that the change takes effect."
   1872   :group 'org-appearance
   1873   :type '(set :greedy t
   1874 	      (const :tag "Double bracket links" bracket)
   1875 	      (const :tag "Angular bracket links" angle)
   1876 	      (const :tag "Plain text links" plain)
   1877 	      (const :tag "Radio target matches" radio)
   1878 	      (const :tag "Tags" tag)
   1879 	      (const :tag "Timestamps" date)
   1880 	      (const :tag "Footnotes" footnote)))
   1881 
   1882 (defcustom org-mark-ring-length 4
   1883   "Number of different positions to be recorded in the ring.
   1884 Changing this requires a restart of Emacs to work correctly."
   1885   :group 'org-link-follow
   1886   :type 'integer)
   1887 
   1888 (defgroup org-todo nil
   1889   "Options concerning TODO items in Org mode."
   1890   :tag "Org TODO"
   1891   :group 'org)
   1892 
   1893 (defgroup org-progress nil
   1894   "Options concerning Progress logging in Org mode."
   1895   :tag "Org Progress"
   1896   :group 'org-time)
   1897 
   1898 (defvar org-todo-interpretation-widgets
   1899   '((:tag "Sequence (cycling hits every state)" sequence)
   1900     (:tag "Type     (cycling directly to DONE)" type))
   1901   "The available interpretation symbols for customizing `org-todo-keywords'.
   1902 Interested libraries should add to this list.")
   1903 
   1904 (defcustom org-todo-keywords '((sequence "TODO" "DONE"))
   1905   "List of TODO entry keyword sequences and their interpretation.
   1906 \\<org-mode-map>This is a list of sequences.
   1907 
   1908 Each sequence starts with a symbol, either `sequence' or `type',
   1909 indicating if the keywords should be interpreted as a sequence of
   1910 action steps, or as different types of TODO items.  The first
   1911 keywords are states requiring action - these states will select a headline
   1912 for inclusion into the global TODO list Org produces.  If one of the
   1913 \"keywords\" is the vertical bar, \"|\", the remaining keywords
   1914 signify that no further action is necessary.  If \"|\" is not found,
   1915 the last keyword is treated as the only DONE state of the sequence.
   1916 
   1917 The command `\\[org-todo]' cycles an entry through these states, and one
   1918 additional state where no keyword is present.  For details about this
   1919 cycling, see the manual.
   1920 
   1921 TODO keywords and interpretation can also be set on a per-file basis with
   1922 the special #+SEQ_TODO and #+TYP_TODO lines.
   1923 
   1924 Each keyword can optionally specify a character for fast state selection
   1925 \(in combination with the variable `org-use-fast-todo-selection')
   1926 and specifiers for state change logging, using the same syntax that
   1927 is used in the \"#+TODO:\" lines.  For example, \"WAIT(w)\" says that
   1928 the WAIT state can be selected with the \"w\" key.  \"WAIT(w!)\"
   1929 indicates to record a time stamp each time this state is selected.
   1930 
   1931 Each keyword may also specify if a timestamp or a note should be
   1932 recorded when entering or leaving the state, by adding additional
   1933 characters in the parenthesis after the keyword.  This looks like this:
   1934 \"WAIT(w@/!)\".  \"@\" means to add a note (with time), \"!\" means to
   1935 record only the time of the state change.  With X and Y being either
   1936 \"@\" or \"!\", \"X/Y\" means use X when entering the state, and use
   1937 Y when leaving the state if and only if the *target* state does not
   1938 define X.  You may omit any of the fast-selection key or X or /Y,
   1939 so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid.
   1940 
   1941 For backward compatibility, this variable may also be just a list
   1942 of keywords.  In this case the interpretation (sequence or type) will be
   1943 taken from the (otherwise obsolete) variable `org-todo-interpretation'."
   1944   :group 'org-todo
   1945   :group 'org-keywords
   1946   :type '(choice
   1947 	  (repeat :tag "Old syntax, just keywords"
   1948 		  (string :tag "Keyword"))
   1949 	  (repeat :tag "New syntax"
   1950 		  (cons
   1951 		   (choice
   1952 		    :tag "Interpretation"
   1953 		    ;;Quick and dirty way to see
   1954                     ;;`org-todo-interpretation'.  This takes the
   1955 		    ;;place of item arguments
   1956 		    :convert-widget
   1957 		    (lambda (widget)
   1958 		      (widget-put widget
   1959 				  :args (mapcar
   1960 					 (lambda (x)
   1961 					   (widget-convert
   1962 					    (cons 'const x)))
   1963 					 org-todo-interpretation-widgets))
   1964 		      widget))
   1965 		   (repeat
   1966 		    (string :tag "Keyword"))))))
   1967 
   1968 (defvar-local org-todo-keywords-1 nil
   1969   "All TODO and DONE keywords active in a buffer.")
   1970 (defvar org-todo-keywords-for-agenda nil)
   1971 (defvar org-done-keywords-for-agenda nil)
   1972 (defvar org-todo-keyword-alist-for-agenda nil)
   1973 (defvar org-tag-alist-for-agenda nil
   1974   "Alist of all tags from all agenda files.")
   1975 (defvar org-tag-groups-alist-for-agenda nil
   1976   "Alist of all groups tags from all current agenda files.")
   1977 (defvar-local org-tag-groups-alist nil)
   1978 (defvar org-agenda-contributing-files nil)
   1979 (defvar-local org-current-tag-alist nil
   1980   "Alist of all tag groups in current buffer.
   1981 This variable takes into consideration `org-tag-alist',
   1982 `org-tag-persistent-alist' and TAGS keywords in the buffer.")
   1983 (defvar-local org-not-done-keywords nil)
   1984 (defvar-local org-done-keywords nil)
   1985 (defvar-local org-todo-heads nil)
   1986 (defvar-local org-todo-sets nil)
   1987 (defvar-local org-todo-log-states nil)
   1988 (defvar-local org-todo-kwd-alist nil)
   1989 (defvar-local org-todo-key-alist nil)
   1990 (defvar-local org-todo-key-trigger nil)
   1991 
   1992 (defcustom org-todo-interpretation 'sequence
   1993   "Controls how TODO keywords are interpreted.
   1994 This variable is in principle obsolete and is only used for
   1995 backward compatibility, if the interpretation of todo keywords is
   1996 not given already in `org-todo-keywords'.  See that variable for
   1997 more information."
   1998   :group 'org-todo
   1999   :group 'org-keywords
   2000   :type '(choice (const sequence)
   2001 		 (const type)))
   2002 
   2003 (defcustom org-use-fast-todo-selection 'auto
   2004   "\\<org-mode-map>\
   2005 Non-nil means use the fast todo selection scheme with `\\[org-todo]'.
   2006 This variable describes if and under what circumstances the cycling
   2007 mechanism for TODO keywords will be replaced by a single-key, direct
   2008 selection scheme, where the choices are displayed in a little window.
   2009 
   2010 When nil, fast selection is never used.  This means that the command
   2011 will always switch to the next state.
   2012 
   2013 When it is the symbol `auto', fast selection is whenever selection
   2014 keys have been defined.
   2015 
   2016 `expert' is like `auto', but no special window with the keyword
   2017 will be shown, choices will only be listed in the prompt.
   2018 
   2019 In all cases, the special interface is only used if access keys have
   2020 actually been assigned by the user, i.e. if keywords in the configuration
   2021 are followed by a letter in parenthesis, like TODO(t)."
   2022   :group 'org-todo
   2023   :set (lambda (var val)
   2024 	 (cond
   2025 	  ((eq var t) (set var 'auto))
   2026 	  ((eq var 'prefix) (set var nil))
   2027 	  (t (set var val))))
   2028   :type '(choice
   2029 	  (const :tag "Never" nil)
   2030 	  (const :tag "Automatically, when key letter have been defined" auto)
   2031 	  (const :tag "Automatically, but don't show the selection window" expert)))
   2032 
   2033 (defcustom org-provide-todo-statistics t
   2034   "Non-nil means update todo statistics after insert and toggle.
   2035 ALL-HEADLINES means update todo statistics by including headlines
   2036 with no TODO keyword as well, counting them as not done.
   2037 A list of TODO keywords means the same, but skip keywords that are
   2038 not in this list.
   2039 When set to a list of two lists, the first list contains keywords
   2040 to consider as TODO keywords, the second list contains keywords
   2041 to consider as DONE keywords.
   2042 
   2043 When this is set, todo statistics is updated in the parent of the
   2044 current entry each time a todo state is changed."
   2045   :group 'org-todo
   2046   :type '(choice
   2047 	  (const :tag "Yes, only for TODO entries" t)
   2048 	  (const :tag "Yes, including all entries" all-headlines)
   2049 	  (repeat :tag "Yes, for TODOs in this list"
   2050 		  (string :tag "TODO keyword"))
   2051 	  (list :tag "Yes, for TODOs and DONEs in these lists"
   2052 		(repeat (string :tag "TODO keyword"))
   2053 		(repeat (string :tag "DONE keyword")))
   2054 	  (other :tag "No TODO statistics" nil)))
   2055 
   2056 (defcustom org-hierarchical-todo-statistics t
   2057   "Non-nil means TODO statistics covers just direct children.
   2058 When nil, all entries in the subtree are considered.
   2059 This has only an effect if `org-provide-todo-statistics' is set.
   2060 To set this to nil for only a single subtree, use a COOKIE_DATA
   2061 property and include the word \"recursive\" into the value."
   2062   :group 'org-todo
   2063   :type 'boolean)
   2064 
   2065 (defcustom org-after-todo-state-change-hook nil
   2066   "Hook which is run after the state of a TODO item was changed.
   2067 The new state (a string with a TODO keyword, or nil) is available in the
   2068 Lisp variable `org-state'."
   2069   :group 'org-todo
   2070   :type 'hook)
   2071 
   2072 (defvar org-blocker-hook nil
   2073   "Hook for functions that are allowed to block a state change.
   2074 
   2075 Functions in this hook should not modify the buffer.
   2076 Each function gets as its single argument a property list,
   2077 see `org-trigger-hook' for more information about this list.
   2078 
   2079 If any of the functions in this hook returns nil, the state change
   2080 is blocked.")
   2081 
   2082 (defvar org-trigger-hook nil
   2083   "Hook for functions that are triggered by a state change.
   2084 
   2085 Each function gets as its single argument a property list with at
   2086 least the following elements:
   2087 
   2088  (:type type-of-change :position pos-at-entry-start
   2089   :from old-state :to new-state)
   2090 
   2091 Depending on the type, more properties may be present.
   2092 
   2093 This mechanism is currently implemented for:
   2094 
   2095 TODO state changes
   2096 ------------------
   2097 :type  todo-state-change
   2098 :from  previous state (keyword as a string), or nil, or a symbol
   2099        `todo' or `done', to indicate the general type of state.
   2100 :to    new state, like in :from")
   2101 
   2102 (defcustom org-enforce-todo-dependencies nil
   2103   "Non-nil means undone TODO entries will block switching the parent to DONE.
   2104 Also, if a parent has an :ORDERED: property, switching an entry to DONE will
   2105 be blocked if any prior sibling is not yet done.
   2106 Finally, if the parent is blocked because of ordered siblings of its own,
   2107 the child will also be blocked."
   2108   :set (lambda (var val)
   2109 	 (set var val)
   2110 	 (if val
   2111 	     (add-hook 'org-blocker-hook
   2112 		       'org-block-todo-from-children-or-siblings-or-parent)
   2113 	   (remove-hook 'org-blocker-hook
   2114 			'org-block-todo-from-children-or-siblings-or-parent)))
   2115   :group 'org-todo
   2116   :type 'boolean)
   2117 
   2118 (defcustom org-enforce-todo-checkbox-dependencies nil
   2119   "Non-nil means unchecked boxes will block switching the parent to DONE.
   2120 When this is nil, checkboxes have no influence on switching TODO states.
   2121 When non-nil, you first need to check off all check boxes before the TODO
   2122 entry can be switched to DONE.
   2123 This variable needs to be set before org.el is loaded, and you need to
   2124 restart Emacs after a change to make the change effective.  The only way
   2125 to change it while Emacs is running is through the customize interface."
   2126   :set (lambda (var val)
   2127 	 (set var val)
   2128 	 (if val
   2129 	     (add-hook 'org-blocker-hook
   2130 		       'org-block-todo-from-checkboxes)
   2131 	   (remove-hook 'org-blocker-hook
   2132 			'org-block-todo-from-checkboxes)))
   2133   :group 'org-todo
   2134   :type 'boolean)
   2135 
   2136 (defcustom org-treat-insert-todo-heading-as-state-change nil
   2137   "Non-nil means inserting a TODO heading is treated as state change.
   2138 So when the command `\\[org-insert-todo-heading]' is used, state change
   2139 logging will apply if appropriate.  When nil, the new TODO item will
   2140 be inserted directly, and no logging will take place."
   2141   :group 'org-todo
   2142   :type 'boolean)
   2143 
   2144 (defcustom org-treat-S-cursor-todo-selection-as-state-change t
   2145   "Non-nil means switching TODO states with S-cursor counts as state change.
   2146 This is the default behavior.  However, setting this to nil allows a
   2147 convenient way to select a TODO state and bypass any logging associated
   2148 with that."
   2149   :group 'org-todo
   2150   :type 'boolean)
   2151 
   2152 (defcustom org-todo-state-tags-triggers nil
   2153   "Tag changes that should be triggered by TODO state changes.
   2154 This is a list.  Each entry is
   2155 
   2156   (state-change (tag . flag) .......)
   2157 
   2158 State-change can be a string with a state, and empty string to indicate the
   2159 state that has no TODO keyword, or it can be one of the symbols `todo'
   2160 or `done', meaning any not-done or done state, respectively."
   2161   :group 'org-todo
   2162   :group 'org-tags
   2163   :type '(repeat
   2164 	  (cons (choice :tag "When changing to"
   2165 			(const :tag "Not-done state" todo)
   2166 			(const :tag "Done state" done)
   2167 			(string :tag "State"))
   2168 		(repeat
   2169 		 (cons :tag "Tag action"
   2170 		       (string :tag "Tag")
   2171 		       (choice (const :tag "Add" t) (const :tag "Remove" nil)))))))
   2172 
   2173 (defcustom org-log-done nil
   2174   "Information to record when a task moves to the DONE state.
   2175 
   2176 Possible values are:
   2177 
   2178 nil     Don't add anything, just change the keyword
   2179 time    Add a time stamp to the task
   2180 note    Prompt for a note and add it with template `org-log-note-headings'
   2181 
   2182 This option can also be set with on a per-file-basis with
   2183 
   2184    #+STARTUP: nologdone
   2185    #+STARTUP: logdone
   2186    #+STARTUP: lognotedone
   2187 
   2188 You can have local logging settings for a subtree by setting the LOGGING
   2189 property to one or more of these keywords."
   2190   :group 'org-todo
   2191   :group 'org-progress
   2192   :type '(choice
   2193 	  (const :tag "No logging" nil)
   2194 	  (const :tag "Record CLOSED timestamp" time)
   2195 	  (const :tag "Record CLOSED timestamp with note." note)))
   2196 
   2197 ;; Normalize old uses of org-log-done.
   2198 (cond
   2199  ((eq org-log-done t) (setq org-log-done 'time))
   2200  ((and (listp org-log-done) (memq 'done org-log-done))
   2201   (setq org-log-done 'note)))
   2202 
   2203 (defcustom org-log-reschedule nil
   2204   "Information to record when the scheduling date of a task is modified.
   2205 
   2206 Possible values are:
   2207 
   2208 nil     Don't add anything, just change the date
   2209 time    Add a time stamp to the task
   2210 note    Prompt for a note and add it with template `org-log-note-headings'
   2211 
   2212 This option can also be set with on a per-file-basis with
   2213 
   2214    #+STARTUP: nologreschedule
   2215    #+STARTUP: logreschedule
   2216    #+STARTUP: lognotereschedule
   2217 
   2218 You can have local logging settings for a subtree by setting the LOGGING
   2219 property to one or more of these keywords.
   2220 
   2221 This variable has an effect when calling `org-schedule' or
   2222 `org-agenda-schedule' only."
   2223   :group 'org-todo
   2224   :group 'org-progress
   2225   :type '(choice
   2226 	  (const :tag "No logging" nil)
   2227 	  (const :tag "Record timestamp" time)
   2228 	  (const :tag "Record timestamp with note" note)))
   2229 
   2230 (defcustom org-log-redeadline nil
   2231   "Information to record when the deadline date of a task is modified.
   2232 
   2233 Possible values are:
   2234 
   2235 nil     Don't add anything, just change the date
   2236 time    Add a time stamp to the task
   2237 note    Prompt for a note and add it with template `org-log-note-headings'
   2238 
   2239 This option can also be set with on a per-file-basis with
   2240 
   2241    #+STARTUP: nologredeadline
   2242    #+STARTUP: logredeadline
   2243    #+STARTUP: lognoteredeadline
   2244 
   2245 You can have local logging settings for a subtree by setting the LOGGING
   2246 property to one or more of these keywords.
   2247 
   2248 This variable has an effect when calling `org-deadline' or
   2249 `org-agenda-deadline' only."
   2250   :group 'org-todo
   2251   :group 'org-progress
   2252   :type '(choice
   2253 	  (const :tag "No logging" nil)
   2254 	  (const :tag "Record timestamp" time)
   2255 	  (const :tag "Record timestamp with note." note)))
   2256 
   2257 (defcustom org-log-note-clock-out nil
   2258   "Non-nil means record a note when clocking out of an item.
   2259 This can also be configured on a per-file basis by adding one of
   2260 the following lines anywhere in the buffer:
   2261 
   2262    #+STARTUP: lognoteclock-out
   2263    #+STARTUP: nolognoteclock-out"
   2264   :group 'org-todo
   2265   :group 'org-progress
   2266   :type 'boolean)
   2267 
   2268 (defcustom org-log-done-with-time t
   2269   "Non-nil means the CLOSED time stamp will contain date and time.
   2270 When nil, only the date will be recorded."
   2271   :group 'org-progress
   2272   :type 'boolean)
   2273 
   2274 (defcustom org-log-note-headings
   2275   '((done .  "CLOSING NOTE %t")
   2276     (state . "State %-12s from %-12S %t")
   2277     (note .  "Note taken on %t")
   2278     (reschedule .  "Rescheduled from %S on %t")
   2279     (delschedule .  "Not scheduled, was %S on %t")
   2280     (redeadline .  "New deadline from %S on %t")
   2281     (deldeadline .  "Removed deadline, was %S on %t")
   2282     (refile . "Refiled on %t")
   2283     (clock-out . ""))
   2284   "Headings for notes added to entries.
   2285 
   2286 The value is an alist, with the car being a symbol indicating the
   2287 note context, and the cdr is the heading to be used.  The heading
   2288 may also be the empty string.  The following placeholders can be
   2289 used:
   2290 
   2291   %t  a time stamp.
   2292   %T  an active time stamp instead the default inactive one
   2293   %d  a short-format time stamp.
   2294   %D  an active short-format time stamp.
   2295   %s  the new TODO state or time stamp (inactive), in double quotes.
   2296   %S  the old TODO state or time stamp (inactive), in double quotes.
   2297   %u  the user name.
   2298   %U  full user name.
   2299 
   2300 In fact, it is not a good idea to change the `state' entry,
   2301 because Agenda Log mode depends on the format of these entries."
   2302   :group  'org-todo
   2303   :group  'org-progress
   2304   :type '(list :greedy t
   2305 	       (cons (const :tag "Heading when closing an item" done) string)
   2306 	       (cons (const :tag
   2307 			    "Heading when changing todo state (todo sequence only)"
   2308 			    state) string)
   2309 	       (cons (const :tag "Heading when just taking a note" note) string)
   2310 	       (cons (const :tag "Heading when rescheduling" reschedule) string)
   2311 	       (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string)
   2312 	       (cons (const :tag "Heading when changing deadline"  redeadline) string)
   2313 	       (cons (const :tag "Heading when deleting a deadline" deldeadline) string)
   2314 	       (cons (const :tag "Heading when refiling" refile) string)
   2315 	       (cons (const :tag "Heading when clocking out" clock-out) string)))
   2316 
   2317 (unless (assq 'note org-log-note-headings)
   2318   (push '(note . "%t") org-log-note-headings))
   2319 
   2320 (defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer)
   2321 
   2322 (defcustom org-log-into-drawer nil
   2323   "Non-nil means insert state change notes and time stamps into a drawer.
   2324 When nil, state changes notes will be inserted after the headline and
   2325 any scheduling and clock lines, but not inside a drawer.
   2326 
   2327 The value of this variable should be the name of the drawer to use.
   2328 LOGBOOK is proposed as the default drawer for this purpose, you can
   2329 also set this to a string to define the drawer of your choice.
   2330 
   2331 A value of t is also allowed, representing \"LOGBOOK\".
   2332 
   2333 A value of t or nil can also be set with on a per-file-basis with
   2334 
   2335    #+STARTUP: logdrawer
   2336    #+STARTUP: nologdrawer
   2337 
   2338 If this variable is set, `org-log-state-notes-insert-after-drawers'
   2339 will be ignored.
   2340 
   2341 You can set the property LOG_INTO_DRAWER to overrule this setting for
   2342 a subtree.
   2343 
   2344 Do not check directly this variable in a Lisp program.  Call
   2345 function `org-log-into-drawer' instead."
   2346   :group 'org-todo
   2347   :group 'org-progress
   2348   :type '(choice
   2349 	  (const :tag "Not into a drawer" nil)
   2350 	  (const :tag "LOGBOOK" t)
   2351 	  (string :tag "Other")))
   2352 
   2353 (defun org-log-into-drawer ()
   2354   "Name of the log drawer, as a string, or nil.
   2355 This is the value of `org-log-into-drawer'.  However, if the
   2356 current entry has or inherits a LOG_INTO_DRAWER property, it will
   2357 be used instead of the default value."
   2358   (let ((p (org-entry-get nil "LOG_INTO_DRAWER" 'inherit t)))
   2359     (cond ((equal p "nil") nil)
   2360 	  ((equal p "t") "LOGBOOK")
   2361 	  ((stringp p) p)
   2362 	  (p "LOGBOOK")
   2363 	  ((stringp org-log-into-drawer) org-log-into-drawer)
   2364 	  (org-log-into-drawer "LOGBOOK"))))
   2365 
   2366 (defcustom org-log-state-notes-insert-after-drawers nil
   2367   "Non-nil means insert state change notes after any drawers in entry.
   2368 Only the drawers that *immediately* follow the headline and the
   2369 deadline/scheduled line are skipped.
   2370 When nil, insert notes right after the heading and perhaps the line
   2371 with deadline/scheduling if present.
   2372 
   2373 This variable will have no effect if `org-log-into-drawer' is
   2374 set."
   2375   :group 'org-todo
   2376   :group 'org-progress
   2377   :type 'boolean)
   2378 
   2379 (defcustom org-log-states-order-reversed t
   2380   "Non-nil means the latest state note will be directly after heading.
   2381 When nil, the state change notes will be ordered according to time.
   2382 
   2383 This option can also be set with on a per-file-basis with
   2384 
   2385    #+STARTUP: logstatesreversed
   2386    #+STARTUP: nologstatesreversed"
   2387   :group 'org-todo
   2388   :group 'org-progress
   2389   :type 'boolean)
   2390 
   2391 (defcustom org-todo-repeat-to-state nil
   2392   "The TODO state to which a repeater should return the repeating task.
   2393 By default this is the first task of a TODO sequence or the
   2394 previous state of a TYPE_TODO set.  But you can specify to use
   2395 the previous state in a TODO sequence or a string.
   2396 
   2397 Alternatively, you can set the :REPEAT_TO_STATE: property of the
   2398 entry, which has precedence over this option."
   2399   :group 'org-todo
   2400   :version "24.1"
   2401   :type '(choice (const :tag "Use the previous TODO state" t)
   2402 		 (const :tag "Use the head of the TODO sequence" nil)
   2403 		 (string :tag "Use a specific TODO state")))
   2404 
   2405 (defcustom org-log-repeat 'time
   2406   "Non-nil means record moving through the DONE state when triggering repeat.
   2407 An auto-repeating task is immediately switched back to TODO when
   2408 marked DONE.  If you are not logging state changes (by adding \"@\"
   2409 or \"!\" to the TODO keyword definition), or set `org-log-done' to
   2410 record a closing note, there will be no record of the task moving
   2411 through DONE.  This variable forces taking a note anyway.
   2412 
   2413 nil     Don't force a record
   2414 time    Record a time stamp
   2415 note    Prompt for a note and add it with template `org-log-note-headings'
   2416 
   2417 This option can also be set with on a per-file-basis with
   2418 
   2419    #+STARTUP: nologrepeat
   2420    #+STARTUP: logrepeat
   2421    #+STARTUP: lognoterepeat
   2422 
   2423 You can have local logging settings for a subtree by setting the LOGGING
   2424 property to one or more of these keywords."
   2425   :group 'org-todo
   2426   :group 'org-progress
   2427   :type '(choice
   2428 	  (const :tag "Don't force a record" nil)
   2429 	  (const :tag "Force recording the DONE state" time)
   2430 	  (const :tag "Force recording a note with the DONE state" note)))
   2431 
   2432 (defcustom org-todo-repeat-hook nil
   2433   "Hook that is run after a task has been repeated."
   2434   :package-version '(Org . "9.2")
   2435   :group 'org-todo
   2436   :type 'hook)
   2437 
   2438 (defgroup org-priorities nil
   2439   "Priorities in Org mode."
   2440   :tag "Org Priorities"
   2441   :group 'org-todo)
   2442 
   2443 (defvaralias 'org-enable-priority-commands 'org-priority-enable-commands)
   2444 (defcustom org-priority-enable-commands t
   2445   "Non-nil means priority commands are active.
   2446 When nil, these commands will be disabled, so that you never accidentally
   2447 set a priority."
   2448   :group 'org-priorities
   2449   :type 'boolean)
   2450 
   2451 (defvaralias 'org-highest-priority 'org-priority-highest)
   2452 
   2453 (defcustom org-priority-highest ?A
   2454   "The highest priority of TODO items.
   2455 
   2456 A character like ?A, ?B, etc., or a numeric value like 1, 2, etc.
   2457 
   2458 The default is the character ?A, which is 65 as a numeric value.
   2459 
   2460 If you set `org-priority-highest' to a numeric value inferior to
   2461 65, Org assumes you want to use digits for the priority cookie.
   2462 If you set it to >=65, Org assumes you want to use alphabetical
   2463 characters.
   2464 
   2465 In both cases, the value of `org-priority-highest' must be
   2466 smaller than `org-priority-lowest': for example, if \"A\" is the
   2467 highest priority, it is smaller than the lowest \"C\" priority:
   2468 65 < 67."
   2469   :group 'org-priorities
   2470   :type '(choice
   2471 	  (character :tag "Character")
   2472 	  (integer :tag "Integer (< 65)")))
   2473 
   2474 (defvaralias 'org-lowest-priority 'org-priority-lowest)
   2475 (defcustom org-priority-lowest ?C
   2476   "The lowest priority of TODO items.
   2477 
   2478 A character like ?C, ?B, etc., or a numeric value like 9, 8, etc.
   2479 
   2480 The default is the character ?C, which is 67 as a numeric value.
   2481 
   2482 If you set `org-priority-lowest' to a numeric value inferior to
   2483 65, Org assumes you want to use digits for the priority cookie.
   2484 If you set it to >=65, Org assumes you want to use alphabetical
   2485 characters.
   2486 
   2487 In both cases, the value of `org-priority-lowest' must be greater
   2488 than `org-priority-highest': for example, if \"C\" is the lowest
   2489 priority, it is greater than the highest \"A\" priority: 67 >
   2490 65."
   2491   :group 'org-priorities
   2492   :type '(choice
   2493 	  (character :tag "Character")
   2494 	  (integer :tag "Integer (< 65)")))
   2495 
   2496 (defvaralias 'org-default-priority 'org-priority-default)
   2497 (defcustom org-priority-default ?B
   2498   "The default priority of TODO items.
   2499 This is the priority an item gets if no explicit priority is given.
   2500 When starting to cycle on an empty priority the first step in the cycle
   2501 depends on `org-priority-start-cycle-with-default'.  The resulting first
   2502 step priority must not exceed the range from `org-priority-highest' to
   2503 `org-priority-lowest' which means that `org-priority-default' has to be
   2504 in this range exclusive or inclusive to the range boundaries.  Else the
   2505 first step refuses to set the default and the second will fall back on
   2506 \(depending on the command used) the highest or lowest priority."
   2507   :group 'org-priorities
   2508   :type '(choice
   2509 	  (character :tag "Character")
   2510 	  (integer :tag "Integer (< 65)")))
   2511 
   2512 (defcustom org-priority-start-cycle-with-default t
   2513   "Non-nil means start with default priority when starting to cycle.
   2514 When this is nil, the first step in the cycle will be (depending on the
   2515 command used) one higher or lower than the default priority.
   2516 See also `org-priority-default'."
   2517   :group 'org-priorities
   2518   :type 'boolean)
   2519 
   2520 (defvaralias 'org-get-priority-function 'org-priority-get-priority-function)
   2521 (defcustom org-priority-get-priority-function nil
   2522   "Function to extract the priority from a string.
   2523 The string is normally the headline.  If this is nil, Org
   2524 computes the priority from the priority cookie like [#A] in the
   2525 headline.  It returns an integer, increasing by 1000 for each
   2526 priority level.
   2527 
   2528 The user can set a different function here, which should take a
   2529 string as an argument and return the numeric priority."
   2530   :group 'org-priorities
   2531   :version "24.1"
   2532   :type '(choice
   2533 	  (const nil)
   2534 	  (function)))
   2535 
   2536 (defgroup org-time nil
   2537   "Options concerning time stamps and deadlines in Org mode."
   2538   :tag "Org Time"
   2539   :group 'org)
   2540 
   2541 (defcustom org-time-stamp-rounding-minutes '(0 5)
   2542   "Number of minutes to round time stamps to.
   2543 \\<org-mode-map>\
   2544 These are two values, the first applies when first creating a time stamp.
   2545 The second applies when changing it with the commands `S-up' and `S-down'.
   2546 When changing the time stamp, this means that it will change in steps
   2547 of N minutes, as given by the second value.
   2548 
   2549 When a setting is 0 or 1, insert the time unmodified.  Useful rounding
   2550 numbers should be factors of 60, so for example 5, 10, 15.
   2551 
   2552 When this is larger than 1, you can still force an exact time stamp by using
   2553 a double prefix argument to a time stamp command like \
   2554 `\\[org-time-stamp]' or `\\[org-time-stamp-inactive],
   2555 and by using a prefix arg to `S-up/down' to specify the exact number
   2556 of minutes to shift."
   2557   :group 'org-time
   2558   :get (lambda (var) ; Make sure both elements are there
   2559 	 (if (integerp (default-value var))
   2560 	     (list (default-value var) 5)
   2561 	   (default-value var)))
   2562   :type '(list
   2563 	  (integer :tag "when inserting times")
   2564 	  (integer :tag "when modifying times")))
   2565 
   2566 ;; Normalize old customizations of this variable.
   2567 (when (integerp org-time-stamp-rounding-minutes)
   2568   (setq org-time-stamp-rounding-minutes
   2569 	(list org-time-stamp-rounding-minutes
   2570 	      org-time-stamp-rounding-minutes)))
   2571 
   2572 (defcustom org-display-custom-times nil
   2573   "Non-nil means overlay custom formats over all time stamps.
   2574 The formats are defined through the variable `org-time-stamp-custom-formats'.
   2575 To turn this on on a per-file basis, insert anywhere in the file:
   2576    #+STARTUP: customtime"
   2577   :group 'org-time
   2578   :set 'set-default
   2579   :type 'sexp)
   2580 (make-variable-buffer-local 'org-display-custom-times)
   2581 
   2582 (defcustom org-time-stamp-custom-formats
   2583   '("<%m/%d/%y %a>" . "<%m/%d/%y %a %H:%M>") ; american
   2584   "Custom formats for time stamps.  See `format-time-string' for the syntax.
   2585 These are overlaid over the default ISO format if the variable
   2586 `org-display-custom-times' is set.  Time like %H:%M should be at the
   2587 end of the second format.  The custom formats are also honored by export
   2588 commands, if custom time display is turned on at the time of export."
   2589   :group 'org-time
   2590   :type 'sexp)
   2591 
   2592 (defun org-time-stamp-format (&optional long inactive)
   2593   "Get the right format for a time string."
   2594   (let ((f (if long (cdr org-time-stamp-formats)
   2595 	     (car org-time-stamp-formats))))
   2596     (if inactive
   2597 	(concat "[" (substring f 1 -1) "]")
   2598       f)))
   2599 
   2600 (defcustom org-deadline-warning-days 14
   2601   "Number of days before expiration during which a deadline becomes active.
   2602 This variable governs the display in sparse trees and in the agenda.
   2603 When 0 or negative, it means use this number (the absolute value of it)
   2604 even if a deadline has a different individual lead time specified.
   2605 
   2606 Custom commands can set this variable in the options section."
   2607   :group 'org-time
   2608   :group 'org-agenda-daily/weekly
   2609   :type 'integer)
   2610 
   2611 (defcustom org-scheduled-delay-days 0
   2612   "Number of days before a scheduled item becomes active.
   2613 This variable governs the display in sparse trees and in the agenda.
   2614 The default value (i.e. 0) means: don't delay scheduled item.
   2615 When negative, it means use this number (the absolute value of it)
   2616 even if a scheduled item has a different individual delay time
   2617 specified.
   2618 
   2619 Custom commands can set this variable in the options section."
   2620   :group 'org-time
   2621   :group 'org-agenda-daily/weekly
   2622   :version "24.4"
   2623   :package-version '(Org . "8.0")
   2624   :type 'integer)
   2625 
   2626 (defcustom org-read-date-prefer-future t
   2627   "Non-nil means assume future for incomplete date input from user.
   2628 This affects the following situations:
   2629 1. The user gives a month but not a year.
   2630    For example, if it is April and you enter \"feb 2\", this will be read
   2631    as Feb 2, *next* year.  \"May 5\", however, will be this year.
   2632 2. The user gives a day, but no month.
   2633    For example, if today is the 15th, and you enter \"3\", Org will read
   2634    this as the third of *next* month.  However, if you enter \"17\",
   2635    it will be considered as *this* month.
   2636 
   2637 If you set this variable to the symbol `time', then also the following
   2638 will work:
   2639 
   2640 3. If the user gives a time.
   2641    If the time is before now, it will be interpreted as tomorrow.
   2642 
   2643 Currently none of this works for ISO week specifications.
   2644 
   2645 When this option is nil, the current day, month and year will always be
   2646 used as defaults.
   2647 
   2648 See also `org-agenda-jump-prefer-future'."
   2649   :group 'org-time
   2650   :type '(choice
   2651 	  (const :tag "Never" nil)
   2652 	  (const :tag "Check month and day" t)
   2653 	  (const :tag "Check month, day, and time" time)))
   2654 
   2655 (defcustom org-agenda-jump-prefer-future 'org-read-date-prefer-future
   2656   "Should the agenda jump command prefer the future for incomplete dates?
   2657 The default is to do the same as configured in `org-read-date-prefer-future'.
   2658 But you can also set a deviating value here.
   2659 This may t or nil, or the symbol `org-read-date-prefer-future'."
   2660   :group 'org-agenda
   2661   :group 'org-time
   2662   :version "24.1"
   2663   :type '(choice
   2664 	  (const :tag "Use org-read-date-prefer-future"
   2665 		 org-read-date-prefer-future)
   2666 	  (const :tag "Never" nil)
   2667 	  (const :tag "Always" t)))
   2668 
   2669 (defcustom org-read-date-force-compatible-dates t
   2670   "Should date/time prompt force dates that are guaranteed to work in Emacs?
   2671 
   2672 Depending on the system Emacs is running on, certain dates cannot
   2673 be represented with the type used internally to represent time.
   2674 Dates between 1970-1-1 and 2038-1-1 can always be represented
   2675 correctly.  Some systems allow for earlier dates, some for later,
   2676 some for both.  One way to find out is to insert any date into an
   2677 Org buffer, putting the cursor on the year and hitting S-up and
   2678 S-down to test the range.
   2679 
   2680 When this variable is set to t, the date/time prompt will not let
   2681 you specify dates outside the 1970-2037 range, so it is certain that
   2682 these dates will work in whatever version of Emacs you are
   2683 running, and also that you can move a file from one Emacs implementation
   2684 to another.  Whenever Org is forcing the year for you, it will display
   2685 a message and beep.
   2686 
   2687 When this variable is nil, Org will check if the date is
   2688 representable in the specific Emacs implementation you are using.
   2689 If not, it will force a year, usually the current year, and beep
   2690 to remind you.  Currently this setting is not recommended because
   2691 the likelihood that you will open your Org files in an Emacs that
   2692 has limited date range is not negligible.
   2693 
   2694 A workaround for this problem is to use diary sexp dates for time
   2695 stamps outside of this range."
   2696   :group 'org-time
   2697   :version "24.1"
   2698   :type 'boolean)
   2699 
   2700 (defcustom org-read-date-display-live t
   2701   "Non-nil means display current interpretation of date prompt live.
   2702 This display will be in an overlay, in the minibuffer.  Note that
   2703 live display is only active when `org-read-date-popup-calendar'
   2704 is non-nil."
   2705   :group 'org-time
   2706   :type 'boolean)
   2707 
   2708 (defvaralias 'org-popup-calendar-for-date-prompt
   2709   'org-read-date-popup-calendar)
   2710 
   2711 (defcustom org-read-date-popup-calendar t
   2712   "Non-nil means pop up a calendar when prompting for a date.
   2713 In the calendar, the date can be selected with mouse-1.  However, the
   2714 minibuffer will also be active, and you can simply enter the date as well.
   2715 When nil, only the minibuffer will be available."
   2716   :group 'org-time
   2717   :type 'boolean)
   2718 
   2719 (defcustom org-extend-today-until 0
   2720   "The hour when your day really ends.  Must be an integer.
   2721 This has influence for the following applications:
   2722 - When switching the agenda to \"today\".  If it is still earlier than
   2723   the time given here, the day recognized as TODAY is actually yesterday.
   2724 - When a date is read from the user and it is still before the time given
   2725   here, the current date and time will be assumed to be yesterday, 23:59.
   2726   Also, timestamps inserted in capture templates follow this rule.
   2727 
   2728 IMPORTANT:  This is a feature whose implementation is and likely will
   2729 remain incomplete.  Really, it is only here because past midnight seems to
   2730 be the favorite working time of John Wiegley :-)"
   2731   :group 'org-time
   2732   :type 'integer)
   2733 
   2734 (defcustom org-use-effective-time nil
   2735   "If non-nil, consider `org-extend-today-until' when creating timestamps.
   2736 For example, if `org-extend-today-until' is 8, and it's 4am, then the
   2737 \"effective time\" of any timestamps between midnight and 8am will be
   2738 23:59 of the previous day."
   2739   :group 'org-time
   2740   :version "24.1"
   2741   :type 'boolean)
   2742 
   2743 (defcustom org-use-last-clock-out-time-as-effective-time nil
   2744   "When non-nil, use the last clock out time for `org-todo'.
   2745 Note that this option has precedence over the combined use of
   2746 `org-use-effective-time' and `org-extend-today-until'."
   2747   :group 'org-time
   2748   :version "24.4"
   2749   :package-version '(Org . "8.0")
   2750   :type 'boolean)
   2751 
   2752 (defcustom org-edit-timestamp-down-means-later nil
   2753   "Non-nil means S-down will increase the time in a time stamp.
   2754 When nil, S-up will increase."
   2755   :group 'org-time
   2756   :type 'boolean)
   2757 
   2758 (defcustom org-calendar-follow-timestamp-change t
   2759   "Non-nil means make the calendar window follow timestamp changes.
   2760 When a timestamp is modified and the calendar window is visible, it will be
   2761 moved to the new date."
   2762   :group 'org-time
   2763   :type 'boolean)
   2764 
   2765 (defgroup org-tags nil
   2766   "Options concerning tags in Org mode."
   2767   :tag "Org Tags"
   2768   :group 'org)
   2769 
   2770 (defcustom org-tag-alist nil
   2771   "Default tags available in Org files.
   2772 
   2773 The value of this variable is an alist.  Associations either:
   2774 
   2775   (TAG)
   2776   (TAG . SELECT)
   2777   (SPECIAL)
   2778 
   2779 where TAG is a tag as a string, SELECT is character, used to
   2780 select that tag through the fast tag selection interface, and
   2781 SPECIAL is one of the following keywords: `:startgroup',
   2782 `:startgrouptag', `:grouptags', `:endgroup', `:endgrouptag' or
   2783 `:newline'.  These keywords are used to define a hierarchy of
   2784 tags.  See manual for details.
   2785 
   2786 When this variable is nil, Org mode bases tag input on what is
   2787 already in the buffer.  The value can be overridden locally by
   2788 using a TAGS keyword, e.g.,
   2789 
   2790   #+TAGS: tag1 tag2
   2791 
   2792 See also `org-tag-persistent-alist' to sidestep this behavior."
   2793   :group 'org-tags
   2794   :type '(repeat
   2795 	  (choice
   2796 	   (cons :tag "Tag with key"
   2797 		 (string    :tag "Tag name")
   2798 		 (character :tag "Access char"))
   2799 	   (list :tag "Tag" (string :tag "Tag name"))
   2800 	   (const :tag "Start radio group" (:startgroup))
   2801 	   (const :tag "Start tag group, non distinct" (:startgrouptag))
   2802 	   (const :tag "Group tags delimiter" (:grouptags))
   2803 	   (const :tag "End radio group" (:endgroup))
   2804 	   (const :tag "End tag group, non distinct" (:endgrouptag))
   2805 	   (const :tag "New line" (:newline)))))
   2806 
   2807 (defcustom org-tag-persistent-alist nil
   2808   "Tags always available in Org files.
   2809 
   2810 The value of this variable is an alist.  Associations either:
   2811 
   2812   (TAG)
   2813   (TAG . SELECT)
   2814   (SPECIAL)
   2815 
   2816 where TAG is a tag as a string, SELECT is a character, used to
   2817 select that tag through the fast tag selection interface, and
   2818 SPECIAL is one of the following keywords: `:startgroup',
   2819 `:startgrouptag', `:grouptags', `:endgroup', `:endgrouptag' or
   2820 `:newline'.  These keywords are used to define a hierarchy of
   2821 tags.  See manual for details.
   2822 
   2823 Unlike to `org-tag-alist', tags defined in this variable do not
   2824 depend on a local TAGS keyword.  Instead, to disable these tags
   2825 on a per-file basis, insert anywhere in the file:
   2826 
   2827   #+STARTUP: noptag"
   2828   :group 'org-tags
   2829   :type '(repeat
   2830 	  (choice
   2831 	   (cons :tag "Tag with key"
   2832 		 (string    :tag "Tag name")
   2833 		 (character :tag "Access char"))
   2834 	   (list :tag "Tag" (string :tag "Tag name"))
   2835 	   (const :tag "Start radio group" (:startgroup))
   2836 	   (const :tag "Start tag group, non distinct" (:startgrouptag))
   2837 	   (const :tag "Group tags delimiter" (:grouptags))
   2838 	   (const :tag "End radio group" (:endgroup))
   2839 	   (const :tag "End tag group, non distinct" (:endgrouptag))
   2840 	   (const :tag "New line" (:newline)))))
   2841 
   2842 (defcustom org-complete-tags-always-offer-all-agenda-tags nil
   2843   "If non-nil, always offer completion for all tags of all agenda files.
   2844 
   2845 Setting this variable locally allows for dynamic generation of tag
   2846 completions in capture buffers.
   2847 
   2848   (add-hook \\='org-capture-mode-hook
   2849             (lambda ()
   2850               (setq-local org-complete-tags-always-offer-all-agenda-tags t)))"
   2851   :group 'org-tags
   2852   :version "24.1"
   2853   :type 'boolean)
   2854 
   2855 (defvar org-file-tags nil
   2856   "List of tags that can be inherited by all entries in the file.
   2857 The tags will be inherited if the variable `org-use-tag-inheritance'
   2858 says they should be.
   2859 This variable is populated from #+FILETAGS lines.")
   2860 
   2861 (defcustom org-use-fast-tag-selection 'auto
   2862   "Non-nil means use fast tag selection scheme.
   2863 This is a special interface to select and deselect tags with single keys.
   2864 When nil, fast selection is never used.
   2865 When the symbol `auto', fast selection is used if and only if selection
   2866 characters for tags have been configured, either through the variable
   2867 `org-tag-alist' or through a #+TAGS line in the buffer.
   2868 When t, fast selection is always used and selection keys are assigned
   2869 automatically if necessary."
   2870   :group 'org-tags
   2871   :type '(choice
   2872 	  (const :tag "Always" t)
   2873 	  (const :tag "Never" nil)
   2874 	  (const :tag "When selection characters are configured" auto)))
   2875 
   2876 (defcustom org-fast-tag-selection-single-key nil
   2877   "Non-nil means fast tag selection exits after first change.
   2878 When nil, you have to press RET to exit it.
   2879 During fast tag selection, you can toggle this flag with `C-c'.
   2880 This variable can also have the value `expert'.  In this case, the window
   2881 displaying the tags menu is not even shown, until you press `C-c' again."
   2882   :group 'org-tags
   2883   :type '(choice
   2884 	  (const :tag "No" nil)
   2885 	  (const :tag "Yes" t)
   2886 	  (const :tag "Expert" expert)))
   2887 
   2888 (defvar org-fast-tag-selection-include-todo nil
   2889   "Non-nil means fast tags selection interface will also offer TODO states.
   2890 This is an undocumented feature, you should not rely on it.")
   2891 
   2892 (defcustom org-tags-column -77
   2893   "The column to which tags should be indented in a headline.
   2894 If this number is positive, it specifies the column.  If it is negative,
   2895 it means that the tags should be flushright to that column.  For example,
   2896 -80 works well for a normal 80 character screen.
   2897 When 0, place tags directly after headline text, with only one space in
   2898 between."
   2899   :group 'org-tags
   2900   :type 'integer)
   2901 
   2902 (defcustom org-auto-align-tags t
   2903   "Non-nil keeps tags aligned when modifying headlines.
   2904 Some operations (i.e. demoting) change the length of a headline and
   2905 therefore shift the tags around.  With this option turned on, after
   2906 each such operation the tags are again aligned to `org-tags-column'."
   2907   :group 'org-tags
   2908   :type 'boolean)
   2909 
   2910 (defcustom org-use-tag-inheritance t
   2911   "Non-nil means tags in levels apply also for sublevels.
   2912 When nil, only the tags directly given in a specific line apply there.
   2913 This may also be a list of tags that should be inherited, or a regexp that
   2914 matches tags that should be inherited.  Additional control is possible
   2915 with the variable  `org-tags-exclude-from-inheritance' which gives an
   2916 explicit list of tags to be excluded from inheritance, even if the value of
   2917 `org-use-tag-inheritance' would select it for inheritance.
   2918 
   2919 If this option is t, a match early-on in a tree can lead to a large
   2920 number of matches in the subtree when constructing the agenda or creating
   2921 a sparse tree.  If you only want to see the first match in a tree during
   2922 a search, check out the variable `org-tags-match-list-sublevels'."
   2923   :group 'org-tags
   2924   :type '(choice
   2925 	  (const :tag "Not" nil)
   2926 	  (const :tag "Always" t)
   2927 	  (repeat :tag "Specific tags" (string :tag "Tag"))
   2928 	  (regexp :tag "Tags matched by regexp")))
   2929 
   2930 (defcustom org-tags-exclude-from-inheritance nil
   2931   "List of tags that should never be inherited.
   2932 This is a way to exclude a few tags from inheritance.  For way to do
   2933 the opposite, to actively allow inheritance for selected tags,
   2934 see the variable `org-use-tag-inheritance'."
   2935   :group 'org-tags
   2936   :type '(repeat (string :tag "Tag")))
   2937 
   2938 (defun org-tag-inherit-p (tag)
   2939   "Check if TAG is one that should be inherited."
   2940   (cond
   2941    ((member tag org-tags-exclude-from-inheritance) nil)
   2942    ((eq org-use-tag-inheritance t) t)
   2943    ((not org-use-tag-inheritance) nil)
   2944    ((stringp org-use-tag-inheritance)
   2945     (string-match org-use-tag-inheritance tag))
   2946    ((listp org-use-tag-inheritance)
   2947     (member tag org-use-tag-inheritance))
   2948    (t (error "Invalid setting of `org-use-tag-inheritance'"))))
   2949 
   2950 (defcustom org-tags-match-list-sublevels t
   2951   "Non-nil means list also sublevels of headlines matching a search.
   2952 This variable applies to tags/property searches, and also to stuck
   2953 projects because this search is based on a tags match as well.
   2954 
   2955 When set to the symbol `indented', sublevels are indented with
   2956 leading dots.
   2957 
   2958 Because of tag inheritance (see variable `org-use-tag-inheritance'),
   2959 the sublevels of a headline matching a tag search often also match
   2960 the same search.  Listing all of them can create very long lists.
   2961 Setting this variable to nil causes subtrees of a match to be skipped.
   2962 
   2963 This variable is semi-obsolete and probably should always be true.  It
   2964 is better to limit inheritance to certain tags using the variables
   2965 `org-use-tag-inheritance' and `org-tags-exclude-from-inheritance'."
   2966   :group 'org-tags
   2967   :type '(choice
   2968 	  (const :tag "No, don't list them" nil)
   2969 	  (const :tag "Yes, do list them" t)
   2970 	  (const :tag "List them, indented with leading dots" indented)))
   2971 
   2972 (defcustom org-tags-sort-function nil
   2973   "When set, tags are sorted using this function as a comparator."
   2974   :group 'org-tags
   2975   :type '(choice
   2976 	  (const :tag "No sorting" nil)
   2977 	  (const :tag "Alphabetical" org-string-collate-lessp)
   2978 	  (const :tag "Reverse alphabetical" org-string-collate-greaterp)
   2979 	  (function :tag "Custom function" nil)))
   2980 
   2981 (defvar org-tags-history nil
   2982   "History of minibuffer reads for tags.")
   2983 (defvar org-last-tags-completion-table nil
   2984   "The last used completion table for tags.")
   2985 (defvar org-after-tags-change-hook nil
   2986   "Hook that is run after the tags in a line have changed.")
   2987 
   2988 (defgroup org-properties nil
   2989   "Options concerning properties in Org mode."
   2990   :tag "Org Properties"
   2991   :group 'org)
   2992 
   2993 (defcustom org-property-format "%-10s %s"
   2994   "How property key/value pairs should be formatted by `indent-line'.
   2995 When `indent-line' hits a property definition, it will format the line
   2996 according to this format, mainly to make sure that the values are
   2997 lined-up with respect to each other."
   2998   :group 'org-properties
   2999   :type 'string)
   3000 
   3001 (defcustom org-properties-postprocess-alist nil
   3002   "Alist of properties and functions to adjust inserted values.
   3003 Elements of this alist must be of the form
   3004 
   3005   ([string] [function])
   3006 
   3007 where [string] must be a property name and [function] must be a
   3008 lambda expression: this lambda expression must take one argument,
   3009 the value to adjust, and return the new value as a string.
   3010 
   3011 For example, this element will allow the property \"Remaining\"
   3012 to be updated wrt the relation between the \"Effort\" property
   3013 and the clock summary:
   3014 
   3015  ((\"Remaining\" (lambda(value)
   3016                    (let ((clocksum (org-clock-sum-current-item))
   3017                          (effort (org-duration-to-minutes
   3018                                    (org-entry-get (point) \"Effort\"))))
   3019                      (org-minutes-to-clocksum-string (- effort clocksum))))))"
   3020   :group 'org-properties
   3021   :version "24.1"
   3022   :type '(alist :key-type (string     :tag "Property")
   3023 		:value-type (function :tag "Function")))
   3024 
   3025 (defcustom org-use-property-inheritance nil
   3026   "Non-nil means properties apply also for sublevels.
   3027 
   3028 This setting is chiefly used during property searches.  Turning it on can
   3029 cause significant overhead when doing a search, which is why it is not
   3030 on by default.
   3031 
   3032 When nil, only the properties directly given in the current entry count.
   3033 When t, every property is inherited.  The value may also be a list of
   3034 properties that should have inheritance, or a regular expression matching
   3035 properties that should be inherited.
   3036 
   3037 However, note that some special properties use inheritance under special
   3038 circumstances (not in searches).  Examples are CATEGORY, ARCHIVE, COLUMNS,
   3039 and the properties ending in \"_ALL\" when they are used as descriptor
   3040 for valid values of a property.
   3041 
   3042 Note for programmers:
   3043 When querying an entry with `org-entry-get', you can control if inheritance
   3044 should be used.  By default, `org-entry-get' looks only at the local
   3045 properties.  You can request inheritance by setting the inherit argument
   3046 to t (to force inheritance) or to `selective' (to respect the setting
   3047 in this variable)."
   3048   :group 'org-properties
   3049   :type '(choice
   3050 	  (const :tag "Not" nil)
   3051 	  (const :tag "Always" t)
   3052 	  (repeat :tag "Specific properties" (string :tag "Property"))
   3053 	  (regexp :tag "Properties matched by regexp")))
   3054 
   3055 (defun org-property-inherit-p (property)
   3056   "Return a non-nil value if PROPERTY should be inherited."
   3057   (cond
   3058    ((eq org-use-property-inheritance t) t)
   3059    ((not org-use-property-inheritance) nil)
   3060    ((stringp org-use-property-inheritance)
   3061     (string-match org-use-property-inheritance property))
   3062    ((listp org-use-property-inheritance)
   3063     (member-ignore-case property org-use-property-inheritance))
   3064    (t (error "Invalid setting of `org-use-property-inheritance'"))))
   3065 
   3066 (defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS"
   3067   "The default column format, if no other format has been defined.
   3068 This variable can be set on the per-file basis by inserting a line
   3069 
   3070 #+COLUMNS: %25ITEM ....."
   3071   :group 'org-properties
   3072   :type 'string)
   3073 
   3074 (defcustom org-columns-default-format-for-agenda nil
   3075   "The default column format in an agenda buffer.
   3076 This will be used for column view in the agenda unless a format has
   3077 been set by adding `org-overriding-columns-format' to the local
   3078 settings list of a custom agenda view.  When nil, the columns format
   3079 for the first item in the agenda list will be used, or as a fall-back,
   3080 `org-columns-default-format'."
   3081   :group 'org-properties
   3082   :type '(choice
   3083 	  (const :tag "No default" nil)
   3084 	  (string :tag "Format string")))
   3085 
   3086 (defcustom org-columns-ellipses ".."
   3087   "The ellipses to be used when a field in column view is truncated.
   3088 When this is the empty string, as many characters as possible are shown,
   3089 but then there will be no visual indication that the field has been truncated.
   3090 When this is a string of length N, the last N characters of a truncated
   3091 field are replaced by this string.  If the column is narrower than the
   3092 ellipses string, only part of the ellipses string will be shown."
   3093   :group 'org-properties
   3094   :type 'string)
   3095 
   3096 (defconst org-global-properties-fixed
   3097   '(("VISIBILITY_ALL" . "folded children content all")
   3098     ("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto"))
   3099   "List of property/value pairs that can be inherited by any entry.
   3100 
   3101 These are fixed values, for the preset properties.  The user variable
   3102 that can be used to add to this list is `org-global-properties'.
   3103 
   3104 The entries in this list are cons cells where the car is a property
   3105 name and cdr is a string with the value.  If the value represents
   3106 multiple items like an \"_ALL\" property, separate the items by
   3107 spaces.")
   3108 
   3109 (defcustom org-global-properties nil
   3110   "List of property/value pairs that can be inherited by any entry.
   3111 
   3112 This list will be combined with the constant `org-global-properties-fixed'.
   3113 
   3114 The entries in this list are cons cells where the car is a property
   3115 name and cdr is a string with the value.
   3116 
   3117 Buffer local properties are added either by a document property drawer
   3118 
   3119 :PROPERTIES:
   3120 :NAME: VALUE
   3121 :END:
   3122 
   3123 or by adding lines like
   3124 
   3125 #+PROPERTY: NAME VALUE"
   3126   :group 'org-properties
   3127   :type '(repeat
   3128 	  (cons (string :tag "Property")
   3129 		(string :tag "Value"))))
   3130 
   3131 (defvar-local org-keyword-properties nil
   3132   "List of property/value pairs inherited by any entry.
   3133 
   3134 Valid for the current buffer.  This variable is populated from
   3135 PROPERTY keywords.
   3136 
   3137 Note that properties are defined also in property drawers.
   3138 Properties defined there take precedence over properties defined
   3139 as keywords.")
   3140 
   3141 (defgroup org-agenda nil
   3142   "Options concerning agenda views in Org mode."
   3143   :tag "Org Agenda"
   3144   :group 'org)
   3145 
   3146 (defvar-local org-category nil
   3147   "Variable used by Org files to set a category for agenda display.
   3148 There are multiple ways to set the category.  One way is to set
   3149 it in the document property drawer.  For example:
   3150 
   3151 :PROPERTIES:
   3152 :CATEGORY: ELisp
   3153 :END:
   3154 
   3155 Other ways to define it is as an Emacs file variable, for example
   3156 
   3157 #   -*- mode: org; org-category: \"ELisp\"
   3158 
   3159 or for the file to contain a special line:
   3160 
   3161 #+CATEGORY: ELisp
   3162 
   3163 If the file does not specify a category, then file's base name
   3164 is used instead.")
   3165 (put 'org-category 'safe-local-variable (lambda (x) (or (symbolp x) (stringp x))))
   3166 
   3167 (defcustom org-agenda-files nil
   3168   "The files to be used for agenda display.
   3169 
   3170 If an entry is a directory, all files in that directory that are matched
   3171 by `org-agenda-file-regexp' will be part of the file list.
   3172 
   3173 If the value of the variable is not a list but a single file name, then
   3174 the list of agenda files is actually stored and maintained in that file,
   3175 one agenda file per line.  In this file paths can be given relative to
   3176 `org-directory'.  Tilde expansion and environment variable substitution
   3177 are also made.
   3178 
   3179 Entries may be added to this list with `\\[org-agenda-file-to-front]'
   3180 and removed with `\\[org-remove-file]'."
   3181   :group 'org-agenda
   3182   :type '(choice
   3183 	  (repeat :tag "List of files and directories" file)
   3184 	  (file :tag "Store list in a file\n" :value "~/.agenda_files")))
   3185 
   3186 (defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'"
   3187   "Regular expression to match files for `org-agenda-files'.
   3188 If any element in the list in that variable contains a directory instead
   3189 of a normal file, all files in that directory that are matched by this
   3190 regular expression will be included."
   3191   :group 'org-agenda
   3192   :type 'regexp)
   3193 
   3194 (defvaralias 'org-agenda-multi-occur-extra-files
   3195   'org-agenda-text-search-extra-files)
   3196 
   3197 (defcustom org-agenda-text-search-extra-files nil
   3198   "List of extra files to be searched by text search commands.
   3199 These files will be searched in addition to the agenda files by the
   3200 commands `org-search-view' (`\\[org-agenda] s') \
   3201 and `org-occur-in-agenda-files'.
   3202 Note that these files will only be searched for text search commands,
   3203 not for the other agenda views like todo lists, tag searches or the weekly
   3204 agenda.  This variable is intended to list notes and possibly archive files
   3205 that should also be searched by these two commands.
   3206 In fact, if the first element in the list is the symbol `agenda-archives',
   3207 then all archive files of all agenda files will be added to the search
   3208 scope."
   3209   :group 'org-agenda
   3210   :type '(set :greedy t
   3211 	      (const :tag "Agenda Archives" agenda-archives)
   3212 	      (repeat :inline t (file))))
   3213 
   3214 (defcustom org-agenda-skip-unavailable-files nil
   3215   "Non-nil means to just skip non-reachable files in `org-agenda-files'.
   3216 A nil value means to remove them, after a query, from the list."
   3217   :group 'org-agenda
   3218   :type 'boolean)
   3219 
   3220 (defgroup org-latex nil
   3221   "Options for embedding LaTeX code into Org mode."
   3222   :tag "Org LaTeX"
   3223   :group 'org)
   3224 
   3225 (defcustom org-format-latex-options
   3226   '(:foreground default :background default :scale 1.0
   3227 		:html-foreground "Black" :html-background "Transparent"
   3228 		:html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\["))
   3229   "Options for creating images from LaTeX fragments.
   3230 This is a property list with the following properties:
   3231 :foreground  the foreground color for images embedded in Emacs, e.g. \"Black\".
   3232              `default' means use the foreground of the default face.
   3233              `auto' means use the foreground from the text face.
   3234 :background  the background color, or \"Transparent\".
   3235              `default' means use the background of the default face.
   3236              `auto' means use the background from the text face.
   3237 :scale       a scaling factor for the size of the images, to get more pixels
   3238 :html-foreground, :html-background, :html-scale
   3239              the same numbers for HTML export.
   3240 :matchers    a list indicating which matchers should be used to
   3241              find LaTeX fragments.  Valid members of this list are:
   3242              \"begin\" find environments
   3243              \"$1\"    find single characters surrounded by $.$
   3244              \"$\"     find math expressions surrounded by $...$
   3245              \"$$\"    find math expressions surrounded by $$....$$
   3246              \"\\(\"    find math expressions surrounded by \\(...\\)
   3247              \"\\=\\[\"    find math expressions surrounded by \\=\\[...\\]"
   3248   :group 'org-latex
   3249   :type 'plist)
   3250 
   3251 (defcustom org-format-latex-signal-error t
   3252   "Non-nil means signal an error when image creation of LaTeX snippets fails.
   3253 When nil, just push out a message."
   3254   :group 'org-latex
   3255   :version "24.1"
   3256   :type 'boolean)
   3257 
   3258 (defcustom org-latex-to-mathml-jar-file nil
   3259   "Value of\"%j\" in `org-latex-to-mathml-convert-command'.
   3260 Use this to specify additional executable file say a jar file.
   3261 
   3262 When using MathToWeb as the converter, specify the full-path to
   3263 your mathtoweb.jar file."
   3264   :group 'org-latex
   3265   :version "24.1"
   3266   :type '(choice
   3267 	  (const :tag "None" nil)
   3268 	  (file :tag "JAR file" :must-match t)))
   3269 
   3270 (defcustom org-latex-to-mathml-convert-command nil
   3271   "Command to convert LaTeX fragments to MathML.
   3272 Replace format-specifiers in the command as noted below and use
   3273 `shell-command' to convert LaTeX to MathML.
   3274 %j:     Executable file in fully expanded form as specified by
   3275         `org-latex-to-mathml-jar-file'.
   3276 %I:     Input LaTeX file in fully expanded form.
   3277 %i:     The latex fragment to be converted.
   3278 %o:     Output MathML file.
   3279 
   3280 This command is used by `org-create-math-formula'.
   3281 
   3282 When using MathToWeb as the converter, set this option to
   3283 \"java -jar %j -unicode -force -df %o %I\".
   3284 
   3285 When using LaTeXML set this option to
   3286 \"latexmlmath \"%i\" --presentationmathml=%o\"."
   3287   :group 'org-latex
   3288   :version "24.1"
   3289   :type '(choice
   3290 	  (const :tag "None" nil)
   3291 	  (string :tag "\nShell command")))
   3292 
   3293 (defcustom org-latex-to-html-convert-command nil
   3294   "Command to convert LaTeX fragments to HTML.
   3295 This command is very open-ended: the output of the command will
   3296 directly replace the LaTeX fragment in the resulting HTML.
   3297 Replace format-specifiers in the command as noted below and use
   3298 `shell-command' to convert LaTeX to HTML.
   3299 %i:     The LaTeX fragment to be converted.
   3300 
   3301 For example, this could be used with LaTeXML as
   3302 \"latexmlc 'literal:%i' --profile=math --preload=siunitx.sty 2>/dev/null\"."
   3303   :group 'org-latex
   3304   :package-version '(Org . "9.4")
   3305   :type '(choice
   3306 	  (const :tag "None" nil)
   3307 	  (string :tag "Shell command")))
   3308 
   3309 (defcustom org-preview-latex-default-process 'dvipng
   3310   "The default process to convert LaTeX fragments to image files.
   3311 All available processes and theirs documents can be found in
   3312 `org-preview-latex-process-alist', which see."
   3313   :group 'org-latex
   3314   :version "26.1"
   3315   :package-version '(Org . "9.0")
   3316   :type 'symbol)
   3317 
   3318 (defcustom org-preview-latex-process-alist
   3319   '((dvipng
   3320      :programs ("latex" "dvipng")
   3321      :description "dvi > png"
   3322      :message "you need to install the programs: latex and dvipng."
   3323      :image-input-type "dvi"
   3324      :image-output-type "png"
   3325      :image-size-adjust (1.0 . 1.0)
   3326      :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f")
   3327      :image-converter ("dvipng -D %D -T tight -bg Transparent -o %O %f"))
   3328     (dvisvgm
   3329      :programs ("latex" "dvisvgm")
   3330      :description "dvi > svg"
   3331      :message "you need to install the programs: latex and dvisvgm."
   3332      :image-input-type "dvi"
   3333      :image-output-type "svg"
   3334      :image-size-adjust (1.7 . 1.5)
   3335      :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f")
   3336      :image-converter ("dvisvgm %f -n -b min -c %S -o %O"))
   3337     (imagemagick
   3338      :programs ("latex" "convert")
   3339      :description "pdf > png"
   3340      :message "you need to install the programs: latex and imagemagick."
   3341      :image-input-type "pdf"
   3342      :image-output-type "png"
   3343      :image-size-adjust (1.0 . 1.0)
   3344      :latex-compiler ("pdflatex -interaction nonstopmode -output-directory %o %f")
   3345      :image-converter
   3346      ("convert -density %D -trim -antialias %f -quality 100 %O")))
   3347   "Definitions of external processes for LaTeX previewing.
   3348 Org mode can use some external commands to generate TeX snippet's images for
   3349 previewing or inserting into HTML files, e.g., \"dvipng\".  This variable tells
   3350 `org-create-formula-image' how to call them.
   3351 
   3352 The value is an alist with the pattern (NAME . PROPERTIES).  NAME is a symbol.
   3353 PROPERTIES accepts the following attributes:
   3354 
   3355   :programs           list of strings, required programs.
   3356   :description        string, describe the process.
   3357   :message            string, message it when required programs cannot be found.
   3358   :image-input-type   string, input file type of image converter (e.g., \"dvi\").
   3359   :image-output-type  string, output file type of image converter (e.g., \"png\").
   3360   :image-size-adjust  cons of numbers, the car element is used to adjust LaTeX
   3361                       image size showed in buffer and the cdr element is for
   3362                       HTML file.  This option is only useful for process
   3363                       developers, users should use variable
   3364                       `org-format-latex-options' instead.
   3365   :post-clean         list of strings, files matched are to be cleaned up once
   3366                       the image is generated.  When nil, the files with \".dvi\",
   3367                       \".xdv\", \".pdf\", \".tex\", \".aux\", \".log\", \".svg\",
   3368                       \".png\", \".jpg\", \".jpeg\" or \".out\" extension will
   3369                       be cleaned up.
   3370   :latex-header       list of strings, the LaTeX header of the snippet file.
   3371                       When nil, the fallback value is used instead, which is
   3372                       controlled by `org-format-latex-header',
   3373                       `org-latex-default-packages-alist' and
   3374                       `org-latex-packages-alist', which see.
   3375   :latex-compiler     list of LaTeX commands, as strings.  Each of them is given
   3376                       to the shell.  Place-holders \"%t\", \"%b\" and \"%o\" are
   3377                       replaced with values defined below.
   3378   :image-converter    list of image converter commands strings.  Each of them is
   3379                       given to the shell and supports any of the following
   3380                       place-holders defined below.
   3381 
   3382 Place-holders used by `:image-converter' and `:latex-compiler':
   3383 
   3384   %f    input file name
   3385   %b    base name of input file
   3386   %o    base directory of input file
   3387   %O    absolute output file name
   3388 
   3389 Place-holders only used by `:image-converter':
   3390 
   3391   %D    dpi, which is used to adjust image size by some processing commands.
   3392   %S    the image size scale ratio, which is used to adjust image size by some
   3393         processing commands."
   3394   :group 'org-latex
   3395   :version "26.1"
   3396   :package-version '(Org . "9.0")
   3397   :type '(alist :tag "LaTeX to image backends"
   3398 		:value-type (plist)))
   3399 
   3400 (defcustom org-preview-latex-image-directory "ltximg/"
   3401   "Path to store latex preview images.
   3402 A relative path here creates many directories relative to the
   3403 processed Org files paths.  An absolute path puts all preview
   3404 images at the same place."
   3405   :group 'org-latex
   3406   :version "26.1"
   3407   :package-version '(Org . "9.0")
   3408   :type 'string)
   3409 
   3410 (defun org-format-latex-mathml-available-p ()
   3411   "Return t if `org-latex-to-mathml-convert-command' is usable."
   3412   (save-match-data
   3413     (when (and (boundp 'org-latex-to-mathml-convert-command)
   3414 	       org-latex-to-mathml-convert-command)
   3415       (let ((executable (car (split-string
   3416 			      org-latex-to-mathml-convert-command))))
   3417 	(when (executable-find executable)
   3418 	  (if (string-match
   3419 	       "%j" org-latex-to-mathml-convert-command)
   3420 	      (file-readable-p org-latex-to-mathml-jar-file)
   3421 	    t))))))
   3422 
   3423 (defcustom org-format-latex-header "\\documentclass{article}
   3424 \\usepackage[usenames]{color}
   3425 \[PACKAGES]
   3426 \[DEFAULT-PACKAGES]
   3427 \\pagestyle{empty}             % do not remove
   3428 % The settings below are copied from fullpage.sty
   3429 \\setlength{\\textwidth}{\\paperwidth}
   3430 \\addtolength{\\textwidth}{-3cm}
   3431 \\setlength{\\oddsidemargin}{1.5cm}
   3432 \\addtolength{\\oddsidemargin}{-2.54cm}
   3433 \\setlength{\\evensidemargin}{\\oddsidemargin}
   3434 \\setlength{\\textheight}{\\paperheight}
   3435 \\addtolength{\\textheight}{-\\headheight}
   3436 \\addtolength{\\textheight}{-\\headsep}
   3437 \\addtolength{\\textheight}{-\\footskip}
   3438 \\addtolength{\\textheight}{-3cm}
   3439 \\setlength{\\topmargin}{1.5cm}
   3440 \\addtolength{\\topmargin}{-2.54cm}"
   3441   "The document header used for processing LaTeX fragments.
   3442 It is imperative that this header make sure that no page number
   3443 appears on the page.  The package defined in the variables
   3444 `org-latex-default-packages-alist' and `org-latex-packages-alist'
   3445 will either replace the placeholder \"[PACKAGES]\" in this
   3446 header, or they will be appended."
   3447   :group 'org-latex
   3448   :type 'string)
   3449 
   3450 (defun org-set-packages-alist (var val)
   3451   "Set the packages alist and make sure it has 3 elements per entry."
   3452   (set var (mapcar (lambda (x)
   3453 		     (if (and (consp x) (= (length x) 2))
   3454 			 (list (car x) (nth 1 x) t)
   3455 		       x))
   3456 		   val)))
   3457 
   3458 (defun org-get-packages-alist (var)
   3459   "Get the packages alist and make sure it has 3 elements per entry."
   3460   (mapcar (lambda (x)
   3461 	    (if (and (consp x) (= (length x) 2))
   3462 		(list (car x) (nth 1 x) t)
   3463 	      x))
   3464 	  (default-value var)))
   3465 
   3466 (defcustom org-latex-default-packages-alist
   3467   '(("AUTO" "inputenc"  t ("pdflatex"))
   3468     ("T1"   "fontenc"   t ("pdflatex"))
   3469     (""     "graphicx"  t)
   3470     (""     "longtable" nil)
   3471     (""     "wrapfig"   nil)
   3472     (""     "rotating"  nil)
   3473     ("normalem" "ulem"  t)
   3474     (""     "amsmath"   t)
   3475     (""     "amssymb"   t)
   3476     (""     "capt-of"   nil)
   3477     (""     "hyperref"  nil))
   3478   "Alist of default packages to be inserted in the header.
   3479 
   3480 Change this only if one of the packages here causes an
   3481 incompatibility with another package you are using.
   3482 
   3483 The packages in this list are needed by one part or another of
   3484 Org mode to function properly:
   3485 
   3486 - inputenc, fontenc:  for basic font and character selection
   3487 - graphicx: for including images
   3488 - longtable: For multipage tables
   3489 - wrapfig: for figure placement
   3490 - rotating: for sideways figures and tables
   3491 - ulem: for underline and strike-through
   3492 - amsmath: for subscript and superscript and math environments
   3493 - amssymb: for various symbols used for interpreting the entities
   3494   in `org-entities'.  You can skip some of this package if you don't
   3495   use any of the symbols.
   3496 - capt-of: for captions outside of floats
   3497 - hyperref: for cross references
   3498 
   3499 Therefore you should not modify this variable unless you know
   3500 what you are doing.  The one reason to change it anyway is that
   3501 you might be loading some other package that conflicts with one
   3502 of the default packages.  Each element is either a cell or
   3503 a string.
   3504 
   3505 A cell is of the format
   3506 
   3507   (\"options\" \"package\" SNIPPET-FLAG COMPILERS)
   3508 
   3509 If SNIPPET-FLAG is non-nil, the package also needs to be included
   3510 when compiling LaTeX snippets into images for inclusion into
   3511 non-LaTeX output.
   3512 
   3513 COMPILERS is a list of compilers that should include the package,
   3514 see `org-latex-compiler'.  If the document compiler is not in the
   3515 list, and the list is non-nil, the package will not be inserted
   3516 in the final document.
   3517 
   3518 A string will be inserted as-is in the header of the document."
   3519   :group 'org-latex
   3520   :group 'org-export-latex
   3521   :set 'org-set-packages-alist
   3522   :get 'org-get-packages-alist
   3523   :version "26.1"
   3524   :package-version '(Org . "8.3")
   3525   :type '(repeat
   3526 	  (choice
   3527 	   (list :tag "options/package pair"
   3528 		 (string :tag "options")
   3529 		 (string :tag "package")
   3530 		 (boolean :tag "Snippet")
   3531 		 (choice
   3532 		  (const :tag "For all compilers" nil)
   3533 		  (repeat :tag "Allowed compiler" string)))
   3534 	   (string :tag "A line of LaTeX"))))
   3535 
   3536 (defcustom org-latex-packages-alist nil
   3537   "Alist of packages to be inserted in every LaTeX header.
   3538 
   3539 These will be inserted after `org-latex-default-packages-alist'.
   3540 Each element is either a cell or a string.
   3541 
   3542 A cell is of the format:
   3543 
   3544     (\"options\" \"package\" SNIPPET-FLAG COMPILERS)
   3545 
   3546 SNIPPET-FLAG, when non-nil, indicates that this package is also
   3547 needed when turning LaTeX snippets into images for inclusion into
   3548 non-LaTeX output.
   3549 
   3550 COMPILERS is a list of compilers that should include the package,
   3551 see `org-latex-compiler'.  If the document compiler is not in the
   3552 list, and the list is non-nil, the package will not be inserted
   3553 in the final document.
   3554 
   3555 A string will be inserted as-is in the header of the document.
   3556 
   3557 Make sure that you only list packages here which:
   3558 
   3559   - you want in every file;
   3560   - do not conflict with the setup in `org-format-latex-header';
   3561   - do not conflict with the default packages in
   3562     `org-latex-default-packages-alist'."
   3563   :group 'org-latex
   3564   :group 'org-export-latex
   3565   :set 'org-set-packages-alist
   3566   :get 'org-get-packages-alist
   3567   :type '(repeat
   3568 	  (choice
   3569 	   (list :tag "options/package pair"
   3570 		 (string :tag "options")
   3571 		 (string :tag "package")
   3572 		 (boolean :tag "Snippet"))
   3573 	   (string :tag "A line of LaTeX"))))
   3574 
   3575 (defgroup org-appearance nil
   3576   "Settings for Org mode appearance."
   3577   :tag "Org Appearance"
   3578   :group 'org)
   3579 
   3580 (defcustom org-level-color-stars-only nil
   3581   "Non-nil means fontify only the stars in each headline.
   3582 When nil, the entire headline is fontified.
   3583 Changing it requires restart of `font-lock-mode' to become effective
   3584 also in regions already fontified."
   3585   :group 'org-appearance
   3586   :type 'boolean)
   3587 
   3588 (defcustom org-hide-leading-stars nil
   3589   "Non-nil means hide the first N-1 stars in a headline.
   3590 This works by using the face `org-hide' for these stars.  This
   3591 face is white for a light background, and black for a dark
   3592 background.  You may have to customize the face `org-hide' to
   3593 make this work.
   3594 Changing it requires restart of `font-lock-mode' to become effective
   3595 also in regions already fontified.
   3596 You may also set this on a per-file basis by adding one of the following
   3597 lines to the buffer:
   3598 
   3599    #+STARTUP: hidestars
   3600    #+STARTUP: showstars"
   3601   :group 'org-appearance
   3602   :type 'boolean)
   3603 
   3604 (defcustom org-hidden-keywords nil
   3605   "List of symbols corresponding to keywords to be hidden in the Org buffer.
   3606 For example, a value \\='(title) for this list makes the document's title
   3607 appear in the buffer without the initial \"#+TITLE:\" part."
   3608   :group 'org-appearance
   3609   :package-version '(Org . "9.5")
   3610   :type '(set (const :tag "#+AUTHOR" author)
   3611 	      (const :tag "#+DATE" date)
   3612 	      (const :tag "#+EMAIL" email)
   3613 	      (const :tag "#+SUBTITLE" subtitle)
   3614 	      (const :tag "#+TITLE" title)))
   3615 
   3616 (defcustom org-custom-properties nil
   3617   "List of properties (as strings) with a special meaning.
   3618 The default use of these custom properties is to let the user
   3619 hide them with `org-toggle-custom-properties-visibility'."
   3620   :group 'org-properties
   3621   :group 'org-appearance
   3622   :version "24.3"
   3623   :type '(repeat (string :tag "Property Name")))
   3624 
   3625 (defcustom org-fontify-todo-headline nil
   3626   "Non-nil means change the face of a headline if it is marked as TODO.
   3627 Normally, only the TODO/DONE keyword indicates the state of a headline.
   3628 When this is non-nil, the headline after the keyword is set to the
   3629 `org-headline-todo' as an additional indication."
   3630   :group 'org-appearance
   3631   :package-version '(Org . "9.4")
   3632   :type 'boolean
   3633   :safe t)
   3634 
   3635 (defcustom org-fontify-done-headline t
   3636   "Non-nil means change the face of a headline if it is marked DONE.
   3637 Normally, only the TODO/DONE keyword indicates the state of a headline.
   3638 When this is non-nil, the headline after the keyword is set to the
   3639 `org-headline-done' as an additional indication."
   3640   :group 'org-appearance
   3641   :package-version '(Org . "9.4")
   3642   :type 'boolean)
   3643 
   3644 (defcustom org-fontify-emphasized-text t
   3645   "Non-nil means fontify *bold*, /italic/ and _underlined_ text.
   3646 Changing this variable requires a restart of Emacs to take effect."
   3647   :group 'org-appearance
   3648   :type 'boolean)
   3649 
   3650 (defcustom org-fontify-whole-heading-line nil
   3651   "Non-nil means fontify the whole line for headings.
   3652 This is useful when setting a background color for the
   3653 org-level-* faces."
   3654   :group 'org-appearance
   3655   :type 'boolean)
   3656 
   3657 (defcustom org-fontify-whole-block-delimiter-line t
   3658   "Non-nil means fontify the whole line for begin/end lines of blocks.
   3659 This is useful when setting a background color for the
   3660 org-block-begin-line and org-block-end-line faces."
   3661   :group 'org-appearance
   3662   :type 'boolean)
   3663 
   3664 (defcustom org-highlight-latex-and-related nil
   3665   "Non-nil means highlight LaTeX related syntax in the buffer.
   3666 When non-nil, the value should be a list containing any of the
   3667 following symbols:
   3668   `native'   Highlight LaTeX snippets and environments natively.
   3669   `latex'    Highlight LaTeX snippets and environments.
   3670   `script'   Highlight subscript and superscript.
   3671   `entities' Highlight entities."
   3672   :group 'org-appearance
   3673   :version "24.4"
   3674   :package-version '(Org . "8.0")
   3675   :type '(choice
   3676 	  (const :tag "No highlighting" nil)
   3677 	  (set :greedy t :tag "Highlight"
   3678 	       (const :tag "LaTeX snippets and environments (native)" native)
   3679 	       (const :tag "LaTeX snippets and environments" latex)
   3680 	       (const :tag "Subscript and superscript" script)
   3681 	       (const :tag "Entities" entities))))
   3682 
   3683 (defcustom org-hide-emphasis-markers nil
   3684   "Non-nil mean font-lock should hide the emphasis marker characters."
   3685   :group 'org-appearance
   3686   :type 'boolean
   3687   :safe #'booleanp)
   3688 
   3689 (defcustom org-hide-macro-markers nil
   3690   "Non-nil mean font-lock should hide the brackets marking macro calls."
   3691   :group 'org-appearance
   3692   :type 'boolean)
   3693 
   3694 (defcustom org-pretty-entities nil
   3695   "Non-nil means show entities as UTF8 characters.
   3696 When nil, the \\name form remains in the buffer."
   3697   :group 'org-appearance
   3698   :version "24.1"
   3699   :type 'boolean)
   3700 
   3701 (defcustom org-pretty-entities-include-sub-superscripts t
   3702   "Non-nil means, pretty entity display includes formatting sub/superscripts."
   3703   :group 'org-appearance
   3704   :version "24.1"
   3705   :type 'boolean)
   3706 
   3707 (defvar org-emph-re nil
   3708   "Regular expression for matching emphasis.
   3709 After a match, the match groups contain these elements:
   3710 0  The match of the full regular expression, including the characters
   3711    before and after the proper match
   3712 1  The character before the proper match, or empty at beginning of line
   3713 2  The proper match, including the leading and trailing markers
   3714 3  The leading marker like * or /, indicating the type of highlighting
   3715 4  The text between the emphasis markers, not including the markers
   3716 5  The character after the match, empty at the end of a line")
   3717 
   3718 (defvar org-verbatim-re nil
   3719   "Regular expression for matching verbatim text.")
   3720 
   3721 (defvar org-emphasis-regexp-components) ; defined just below
   3722 (defvar org-emphasis-alist) ; defined just below
   3723 (defun org-set-emph-re (var val)
   3724   "Set variable and compute the emphasis regular expression."
   3725   (set var val)
   3726   (when (and (boundp 'org-emphasis-alist)
   3727 	     (boundp 'org-emphasis-regexp-components)
   3728 	     org-emphasis-alist org-emphasis-regexp-components)
   3729     (pcase-let*
   3730 	((`(,pre ,post ,border ,body ,nl) org-emphasis-regexp-components)
   3731 	 (body (if (<= nl 0) body
   3732 		 (format "%s*?\\(?:\n%s*?\\)\\{0,%d\\}" body body nl)))
   3733 	 (template
   3734 	  (format (concat "\\([%s]\\|^\\)" ;before markers
   3735 			  "\\(\\([%%s]\\)\\([^%s]\\|[^%s]%s[^%s]\\)\\3\\)"
   3736 			  "\\([%s]\\|$\\)") ;after markers
   3737 		  pre border border body border post)))
   3738       (setq org-emph-re (format template "*/_+"))
   3739       (setq org-verbatim-re (format template "=~")))))
   3740 
   3741 ;; This used to be a defcustom (Org <8.0) but allowing the users to
   3742 ;; set this option proved cumbersome.  See this message/thread:
   3743 ;; https://orgmode.org/list/B72CDC2B-72F6-43A8-AC70-E6E6295766EC@gmail.com
   3744 (defvar org-emphasis-regexp-components
   3745   '("-[:space:]('\"{" "-[:space:].,:!?;'\")}\\[" "[:space:]" "." 1)
   3746   "Components used to build the regular expression for emphasis.
   3747 This is a list with five entries.  Terminology:  In an emphasis string
   3748 like \" *strong word* \", we call the initial space PREMATCH, the final
   3749 space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters
   3750 and \"trong wor\" is the body.  The different components in this variable
   3751 specify what is allowed/forbidden in each part:
   3752 
   3753 pre          Chars allowed as prematch.  Beginning of line will be allowed too.
   3754 post         Chars allowed as postmatch.  End of line will be allowed too.
   3755 border       The chars *forbidden* as border characters.
   3756 body-regexp  A regexp like \".\" to match a body character.  Don't use
   3757              non-shy groups here, and don't allow newline here.
   3758 newline      The maximum number of newlines allowed in an emphasis exp.
   3759 
   3760 You need to reload Org or to restart Emacs after setting this.")
   3761 
   3762 (defcustom org-emphasis-alist
   3763   '(("*" bold)
   3764     ("/" italic)
   3765     ("_" underline)
   3766     ("=" org-verbatim verbatim)
   3767     ("~" org-code verbatim)
   3768     ("+" (:strike-through t)))
   3769   "Alist of characters and faces to emphasize text.
   3770 Text starting and ending with a special character will be emphasized,
   3771 for example *bold*, _underlined_ and /italic/.  This variable sets the
   3772 marker characters and the face to be used by font-lock for highlighting
   3773 in Org buffers.
   3774 
   3775 You need to reload Org or to restart Emacs after customizing this."
   3776   :group 'org-appearance
   3777   :set 'org-set-emph-re
   3778   :version "24.4"
   3779   :package-version '(Org . "8.0")
   3780   :type '(repeat
   3781 	  (list
   3782 	   (string :tag "Marker character")
   3783 	   (choice
   3784 	    (face :tag "Font-lock-face")
   3785 	    (plist :tag "Face property list"))
   3786 	   (option (const verbatim)))))
   3787 
   3788 (defvar org-protecting-blocks '("src" "example" "export")
   3789   "Blocks that contain text that is quoted, i.e. not processed as Org syntax.
   3790 This is needed for font-lock setup.")
   3791 
   3792 ;;; Functions and variables from their packages
   3793 ;;  Declared here to avoid compiler warnings
   3794 (defvar mark-active)
   3795 
   3796 ;; Various packages
   3797 (declare-function calc-eval "calc" (str &optional separator &rest args))
   3798 (declare-function calendar-forward-day "cal-move" (arg))
   3799 (declare-function calendar-goto-date "cal-move" (date))
   3800 (declare-function calendar-goto-today "cal-move" ())
   3801 (declare-function calendar-iso-from-absolute "cal-iso" (date))
   3802 (declare-function calendar-iso-to-absolute "cal-iso" (date))
   3803 (declare-function cdlatex-compute-tables "ext:cdlatex" ())
   3804 (declare-function cdlatex-tab "ext:cdlatex" ())
   3805 (declare-function dired-get-filename
   3806 		  "dired"
   3807 		  (&optional localp no-error-if-not-filep))
   3808 (declare-function iswitchb-read-buffer
   3809 		  "iswitchb"
   3810 		  (prompt &optional
   3811 			  default require-match _predicate start matches-set))
   3812 (declare-function org-agenda-change-all-lines
   3813 		  "org-agenda"
   3814 		  (newhead hdmarker &optional fixface just-this))
   3815 (declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
   3816 		  "org-agenda"
   3817 		  (&optional end))
   3818 (declare-function org-agenda-copy-local-variable "org-agenda" (var))
   3819 (declare-function org-agenda-format-item
   3820 		  "org-agenda"
   3821 		  (extra txt &optional level category tags dotime
   3822 			 remove-re habitp))
   3823 (declare-function org-agenda-new-marker "org-agenda" (&optional pos))
   3824 (declare-function org-agenda-save-markers-for-cut-and-paste
   3825 		  "org-agenda"
   3826 		  (beg end))
   3827 (declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type))
   3828 (declare-function org-agenda-skip "org-agenda" ())
   3829 (declare-function org-attach-expand "org-attach" (file))
   3830 (declare-function org-attach-reveal "org-attach" ())
   3831 (declare-function org-attach-reveal-in-emacs "org-attach" ())
   3832 (declare-function org-gnus-follow-link "org-gnus" (&optional group article))
   3833 (declare-function org-indent-mode "org-indent" (&optional arg))
   3834 (declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
   3835 (declare-function org-inlinetask-goto-end "org-inlinetask" ())
   3836 (declare-function org-inlinetask-in-task-p "org-inlinetask" ())
   3837 (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
   3838 (declare-function parse-time-string "parse-time" (string))
   3839 
   3840 (defvar align-mode-rules-list)
   3841 (defvar calc-embedded-close-formula)
   3842 (defvar calc-embedded-open-formula)
   3843 (defvar calc-embedded-open-mode)
   3844 (defvar font-lock-unfontify-region-function)
   3845 (defvar iswitchb-temp-buflist)
   3846 (defvar org-agenda-tags-todo-honor-ignore-options)
   3847 (defvar remember-data-file)
   3848 (defvar texmathp-why)
   3849 
   3850 (declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end))
   3851 (declare-function org-clock-update-mode-line "org-clock" (&optional refresh))
   3852 (declare-function org-resolve-clocks "org-clock"
   3853 		  (&optional also-non-dangling-p prompt last-valid))
   3854 
   3855 (defvar org-clock-start-time)
   3856 (defvar org-clock-marker (make-marker)
   3857   "Marker recording the last clock-in.")
   3858 (defvar org-clock-hd-marker (make-marker)
   3859   "Marker recording the last clock-in, but the headline position.")
   3860 (defvar org-clock-heading ""
   3861   "The heading of the current clock entry.")
   3862 (defun org-clocking-buffer ()
   3863   "Return the buffer where the clock is currently running.
   3864 Return nil if no clock is running."
   3865   (marker-buffer org-clock-marker))
   3866 (defalias 'org-clock-is-active #'org-clocking-buffer)
   3867 
   3868 (defun org-check-running-clock ()
   3869   "Check if the current buffer contains the running clock.
   3870 If yes, offer to stop it and to save the buffer with the changes."
   3871   (when (and (equal (marker-buffer org-clock-marker) (current-buffer))
   3872 	     (y-or-n-p (format "Clock-out in buffer %s before killing it? "
   3873 			       (buffer-name))))
   3874     (org-clock-out)
   3875     (when (y-or-n-p "Save changed buffer?")
   3876       (save-buffer))))
   3877 
   3878 (defun org-clocktable-try-shift (dir n)
   3879   "Check if this line starts a clock table, if yes, shift the time block."
   3880   (when (org-match-line "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>")
   3881     (org-clocktable-shift dir n)))
   3882 
   3883 ;;;###autoload
   3884 (defun org-clock-persistence-insinuate ()
   3885   "Set up hooks for clock persistence."
   3886   (require 'org-clock)
   3887   (add-hook 'org-mode-hook 'org-clock-load)
   3888   (add-hook 'kill-emacs-hook 'org-clock-save))
   3889 
   3890 (defun org-clock-auto-clockout-insinuate ()
   3891   "Set up hook for auto clocking out when Emacs is idle.
   3892 See `org-clock-auto-clockout-timer'.
   3893 
   3894 This function is meant to be added to the user configuration."
   3895   (require 'org-clock)
   3896   (add-hook 'org-clock-in-hook #'org-clock-auto-clockout t))
   3897 
   3898 (defgroup org-archive nil
   3899   "Options concerning archiving in Org mode."
   3900   :tag "Org Archive"
   3901   :group 'org-structure)
   3902 
   3903 (defcustom org-archive-location "%s_archive::"
   3904   "The location where subtrees should be archived.
   3905 
   3906 The value of this variable is a string, consisting of two parts,
   3907 separated by a double-colon.  The first part is a filename and
   3908 the second part is a headline.
   3909 
   3910 When the filename is omitted, archiving happens in the same file.
   3911 %s in the filename will be replaced by the current file
   3912 name (without the directory part).  Archiving to a different file
   3913 is useful to keep archived entries from contributing to the
   3914 Org Agenda.
   3915 
   3916 The archived entries will be filed as subtrees of the specified
   3917 headline.  When the headline is omitted, the subtrees are simply
   3918 filed away at the end of the file, as top-level entries.  Also in
   3919 the heading you can use %s to represent the file name, this can be
   3920 useful when using the same archive for a number of different files.
   3921 
   3922 Here are a few examples:
   3923 \"%s_archive::\"
   3924 	If the current file is Projects.org, archive in file
   3925 	Projects.org_archive, as top-level trees.  This is the default.
   3926 
   3927 \"::* Archived Tasks\"
   3928 	Archive in the current file, under the top-level headline
   3929 	\"* Archived Tasks\".
   3930 
   3931 \"~/org/archive.org::\"
   3932 	Archive in file ~/org/archive.org (absolute path), as top-level trees.
   3933 
   3934 \"~/org/archive.org::* From %s\"
   3935 	Archive in file ~/org/archive.org (absolute path), under headlines
   3936         \"From FILENAME\" where file name is the current file name.
   3937 
   3938 \"~/org/datetree.org::datetree/* Finished Tasks\"
   3939         The \"datetree/\" string is special, signifying to archive
   3940         items to the datetree.  Items are placed in either the CLOSED
   3941         date of the item, or the current date if there is no CLOSED date.
   3942         The heading will be a subentry to the current date.  There doesn't
   3943         need to be a heading, but there always needs to be a slash after
   3944         datetree.  For example, to store archived items directly in the
   3945         datetree, use \"~/org/datetree.org::datetree/\".
   3946 
   3947 \"basement::** Finished Tasks\"
   3948 	Archive in file ./basement (relative path), as level 3 trees
   3949 	below the level 2 heading \"** Finished Tasks\".
   3950 
   3951 You may define it locally by setting an ARCHIVE property.  If
   3952 such a property is found in the file or in an entry, and anywhere
   3953 up the hierarchy, it will be used.
   3954 
   3955 You can also set it for the whole file using the keyword-syntax:
   3956 
   3957 #+ARCHIVE: basement::** Finished Tasks"
   3958   :group 'org-archive
   3959   :type 'string)
   3960 
   3961 (defcustom org-agenda-skip-archived-trees t
   3962   "Non-nil means the agenda will skip any items located in archived trees.
   3963 An archived tree is a tree marked with the tag ARCHIVE.  The use of this
   3964 variable is no longer recommended, you should leave it at the value t.
   3965 Instead, use the key `v' to cycle the archives-mode in the agenda."
   3966   :group 'org-archive
   3967   :group 'org-agenda-skip
   3968   :type 'boolean)
   3969 
   3970 (defcustom org-columns-skip-archived-trees t
   3971   "Non-nil means ignore archived trees when creating column view."
   3972   :group 'org-archive
   3973   :group 'org-properties
   3974   :type 'boolean)
   3975 
   3976 (defcustom org-cycle-open-archived-trees nil
   3977   "Non-nil means `org-cycle' will open archived trees.
   3978 An archived tree is a tree marked with the tag ARCHIVE.
   3979 When nil, archived trees will stay folded.  You can still open them with
   3980 normal outline commands like `show-all', but not with the cycling commands."
   3981   :group 'org-archive
   3982   :group 'org-cycle
   3983   :type 'boolean)
   3984 
   3985 (defcustom org-sparse-tree-open-archived-trees nil
   3986   "Non-nil means sparse tree construction shows matches in archived trees.
   3987 When nil, matches in these trees are highlighted, but the trees are kept in
   3988 collapsed state."
   3989   :group 'org-archive
   3990   :group 'org-sparse-trees
   3991   :type 'boolean)
   3992 
   3993 (defcustom org-sparse-tree-default-date-type nil
   3994   "The default date type when building a sparse tree.
   3995 When this is nil, a date is a scheduled or a deadline timestamp.
   3996 Otherwise, these types are allowed:
   3997 
   3998         all: all timestamps
   3999      active: only active timestamps (<...>)
   4000    inactive: only inactive timestamps ([...])
   4001   scheduled: only scheduled timestamps
   4002    deadline: only deadline timestamps"
   4003   :type '(choice (const :tag "Scheduled or deadline" nil)
   4004 		 (const :tag "All timestamps" all)
   4005 		 (const :tag "Only active timestamps" active)
   4006 		 (const :tag "Only inactive timestamps" inactive)
   4007 		 (const :tag "Only scheduled timestamps" scheduled)
   4008 		 (const :tag "Only deadline timestamps" deadline)
   4009 		 (const :tag "Only closed timestamps" closed))
   4010   :version "26.1"
   4011   :package-version '(Org . "8.3")
   4012   :group 'org-sparse-trees)
   4013 
   4014 (defun org-cycle-hide-archived-subtrees (state)
   4015   "Re-hide all archived subtrees after a visibility state change.
   4016 STATE should be one of the symbols listed in the docstring of
   4017 `org-cycle-hook'."
   4018   (when (and (not org-cycle-open-archived-trees)
   4019              (not (memq state '(overview folded))))
   4020     (save-excursion
   4021       (let* ((globalp (memq state '(contents all)))
   4022              (beg (if globalp (point-min) (point)))
   4023              (end (if globalp (point-max) (org-end-of-subtree t))))
   4024 	(org-hide-archived-subtrees beg end)
   4025 	(goto-char beg)
   4026 	(when (looking-at-p (concat ".*:" org-archive-tag ":"))
   4027 	  (message "%s" (substitute-command-keys
   4028 			 "Subtree is archived and stays closed.  Use \
   4029 `\\[org-force-cycle-archived]' to cycle it anyway.")))))))
   4030 
   4031 (defun org-force-cycle-archived ()
   4032   "Cycle subtree even if it is archived."
   4033   (interactive)
   4034   (setq this-command 'org-cycle)
   4035   (let ((org-cycle-open-archived-trees t))
   4036     (call-interactively 'org-cycle)))
   4037 
   4038 (defun org-hide-archived-subtrees (beg end)
   4039   "Re-hide all archived subtrees after a visibility state change."
   4040   (org-with-wide-buffer
   4041    (let ((case-fold-search nil)
   4042 	 (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":")))
   4043      (goto-char beg)
   4044      ;; Include headline point is currently on.
   4045      (beginning-of-line)
   4046      (while (and (< (point) end) (re-search-forward re end t))
   4047        (when (member org-archive-tag (org-get-tags nil t))
   4048 	 (org-flag-subtree t)
   4049 	 (org-end-of-subtree t))))))
   4050 
   4051 (defun org-flag-subtree (flag)
   4052   (save-excursion
   4053     (org-back-to-heading t)
   4054     (org-flag-region (line-end-position)
   4055 		     (progn (org-end-of-subtree t) (point))
   4056 		     flag
   4057 		     'outline)))
   4058 
   4059 (defalias 'org-advertized-archive-subtree 'org-archive-subtree)
   4060 
   4061 ;; Declare Column View Code
   4062 
   4063 (declare-function org-columns-get-format-and-top-level "org-colview" ())
   4064 (declare-function org-columns-compute "org-colview" (property))
   4065 
   4066 ;; Declare ID code
   4067 
   4068 (declare-function org-id-store-link "org-id")
   4069 (declare-function org-id-locations-load "org-id")
   4070 (declare-function org-id-locations-save "org-id")
   4071 (defvar org-id-track-globally)
   4072 
   4073 ;;; Variables for pre-computed regular expressions, all buffer local
   4074 
   4075 (defvar-local org-todo-regexp nil
   4076   "Matches any of the TODO state keywords.
   4077 Since TODO keywords are case-sensitive, `case-fold-search' is
   4078 expected to be bound to nil when matching against this regexp.")
   4079 
   4080 (defvar-local org-not-done-regexp nil
   4081   "Matches any of the TODO state keywords except the last one.
   4082 Since TODO keywords are case-sensitive, `case-fold-search' is
   4083 expected to be bound to nil when matching against this regexp.")
   4084 
   4085 (defvar-local org-not-done-heading-regexp nil
   4086   "Matches a TODO headline that is not done.
   4087 Since TODO keywords are case-sensitive, `case-fold-search' is
   4088 expected to be bound to nil when matching against this regexp.")
   4089 
   4090 (defvar-local org-todo-line-regexp nil
   4091   "Matches a headline and puts TODO state into group 2 if present.
   4092 Since TODO keywords are case-sensitive, `case-fold-search' is
   4093 expected to be bound to nil when matching against this regexp.")
   4094 
   4095 (defvar-local org-complex-heading-regexp nil
   4096   "Matches a headline and puts everything into groups:
   4097 
   4098 group 1: Stars
   4099 group 2: The TODO keyword, maybe
   4100 group 3: Priority cookie
   4101 group 4: True headline
   4102 group 5: Tags
   4103 
   4104 Since TODO keywords are case-sensitive, `case-fold-search' is
   4105 expected to be bound to nil when matching against this regexp.")
   4106 
   4107 (defvar-local org-complex-heading-regexp-format nil
   4108   "Printf format to make regexp to match an exact headline.
   4109 This regexp will match the headline of any node which has the
   4110 exact headline text that is put into the format, but may have any
   4111 TODO state, priority and tags.")
   4112 
   4113 (defvar-local org-todo-line-tags-regexp nil
   4114   "Matches a headline and puts TODO state into group 2 if present.
   4115 Also put tags into group 4 if tags are present.")
   4116 
   4117 (defconst org-plain-time-of-day-regexp
   4118   (concat
   4119    "\\(\\<[012]?[0-9]"
   4120    "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
   4121    "\\(--?"
   4122    "\\(\\<[012]?[0-9]"
   4123    "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
   4124    "\\)?")
   4125   "Regular expression to match a plain time or time range.
   4126 Examples:  11:45 or 8am-13:15 or 2:45-2:45pm.  After a match, the following
   4127 groups carry important information:
   4128 0  the full match
   4129 1  the first time, range or not
   4130 8  the second time, if it is a range.")
   4131 
   4132 (defconst org-plain-time-extension-regexp
   4133   (concat
   4134    "\\(\\<[012]?[0-9]"
   4135    "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
   4136    "\\+\\([0-9]+\\)\\(:\\([0-5][0-9]\\)\\)?")
   4137   "Regular expression to match a time range like 13:30+2:10 = 13:30-15:40.
   4138 Examples:  11:45 or 8am-13:15 or 2:45-2:45pm.  After a match, the following
   4139 groups carry important information:
   4140 0  the full match
   4141 7  hours of duration
   4142 9  minutes of duration")
   4143 
   4144 (defconst org-stamp-time-of-day-regexp
   4145   (concat
   4146    "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)"
   4147    "\\([012][0-9]:[0-5][0-9]\\)\\(-\\([012][0-9]:[0-5][0-9]\\)\\)?[^\n\r>]*?>"
   4148    "\\(--?"
   4149    "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?")
   4150   "Regular expression to match a timestamp time or time range.
   4151 After a match, the following groups carry important information:
   4152 0  the full match
   4153 1  date plus weekday, for back referencing to make sure
   4154      both times are on the same day
   4155 2  the first time, range or not
   4156 4  the second time, if it is a range.")
   4157 
   4158 (defconst org-startup-options
   4159   '(("fold" org-startup-folded t)
   4160     ("overview" org-startup-folded t)
   4161     ("nofold" org-startup-folded nil)
   4162     ("showall" org-startup-folded nil)
   4163     ("show2levels" org-startup-folded show2levels)
   4164     ("show3levels" org-startup-folded show3levels)
   4165     ("show4levels" org-startup-folded show4levels)
   4166     ("show5levels" org-startup-folded show5levels)
   4167     ("showeverything" org-startup-folded showeverything)
   4168     ("content" org-startup-folded content)
   4169     ("indent" org-startup-indented t)
   4170     ("noindent" org-startup-indented nil)
   4171     ("num" org-startup-numerated t)
   4172     ("nonum" org-startup-numerated nil)
   4173     ("hidestars" org-hide-leading-stars t)
   4174     ("showstars" org-hide-leading-stars nil)
   4175     ("odd" org-odd-levels-only t)
   4176     ("oddeven" org-odd-levels-only nil)
   4177     ("align" org-startup-align-all-tables t)
   4178     ("noalign" org-startup-align-all-tables nil)
   4179     ("shrink" org-startup-shrink-all-tables t)
   4180     ("inlineimages" org-startup-with-inline-images t)
   4181     ("noinlineimages" org-startup-with-inline-images nil)
   4182     ("latexpreview" org-startup-with-latex-preview t)
   4183     ("nolatexpreview" org-startup-with-latex-preview nil)
   4184     ("customtime" org-display-custom-times t)
   4185     ("logdone" org-log-done time)
   4186     ("lognotedone" org-log-done note)
   4187     ("nologdone" org-log-done nil)
   4188     ("lognoteclock-out" org-log-note-clock-out t)
   4189     ("nolognoteclock-out" org-log-note-clock-out nil)
   4190     ("logrepeat" org-log-repeat state)
   4191     ("lognoterepeat" org-log-repeat note)
   4192     ("logdrawer" org-log-into-drawer t)
   4193     ("nologdrawer" org-log-into-drawer nil)
   4194     ("logstatesreversed" org-log-states-order-reversed t)
   4195     ("nologstatesreversed" org-log-states-order-reversed nil)
   4196     ("nologrepeat" org-log-repeat nil)
   4197     ("logreschedule" org-log-reschedule time)
   4198     ("lognotereschedule" org-log-reschedule note)
   4199     ("nologreschedule" org-log-reschedule nil)
   4200     ("logredeadline" org-log-redeadline time)
   4201     ("lognoteredeadline" org-log-redeadline note)
   4202     ("nologredeadline" org-log-redeadline nil)
   4203     ("logrefile" org-log-refile time)
   4204     ("lognoterefile" org-log-refile note)
   4205     ("nologrefile" org-log-refile nil)
   4206     ("fninline" org-footnote-define-inline t)
   4207     ("nofninline" org-footnote-define-inline nil)
   4208     ("fnlocal" org-footnote-section nil)
   4209     ("fnauto" org-footnote-auto-label t)
   4210     ("fnprompt" org-footnote-auto-label nil)
   4211     ("fnconfirm" org-footnote-auto-label confirm)
   4212     ("fnplain" org-footnote-auto-label plain)
   4213     ("fnadjust" org-footnote-auto-adjust t)
   4214     ("nofnadjust" org-footnote-auto-adjust nil)
   4215     ("constcgs" constants-unit-system cgs)
   4216     ("constSI" constants-unit-system SI)
   4217     ("noptag" org-tag-persistent-alist nil)
   4218     ("hideblocks" org-hide-block-startup t)
   4219     ("nohideblocks" org-hide-block-startup nil)
   4220     ("beamer" org-startup-with-beamer-mode t)
   4221     ("entitiespretty" org-pretty-entities t)
   4222     ("entitiesplain" org-pretty-entities nil))
   4223   "Variable associated with STARTUP options for Org.
   4224 Each element is a list of three items: the startup options (as written
   4225 in the #+STARTUP line), the corresponding variable, and the value to set
   4226 this variable to if the option is found.  An optional fourth element PUSH
   4227 means to push this value onto the list in the variable.")
   4228 
   4229 (defcustom org-group-tags t
   4230   "When non-nil (the default), use group tags.
   4231 This can be turned on/off through `org-toggle-tags-groups'."
   4232   :group 'org-tags
   4233   :group 'org-startup
   4234   :type 'boolean)
   4235 
   4236 (defvar org-inhibit-startup nil)        ; Dynamically-scoped param.
   4237 
   4238 (defun org-toggle-tags-groups ()
   4239   "Toggle support for group tags.
   4240 Support for group tags is controlled by the option
   4241 `org-group-tags', which is non-nil by default."
   4242   (interactive)
   4243   (setq org-group-tags (not org-group-tags))
   4244   (cond ((and (derived-mode-p 'org-agenda-mode)
   4245 	      org-group-tags)
   4246 	 (org-agenda-redo))
   4247 	((derived-mode-p 'org-mode)
   4248 	 (let ((org-inhibit-startup t)) (org-mode))))
   4249   (message "Groups tags support has been turned %s"
   4250 	   (if org-group-tags "on" "off")))
   4251 
   4252 (defun org--tag-add-to-alist (alist1 alist2)
   4253   "Merge tags from ALIST1 into ALIST2.
   4254 
   4255 Duplicates tags outside a group are removed.  Keywords and order
   4256 are preserved.
   4257 
   4258 The function assumes ALIST1 and ALIST2 are proper tag alists.
   4259 See `org-tag-alist' for their structure."
   4260   (cond
   4261    ((null alist2) alist1)
   4262    ((null alist1) alist2)
   4263    (t
   4264     (let ((to-add nil)
   4265 	  (group-flag nil))
   4266       (dolist (tag-pair alist1)
   4267 	(pcase tag-pair
   4268 	  (`(,(or :startgrouptag :startgroup))
   4269 	   (setq group-flag t)
   4270 	   (push tag-pair to-add))
   4271 	  (`(,(or :endgrouptag :endgroup))
   4272 	   (setq group-flag nil)
   4273 	   (push tag-pair to-add))
   4274 	  (`(,(or :grouptags :newline))
   4275 	   (push tag-pair to-add))
   4276 	  (`(,tag . ,_)
   4277 	   ;; Remove duplicates from ALIST1, unless they are in
   4278 	   ;; a group.  Indeed, it makes sense to have a tag appear in
   4279 	   ;; multiple groups.
   4280 	   (when (or group-flag (not (assoc tag alist2)))
   4281 	     (push tag-pair to-add)))
   4282 	  (_ (error "Invalid association in tag alist: %S" tag-pair))))
   4283       ;; Preserve order of ALIST1.
   4284       (append (nreverse to-add) alist2)))))
   4285 
   4286 (defun org-priority-to-value (s)
   4287   "Convert priority string S to its numeric value."
   4288   (or (save-match-data
   4289 	(and (string-match "\\([0-9]+\\)" s)
   4290 	     (string-to-number (match-string 1 s))))
   4291       (string-to-char s)))
   4292 
   4293 (defun org-set-regexps-and-options (&optional tags-only)
   4294   "Precompute regular expressions used in the current buffer.
   4295 When optional argument TAGS-ONLY is non-nil, only compute tags
   4296 related expressions."
   4297   (when (derived-mode-p 'org-mode)
   4298     (let ((alist (org-collect-keywords
   4299 		  (append '("FILETAGS" "TAGS")
   4300 			  (and (not tags-only)
   4301 			       '("ARCHIVE" "CATEGORY" "COLUMNS" "CONSTANTS"
   4302 				 "LINK" "OPTIONS" "PRIORITIES" "PROPERTY"
   4303 				 "SEQ_TODO" "STARTUP" "TODO" "TYP_TODO")))
   4304 		  '("ARCHIVE" "CATEGORY" "COLUMNS" "PRIORITIES"))))
   4305       ;; Startup options.  Get this early since it does change
   4306       ;; behavior for other options (e.g., tags).
   4307       (let ((startup (cl-mapcan (lambda (value) (split-string value))
   4308 				(cdr (assoc "STARTUP" alist)))))
   4309 	(dolist (option startup)
   4310 	  (pcase (assoc-string option org-startup-options t)
   4311 	    (`(,_ ,variable ,value t)
   4312 	     (unless (listp (symbol-value variable))
   4313 	       (set (make-local-variable variable) nil))
   4314 	     (add-to-list variable value))
   4315 	    (`(,_ ,variable ,value . ,_)
   4316 	     (set (make-local-variable variable) value))
   4317 	    (_ nil))))
   4318       (setq-local org-file-tags
   4319 		  (mapcar #'org-add-prop-inherited
   4320 			  (cl-mapcan (lambda (value)
   4321 				       (cl-mapcan
   4322 					(lambda (k) (org-split-string k ":"))
   4323 					(split-string value)))
   4324 				     (cdr (assoc "FILETAGS" alist)))))
   4325       (setq org-current-tag-alist
   4326 	    (org--tag-add-to-alist
   4327 	     org-tag-persistent-alist
   4328 	     (let ((tags (cdr (assoc "TAGS" alist))))
   4329 	       (if tags
   4330 		   (org-tag-string-to-alist
   4331 		    (mapconcat #'identity tags "\n"))
   4332 		 org-tag-alist))))
   4333       (setq org-tag-groups-alist
   4334 	    (org-tag-alist-to-groups org-current-tag-alist))
   4335       (unless tags-only
   4336 	;; Properties.
   4337 	(let ((properties nil))
   4338 	  (dolist (value (cdr (assoc "PROPERTY" alist)))
   4339 	    (when (string-match "\\(\\S-+\\)[ \t]+\\(.*\\)" value)
   4340 	      (setq properties (org--update-property-plist
   4341 				(match-string-no-properties 1 value)
   4342 				(match-string-no-properties 2 value)
   4343 				properties))))
   4344 	  (setq-local org-keyword-properties properties))
   4345 	;; Archive location.
   4346 	(let ((archive (cdr (assoc "ARCHIVE" alist))))
   4347 	  (when archive (setq-local org-archive-location archive)))
   4348 	;; Category.
   4349 	(let ((category (cdr (assoc "CATEGORY" alist))))
   4350 	  (when category
   4351 	    (setq-local org-category (intern category))
   4352 	    (setq-local org-keyword-properties
   4353 			(org--update-property-plist
   4354 			 "CATEGORY" category org-keyword-properties))))
   4355 	;; Columns.
   4356 	(let ((column (cdr (assoc "COLUMNS" alist))))
   4357 	  (when column (setq-local org-columns-default-format column)))
   4358 	;; Constants.
   4359 	(let ((store nil))
   4360 	  (dolist (pair (cl-mapcan #'split-string
   4361 				   (cdr (assoc "CONSTANTS" alist))))
   4362 	    (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" pair)
   4363 	      (let* ((name (match-string 1 pair))
   4364 		     (value (match-string 2 pair))
   4365 		     (old (assoc name store)))
   4366 		(if old (setcdr old value)
   4367 		  (push (cons name value) store)))))
   4368 	  (setq org-table-formula-constants-local store))
   4369 	;; Link abbreviations.
   4370 	(let ((links
   4371 	       (delq nil
   4372 		     (mapcar
   4373 		      (lambda (value)
   4374 			(and (string-match "\\`\\(\\S-+\\)[ \t]+\\(.+\\)" value)
   4375 			     (cons (match-string-no-properties 1 value)
   4376 				   (match-string-no-properties 2 value))))
   4377 		      (cdr (assoc "LINK" alist))))))
   4378 	  (when links (setq org-link-abbrev-alist-local (nreverse links))))
   4379 	;; Priorities.
   4380 	(let ((value (cdr (assoc "PRIORITIES" alist))))
   4381 	  (pcase (and value (split-string value))
   4382 	    (`(,high ,low ,default . ,_)
   4383 	     (setq-local org-priority-highest (org-priority-to-value high))
   4384 	     (setq-local org-priority-lowest (org-priority-to-value low))
   4385 	     (setq-local org-priority-default (org-priority-to-value default)))))
   4386 	;; Scripts.
   4387 	(let ((value (cdr (assoc "OPTIONS" alist))))
   4388 	  (dolist (option value)
   4389 	    (when (string-match "\\^:\\(t\\|nil\\|{}\\)" option)
   4390 	      (setq-local org-use-sub-superscripts
   4391 			  (read (match-string 1 option))))))
   4392 	;; TODO keywords.
   4393 	(setq-local org-todo-kwd-alist nil)
   4394 	(setq-local org-todo-key-alist nil)
   4395 	(setq-local org-todo-key-trigger nil)
   4396 	(setq-local org-todo-keywords-1 nil)
   4397 	(setq-local org-done-keywords nil)
   4398 	(setq-local org-todo-heads nil)
   4399 	(setq-local org-todo-sets nil)
   4400 	(setq-local org-todo-log-states nil)
   4401 	(let ((todo-sequences
   4402 	       (or (append (mapcar (lambda (value)
   4403 				     (cons 'type (split-string value)))
   4404 				   (cdr (assoc "TYP_TODO" alist)))
   4405 			   (mapcar (lambda (value)
   4406 				     (cons 'sequence (split-string value)))
   4407 				   (append (cdr (assoc "TODO" alist))
   4408 					   (cdr (assoc "SEQ_TODO" alist)))))
   4409 		   (let ((d (default-value 'org-todo-keywords)))
   4410 		     (if (not (stringp (car d))) d
   4411 		       ;; XXX: Backward compatibility code.
   4412 		       (list (cons org-todo-interpretation d)))))))
   4413 	  (dolist (sequence todo-sequences)
   4414 	    (let* ((sequence (or (run-hook-with-args-until-success
   4415 				  'org-todo-setup-filter-hook sequence)
   4416 				 sequence))
   4417 		   (sequence-type (car sequence))
   4418 		   (keywords (cdr sequence))
   4419 		   (sep (member "|" keywords))
   4420 		   names alist)
   4421 	      (dolist (k (remove "|" keywords))
   4422 		(unless (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$"
   4423 				      k)
   4424 		  (error "Invalid TODO keyword %s" k))
   4425 		(let ((name (match-string 1 k))
   4426 		      (key (match-string 2 k))
   4427 		      (log (org-extract-log-state-settings k)))
   4428 		  (push name names)
   4429 		  (push (cons name (and key (string-to-char key))) alist)
   4430 		  (when log (push log org-todo-log-states))))
   4431 	      (let* ((names (nreverse names))
   4432 		     (done (if sep (org-remove-keyword-keys (cdr sep))
   4433 			     (last names)))
   4434 		     (head (car names))
   4435 		     (tail (list sequence-type head (car done) (org-last done))))
   4436 		(add-to-list 'org-todo-heads head 'append)
   4437 		(push names org-todo-sets)
   4438 		(setq org-done-keywords (append org-done-keywords done nil))
   4439 		(setq org-todo-keywords-1 (append org-todo-keywords-1 names nil))
   4440 		(setq org-todo-key-alist
   4441 		      (append org-todo-key-alist
   4442 			      (and alist
   4443 				   (append '((:startgroup))
   4444 					   (nreverse alist)
   4445 					   '((:endgroup))))))
   4446 		(dolist (k names) (push (cons k tail) org-todo-kwd-alist))))))
   4447 	(setq org-todo-sets (nreverse org-todo-sets)
   4448 	      org-todo-kwd-alist (nreverse org-todo-kwd-alist)
   4449 	      org-todo-key-trigger (delq nil (mapcar #'cdr org-todo-key-alist))
   4450 	      org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))
   4451 	;; Compute the regular expressions and other local variables.
   4452 	;; Using `org-outline-regexp-bol' would complicate them much,
   4453 	;; because of the fixed white space at the end of that string.
   4454 	(unless org-done-keywords
   4455 	  (setq org-done-keywords
   4456 		(and org-todo-keywords-1 (last org-todo-keywords-1))))
   4457 	(setq org-not-done-keywords
   4458 	      (org-delete-all org-done-keywords
   4459 			      (copy-sequence org-todo-keywords-1))
   4460 	      org-todo-regexp (regexp-opt org-todo-keywords-1 t)
   4461 	      org-not-done-regexp (regexp-opt org-not-done-keywords t)
   4462 	      org-not-done-heading-regexp
   4463 	      (format org-heading-keyword-regexp-format org-not-done-regexp)
   4464 	      org-todo-line-regexp
   4465 	      (format org-heading-keyword-maybe-regexp-format org-todo-regexp)
   4466 	      org-complex-heading-regexp
   4467 	      (concat "^\\(\\*+\\)"
   4468 		      "\\(?: +" org-todo-regexp "\\)?"
   4469 		      "\\(?: +\\(\\[#.\\]\\)\\)?"
   4470 		      "\\(?: +\\(.*?\\)\\)??"
   4471 		      "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?"
   4472 		      "[ \t]*$")
   4473 	      org-complex-heading-regexp-format
   4474 	      (concat "^\\(\\*+\\)"
   4475 		      "\\(?: +" org-todo-regexp "\\)?"
   4476 		      "\\(?: +\\(\\[#.\\]\\)\\)?"
   4477 		      "\\(?: +"
   4478 		      ;; Stats cookies can be stuck to body.
   4479 		      "\\(?:\\[[0-9%%/]+\\] *\\)*"
   4480 		      "\\(%s\\)"
   4481 		      "\\(?: *\\[[0-9%%/]+\\]\\)*"
   4482 		      "\\)"
   4483 		      "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?"
   4484 		      "[ \t]*$")
   4485 	      org-todo-line-tags-regexp
   4486 	      (concat "^\\(\\*+\\)"
   4487 		      "\\(?: +" org-todo-regexp "\\)?"
   4488 		      "\\(?: +\\(.*?\\)\\)??"
   4489 		      "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?"
   4490 		      "[ \t]*$"))
   4491 	(org-compute-latex-and-related-regexp)))))
   4492 
   4493 (defun org-collect-keywords (keywords &optional unique directory)
   4494   "Return values for KEYWORDS in current buffer, as an alist.
   4495 
   4496 KEYWORDS is a list of strings.  Return value is a list of
   4497 elements with the pattern:
   4498 
   4499   (NAME . LIST-OF-VALUES)
   4500 
   4501 where NAME is the upcase name of the keyword, and LIST-OF-VALUES
   4502 is a list of non-empty values, as strings, in order of appearance
   4503 in the buffer.
   4504 
   4505 When KEYWORD appears in UNIQUE list, LIST-OF-VALUE is its first
   4506 value, empty or not, appearing in the buffer, as a string.
   4507 
   4508 When KEYWORD appears in DIRECTORIES, each value is a cons cell:
   4509 
   4510   (VALUE . DIRECTORY)
   4511 
   4512 where VALUE is the regular value, and DIRECTORY is the variable
   4513 `default-directory' for the buffer containing the keyword.  This
   4514 is important for values containing relative file names, since the
   4515 function follows SETUPFILE keywords, and may change its working
   4516 directory."
   4517   (let* ((keywords (cons "SETUPFILE" (mapcar #'upcase keywords)))
   4518 	 (unique (mapcar #'upcase unique))
   4519 	 (alist (org--collect-keywords-1
   4520 		 keywords unique directory
   4521 		 (and buffer-file-name (list buffer-file-name))
   4522 		 nil)))
   4523     ;; Re-order results.
   4524     (dolist (entry alist)
   4525       (pcase entry
   4526 	(`(,_ . ,(and value (pred consp)))
   4527 	 (setcdr entry (nreverse value)))))
   4528     (nreverse alist)))
   4529 
   4530 (defun org--collect-keywords-1 (keywords unique directory files alist)
   4531   (org-with-point-at 1
   4532     (let ((case-fold-search t)
   4533 	  (regexp (org-make-options-regexp keywords)))
   4534       (while (and keywords (re-search-forward regexp nil t))
   4535         (let ((element (org-element-at-point)))
   4536           (when (eq 'keyword (org-element-type element))
   4537             (let ((value (org-element-property :value element)))
   4538               (pcase (org-element-property :key element)
   4539 		("SETUPFILE"
   4540 		 (when (and (org-string-nw-p value)
   4541 			    (not buffer-read-only)) ;FIXME: bug in Gnus?
   4542 		   (let* ((uri (org-strip-quotes value))
   4543 			  (uri-is-url (org-url-p uri))
   4544 			  (uri (if uri-is-url
   4545 				   uri
   4546 				 (expand-file-name uri))))
   4547 		     (unless (member uri files)
   4548 		       (with-temp-buffer
   4549 			 (unless uri-is-url
   4550 			   (setq default-directory (file-name-directory uri)))
   4551 			 (let ((contents (org-file-contents uri :noerror)))
   4552 			   (when contents
   4553 			     (insert contents)
   4554 			     ;; Fake Org mode: `org-element-at-point'
   4555 			     ;; doesn't need full set-up.
   4556 			     (let ((major-mode 'org-mode))
   4557 			       (setq alist
   4558 				     (org--collect-keywords-1
   4559 				      keywords unique directory
   4560 				      (cons uri files)
   4561 				      alist))))))))))
   4562 		(keyword
   4563 		 (let ((entry (assoc keyword alist))
   4564 		       (final
   4565 			(cond ((not (member keyword directory)) value)
   4566 			      (buffer-file-name
   4567 			       (cons value
   4568 				     (file-name-directory buffer-file-name)))
   4569 			      (t (cons value default-directory)))))
   4570 		   (cond ((member keyword unique)
   4571 			  (push (cons keyword final) alist)
   4572 			  (setq keywords (remove keyword keywords))
   4573 			  (setq regexp (org-make-options-regexp keywords)))
   4574 			 ((null entry) (push (list keyword final) alist))
   4575 			 (t (push final (cdr entry)))))))))))
   4576       alist)))
   4577 
   4578 (defun org-tag-string-to-alist (s)
   4579   "Return tag alist associated to string S.
   4580 S is a value for TAGS keyword or produced with
   4581 `org-tag-alist-to-string'.  Return value is an alist suitable for
   4582 `org-tag-alist' or `org-tag-persistent-alist'."
   4583   (let ((lines (mapcar #'split-string (split-string s "\n" t)))
   4584 	(tag-re (concat "\\`\\(" org-tag-re "\\|{.+?}\\)" ; regular expression
   4585 			"\\(?:(\\(.\\))\\)?\\'"))
   4586 	alist group-flag)
   4587     (dolist (tokens lines (cdr (nreverse alist)))
   4588       (push '(:newline) alist)
   4589       (while tokens
   4590 	(let ((token (pop tokens)))
   4591 	  (pcase token
   4592 	    ("{"
   4593 	     (push '(:startgroup) alist)
   4594 	     (when (equal (nth 1 tokens) ":") (setq group-flag t)))
   4595 	    ("}"
   4596 	     (push '(:endgroup) alist)
   4597 	     (setq group-flag nil))
   4598 	    ("["
   4599 	     (push '(:startgrouptag) alist)
   4600 	     (when (equal (nth 1 tokens) ":") (setq group-flag t)))
   4601 	    ("]"
   4602 	     (push '(:endgrouptag) alist)
   4603 	     (setq group-flag nil))
   4604 	    (":"
   4605 	     (push '(:grouptags) alist))
   4606 	    ((guard (string-match tag-re token))
   4607 	     (let ((tag (match-string 1 token))
   4608 		   (key (and (match-beginning 2)
   4609 			     (string-to-char (match-string 2 token)))))
   4610 	       ;; Push all tags in groups, no matter if they already
   4611 	       ;; appear somewhere else in the list.
   4612 	       (when (or group-flag (not (assoc tag alist)))
   4613 		 (push (cons tag key) alist))))))))))
   4614 
   4615 (defun org-tag-alist-to-string (alist &optional skip-key)
   4616   "Return tag string associated to ALIST.
   4617 
   4618 ALIST is an alist, as defined in `org-tag-alist' or
   4619 `org-tag-persistent-alist', or produced with
   4620 `org-tag-string-to-alist'.
   4621 
   4622 Return value is a string suitable as a value for \"TAGS\"
   4623 keyword.
   4624 
   4625 When optional argument SKIP-KEY is non-nil, skip selection keys
   4626 next to tags."
   4627   (mapconcat (lambda (token)
   4628 	       (pcase token
   4629 		 (`(:startgroup) "{")
   4630 		 (`(:endgroup) "}")
   4631 		 (`(:startgrouptag) "[")
   4632 		 (`(:endgrouptag) "]")
   4633 		 (`(:grouptags) ":")
   4634 		 (`(:newline) "\\n")
   4635 		 ((and
   4636 		   (guard (not skip-key))
   4637 		   `(,(and tag (pred stringp)) . ,(and key (pred characterp))))
   4638 		  (format "%s(%c)" tag key))
   4639 		 (`(,(and tag (pred stringp)) . ,_) tag)
   4640 		 (_ (user-error "Invalid tag token: %S" token))))
   4641 	     alist
   4642 	     " "))
   4643 
   4644 (defun org-tag-alist-to-groups (alist)
   4645   "Return group alist from tag ALIST.
   4646 ALIST is an alist, as defined in `org-tag-alist' or
   4647 `org-tag-persistent-alist', or produced with
   4648 `org-tag-string-to-alist'.  Return value is an alist following
   4649 the pattern (GROUP-TAG TAGS) where GROUP-TAG is the tag, as
   4650 a string, summarizing TAGS, as a list of strings."
   4651   (let (groups group-status current-group)
   4652     (dolist (token alist (nreverse groups))
   4653       (pcase token
   4654 	(`(,(or :startgroup :startgrouptag)) (setq group-status t))
   4655 	(`(,(or :endgroup :endgrouptag))
   4656 	 (when (eq group-status 'append)
   4657 	   (push (nreverse current-group) groups))
   4658 	 (setq group-status nil current-group nil))
   4659 	(`(:grouptags) (setq group-status 'append))
   4660 	((and `(,tag . ,_) (guard group-status))
   4661 	 (if (eq group-status 'append) (push tag current-group)
   4662 	   (setq current-group (list tag))))
   4663 	(_ nil)))))
   4664 
   4665 (defvar org--file-cache (make-hash-table :test #'equal)
   4666   "Hash table to store contents of files referenced via a URL.
   4667 This is the cache of file URLs read using `org-file-contents'.")
   4668 
   4669 (defun org-reset-file-cache ()
   4670   "Reset the cache of files downloaded by `org-file-contents'."
   4671   (clrhash org--file-cache))
   4672 
   4673 (defun org-file-contents (file &optional noerror nocache)
   4674   "Return the contents of FILE, as a string.
   4675 
   4676 FILE can be a file name or URL.
   4677 
   4678 If FILE is a URL, download the contents.  If the URL contents are
   4679 already cached in the `org--file-cache' hash table, the download step
   4680 is skipped.
   4681 
   4682 If NOERROR is non-nil, ignore the error when unable to read the FILE
   4683 from file or URL, and return nil.
   4684 
   4685 If NOCACHE is non-nil, do a fresh fetch of FILE even if cached version
   4686 is available.  This option applies only if FILE is a URL."
   4687   (let* ((is-url (org-url-p file))
   4688          (cache (and is-url
   4689                      (not nocache)
   4690                      (gethash file org--file-cache))))
   4691     (cond
   4692      (cache)
   4693      (is-url
   4694       (with-current-buffer (url-retrieve-synchronously file)
   4695 	(goto-char (point-min))
   4696 	;; Move point to after the url-retrieve header.
   4697 	(search-forward "\n\n" nil :move)
   4698 	;; Search for the success code only in the url-retrieve header.
   4699 	(if (save-excursion
   4700 	      (re-search-backward "HTTP.*\\s-+200\\s-OK" nil :noerror))
   4701 	    ;; Update the cache `org--file-cache' and return contents.
   4702 	    (puthash file
   4703 		     (buffer-substring-no-properties (point) (point-max))
   4704 		     org--file-cache)
   4705 	  (funcall (if noerror #'message #'user-error)
   4706 		   "Unable to fetch file from %S"
   4707 		   file)
   4708 	  nil)))
   4709      (t
   4710       (with-temp-buffer
   4711         (condition-case nil
   4712 	    (progn
   4713 	      (insert-file-contents file)
   4714 	      (buffer-string))
   4715 	  (file-error
   4716            (funcall (if noerror #'message #'user-error)
   4717 		    "Unable to read file %S"
   4718 		    file)
   4719 	   nil)))))))
   4720 
   4721 (defun org-extract-log-state-settings (x)
   4722   "Extract the log state setting from a TODO keyword string.
   4723 This will extract info from a string like \"WAIT(w@/!)\"."
   4724   (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x)
   4725     (let ((kw (match-string 1 x))
   4726 	  (log1 (and (match-end 3) (match-string 3 x)))
   4727 	  (log2 (and (match-end 4) (match-string 4 x))))
   4728       (and (or log1 log2)
   4729 	   (list kw
   4730 		 (and log1 (if (equal log1 "!") 'time 'note))
   4731 		 (and log2 (if (equal log2 "!") 'time 'note)))))))
   4732 
   4733 (defun org-remove-keyword-keys (list)
   4734   "Remove a pair of parenthesis at the end of each string in LIST."
   4735   (mapcar (lambda (x)
   4736 	    (if (string-match "(.*)$" x)
   4737 		(substring x 0 (match-beginning 0))
   4738 	      x))
   4739 	  list))
   4740 
   4741 (defun org-assign-fast-keys (alist)
   4742   "Assign fast keys to a keyword-key alist.
   4743 Respect keys that are already there."
   4744   (let (new e (alt ?0))
   4745     (while (setq e (pop alist))
   4746       (if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup))
   4747 	      (cdr e)) ;; Key already assigned.
   4748 	  (push e new)
   4749 	(let ((clist (string-to-list (downcase (car e))))
   4750 	      (used (append new alist)))
   4751 	  (when (= (car clist) ?@)
   4752 	    (pop clist))
   4753 	  (while (and clist (rassoc (car clist) used))
   4754 	    (pop clist))
   4755 	  (unless clist
   4756 	    (while (rassoc alt used)
   4757 	      (cl-incf alt)))
   4758 	  (push (cons (car e) (or (car clist) alt)) new))))
   4759     (nreverse new)))
   4760 
   4761 ;;; Some variables used in various places
   4762 
   4763 (defvar org-window-configuration nil
   4764   "Used in various places to store a window configuration.")
   4765 (defvar org-selected-window nil
   4766   "Used in various places to store a window configuration.")
   4767 (defvar org-finish-function nil
   4768   "Function to be called when `C-c C-c' is used.
   4769 This is for getting out of special buffers like capture.")
   4770 (defvar org-last-state)
   4771 
   4772 ;; Defined somewhere in this file, but used before definition.
   4773 (defvar org-entities)     ;; defined in org-entities.el
   4774 (defvar org-struct-menu)
   4775 (defvar org-org-menu)
   4776 (defvar org-tbl-menu)
   4777 
   4778 ;;;; Define the Org mode
   4779 
   4780 (defun org-before-change-function (_beg _end)
   4781   "Every change indicates that a table might need an update."
   4782   (setq org-table-may-need-update t))
   4783 (defvar org-mode-map)
   4784 (defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param.
   4785 (defvar org-agenda-keep-modes nil)      ; Dynamically-scoped param.
   4786 (defvar org-inhibit-logging nil)        ; Dynamically-scoped param.
   4787 (defvar org-inhibit-blocking nil)       ; Dynamically-scoped param.
   4788 
   4789 (defvar bidi-paragraph-direction)
   4790 (defvar buffer-face-mode-face)
   4791 
   4792 (require 'outline)
   4793 
   4794 ;; Other stuff we need.
   4795 (require 'time-date)
   4796 (unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time))
   4797 (when (< emacs-major-version 28)  ; preloaded in Emacs 28
   4798   (require 'easymenu))
   4799 
   4800 (require 'org-entities)
   4801 (require 'org-faces)
   4802 (require 'org-list)
   4803 (require 'org-pcomplete)
   4804 (require 'org-src)
   4805 (require 'org-footnote)
   4806 (require 'org-macro)
   4807 
   4808 ;; babel
   4809 (require 'ob)
   4810 
   4811 ;;;###autoload
   4812 (define-derived-mode org-mode outline-mode "Org"
   4813   "Outline-based notes management and organizer, alias
   4814 \"Carsten's outline-mode for keeping track of everything.\"
   4815 
   4816 Org mode develops organizational tasks around a NOTES file which
   4817 contains information about projects as plain text.  Org mode is
   4818 implemented on top of Outline mode, which is ideal to keep the content
   4819 of large files well structured.  It supports ToDo items, deadlines and
   4820 time stamps, which magically appear in the diary listing of the Emacs
   4821 calendar.  Tables are easily created with a built-in table editor.
   4822 Plain text URL-like links connect to websites, emails (VM), Usenet
   4823 messages (Gnus), BBDB entries, and any files related to the project.
   4824 For printing and sharing of notes, an Org file (or a part of it)
   4825 can be exported as a structured ASCII or HTML file.
   4826 
   4827 The following commands are available:
   4828 
   4829 \\{org-mode-map}"
   4830   (org-load-modules-maybe)
   4831   (org-install-agenda-files-menu)
   4832   (when org-link-descriptive (add-to-invisibility-spec '(org-link)))
   4833   (make-local-variable 'org-link-descriptive)
   4834   (add-to-invisibility-spec '(org-hide-block . t))
   4835   (setq-local outline-regexp org-outline-regexp)
   4836   (setq-local outline-level 'org-outline-level)
   4837   (setq bidi-paragraph-direction 'left-to-right)
   4838   (when (and (stringp org-ellipsis) (not (equal "" org-ellipsis)))
   4839     (unless org-display-table
   4840       (setq org-display-table (make-display-table)))
   4841     (set-display-table-slot
   4842      org-display-table 4
   4843      (vconcat (mapcar (lambda (c) (make-glyph-code c 'org-ellipsis))
   4844 		      org-ellipsis)))
   4845     (setq buffer-display-table org-display-table))
   4846   (org-set-regexps-and-options)
   4847   (org-set-font-lock-defaults)
   4848   (when (and org-tag-faces (not org-tags-special-faces-re))
   4849     ;; tag faces set outside customize.... force initialization.
   4850     (org-set-tag-faces 'org-tag-faces org-tag-faces))
   4851   ;; Calc embedded
   4852   (setq-local calc-embedded-open-mode "# ")
   4853   ;; Modify a few syntax entries
   4854   (modify-syntax-entry ?\" "\"")
   4855   (modify-syntax-entry ?\\ "_")
   4856   (modify-syntax-entry ?~ "_")
   4857   (modify-syntax-entry ?< "(>")
   4858   (modify-syntax-entry ?> ")<")
   4859   (setq-local font-lock-unfontify-region-function 'org-unfontify-region)
   4860   ;; Activate before-change-function
   4861   (setq-local org-table-may-need-update t)
   4862   (add-hook 'before-change-functions 'org-before-change-function nil 'local)
   4863   ;; Check for running clock before killing a buffer
   4864   (add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
   4865   ;; Initialize macros templates.
   4866   (org-macro-initialize-templates)
   4867   ;; Initialize radio targets.
   4868   (org-update-radio-target-regexp)
   4869   ;; Indentation.
   4870   (setq-local indent-line-function 'org-indent-line)
   4871   (setq-local indent-region-function 'org-indent-region)
   4872   ;; Filling and auto-filling.
   4873   (org-setup-filling)
   4874   ;; Comments.
   4875   (org-setup-comments-handling)
   4876   ;; Initialize cache.
   4877   (org-element-cache-reset)
   4878   ;; Beginning/end of defun
   4879   (setq-local beginning-of-defun-function 'org-backward-element)
   4880   (setq-local end-of-defun-function
   4881 	      (lambda ()
   4882 		(if (not (org-at-heading-p))
   4883 		    (org-forward-element)
   4884 		  (org-forward-element)
   4885 		  (forward-char -1))))
   4886   ;; Next error for sparse trees
   4887   (setq-local next-error-function 'org-occur-next-match)
   4888   ;; Make commit log messages from Org documents easier.
   4889   (setq-local add-log-current-defun-function #'org-add-log-current-headline)
   4890   ;; Make sure dependence stuff works reliably, even for users who set it
   4891   ;; too late :-(
   4892   (if org-enforce-todo-dependencies
   4893       (add-hook 'org-blocker-hook
   4894 		'org-block-todo-from-children-or-siblings-or-parent)
   4895     (remove-hook 'org-blocker-hook
   4896 		 'org-block-todo-from-children-or-siblings-or-parent))
   4897   (if org-enforce-todo-checkbox-dependencies
   4898       (add-hook 'org-blocker-hook
   4899 		'org-block-todo-from-checkboxes)
   4900     (remove-hook 'org-blocker-hook
   4901 		 'org-block-todo-from-checkboxes))
   4902 
   4903   ;; Align options lines
   4904   (setq-local
   4905    align-mode-rules-list
   4906    '((org-in-buffer-settings
   4907       (regexp . "^[ \t]*#\\+[A-Z_]+:\\(\\s-*\\)\\S-+")
   4908       (modes . '(org-mode)))))
   4909 
   4910   ;; Setup the pcomplete hooks
   4911   (setq-local pcomplete-command-completion-function #'org-pcomplete-initial)
   4912   (setq-local pcomplete-command-name-function #'org-command-at-point)
   4913   (setq-local pcomplete-default-completion-function #'ignore)
   4914   (setq-local pcomplete-parse-arguments-function #'org-parse-arguments)
   4915   (setq-local pcomplete-termination-string "")
   4916   (add-hook 'completion-at-point-functions
   4917             #'pcomplete-completions-at-point nil t)
   4918   (setq-local buffer-face-mode-face 'org-default)
   4919 
   4920   ;; If empty file that did not turn on Org mode automatically, make
   4921   ;; it to.
   4922   (when (and org-insert-mode-line-in-empty-file
   4923 	     (called-interactively-p 'any)
   4924 	     (= (point-min) (point-max)))
   4925     (insert "#    -*- mode: org -*-\n\n"))
   4926   (unless org-inhibit-startup
   4927     (org-unmodified
   4928      (when org-startup-with-beamer-mode (org-beamer-mode))
   4929      (when (or org-startup-align-all-tables org-startup-shrink-all-tables)
   4930        (org-table-map-tables
   4931 	(cond ((and org-startup-align-all-tables
   4932 		    org-startup-shrink-all-tables)
   4933 	       (lambda () (org-table-align) (org-table-shrink)))
   4934 	      (org-startup-align-all-tables #'org-table-align)
   4935 	      (t #'org-table-shrink))
   4936 	t))
   4937      (when org-startup-with-inline-images (org-display-inline-images))
   4938      (when org-startup-with-latex-preview (org-latex-preview '(16)))
   4939      (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility))
   4940      (when org-startup-truncated (setq truncate-lines t))
   4941      (when org-startup-numerated (require 'org-num) (org-num-mode 1))
   4942      (when org-startup-indented (require 'org-indent) (org-indent-mode 1))))
   4943 
   4944   ;; Add a custom keymap for `visual-line-mode' so that activating
   4945   ;; this minor mode does not override Org's keybindings.
   4946   ;; FIXME: Probably `visual-line-mode' should take care of this.
   4947   (let ((oldmap (cdr (assoc 'visual-line-mode minor-mode-map-alist)))
   4948         (newmap (make-sparse-keymap)))
   4949     (set-keymap-parent newmap oldmap)
   4950     (define-key newmap [remap move-beginning-of-line] nil)
   4951     (define-key newmap [remap move-end-of-line] nil)
   4952     (define-key newmap [remap kill-line] nil)
   4953     (make-local-variable 'minor-mode-overriding-map-alist)
   4954     (push `(visual-line-mode . ,newmap) minor-mode-overriding-map-alist))
   4955 
   4956   ;; Activate `org-table-header-line-mode'
   4957   (when org-table-header-line-p
   4958     (org-table-header-line-mode 1))
   4959   ;; Try to set `org-hide' face correctly.
   4960   (let ((foreground (org-find-invisible-foreground)))
   4961     (when foreground
   4962       (set-face-foreground 'org-hide foreground)))
   4963   ;; Set face extension as requested.
   4964   (org--set-faces-extend '(org-block-begin-line org-block-end-line)
   4965                          org-fontify-whole-block-delimiter-line)
   4966   (org--set-faces-extend org-level-faces org-fontify-whole-heading-line))
   4967 
   4968 ;; Update `customize-package-emacs-version-alist'
   4969 (add-to-list 'customize-package-emacs-version-alist
   4970 	     '(Org ("8.0" . "24.4")
   4971 		   ("8.1" . "24.4")
   4972 		   ("8.2" . "24.4")
   4973 		   ("8.2.7" . "24.4")
   4974 		   ("8.3" . "26.1")
   4975 		   ("9.0" . "26.1")
   4976 		   ("9.1" . "26.1")
   4977 		   ("9.2" . "27.1")
   4978 		   ("9.3" . "27.1")
   4979 		   ("9.4" . "27.2")
   4980 		   ("9.5" . "28.1")))
   4981 
   4982 (defvar org-mode-transpose-word-syntax-table
   4983   (let ((st (make-syntax-table text-mode-syntax-table)))
   4984     (dolist (c org-emphasis-alist st)
   4985       (modify-syntax-entry (string-to-char (car c)) "w p" st))))
   4986 
   4987 (when (fboundp 'abbrev-table-put)
   4988   (abbrev-table-put org-mode-abbrev-table
   4989 		    :parents (list text-mode-abbrev-table)))
   4990 
   4991 (defun org-find-invisible-foreground ()
   4992   (let ((candidates (remove
   4993 		     "unspecified-bg"
   4994 		     (nconc
   4995 		      (list (face-background 'default)
   4996 			    (face-background 'org-default))
   4997 		      (mapcar
   4998 		       (lambda (alist)
   4999 			 (when (boundp alist)
   5000 			   (cdr (assq 'background-color (symbol-value alist)))))
   5001 		       '(default-frame-alist initial-frame-alist window-system-default-frame-alist))
   5002 		      (list (face-foreground 'org-hide))))))
   5003     (car (remove nil candidates))))
   5004 
   5005 (defun org-current-time (&optional rounding-minutes past)
   5006   "Current time, possibly rounded to ROUNDING-MINUTES.
   5007 When ROUNDING-MINUTES is not an integer, fall back on the car of
   5008 `org-time-stamp-rounding-minutes'.  When PAST is non-nil, ensure
   5009 the rounding returns a past time."
   5010   (let ((r (or (and (integerp rounding-minutes) rounding-minutes)
   5011 	       (car org-time-stamp-rounding-minutes)))
   5012 	(now (current-time)))
   5013     (if (< r 1)
   5014 	now
   5015       (let* ((time (decode-time now))
   5016 	     (res (apply #'encode-time 0 (* r (round (nth 1 time) r))
   5017 			 (nthcdr 2 time))))
   5018 	(if (or (not past) (org-time-less-p res now))
   5019 	    res
   5020 	  (org-time-subtract res (* r 60)))))))
   5021 
   5022 (defun org-today ()
   5023   "Return today date, considering `org-extend-today-until'."
   5024   (time-to-days
   5025    (org-time-since (* 3600 org-extend-today-until))))
   5026 
   5027 ;;;; Font-Lock stuff, including the activators
   5028 
   5029 (defconst org-match-sexp-depth 3
   5030   "Number of stacked braces for sub/superscript matching.")
   5031 
   5032 (defun org-create-multibrace-regexp (left right n)
   5033   "Create a regular expression which will match a balanced sexp.
   5034 Opening delimiter is LEFT, and closing delimiter is RIGHT, both given
   5035 as single character strings.
   5036 The regexp returned will match the entire expression including the
   5037 delimiters.  It will also define a single group which contains the
   5038 match except for the outermost delimiters.  The maximum depth of
   5039 stacked delimiters is N.  Escaping delimiters is not possible."
   5040   (let* ((nothing (concat "[^" left right "]*?"))
   5041 	 (or "\\|")
   5042 	 (re nothing)
   5043 	 (next (concat "\\(?:" nothing left nothing right "\\)+" nothing)))
   5044     (while (> n 1)
   5045       (setq n (1- n)
   5046 	    re (concat re or next)
   5047 	    next (concat "\\(?:" nothing left next right "\\)+" nothing)))
   5048     (concat left "\\(" re "\\)" right)))
   5049 
   5050 (defconst org-match-substring-regexp
   5051   (concat
   5052    "\\(\\S-\\)\\([_^]\\)\\("
   5053    "\\(?:" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
   5054    "\\|"
   5055    "\\(?:" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
   5056    "\\|"
   5057    "\\(?:\\*\\|[+-]?[[:alnum:].,\\]*[[:alnum:]]\\)\\)")
   5058   "The regular expression matching a sub- or superscript.")
   5059 
   5060 (defconst org-match-substring-with-braces-regexp
   5061   (concat
   5062    "\\(\\S-\\)\\([_^]\\)"
   5063    "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)")
   5064   "The regular expression matching a sub- or superscript, forcing braces.")
   5065 
   5066 (defvar org-emph-face nil)
   5067 
   5068 (defun org-do-emphasis-faces (limit)
   5069   "Run through the buffer and emphasize strings."
   5070   (let ((quick-re (format "\\([%s]\\|^\\)\\([~=*/_+]\\)"
   5071 			  (car org-emphasis-regexp-components))))
   5072     (catch :exit
   5073       (while (re-search-forward quick-re limit t)
   5074 	(let* ((marker (match-string 2))
   5075 	       (verbatim? (member marker '("~" "="))))
   5076 	  (when (save-excursion
   5077 		  (goto-char (match-beginning 0))
   5078 		  (and
   5079 		   ;; Do not match table hlines.
   5080 		   (not (and (equal marker "+")
   5081 			     (org-match-line
   5082 			      "[ \t]*\\(|[-+]+|?\\|\\+[-+]+\\+\\)[ \t]*$")))
   5083 		   ;; Do not match headline stars.  Do not consider
   5084 		   ;; stars of a headline as closing marker for bold
   5085 		   ;; markup either.
   5086 		   (not (and (equal marker "*")
   5087 			     (save-excursion
   5088 			       (forward-char)
   5089 			       (skip-chars-backward "*")
   5090 			       (looking-at-p org-outline-regexp-bol))))
   5091 		   ;; Match full emphasis markup regexp.
   5092 		   (looking-at (if verbatim? org-verbatim-re org-emph-re))
   5093 		   ;; Do not span over paragraph boundaries.
   5094 		   (not (string-match-p org-element-paragraph-separate
   5095 					(match-string 2)))
   5096 		   ;; Do not span over cells in table rows.
   5097 		   (not (and (save-match-data (org-match-line "[ \t]*|"))
   5098 			     (string-match-p "|" (match-string 4))))))
   5099 	    (pcase-let ((`(,_ ,face ,_) (assoc marker org-emphasis-alist))
   5100 			(m (if org-hide-emphasis-markers 4 2)))
   5101 	      (font-lock-prepend-text-property
   5102 	       (match-beginning m) (match-end m) 'face face)
   5103 	      (when verbatim?
   5104 		(org-remove-flyspell-overlays-in
   5105 		 (match-beginning 0) (match-end 0))
   5106 		(remove-text-properties (match-beginning 2) (match-end 2)
   5107 					'(display t invisible t intangible t)))
   5108 	      (add-text-properties (match-beginning 2) (match-end 2)
   5109 				   '(font-lock-multiline t org-emphasis t))
   5110 	      (when (and org-hide-emphasis-markers
   5111 			 (not (org-at-comment-p)))
   5112 		(add-text-properties (match-end 4) (match-beginning 5)
   5113 				     '(invisible t))
   5114 		(add-text-properties (match-beginning 3) (match-end 3)
   5115 				     '(invisible t)))
   5116 	      (throw :exit t))))))))
   5117 
   5118 (defun org-emphasize (&optional char)
   5119   "Insert or change an emphasis, i.e. a font like bold or italic.
   5120 If there is an active region, change that region to a new emphasis.
   5121 If there is no region, just insert the marker characters and position
   5122 the cursor between them.
   5123 CHAR should be the marker character.  If it is a space, it means to
   5124 remove the emphasis of the selected region.
   5125 If CHAR is not given (for example in an interactive call) it will be
   5126 prompted for."
   5127   (interactive)
   5128   (let ((erc org-emphasis-regexp-components)
   5129 	(string "") beg end move s)
   5130     (if (org-region-active-p)
   5131 	(setq beg (region-beginning)
   5132 	      end (region-end)
   5133 	      string (buffer-substring beg end))
   5134       (setq move t))
   5135 
   5136     (unless char
   5137       (message "Emphasis marker or tag: [%s]"
   5138 	       (mapconcat #'car org-emphasis-alist ""))
   5139       (setq char (read-char-exclusive)))
   5140     (if (equal char ?\s)
   5141 	(setq s ""
   5142 	      move nil)
   5143       (unless (assoc (char-to-string char) org-emphasis-alist)
   5144 	(user-error "No such emphasis marker: \"%c\"" char))
   5145       (setq s (char-to-string char)))
   5146     (while (and (> (length string) 1)
   5147 		(equal (substring string 0 1) (substring string -1))
   5148 		(assoc (substring string 0 1) org-emphasis-alist))
   5149       (setq string (substring string 1 -1)))
   5150     (setq string (concat s string s))
   5151     (when beg (delete-region beg end))
   5152     (unless (or (bolp)
   5153 		(string-match (concat "[" (nth 0 erc) "\n]")
   5154 			      (char-to-string (char-before (point)))))
   5155       (insert " "))
   5156     (unless (or (eobp)
   5157 		(string-match (concat "[" (nth 1 erc) "\n]")
   5158 			      (char-to-string (char-after (point)))))
   5159       (insert " ") (backward-char 1))
   5160     (insert string)
   5161     (and move (backward-char 1))))
   5162 
   5163 (defconst org-nonsticky-props
   5164   '(mouse-face highlight keymap invisible intangible help-echo org-linked-text htmlize-link))
   5165 
   5166 (defsubst org-rear-nonsticky-at (pos)
   5167   (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props)))
   5168 
   5169 (defun org-activate-links (limit)
   5170   "Add link properties to links.
   5171 This includes angle, plain, and bracket links."
   5172   (catch :exit
   5173     (while (re-search-forward org-link-any-re limit t)
   5174       (let* ((start (match-beginning 0))
   5175 	     (end (match-end 0))
   5176 	     (visible-start (or (match-beginning 3) (match-beginning 2)))
   5177 	     (visible-end (or (match-end 3) (match-end 2)))
   5178 	     (style (cond ((eq ?< (char-after start)) 'angle)
   5179 			  ((eq ?\[ (char-after (1+ start))) 'bracket)
   5180 			  (t 'plain))))
   5181 	(when (and (memq style org-highlight-links)
   5182 		   ;; Do not span over paragraph boundaries.
   5183 		   (not (string-match-p org-element-paragraph-separate
   5184 					(match-string 0)))
   5185 		   ;; Do not confuse plain links with tags.
   5186 		   (not (and (eq style 'plain)
   5187 			     (let ((face (get-text-property
   5188 					  (max (1- start) (point-min)) 'face)))
   5189 			       (if (consp face) (memq 'org-tag face)
   5190 				 (eq 'org-tag face))))))
   5191 	  (let* ((link-object (save-excursion
   5192 				(goto-char start)
   5193 				(save-match-data (org-element-link-parser))))
   5194 		 (link (org-element-property :raw-link link-object))
   5195 		 (type (org-element-property :type link-object))
   5196 		 (path (org-element-property :path link-object))
   5197                  (face-property (pcase (org-link-get-parameter type :face)
   5198 				  ((and (pred functionp) face) (funcall face path))
   5199 				  ((and (pred facep) face) face)
   5200 				  ((and (pred consp) face) face) ;anonymous
   5201 				  (_ 'org-link)))
   5202 		 (properties		;for link's visible part
   5203 		  (list 'mouse-face (or (org-link-get-parameter type :mouse-face)
   5204 					'highlight)
   5205 			'keymap (or (org-link-get-parameter type :keymap)
   5206 				    org-mouse-map)
   5207 			'help-echo (pcase (org-link-get-parameter type :help-echo)
   5208 				     ((and (pred stringp) echo) echo)
   5209 				     ((and (pred functionp) echo) echo)
   5210 				     (_ (concat "LINK: " link)))
   5211 			'htmlize-link (pcase (org-link-get-parameter type
   5212 								     :htmlize-link)
   5213 					((and (pred functionp) f) (funcall f))
   5214 					(_ `(:uri ,link)))
   5215 			'font-lock-multiline t)))
   5216 	    (org-remove-flyspell-overlays-in start end)
   5217 	    (org-rear-nonsticky-at end)
   5218 	    (if (not (eq 'bracket style))
   5219 		(progn
   5220                   (add-face-text-property start end face-property)
   5221 		  (add-text-properties start end properties))
   5222 	      ;; Handle invisible parts in bracket links.
   5223 	      (remove-text-properties start end '(invisible nil))
   5224 	      (let ((hidden
   5225 		     (append `(invisible
   5226 			       ,(or (org-link-get-parameter type :display)
   5227 				    'org-link))
   5228 			     properties)))
   5229 		(add-text-properties start visible-start hidden)
   5230                 (add-face-text-property start end face-property)
   5231 		(add-text-properties visible-start visible-end properties)
   5232 		(add-text-properties visible-end end hidden)
   5233 		(org-rear-nonsticky-at visible-start)
   5234 		(org-rear-nonsticky-at visible-end)))
   5235 	    (let ((f (org-link-get-parameter type :activate-func)))
   5236 	      (when (functionp f)
   5237 		(funcall f start end path (eq style 'bracket))))
   5238 	    (throw :exit t)))))		;signal success
   5239     nil))
   5240 
   5241 (defun org-activate-code (limit)
   5242   (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
   5243     (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
   5244     (remove-text-properties (match-beginning 0) (match-end 0)
   5245 			    '(display t invisible t intangible t))
   5246     t))
   5247 
   5248 (defcustom org-src-fontify-natively t
   5249   "When non-nil, fontify code in code blocks.
   5250 See also the `org-block' face."
   5251   :type 'boolean
   5252   :version "26.1"
   5253   :package-version '(Org . "8.3")
   5254   :group 'org-appearance
   5255   :group 'org-babel)
   5256 
   5257 (defcustom org-allow-promoting-top-level-subtree nil
   5258   "When non-nil, allow promoting a top level subtree.
   5259 The leading star of the top level headline will be replaced
   5260 by a #."
   5261   :type 'boolean
   5262   :version "24.1"
   5263   :group 'org-appearance)
   5264 
   5265 (defun org-fontify-meta-lines-and-blocks (limit)
   5266   (condition-case nil
   5267       (org-fontify-meta-lines-and-blocks-1 limit)
   5268     (error (message "Org mode fontification error in %S at %d"
   5269 		    (current-buffer)
   5270 		    (line-number-at-pos)))))
   5271 
   5272 (defun org-fontify-meta-lines-and-blocks-1 (limit)
   5273   "Fontify #+ lines and blocks."
   5274   (let ((case-fold-search t))
   5275     (when (re-search-forward
   5276 	   (rx bol (group (zero-or-more (any " \t")) "#"
   5277 			  (group (group (or (seq "+" (one-or-more (any "a-zA-Z")) (optional ":"))
   5278 					    (any " \t")
   5279 					    eol))
   5280 				 (optional (group "_" (group (one-or-more (any "a-zA-Z"))))))
   5281 			  (zero-or-more (any " \t"))
   5282 			  (group (group (zero-or-more (not (any " \t\n"))))
   5283 				 (zero-or-more (any " \t"))
   5284 				 (group (zero-or-more any)))))
   5285 	   limit t)
   5286       (let ((beg (match-beginning 0))
   5287 	    (end-of-beginline (match-end 0))
   5288 	    ;; Including \n at end of #+begin line will include \n
   5289 	    ;; after the end of block content.
   5290 	    (block-start (match-end 0))
   5291 	    (block-end nil)
   5292 	    (lang (match-string 7)) ; The language, if it is a source block.
   5293 	    (bol-after-beginline (line-beginning-position 2))
   5294 	    (dc1 (downcase (match-string 2)))
   5295 	    (dc3 (downcase (match-string 3)))
   5296 	    (whole-blockline org-fontify-whole-block-delimiter-line)
   5297 	    beg-of-endline end-of-endline nl-before-endline quoting block-type)
   5298 	(cond
   5299 	 ((and (match-end 4) (equal dc3 "+begin"))
   5300 	  ;; Truly a block
   5301 	  (setq block-type (downcase (match-string 5))
   5302 		;; Src, example, export, maybe more.
   5303 		quoting (member block-type org-protecting-blocks))
   5304 	  (when (re-search-forward
   5305 		 (rx-to-string `(group bol (or (seq (one-or-more "*") space)
   5306 					       (seq (zero-or-more (any " \t"))
   5307 						    "#+end"
   5308 						    ,(match-string 4)
   5309 						    word-end
   5310 						    (zero-or-more any)))))
   5311 		 ;; We look further than LIMIT on purpose.
   5312 		 nil t)
   5313 	    ;; We do have a matching #+end line.
   5314 	    (setq beg-of-endline (match-beginning 0)
   5315 		  end-of-endline (match-end 0)
   5316 		  nl-before-endline (1- (match-beginning 0)))
   5317 	    (setq block-end (match-beginning 0)) ; Include the final newline.
   5318 	    (when quoting
   5319 	      (org-remove-flyspell-overlays-in bol-after-beginline nl-before-endline)
   5320 	      (remove-text-properties beg end-of-endline
   5321 				      '(display t invisible t intangible t)))
   5322 	    (add-text-properties
   5323 	     beg end-of-endline '(font-lock-fontified t font-lock-multiline t))
   5324 	    (org-remove-flyspell-overlays-in beg bol-after-beginline)
   5325 	    (org-remove-flyspell-overlays-in nl-before-endline end-of-endline)
   5326 	    (cond
   5327 	     ((and lang (not (string= lang "")) org-src-fontify-natively)
   5328 	      (save-match-data
   5329                 (org-src-font-lock-fontify-block lang block-start block-end))
   5330 	      (add-text-properties bol-after-beginline block-end '(src-block t)))
   5331 	     (quoting
   5332 	      (add-text-properties
   5333 	       bol-after-beginline beg-of-endline
   5334 	       (list 'face
   5335 		     (list :inherit
   5336 			   (let ((face-name
   5337 				  (intern (format "org-block-%s" lang))))
   5338 			     (append (and (facep face-name) (list face-name))
   5339 				     '(org-block)))))))
   5340 	     ((not org-fontify-quote-and-verse-blocks))
   5341 	     ((string= block-type "quote")
   5342 	      (add-face-text-property
   5343 	       bol-after-beginline beg-of-endline 'org-quote t))
   5344 	     ((string= block-type "verse")
   5345 	      (add-face-text-property
   5346 	       bol-after-beginline beg-of-endline 'org-verse t)))
   5347 	    ;; Fontify the #+begin and #+end lines of the blocks
   5348 	    (add-text-properties
   5349 	     beg (if whole-blockline bol-after-beginline end-of-beginline)
   5350 	     '(face org-block-begin-line))
   5351 	    (unless (eq (char-after beg-of-endline) ?*)
   5352 	      (add-text-properties
   5353 	       beg-of-endline
   5354 	       (if whole-blockline
   5355 		   (let ((beg-of-next-line (1+ end-of-endline)))
   5356 		     (min (point-max) beg-of-next-line))
   5357 		 (min (point-max) end-of-endline))
   5358 	       '(face org-block-end-line)))
   5359 	    t))
   5360 	 ((member dc1 '("+title:" "+subtitle:" "+author:" "+email:" "+date:"))
   5361 	  (org-remove-flyspell-overlays-in
   5362 	   (match-beginning 0)
   5363 	   (if (equal "+title:" dc1) (match-end 2) (match-end 0)))
   5364 	  (add-text-properties
   5365 	   beg (match-end 3)
   5366 	   (if (member (intern (substring dc1 1 -1)) org-hidden-keywords)
   5367 	       '(font-lock-fontified t invisible t)
   5368 	     '(font-lock-fontified t face org-document-info-keyword)))
   5369 	  (add-text-properties
   5370 	   (match-beginning 6) (min (point-max) (1+ (match-end 6)))
   5371 	   (if (string-equal dc1 "+title:")
   5372 	       '(font-lock-fontified t face org-document-title)
   5373 	     '(font-lock-fontified t face org-document-info))))
   5374 	 ((string-prefix-p "+caption" dc1)
   5375 	  (org-remove-flyspell-overlays-in (match-end 2) (match-end 0))
   5376 	  (remove-text-properties (match-beginning 0) (match-end 0)
   5377 				  '(display t invisible t intangible t))
   5378 	  ;; Handle short captions
   5379 	  (save-excursion
   5380 	    (beginning-of-line)
   5381 	    (looking-at (rx (group (zero-or-more (any " \t"))
   5382 				   "#+caption"
   5383 				   (optional "[" (zero-or-more any) "]")
   5384 				   ":")
   5385 			    (zero-or-more (any " \t")))))
   5386 	  (add-text-properties (line-beginning-position) (match-end 1)
   5387 			       '(font-lock-fontified t face org-meta-line))
   5388 	  (add-text-properties (match-end 0) (line-end-position)
   5389 			       '(font-lock-fontified t face org-block))
   5390 	  t)
   5391 	 ((member dc3 '(" " ""))
   5392 	  ;; Just a comment, the plus was not there
   5393 	  (org-remove-flyspell-overlays-in beg (match-end 0))
   5394 	  (add-text-properties
   5395 	   beg (match-end 0)
   5396 	   '(font-lock-fontified t face font-lock-comment-face)))
   5397 	 (t ;; Just any other in-buffer setting, but not indented
   5398 	  (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
   5399 	  (remove-text-properties (match-beginning 0) (match-end 0)
   5400 				  '(display t invisible t intangible t))
   5401 	  (add-text-properties beg (match-end 0)
   5402 			       '(font-lock-fontified t face org-meta-line))
   5403 	  t))))))
   5404 
   5405 (defun org-fontify-drawers (limit)
   5406   "Fontify drawers."
   5407   (when (re-search-forward org-drawer-regexp limit t)
   5408     (add-text-properties (1- (match-beginning 1)) (1+ (match-end 1))
   5409 			 '(font-lock-fontified t face org-drawer))
   5410     (org-remove-flyspell-overlays-in
   5411      (line-beginning-position) (line-beginning-position 2))
   5412     t))
   5413 
   5414 (defun org-fontify-macros (limit)
   5415   "Fontify macros."
   5416   (when (re-search-forward "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)" limit t)
   5417     (let ((begin (match-beginning 0))
   5418 	  (opening-end (match-beginning 1)))
   5419       (when (and (re-search-forward "\n[ \t]*\n\\|\\(}}}\\)" limit t)
   5420 		 (match-string 1))
   5421 	(let ((end (match-end 1))
   5422 	      (closing-start (match-beginning 1)))
   5423 	  (add-text-properties
   5424 	   begin end
   5425 	   '(font-lock-multiline t font-lock-fontified t face org-macro))
   5426 	  (org-remove-flyspell-overlays-in begin end)
   5427 	  (when org-hide-macro-markers
   5428 	    (add-text-properties begin opening-end '(invisible t))
   5429 	    (add-text-properties closing-start end '(invisible t)))
   5430 	  t)))))
   5431 
   5432 (defun org-fontify-extend-region (beg end _old-len)
   5433   (let ((end (if (progn (goto-char end) (looking-at-p "^[*#]"))
   5434                  (1+ end) end))
   5435         (begin-re "\\(\\\\\\[\\|\\(#\\+begin_\\|\\\\begin{\\)\\S-+\\)")
   5436 	(end-re "\\(\\\\\\]\\|\\(#\\+end_\\|\\\\end{\\)\\S-+\\)")
   5437 	(extend
   5438          (lambda (r1 r2 dir)
   5439 	   (let ((re (replace-regexp-in-string
   5440                       "\\(begin\\|end\\)" r1
   5441 		      (replace-regexp-in-string
   5442                        "[][]" r2
   5443 		       (match-string-no-properties 0)))))
   5444 	     (re-search-forward (regexp-quote re) nil t dir)))))
   5445     (goto-char beg)
   5446     (back-to-indentation)
   5447     (save-match-data
   5448       (cond ((looking-at end-re)
   5449 	     (cons (or (funcall extend "begin" "[" -1) beg) end))
   5450 	    ((looking-at begin-re)
   5451 	     (cons beg (or (funcall extend "end" "]" 1) end)))
   5452 	    (t (cons beg end))))))
   5453 
   5454 (defun org-activate-footnote-links (limit)
   5455   "Add text properties for footnotes."
   5456   (let ((fn (org-footnote-next-reference-or-definition limit)))
   5457     (when fn
   5458       (let* ((beg (nth 1 fn))
   5459 	     (end (nth 2 fn))
   5460 	     (label (car fn))
   5461 	     (referencep (/= (line-beginning-position) beg)))
   5462 	(when (and referencep (nth 3 fn))
   5463 	  (save-excursion
   5464 	    (goto-char beg)
   5465 	    (search-forward (or label "fn:"))
   5466 	    (org-remove-flyspell-overlays-in beg (match-end 0))))
   5467 	(add-text-properties beg end
   5468 			     (list 'mouse-face 'highlight
   5469 				   'keymap org-mouse-map
   5470 				   'help-echo
   5471 				   (if referencep "Footnote reference"
   5472 				     "Footnote definition")
   5473 				   'font-lock-fontified t
   5474 				   'font-lock-multiline t
   5475 				   'face 'org-footnote))))))
   5476 
   5477 (defun org-activate-dates (limit)
   5478   "Add text properties for dates."
   5479   (when (and (re-search-forward org-tsr-regexp-both limit t)
   5480 	     (not (equal (char-before (match-beginning 0)) 91)))
   5481     (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
   5482     (add-text-properties (match-beginning 0) (match-end 0)
   5483 			 (list 'mouse-face 'highlight
   5484 			       'keymap org-mouse-map))
   5485     (org-rear-nonsticky-at (match-end 0))
   5486     (when org-display-custom-times
   5487       ;; If it's a date range, activate custom time for second date.
   5488       (when (match-end 3)
   5489 	(org-display-custom-time (match-beginning 3) (match-end 3)))
   5490       (org-display-custom-time (match-beginning 1) (match-end 1)))
   5491     t))
   5492 
   5493 (defun org-activate-target-links (limit)
   5494   "Add text properties for target matches."
   5495   (when org-target-link-regexp
   5496     (let ((case-fold-search t))
   5497       ;; `org-target-link-regexp' matches one character before the
   5498       ;; actual target.
   5499       (unless (bolp) (forward-char -1))
   5500       (when (re-search-forward org-target-link-regexp limit t)
   5501 	(org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
   5502 	(add-text-properties (match-beginning 1) (match-end 1)
   5503 			     (list 'mouse-face 'highlight
   5504 				   'keymap org-mouse-map
   5505 				   'help-echo "Radio target link"
   5506 				   'org-linked-text t))
   5507 	(org-rear-nonsticky-at (match-end 1))
   5508 	t))))
   5509 
   5510 (defvar org-latex-and-related-regexp nil
   5511   "Regular expression for highlighting LaTeX, entities and sub/superscript.")
   5512 
   5513 (defun org-compute-latex-and-related-regexp ()
   5514   "Compute regular expression for LaTeX, entities and sub/superscript.
   5515 Result depends on variable `org-highlight-latex-and-related'."
   5516   (let ((re-sub
   5517 	 (cond ((not (memq 'script org-highlight-latex-and-related)) nil)
   5518 	       ((eq org-use-sub-superscripts '{})
   5519 		(list org-match-substring-with-braces-regexp))
   5520 	       (org-use-sub-superscripts (list org-match-substring-regexp))))
   5521 	(re-latex
   5522 	 (when (or (memq 'latex org-highlight-latex-and-related)
   5523 		   (memq 'native org-highlight-latex-and-related))
   5524 	   (let ((matchers (plist-get org-format-latex-options :matchers)))
   5525 	     (delq nil
   5526 		   (mapcar (lambda (x)
   5527 			     (and (member (car x) matchers) (nth 1 x)))
   5528 			   org-latex-regexps)))))
   5529 	(re-entities
   5530 	 (when (memq 'entities org-highlight-latex-and-related)
   5531 	   (list "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\
   5532 \\($\\|{}\\|[^[:alpha:]]\\)"))))
   5533     (setq-local org-latex-and-related-regexp
   5534 		(mapconcat #'identity
   5535 			   (append re-latex re-entities re-sub)
   5536 			   "\\|"))))
   5537 
   5538 (defun org-do-latex-and-related (limit)
   5539   "Highlight LaTeX snippets and environments, entities and sub/superscript.
   5540 Stop at first highlighted object, if any.  Return t if some
   5541 highlighting was done, nil otherwise."
   5542   (when (org-string-nw-p org-latex-and-related-regexp)
   5543     (let ((latex-prefix-re (rx (or "$" "\\(" "\\[")))
   5544 	  (blank-line-re (rx (and "\n" (zero-or-more (or " " "\t")) "\n"))))
   5545       (catch 'found
   5546 	(while (and (< (point) limit)
   5547 		    (re-search-forward org-latex-and-related-regexp nil t))
   5548 	  (cond
   5549            ((>= (match-beginning 0) limit)
   5550 	    (throw 'found nil))
   5551 	   ((cl-some (lambda (f)
   5552 		       (memq f '(org-code org-verbatim underline
   5553 					  org-special-keyword)))
   5554 		     (save-excursion
   5555 		       (goto-char (1+ (match-beginning 0)))
   5556 		       (face-at-point nil t))))
   5557 	   ;; Try to limit false positives.  In this case, ignore
   5558 	   ;; $$...$$, \(...\), and \[...\] LaTeX constructs if they
   5559 	   ;; contain an empty line.
   5560 	   ((save-excursion
   5561 	      (goto-char (match-beginning 0))
   5562 	      (and (looking-at-p latex-prefix-re)
   5563 		   (save-match-data
   5564 		     (re-search-forward blank-line-re (1- (match-end 0)) t)))))
   5565 	   (t
   5566 	    (let* ((offset (if (memq (char-after (1+ (match-beginning 0)))
   5567 				     '(?_ ?^))
   5568 			       1
   5569 			     0))
   5570 		   (start (+ offset (match-beginning 0)))
   5571 		   (end (match-end 0)))
   5572 	      (if (memq 'native org-highlight-latex-and-related)
   5573 		  (org-src-font-lock-fontify-block "latex" start end)
   5574 		(font-lock-prepend-text-property start end
   5575 						 'face 'org-latex-and-related))
   5576 	      (add-text-properties (+ offset (match-beginning 0)) (match-end 0)
   5577 				   '(font-lock-multiline t))
   5578 	      (throw 'found t)))))
   5579 	nil))))
   5580 
   5581 (defun org-restart-font-lock ()
   5582   "Restart `font-lock-mode', to force refontification."
   5583   (when font-lock-mode
   5584     (font-lock-mode -1)
   5585     (font-lock-mode 1)))
   5586 
   5587 (defun org-activate-tags (limit)
   5588   (when (re-search-forward org-tag-line-re limit t)
   5589     (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
   5590     (add-text-properties (match-beginning 1) (match-end 1)
   5591 			 (list 'mouse-face 'highlight
   5592 			       'keymap org-mouse-map))
   5593     (org-rear-nonsticky-at (match-end 1))
   5594     t))
   5595 
   5596 (defun org-outline-level ()
   5597   "Compute the outline level of the heading at point.
   5598 
   5599 If this is called at a normal headline, the level is the number
   5600 of stars.  Use `org-reduced-level' to remove the effect of
   5601 `org-odd-levels'.  Unlike to `org-current-level', this function
   5602 takes into consideration inlinetasks."
   5603   (org-with-wide-buffer
   5604    (end-of-line)
   5605    (if (re-search-backward org-outline-regexp-bol nil t)
   5606        (1- (- (match-end 0) (match-beginning 0)))
   5607      0)))
   5608 
   5609 (defvar org-font-lock-keywords nil)
   5610 
   5611 (defsubst org-re-property (property &optional literal allow-null value)
   5612   "Return a regexp matching a PROPERTY line.
   5613 
   5614 When optional argument LITERAL is non-nil, do not quote PROPERTY.
   5615 This is useful when PROPERTY is a regexp.  When ALLOW-NULL is
   5616 non-nil, match properties even without a value.
   5617 
   5618 Match group 3 is set to the value when it exists.  If there is no
   5619 value and ALLOW-NULL is non-nil, it is set to the empty string.
   5620 
   5621 With optional argument VALUE, match only property lines with
   5622 that value; in this case, ALLOW-NULL is ignored.  VALUE is quoted
   5623 unless LITERAL is non-nil."
   5624   (concat
   5625    "^\\(?4:[ \t]*\\)"
   5626    (format "\\(?1::\\(?2:%s\\):\\)"
   5627 	   (if literal property (regexp-quote property)))
   5628    (cond (value
   5629 	  (format "[ \t]+\\(?3:%s\\)\\(?5:[ \t]*\\)$"
   5630 		  (if literal value (regexp-quote value))))
   5631 	 (allow-null
   5632 	  "\\(?:\\(?3:$\\)\\|[ \t]+\\(?3:.*?\\)\\)\\(?5:[ \t]*\\)$")
   5633 	 (t
   5634 	  "[ \t]+\\(?3:[^ \r\t\n]+.*?\\)\\(?5:[ \t]*\\)$"))))
   5635 
   5636 (defconst org-property-re
   5637   (org-re-property "\\S-+" 'literal t)
   5638   "Regular expression matching a property line.
   5639 There are four matching groups:
   5640 1: :PROPKEY: including the leading and trailing colon,
   5641 2: PROPKEY without the leading and trailing colon,
   5642 3: PROPVAL without leading or trailing spaces,
   5643 4: the indentation of the current line,
   5644 5: trailing whitespace.")
   5645 
   5646 (defvar org-font-lock-hook nil
   5647   "Functions to be called for special font lock stuff.")
   5648 
   5649 (defvar org-font-lock-extra-keywords nil) ;Dynamically scoped.
   5650 
   5651 (defvar org-font-lock-set-keywords-hook nil
   5652   "Functions that can manipulate `org-font-lock-extra-keywords'.
   5653 This is called after `org-font-lock-extra-keywords' is defined, but before
   5654 it is installed to be used by font lock.  This can be useful if something
   5655 needs to be inserted at a specific position in the font-lock sequence.")
   5656 
   5657 (defun org-font-lock-hook (limit)
   5658   "Run `org-font-lock-hook' within LIMIT."
   5659   (run-hook-with-args 'org-font-lock-hook limit))
   5660 
   5661 (defun org-set-font-lock-defaults ()
   5662   "Set font lock defaults for the current buffer."
   5663   (let ((org-font-lock-extra-keywords
   5664 	 (list
   5665 	  ;; Call the hook
   5666 	  '(org-font-lock-hook)
   5667 	  ;; Headlines
   5668 	  `(,(if org-fontify-whole-heading-line
   5669 		 "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)"
   5670 	       "^\\(\\**\\)\\(\\* \\)\\(.*\\)")
   5671 	    (1 (org-get-level-face 1))
   5672 	    (2 (org-get-level-face 2))
   5673 	    (3 (org-get-level-face 3)))
   5674 	  ;; Table lines
   5675 	  '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
   5676 	    (1 'org-table t))
   5677 	  ;; Table internals
   5678 	  '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t))
   5679 	  '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
   5680 	  '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
   5681 	  '("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t))
   5682 	  ;; Properties
   5683 	  (list org-property-re
   5684 		'(1 'org-special-keyword t)
   5685 		'(3 'org-property-value t))
   5686 	  ;; Drawers
   5687 	  '(org-fontify-drawers)
   5688 	  ;; Link related fontification.
   5689 	  '(org-activate-links)
   5690 	  (when (memq 'tag org-highlight-links) '(org-activate-tags (1 'org-tag prepend)))
   5691 	  (when (memq 'radio org-highlight-links) '(org-activate-target-links (1 'org-link t)))
   5692 	  (when (memq 'date org-highlight-links) '(org-activate-dates (0 'org-date t)))
   5693 	  (when (memq 'footnote org-highlight-links) '(org-activate-footnote-links))
   5694           ;; Targets.
   5695           (list org-radio-target-regexp '(0 'org-target t))
   5696 	  (list org-target-regexp '(0 'org-target t))
   5697 	  ;; Diary sexps.
   5698 	  '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
   5699 	  ;; Macro
   5700 	  '(org-fontify-macros)
   5701 	  ;; TODO keyword
   5702 	  (list (format org-heading-keyword-regexp-format
   5703 			org-todo-regexp)
   5704 		'(2 (org-get-todo-face 2) prepend))
   5705 	  ;; TODO
   5706 	  (when org-fontify-todo-headline
   5707 	    (list (format org-heading-keyword-regexp-format
   5708 			  (concat
   5709 			   "\\(?:"
   5710 			   (mapconcat 'regexp-quote org-not-done-keywords "\\|")
   5711 			   "\\)"))
   5712 		  '(2 'org-headline-todo prepend)))
   5713 	  ;; DONE
   5714 	  (when org-fontify-done-headline
   5715 	    (list (format org-heading-keyword-regexp-format
   5716 			  (concat
   5717 			   "\\(?:"
   5718 			   (mapconcat 'regexp-quote org-done-keywords "\\|")
   5719 			   "\\)"))
   5720 		  '(2 'org-headline-done prepend)))
   5721 	  ;; Priorities
   5722 	  '(org-font-lock-add-priority-faces)
   5723 	  ;; Tags
   5724 	  '(org-font-lock-add-tag-faces)
   5725 	  ;; Tags groups
   5726 	  (when (and org-group-tags org-tag-groups-alist)
   5727 	    (list (concat org-outline-regexp-bol ".+\\(:"
   5728 			  (regexp-opt (mapcar 'car org-tag-groups-alist))
   5729 			  ":\\).*$")
   5730 		  '(1 'org-tag-group prepend)))
   5731 	  ;; Special keywords
   5732 	  (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
   5733 	  (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
   5734 	  (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
   5735 	  (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t))
   5736 	  ;; Emphasis
   5737 	  (when org-fontify-emphasized-text '(org-do-emphasis-faces))
   5738 	  ;; Checkboxes
   5739 	  '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)"
   5740 	    1 'org-checkbox prepend)
   5741 	  (when (cdr (assq 'checkbox org-list-automatic-rules))
   5742 	    '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
   5743 	      (0 (org-get-checkbox-statistics-face) prepend)))
   5744 	  ;; Description list items
   5745           '("\\(?:^[ \t]*[-+]\\|^[ \t]+[*]\\)[ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)"
   5746 	    1 'org-list-dt prepend)
   5747           ;; Inline export snippets
   5748           '("\\(@@\\)\\([a-z-]+:\\).*?\\(@@\\)"
   5749             (1 'font-lock-comment-face t)
   5750             (2 'org-tag t)
   5751             (3 'font-lock-comment-face t))
   5752 	  ;; ARCHIVEd headings
   5753 	  (list (concat
   5754 		 org-outline-regexp-bol
   5755 		 "\\(.*:" org-archive-tag ":.*\\)")
   5756 		'(1 'org-archived prepend))
   5757 	  ;; Specials
   5758 	  '(org-do-latex-and-related)
   5759 	  '(org-fontify-entities)
   5760 	  '(org-raise-scripts)
   5761 	  ;; Code
   5762 	  '(org-activate-code (1 'org-code t))
   5763 	  ;; COMMENT
   5764 	  (list (format
   5765 		 "^\\*+\\(?: +%s\\)?\\(?: +\\[#[A-Z0-9]\\]\\)? +\\(?9:%s\\)\\(?: \\|$\\)"
   5766 		 org-todo-regexp
   5767 		 org-comment-string)
   5768 		'(9 'org-special-keyword t))
   5769 	  ;; Blocks and meta lines
   5770 	  '(org-fontify-meta-lines-and-blocks)
   5771           ;; Citations
   5772           '(org-cite-activate))))
   5773     (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
   5774     (run-hooks 'org-font-lock-set-keywords-hook)
   5775     ;; Now set the full font-lock-keywords
   5776     (setq-local org-font-lock-keywords org-font-lock-extra-keywords)
   5777     (setq-local font-lock-defaults
   5778 		'(org-font-lock-keywords t nil nil backward-paragraph))
   5779     (setq-local font-lock-extend-after-change-region-function
   5780 		#'org-fontify-extend-region)
   5781     (kill-local-variable 'font-lock-keywords)
   5782     nil))
   5783 
   5784 (defun org-toggle-pretty-entities ()
   5785   "Toggle the composition display of entities as UTF8 characters."
   5786   (interactive)
   5787   (setq-local org-pretty-entities (not org-pretty-entities))
   5788   (org-restart-font-lock)
   5789   (if org-pretty-entities
   5790       (message "Entities are now displayed as UTF8 characters")
   5791     (save-restriction
   5792       (widen)
   5793       (decompose-region (point-min) (point-max))
   5794       (message "Entities are now displayed as plain text"))))
   5795 
   5796 (defvar-local org-custom-properties-overlays nil
   5797   "List of overlays used for custom properties.")
   5798 
   5799 (defun org-toggle-custom-properties-visibility ()
   5800   "Display or hide properties in `org-custom-properties'."
   5801   (interactive)
   5802   (if org-custom-properties-overlays
   5803       (progn (mapc #'delete-overlay org-custom-properties-overlays)
   5804 	     (setq org-custom-properties-overlays nil))
   5805     (when org-custom-properties
   5806       (org-with-wide-buffer
   5807        (goto-char (point-min))
   5808        (let ((regexp (org-re-property (regexp-opt org-custom-properties) t t)))
   5809 	 (while (re-search-forward regexp nil t)
   5810 	   (let ((end (cdr (save-match-data (org-get-property-block)))))
   5811 	     (when (and end (< (point) end))
   5812 	       ;; Hide first custom property in current drawer.
   5813 	       (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
   5814 		 (overlay-put o 'invisible t)
   5815 		 (overlay-put o 'org-custom-property t)
   5816 		 (push o org-custom-properties-overlays))
   5817 	       ;; Hide additional custom properties in the same drawer.
   5818 	       (while (re-search-forward regexp end t)
   5819 		 (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
   5820 		   (overlay-put o 'invisible t)
   5821 		   (overlay-put o 'org-custom-property t)
   5822 		   (push o org-custom-properties-overlays)))))
   5823 	   ;; Each entry is limited to a single property drawer.
   5824 	   (outline-next-heading)))))))
   5825 
   5826 (defun org-fontify-entities (limit)
   5827   "Find an entity to fontify."
   5828   (let (ee)
   5829     (when org-pretty-entities
   5830       (catch 'match
   5831 	;; "\_ "-family is left out on purpose.  Only the first one,
   5832 	;; i.e., "\_ ", could be fontified anyway, and it would be
   5833 	;; confusing when adding a second white space character.
   5834 	(while (re-search-forward
   5835 		"\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)"
   5836 		limit t)
   5837 	  (when (and (not (org-at-comment-p))
   5838 		     (setq ee (org-entity-get (match-string 1)))
   5839 		     (= (length (nth 6 ee)) 1))
   5840 	    (let* ((end (if (equal (match-string 2) "{}")
   5841 			    (match-end 2)
   5842 			  (match-end 1))))
   5843 	      (add-text-properties
   5844 	       (match-beginning 0) end
   5845 	       (list 'font-lock-fontified t))
   5846 	      (compose-region (match-beginning 0) end
   5847 			      (nth 6 ee) nil)
   5848 	      (backward-char 1)
   5849 	      (throw 'match t))))
   5850 	nil))))
   5851 
   5852 (defun org-fontify-like-in-org-mode (s &optional odd-levels)
   5853   "Fontify string S like in Org mode."
   5854   (with-temp-buffer
   5855     (insert s)
   5856     (let ((org-odd-levels-only odd-levels))
   5857       (org-mode)
   5858       (org-font-lock-ensure)
   5859       (buffer-string))))
   5860 
   5861 (defun org-get-level-face (n)
   5862   "Get the right face for match N in font-lock matching of headlines."
   5863   (let* ((org-l0 (- (match-end 2) (match-beginning 1) 1))
   5864 	 (org-l (if org-odd-levels-only (1+ (/ org-l0 2)) org-l0))
   5865 	 (org-f (if org-cycle-level-faces
   5866 		    (nth (% (1- org-l) org-n-level-faces) org-level-faces)
   5867 		  (nth (1- (min org-l org-n-level-faces)) org-level-faces))))
   5868     (cond
   5869      ((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
   5870      ((eq n 2) org-f)
   5871      (t (unless org-level-color-stars-only org-f)))))
   5872 
   5873 (defun org-face-from-face-or-color (context inherit face-or-color)
   5874   "Create a face list that inherits INHERIT, but sets the foreground color.
   5875 When FACE-OR-COLOR is not a string, just return it."
   5876   (if (stringp face-or-color)
   5877       (list :inherit inherit
   5878 	    (cdr (assoc context org-faces-easy-properties))
   5879 	    face-or-color)
   5880     face-or-color))
   5881 
   5882 (defun org-get-todo-face (kwd)
   5883   "Get the right face for a TODO keyword KWD.
   5884 If KWD is a number, get the corresponding match group."
   5885   (when (numberp kwd) (setq kwd (match-string kwd)))
   5886   (or (org-face-from-face-or-color
   5887        'todo 'org-todo (cdr (assoc kwd org-todo-keyword-faces)))
   5888       (and (member kwd org-done-keywords) 'org-done)
   5889       'org-todo))
   5890 
   5891 (defun org-get-priority-face (priority)
   5892   "Get the right face for PRIORITY.
   5893 PRIORITY is a character."
   5894   (or (org-face-from-face-or-color
   5895        'priority 'org-priority (cdr (assq priority org-priority-faces)))
   5896       'org-priority))
   5897 
   5898 (defun org-get-tag-face (tag)
   5899   "Get the right face for TAG.
   5900 If TAG is a number, get the corresponding match group."
   5901   (let ((tag (if (wholenump tag) (match-string tag) tag)))
   5902     (or (org-face-from-face-or-color
   5903 	 'tag 'org-tag (cdr (assoc tag org-tag-faces)))
   5904 	'org-tag)))
   5905 
   5906 (defvar org-priority-regexp) ; defined later in the file
   5907 
   5908 (defun org-font-lock-add-priority-faces (limit)
   5909   "Add the special priority faces."
   5910   (while (re-search-forward (concat "^\\*+" org-priority-regexp) limit t)
   5911     (let ((beg (match-beginning 1))
   5912 	  (end (1+ (match-end 2))))
   5913       (add-face-text-property
   5914        beg end
   5915        (org-get-priority-face (string-to-char (match-string 2))))
   5916       (add-text-properties
   5917        beg end
   5918        (list 'font-lock-fontified t)))))
   5919 
   5920 (defun org-font-lock-add-tag-faces (limit)
   5921   "Add the special tag faces."
   5922   (when (and org-tag-faces org-tags-special-faces-re)
   5923     (while (re-search-forward org-tags-special-faces-re limit t)
   5924       (add-face-text-property
   5925        (match-beginning 1)
   5926        (match-end 1)
   5927        (org-get-tag-face 1))
   5928       (add-text-properties (match-beginning 1) (match-end 1)
   5929 			   (list 'font-lock-fontified t))
   5930       (backward-char 1))))
   5931 
   5932 (defun org-unfontify-region (beg end &optional _maybe_loudly)
   5933   "Remove fontification and activation overlays from links."
   5934   (font-lock-default-unfontify-region beg end)
   5935   (let* ((buffer-undo-list t)
   5936 	 (inhibit-read-only t) (inhibit-point-motion-hooks t)
   5937 	 (inhibit-modification-hooks t)
   5938 	 deactivate-mark buffer-file-name buffer-file-truename)
   5939     (decompose-region beg end)
   5940     (remove-text-properties beg end
   5941 			    '(mouse-face t keymap t org-linked-text t
   5942 					 invisible t intangible t
   5943 					 org-emphasis t))
   5944     (org-remove-font-lock-display-properties beg end)))
   5945 
   5946 (defconst org-script-display  '(((raise -0.3) (height 0.7))
   5947 				((raise 0.3)  (height 0.7))
   5948 				((raise -0.5))
   5949 				((raise 0.5)))
   5950   "Display properties for showing superscripts and subscripts.")
   5951 
   5952 (defun org-remove-font-lock-display-properties (beg end)
   5953   "Remove specific display properties that have been added by font lock.
   5954 The will remove the raise properties that are used to show superscripts
   5955 and subscripts."
   5956   (let (next prop)
   5957     (while (< beg end)
   5958       (setq next (next-single-property-change beg 'display nil end)
   5959 	    prop (get-text-property beg 'display))
   5960       (when (member prop org-script-display)
   5961 	(put-text-property beg next 'display nil))
   5962       (setq beg next))))
   5963 
   5964 (defun org-raise-scripts (limit)
   5965   "Add raise properties to sub/superscripts."
   5966   (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts
   5967 	     (re-search-forward
   5968 	      (if (eq org-use-sub-superscripts t)
   5969 		  org-match-substring-regexp
   5970 		org-match-substring-with-braces-regexp)
   5971 	      limit t))
   5972     (let* ((pos (point)) table-p comment-p
   5973 	   (mpos (match-beginning 3))
   5974 	   (emph-p (get-text-property mpos 'org-emphasis))
   5975 	   (link-p (get-text-property mpos 'mouse-face))
   5976 	   (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face))))
   5977       (goto-char (point-at-bol))
   5978       (setq table-p (looking-at-p org-table-dataline-regexp)
   5979 	    comment-p (looking-at-p "^[ \t]*#[ +]"))
   5980       (goto-char pos)
   5981       ;; Handle a_b^c
   5982       (when (member (char-after) '(?_ ?^)) (goto-char (1- pos)))
   5983       (unless (or comment-p emph-p link-p keyw-p)
   5984 	(put-text-property (match-beginning 3) (match-end 0)
   5985 			   'display
   5986 			   (if (equal (char-after (match-beginning 2)) ?^)
   5987 			       (nth (if table-p 3 1) org-script-display)
   5988 			     (nth (if table-p 2 0) org-script-display)))
   5989 	(add-text-properties (match-beginning 2) (match-end 2)
   5990 			     (list 'invisible t))
   5991 	(when (and (eq (char-after (match-beginning 3)) ?{)
   5992 		   (eq (char-before (match-end 3)) ?}))
   5993 	  (add-text-properties (match-beginning 3) (1+ (match-beginning 3))
   5994 			       (list 'invisible t))
   5995 	  (add-text-properties (1- (match-end 3)) (match-end 3)
   5996 			       (list 'invisible t))))
   5997       t)))
   5998 
   5999 (defun org-remove-empty-overlays-at (pos)
   6000   "Remove outline overlays that do not contain non-white stuff."
   6001   (dolist (o (overlays-at pos))
   6002     (and (eq 'outline (overlay-get o 'invisible))
   6003 	 (not (string-match-p
   6004                "\\S-" (buffer-substring (overlay-start o)
   6005 					(overlay-end o))))
   6006 	 (delete-overlay o))))
   6007 
   6008 (defun org-show-empty-lines-in-parent ()
   6009   "Move to the parent and re-show empty lines before visible headlines."
   6010   (save-excursion
   6011     (let ((context (if (org-up-heading-safe) 'children 'overview)))
   6012       (org-cycle-show-empty-lines context))))
   6013 
   6014 (defun org-files-list ()
   6015   "Return `org-agenda-files' list, plus all open Org files.
   6016 This is useful for operations that need to scan all of a user's
   6017 open and agenda-wise Org files."
   6018   (let ((files (mapcar #'expand-file-name (org-agenda-files))))
   6019     (dolist (buf (buffer-list))
   6020       (with-current-buffer buf
   6021 	(when (and (derived-mode-p 'org-mode) (buffer-file-name))
   6022 	  (cl-pushnew (expand-file-name (buffer-file-name)) files
   6023 		      :test #'equal))))
   6024     files))
   6025 
   6026 (defsubst org-entry-beginning-position ()
   6027   "Return the beginning position of the current entry."
   6028   (save-excursion (org-back-to-heading t) (point)))
   6029 
   6030 (defsubst org-entry-end-position ()
   6031   "Return the end position of the current entry."
   6032   (save-excursion (outline-next-heading) (point)))
   6033 
   6034 (defun org-subtree-end-visible-p ()
   6035   "Is the end of the current subtree visible?"
   6036   (pos-visible-in-window-p
   6037    (save-excursion (org-end-of-subtree t) (point))))
   6038 
   6039 (defun org-first-headline-recenter ()
   6040   "Move cursor to the first headline and recenter the headline."
   6041   (let ((window (get-buffer-window)))
   6042     (when window
   6043       (goto-char (point-min))
   6044       (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
   6045 	(set-window-start window (line-beginning-position))))))
   6046 
   6047 
   6048 ;;; Visibility (headlines, blocks, drawers)
   6049 
   6050 ;;;; Headlines visibility
   6051 
   6052 (defun org-show-entry ()
   6053   "Show the body directly following its heading.
   6054 Show the heading too, if it is currently invisible."
   6055   (interactive)
   6056   (save-excursion
   6057     (org-back-to-heading-or-point-min t)
   6058     (org-flag-region
   6059      (line-end-position 0)
   6060      (save-excursion
   6061        (if (re-search-forward
   6062 	    (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
   6063 	   (match-beginning 1)
   6064 	 (point-max)))
   6065      nil
   6066      'outline)
   6067     (org-cycle-hide-drawers 'children)))
   6068 
   6069 (defun org-hide-entry ()
   6070   "Hide the body directly following its heading."
   6071   (interactive)
   6072   (save-excursion
   6073     (org-back-to-heading-or-point-min t)
   6074     (when (org-at-heading-p) (forward-line))
   6075     (org-flag-region
   6076      (line-end-position 0)
   6077      (save-excursion
   6078        (if (re-search-forward
   6079 	    (concat "[\r\n]" org-outline-regexp) nil t)
   6080            (line-end-position 0)
   6081 	 (point-max)))
   6082      t
   6083      'outline)))
   6084 
   6085 (defun org-show-children (&optional level)
   6086   "Show all direct subheadings of this heading.
   6087 Prefix arg LEVEL is how many levels below the current level
   6088 should be shown.  Default is enough to cause the following
   6089 heading to appear."
   6090   (interactive "p")
   6091   (unless (org-before-first-heading-p)
   6092     (save-excursion
   6093       (org-with-limited-levels (org-back-to-heading t))
   6094       (let* ((current-level (funcall outline-level))
   6095 	     (max-level (org-get-valid-level
   6096 			 current-level
   6097 			 (if level (prefix-numeric-value level) 1)))
   6098 	     (end (save-excursion (org-end-of-subtree t t)))
   6099 	     (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)")
   6100 	     (past-first-child nil)
   6101 	     ;; Make sure to skip inlinetasks.
   6102 	     (re (format regexp-fmt
   6103 			 current-level
   6104 			 (cond
   6105 			  ((not (featurep 'org-inlinetask)) "")
   6106 			  (org-odd-levels-only (- (* 2 org-inlinetask-min-level)
   6107 						  3))
   6108 			  (t (1- org-inlinetask-min-level))))))
   6109 	;; Display parent heading.
   6110 	(org-flag-heading nil)
   6111 	(forward-line)
   6112 	;; Display children.  First child may be deeper than expected
   6113 	;; MAX-LEVEL.  Since we want to display it anyway, adjust
   6114 	;; MAX-LEVEL accordingly.
   6115 	(while (re-search-forward re end t)
   6116 	  (unless past-first-child
   6117 	    (setq re (format regexp-fmt
   6118 			     current-level
   6119 			     (max (funcall outline-level) max-level)))
   6120 	    (setq past-first-child t))
   6121 	  (org-flag-heading nil))))))
   6122 
   6123 (defun org-show-subtree ()
   6124   "Show everything after this heading at deeper levels."
   6125   (interactive)
   6126   (org-flag-region
   6127    (point) (save-excursion (org-end-of-subtree t t)) nil 'outline))
   6128 
   6129 ;;;; Blocks and drawers visibility
   6130 
   6131 (defun org--hide-wrapper-toggle (element category force no-error)
   6132   "Toggle visibility for ELEMENT.
   6133 
   6134 ELEMENT is a block or drawer type parsed element.  CATEGORY is
   6135 either `block' or `drawer'.  When FORCE is `off', show the block
   6136 or drawer.  If it is non-nil, hide it unconditionally.  Throw an
   6137 error when not at a block or drawer, unless NO-ERROR is non-nil.
   6138 
   6139 Return a non-nil value when toggling is successful."
   6140   (let ((type (org-element-type element)))
   6141     (cond
   6142      ((memq type
   6143 	    (pcase category
   6144 	      (`drawer '(drawer property-drawer))
   6145 	      (`block '(center-block
   6146 			comment-block dynamic-block example-block export-block
   6147 			quote-block special-block src-block verse-block))
   6148 	      (_ (error "Unknown category: %S" category))))
   6149       (let* ((post (org-element-property :post-affiliated element))
   6150 	     (start (save-excursion
   6151 		      (goto-char post)
   6152 		      (line-end-position)))
   6153 	     (end (save-excursion
   6154 		    (goto-char (org-element-property :end element))
   6155 		    (skip-chars-backward " \t\n")
   6156 		    (line-end-position))))
   6157 	;; Do nothing when not before or at the block opening line or
   6158 	;; at the block closing line.
   6159 	(unless (let ((eol (line-end-position)))
   6160 		  (and (> eol start) (/= eol end)))
   6161 	  (let* ((spec (if (eq category 'block) 'org-hide-block 'outline))
   6162 		 (flag
   6163 		  (cond ((eq force 'off) nil)
   6164 			(force t)
   6165 			((eq spec (get-char-property start 'invisible)) nil)
   6166 			(t t))))
   6167 	    (org-flag-region start end flag spec))
   6168 	  ;; When the block is hidden away, make sure point is left in
   6169 	  ;; a visible part of the buffer.
   6170 	  (when (invisible-p (max (1- (point)) (point-min)))
   6171 	    (goto-char post))
   6172 	  ;; Signal success.
   6173 	  t)))
   6174      (no-error nil)
   6175      (t
   6176       (user-error (if (eq category 'drawer)
   6177 		      "Not at a drawer"
   6178 		    "Not at a block"))))))
   6179 
   6180 (defun org-hide-block-toggle (&optional force no-error element)
   6181   "Toggle the visibility of the current block.
   6182 
   6183 When optional argument FORCE is `off', make block visible.  If it
   6184 is non-nil, hide it unconditionally.  Throw an error when not at
   6185 a block, unless NO-ERROR is non-nil.  When optional argument
   6186 ELEMENT is provided, consider it instead of the current block.
   6187 
   6188 Return a non-nil value when toggling is successful."
   6189   (interactive)
   6190   (org--hide-wrapper-toggle
   6191    (or element (org-element-at-point)) 'block force no-error))
   6192 
   6193 (defun org-hide-drawer-toggle (&optional force no-error element)
   6194   "Toggle the visibility of the current drawer.
   6195 
   6196 When optional argument FORCE is `off', make drawer visible.  If
   6197 it is non-nil, hide it unconditionally.  Throw an error when not
   6198 at a drawer, unless NO-ERROR is non-nil.  When optional argument
   6199 ELEMENT is provided, consider it instead of the current drawer.
   6200 
   6201 Return a non-nil value when toggling is successful."
   6202   (interactive)
   6203   (org--hide-wrapper-toggle
   6204    (or element (org-element-at-point)) 'drawer force no-error))
   6205 
   6206 (defun org-hide-block-all ()
   6207   "Fold all blocks in the current buffer."
   6208   (interactive)
   6209   (org-show-all '(blocks))
   6210   (org-block-map 'org-hide-block-toggle))
   6211 
   6212 (defun org-hide-drawer-all ()
   6213   "Fold all drawers in the current buffer."
   6214   (let ((begin (point-min))
   6215 	(end (point-max)))
   6216     (org--hide-drawers begin end)))
   6217 
   6218 (defun org-cycle-hide-drawers (state)
   6219   "Re-hide all drawers after a visibility state change.
   6220 STATE should be one of the symbols listed in the docstring of
   6221 `org-cycle-hook'."
   6222   (when (derived-mode-p 'org-mode)
   6223     (cond ((not (memq state '(overview folded contents)))
   6224 	   (let* ((global? (eq state 'all))
   6225 		  (beg (if global? (point-min) (line-beginning-position)))
   6226 		  (end (cond (global? (point-max))
   6227 			     ((eq state 'children) (org-entry-end-position))
   6228 			     (t (save-excursion (org-end-of-subtree t t))))))
   6229 	     (org--hide-drawers beg end)))
   6230 	  ((memq state '(overview contents))
   6231 	   ;; Hide drawers before first heading.
   6232 	   (let ((beg (point-min))
   6233 		 (end (save-excursion
   6234 			(goto-char (point-min))
   6235 			(if (org-before-first-heading-p)
   6236 			    (org-entry-end-position)
   6237 			  (point-min)))))
   6238 	     (when (< beg end)
   6239 	       (org--hide-drawers beg end)))))))
   6240 
   6241 (defun org--hide-drawers (begin end)
   6242   "Hide all drawers between BEGIN and END."
   6243   (save-excursion
   6244     (goto-char begin)
   6245     (while (re-search-forward org-drawer-regexp end t)
   6246       (let* ((pair (get-char-property-and-overlay (line-beginning-position)
   6247 						  'invisible))
   6248 	     (o (cdr-safe pair)))
   6249 	(if (overlayp o) (goto-char (overlay-end o)) ;invisible drawer
   6250 	  (pcase (get-char-property-and-overlay (point) 'invisible)
   6251 	    (`(outline . ,o) (goto-char (overlay-end o))) ;already folded
   6252 	    (_
   6253 	     (let* ((drawer (org-element-at-point))
   6254 		    (type (org-element-type drawer)))
   6255 	       (when (memq type '(drawer property-drawer))
   6256 		 (org-hide-drawer-toggle t nil drawer)
   6257 		 ;; Make sure to skip drawer entirely or we might flag it
   6258 		 ;; another time when matching its ending line with
   6259 		 ;; `org-drawer-regexp'.
   6260 		 (goto-char (org-element-property :end drawer)))))))))))
   6261 
   6262 ;;;; Visibility cycling
   6263 
   6264 (defvar-local org-cycle-global-status nil)
   6265 (put 'org-cycle-global-status 'org-state t)
   6266 (defvar-local org-cycle-subtree-status nil)
   6267 (put 'org-cycle-subtree-status 'org-state t)
   6268 
   6269 (defun org-show-all (&optional types)
   6270   "Show all contents in the visible part of the buffer.
   6271 By default, the function expands headings, blocks and drawers.
   6272 When optional argument TYPE is a list of symbols among `blocks',
   6273 `drawers' and `headings', to only expand one specific type."
   6274   (interactive)
   6275   (let ((types (or types '(blocks drawers headings))))
   6276     (when (memq 'blocks types)
   6277       (org-flag-region (point-min) (point-max) nil 'org-hide-block))
   6278     (cond
   6279      ;; Fast path.  Since headings and drawers share the same
   6280      ;; invisible spec, clear everything in one go.
   6281      ((and (memq 'headings types)
   6282 	   (memq 'drawers types))
   6283       (org-flag-region (point-min) (point-max) nil 'outline))
   6284      ((memq 'headings types)
   6285       (org-flag-region (point-min) (point-max) nil 'outline)
   6286       (org-cycle-hide-drawers 'all))
   6287      ((memq 'drawers types)
   6288       (save-excursion
   6289 	(goto-char (point-min))
   6290 	(while (re-search-forward org-drawer-regexp nil t)
   6291 	  (let* ((pair (get-char-property-and-overlay (line-beginning-position)
   6292 						      'invisible))
   6293 		 (o (cdr-safe pair)))
   6294 	    (if (overlayp o) (goto-char (overlay-end o))
   6295 	      (pcase (get-char-property-and-overlay (point) 'invisible)
   6296 		(`(outline . ,o)
   6297 		 (goto-char (overlay-end o))
   6298 		 (delete-overlay o))
   6299 		(_ nil))))))))))
   6300 
   6301 ;;;###autoload
   6302 (defun org-cycle (&optional arg)
   6303   "TAB-action and visibility cycling for Org mode.
   6304 
   6305 This is the command invoked in Org mode by the `TAB' key.  Its main
   6306 purpose is outline visibility cycling, but it also invokes other actions
   6307 in special contexts.
   6308 
   6309 When this function is called with a `\\[universal-argument]' prefix, rotate \
   6310 the entire
   6311 buffer through 3 states (global cycling)
   6312   1. OVERVIEW: Show only top-level headlines.
   6313   2. CONTENTS: Show all headlines of all levels, but no body text.
   6314   3. SHOW ALL: Show everything.
   6315 
   6316 With a `\\[universal-argument] \\[universal-argument]' prefix argument, \
   6317 switch to the startup visibility,
   6318 determined by the variable `org-startup-folded', and by any VISIBILITY
   6319 properties in the buffer.
   6320 
   6321 With a `\\[universal-argument] \\[universal-argument] \
   6322 \\[universal-argument]' prefix argument, show the entire buffer, including
   6323 any drawers.
   6324 
   6325 When inside a table, re-align the table and move to the next field.
   6326 
   6327 When point is at the beginning of a headline, rotate the subtree started
   6328 by this line through 3 different states (local cycling)
   6329   1. FOLDED:   Only the main headline is shown.
   6330   2. CHILDREN: The main headline and the direct children are shown.
   6331                From this state, you can move to one of the children
   6332                and zoom in further.
   6333   3. SUBTREE:  Show the entire subtree, including body text.
   6334 If there is no subtree, switch directly from CHILDREN to FOLDED.
   6335 
   6336 When point is at the beginning of an empty headline and the variable
   6337 `org-cycle-level-after-item/entry-creation' is set, cycle the level
   6338 of the headline by demoting and promoting it to likely levels.  This
   6339 speeds up creation document structure by pressing `TAB' once or several
   6340 times right after creating a new headline.
   6341 
   6342 When there is a numeric prefix, go up to a heading with level ARG, do
   6343 a `show-subtree' and return to the previous cursor position.  If ARG
   6344 is negative, go up that many levels.
   6345 
   6346 When point is not at the beginning of a headline, execute the global
   6347 binding for `TAB', which is re-indenting the line.  See the option
   6348 `org-cycle-emulate-tab' for details.
   6349 
   6350 As a special case, if point is at the very beginning of the buffer, if
   6351 there is no headline there, and if the variable `org-cycle-global-at-bob'
   6352 is non-nil, this function acts as if called with prefix argument \
   6353 \(`\\[universal-argument] TAB',
   6354 same as `S-TAB') also when called without prefix argument."
   6355   (interactive "P")
   6356   (org-load-modules-maybe)
   6357   (unless (or (run-hook-with-args-until-success 'org-tab-first-hook)
   6358 	      (and org-cycle-level-after-item/entry-creation
   6359 		   (or (org-cycle-level)
   6360 		       (org-cycle-item-indentation))))
   6361     (let* ((limit-level
   6362 	    (or org-cycle-max-level
   6363 		(and (boundp 'org-inlinetask-min-level)
   6364 		     org-inlinetask-min-level
   6365 		     (1- org-inlinetask-min-level))))
   6366 	   (nstars
   6367 	    (and limit-level
   6368 		 (if org-odd-levels-only
   6369 		     (1- (* 2 limit-level))
   6370 		   limit-level)))
   6371 	   (org-outline-regexp
   6372 	    (format "\\*%s " (if nstars (format "\\{1,%d\\}" nstars) "+"))))
   6373       (cond
   6374        ((equal arg '(16))
   6375 	(setq last-command 'dummy)
   6376 	(org-set-startup-visibility)
   6377 	(org-unlogged-message "Startup visibility, plus VISIBILITY properties"))
   6378        ((equal arg '(64))
   6379 	(org-show-all)
   6380 	(org-unlogged-message "Entire buffer visible, including drawers"))
   6381        ((equal arg '(4)) (org-cycle-internal-global))
   6382        ;; Show-subtree, ARG levels up from here.
   6383        ((integerp arg)
   6384 	(save-excursion
   6385 	  (org-back-to-heading)
   6386 	  (outline-up-heading (if (< arg 0) (- arg)
   6387 				(- (funcall outline-level) arg)))
   6388 	  (org-show-subtree)))
   6389        ;; Global cycling at BOB: delegate to `org-cycle-internal-global'.
   6390        ((and org-cycle-global-at-bob
   6391 	     (bobp)
   6392 	     (not (looking-at org-outline-regexp)))
   6393 	(let ((org-cycle-hook
   6394 	       (remq 'org-optimize-window-after-visibility-change
   6395 		     org-cycle-hook)))
   6396 	  (org-cycle-internal-global)))
   6397        ;; Try CDLaTeX TAB completion.
   6398        ((org-try-cdlatex-tab))
   6399        ;; Inline task: delegate to `org-inlinetask-toggle-visibility'.
   6400        ((and (featurep 'org-inlinetask)
   6401 	     (org-inlinetask-at-task-p)
   6402 	     (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
   6403 	(org-inlinetask-toggle-visibility))
   6404        (t
   6405 	(let ((pos (point))
   6406 	      (element (org-element-at-point)))
   6407 	  (cond
   6408 	   ;; Try toggling visibility for block at point.
   6409 	   ((org-hide-block-toggle nil t element))
   6410 	   ;; Try toggling visibility for drawer at point.
   6411 	   ((org-hide-drawer-toggle nil t element))
   6412 	   ;; Table: enter it or move to the next field.
   6413 	   ((and (org-match-line "[ \t]*[|+]")
   6414 		 (org-element-lineage element '(table) t))
   6415 	    (if (and (eq 'table (org-element-type element))
   6416 		     (eq 'table.el (org-element-property :type element)))
   6417 		(message (substitute-command-keys "\\<org-mode-map>\
   6418 Use `\\[org-edit-special]' to edit table.el tables"))
   6419 	      (org-table-justify-field-maybe)
   6420 	      (call-interactively #'org-table-next-field)))
   6421 	   ((run-hook-with-args-until-success
   6422 	     'org-tab-after-check-for-table-hook))
   6423 	   ;; At an item/headline: delegate to `org-cycle-internal-local'.
   6424 	   ((and (or (and org-cycle-include-plain-lists
   6425 			  (let ((item (org-element-lineage element
   6426 							   '(item plain-list)
   6427 							   t)))
   6428 			    (and item
   6429 				 (= (line-beginning-position)
   6430 				    (org-element-property :post-affiliated
   6431 							  item)))))
   6432 		     (org-match-line org-outline-regexp))
   6433 		 (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
   6434 	    (org-cycle-internal-local))
   6435 	   ;; From there: TAB emulation and template completion.
   6436 	   (buffer-read-only (org-back-to-heading))
   6437 	   ((run-hook-with-args-until-success
   6438 	     'org-tab-after-check-for-cycling-hook))
   6439 	   ((run-hook-with-args-until-success
   6440 	     'org-tab-before-tab-emulation-hook))
   6441 	   ((and (eq org-cycle-emulate-tab 'exc-hl-bol)
   6442 		 (or (not (bolp))
   6443 		     (not (looking-at org-outline-regexp))))
   6444 	    (call-interactively (global-key-binding (kbd "TAB"))))
   6445 	   ((or (eq org-cycle-emulate-tab t)
   6446 		(and (memq org-cycle-emulate-tab '(white whitestart))
   6447 		     (save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
   6448 		     (or (and (eq org-cycle-emulate-tab 'white)
   6449 			      (= (match-end 0) (point-at-eol)))
   6450 			 (and (eq org-cycle-emulate-tab 'whitestart)
   6451 			      (>= (match-end 0) pos)))))
   6452 	    (call-interactively (global-key-binding (kbd "TAB"))))
   6453 	   (t
   6454 	    (save-excursion
   6455 	      (org-back-to-heading)
   6456 	      (org-cycle))))))))))
   6457 
   6458 (defun org-cycle-internal-global ()
   6459   "Do the global cycling action."
   6460   ;; Hack to avoid display of messages for .org  attachments in Gnus
   6461   (let ((ga (string-match-p "\\*fontification" (buffer-name))))
   6462     (cond
   6463      ((and (eq last-command this-command)
   6464 	   (eq org-cycle-global-status 'overview))
   6465       ;; We just created the overview - now do table of contents
   6466       ;; This can be slow in very large buffers, so indicate action
   6467       (run-hook-with-args 'org-pre-cycle-hook 'contents)
   6468       (unless ga (org-unlogged-message "CONTENTS..."))
   6469       (org-content)
   6470       (unless ga (org-unlogged-message "CONTENTS...done"))
   6471       (setq org-cycle-global-status 'contents)
   6472       (run-hook-with-args 'org-cycle-hook 'contents))
   6473 
   6474      ((and (eq last-command this-command)
   6475 	   (eq org-cycle-global-status 'contents))
   6476       ;; We just showed the table of contents - now show everything
   6477       (run-hook-with-args 'org-pre-cycle-hook 'all)
   6478       (org-show-all '(headings blocks))
   6479       (unless ga (org-unlogged-message "SHOW ALL"))
   6480       (setq org-cycle-global-status 'all)
   6481       (run-hook-with-args 'org-cycle-hook 'all))
   6482 
   6483      (t
   6484       ;; Default action: go to overview
   6485       (run-hook-with-args 'org-pre-cycle-hook 'overview)
   6486       (org-overview)
   6487       (unless ga (org-unlogged-message "OVERVIEW"))
   6488       (setq org-cycle-global-status 'overview)
   6489       (run-hook-with-args 'org-cycle-hook 'overview)))))
   6490 
   6491 (defvar org-called-with-limited-levels nil
   6492   "Non-nil when `org-with-limited-levels' is currently active.")
   6493 
   6494 (defun org-cycle-internal-local ()
   6495   "Do the local cycling action."
   6496   (let ((goal-column 0) eoh eol eos has-children children-skipped struct)
   6497     ;; First, determine end of headline (EOH), end of subtree or item
   6498     ;; (EOS), and if item or heading has children (HAS-CHILDREN).
   6499     (save-excursion
   6500       (if (org-at-item-p)
   6501 	  (progn
   6502 	    (beginning-of-line)
   6503 	    (setq struct (org-list-struct))
   6504 	    (setq eoh (point-at-eol))
   6505 	    (setq eos (org-list-get-item-end-before-blank (point) struct))
   6506 	    (setq has-children (org-list-has-child-p (point) struct)))
   6507 	(org-back-to-heading)
   6508 	(setq eoh (save-excursion (outline-end-of-heading) (point)))
   6509 	(setq eos (save-excursion
   6510 		    (org-end-of-subtree t t)
   6511 		    (unless (eobp) (forward-char -1))
   6512 		    (point)))
   6513 	(setq has-children
   6514 	      (or
   6515 	       (save-excursion
   6516 		 (let ((level (funcall outline-level)))
   6517 		   (outline-next-heading)
   6518 		   (and (org-at-heading-p t)
   6519 			(> (funcall outline-level) level))))
   6520 	       (and (eq org-cycle-include-plain-lists 'integrate)
   6521 		    (save-excursion
   6522 		      (org-list-search-forward (org-item-beginning-re) eos t))))))
   6523       ;; Determine end invisible part of buffer (EOL)
   6524       (beginning-of-line 2)
   6525       (while (and (not (eobp))		;this is like `next-line'
   6526 		  (get-char-property (1- (point)) 'invisible))
   6527 	(goto-char (next-single-char-property-change (point) 'invisible))
   6528 	(and (eolp) (beginning-of-line 2)))
   6529       (setq eol (point)))
   6530     ;; Find out what to do next and set `this-command'
   6531     (cond
   6532      ((= eos eoh)
   6533       ;; Nothing is hidden behind this heading
   6534       (unless (org-before-first-heading-p)
   6535 	(run-hook-with-args 'org-pre-cycle-hook 'empty))
   6536       (org-unlogged-message "EMPTY ENTRY")
   6537       (setq org-cycle-subtree-status nil)
   6538       (save-excursion
   6539 	(goto-char eos)
   6540 	(outline-next-heading)
   6541 	(when (org-invisible-p) (org-flag-heading nil))))
   6542      ((and (or (>= eol eos)
   6543 	       (not (string-match "\\S-" (buffer-substring eol eos))))
   6544 	   (or has-children
   6545 	       (not (setq children-skipped
   6546 			  org-cycle-skip-children-state-if-no-children))))
   6547       ;; Entire subtree is hidden in one line: children view
   6548       (unless (org-before-first-heading-p)
   6549 	(run-hook-with-args 'org-pre-cycle-hook 'children))
   6550       (if (org-at-item-p)
   6551 	  (org-list-set-item-visibility (point-at-bol) struct 'children)
   6552 	(org-show-entry)
   6553 	(org-with-limited-levels (org-show-children))
   6554 	(org-show-set-visibility 'tree)
   6555 	;; Fold every list in subtree to top-level items.
   6556 	(when (eq org-cycle-include-plain-lists 'integrate)
   6557 	  (save-excursion
   6558 	    (org-back-to-heading)
   6559 	    (while (org-list-search-forward (org-item-beginning-re) eos t)
   6560 	      (beginning-of-line 1)
   6561 	      (let* ((struct (org-list-struct))
   6562 		     (prevs (org-list-prevs-alist struct))
   6563 		     (end (org-list-get-bottom-point struct)))
   6564 		(dolist (e (org-list-get-all-items (point) struct prevs))
   6565 		  (org-list-set-item-visibility e struct 'folded))
   6566 		(goto-char (if (< end eos) end eos)))))))
   6567       (org-unlogged-message "CHILDREN")
   6568       (save-excursion
   6569 	(goto-char eos)
   6570 	(outline-next-heading)
   6571 	(when (org-invisible-p) (org-flag-heading nil)))
   6572       (setq org-cycle-subtree-status 'children)
   6573       (unless (org-before-first-heading-p)
   6574 	(run-hook-with-args 'org-cycle-hook 'children)))
   6575      ((or children-skipped
   6576 	  (and (eq last-command this-command)
   6577 	       (eq org-cycle-subtree-status 'children)))
   6578       ;; We just showed the children, or no children are there,
   6579       ;; now show everything.
   6580       (unless (org-before-first-heading-p)
   6581 	(run-hook-with-args 'org-pre-cycle-hook 'subtree))
   6582       (org-flag-region eoh eos nil 'outline)
   6583       (org-unlogged-message
   6584        (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
   6585       (setq org-cycle-subtree-status 'subtree)
   6586       (unless (org-before-first-heading-p)
   6587 	(run-hook-with-args 'org-cycle-hook 'subtree)))
   6588      (t
   6589       ;; Default action: hide the subtree.
   6590       (run-hook-with-args 'org-pre-cycle-hook 'folded)
   6591       (org-flag-region eoh eos t 'outline)
   6592       (org-unlogged-message "FOLDED")
   6593       (setq org-cycle-subtree-status 'folded)
   6594       (unless (org-before-first-heading-p)
   6595 	(run-hook-with-args 'org-cycle-hook 'folded))))))
   6596 
   6597 ;;;###autoload
   6598 (defun org-global-cycle (&optional arg)
   6599   "Cycle the global visibility.  For details see `org-cycle'.
   6600 With `\\[universal-argument]' prefix ARG, switch to startup visibility.
   6601 With a numeric prefix, show all headlines up to that level."
   6602   (interactive "P")
   6603   (cond
   6604    ((integerp arg)
   6605     (org-content arg)
   6606     (setq org-cycle-global-status 'contents))
   6607    ((equal arg '(4))
   6608     (org-set-startup-visibility)
   6609     (org-unlogged-message "Startup visibility, plus VISIBILITY properties."))
   6610    (t
   6611     (org-cycle '(4)))))
   6612 
   6613 (defun org-set-startup-visibility ()
   6614   "Set the visibility required by startup options and properties."
   6615   (cond
   6616    ((eq org-startup-folded t)
   6617     (org-overview))
   6618    ((eq org-startup-folded 'content)
   6619     (org-content))
   6620    ((eq org-startup-folded 'show2levels)
   6621     (org-content 2))
   6622    ((eq org-startup-folded 'show3levels)
   6623     (org-content 3))
   6624    ((eq org-startup-folded 'show4levels)
   6625     (org-content 4))
   6626    ((eq org-startup-folded 'show5levels)
   6627     (org-content 5))
   6628    ((or (eq org-startup-folded 'showeverything)
   6629 	(eq org-startup-folded nil))
   6630     (org-show-all)))
   6631   (unless (eq org-startup-folded 'showeverything)
   6632     (when org-hide-block-startup (org-hide-block-all))
   6633     (org-set-visibility-according-to-property)
   6634     (org-cycle-hide-archived-subtrees 'all)
   6635     (org-cycle-hide-drawers 'all)
   6636     (org-cycle-show-empty-lines t)))
   6637 
   6638 (defun org-set-visibility-according-to-property ()
   6639   "Switch subtree visibility according to VISIBILITY property."
   6640   (interactive)
   6641   (let ((regexp (org-re-property "VISIBILITY")))
   6642     (org-with-point-at 1
   6643       (while (re-search-forward regexp nil t)
   6644 	(let ((state (match-string 3)))
   6645 	  (if (not (org-at-property-p)) (outline-next-heading)
   6646 	    (save-excursion
   6647 	      (org-back-to-heading t)
   6648 	      (org-flag-subtree t)
   6649 	      (org-reveal)
   6650 	      (pcase state
   6651 		("folded"
   6652 		 (org-flag-subtree t))
   6653 		("children"
   6654 		 (org-show-hidden-entry)
   6655 		 (org-show-children))
   6656 		("content"
   6657 		 (save-excursion
   6658 		   (save-restriction
   6659 		     (org-narrow-to-subtree)
   6660 		     (org-content))))
   6661 		((or "all" "showall")
   6662 		 (outline-show-subtree))
   6663 		(_ nil)))
   6664 	    (org-end-of-subtree)))))))
   6665 
   6666 (defun org-overview ()
   6667   "Switch to overview mode, showing only top-level headlines."
   6668   (interactive)
   6669   (org-show-all '(headings drawers))
   6670   (save-excursion
   6671     (goto-char (point-min))
   6672     (when (re-search-forward org-outline-regexp-bol nil t)
   6673       (let* ((last (line-end-position))
   6674              (level (- (match-end 0) (match-beginning 0) 1))
   6675              (regexp (format "^\\*\\{1,%d\\} " level)))
   6676         (while (re-search-forward regexp nil :move)
   6677           (org-flag-region last (line-end-position 0) t 'outline)
   6678           (setq last (line-end-position))
   6679           (setq level (- (match-end 0) (match-beginning 0) 1))
   6680           (setq regexp (format "^\\*\\{1,%d\\} " level)))
   6681         (org-flag-region last (point) t 'outline)))))
   6682 
   6683 (defun org-content (&optional arg)
   6684   "Show all headlines in the buffer, like a table of contents.
   6685 With numerical argument N, show content up to level N."
   6686   (interactive "p")
   6687   (org-show-all '(headings drawers))
   6688   (save-excursion
   6689     (goto-char (point-max))
   6690     (let ((regexp (if (and (wholenump arg) (> arg 0))
   6691                       (format "^\\*\\{1,%d\\} " arg)
   6692                     "^\\*+ "))
   6693           (last (point)))
   6694       (while (re-search-backward regexp nil t)
   6695         (org-flag-region (line-end-position) last t 'outline)
   6696         (setq last (line-end-position 0))))))
   6697 
   6698 (defvar org-scroll-position-to-restore nil
   6699   "Temporarily store scroll position to restore.")
   6700 (defun org-optimize-window-after-visibility-change (state)
   6701   "Adjust the window after a change in outline visibility.
   6702 This function is the default value of the hook `org-cycle-hook'."
   6703   (when (get-buffer-window (current-buffer))
   6704     (let ((repeat (eq last-command this-command)))
   6705       (unless repeat
   6706 	(setq org-scroll-position-to-restore nil))
   6707       (cond
   6708        ((eq state 'content)  nil)
   6709        ((eq state 'all)      nil)
   6710        ((and org-scroll-position-to-restore repeat
   6711 	     (eq state 'folded))
   6712 	(set-window-start nil org-scroll-position-to-restore))
   6713        ((eq state 'folded) nil)
   6714        ((eq state 'children)
   6715 	(setq org-scroll-position-to-restore (window-start))
   6716 	(or (org-subtree-end-visible-p) (recenter 1)))
   6717        ((eq state 'subtree)
   6718 	(unless repeat
   6719 	  (setq org-scroll-position-to-restore (window-start)))
   6720 	(or (org-subtree-end-visible-p) (recenter 1)))))))
   6721 
   6722 (defun org-clean-visibility-after-subtree-move ()
   6723   "Fix visibility issues after moving a subtree."
   6724   ;; First, find a reasonable region to look at:
   6725   ;; Start two siblings above, end three below
   6726   (let* ((beg (save-excursion
   6727 		(and (org-get-previous-sibling)
   6728 		     (org-get-previous-sibling))
   6729 		(point)))
   6730 	 (end (save-excursion
   6731 		(and (org-get-next-sibling)
   6732 		     (org-get-next-sibling)
   6733 		     (org-get-next-sibling))
   6734 		(if (org-at-heading-p)
   6735 		    (point-at-eol)
   6736 		  (point))))
   6737 	 (level (looking-at "\\*+"))
   6738 	 (re (when level (concat "^" (regexp-quote (match-string 0)) " "))))
   6739     (save-excursion
   6740       (save-restriction
   6741 	(narrow-to-region beg end)
   6742 	(when re
   6743 	  ;; Properly fold already folded siblings
   6744 	  (goto-char (point-min))
   6745 	  (while (re-search-forward re nil t)
   6746 	    (when (and (not (org-invisible-p))
   6747 		       (org-invisible-p (line-end-position)))
   6748 	      (outline-hide-entry))))
   6749 	(org-cycle-hide-drawers 'all)
   6750 	(org-cycle-show-empty-lines 'overview)))))
   6751 
   6752 (defun org-cycle-show-empty-lines (state)
   6753   "Show empty lines above all visible headlines.
   6754 The region to be covered depends on STATE when called through
   6755 `org-cycle-hook'.  Lisp program can use t for STATE to get the
   6756 entire buffer covered.  Note that an empty line is only shown if there
   6757 are at least `org-cycle-separator-lines' empty lines before the headline."
   6758   (when (/= org-cycle-separator-lines 0)
   6759     (save-excursion
   6760       (let* ((n (abs org-cycle-separator-lines))
   6761 	     (re (cond
   6762 		  ((= n 1) "\\(\n[ \t]*\n\\*+\\) ")
   6763 		  ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ")
   6764 		  (t (let ((ns (number-to-string (- n 2))))
   6765 		       (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}"
   6766 			       "[ \t]*\\(\n[ \t]*\n\\*+\\) ")))))
   6767 	     beg end)
   6768 	(cond
   6769 	 ((memq state '(overview contents t))
   6770 	  (setq beg (point-min) end (point-max)))
   6771 	 ((memq state '(children folded))
   6772 	  (setq beg (point)
   6773 		end (progn (org-end-of-subtree t t)
   6774 			   (line-beginning-position 2)))))
   6775 	(when beg
   6776 	  (goto-char beg)
   6777 	  (while (re-search-forward re end t)
   6778 	    (unless (get-char-property (match-end 1) 'invisible)
   6779 	      (let ((e (match-end 1))
   6780 		    (b (if (>= org-cycle-separator-lines 0)
   6781 			   (match-beginning 1)
   6782 			 (save-excursion
   6783 			   (goto-char (match-beginning 0))
   6784 			   (skip-chars-backward " \t\n")
   6785 			   (line-end-position)))))
   6786 		(org-flag-region b e nil 'outline))))))))
   6787   ;; Never hide empty lines at the end of the file.
   6788   (save-excursion
   6789     (goto-char (point-max))
   6790     (outline-previous-heading)
   6791     (outline-end-of-heading)
   6792     (when (and (looking-at "[ \t\n]+")
   6793 	       (= (match-end 0) (point-max)))
   6794       (org-flag-region (point) (match-end 0) nil 'outline))))
   6795 
   6796 ;;;; Reveal point location
   6797 
   6798 (defun org-show-context (&optional key)
   6799   "Make sure point and context are visible.
   6800 Optional argument KEY, when non-nil, is a symbol.  See
   6801 `org-show-context-detail' for allowed values and how much is to
   6802 be shown."
   6803   (org-show-set-visibility
   6804    (cond ((symbolp org-show-context-detail) org-show-context-detail)
   6805 	 ((cdr (assq key org-show-context-detail)))
   6806 	 (t (cdr (assq 'default org-show-context-detail))))))
   6807 
   6808 (defun org-show-set-visibility (detail)
   6809   "Set visibility around point according to DETAIL.
   6810 DETAIL is either nil, `minimal', `local', `ancestors',
   6811 `ancestors-full', `lineage', `tree', `canonical' or t.  See
   6812 `org-show-context-detail' for more information."
   6813   ;; Show current heading and possibly its entry, following headline
   6814   ;; or all children.
   6815   (if (and (org-at-heading-p) (not (eq detail 'local)))
   6816       (org-flag-heading nil)
   6817     (org-show-entry)
   6818     ;; If point is hidden within a drawer or a block, make sure to
   6819     ;; expose it.
   6820     (dolist (o (overlays-at (point)))
   6821       (when (memq (overlay-get o 'invisible) '(org-hide-block outline))
   6822 	(delete-overlay o)))
   6823     (unless (org-before-first-heading-p)
   6824       (org-with-limited-levels
   6825        (cl-case detail
   6826 	 ((tree canonical t) (org-show-children))
   6827 	 ((nil minimal ancestors ancestors-full))
   6828 	 (t (save-excursion
   6829 	      (outline-next-heading)
   6830 	      (org-flag-heading nil)))))))
   6831   ;; Show whole subtree.
   6832   (when (eq detail 'ancestors-full) (org-show-subtree))
   6833   ;; Show all siblings.
   6834   (when (eq detail 'lineage) (org-show-siblings))
   6835   ;; Show ancestors, possibly with their children.
   6836   (when (memq detail '(ancestors ancestors-full lineage tree canonical t))
   6837     (save-excursion
   6838       (while (org-up-heading-safe)
   6839 	(org-flag-heading nil)
   6840 	(when (memq detail '(canonical t)) (org-show-entry))
   6841 	(when (memq detail '(tree canonical t)) (org-show-children))))))
   6842 
   6843 (defvar org-reveal-start-hook nil
   6844   "Hook run before revealing a location.")
   6845 
   6846 (defun org-reveal (&optional siblings)
   6847   "Show current entry, hierarchy above it, and the following headline.
   6848 
   6849 This can be used to show a consistent set of context around
   6850 locations exposed with `org-show-context'.
   6851 
   6852 With optional argument SIBLINGS, on each level of the hierarchy all
   6853 siblings are shown.  This repairs the tree structure to what it would
   6854 look like when opened with hierarchical calls to `org-cycle'.
   6855 
   6856 With a \\[universal-argument] \\[universal-argument] prefix, \
   6857 go to the parent and show the entire tree."
   6858   (interactive "P")
   6859   (run-hooks 'org-reveal-start-hook)
   6860   (cond ((equal siblings '(4)) (org-show-set-visibility 'canonical))
   6861 	((equal siblings '(16))
   6862 	 (save-excursion
   6863 	   (when (org-up-heading-safe)
   6864 	     (org-show-subtree)
   6865 	     (run-hook-with-args 'org-cycle-hook 'subtree))))
   6866 	(t (org-show-set-visibility 'lineage))))
   6867 
   6868 
   6869 ;;; Indirect buffer display of subtrees
   6870 
   6871 (defvar org-indirect-dedicated-frame nil
   6872   "This is the frame being used for indirect tree display.")
   6873 (defvar org-last-indirect-buffer nil)
   6874 
   6875 (defun org-tree-to-indirect-buffer (&optional arg)
   6876   "Create indirect buffer and narrow it to current subtree.
   6877 
   6878 With a numerical prefix ARG, go up to this level and then take that tree.
   6879 If ARG is negative, go up that many levels.
   6880 
   6881 If `org-indirect-buffer-display' is not `new-frame', the command removes the
   6882 indirect buffer previously made with this command, to avoid proliferation of
   6883 indirect buffers.  However, when you call the command with a \
   6884 `\\[universal-argument]' prefix, or
   6885 when `org-indirect-buffer-display' is `new-frame', the last buffer is kept
   6886 so that you can work with several indirect buffers at the same time.  If
   6887 `org-indirect-buffer-display' is `dedicated-frame', the \
   6888 `\\[universal-argument]' prefix also
   6889 requests that a new frame be made for the new buffer, so that the dedicated
   6890 frame is not changed."
   6891   (interactive "P")
   6892   (let ((cbuf (current-buffer))
   6893 	(cwin (selected-window))
   6894 	(pos (point))
   6895 	beg end level heading ibuf)
   6896     (save-excursion
   6897       (org-back-to-heading t)
   6898       (when (numberp arg)
   6899 	(setq level (org-outline-level))
   6900 	(when (< arg 0) (setq arg (+ level arg)))
   6901 	(while (> (setq level (org-outline-level)) arg)
   6902 	  (org-up-heading-safe)))
   6903       (setq beg (point)
   6904 	    heading (org-get-heading 'no-tags))
   6905       (org-end-of-subtree t t)
   6906       (when (org-at-heading-p) (backward-char 1))
   6907       (setq end (point)))
   6908     (when (and (buffer-live-p org-last-indirect-buffer)
   6909 	       (not (eq org-indirect-buffer-display 'new-frame))
   6910 	       (not arg))
   6911       (kill-buffer org-last-indirect-buffer))
   6912     (setq ibuf (org-get-indirect-buffer cbuf heading)
   6913 	  org-last-indirect-buffer ibuf)
   6914     (cond
   6915      ((or (eq org-indirect-buffer-display 'new-frame)
   6916 	  (and arg (eq org-indirect-buffer-display 'dedicated-frame)))
   6917       (select-frame (make-frame))
   6918       (delete-other-windows)
   6919       (pop-to-buffer-same-window ibuf)
   6920       (org-set-frame-title heading))
   6921      ((eq org-indirect-buffer-display 'dedicated-frame)
   6922       (raise-frame
   6923        (select-frame (or (and org-indirect-dedicated-frame
   6924 			      (frame-live-p org-indirect-dedicated-frame)
   6925 			      org-indirect-dedicated-frame)
   6926 			 (setq org-indirect-dedicated-frame (make-frame)))))
   6927       (delete-other-windows)
   6928       (pop-to-buffer-same-window ibuf)
   6929       (org-set-frame-title (concat "Indirect: " heading)))
   6930      ((eq org-indirect-buffer-display 'current-window)
   6931       (pop-to-buffer-same-window ibuf))
   6932      ((eq org-indirect-buffer-display 'other-window)
   6933       (pop-to-buffer ibuf))
   6934      (t (error "Invalid value")))
   6935     (narrow-to-region beg end)
   6936     (org-show-all '(headings drawers blocks))
   6937     (goto-char pos)
   6938     (run-hook-with-args 'org-cycle-hook 'all)
   6939     (and (window-live-p cwin) (select-window cwin))))
   6940 
   6941 (defun org-get-indirect-buffer (&optional buffer heading)
   6942   (setq buffer (or buffer (current-buffer)))
   6943   (let ((n 1) (base (buffer-name buffer)) bname)
   6944     (while (buffer-live-p
   6945 	    (get-buffer
   6946 	     (setq bname
   6947 		   (concat base "-"
   6948 			   (if heading (concat heading "-" (number-to-string n))
   6949 			     (number-to-string n))))))
   6950       (setq n (1+ n)))
   6951     (condition-case nil
   6952         (make-indirect-buffer buffer bname 'clone)
   6953       (error (make-indirect-buffer buffer bname)))))
   6954 
   6955 (defun org-set-frame-title (title)
   6956   "Set the title of the current frame to the string TITLE."
   6957   (modify-frame-parameters (selected-frame) (list (cons 'name title))))
   6958 
   6959 ;;;; Structure editing
   6960 
   6961 ;;; Inserting headlines
   6962 
   6963 (defun org--blank-before-heading-p (&optional parent)
   6964   "Non-nil when an empty line should precede a new heading here.
   6965 When optional argument PARENT is non-nil, consider parent
   6966 headline instead of current one."
   6967   (pcase (assq 'heading org-blank-before-new-entry)
   6968     (`(heading . auto)
   6969      (save-excursion
   6970        (org-with-limited-levels
   6971         (unless (and (org-before-first-heading-p)
   6972                      (not (outline-next-heading)))
   6973           (org-back-to-heading t)
   6974           (when parent (org-up-heading-safe))
   6975           (cond ((not (bobp))
   6976                  (org-previous-line-empty-p))
   6977 		((outline-next-heading)
   6978 		 (org-previous-line-empty-p))
   6979 		;; Ignore trailing spaces on last buffer line.
   6980 		((progn (skip-chars-backward " \t") (bolp))
   6981 		 (org-previous-line-empty-p))
   6982 		(t nil))))))
   6983     (`(heading . ,value) value)
   6984     (_ nil)))
   6985 
   6986 (defun org-insert-heading (&optional arg invisible-ok top)
   6987   "Insert a new heading or an item with the same depth at point.
   6988 
   6989 If point is at the beginning of a heading, insert a new heading
   6990 or a new headline above the current one.  When at the beginning
   6991 of a regular line of text, turn it into a heading.
   6992 
   6993 If point is in the middle of a line, split it and create a new
   6994 headline with the text in the current line after point (see
   6995 `org-M-RET-may-split-line' on how to modify this behavior).  As
   6996 a special case, on a headline, splitting can only happen on the
   6997 title itself.  E.g., this excludes breaking stars or tags.
   6998 
   6999 With a `\\[universal-argument]' prefix, set \
   7000 `org-insert-heading-respect-content' to
   7001 a non-nil value for the duration of the command.  This forces the
   7002 insertion of a heading after the current subtree, independently
   7003 on the location of point.
   7004 
   7005 With a `\\[universal-argument] \\[universal-argument]' prefix, \
   7006 insert the heading at the end of the tree
   7007 above the current heading.  For example, if point is within a
   7008 2nd-level heading, then it will insert a 2nd-level heading at
   7009 the end of the 1st-level parent subtree.
   7010 
   7011 When INVISIBLE-OK is set, stop at invisible headlines when going
   7012 back.  This is important for non-interactive uses of the
   7013 command.
   7014 
   7015 When optional argument TOP is non-nil, insert a level 1 heading,
   7016 unconditionally."
   7017   (interactive "P")
   7018   (let* ((blank? (org--blank-before-heading-p (equal arg '(16))))
   7019 	 (level (org-current-level))
   7020 	 (stars (make-string (if (and level (not top)) level 1) ?*)))
   7021     (cond
   7022      ((or org-insert-heading-respect-content
   7023 	  (member arg '((4) (16)))
   7024 	  (and (not invisible-ok)
   7025 	       (invisible-p (max (1- (point)) (point-min)))))
   7026       ;; Position point at the location of insertion.  Make sure we
   7027       ;; end up on a visible headline if INVISIBLE-OK is nil.
   7028       (org-with-limited-levels
   7029        (if (not level) (outline-next-heading) ;before first headline
   7030 	 (org-back-to-heading invisible-ok)
   7031 	 (when (equal arg '(16)) (org-up-heading-safe))
   7032 	 (org-end-of-subtree)))
   7033       (unless (bolp) (insert "\n"))
   7034       (when (and blank? (save-excursion
   7035                           (backward-char)
   7036                           (org-before-first-heading-p)))
   7037         (insert "\n")
   7038         (backward-char))
   7039       (when (and (not level) (not (eobp)) (not (bobp)))
   7040         (when (org-at-heading-p) (insert "\n"))
   7041         (backward-char))
   7042       (unless (and blank? (org-previous-line-empty-p))
   7043 	(org-N-empty-lines-before-current (if blank? 1 0)))
   7044       (insert stars " ")
   7045       ;; When INVISIBLE-OK is non-nil, ensure newly created headline
   7046       ;; is visible.
   7047       (unless invisible-ok
   7048 	(pcase (get-char-property-and-overlay (point) 'invisible)
   7049 	  (`(outline . ,o)
   7050 	   (move-overlay o (overlay-start o) (line-end-position 0)))
   7051 	  (_ nil))))
   7052      ;; At a headline...
   7053      ((org-at-heading-p)
   7054       (cond ((bolp)
   7055 	     (when blank? (save-excursion (insert "\n")))
   7056 	     (save-excursion (insert stars " \n"))
   7057 	     (unless (and blank? (org-previous-line-empty-p))
   7058 	       (org-N-empty-lines-before-current (if blank? 1 0)))
   7059 	     (end-of-line))
   7060 	    ((and (org-get-alist-option org-M-RET-may-split-line 'headline)
   7061 		  (org-match-line org-complex-heading-regexp)
   7062 		  (org-pos-in-match-range (point) 4))
   7063 	     ;; Grab the text that should moved to the new headline.
   7064 	     ;; Preserve tags.
   7065 	     (let ((split (delete-and-extract-region (point) (match-end 4))))
   7066 	       (if (looking-at "[ \t]*$") (replace-match "")
   7067 		 (org-align-tags))
   7068 	       (end-of-line)
   7069 	       (when blank? (insert "\n"))
   7070 	       (insert "\n" stars " ")
   7071 	       (when (org-string-nw-p split) (insert split))))
   7072 	    (t
   7073 	     (end-of-line)
   7074 	     (when blank? (insert "\n"))
   7075 	     (insert "\n" stars " "))))
   7076      ;; On regular text, turn line into a headline or split, if
   7077      ;; appropriate.
   7078      ((bolp)
   7079       (insert stars " ")
   7080       (unless (and blank? (org-previous-line-empty-p))
   7081         (org-N-empty-lines-before-current (if blank? 1 0))))
   7082      (t
   7083       (unless (org-get-alist-option org-M-RET-may-split-line 'headline)
   7084         (end-of-line))
   7085       (insert "\n" stars " ")
   7086       (unless (and blank? (org-previous-line-empty-p))
   7087         (org-N-empty-lines-before-current (if blank? 1 0))))))
   7088   (run-hooks 'org-insert-heading-hook))
   7089 
   7090 (defun org-N-empty-lines-before-current (n)
   7091   "Make the number of empty lines before current exactly N.
   7092 So this will delete or add empty lines."
   7093   (let ((column (current-column)))
   7094     (beginning-of-line)
   7095     (unless (bobp)
   7096       (let ((start (save-excursion
   7097 		     (skip-chars-backward " \r\t\n")
   7098 		     (line-end-position))))
   7099 	(delete-region start (line-end-position 0))))
   7100     (insert (make-string n ?\n))
   7101     (move-to-column column)))
   7102 
   7103 (defun org-get-heading (&optional no-tags no-todo no-priority no-comment)
   7104   "Return the heading of the current entry, without the stars.
   7105 When NO-TAGS is non-nil, don't include tags.
   7106 When NO-TODO is non-nil, don't include TODO keywords.
   7107 When NO-PRIORITY is non-nil, don't include priority cookie.
   7108 When NO-COMMENT is non-nil, don't include COMMENT string.
   7109 Return nil before first heading."
   7110   (unless (org-before-first-heading-p)
   7111     (save-excursion
   7112       (org-back-to-heading t)
   7113       (let ((case-fold-search nil))
   7114 	(looking-at org-complex-heading-regexp)
   7115 	(let ((todo (and (not no-todo) (match-string 2)))
   7116 	      (priority (and (not no-priority) (match-string 3)))
   7117 	      (headline (pcase (match-string 4)
   7118 			  (`nil "")
   7119 			  ((and (guard no-comment) h)
   7120 			   (replace-regexp-in-string
   7121 			    (eval-when-compile
   7122 			      (format "\\`%s[ \t]+" org-comment-string))
   7123 			    "" h))
   7124 			  (h h)))
   7125 	      (tags (and (not no-tags) (match-string 5))))
   7126 	  (mapconcat #'identity
   7127 		     (delq nil (list todo priority headline tags))
   7128 		     " "))))))
   7129 
   7130 (defun org-heading-components ()
   7131   "Return the components of the current heading.
   7132 This is a list with the following elements:
   7133 - the level as an integer
   7134 - the reduced level, different if `org-odd-levels-only' is set.
   7135 - the TODO keyword, or nil
   7136 - the priority character, like ?A, or nil if no priority is given
   7137 - the headline text itself, or the tags string if no headline text
   7138 - the tags string, or nil."
   7139   (save-excursion
   7140     (org-back-to-heading t)
   7141     (when (let (case-fold-search) (looking-at org-complex-heading-regexp))
   7142       (list (length (match-string 1))
   7143 	    (org-reduced-level (length (match-string 1)))
   7144 	    (match-string-no-properties 2)
   7145 	    (and (match-end 3) (aref (match-string 3) 2))
   7146 	    (match-string-no-properties 4)
   7147 	    (match-string-no-properties 5)))))
   7148 
   7149 (defun org-get-entry ()
   7150   "Get the entry text, after heading, entire subtree."
   7151   (save-excursion
   7152     (org-back-to-heading t)
   7153     (buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
   7154 
   7155 (defun org-edit-headline (&optional heading)
   7156   "Edit the current headline.
   7157 Set it to HEADING when provided."
   7158   (interactive)
   7159   (org-with-wide-buffer
   7160    (org-back-to-heading t)
   7161    (let ((case-fold-search nil))
   7162      (when (looking-at org-complex-heading-regexp)
   7163        (let* ((old (match-string-no-properties 4))
   7164 	      (new (save-match-data
   7165 		     (org-trim (or heading (read-string "Edit: " old))))))
   7166 	 (unless (equal old new)
   7167 	   (if old (replace-match new t t nil 4)
   7168 	     (goto-char (or (match-end 3) (match-end 2) (match-end 1)))
   7169 	     (insert " " new))
   7170 	   (org-align-tags)
   7171 	   (when (looking-at "[ \t]*$") (replace-match ""))))))))
   7172 
   7173 (defun org-insert-heading-after-current ()
   7174   "Insert a new heading with same level as current, after current subtree."
   7175   (interactive)
   7176   (org-back-to-heading)
   7177   (org-insert-heading)
   7178   (org-move-subtree-down)
   7179   (end-of-line 1))
   7180 
   7181 (defun org-insert-heading-respect-content (&optional invisible-ok)
   7182   "Insert heading with `org-insert-heading-respect-content' set to t."
   7183   (interactive)
   7184   (org-insert-heading '(4) invisible-ok))
   7185 
   7186 (defun org-insert-todo-heading-respect-content (&optional force-state)
   7187   "Insert TODO heading with `org-insert-heading-respect-content' set to t."
   7188   (interactive)
   7189   (org-insert-todo-heading force-state '(4)))
   7190 
   7191 (defun org-insert-todo-heading (arg &optional force-heading)
   7192   "Insert a new heading with the same level and TODO state as current heading.
   7193 
   7194 If the heading has no TODO state, or if the state is DONE, use
   7195 the first state (TODO by default).  Also with one prefix arg,
   7196 force first state.  With two prefix args, force inserting at the
   7197 end of the parent subtree.
   7198 
   7199 When called at a plain list item, insert a new item with an
   7200 unchecked check box."
   7201   (interactive "P")
   7202   (when (or force-heading (not (org-insert-item 'checkbox)))
   7203     (org-insert-heading (or (and (equal arg '(16)) '(16))
   7204 			    force-heading))
   7205     (save-excursion
   7206       (org-forward-heading-same-level -1)
   7207       (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)))
   7208     (let* ((new-mark-x
   7209 	    (if (or (equal arg '(4))
   7210 		    (not (match-beginning 2))
   7211 		    (member (match-string 2) org-done-keywords))
   7212 		(car org-todo-keywords-1)
   7213 	      (match-string 2)))
   7214 	   (new-mark
   7215 	    (or
   7216 	     (run-hook-with-args-until-success
   7217 	      'org-todo-get-default-hook new-mark-x nil)
   7218 	     new-mark-x)))
   7219       (beginning-of-line 1)
   7220       (and (looking-at org-outline-regexp) (goto-char (match-end 0))
   7221 	   (if org-treat-insert-todo-heading-as-state-change
   7222 	       (org-todo new-mark)
   7223 	     (insert new-mark " "))))
   7224     (when org-provide-todo-statistics
   7225       (org-update-parent-todo-statistics))))
   7226 
   7227 (defun org-insert-subheading (arg)
   7228   "Insert a new subheading and demote it.
   7229 Works for outline headings and for plain lists alike."
   7230   (interactive "P")
   7231   (org-insert-heading arg)
   7232   (cond
   7233    ((org-at-heading-p) (org-do-demote))
   7234    ((org-at-item-p) (org-indent-item))))
   7235 
   7236 (defun org-insert-todo-subheading (arg)
   7237   "Insert a new subheading with TODO keyword or checkbox and demote it.
   7238 Works for outline headings and for plain lists alike."
   7239   (interactive "P")
   7240   (org-insert-todo-heading arg)
   7241   (cond
   7242    ((org-at-heading-p) (org-do-demote))
   7243    ((org-at-item-p) (org-indent-item))))
   7244 
   7245 ;;; Promotion and Demotion
   7246 
   7247 (defvar org-after-demote-entry-hook nil
   7248   "Hook run after an entry has been demoted.
   7249 The cursor will be at the beginning of the entry.
   7250 When a subtree is being demoted, the hook will be called for each node.")
   7251 
   7252 (defvar org-after-promote-entry-hook nil
   7253   "Hook run after an entry has been promoted.
   7254 The cursor will be at the beginning of the entry.
   7255 When a subtree is being promoted, the hook will be called for each node.")
   7256 
   7257 (defun org-promote-subtree ()
   7258   "Promote the entire subtree.
   7259 See also `org-promote'."
   7260   (interactive)
   7261   (save-excursion
   7262     (org-with-limited-levels (org-map-tree 'org-promote)))
   7263   (org-fix-position-after-promote))
   7264 
   7265 (defun org-demote-subtree ()
   7266   "Demote the entire subtree.
   7267 See `org-demote' and `org-promote'."
   7268   (interactive)
   7269   (save-excursion
   7270     (org-with-limited-levels (org-map-tree 'org-demote)))
   7271   (org-fix-position-after-promote))
   7272 
   7273 (defun org-do-promote ()
   7274   "Promote the current heading higher up the tree.
   7275 If the region is active in `transient-mark-mode', promote all
   7276 headings in the region."
   7277   (interactive)
   7278   (save-excursion
   7279     (if (org-region-active-p)
   7280 	(org-map-region 'org-promote (region-beginning) (region-end))
   7281       (org-promote)))
   7282   (org-fix-position-after-promote))
   7283 
   7284 (defun org-do-demote ()
   7285   "Demote the current heading lower down the tree.
   7286 If the region is active in `transient-mark-mode', demote all
   7287 headings in the region."
   7288   (interactive)
   7289   (save-excursion
   7290     (if (org-region-active-p)
   7291 	(org-map-region 'org-demote (region-beginning) (region-end))
   7292       (org-demote)))
   7293   (org-fix-position-after-promote))
   7294 
   7295 (defun org-fix-position-after-promote ()
   7296   "Fix cursor position and indentation after demoting/promoting."
   7297   (let ((pos (point)))
   7298     (when (save-excursion
   7299 	    (beginning-of-line)
   7300 	    (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
   7301 	    (or (eq pos (match-end 1)) (eq pos (match-end 2))))
   7302       (cond ((eobp) (insert " "))
   7303 	    ((eolp) (insert " "))
   7304 	    ((equal (char-after) ?\s) (forward-char 1))))))
   7305 
   7306 (defun org-current-level ()
   7307   "Return the level of the current entry, or nil if before the first headline.
   7308 The level is the number of stars at the beginning of the
   7309 headline.  Use `org-reduced-level' to remove the effect of
   7310 `org-odd-levels'.  Unlike to `org-outline-level', this function
   7311 ignores inlinetasks."
   7312   (let ((level (org-with-limited-levels (org-outline-level))))
   7313     (and (> level 0) level)))
   7314 
   7315 (defun org-get-previous-line-level ()
   7316   "Return the outline depth of the last headline before the current line.
   7317 Returns 0 for the first headline in the buffer, and nil if before the
   7318 first headline."
   7319   (and (org-current-level)
   7320        (or (and (/= (line-beginning-position) (point-min))
   7321 		(save-excursion (beginning-of-line 0) (org-current-level)))
   7322 	   0)))
   7323 
   7324 (defun org-reduced-level (l)
   7325   "Compute the effective level of a heading.
   7326 This takes into account the setting of `org-odd-levels-only'."
   7327   (cond
   7328    ((zerop l) 0)
   7329    (org-odd-levels-only (1+ (floor (/ l 2))))
   7330    (t l)))
   7331 
   7332 (defun org-level-increment ()
   7333   "Return the number of stars that will be added or removed at a
   7334 time to headlines when structure editing, based on the value of
   7335 `org-odd-levels-only'."
   7336   (if org-odd-levels-only 2 1))
   7337 
   7338 (defun org-get-valid-level (level &optional change)
   7339   "Rectify a level change under the influence of `org-odd-levels-only'.
   7340 LEVEL is a current level, CHANGE is by how much the level should
   7341 be modified.  Even if CHANGE is nil, LEVEL may be returned
   7342 modified because even level numbers will become the next higher
   7343 odd number.  Returns values greater than 0."
   7344   (if org-odd-levels-only
   7345       (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2))))
   7346 	    ((> change 0) (1+ (* 2 (/ (+ (1- level) (* 2 change)) 2))))
   7347 	    ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2))))))
   7348     (max 1 (+ level (or change 0)))))
   7349 
   7350 (defun org-promote ()
   7351   "Promote the current heading higher up the tree."
   7352   (org-with-wide-buffer
   7353    (org-back-to-heading t)
   7354    (let* ((after-change-functions (remq 'flyspell-after-change-function
   7355 					after-change-functions))
   7356 	  (level (save-match-data (funcall outline-level)))
   7357 	  (up-head (concat (make-string (org-get-valid-level level -1) ?*) " "))
   7358 	  (diff (abs (- level (length up-head) -1))))
   7359      (cond
   7360       ((and (= level 1) org-allow-promoting-top-level-subtree)
   7361        (replace-match "# " nil t))
   7362       ((= level 1)
   7363        (user-error "Cannot promote to level 0.  UNDO to recover if necessary"))
   7364       (t (replace-match up-head nil t)))
   7365      (unless (= level 1)
   7366        (when org-auto-align-tags (org-align-tags))
   7367        (when org-adapt-indentation (org-fixup-indentation (- diff))))
   7368      (run-hooks 'org-after-promote-entry-hook))))
   7369 
   7370 (defun org-demote ()
   7371   "Demote the current heading lower down the tree."
   7372   (org-with-wide-buffer
   7373    (org-back-to-heading t)
   7374    (let* ((after-change-functions (remq 'flyspell-after-change-function
   7375 					after-change-functions))
   7376 	  (level (save-match-data (funcall outline-level)))
   7377 	  (down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
   7378 	  (diff (abs (- level (length down-head) -1))))
   7379      (replace-match down-head nil t)
   7380      (when org-auto-align-tags (org-align-tags))
   7381      (when org-adapt-indentation (org-fixup-indentation diff))
   7382      (run-hooks 'org-after-demote-entry-hook))))
   7383 
   7384 (defun org-cycle-level ()
   7385   "Cycle the level of an empty headline through possible states.
   7386 This goes first to child, then to parent, level, then up the hierarchy.
   7387 After top level, it switches back to sibling level."
   7388   (interactive)
   7389   (let ((org-adapt-indentation nil))
   7390     (when (org-point-at-end-of-empty-headline)
   7391       (setq this-command 'org-cycle-level) ; Only needed for caching
   7392       (let ((cur-level (org-current-level))
   7393             (prev-level (org-get-previous-line-level)))
   7394         (cond
   7395          ;; If first headline in file, promote to top-level.
   7396          ((= prev-level 0)
   7397           (cl-loop repeat (/ (- cur-level 1) (org-level-increment))
   7398 		   do (org-do-promote)))
   7399          ;; If same level as prev, demote one.
   7400          ((= prev-level cur-level)
   7401           (org-do-demote))
   7402          ;; If parent is top-level, promote to top level if not already.
   7403          ((= prev-level 1)
   7404           (cl-loop repeat (/ (- cur-level 1) (org-level-increment))
   7405 		   do (org-do-promote)))
   7406          ;; If top-level, return to prev-level.
   7407          ((= cur-level 1)
   7408           (cl-loop repeat (/ (- prev-level 1) (org-level-increment))
   7409 		   do (org-do-demote)))
   7410          ;; If less than prev-level, promote one.
   7411          ((< cur-level prev-level)
   7412           (org-do-promote))
   7413          ;; If deeper than prev-level, promote until higher than
   7414          ;; prev-level.
   7415          ((> cur-level prev-level)
   7416           (cl-loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment)))
   7417 		   do (org-do-promote))))
   7418         t))))
   7419 
   7420 (defun org-map-tree (fun)
   7421   "Call FUN for every heading underneath the current one."
   7422   (org-back-to-heading t)
   7423   (let ((level (funcall outline-level)))
   7424     (save-excursion
   7425       (funcall fun)
   7426       (while (and (progn
   7427 		    (outline-next-heading)
   7428 		    (> (funcall outline-level) level))
   7429 		  (not (eobp)))
   7430 	(funcall fun)))))
   7431 
   7432 (defun org-map-region (fun beg end)
   7433   "Call FUN for every heading between BEG and END."
   7434   (let ((org-ignore-region t))
   7435     (save-excursion
   7436       (setq end (copy-marker end))
   7437       (goto-char beg)
   7438       (when (and (re-search-forward org-outline-regexp-bol nil t)
   7439 		 (< (point) end))
   7440 	(funcall fun))
   7441       (while (and (progn
   7442 		    (outline-next-heading)
   7443 		    (< (point) end))
   7444 		  (not (eobp)))
   7445 	(funcall fun)))))
   7446 
   7447 (defun org-fixup-indentation (diff)
   7448   "Change the indentation in the current entry by DIFF.
   7449 
   7450 DIFF is an integer.  Indentation is done according to the
   7451 following rules:
   7452 
   7453   - Planning information and property drawers are always indented
   7454     according to the new level of the headline;
   7455 
   7456   - Footnote definitions and their contents are ignored;
   7457 
   7458   - Inlinetasks' boundaries are not shifted;
   7459 
   7460   - Empty lines are ignored;
   7461 
   7462   - Other lines' indentation are shifted by DIFF columns, unless
   7463     it would introduce a structural change in the document, in
   7464     which case no shifting is done at all.
   7465 
   7466 Assume point is at a heading or an inlinetask beginning."
   7467   (org-with-wide-buffer
   7468    (narrow-to-region (line-beginning-position)
   7469 		     (save-excursion
   7470 		       (if (org-with-limited-levels (org-at-heading-p))
   7471 			   (org-with-limited-levels (outline-next-heading))
   7472 			 (org-inlinetask-goto-end))
   7473 		       (point)))
   7474    (forward-line)
   7475    ;; Indent properly planning info and property drawer.
   7476    (when (looking-at-p org-planning-line-re)
   7477      (org-indent-line)
   7478      (forward-line))
   7479    (when (looking-at org-property-drawer-re)
   7480      (goto-char (match-end 0))
   7481      (forward-line)
   7482      (org-indent-region (match-beginning 0) (match-end 0)))
   7483    (when (looking-at org-logbook-drawer-re)
   7484      (let ((end-marker  (move-marker (make-marker) (match-end 0)))
   7485 	   (col (+ (current-indentation) diff)))
   7486        (when (wholenump col)
   7487 	 (while (< (point) end-marker)
   7488            (if (natnump diff)
   7489 	       (insert (make-string diff 32))
   7490              (delete-char (abs diff)))
   7491 	   (forward-line)))))
   7492    (catch 'no-shift
   7493      (when (or (zerop diff) (not (eq org-adapt-indentation t)))
   7494        (throw 'no-shift nil))
   7495      ;; If DIFF is negative, first check if a shift is possible at all
   7496      ;; (e.g., it doesn't break structure).  This can only happen if
   7497      ;; some contents are not properly indented.
   7498      (let ((case-fold-search t))
   7499        (when (< diff 0)
   7500 	 (let ((diff (- diff))
   7501 	       (forbidden-re (concat org-outline-regexp
   7502 				     "\\|"
   7503 				     (substring org-footnote-definition-re 1))))
   7504 	   (save-excursion
   7505 	     (while (not (eobp))
   7506 	       (cond
   7507 		((looking-at-p "[ \t]*$") (forward-line))
   7508 		((and (looking-at-p org-footnote-definition-re)
   7509 		      (let ((e (org-element-at-point)))
   7510 			(and (eq (org-element-type e) 'footnote-definition)
   7511 			     (goto-char (org-element-property :end e))))))
   7512 		((looking-at-p org-outline-regexp) (forward-line))
   7513 		;; Give up if shifting would move before column 0 or
   7514 		;; if it would introduce a headline or a footnote
   7515 		;; definition.
   7516 		(t
   7517 		 (skip-chars-forward " \t")
   7518 		 (let ((ind (current-column)))
   7519 		   (when (or (< ind diff)
   7520 			     (and (= ind diff) (looking-at-p forbidden-re)))
   7521 		     (throw 'no-shift nil)))
   7522 		 ;; Ignore contents of example blocks and source
   7523 		 ;; blocks if their indentation is meant to be
   7524 		 ;; preserved.  Jump to block's closing line.
   7525 		 (beginning-of-line)
   7526 		 (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)")
   7527 			  (let ((e (org-element-at-point)))
   7528 			    (and (memq (org-element-type e)
   7529 				       '(example-block src-block))
   7530 				 (or org-src-preserve-indentation
   7531 				     (org-element-property :preserve-indent e))
   7532 				 (goto-char (org-element-property :end e))
   7533 				 (progn (skip-chars-backward " \r\t\n")
   7534 					(beginning-of-line)
   7535 					t))))
   7536 		     (forward-line))))))))
   7537        ;; Shift lines but footnote definitions, inlinetasks boundaries
   7538        ;; by DIFF.  Also skip contents of source or example blocks
   7539        ;; when indentation is meant to be preserved.
   7540        (while (not (eobp))
   7541 	 (cond
   7542 	  ((and (looking-at-p org-footnote-definition-re)
   7543 		(let ((e (org-element-at-point)))
   7544 		  (and (eq (org-element-type e) 'footnote-definition)
   7545 		       (goto-char (org-element-property :end e))))))
   7546 	  ((looking-at-p org-outline-regexp) (forward-line))
   7547 	  ((looking-at-p "[ \t]*$") (forward-line))
   7548 	  (t
   7549 	   (indent-line-to (+ (current-indentation) diff))
   7550 	   (beginning-of-line)
   7551 	   (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)")
   7552 		    (let ((e (org-element-at-point)))
   7553 		      (and (memq (org-element-type e)
   7554 				 '(example-block src-block))
   7555 			   (or org-src-preserve-indentation
   7556 			       (org-element-property :preserve-indent e))
   7557 			   (goto-char (org-element-property :end e))
   7558 			   (progn (skip-chars-backward " \r\t\n")
   7559 				  (beginning-of-line)
   7560 				  t))))
   7561 	       (forward-line)))))))))
   7562 
   7563 (defun org-convert-to-odd-levels ()
   7564   "Convert an Org file with all levels allowed to one with odd levels.
   7565 This will leave level 1 alone, convert level 2 to level 3, level 3 to
   7566 level 5 etc."
   7567   (interactive)
   7568   (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ")
   7569     (let ((outline-level 'org-outline-level)
   7570 	  (org-odd-levels-only nil) n)
   7571       (save-excursion
   7572 	(goto-char (point-min))
   7573 	(while (re-search-forward "^\\*\\*+ " nil t)
   7574 	  (setq n (- (length (match-string 0)) 2))
   7575 	  (while (>= (setq n (1- n)) 0)
   7576 	    (org-demote))
   7577 	  (end-of-line 1))))))
   7578 
   7579 (defun org-convert-to-oddeven-levels ()
   7580   "Convert an Org file with only odd levels to one with odd/even levels.
   7581 This promotes level 3 to level 2, level 5 to level 3 etc.  If the
   7582 file contains a section with an even level, conversion would
   7583 destroy the structure of the file.  An error is signaled in this
   7584 case."
   7585   (interactive)
   7586   (goto-char (point-min))
   7587   ;; First check if there are no even levels
   7588   (when (re-search-forward "^\\(\\*\\*\\)+ " nil t)
   7589     (org-show-set-visibility 'canonical)
   7590     (error "Not all levels are odd in this file.  Conversion not possible"))
   7591   (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
   7592     (let ((outline-regexp org-outline-regexp)
   7593 	  (outline-level 'org-outline-level)
   7594 	  (org-odd-levels-only nil) n)
   7595       (save-excursion
   7596 	(goto-char (point-min))
   7597 	(while (re-search-forward "^\\*\\*+ " nil t)
   7598 	  (setq n (/ (1- (length (match-string 0))) 2))
   7599 	  (while (>= (setq n (1- n)) 0)
   7600 	    (org-promote))
   7601 	  (end-of-line 1))))))
   7602 
   7603 (defun org-tr-level (n)
   7604   "Make N odd if required."
   7605   (if org-odd-levels-only (1+ (/ n 2)) n))
   7606 
   7607 ;;; Vertical tree motion, cutting and pasting of subtrees
   7608 
   7609 (defun org-move-subtree-up (&optional arg)
   7610   "Move the current subtree up past ARG headlines of the same level."
   7611   (interactive "p")
   7612   (org-move-subtree-down (- (prefix-numeric-value arg))))
   7613 
   7614 (defun org-move-subtree-down (&optional arg)
   7615   "Move the current subtree down past ARG headlines of the same level."
   7616   (interactive "p")
   7617   (setq arg (prefix-numeric-value arg))
   7618   (org-preserve-local-variables
   7619    (let ((movfunc (if (> arg 0) 'org-get-next-sibling
   7620 		    'org-get-previous-sibling))
   7621 	 (ins-point (make-marker))
   7622 	 (cnt (abs arg))
   7623 	 (col (current-column))
   7624 	 beg end txt folded)
   7625      ;; Select the tree
   7626      (org-back-to-heading)
   7627      (setq beg (point))
   7628      (save-match-data
   7629        (save-excursion (outline-end-of-heading)
   7630 		       (setq folded (org-invisible-p)))
   7631        (progn (org-end-of-subtree nil t)
   7632 	      (unless (eobp) (backward-char))))
   7633      (outline-next-heading)
   7634      (setq end (point))
   7635      (goto-char beg)
   7636      ;; Find insertion point, with error handling
   7637      (while (> cnt 0)
   7638        (unless (and (funcall movfunc) (looking-at org-outline-regexp))
   7639 	 (goto-char beg)
   7640 	 (user-error "Cannot move past superior level or buffer limit"))
   7641        (setq cnt (1- cnt)))
   7642      (when (> arg 0)
   7643        ;; Moving forward - still need to move over subtree
   7644        (org-end-of-subtree t t)
   7645        (save-excursion
   7646 	 (org-back-over-empty-lines)
   7647 	 (or (bolp) (newline))))
   7648      (move-marker ins-point (point))
   7649      (setq txt (buffer-substring beg end))
   7650      (org-save-markers-in-region beg end)
   7651      (delete-region beg end)
   7652      (org-remove-empty-overlays-at beg)
   7653      (unless (= beg (point-min)) (org-flag-region (1- beg) beg nil 'outline))
   7654      (unless (bobp) (org-flag-region (1- (point)) (point) nil 'outline))
   7655      (and (not (bolp)) (looking-at "\n") (forward-char 1))
   7656      (let ((bbb (point)))
   7657        (insert-before-markers txt)
   7658        (org-reinstall-markers-in-region bbb)
   7659        (move-marker ins-point bbb))
   7660      (or (bolp) (insert "\n"))
   7661      (goto-char ins-point)
   7662      (org-skip-whitespace)
   7663      (move-marker ins-point nil)
   7664      (if folded
   7665 	 (org-flag-subtree t)
   7666        (org-show-entry)
   7667        (org-show-children))
   7668      (org-clean-visibility-after-subtree-move)
   7669      ;; move back to the initial column we were at
   7670      (move-to-column col))))
   7671 
   7672 (defvar org-subtree-clip ""
   7673   "Clipboard for cut and paste of subtrees.
   7674 This is actually only a copy of the kill, because we use the normal kill
   7675 ring.  We need it to check if the kill was created by `org-copy-subtree'.")
   7676 
   7677 (defvar org-subtree-clip-folded nil
   7678   "Was the last copied subtree folded?
   7679 This is used to fold the tree back after pasting.")
   7680 
   7681 (defun org-cut-subtree (&optional n)
   7682   "Cut the current subtree into the clipboard.
   7683 With prefix arg N, cut this many sequential subtrees.
   7684 This is a short-hand for marking the subtree and then cutting it."
   7685   (interactive "p")
   7686   (org-copy-subtree n 'cut))
   7687 
   7688 (defun org-copy-subtree (&optional n cut force-store-markers nosubtrees)
   7689   "Copy the current subtree into the clipboard.
   7690 With prefix arg N, copy this many sequential subtrees.
   7691 This is a short-hand for marking the subtree and then copying it.
   7692 If CUT is non-nil, actually cut the subtree.
   7693 If FORCE-STORE-MARKERS is non-nil, store the relative locations
   7694 of some markers in the region, even if CUT is non-nil.  This is
   7695 useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
   7696   (interactive "p")
   7697   (org-preserve-local-variables
   7698    (let (beg end folded (beg0 (point)))
   7699      (if (called-interactively-p 'any)
   7700 	 (org-back-to-heading nil)    ; take what looks like a subtree
   7701        (org-back-to-heading t))	      ; take what is really there
   7702      (setq beg (point))
   7703      (skip-chars-forward " \t\r\n")
   7704      (save-match-data
   7705        (if nosubtrees
   7706 	   (outline-next-heading)
   7707 	 (save-excursion (outline-end-of-heading)
   7708 			 (setq folded (org-invisible-p)))
   7709 	 (ignore-errors (org-forward-heading-same-level (1- n) t))
   7710 	 (org-end-of-subtree t t)))
   7711      ;; Include the end of an inlinetask
   7712      (when (and (featurep 'org-inlinetask)
   7713 		(looking-at-p (concat (org-inlinetask-outline-regexp)
   7714 				      "END[ \t]*$")))
   7715        (end-of-line))
   7716      (setq end (point))
   7717      (goto-char beg0)
   7718      (when (> end beg)
   7719        (setq org-subtree-clip-folded folded)
   7720        (when (or cut force-store-markers)
   7721 	 (org-save-markers-in-region beg end))
   7722        (if cut (kill-region beg end) (copy-region-as-kill beg end))
   7723        (setq org-subtree-clip (current-kill 0))
   7724        (message "%s: Subtree(s) with %d characters"
   7725 		(if cut "Cut" "Copied")
   7726 		(length org-subtree-clip))))))
   7727 
   7728 (defun org-paste-subtree (&optional level tree for-yank remove)
   7729   "Paste the clipboard as a subtree, with modification of headline level.
   7730 
   7731 The entire subtree is promoted or demoted in order to match a new headline
   7732 level.
   7733 
   7734 If the cursor is at the beginning of a headline, the same level as
   7735 that headline is used to paste the tree.
   7736 
   7737 If not, the new level is derived from the *visible* headings
   7738 before and after the insertion point, and taken to be the inferior headline
   7739 level of the two.  So if the previous visible heading is level 3 and the
   7740 next is level 4 (or vice versa), level 4 will be used for insertion.
   7741 This makes sure that the subtree remains an independent subtree and does
   7742 not swallow low level entries.
   7743 
   7744 You can also force a different level, either by using a numeric prefix
   7745 argument, or by inserting the heading marker by hand.  For example, if the
   7746 cursor is after \"*****\", then the tree will be shifted to level 5.
   7747 
   7748 If optional TREE is given, use this text instead of the kill ring.
   7749 
   7750 When FOR-YANK is set, this is called by `org-yank'.  In this case, do not
   7751 move back over whitespace before inserting, and move point to the end of
   7752 the inserted text when done.
   7753 
   7754 When REMOVE is non-nil, remove the subtree from the clipboard."
   7755   (interactive "P")
   7756   (setq tree (or tree (and kill-ring (current-kill 0))))
   7757   (unless (org-kill-is-subtree-p tree)
   7758     (user-error
   7759      (substitute-command-keys
   7760       "The kill is not a (set of) tree(s).  Use `\\[yank]' to yank anyway")))
   7761   (org-with-limited-levels
   7762    (let* ((visp (not (org-invisible-p)))
   7763 	  (txt tree)
   7764 	  (old-level (if (string-match org-outline-regexp-bol txt)
   7765 			 (- (match-end 0) (match-beginning 0) 1)
   7766 		       -1))
   7767 	  (force-level
   7768 	   (cond
   7769 	    (level (prefix-numeric-value level))
   7770 	    ;; When point is after the stars in an otherwise empty
   7771 	    ;; headline, use the number of stars as the forced level.
   7772 	    ((and (org-match-line "^\\*+[ \t]*$")
   7773 		  (not (eq ?* (char-after))))
   7774 	     (org-outline-level))
   7775 	    ((looking-at-p org-outline-regexp-bol) (org-outline-level))))
   7776 	  (previous-level
   7777 	   (save-excursion
   7778 	     (org-previous-visible-heading 1)
   7779 	     (if (org-at-heading-p) (org-outline-level) 1)))
   7780 	  (next-level
   7781 	   (save-excursion
   7782 	     (if (org-at-heading-p) (org-outline-level)
   7783 	       (org-next-visible-heading 1)
   7784 	       (if (org-at-heading-p) (org-outline-level) 1))))
   7785 	  (new-level (or force-level (max previous-level next-level)))
   7786 	  (shift (if (or (= old-level -1)
   7787 			 (= new-level -1)
   7788 			 (= old-level new-level))
   7789 		     0
   7790 		   (- new-level old-level)))
   7791 	  (delta (if (> shift 0) -1 1))
   7792 	  (func (if (> shift 0) #'org-demote #'org-promote))
   7793 	  (org-odd-levels-only nil)
   7794 	  beg end newend)
   7795      ;; Remove the forced level indicator.
   7796      (when (and force-level (not level))
   7797        (delete-region (line-beginning-position) (point)))
   7798      ;; Paste before the next visible heading or at end of buffer,
   7799      ;; unless point is at the beginning of a headline.
   7800      (unless (and (bolp) (org-at-heading-p))
   7801        (org-next-visible-heading 1)
   7802        (unless (bolp) (insert "\n")))
   7803      (setq beg (point))
   7804      (when (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
   7805      (insert-before-markers txt)
   7806      (unless (string-suffix-p "\n" txt) (insert "\n"))
   7807      (setq newend (point))
   7808      (org-reinstall-markers-in-region beg)
   7809      (setq end (point))
   7810      (goto-char beg)
   7811      (skip-chars-forward " \t\n\r")
   7812      (setq beg (point))
   7813      (when (and (org-invisible-p) visp)
   7814        (save-excursion (outline-show-heading)))
   7815      ;; Shift if necessary.
   7816      (unless (= shift 0)
   7817        (save-restriction
   7818 	 (narrow-to-region beg end)
   7819 	 (while (not (= shift 0))
   7820 	   (org-map-region func (point-min) (point-max))
   7821 	   (setq shift (+ delta shift)))
   7822 	 (goto-char (point-min))
   7823 	 (setq newend (point-max))))
   7824      (when (or for-yank (called-interactively-p 'interactive))
   7825        (message "Clipboard pasted as level %d subtree" new-level))
   7826      (when (and (not for-yank) ; in this case, org-yank will decide about folding
   7827 		kill-ring
   7828 		(equal org-subtree-clip (current-kill 0))
   7829 		org-subtree-clip-folded)
   7830        ;; The tree was folded before it was killed/copied
   7831        (org-flag-subtree t))
   7832      (when for-yank (goto-char newend))
   7833      (when remove (pop kill-ring)))))
   7834 
   7835 (defun org-kill-is-subtree-p (&optional txt)
   7836   "Check if the current kill is an outline subtree, or a set of trees.
   7837 Returns nil if kill does not start with a headline, or if the first
   7838 headline level is not the largest headline level in the tree.
   7839 So this will actually accept several entries of equal levels as well,
   7840 which is OK for `org-paste-subtree'.
   7841 If optional TXT is given, check this string instead of the current kill."
   7842   (let* ((kill (or txt (and kill-ring (current-kill 0)) ""))
   7843 	 (re (org-get-limited-outline-regexp))
   7844 	 (^re (concat "^" re))
   7845 	 (start-level (and kill
   7846 			   (string-match
   7847 			    (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" re "\\)")
   7848 			    kill)
   7849 			   (- (match-end 2) (match-beginning 2) 1)))
   7850 	 (start (1+ (or (match-beginning 2) -1))))
   7851     (if (not start-level)
   7852 	(progn
   7853 	  nil)  ;; does not even start with a heading
   7854       (catch 'exit
   7855 	(while (setq start (string-match ^re kill (1+ start)))
   7856 	  (when (< (- (match-end 0) (match-beginning 0) 1) start-level)
   7857 	    (throw 'exit nil)))
   7858 	t))))
   7859 
   7860 (defvar org-markers-to-move nil
   7861   "Markers that should be moved with a cut-and-paste operation.
   7862 Those markers are stored together with their positions relative to
   7863 the start of the region.")
   7864 
   7865 (defun org-save-markers-in-region (beg end)
   7866   "Check markers in region.
   7867 If these markers are between BEG and END, record their position relative
   7868 to BEG, so that after moving the block of text, we can put the markers back
   7869 into place.
   7870 This function gets called just before an entry or tree gets cut from the
   7871 buffer.  After re-insertion, `org-reinstall-markers-in-region' must be
   7872 called immediately, to move the markers with the entries."
   7873   (setq org-markers-to-move nil)
   7874   (when (featurep 'org-clock)
   7875     (org-clock-save-markers-for-cut-and-paste beg end))
   7876   (when (featurep 'org-agenda)
   7877     (org-agenda-save-markers-for-cut-and-paste beg end)))
   7878 
   7879 (defun org-check-and-save-marker (marker beg end)
   7880   "Check if MARKER is between BEG and END.
   7881 If yes, remember the marker and the distance to BEG."
   7882   (when (and (marker-buffer marker)
   7883 	     (or (equal (marker-buffer marker) (current-buffer))
   7884                  (equal (marker-buffer marker) (buffer-base-buffer (current-buffer))))
   7885 	     (>= marker beg) (< marker end))
   7886     (push (cons marker (- marker beg)) org-markers-to-move)))
   7887 
   7888 (defun org-reinstall-markers-in-region (beg)
   7889   "Move all remembered markers to their position relative to BEG."
   7890   (dolist (x org-markers-to-move)
   7891     (move-marker (car x) (+ beg (cdr x))))
   7892   (setq org-markers-to-move nil))
   7893 
   7894 (defun org-narrow-to-subtree ()
   7895   "Narrow buffer to the current subtree."
   7896   (interactive)
   7897   (save-excursion
   7898     (save-match-data
   7899       (org-with-limited-levels
   7900        (narrow-to-region
   7901 	(progn (org-back-to-heading t) (point))
   7902 	(progn (org-end-of-subtree t t)
   7903 	       (when (and (org-at-heading-p) (not (eobp))) (backward-char 1))
   7904 	       (point)))))))
   7905 
   7906 (defun org-toggle-narrow-to-subtree ()
   7907   "Narrow to the subtree at point or widen a narrowed buffer."
   7908   (interactive)
   7909   (if (buffer-narrowed-p)
   7910       (progn (widen) (message "Buffer widen"))
   7911     (org-narrow-to-subtree)
   7912     (message "Buffer narrowed to current subtree")))
   7913 
   7914 (defun org-narrow-to-block ()
   7915   "Narrow buffer to the current block."
   7916   (interactive)
   7917   (let* ((case-fold-search t)
   7918 	 (blockp (org-between-regexps-p "^[ \t]*#\\+begin_.*"
   7919 					"^[ \t]*#\\+end_.*")))
   7920     (if blockp
   7921 	(narrow-to-region (car blockp) (cdr blockp))
   7922       (user-error "Not in a block"))))
   7923 
   7924 (defun org-clone-subtree-with-time-shift (n &optional shift)
   7925   "Clone the task (subtree) at point N times.
   7926 The clones will be inserted as siblings.
   7927 
   7928 In interactive use, the user will be prompted for the number of
   7929 clones to be produced.  If the entry has a timestamp, the user
   7930 will also be prompted for a time shift, which may be a repeater
   7931 as used in time stamps, for example `+3d'.  To disable this,
   7932 you can call the function with a universal prefix argument.
   7933 
   7934 When a valid repeater is given and the entry contains any time
   7935 stamps, the clones will become a sequence in time, with time
   7936 stamps in the subtree shifted for each clone produced.  If SHIFT
   7937 is nil or the empty string, time stamps will be left alone.  The
   7938 ID property of the original subtree is removed.
   7939 
   7940 In each clone, all the CLOCK entries will be removed.  This
   7941 prevents Org from considering that the clocked times overlap.
   7942 
   7943 If the original subtree did contain time stamps with a repeater,
   7944 the following will happen:
   7945 - the repeater will be removed in each clone
   7946 - an additional clone will be produced, with the current, unshifted
   7947   date(s) in the entry.
   7948 - the original entry will be placed *after* all the clones, with
   7949   repeater intact.
   7950 - the start days in the repeater in the original entry will be shifted
   7951   to past the last clone.
   7952 In this way you can spell out a number of instances of a repeating task,
   7953 and still retain the repeater to cover future instances of the task.
   7954 
   7955 As described above, N+1 clones are produced when the original
   7956 subtree has a repeater.  Setting N to 0, then, can be used to
   7957 remove the repeater from a subtree and create a shifted clone
   7958 with the original repeater."
   7959   (interactive "nNumber of clones to produce: ")
   7960   (unless (wholenump n) (user-error "Invalid number of replications %s" n))
   7961   (when (org-before-first-heading-p) (user-error "No subtree to clone"))
   7962   (let* ((beg (save-excursion (org-back-to-heading t) (point)))
   7963 	 (end-of-tree (save-excursion (org-end-of-subtree t t) (point)))
   7964 	 (shift
   7965 	  (or shift
   7966 	      (if (and (not (equal current-prefix-arg '(4)))
   7967 		       (save-excursion
   7968 			 (goto-char beg)
   7969 			 (re-search-forward org-ts-regexp-both end-of-tree t)))
   7970 		  (read-from-minibuffer
   7971 		   "Date shift per clone (e.g. +1w, empty to copy unchanged): ")
   7972 		"")))			;No time shift
   7973 	 (doshift
   7974 	  (and (org-string-nw-p shift)
   7975 	       (or (string-match "\\`[ \t]*\\([+-]?[0-9]+\\)\\([hdwmy]\\)[ \t]*\\'"
   7976 				 shift)
   7977 		   (user-error "Invalid shift specification %s" shift)))))
   7978     (goto-char end-of-tree)
   7979     (unless (bolp) (insert "\n"))
   7980     (let* ((end (point))
   7981 	   (template (buffer-substring beg end))
   7982 	   (shift-n (and doshift (string-to-number (match-string 1 shift))))
   7983 	   (shift-what (pcase (and doshift (match-string 2 shift))
   7984 			 (`nil nil)
   7985 			 ("h" 'hour)
   7986 			 ("d" 'day)
   7987 			 ("w" (setq shift-n (* 7 shift-n)) 'day)
   7988 			 ("m" 'month)
   7989 			 ("y" 'year)
   7990 			 (_ (error "Unsupported time unit"))))
   7991 	   (nmin 1)
   7992 	   (nmax n)
   7993 	   (n-no-remove -1)
   7994 	   (org-id-overriding-file-name (buffer-file-name (buffer-base-buffer)))
   7995 	   (idprop (org-entry-get beg "ID")))
   7996       (when (and doshift
   7997 		 (string-match-p "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>"
   7998 				 template))
   7999 	(delete-region beg end)
   8000 	(setq end beg)
   8001 	(setq nmin 0)
   8002 	(setq nmax (1+ nmax))
   8003 	(setq n-no-remove nmax))
   8004       (goto-char end)
   8005       (cl-loop for n from nmin to nmax do
   8006 	       (insert
   8007 		;; Prepare clone.
   8008 		(with-temp-buffer
   8009 		  (insert template)
   8010 		  (org-mode)
   8011 		  (goto-char (point-min))
   8012 		  (org-show-subtree)
   8013 		  (and idprop (if org-clone-delete-id
   8014 				  (org-entry-delete nil "ID")
   8015 				(org-id-get-create t)))
   8016 		  (unless (= n 0)
   8017 		    (while (re-search-forward org-clock-line-re nil t)
   8018 		      (delete-region (line-beginning-position)
   8019 				     (line-beginning-position 2)))
   8020 		    (goto-char (point-min))
   8021 		    (while (re-search-forward org-drawer-regexp nil t)
   8022 		      (org-remove-empty-drawer-at (point))))
   8023 		  (goto-char (point-min))
   8024 		  (when doshift
   8025 		    (while (re-search-forward org-ts-regexp-both nil t)
   8026 		      (org-timestamp-change (* n shift-n) shift-what))
   8027 		    (unless (= n n-no-remove)
   8028 		      (goto-char (point-min))
   8029 		      (while (re-search-forward org-ts-regexp nil t)
   8030 			(save-excursion
   8031 			  (goto-char (match-beginning 0))
   8032 			  (when (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)")
   8033 			    (delete-region (match-beginning 1) (match-end 1)))))))
   8034 		  (buffer-string)))))
   8035     (goto-char beg)))
   8036 
   8037 ;;; Outline path
   8038 
   8039 (defvar org-outline-path-cache nil
   8040   "Alist between buffer positions and outline paths.
   8041 It value is an alist (POSITION . PATH) where POSITION is the
   8042 buffer position at the beginning of an entry and PATH is a list
   8043 of strings describing the outline path for that entry, in reverse
   8044 order.")
   8045 
   8046 (defun org--get-outline-path-1 (&optional use-cache)
   8047   "Return outline path to current headline.
   8048 
   8049 Outline path is a list of strings, in reverse order.  When
   8050 optional argument USE-CACHE is non-nil, make use of a cache.  See
   8051 `org-get-outline-path' for details.
   8052 
   8053 Assume buffer is widened and point is on a headline."
   8054   (or (and use-cache (cdr (assq (point) org-outline-path-cache)))
   8055       (let ((p (point))
   8056 	    (heading (let ((case-fold-search nil))
   8057 		       (looking-at org-complex-heading-regexp)
   8058 		       (if (not (match-end 4)) ""
   8059 			 ;; Remove statistics cookies.
   8060 			 (org-trim
   8061 			  (org-link-display-format
   8062 			   (replace-regexp-in-string
   8063 			    "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
   8064 			    (match-string-no-properties 4))))))))
   8065 	(if (org-up-heading-safe)
   8066 	    (let ((path (cons heading (org--get-outline-path-1 use-cache))))
   8067 	      (when use-cache
   8068 		(push (cons p path) org-outline-path-cache))
   8069 	      path)
   8070 	  ;; This is a new root node.  Since we assume we are moving
   8071 	  ;; forward, we can drop previous cache so as to limit number
   8072 	  ;; of associations there.
   8073 	  (let ((path (list heading)))
   8074 	    (when use-cache (setq org-outline-path-cache (list (cons p path))))
   8075 	    path)))))
   8076 
   8077 (defun org-get-outline-path (&optional with-self use-cache)
   8078   "Return the outline path to the current entry.
   8079 
   8080 An outline path is a list of ancestors for current headline, as
   8081 a list of strings.  Statistics cookies are removed and links are
   8082 replaced with their description, if any, or their path otherwise.
   8083 
   8084 When optional argument WITH-SELF is non-nil, the path also
   8085 includes the current headline.
   8086 
   8087 When optional argument USE-CACHE is non-nil, cache outline paths
   8088 between calls to this function so as to avoid backtracking.  This
   8089 argument is useful when planning to find more than one outline
   8090 path in the same document.  In that case, there are two
   8091 conditions to satisfy:
   8092   - `org-outline-path-cache' is set to nil before starting the
   8093     process;
   8094   - outline paths are computed by increasing buffer positions."
   8095   (org-with-wide-buffer
   8096    (and (or (and with-self (org-back-to-heading t))
   8097 	    (org-up-heading-safe))
   8098 	(reverse (org--get-outline-path-1 use-cache)))))
   8099 
   8100 (defun org-format-outline-path (path &optional width prefix separator)
   8101   "Format the outline path PATH for display.
   8102 WIDTH is the maximum number of characters that is available.
   8103 PREFIX is a prefix to be included in the returned string,
   8104 such as the file name.
   8105 SEPARATOR is inserted between the different parts of the path,
   8106 the default is \"/\"."
   8107   (setq width (or width 79))
   8108   (setq path (delq nil path))
   8109   (unless (> width 0)
   8110     (user-error "Argument `width' must be positive"))
   8111   (setq separator (or separator "/"))
   8112   (let* ((org-odd-levels-only nil)
   8113 	 (fpath (concat
   8114 		 prefix (and prefix path separator)
   8115 		 (mapconcat
   8116 		  (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s))
   8117 		  (cl-loop for head in path
   8118 			   for n from 0
   8119 			   collect (org-add-props
   8120 				       head nil 'face
   8121 				       (nth (% n org-n-level-faces) org-level-faces)))
   8122 		  separator))))
   8123     (when (> (length fpath) width)
   8124       (if (< width 7)
   8125 	  ;; It's unlikely that `width' will be this small, but don't
   8126 	  ;; waste characters by adding ".." if it is.
   8127 	  (setq fpath (substring fpath 0 width))
   8128 	(setf (substring fpath (- width 2)) "..")))
   8129     fpath))
   8130 
   8131 (defun org-display-outline-path (&optional file current separator just-return-string)
   8132   "Display the current outline path in the echo area.
   8133 
   8134 If FILE is non-nil, prepend the output with the file name.
   8135 If CURRENT is non-nil, append the current heading to the output.
   8136 SEPARATOR is passed through to `org-format-outline-path'.  It separates
   8137 the different parts of the path and defaults to \"/\".
   8138 If JUST-RETURN-STRING is non-nil, return a string, don't display a message."
   8139   (interactive "P")
   8140   (let* (case-fold-search
   8141 	 (bfn (buffer-file-name (buffer-base-buffer)))
   8142 	 (path (and (derived-mode-p 'org-mode) (org-get-outline-path)))
   8143 	 res)
   8144     (when current (setq path (append path
   8145 				     (save-excursion
   8146 				       (org-back-to-heading t)
   8147 				       (when (looking-at org-complex-heading-regexp)
   8148 					 (list (match-string 4)))))))
   8149     (setq res
   8150 	  (org-format-outline-path
   8151 	   path
   8152 	   (1- (frame-width))
   8153 	   (and file bfn (concat (file-name-nondirectory bfn) separator))
   8154 	   separator))
   8155     (add-face-text-property 0 (length res)
   8156 			    `(:height ,(face-attribute 'default :height))
   8157 			    nil res)
   8158     (if just-return-string
   8159 	res
   8160       (org-unlogged-message "%s" res))))
   8161 
   8162 ;;; Outline Sorting
   8163 
   8164 (defun org-sort (&optional with-case)
   8165   "Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'.
   8166 Optional argument WITH-CASE means sort case-sensitively."
   8167   (interactive "P")
   8168   (org-call-with-arg
   8169    (cond ((org-at-table-p) #'org-table-sort-lines)
   8170 	 ((org-at-item-p) #'org-sort-list)
   8171 	 (t #'org-sort-entries))
   8172    with-case))
   8173 
   8174 (defun org-sort-remove-invisible (s)
   8175   "Remove emphasis markers and any invisible property from string S.
   8176 Assume S may contain only objects."
   8177   ;; org-element-interpret-data clears any text property, including
   8178   ;; invisible part.
   8179   (org-element-interpret-data
   8180    (let ((tree (org-element-parse-secondary-string
   8181                 s (org-element-restriction 'paragraph))))
   8182      (org-element-map tree '(bold code italic link strike-through underline verbatim)
   8183        (lambda (o)
   8184          (pcase (org-element-type o)
   8185            ;; Terminal object.  Replace it with its value.
   8186            ((or `code `verbatim)
   8187             (let ((new (org-element-property :value o)))
   8188               (org-element-insert-before new o)
   8189               (org-element-put-property
   8190                new :post-blank (org-element-property :post-blank o))))
   8191            ;; Non-terminal objects.  Splice contents.
   8192            (type
   8193             (let ((contents
   8194                    (or (org-element-contents o)
   8195                        (and (eq type 'link)
   8196                             (list (org-element-property :raw-link o)))))
   8197                   (c nil))
   8198               (while contents
   8199                 (setq c (pop contents))
   8200                 (org-element-insert-before c o))
   8201               (org-element-put-property
   8202                c :post-blank (org-element-property :post-blank o)))))
   8203          (org-element-extract-element o)))
   8204      ;; Return modified tree.
   8205      tree)))
   8206 
   8207 (defvar org-after-sorting-entries-or-items-hook nil
   8208   "Hook that is run after a bunch of entries or items have been sorted.
   8209 When children are sorted, the cursor is in the parent line when this
   8210 hook gets called.  When a region or a plain list is sorted, the cursor
   8211 will be in the first entry of the sorted region/list.")
   8212 
   8213 (defun org-sort-entries
   8214     (&optional with-case sorting-type getkey-func compare-func property
   8215 	       interactive?)
   8216   "Sort entries on a certain level of an outline tree.
   8217 If there is an active region, the entries in the region are sorted.
   8218 Else, if the cursor is before the first entry, sort the top-level items.
   8219 Else, the children of the entry at point are sorted.
   8220 
   8221 Sorting can be alphabetically, numerically, by date/time as given by
   8222 a time stamp, by a property, by priority order, or by a custom function.
   8223 
   8224 The command prompts for the sorting type unless it has been given to the
   8225 function through the SORTING-TYPE argument, which needs to be a character,
   8226 \(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?o ?O ?r ?R ?f ?F ?k ?K).  Here is
   8227 the precise meaning of each character:
   8228 
   8229 a   Alphabetically, ignoring the TODO keyword and the priority, if any.
   8230 c   By creation time, which is assumed to be the first inactive time stamp
   8231     at the beginning of a line.
   8232 d   By deadline date/time.
   8233 k   By clocking time.
   8234 n   Numerically, by converting the beginning of the entry/item to a number.
   8235 o   By order of TODO keywords.
   8236 p   By priority according to the cookie.
   8237 r   By the value of a property.
   8238 s   By scheduled date/time.
   8239 t   By date/time, either the first active time stamp in the entry, or, if
   8240     none exist, by the first inactive one.
   8241 
   8242 Capital letters will reverse the sort order.
   8243 
   8244 If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be
   8245 called with point at the beginning of the record.  It must return a
   8246 value that is compatible with COMPARE-FUNC, the function used to
   8247 compare entries.
   8248 
   8249 Comparing entries ignores case by default.  However, with an optional argument
   8250 WITH-CASE, the sorting considers case as well.
   8251 
   8252 Sorting is done against the visible part of the headlines, it ignores hidden
   8253 links.
   8254 
   8255 When sorting is done, call `org-after-sorting-entries-or-items-hook'.
   8256 
   8257 A non-nil value for INTERACTIVE? is used to signal that this
   8258 function is being called interactively."
   8259   (interactive (list current-prefix-arg nil nil nil nil t))
   8260   (let ((case-func (if with-case 'identity 'downcase))
   8261         start beg end stars re re2
   8262         txt what tmp)
   8263     ;; Find beginning and end of region to sort
   8264     (cond
   8265      ((org-region-active-p)
   8266       ;; we will sort the region
   8267       (setq end (region-end)
   8268             what "region")
   8269       (goto-char (region-beginning))
   8270       (unless (org-at-heading-p) (outline-next-heading))
   8271       (setq start (point)))
   8272      ((or (org-at-heading-p)
   8273           (ignore-errors (progn (org-back-to-heading) t)))
   8274       ;; we will sort the children of the current headline
   8275       (org-back-to-heading)
   8276       (setq start (point)
   8277 	    end (progn (org-end-of-subtree t t)
   8278 		       (or (bolp) (insert "\n"))
   8279 		       (when (>= (org-back-over-empty-lines) 1)
   8280 			 (forward-line 1))
   8281 		       (point))
   8282 	    what "children")
   8283       (goto-char start)
   8284       (outline-show-subtree)
   8285       (outline-next-heading))
   8286      (t
   8287       ;; we will sort the top-level entries in this file
   8288       (goto-char (point-min))
   8289       (or (org-at-heading-p) (outline-next-heading))
   8290       (setq start (point))
   8291       (goto-char (point-max))
   8292       (beginning-of-line 1)
   8293       (when (looking-at ".*?\\S-")
   8294 	;; File ends in a non-white line
   8295 	(end-of-line 1)
   8296 	(insert "\n"))
   8297       (setq end (point-max))
   8298       (setq what "top-level")
   8299       (goto-char start)
   8300       (org-show-all '(headings drawers blocks))))
   8301 
   8302     (setq beg (point))
   8303     (when (>= beg end) (goto-char start) (user-error "Nothing to sort"))
   8304 
   8305     (looking-at "\\(\\*+\\)")
   8306     (setq stars (match-string 1)
   8307 	  re (concat "^" (regexp-quote stars) " +")
   8308 	  re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[ \t\n]")
   8309 	  txt (buffer-substring beg end))
   8310     (unless (equal (substring txt -1) "\n") (setq txt (concat txt "\n")))
   8311     (when (and (not (equal stars "*")) (string-match re2 txt))
   8312       (user-error "Region to sort contains a level above the first entry"))
   8313 
   8314     (unless sorting-type
   8315       (message
   8316        "Sort %s: [a]lpha  [n]umeric  [p]riority  p[r]operty  todo[o]rder  [f]unc
   8317                [t]ime [s]cheduled  [d]eadline  [c]reated  cloc[k]ing
   8318                A/N/P/R/O/F/T/S/D/C/K means reversed:"
   8319        what)
   8320       (setq sorting-type (read-char-exclusive)))
   8321 
   8322     (unless getkey-func
   8323       (and (= (downcase sorting-type) ?f)
   8324 	   (setq getkey-func
   8325 		 (or (and interactive?
   8326 			  (org-read-function
   8327 			   "Function for extracting keys: "))
   8328 		     (error "Missing key extractor")))))
   8329 
   8330     (and (= (downcase sorting-type) ?r)
   8331 	 (not property)
   8332 	 (setq property
   8333 	       (completing-read "Property: "
   8334 				(mapcar #'list (org-buffer-property-keys t))
   8335 				nil t)))
   8336 
   8337     (when (member sorting-type '(?k ?K)) (org-clock-sum))
   8338     (message "Sorting entries...")
   8339 
   8340     (save-restriction
   8341       (narrow-to-region start end)
   8342       (let ((restore-clock?
   8343 	     ;; The clock marker is lost when using `sort-subr'; mark
   8344 	     ;; the clock with temporary `:org-clock-marker-backup'
   8345 	     ;; text property.
   8346 	     (when (and (eq (org-clocking-buffer) (current-buffer))
   8347 			(<= start (marker-position org-clock-marker))
   8348 			(>= end (marker-position org-clock-marker)))
   8349 	       (with-silent-modifications
   8350 		 (put-text-property (1- org-clock-marker) org-clock-marker
   8351 				    :org-clock-marker-backup t))
   8352 	       t))
   8353 	    (dcst (downcase sorting-type))
   8354 	    (case-fold-search nil)
   8355 	    (now (current-time)))
   8356         (org-preserve-local-variables
   8357 	 (sort-subr
   8358 	  (/= dcst sorting-type)
   8359 	  ;; This function moves to the beginning character of the
   8360 	  ;; "record" to be sorted.
   8361 	  (lambda nil
   8362 	    (if (re-search-forward re nil t)
   8363 		(goto-char (match-beginning 0))
   8364 	      (goto-char (point-max))))
   8365 	  ;; This function moves to the last character of the "record" being
   8366 	  ;; sorted.
   8367 	  (lambda nil
   8368 	    (save-match-data
   8369 	      (condition-case nil
   8370 		  (outline-forward-same-level 1)
   8371 		(error
   8372 		 (goto-char (point-max))))))
   8373 	  ;; This function returns the value that gets sorted against.
   8374 	  (lambda ()
   8375 	    (cond
   8376 	     ((= dcst ?n)
   8377 	      (string-to-number
   8378 	       (org-sort-remove-invisible (org-get-heading t t t t))))
   8379 	     ((= dcst ?a)
   8380 	      (funcall case-func
   8381 		       (org-sort-remove-invisible (org-get-heading t t t t))))
   8382 	     ((= dcst ?k)
   8383 	      (or (get-text-property (point) :org-clock-minutes) 0))
   8384 	     ((= dcst ?t)
   8385 	      (let ((end (save-excursion (outline-next-heading) (point))))
   8386 		(if (or (re-search-forward org-ts-regexp end t)
   8387 			(re-search-forward org-ts-regexp-both end t))
   8388 		    (org-time-string-to-seconds (match-string 0))
   8389 		  (float-time now))))
   8390 	     ((= dcst ?c)
   8391 	      (let ((end (save-excursion (outline-next-heading) (point))))
   8392 		(if (re-search-forward
   8393 		     (concat "^[ \t]*\\[" org-ts-regexp1 "\\]")
   8394 		     end t)
   8395 		    (org-time-string-to-seconds (match-string 0))
   8396 		  (float-time now))))
   8397 	     ((= dcst ?s)
   8398 	      (let ((end (save-excursion (outline-next-heading) (point))))
   8399 		(if (re-search-forward org-scheduled-time-regexp end t)
   8400 		    (org-time-string-to-seconds (match-string 1))
   8401 		  (float-time now))))
   8402 	     ((= dcst ?d)
   8403 	      (let ((end (save-excursion (outline-next-heading) (point))))
   8404 		(if (re-search-forward org-deadline-time-regexp end t)
   8405 		    (org-time-string-to-seconds (match-string 1))
   8406 		  (float-time now))))
   8407 	     ((= dcst ?p)
   8408 	      (if (re-search-forward org-priority-regexp (point-at-eol) t)
   8409 		  (string-to-char (match-string 2))
   8410 		org-priority-default))
   8411 	     ((= dcst ?r)
   8412 	      (or (org-entry-get nil property) ""))
   8413 	     ((= dcst ?o)
   8414 	      (when (looking-at org-complex-heading-regexp)
   8415 		(let* ((m (match-string 2))
   8416 		       (s (if (member m org-done-keywords) '- '+)))
   8417 		  (- 99 (funcall s (length (member m org-todo-keywords-1)))))))
   8418 	     ((= dcst ?f)
   8419 	      (if getkey-func
   8420 		  (progn
   8421 		    (setq tmp (funcall getkey-func))
   8422 		    (when (stringp tmp) (setq tmp (funcall case-func tmp)))
   8423 		    tmp)
   8424 		(error "Invalid key function `%s'" getkey-func)))
   8425 	     (t (error "Invalid sorting type `%c'" sorting-type))))
   8426 	  nil
   8427 	  (cond
   8428 	   ((= dcst ?a) 'org-string-collate-lessp)
   8429 	   ((= dcst ?f)
   8430 	    (or compare-func
   8431 		(and interactive?
   8432 		     (org-read-function
   8433 		      (concat "Function for comparing keys "
   8434 			      "(empty for default `sort-subr' predicate): ")
   8435 		      'allow-empty))))
   8436 	   ((member dcst '(?p ?t ?s ?d ?c ?k)) '<))))
   8437 	(org-cycle-hide-drawers 'all)
   8438 	(when restore-clock?
   8439 	  (move-marker org-clock-marker
   8440 		       (1+ (next-single-property-change
   8441 			    start :org-clock-marker-backup)))
   8442 	  (remove-text-properties (1- org-clock-marker) org-clock-marker
   8443 				  '(:org-clock-marker-backup t)))))
   8444     (run-hooks 'org-after-sorting-entries-or-items-hook)
   8445     (message "Sorting entries...done")))
   8446 
   8447 (defun org-contextualize-keys (alist contexts)
   8448   "Return valid elements in ALIST depending on CONTEXTS.
   8449 
   8450 `org-agenda-custom-commands' or `org-capture-templates' are the
   8451 values used for ALIST, and `org-agenda-custom-commands-contexts'
   8452 or `org-capture-templates-contexts' are the associated contexts
   8453 definitions."
   8454   (let ((contexts
   8455 	 ;; normalize contexts
   8456 	 (mapcar
   8457 	  (lambda(c) (cond ((listp (cadr c))
   8458 			    (list (car c) (car c) (nth 1 c)))
   8459 			   ((string= "" (cadr c))
   8460 			    (list (car c) (car c) (nth 2 c)))
   8461 			   (t c)))
   8462           contexts))
   8463 	(a alist) r s)
   8464     ;; loop over all commands or templates
   8465     (dolist (c a)
   8466       (let (vrules repl)
   8467 	(cond
   8468 	 ((not (assoc (car c) contexts))
   8469 	  (push c r))
   8470 	 ((and (assoc (car c) contexts)
   8471 	       (setq vrules (org-contextualize-validate-key
   8472 			     (car c) contexts)))
   8473 	  (mapc (lambda (vr)
   8474 		  (unless (equal (car vr) (cadr vr))
   8475 		    (setq repl vr)))
   8476                 vrules)
   8477 	  (if (not repl) (push c r)
   8478 	    (push (cadr repl) s)
   8479 	    (push
   8480 	     (cons (car c)
   8481 		   (cdr (or (assoc (cadr repl) alist)
   8482 			    (error "Undefined key `%s' as contextual replacement for `%s'"
   8483 				   (cadr repl) (car c)))))
   8484 	     r))))))
   8485     ;; Return limited ALIST, possibly with keys modified, and deduplicated
   8486     (delq
   8487      nil
   8488      (delete-dups
   8489       (mapcar (lambda (x)
   8490 		(let ((tpl (car x)))
   8491 		  (unless (delq
   8492 			   nil
   8493 			   (mapcar (lambda (y)
   8494 				     (equal y tpl))
   8495 				   s))
   8496                     x)))
   8497 	      (reverse r))))))
   8498 
   8499 (defun org-contextualize-validate-key (key contexts)
   8500   "Check CONTEXTS for agenda or capture KEY."
   8501   (let (res)
   8502     (dolist (r contexts)
   8503       (dolist (rr (car (last r)))
   8504 	(when
   8505 	    (and (equal key (car r))
   8506 		 (if (functionp rr) (funcall rr)
   8507 		   (or (and (eq (car rr) 'in-file)
   8508 			    (buffer-file-name)
   8509 			    (string-match (cdr rr) (buffer-file-name)))
   8510 		       (and (eq (car rr) 'in-mode)
   8511 			    (string-match (cdr rr) (symbol-name major-mode)))
   8512 		       (and (eq (car rr) 'in-buffer)
   8513 			    (string-match (cdr rr) (buffer-name)))
   8514 		       (when (and (eq (car rr) 'not-in-file)
   8515 				  (buffer-file-name))
   8516 			 (not (string-match (cdr rr) (buffer-file-name))))
   8517 		       (when (eq (car rr) 'not-in-mode)
   8518 			 (not (string-match (cdr rr) (symbol-name major-mode))))
   8519 		       (when (eq (car rr) 'not-in-buffer)
   8520 			 (not (string-match (cdr rr) (buffer-name)))))))
   8521 	  (push r res))))
   8522     (delete-dups (delq nil res))))
   8523 
   8524 ;; Defined to provide a value for defcustom, since there is no
   8525 ;; string-collate-greaterp in Emacs.
   8526 (defun org-string-collate-greaterp (s1 s2)
   8527   "Return non-nil if S1 is greater than S2 in collation order."
   8528   (not (org-string-collate-lessp s1 s2)))
   8529 
   8530 ;;;###autoload
   8531 (defun org-run-like-in-org-mode (cmd)
   8532   "Run a command, pretending that the current buffer is in Org mode.
   8533 This will temporarily bind local variables that are typically bound in
   8534 Org mode to the values they have in Org mode, and then interactively
   8535 call CMD."
   8536   (org-load-modules-maybe)
   8537   (let (binds)
   8538     (dolist (var (org-get-local-variables))
   8539       (when (or (not (boundp (car var)))
   8540 		(eq (symbol-value (car var))
   8541 		    (default-value (car var))))
   8542 	(push (list (car var) `(quote ,(cadr var))) binds)))
   8543     (eval `(let ,binds
   8544 	     (call-interactively (quote ,cmd))))))
   8545 
   8546 (defun org-get-category (&optional pos force-refresh)
   8547   "Get the category applying to position POS."
   8548   (save-match-data
   8549     (when force-refresh (org-refresh-category-properties))
   8550     (let ((pos (or pos (point))))
   8551       (or (get-text-property pos 'org-category)
   8552 	  (progn (org-refresh-category-properties)
   8553 		 (get-text-property pos 'org-category))))))
   8554 
   8555 ;;; Refresh properties
   8556 
   8557 (defun org-refresh-properties (dprop tprop)
   8558   "Refresh buffer text properties.
   8559 DPROP is the drawer property and TPROP is either the
   8560 corresponding text property to set, or an alist with each element
   8561 being a text property (as a symbol) and a function to apply to
   8562 the value of the drawer property."
   8563   (let* ((case-fold-search t)
   8564 	 (inhibit-read-only t)
   8565 	 (inherit? (org-property-inherit-p dprop))
   8566 	 (property-re (org-re-property (concat (regexp-quote dprop) "\\+?") t))
   8567 	 (global-or-keyword (and inherit?
   8568 				 (org--property-global-or-keyword-value dprop nil))))
   8569     (with-silent-modifications
   8570       (org-with-point-at 1
   8571 	;; Set global and keyword based values to the whole buffer.
   8572 	(when global-or-keyword
   8573 	  (put-text-property (point-min) (point-max) tprop global-or-keyword))
   8574 	;; Set values based on property-drawers throughout the document.
   8575 	(while (re-search-forward property-re nil t)
   8576 	  (when (org-at-property-p)
   8577 	    (org-refresh-property tprop (org-entry-get (point) dprop) inherit?))
   8578 	  (outline-next-heading))))))
   8579 
   8580 (defun org-refresh-property (tprop p &optional inherit)
   8581   "Refresh the buffer text property TPROP from the drawer property P.
   8582 
   8583 The refresh happens only for the current entry, or the whole
   8584 sub-tree if optional argument INHERIT is non-nil.
   8585 
   8586 If point is before first headline, the function applies to the
   8587 part before the first headline.  In that particular case, when
   8588 optional argument INHERIT is non-nil, it refreshes properties for
   8589 the whole buffer."
   8590   (save-excursion
   8591     (org-back-to-heading-or-point-min t)
   8592     (let ((start (point))
   8593 	  (end (save-excursion
   8594 		 (cond ((and inherit (org-before-first-heading-p))
   8595 			(point-max))
   8596 		       (inherit
   8597 			(org-end-of-subtree t t))
   8598 		       ((outline-next-heading))
   8599 		       ((point-max))))))
   8600       (if (symbolp tprop)
   8601 	  ;; TPROP is a text property symbol.
   8602 	  (put-text-property start end tprop p)
   8603 	;; TPROP is an alist with (property . function) elements.
   8604 	(pcase-dolist (`(,prop . ,f) tprop)
   8605 	  (put-text-property start end prop (funcall f p)))))))
   8606 
   8607 (defun org-refresh-category-properties ()
   8608   "Refresh category text properties in the buffer."
   8609   (let ((case-fold-search t)
   8610 	(inhibit-read-only t)
   8611 	(default-category
   8612 	  (cond ((null org-category)
   8613 		 (if buffer-file-name
   8614 		     (file-name-sans-extension
   8615 		      (file-name-nondirectory buffer-file-name))
   8616 		   "???"))
   8617 		((symbolp org-category) (symbol-name org-category))
   8618 		(t org-category))))
   8619     (with-silent-modifications
   8620       (org-with-wide-buffer
   8621        ;; Set buffer-wide property from keyword.  Search last #+CATEGORY
   8622        ;; keyword.  If none is found, fall-back to `org-category' or
   8623        ;; buffer file name, or set it by the document property drawer.
   8624        (put-text-property
   8625 	(point-min) (point-max)
   8626 	'org-category
   8627 	(catch 'buffer-category
   8628 	  (goto-char (point-max))
   8629 	  (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t)
   8630 	    (let ((element (org-element-at-point)))
   8631 	      (when (eq (org-element-type element) 'keyword)
   8632 		(throw 'buffer-category
   8633 		       (org-element-property :value element)))))
   8634 	  default-category))
   8635        ;; Set categories from the document property drawer or
   8636        ;; property drawers in the outline.  If category is found in
   8637        ;; the property drawer for the whole buffer that value
   8638        ;; overrides the keyword-based value set above.
   8639        (goto-char (point-min))
   8640        (let ((regexp (org-re-property "CATEGORY")))
   8641 	 (while (re-search-forward regexp nil t)
   8642 	   (let ((value (match-string-no-properties 3)))
   8643 	     (when (org-at-property-p)
   8644 	       (put-text-property
   8645 		(save-excursion (org-back-to-heading-or-point-min t))
   8646 		(save-excursion (if (org-before-first-heading-p)
   8647 				    (point-max)
   8648 				  (org-end-of-subtree t t)))
   8649 		'org-category
   8650 		value)))))))))
   8651 
   8652 (defun org-refresh-stats-properties ()
   8653   "Refresh stats text properties in the buffer."
   8654   (with-silent-modifications
   8655     (org-with-point-at 1
   8656       (let ((regexp (concat org-outline-regexp-bol
   8657 			    ".*\\[\\([0-9]*\\)\\(?:%\\|/\\([0-9]*\\)\\)\\]")))
   8658 	(while (re-search-forward regexp nil t)
   8659 	  (let* ((numerator (string-to-number (match-string 1)))
   8660 		 (denominator (and (match-end 2)
   8661 				   (string-to-number (match-string 2))))
   8662 		 (stats (cond ((not denominator) numerator) ;percent
   8663 			      ((= denominator 0) 0)
   8664 			      (t (/ (* numerator 100) denominator)))))
   8665 	    (put-text-property (point) (progn (org-end-of-subtree t t) (point))
   8666 			       'org-stats stats)))))))
   8667 
   8668 (defun org-refresh-effort-properties ()
   8669   "Refresh effort properties."
   8670   (org-refresh-properties
   8671    org-effort-property
   8672    '((effort . identity)
   8673      (effort-minutes . org-duration-to-minutes))))
   8674 
   8675 (defun org-find-file-at-mouse (ev)
   8676   "Open file link or URL at mouse."
   8677   (interactive "e")
   8678   (mouse-set-point ev)
   8679   (org-open-at-point 'in-emacs))
   8680 
   8681 (defun org-open-at-mouse (ev)
   8682   "Open file link or URL at mouse.
   8683 See the docstring of `org-open-file' for details."
   8684   (interactive "e")
   8685   (mouse-set-point ev)
   8686   (when (eq major-mode 'org-agenda-mode)
   8687     (org-agenda-copy-local-variable 'org-link-abbrev-alist-local))
   8688   (org-open-at-point))
   8689 
   8690 (defvar org-window-config-before-follow-link nil
   8691   "The window configuration before following a link.
   8692 This is saved in case the need arises to restore it.")
   8693 
   8694 (defun org--file-default-apps ()
   8695   "Return the default applications for this operating system."
   8696   (pcase system-type
   8697     (`darwin org-file-apps-macos)
   8698     (`windows-nt org-file-apps-windowsnt)
   8699     (_ org-file-apps-gnu)))
   8700 
   8701 (defun org--file-apps-entry-dlink-p (entry)
   8702   "Non-nil if ENTRY should be matched against the link by `org-open-file'.
   8703 
   8704 It assumes that is the case when the entry uses a regular
   8705 expression which has at least one grouping construct and the
   8706 action is either a Lisp form or a command string containing
   8707 \"%1\", i.e., using at least one subexpression match as
   8708 a parameter."
   8709   (pcase entry
   8710     (`(,selector . ,action)
   8711      (and (stringp selector)
   8712 	  (> (regexp-opt-depth selector) 0)
   8713 	  (or (and (stringp action)
   8714 		   (string-match "%[0-9]" action))
   8715 	      (consp action))))
   8716     (_ nil)))
   8717 
   8718 (defun org--file-apps-regexp-alist (list &optional add-auto-mode)
   8719   "Convert extensions to regular expressions in the cars of LIST.
   8720 
   8721 Also, weed out any non-string entries, because the return value
   8722 is used only for regexp matching.
   8723 
   8724 When ADD-AUTO-MODE is non-nil, make all matches in `auto-mode-alist'
   8725 point to the symbol `emacs', indicating that the file should be
   8726 opened in Emacs."
   8727   (append
   8728    (delq nil
   8729 	 (mapcar (lambda (x)
   8730 		   (unless (not (stringp (car x)))
   8731 		     (if (string-match "\\W" (car x))
   8732 			 x
   8733 		       (cons (concat "\\." (car x) "\\'") (cdr x)))))
   8734 		 list))
   8735    (when add-auto-mode
   8736      (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist))))
   8737 
   8738 ;;;###autoload
   8739 (defun org-open-file (path &optional in-emacs line search)
   8740   "Open the file at PATH.
   8741 First, this expands any special file name abbreviations.  Then the
   8742 configuration variable `org-file-apps' is checked if it contains an
   8743 entry for this file type, and if yes, the corresponding command is launched.
   8744 
   8745 If no application is found, Emacs simply visits the file.
   8746 
   8747 With optional prefix argument IN-EMACS, Emacs will visit the file.
   8748 With a double \\[universal-argument] \\[universal-argument] \
   8749 prefix arg, Org tries to avoid opening in Emacs
   8750 and to use an external application to visit the file.
   8751 
   8752 Optional LINE specifies a line to go to, optional SEARCH a string
   8753 to search for.  If LINE or SEARCH is given, the file will be
   8754 opened in Emacs, unless an entry from `org-file-apps' that makes
   8755 use of groups in a regexp matches.
   8756 
   8757 If you want to change the way frames are used when following a
   8758 link, please customize `org-link-frame-setup'.
   8759 
   8760 If the file does not exist, throw an error."
   8761   (let* ((file (if (equal path "") buffer-file-name
   8762 		 (substitute-in-file-name (expand-file-name path))))
   8763 	 (file-apps (append org-file-apps (org--file-default-apps)))
   8764 	 (apps (cl-remove-if #'org--file-apps-entry-dlink-p file-apps))
   8765 	 (apps-dlink (cl-remove-if-not #'org--file-apps-entry-dlink-p
   8766 				       file-apps))
   8767 	 (remp (and (assq 'remote apps) (file-remote-p file)))
   8768 	 (dirp (unless remp (file-directory-p file)))
   8769 	 (file (if (and dirp org-open-directory-means-index-dot-org)
   8770 		   (concat (file-name-as-directory file) "index.org")
   8771 		 file))
   8772 	 (a-m-a-p (assq 'auto-mode apps))
   8773 	 (dfile (downcase file))
   8774 	 ;; Reconstruct the original link from the PATH, LINE and
   8775 	 ;; SEARCH args.
   8776 	 (link (cond (line (concat file "::" (number-to-string line)))
   8777 		     (search (concat file "::" search))
   8778 		     (t file)))
   8779 	 (dlink (downcase link))
   8780 	 (ext
   8781 	  (and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile)
   8782 	       (match-string 1 dfile)))
   8783 	 (save-position-maybe
   8784 	  (let ((old-buffer (current-buffer))
   8785 		(old-pos (point))
   8786 		(old-mode major-mode))
   8787 	    (lambda ()
   8788 	      (and (derived-mode-p 'org-mode)
   8789 		   (eq old-mode 'org-mode)
   8790 		   (or (not (eq old-buffer (current-buffer)))
   8791 		       (not (eq old-pos (point))))
   8792 		   (org-mark-ring-push old-pos old-buffer)))))
   8793 	 cmd link-match-data)
   8794     (cond
   8795      ((member in-emacs '((16) system))
   8796       (setq cmd (cdr (assq 'system apps))))
   8797      (in-emacs (setq cmd 'emacs))
   8798      (t
   8799       (setq cmd (or (and remp (cdr (assq 'remote apps)))
   8800 		    (and dirp (cdr (assq 'directory apps)))
   8801 		    ;; First, try matching against apps-dlink if we
   8802 		    ;; get a match here, store the match data for
   8803 		    ;; later.
   8804 		    (let ((match (assoc-default dlink apps-dlink
   8805 						'string-match)))
   8806 		      (if match
   8807 			  (progn (setq link-match-data (match-data))
   8808 				 match)
   8809 			(progn (setq in-emacs (or in-emacs line search))
   8810 			       nil))) ; if we have no match in apps-dlink,
   8811 					; always open the file in emacs if line or search
   8812 					; is given (for backwards compatibility)
   8813 		    (assoc-default dfile
   8814 				   (org--file-apps-regexp-alist apps a-m-a-p)
   8815 				   'string-match)
   8816 		    (cdr (assoc ext apps))
   8817 		    (cdr (assq t apps))))))
   8818     (when (eq cmd 'system)
   8819       (setq cmd (cdr (assq 'system apps))))
   8820     (when (eq cmd 'default)
   8821       (setq cmd (cdr (assoc t apps))))
   8822     (when (eq cmd 'mailcap)
   8823       (require 'mailcap)
   8824       (mailcap-parse-mailcaps)
   8825       (let* ((mime-type (mailcap-extension-to-mime (or ext "")))
   8826 	     (command (mailcap-mime-info mime-type)))
   8827 	(if (stringp command)
   8828 	    (setq cmd command)
   8829 	  (setq cmd 'emacs))))
   8830     (when (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files
   8831 	       (not (file-exists-p file))
   8832 	       (not org-open-non-existing-files))
   8833       (user-error "No such file: %s" file))
   8834     (cond
   8835      ((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
   8836       ;; Remove quotes around the file name - we'll use shell-quote-argument.
   8837       (while (string-match "['\"]%s['\"]" cmd)
   8838 	(setq cmd (replace-match "%s" t t cmd)))
   8839       (setq cmd (replace-regexp-in-string
   8840 		 "%s"
   8841 		 (shell-quote-argument (convert-standard-filename file))
   8842 		 cmd
   8843 		 nil t))
   8844 
   8845       ;; Replace "%1", "%2" etc. in command with group matches from regex
   8846       (save-match-data
   8847 	(let ((match-index 1)
   8848 	      (number-of-groups (- (/ (length link-match-data) 2) 1)))
   8849 	  (set-match-data link-match-data)
   8850 	  (while (<= match-index number-of-groups)
   8851 	    (let ((regex (concat "%" (number-to-string match-index)))
   8852 		  (replace-with (match-string match-index dlink)))
   8853 	      (while (string-match regex cmd)
   8854 		(setq cmd (replace-match replace-with t t cmd))))
   8855 	    (setq match-index (+ match-index 1)))))
   8856 
   8857       (save-window-excursion
   8858 	(message "Running %s...done" cmd)
   8859         ;; Handlers such as "gio open" and kde-open5 start viewer in background
   8860         ;; and exit immediately.  Use pipe connection type instead of pty to
   8861         ;; avoid killing children processes with SIGHUP when temporary terminal
   8862         ;; session is finished.
   8863         ;;
   8864         ;; TODO: Once minimum Emacs version is 25.1 or above, consider using
   8865         ;; the `make-process' invocation from 5db61eb0f929 to get more helpful
   8866         ;; error messages.
   8867         (let ((process-connection-type nil))
   8868 	  (start-process-shell-command cmd nil cmd))
   8869 	(and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))))
   8870      ((or (stringp cmd)
   8871 	  (eq cmd 'emacs))
   8872       (funcall (cdr (assq 'file org-link-frame-setup)) file)
   8873       (widen)
   8874       (cond (line (org-goto-line line)
   8875 		  (when (derived-mode-p 'org-mode) (org-reveal)))
   8876 	    (search (condition-case err
   8877 			(org-link-search search)
   8878 		      ;; Save position before error-ing out so user
   8879 		      ;; can easily move back to the original buffer.
   8880 		      (error (funcall save-position-maybe)
   8881 			     (error (nth 1 err)))))))
   8882      ((functionp cmd)
   8883       (save-match-data
   8884 	(set-match-data link-match-data)
   8885 	(condition-case nil
   8886 	    (funcall cmd file link)
   8887 	  ;; FIXME: Remove this check when most default installations
   8888 	  ;; of Emacs have at least Org 9.0.
   8889 	  ((debug wrong-number-of-arguments wrong-type-argument
   8890 		  invalid-function)
   8891 	   (user-error "Please see Org News for version 9.0 about \
   8892 `org-file-apps'--Lisp error: %S" cmd)))))
   8893      ((consp cmd)
   8894       ;; FIXME: Remove this check when most default installations of
   8895       ;; Emacs have at least Org 9.0.  Heads-up instead of silently
   8896       ;; fall back to `org-link-frame-setup' for an old usage of
   8897       ;; `org-file-apps' with sexp instead of a function for `cmd'.
   8898       (user-error "Please see Org News for version 9.0 about \
   8899 `org-file-apps'--Error: Deprecated usage of %S" cmd))
   8900      (t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
   8901     (funcall save-position-maybe)))
   8902 
   8903 ;;;###autoload
   8904 (defun org-open-at-point-global ()
   8905   "Follow a link or a time-stamp like Org mode does.
   8906 Also follow links and emails as seen by `thing-at-point'.
   8907 This command can be called in any mode to follow an external
   8908 link or a time-stamp that has Org mode syntax.  Its behavior
   8909 is undefined when called on internal links like fuzzy links.
   8910 Raise a user error when there is nothing to follow."
   8911   (interactive)
   8912   (let ((tap-url (thing-at-point 'url))
   8913 	(tap-email (thing-at-point 'email)))
   8914     (cond ((org-in-regexp org-link-any-re)
   8915 	   (org-link-open-from-string (match-string-no-properties 0)))
   8916 	  ((or (org-in-regexp org-ts-regexp-both nil t)
   8917 	       (org-in-regexp org-tsr-regexp-both nil t))
   8918 	   (org-follow-timestamp-link))
   8919 	  (tap-url (org-link-open-from-string tap-url))
   8920 	  (tap-email (org-link-open-from-string
   8921 		      (concat "mailto:" tap-email)))
   8922 	  (t (user-error "No link found")))))
   8923 
   8924 (defvar org-open-at-point-functions nil
   8925   "Hook that is run when following a link at point.
   8926 
   8927 Functions in this hook must return t if they identify and follow
   8928 a link at point.  If they don't find anything interesting at point,
   8929 they must return nil.")
   8930 
   8931 (defun org-open-at-point (&optional arg)
   8932   "Open link, timestamp, footnote or tags at point.
   8933 
   8934 When point is on a link, follow it.  Normally, files will be
   8935 opened by an appropriate application.  If the optional prefix
   8936 argument ARG is non-nil, Emacs will visit the file.  With
   8937 a double prefix argument, try to open outside of Emacs, in the
   8938 application the system uses for this file type.
   8939 
   8940 When point is on a timestamp, open the agenda at the day
   8941 specified.
   8942 
   8943 When point is a footnote definition, move to the first reference
   8944 found.  If it is on a reference, move to the associated
   8945 definition.
   8946 
   8947 When point is on a headline, display a list of every link in the
   8948 entry, so it is possible to pick one, or all, of them.  If point
   8949 is on a tag, call `org-tags-view' instead.
   8950 
   8951 On top of syntactically correct links, this function also tries
   8952 to open links and time-stamps in comments, node properties, and
   8953 keywords if point is on something looking like a timestamp or
   8954 a link."
   8955   (interactive "P")
   8956   (org-load-modules-maybe)
   8957   (setq org-window-config-before-follow-link (current-window-configuration))
   8958   (org-remove-occur-highlights nil nil t)
   8959   (unless (run-hook-with-args-until-success 'org-open-at-point-functions)
   8960     (let* ((context
   8961 	    ;; Only consider supported types, even if they are not the
   8962 	    ;; closest one.
   8963 	    (org-element-lineage
   8964 	     (org-element-context)
   8965 	     '(citation citation-reference clock comment comment-block
   8966                         footnote-definition footnote-reference headline
   8967                         inline-src-block inlinetask keyword link node-property
   8968                         planning src-block timestamp)
   8969 	     t))
   8970 	   (type (org-element-type context))
   8971 	   (value (org-element-property :value context)))
   8972       (cond
   8973        ((not type) (user-error "No link found"))
   8974        ;; No valid link at point.  For convenience, look if something
   8975        ;; looks like a link under point in some specific places.
   8976        ((memq type '(comment comment-block node-property keyword))
   8977 	(call-interactively #'org-open-at-point-global))
   8978        ;; On a headline or an inlinetask, but not on a timestamp,
   8979        ;; a link, a footnote reference or a citation.
   8980        ((memq type '(headline inlinetask))
   8981 	(org-match-line org-complex-heading-regexp)
   8982 	(let ((tags-beg (match-beginning 5))
   8983 	      (tags-end (match-end 5)))
   8984 	  (if (and tags-beg (>= (point) tags-beg) (< (point) tags-end))
   8985 	      ;; On tags.
   8986 	      (org-tags-view
   8987 	       arg
   8988 	       (save-excursion
   8989 		 (let* ((beg-tag (or (search-backward ":" tags-beg 'at-limit) (point)))
   8990 			(end-tag (search-forward ":" tags-end nil 2)))
   8991 		   (buffer-substring (1+ beg-tag) (1- end-tag)))))
   8992 	    ;; Not on tags.
   8993 	    (pcase (org-offer-links-in-entry (current-buffer) (point) arg)
   8994 	      (`(nil . ,_)
   8995 	       (require 'org-attach)
   8996 	       (when (org-attach-dir)
   8997 		 (message "Opening attachment")
   8998 		 (if (equal arg '(4))
   8999 		     (org-attach-reveal-in-emacs)
   9000 		   (org-attach-reveal))))
   9001 	      (`(,links . ,links-end)
   9002 	       (dolist (link (if (stringp links) (list links) links))
   9003 		 (search-forward link nil links-end)
   9004 		 (goto-char (match-beginning 0))
   9005 		 (org-open-at-point arg)))))))
   9006        ;; On a footnote reference or at definition's label.
   9007        ((or (eq type 'footnote-reference)
   9008 	    (and (eq type 'footnote-definition)
   9009 		 (save-excursion
   9010 		   ;; Do not validate action when point is on the
   9011 		   ;; spaces right after the footnote label, in order
   9012 		   ;; to be on par with behavior on links.
   9013 		   (skip-chars-forward " \t")
   9014 		   (let ((begin
   9015 			  (org-element-property :contents-begin context)))
   9016 		     (if begin (< (point) begin)
   9017 		       (= (org-element-property :post-affiliated context)
   9018 			  (line-beginning-position)))))))
   9019 	(org-footnote-action))
   9020        ;; On a planning line.  Check if we are really on a timestamp.
   9021        ((and (eq type 'planning)
   9022 	     (org-in-regexp org-ts-regexp-both nil t))
   9023 	(org-follow-timestamp-link))
   9024        ;; On a clock line, make sure point is on the timestamp
   9025        ;; before opening it.
   9026        ((and (eq type 'clock)
   9027 	     value
   9028 	     (>= (point) (org-element-property :begin value))
   9029 	     (<= (point) (org-element-property :end value)))
   9030 	(org-follow-timestamp-link))
   9031        ((eq type 'src-block) (org-babel-open-src-block-result))
   9032        ;; Do nothing on white spaces after an object.
   9033        ((>= (point)
   9034 	    (save-excursion
   9035 	      (goto-char (org-element-property :end context))
   9036 	      (skip-chars-backward " \t")
   9037 	      (point)))
   9038 	(user-error "No link found"))
   9039        ((eq type 'inline-src-block) (org-babel-open-src-block-result))
   9040        ((eq type 'timestamp) (org-follow-timestamp-link))
   9041        ((eq type 'link) (org-link-open context arg))
   9042        ((memq type '(citation citation-reference)) (org-cite-follow context arg))
   9043        (t (user-error "No link found")))))
   9044   (run-hook-with-args 'org-follow-link-hook))
   9045 
   9046 ;;;###autoload
   9047 (defun org-offer-links-in-entry (buffer marker &optional nth zero)
   9048   "Offer links in the current entry and return the selected link.
   9049 If there is only one link, return it.
   9050 If NTH is an integer, return the NTH link found.
   9051 If ZERO is a string, check also this string for a link, and if
   9052 there is one, return it."
   9053   (with-current-buffer buffer
   9054     (org-with-wide-buffer
   9055      (goto-char marker)
   9056      (let ((cnt ?0)
   9057 	   have-zero end links link c)
   9058        (when (and (stringp zero) (string-match org-link-bracket-re zero))
   9059 	 (push (match-string 0 zero) links)
   9060 	 (setq cnt (1- cnt) have-zero t))
   9061        (save-excursion
   9062 	 (org-back-to-heading t)
   9063 	 (setq end (save-excursion (outline-next-heading) (point)))
   9064 	 (while (re-search-forward org-link-any-re end t)
   9065 	   (push (match-string 0) links))
   9066 	 (setq links (org-uniquify (reverse links))))
   9067        (cond
   9068 	((null links)
   9069 	 (message "No links"))
   9070 	((equal (length links) 1)
   9071 	 (setq link (car links)))
   9072 	((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth)))
   9073 	 (setq link (nth (if have-zero nth (1- nth)) links)))
   9074 	(t				; we have to select a link
   9075 	 (save-excursion
   9076 	   (save-window-excursion
   9077 	     (delete-other-windows)
   9078 	     (with-output-to-temp-buffer "*Select Link*"
   9079 	       (dolist (l links)
   9080 		 (cond
   9081 		  ((not (string-match org-link-bracket-re l))
   9082 		   (princ (format "[%c]  %s\n" (cl-incf cnt)
   9083 				  (org-unbracket-string "<" ">" l))))
   9084 		  ((match-end 2)
   9085 		   (princ (format "[%c]  %s (%s)\n" (cl-incf cnt)
   9086 				  (match-string 2 l) (match-string 1 l))))
   9087 		  (t (princ (format "[%c]  %s\n" (cl-incf cnt)
   9088 				    (match-string 1 l)))))))
   9089 	     (org-fit-window-to-buffer (get-buffer-window "*Select Link*"))
   9090 	     (message "Select link to open, RET to open all:")
   9091 	     (setq c (read-char-exclusive))
   9092 	     (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*"))))
   9093 	 (when (equal c ?q) (user-error "Abort"))
   9094 	 (if (equal c ?\C-m)
   9095 	     (setq link links)
   9096 	   (setq nth (- c ?0))
   9097 	   (when have-zero (setq nth (1+ nth)))
   9098 	   (unless (and (integerp nth) (>= (length links) nth))
   9099 	     (user-error "Invalid link selection"))
   9100 	   (setq link (nth (1- nth) links)))))
   9101        (cons link end)))))
   9102 
   9103 ;;; File search
   9104 
   9105 (defun org-do-occur (regexp &optional cleanup)
   9106   "Call the Emacs command `occur'.
   9107 If CLEANUP is non-nil, remove the printout of the regular expression
   9108 in the *Occur* buffer.  This is useful if the regex is long and not useful
   9109 to read."
   9110   (occur regexp)
   9111   (when cleanup
   9112     (let ((cwin (selected-window)) win beg end)
   9113       (when (setq win (get-buffer-window "*Occur*"))
   9114 	(select-window win))
   9115       (goto-char (point-min))
   9116       (when (re-search-forward "match[a-z]+" nil t)
   9117 	(setq beg (match-end 0))
   9118 	(when (re-search-forward "^[ \t]*[0-9]+" nil t)
   9119 	  (setq end (1- (match-beginning 0)))))
   9120       (and beg end (let ((inhibit-read-only t)) (delete-region beg end)))
   9121       (goto-char (point-min))
   9122       (select-window cwin))))
   9123 
   9124 
   9125 ;;; The Mark Ring
   9126 
   9127 (defvar org-mark-ring nil
   9128   "Mark ring for positions before jumps in Org mode.")
   9129 
   9130 (defvar org-mark-ring-last-goto nil
   9131   "Last position in the mark ring used to go back.")
   9132 
   9133 ;; Fill and close the ring
   9134 (setq org-mark-ring nil)
   9135 (setq org-mark-ring-last-goto nil) ;in case file is reloaded
   9136 
   9137 (dotimes (_ org-mark-ring-length) (push (make-marker) org-mark-ring))
   9138 (setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring)
   9139 	org-mark-ring)
   9140 
   9141 (defun org-mark-ring-push (&optional pos buffer)
   9142   "Put the current position into the mark ring and rotate it.
   9143 Also push position into the Emacs mark ring.  If optional
   9144 argument POS and BUFFER are not nil, mark this location instead."
   9145   (interactive)
   9146   (let ((pos (or pos (point)))
   9147 	(buffer (or buffer (current-buffer))))
   9148     (with-current-buffer buffer
   9149       (org-with-point-at pos (push-mark nil t)))
   9150     (setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring))
   9151     (move-marker (car org-mark-ring) pos buffer))
   9152   (message
   9153    (substitute-command-keys
   9154     "Position saved to mark ring, go back with `\\[org-mark-ring-goto]'.")))
   9155 
   9156 (defun org-mark-ring-goto (&optional n)
   9157   "Jump to the previous position in the mark ring.
   9158 With prefix arg N, jump back that many stored positions.  When
   9159 called several times in succession, walk through the entire ring.
   9160 Org mode commands jumping to a different position in the current file,
   9161 or to another Org file, automatically push the old position onto the ring."
   9162   (interactive "p")
   9163   (let (p m)
   9164     (if (eq last-command this-command)
   9165 	(setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring)))
   9166       (setq p org-mark-ring))
   9167     (setq org-mark-ring-last-goto p)
   9168     (setq m (car p))
   9169     (pop-to-buffer-same-window (marker-buffer m))
   9170     (goto-char m)
   9171     (when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
   9172 
   9173 ;;; Following specific links
   9174 
   9175 (defvar org-agenda-buffer-tmp-name)
   9176 (defvar org-agenda-start-on-weekday)
   9177 (defvar org-agenda-buffer-name)
   9178 (defun org-follow-timestamp-link ()
   9179   "Open an agenda view for the time-stamp date/range at point."
   9180   ;; Avoid changing the global value.
   9181   (let ((org-agenda-buffer-name org-agenda-buffer-name))
   9182     (cond
   9183      ((org-at-date-range-p t)
   9184       (let ((org-agenda-start-on-weekday)
   9185 	    (t1 (match-string 1))
   9186 	    (t2 (match-string 2)) tt1 tt2)
   9187 	(setq tt1 (time-to-days (org-time-string-to-time t1))
   9188 	      tt2 (time-to-days (org-time-string-to-time t2)))
   9189 	(let ((org-agenda-buffer-tmp-name
   9190 	       (format "*Org Agenda(a:%s)"
   9191 		       (concat (substring t1 0 10) "--" (substring t2 0 10)))))
   9192 	  (org-agenda-list nil tt1 (1+ (- tt2 tt1))))))
   9193      ((org-at-timestamp-p 'lax)
   9194       (let ((org-agenda-buffer-tmp-name
   9195 	     (format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10))))
   9196 	(org-agenda-list nil (time-to-days (org-time-string-to-time
   9197 					    (substring (match-string 1) 0 10)))
   9198 			 1)))
   9199      (t (error "This should not happen")))))
   9200 
   9201 
   9202 ;;; Following file links
   9203 (declare-function mailcap-parse-mailcaps "mailcap" (&optional path force))
   9204 (declare-function mailcap-extension-to-mime "mailcap" (extn))
   9205 (declare-function mailcap-mime-info
   9206 		  "mailcap" (string &optional request no-decode))
   9207 (defvar org-wait nil)
   9208 
   9209 ;;;; Refiling
   9210 
   9211 (defun org-get-org-file ()
   9212   "Read a filename, with default directory `org-directory'."
   9213   (let ((default (or org-default-notes-file remember-data-file)))
   9214     (read-file-name (format "File name [%s]: " default)
   9215 		    (file-name-as-directory org-directory)
   9216 		    default)))
   9217 
   9218 (defun org-notes-order-reversed-p ()
   9219   "Check if the current file should receive notes in reversed order."
   9220   (cond
   9221    ((not org-reverse-note-order) nil)
   9222    ((eq t org-reverse-note-order) t)
   9223    ((not (listp org-reverse-note-order)) nil)
   9224    (t (catch 'exit
   9225         (dolist (entry org-reverse-note-order)
   9226           (when (string-match (car entry) buffer-file-name)
   9227 	    (throw 'exit (cdr entry))))))))
   9228 
   9229 (defvar org-agenda-new-buffers nil
   9230   "Buffers created to visit agenda files.")
   9231 
   9232 (declare-function org-string-nw-p "org-macs" (s))
   9233 ;;;; Dynamic blocks
   9234 
   9235 (defun org-find-dblock (name)
   9236   "Find the first dynamic block with name NAME in the buffer.
   9237 If not found, stay at current position and return nil."
   9238   (let ((case-fold-search t) pos)
   9239     (save-excursion
   9240       (goto-char (point-min))
   9241       (setq pos (and (re-search-forward
   9242 		      (concat "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+" name "\\>") nil t)
   9243 		     (match-beginning 0))))
   9244     (when pos (goto-char pos))
   9245     pos))
   9246 
   9247 (defun org-create-dblock (plist)
   9248   "Create a dynamic block section, with parameters taken from PLIST.
   9249 PLIST must contain a :name entry which is used as the name of the block."
   9250   (when (string-match "\\S-" (buffer-substring (point-at-bol) (point-at-eol)))
   9251     (end-of-line 1)
   9252     (newline))
   9253   (let ((col (current-column))
   9254 	(name (plist-get plist :name)))
   9255     (insert "#+BEGIN: " name)
   9256     (while plist
   9257       (if (eq (car plist) :name)
   9258 	  (setq plist (cddr plist))
   9259 	(insert " " (prin1-to-string (pop plist)))))
   9260     (insert "\n\n" (make-string col ?\ ) "#+END:\n")
   9261     (beginning-of-line -2)))
   9262 
   9263 (defun org-prepare-dblock ()
   9264   "Prepare dynamic block for refresh.
   9265 This empties the block, puts the cursor at the insert position and returns
   9266 the property list including an extra property :name with the block name."
   9267   (unless (looking-at org-dblock-start-re)
   9268     (user-error "Not at a dynamic block"))
   9269   (let* ((begdel (1+ (match-end 0)))
   9270 	 (name (org-no-properties (match-string 1)))
   9271 	 (params (append (list :name name)
   9272 			 (read (concat "(" (match-string 3) ")")))))
   9273     (save-excursion
   9274       (beginning-of-line 1)
   9275       (skip-chars-forward " \t")
   9276       (setq params (plist-put params :indentation-column (current-column))))
   9277     (unless (re-search-forward org-dblock-end-re nil t)
   9278       (error "Dynamic block not terminated"))
   9279     (setq params
   9280 	  (append params
   9281 		  (list :content (buffer-substring
   9282 				  begdel (match-beginning 0)))))
   9283     (delete-region begdel (match-beginning 0))
   9284     (goto-char begdel)
   9285     (open-line 1)
   9286     params))
   9287 
   9288 (defun org-map-dblocks (&optional command)
   9289   "Apply COMMAND to all dynamic blocks in the current buffer.
   9290 If COMMAND is not given, use `org-update-dblock'."
   9291   (let ((cmd (or command 'org-update-dblock)))
   9292     (save-excursion
   9293       (goto-char (point-min))
   9294       (while (re-search-forward org-dblock-start-re nil t)
   9295 	(goto-char (match-beginning 0))
   9296         (save-excursion
   9297           (condition-case nil
   9298               (funcall cmd)
   9299             (error (message "Error during update of dynamic block"))))
   9300 	(unless (re-search-forward org-dblock-end-re nil t)
   9301 	  (error "Dynamic block not terminated"))))))
   9302 
   9303 (defvar org-dynamic-block-alist nil
   9304   "Alist defining all the Org dynamic blocks.
   9305 
   9306 The key is the dynamic block type name, as a string.  The value
   9307 is the function used to insert the dynamic block.
   9308 
   9309 Use `org-dynamic-block-define' to populate it.")
   9310 
   9311 (defun org-dynamic-block-function (type)
   9312   "Return function associated to a given dynamic block type.
   9313 TYPE is the dynamic block type, as a string."
   9314   (cdr (assoc type org-dynamic-block-alist)))
   9315 
   9316 (defun org-dynamic-block-types ()
   9317   "List all defined dynamic block types."
   9318   (mapcar #'car org-dynamic-block-alist))
   9319 
   9320 (defun org-dynamic-block-define (type func)
   9321   "Define dynamic block TYPE with FUNC.
   9322 TYPE is a string.  FUNC is the function creating the dynamic
   9323 block of such type."
   9324   (pcase (assoc type org-dynamic-block-alist)
   9325     (`nil (push (cons type func) org-dynamic-block-alist))
   9326     (def (setcdr def func))))
   9327 
   9328 (defun org-dynamic-block-insert-dblock (type &optional interactive-p)
   9329   "Insert a dynamic block of type TYPE.
   9330 When used interactively, select the dynamic block types among
   9331 defined types, per `org-dynamic-block-define'.  If INTERACTIVE-P
   9332 is non-nil, call the dynamic block function interactively."
   9333   (interactive (list (completing-read "Dynamic block: "
   9334 				      (org-dynamic-block-types))
   9335 		     t))
   9336   (pcase (org-dynamic-block-function type)
   9337     (`nil (error "No such dynamic block: %S" type))
   9338     ((and f (pred functionp))
   9339      (if interactive-p (call-interactively f) (funcall f)))
   9340     (_ (error "Invalid function for dynamic block %S" type))))
   9341 
   9342 (defun org-dblock-update (&optional arg)
   9343   "User command for updating dynamic blocks.
   9344 Update the dynamic block at point.  With prefix ARG, update all dynamic
   9345 blocks in the buffer."
   9346   (interactive "P")
   9347   (if arg
   9348       (org-update-all-dblocks)
   9349     (or (looking-at org-dblock-start-re)
   9350 	(org-beginning-of-dblock))
   9351     (org-update-dblock)))
   9352 
   9353 (defun org-update-dblock ()
   9354   "Update the dynamic block at point.
   9355 This means to empty the block, parse for parameters and then call
   9356 the correct writing function."
   9357   (interactive)
   9358   (save-excursion
   9359     (let* ((win (selected-window))
   9360 	   (pos (point))
   9361 	   (line (org-current-line))
   9362 	   (params (org-prepare-dblock))
   9363 	   (name (plist-get params :name))
   9364 	   (indent (plist-get params :indentation-column))
   9365 	   (cmd (intern (concat "org-dblock-write:" name))))
   9366       (message "Updating dynamic block `%s' at line %d..." name line)
   9367       (funcall cmd params)
   9368       (message "Updating dynamic block `%s' at line %d...done" name line)
   9369       (goto-char pos)
   9370       (when (and indent (> indent 0))
   9371 	(setq indent (make-string indent ?\ ))
   9372 	(save-excursion
   9373 	  (select-window win)
   9374 	  (org-beginning-of-dblock)
   9375 	  (forward-line 1)
   9376 	  (while (not (looking-at org-dblock-end-re))
   9377 	    (insert indent)
   9378 	    (beginning-of-line 2))
   9379 	  (when (looking-at org-dblock-end-re)
   9380 	    (and (looking-at "[ \t]+")
   9381 		 (replace-match ""))
   9382 	    (insert indent)))))))
   9383 
   9384 (defun org-beginning-of-dblock ()
   9385   "Find the beginning of the dynamic block at point.
   9386 Error if there is no such block at point."
   9387   (let ((pos (point))
   9388 	beg)
   9389     (end-of-line 1)
   9390     (if (and (re-search-backward org-dblock-start-re nil t)
   9391 	     (setq beg (match-beginning 0))
   9392 	     (re-search-forward org-dblock-end-re nil t)
   9393 	     (> (match-end 0) pos))
   9394 	(goto-char beg)
   9395       (goto-char pos)
   9396       (error "Not in a dynamic block"))))
   9397 
   9398 (defun org-update-all-dblocks ()
   9399   "Update all dynamic blocks in the buffer.
   9400 This function can be used in a hook."
   9401   (interactive)
   9402   (when (derived-mode-p 'org-mode)
   9403     (org-map-dblocks 'org-update-dblock)))
   9404 
   9405 
   9406 ;;;; Completion
   9407 
   9408 (declare-function org-export-backend-options "ox" (cl-x) t)
   9409 (defun org-get-export-keywords ()
   9410   "Return a list of all currently understood export keywords.
   9411 Export keywords include options, block names, attributes and
   9412 keywords relative to each registered export back-end."
   9413   (let (keywords)
   9414     (dolist (backend
   9415 	     (bound-and-true-p org-export-registered-backends)
   9416 	     (delq nil keywords))
   9417       ;; Back-end name (for keywords, like #+LATEX:)
   9418       (push (upcase (symbol-name (org-export-backend-name backend))) keywords)
   9419       (dolist (option-entry (org-export-backend-options backend))
   9420 	;; Back-end options.
   9421 	(push (nth 1 option-entry) keywords)))))
   9422 
   9423 (defconst org-options-keywords
   9424   '("ARCHIVE:" "AUTHOR:" "BIND:" "CATEGORY:" "COLUMNS:" "CREATOR:" "DATE:"
   9425     "DESCRIPTION:" "DRAWERS:" "EMAIL:" "EXCLUDE_TAGS:" "FILETAGS:" "INCLUDE:"
   9426     "INDEX:" "KEYWORDS:" "LANGUAGE:" "MACRO:" "OPTIONS:" "PROPERTY:"
   9427     "PRIORITIES:" "SELECT_TAGS:" "SEQ_TODO:" "SETUPFILE:" "STARTUP:" "TAGS:"
   9428     "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:"))
   9429 
   9430 (defcustom org-structure-template-alist
   9431   '(("a" . "export ascii")
   9432     ("c" . "center")
   9433     ("C" . "comment")
   9434     ("e" . "example")
   9435     ("E" . "export")
   9436     ("h" . "export html")
   9437     ("l" . "export latex")
   9438     ("q" . "quote")
   9439     ("s" . "src")
   9440     ("v" . "verse"))
   9441   "An alist of keys and block types.
   9442 `org-insert-structure-template' will display a menu with this
   9443 list of templates to choose from.  The block type is inserted,
   9444 with \"#+BEGIN_\" and \"#+END_\" added automatically.
   9445 
   9446 The menu keys are defined by the car of each entry in this alist.
   9447 If two entries have the keys \"a\" and \"aa\" respectively, the
   9448 former will be inserted by typing \"a TAB/RET/SPC\" and the
   9449 latter will be inserted by typing \"aa\".  If an entry with the
   9450 key \"aab\" is later added, it can be inserted by typing \"ab\".
   9451 
   9452 If loaded, Org Tempo also uses `org-structure-template-alist'.  A
   9453 block can be inserted by pressing TAB after the string \"<KEY\"."
   9454   :group 'org-edit-structure
   9455   :type '(repeat
   9456 	  (cons (string :tag "Key")
   9457 		(string :tag "Template")))
   9458   :package-version '(Org . "9.2"))
   9459 
   9460 (defun org--check-org-structure-template-alist (&optional checklist)
   9461   "Check whether `org-structure-template-alist' is set up correctly.
   9462 In particular, check if the Org 9.2 format is used as opposed to
   9463 previous format."
   9464   (let ((elm (cl-remove-if-not (lambda (x) (listp (cdr x)))
   9465 			       (or (eval checklist)
   9466 				   org-structure-template-alist))))
   9467     (when elm
   9468       (org-display-warning
   9469        (format "
   9470 Please update the entries of `%s'.
   9471 
   9472 In Org 9.2 the format was changed from something like
   9473 
   9474     (\"s\" \"#+BEGIN_SRC ?\\n#+END_SRC\")
   9475 
   9476 to something like
   9477 
   9478     (\"s\" . \"src\")
   9479 
   9480 Please refer to the documentation of `org-structure-template-alist'.
   9481 
   9482 The following entries must be updated:
   9483 
   9484 %s"
   9485 	       (or checklist 'org-structure-template-alist)
   9486 	       (pp-to-string elm))))))
   9487 
   9488 (defun org--insert-structure-template-mks ()
   9489   "Present `org-structure-template-alist' with `org-mks'.
   9490 
   9491 Menus are added if keys require more than one keystroke.  Tabs
   9492 are added to single key entries when more than one stroke is
   9493 needed.  Keys longer than two characters are reduced to two
   9494 characters."
   9495   (org--check-org-structure-template-alist)
   9496   (let* (case-fold-search
   9497 	 (templates (append org-structure-template-alist
   9498 			    '(("\t" . "Press TAB, RET or SPC to write block name"))))
   9499          (keys (mapcar #'car templates))
   9500          (start-letters
   9501 	  (delete-dups (mapcar (lambda (key) (substring key 0 1)) keys)))
   9502 	 ;; Sort each element of `org-structure-template-alist' into
   9503 	 ;; sublists according to the first letter.
   9504          (superlist
   9505 	  (mapcar (lambda (letter)
   9506                     (list letter
   9507 			  (cl-remove-if-not
   9508 			   (apply-partially #'string-match-p (concat "^" letter))
   9509 			   templates :key #'car)))
   9510 		  start-letters)))
   9511     (org-mks
   9512      (apply #'append
   9513 	    ;; Make an `org-mks' table.  If only one element is
   9514 	    ;; present in a sublist, make it part of the top-menu,
   9515 	    ;; otherwise make a submenu according to the starting
   9516 	    ;; letter and populate it.
   9517 	    (mapcar (lambda (sublist)
   9518 		      (if (eq 1 (length (cadr sublist)))
   9519                           (mapcar (lambda (elm)
   9520 				    (list (substring (car elm) 0 1)
   9521                                           (cdr elm) ""))
   9522                                   (cadr sublist))
   9523 			;; Create submenu.
   9524                         (let* ((topkey (car sublist))
   9525 			       (elms (cadr sublist))
   9526 			       (keys (mapcar #'car elms))
   9527 			       (long (> (length elms) 3)))
   9528                           (append
   9529 			   (list
   9530 			    ;; Make a description of the submenu.
   9531 			    (list topkey
   9532 				  (concat
   9533 				   (mapconcat #'cdr
   9534 					      (cl-subseq elms 0 (if long 3 (length elms)))
   9535 					      ", ")
   9536                                    (when long ", ..."))))
   9537 			   ;; List of entries in submenu.
   9538 			   (cl-mapcar #'list
   9539 				      (org--insert-structure-template-unique-keys keys)
   9540 				      (mapcar #'cdr elms)
   9541 				      (make-list (length elms) ""))))))
   9542 		    superlist))
   9543      "Select a key\n============"
   9544      "Key: ")))
   9545 
   9546 (defun org--insert-structure-template-unique-keys (keys)
   9547   "Make a list of unique, two characters long elements from KEYS.
   9548 
   9549 Elements of length one have a tab appended.  Elements of length
   9550 two are kept as is.  Longer elements are truncated to length two.
   9551 
   9552 If an element cannot be made unique, an error is raised."
   9553   (let ((ordered-keys (cl-sort (copy-sequence keys) #'< :key #'length))
   9554 	menu-keys)
   9555     (dolist (key ordered-keys)
   9556       (let ((potential-key
   9557 	     (cl-case (length key)
   9558 	       (1 (concat key "\t"))
   9559 	       (2 key)
   9560 	       (otherwise
   9561 		(cl-find-if-not (lambda (k) (assoc k menu-keys))
   9562 				(mapcar (apply-partially #'concat (substring  key 0 1))
   9563 					(split-string (substring key 1) "" t)))))))
   9564 	(if (or (not potential-key) (assoc potential-key menu-keys))
   9565             (user-error "Could not make unique key for `%s'" key)
   9566 	  (push (cons potential-key key) menu-keys))))
   9567     (mapcar #'car
   9568 	    (cl-sort menu-keys #'<
   9569 		     :key (lambda (elm) (cl-position (cdr elm) keys))))))
   9570 
   9571 (defun org-insert-structure-template (type)
   9572   "Insert a block structure of the type #+begin_foo/#+end_foo.
   9573 Select a block from `org-structure-template-alist' then type
   9574 either RET, TAB or SPC to write the block type.  With an active
   9575 region, wrap the region in the block.  Otherwise, insert an empty
   9576 block."
   9577   (interactive
   9578    (list (pcase (org--insert-structure-template-mks)
   9579 	   (`("\t" . ,_) (read-string "Structure type: "))
   9580 	   (`(,_ ,choice . ,_) choice))))
   9581   (let* ((region? (use-region-p))
   9582 	 (region-start (and region? (region-beginning)))
   9583 	 (region-end (and region? (copy-marker (region-end))))
   9584 	 (extended? (string-match-p "\\`\\(src\\|export\\)\\'" type))
   9585 	 (verbatim? (string-match-p
   9586 		     (concat "\\`" (regexp-opt '("example" "export" "src")))
   9587 		     type)))
   9588     (when region? (goto-char region-start))
   9589     (let ((column (current-indentation)))
   9590       (if (save-excursion (skip-chars-backward " \t") (bolp))
   9591 	  (beginning-of-line)
   9592 	(insert "\n"))
   9593       (save-excursion
   9594 	(indent-to column)
   9595 	(insert (format "#+begin_%s%s\n" type (if extended? " " "")))
   9596 	(when region?
   9597 	  (when verbatim? (org-escape-code-in-region (point) region-end))
   9598 	  (goto-char region-end)
   9599 	  ;; Ignore empty lines at the end of the region.
   9600 	  (skip-chars-backward " \r\t\n")
   9601 	  (end-of-line))
   9602 	(unless (bolp) (insert "\n"))
   9603 	(indent-to column)
   9604 	(insert (format "#+end_%s" (car (split-string type))))
   9605 	(if (looking-at "[ \t]*$") (replace-match "")
   9606 	  (insert "\n"))
   9607 	(when (and (eobp) (not (bolp))) (insert "\n")))
   9608       (if extended? (end-of-line)
   9609 	(forward-line)
   9610 	(skip-chars-forward " \t")))))
   9611 
   9612 
   9613 ;;;; TODO, DEADLINE, Comments
   9614 
   9615 (defun org-toggle-comment ()
   9616   "Change the COMMENT state of an entry."
   9617   (interactive)
   9618   (save-excursion
   9619     (org-back-to-heading)
   9620     (let ((case-fold-search nil))
   9621       (looking-at org-complex-heading-regexp))
   9622     (goto-char (or (match-end 3) (match-end 2) (match-end 1)))
   9623     (skip-chars-forward " \t")
   9624     (unless (memq (char-before) '(?\s ?\t)) (insert " "))
   9625     (if (org-in-commented-heading-p t)
   9626 	(delete-region (point)
   9627 		       (progn (search-forward " " (line-end-position) 'move)
   9628 			      (skip-chars-forward " \t")
   9629 			      (point)))
   9630       (insert org-comment-string)
   9631       (unless (eolp) (insert " ")))))
   9632 
   9633 (defvar org-last-todo-state-is-todo nil
   9634   "This is non-nil when the last TODO state change led to a TODO state.
   9635 If the last change removed the TODO tag or switched to DONE, then
   9636 this is nil.")
   9637 
   9638 (defvar org-todo-setup-filter-hook nil
   9639   "Hook for functions that pre-filter todo specs.
   9640 Each function takes a todo spec and returns either nil or the spec
   9641 transformed into canonical form." )
   9642 
   9643 (defvar org-todo-get-default-hook nil
   9644   "Hook for functions that get a default item for todo.
   9645 Each function takes arguments (NEW-MARK OLD-MARK) and returns either
   9646 nil or a string to be used for the todo mark." )
   9647 
   9648 (defvar org-agenda-headline-snapshot-before-repeat)
   9649 
   9650 (defun org-current-effective-time ()
   9651   "Return current time adjusted for `org-extend-today-until' variable."
   9652   (let* ((ct (org-current-time))
   9653 	 (dct (decode-time ct))
   9654 	 (ct1
   9655 	  (cond
   9656 	   (org-use-last-clock-out-time-as-effective-time
   9657 	    (or (org-clock-get-last-clock-out-time) ct))
   9658 	   ((and org-use-effective-time (< (nth 2 dct) org-extend-today-until))
   9659 	    (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)))
   9660 	   (t ct))))
   9661     ct1))
   9662 
   9663 (defun org-todo-yesterday (&optional arg)
   9664   "Like `org-todo' but the time of change will be 23:59 of yesterday."
   9665   (interactive "P")
   9666   (if (eq major-mode 'org-agenda-mode)
   9667       (apply 'org-agenda-todo-yesterday arg)
   9668     (let* ((org-use-effective-time t)
   9669 	   (hour (nth 2 (decode-time (org-current-time))))
   9670 	   (org-extend-today-until (1+ hour)))
   9671       (org-todo arg))))
   9672 
   9673 (defvar org-block-entry-blocking ""
   9674   "First entry preventing the TODO state change.")
   9675 
   9676 (defun org-cancel-repeater ()
   9677   "Cancel a repeater by setting its numeric value to zero."
   9678   (interactive)
   9679   (save-excursion
   9680     (org-back-to-heading t)
   9681     (let ((bound1 (point))
   9682 	  (bound0 (save-excursion (outline-next-heading) (point))))
   9683       (when (and (re-search-forward
   9684 		  (concat "\\(" org-scheduled-time-regexp "\\)\\|\\("
   9685 			  org-deadline-time-regexp "\\)\\|\\("
   9686 			  org-ts-regexp "\\)")
   9687 		  bound0 t)
   9688 		 (re-search-backward "[ \t]+\\(?:[.+]\\)?\\+\\([0-9]+\\)[hdwmy]"
   9689 				     bound1 t))
   9690 	(replace-match "0" t nil nil 1)))))
   9691 
   9692 (defvar org-state)
   9693 (defvar org-blocked-by-checkboxes)
   9694 (defun org-todo (&optional arg)
   9695   "Change the TODO state of an item.
   9696 
   9697 The state of an item is given by a keyword at the start of the heading,
   9698 like
   9699      *** TODO Write paper
   9700      *** DONE Call mom
   9701 
   9702 The different keywords are specified in the variable `org-todo-keywords'.
   9703 By default the available states are \"TODO\" and \"DONE\".  So, for this
   9704 example: when the item starts with TODO, it is changed to DONE.
   9705 When it starts with DONE, the DONE is removed.  And when neither TODO nor
   9706 DONE are present, add TODO at the beginning of the heading.
   9707 You can set up single-character keys to fast-select the new state.  See the
   9708 `org-todo-keywords' and `org-use-fast-todo-selection' for details.
   9709 
   9710 With `\\[universal-argument]' prefix ARG, force logging the state change \
   9711 and take a
   9712 logging note.
   9713 With a `\\[universal-argument] \\[universal-argument]' prefix, switch to the \
   9714 next set of TODO \
   9715 keywords (nextset).
   9716 Another way to achieve this is `S-C-<right>'.
   9717 With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
   9718 prefix, circumvent any state blocking.
   9719 With numeric prefix arg, switch to the Nth state.
   9720 
   9721 With a numeric prefix arg of 0, inhibit note taking for the change.
   9722 With a numeric prefix arg of -1, cancel repeater to allow marking as DONE.
   9723 
   9724 When called through ELisp, arg is also interpreted in the following way:
   9725 `none'        -> empty state
   9726 \"\"            -> switch to empty state
   9727 `done'        -> switch to DONE
   9728 `nextset'     -> switch to the next set of keywords
   9729 `previousset' -> switch to the previous set of keywords
   9730 \"WAITING\"     -> switch to the specified keyword, but only if it
   9731                  really is a member of `org-todo-keywords'."
   9732   (interactive "P")
   9733   (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
   9734       (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
   9735 		    'region-start-level 'region))
   9736 	    org-loop-over-headlines-in-active-region)
   9737 	(org-map-entries
   9738 	 (lambda () (org-todo arg))
   9739 	 nil cl
   9740 	 (when (org-invisible-p) (org-end-of-subtree nil t))))
   9741     (when (equal arg '(16)) (setq arg 'nextset))
   9742     (when (equal arg -1) (org-cancel-repeater) (setq arg nil))
   9743     (let ((org-blocker-hook org-blocker-hook)
   9744 	  commentp
   9745 	  case-fold-search)
   9746       (when (equal arg '(64))
   9747 	(setq arg nil org-blocker-hook nil))
   9748       (when (and org-blocker-hook
   9749 		 (or org-inhibit-blocking
   9750 		     (org-entry-get nil "NOBLOCKING")))
   9751 	(setq org-blocker-hook nil))
   9752       (save-excursion
   9753 	(catch 'exit
   9754 	  (org-back-to-heading t)
   9755 	  (when (org-in-commented-heading-p t)
   9756 	    (org-toggle-comment)
   9757 	    (setq commentp t))
   9758 	  (when (looking-at org-outline-regexp) (goto-char (1- (match-end 0))))
   9759 	  (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)"))
   9760 	      (looking-at "\\(?: *\\|[ \t]*$\\)"))
   9761 	  (let* ((match-data (match-data))
   9762 		 (startpos (copy-marker (line-beginning-position)))
   9763 		 (force-log (and  (equal arg '(4)) (prog1 t (setq arg nil))))
   9764 		 (logging (save-match-data (org-entry-get nil "LOGGING" t t)))
   9765 		 (org-log-done org-log-done)
   9766 		 (org-log-repeat org-log-repeat)
   9767 		 (org-todo-log-states org-todo-log-states)
   9768 		 (org-inhibit-logging
   9769 		  (if (equal arg 0)
   9770 		      (progn (setq arg nil) 'note) org-inhibit-logging))
   9771 		 (this (match-string 1))
   9772 		 (hl-pos (match-beginning 0))
   9773 		 (head (org-get-todo-sequence-head this))
   9774 		 (ass (assoc head org-todo-kwd-alist))
   9775 		 (interpret (nth 1 ass))
   9776 		 (done-word (nth 3 ass))
   9777 		 (final-done-word (nth 4 ass))
   9778 		 (org-last-state (or this ""))
   9779 		 (completion-ignore-case t)
   9780 		 (member (member this org-todo-keywords-1))
   9781 		 (tail (cdr member))
   9782 		 (org-state (cond
   9783 			     ((eq arg 'right)
   9784 			      ;; Next state
   9785 			      (if this
   9786 				  (if tail (car tail) nil)
   9787 				(car org-todo-keywords-1)))
   9788 			     ((eq arg 'left)
   9789 			      ;; Previous state
   9790 			      (unless (equal member org-todo-keywords-1)
   9791 				(if this
   9792 				    (nth (- (length org-todo-keywords-1)
   9793 					    (length tail) 2)
   9794 					 org-todo-keywords-1)
   9795 				  (org-last org-todo-keywords-1))))
   9796 			     (arg
   9797 			      ;; User or caller requests a specific state.
   9798 			      (cond
   9799 			       ((equal arg "") nil)
   9800 			       ((eq arg 'none) nil)
   9801 			       ((eq arg 'done) (or done-word (car org-done-keywords)))
   9802 			       ((eq arg 'nextset)
   9803 				(or (car (cdr (member head org-todo-heads)))
   9804 				    (car org-todo-heads)))
   9805 			       ((eq arg 'previousset)
   9806 				(let ((org-todo-heads (reverse org-todo-heads)))
   9807 				  (or (car (cdr (member head org-todo-heads)))
   9808 				      (car org-todo-heads))))
   9809 			       ((car (member arg org-todo-keywords-1)))
   9810 			       ((stringp arg)
   9811 				(user-error "State `%s' not valid in this file" arg))
   9812 			       ((nth (1- (prefix-numeric-value arg))
   9813 				     org-todo-keywords-1))))
   9814 			     ((and org-todo-key-trigger org-use-fast-todo-selection)
   9815 			      ;; Use fast selection.
   9816 			      (org-fast-todo-selection this))
   9817 			     ((null member) (or head (car org-todo-keywords-1)))
   9818 			     ((equal this final-done-word) nil) ;-> make empty
   9819 			     ((null tail) nil) ;-> first entry
   9820 			     ((memq interpret '(type priority))
   9821 			      (if (eq this-command last-command)
   9822 				  (car tail)
   9823 				(if (> (length tail) 0)
   9824 				    (or done-word (car org-done-keywords))
   9825 				  nil)))
   9826 			     (t
   9827 			      (car tail))))
   9828 		 (org-state (or
   9829 			     (run-hook-with-args-until-success
   9830 			      'org-todo-get-default-hook org-state org-last-state)
   9831 			     org-state))
   9832 		 (next (if (org-string-nw-p org-state) (concat " " org-state " ") " "))
   9833 		 (change-plist (list :type 'todo-state-change :from this :to org-state
   9834 				     :position startpos))
   9835 		 dolog now-done-p)
   9836 	    (when org-blocker-hook
   9837 	      (let (org-blocked-by-checkboxes block-reason)
   9838 		(setq org-last-todo-state-is-todo
   9839 		      (not (member this org-done-keywords)))
   9840 		(unless (save-excursion
   9841 			  (save-match-data
   9842 			    (org-with-wide-buffer
   9843 			     (run-hook-with-args-until-failure
   9844 			      'org-blocker-hook change-plist))))
   9845 		  (setq block-reason (if org-blocked-by-checkboxes
   9846 					 "contained checkboxes"
   9847 				       (format "\"%s\"" org-block-entry-blocking)))
   9848 		  (if (called-interactively-p 'interactive)
   9849 		      (user-error "TODO state change from %s to %s blocked (by %s)"
   9850 				  this org-state block-reason)
   9851 		    ;; Fail silently.
   9852 		    (message "TODO state change from %s to %s blocked (by %s)"
   9853 			     this org-state block-reason)
   9854 		    (throw 'exit nil)))))
   9855 	    (store-match-data match-data)
   9856 	    (replace-match next t t)
   9857 	    (cond ((and org-state (equal this org-state))
   9858 		   (message "TODO state was already %s" (org-trim next)))
   9859 		  ((not (pos-visible-in-window-p hl-pos))
   9860 		   (message "TODO state changed to %s" (org-trim next))))
   9861 	    (unless head
   9862 	      (setq head (org-get-todo-sequence-head org-state)
   9863 		    ass (assoc head org-todo-kwd-alist)
   9864 		    interpret (nth 1 ass)
   9865 		    done-word (nth 3 ass)
   9866 		    final-done-word (nth 4 ass)))
   9867 	    (when (memq arg '(nextset previousset))
   9868 	      (message "Keyword-Set %d/%d: %s"
   9869 		       (- (length org-todo-sets) -1
   9870 			  (length (memq (assoc org-state org-todo-sets) org-todo-sets)))
   9871 		       (length org-todo-sets)
   9872 		       (mapconcat 'identity (assoc org-state org-todo-sets) " ")))
   9873 	    (setq org-last-todo-state-is-todo
   9874 		  (not (member org-state org-done-keywords)))
   9875 	    (setq now-done-p (and (member org-state org-done-keywords)
   9876 				  (not (member this org-done-keywords))))
   9877 	    (and logging (org-local-logging logging))
   9878 	    (when (or (and (or org-todo-log-states org-log-done)
   9879 			   (not (eq org-inhibit-logging t))
   9880 			   (not (memq arg '(nextset previousset))))
   9881 		      force-log)
   9882 	      ;; We need to look at recording a time and note.
   9883 	      (setq dolog (or (if force-log 'note)
   9884 			      (nth 1 (assoc org-state org-todo-log-states))
   9885 			      (nth 2 (assoc this org-todo-log-states))))
   9886 	      (when (and (eq dolog 'note) (eq org-inhibit-logging 'note))
   9887 		(setq dolog 'time))
   9888 	      (when (or (and (not org-state) (not org-closed-keep-when-no-todo))
   9889 			(and org-state
   9890 			     (member org-state org-not-done-keywords)
   9891 			     (not (member this org-not-done-keywords))))
   9892 		;; This is now a todo state and was not one before
   9893 		;; If there was a CLOSED time stamp, get rid of it.
   9894 		(org-add-planning-info nil nil 'closed))
   9895 	      (when (and now-done-p org-log-done)
   9896 		;; It is now done, and it was not done before.
   9897 		(org-add-planning-info 'closed (org-current-effective-time))
   9898 		(when (and (not dolog) (eq 'note org-log-done))
   9899 		  (org-add-log-setup 'done org-state this 'note)))
   9900 	      (when (and org-state dolog)
   9901 		;; This is a non-nil state, and we need to log it.
   9902 		(org-add-log-setup 'state org-state this dolog)))
   9903 	    ;; Fixup tag positioning.
   9904 	    (org-todo-trigger-tag-changes org-state)
   9905 	    (when org-auto-align-tags (org-align-tags))
   9906 	    (when org-provide-todo-statistics
   9907 	      (org-update-parent-todo-statistics))
   9908 	    (when (bound-and-true-p org-clock-out-when-done)
   9909 	      (org-clock-out-if-current))
   9910 	    (run-hooks 'org-after-todo-state-change-hook)
   9911 	    (when (and arg (not (member org-state org-done-keywords)))
   9912 	      (setq head (org-get-todo-sequence-head org-state)))
   9913 	    (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
   9914 	    ;; Do we need to trigger a repeat?
   9915 	    (when now-done-p
   9916 	      (when (boundp 'org-agenda-headline-snapshot-before-repeat)
   9917 		;; This is for the agenda, take a snapshot of the headline.
   9918 		(save-match-data
   9919 		  (setq org-agenda-headline-snapshot-before-repeat
   9920 			(org-get-heading))))
   9921 	      (org-auto-repeat-maybe org-state))
   9922 	    ;; Fixup cursor location if close to the keyword.
   9923 	    (when (and (outline-on-heading-p)
   9924 		       (not (bolp))
   9925 		       (save-excursion (beginning-of-line 1)
   9926 				       (looking-at org-todo-line-regexp))
   9927 		       (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
   9928 	      (goto-char (or (match-end 2) (match-end 1)))
   9929 	      (and (looking-at " ")
   9930 		   (not (looking-at " *:"))
   9931 		   (just-one-space)))
   9932 	    (when org-trigger-hook
   9933 	      (save-excursion
   9934 		(run-hook-with-args 'org-trigger-hook change-plist)))
   9935 	    (when commentp (org-toggle-comment))))))))
   9936 
   9937 (defun org-block-todo-from-children-or-siblings-or-parent (change-plist)
   9938   "Block turning an entry into a TODO, using the hierarchy.
   9939 This checks whether the current task should be blocked from state
   9940 changes.  Such blocking occurs when:
   9941 
   9942   1. The task has children which are not all in a completed state.
   9943 
   9944   2. A task has a parent with the property :ORDERED:, and there
   9945      are siblings prior to the current task with incomplete
   9946      status.
   9947 
   9948   3. The parent of the task is blocked because it has siblings that should
   9949      be done first, or is child of a block grandparent TODO entry."
   9950 
   9951   (if (not org-enforce-todo-dependencies)
   9952       t ; if locally turned off don't block
   9953     (catch 'dont-block
   9954       ;; If this is not a todo state change, or if this entry is already DONE,
   9955       ;; do not block
   9956       (when (or (not (eq (plist-get change-plist :type) 'todo-state-change))
   9957 		(member (plist-get change-plist :from)
   9958 			(cons 'done org-done-keywords))
   9959 		(member (plist-get change-plist :to)
   9960 			(cons 'todo org-not-done-keywords))
   9961 		(not (plist-get change-plist :to)))
   9962 	(throw 'dont-block t))
   9963       ;; If this task has children, and any are undone, it's blocked
   9964       (save-excursion
   9965 	(org-back-to-heading t)
   9966 	(let ((this-level (funcall outline-level)))
   9967 	  (outline-next-heading)
   9968 	  (let ((child-level (funcall outline-level)))
   9969 	    (while (and (not (eobp))
   9970 			(> child-level this-level))
   9971 	      ;; this todo has children, check whether they are all
   9972 	      ;; completed
   9973 	      (when (and (not (org-entry-is-done-p))
   9974 			 (org-entry-is-todo-p))
   9975 		(setq org-block-entry-blocking (org-get-heading))
   9976 		(throw 'dont-block nil))
   9977 	      (outline-next-heading)
   9978 	      (setq child-level (funcall outline-level))))))
   9979       ;; Otherwise, if the task's parent has the :ORDERED: property, and
   9980       ;; any previous siblings are undone, it's blocked
   9981       (save-excursion
   9982 	(org-back-to-heading t)
   9983 	(let* ((pos (point))
   9984 	       (parent-pos (and (org-up-heading-safe) (point)))
   9985 	       (case-fold-search nil))
   9986 	  (unless parent-pos (throw 'dont-block t)) ; no parent
   9987 	  (when (and (org-not-nil (org-entry-get (point) "ORDERED"))
   9988 		     (forward-line 1)
   9989 		     (re-search-forward org-not-done-heading-regexp pos t))
   9990 	    (setq org-block-entry-blocking (match-string 0))
   9991 	    (throw 'dont-block nil))  ; block, there is an older sibling not done.
   9992 	  ;; Search further up the hierarchy, to see if an ancestor is blocked
   9993 	  (while t
   9994 	    (goto-char parent-pos)
   9995 	    (unless (looking-at org-not-done-heading-regexp)
   9996 	      (throw 'dont-block t))	; do not block, parent is not a TODO
   9997 	    (setq pos (point))
   9998 	    (setq parent-pos (and (org-up-heading-safe) (point)))
   9999 	    (unless parent-pos (throw 'dont-block t)) ; no parent
  10000 	    (when (and (org-not-nil (org-entry-get (point) "ORDERED"))
  10001 		       (forward-line 1)
  10002 		       (re-search-forward org-not-done-heading-regexp pos t)
  10003 		       (setq org-block-entry-blocking (org-get-heading)))
  10004 	      (throw 'dont-block nil)))))))) ; block, older sibling not done.
  10005 
  10006 (defcustom org-track-ordered-property-with-tag nil
  10007   "Should the ORDERED property also be shown as a tag?
  10008 The ORDERED property decides if an entry should require subtasks to be
  10009 completed in sequence.  Since a property is not very visible, setting
  10010 this option means that toggling the ORDERED property with the command
  10011 `org-toggle-ordered-property' will also toggle a tag ORDERED.  That tag is
  10012 not relevant for the behavior, but it makes things more visible.
  10013 
  10014 Note that toggling the tag with tags commands will not change the property
  10015 and therefore not influence behavior!
  10016 
  10017 This can be t, meaning the tag ORDERED should be used.  It can also be a
  10018 string to select a different tag for this task."
  10019   :group 'org-todo
  10020   :type '(choice
  10021 	  (const :tag "No tracking" nil)
  10022 	  (const :tag "Track with ORDERED tag" t)
  10023 	  (string :tag "Use other tag")))
  10024 
  10025 (defun org-toggle-ordered-property ()
  10026   "Toggle the ORDERED property of the current entry.
  10027 For better visibility, you can track the value of this property with a tag.
  10028 See variable `org-track-ordered-property-with-tag'."
  10029   (interactive)
  10030   (let* ((t1 org-track-ordered-property-with-tag)
  10031 	 (tag (and t1 (if (stringp t1) t1 "ORDERED"))))
  10032     (save-excursion
  10033       (org-back-to-heading)
  10034       (if (org-entry-get nil "ORDERED")
  10035 	  (progn
  10036 	    (org-delete-property "ORDERED")
  10037 	    (and tag (org-toggle-tag tag 'off))
  10038 	    (message "Subtasks can be completed in arbitrary order"))
  10039 	(org-entry-put nil "ORDERED" "t")
  10040 	(and tag (org-toggle-tag tag 'on))
  10041 	(message "Subtasks must be completed in sequence")))))
  10042 
  10043 (defun org-block-todo-from-checkboxes (change-plist)
  10044   "Block turning an entry into a TODO, using checkboxes.
  10045 This checks whether the current task should be blocked from state
  10046 changes because there are unchecked boxes in this entry."
  10047   (if (not org-enforce-todo-checkbox-dependencies)
  10048       t ; if locally turned off don't block
  10049     (catch 'dont-block
  10050       ;; If this is not a todo state change, or if this entry is already DONE,
  10051       ;; do not block
  10052       (when (or (not (eq (plist-get change-plist :type) 'todo-state-change))
  10053 		(member (plist-get change-plist :from)
  10054 			(cons 'done org-done-keywords))
  10055 		(member (plist-get change-plist :to)
  10056 			(cons 'todo org-not-done-keywords))
  10057 		(not (plist-get change-plist :to)))
  10058 	(throw 'dont-block t))
  10059       ;; If this task has checkboxes that are not checked, it's blocked
  10060       (save-excursion
  10061 	(org-back-to-heading t)
  10062 	(let ((beg (point)) end)
  10063 	  (outline-next-heading)
  10064 	  (setq end (point))
  10065 	  (goto-char beg)
  10066 	  (when (org-list-search-forward
  10067 		 (concat (org-item-beginning-re)
  10068 			 "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
  10069 			 "\\[[- ]\\]")
  10070 		 end t)
  10071 	    (when (boundp 'org-blocked-by-checkboxes)
  10072 	      (setq org-blocked-by-checkboxes t))
  10073 	    (throw 'dont-block nil))))
  10074       t))) ; do not block
  10075 
  10076 (defun org-entry-blocked-p ()
  10077   "Non-nil if entry at point is blocked."
  10078   (and (not (org-entry-get nil "NOBLOCKING"))
  10079        (member (org-entry-get nil "TODO") org-not-done-keywords)
  10080        (not (run-hook-with-args-until-failure
  10081 	     'org-blocker-hook
  10082 	     (list :type 'todo-state-change
  10083 		   :position (point)
  10084 		   :from 'todo
  10085 		   :to 'done)))))
  10086 
  10087 (defun org-update-statistics-cookies (all)
  10088   "Update the statistics cookie, either from TODO or from checkboxes.
  10089 This should be called with the cursor in a line with a statistics
  10090 cookie.  When called with a \\[universal-argument] prefix, update
  10091 all statistics cookies in the buffer."
  10092   (interactive "P")
  10093   (if all
  10094       (progn
  10095 	(org-update-checkbox-count 'all)
  10096 	(org-map-region 'org-update-parent-todo-statistics
  10097                         (point-min) (point-max)))
  10098     (if (not (org-at-heading-p))
  10099 	(org-update-checkbox-count)
  10100       (let ((pos (point-marker))
  10101 	    end l1 l2)
  10102 	(ignore-errors (org-back-to-heading t))
  10103 	(if (not (org-at-heading-p))
  10104 	    (org-update-checkbox-count)
  10105 	  (setq l1 (org-outline-level))
  10106 	  (setq end
  10107                 (save-excursion
  10108 		  (outline-next-heading)
  10109 		  (when (org-at-heading-p) (setq l2 (org-outline-level)))
  10110 		  (point)))
  10111 	  (if (and (save-excursion
  10112 		     (re-search-forward
  10113 		      "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) \\[[- X]\\]" end t))
  10114 	           (not (save-excursion
  10115                           (re-search-forward
  10116 			   ":COOKIE_DATA:.*\\<todo\\>" end t))))
  10117 	      (org-update-checkbox-count)
  10118 	    (if (and l2 (> l2 l1))
  10119 		(progn
  10120 		  (goto-char end)
  10121 		  (org-update-parent-todo-statistics))
  10122 	      (goto-char pos)
  10123 	      (beginning-of-line 1)
  10124 	      (while (re-search-forward
  10125 		      "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)"
  10126 		      (point-at-eol) t)
  10127 		(replace-match (if (match-end 2) "[100%]" "[0/0]") t t)))))
  10128 	(goto-char pos)
  10129 	(move-marker pos nil)))))
  10130 
  10131 (defvar org-entry-property-inherited-from) ;; defined below
  10132 (defun org-update-parent-todo-statistics ()
  10133   "Update any statistics cookie in the parent of the current headline.
  10134 When `org-hierarchical-todo-statistics' is nil, statistics will cover
  10135 the entire subtree and this will travel up the hierarchy and update
  10136 statistics everywhere."
  10137   (let* ((prop (save-excursion
  10138                  (org-up-heading-safe)
  10139 		 (org-entry-get nil "COOKIE_DATA" 'inherit)))
  10140 	 (recursive (or (not org-hierarchical-todo-statistics)
  10141 			(and prop (string-match "\\<recursive\\>" prop))))
  10142 	 (lim (or (and prop (marker-position org-entry-property-inherited-from))
  10143 		  0))
  10144 	 (first t)
  10145 	 (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
  10146 	 level ltoggle l1 new ndel
  10147 	 (cnt-all 0) (cnt-done 0) is-percent kwd
  10148 	 checkbox-beg cookie-present)
  10149     (catch 'exit
  10150       (save-excursion
  10151 	(beginning-of-line 1)
  10152 	(setq ltoggle (funcall outline-level))
  10153 	;; Three situations are to consider:
  10154 
  10155 	;; 1. if `org-hierarchical-todo-statistics' is nil, repeat up
  10156 	;;    to the top-level ancestor on the headline;
  10157 
  10158 	;; 2. If parent has "recursive" property, repeat up to the
  10159 	;;    headline setting that property, taking inheritance into
  10160 	;;    account;
  10161 
  10162 	;; 3. Else, move up to direct parent and proceed only once.
  10163 	(while (and (setq level (org-up-heading-safe))
  10164 		    (or recursive first)
  10165 		    (>= (point) lim))
  10166 	  (setq first nil cookie-present nil)
  10167 	  (unless (and level
  10168 		       (not (string-match
  10169 			     "\\<checkbox\\>"
  10170 			     (downcase (or (org-entry-get nil "COOKIE_DATA")
  10171 					   "")))))
  10172 	    (throw 'exit nil))
  10173 	  (while (re-search-forward box-re (point-at-eol) t)
  10174 	    (setq cnt-all 0 cnt-done 0 cookie-present t)
  10175 	    (setq is-percent (match-end 2) checkbox-beg (match-beginning 0))
  10176 	    (save-match-data
  10177 	      (unless (outline-next-heading) (throw 'exit nil))
  10178 	      (while (and (looking-at org-complex-heading-regexp)
  10179 	    		  (> (setq l1 (length (match-string 1))) level))
  10180 	    	(setq kwd (and (or recursive (= l1 ltoggle))
  10181 	    		       (match-string 2)))
  10182 	    	(if (or (eq org-provide-todo-statistics 'all-headlines)
  10183 			(and (eq org-provide-todo-statistics t)
  10184 			     (or (member kwd org-done-keywords)))
  10185 	    		(and (listp org-provide-todo-statistics)
  10186 			     (stringp (car org-provide-todo-statistics))
  10187 	    		     (or (member kwd org-provide-todo-statistics)
  10188 				 (member kwd org-done-keywords)))
  10189 			(and (listp org-provide-todo-statistics)
  10190 			     (listp (car org-provide-todo-statistics))
  10191 			     (or (member kwd (car org-provide-todo-statistics))
  10192 				 (and (member kwd org-done-keywords)
  10193 				      (member kwd (cadr org-provide-todo-statistics))))))
  10194 	    	    (setq cnt-all (1+ cnt-all))
  10195 		  (and (eq org-provide-todo-statistics t)
  10196 		       kwd
  10197 		       (setq cnt-all (1+ cnt-all))))
  10198 		(when (or (and (member org-provide-todo-statistics '(t all-headlines))
  10199 			       (member kwd org-done-keywords))
  10200 			  (and (listp org-provide-todo-statistics)
  10201 			       (listp (car org-provide-todo-statistics))
  10202 			       (member kwd org-done-keywords)
  10203 			       (member kwd (cadr org-provide-todo-statistics)))
  10204 			  (and (listp org-provide-todo-statistics)
  10205 			       (stringp (car org-provide-todo-statistics))
  10206 			       (member kwd org-done-keywords)))
  10207 		  (setq cnt-done (1+ cnt-done)))
  10208 	    	(outline-next-heading)))
  10209 	    (setq new
  10210 	    	  (if is-percent
  10211 		      (format "[%d%%]" (floor (* 100.0 cnt-done)
  10212 					      (max 1 cnt-all)))
  10213 	    	    (format "[%d/%d]" cnt-done cnt-all))
  10214 	    	  ndel (- (match-end 0) checkbox-beg))
  10215 	    (goto-char checkbox-beg)
  10216 	    (insert new)
  10217 	    (delete-region (point) (+ (point) ndel))
  10218 	    (when org-auto-align-tags (org-fix-tags-on-the-fly)))
  10219 	  (when cookie-present
  10220 	    (run-hook-with-args 'org-after-todo-statistics-hook
  10221 				cnt-done (- cnt-all cnt-done))))))
  10222     (run-hooks 'org-todo-statistics-hook)))
  10223 
  10224 (defvar org-after-todo-statistics-hook nil
  10225   "Hook that is called after a TODO statistics cookie has been updated.
  10226 Each function is called with two arguments: the number of not-done entries
  10227 and the number of done entries.
  10228 
  10229 For example, the following function, when added to this hook, will switch
  10230 an entry to DONE when all children are done, and back to TODO when new
  10231 entries are set to a TODO status.  Note that this hook is only called
  10232 when there is a statistics cookie in the headline!
  10233 
  10234  (defun org-summary-todo (n-done n-not-done)
  10235    \"Switch entry to DONE when all subentries are done, to TODO otherwise.\"
  10236    (let (org-log-done org-log-states)   ; turn off logging
  10237      (org-todo (if (= n-not-done 0) \"DONE\" \"TODO\"))))")
  10238 
  10239 (defvar org-todo-statistics-hook nil
  10240   "Hook that is run whenever Org thinks TODO statistics should be updated.
  10241 This hook runs even if there is no statistics cookie present, in which case
  10242 `org-after-todo-statistics-hook' would not run.")
  10243 
  10244 (defun org-todo-trigger-tag-changes (state)
  10245   "Apply the changes defined in `org-todo-state-tags-triggers'."
  10246   (let ((l org-todo-state-tags-triggers)
  10247 	changes)
  10248     (when (or (not state) (equal state ""))
  10249       (setq changes (append changes (cdr (assoc "" l)))))
  10250     (when (and (stringp state) (> (length state) 0))
  10251       (setq changes (append changes (cdr (assoc state l)))))
  10252     (when (member state org-not-done-keywords)
  10253       (setq changes (append changes (cdr (assq 'todo l)))))
  10254     (when (member state org-done-keywords)
  10255       (setq changes (append changes (cdr (assq 'done l)))))
  10256     (dolist (c changes)
  10257       (org-toggle-tag (car c) (if (cdr c) 'on 'off)))))
  10258 
  10259 (defun org-local-logging (value)
  10260   "Get logging settings from a property VALUE."
  10261   ;; Directly set the variables, they are already local.
  10262   (setq org-log-done nil
  10263         org-log-repeat nil
  10264         org-todo-log-states nil)
  10265   (dolist (w (split-string value))
  10266     (let (a)
  10267       (cond
  10268        ((setq a (assoc w org-startup-options))
  10269         (and (member (nth 1 a) '(org-log-done org-log-repeat))
  10270              (set (nth 1 a) (nth 2 a))))
  10271        ((setq a (org-extract-log-state-settings w))
  10272         (and (member (car a) org-todo-keywords-1)
  10273              (push a org-todo-log-states)))))))
  10274 
  10275 (defun org-get-todo-sequence-head (kwd)
  10276   "Return the head of the TODO sequence to which KWD belongs.
  10277 If KWD is not set, check if there is a text property remembering the
  10278 right sequence."
  10279   (let (p)
  10280     (cond
  10281      ((not kwd)
  10282       (or (get-text-property (point-at-bol) 'org-todo-head)
  10283 	  (progn
  10284 	    (setq p (next-single-property-change (point-at-bol) 'org-todo-head
  10285 						 nil (point-at-eol)))
  10286 	    (get-text-property p 'org-todo-head))))
  10287      ((not (member kwd org-todo-keywords-1))
  10288       (car org-todo-keywords-1))
  10289      (t (nth 2 (assoc kwd org-todo-kwd-alist))))))
  10290 
  10291 (defun org-fast-todo-selection (&optional current-state)
  10292   "Fast TODO keyword selection with single keys.
  10293 Returns the new TODO keyword, or nil if no state change should occur.
  10294 When CURRENT-STATE is given and selection letters are not unique globally,
  10295 prefer a state in the current sequence over on in another sequence."
  10296   (let* ((fulltable org-todo-key-alist)
  10297 	 (head (org-get-todo-sequence-head current-state))
  10298 	 (done-keywords org-done-keywords) ;; needed for the faces.
  10299 	 (maxlen (apply 'max (mapcar
  10300 			      (lambda (x)
  10301 				(if (stringp (car x)) (string-width (car x)) 0))
  10302 			      fulltable)))
  10303 	 (expert (equal org-use-fast-todo-selection 'expert))
  10304 	 (prompt "")
  10305 	 (fwidth (+ maxlen 3 1 3))
  10306 	 (ncol (/ (- (window-width) 4) fwidth))
  10307 	 tg cnt e c tbl subtable
  10308 	 groups ingroup in-current-sequence)
  10309     (save-excursion
  10310       (save-window-excursion
  10311 	(if expert
  10312 	    (set-buffer (get-buffer-create " *Org todo*"))
  10313 	  (delete-other-windows)
  10314 	  (set-window-buffer (split-window-vertically) (get-buffer-create " *Org todo*"))
  10315 	  (org-switch-to-buffer-other-window " *Org todo*"))
  10316 	(erase-buffer)
  10317 	(setq-local org-done-keywords done-keywords)
  10318 	(setq tbl fulltable cnt 0)
  10319 	(while (setq e (pop tbl))
  10320 	  (cond
  10321 	   ((equal e '(:startgroup))
  10322 	    (push '() groups) (setq ingroup t)
  10323 	    (unless (= cnt 0)
  10324 	      (setq cnt 0)
  10325 	      (insert "\n"))
  10326 	    (setq prompt (concat prompt "{"))
  10327 	    (insert "{ "))
  10328 	   ((equal e '(:endgroup))
  10329 	    (setq ingroup nil cnt 0 in-current-sequence nil)
  10330 	    (setq prompt (concat prompt "}"))
  10331 	    (insert "}\n"))
  10332 	   ((equal e '(:newline))
  10333 	    (unless (= cnt 0)
  10334 	      (setq cnt 0)
  10335 	      (insert "\n")
  10336 	      (setq e (car tbl))
  10337 	      (while (equal (car tbl) '(:newline))
  10338 		(insert "\n")
  10339 		(setq tbl (cdr tbl)))))
  10340 	   (t
  10341 	    (setq tg (car e) c (cdr e))
  10342 	    (if (equal tg head) (setq in-current-sequence t))
  10343 	    (when ingroup (push tg (car groups)))
  10344 	    (when in-current-sequence (push e subtable))
  10345 	    (setq tg (org-add-props tg nil 'face
  10346 				    (org-get-todo-face tg)))
  10347 	    (when (and (= cnt 0) (not ingroup)) (insert "  "))
  10348 	    (setq prompt (concat prompt "[" (char-to-string c) "] " tg " "))
  10349 	    (insert "[" c "] " tg (make-string
  10350 				   (- fwidth 4 (length tg)) ?\ ))
  10351 	    (when (and (= (setq cnt (1+ cnt)) ncol)
  10352 		       ;; Avoid lines with just a closing delimiter.
  10353 		       (not (equal (car tbl) '(:endgroup))))
  10354 	      (insert "\n")
  10355 	      (when ingroup (insert "  "))
  10356 	      (setq cnt 0)))))
  10357 	(insert "\n")
  10358 	(goto-char (point-min))
  10359 	(unless expert (org-fit-window-to-buffer))
  10360 	(message (concat "[a-z..]:Set [SPC]:clear"
  10361 			 (if expert (concat "\n" prompt) "")))
  10362 	(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
  10363 	(setq subtable (nreverse subtable))
  10364 	(cond
  10365 	 ((or (= c ?\C-g)
  10366 	      (and (= c ?q) (not (rassoc c fulltable))))
  10367 	  (setq quit-flag t))
  10368 	 ((= c ?\ ) nil)
  10369 	 ((setq e (or (rassoc c subtable) (rassoc c fulltable))
  10370 		tg (car e))
  10371 	  tg)
  10372 	 (t (setq quit-flag t)))))))
  10373 
  10374 (defun org-entry-is-todo-p ()
  10375   (member (org-get-todo-state) org-not-done-keywords))
  10376 
  10377 (defun org-entry-is-done-p ()
  10378   (member (org-get-todo-state) org-done-keywords))
  10379 
  10380 (defun org-get-todo-state ()
  10381   "Return the TODO keyword of the current subtree."
  10382   (save-excursion
  10383     (org-back-to-heading t)
  10384     (and (let ((case-fold-search nil))
  10385            (looking-at org-todo-line-regexp))
  10386 	 (match-end 2)
  10387 	 (match-string 2))))
  10388 
  10389 (defun org-at-date-range-p (&optional inactive-ok)
  10390   "Non-nil if point is inside a date range.
  10391 
  10392 When optional argument INACTIVE-OK is non-nil, also consider
  10393 inactive time ranges.
  10394 
  10395 When this function returns a non-nil value, match data is set
  10396 according to `org-tr-regexp-both' or `org-tr-regexp', depending
  10397 on INACTIVE-OK."
  10398   (interactive)
  10399   (save-excursion
  10400     (catch 'exit
  10401       (let ((pos (point)))
  10402 	(skip-chars-backward "^[<\r\n")
  10403 	(skip-chars-backward "<[")
  10404 	(and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp))
  10405 	     (>= (match-end 0) pos)
  10406 	     (throw 'exit t))
  10407 	(skip-chars-backward "^<[\r\n")
  10408 	(skip-chars-backward "<[")
  10409 	(and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp))
  10410 	     (>= (match-end 0) pos)
  10411 	     (throw 'exit t)))
  10412       nil)))
  10413 
  10414 (defun org-get-repeat (&optional timestamp)
  10415   "Check if there is a time-stamp with repeater in this entry.
  10416 
  10417 Return the repeater, as a string, or nil.  Also return nil when
  10418 this function is called before first heading.
  10419 
  10420 When optional argument TIMESTAMP is a string, extract the
  10421 repeater from there instead."
  10422   (save-match-data
  10423     (cond
  10424      (timestamp
  10425       (and (string-match org-repeat-re timestamp)
  10426 	   (match-string-no-properties 1 timestamp)))
  10427      ((org-before-first-heading-p) nil)
  10428      (t
  10429       (save-excursion
  10430 	(org-back-to-heading t)
  10431 	(let ((end (org-entry-end-position)))
  10432 	  (catch :repeat
  10433 	    (while (re-search-forward org-repeat-re end t)
  10434 	      (when (save-match-data (org-at-timestamp-p 'agenda))
  10435 		(throw :repeat (match-string-no-properties 1)))))))))))
  10436 
  10437 (defvar org-last-changed-timestamp)
  10438 (defvar org-last-inserted-timestamp)
  10439 (defvar org-log-post-message)
  10440 (defvar org-log-note-purpose)
  10441 (defvar org-log-note-how nil)
  10442 (defvar org-log-note-extra)
  10443 (defvar org-log-setup nil)
  10444 (defun org-auto-repeat-maybe (done-word)
  10445   "Check if the current headline contains a repeated time-stamp.
  10446 
  10447 If yes, set TODO state back to what it was and change the base date
  10448 of repeating deadline/scheduled time stamps to new date.
  10449 
  10450 This function is run automatically after each state change to a DONE state."
  10451   (let* ((repeat (org-get-repeat))
  10452 	 (aa (assoc org-last-state org-todo-kwd-alist))
  10453 	 (interpret (nth 1 aa))
  10454 	 (head (nth 2 aa))
  10455 	 (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year)))
  10456 	 (msg "Entry repeats: ")
  10457 	 (org-log-done nil)
  10458 	 (org-todo-log-states nil)
  10459 	 (end (copy-marker (org-entry-end-position))))
  10460     (when (and repeat (not (= 0 (string-to-number (substring repeat 1)))))
  10461       (when (eq org-log-repeat t) (setq org-log-repeat 'state))
  10462       (let ((to-state
  10463              (or (org-entry-get nil "REPEAT_TO_STATE" 'selective)
  10464 		 (and (stringp org-todo-repeat-to-state)
  10465 		      org-todo-repeat-to-state)
  10466 		 (and org-todo-repeat-to-state org-last-state))))
  10467 	(org-todo (cond ((and to-state (member to-state org-todo-keywords-1))
  10468 			 to-state)
  10469 			((eq interpret 'type) org-last-state)
  10470 			(head)
  10471 			(t 'none))))
  10472       (org-back-to-heading t)
  10473       (org-add-planning-info nil nil 'closed)
  10474       ;; When `org-log-repeat' is non-nil or entry contains
  10475       ;; a clock, set LAST_REPEAT property.
  10476       (when (or org-log-repeat
  10477 		(catch :clock
  10478 		  (save-excursion
  10479 		    (while (re-search-forward org-clock-line-re end t)
  10480 		      (when (org-at-clock-log-p) (throw :clock t))))))
  10481 	(org-entry-put nil "LAST_REPEAT" (format-time-string
  10482 					  (org-time-stamp-format t t))))
  10483       (when org-log-repeat
  10484 	(if org-log-setup
  10485 	    ;; We are already setup for some record.
  10486 	    (when (eq org-log-repeat 'note)
  10487 	      ;; Make sure we take a note, not only a time stamp.
  10488 	      (setq org-log-note-how 'note))
  10489 	  ;; Set up for taking a record.
  10490 	  (org-add-log-setup 'state
  10491 			     (or done-word (car org-done-keywords))
  10492 			     org-last-state
  10493 			     org-log-repeat)))
  10494       ;; Time-stamps without a repeater are usually skipped.  However,
  10495       ;; a SCHEDULED time-stamp without one is removed, as they are no
  10496       ;; longer relevant.
  10497       (save-excursion
  10498 	(let ((scheduled (org-entry-get (point) "SCHEDULED")))
  10499 	  (when (and scheduled (not (string-match-p org-repeat-re scheduled)))
  10500 	    (org-remove-timestamp-with-keyword org-scheduled-string))))
  10501       ;; Update every time-stamp with a repeater in the entry.
  10502       (let ((planning-re (regexp-opt
  10503 			  (list org-scheduled-string org-deadline-string))))
  10504 	(while (re-search-forward org-repeat-re end t)
  10505 	  (let* ((ts (match-string 0))
  10506 		 (type (if (not (org-at-planning-p)) "Plain:"
  10507 			 (save-excursion
  10508 			   (re-search-backward
  10509 			    planning-re (line-beginning-position) t)
  10510 			   (match-string 0)))))
  10511 	    (when (and (org-at-timestamp-p 'agenda)
  10512 		       (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts))
  10513 	      (let ((n (string-to-number (match-string 2 ts)))
  10514 		    (what (match-string 3 ts)))
  10515 		(when (equal what "w") (setq n (* n 7) what "d"))
  10516 		(when (and (equal what "h")
  10517 			   (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}"
  10518 						ts)))
  10519 		  (user-error
  10520 		   "Cannot repeat in %d hour(s) because no hour has been set"
  10521 		   n))
  10522 		;; Preparation, see if we need to modify the start
  10523 		;; date for the change.
  10524 		(when (match-end 1)
  10525 		  (let ((time (save-match-data (org-time-string-to-time ts)))
  10526 			(repeater-type (match-string 1 ts)))
  10527 		    (cond
  10528 		     ((equal "." repeater-type)
  10529 		      ;; Shift starting date to today, or now if
  10530 		      ;; repeater is by hours.
  10531 		      (if (equal what "h")
  10532 			  (org-timestamp-change
  10533 			   (floor (- (org-time-stamp-to-now ts t)) 60) 'minute)
  10534 			(org-timestamp-change
  10535 			 (- (org-today) (time-to-days time)) 'day)))
  10536 		     ((equal "+" repeater-type)
  10537 		      (let ((nshiftmax 10)
  10538 			    (nshift 0))
  10539 			(while (or (= nshift 0)
  10540 				   (not (org-time-less-p nil time)))
  10541 			  (when (= nshiftmax (cl-incf nshift))
  10542 			    (or (y-or-n-p
  10543 				 (format "%d repeater intervals were not \
  10544 enough to shift date past today.  Continue? "
  10545 					 nshift))
  10546 				(user-error "Abort")))
  10547 			  (org-timestamp-change n (cdr (assoc what whata)))
  10548 			  (org-in-regexp org-ts-regexp3)
  10549 			  (setq ts (match-string 1))
  10550 			  (setq time
  10551 				(save-match-data
  10552 				  (org-time-string-to-time ts)))))
  10553 		      (org-timestamp-change (- n) (cdr (assoc what whata)))
  10554 		      ;; Rematch, so that we have everything in place
  10555 		      ;; for the real shift.
  10556 		      (org-in-regexp org-ts-regexp3)
  10557 		      (setq ts (match-string 1))
  10558 		      (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)"
  10559 				    ts)))))
  10560 		(save-excursion
  10561 		  (org-timestamp-change n (cdr (assoc what whata)) nil t))
  10562 		(setq msg
  10563 		      (concat msg type " " org-last-changed-timestamp " ")))))))
  10564       (run-hooks 'org-todo-repeat-hook)
  10565       (setq org-log-post-message msg)
  10566       (message msg))))
  10567 
  10568 (defun org-show-todo-tree (arg)
  10569   "Make a compact tree which shows all headlines marked with TODO.
  10570 The tree will show the lines where the regexp matches, and all higher
  10571 headlines above the match.
  10572 With a `\\[universal-argument]' prefix, prompt for a regexp to match.
  10573 With a numeric prefix N, construct a sparse tree for the Nth element
  10574 of `org-todo-keywords-1'."
  10575   (interactive "P")
  10576   (let ((case-fold-search nil)
  10577 	(kwd-re
  10578 	 (cond ((null arg) (concat org-not-done-regexp "\\s-"))
  10579 	       ((equal arg '(4))
  10580 		(let ((kwd
  10581 		       (completing-read "Keyword (or KWD1|KWD2|...): "
  10582 					(mapcar #'list org-todo-keywords-1))))
  10583 		  (concat "\\("
  10584 			  (mapconcat 'identity (org-split-string kwd "|") "\\|")
  10585 			  "\\)\\>")))
  10586 	       ((<= (prefix-numeric-value arg) (length org-todo-keywords-1))
  10587 		(regexp-quote (nth (1- (prefix-numeric-value arg))
  10588 				   org-todo-keywords-1)))
  10589 	       (t (user-error "Invalid prefix argument: %s" arg)))))
  10590     (message "%d TODO entries found"
  10591 	     (org-occur (concat "^" org-outline-regexp " *" kwd-re )))))
  10592 
  10593 (defun org--deadline-or-schedule (arg type time)
  10594   "Insert DEADLINE or SCHEDULE information in current entry.
  10595 TYPE is either `deadline' or `scheduled'.  See `org-deadline' or
  10596 `org-schedule' for information about ARG and TIME arguments."
  10597   (let* ((deadline? (eq type 'deadline))
  10598 	 (keyword (if deadline? org-deadline-string org-scheduled-string))
  10599 	 (log (if deadline? org-log-redeadline org-log-reschedule))
  10600 	 (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED")))
  10601 	 (old-date-time (and old-date (org-time-string-to-time old-date)))
  10602 	 ;; Save repeater cookie from either TIME or current scheduled
  10603 	 ;; time stamp.  We are going to insert it back at the end of
  10604 	 ;; the process.
  10605 	 (repeater (or (and (org-string-nw-p time)
  10606 			    ;; We use `org-repeat-re' because we need
  10607 			    ;; to tell the difference between a real
  10608 			    ;; repeater and a time delta, e.g. "+2d".
  10609 			    (string-match org-repeat-re time)
  10610 			    (match-string 1 time))
  10611 		       (and (org-string-nw-p old-date)
  10612 			    (string-match "\\([.+-]+[0-9]+[hdwmy]\
  10613 \\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)"
  10614 					  old-date)
  10615 			    (match-string 1 old-date)))))
  10616     (pcase arg
  10617       (`(4)
  10618        (if (not old-date)
  10619 	   (message (if deadline? "Entry had no deadline to remove"
  10620 		      "Entry was not scheduled"))
  10621 	 (when (and old-date log)
  10622 	   (org-add-log-setup (if deadline? 'deldeadline 'delschedule)
  10623 			      nil old-date log))
  10624 	 (org-remove-timestamp-with-keyword keyword)
  10625 	 (message (if deadline? "Entry no longer has a deadline."
  10626 		    "Entry is no longer scheduled."))))
  10627       (`(16)
  10628        (save-excursion
  10629 	 (org-back-to-heading t)
  10630 	 (let ((regexp (if deadline? org-deadline-time-regexp
  10631 			 org-scheduled-time-regexp)))
  10632 	   (if (not (re-search-forward regexp (line-end-position 2) t))
  10633 	       (user-error (if deadline? "No deadline information to update"
  10634 			     "No scheduled information to update"))
  10635 	     (let* ((rpl0 (match-string 1))
  10636 		    (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))
  10637 		    (msg (if deadline? "Warn starting from" "Delay until")))
  10638 	       (replace-match
  10639 		(concat keyword
  10640 			" <" rpl
  10641 			(format " -%dd"
  10642 				(abs (- (time-to-days
  10643 					 (save-match-data
  10644 					   (org-read-date
  10645 					    nil t nil msg old-date-time)))
  10646 					(time-to-days old-date-time))))
  10647 			">") t t))))))
  10648       (_
  10649        (org-add-planning-info type time 'closed)
  10650        (when (and old-date
  10651 		  log
  10652 		  (not (equal old-date org-last-inserted-timestamp)))
  10653 	 (org-add-log-setup (if deadline? 'redeadline 'reschedule)
  10654 			    org-last-inserted-timestamp
  10655 			    old-date
  10656 			    log))
  10657        (when repeater
  10658 	 (save-excursion
  10659 	   (org-back-to-heading t)
  10660 	   (when (re-search-forward
  10661 		  (concat keyword " " org-last-inserted-timestamp)
  10662 		  (line-end-position 2)
  10663 		  t)
  10664 	     (goto-char (1- (match-end 0)))
  10665 	     (insert " " repeater)
  10666 	     (setq org-last-inserted-timestamp
  10667 		   (concat (substring org-last-inserted-timestamp 0 -1)
  10668 			   " " repeater
  10669 			   (substring org-last-inserted-timestamp -1))))))
  10670        (message (if deadline? "Deadline on %s" "Scheduled to %s")
  10671 		org-last-inserted-timestamp)))))
  10672 
  10673 (defun org-deadline (arg &optional time)
  10674   "Insert a \"DEADLINE:\" string with a timestamp to make a deadline.
  10675 
  10676 When called interactively, this command pops up the Emacs calendar to let
  10677 the user select a date.
  10678 
  10679 With one universal prefix argument, remove any deadline from the item.
  10680 With two universal prefix arguments, prompt for a warning delay.
  10681 With argument TIME, set the deadline at the corresponding date.  TIME
  10682 can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
  10683   (interactive "P")
  10684   (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
  10685       (org-map-entries
  10686        (lambda () (org--deadline-or-schedule arg 'deadline time))
  10687        nil
  10688        (if (eq org-loop-over-headlines-in-active-region 'start-level)
  10689 	   'region-start-level
  10690 	 'region)
  10691        (lambda () (when (org-invisible-p) (org-end-of-subtree nil t))))
  10692     (org--deadline-or-schedule arg 'deadline time)))
  10693 
  10694 (defun org-schedule (arg &optional time)
  10695   "Insert a \"SCHEDULED:\" string with a timestamp to schedule an item.
  10696 
  10697 When called interactively, this command pops up the Emacs calendar to let
  10698 the user select a date.
  10699 
  10700 With one universal prefix argument, remove any scheduling date from the item.
  10701 With two universal prefix arguments, prompt for a delay cookie.
  10702 With argument TIME, scheduled at the corresponding date.  TIME can
  10703 either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
  10704   (interactive "P")
  10705   (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
  10706       (org-map-entries
  10707        (lambda () (org--deadline-or-schedule arg 'scheduled time))
  10708        nil
  10709        (if (eq org-loop-over-headlines-in-active-region 'start-level)
  10710 	   'region-start-level
  10711 	 'region)
  10712        (lambda () (when (org-invisible-p) (org-end-of-subtree nil t))))
  10713     (org--deadline-or-schedule arg 'scheduled time)))
  10714 
  10715 (defun org-get-scheduled-time (pom &optional inherit)
  10716   "Get the scheduled time as a time tuple, of a format suitable
  10717 for calling org-schedule with, or if there is no scheduling,
  10718 returns nil."
  10719   (let ((time (org-entry-get pom "SCHEDULED" inherit)))
  10720     (when time
  10721       (org-time-string-to-time time))))
  10722 
  10723 (defun org-get-deadline-time (pom &optional inherit)
  10724   "Get the deadline as a time tuple, of a format suitable for
  10725 calling org-deadline with, or if there is no scheduling, returns
  10726 nil."
  10727   (let ((time (org-entry-get pom "DEADLINE" inherit)))
  10728     (when time
  10729       (org-time-string-to-time time))))
  10730 
  10731 (defun org-remove-timestamp-with-keyword (keyword)
  10732   "Remove all time stamps with KEYWORD in the current entry."
  10733   (let ((re (concat "\\<" (regexp-quote keyword) " +<[^>\n]+>[ \t]*"))
  10734 	beg)
  10735     (save-excursion
  10736       (org-back-to-heading t)
  10737       (setq beg (point))
  10738       (outline-next-heading)
  10739       (while (re-search-backward re beg t)
  10740 	(replace-match "")
  10741 	(if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point)))
  10742 		 (equal (char-before) ?\ ))
  10743 	    (backward-delete-char 1)
  10744 	  (when (string-match "^[ \t]*$" (buffer-substring
  10745 					  (point-at-bol) (point-at-eol)))
  10746 	    (delete-region (point-at-bol)
  10747 			   (min (point-max) (1+ (point-at-eol))))))))))
  10748 
  10749 (defvar org-time-was-given) ; dynamically scoped parameter
  10750 (defvar org-end-time-was-given) ; dynamically scoped parameter
  10751 
  10752 (defun org-at-planning-p ()
  10753   "Non-nil when point is on a planning info line."
  10754   ;; This is as accurate and faster than `org-element-at-point' since
  10755   ;; planning info location is fixed in the section.
  10756   (org-with-wide-buffer
  10757    (beginning-of-line)
  10758    (and (looking-at-p org-planning-line-re)
  10759 	(eq (point)
  10760 	    (ignore-errors
  10761 	      (if (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p))
  10762 		  (org-back-to-heading t)
  10763 		(org-with-limited-levels (org-back-to-heading t)))
  10764 	      (line-beginning-position 2))))))
  10765 
  10766 (defun org-add-planning-info (what &optional time &rest remove)
  10767   "Insert new timestamp with keyword in the planning line.
  10768 WHAT indicates what kind of time stamp to add.  It is a symbol
  10769 among `closed', `deadline', `scheduled' and nil.  TIME indicates
  10770 the time to use.  If none is given, the user is prompted for
  10771 a date.  REMOVE indicates what kind of entries to remove.  An old
  10772 WHAT entry will also be removed."
  10773   (let (org-time-was-given org-end-time-was-given default-time default-input)
  10774     (when (and (memq what '(scheduled deadline))
  10775 	       (or (not time)
  10776 		   (and (stringp time)
  10777 			(string-match "^[-+]+[0-9]" time))))
  10778       ;; Try to get a default date/time from existing timestamp
  10779       (save-excursion
  10780 	(org-back-to-heading t)
  10781 	(let ((end (save-excursion (outline-next-heading) (point))) ts)
  10782 	  (when (re-search-forward (if (eq what 'scheduled)
  10783 				       org-scheduled-time-regexp
  10784 				     org-deadline-time-regexp)
  10785 				   end t)
  10786 	    (setq ts (match-string 1)
  10787 		  default-time (org-time-string-to-time ts)
  10788 		  default-input (and ts (org-get-compact-tod ts)))))))
  10789     (when what
  10790       (setq time
  10791 	    (if (stringp time)
  10792 		;; This is a string (relative or absolute), set
  10793 		;; proper date.
  10794 		(apply #'encode-time
  10795 		       (org-read-date-analyze
  10796 			time default-time (decode-time default-time)))
  10797 	      ;; If necessary, get the time from the user
  10798 	      (or time (org-read-date nil 'to-time nil
  10799 				      (cl-case what
  10800 					(deadline "DEADLINE")
  10801 					(scheduled "SCHEDULED")
  10802 					(otherwise nil))
  10803 				      default-time default-input)))))
  10804     (org-with-wide-buffer
  10805      (org-back-to-heading t)
  10806      (let ((planning? (save-excursion
  10807 			(forward-line)
  10808 			(looking-at-p org-planning-line-re))))
  10809        (cond
  10810 	(planning?
  10811 	 (forward-line)
  10812 	 ;; Move to current indentation.
  10813 	 (skip-chars-forward " \t")
  10814 	 ;; Check if we have to remove something.
  10815 	 (dolist (type (if what (cons what remove) remove))
  10816 	   (save-excursion
  10817 	     (when (re-search-forward
  10818 		    (cl-case type
  10819 		      (closed org-closed-time-regexp)
  10820 		      (deadline org-deadline-time-regexp)
  10821 		      (scheduled org-scheduled-time-regexp)
  10822 		      (otherwise (error "Invalid planning type: %s" type)))
  10823 		    (line-end-position)
  10824 		    t)
  10825 	       ;; Delete until next keyword or end of line.
  10826 	       (delete-region
  10827 		(match-beginning 0)
  10828 		(if (re-search-forward org-keyword-time-not-clock-regexp
  10829 				       (line-end-position)
  10830 				       t)
  10831 		    (match-beginning 0)
  10832 		  (line-end-position))))))
  10833 	 ;; If there is nothing more to add and no more keyword is
  10834 	 ;; left, remove the line completely.
  10835 	 (if (and (looking-at-p "[ \t]*$") (not what))
  10836 	     (delete-region (line-end-position 0)
  10837 			    (line-end-position))
  10838 	   ;; If we removed last keyword, do not leave trailing white
  10839 	   ;; space at the end of line.
  10840 	   (let ((p (point)))
  10841 	     (save-excursion
  10842 	       (end-of-line)
  10843 	       (unless (= (skip-chars-backward " \t" p) 0)
  10844 		 (delete-region (point) (line-end-position)))))))
  10845 	(what
  10846 	 (end-of-line)
  10847 	 (insert "\n")
  10848 	 (when org-adapt-indentation
  10849 	   (indent-to-column (1+ (org-outline-level)))))
  10850 	(t nil)))
  10851      (when what
  10852        ;; Insert planning keyword.
  10853        (insert (cl-case what
  10854 		 (closed org-closed-string)
  10855 		 (deadline org-deadline-string)
  10856 		 (scheduled org-scheduled-string)
  10857 		 (otherwise (error "Invalid planning type: %s" what)))
  10858 	       " ")
  10859        ;; Insert associated timestamp.
  10860        (let ((ts (org-insert-time-stamp
  10861 		  time
  10862 		  (or org-time-was-given
  10863 		      (and (eq what 'closed) org-log-done-with-time))
  10864 		  (eq what 'closed)
  10865 		  nil nil (list org-end-time-was-given))))
  10866 	 (unless (eolp) (insert " "))
  10867 	 ts)))))
  10868 
  10869 (defvar org-log-note-marker (make-marker)
  10870   "Marker pointing at the entry where the note is to be inserted.")
  10871 (defvar org-log-note-purpose nil)
  10872 (defvar org-log-note-state nil)
  10873 (defvar org-log-note-previous-state nil)
  10874 (defvar org-log-note-extra nil)
  10875 (defvar org-log-note-window-configuration nil)
  10876 (defvar org-log-note-return-to (make-marker))
  10877 (defvar org-log-note-effective-time nil
  10878   "Remembered current time.
  10879 So that dynamically scoped `org-extend-today-until' affects
  10880 timestamps in state change log.")
  10881 
  10882 (defvar org-log-post-message nil
  10883   "Message to be displayed after a log note has been stored.
  10884 The auto-repeater uses this.")
  10885 
  10886 (defun org-add-note ()
  10887   "Add a note to the current entry.
  10888 This is done in the same way as adding a state change note."
  10889   (interactive)
  10890   (org-add-log-setup 'note))
  10891 
  10892 (defun org-log-beginning (&optional create)
  10893   "Return expected start of log notes in current entry.
  10894 When optional argument CREATE is non-nil, the function creates
  10895 a drawer to store notes, if necessary.  Returned position ignores
  10896 narrowing."
  10897   (org-with-wide-buffer
  10898    (let ((drawer (org-log-into-drawer)))
  10899      (cond
  10900       (drawer
  10901        (org-end-of-meta-data)
  10902        (let ((regexp (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$"))
  10903 	     (end (if (org-at-heading-p) (point)
  10904 		    (save-excursion (outline-next-heading) (point))))
  10905 	     (case-fold-search t))
  10906 	 (catch 'exit
  10907 	   ;; Try to find existing drawer.
  10908 	   (while (re-search-forward regexp end t)
  10909 	     (let ((element (org-element-at-point)))
  10910 	       (when (eq (org-element-type element) 'drawer)
  10911 		 (let ((cend  (org-element-property :contents-end element)))
  10912 		   (when (and (not org-log-states-order-reversed) cend)
  10913 		     (goto-char cend)))
  10914 		 (throw 'exit nil))))
  10915 	   ;; No drawer found.  Create one, if permitted.
  10916 	   (when create
  10917 	     (unless (bolp) (insert "\n"))
  10918 	     (let ((beg (point)))
  10919 	       (insert ":" drawer ":\n:END:\n")
  10920 	       (org-indent-region beg (point))
  10921 	       (org-flag-region (line-end-position -1)
  10922                                 (1- (point)) t 'outline))
  10923 	     (end-of-line -1)))))
  10924       (t
  10925        (org-end-of-meta-data org-log-state-notes-insert-after-drawers)
  10926        (skip-chars-forward " \t\n")
  10927        (beginning-of-line)
  10928        (unless org-log-states-order-reversed
  10929 	 (org-skip-over-state-notes)
  10930 	 (skip-chars-backward " \t\n")
  10931 	 (forward-line)))))
  10932    (if (bolp) (point) (line-beginning-position 2))))
  10933 
  10934 (defun org-add-log-setup (&optional purpose state prev-state how extra)
  10935   "Set up the post command hook to take a note.
  10936 If this is about to TODO state change, the new state is expected in STATE.
  10937 HOW is an indicator what kind of note should be created.
  10938 EXTRA is additional text that will be inserted into the notes buffer."
  10939   (move-marker org-log-note-marker (point))
  10940   (setq org-log-note-purpose purpose
  10941 	org-log-note-state state
  10942 	org-log-note-previous-state prev-state
  10943 	org-log-note-how how
  10944 	org-log-note-extra extra
  10945 	org-log-note-effective-time (org-current-effective-time)
  10946         org-log-setup t)
  10947   (add-hook 'post-command-hook 'org-add-log-note 'append))
  10948 
  10949 (defun org-skip-over-state-notes ()
  10950   "Skip past the list of State notes in an entry."
  10951   (when (ignore-errors (goto-char (org-in-item-p)))
  10952     (let* ((struct (org-list-struct))
  10953 	   (prevs (org-list-prevs-alist struct))
  10954 	   (regexp
  10955 	    (concat "[ \t]*- +"
  10956 		    (replace-regexp-in-string
  10957 		     " +" " +"
  10958 		     (org-replace-escapes
  10959 		      (regexp-quote (cdr (assq 'state org-log-note-headings)))
  10960 		      `(("%d" . ,org-ts-regexp-inactive)
  10961 			("%D" . ,org-ts-regexp)
  10962 			("%s" . "\\(?:\"\\S-+\"\\)?")
  10963 			("%S" . "\\(?:\"\\S-+\"\\)?")
  10964 			("%t" . ,org-ts-regexp-inactive)
  10965 			("%T" . ,org-ts-regexp)
  10966 			("%u" . ".*?")
  10967 			("%U" . ".*?")))))))
  10968       (while (looking-at-p regexp)
  10969 	(goto-char (or (org-list-get-next-item (point) struct prevs)
  10970 		       (org-list-get-item-end (point) struct)))))))
  10971 
  10972 (defun org-add-log-note (&optional _purpose)
  10973   "Pop up a window for taking a note, and add this note later."
  10974   (remove-hook 'post-command-hook 'org-add-log-note)
  10975   (setq org-log-setup nil)
  10976   (setq org-log-note-window-configuration (current-window-configuration))
  10977   (delete-other-windows)
  10978   (move-marker org-log-note-return-to (point))
  10979   (pop-to-buffer-same-window (marker-buffer org-log-note-marker))
  10980   (goto-char org-log-note-marker)
  10981   (org-switch-to-buffer-other-window "*Org Note*")
  10982   (erase-buffer)
  10983   (if (memq org-log-note-how '(time state))
  10984       (org-store-log-note)
  10985     (let ((org-inhibit-startup t)) (org-mode))
  10986     (insert (format "# Insert note for %s.
  10987 # Finish with C-c C-c, or cancel with C-c C-k.\n\n"
  10988 		    (cl-case org-log-note-purpose
  10989 		      (clock-out "stopped clock")
  10990 		      (done  "closed todo item")
  10991 		      (reschedule "rescheduling")
  10992 		      (delschedule "no longer scheduled")
  10993 		      (redeadline "changing deadline")
  10994 		      (deldeadline "removing deadline")
  10995 		      (refile "refiling")
  10996 		      (note "this entry")
  10997 		      (state
  10998 		       (format "state change from \"%s\" to \"%s\""
  10999 			       (or org-log-note-previous-state "")
  11000 			       (or org-log-note-state "")))
  11001 		      (t (error "This should not happen")))))
  11002     (when org-log-note-extra (insert org-log-note-extra))
  11003     (setq-local org-finish-function 'org-store-log-note)
  11004     (run-hooks 'org-log-buffer-setup-hook)))
  11005 
  11006 (defvar org-note-abort nil) ; dynamically scoped
  11007 (defun org-store-log-note ()
  11008   "Finish taking a log note, and insert it to where it belongs."
  11009   (let ((txt (prog1 (buffer-string)
  11010 	       (kill-buffer)))
  11011 	(note (cdr (assq org-log-note-purpose org-log-note-headings)))
  11012 	lines)
  11013     (while (string-match "\\`# .*\n[ \t\n]*" txt)
  11014       (setq txt (replace-match "" t t txt)))
  11015     (when (string-match "\\s-+\\'" txt)
  11016       (setq txt (replace-match "" t t txt)))
  11017     (setq lines (and (not (equal "" txt)) (org-split-string txt "\n")))
  11018     (when (org-string-nw-p note)
  11019       (setq note
  11020 	    (org-replace-escapes
  11021 	     note
  11022 	     (list (cons "%u" (user-login-name))
  11023 		   (cons "%U" user-full-name)
  11024 		   (cons "%t" (format-time-string
  11025 			       (org-time-stamp-format 'long 'inactive)
  11026 			       org-log-note-effective-time))
  11027 		   (cons "%T" (format-time-string
  11028 			       (org-time-stamp-format 'long nil)
  11029 			       org-log-note-effective-time))
  11030 		   (cons "%d" (format-time-string
  11031 			       (org-time-stamp-format nil 'inactive)
  11032 			       org-log-note-effective-time))
  11033 		   (cons "%D" (format-time-string
  11034 			       (org-time-stamp-format nil nil)
  11035 			       org-log-note-effective-time))
  11036 		   (cons "%s" (cond
  11037 			       ((not org-log-note-state) "")
  11038 			       ((string-match-p org-ts-regexp
  11039 						org-log-note-state)
  11040 				(format "\"[%s]\""
  11041 					(substring org-log-note-state 1 -1)))
  11042 			       (t (format "\"%s\"" org-log-note-state))))
  11043 		   (cons "%S"
  11044 			 (cond
  11045 			  ((not org-log-note-previous-state) "")
  11046 			  ((string-match-p org-ts-regexp
  11047 					   org-log-note-previous-state)
  11048 			   (format "\"[%s]\""
  11049 				   (substring
  11050 				    org-log-note-previous-state 1 -1)))
  11051 			  (t (format "\"%s\""
  11052 				     org-log-note-previous-state)))))))
  11053       (when lines (setq note (concat note " \\\\")))
  11054       (push note lines))
  11055     (when (and lines (not org-note-abort))
  11056       (with-current-buffer (marker-buffer org-log-note-marker)
  11057 	(org-with-wide-buffer
  11058 	 ;; Find location for the new note.
  11059 	 (goto-char org-log-note-marker)
  11060 	 (set-marker org-log-note-marker nil)
  11061 	 ;; Note associated to a clock is to be located right after
  11062 	 ;; the clock.  Do not move point.
  11063 	 (unless (eq org-log-note-purpose 'clock-out)
  11064 	   (goto-char (org-log-beginning t)))
  11065 	 ;; Make sure point is at the beginning of an empty line.
  11066 	 (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
  11067 	       ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n"))))
  11068 	 ;; In an existing list, add a new item at the top level.
  11069 	 ;; Otherwise, indent line like a regular one.
  11070 	 (let ((itemp (org-in-item-p)))
  11071 	   (if itemp
  11072 	       (indent-line-to
  11073 		(let ((struct (save-excursion
  11074 				(goto-char itemp) (org-list-struct))))
  11075 		  (org-list-get-ind (org-list-get-top-point struct) struct)))
  11076 	     (org-indent-line)))
  11077 	 (insert (org-list-bullet-string "-") (pop lines))
  11078 	 (let ((ind (org-list-item-body-column (line-beginning-position))))
  11079 	   (dolist (line lines)
  11080 	     (insert "\n")
  11081 	     (indent-line-to ind)
  11082 	     (insert line)))
  11083 	 (message "Note stored")
  11084 	 (org-back-to-heading t)))))
  11085   ;; Don't add undo information when called from `org-agenda-todo'.
  11086   (set-window-configuration org-log-note-window-configuration)
  11087   (with-current-buffer (marker-buffer org-log-note-return-to)
  11088     (goto-char org-log-note-return-to))
  11089   (move-marker org-log-note-return-to nil)
  11090   (when org-log-post-message (message "%s" org-log-post-message)))
  11091 
  11092 (defun org-remove-empty-drawer-at (pos)
  11093   "Remove an empty drawer at position POS.
  11094 POS may also be a marker."
  11095   (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
  11096     (org-with-wide-buffer
  11097      (goto-char pos)
  11098      (let ((drawer (org-element-at-point)))
  11099        (when (and (memq (org-element-type drawer) '(drawer property-drawer))
  11100 		  (not (org-element-property :contents-begin drawer)))
  11101 	 (delete-region (org-element-property :begin drawer)
  11102 			(progn (goto-char (org-element-property :end drawer))
  11103 			       (skip-chars-backward " \r\t\n")
  11104 			       (forward-line)
  11105 			       (point))))))))
  11106 
  11107 (defvar org-ts-type nil)
  11108 (defun org-sparse-tree (&optional arg type)
  11109   "Create a sparse tree, prompt for the details.
  11110 This command can create sparse trees.  You first need to select the type
  11111 of match used to create the tree:
  11112 
  11113 t      Show all TODO entries.
  11114 T      Show entries with a specific TODO keyword.
  11115 m      Show entries selected by a tags/property match.
  11116 p      Enter a property name and its value (both with completion on existing
  11117        names/values) and show entries with that property.
  11118 r      Show entries matching a regular expression (`/' can be used as well).
  11119 b      Show deadlines and scheduled items before a date.
  11120 a      Show deadlines and scheduled items after a date.
  11121 d      Show deadlines due within `org-deadline-warning-days'.
  11122 D      Show deadlines and scheduled items between a date range."
  11123   (interactive "P")
  11124   (setq type (or type org-sparse-tree-default-date-type))
  11125   (setq org-ts-type type)
  11126   (message "Sparse tree: [r]egexp [t]odo [T]odo-kwd [m]atch [p]roperty
  11127              [d]eadlines [b]efore-date [a]fter-date [D]ates range
  11128              [c]ycle through date types: %s"
  11129 	   (cl-case type
  11130 	     (all "all timestamps")
  11131 	     (scheduled "only scheduled")
  11132 	     (deadline "only deadline")
  11133 	     (active "only active timestamps")
  11134 	     (inactive "only inactive timestamps")
  11135 	     (closed "with a closed time-stamp")
  11136 	     (otherwise "scheduled/deadline")))
  11137   (let ((answer (read-char-exclusive)))
  11138     (cl-case answer
  11139       (?c
  11140        (org-sparse-tree
  11141 	arg
  11142 	(cadr
  11143 	 (memq type '(nil all scheduled deadline active inactive closed)))))
  11144       (?d (call-interactively 'org-check-deadlines))
  11145       (?b (call-interactively 'org-check-before-date))
  11146       (?a (call-interactively 'org-check-after-date))
  11147       (?D (call-interactively 'org-check-dates-range))
  11148       (?t (call-interactively 'org-show-todo-tree))
  11149       (?T (org-show-todo-tree '(4)))
  11150       (?m (call-interactively 'org-match-sparse-tree))
  11151       ((?p ?P)
  11152        (let* ((kwd (completing-read
  11153 		    "Property: " (mapcar #'list (org-buffer-property-keys))))
  11154 	      (value (completing-read
  11155 		      "Value: " (mapcar #'list (org-property-values kwd)))))
  11156 	 (unless (string-match "\\`{.*}\\'" value)
  11157 	   (setq value (concat "\"" value "\"")))
  11158 	 (org-match-sparse-tree arg (concat kwd "=" value))))
  11159       ((?r ?R ?/) (call-interactively 'org-occur))
  11160       (otherwise (user-error "No such sparse tree command \"%c\"" answer)))))
  11161 
  11162 (defvar-local org-occur-highlights nil
  11163   "List of overlays used for occur matches.")
  11164 (defvar-local org-occur-parameters nil
  11165   "Parameters of the active org-occur calls.
  11166 This is a list, each call to org-occur pushes as cons cell,
  11167 containing the regular expression and the callback, onto the list.
  11168 The list can contain several entries if `org-occur' has been called
  11169 several time with the KEEP-PREVIOUS argument.  Otherwise, this list
  11170 will only contain one set of parameters.  When the highlights are
  11171 removed (for example with `C-c C-c', or with the next edit (depending
  11172 on `org-remove-highlights-with-change'), this variable is emptied
  11173 as well.")
  11174 
  11175 (defun org-occur (regexp &optional keep-previous callback)
  11176   "Make a compact tree showing all matches of REGEXP.
  11177 
  11178 The tree will show the lines where the regexp matches, and any other context
  11179 defined in `org-show-context-detail', which see.
  11180 
  11181 When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing
  11182 done by a previous call to `org-occur' will be kept, to allow stacking of
  11183 calls to this command.
  11184 
  11185 Optional argument CALLBACK can be a function of no argument.  In this case,
  11186 it is called with point at the end of the match, match data being set
  11187 accordingly.  Current match is shown only if the return value is non-nil.
  11188 The function must neither move point nor alter narrowing."
  11189   (interactive "sRegexp: \nP")
  11190   (when (equal regexp "")
  11191     (user-error "Regexp cannot be empty"))
  11192   (unless keep-previous
  11193     (org-remove-occur-highlights nil nil t))
  11194   (push (cons regexp callback) org-occur-parameters)
  11195   (let ((cnt 0))
  11196     (save-excursion
  11197       (goto-char (point-min))
  11198       (when (or (not keep-previous)	    ; do not want to keep
  11199 		(not org-occur-highlights)) ; no previous matches
  11200 	;; hide everything
  11201 	(org-overview))
  11202       (let ((case-fold-search (if (eq org-occur-case-fold-search 'smart)
  11203 				  (isearch-no-upper-case-p regexp t)
  11204 				org-occur-case-fold-search)))
  11205 	(while (re-search-forward regexp nil t)
  11206 	  (when (or (not callback)
  11207 		    (save-match-data (funcall callback)))
  11208 	    (setq cnt (1+ cnt))
  11209 	    (when org-highlight-sparse-tree-matches
  11210 	      (org-highlight-new-match (match-beginning 0) (match-end 0)))
  11211 	    (org-show-context 'occur-tree)))))
  11212     (when org-remove-highlights-with-change
  11213       (add-hook 'before-change-functions 'org-remove-occur-highlights
  11214 		nil 'local))
  11215     (unless org-sparse-tree-open-archived-trees
  11216       (org-hide-archived-subtrees (point-min) (point-max)))
  11217     (run-hooks 'org-occur-hook)
  11218     (when (called-interactively-p 'interactive)
  11219       (message "%d match(es) for regexp %s" cnt regexp))
  11220     cnt))
  11221 
  11222 (defun org-occur-next-match (&optional n _reset)
  11223   "Function for `next-error-function' to find sparse tree matches.
  11224 N is the number of matches to move, when negative move backwards.
  11225 This function always goes back to the starting point when no
  11226 match is found."
  11227   (let* ((limit (if (< n 0) (point-min) (point-max)))
  11228 	 (search-func (if (< n 0)
  11229 			  'previous-single-char-property-change
  11230 			'next-single-char-property-change))
  11231 	 (n (abs n))
  11232 	 (pos (point))
  11233 	 p1)
  11234     (catch 'exit
  11235       (while (setq p1 (funcall search-func (point) 'org-type))
  11236 	(when (equal p1 limit)
  11237 	  (goto-char pos)
  11238 	  (user-error "No more matches"))
  11239 	(when (equal (get-char-property p1 'org-type) 'org-occur)
  11240 	  (setq n (1- n))
  11241 	  (when (= n 0)
  11242 	    (goto-char p1)
  11243 	    (throw 'exit (point))))
  11244 	(goto-char p1))
  11245       (goto-char p1)
  11246       (user-error "No more matches"))))
  11247 
  11248 (defun org-highlight-new-match (beg end)
  11249   "Highlight from BEG to END and mark the highlight is an occur headline."
  11250   (let ((ov (make-overlay beg end)))
  11251     (overlay-put ov 'face 'secondary-selection)
  11252     (overlay-put ov 'org-type 'org-occur)
  11253     (push ov org-occur-highlights)))
  11254 
  11255 (defun org-remove-occur-highlights (&optional _beg _end noremove)
  11256   "Remove the occur highlights from the buffer.
  11257 BEG and END are ignored.  If NOREMOVE is nil, remove this function
  11258 from the `before-change-functions' in the current buffer."
  11259   (interactive)
  11260   (unless org-inhibit-highlight-removal
  11261     (mapc #'delete-overlay org-occur-highlights)
  11262     (setq org-occur-highlights nil)
  11263     (setq org-occur-parameters nil)
  11264     (unless noremove
  11265       (remove-hook 'before-change-functions
  11266 		   'org-remove-occur-highlights 'local))))
  11267 
  11268 ;;;; Priorities
  11269 
  11270 (defvar org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]+\\)\\] ?\\)"
  11271   "Regular expression matching the priority indicator.
  11272 A priority indicator can be e.g. [#A] or [#1].
  11273 This regular expression matches these groups:
  11274 0 : the whole match, e.g. \"TODO [#A] Hack\"
  11275 1 : the priority cookie, e.g. \"[#A]\"
  11276 2 : the value of the priority cookie, e.g. \"A\".")
  11277 
  11278 (defun org-priority-up ()
  11279   "Increase the priority of the current item."
  11280   (interactive)
  11281   (org-priority 'up))
  11282 
  11283 (defun org-priority-down ()
  11284   "Decrease the priority of the current item."
  11285   (interactive)
  11286   (org-priority 'down))
  11287 
  11288 (defun org-priority (&optional action show)
  11289   "Change the priority of an item.
  11290 
  11291 When called interactively with a `\\[universal-argument]' prefix,
  11292 show the priority in the minibuffer instead of changing it.
  11293 
  11294 When called programmatically, ACTION can be `set', `up', `down',
  11295 or a character."
  11296   (interactive "P")
  11297   (when show
  11298     ;; Deprecation warning inserted for Org 9.2; once enough time has
  11299     ;; passed the SHOW argument should be removed.
  11300     (warn "`org-priority' called with deprecated SHOW argument"))
  11301   (if (equal action '(4))
  11302       (org-priority-show)
  11303     (unless org-priority-enable-commands
  11304       (user-error "Priority commands are disabled"))
  11305     (setq action (or action 'set))
  11306     (let ((nump (< org-priority-lowest 65))
  11307 	  current new news have remove)
  11308       (save-excursion
  11309 	(org-back-to-heading t)
  11310 	(when (looking-at org-priority-regexp)
  11311 	  (let ((ms (match-string 2)))
  11312 	    (setq current (org-priority-to-value ms)
  11313 		  have t)))
  11314 	(cond
  11315 	 ((eq action 'remove)
  11316 	  (setq remove t new ?\ ))
  11317 	 ((or (eq action 'set)
  11318 	      (integerp action))
  11319 	  (if (not (eq action 'set))
  11320 	      (setq new action)
  11321 	    (setq
  11322 	     new
  11323 	     (if nump
  11324                  (let ((msg (format "Priority %s-%s, SPC to remove: "
  11325 				    (number-to-string org-priority-highest)
  11326 				    (number-to-string org-priority-lowest))))
  11327                    (if (< 9 org-priority-lowest)
  11328 		       (string-to-number (read-string msg))
  11329                      (message msg)
  11330                      (string-to-number (char-to-string (read-char-exclusive)))))
  11331 	       (progn (message "Priority %c-%c, SPC to remove: "
  11332 			       org-priority-highest org-priority-lowest)
  11333 		      (save-match-data
  11334 			(setq new (read-char-exclusive)))))))
  11335 	  (when (and (= (upcase org-priority-highest) org-priority-highest)
  11336 		     (= (upcase org-priority-lowest) org-priority-lowest))
  11337 	    (setq new (upcase new)))
  11338 	  (cond ((equal new ?\s) (setq remove t))
  11339 		((or (< (upcase new) org-priority-highest) (> (upcase new) org-priority-lowest))
  11340 		 (user-error
  11341 		  (if nump
  11342 		      "Priority must be between `%s' and `%s'"
  11343 		    "Priority must be between `%c' and `%c'")
  11344 		  org-priority-highest org-priority-lowest))))
  11345 	 ((eq action 'up)
  11346 	  (setq new (if have
  11347 			(1- current)  ; normal cycling
  11348 		      ;; last priority was empty
  11349 		      (if (eq last-command this-command)
  11350 			  org-priority-lowest  ; wrap around empty to lowest
  11351 			;; default
  11352 			(if org-priority-start-cycle-with-default
  11353 			    org-priority-default
  11354 			  (1- org-priority-default))))))
  11355 	 ((eq action 'down)
  11356 	  (setq new (if have
  11357 			(1+ current)  ; normal cycling
  11358 		      ;; last priority was empty
  11359 		      (if (eq last-command this-command)
  11360 			  org-priority-highest  ; wrap around empty to highest
  11361 			;; default
  11362 			(if org-priority-start-cycle-with-default
  11363 			    org-priority-default
  11364 			  (1+ org-priority-default))))))
  11365 	 (t (user-error "Invalid action")))
  11366 	(when (or (< (upcase new) org-priority-highest)
  11367 		  (> (upcase new) org-priority-lowest))
  11368 	  (if (and (memq action '(up down))
  11369 		   (not have) (not (eq last-command this-command)))
  11370 	      ;; `new' is from default priority
  11371 	      (error
  11372 	       "The default can not be set, see `org-priority-default' why")
  11373 	    ;; normal cycling: `new' is beyond highest/lowest priority
  11374 	    ;; and is wrapped around to the empty priority
  11375 	    (setq remove t)))
  11376 	;; Numerical priorities are limited to 64, beyond that number,
  11377 	;; assume the priority cookie is a character.
  11378 	(setq news (if (> new 64) (format "%c" new) (format "%s" new)))
  11379 	(if have
  11380 	    (if remove
  11381 		(replace-match "" t t nil 1)
  11382 	      (replace-match news t t nil 2))
  11383 	  (if remove
  11384 	      (user-error "No priority cookie found in line")
  11385 	    (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
  11386 	    (if (match-end 2)
  11387 		(progn
  11388 		  (goto-char (match-end 2))
  11389 		  (insert " [#" news "]"))
  11390 	      (goto-char (match-beginning 3))
  11391 	      (insert "[#" news "] "))))
  11392 	(org-align-tags))
  11393       (if remove
  11394 	  (message "Priority removed")
  11395 	(message "Priority of current item set to %s" news)))))
  11396 
  11397 (defalias 'org-show-priority 'org-priority-show)
  11398 (defun org-priority-show ()
  11399   "Show the priority of the current item.
  11400 This priority is composed of the main priority given with the [#A] cookies,
  11401 and by additional input from the age of a schedules or deadline entry."
  11402   (interactive)
  11403   (let ((pri (if (eq major-mode 'org-agenda-mode)
  11404 		 (org-get-at-bol 'priority)
  11405 	       (save-excursion
  11406 		 (save-match-data
  11407 		   (beginning-of-line)
  11408 		   (and (looking-at org-heading-regexp)
  11409 			(org-get-priority (match-string 0))))))))
  11410     (message "Priority is %d" (if pri pri -1000))))
  11411 
  11412 (defun org-get-priority (s)
  11413   "Find priority cookie and return priority.
  11414 S is a string against which you can match `org-priority-regexp'.
  11415 If `org-priority-get-priority-function' is set to a custom
  11416 function, use it.  Otherwise process S and output the priority
  11417 value, an integer."
  11418   (save-match-data
  11419     (if (functionp org-priority-get-priority-function)
  11420 	(funcall org-priority-get-priority-function s)
  11421       (if (not (string-match org-priority-regexp s))
  11422 	  (* 1000 (- org-priority-lowest org-priority-default))
  11423 	(* 1000 (- org-priority-lowest
  11424 		   (org-priority-to-value (match-string 2 s))))))))
  11425 
  11426 ;;;; Tags
  11427 
  11428 (defvar org-agenda-archives-mode)
  11429 (defvar org-map-continue-from nil
  11430   "Position from where mapping should continue.
  11431 Can be set by the action argument to `org-scan-tags' and `org-map-entries'.")
  11432 
  11433 (defvar org-scanner-tags nil
  11434   "The current tag list while the tags scanner is running.")
  11435 
  11436 (defvar org-trust-scanner-tags nil
  11437   "Should `org-get-tags' use the tags for the scanner.
  11438 This is for internal dynamical scoping only.
  11439 When this is non-nil, the function `org-get-tags' will return the value
  11440 of `org-scanner-tags' instead of building the list by itself.  This
  11441 can lead to large speed-ups when the tags scanner is used in a file with
  11442 many entries, and when the list of tags is retrieved, for example to
  11443 obtain a list of properties.  Building the tags list for each entry in such
  11444 a file becomes an N^2 operation - but with this variable set, it scales
  11445 as N.")
  11446 
  11447 (defvar org--matcher-tags-todo-only nil)
  11448 
  11449 (defun org-scan-tags (action matcher todo-only &optional start-level)
  11450   "Scan headline tags with inheritance and produce output ACTION.
  11451 
  11452 ACTION can be `sparse-tree' to produce a sparse tree in the current buffer,
  11453 or `agenda' to produce an entry list for an agenda view.  It can also be
  11454 a Lisp form or a function that should be called at each matched headline, in
  11455 this case the return value is a list of all return values from these calls.
  11456 
  11457 MATCHER is a function accepting three arguments, returning
  11458 a non-nil value whenever a given set of tags qualifies a headline
  11459 for inclusion.  See `org-make-tags-matcher' for more information.
  11460 As a special case, it can also be set to t (respectively nil) in
  11461 order to match all (respectively none) headline.
  11462 
  11463 When TODO-ONLY is non-nil, only lines with a TODO keyword are
  11464 included in the output.
  11465 
  11466 START-LEVEL can be a string with asterisks, reducing the scope to
  11467 headlines matching this string."
  11468   (require 'org-agenda)
  11469   (let* ((re (concat "^"
  11470 		     (if start-level
  11471 			 ;; Get the correct level to match
  11472 			 (concat "\\*\\{" (number-to-string start-level) "\\} ")
  11473 		       org-outline-regexp)
  11474 		     " *\\(" (regexp-opt org-todo-keywords-1 'words) "\\)?"
  11475 		     " *\\(.*?\\)\\([ \t]:\\(?:" org-tag-re ":\\)+\\)?[ \t]*$"))
  11476 	 (props (list 'face 'default
  11477 		      'done-face 'org-agenda-done
  11478 		      'undone-face 'default
  11479 		      'mouse-face 'highlight
  11480 		      'org-not-done-regexp org-not-done-regexp
  11481 		      'org-todo-regexp org-todo-regexp
  11482 		      'org-complex-heading-regexp org-complex-heading-regexp
  11483 		      'help-echo
  11484 		      (format "mouse-2 or RET jump to Org file %S"
  11485 			      (abbreviate-file-name
  11486 			       (or (buffer-file-name (buffer-base-buffer))
  11487 				   (buffer-name (buffer-base-buffer)))))))
  11488 	 (org-map-continue-from nil)
  11489          lspos tags tags-list
  11490 	 (tags-alist (list (cons 0 org-file-tags)))
  11491 	 (llast 0) rtn rtn1 level category i txt
  11492 	 todo marker entry priority
  11493 	 ts-date ts-date-type ts-date-pair)
  11494     (unless (or (member action '(agenda sparse-tree)) (functionp action))
  11495       (setq action (list 'lambda nil action)))
  11496     (save-excursion
  11497       (goto-char (point-min))
  11498       (when (eq action 'sparse-tree)
  11499 	(org-overview)
  11500 	(org-remove-occur-highlights))
  11501       (while (let (case-fold-search)
  11502 	       (re-search-forward re nil t))
  11503 	(setq org-map-continue-from nil)
  11504 	(catch :skip
  11505 	  ;; Ignore closing parts of inline tasks.
  11506 	  (when (and (fboundp 'org-inlinetask-end-p) (org-inlinetask-end-p))
  11507 	    (throw :skip t))
  11508 	  (setq todo (and (match-end 1) (match-string-no-properties 1)))
  11509 	  (setq tags (and (match-end 4) (org-trim (match-string-no-properties 4))))
  11510 	  (goto-char (setq lspos (match-beginning 0)))
  11511 	  (setq level (org-reduced-level (org-outline-level))
  11512 		category (org-get-category))
  11513           (when (eq action 'agenda)
  11514             (setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
  11515 		  ts-date (car ts-date-pair)
  11516 		  ts-date-type (cdr ts-date-pair)))
  11517 	  (setq i llast llast level)
  11518 	  ;; remove tag lists from same and sublevels
  11519 	  (while (>= i level)
  11520 	    (when (setq entry (assoc i tags-alist))
  11521 	      (setq tags-alist (delete entry tags-alist)))
  11522 	    (setq i (1- i)))
  11523 	  ;; add the next tags
  11524 	  (when tags
  11525 	    (setq tags (org-split-string tags ":")
  11526 		  tags-alist
  11527 		  (cons (cons level tags) tags-alist)))
  11528 	  ;; compile tags for current headline
  11529 	  (setq tags-list
  11530 		(if org-use-tag-inheritance
  11531 		    (apply 'append (mapcar 'cdr (reverse tags-alist)))
  11532 		  tags)
  11533 		org-scanner-tags tags-list)
  11534 	  (when org-use-tag-inheritance
  11535 	    (setcdr (car tags-alist)
  11536 		    (mapcar (lambda (x)
  11537 			      (setq x (copy-sequence x))
  11538 			      (org-add-prop-inherited x))
  11539 			    (cdar tags-alist))))
  11540 	  (when (and tags org-use-tag-inheritance
  11541 		     (or (not (eq t org-use-tag-inheritance))
  11542 			 org-tags-exclude-from-inheritance))
  11543 	    ;; Selective inheritance, remove uninherited ones.
  11544 	    (setcdr (car tags-alist)
  11545 		    (org-remove-uninherited-tags (cdar tags-alist))))
  11546 	  (when (and
  11547 
  11548 		 ;; eval matcher only when the todo condition is OK
  11549 		 (and (or (not todo-only) (member todo org-todo-keywords-1))
  11550 		      (if (functionp matcher)
  11551 			  (let ((case-fold-search t) (org-trust-scanner-tags t))
  11552 			    (funcall matcher todo tags-list level))
  11553 			matcher))
  11554 
  11555 		 ;; Call the skipper, but return t if it does not
  11556 		 ;; skip, so that the `and' form continues evaluating.
  11557 		 (progn
  11558 		   (unless (eq action 'sparse-tree) (org-agenda-skip))
  11559 		   t)
  11560 
  11561 		 ;; Check if timestamps are deselecting this entry
  11562 		 (or (not todo-only)
  11563 		     (and (member todo org-todo-keywords-1)
  11564 			  (or (not org-agenda-tags-todo-honor-ignore-options)
  11565 			      (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))))
  11566 
  11567 	    ;; select this headline
  11568 	    (cond
  11569 	     ((eq action 'sparse-tree)
  11570 	      (and org-highlight-sparse-tree-matches
  11571 		   (org-get-heading) (match-end 0)
  11572 		   (org-highlight-new-match
  11573 		    (match-beginning 1) (match-end 1)))
  11574 	      (org-show-context 'tags-tree))
  11575 	     ((eq action 'agenda)
  11576 	      (setq txt (org-agenda-format-item
  11577 			 ""
  11578 			 (concat
  11579 			  (if (eq org-tags-match-list-sublevels 'indented)
  11580 			      (make-string (1- level) ?.) "")
  11581 			  (org-get-heading))
  11582 			 (make-string level ?\s)
  11583 			 category
  11584 			 tags-list)
  11585 		    priority (org-get-priority txt))
  11586 	      (goto-char lspos)
  11587 	      (setq marker (org-agenda-new-marker))
  11588 	      (org-add-props txt props
  11589 		'org-marker marker 'org-hd-marker marker 'org-category category
  11590 		'todo-state todo
  11591                 'ts-date ts-date
  11592 		'priority priority
  11593                 'type (concat "tagsmatch" ts-date-type))
  11594 	      (push txt rtn))
  11595 	     ((functionp action)
  11596 	      (setq org-map-continue-from nil)
  11597 	      (save-excursion
  11598 		(setq rtn1 (funcall action))
  11599 		(push rtn1 rtn)))
  11600 	     (t (user-error "Invalid action")))
  11601 
  11602 	    ;; if we are to skip sublevels, jump to end of subtree
  11603 	    (unless org-tags-match-list-sublevels
  11604 	      (org-end-of-subtree t)
  11605 	      (backward-char 1))))
  11606 	;; Get the correct position from where to continue
  11607 	(if org-map-continue-from
  11608 	    (goto-char org-map-continue-from)
  11609 	  (and (= (point) lspos) (end-of-line 1)))))
  11610     (when (and (eq action 'sparse-tree)
  11611 	       (not org-sparse-tree-open-archived-trees))
  11612       (org-hide-archived-subtrees (point-min) (point-max)))
  11613     (nreverse rtn)))
  11614 
  11615 (defun org-remove-uninherited-tags (tags)
  11616   "Remove all tags that are not inherited from the list TAGS."
  11617   (cond
  11618    ((eq org-use-tag-inheritance t)
  11619     (if org-tags-exclude-from-inheritance
  11620 	(org-delete-all org-tags-exclude-from-inheritance tags)
  11621       tags))
  11622    ((not org-use-tag-inheritance) nil)
  11623    ((stringp org-use-tag-inheritance)
  11624     (delq nil (mapcar
  11625 	       (lambda (x)
  11626 		 (if (and (string-match org-use-tag-inheritance x)
  11627 			  (not (member x org-tags-exclude-from-inheritance)))
  11628 		     x nil))
  11629 	       tags)))
  11630    ((listp org-use-tag-inheritance)
  11631     (delq nil (mapcar
  11632 	       (lambda (x)
  11633 		 (if (member x org-use-tag-inheritance) x nil))
  11634 	       tags)))))
  11635 
  11636 (defun org-match-sparse-tree (&optional todo-only match)
  11637   "Create a sparse tree according to tags string MATCH.
  11638 
  11639 MATCH is a string with match syntax.  It can contain a selection
  11640 of tags (\"+work+urgent-boss\"), properties (\"LEVEL>3\"), and
  11641 TODO keywords (\"TODO=\\\"WAITING\\\"\") or a combination of
  11642 those.  See the manual for details.
  11643 
  11644 If optional argument TODO-ONLY is non-nil, only select lines that
  11645 are also TODO tasks."
  11646   (interactive "P")
  11647   (org-agenda-prepare-buffers (list (current-buffer)))
  11648   (let ((org--matcher-tags-todo-only todo-only))
  11649     (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match t))
  11650 		   org--matcher-tags-todo-only)))
  11651 
  11652 (defalias 'org-tags-sparse-tree 'org-match-sparse-tree)
  11653 
  11654 (defvar org-cached-props nil)
  11655 (defun org-cached-entry-get (pom property)
  11656   (if (or (eq t org-use-property-inheritance)
  11657 	  (and (stringp org-use-property-inheritance)
  11658 	       (let ((case-fold-search t))
  11659 		 (string-match-p org-use-property-inheritance property)))
  11660 	  (and (listp org-use-property-inheritance)
  11661 	       (member-ignore-case property org-use-property-inheritance)))
  11662       ;; Caching is not possible, check it directly.
  11663       (org-entry-get pom property 'inherit)
  11664     ;; Get all properties, so we can do complicated checks easily.
  11665     (cdr (assoc-string property
  11666 		       (or org-cached-props
  11667 			   (setq org-cached-props (org-entry-properties pom)))
  11668 		       t))))
  11669 
  11670 (defun org-global-tags-completion-table (&optional files)
  11671   "Return the list of all tags in all agenda buffer/files.
  11672 Optional FILES argument is a list of files which can be used
  11673 instead of the agenda files."
  11674   (save-excursion
  11675     (org-uniquify
  11676      (delq nil
  11677 	   (apply #'append
  11678 		  (mapcar
  11679 		   (lambda (file)
  11680 		     (set-buffer (find-file-noselect file))
  11681 		     (org--tag-add-to-alist
  11682 		      (org-get-buffer-tags)
  11683 		      (mapcar (lambda (x)
  11684 				(and (stringp (car-safe x))
  11685 				     (list (car-safe x))))
  11686 			      org-current-tag-alist)))
  11687 		   (if (car-safe files) files
  11688 		     (org-agenda-files))))))))
  11689 
  11690 (defun org-make-tags-matcher (match &optional only-local-tags)
  11691   "Create the TAGS/TODO matcher form for the selection string MATCH.
  11692 
  11693 Returns a cons of the selection string MATCH and a function
  11694 implementing the matcher.
  11695 
  11696 The matcher is to be called at an Org entry, with point on the
  11697 headline, and returns non-nil if the entry matches the selection
  11698 string MATCH.  It must be called with three arguments: the TODO
  11699 keyword at the entry (or nil if none), the list of all tags at
  11700 the entry including inherited ones and the reduced level of the
  11701 headline.  Additionally, the category of the entry, if any, must
  11702 be specified as the text property `org-category' on the headline.
  11703 
  11704 This function sets the variable `org--matcher-tags-todo-only' to
  11705 a non-nil value if the matcher restricts matching to TODO
  11706 entries, otherwise it is not touched.
  11707 
  11708 When ONLY-LOCAL-TAGS is non-nil, ignore the global tag completion
  11709 table, only get buffer tags.
  11710 
  11711 See also `org-scan-tags'."
  11712   (unless match
  11713     ;; Get a new match request, with completion against the global
  11714     ;; tags table and the local tags in current buffer.
  11715     (let ((org-last-tags-completion-table
  11716 	   (org--tag-add-to-alist
  11717 	    (org-get-buffer-tags)
  11718 	    (unless only-local-tags
  11719 	      (org-global-tags-completion-table)))))
  11720       (setq match
  11721 	    (completing-read
  11722 	     "Match: "
  11723 	     'org-tags-completion-function nil nil nil 'org-tags-history))))
  11724 
  11725   (let ((match0 match)
  11726 	(re (concat
  11727 	     "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)"
  11728 	     "\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)"
  11729 	     "\\([<>=]\\{1,2\\}\\)"
  11730 	     "\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)"
  11731 	     "\\|" org-tag-re "\\)"))
  11732 	(start 0)
  11733 	tagsmatch todomatch tagsmatcher todomatcher)
  11734 
  11735     ;; Expand group tags.
  11736     (setq match (org-tags-expand match))
  11737 
  11738     ;; Check if there is a TODO part of this match, which would be the
  11739     ;; part after a "/".  To make sure that this slash is not part of
  11740     ;; a property value to be matched against, we also check that
  11741     ;; there is no / after that slash.  First, find the last slash.
  11742     (let ((s 0))
  11743       (while (string-match "/+" match s)
  11744 	(setq start (match-beginning 0))
  11745 	(setq s (match-end 0))))
  11746     (if (and (string-match "/+" match start)
  11747 	     (not (string-match-p "\"" match start)))
  11748 	;; Match contains also a TODO-matching request.
  11749 	(progn
  11750 	  (setq tagsmatch (substring match 0 (match-beginning 0)))
  11751 	  (setq todomatch (substring match (match-end 0)))
  11752 	  (when (string-prefix-p "!" todomatch)
  11753 	    (setq org--matcher-tags-todo-only t)
  11754 	    (setq todomatch (substring todomatch 1)))
  11755 	  (when (string-match "\\`\\s-*\\'" todomatch)
  11756 	    (setq todomatch nil)))
  11757       ;; Only matching tags.
  11758       (setq tagsmatch match)
  11759       (setq todomatch nil))
  11760 
  11761     ;; Make the tags matcher.
  11762     (when (org-string-nw-p tagsmatch)
  11763       (let ((orlist nil)
  11764 	    (orterms (org-split-string tagsmatch "|"))
  11765 	    term)
  11766 	(while (setq term (pop orterms))
  11767 	  (while (and (equal (substring term -1) "\\") orterms)
  11768 	    (setq term (concat term "|" (pop orterms)))) ;repair bad split.
  11769 	  (while (string-match re term)
  11770 	    (let* ((rest (substring term (match-end 0)))
  11771 		   (minus (and (match-end 1)
  11772 			       (equal (match-string 1 term) "-")))
  11773 		   (tag (save-match-data
  11774 			  (replace-regexp-in-string
  11775 			   "\\\\-" "-" (match-string 2 term))))
  11776 		   (regexp (eq (string-to-char tag) ?{))
  11777 		   (levelp (match-end 4))
  11778 		   (propp (match-end 5))
  11779 		   (mm
  11780 		    (cond
  11781 		     (regexp `(org-match-any-p ,(substring tag 1 -1) tags-list))
  11782 		     (levelp
  11783 		      `(,(org-op-to-function (match-string 3 term))
  11784 			level
  11785 			,(string-to-number (match-string 4 term))))
  11786 		     (propp
  11787 		      (let* ((gv (pcase (upcase (match-string 5 term))
  11788 				   ("CATEGORY"
  11789 				    '(get-text-property (point) 'org-category))
  11790 				   ("TODO" 'todo)
  11791 				   (p `(org-cached-entry-get nil ,p))))
  11792 			     (pv (match-string 7 term))
  11793 			     (regexp (eq (string-to-char pv) ?{))
  11794 			     (strp (eq (string-to-char pv) ?\"))
  11795 			     (timep (string-match-p "^\"[[<].*[]>]\"$" pv))
  11796 			     (po (org-op-to-function (match-string 6 term)
  11797 						     (if timep 'time strp))))
  11798 			(setq pv (if (or regexp strp) (substring pv 1 -1) pv))
  11799 			(when timep (setq pv (org-matcher-time pv)))
  11800 			(cond ((and regexp (eq po '/=))
  11801 			       `(not (string-match ,pv (or ,gv ""))))
  11802 			      (regexp `(string-match ,pv (or ,gv "")))
  11803 			      (strp `(,po (or ,gv "") ,pv))
  11804 			      (t
  11805 			       `(,po
  11806 				 (string-to-number (or ,gv ""))
  11807 				 ,(string-to-number pv))))))
  11808 		     (t `(member ,tag tags-list)))))
  11809 	      (push (if minus `(not ,mm) mm) tagsmatcher)
  11810 	      (setq term rest)))
  11811 	  (push `(and ,@tagsmatcher) orlist)
  11812 	  (setq tagsmatcher nil))
  11813 	(setq tagsmatcher `(progn (setq org-cached-props nil) (or ,@orlist)))))
  11814 
  11815     ;; Make the TODO matcher.
  11816     (when (org-string-nw-p todomatch)
  11817       (let ((orlist nil))
  11818 	(dolist (term (org-split-string todomatch "|"))
  11819 	  (while (string-match re term)
  11820 	    (let* ((minus (and (match-end 1)
  11821 			       (equal (match-string 1 term) "-")))
  11822 		   (kwd (match-string 2 term))
  11823 		   (regexp (eq (string-to-char kwd) ?{))
  11824 		   (mm (if regexp `(string-match ,(substring kwd 1 -1) todo)
  11825 			 `(equal todo ,kwd))))
  11826 	      (push (if minus `(not ,mm) mm) todomatcher))
  11827 	    (setq term (substring term (match-end 0))))
  11828 	  (push (if (> (length todomatcher) 1)
  11829 		    (cons 'and todomatcher)
  11830 		  (car todomatcher))
  11831 		orlist)
  11832 	  (setq todomatcher nil))
  11833 	(setq todomatcher (cons 'or orlist))))
  11834 
  11835     ;; Return the string and function of the matcher.  If no
  11836     ;; tags-specific or todo-specific matcher exists, match
  11837     ;; everything.
  11838     (let ((matcher (if (and tagsmatcher todomatcher)
  11839 		       `(and ,tagsmatcher ,todomatcher)
  11840 		     (or tagsmatcher todomatcher t))))
  11841       (when org--matcher-tags-todo-only
  11842 	(setq matcher `(and (member todo org-not-done-keywords) ,matcher)))
  11843       (cons match0 `(lambda (todo tags-list level) ,matcher)))))
  11844 
  11845 (defun org--tags-expand-group (group tag-groups expanded)
  11846   "Recursively expand all tags in GROUP, according to TAG-GROUPS.
  11847 TAG-GROUPS is the list of groups used for expansion.  EXPANDED is
  11848 an accumulator used in recursive calls."
  11849   (dolist (tag group)
  11850     (unless (member tag expanded)
  11851       (let ((group (assoc tag tag-groups)))
  11852 	(push tag expanded)
  11853 	(when group
  11854 	  (setq expanded
  11855 		(org--tags-expand-group (cdr group) tag-groups expanded))))))
  11856   expanded)
  11857 
  11858 (defun org-tags-expand (match &optional single-as-list)
  11859   "Expand group tags in MATCH.
  11860 
  11861 This replaces every group tag in MATCH with a regexp tag search.
  11862 For example, a group tag \"Work\" defined as { Work : Lab Conf }
  11863 will be replaced like this:
  11864 
  11865    Work =>  {\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
  11866   +Work => +{\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
  11867   -Work => -{\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
  11868 
  11869 Replacing by a regexp preserves the structure of the match.
  11870 E.g., this expansion
  11871 
  11872   Work|Home => {\\(?:Work\\|Lab\\|Conf\\}|Home
  11873 
  11874 will match anything tagged with \"Lab\" and \"Home\", or tagged
  11875 with \"Conf\" and \"Home\" or tagged with \"Work\" and \"Home\".
  11876 
  11877 A group tag in MATCH can contain regular expressions of its own.
  11878 For example, a group tag \"Proj\" defined as { Proj : {P@.+} }
  11879 will be replaced like this:
  11880 
  11881    Proj => {\\<\\(?:Proj\\)\\>\\|P@.+}
  11882 
  11883 When the optional argument SINGLE-AS-LIST is non-nil, MATCH is
  11884 assumed to be a single group tag, and the function will return
  11885 the list of tags in this group."
  11886   (unless (org-string-nw-p match) (error "Invalid match tag: %S" match))
  11887   (let ((tag-groups
  11888          (or org-tag-groups-alist-for-agenda org-tag-groups-alist)))
  11889     (cond
  11890      (single-as-list (org--tags-expand-group (list match) tag-groups nil))
  11891      (org-group-tags
  11892       (let* ((case-fold-search t)
  11893 	     (tag-syntax org-mode-syntax-table)
  11894 	     (group-keys (mapcar #'car tag-groups))
  11895 	     (key-regexp (concat "\\([+-]?\\)" (regexp-opt group-keys 'words)))
  11896 	     (return-match match))
  11897 	;; Mark regexp-expressions in the match-expression so that we
  11898 	;; do not replace them later on.
  11899 	(let ((s 0))
  11900 	  (while (string-match "{.+?}" return-match s)
  11901 	    (setq s (match-end 0))
  11902 	    (add-text-properties
  11903 	     (match-beginning 0) (match-end 0) '(regexp t) return-match)))
  11904 	;; @ and _ are allowed as word-components in tags.
  11905 	(modify-syntax-entry ?@ "w" tag-syntax)
  11906 	(modify-syntax-entry ?_ "w" tag-syntax)
  11907 	;; For each tag token found in MATCH, compute a regexp and  it
  11908 	(with-syntax-table tag-syntax
  11909 	  (replace-regexp-in-string
  11910 	   key-regexp
  11911 	   (lambda (m)
  11912 	     (if (get-text-property (match-beginning 2) 'regexp m)
  11913 		 m			;regexp tag: ignore
  11914 	       (let* ((operator (match-string 1 m))
  11915 		      (tag-token (let ((tag (match-string 2 m)))
  11916 				   (list tag)))
  11917 		      regexp-tags regular-tags)
  11918 		 ;; Partition tags between regexp and regular tags.
  11919 		 ;; Remove curly bracket syntax from regexp tags.
  11920 		 (dolist (tag (org--tags-expand-group tag-token tag-groups nil))
  11921 		   (save-match-data
  11922 		     (if (string-match "{\\(.+?\\)}" tag)
  11923 			 (push (match-string 1 tag) regexp-tags)
  11924 		       (push tag regular-tags))))
  11925 		 ;; Replace tag token by the appropriate regexp.
  11926 		 ;; Regular tags need to be regexp-quoted, whereas
  11927 		 ;; regexp-tags are inserted as-is.
  11928 		 (let ((regular (regexp-opt regular-tags))
  11929 		       (regexp (mapconcat #'identity regexp-tags "\\|")))
  11930 		   (concat operator
  11931 			   (cond
  11932 			    ((null regular-tags) (format "{%s}" regexp))
  11933 			    ((null regexp-tags) (format "{\\<%s\\>}" regular))
  11934 			    (t (format "{\\<%s\\>\\|%s}" regular regexp))))))))
  11935 	   return-match
  11936 	   t t))))
  11937      (t match))))
  11938 
  11939 (defun org-op-to-function (op &optional stringp)
  11940   "Turn an operator into the appropriate function."
  11941   (setq op
  11942 	(cond
  11943 	 ((equal  op   "<"       ) '(<     org-string<  org-time<))
  11944 	 ((equal  op   ">"       ) '(>     org-string>  org-time>))
  11945 	 ((member op '("<=" "=<")) '(<=    org-string<= org-time<=))
  11946 	 ((member op '(">=" "=>")) '(>=    org-string>= org-time>=))
  11947 	 ((member op '("="  "==")) '(=     string=      org-time=))
  11948 	 ((member op '("<>" "!=")) '(/=    org-string<> org-time<>))))
  11949   (nth (if (eq stringp 'time) 2 (if stringp 1 0)) op))
  11950 
  11951 (defvar org-add-colon-after-tag-completion nil)  ;; dynamically scoped param
  11952 (defvar org-tags-overlay (make-overlay 1 1))
  11953 (delete-overlay org-tags-overlay)
  11954 
  11955 (defun org-add-prop-inherited (s)
  11956   (add-text-properties 0 (length s) '(inherited t) s)
  11957   s)
  11958 
  11959 (defun org-toggle-tag (tag &optional onoff)
  11960   "Toggle the tag TAG for the current line.
  11961 If ONOFF is `on' or `off', don't toggle but set to this state."
  11962   (save-excursion
  11963     (org-back-to-heading t)
  11964     (let ((current
  11965 	   ;; Reverse the tags list so any new tag is appended to the
  11966 	   ;; current list of tags.
  11967 	   (nreverse (org-get-tags nil t)))
  11968 	  res)
  11969       (pcase onoff
  11970 	(`off (setq current (delete tag current)))
  11971 	((or `on (guard (not (member tag current))))
  11972 	 (setq res t)
  11973 	 (cl-pushnew tag current :test #'equal))
  11974 	(_ (setq current (delete tag current))))
  11975       (org-set-tags (nreverse current))
  11976       res)))
  11977 
  11978 (defun org--align-tags-here (to-col)
  11979   "Align tags on the current headline to TO-COL.
  11980 Assume point is on a headline.  Preserve point when aligning
  11981 tags."
  11982   (when (org-match-line org-tag-line-re)
  11983     (let* ((tags-start (match-beginning 1))
  11984 	   (blank-start (save-excursion
  11985 			  (goto-char tags-start)
  11986 			  (skip-chars-backward " \t")
  11987 			  (point)))
  11988 	   (new (max (if (>= to-col 0) to-col
  11989 		       (- (abs to-col) (string-width (match-string 1))))
  11990 		     ;; Introduce at least one space after the heading
  11991 		     ;; or the stars.
  11992 		     (save-excursion
  11993 		       (goto-char blank-start)
  11994 		       (1+ (current-column)))))
  11995 	   (current
  11996 	    (save-excursion (goto-char tags-start) (current-column)))
  11997 	   (origin (point-marker))
  11998 	   (column (current-column))
  11999 	   (in-blank? (and (> origin blank-start) (<= origin tags-start))))
  12000       (when (/= new current)
  12001 	(delete-region blank-start tags-start)
  12002 	(goto-char blank-start)
  12003 	(let ((indent-tabs-mode nil)) (indent-to new))
  12004 	;; Try to move back to original position.  If point was in the
  12005 	;; blanks before the tags, ORIGIN marker is of no use because
  12006 	;; it now points to BLANK-START.  Use COLUMN instead.
  12007 	(if in-blank? (org-move-to-column column) (goto-char origin))))))
  12008 
  12009 (defun org-set-tags-command (&optional arg)
  12010   "Set the tags for the current visible entry.
  12011 
  12012 When called with `\\[universal-argument]' prefix argument ARG, \
  12013 realign all tags
  12014 in the current buffer.
  12015 
  12016 When called with `\\[universal-argument] \\[universal-argument]' prefix argument, \
  12017 unconditionally do not
  12018 offer the fast tag selection interface.
  12019 
  12020 If a region is active, set tags in the region according to the
  12021 setting of `org-loop-over-headlines-in-active-region'.
  12022 
  12023 This function is for interactive use only;
  12024 in Lisp code use `org-set-tags' instead."
  12025   (interactive "P")
  12026   (let ((org-use-fast-tag-selection
  12027 	 (unless (equal '(16) arg) org-use-fast-tag-selection)))
  12028     (cond
  12029      ((equal '(4) arg) (org-align-tags t))
  12030      ((and (org-region-active-p) org-loop-over-headlines-in-active-region)
  12031       (let (org-loop-over-headlines-in-active-region) ;  hint: infinite recursion.
  12032 	(org-map-entries
  12033 	 #'org-set-tags-command
  12034 	 nil
  12035 	 (if (eq org-loop-over-headlines-in-active-region 'start-level)
  12036 	     'region-start-level
  12037 	   'region)
  12038 	 (lambda () (when (org-invisible-p) (org-end-of-subtree nil t))))))
  12039      (t
  12040       (save-excursion
  12041 	(org-back-to-heading)
  12042 	(let* ((all-tags (org-get-tags))
  12043 	       (table (setq org-last-tags-completion-table
  12044 			    (org--tag-add-to-alist
  12045 			     (and org-complete-tags-always-offer-all-agenda-tags
  12046 				  (org-global-tags-completion-table
  12047 				   (org-agenda-files)))
  12048 			     (or org-current-tag-alist (org-get-buffer-tags)))))
  12049 	       (current-tags
  12050 		(cl-remove-if (lambda (tag) (get-text-property 0 'inherited tag))
  12051 			      all-tags))
  12052 	       (inherited-tags
  12053 		(cl-remove-if-not (lambda (tag) (get-text-property 0 'inherited tag))
  12054 				  all-tags))
  12055 	       (tags
  12056 		(replace-regexp-in-string
  12057 		 ;; Ignore all forbidden characters in tags.
  12058 		 "[^[:alnum:]_@#%]+" ":"
  12059 		 (if (or (eq t org-use-fast-tag-selection)
  12060 			 (and org-use-fast-tag-selection
  12061 			      (delq nil (mapcar #'cdr table))))
  12062 		     (org-fast-tag-selection
  12063 		      current-tags
  12064 		      inherited-tags
  12065 		      table
  12066 		      (and org-fast-tag-selection-include-todo org-todo-key-alist))
  12067 		   (let ((org-add-colon-after-tag-completion (< 1 (length table)))
  12068                          (crm-separator "[ \t]*:[ \t]*"))
  12069 		     (mapconcat #'identity
  12070                                 (completing-read-multiple
  12071 			         "Tags: "
  12072 			         org-last-tags-completion-table
  12073 			         nil nil (org-make-tag-string current-tags)
  12074 			         'org-tags-history)
  12075                                 ":"))))))
  12076 	  (org-set-tags tags)))))
  12077     ;; `save-excursion' may not replace the point at the right
  12078     ;; position.
  12079     (when (and (save-excursion (skip-chars-backward "*") (bolp))
  12080 	       (looking-at-p " "))
  12081       (forward-char))))
  12082 
  12083 (defun org-align-tags (&optional all)
  12084   "Align tags in current entry.
  12085 When optional argument ALL is non-nil, align all tags in the
  12086 visible part of the buffer."
  12087   (let ((get-indent-column
  12088 	 (lambda ()
  12089 	   (let ((offset (if (bound-and-true-p org-indent-mode)
  12090 			     (* (1- org-indent-indentation-per-level)
  12091 				(1- (org-current-level)))
  12092 			   0)))
  12093 	     (+ org-tags-column
  12094 		(if (> org-tags-column 0) (- offset) offset))))))
  12095     (if (and (not all) (org-at-heading-p))
  12096 	(org--align-tags-here (funcall get-indent-column))
  12097       (save-excursion
  12098 	(if all
  12099 	    (progn
  12100 	      (goto-char (point-min))
  12101 	      (while (re-search-forward org-tag-line-re nil t)
  12102 		(org--align-tags-here (funcall get-indent-column))))
  12103 	  (org-back-to-heading t)
  12104 	  (org--align-tags-here (funcall get-indent-column)))))))
  12105 
  12106 (defun org-set-tags (tags)
  12107   "Set the tags of the current entry to TAGS, replacing current tags.
  12108 
  12109 TAGS may be a tags string like \":aa:bb:cc:\", or a list of tags.
  12110 If TAGS is nil or the empty string, all tags are removed.
  12111 
  12112 This function assumes point is on a headline."
  12113   (org-with-wide-buffer
  12114    (let ((tags (pcase tags
  12115 		 ((pred listp) tags)
  12116 		 ((pred stringp) (split-string (org-trim tags) ":" t))
  12117 		 (_ (error "Invalid tag specification: %S" tags))))
  12118 	 (old-tags (org-get-tags nil t))
  12119 	 (tags-change? nil))
  12120      (when (functionp org-tags-sort-function)
  12121        (setq tags (sort tags org-tags-sort-function)))
  12122      (setq tags-change? (not (equal tags old-tags)))
  12123      (when tags-change?
  12124        ;; Delete previous tags and any trailing white space.
  12125        (goto-char (if (org-match-line org-tag-line-re) (match-beginning 1)
  12126 		    (line-end-position)))
  12127        (skip-chars-backward " \t")
  12128        (delete-region (point) (line-end-position))
  12129        ;; Deleting white spaces may break an otherwise empty headline.
  12130        ;; Re-introduce one space in this case.
  12131        (unless (org-at-heading-p) (insert " "))
  12132        (when tags
  12133 	 (save-excursion (insert " " (org-make-tag-string tags)))
  12134 	 ;; When text is being inserted on an invisible region
  12135 	 ;; boundary, it can be inadvertently sucked into
  12136 	 ;; invisibility.
  12137 	 (unless (org-invisible-p (line-beginning-position))
  12138 	   (org-flag-region (point) (line-end-position) nil 'outline))))
  12139      ;; Align tags, if any.
  12140      (when tags (org-align-tags))
  12141      (when tags-change? (run-hooks 'org-after-tags-change-hook)))))
  12142 
  12143 (defun org-change-tag-in-region (beg end tag off)
  12144   "Add or remove TAG for each entry in the region.
  12145 This works in the agenda, and also in an Org buffer."
  12146   (interactive
  12147    (list (region-beginning) (region-end)
  12148 	 (let ((org-last-tags-completion-table
  12149 		(if (derived-mode-p 'org-mode)
  12150 		    (org--tag-add-to-alist
  12151 		     (org-get-buffer-tags)
  12152 		     (org-global-tags-completion-table))
  12153 		  (org-global-tags-completion-table))))
  12154 	   (completing-read
  12155 	    "Tag: " org-last-tags-completion-table nil nil nil
  12156 	    'org-tags-history))
  12157 	 (progn
  12158 	   (message "[s]et or [r]emove? ")
  12159 	   (equal (read-char-exclusive) ?r))))
  12160   (when (fboundp 'deactivate-mark) (deactivate-mark))
  12161   (let ((agendap (equal major-mode 'org-agenda-mode))
  12162 	l1 l2 m buf pos newhead (cnt 0))
  12163     (goto-char end)
  12164     (setq l2 (1- (org-current-line)))
  12165     (goto-char beg)
  12166     (setq l1 (org-current-line))
  12167     (cl-loop for l from l1 to l2 do
  12168 	     (org-goto-line l)
  12169 	     (setq m (get-text-property (point) 'org-hd-marker))
  12170 	     (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p))
  12171 		       (and agendap m))
  12172 	       (setq buf (if agendap (marker-buffer m) (current-buffer))
  12173 		     pos (if agendap m (point)))
  12174 	       (with-current-buffer buf
  12175 		 (save-excursion
  12176 		   (save-restriction
  12177 		     (goto-char pos)
  12178 		     (setq cnt (1+ cnt))
  12179 		     (org-toggle-tag tag (if off 'off 'on))
  12180 		     (setq newhead (org-get-heading)))))
  12181 	       (and agendap (org-agenda-change-all-lines newhead m))))
  12182     (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt)))
  12183 
  12184 (defun org-tags-completion-function (string _predicate &optional flag)
  12185   "Complete tag STRING.
  12186 FLAG specifies the type of completion operation to perform.  This
  12187 function is passed as a collection function to `completing-read',
  12188 which see."
  12189   (let ((completion-ignore-case nil)	;tags are case-sensitive
  12190 	(confirm (lambda (x) (stringp (car x))))
  12191 	(prefix ""))
  12192     (when (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string)
  12193       (setq prefix (match-string 1 string))
  12194       (setq string (match-string 2 string)))
  12195     (pcase flag
  12196       (`t (all-completions string org-last-tags-completion-table confirm))
  12197       (`lambda (assoc string org-last-tags-completion-table)) ;exact match?
  12198       (`nil
  12199        (pcase (try-completion string org-last-tags-completion-table confirm)
  12200 	 ((and completion (pred stringp))
  12201 	  (concat prefix
  12202 		  completion
  12203 		  (if (and org-add-colon-after-tag-completion
  12204 			   (assoc completion org-last-tags-completion-table))
  12205 		      ":"
  12206 		    "")))
  12207 	 (completion completion)))
  12208       (_ nil))))
  12209 
  12210 (defun org-fast-tag-insert (kwd tags face &optional end)
  12211   "Insert KWD, and the TAGS, the latter with face FACE.
  12212 Also insert END."
  12213   (insert (format "%-12s" (concat kwd ":"))
  12214 	  (org-add-props (mapconcat 'identity tags " ") nil 'face face)
  12215 	  (or end "")))
  12216 
  12217 (defun org-fast-tag-show-exit (flag)
  12218   (save-excursion
  12219     (org-goto-line 3)
  12220     (when (re-search-forward "[ \t]+Next change exits" (point-at-eol) t)
  12221       (replace-match ""))
  12222     (when flag
  12223       (end-of-line 1)
  12224       (org-move-to-column (- (window-width) 19) t)
  12225       (insert (org-add-props " Next change exits" nil 'face 'org-warning)))))
  12226 
  12227 (defun org-set-current-tags-overlay (current prefix)
  12228   "Add an overlay to CURRENT tag with PREFIX."
  12229   (let ((s (org-make-tag-string current)))
  12230     (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s)
  12231     (org-overlay-display org-tags-overlay (concat prefix s))))
  12232 
  12233 (defvar org-last-tag-selection-key nil)
  12234 (defun org-fast-tag-selection (current inherited table &optional todo-table)
  12235   "Fast tag selection with single keys.
  12236 CURRENT is the current list of tags in the headline, INHERITED is the
  12237 list of inherited tags, and TABLE is an alist of tags and corresponding keys,
  12238 possibly with grouping information.  TODO-TABLE is a similar table with
  12239 TODO keywords, should these have keys assigned to them.
  12240 If the keys are nil, a-z are automatically assigned.
  12241 Returns the new tags string, or nil to not change the current settings."
  12242   (let* ((fulltable (append table todo-table))
  12243 	 (maxlen (if (null fulltable) 0
  12244 		   (apply #'max
  12245 			  (mapcar (lambda (x)
  12246 				    (if (stringp (car x)) (string-width (car x))
  12247 				      0))
  12248 				  fulltable))))
  12249 	 (buf (current-buffer))
  12250 	 (expert (eq org-fast-tag-selection-single-key 'expert))
  12251 	 (tab-tags nil)
  12252 	 (fwidth (+ maxlen 3 1 3))
  12253 	 (ncol (/ (- (window-width) 4) fwidth))
  12254 	 (i-face 'org-done)
  12255 	 (c-face 'org-todo)
  12256 	 tg cnt e c char c1 c2 ntable tbl rtn
  12257 	 ov-start ov-end ov-prefix
  12258 	 (exit-after-next org-fast-tag-selection-single-key)
  12259 	 (done-keywords org-done-keywords)
  12260 	 groups ingroup intaggroup)
  12261     (save-excursion
  12262       (beginning-of-line)
  12263       (if (looking-at org-tag-line-re)
  12264 	  (setq ov-start (match-beginning 1)
  12265 		ov-end (match-end 1)
  12266 		ov-prefix "")
  12267 	(setq ov-start (1- (point-at-eol))
  12268 	      ov-end (1+ ov-start))
  12269 	(skip-chars-forward "^\n\r")
  12270 	(setq ov-prefix
  12271 	      (concat
  12272 	       (buffer-substring (1- (point)) (point))
  12273 	       (if (> (current-column) org-tags-column)
  12274 		   " "
  12275 		 (make-string (- org-tags-column (current-column)) ?\ ))))))
  12276     (move-overlay org-tags-overlay ov-start ov-end)
  12277     (save-excursion
  12278       (save-window-excursion
  12279 	(if expert
  12280 	    (set-buffer (get-buffer-create " *Org tags*"))
  12281 	  (delete-other-windows)
  12282 	  (set-window-buffer (split-window-vertically) (get-buffer-create " *Org tags*"))
  12283 	  (org-switch-to-buffer-other-window " *Org tags*"))
  12284 	(erase-buffer)
  12285 	(setq-local org-done-keywords done-keywords)
  12286 	(org-fast-tag-insert "Inherited" inherited i-face "\n")
  12287 	(org-fast-tag-insert "Current" current c-face "\n\n")
  12288 	(org-fast-tag-show-exit exit-after-next)
  12289 	(org-set-current-tags-overlay current ov-prefix)
  12290 	(setq tbl fulltable char ?a cnt 0)
  12291 	(while (setq e (pop tbl))
  12292 	  (cond
  12293 	   ((eq (car e) :startgroup)
  12294 	    (push '() groups) (setq ingroup t)
  12295 	    (unless (zerop cnt)
  12296 	      (setq cnt 0)
  12297 	      (insert "\n"))
  12298 	    (insert (if (cdr e) (format "%s: " (cdr e)) "") "{ "))
  12299 	   ((eq (car e) :endgroup)
  12300 	    (setq ingroup nil cnt 0)
  12301 	    (insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
  12302 	   ((eq (car e) :startgrouptag)
  12303 	    (setq intaggroup t)
  12304 	    (unless (zerop cnt)
  12305 	      (setq cnt 0)
  12306 	      (insert "\n"))
  12307 	    (insert "[ "))
  12308 	   ((eq (car e) :endgrouptag)
  12309 	    (setq intaggroup nil cnt 0)
  12310 	    (insert "]\n"))
  12311 	   ((equal e '(:newline))
  12312 	    (unless (zerop cnt)
  12313 	      (setq cnt 0)
  12314 	      (insert "\n")
  12315 	      (setq e (car tbl))
  12316 	      (while (equal (car tbl) '(:newline))
  12317 		(insert "\n")
  12318 		(setq tbl (cdr tbl)))))
  12319 	   ((equal e '(:grouptags)) (insert " : "))
  12320 	   (t
  12321 	    (setq tg (copy-sequence (car e)) c2 nil)
  12322 	    (if (cdr e)
  12323 		(setq c (cdr e))
  12324 	      ;; automatically assign a character.
  12325 	      (setq c1 (string-to-char
  12326 			(downcase (substring
  12327 				   tg (if (= (string-to-char tg) ?@) 1 0)))))
  12328 	      (if (or (rassoc c1 ntable) (rassoc c1 table))
  12329 		  (while (or (rassoc char ntable) (rassoc char table))
  12330 		    (setq char (1+ char)))
  12331 		(setq c2 c1))
  12332 	      (setq c (or c2 char)))
  12333 	    (when ingroup (push tg (car groups)))
  12334 	    (setq tg (org-add-props tg nil 'face
  12335 				    (cond
  12336 				     ((not (assoc tg table))
  12337 				      (org-get-todo-face tg))
  12338 				     ((member tg current) c-face)
  12339 				     ((member tg inherited) i-face))))
  12340 	    (when (equal (caar tbl) :grouptags)
  12341 	      (org-add-props tg nil 'face 'org-tag-group))
  12342 	    (when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert "  "))
  12343 	    (insert "[" c "] " tg (make-string
  12344 				   (- fwidth 4 (length tg)) ?\ ))
  12345 	    (push (cons tg c) ntable)
  12346 	    (when (= (cl-incf cnt) ncol)
  12347 	      (unless (memq (caar tbl) '(:endgroup :endgrouptag))
  12348 		(insert "\n")
  12349 		(when (or ingroup intaggroup) (insert "  ")))
  12350 	      (setq cnt 0)))))
  12351 	(setq ntable (nreverse ntable))
  12352 	(insert "\n")
  12353 	(goto-char (point-min))
  12354 	(unless expert (org-fit-window-to-buffer))
  12355 	(setq rtn
  12356 	      (catch 'exit
  12357 		(while t
  12358 		  (message "[a-z..]:toggle [SPC]:clear [RET]:accept [TAB]:edit [!] %sgroups%s"
  12359 			   (if (not groups) "no " "")
  12360 			   (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
  12361 		  (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
  12362 		  (setq org-last-tag-selection-key c)
  12363 		  (cond
  12364 		   ((= c ?\r) (throw 'exit t))
  12365 		   ((= c ?!)
  12366 		    (setq groups (not groups))
  12367 		    (goto-char (point-min))
  12368 		    (while (re-search-forward "[{}]" nil t) (replace-match " ")))
  12369 		   ((= c ?\C-c)
  12370 		    (if (not expert)
  12371 			(org-fast-tag-show-exit
  12372 			 (setq exit-after-next (not exit-after-next)))
  12373 		      (setq expert nil)
  12374 		      (delete-other-windows)
  12375 		      (set-window-buffer (split-window-vertically) " *Org tags*")
  12376 		      (org-switch-to-buffer-other-window " *Org tags*")
  12377 		      (org-fit-window-to-buffer)))
  12378 		   ((or (= c ?\C-g)
  12379 			(and (= c ?q) (not (rassoc c ntable))))
  12380 		    (delete-overlay org-tags-overlay)
  12381 		    (setq quit-flag t))
  12382 		   ((= c ?\ )
  12383 		    (setq current nil)
  12384 		    (when exit-after-next (setq exit-after-next 'now)))
  12385 		   ((= c ?\t)
  12386                     (condition-case nil
  12387                         (unless tab-tags
  12388                           (setq tab-tags
  12389                                 (delq nil
  12390                                       (mapcar (lambda (x)
  12391                                                 (let ((item (car-safe x)))
  12392                                                   (and (stringp item)
  12393                                                        (list item))))
  12394                                               (org--tag-add-to-alist
  12395                                                (with-current-buffer buf
  12396                                                  (org-get-buffer-tags))
  12397                                                table))))))
  12398                     (setq tg (completing-read "Tag: " tab-tags))
  12399 		    (when (string-match "\\S-" tg)
  12400 		      (cl-pushnew (list tg) tab-tags :test #'equal)
  12401 		      (if (member tg current)
  12402 			  (setq current (delete tg current))
  12403 			(push tg current)))
  12404 		    (when exit-after-next (setq exit-after-next 'now)))
  12405 		   ((setq e (rassoc c todo-table) tg (car e))
  12406 		    (with-current-buffer buf
  12407 		      (save-excursion (org-todo tg)))
  12408 		    (when exit-after-next (setq exit-after-next 'now)))
  12409 		   ((setq e (rassoc c ntable) tg (car e))
  12410 		    (if (member tg current)
  12411 			(setq current (delete tg current))
  12412 		      (cl-loop for g in groups do
  12413 			       (when (member tg g)
  12414 				 (dolist (x g) (setq current (delete x current)))))
  12415 		      (push tg current))
  12416 		    (when exit-after-next (setq exit-after-next 'now))))
  12417 
  12418 		  ;; Create a sorted list
  12419 		  (setq current
  12420 			(sort current
  12421 			      (lambda (a b)
  12422 				(assoc b (cdr (memq (assoc a ntable) ntable))))))
  12423 		  (when (eq exit-after-next 'now) (throw 'exit t))
  12424 		  (goto-char (point-min))
  12425 		  (beginning-of-line 2)
  12426 		  (delete-region (point) (point-at-eol))
  12427 		  (org-fast-tag-insert "Current" current c-face)
  12428 		  (org-set-current-tags-overlay current ov-prefix)
  12429 		  (let ((tag-re (concat "\\[.\\] \\(" org-tag-re "\\)")))
  12430 		    (while (re-search-forward tag-re nil t)
  12431 		      (let ((tag (match-string 1)))
  12432 			(add-text-properties
  12433 			 (match-beginning 1) (match-end 1)
  12434 			 (list 'face
  12435 			       (cond
  12436 				((member tag current) c-face)
  12437 				((member tag inherited) i-face)
  12438 				(t (get-text-property (match-beginning 1) '
  12439 						      face))))))))
  12440 		  (goto-char (point-min)))))
  12441 	(delete-overlay org-tags-overlay)
  12442 	(if rtn
  12443 	    (mapconcat 'identity current ":")
  12444 	  nil)))))
  12445 
  12446 (defun org-make-tag-string (tags)
  12447   "Return string associated to TAGS.
  12448 TAGS is a list of strings."
  12449   (if (null tags) ""
  12450     (format ":%s:" (mapconcat #'identity tags ":"))))
  12451 
  12452 (defun org--get-local-tags ()
  12453   "Return list of tags for the current headline.
  12454 Assume point is at the beginning of the headline."
  12455   (and (looking-at org-tag-line-re)
  12456        (split-string (match-string-no-properties 2) ":" t)))
  12457 
  12458 (defun org-get-tags (&optional pos local)
  12459   "Get the list of tags specified in the current headline.
  12460 
  12461 When argument POS is non-nil, retrieve tags for headline at POS.
  12462 
  12463 According to `org-use-tag-inheritance', tags may be inherited
  12464 from parent headlines, and from the whole document, through
  12465 `org-file-tags'.  In this case, the returned list of tags
  12466 contains tags in this order: file tags, tags inherited from
  12467 parent headlines, local tags.  If a tag appears multiple times,
  12468 only the most local tag is returned.
  12469 
  12470 However, when optional argument LOCAL is non-nil, only return
  12471 tags specified at the headline.
  12472 
  12473 Inherited tags have the `inherited' text property."
  12474   (if (and org-trust-scanner-tags
  12475            (or (not pos) (eq pos (point)))
  12476            (not local))
  12477       org-scanner-tags
  12478     (org-with-point-at (or pos (point))
  12479       (unless (org-before-first-heading-p)
  12480         (org-back-to-heading t)
  12481         (let ((ltags (org--get-local-tags)) itags)
  12482           (if (or local (not org-use-tag-inheritance)) ltags
  12483             (while (org-up-heading-safe)
  12484               (setq itags (nconc (mapcar #'org-add-prop-inherited
  12485 					 (org--get-local-tags))
  12486 				 itags)))
  12487             (setq itags (append org-file-tags itags))
  12488             (nreverse
  12489 	     (delete-dups
  12490 	      (nreverse (nconc (org-remove-uninherited-tags itags) ltags))))))))))
  12491 
  12492 (defun org-get-buffer-tags ()
  12493   "Get a table of all tags used in the buffer, for completion."
  12494   (org-with-point-at 1
  12495     (let (tags)
  12496       (while (re-search-forward org-tag-line-re nil t)
  12497 	(setq tags (nconc (split-string (match-string-no-properties 2) ":")
  12498 			  tags)))
  12499       (mapcar #'list (delete-dups (append org-file-tags tags))))))
  12500 
  12501 ;;;; The mapping API
  12502 
  12503 (defvar org-agenda-skip-comment-trees)
  12504 (defvar org-agenda-skip-function)
  12505 (defun org-map-entries (func &optional match scope &rest skip)
  12506   "Call FUNC at each headline selected by MATCH in SCOPE.
  12507 
  12508 FUNC is a function or a Lisp form.  The function will be called without
  12509 arguments, with the cursor positioned at the beginning of the headline.
  12510 The return values of all calls to the function will be collected and
  12511 returned as a list.
  12512 
  12513 The call to FUNC will be wrapped into a `save-excursion' form, so FUNC
  12514 does not need to preserve point.  After evaluation, the cursor will be
  12515 moved to the end of the line (presumably of the headline of the
  12516 processed entry) and search continues from there.  Under some
  12517 circumstances, this may not produce the wanted results.  For example,
  12518 if you have removed (e.g. archived) the current (sub)tree it could
  12519 mean that the next entry will be skipped entirely.  In such cases, you
  12520 can specify the position from where search should continue by making
  12521 FUNC set the variable `org-map-continue-from' to the desired buffer
  12522 position.
  12523 
  12524 MATCH is a tags/property/todo match as it is used in the agenda tags view.
  12525 Only headlines that are matched by this query will be considered during
  12526 the iteration.  When MATCH is nil or t, all headlines will be
  12527 visited by the iteration.
  12528 
  12529 SCOPE determines the scope of this command.  It can be any of:
  12530 
  12531 nil     The current buffer, respecting the restriction if any
  12532 tree    The subtree started with the entry at point
  12533 region  The entries within the active region, if any
  12534 region-start-level
  12535         The entries within the active region, but only those at
  12536         the same level than the first one.
  12537 file    The current buffer, without restriction
  12538 file-with-archives
  12539         The current buffer, and any archives associated with it
  12540 agenda  All agenda files
  12541 agenda-with-archives
  12542         All agenda files with any archive files associated with them
  12543 \(file1 file2 ...)
  12544         If this is a list, all files in the list will be scanned
  12545 
  12546 The remaining args are treated as settings for the skipping facilities of
  12547 the scanner.  The following items can be given here:
  12548 
  12549   archive    skip trees with the archive tag
  12550   comment    skip trees with the COMMENT keyword
  12551   function or Emacs Lisp form:
  12552              will be used as value for `org-agenda-skip-function', so
  12553              whenever the function returns a position, FUNC will not be
  12554              called for that entry and search will continue from the
  12555              position returned
  12556 
  12557 If your function needs to retrieve the tags including inherited tags
  12558 at the *current* entry, you can use the value of the variable
  12559 `org-scanner-tags' which will be much faster than getting the value
  12560 with `org-get-tags'.  If your function gets properties with
  12561 `org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags'
  12562 to t around the call to `org-entry-properties' to get the same speedup.
  12563 Note that if your function moves around to retrieve tags and properties at
  12564 a *different* entry, you cannot use these techniques."
  12565   (unless (and (or (eq scope 'region) (eq scope 'region-start-level))
  12566 	       (not (org-region-active-p)))
  12567     (let* ((org-agenda-archives-mode nil) ; just to make sure
  12568 	   (org-agenda-skip-archived-trees (memq 'archive skip))
  12569 	   (org-agenda-skip-comment-trees (memq 'comment skip))
  12570 	   (org-agenda-skip-function
  12571 	    (car (org-delete-all '(comment archive) skip)))
  12572 	   (org-tags-match-list-sublevels t)
  12573 	   (start-level (eq scope 'region-start-level))
  12574 	   matcher res
  12575 	   org-todo-keywords-for-agenda
  12576 	   org-done-keywords-for-agenda
  12577 	   org-todo-keyword-alist-for-agenda
  12578 	   org-tag-alist-for-agenda
  12579 	   org--matcher-tags-todo-only)
  12580 
  12581       (cond
  12582        ((eq match t)   (setq matcher t))
  12583        ((eq match nil) (setq matcher t))
  12584        (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
  12585 
  12586       (save-excursion
  12587 	(save-restriction
  12588 	  (cond ((eq scope 'tree)
  12589 		 (org-back-to-heading t)
  12590 		 (org-narrow-to-subtree)
  12591 		 (setq scope nil))
  12592 		((and (or (eq scope 'region) (eq scope 'region-start-level))
  12593 		      (org-region-active-p))
  12594 		 ;; If needed, set start-level to a string like "2"
  12595 		 (when start-level
  12596 		   (save-excursion
  12597 		     (goto-char (region-beginning))
  12598 		     (unless (org-at-heading-p) (outline-next-heading))
  12599 		     (setq start-level (org-current-level))))
  12600 		 (narrow-to-region (region-beginning)
  12601 				   (save-excursion
  12602 				     (goto-char (region-end))
  12603 				     (unless (and (bolp) (org-at-heading-p))
  12604 				       (outline-next-heading))
  12605 				     (point)))
  12606 		 (setq scope nil)))
  12607 
  12608 	  (if (not scope)
  12609 	      (progn
  12610 		(org-agenda-prepare-buffers
  12611 		 (and buffer-file-name (list buffer-file-name)))
  12612 		(setq res
  12613 		      (org-scan-tags
  12614 		       func matcher org--matcher-tags-todo-only start-level)))
  12615 	    ;; Get the right scope
  12616 	    (cond
  12617 	     ((and scope (listp scope) (symbolp (car scope)))
  12618 	      (setq scope (eval scope)))
  12619 	     ((eq scope 'agenda)
  12620 	      (setq scope (org-agenda-files t)))
  12621 	     ((eq scope 'agenda-with-archives)
  12622 	      (setq scope (org-agenda-files t))
  12623 	      (setq scope (org-add-archive-files scope)))
  12624 	     ((eq scope 'file)
  12625 	      (setq scope (and buffer-file-name (list buffer-file-name))))
  12626 	     ((eq scope 'file-with-archives)
  12627 	      (setq scope (org-add-archive-files (list (buffer-file-name))))))
  12628 	    (org-agenda-prepare-buffers scope)
  12629 	    (dolist (file scope)
  12630 	      (with-current-buffer (org-find-base-buffer-visiting file)
  12631 		(org-with-wide-buffer
  12632 		 (goto-char (point-min))
  12633 		 (setq res
  12634 		       (append
  12635 			res
  12636 			(org-scan-tags
  12637 			 func matcher org--matcher-tags-todo-only)))))))))
  12638       res)))
  12639 
  12640 ;;; Properties API
  12641 
  12642 (defconst org-special-properties
  12643   '("ALLTAGS" "BLOCKED" "CLOCKSUM" "CLOCKSUM_T" "CLOSED" "DEADLINE" "FILE"
  12644     "ITEM" "PRIORITY" "SCHEDULED" "TAGS" "TIMESTAMP" "TIMESTAMP_IA" "TODO")
  12645   "The special properties valid in Org mode.
  12646 These are properties that are not defined in the property drawer,
  12647 but in some other way.")
  12648 
  12649 (defconst org-default-properties
  12650   '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" "CUSTOM_ID"
  12651     "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY"
  12652     "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE"
  12653     "EXPORT_OPTIONS" "EXPORT_TEXT" "EXPORT_FILE_NAME"
  12654     "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" "UNNUMBERED"
  12655     "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE"
  12656     "CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS")
  12657   "Some properties that are used by Org mode for various purposes.
  12658 Being in this list makes sure that they are offered for completion.")
  12659 
  12660 (defun org--valid-property-p (property)
  12661   "Non-nil when string PROPERTY is a valid property name."
  12662   (not
  12663    (or (equal property "")
  12664        (string-match-p "\\s-" property))))
  12665 
  12666 (defun org--update-property-plist (key val props)
  12667   "Associate KEY to VAL in alist PROPS.
  12668 Modifications are made by side-effect.  Return new alist."
  12669   (let* ((appending (string= (substring key -1) "+"))
  12670 	 (key (if appending (substring key 0 -1) key))
  12671 	 (old (assoc-string key props t)))
  12672     (if (not old) (cons (cons key val) props)
  12673       (setcdr old (if appending (concat (cdr old) " " val) val))
  12674       props)))
  12675 
  12676 (defun org-get-property-block (&optional beg force)
  12677   "Return the (beg . end) range of the body of the property drawer.
  12678 BEG is the beginning of the current subtree or the beginning of
  12679 the document if before the first headline.  If it is not given,
  12680 it will be found.  If the drawer does not exist, create it if
  12681 FORCE is non-nil, or return nil."
  12682   (org-with-wide-buffer
  12683    (let ((beg (cond (beg (goto-char beg))
  12684 		    ((or (not (featurep 'org-inlinetask))
  12685 			 (org-inlinetask-in-task-p))
  12686 		     (org-back-to-heading-or-point-min t) (point))
  12687 		    (t (org-with-limited-levels
  12688 			(org-back-to-heading-or-point-min t))
  12689 		       (point)))))
  12690      ;; Move point to its position according to its positional rules.
  12691      (cond ((org-before-first-heading-p)
  12692 	    (while (and (org-at-comment-p) (bolp)) (forward-line)))
  12693 	   (t (forward-line)
  12694 	      (when (looking-at-p org-planning-line-re) (forward-line))))
  12695      (cond ((looking-at org-property-drawer-re)
  12696 	    (forward-line)
  12697 	    (cons (point) (progn (goto-char (match-end 0))
  12698 				 (line-beginning-position))))
  12699 	   (force
  12700 	    (goto-char beg)
  12701 	    (org-insert-property-drawer)
  12702 	    (let ((pos (save-excursion (re-search-forward org-property-drawer-re)
  12703 				       (line-beginning-position))))
  12704 	      (cons pos pos)))))))
  12705 
  12706 (defun org-at-property-drawer-p ()
  12707   "Non-nil when point is at the first line of a property drawer."
  12708   (org-with-wide-buffer
  12709    (beginning-of-line)
  12710    (and (looking-at org-property-drawer-re)
  12711 	(or (bobp)
  12712 	    (progn
  12713 	      (forward-line -1)
  12714 	      (cond ((org-at-heading-p))
  12715 		    ((looking-at org-planning-line-re)
  12716 		     (forward-line -1)
  12717 		     (org-at-heading-p))
  12718 		    ((looking-at org-comment-regexp)
  12719 		     (forward-line -1)
  12720 		     (while (and (not (bobp)) (looking-at org-comment-regexp))
  12721 		       (forward-line -1))
  12722 		     (looking-at org-comment-regexp))
  12723 		    (t nil)))))))
  12724 
  12725 (defun org-at-property-p ()
  12726   "Non-nil when point is inside a property drawer.
  12727 See `org-property-re' for match data, if applicable."
  12728   (save-excursion
  12729     (beginning-of-line)
  12730     (and (looking-at org-property-re)
  12731 	 (let ((property-drawer (save-match-data (org-get-property-block))))
  12732 	   (and property-drawer
  12733 		(>= (point) (car property-drawer))
  12734 		(< (point) (cdr property-drawer)))))))
  12735 
  12736 (defun org-property-action ()
  12737   "Do an action on properties."
  12738   (interactive)
  12739   (message "Property Action:  [s]et  [d]elete  [D]elete globally  [c]ompute")
  12740   (let ((c (read-char-exclusive)))
  12741     (cl-case c
  12742       (?s (call-interactively #'org-set-property))
  12743       (?d (call-interactively #'org-delete-property))
  12744       (?D (call-interactively #'org-delete-property-globally))
  12745       (?c (call-interactively #'org-compute-property-at-point))
  12746       (otherwise (user-error "No such property action %c" c)))))
  12747 
  12748 (defun org-inc-effort ()
  12749   "Increment the value of the effort property in the current entry."
  12750   (interactive)
  12751   (org-set-effort t))
  12752 
  12753 (defvar org-clock-effort)       ; Defined in org-clock.el.
  12754 (defvar org-clock-current-task) ; Defined in org-clock.el.
  12755 (defun org-set-effort (&optional increment value)
  12756   "Set the effort property of the current entry.
  12757 If INCREMENT is non-nil, set the property to the next allowed
  12758 value.  Otherwise, if optional argument VALUE is provided, use
  12759 it.  Eventually, prompt for the new value if none of the previous
  12760 variables is set."
  12761   (interactive "P")
  12762   (let* ((allowed (org-property-get-allowed-values nil org-effort-property t))
  12763 	 (current (org-entry-get nil org-effort-property))
  12764 	 (value
  12765 	  (cond
  12766 	   (increment
  12767 	    (unless allowed (user-error "Allowed effort values are not set"))
  12768 	    (or (cl-caadr (member (list current) allowed))
  12769 		(user-error "Unknown value %S among allowed values" current)))
  12770 	   (value
  12771 	    (if (stringp value) value
  12772 	      (error "Invalid effort value: %S" value)))
  12773 	   (t
  12774 	    (let ((must-match
  12775 		   (and allowed
  12776 			(not (get-text-property 0 'org-unrestricted
  12777 						(caar allowed))))))
  12778 	      (completing-read "Effort: " allowed nil must-match))))))
  12779     ;; Test whether the value can be interpreted as a duration before
  12780     ;; inserting it in the buffer:
  12781     (org-duration-to-minutes value)
  12782     ;; Maybe update the effort value:
  12783     (unless (equal current value)
  12784       (org-entry-put nil org-effort-property value))
  12785     (org-refresh-property '((effort . identity)
  12786 			    (effort-minutes . org-duration-to-minutes))
  12787 			  value)
  12788     (when (equal (org-get-heading t t t t)
  12789 		 (bound-and-true-p org-clock-current-task))
  12790       (setq org-clock-effort value)
  12791       (org-clock-update-mode-line))
  12792     (message "%s is now %s" org-effort-property value)))
  12793 
  12794 (defun org-entry-properties (&optional pom which)
  12795   "Get all properties of the current entry.
  12796 
  12797 When POM is a buffer position, get all properties from the entry
  12798 there instead.
  12799 
  12800 This includes the TODO keyword, the tags, time strings for
  12801 deadline, scheduled, and clocking, and any additional properties
  12802 defined in the entry.
  12803 
  12804 If WHICH is nil or `all', get all properties.  If WHICH is
  12805 `special' or `standard', only get that subclass.  If WHICH is
  12806 a string, only get that property.
  12807 
  12808 Return value is an alist.  Keys are properties, as upcased
  12809 strings."
  12810   (org-with-point-at pom
  12811     (when (and (derived-mode-p 'org-mode)
  12812 	       (org-back-to-heading-or-point-min t))
  12813       (catch 'exit
  12814 	(let* ((beg (point))
  12815 	       (specific (and (stringp which) (upcase which)))
  12816 	       (which (cond ((not specific) which)
  12817 			    ((member specific org-special-properties) 'special)
  12818 			    (t 'standard)))
  12819 	       props)
  12820 	  ;; Get the special properties, like TODO and TAGS.
  12821 	  (when (memq which '(nil all special))
  12822 	    (when (or (not specific) (string= specific "CLOCKSUM"))
  12823 	      (let ((clocksum (get-text-property (point) :org-clock-minutes)))
  12824 		(when clocksum
  12825 		  (push (cons "CLOCKSUM" (org-duration-from-minutes clocksum))
  12826 			props)))
  12827 	      (when specific (throw 'exit props)))
  12828 	    (when (or (not specific) (string= specific "CLOCKSUM_T"))
  12829 	      (let ((clocksumt (get-text-property (point)
  12830 						  :org-clock-minutes-today)))
  12831 		(when clocksumt
  12832 		  (push (cons "CLOCKSUM_T"
  12833 			      (org-duration-from-minutes clocksumt))
  12834 			props)))
  12835 	      (when specific (throw 'exit props)))
  12836 	    (when (or (not specific) (string= specific "ITEM"))
  12837 	      (let ((case-fold-search nil))
  12838 		(when (looking-at org-complex-heading-regexp)
  12839 		  (push (cons "ITEM"
  12840 			      (let ((title (match-string-no-properties 4)))
  12841 				(if (org-string-nw-p title)
  12842 				    (org-remove-tabs title)
  12843 				  "")))
  12844 			props)))
  12845 	      (when specific (throw 'exit props)))
  12846 	    (when (or (not specific) (string= specific "TODO"))
  12847 	      (let ((case-fold-search nil))
  12848 		(when (and (looking-at org-todo-line-regexp) (match-end 2))
  12849 		  (push (cons "TODO" (match-string-no-properties 2)) props)))
  12850 	      (when specific (throw 'exit props)))
  12851 	    (when (or (not specific) (string= specific "PRIORITY"))
  12852 	      (push (cons "PRIORITY"
  12853 			  (if (looking-at org-priority-regexp)
  12854 			      (match-string-no-properties 2)
  12855 			    (char-to-string org-priority-default)))
  12856 		    props)
  12857 	      (when specific (throw 'exit props)))
  12858 	    (when (or (not specific) (string= specific "FILE"))
  12859 	      (push (cons "FILE" (buffer-file-name (buffer-base-buffer)))
  12860 		    props)
  12861 	      (when specific (throw 'exit props)))
  12862 	    (when (or (not specific) (string= specific "TAGS"))
  12863 	      (let ((tags (org-get-tags nil t)))
  12864 		(when tags
  12865 		  (push (cons "TAGS" (org-make-tag-string tags))
  12866 			props)))
  12867 	      (when specific (throw 'exit props)))
  12868 	    (when (or (not specific) (string= specific "ALLTAGS"))
  12869 	      (let ((tags (org-get-tags)))
  12870 		(when tags
  12871 		  (push (cons "ALLTAGS" (org-make-tag-string tags))
  12872 			props)))
  12873 	      (when specific (throw 'exit props)))
  12874 	    (when (or (not specific) (string= specific "BLOCKED"))
  12875 	      (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)
  12876 	      (when specific (throw 'exit props)))
  12877 	    (when (or (not specific)
  12878 		      (member specific '("CLOSED" "DEADLINE" "SCHEDULED")))
  12879 	      (forward-line)
  12880 	      (when (looking-at-p org-planning-line-re)
  12881 		(end-of-line)
  12882 		(let ((bol (line-beginning-position))
  12883 		      ;; Backward compatibility: time keywords used to
  12884 		      ;; be configurable (before 8.3).  Make sure we
  12885 		      ;; get the correct keyword.
  12886 		      (key-assoc `(("CLOSED" . ,org-closed-string)
  12887 				   ("DEADLINE" . ,org-deadline-string)
  12888 				   ("SCHEDULED" . ,org-scheduled-string))))
  12889 		  (dolist (pair (if specific (list (assoc specific key-assoc))
  12890 				  key-assoc))
  12891 		    (save-excursion
  12892 		      (when (search-backward (cdr pair) bol t)
  12893 			(goto-char (match-end 0))
  12894 			(skip-chars-forward " \t")
  12895 			(and (looking-at org-ts-regexp-both)
  12896 			     (push (cons (car pair)
  12897 					 (match-string-no-properties 0))
  12898 				   props)))))))
  12899 	      (when specific (throw 'exit props)))
  12900 	    (when (or (not specific)
  12901 		      (member specific '("TIMESTAMP" "TIMESTAMP_IA")))
  12902 	      (let ((find-ts
  12903 		     (lambda (end ts)
  12904 		       ;; Fix next time-stamp before END.  TS is the
  12905 		       ;; list of time-stamps found so far.
  12906 		       (let ((ts ts)
  12907 			     (regexp (cond
  12908 				      ((string= specific "TIMESTAMP")
  12909 				       org-ts-regexp)
  12910 				      ((string= specific "TIMESTAMP_IA")
  12911 				       org-ts-regexp-inactive)
  12912 				      ((assoc "TIMESTAMP_IA" ts)
  12913 				       org-ts-regexp)
  12914 				      ((assoc "TIMESTAMP" ts)
  12915 				       org-ts-regexp-inactive)
  12916 				      (t org-ts-regexp-both))))
  12917 			 (catch 'next
  12918 			   (while (re-search-forward regexp end t)
  12919 			     (backward-char)
  12920 			     (let ((object (org-element-context)))
  12921 			       ;; Accept to match timestamps in node
  12922 			       ;; properties, too.
  12923 			       (when (memq (org-element-type object)
  12924 					   '(node-property timestamp))
  12925 				 (let ((type
  12926 					(org-element-property :type object)))
  12927 				   (cond
  12928 				    ((and (memq type '(active active-range))
  12929 					  (not (equal specific "TIMESTAMP_IA")))
  12930 				     (unless (assoc "TIMESTAMP" ts)
  12931 				       (push (cons "TIMESTAMP"
  12932 						   (org-element-property
  12933 						    :raw-value object))
  12934 					     ts)
  12935 				       (when specific (throw 'exit ts))))
  12936 				    ((and (memq type '(inactive inactive-range))
  12937 					  (not (string= specific "TIMESTAMP")))
  12938 				     (unless (assoc "TIMESTAMP_IA" ts)
  12939 				       (push (cons "TIMESTAMP_IA"
  12940 						   (org-element-property
  12941 						    :raw-value object))
  12942 					     ts)
  12943 				       (when specific (throw 'exit ts))))))
  12944 				 ;; Both timestamp types are found,
  12945 				 ;; move to next part.
  12946 				 (when (= (length ts) 2) (throw 'next ts)))))
  12947 			   ts)))))
  12948 		(goto-char beg)
  12949 		;; First look for timestamps within headline.
  12950 		(let ((ts (funcall find-ts (line-end-position) nil)))
  12951 		  (if (= (length ts) 2) (setq props (nconc ts props))
  12952 		    ;; Then find timestamps in the section, skipping
  12953 		    ;; planning line.
  12954 		    (let ((end (save-excursion (outline-next-heading))))
  12955 		      (forward-line)
  12956 		      (when (looking-at-p org-planning-line-re) (forward-line))
  12957 		      (setq props (nconc (funcall find-ts end ts) props))))))))
  12958 	  ;; Get the standard properties, like :PROP:.
  12959 	  (when (memq which '(nil all standard))
  12960 	    ;; If we are looking after a specific property, delegate
  12961 	    ;; to `org-entry-get', which is faster.  However, make an
  12962 	    ;; exception for "CATEGORY", since it can be also set
  12963 	    ;; through keywords (i.e. #+CATEGORY).
  12964 	    (if (and specific (not (equal specific "CATEGORY")))
  12965 		(let ((value (org-entry-get beg specific nil t)))
  12966 		  (throw 'exit (and value (list (cons specific value)))))
  12967 	      (let ((range (org-get-property-block beg)))
  12968 		(when range
  12969 		  (let ((end (cdr range)) seen-base)
  12970 		    (goto-char (car range))
  12971 		    ;; Unlike to `org--update-property-plist', we
  12972 		    ;; handle the case where base values is found
  12973 		    ;; after its extension.  We also forbid standard
  12974 		    ;; properties to be named as special properties.
  12975 		    (while (re-search-forward org-property-re end t)
  12976 		      (let* ((key (upcase (match-string-no-properties 2)))
  12977 			     (extendp (string-match-p "\\+\\'" key))
  12978 			     (key-base (if extendp (substring key 0 -1) key))
  12979 			     (value (match-string-no-properties 3)))
  12980 			(cond
  12981 			 ((member-ignore-case key-base org-special-properties))
  12982 			 (extendp
  12983 			  (setq props
  12984 				(org--update-property-plist key value props)))
  12985 			 ((member key seen-base))
  12986 			 (t (push key seen-base)
  12987 			    (let ((p (assoc-string key props t)))
  12988 			      (if p (setcdr p (concat value " " (cdr p)))
  12989 				(push (cons key value) props))))))))))))
  12990 	  (unless (assoc "CATEGORY" props)
  12991 	    (push (cons "CATEGORY" (org-get-category beg)) props)
  12992 	    (when (string= specific "CATEGORY") (throw 'exit props)))
  12993 	  ;; Return value.
  12994 	  props)))))
  12995 
  12996 (defun org--property-local-values (property literal-nil)
  12997   "Return value for PROPERTY in current entry.
  12998 Value is a list whose car is the base value for PROPERTY and cdr
  12999 a list of accumulated values.  Return nil if neither is found in
  13000 the entry.  Also return nil when PROPERTY is set to \"nil\",
  13001 unless LITERAL-NIL is non-nil."
  13002   (let ((range (org-get-property-block)))
  13003     (when range
  13004       (goto-char (car range))
  13005       (let* ((case-fold-search t)
  13006 	     (end (cdr range))
  13007 	     (value
  13008 	      ;; Base value.
  13009 	      (save-excursion
  13010 		(let ((v (and (re-search-forward
  13011 			       (org-re-property property nil t) end t)
  13012 			      (match-string-no-properties 3))))
  13013 		  (list (if literal-nil v (org-not-nil v)))))))
  13014 	;; Find additional values.
  13015 	(let* ((property+ (org-re-property (concat property "+") nil t)))
  13016 	  (while (re-search-forward property+ end t)
  13017 	    (push (match-string-no-properties 3) value)))
  13018 	;; Return final values.
  13019 	(and (not (equal value '(nil))) (nreverse value))))))
  13020 
  13021 (defun org--property-global-or-keyword-value (property literal-nil)
  13022   "Return value for PROPERTY as defined by global properties or by keyword.
  13023 Return value is a string.  Return nil if property is not set
  13024 globally or by keyword.  Also return nil when PROPERTY is set to
  13025 \"nil\", unless LITERAL-NIL is non-nil."
  13026   (let ((global
  13027 	 (cdr (or (assoc-string property org-keyword-properties t)
  13028 		  (assoc-string property org-global-properties t)
  13029 		  (assoc-string property org-global-properties-fixed t)))))
  13030     (if literal-nil global (org-not-nil global))))
  13031 
  13032 (defun org-entry-get (pom property &optional inherit literal-nil)
  13033   "Get value of PROPERTY for entry or content at point-or-marker POM.
  13034 
  13035 If INHERIT is non-nil and the entry does not have the property,
  13036 then also check higher levels of the hierarchy.  If INHERIT is
  13037 the symbol `selective', use inheritance only if the setting in
  13038 `org-use-property-inheritance' selects PROPERTY for inheritance.
  13039 
  13040 If the property is present but empty, the return value is the
  13041 empty string.  If the property is not present at all, nil is
  13042 returned.  In any other case, return the value as a string.
  13043 Search is case-insensitive.
  13044 
  13045 If LITERAL-NIL is set, return the string value \"nil\" as
  13046 a string, do not interpret it as the list atom nil.  This is used
  13047 for inheritance when a \"nil\" value can supersede a non-nil
  13048 value higher up the hierarchy."
  13049   (org-with-point-at pom
  13050     (cond
  13051      ((member-ignore-case property (cons "CATEGORY" org-special-properties))
  13052       ;; We need a special property.  Use `org-entry-properties' to
  13053       ;; retrieve it, but specify the wanted property.
  13054       (cdr (assoc-string property (org-entry-properties nil property))))
  13055      ((and inherit
  13056 	   (or (not (eq inherit 'selective)) (org-property-inherit-p property)))
  13057       (org-entry-get-with-inheritance property literal-nil))
  13058      (t
  13059       (let* ((local (org--property-local-values property literal-nil))
  13060 	     (value (and local (mapconcat #'identity (delq nil local) " "))))
  13061 	(if literal-nil value (org-not-nil value)))))))
  13062 
  13063 (defun org-property-or-variable-value (var &optional inherit)
  13064   "Check if there is a property fixing the value of VAR.
  13065 If yes, return this value.  If not, return the current value of the variable."
  13066   (let ((prop (org-entry-get nil (symbol-name var) inherit)))
  13067     (if (and prop (stringp prop) (string-match "\\S-" prop))
  13068 	(read prop)
  13069       (symbol-value var))))
  13070 
  13071 (defun org-entry-delete (pom property)
  13072   "Delete PROPERTY from entry at point-or-marker POM.
  13073 Accumulated properties, i.e. PROPERTY+, are also removed.  Return
  13074 non-nil when a property was removed."
  13075   (org-with-point-at pom
  13076     (pcase (org-get-property-block)
  13077       (`(,begin . ,origin)
  13078        (let* ((end (copy-marker origin))
  13079 	      (re (org-re-property
  13080 		   (concat (regexp-quote property) "\\+?") t t)))
  13081 	 (goto-char begin)
  13082 	 (while (re-search-forward re end t)
  13083 	   (delete-region (match-beginning 0) (line-beginning-position 2)))
  13084 	 ;; If drawer is empty, remove it altogether.
  13085 	 (when (= begin end)
  13086 	   (delete-region (line-beginning-position 0)
  13087 			  (line-beginning-position 2)))
  13088 	 ;; Return non-nil if some property was removed.
  13089 	 (prog1 (/= end origin) (set-marker end nil))))
  13090       (_ nil))))
  13091 
  13092 ;; Multi-values properties are properties that contain multiple values
  13093 ;; These values are assumed to be single words, separated by whitespace.
  13094 (defun org-entry-add-to-multivalued-property (pom property value)
  13095   "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM."
  13096   (let* ((old (org-entry-get pom property))
  13097 	 (values (and old (split-string old))))
  13098     (setq value (org-entry-protect-space value))
  13099     (unless (member value values)
  13100       (setq values (append values (list value)))
  13101       (org-entry-put pom property (mapconcat #'identity values " ")))))
  13102 
  13103 (defun org-entry-remove-from-multivalued-property (pom property value)
  13104   "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM."
  13105   (let* ((old (org-entry-get pom property))
  13106 	 (values (and old (split-string old))))
  13107     (setq value (org-entry-protect-space value))
  13108     (when (member value values)
  13109       (setq values (delete value values))
  13110       (org-entry-put pom property (mapconcat #'identity values " ")))))
  13111 
  13112 (defun org-entry-member-in-multivalued-property (pom property value)
  13113   "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?"
  13114   (let* ((old (org-entry-get pom property))
  13115 	 (values (and old (split-string old))))
  13116     (setq value (org-entry-protect-space value))
  13117     (member value values)))
  13118 
  13119 (defun org-entry-get-multivalued-property (pom property)
  13120   "Return a list of values in a multivalued property."
  13121   (let* ((value (org-entry-get pom property))
  13122 	 (values (and value (split-string value))))
  13123     (mapcar #'org-entry-restore-space values)))
  13124 
  13125 (defun org-entry-put-multivalued-property (pom property &rest values)
  13126   "Set multivalued PROPERTY at point-or-marker POM to VALUES.
  13127 VALUES should be a list of strings.  Spaces will be protected."
  13128   (org-entry-put pom property (mapconcat #'org-entry-protect-space values " "))
  13129   (let* ((value (org-entry-get pom property))
  13130 	 (values (and value (split-string value))))
  13131     (mapcar #'org-entry-restore-space values)))
  13132 
  13133 (defun org-entry-protect-space (s)
  13134   "Protect spaces and newline in string S."
  13135   (while (string-match " " s)
  13136     (setq s (replace-match "%20" t t s)))
  13137   (while (string-match "\n" s)
  13138     (setq s (replace-match "%0A" t t s)))
  13139   s)
  13140 
  13141 (defun org-entry-restore-space (s)
  13142   "Restore spaces and newline in string S."
  13143   (while (string-match "%20" s)
  13144     (setq s (replace-match " " t t s)))
  13145   (while (string-match "%0A" s)
  13146     (setq s (replace-match "\n" t t s)))
  13147   s)
  13148 
  13149 (defvar org-entry-property-inherited-from (make-marker)
  13150   "Marker pointing to the entry from where a property was inherited.
  13151 Each call to `org-entry-get-with-inheritance' will set this marker to the
  13152 location of the entry where the inheritance search matched.  If there was
  13153 no match, the marker will point nowhere.
  13154 Note that also `org-entry-get' calls this function, if the INHERIT flag
  13155 is set.")
  13156 
  13157 (defun org-entry-get-with-inheritance (property &optional literal-nil)
  13158   "Get PROPERTY of entry or content at point, search higher levels if needed.
  13159 The search will stop at the first ancestor which has the property defined.
  13160 If the value found is \"nil\", return nil to show that the property
  13161 should be considered as undefined (this is the meaning of nil here).
  13162 However, if LITERAL-NIL is set, return the string value \"nil\" instead."
  13163   (move-marker org-entry-property-inherited-from nil)
  13164   (org-with-wide-buffer
  13165    (let (value)
  13166      (catch 'exit
  13167        (while t
  13168 	 (let ((v (org--property-local-values property literal-nil)))
  13169 	   (when v
  13170 	     (setq value
  13171 		   (concat (mapconcat #'identity (delq nil v) " ")
  13172 			   (and value " ")
  13173 			   value)))
  13174 	   (cond
  13175 	    ((car v)
  13176 	     (org-back-to-heading-or-point-min t)
  13177 	     (move-marker org-entry-property-inherited-from (point))
  13178 	     (throw 'exit nil))
  13179 	    ((org-up-heading-or-point-min))
  13180 	    (t
  13181 	     (let ((global (org--property-global-or-keyword-value property literal-nil)))
  13182 	       (cond ((not global))
  13183 		     (value (setq value (concat global " " value)))
  13184 		     (t (setq value global))))
  13185 	     (throw 'exit nil))))))
  13186      (if literal-nil value (org-not-nil value)))))
  13187 
  13188 (defvar org-property-changed-functions nil
  13189   "Hook called when the value of a property has changed.
  13190 Each hook function should accept two arguments, the name of the property
  13191 and the new value.")
  13192 
  13193 (defun org-entry-put (pom property value)
  13194   "Set PROPERTY to VALUE for entry at point-or-marker POM.
  13195 
  13196 If the value is nil, it is converted to the empty string.  If it
  13197 is not a string, an error is raised.  Also raise an error on
  13198 invalid property names.
  13199 
  13200 PROPERTY can be any regular property (see
  13201 `org-special-properties').  It can also be \"TODO\",
  13202 \"PRIORITY\", \"SCHEDULED\" and \"DEADLINE\".
  13203 
  13204 For the last two properties, VALUE may have any of the special
  13205 values \"earlier\" and \"later\".  The function then increases or
  13206 decreases scheduled or deadline date by one day."
  13207   (cond ((null value) (setq value ""))
  13208 	((not (stringp value)) (error "Properties values should be strings"))
  13209 	((not (org--valid-property-p property))
  13210 	 (user-error "Invalid property name: \"%s\"" property)))
  13211   (org-no-read-only
  13212    (org-with-point-at pom
  13213      (if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p))
  13214 	 (org-back-to-heading-or-point-min t)
  13215        (org-with-limited-levels (org-back-to-heading-or-point-min t)))
  13216      (let ((beg (point)))
  13217        (cond
  13218         ((equal property "TODO")
  13219 	 (cond ((not (org-string-nw-p value)) (setq value 'none))
  13220 	       ((not (member value org-todo-keywords-1))
  13221 	        (user-error "\"%s\" is not a valid TODO state" value)))
  13222 	 (org-todo value)
  13223 	 (org-align-tags))
  13224         ((equal property "PRIORITY")
  13225 	 (org-priority (if (org-string-nw-p value) (string-to-char value) ?\s))
  13226 	 (org-align-tags))
  13227         ((equal property "SCHEDULED")
  13228 	 (forward-line)
  13229 	 (if (and (looking-at-p org-planning-line-re)
  13230 		  (re-search-forward
  13231 		   org-scheduled-time-regexp (line-end-position) t))
  13232 	     (cond ((string= value "earlier") (org-timestamp-change -1 'day))
  13233 		   ((string= value "later") (org-timestamp-change 1 'day))
  13234 		   ((string= value "") (org-schedule '(4)))
  13235 		   (t (org-schedule nil value)))
  13236 	   (if (member value '("earlier" "later" ""))
  13237 	       (call-interactively #'org-schedule)
  13238 	     (org-schedule nil value))))
  13239         ((equal property "DEADLINE")
  13240 	 (forward-line)
  13241 	 (if (and (looking-at-p org-planning-line-re)
  13242 		  (re-search-forward
  13243 		   org-deadline-time-regexp (line-end-position) t))
  13244 	     (cond ((string= value "earlier") (org-timestamp-change -1 'day))
  13245 		   ((string= value "later") (org-timestamp-change 1 'day))
  13246 		   ((string= value "") (org-deadline '(4)))
  13247 		   (t (org-deadline nil value)))
  13248 	   (if (member value '("earlier" "later" ""))
  13249 	       (call-interactively #'org-deadline)
  13250 	     (org-deadline nil value))))
  13251         ((member property org-special-properties)
  13252 	 (error "The %s property cannot be set with `org-entry-put'" property))
  13253         (t
  13254 	 (let* ((range (org-get-property-block beg 'force))
  13255 	        (end (cdr range))
  13256 	        (case-fold-search t))
  13257 	   (goto-char (car range))
  13258 	   (if (re-search-forward (org-re-property property nil t) end t)
  13259 	       (progn (delete-region (match-beginning 0) (match-end 0))
  13260 		      (goto-char (match-beginning 0)))
  13261 	     (goto-char end)
  13262 	     (insert "\n")
  13263 	     (backward-char))
  13264 	   (insert ":" property ":")
  13265 	   (when value (insert " " value))
  13266 	   (org-indent-line)))))
  13267      (run-hook-with-args 'org-property-changed-functions property value))))
  13268 
  13269 (defun org-buffer-property-keys (&optional specials defaults columns)
  13270   "Get all property keys in the current buffer.
  13271 
  13272 When SPECIALS is non-nil, also list the special properties that
  13273 reflect things like tags and TODO state.
  13274 
  13275 When DEFAULTS is non-nil, also include properties that has
  13276 special meaning internally: ARCHIVE, CATEGORY, SUMMARY,
  13277 DESCRIPTION, LOCATION, and LOGGING and others.
  13278 
  13279 When COLUMNS in non-nil, also include property names given in
  13280 COLUMN formats in the current buffer."
  13281   (let ((case-fold-search t)
  13282 	(props (append
  13283 		(and specials org-special-properties)
  13284 		(and defaults (cons org-effort-property org-default-properties))
  13285 		;; Get property names from #+PROPERTY keywords as well
  13286 		(mapcar (lambda (s)
  13287 			  (nth 0 (split-string s)))
  13288 			(cdar (org-collect-keywords '("PROPERTY")))))))
  13289     (org-with-wide-buffer
  13290      (goto-char (point-min))
  13291      (while (re-search-forward org-property-start-re nil t)
  13292        (catch :skip
  13293 	 (let ((range (org-get-property-block)))
  13294 	   (unless range (throw :skip nil))
  13295 	   (goto-char (car range))
  13296 	   (let ((begin (car range))
  13297 		 (end (cdr range)))
  13298 	     ;; Make sure that found property block is not located
  13299 	     ;; before current point, as it would generate an infloop.
  13300 	     ;; It can happen, for example, in the following
  13301 	     ;; situation:
  13302 	     ;;
  13303 	     ;; * Headline
  13304 	     ;;   :PROPERTIES:
  13305 	     ;;   ...
  13306 	     ;;   :END:
  13307 	     ;; *************** Inlinetask
  13308 	     ;; #+BEGIN_EXAMPLE
  13309 	     ;; :PROPERTIES:
  13310 	     ;; #+END_EXAMPLE
  13311 	     ;;
  13312 	     (if (< begin (point)) (throw :skip nil) (goto-char begin))
  13313 	     (while (< (point) end)
  13314 	       (let ((p (progn (looking-at org-property-re)
  13315 			       (match-string-no-properties 2))))
  13316 		 ;; Only add true property name, not extension symbol.
  13317 		 (push (if (not (string-match-p "\\+\\'" p)) p
  13318 			 (substring p 0 -1))
  13319 		       props))
  13320 	       (forward-line))))
  13321 	 (outline-next-heading)))
  13322      (when columns
  13323        (goto-char (point-min))
  13324        (while (re-search-forward "^[ \t]*\\(?:#\\+\\|:\\)COLUMNS:" nil t)
  13325 	 (let ((element (org-element-at-point)))
  13326 	   (when (memq (org-element-type element) '(keyword node-property))
  13327 	     (let ((value (org-element-property :value element))
  13328 		   (start 0))
  13329 	       (while (string-match "%[0-9]*\\([[:alnum:]_-]+\\)\\(([^)]+)\\)?\
  13330 \\(?:{[^}]+}\\)?"
  13331 				    value start)
  13332 		 (setq start (match-end 0))
  13333 		 (let ((p (match-string-no-properties 1 value)))
  13334 		   (unless (member-ignore-case p org-special-properties)
  13335 		     (push p props))))))))))
  13336     (sort (delete-dups
  13337 	   (append props
  13338 		   ;; for each xxx_ALL property, make sure the bare
  13339 		   ;; xxx property is also included
  13340 		   (delq nil (mapcar (lambda (p)
  13341 				       (and (string-match-p "._ALL\\'" p)
  13342 					    (substring p 0 -4)))
  13343 				     props))))
  13344 	  (lambda (a b) (string< (upcase a) (upcase b))))))
  13345 
  13346 (defun org-property-values (key)
  13347   "List all non-nil values of property KEY in current buffer."
  13348   (org-with-wide-buffer
  13349    (goto-char (point-min))
  13350    (let ((case-fold-search t)
  13351 	 (re (org-re-property key))
  13352 	 values)
  13353      (while (re-search-forward re nil t)
  13354        (push (org-entry-get (point) key) values))
  13355      (delete-dups values))))
  13356 
  13357 (defun org-insert-property-drawer ()
  13358   "Insert a property drawer into the current entry.
  13359 Do nothing if the drawer already exists.  The newly created
  13360 drawer is immediately hidden."
  13361   (org-with-wide-buffer
  13362    ;; Set point to the position where the drawer should be inserted.
  13363    (if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p))
  13364        (org-back-to-heading-or-point-min t)
  13365      (org-with-limited-levels (org-back-to-heading-or-point-min t)))
  13366    (if (org-before-first-heading-p)
  13367        (while (and (org-at-comment-p) (bolp)) (forward-line))
  13368      (progn
  13369        (forward-line)
  13370        (when (looking-at-p org-planning-line-re) (forward-line))))
  13371    (unless (looking-at-p org-property-drawer-re)
  13372      ;; Make sure we start editing a line from current entry, not from
  13373      ;; next one.  It prevents extending text properties or overlays
  13374      ;; belonging to the latter.
  13375      (when (and (bolp) (> (point) (point-min))) (backward-char))
  13376      (let ((begin (if (bobp) (point) (1+ (point))))
  13377 	   (inhibit-read-only t))
  13378        (unless (bobp) (insert "\n"))
  13379        (insert ":PROPERTIES:\n:END:")
  13380        (org-flag-region (line-end-position 0) (point) t 'outline)
  13381        (when (or (eobp) (= begin (point-min))) (insert "\n"))
  13382        (org-indent-region begin (point))))))
  13383 
  13384 (defun org-insert-drawer (&optional arg drawer)
  13385   "Insert a drawer at point.
  13386 
  13387 When optional argument ARG is non-nil, insert a property drawer.
  13388 
  13389 Optional argument DRAWER, when non-nil, is a string representing
  13390 drawer's name.  Otherwise, the user is prompted for a name.
  13391 
  13392 If a region is active, insert the drawer around that region
  13393 instead.
  13394 
  13395 Point is left between drawer's boundaries."
  13396   (interactive "P")
  13397   (let* ((drawer (if arg "PROPERTIES"
  13398 		   (or drawer (read-from-minibuffer "Drawer: ")))))
  13399     (cond
  13400      ;; With C-u, fall back on `org-insert-property-drawer'
  13401      (arg (org-insert-property-drawer))
  13402      ;; Check validity of suggested drawer's name.
  13403      ((not (string-match-p org-drawer-regexp (format ":%s:" drawer)))
  13404       (user-error "Invalid drawer name"))
  13405      ;; With an active region, insert a drawer at point.
  13406      ((not (org-region-active-p))
  13407       (progn
  13408 	(unless (bolp) (insert "\n"))
  13409 	(insert (format ":%s:\n\n:END:\n" drawer))
  13410 	(forward-line -2)))
  13411      ;; Otherwise, insert the drawer at point
  13412      (t
  13413       (let ((rbeg (region-beginning))
  13414 	    (rend (copy-marker (region-end))))
  13415 	(unwind-protect
  13416 	    (progn
  13417 	      (goto-char rbeg)
  13418 	      (beginning-of-line)
  13419 	      (when (save-excursion
  13420 		      (re-search-forward org-outline-regexp-bol rend t))
  13421 		(user-error "Drawers cannot contain headlines"))
  13422 	      ;; Position point at the beginning of the first
  13423 	      ;; non-blank line in region.  Insert drawer's opening
  13424 	      ;; there, then indent it.
  13425 	      (org-skip-whitespace)
  13426 	      (beginning-of-line)
  13427 	      (insert ":" drawer ":\n")
  13428 	      (forward-line -1)
  13429 	      (indent-for-tab-command)
  13430 	      ;; Move point to the beginning of the first blank line
  13431 	      ;; after the last non-blank line in region.  Insert
  13432 	      ;; drawer's closing, then indent it.
  13433 	      (goto-char rend)
  13434 	      (skip-chars-backward " \r\t\n")
  13435 	      (insert "\n:END:")
  13436 	      (deactivate-mark t)
  13437 	      (indent-for-tab-command)
  13438 	      (unless (eolp) (insert "\n")))
  13439 	  ;; Clear marker, whatever the outcome of insertion is.
  13440 	  (set-marker rend nil)))))))
  13441 
  13442 (defvar org-property-set-functions-alist nil
  13443   "Property set function alist.
  13444 Each entry should have the following format:
  13445 
  13446  (PROPERTY . READ-FUNCTION)
  13447 
  13448 The read function will be called with the same argument as
  13449 `org-completing-read'.")
  13450 
  13451 (defun org-set-property-function (property)
  13452   "Get the function that should be used to set PROPERTY.
  13453 This is computed according to `org-property-set-functions-alist'."
  13454   (or (cdr (assoc property org-property-set-functions-alist))
  13455       'org-completing-read))
  13456 
  13457 (defun org-read-property-value (property &optional pom default)
  13458   "Read value for PROPERTY, as a string.
  13459 When optional argument POM is non-nil, completion uses additional
  13460 information, i.e., allowed or existing values at point or marker
  13461 POM.
  13462 Optional argument DEFAULT provides a default value for PROPERTY."
  13463   (let* ((completion-ignore-case t)
  13464 	 (allowed
  13465 	  (or (org-property-get-allowed-values nil property 'table)
  13466 	      (and pom (org-property-get-allowed-values pom property 'table))))
  13467 	 (current (org-entry-get nil property))
  13468 	 (prompt (format "%s value%s: "
  13469 			 property
  13470 			 (if (org-string-nw-p current)
  13471 			     (format " [%s]" current)
  13472 			   "")))
  13473 	 (set-function (org-set-property-function property)))
  13474     (org-trim
  13475      (if allowed
  13476 	 (funcall set-function
  13477 		  prompt allowed nil
  13478 		  (not (get-text-property 0 'org-unrestricted (caar allowed)))
  13479 		  default nil default)
  13480        (let ((all (mapcar #'list
  13481 			  (append (org-property-values property)
  13482 				  (and pom
  13483 				       (org-with-point-at pom
  13484 					 (org-property-values property)))))))
  13485 	 (funcall set-function prompt all nil nil "" nil current))))))
  13486 
  13487 (defvar org-last-set-property nil)
  13488 (defvar org-last-set-property-value nil)
  13489 (defun org-read-property-name ()
  13490   "Read a property name."
  13491   (let ((completion-ignore-case t)
  13492 	(default-prop (or (and (org-at-property-p)
  13493 			       (match-string-no-properties 2))
  13494 			  org-last-set-property)))
  13495     (org-completing-read
  13496      (concat "Property"
  13497 	     (if default-prop (concat " [" default-prop "]") "")
  13498 	     ": ")
  13499      (mapcar #'list (org-buffer-property-keys nil t t))
  13500      nil nil nil nil default-prop)))
  13501 
  13502 (defun org-set-property-and-value (use-last)
  13503   "Allow to set [PROPERTY]: [value] direction from prompt.
  13504 When use-default, don't even ask, just use the last
  13505 \"[PROPERTY]: [value]\" string from the history."
  13506   (interactive "P")
  13507   (let* ((completion-ignore-case t)
  13508 	 (pv (or (and use-last org-last-set-property-value)
  13509 		 (org-completing-read
  13510 		  "Enter a \"[Property]: [value]\" pair: "
  13511 		  nil nil nil nil nil
  13512 		  org-last-set-property-value)))
  13513 	 prop val)
  13514     (when (string-match "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*$" pv)
  13515       (setq prop (match-string 1 pv)
  13516 	    val (match-string 2 pv))
  13517       (org-set-property prop val))))
  13518 
  13519 (defun org-set-property (property value)
  13520   "In the current entry, set PROPERTY to VALUE.
  13521 
  13522 When called interactively, this will prompt for a property name, offering
  13523 completion on existing and default properties.  And then it will prompt
  13524 for a value, offering completion either on allowed values (via an inherited
  13525 xxx_ALL property) or on existing values in other instances of this property
  13526 in the current file.
  13527 
  13528 Throw an error when trying to set a property with an invalid name."
  13529   (interactive (list nil nil))
  13530   (let ((property (or property (org-read-property-name))))
  13531     ;; `org-entry-put' also makes the following check, but this one
  13532     ;; avoids polluting `org-last-set-property' and
  13533     ;; `org-last-set-property-value' needlessly.
  13534     (unless (org--valid-property-p property)
  13535       (user-error "Invalid property name: \"%s\"" property))
  13536     (let ((value (or value (org-read-property-value property)))
  13537 	  (fn (cdr (assoc-string property org-properties-postprocess-alist t))))
  13538       (setq org-last-set-property property)
  13539       (setq org-last-set-property-value (concat property ": " value))
  13540       ;; Possibly postprocess the inserted value:
  13541       (when fn (setq value (funcall fn value)))
  13542       (unless (equal (org-entry-get nil property) value)
  13543 	(org-entry-put nil property value)))))
  13544 
  13545 (defun org-find-property (property &optional value)
  13546   "Find first entry in buffer that sets PROPERTY.
  13547 
  13548 When optional argument VALUE is non-nil, only consider an entry
  13549 if it contains PROPERTY set to this value.  If PROPERTY should be
  13550 explicitly set to nil, use string \"nil\" for VALUE.
  13551 
  13552 Return position where the entry begins, or nil if there is no
  13553 such entry.  If narrowing is in effect, only search the visible
  13554 part of the buffer."
  13555   (save-excursion
  13556     (goto-char (point-min))
  13557     (let ((case-fold-search t)
  13558 	  (re (org-re-property property nil (not value) value)))
  13559       (catch 'exit
  13560 	(while (re-search-forward re nil t)
  13561 	  (when (if value (org-at-property-p)
  13562 		  (org-entry-get (point) property nil t))
  13563 	    (throw 'exit (progn (org-back-to-heading-or-point-min t)
  13564 				(point)))))))))
  13565 
  13566 (defun org-delete-property (property)
  13567   "In the current entry, delete PROPERTY."
  13568   (interactive
  13569    (let* ((completion-ignore-case t)
  13570 	  (cat (org-entry-get (point) "CATEGORY"))
  13571 	  (props0 (org-entry-properties nil 'standard))
  13572 	  (props (if cat props0
  13573 		   (delete `("CATEGORY" . ,(org-get-category)) props0)))
  13574 	  (prop (if (< 1 (length props))
  13575 		    (completing-read "Property: " props nil t)
  13576 		  (caar props))))
  13577      (list prop)))
  13578   (if (not property)
  13579       (message "No property to delete in this entry")
  13580     (org-entry-delete nil property)
  13581     (message "Property \"%s\" deleted" property)))
  13582 
  13583 (defun org-delete-property-globally (property)
  13584   "Remove PROPERTY globally, from all entries.
  13585 This function ignores narrowing, if any."
  13586   (interactive
  13587    (let* ((completion-ignore-case t)
  13588 	  (prop (completing-read
  13589 		 "Globally remove property: "
  13590 		 (mapcar #'list (org-buffer-property-keys)))))
  13591      (list prop)))
  13592   (org-with-wide-buffer
  13593    (goto-char (point-min))
  13594    (let ((count 0)
  13595 	 (re (org-re-property (concat (regexp-quote property) "\\+?") t t)))
  13596      (while (re-search-forward re nil t)
  13597        (when (org-entry-delete (point) property) (cl-incf count)))
  13598      (message "Property \"%s\" removed from %d entries" property count))))
  13599 
  13600 (defvar org-columns-current-fmt-compiled) ; defined in org-colview.el
  13601 
  13602 (defun org-compute-property-at-point ()
  13603   "Compute the property at point.
  13604 This looks for an enclosing column format, extracts the operator and
  13605 then applies it to the property in the column format's scope."
  13606   (interactive)
  13607   (unless (org-at-property-p)
  13608     (user-error "Not at a property"))
  13609   (let ((prop (match-string-no-properties 2)))
  13610     (org-columns-get-format-and-top-level)
  13611     (unless (nth 3 (assoc-string prop org-columns-current-fmt-compiled t))
  13612       (user-error "No operator defined for property %s" prop))
  13613     (org-columns-compute prop)))
  13614 
  13615 (defvar org-property-allowed-value-functions nil
  13616   "Hook for functions supplying allowed values for a specific property.
  13617 The functions must take a single argument, the name of the property, and
  13618 return a flat list of allowed values.  If \":ETC\" is one of
  13619 the values, this means that these values are intended as defaults for
  13620 completion, but that other values should be allowed too.
  13621 The functions must return nil if they are not responsible for this
  13622 property.")
  13623 
  13624 (defun org-property-get-allowed-values (pom property &optional table)
  13625   "Get allowed values for the property PROPERTY.
  13626 When TABLE is non-nil, return an alist that can directly be used for
  13627 completion."
  13628   (let (vals)
  13629     (cond
  13630      ((equal property "TODO")
  13631       (setq vals (org-with-point-at pom
  13632 		   (append org-todo-keywords-1 '("")))))
  13633      ((equal property "PRIORITY")
  13634       (let ((n org-priority-lowest))
  13635 	(while (>= n org-priority-highest)
  13636 	  (push (char-to-string n) vals)
  13637 	  (setq n (1- n)))))
  13638      ((equal property "CATEGORY"))
  13639      ((member property org-special-properties))
  13640      ((setq vals (run-hook-with-args-until-success
  13641 		  'org-property-allowed-value-functions property)))
  13642      (t
  13643       (setq vals (org-entry-get pom (concat property "_ALL") 'inherit))
  13644       (when (and vals (string-match "\\S-" vals))
  13645 	(setq vals (car (read-from-string (concat "(" vals ")"))))
  13646 	(setq vals (mapcar (lambda (x)
  13647 			     (cond ((stringp x) x)
  13648 				   ((numberp x) (number-to-string x))
  13649 				   ((symbolp x) (symbol-name x))
  13650 				   (t "???")))
  13651 			   vals)))))
  13652     (when (member ":ETC" vals)
  13653       (setq vals (remove ":ETC" vals))
  13654       (org-add-props (car vals) '(org-unrestricted t)))
  13655     (if table (mapcar 'list vals) vals)))
  13656 
  13657 (defun org-property-previous-allowed-value (&optional _previous)
  13658   "Switch to the next allowed value for this property."
  13659   (interactive)
  13660   (org-property-next-allowed-value t))
  13661 
  13662 (defun org-property-next-allowed-value (&optional previous)
  13663   "Switch to the next allowed value for this property."
  13664   (interactive)
  13665   (unless (org-at-property-p)
  13666     (user-error "Not at a property"))
  13667   (let* ((prop (car (save-match-data (org-split-string (match-string 1) ":"))))
  13668 	 (key (match-string 2))
  13669 	 (value (match-string 3))
  13670 	 (allowed (or (org-property-get-allowed-values (point) key)
  13671 		      (and (member value  '("[ ]" "[-]" "[X]"))
  13672 			   '("[ ]" "[X]"))))
  13673 	 (heading (save-match-data (nth 4 (org-heading-components))))
  13674 	 nval)
  13675     (unless allowed
  13676       (user-error "Allowed values for this property have not been defined"))
  13677     (when previous (setq allowed (reverse allowed)))
  13678     (when (member value allowed)
  13679       (setq nval (car (cdr (member value allowed)))))
  13680     (setq nval (or nval (car allowed)))
  13681     (when (equal nval value)
  13682       (user-error "Only one allowed value for this property"))
  13683     (org-at-property-p)
  13684     (replace-match (concat " :" key ": " nval) t t)
  13685     (org-indent-line)
  13686     (beginning-of-line 1)
  13687     (skip-chars-forward " \t")
  13688     (when (equal prop org-effort-property)
  13689       (org-refresh-property
  13690        '((effort . identity)
  13691 	 (effort-minutes . org-duration-to-minutes))
  13692        nval)
  13693       (when (string= org-clock-current-task heading)
  13694 	(setq org-clock-effort nval)
  13695 	(org-clock-update-mode-line)))
  13696     (run-hook-with-args 'org-property-changed-functions key nval)))
  13697 
  13698 (defun org-find-olp (path &optional this-buffer)
  13699   "Return a marker pointing to the entry at outline path OLP.
  13700 If anything goes wrong, throw an error, and if you need to do
  13701 something based on this error, you can catch it with
  13702 `condition-case'.
  13703 
  13704 If THIS-BUFFER is set, the outline path does not contain a file,
  13705 only headings."
  13706   (let* ((file (if this-buffer buffer-file-name (pop path)))
  13707 	 (buffer (if this-buffer (current-buffer) (find-file-noselect file)))
  13708 	 (level 1)
  13709 	 (lmin 1)
  13710 	 (lmax 1)
  13711 	 end found flevel)
  13712     (unless buffer (error "File not found :%s" file))
  13713     (with-current-buffer buffer
  13714       (unless (derived-mode-p 'org-mode)
  13715 	(error "Buffer %s needs to be in Org mode" buffer))
  13716       (org-with-wide-buffer
  13717        (goto-char (point-min))
  13718        (dolist (heading path)
  13719 	 (let ((re (format org-complex-heading-regexp-format
  13720 			   (regexp-quote heading)))
  13721 	       (cnt 0))
  13722 	   (while (re-search-forward re end t)
  13723 	     (setq level (- (match-end 1) (match-beginning 1)))
  13724 	     (when (and (>= level lmin) (<= level lmax))
  13725 	       (setq found (match-beginning 0) flevel level cnt (1+ cnt))))
  13726 	   (when (= cnt 0)
  13727 	     (error "Heading not found on level %d: %s" lmax heading))
  13728 	   (when (> cnt 1)
  13729 	     (error "Heading not unique on level %d: %s" lmax heading))
  13730 	   (goto-char found)
  13731 	   (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0)))
  13732 	   (setq end (save-excursion (org-end-of-subtree t t)))))
  13733        (when (org-at-heading-p)
  13734 	 (point-marker))))))
  13735 
  13736 (defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only)
  13737   "Find node HEADING in BUFFER.
  13738 Return a marker to the heading if it was found, or nil if not.
  13739 If POS-ONLY is set, return just the position instead of a marker.
  13740 
  13741 The heading text must match exact, but it may have a TODO keyword,
  13742 a priority cookie and tags in the standard locations."
  13743   (with-current-buffer (or buffer (current-buffer))
  13744     (org-with-wide-buffer
  13745      (goto-char (point-min))
  13746      (let (case-fold-search)
  13747        (when (re-search-forward
  13748 	      (format org-complex-heading-regexp-format
  13749 		      (regexp-quote heading)) nil t)
  13750 	 (if pos-only
  13751 	     (match-beginning 0)
  13752 	   (move-marker (make-marker) (match-beginning 0))))))))
  13753 
  13754 (defun org-find-exact-heading-in-directory (heading &optional dir)
  13755   "Find Org node headline HEADING in all \".org\" files in directory DIR.
  13756 When the target headline is found, return a marker to this location."
  13757   (let ((files (directory-files (or dir default-directory)
  13758 				t "\\`[^.#].*\\.org\\'"))
  13759 	visiting m buffer)
  13760     (catch 'found
  13761       (dolist (file files)
  13762         (message "trying %s" file)
  13763         (setq visiting (org-find-base-buffer-visiting file))
  13764         (setq buffer (or visiting (find-file-noselect file)))
  13765         (setq m (org-find-exact-headline-in-buffer
  13766                  heading buffer))
  13767         (when (and (not m) (not visiting)) (kill-buffer buffer))
  13768         (and m (throw 'found m))))))
  13769 
  13770 (defun org-find-entry-with-id (ident)
  13771   "Locate the entry that contains the ID property with exact value IDENT.
  13772 IDENT can be a string, a symbol or a number, this function will search for
  13773 the string representation of it.
  13774 Return the position where this entry starts, or nil if there is no such entry."
  13775   (interactive "sID: ")
  13776   (let ((id (cond
  13777 	     ((stringp ident) ident)
  13778 	     ((symbolp ident) (symbol-name ident))
  13779 	     ((numberp ident) (number-to-string ident))
  13780 	     (t (error "IDENT %s must be a string, symbol or number" ident)))))
  13781     (org-with-wide-buffer (org-find-property "ID" id))))
  13782 
  13783 ;;;; Timestamps
  13784 
  13785 (defvar org-last-changed-timestamp nil)
  13786 (defvar org-last-inserted-timestamp nil
  13787   "The last time stamp inserted with `org-insert-time-stamp'.")
  13788 
  13789 (defun org-time-stamp (arg &optional inactive)
  13790   "Prompt for a date/time and insert a time stamp.
  13791 
  13792 If the user specifies a time like HH:MM or if this command is
  13793 called with at least one prefix argument, the time stamp contains
  13794 the date and the time.  Otherwise, only the date is included.
  13795 
  13796 All parts of a date not specified by the user are filled in from
  13797 the timestamp at point, if any, or the current date/time
  13798 otherwise.
  13799 
  13800 If there is already a timestamp at the cursor, it is replaced.
  13801 
  13802 With two universal prefix arguments, insert an active timestamp
  13803 with the current time without prompting the user.
  13804 
  13805 When called from Lisp, the timestamp is inactive if INACTIVE is
  13806 non-nil."
  13807   (interactive "P")
  13808   (let* ((ts (cond
  13809 	      ((org-at-date-range-p t)
  13810 	       (match-string (if (< (point) (- (match-beginning 2) 2)) 1 2)))
  13811 	      ((org-at-timestamp-p 'lax) (match-string 0))))
  13812 	 ;; Default time is either the timestamp at point or today.
  13813 	 ;; When entering a range, only the range start is considered.
  13814          (default-time (and ts (org-time-string-to-time ts)))
  13815          (default-input (and ts (org-get-compact-tod ts)))
  13816          (repeater (and ts
  13817 			(string-match "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ts)
  13818 			(match-string 0 ts)))
  13819 	 org-time-was-given
  13820 	 org-end-time-was-given
  13821 	 (time
  13822 	  (if (equal arg '(16)) (current-time)
  13823 	    ;; Preserve `this-command' and `last-command'.
  13824 	    (let ((this-command this-command)
  13825 		  (last-command last-command))
  13826 	      (org-read-date
  13827 	       arg 'totime nil nil default-time default-input
  13828 	       inactive)))))
  13829     (cond
  13830      ((and ts
  13831            (memq last-command '(org-time-stamp org-time-stamp-inactive))
  13832            (memq this-command '(org-time-stamp org-time-stamp-inactive)))
  13833       (insert "--")
  13834       (org-insert-time-stamp time (or org-time-was-given arg) inactive))
  13835      (ts
  13836       ;; Make sure we're on a timestamp.  When in the middle of a date
  13837       ;; range, move arbitrarily to range end.
  13838       (unless (org-at-timestamp-p 'lax)
  13839 	(skip-chars-forward "-")
  13840 	(org-at-timestamp-p 'lax))
  13841       (replace-match "")
  13842       (setq org-last-changed-timestamp
  13843 	    (org-insert-time-stamp
  13844 	     time (or org-time-was-given arg)
  13845 	     inactive nil nil (list org-end-time-was-given)))
  13846       (when repeater
  13847 	(backward-char)
  13848 	(insert " " repeater)
  13849 	(setq org-last-changed-timestamp
  13850 	      (concat (substring org-last-inserted-timestamp 0 -1)
  13851 		      " " repeater ">")))
  13852       (message "Timestamp updated"))
  13853      ((equal arg '(16)) (org-insert-time-stamp time t inactive))
  13854      (t (org-insert-time-stamp
  13855 	 time (or org-time-was-given arg) inactive nil nil
  13856 	 (list org-end-time-was-given))))))
  13857 
  13858 ;; FIXME: can we use this for something else, like computing time differences?
  13859 (defun org-get-compact-tod (s)
  13860   (when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s)
  13861     (let* ((t1 (match-string 1 s))
  13862 	   (h1 (string-to-number (match-string 2 s)))
  13863 	   (m1 (string-to-number (match-string 3 s)))
  13864 	   (t2 (and (match-end 4) (match-string 5 s)))
  13865 	   (h2 (and t2 (string-to-number (match-string 6 s))))
  13866 	   (m2 (and t2 (string-to-number (match-string 7 s))))
  13867 	   dh dm)
  13868       (if (not t2)
  13869 	  t1
  13870 	(setq dh (- h2 h1) dm (- m2 m1))
  13871 	(when (< dm 0) (setq dm (+ dm 60) dh (1- dh)))
  13872 	(concat t1 "+" (number-to-string dh)
  13873 		(and (/= 0 dm) (format ":%02d" dm)))))))
  13874 
  13875 (defun org-time-stamp-inactive (&optional arg)
  13876   "Insert an inactive time stamp.
  13877 
  13878 An inactive time stamp is enclosed in square brackets instead of
  13879 angle brackets.  It is inactive in the sense that it does not
  13880 trigger agenda entries.  So these are more for recording a
  13881 certain time/date.
  13882 
  13883 If the user specifies a time like HH:MM or if this command is called with
  13884 at least one prefix argument, the time stamp contains the date and the time.
  13885 Otherwise, only the date is included.
  13886 
  13887 When called with two universal prefix arguments, insert an inactive time stamp
  13888 with the current time without prompting the user."
  13889   (interactive "P")
  13890   (org-time-stamp arg 'inactive))
  13891 
  13892 (defvar org-date-ovl (make-overlay 1 1))
  13893 (overlay-put org-date-ovl 'face 'org-date-selected)
  13894 (delete-overlay org-date-ovl)
  13895 
  13896 (defvar org-ans1) ; dynamically scoped parameter
  13897 (defvar org-ans2) ; dynamically scoped parameter
  13898 
  13899 (defvar org-plain-time-of-day-regexp) ; defined below
  13900 
  13901 (defvar org-overriding-default-time nil) ; dynamically scoped
  13902 (defvar org-read-date-overlay nil)
  13903 (defvar org-read-date-history nil)
  13904 (defvar org-read-date-final-answer nil)
  13905 (defvar org-read-date-analyze-futurep nil)
  13906 (defvar org-read-date-analyze-forced-year nil)
  13907 (defvar org-read-date-inactive)
  13908 (defvar org-def)
  13909 (defvar org-defdecode)
  13910 (defvar org-with-time)
  13911 
  13912 (defvar calendar-setup)			; Dynamically scoped.
  13913 (defun org-read-date (&optional with-time to-time from-string prompt
  13914 				default-time default-input inactive)
  13915   "Read a date, possibly a time, and make things smooth for the user.
  13916 The prompt will suggest to enter an ISO date, but you can also enter anything
  13917 which will at least partially be understood by `parse-time-string'.
  13918 Unrecognized parts of the date will default to the current day, month, year,
  13919 hour and minute.  If this command is called to replace a timestamp at point,
  13920 or to enter the second timestamp of a range, the default time is taken
  13921 from the existing stamp.  Furthermore, the command prefers the future,
  13922 so if you are giving a date where the year is not given, and the day-month
  13923 combination is already past in the current year, it will assume you
  13924 mean next year.  For details, see the manual.  A few examples:
  13925 
  13926   3-2-5         --> 2003-02-05
  13927   feb 15        --> currentyear-02-15
  13928   2/15          --> currentyear-02-15
  13929   sep 12 9      --> 2009-09-12
  13930   12:45         --> today 12:45
  13931   22 sept 0:34  --> currentyear-09-22 0:34
  13932   12            --> currentyear-currentmonth-12
  13933   Fri           --> nearest Friday after today
  13934   -Tue          --> last Tuesday
  13935   etc.
  13936 
  13937 Furthermore you can specify a relative date by giving, as the *first* thing
  13938 in the input:  a plus/minus sign, a number and a letter [hdwmy] to indicate
  13939 change in days weeks, months, years.
  13940 With a single plus or minus, the date is relative to today.  With a double
  13941 plus or minus, it is relative to the date in DEFAULT-TIME.  E.g.
  13942   +4d           --> four days from today
  13943   +4            --> same as above
  13944   +2w           --> two weeks from today
  13945   ++5           --> five days from default date
  13946 
  13947 The function understands only English month and weekday abbreviations.
  13948 
  13949 While prompting, a calendar is popped up - you can also select the
  13950 date with the mouse (button 1).  The calendar shows a period of three
  13951 months.  To scroll it to other months, use the keys `>' and `<'.
  13952 If you don't like the calendar, turn it off with
  13953        (setq org-read-date-popup-calendar nil)
  13954 
  13955 With optional argument TO-TIME, the date will immediately be converted
  13956 to an internal time.
  13957 With an optional argument WITH-TIME, the prompt will suggest to
  13958 also insert a time.  Note that when WITH-TIME is not set, you can
  13959 still enter a time, and this function will inform the calling routine
  13960 about this change.  The calling routine may then choose to change the
  13961 format used to insert the time stamp into the buffer to include the time.
  13962 With optional argument FROM-STRING, read from this string instead from
  13963 the user.  PROMPT can overwrite the default prompt.  DEFAULT-TIME is
  13964 the time/date that is used for everything that is not specified by the
  13965 user."
  13966   (require 'parse-time)
  13967   (let* ((org-with-time with-time)
  13968 	 (org-time-stamp-rounding-minutes
  13969 	  (if (equal org-with-time '(16))
  13970 	      '(0 0)
  13971 	    org-time-stamp-rounding-minutes))
  13972 	 (ct (org-current-time))
  13973 	 (org-def (or org-overriding-default-time default-time ct))
  13974 	 (org-defdecode (decode-time org-def))
  13975          (cur-frame (selected-frame))
  13976 	 (mouse-autoselect-window nil)	; Don't let the mouse jump
  13977 	 (calendar-setup
  13978 	  (and (eq calendar-setup 'calendar-only) 'calendar-only))
  13979 	 (calendar-move-hook nil)
  13980 	 (calendar-view-diary-initially-flag nil)
  13981 	 (calendar-view-holidays-initially-flag nil)
  13982 	 ans (org-ans0 "") org-ans1 org-ans2 final cal-frame)
  13983     ;; Rationalize `org-def' and `org-defdecode', if required.
  13984     (when (< (nth 2 org-defdecode) org-extend-today-until)
  13985       (setf (nth 2 org-defdecode) -1)
  13986       (setf (nth 1 org-defdecode) 59)
  13987       (setq org-def (apply #'encode-time org-defdecode))
  13988       (setq org-defdecode (decode-time org-def)))
  13989     (let* ((timestr (format-time-string
  13990 		     (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d")
  13991 		     org-def))
  13992 	   (prompt (concat (if prompt (concat prompt " ") "")
  13993 			   (format "Date+time [%s]: " timestr))))
  13994       (cond
  13995        (from-string (setq ans from-string))
  13996        (org-read-date-popup-calendar
  13997 	(save-excursion
  13998 	  (save-window-excursion
  13999 	    (calendar)
  14000 	    (when (eq calendar-setup 'calendar-only)
  14001 	      (setq cal-frame
  14002 		    (window-frame (get-buffer-window "*Calendar*" 'visible)))
  14003 	      (select-frame cal-frame))
  14004 	    (org-eval-in-calendar '(setq cursor-type nil) t)
  14005 	    (unwind-protect
  14006 		(progn
  14007 		  (calendar-forward-day (- (time-to-days org-def)
  14008 					   (calendar-absolute-from-gregorian
  14009 					    (calendar-current-date))))
  14010 		  (org-eval-in-calendar nil t)
  14011 		  (let* ((old-map (current-local-map))
  14012 			 (map (copy-keymap calendar-mode-map))
  14013 			 (minibuffer-local-map
  14014 			  (copy-keymap org-read-date-minibuffer-local-map)))
  14015 		    (org-defkey map (kbd "RET") 'org-calendar-select)
  14016 		    (org-defkey map [mouse-1] 'org-calendar-select-mouse)
  14017 		    (org-defkey map [mouse-2] 'org-calendar-select-mouse)
  14018 		    (unwind-protect
  14019 			(progn
  14020 			  (use-local-map map)
  14021 			  (setq org-read-date-inactive inactive)
  14022 			  (add-hook 'post-command-hook 'org-read-date-display)
  14023 			  (setq org-ans0
  14024 				(read-string prompt
  14025 					     default-input
  14026 					     'org-read-date-history
  14027 					     nil))
  14028 			  ;; org-ans0: from prompt
  14029 			  ;; org-ans1: from mouse click
  14030 			  ;; org-ans2: from calendar motion
  14031 			  (setq ans
  14032 				(concat org-ans0 " " (or org-ans1 org-ans2))))
  14033 		      (remove-hook 'post-command-hook 'org-read-date-display)
  14034 		      (use-local-map old-map)
  14035 		      (when org-read-date-overlay
  14036 			(delete-overlay org-read-date-overlay)
  14037 			(setq org-read-date-overlay nil)))))
  14038 	      (bury-buffer "*Calendar*")
  14039 	      (when cal-frame
  14040 		(delete-frame cal-frame)
  14041 		(select-frame-set-input-focus cur-frame))))))
  14042 
  14043        (t				; Naked prompt only
  14044 	(unwind-protect
  14045 	    (setq ans (read-string prompt default-input
  14046 				   'org-read-date-history timestr))
  14047 	  (when org-read-date-overlay
  14048 	    (delete-overlay org-read-date-overlay)
  14049 	    (setq org-read-date-overlay nil))))))
  14050 
  14051     (setq final (org-read-date-analyze ans org-def org-defdecode))
  14052 
  14053     (when org-read-date-analyze-forced-year
  14054       (message "Year was forced into %s"
  14055 	       (if org-read-date-force-compatible-dates
  14056 		   "compatible range (1970-2037)"
  14057 		 "range representable on this machine"))
  14058       (ding))
  14059 
  14060     (setq final (apply #'encode-time final))
  14061 
  14062     (setq org-read-date-final-answer ans)
  14063 
  14064     (if to-time
  14065 	final
  14066       ;; This round-trip gets rid of 34th of August and stuff like that....
  14067       (setq final (decode-time final))
  14068       (if (and (boundp 'org-time-was-given) org-time-was-given)
  14069 	  (format "%04d-%02d-%02d %02d:%02d"
  14070 		  (nth 5 final) (nth 4 final) (nth 3 final)
  14071 		  (nth 2 final) (nth 1 final))
  14072 	(format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final))))))
  14073 
  14074 (defun org-read-date-display ()
  14075   "Display the current date prompt interpretation in the minibuffer."
  14076   (when org-read-date-display-live
  14077     (when org-read-date-overlay
  14078       (delete-overlay org-read-date-overlay))
  14079     (when (minibufferp (current-buffer))
  14080       (save-excursion
  14081 	(end-of-line 1)
  14082 	(while (not (equal (buffer-substring
  14083 			    (max (point-min) (- (point) 4)) (point))
  14084 			   "    "))
  14085 	  (insert " ")))
  14086       (let* ((ans (concat (buffer-substring (point-at-bol) (point-max))
  14087 			  " " (or org-ans1 org-ans2)))
  14088 	     (org-end-time-was-given nil)
  14089 	     (f (org-read-date-analyze ans org-def org-defdecode))
  14090 	     (fmts (if org-display-custom-times
  14091 		       org-time-stamp-custom-formats
  14092 		     org-time-stamp-formats))
  14093 	     (fmt (if (or org-with-time
  14094 			  (and (boundp 'org-time-was-given) org-time-was-given))
  14095 		      (cdr fmts)
  14096 		    (car fmts)))
  14097 	     (txt (format-time-string fmt (apply #'encode-time f)))
  14098 	     (txt (if org-read-date-inactive (concat "[" (substring txt 1 -1) "]") txt))
  14099 	     (txt (concat "=> " txt)))
  14100 	(when (and org-end-time-was-given
  14101 		   (string-match org-plain-time-of-day-regexp txt))
  14102 	  (setq txt (concat (substring txt 0 (match-end 0)) "-"
  14103 			    org-end-time-was-given
  14104 			    (substring txt (match-end 0)))))
  14105 	(when org-read-date-analyze-futurep
  14106 	  (setq txt (concat txt " (=>F)")))
  14107 	(setq org-read-date-overlay
  14108 	      (make-overlay (1- (point-at-eol)) (point-at-eol)))
  14109 	(org-overlay-display org-read-date-overlay txt 'secondary-selection)))))
  14110 
  14111 (defun org-read-date-analyze (ans def defdecode)
  14112   "Analyze the combined answer of the date prompt."
  14113   ;; FIXME: cleanup and comment
  14114   (let ((org-def def)
  14115 	(org-defdecode defdecode)
  14116 	(nowdecode (decode-time))
  14117 	delta deltan deltaw deltadef year month day
  14118 	hour minute second wday pm h2 m2 tl wday1
  14119 	iso-year iso-weekday iso-week iso-date futurep kill-year)
  14120     (setq org-read-date-analyze-futurep nil
  14121 	  org-read-date-analyze-forced-year nil)
  14122     (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans)
  14123       (setq ans "+0"))
  14124 
  14125     (when (setq delta (org-read-date-get-relative ans nil org-def))
  14126       (setq ans (replace-match "" t t ans)
  14127 	    deltan (car delta)
  14128 	    deltaw (nth 1 delta)
  14129 	    deltadef (nth 2 delta)))
  14130 
  14131     ;; Check if there is an iso week date in there.  If yes, store the
  14132     ;; info and postpone interpreting it until the rest of the parsing
  14133     ;; is done.
  14134     (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans)
  14135       (setq iso-year (when (match-end 1)
  14136 		       (org-small-year-to-year
  14137 			(string-to-number (match-string 1 ans))))
  14138 	    iso-weekday (when (match-end 3)
  14139 			  (string-to-number (match-string 3 ans)))
  14140 	    iso-week (string-to-number (match-string 2 ans)))
  14141       (setq ans (replace-match "" t t ans)))
  14142 
  14143     ;; Help matching ISO dates with single digit month or day, like 2006-8-11.
  14144     (when (string-match
  14145 	   "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans)
  14146       (setq year (if (match-end 2)
  14147 		     (string-to-number (match-string 2 ans))
  14148 		   (progn (setq kill-year t)
  14149 			  (string-to-number (format-time-string "%Y"))))
  14150 	    month (string-to-number (match-string 3 ans))
  14151 	    day (string-to-number (match-string 4 ans)))
  14152       (setq year (org-small-year-to-year year))
  14153       (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
  14154 			       t nil ans)))
  14155 
  14156     ;; Help matching dotted european dates
  14157     (when (string-match
  14158 	   "^ *\\(3[01]\\|0?[1-9]\\|[12][0-9]\\)\\. ?\\(0?[1-9]\\|1[012]\\)\\.\\( ?[1-9][0-9]\\{3\\}\\)?" ans)
  14159       (setq year (if (match-end 3) (string-to-number (match-string 3 ans))
  14160 		   (setq kill-year t)
  14161 		   (string-to-number (format-time-string "%Y")))
  14162 	    day (string-to-number (match-string 1 ans))
  14163 	    month (string-to-number (match-string 2 ans))
  14164 	    ans (replace-match (format "%04d-%02d-%02d" year month day)
  14165 			       t nil ans)))
  14166 
  14167     ;; Help matching american dates, like 5/30 or 5/30/7
  14168     (when (string-match
  14169 	   "^ *\\(0?[1-9]\\|1[012]\\)/\\(0?[1-9]\\|[12][0-9]\\|3[01]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans)
  14170       (setq year (if (match-end 4)
  14171 		     (string-to-number (match-string 4 ans))
  14172 		   (progn (setq kill-year t)
  14173 			  (string-to-number (format-time-string "%Y"))))
  14174 	    month (string-to-number (match-string 1 ans))
  14175 	    day (string-to-number (match-string 2 ans)))
  14176       (setq year (org-small-year-to-year year))
  14177       (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
  14178 			       t nil ans)))
  14179     ;; Help matching am/pm times, because `parse-time-string' does not do that.
  14180     ;; If there is a time with am/pm, and *no* time without it, we convert
  14181     ;; so that matching will be successful.
  14182     (cl-loop for i from 1 to 2 do	; twice, for end time as well
  14183 	     (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
  14184 			(string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans))
  14185 	       (setq hour (string-to-number (match-string 1 ans))
  14186 		     minute (if (match-end 3)
  14187 				(string-to-number (match-string 3 ans))
  14188 			      0)
  14189 		     pm (equal ?p
  14190 			       (string-to-char (downcase (match-string 4 ans)))))
  14191 	       (if (and (= hour 12) (not pm))
  14192 		   (setq hour 0)
  14193 		 (when (and pm (< hour 12)) (setq hour (+ 12 hour))))
  14194 	       (setq ans (replace-match (format "%02d:%02d" hour minute)
  14195 					t t ans))))
  14196 
  14197     ;; Help matching HHhMM times, similarly as for am/pm times.
  14198     (cl-loop for i from 1 to 2 do	; twice, for end time as well
  14199 	     (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
  14200 			(string-match "\\(?:\\(?1:[012]?[0-9]\\)?h\\(?2:[0-5][0-9]\\)\\)\\|\\(?:\\(?1:[012]?[0-9]\\)h\\(?2:[0-5][0-9]\\)?\\)\\>" ans))
  14201 	       (setq hour (if (match-end 1)
  14202 			      (string-to-number (match-string 1 ans))
  14203 			    0)
  14204 		     minute (if (match-end 2)
  14205 				(string-to-number (match-string 2 ans))
  14206 			      0))
  14207 	       (setq ans (replace-match (format "%02d:%02d" hour minute)
  14208 					t t ans))))
  14209 
  14210     ;; Check if a time range is given as a duration
  14211     (when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans)
  14212       (setq hour (string-to-number (match-string 1 ans))
  14213 	    h2 (+ hour (string-to-number (match-string 3 ans)))
  14214 	    minute (string-to-number (match-string 2 ans))
  14215 	    m2 (+ minute (if (match-end 5) (string-to-number
  14216 					    (match-string 5 ans))0)))
  14217       (when (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60)))
  14218       (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2)
  14219 			       t t ans)))
  14220 
  14221     ;; Check if there is a time range
  14222     (when (boundp 'org-end-time-was-given)
  14223       (setq org-time-was-given nil)
  14224       (when (and (string-match org-plain-time-of-day-regexp ans)
  14225 		 (match-end 8))
  14226 	(setq org-end-time-was-given (match-string 8 ans))
  14227 	(setq ans (concat (substring ans 0 (match-beginning 7))
  14228 			  (substring ans (match-end 7))))))
  14229 
  14230     (setq tl (parse-time-string ans)
  14231 	  day (or (nth 3 tl) (nth 3 org-defdecode))
  14232 	  month
  14233 	  (cond ((nth 4 tl))
  14234 		((not org-read-date-prefer-future) (nth 4 org-defdecode))
  14235 		;; Day was specified.  Make sure DAY+MONTH
  14236 		;; combination happens in the future.
  14237 		((nth 3 tl)
  14238 		 (setq futurep t)
  14239 		 (if (< day (nth 3 nowdecode)) (1+ (nth 4 nowdecode))
  14240 		   (nth 4 nowdecode)))
  14241 		(t (nth 4 org-defdecode)))
  14242 	  year
  14243 	  (cond ((and (not kill-year) (nth 5 tl)))
  14244 		((not org-read-date-prefer-future) (nth 5 org-defdecode))
  14245 		;; Month was guessed in the future and is at least
  14246 		;; equal to NOWDECODE's.  Fix year accordingly.
  14247 		(futurep
  14248 		 (if (or (> month (nth 4 nowdecode))
  14249 			 (>= day (nth 3 nowdecode)))
  14250 		     (nth 5 nowdecode)
  14251 		   (1+ (nth 5 nowdecode))))
  14252 		;; Month was specified.  Make sure MONTH+YEAR
  14253 		;; combination happens in the future.
  14254 		((nth 4 tl)
  14255 		 (setq futurep t)
  14256 		 (cond ((> month (nth 4 nowdecode)) (nth 5 nowdecode))
  14257 		       ((< month (nth 4 nowdecode)) (1+ (nth 5 nowdecode)))
  14258 		       ((< day (nth 3 nowdecode)) (1+ (nth 5 nowdecode)))
  14259 		       (t (nth 5 nowdecode))))
  14260 		(t (nth 5 org-defdecode)))
  14261 	  hour (or (nth 2 tl) (nth 2 org-defdecode))
  14262 	  minute (or (nth 1 tl) (nth 1 org-defdecode))
  14263 	  second (or (nth 0 tl) 0)
  14264 	  wday (nth 6 tl))
  14265 
  14266     (when (and (eq org-read-date-prefer-future 'time)
  14267 	       (not (nth 3 tl)) (not (nth 4 tl)) (not (nth 5 tl))
  14268 	       (equal day (nth 3 nowdecode))
  14269 	       (equal month (nth 4 nowdecode))
  14270 	       (equal year (nth 5 nowdecode))
  14271 	       (nth 2 tl)
  14272 	       (or (< (nth 2 tl) (nth 2 nowdecode))
  14273 		   (and (= (nth 2 tl) (nth 2 nowdecode))
  14274 			(nth 1 tl)
  14275 			(< (nth 1 tl) (nth 1 nowdecode)))))
  14276       (setq day (1+ day)
  14277 	    futurep t))
  14278 
  14279     ;; Special date definitions below
  14280     (cond
  14281      (iso-week
  14282       ;; There was an iso week
  14283       (require 'cal-iso)
  14284       (setq futurep nil)
  14285       (setq year (or iso-year year)
  14286 	    day (or iso-weekday wday 1)
  14287 	    wday nil ; to make sure that the trigger below does not match
  14288 	    iso-date (calendar-gregorian-from-absolute
  14289 		      (calendar-iso-to-absolute
  14290 		       (list iso-week day year))))
  14291 					; FIXME:  Should we also push ISO weeks into the future?
  14292 					;      (when (and org-read-date-prefer-future
  14293 					;		 (not iso-year)
  14294 					;		 (< (calendar-absolute-from-gregorian iso-date)
  14295 					;		    (time-to-days nil)))
  14296 					;	(setq year (1+ year)
  14297 					;	      iso-date (calendar-gregorian-from-absolute
  14298 					;			(calendar-iso-to-absolute
  14299 					;			 (list iso-week day year)))))
  14300       (setq month (car iso-date)
  14301 	    year (nth 2 iso-date)
  14302 	    day (nth 1 iso-date)))
  14303      (deltan
  14304       (setq futurep nil)
  14305       (unless deltadef
  14306 	(let ((now (decode-time)))
  14307 	  (setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
  14308       (cond ((member deltaw '("d" "")) (setq day (+ day deltan)))
  14309 	    ((equal deltaw "w") (setq day (+ day (* 7 deltan))))
  14310 	    ((equal deltaw "m") (setq month (+ month deltan)))
  14311 	    ((equal deltaw "y") (setq year (+ year deltan)))))
  14312      ((and wday (not (nth 3 tl)))
  14313       ;; Weekday was given, but no day, so pick that day in the week
  14314       ;; on or after the derived date.
  14315       (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year))))
  14316       (unless (equal wday wday1)
  14317 	(setq day (+ day (% (- wday wday1 -7) 7))))))
  14318     (when (and (boundp 'org-time-was-given)
  14319 	       (nth 2 tl))
  14320       (setq org-time-was-given t))
  14321     (when (< year 100) (setq year (+ 2000 year)))
  14322     ;; Check of the date is representable
  14323     (if org-read-date-force-compatible-dates
  14324 	(progn
  14325 	  (when (< year 1970)
  14326 	    (setq year 1970 org-read-date-analyze-forced-year t))
  14327 	  (when (> year 2037)
  14328 	    (setq year 2037 org-read-date-analyze-forced-year t)))
  14329       (condition-case nil
  14330 	  (ignore (encode-time second minute hour day month year))
  14331 	(error
  14332 	 (setq year (nth 5 org-defdecode))
  14333 	 (setq org-read-date-analyze-forced-year t))))
  14334     (setq org-read-date-analyze-futurep futurep)
  14335     (list second minute hour day month year)))
  14336 
  14337 (defvar parse-time-weekdays)
  14338 (defun org-read-date-get-relative (s today default)
  14339   "Check string S for special relative date string.
  14340 TODAY and DEFAULT are internal times, for today and for a default.
  14341 Return shift list (N what def-flag)
  14342 WHAT       is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year.
  14343 N          is the number of WHATs to shift.
  14344 DEF-FLAG   is t when a double ++ or -- indicates shift relative to
  14345            the DEFAULT date rather than TODAY."
  14346   (require 'parse-time)
  14347   (when (and
  14348 	 (string-match
  14349 	  (concat
  14350 	   "\\`[ \t]*\\([-+]\\{0,2\\}\\)"
  14351 	   "\\([0-9]+\\)?"
  14352 	   "\\([hdwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?"
  14353 	   "\\([ \t]\\|$\\)") s)
  14354 	 (or (> (match-end 1) (match-beginning 1)) (match-end 4)))
  14355     (let* ((dir (if (> (match-end 1) (match-beginning 1))
  14356 		    (string-to-char (substring (match-string 1 s) -1))
  14357 		  ?+))
  14358 	   (rel (and (match-end 1) (= 2 (- (match-end 1) (match-beginning 1)))))
  14359 	   (n (if (match-end 2) (string-to-number (match-string 2 s)) 1))
  14360 	   (what (if (match-end 3) (match-string 3 s) "d"))
  14361 	   (wday1 (cdr (assoc (downcase what) parse-time-weekdays)))
  14362 	   (date (if rel default today))
  14363 	   (wday (nth 6 (decode-time date)))
  14364 	   delta)
  14365       (if wday1
  14366 	  (progn
  14367 	    (setq delta (mod (+ 7 (- wday1 wday)) 7))
  14368 	    (when (= delta 0) (setq delta 7))
  14369 	    (when (= dir ?-)
  14370 	      (setq delta (- delta 7))
  14371 	      (when (= delta 0) (setq delta -7)))
  14372 	    (when (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7)))))
  14373 	    (list delta "d" rel))
  14374 	(list (* n (if (= dir ?-) -1 1)) what rel)))))
  14375 
  14376 (defun org-order-calendar-date-args (arg1 arg2 arg3)
  14377   "Turn a user-specified date into the internal representation.
  14378 The internal representation needed by the calendar is (month day year).
  14379 This is a wrapper to handle the brain-dead convention in calendar that
  14380 user function argument order change dependent on argument order."
  14381   (pcase calendar-date-style
  14382     (`american (list arg1 arg2 arg3))
  14383     (`european (list arg2 arg1 arg3))
  14384     (`iso (list arg2 arg3 arg1))))
  14385 
  14386 (defun org-eval-in-calendar (form &optional keepdate)
  14387   "Eval FORM in the calendar window and return to current window.
  14388 Unless KEEPDATE is non-nil, update `org-ans2' to the cursor date."
  14389   (let ((sf (selected-frame))
  14390 	(sw (selected-window)))
  14391     (select-window (get-buffer-window "*Calendar*" t))
  14392     (eval form)
  14393     (when (and (not keepdate) (calendar-cursor-to-date))
  14394       (let* ((date (calendar-cursor-to-date))
  14395 	     (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
  14396 	(setq org-ans2 (format-time-string "%Y-%m-%d" time))))
  14397     (move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))
  14398     (select-window sw)
  14399     (select-frame-set-input-focus sf)))
  14400 
  14401 (defun org-calendar-select ()
  14402   "Return to `org-read-date' with the date currently selected.
  14403 This is used by `org-read-date' in a temporary keymap for the calendar buffer."
  14404   (interactive)
  14405   (when (calendar-cursor-to-date)
  14406     (let* ((date (calendar-cursor-to-date))
  14407 	   (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
  14408       (setq org-ans1 (format-time-string "%Y-%m-%d" time)))
  14409     (when (active-minibuffer-window) (exit-minibuffer))))
  14410 
  14411 (defun org-insert-time-stamp (time &optional with-hm inactive pre post extra)
  14412   "Insert a date stamp for the date given by the internal TIME.
  14413 See `format-time-string' for the format of TIME.
  14414 WITH-HM means use the stamp format that includes the time of the day.
  14415 INACTIVE means use square brackets instead of angular ones, so that the
  14416 stamp will not contribute to the agenda.
  14417 PRE and POST are optional strings to be inserted before and after the
  14418 stamp.
  14419 The command returns the inserted time stamp."
  14420   (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats))
  14421 	stamp)
  14422     (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]")))
  14423     (insert-before-markers (or pre ""))
  14424     (when (listp extra)
  14425       (setq extra (car extra))
  14426       (if (and (stringp extra)
  14427 	       (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra))
  14428 	  (setq extra (format "-%02d:%02d"
  14429 			      (string-to-number (match-string 1 extra))
  14430 			      (string-to-number (match-string 2 extra))))
  14431 	(setq extra nil)))
  14432     (when extra
  14433       (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1))))
  14434     (insert-before-markers (setq stamp (format-time-string fmt time)))
  14435     (insert-before-markers (or post ""))
  14436     (setq org-last-inserted-timestamp stamp)))
  14437 
  14438 (defun org-toggle-time-stamp-overlays ()
  14439   "Toggle the use of custom time stamp formats."
  14440   (interactive)
  14441   (setq org-display-custom-times (not org-display-custom-times))
  14442   (unless org-display-custom-times
  14443     (let ((p (point-min)) (bmp (buffer-modified-p)))
  14444       (while (setq p (next-single-property-change p 'display))
  14445 	(when (and (get-text-property p 'display)
  14446 		   (eq (get-text-property p 'face) 'org-date))
  14447 	  (remove-text-properties
  14448 	   p (setq p (next-single-property-change p 'display))
  14449 	   '(display t))))
  14450       (set-buffer-modified-p bmp)))
  14451   (org-restart-font-lock)
  14452   (setq org-table-may-need-update t)
  14453   (if org-display-custom-times
  14454       (message "Time stamps are overlaid with custom format")
  14455     (message "Time stamp overlays removed")))
  14456 
  14457 (defun org-display-custom-time (beg end)
  14458   "Overlay modified time stamp format over timestamp between BEG and END."
  14459   (let* ((ts (buffer-substring beg end))
  14460 	 t1 with-hm tf time str (off 0))
  14461     (save-match-data
  14462       (setq t1 (org-parse-time-string ts t))
  14463       (when (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts)
  14464 	(setq off (- (match-end 0) (match-beginning 0)))))
  14465     (setq end (- end off))
  14466     (setq with-hm (and (nth 1 t1) (nth 2 t1))
  14467 	  tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats)
  14468 	  time (org-fix-decoded-time t1)
  14469 	  str (org-add-props
  14470 		  (format-time-string
  14471 		   (substring tf 1 -1) (apply 'encode-time time))
  14472 		  nil 'mouse-face 'highlight))
  14473     (put-text-property beg end 'display str)))
  14474 
  14475 (defun org-fix-decoded-time (time)
  14476   "Set 0 instead of nil for the first 6 elements of time.
  14477 Don't touch the rest."
  14478   (let ((n 0))
  14479     (mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time)))
  14480 
  14481 (defun org-time-stamp-to-now (timestamp-string &optional seconds)
  14482   "Difference between TIMESTAMP-STRING and now in days.
  14483 If SECONDS is non-nil, return the difference in seconds."
  14484   (let ((fdiff (if seconds #'float-time #'time-to-days)))
  14485     (- (funcall fdiff (org-time-string-to-time timestamp-string))
  14486        (funcall fdiff nil))))
  14487 
  14488 (defun org-deadline-close-p (timestamp-string &optional ndays)
  14489   "Is the time in TIMESTAMP-STRING close to the current date?"
  14490   (setq ndays (or ndays (org-get-wdays timestamp-string)))
  14491   (and (<= (org-time-stamp-to-now timestamp-string) ndays)
  14492        (not (org-entry-is-done-p))))
  14493 
  14494 (defun org-get-wdays (ts &optional delay zero-delay)
  14495   "Get the deadline lead time appropriate for timestring TS.
  14496 When DELAY is non-nil, get the delay time for scheduled items
  14497 instead of the deadline lead time.  When ZERO-DELAY is non-nil
  14498 and `org-scheduled-delay-days' is 0, enforce 0 as the delay,
  14499 don't try to find the delay cookie in the scheduled timestamp."
  14500   (let ((tv (if delay org-scheduled-delay-days
  14501 	      org-deadline-warning-days)))
  14502     (cond
  14503      ((or (and delay (< tv 0))
  14504 	  (and delay zero-delay (<= tv 0))
  14505 	  (and (not delay) (<= tv 0)))
  14506       ;; Enforce this value no matter what
  14507       (- tv))
  14508      ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts)
  14509       ;; lead time is specified.
  14510       (floor (* (string-to-number (match-string 1 ts))
  14511 		(cdr (assoc (match-string 2 ts)
  14512 			    '(("d" . 1)    ("w" . 7)
  14513 			      ("m" . 30.4) ("y" . 365.25)
  14514 			      ("h" . 0.041667)))))))
  14515      ;; go for the default.
  14516      (t tv))))
  14517 
  14518 (defun org-calendar-select-mouse (ev)
  14519   "Return to `org-read-date' with the date currently selected.
  14520 This is used by `org-read-date' in a temporary keymap for the calendar buffer."
  14521   (interactive "e")
  14522   (mouse-set-point ev)
  14523   (when (calendar-cursor-to-date)
  14524     (let* ((date (calendar-cursor-to-date))
  14525 	   (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
  14526       (setq org-ans1 (format-time-string "%Y-%m-%d" time)))
  14527     (when (active-minibuffer-window) (exit-minibuffer))))
  14528 
  14529 (defun org-check-deadlines (ndays)
  14530   "Check if there are any deadlines due or past due.
  14531 A deadline is considered due if it happens within `org-deadline-warning-days'
  14532 days from today's date.  If the deadline appears in an entry marked DONE,
  14533 it is not shown.  A numeric prefix argument NDAYS can be used to test that
  14534 many days.  If the prefix is a raw `\\[universal-argument]', all deadlines \
  14535 are shown."
  14536   (interactive "P")
  14537   (let* ((org-warn-days
  14538 	  (cond
  14539 	   ((equal ndays '(4)) 100000)
  14540 	   (ndays (prefix-numeric-value ndays))
  14541 	   (t (abs org-deadline-warning-days))))
  14542 	 (case-fold-search nil)
  14543 	 (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>"))
  14544 	 (callback
  14545 	  (lambda () (org-deadline-close-p (match-string 1) org-warn-days))))
  14546     (message "%d deadlines past-due or due within %d days"
  14547 	     (org-occur regexp nil callback)
  14548 	     org-warn-days)))
  14549 
  14550 (defsubst org-re-timestamp (type)
  14551   "Return a regexp for timestamp TYPE.
  14552 Allowed values for TYPE are:
  14553 
  14554         all: all timestamps
  14555      active: only active timestamps (<...>)
  14556    inactive: only inactive timestamps ([...])
  14557   scheduled: only scheduled timestamps
  14558    deadline: only deadline timestamps
  14559      closed: only closed time-stamps
  14560 
  14561 When TYPE is nil, fall back on returning a regexp that matches
  14562 both scheduled and deadline timestamps."
  14563   (cl-case type
  14564     (all org-ts-regexp-both)
  14565     (active org-ts-regexp)
  14566     (inactive org-ts-regexp-inactive)
  14567     (scheduled org-scheduled-time-regexp)
  14568     (deadline org-deadline-time-regexp)
  14569     (closed org-closed-time-regexp)
  14570     (otherwise
  14571      (concat "\\<"
  14572 	     (regexp-opt (list org-deadline-string org-scheduled-string))
  14573 	     " *<\\([^>]+\\)>"))))
  14574 
  14575 (defun org-check-before-date (d)
  14576   "Check if there are deadlines or scheduled entries before date D."
  14577   (interactive (list (org-read-date)))
  14578   (let* ((case-fold-search nil)
  14579 	 (regexp (org-re-timestamp org-ts-type))
  14580 	 (ts-type org-ts-type)
  14581 	 (callback
  14582 	  (lambda ()
  14583 	    (let ((match (match-string 1)))
  14584 	      (and (if (memq ts-type '(active inactive all))
  14585 		       (eq (org-element-type (save-excursion
  14586 					       (backward-char)
  14587 					       (org-element-context)))
  14588 			   'timestamp)
  14589 		     (org-at-planning-p))
  14590 		   (time-less-p
  14591 		    (org-time-string-to-time match)
  14592 		    (org-time-string-to-time d)))))))
  14593     (message "%d entries before %s"
  14594 	     (org-occur regexp nil callback)
  14595 	     d)))
  14596 
  14597 (defun org-check-after-date (d)
  14598   "Check if there are deadlines or scheduled entries after date D."
  14599   (interactive (list (org-read-date)))
  14600   (let* ((case-fold-search nil)
  14601 	 (regexp (org-re-timestamp org-ts-type))
  14602 	 (ts-type org-ts-type)
  14603 	 (callback
  14604 	  (lambda ()
  14605 	    (let ((match (match-string 1)))
  14606 	      (and (if (memq ts-type '(active inactive all))
  14607 		       (eq (org-element-type (save-excursion
  14608 					       (backward-char)
  14609 					       (org-element-context)))
  14610 			   'timestamp)
  14611 		     (org-at-planning-p))
  14612 		   (not (time-less-p
  14613 			 (org-time-string-to-time match)
  14614 			 (org-time-string-to-time d))))))))
  14615     (message "%d entries after %s"
  14616 	     (org-occur regexp nil callback)
  14617 	     d)))
  14618 
  14619 (defun org-check-dates-range (start-date end-date)
  14620   "Check for deadlines/scheduled entries between START-DATE and END-DATE."
  14621   (interactive (list (org-read-date nil nil nil "Range starts")
  14622 		     (org-read-date nil nil nil "Range end")))
  14623   (let ((case-fold-search nil)
  14624 	(regexp (org-re-timestamp org-ts-type))
  14625 	(callback
  14626 	 (let ((type org-ts-type))
  14627 	   (lambda ()
  14628 	     (let ((match (match-string 1)))
  14629 	       (and
  14630 		(if (memq type '(active inactive all))
  14631 		    (eq (org-element-type (save-excursion
  14632 					    (backward-char)
  14633 					    (org-element-context)))
  14634 			'timestamp)
  14635 		  (org-at-planning-p))
  14636 		(not (time-less-p
  14637 		      (org-time-string-to-time match)
  14638 		      (org-time-string-to-time start-date)))
  14639 		(time-less-p
  14640 		 (org-time-string-to-time match)
  14641 		 (org-time-string-to-time end-date))))))))
  14642     (message "%d entries between %s and %s"
  14643 	     (org-occur regexp nil callback) start-date end-date)))
  14644 
  14645 (defun org-evaluate-time-range (&optional to-buffer)
  14646   "Evaluate a time range by computing the difference between start and end.
  14647 Normally the result is just printed in the echo area, but with prefix arg
  14648 TO-BUFFER, the result is inserted just after the date stamp into the buffer.
  14649 If the time range is actually in a table, the result is inserted into the
  14650 next column.
  14651 For time difference computation, a year is assumed to be exactly 365
  14652 days in order to avoid rounding problems."
  14653   (interactive "P")
  14654   (or
  14655    (org-clock-update-time-maybe)
  14656    (save-excursion
  14657      (unless (org-at-date-range-p t)
  14658        (goto-char (point-at-bol))
  14659        (re-search-forward org-tr-regexp-both (point-at-eol) t))
  14660      (unless (org-at-date-range-p t)
  14661        (user-error "Not at a time-stamp range, and none found in current line")))
  14662    (let* ((ts1 (match-string 1))
  14663 	  (ts2 (match-string 2))
  14664 	  (havetime (or (> (length ts1) 15) (> (length ts2) 15)))
  14665 	  (match-end (match-end 0))
  14666 	  (time1 (org-time-string-to-time ts1))
  14667 	  (time2 (org-time-string-to-time ts2))
  14668 	  (diff (abs (float-time (time-subtract time2 time1))))
  14669 	  (negative (time-less-p time2 time1))
  14670 	  ;; (ys (floor (* 365 24 60 60)))
  14671 	  (ds (* 24 60 60))
  14672 	  (hs (* 60 60))
  14673 	  (fy "%dy %dd %02d:%02d")
  14674 	  (fy1 "%dy %dd")
  14675 	  (fd "%dd %02d:%02d")
  14676 	  (fd1 "%dd")
  14677 	  (fh "%02d:%02d")
  14678 	  y d h m align)
  14679      (if havetime
  14680 	 (setq ; y (floor diff ys)  diff (mod diff ys)
  14681 	  y 0
  14682 	  d (floor diff ds)  diff (mod diff ds)
  14683 	  h (floor diff hs)  diff (mod diff hs)
  14684 	  m (floor diff 60))
  14685        (setq ; y (floor diff ys)  diff (mod diff ys)
  14686 	y 0
  14687 	d (round diff ds)
  14688 	h 0 m 0))
  14689      (if (not to-buffer)
  14690 	 (message "%s" (org-make-tdiff-string y d h m))
  14691        (if (org-at-table-p)
  14692 	   (progn
  14693 	     (goto-char match-end)
  14694 	     (setq align t)
  14695 	     (and (looking-at " *|") (goto-char (match-end 0))))
  14696 	 (goto-char match-end))
  14697        (when (looking-at
  14698 	      "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]")
  14699 	 (replace-match ""))
  14700        (when negative (insert " -"))
  14701        (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m))
  14702 	 (if (> d 0) (insert " " (format (if havetime fd fd1) d h m))
  14703 	   (insert " " (format fh h m))))
  14704        (when align (org-table-align))
  14705        (message "Time difference inserted")))))
  14706 
  14707 (defun org-make-tdiff-string (y d h m)
  14708   (let ((fmt "")
  14709 	(l nil))
  14710     (when (> y 0)
  14711       (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " "))
  14712       (push y l))
  14713     (when (> d 0)
  14714       (setq fmt (concat fmt "%d day"  (if (> d 1) "s" "") " "))
  14715       (push d l))
  14716     (when (> h 0)
  14717       (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " "))
  14718       (push h l))
  14719     (when (> m 0)
  14720       (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " "))
  14721       (push m l))
  14722     (apply 'format fmt (nreverse l))))
  14723 
  14724 (defun org-time-string-to-time (s)
  14725   "Convert timestamp string S into internal time."
  14726   (apply #'encode-time (org-parse-time-string s)))
  14727 
  14728 (defun org-time-string-to-seconds (s)
  14729   "Convert a timestamp string S into a number of seconds."
  14730   (float-time (org-time-string-to-time s)))
  14731 
  14732 (org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp")
  14733 
  14734 (defun org-time-string-to-absolute (s &optional daynr prefer buffer pos)
  14735   "Convert time stamp S to an absolute day number.
  14736 
  14737 If DAYNR in non-nil, and there is a specifier for a cyclic time
  14738 stamp, get the closest date to DAYNR.  If PREFER is
  14739 `past' (respectively `future') return a date past (respectively
  14740 after) or equal to DAYNR.
  14741 
  14742 POS is the location of time stamp S, as a buffer position in
  14743 BUFFER.
  14744 
  14745 Diary sexp timestamps are matched against DAYNR, when non-nil.
  14746 If matching fails or DAYNR is nil, `org-diary-sexp-no-match' is
  14747 signaled."
  14748   (cond
  14749    ((string-match "\\`%%\\((.*)\\)" s)
  14750     ;; Sexp timestamp: try to match DAYNR, if available, since we're
  14751     ;; only able to match individual dates.  If it fails, raise an
  14752     ;; error.
  14753     (if (and daynr
  14754 	     (org-diary-sexp-entry
  14755 	      (match-string 1 s) "" (calendar-gregorian-from-absolute daynr)))
  14756 	daynr
  14757       (signal 'org-diary-sexp-no-match (list s))))
  14758    (daynr (org-closest-date s daynr prefer))
  14759    (t (time-to-days
  14760        (condition-case errdata
  14761 	   (org-time-string-to-time s)
  14762 	 (error (error "Bad timestamp `%s'%s\nError was: %s"
  14763 		       s
  14764 		       (if (not (and buffer pos)) ""
  14765 			 (format-message " at %d in buffer `%s'" pos buffer))
  14766 		       (cdr errdata))))))))
  14767 
  14768 (defun org-days-to-iso-week (days)
  14769   "Return the ISO week number."
  14770   (require 'cal-iso)
  14771   (car (calendar-iso-from-absolute days)))
  14772 
  14773 (defun org-small-year-to-year (year)
  14774   "Convert 2-digit years into 4-digit years.
  14775 YEAR is expanded into one of the 30 next years, if possible, or
  14776 into a past one.  Any year larger than 99 is returned unchanged."
  14777   (if (>= year 100) year
  14778     (let* ((current (string-to-number (format-time-string "%Y")))
  14779 	   (century (/ current 100))
  14780 	   (offset (- year (% current 100))))
  14781       (cond ((> offset 30) (+ (* (1- century) 100) year))
  14782 	    ((> offset -70) (+ (* century 100) year))
  14783 	    (t (+ (* (1+ century) 100) year))))))
  14784 
  14785 (defun org-time-from-absolute (d)
  14786   "Return the time corresponding to date D.
  14787 D may be an absolute day number, or a calendar-type list (month day year)."
  14788   (when (numberp d) (setq d (calendar-gregorian-from-absolute d)))
  14789   (encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d)))
  14790 
  14791 (defvar org-agenda-current-date)
  14792 (defun org-calendar-holiday ()
  14793   "List of holidays, for Diary display in Org mode."
  14794   (require 'holidays)
  14795   (let ((hl (calendar-check-holidays org-agenda-current-date)))
  14796     (and hl (mapconcat #'identity hl "; "))))
  14797 
  14798 (defun org-diary-sexp-entry (sexp entry d)
  14799   "Process a SEXP diary ENTRY for date D."
  14800   (require 'diary-lib)
  14801   ;; `org-anniversary' and alike expect ENTRY and DATE to be bound
  14802   ;; dynamically.
  14803   (let* ((sexp `(let ((entry ,entry)
  14804 		      (date ',d))
  14805 		  ,(car (read-from-string sexp))))
  14806 	 (result (if calendar-debug-sexp (eval sexp)
  14807 		   (condition-case nil
  14808 		       (eval sexp)
  14809 		     (error
  14810 		      (beep)
  14811 		      (message "Bad sexp at line %d in %s: %s"
  14812 			       (org-current-line)
  14813 			       (buffer-file-name) sexp)
  14814 		      (sleep-for 2))))))
  14815     (cond ((stringp result) (split-string result "; "))
  14816 	  ((and (consp result)
  14817 		(not (consp (cdr result)))
  14818 		(stringp (cdr result))) (cdr result))
  14819 	  ((and (consp result)
  14820 		(stringp (car result))) result)
  14821 	  (result entry))))
  14822 
  14823 (defun org-diary-to-ical-string (frombuf)
  14824   "Get iCalendar entries from diary entries in buffer FROMBUF.
  14825 This uses the icalendar.el library."
  14826   (let* ((tmpdir temporary-file-directory)
  14827 	 (tmpfile (make-temp-name
  14828 		   (expand-file-name "orgics" tmpdir)))
  14829 	 buf rtn b e)
  14830     (with-current-buffer frombuf
  14831       (icalendar-export-region (point-min) (point-max) tmpfile)
  14832       (setq buf (find-buffer-visiting tmpfile))
  14833       (set-buffer buf)
  14834       (goto-char (point-min))
  14835       (when (re-search-forward "^BEGIN:VEVENT" nil t)
  14836 	(setq b (match-beginning 0)))
  14837       (goto-char (point-max))
  14838       (when (re-search-backward "^END:VEVENT" nil t)
  14839 	(setq e (match-end 0)))
  14840       (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") "")))
  14841     (kill-buffer buf)
  14842     (delete-file tmpfile)
  14843     rtn))
  14844 
  14845 (defun org-closest-date (start current prefer)
  14846   "Return closest date to CURRENT starting from START.
  14847 
  14848 CURRENT and START are both time stamps.
  14849 
  14850 When PREFER is `past', return a date that is either CURRENT or
  14851 past.  When PREFER is `future', return a date that is either
  14852 CURRENT or future.
  14853 
  14854 Only time stamps with a repeater are modified.  Any other time
  14855 stamp stay unchanged.  In any case, return value is an absolute
  14856 day number."
  14857   (if (not (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)" start))
  14858       ;; No repeater.  Do not shift time stamp.
  14859       (time-to-days (org-time-string-to-time start))
  14860     (let ((value (string-to-number (match-string 1 start)))
  14861 	  (type (match-string 2 start)))
  14862       (if (= 0 value)
  14863 	  ;; Repeater with a 0-value is considered as void.
  14864 	  (time-to-days (org-time-string-to-time start))
  14865 	(let* ((base (org-date-to-gregorian start))
  14866 	       (target (org-date-to-gregorian current))
  14867 	       (sday (calendar-absolute-from-gregorian base))
  14868 	       (cday (calendar-absolute-from-gregorian target))
  14869 	       n1 n2)
  14870 	  ;; If START is already past CURRENT, just return START.
  14871 	  (if (<= cday sday) sday
  14872 	    ;; Compute closest date before (N1) and closest date past
  14873 	    ;; (N2) CURRENT.
  14874 	    (pcase type
  14875 	      ("h"
  14876 	       (let ((missing-hours
  14877 		      (mod (+ (- (* 24 (- cday sday))
  14878 				 (nth 2 (org-parse-time-string start)))
  14879 			      org-extend-today-until)
  14880 			   value)))
  14881 		 (setf n1 (if (= missing-hours 0) cday
  14882 			    (- cday (1+ (/ missing-hours 24)))))
  14883 		 (setf n2 (+ cday (/ (- value missing-hours) 24)))))
  14884 	      ((or "d" "w")
  14885 	       (let ((value (if (equal type "w") (* 7 value) value)))
  14886 		 (setf n1 (+ sday (* value (/ (- cday sday) value))))
  14887 		 (setf n2 (+ n1 value))))
  14888 	      ("m"
  14889 	       (let* ((add-months
  14890 		       (lambda (d n)
  14891 			 ;; Add N months to gregorian date D, i.e.,
  14892 			 ;; a list (MONTH DAY YEAR).  Return a valid
  14893 			 ;; gregorian date.
  14894 			 (let ((m (+ (nth 0 d) n)))
  14895 			   (list (mod m 12)
  14896 				 (nth 1 d)
  14897 				 (+ (/ m 12) (nth 2 d))))))
  14898 		      (months		; Complete months to TARGET.
  14899 		       (* (/ (+ (* 12 (- (nth 2 target) (nth 2 base)))
  14900 				(- (nth 0 target) (nth 0 base))
  14901 				;; If START's day is greater than
  14902 				;; TARGET's, remove incomplete month.
  14903 				(if (> (nth 1 target) (nth 1 base)) 0 -1))
  14904 			     value)
  14905 			  value))
  14906 		      (before (funcall add-months base months)))
  14907 		 (setf n1 (calendar-absolute-from-gregorian before))
  14908 		 (setf n2
  14909 		       (calendar-absolute-from-gregorian
  14910 			(funcall add-months before value)))))
  14911 	      (_
  14912 	       (let* ((d (nth 1 base))
  14913 		      (m (nth 0 base))
  14914 		      (y (nth 2 base))
  14915 		      (years		; Complete years to TARGET.
  14916 		       (* (/ (- (nth 2 target)
  14917 				y
  14918 				;; If START's month and day are
  14919 				;; greater than TARGET's, remove
  14920 				;; incomplete year.
  14921 				(if (or (> (nth 0 target) m)
  14922 					(and (= (nth 0 target) m)
  14923 					     (> (nth 1 target) d)))
  14924 				    0
  14925 				  1))
  14926 			     value)
  14927 			  value))
  14928 		      (before (list m d (+ y years))))
  14929 		 (setf n1 (calendar-absolute-from-gregorian before))
  14930 		 (setf n2 (calendar-absolute-from-gregorian
  14931 			   (list m d (+ (nth 2 before) value)))))))
  14932 	    ;; Handle PREFER parameter, if any.
  14933 	    (cond
  14934 	     ((eq prefer 'past)   (if (= cday n2) n2 n1))
  14935 	     ((eq prefer 'future) (if (= cday n1) n1 n2))
  14936 	     (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1)))))))))
  14937 
  14938 (defun org-date-to-gregorian (d)
  14939   "Turn any specification of date D into a Gregorian date for the calendar."
  14940   (cond ((integerp d) (calendar-gregorian-from-absolute d))
  14941 	((and (listp d) (= (length d) 3)) d)
  14942 	((stringp d)
  14943 	 (let ((d (org-parse-time-string d)))
  14944 	   (list (nth 4 d) (nth 3 d) (nth 5 d))))
  14945 	((listp d) (list (nth 4 d) (nth 3 d) (nth 5 d)))))
  14946 
  14947 (defun org-timestamp-up (&optional arg)
  14948   "Increase the date item at the cursor by one.
  14949 If the cursor is on the year, change the year.  If it is on the month,
  14950 the day or the time, change that.  If the cursor is on the enclosing
  14951 bracket, change the timestamp type.
  14952 With prefix ARG, change by that many units."
  14953   (interactive "p")
  14954   (org-timestamp-change (prefix-numeric-value arg) nil 'updown))
  14955 
  14956 (defun org-timestamp-down (&optional arg)
  14957   "Decrease the date item at the cursor by one.
  14958 If the cursor is on the year, change the year.  If it is on the month,
  14959 the day or the time, change that.  If the cursor is on the enclosing
  14960 bracket, change the timestamp type.
  14961 With prefix ARG, change by that many units."
  14962   (interactive "p")
  14963   (org-timestamp-change (- (prefix-numeric-value arg)) nil 'updown))
  14964 
  14965 (defun org-timestamp-up-day (&optional arg)
  14966   "Increase the date in the time stamp by one day.
  14967 With prefix ARG, change that many days."
  14968   (interactive "p")
  14969   (if (and (not (org-at-timestamp-p 'lax))
  14970 	   (org-at-heading-p))
  14971       (org-todo 'up)
  14972     (org-timestamp-change (prefix-numeric-value arg) 'day 'updown)))
  14973 
  14974 (defun org-timestamp-down-day (&optional arg)
  14975   "Decrease the date in the time stamp by one day.
  14976 With prefix ARG, change that many days."
  14977   (interactive "p")
  14978   (if (and (not (org-at-timestamp-p 'lax))
  14979 	   (org-at-heading-p))
  14980       (org-todo 'down)
  14981     (org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown))
  14982 
  14983 (defun org-at-timestamp-p (&optional extended)
  14984   "Non-nil if point is inside a timestamp.
  14985 
  14986 By default, the function only consider syntactically valid active
  14987 timestamps.  However, the caller may have a broader definition
  14988 for timestamps.  As a consequence, optional argument EXTENDED can
  14989 be set to the following values
  14990 
  14991   `inactive'
  14992 
  14993     Include also syntactically valid inactive timestamps.
  14994 
  14995   `agenda'
  14996 
  14997     Include timestamps allowed in Agenda, i.e., those in
  14998     properties drawers, planning lines and clock lines.
  14999 
  15000   `lax'
  15001 
  15002     Ignore context.  The function matches any part of the
  15003     document looking like a timestamp.  This includes comments,
  15004     example blocks...
  15005 
  15006 For backward-compatibility with Org 9.0, every other non-nil
  15007 value is equivalent to `inactive'.
  15008 
  15009 When at a timestamp, return the position of the point as a symbol
  15010 among `bracket', `after', `year', `month', `hour', `minute',
  15011 `day' or a number of character from the last know part of the
  15012 time stamp.
  15013 
  15014 When matching, the match groups are the following:
  15015   group 1: year
  15016   group 2: month
  15017   group 3: day number
  15018   group 4: day name
  15019   group 5: hours, if any
  15020   group 6: minutes, if any"
  15021   (let* ((regexp (if extended org-ts-regexp3 org-ts-regexp2))
  15022 	 (pos (point))
  15023 	 (match?
  15024 	  (let ((boundaries (org-in-regexp regexp)))
  15025 	    (save-match-data
  15026 	      (cond ((null boundaries) nil)
  15027 		    ((eq extended 'lax) t)
  15028 		    (t
  15029 		     (or (and (eq extended 'agenda)
  15030 			      (or (org-at-planning-p)
  15031 				  (org-at-property-p)
  15032 				  (and (bound-and-true-p
  15033 					org-agenda-include-inactive-timestamps)
  15034 				       (org-at-clock-log-p))))
  15035 			 (eq 'timestamp
  15036 			     (save-excursion
  15037 			       (when (= pos (cdr boundaries)) (forward-char -1))
  15038 			       (org-element-type (org-element-context)))))))))))
  15039     (cond
  15040      ((not match?)                        nil)
  15041      ((= pos (match-beginning 0))         'bracket)
  15042      ;; Distinguish location right before the closing bracket from
  15043      ;; right after it.
  15044      ((= pos (1- (match-end 0)))          'bracket)
  15045      ((= pos (match-end 0))               'after)
  15046      ((org-pos-in-match-range pos 2)      'year)
  15047      ((org-pos-in-match-range pos 3)      'month)
  15048      ((org-pos-in-match-range pos 7)      'hour)
  15049      ((org-pos-in-match-range pos 8)      'minute)
  15050      ((or (org-pos-in-match-range pos 4)
  15051 	  (org-pos-in-match-range pos 5)) 'day)
  15052      ((and (> pos (or (match-end 8) (match-end 5)))
  15053 	   (< pos (match-end 0)))
  15054       (- pos (or (match-end 8) (match-end 5))))
  15055      (t                                   'day))))
  15056 
  15057 (defun org-toggle-timestamp-type ()
  15058   "Toggle the type (<active> or [inactive]) of a time stamp."
  15059   (interactive)
  15060   (when (org-at-timestamp-p 'lax)
  15061     (let ((beg (match-beginning 0)) (end (match-end 0))
  15062 	  (map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]"))))
  15063       (save-excursion
  15064 	(goto-char beg)
  15065 	(while (re-search-forward "[][<>]" end t)
  15066 	  (replace-match (cdr (assoc (char-after (match-beginning 0)) map))
  15067 			 t t)))
  15068       (message "Timestamp is now %sactive"
  15069 	       (if (equal (char-after beg) ?<) "" "in")))))
  15070 
  15071 (defun org-at-clock-log-p ()
  15072   "Non-nil if point is on a clock log line."
  15073   (and (org-match-line org-clock-line-re)
  15074        (eq (org-element-type (save-match-data (org-element-at-point))) 'clock)))
  15075 
  15076 (defvar org-clock-history)                     ; defined in org-clock.el
  15077 (defvar org-clock-adjust-closest nil)          ; defined in org-clock.el
  15078 (defun org-timestamp-change (n &optional what updown suppress-tmp-delay)
  15079   "Change the date in the time stamp at point.
  15080 
  15081 The date is changed by N times WHAT.  WHAT can be `day', `month',
  15082 `year', `hour', or `minute'.  If WHAT is not given, the cursor
  15083 position in the timestamp determines what is changed.
  15084 
  15085 When optional argument UPDOWN is non-nil, minutes are rounded
  15086 according to `org-time-stamp-rounding-minutes'.
  15087 
  15088 When SUPPRESS-TMP-DELAY is non-nil, suppress delays like
  15089 \"--2d\"."
  15090   (let ((origin (point))
  15091 	(timestamp? (org-at-timestamp-p 'lax))
  15092 	origin-cat
  15093 	with-hm inactive
  15094 	(dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
  15095 	extra rem
  15096 	ts time time0 fixnext clrgx)
  15097     (unless timestamp? (user-error "Not at a timestamp"))
  15098     (if (and (not what) (eq timestamp? 'bracket))
  15099 	(org-toggle-timestamp-type)
  15100       ;; Point isn't on brackets.  Remember the part of the time-stamp
  15101       ;; the point was in.  Indeed, size of time-stamps may change,
  15102       ;; but point must be kept in the same category nonetheless.
  15103       (setq origin-cat timestamp?)
  15104       (when (and (not what) (not (eq timestamp? 'day))
  15105 		 org-display-custom-times
  15106 		 (get-text-property (point) 'display)
  15107 		 (not (get-text-property (1- (point)) 'display)))
  15108 	(setq timestamp? 'day))
  15109       (setq timestamp? (or what timestamp?)
  15110 	    inactive (= (char-after (match-beginning 0)) ?\[)
  15111 	    ts (match-string 0))
  15112       (replace-match "")
  15113       (when (string-match
  15114 	     "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]"
  15115 	     ts)
  15116 	(setq extra (match-string 1 ts))
  15117 	(when suppress-tmp-delay
  15118 	  (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra))))
  15119       (when (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
  15120 	(setq with-hm t))
  15121       (setq time0 (org-parse-time-string ts))
  15122       (when (and updown
  15123 		 (eq timestamp? 'minute)
  15124 		 (not current-prefix-arg))
  15125 	;; This looks like s-up and s-down.  Change by one rounding step.
  15126 	(setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0))))
  15127 	(unless (= 0 (setq rem (% (nth 1 time0) dm)))
  15128 	  (setcar (cdr time0) (+ (nth 1 time0)
  15129 				 (if (> n 0) (- rem) (- dm rem))))))
  15130       (setq time
  15131 	    (apply #'encode-time
  15132 		   (or (car time0) 0)
  15133 		   (+ (if (eq timestamp? 'minute) n 0) (nth 1 time0))
  15134 		   (+ (if (eq timestamp? 'hour) n 0)   (nth 2 time0))
  15135 		   (+ (if (eq timestamp? 'day) n 0)    (nth 3 time0))
  15136 		   (+ (if (eq timestamp? 'month) n 0)  (nth 4 time0))
  15137 		   (+ (if (eq timestamp? 'year) n 0)   (nth 5 time0))
  15138 		   (nthcdr 6 time0)))
  15139       (when (and (memq timestamp? '(hour minute))
  15140 		 extra
  15141 		 (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
  15142 	(setq extra (org-modify-ts-extra
  15143 		     extra
  15144 		     (if (eq timestamp? 'hour) 2 5)
  15145 		     n dm)))
  15146       (when (integerp timestamp?)
  15147 	(setq extra (org-modify-ts-extra extra timestamp? n dm)))
  15148       (when (eq what 'calendar)
  15149 	(let ((cal-date (org-get-date-from-calendar)))
  15150 	  (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
  15151 	  (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day
  15152 	  (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year
  15153 	  (setcar time0 (or (car time0) 0))
  15154 	  (setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
  15155 	  (setcar (nthcdr 2 time0) (or (nth 2 time0) 0))
  15156 	  (setq time (apply 'encode-time time0))))
  15157       ;; Insert the new time-stamp, and ensure point stays in the same
  15158       ;; category as before (i.e. not after the last position in that
  15159       ;; category).
  15160       (let ((pos (point)))
  15161 	;; Stay before inserted string. `save-excursion' is of no use.
  15162 	(setq org-last-changed-timestamp
  15163 	      (org-insert-time-stamp time with-hm inactive nil nil extra))
  15164 	(goto-char pos))
  15165       (save-match-data
  15166 	(looking-at org-ts-regexp3)
  15167 	(goto-char
  15168 	 (pcase origin-cat
  15169 	   ;; `day' category ends before `hour' if any, or at the end
  15170 	   ;; of the day name.
  15171 	   (`day (min (or (match-beginning 7) (1- (match-end 5))) origin))
  15172 	   (`hour (min (match-end 7) origin))
  15173 	   (`minute (min (1- (match-end 8)) origin))
  15174 	   ((pred integerp) (min (1- (match-end 0)) origin))
  15175 	   ;; Point was right after the time-stamp.  However, the
  15176 	   ;; time-stamp length might have changed, so refer to
  15177 	   ;; (match-end 0) instead.
  15178 	   (`after (match-end 0))
  15179 	   ;; `year' and `month' have both fixed size: point couldn't
  15180 	   ;; have moved into another part.
  15181 	   (_ origin))))
  15182       ;; Update clock if on a CLOCK line.
  15183       (org-clock-update-time-maybe)
  15184       ;; Maybe adjust the closest clock in `org-clock-history'
  15185       (when org-clock-adjust-closest
  15186 	(if (not (and (org-at-clock-log-p)
  15187 		      (< 1 (length (delq nil (mapcar 'marker-position
  15188 						     org-clock-history))))))
  15189 	    (message "No clock to adjust")
  15190 	  (cond ((save-excursion	; fix previous clock?
  15191 		   (re-search-backward org-ts-regexp0 nil t)
  15192 		   (looking-back (concat org-clock-string " \\[")
  15193 				 (line-beginning-position)))
  15194 		 (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$")))
  15195 		((save-excursion	; fix next clock?
  15196 		   (re-search-backward org-ts-regexp0 nil t)
  15197 		   (looking-at (concat org-ts-regexp0 "\\] =>")))
  15198 		 (setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0))))
  15199 	  (save-window-excursion
  15200 	    ;; Find closest clock to point, adjust the previous/next one in history
  15201 	    (let* ((p (save-excursion (org-back-to-heading t)))
  15202 		   (cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history))
  15203 		   (clfixnth
  15204 		    (+ fixnext (- (length cl) (or (length (member (apply 'min cl) cl)) 100))))
  15205 		   (clfixpos (unless (> 0 clfixnth) (nth clfixnth org-clock-history))))
  15206 	      (if (not clfixpos)
  15207 		  (message "No clock to adjust")
  15208 		(save-excursion
  15209 		  (org-goto-marker-or-bmk clfixpos)
  15210 		  (org-show-subtree)
  15211 		  (when (re-search-forward clrgx nil t)
  15212 		    (goto-char (match-beginning 1))
  15213 		    (let (org-clock-adjust-closest)
  15214 		      (org-timestamp-change n timestamp? updown))
  15215 		    (message "Clock adjusted in %s for heading: %s"
  15216 			     (file-name-nondirectory (buffer-file-name))
  15217 			     (org-get-heading t t)))))))))
  15218       ;; Try to recenter the calendar window, if any.
  15219       (when (and org-calendar-follow-timestamp-change
  15220 		 (get-buffer-window "*Calendar*" t)
  15221 		 (memq timestamp? '(day month year)))
  15222 	(org-recenter-calendar (time-to-days time))))))
  15223 
  15224 (defun org-modify-ts-extra (s pos n dm)
  15225   "Change the different parts of the lead-time and repeat fields in timestamp."
  15226   (let ((idx '(("d" . 0) ("w" . 1) ("m" . 2) ("y" . 3) ("d" . -1) ("y" . 4)))
  15227 	ng h m new rem)
  15228     (when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( +\\+\\([0-9]+\\)\\([dmwy]\\)\\)?\\( +-\\([0-9]+\\)\\([dmwy]\\)\\)?" s)
  15229       (cond
  15230        ((or (org-pos-in-match-range pos 2)
  15231 	    (org-pos-in-match-range pos 3))
  15232 	(setq m (string-to-number (match-string 3 s))
  15233 	      h (string-to-number (match-string 2 s)))
  15234 	(if (org-pos-in-match-range pos 2)
  15235 	    (setq h (+ h n))
  15236 	  (setq n (* dm (with-no-warnings (cl-signum n))))
  15237 	  (unless (= 0 (setq rem (% m dm)))
  15238 	    (setq m (+ m (if (> n 0) (- rem) (- dm rem)))))
  15239 	  (setq m (+ m n)))
  15240 	(when (< m 0) (setq m (+ m 60) h (1- h)))
  15241 	(when (> m 59) (setq m (- m 60) h (1+ h)))
  15242 	(setq h (mod h 24))
  15243 	(setq ng 1 new (format "-%02d:%02d" h m)))
  15244        ((org-pos-in-match-range pos 6)
  15245 	(setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx))))
  15246        ((org-pos-in-match-range pos 5)
  15247 	(setq ng 5 new (format "%d" (max 1 (+ n (string-to-number (match-string 5 s)))))))
  15248 
  15249        ((org-pos-in-match-range pos 9)
  15250 	(setq ng 9 new (car (rassoc (+ n (cdr (assoc (match-string 9 s) idx))) idx))))
  15251        ((org-pos-in-match-range pos 8)
  15252 	(setq ng 8 new (format "%d" (max 0 (+ n (string-to-number (match-string 8 s))))))))
  15253 
  15254       (when ng
  15255 	(setq s (concat
  15256 		 (substring s 0 (match-beginning ng))
  15257 		 new
  15258 		 (substring s (match-end ng))))))
  15259     s))
  15260 
  15261 (defun org-recenter-calendar (d)
  15262   "If the calendar is visible, recenter it to date D."
  15263   (let ((cwin (get-buffer-window "*Calendar*" t)))
  15264     (when cwin
  15265       (let ((calendar-move-hook nil))
  15266 	(with-selected-window cwin
  15267 	  (calendar-goto-date
  15268 	   (if (listp d) d (calendar-gregorian-from-absolute d))))))))
  15269 
  15270 (defun org-goto-calendar (&optional arg)
  15271   "Go to the Emacs calendar at the current date.
  15272 If there is a time stamp in the current line, go to that date.
  15273 A prefix ARG can be used to force the current date."
  15274   (interactive "P")
  15275   (let ((calendar-move-hook nil)
  15276 	(calendar-view-holidays-initially-flag nil)
  15277 	(calendar-view-diary-initially-flag nil)
  15278 	diff)
  15279     (when (or (org-at-timestamp-p 'lax)
  15280 	      (org-match-line (concat ".*" org-ts-regexp)))
  15281       (let ((d1 (time-to-days nil))
  15282 	    (d2 (time-to-days (org-time-string-to-time (match-string 1)))))
  15283 	(setq diff (- d2 d1))))
  15284     (calendar)
  15285     (calendar-goto-today)
  15286     (when (and diff (not arg)) (calendar-forward-day diff))))
  15287 
  15288 (defun org-get-date-from-calendar ()
  15289   "Return a list (month day year) of date at point in calendar."
  15290   (with-current-buffer "*Calendar*"
  15291     (save-match-data
  15292       (calendar-cursor-to-date))))
  15293 
  15294 (defun org-date-from-calendar ()
  15295   "Insert time stamp corresponding to cursor date in *Calendar* buffer.
  15296 If there is already a time stamp at the cursor position, update it."
  15297   (interactive)
  15298   (if (org-at-timestamp-p 'lax)
  15299       (org-timestamp-change 0 'calendar)
  15300     (let ((cal-date (org-get-date-from-calendar)))
  15301       (org-insert-time-stamp
  15302        (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date))))))
  15303 
  15304 (defcustom org-image-actual-width t
  15305   "When non-nil, use the actual width of images when inlining them.
  15306 
  15307 When set to a number, use imagemagick (when available) to set the
  15308 image's width to this value.
  15309 
  15310 When set to a number in a list, try to get the width from any
  15311 #+ATTR.* keyword if it matches a width specification like
  15312 
  15313   #+ATTR_HTML: :width 300px
  15314 
  15315 and fall back on that number if none is found.
  15316 
  15317 When set to nil, try to get the width from an #+ATTR.* keyword
  15318 and fall back on the original width if none is found.
  15319 
  15320 When set to any other non-nil value, always use the image width.
  15321 
  15322 This requires Emacs >= 24.1, built with imagemagick support."
  15323   :group 'org-appearance
  15324   :version "24.4"
  15325   :package-version '(Org . "8.0")
  15326   :type '(choice
  15327 	  (const :tag "Use the image width" t)
  15328 	  (integer :tag "Use a number of pixels")
  15329 	  (list :tag "Use #+ATTR* or a number of pixels" (integer))
  15330 	  (const :tag "Use #+ATTR* or don't resize" nil)))
  15331 
  15332 (defcustom org-agenda-inhibit-startup nil
  15333   "Inhibit startup when preparing agenda buffers.
  15334 When this variable is t, the initialization of the Org agenda
  15335 buffers is inhibited: e.g. the visibility state is not set, the
  15336 tables are not re-aligned, etc."
  15337   :type 'boolean
  15338   :version "24.3"
  15339   :group 'org-agenda)
  15340 
  15341 (defcustom org-agenda-ignore-properties nil
  15342   "Avoid updating text properties when building the agenda.
  15343 Properties are used to prepare buffers for effort estimates,
  15344 appointments, statistics and subtree-local categories.
  15345 If you don't use these in the agenda, you can add them to this
  15346 list and agenda building will be a bit faster.
  15347 The value is a list, with zero or more of the symbols `effort', `appt',
  15348 `stats' or `category'."
  15349   :type '(set :greedy t
  15350 	      (const effort)
  15351 	      (const appt)
  15352 	      (const stats)
  15353 	      (const category))
  15354   :version "26.1"
  15355   :package-version '(Org . "8.3")
  15356   :group 'org-agenda)
  15357 
  15358 ;;;; Files
  15359 
  15360 (defun org-save-all-org-buffers ()
  15361   "Save all Org buffers without user confirmation."
  15362   (interactive)
  15363   (message "Saving all Org buffers...")
  15364   (save-some-buffers t (lambda () (derived-mode-p 'org-mode)))
  15365   (when (featurep 'org-id) (org-id-locations-save))
  15366   (message "Saving all Org buffers... done"))
  15367 
  15368 (defun org-revert-all-org-buffers ()
  15369   "Revert all Org buffers.
  15370 Prompt for confirmation when there are unsaved changes.
  15371 Be sure you know what you are doing before letting this function
  15372 overwrite your changes.
  15373 
  15374 This function is useful in a setup where one tracks Org files
  15375 with a version control system, to revert on one machine after pulling
  15376 changes from another.  I believe the procedure must be like this:
  15377 
  15378 1. \\[org-save-all-org-buffers]
  15379 2. Pull changes from the other machine, resolve conflicts
  15380 3. \\[org-revert-all-org-buffers]"
  15381   (interactive)
  15382   (unless (yes-or-no-p "Revert all Org buffers from their files? ")
  15383     (user-error "Abort"))
  15384   (save-excursion
  15385     (save-window-excursion
  15386       (dolist (b (buffer-list))
  15387 	(when (and (with-current-buffer b (derived-mode-p 'org-mode))
  15388 		   (with-current-buffer b buffer-file-name))
  15389 	  (pop-to-buffer-same-window b)
  15390 	  (revert-buffer t 'no-confirm)))
  15391       (when (and (featurep 'org-id) org-id-track-globally)
  15392 	(org-id-locations-load)))))
  15393 
  15394 ;;;; Agenda files
  15395 
  15396 ;;;###autoload
  15397 (defun org-switchb (&optional arg)
  15398   "Switch between Org buffers.
  15399 
  15400 With `\\[universal-argument]' prefix, restrict available buffers to files.
  15401 
  15402 With `\\[universal-argument] \\[universal-argument]' \
  15403 prefix, restrict available buffers to agenda files."
  15404   (interactive "P")
  15405   (let ((blist (org-buffer-list
  15406 		(cond ((equal arg '(4))  'files)
  15407 		      ((equal arg '(16)) 'agenda)))))
  15408     (pop-to-buffer-same-window
  15409      (completing-read "Org buffer: "
  15410 		      (mapcar #'list (mapcar #'buffer-name blist))
  15411 		      nil t))))
  15412 
  15413 (defun org-buffer-list (&optional predicate exclude-tmp)
  15414   "Return a list of Org buffers.
  15415 PREDICATE can be `export', `files' or `agenda'.
  15416 
  15417 export   restrict the list to Export buffers.
  15418 files    restrict the list to buffers visiting Org files.
  15419 agenda   restrict the list to buffers visiting agenda files.
  15420 
  15421 If EXCLUDE-TMP is non-nil, ignore temporary buffers."
  15422   (let* ((bfn nil)
  15423 	 (agenda-files (and (eq predicate 'agenda)
  15424 			    (mapcar 'file-truename (org-agenda-files t))))
  15425 	 (filter
  15426 	  (cond
  15427 	   ((eq predicate 'files)
  15428 	    (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode))))
  15429 	   ((eq predicate 'export)
  15430 	    (lambda (b) (string-match "\\*Org .*Export" (buffer-name b))))
  15431 	   ((eq predicate 'agenda)
  15432 	    (lambda (b)
  15433 	      (with-current-buffer b
  15434 		(and (derived-mode-p 'org-mode)
  15435 		     (setq bfn (buffer-file-name b))
  15436 		     (member (file-truename bfn) agenda-files)))))
  15437 	   (t (lambda (b) (with-current-buffer b
  15438 			    (or (derived-mode-p 'org-mode)
  15439 				(string-match "\\*Org .*Export"
  15440 					      (buffer-name b)))))))))
  15441     (delq nil
  15442 	  (mapcar
  15443 	   (lambda(b)
  15444 	     (if (and (funcall filter b)
  15445 		      (or (not exclude-tmp)
  15446 			  (not (string-match "tmp" (buffer-name b)))))
  15447 		 b
  15448 	       nil))
  15449 	   (buffer-list)))))
  15450 
  15451 (defun org-agenda-files (&optional unrestricted archives)
  15452   "Get the list of agenda files.
  15453 Optional UNRESTRICTED means return the full list even if a restriction
  15454 is currently in place.
  15455 When ARCHIVES is t, include all archive files that are really being
  15456 used by the agenda files.  If ARCHIVE is `ifmode', do this only if
  15457 `org-agenda-archives-mode' is t."
  15458   (let ((files
  15459 	 (cond
  15460 	  ((and (not unrestricted) (get 'org-agenda-files 'org-restrict)))
  15461 	  ((stringp org-agenda-files) (org-read-agenda-file-list))
  15462 	  ((listp org-agenda-files) org-agenda-files)
  15463 	  (t (error "Invalid value of `org-agenda-files'")))))
  15464     (setq files (apply 'append
  15465 		       (mapcar (lambda (f)
  15466 				 (if (file-directory-p f)
  15467 				     (directory-files
  15468 				      f t org-agenda-file-regexp)
  15469 				   (list (expand-file-name f org-directory))))
  15470 			       files)))
  15471     (when org-agenda-skip-unavailable-files
  15472       (setq files (delq nil
  15473 			(mapcar (lambda (file)
  15474 				  (and (file-readable-p file) file))
  15475 				files))))
  15476     (when (or (eq archives t)
  15477 	      (and (eq archives 'ifmode) (eq org-agenda-archives-mode t)))
  15478       (setq files (org-add-archive-files files)))
  15479     files))
  15480 
  15481 (defun org-agenda-file-p (&optional file)
  15482   "Return non-nil, if FILE is an agenda file.
  15483 If FILE is omitted, use the file associated with the current
  15484 buffer."
  15485   (let ((fname (or file (buffer-file-name))))
  15486     (and fname
  15487          (member (file-truename fname)
  15488                  (mapcar #'file-truename (org-agenda-files t))))))
  15489 
  15490 (defun org-edit-agenda-file-list ()
  15491   "Edit the list of agenda files.
  15492 Depending on setup, this either uses customize to edit the variable
  15493 `org-agenda-files', or it visits the file that is holding the list.  In the
  15494 latter case, the buffer is set up in a way that saving it automatically kills
  15495 the buffer and restores the previous window configuration."
  15496   (interactive)
  15497   (if (stringp org-agenda-files)
  15498       (let ((cw (current-window-configuration)))
  15499 	(find-file org-agenda-files)
  15500 	(setq-local org-window-configuration cw)
  15501 	(add-hook 'after-save-hook
  15502 		  (lambda ()
  15503 		    (set-window-configuration
  15504 		     (prog1 org-window-configuration
  15505 		       (kill-buffer (current-buffer))))
  15506 		    (org-install-agenda-files-menu)
  15507 		    (message "New agenda file list installed"))
  15508 		  nil 'local)
  15509 	(message "%s" (substitute-command-keys
  15510 		       "Edit list and finish with \\[save-buffer]")))
  15511     (customize-variable 'org-agenda-files)))
  15512 
  15513 (defun org-store-new-agenda-file-list (list)
  15514   "Set new value for the agenda file list and save it correctly."
  15515   (if (stringp org-agenda-files)
  15516       (let ((fe (org-read-agenda-file-list t)) b u)
  15517 	(while (setq b (find-buffer-visiting org-agenda-files))
  15518 	  (kill-buffer b))
  15519 	(with-temp-file org-agenda-files
  15520 	  (insert
  15521 	   (mapconcat
  15522 	    (lambda (f) ;; Keep un-expanded entries.
  15523 	      (if (setq u (assoc f fe))
  15524 		  (cdr u)
  15525 		f))
  15526 	    list "\n")
  15527 	   "\n")))
  15528     (let ((org-mode-hook nil) (org-inhibit-startup t)
  15529 	  (org-insert-mode-line-in-empty-file nil))
  15530       (setq org-agenda-files list)
  15531       (customize-save-variable 'org-agenda-files org-agenda-files))))
  15532 
  15533 (defun org-read-agenda-file-list (&optional pair-with-expansion)
  15534   "Read the list of agenda files from a file.
  15535 If PAIR-WITH-EXPANSION is t return pairs with un-expanded
  15536 filenames, used by `org-store-new-agenda-file-list' to write back
  15537 un-expanded file names."
  15538   (when (file-directory-p org-agenda-files)
  15539     (error "`org-agenda-files' cannot be a single directory"))
  15540   (when (stringp org-agenda-files)
  15541     (with-temp-buffer
  15542       (insert-file-contents org-agenda-files)
  15543       (mapcar
  15544        (lambda (f)
  15545 	 (let ((e (expand-file-name (substitute-in-file-name f)
  15546 				    org-directory)))
  15547 	   (if pair-with-expansion
  15548 	       (cons e f)
  15549 	     e)))
  15550        (org-split-string (buffer-string) "[ \t\r\n]*?[\r\n][ \t\r\n]*")))))
  15551 
  15552 ;;;###autoload
  15553 (defun org-cycle-agenda-files ()
  15554   "Cycle through the files in `org-agenda-files'.
  15555 If the current buffer visits an agenda file, find the next one in the list.
  15556 If the current buffer does not, find the first agenda file."
  15557   (interactive)
  15558   (let* ((fs (or (org-agenda-files t)
  15559 		 (user-error "No agenda files")))
  15560 	 (files (copy-sequence fs))
  15561 	 (tcf (and buffer-file-name (file-truename buffer-file-name)))
  15562 	 file)
  15563     (when tcf
  15564       (while (and (setq file (pop files))
  15565 		  (not (equal (file-truename file) tcf)))))
  15566     (find-file (car (or files fs)))
  15567     (when (buffer-base-buffer) (pop-to-buffer-same-window (buffer-base-buffer)))))
  15568 
  15569 (defun org-agenda-file-to-front (&optional to-end)
  15570   "Move/add the current file to the top of the agenda file list.
  15571 If the file is not present in the list, it is added to the front.  If it is
  15572 present, it is moved there.  With optional argument TO-END, add/move to the
  15573 end of the list."
  15574   (interactive "P")
  15575   (let ((org-agenda-skip-unavailable-files nil)
  15576 	(file-alist (mapcar (lambda (x)
  15577 			      (cons (file-truename x) x))
  15578 			    (org-agenda-files t)))
  15579 	(ctf (file-truename
  15580 	      (or buffer-file-name
  15581 		  (user-error "Please save the current buffer to a file"))))
  15582 	x had)
  15583     (setq x (assoc ctf file-alist) had x)
  15584 
  15585     (unless x (setq x (cons ctf (abbreviate-file-name buffer-file-name))))
  15586     (if to-end
  15587 	(setq file-alist (append (delq x file-alist) (list x)))
  15588       (setq file-alist (cons x (delq x file-alist))))
  15589     (org-store-new-agenda-file-list (mapcar 'cdr file-alist))
  15590     (org-install-agenda-files-menu)
  15591     (message "File %s to %s of agenda file list"
  15592 	     (if had "moved" "added") (if to-end "end" "front"))))
  15593 
  15594 (defun org-remove-file (&optional file)
  15595   "Remove current file from the list of files in variable `org-agenda-files'.
  15596 These are the files which are being checked for agenda entries.
  15597 Optional argument FILE means use this file instead of the current."
  15598   (interactive)
  15599   (let* ((org-agenda-skip-unavailable-files nil)
  15600 	 (file (or file buffer-file-name
  15601 		   (user-error "Current buffer does not visit a file")))
  15602 	 (true-file (file-truename file))
  15603 	 (afile (abbreviate-file-name file))
  15604 	 (files (delq nil (mapcar
  15605 			   (lambda (x)
  15606 			     (unless (equal true-file
  15607 					    (file-truename x))
  15608 			       x))
  15609 			   (org-agenda-files t)))))
  15610     (if (not (= (length files) (length (org-agenda-files t))))
  15611 	(progn
  15612 	  (org-store-new-agenda-file-list files)
  15613 	  (org-install-agenda-files-menu)
  15614 	  (message "Removed from Org Agenda list: %s" afile))
  15615       (message "File was not in list: %s (not removed)" afile))))
  15616 
  15617 (defun org-file-menu-entry (file)
  15618   (vector file (list 'find-file file) t))
  15619 
  15620 (defun org-check-agenda-file (file)
  15621   "Make sure FILE exists.  If not, ask user what to do."
  15622   (unless (file-exists-p file)
  15623     (message "Non-existent agenda file %s.  [R]emove from list or [A]bort?"
  15624 	     (abbreviate-file-name file))
  15625     (let ((r (downcase (read-char-exclusive))))
  15626       (cond
  15627        ((equal r ?r)
  15628 	(org-remove-file file)
  15629 	(throw 'nextfile t))
  15630        (t (user-error "Abort"))))))
  15631 
  15632 (defun org-get-agenda-file-buffer (file)
  15633   "Get an agenda buffer visiting FILE.
  15634 If the buffer needs to be created, add it to the list of buffers
  15635 which might be released later."
  15636   (let ((buf (org-find-base-buffer-visiting file)))
  15637     (if buf
  15638 	buf ; just return it
  15639       ;; Make a new buffer and remember it
  15640       (setq buf (find-file-noselect file))
  15641       (when buf (push buf org-agenda-new-buffers))
  15642       buf)))
  15643 
  15644 (defun org-release-buffers (blist)
  15645   "Release all buffers in list, asking the user for confirmation when needed.
  15646 When a buffer is unmodified, it is just killed.  When modified, it is saved
  15647 \(if the user agrees) and then killed."
  15648   (let (file)
  15649     (dolist (buf blist)
  15650       (setq file (buffer-file-name buf))
  15651       (when (and (buffer-modified-p buf)
  15652 		 file
  15653 		 (y-or-n-p (format "Save file %s? " file)))
  15654 	(with-current-buffer buf (save-buffer)))
  15655       (kill-buffer buf))))
  15656 
  15657 (defun org-agenda-prepare-buffers (files)
  15658   "Create buffers for all agenda files, protect archived trees and comments."
  15659   (interactive)
  15660   (let ((pa '(:org-archived t))
  15661 	(pc '(:org-comment t))
  15662 	(pall '(:org-archived t :org-comment t))
  15663 	(inhibit-read-only t)
  15664 	(org-inhibit-startup org-agenda-inhibit-startup)
  15665 	(rea (org-make-tag-string (list org-archive-tag)))
  15666 	re pos)
  15667     (setq org-tag-alist-for-agenda nil
  15668 	  org-tag-groups-alist-for-agenda nil)
  15669     (save-excursion
  15670       (save-restriction
  15671 	(dolist (file files)
  15672 	  (catch 'nextfile
  15673 	    (if (bufferp file)
  15674 		(set-buffer file)
  15675 	      (org-check-agenda-file file)
  15676 	      (set-buffer (org-get-agenda-file-buffer file)))
  15677 	    (widen)
  15678 	    (org-set-regexps-and-options 'tags-only)
  15679 	    (setq pos (point))
  15680 	    (or (memq 'category org-agenda-ignore-properties)
  15681 		(org-refresh-category-properties))
  15682 	    (or (memq 'stats org-agenda-ignore-properties)
  15683 		(org-refresh-stats-properties))
  15684 	    (or (memq 'effort org-agenda-ignore-properties)
  15685 		(org-refresh-effort-properties))
  15686 	    (or (memq 'appt org-agenda-ignore-properties)
  15687 		(org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime))
  15688 	    (setq org-todo-keywords-for-agenda
  15689 		  (append org-todo-keywords-for-agenda org-todo-keywords-1))
  15690 	    (setq org-done-keywords-for-agenda
  15691 		  (append org-done-keywords-for-agenda org-done-keywords))
  15692 	    (setq org-todo-keyword-alist-for-agenda
  15693 		  (append org-todo-keyword-alist-for-agenda org-todo-key-alist))
  15694 	    (setq org-tag-alist-for-agenda
  15695 		  (org--tag-add-to-alist
  15696 		   org-tag-alist-for-agenda
  15697 		   org-current-tag-alist))
  15698 	    ;; Merge current file's tag groups into global
  15699 	    ;; `org-tag-groups-alist-for-agenda'.
  15700 	    (when org-group-tags
  15701 	      (dolist (alist org-tag-groups-alist)
  15702 		(let ((old (assoc (car alist) org-tag-groups-alist-for-agenda)))
  15703 		  (if old
  15704 		      (setcdr old (org-uniquify (append (cdr old) (cdr alist))))
  15705 		    (push alist org-tag-groups-alist-for-agenda)))))
  15706 	    (with-silent-modifications
  15707 	      (save-excursion
  15708 		(remove-text-properties (point-min) (point-max) pall)
  15709 		(when org-agenda-skip-archived-trees
  15710 		  (goto-char (point-min))
  15711 		  (while (re-search-forward rea nil t)
  15712 		    (when (org-at-heading-p t)
  15713 		      (add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
  15714 		(goto-char (point-min))
  15715 		(setq re (format "^\\*+ .*\\<%s\\>" org-comment-string))
  15716 		(while (re-search-forward re nil t)
  15717 		  (when (save-match-data (org-in-commented-heading-p t))
  15718 		    (add-text-properties
  15719 		     (match-beginning 0) (org-end-of-subtree t) pc)))))
  15720 	    (goto-char pos)))))
  15721     (setq org-todo-keywords-for-agenda
  15722           (org-uniquify org-todo-keywords-for-agenda))
  15723     (setq org-todo-keyword-alist-for-agenda
  15724 	  (org-uniquify org-todo-keyword-alist-for-agenda))))
  15725 
  15726 
  15727 ;;;; CDLaTeX minor mode
  15728 
  15729 (defvar org-cdlatex-mode-map (make-sparse-keymap)
  15730   "Keymap for the minor `org-cdlatex-mode'.")
  15731 
  15732 (org-defkey org-cdlatex-mode-map (kbd "_") #'org-cdlatex-underscore-caret)
  15733 (org-defkey org-cdlatex-mode-map (kbd "^") #'org-cdlatex-underscore-caret)
  15734 (org-defkey org-cdlatex-mode-map (kbd "`") #'cdlatex-math-symbol)
  15735 (org-defkey org-cdlatex-mode-map (kbd "'") #'org-cdlatex-math-modify)
  15736 (org-defkey org-cdlatex-mode-map (kbd "C-c {") #'org-cdlatex-environment-indent)
  15737 
  15738 (defvar org-cdlatex-texmathp-advice-is-done nil
  15739   "Flag remembering if we have applied the advice to texmathp already.")
  15740 
  15741 (define-minor-mode org-cdlatex-mode
  15742   "Toggle the minor `org-cdlatex-mode'.
  15743 This mode supports entering LaTeX environment and math in LaTeX fragments
  15744 in Org mode.
  15745 \\{org-cdlatex-mode-map}"
  15746   :lighter " OCDL"
  15747   (when org-cdlatex-mode
  15748     (require 'cdlatex)
  15749     (run-hooks 'cdlatex-mode-hook)
  15750     (cdlatex-compute-tables))
  15751   (unless org-cdlatex-texmathp-advice-is-done
  15752     (setq org-cdlatex-texmathp-advice-is-done t)
  15753     (defadvice texmathp (around org-math-always-on activate)
  15754       "Always return t in Org buffers.
  15755 This is because we want to insert math symbols without dollars even outside
  15756 the LaTeX math segments.  If Org mode thinks that point is actually inside
  15757 an embedded LaTeX fragment, let `texmathp' do its job.
  15758 `\\[org-cdlatex-mode-map]'"
  15759       (interactive)
  15760       (let (p)
  15761 	(cond
  15762 	 ((not (derived-mode-p 'org-mode)) ad-do-it)
  15763 	 ((eq this-command 'cdlatex-math-symbol)
  15764 	  (setq ad-return-value t
  15765 		texmathp-why '("cdlatex-math-symbol in org-mode" . 0)))
  15766 	 (t
  15767 	  (let ((p (org-inside-LaTeX-fragment-p)))
  15768 	    (if (and p (member (car p) (plist-get org-format-latex-options :matchers)))
  15769 		(setq ad-return-value t
  15770 		      texmathp-why '("Org mode embedded math" . 0))
  15771 	      (when p ad-do-it)))))))))
  15772 
  15773 (defun turn-on-org-cdlatex ()
  15774   "Unconditionally turn on `org-cdlatex-mode'."
  15775   (org-cdlatex-mode 1))
  15776 
  15777 (defun org-try-cdlatex-tab ()
  15778   "Check if it makes sense to execute `cdlatex-tab', and do it if yes.
  15779 It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is
  15780   - inside a LaTeX fragment, or
  15781   - after the first word in a line, where an abbreviation expansion could
  15782     insert a LaTeX environment."
  15783   (when org-cdlatex-mode
  15784     (cond
  15785      ;; Before any word on the line: No expansion possible.
  15786      ((save-excursion (skip-chars-backward " \t") (bolp)) nil)
  15787      ;; Just after first word on the line: Expand it.  Make sure it
  15788      ;; cannot happen on headlines, though.
  15789      ((save-excursion
  15790 	(skip-chars-backward "a-zA-Z0-9*")
  15791 	(skip-chars-backward " \t")
  15792 	(and (bolp) (not (org-at-heading-p))))
  15793       (cdlatex-tab) t)
  15794      ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t))))
  15795 
  15796 (defun org-cdlatex-underscore-caret (&optional _arg)
  15797   "Execute `cdlatex-sub-superscript' in LaTeX fragments.
  15798 Revert to the normal definition outside of these fragments."
  15799   (interactive "P")
  15800   (if (org-inside-LaTeX-fragment-p)
  15801       (call-interactively 'cdlatex-sub-superscript)
  15802     (let (org-cdlatex-mode)
  15803       (call-interactively (key-binding (vector last-input-event))))))
  15804 
  15805 (defun org-cdlatex-math-modify (&optional _arg)
  15806   "Execute `cdlatex-math-modify' in LaTeX fragments.
  15807 Revert to the normal definition outside of these fragments."
  15808   (interactive "P")
  15809   (if (org-inside-LaTeX-fragment-p)
  15810       (call-interactively 'cdlatex-math-modify)
  15811     (let (org-cdlatex-mode)
  15812       (call-interactively (key-binding (vector last-input-event))))))
  15813 
  15814 (defun org-cdlatex-environment-indent (&optional environment item)
  15815   "Execute `cdlatex-environment' and indent the inserted environment.
  15816 
  15817 ENVIRONMENT and ITEM are passed to `cdlatex-environment'.
  15818 
  15819 The inserted environment is indented to current indentation
  15820 unless point is at the beginning of the line, in which the
  15821 environment remains unintended."
  15822   (interactive)
  15823   ;; cdlatex-environment always return nil.  Therefore, capture output
  15824   ;; first and determine if an environment was selected.
  15825   (let* ((beg (point-marker))
  15826 	 (end (copy-marker (point) t))
  15827 	 (inserted (progn
  15828 		     (ignore-errors (cdlatex-environment environment item))
  15829 		     (< beg end)))
  15830 	 ;; Figure out how many lines to move forward after the
  15831 	 ;; environment has been inserted.
  15832 	 (lines (when inserted
  15833 		  (save-excursion
  15834 		    (- (cl-loop while (< beg (point))
  15835 				with x = 0
  15836 				do (forward-line -1)
  15837 				(cl-incf x)
  15838 				finally return x)
  15839 		       (if (progn (goto-char beg)
  15840 				  (and (progn (skip-chars-forward " \t") (eolp))
  15841 				       (progn (skip-chars-backward " \t") (bolp))))
  15842 			   1 0)))))
  15843 	 (env (org-trim (delete-and-extract-region beg end))))
  15844     (when inserted
  15845       ;; Get indentation of next line unless at column 0.
  15846       (let ((ind (if (bolp) 0
  15847 		   (save-excursion
  15848 		     (org-return t)
  15849 		     (prog1 (current-indentation)
  15850 		       (when (progn (skip-chars-forward " \t") (eolp))
  15851 			 (delete-region beg (point)))))))
  15852 	    (bol (progn (skip-chars-backward " \t") (bolp))))
  15853 	;; Insert a newline before environment unless at column zero
  15854 	;; to "escape" the current line.  Insert a newline if
  15855 	;; something is one the same line as \end{ENVIRONMENT}.
  15856 	(insert
  15857 	 (concat (unless bol "\n") env
  15858 		 (when (and (skip-chars-forward " \t") (not (eolp))) "\n")))
  15859 	(unless (zerop ind)
  15860 	  (save-excursion
  15861 	    (goto-char beg)
  15862 	    (while (< (point) end)
  15863 	      (unless (eolp) (indent-line-to ind))
  15864 	      (forward-line))))
  15865 	(goto-char beg)
  15866 	(forward-line lines)
  15867 	(indent-line-to ind)))
  15868     (set-marker beg nil)
  15869     (set-marker end nil)))
  15870 
  15871 
  15872 ;;;; LaTeX fragments
  15873 
  15874 (defun org-inside-LaTeX-fragment-p ()
  15875   "Test if point is inside a LaTeX fragment.
  15876 I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing
  15877 sequence appearing also before point.
  15878 Even though the matchers for math are configurable, this function assumes
  15879 that \\begin, \\(, \\[, and $$ are always used.  Only the single dollar
  15880 delimiters are skipped when they have been removed by customization.
  15881 The return value is nil, or a cons cell with the delimiter and the
  15882 position of this delimiter.
  15883 
  15884 This function does a reasonably good job, but can locally be fooled by
  15885 for example currency specifications.  For example it will assume being in
  15886 inline math after \"$22.34\".  The LaTeX fragment formatter will only format
  15887 fragments that are properly closed, but during editing, we have to live
  15888 with the uncertainty caused by missing closing delimiters.  This function
  15889 looks only before point, not after."
  15890   (catch 'exit
  15891     (let ((pos (point))
  15892 	  (dodollar (member "$" (plist-get org-format-latex-options :matchers)))
  15893 	  (lim (progn
  15894 		 (re-search-backward (concat "^\\(" paragraph-start "\\)") nil
  15895 				     'move)
  15896 		 (point)))
  15897 	  dd-on str (start 0) m re)
  15898       (goto-char pos)
  15899       (when dodollar
  15900 	(setq str (concat (buffer-substring lim (point)) "\000 X$.")
  15901 	      re (nth 1 (assoc "$" org-latex-regexps)))
  15902 	(while (string-match re str start)
  15903 	  (cond
  15904 	   ((= (match-end 0) (length str))
  15905 	    (throw 'exit (cons "$" (+ lim (match-beginning 0) 1))))
  15906 	   ((= (match-end 0) (- (length str) 5))
  15907 	    (throw 'exit nil))
  15908 	   (t (setq start (match-end 0))))))
  15909       (when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t))
  15910 	(goto-char pos)
  15911 	(and (match-beginning 1) (throw 'exit (cons (match-string 1) m)))
  15912 	(and (match-beginning 2) (throw 'exit nil))
  15913 	;; count $$
  15914 	(while (re-search-backward "\\$\\$" lim t)
  15915 	  (setq dd-on (not dd-on)))
  15916 	(goto-char pos)
  15917 	(when dd-on (cons "$$" m))))))
  15918 
  15919 (defun org-inside-latex-macro-p ()
  15920   "Is point inside a LaTeX macro or its arguments?"
  15921   (save-match-data
  15922     (org-in-regexp
  15923      "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")))
  15924 
  15925 (defun org--make-preview-overlay (beg end image &optional imagetype)
  15926   "Build an overlay between BEG and END using IMAGE file.
  15927 Argument IMAGETYPE is the extension of the displayed image,
  15928 as a string.  It defaults to \"png\"."
  15929   (let ((ov (make-overlay beg end))
  15930 	(imagetype (or (intern imagetype) 'png)))
  15931     (overlay-put ov 'org-overlay-type 'org-latex-overlay)
  15932     (overlay-put ov 'evaporate t)
  15933     (overlay-put ov
  15934 		 'modification-hooks
  15935 		 (list (lambda (o _flag _beg _end &optional _l)
  15936 			 (delete-overlay o))))
  15937     (overlay-put ov
  15938 		 'display
  15939 		 (list 'image :type imagetype :file image :ascent 'center))))
  15940 
  15941 (defun org-clear-latex-preview (&optional beg end)
  15942   "Remove all overlays with LaTeX fragment images in current buffer.
  15943 When optional arguments BEG and END are non-nil, remove all
  15944 overlays between them instead.  Return a non-nil value when some
  15945 overlays were removed, nil otherwise."
  15946   (let ((overlays
  15947 	 (cl-remove-if-not
  15948 	  (lambda (o) (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay))
  15949 	  (overlays-in (or beg (point-min)) (or end (point-max))))))
  15950     (mapc #'delete-overlay overlays)
  15951     overlays))
  15952 
  15953 (defun org--latex-preview-region (beg end)
  15954   "Preview LaTeX fragments between BEG and END.
  15955 BEG and END are buffer positions."
  15956   (let ((file (buffer-file-name (buffer-base-buffer))))
  15957     (save-excursion
  15958       (org-format-latex
  15959        (concat org-preview-latex-image-directory "org-ltximg")
  15960        beg end
  15961        ;; Emacs cannot overlay images from remote hosts.  Create it in
  15962        ;; `temporary-file-directory' instead.
  15963        (if (or (not file) (file-remote-p file))
  15964 	   temporary-file-directory
  15965 	 default-directory)
  15966        'overlays nil 'forbuffer org-preview-latex-default-process))))
  15967 
  15968 (defun org-latex-preview (&optional arg)
  15969   "Toggle preview of the LaTeX fragment at point.
  15970 
  15971 If the cursor is on a LaTeX fragment, create the image and
  15972 overlay it over the source code, if there is none.  Remove it
  15973 otherwise.  If there is no fragment at point, display images for
  15974 all fragments in the current section.
  15975 
  15976 With a `\\[universal-argument]' prefix argument ARG, clear images \
  15977 for all fragments
  15978 in the current section.
  15979 
  15980 With a `\\[universal-argument] \\[universal-argument]' prefix \
  15981 argument ARG, display image for all
  15982 fragments in the buffer.
  15983 
  15984 With a `\\[universal-argument] \\[universal-argument] \
  15985 \\[universal-argument]' prefix argument ARG, clear image for all
  15986 fragments in the buffer."
  15987   (interactive "P")
  15988   (cond
  15989    ((not (display-graphic-p)) nil)
  15990    ;; Clear whole buffer.
  15991    ((equal arg '(64))
  15992     (org-clear-latex-preview (point-min) (point-max))
  15993     (message "LaTeX previews removed from buffer"))
  15994    ;; Preview whole buffer.
  15995    ((equal arg '(16))
  15996     (message "Creating LaTeX previews in buffer...")
  15997     (org--latex-preview-region (point-min) (point-max))
  15998     (message "Creating LaTeX previews in buffer... done."))
  15999    ;; Clear current section.
  16000    ((equal arg '(4))
  16001     (org-clear-latex-preview
  16002      (if (org-before-first-heading-p) (point-min)
  16003        (save-excursion
  16004 	 (org-with-limited-levels (org-back-to-heading t) (point))))
  16005      (org-with-limited-levels (org-entry-end-position))))
  16006    ;; Toggle preview on LaTeX code at point.
  16007    ((let ((datum (org-element-context)))
  16008       (and (memq (org-element-type datum) '(latex-environment latex-fragment))
  16009 	   (let ((beg (org-element-property :begin datum))
  16010 		 (end (org-element-property :end datum)))
  16011 	     (if (org-clear-latex-preview beg end)
  16012 		 (message "LaTeX preview removed")
  16013 	       (message "Creating LaTeX preview...")
  16014 	       (org--latex-preview-region beg end)
  16015 	       (message "Creating LaTeX preview... done."))
  16016 	     t))))
  16017    ;; Preview current section.
  16018    (t
  16019     (let ((beg (if (org-before-first-heading-p) (point-min)
  16020 		 (save-excursion
  16021 		   (org-with-limited-levels (org-back-to-heading t) (point)))))
  16022 	  (end (org-with-limited-levels (org-entry-end-position))))
  16023       (message "Creating LaTeX previews in section...")
  16024       (org--latex-preview-region beg end)
  16025       (message "Creating LaTeX previews in section... done.")))))
  16026 
  16027 (defun org-format-latex
  16028     (prefix &optional beg end dir overlays msg forbuffer processing-type)
  16029   "Replace LaTeX fragments with links to an image.
  16030 
  16031 The function takes care of creating the replacement image.
  16032 
  16033 Only consider fragments between BEG and END when those are
  16034 provided.
  16035 
  16036 When optional argument OVERLAYS is non-nil, display the image on
  16037 top of the fragment instead of replacing it.
  16038 
  16039 PROCESSING-TYPE is the conversion method to use, as a symbol.
  16040 
  16041 Some of the options can be changed using the variable
  16042 `org-format-latex-options', which see."
  16043   (when (and overlays (fboundp 'clear-image-cache)) (clear-image-cache))
  16044   (unless (eq processing-type 'verbatim)
  16045     (let* ((math-regexp "\\$\\|\\\\[([]\\|^[ \t]*\\\\begin{[A-Za-z0-9*]+}")
  16046 	   (cnt 0)
  16047 	   checkdir-flag)
  16048       (goto-char (or beg (point-min)))
  16049       ;; Optimize overlay creation: (info "(elisp) Managing Overlays").
  16050       (when (and overlays (memq processing-type '(dvipng imagemagick)))
  16051 	(overlay-recenter (or end (point-max))))
  16052       (while (re-search-forward math-regexp end t)
  16053 	(unless (and overlays
  16054 		     (eq (get-char-property (point) 'org-overlay-type)
  16055 			 'org-latex-overlay))
  16056 	  (let* ((context (org-element-context))
  16057 		 (type (org-element-type context)))
  16058 	    (when (memq type '(latex-environment latex-fragment))
  16059 	      (let ((block-type (eq type 'latex-environment))
  16060 		    (value (org-element-property :value context))
  16061 		    (beg (org-element-property :begin context))
  16062 		    (end (save-excursion
  16063 			   (goto-char (org-element-property :end context))
  16064 			   (skip-chars-backward " \r\t\n")
  16065 			   (point))))
  16066 		(cond
  16067 		 ((eq processing-type 'mathjax)
  16068 		  ;; Prepare for MathJax processing.
  16069 		  (if (not (string-match "\\`\\$\\$?" value))
  16070 		      (goto-char end)
  16071 		    (delete-region beg end)
  16072 		    (if (string= (match-string 0 value) "$$")
  16073 			(insert "\\[" (substring value 2 -2) "\\]")
  16074 		      (insert "\\(" (substring value 1 -1) "\\)"))))
  16075 		 ((eq processing-type 'html)
  16076 		  (goto-char beg)
  16077 		  (delete-region beg end)
  16078 		  (insert (org-format-latex-as-html value)))
  16079 		 ((assq processing-type org-preview-latex-process-alist)
  16080 		  ;; Process to an image.
  16081 		  (cl-incf cnt)
  16082 		  (goto-char beg)
  16083 		  (let* ((processing-info
  16084 			  (cdr (assq processing-type org-preview-latex-process-alist)))
  16085 			 (face (face-at-point))
  16086 			 ;; Get the colors from the face at point.
  16087 			 (fg
  16088 			  (let ((color (plist-get org-format-latex-options
  16089 						  :foreground)))
  16090                             (if forbuffer
  16091                                 (cond
  16092                                  ((eq color 'auto)
  16093                                   (face-attribute face :foreground nil 'default))
  16094                                  ((eq color 'default)
  16095                                   (face-attribute 'default :foreground nil))
  16096                                  (t color))
  16097                               color)))
  16098 			 (bg
  16099 			  (let ((color (plist-get org-format-latex-options
  16100 						  :background)))
  16101                             (if forbuffer
  16102                                 (cond
  16103                                  ((eq color 'auto)
  16104                                   (face-attribute face :background nil 'default))
  16105                                  ((eq color 'default)
  16106                                   (face-attribute 'default :background nil))
  16107                                  (t color))
  16108                               color)))
  16109 			 (hash (sha1 (prin1-to-string
  16110 				      (list org-format-latex-header
  16111 					    org-latex-default-packages-alist
  16112 					    org-latex-packages-alist
  16113 					    org-format-latex-options
  16114 					    forbuffer value fg bg))))
  16115 			 (imagetype (or (plist-get processing-info :image-output-type) "png"))
  16116 			 (absprefix (expand-file-name prefix dir))
  16117 			 (linkfile (format "%s_%s.%s" prefix hash imagetype))
  16118 			 (movefile (format "%s_%s.%s" absprefix hash imagetype))
  16119 			 (sep (and block-type "\n\n"))
  16120 			 (link (concat sep "[[file:" linkfile "]]" sep))
  16121 			 (options
  16122 			  (org-combine-plists
  16123 			   org-format-latex-options
  16124 			   `(:foreground ,fg :background ,bg))))
  16125 		    (when msg (message msg cnt))
  16126 		    (unless checkdir-flag ; Ensure the directory exists.
  16127 		      (setq checkdir-flag t)
  16128 		      (let ((todir (file-name-directory absprefix)))
  16129 			(unless (file-directory-p todir)
  16130 			  (make-directory todir t))))
  16131 		    (unless (file-exists-p movefile)
  16132 		      (org-create-formula-image
  16133 		       value movefile options forbuffer processing-type))
  16134 		    (if overlays
  16135 			(progn
  16136 			  (dolist (o (overlays-in beg end))
  16137 			    (when (eq (overlay-get o 'org-overlay-type)
  16138 				      'org-latex-overlay)
  16139 			      (delete-overlay o)))
  16140 			  (org--make-preview-overlay beg end movefile imagetype)
  16141 			  (goto-char end))
  16142 		      (delete-region beg end)
  16143 		      (insert
  16144 		       (org-add-props link
  16145 			   (list 'org-latex-src
  16146 				 (replace-regexp-in-string "\"" "" value)
  16147 				 'org-latex-src-embed-type
  16148 				 (if block-type 'paragraph 'character)))))))
  16149 		 ((eq processing-type 'mathml)
  16150 		  ;; Process to MathML.
  16151 		  (unless (org-format-latex-mathml-available-p)
  16152 		    (user-error "LaTeX to MathML converter not configured"))
  16153 		  (cl-incf cnt)
  16154 		  (when msg (message msg cnt))
  16155 		  (goto-char beg)
  16156 		  (delete-region beg end)
  16157 		  (insert (org-format-latex-as-mathml
  16158 			   value block-type prefix dir)))
  16159 		 (t
  16160 		  (error "Unknown conversion process %s for LaTeX fragments"
  16161 			 processing-type)))))))))))
  16162 
  16163 (defun org-create-math-formula (latex-frag &optional mathml-file)
  16164   "Convert LATEX-FRAG to MathML and store it in MATHML-FILE.
  16165 Use `org-latex-to-mathml-convert-command'.  If the conversion is
  16166 successful, return the portion between \"<math...> </math>\"
  16167 elements otherwise return nil.  When MATHML-FILE is specified,
  16168 write the results in to that file.  When invoked as an
  16169 interactive command, prompt for LATEX-FRAG, with initial value
  16170 set to the current active region and echo the results for user
  16171 inspection."
  16172   (interactive (list (let ((frag (when (org-region-active-p)
  16173 				   (buffer-substring-no-properties
  16174 				    (region-beginning) (region-end)))))
  16175 		       (read-string "LaTeX Fragment: " frag nil frag))))
  16176   (unless latex-frag (user-error "Invalid LaTeX fragment"))
  16177   (let* ((tmp-in-file
  16178 	  (let ((file (file-relative-name
  16179 		       (make-temp-name (expand-file-name "ltxmathml-in")))))
  16180 	    (write-region latex-frag nil file)
  16181 	    file))
  16182 	 (tmp-out-file (file-relative-name
  16183 			(make-temp-name (expand-file-name  "ltxmathml-out"))))
  16184 	 (cmd (format-spec
  16185 	       org-latex-to-mathml-convert-command
  16186 	       `((?j . ,(and org-latex-to-mathml-jar-file
  16187 			     (shell-quote-argument
  16188 			      (expand-file-name
  16189 			       org-latex-to-mathml-jar-file))))
  16190 		 (?I . ,(shell-quote-argument tmp-in-file))
  16191 		 (?i . ,latex-frag)
  16192 		 (?o . ,(shell-quote-argument tmp-out-file)))))
  16193 	 mathml shell-command-output)
  16194     (when (called-interactively-p 'any)
  16195       (unless (org-format-latex-mathml-available-p)
  16196 	(user-error "LaTeX to MathML converter not configured")))
  16197     (message "Running %s" cmd)
  16198     (setq shell-command-output (shell-command-to-string cmd))
  16199     (setq mathml
  16200 	  (when (file-readable-p tmp-out-file)
  16201 	    (with-current-buffer (find-file-noselect tmp-out-file t)
  16202 	      (goto-char (point-min))
  16203 	      (when (re-search-forward
  16204 		     (format "<math[^>]*?%s[^>]*?>\\(.\\|\n\\)*</math>"
  16205 			     (regexp-quote
  16206 			      "xmlns=\"http://www.w3.org/1998/Math/MathML\""))
  16207 		     nil t)
  16208 		(prog1 (match-string 0) (kill-buffer))))))
  16209     (cond
  16210      (mathml
  16211       (setq mathml
  16212 	    (concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" mathml))
  16213       (when mathml-file
  16214 	(write-region mathml nil mathml-file))
  16215       (when (called-interactively-p 'any)
  16216 	(message mathml)))
  16217      ((warn "LaTeX to MathML conversion failed")
  16218       (message shell-command-output)))
  16219     (delete-file tmp-in-file)
  16220     (when (file-exists-p tmp-out-file)
  16221       (delete-file tmp-out-file))
  16222     mathml))
  16223 
  16224 (defun org-format-latex-as-mathml (latex-frag latex-frag-type
  16225 					      prefix &optional dir)
  16226   "Use `org-create-math-formula' but check local cache first."
  16227   (let* ((absprefix (expand-file-name prefix dir))
  16228 	 (print-length nil) (print-level nil)
  16229 	 (formula-id (concat
  16230 		      "formula-"
  16231 		      (sha1
  16232 		       (prin1-to-string
  16233 			(list latex-frag
  16234 			      org-latex-to-mathml-convert-command)))))
  16235 	 (formula-cache (format "%s-%s.mathml" absprefix formula-id))
  16236 	 (formula-cache-dir (file-name-directory formula-cache)))
  16237 
  16238     (unless (file-directory-p formula-cache-dir)
  16239       (make-directory formula-cache-dir t))
  16240 
  16241     (unless (file-exists-p formula-cache)
  16242       (org-create-math-formula latex-frag formula-cache))
  16243 
  16244     (if (file-exists-p formula-cache)
  16245 	;; Successful conversion.  Return the link to MathML file.
  16246 	(org-add-props
  16247 	    (format  "[[file:%s]]" (file-relative-name formula-cache dir))
  16248 	    (list 'org-latex-src (replace-regexp-in-string "\"" "" latex-frag)
  16249 		  'org-latex-src-embed-type (if latex-frag-type
  16250 						'paragraph 'character)))
  16251       ;; Failed conversion.  Return the LaTeX fragment verbatim
  16252       latex-frag)))
  16253 
  16254 (defun org-format-latex-as-html (latex-fragment)
  16255   "Convert LATEX-FRAGMENT to HTML.
  16256 This uses  `org-latex-to-html-convert-command', which see."
  16257   (let ((cmd (format-spec org-latex-to-html-convert-command
  16258 			  `((?i . ,latex-fragment)))))
  16259     (message "Running %s" cmd)
  16260     (shell-command-to-string cmd)))
  16261 
  16262 (defun org--get-display-dpi ()
  16263   "Get the DPI of the display.
  16264 The function assumes that the display has the same pixel width in
  16265 the horizontal and vertical directions."
  16266   (if (display-graphic-p)
  16267       (round (/ (display-pixel-height)
  16268 		(/ (display-mm-height) 25.4)))
  16269     (error "Attempt to calculate the dpi of a non-graphic display")))
  16270 
  16271 (defun org-create-formula-image
  16272     (string tofile options buffer &optional processing-type)
  16273   "Create an image from LaTeX source using external processes.
  16274 
  16275 The LaTeX STRING is saved to a temporary LaTeX file, then
  16276 converted to an image file by process PROCESSING-TYPE defined in
  16277 `org-preview-latex-process-alist'.  A nil value defaults to
  16278 `org-preview-latex-default-process'.
  16279 
  16280 The generated image file is eventually moved to TOFILE.
  16281 
  16282 The OPTIONS argument controls the size, foreground color and
  16283 background color of the generated image.
  16284 
  16285 When BUFFER non-nil, this function is used for LaTeX previewing.
  16286 Otherwise, it is used to deal with LaTeX snippets showed in
  16287 a HTML file."
  16288   (let* ((processing-type (or processing-type
  16289 			      org-preview-latex-default-process))
  16290 	 (processing-info
  16291 	  (cdr (assq processing-type org-preview-latex-process-alist)))
  16292 	 (programs (plist-get processing-info :programs))
  16293 	 (error-message (or (plist-get processing-info :message) ""))
  16294 	 (image-input-type (plist-get processing-info :image-input-type))
  16295 	 (image-output-type (plist-get processing-info :image-output-type))
  16296 	 (post-clean (or (plist-get processing-info :post-clean)
  16297 			 '(".dvi" ".xdv" ".pdf" ".tex" ".aux" ".log"
  16298 			   ".svg" ".png" ".jpg" ".jpeg" ".out")))
  16299 	 (latex-header
  16300 	  (or (plist-get processing-info :latex-header)
  16301 	      (org-latex-make-preamble
  16302 	       (org-export-get-environment (org-export-get-backend 'latex))
  16303 	       org-format-latex-header
  16304 	       'snippet)))
  16305 	 (latex-compiler (plist-get processing-info :latex-compiler))
  16306 	 (image-converter (plist-get processing-info :image-converter))
  16307 	 (tmpdir temporary-file-directory)
  16308 	 (texfilebase (make-temp-name
  16309 		       (expand-file-name "orgtex" tmpdir)))
  16310 	 (texfile (concat texfilebase ".tex"))
  16311 	 (image-size-adjust (or (plist-get processing-info :image-size-adjust)
  16312 				'(1.0 . 1.0)))
  16313 	 (scale (* (if buffer (car image-size-adjust) (cdr image-size-adjust))
  16314 		   (or (plist-get options (if buffer :scale :html-scale)) 1.0)))
  16315 	 (dpi (* scale (if buffer (org--get-display-dpi) 140.0)))
  16316 	 (fg (or (plist-get options (if buffer :foreground :html-foreground))
  16317 		 "Black"))
  16318 	 (bg (or (plist-get options (if buffer :background :html-background))
  16319 		 "Transparent"))
  16320 	 (log-buf (get-buffer-create "*Org Preview LaTeX Output*"))
  16321 	 (resize-mini-windows nil)) ;Fix Emacs flicker when creating image.
  16322     (dolist (program programs)
  16323       (org-check-external-command program error-message))
  16324     (if (eq fg 'default)
  16325 	(setq fg (org-latex-color :foreground))
  16326       (setq fg (org-latex-color-format fg)))
  16327     (setq bg (cond
  16328 	      ((eq bg 'default) (org-latex-color :background))
  16329 	      ((string= bg "Transparent") nil)
  16330 	      (t (org-latex-color-format bg))))
  16331     ;; Remove TeX \par at end of snippet to avoid trailing space.
  16332     (if (string-suffix-p string "\n")
  16333         (aset string (1- (length string)) ?%)
  16334       (setq string (concat string "%")))
  16335     (with-temp-file texfile
  16336       (insert latex-header)
  16337       (insert "\n\\begin{document}\n"
  16338 	      "\\definecolor{fg}{rgb}{" fg "}%\n"
  16339 	      (if bg
  16340 		  (concat "\\definecolor{bg}{rgb}{" bg "}%\n"
  16341 			  "\n\\pagecolor{bg}%\n")
  16342 		"")
  16343 	      "\n{\\color{fg}\n"
  16344 	      string
  16345 	      "\n}\n"
  16346 	      "\n\\end{document}\n"))
  16347     (let* ((err-msg (format "Please adjust `%s' part of \
  16348 `org-preview-latex-process-alist'."
  16349 			    processing-type))
  16350 	   (image-input-file
  16351 	    (org-compile-file
  16352 	     texfile latex-compiler image-input-type err-msg log-buf))
  16353 	   (image-output-file
  16354 	    (org-compile-file
  16355 	     image-input-file image-converter image-output-type err-msg log-buf
  16356 	     `((?D . ,(shell-quote-argument (format "%s" dpi)))
  16357 	       (?S . ,(shell-quote-argument (format "%s" (/ dpi 140.0))))))))
  16358       (copy-file image-output-file tofile 'replace)
  16359       (dolist (e post-clean)
  16360 	(when (file-exists-p (concat texfilebase e))
  16361 	  (delete-file (concat texfilebase e))))
  16362       image-output-file)))
  16363 
  16364 (defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra)
  16365   "Fill a LaTeX header template TPL.
  16366 In the template, the following place holders will be recognized:
  16367 
  16368  [DEFAULT-PACKAGES]      \\usepackage statements for DEF-PKG
  16369  [NO-DEFAULT-PACKAGES]   do not include DEF-PKG
  16370  [PACKAGES]              \\usepackage statements for PKG
  16371  [NO-PACKAGES]           do not include PKG
  16372  [EXTRA]                 the string EXTRA
  16373  [NO-EXTRA]              do not include EXTRA
  16374 
  16375 For backward compatibility, if both the positive and the negative place
  16376 holder is missing, the positive one (without the \"NO-\") will be
  16377 assumed to be present at the end of the template.
  16378 DEF-PKG and PKG are assumed to be alists of options/packagename lists.
  16379 EXTRA is a string.
  16380 SNIPPETS-P indicates if this is run to create snippet images for HTML."
  16381   (let (rpl (end ""))
  16382     (if (string-match "^[ \t]*\\[\\(NO-\\)?DEFAULT-PACKAGES\\][ \t]*\n?" tpl)
  16383 	(setq rpl (if (or (match-end 1) (not def-pkg))
  16384 		      "" (org-latex-packages-to-string def-pkg snippets-p t))
  16385 	      tpl (replace-match rpl t t tpl))
  16386       (when def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p))))
  16387 
  16388     (if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl)
  16389 	(setq rpl (if (or (match-end 1) (not pkg))
  16390 		      "" (org-latex-packages-to-string pkg snippets-p t))
  16391 	      tpl (replace-match rpl t t tpl))
  16392       (when pkg (setq end
  16393 		      (concat end "\n"
  16394 			      (org-latex-packages-to-string pkg snippets-p)))))
  16395 
  16396     (if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl)
  16397 	(setq rpl (if (or (match-end 1) (not extra))
  16398 		      "" (concat extra "\n"))
  16399 	      tpl (replace-match rpl t t tpl))
  16400       (when (and extra (string-match "\\S-" extra))
  16401 	(setq end (concat end "\n" extra))))
  16402 
  16403     (if (string-match "\\S-" end)
  16404 	(concat tpl "\n" end)
  16405       tpl)))
  16406 
  16407 (defun org-latex-packages-to-string (pkg &optional snippets-p newline)
  16408   "Turn an alist of packages into a string with the \\usepackage macros."
  16409   (setq pkg (mapconcat (lambda(p)
  16410 			 (cond
  16411 			  ((stringp p) p)
  16412 			  ((and snippets-p (>= (length p) 3) (not (nth 2 p)))
  16413 			   (format "%% Package %s omitted" (cadr p)))
  16414 			  ((equal "" (car p))
  16415 			   (format "\\usepackage{%s}" (cadr p)))
  16416 			  (t
  16417 			   (format "\\usepackage[%s]{%s}"
  16418 				   (car p) (cadr p)))))
  16419 		       pkg
  16420 		       "\n"))
  16421   (if newline (concat pkg "\n") pkg))
  16422 
  16423 (defun org-dvipng-color (attr)
  16424   "Return a RGB color specification for dvipng."
  16425   (org-dvipng-color-format (face-attribute 'default attr nil)))
  16426 
  16427 (defun org-dvipng-color-format (color-name)
  16428   "Convert COLOR-NAME to a RGB color value for dvipng."
  16429   (apply #'format "rgb %s %s %s"
  16430 	 (mapcar 'org-normalize-color
  16431 		 (color-values color-name))))
  16432 
  16433 (defun org-latex-color (attr)
  16434   "Return a RGB color for the LaTeX color package."
  16435   (org-latex-color-format (face-attribute 'default attr nil)))
  16436 
  16437 (defun org-latex-color-format (color-name)
  16438   "Convert COLOR-NAME to a RGB color value."
  16439   (apply #'format "%s,%s,%s"
  16440 	 (mapcar 'org-normalize-color
  16441 		 (color-values color-name))))
  16442 
  16443 (defun org-normalize-color (value)
  16444   "Return string to be used as color value for an RGB component."
  16445   (format "%g" (/ value 65535.0)))
  16446 
  16447 
  16448 ;; Image display
  16449 
  16450 (defvar-local org-inline-image-overlays nil)
  16451 
  16452 (defun org-toggle-inline-images (&optional include-linked)
  16453   "Toggle the display of inline images.
  16454 INCLUDE-LINKED is passed to `org-display-inline-images'."
  16455   (interactive "P")
  16456   (if org-inline-image-overlays
  16457       (progn
  16458 	(org-remove-inline-images)
  16459 	(when (called-interactively-p 'interactive)
  16460 	  (message "Inline image display turned off")))
  16461     (org-display-inline-images include-linked)
  16462     (when (called-interactively-p 'interactive)
  16463       (message (if org-inline-image-overlays
  16464 		   (format "%d images displayed inline"
  16465 			   (length org-inline-image-overlays))
  16466 		 "No images to display inline")))))
  16467 
  16468 (defun org-redisplay-inline-images ()
  16469   "Assure display of inline images and refresh them."
  16470   (interactive)
  16471   (org-toggle-inline-images)
  16472   (unless org-inline-image-overlays
  16473     (org-toggle-inline-images)))
  16474 
  16475 ;; For without-x builds.
  16476 (declare-function image-refresh "image" (spec &optional frame))
  16477 
  16478 (defcustom org-display-remote-inline-images 'skip
  16479   "How to display remote inline images.
  16480 Possible values of this option are:
  16481 
  16482 skip        Don't display remote images.
  16483 download    Always download and display remote images.
  16484 cache       Display remote images, and open them in separate buffers
  16485             for caching.  Silently update the image buffer when a file
  16486             change is detected."
  16487   :group 'org-appearance
  16488   :package-version '(Org . "9.4")
  16489   :type '(choice
  16490 	  (const :tag "Ignore remote images" skip)
  16491 	  (const :tag "Always display remote images" download)
  16492 	  (const :tag "Display and silently update remote images" cache))
  16493   :safe #'symbolp)
  16494 
  16495 (defun org--create-inline-image (file width)
  16496   "Create image located at FILE, or return nil.
  16497 WIDTH is the width of the image.  The image may not be created
  16498 according to the value of `org-display-remote-inline-images'."
  16499   (let* ((remote? (file-remote-p file))
  16500 	 (file-or-data
  16501 	  (pcase org-display-remote-inline-images
  16502 	    ((guard (not remote?)) file)
  16503 	    (`download (with-temp-buffer
  16504 			 (set-buffer-multibyte nil)
  16505 			 (insert-file-contents-literally file)
  16506 			 (buffer-string)))
  16507 	    (`cache (let ((revert-without-query '(".")))
  16508 		      (with-current-buffer (find-file-noselect file)
  16509 			(buffer-string))))
  16510 	    (`skip nil)
  16511 	    (other
  16512 	     (message "Invalid value of `org-display-remote-inline-images': %S"
  16513 		      other)
  16514 	     nil))))
  16515     (when file-or-data
  16516       (create-image file-or-data
  16517 		    (and (image-type-available-p 'imagemagick)
  16518 			 width
  16519 			 'imagemagick)
  16520 		    remote?
  16521 		    :width width))))
  16522 
  16523 (defun org-display-inline-images (&optional include-linked refresh beg end)
  16524   "Display inline images.
  16525 
  16526 An inline image is a link which follows either of these
  16527 conventions:
  16528 
  16529   1. Its path is a file with an extension matching return value
  16530      from `image-file-name-regexp' and it has no contents.
  16531 
  16532   2. Its description consists in a single link of the previous
  16533      type.  In this case, that link must be a well-formed plain
  16534      or angle link, i.e., it must have an explicit \"file\" type.
  16535 
  16536 Equip each image with the key-map `image-map'.
  16537 
  16538 When optional argument INCLUDE-LINKED is non-nil, also links with
  16539 a text description part will be inlined.  This can be nice for
  16540 a quick look at those images, but it does not reflect what
  16541 exported files will look like.
  16542 
  16543 When optional argument REFRESH is non-nil, refresh existing
  16544 images between BEG and END.  This will create new image displays
  16545 only if necessary.
  16546 
  16547 BEG and END define the considered part.  They default to the
  16548 buffer boundaries with possible narrowing."
  16549   (interactive "P")
  16550   (when (display-graphic-p)
  16551     (unless refresh
  16552       (org-remove-inline-images)
  16553       (when (fboundp 'clear-image-cache) (clear-image-cache)))
  16554     (let ((end (or end (point-max))))
  16555       (org-with-point-at (or beg (point-min))
  16556 	(let* ((case-fold-search t)
  16557 	       (file-extension-re (image-file-name-regexp))
  16558 	       (link-abbrevs (mapcar #'car
  16559 				     (append org-link-abbrev-alist-local
  16560 					     org-link-abbrev-alist)))
  16561 	       ;; Check absolute, relative file names and explicit
  16562 	       ;; "file:" links.  Also check link abbreviations since
  16563 	       ;; some might expand to "file" links.
  16564 	       (file-types-re
  16565 		(format "\\[\\[\\(?:file%s:\\|attachment:\\|[./~]\\)\\|\\]\\[\\(<?file:\\)"
  16566 			(if (not link-abbrevs) ""
  16567 			  (concat "\\|" (regexp-opt link-abbrevs))))))
  16568 	  (while (re-search-forward file-types-re end t)
  16569 	    (let* ((link (org-element-lineage
  16570 			  (save-match-data (org-element-context))
  16571 			  '(link) t))
  16572                    (linktype (org-element-property :type link))
  16573 		   (inner-start (match-beginning 1))
  16574 		   (path
  16575 		    (cond
  16576 		     ;; No link at point; no inline image.
  16577 		     ((not link) nil)
  16578 		     ;; File link without a description.  Also handle
  16579 		     ;; INCLUDE-LINKED here since it should have
  16580 		     ;; precedence over the next case.  I.e., if link
  16581 		     ;; contains filenames in both the path and the
  16582 		     ;; description, prioritize the path only when
  16583 		     ;; INCLUDE-LINKED is non-nil.
  16584 		     ((or (not (org-element-property :contents-begin link))
  16585 			  include-linked)
  16586 		      (and (or (equal "file" linktype)
  16587                                (equal "attachment" linktype))
  16588 			   (org-element-property :path link)))
  16589 		     ;; Link with a description.  Check if description
  16590 		     ;; is a filename.  Even if Org doesn't have syntax
  16591 		     ;; for those -- clickable image -- constructs, fake
  16592 		     ;; them, as in `org-export-insert-image-links'.
  16593 		     ((not inner-start) nil)
  16594 		     (t
  16595 		      (org-with-point-at inner-start
  16596 			(and (looking-at
  16597 			      (if (char-equal ?< (char-after inner-start))
  16598 				  org-link-angle-re
  16599 				org-link-plain-re))
  16600 			     ;; File name must fill the whole
  16601 			     ;; description.
  16602 			     (= (org-element-property :contents-end link)
  16603 				(match-end 0))
  16604 			     (match-string 2)))))))
  16605 	      (when (and path (string-match-p file-extension-re path))
  16606 		(let ((file (if (equal "attachment" linktype)
  16607 				(progn
  16608                                   (require 'org-attach)
  16609 				  (ignore-errors (org-attach-expand path)))
  16610                               (expand-file-name path))))
  16611 		  (when (and file (file-exists-p file))
  16612 		    (let ((width (org-display-inline-image--width link))
  16613 			  (old (get-char-property-and-overlay
  16614 				(org-element-property :begin link)
  16615 				'org-image-overlay)))
  16616 		      (if (and (car-safe old) refresh)
  16617 			  (image-refresh (overlay-get (cdr old) 'display))
  16618 			(let ((image (org--create-inline-image file width)))
  16619 			  (when image
  16620 			    (let ((ov (make-overlay
  16621 				       (org-element-property :begin link)
  16622 				       (progn
  16623 					 (goto-char
  16624 					  (org-element-property :end link))
  16625 					 (skip-chars-backward " \t")
  16626 					 (point)))))
  16627 			      (overlay-put ov 'display image)
  16628 			      (overlay-put ov 'face 'default)
  16629 			      (overlay-put ov 'org-image-overlay t)
  16630 			      (overlay-put
  16631 			       ov 'modification-hooks
  16632 			       (list 'org-display-inline-remove-overlay))
  16633 			      (when (boundp 'image-map)
  16634 				(overlay-put ov 'keymap image-map))
  16635 			      (push ov org-inline-image-overlays))))))))))))))))
  16636 
  16637 (defvar visual-fill-column-width) ; Silence compiler warning
  16638 (defun org-display-inline-image--width (link)
  16639   "Determine the display width of the image LINK, in pixels.
  16640 - When `org-image-actual-width' is t, the image's pixel width is used.
  16641 - When `org-image-actual-width' is a number, that value will is used.
  16642 - When `org-image-actual-width' is nil or a list, the first :width attribute
  16643   set (if it exists) is used to set the image width.  A width of X% is
  16644   divided by 100.
  16645   If no :width attribute is given and `org-image-actual-width' is a list with
  16646   a number as the car, then that number is used as the default value.
  16647   If the value is a float between 0 and 2, it interpreted as that proportion
  16648   of the text width in the buffer."
  16649   ;; Apply `org-image-actual-width' specifications.
  16650   (cond
  16651    ((eq org-image-actual-width t) nil)
  16652    ((listp org-image-actual-width)
  16653     (let* ((case-fold-search t)
  16654            (par (org-element-lineage link '(paragraph)))
  16655            (attr-re "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)")
  16656            (par-end (org-element-property :post-affiliated par))
  16657            ;; Try to find an attribute providing a :width.
  16658            (attr-width
  16659             (when (and par (org-with-point-at
  16660                                (org-element-property :begin par)
  16661                              (re-search-forward attr-re par-end t)))
  16662               (match-string 1)))
  16663            (attr-width-val
  16664             (cond
  16665              ((null attr-width) nil)
  16666              ((string-match-p "\\`[0-9.]+%" attr-width)
  16667               (/ (string-to-number attr-width) 100.0))
  16668              (t (string-to-number attr-width))))
  16669            ;; Fallback to `org-image-actual-width' if no explicit width is given.
  16670            (width (or attr-width-val (car org-image-actual-width))))
  16671       (if (and (floatp width) (<= 0.0 width 2.0))
  16672           ;; A float in [0,2] should be interpereted as this portion of
  16673           ;; the text width in the window.  This works well with cases like
  16674           ;; #+attr_latex: :width 0.X\{line,page,column,etc.}width,
  16675           ;; as the "0.X" is pulled out as a float.  We use 2 as the upper
  16676           ;; bound as cases such as 1.2\linewidth are feasible.
  16677           (round (* width
  16678                     (window-pixel-width)
  16679                     (/ (or (and (bound-and-true-p visual-fill-column-mode)
  16680                                 (or visual-fill-column-width auto-fill-function))
  16681                            (when auto-fill-function fill-column)
  16682                            (window-text-width))
  16683                        (float (window-total-width)))))
  16684         width)))
  16685    ((numberp org-image-actual-width)
  16686     org-image-actual-width)
  16687    (t nil)))
  16688 
  16689 (defun org-display-inline-remove-overlay (ov after _beg _end &optional _len)
  16690   "Remove inline-display overlay if a corresponding region is modified."
  16691   (let ((inhibit-modification-hooks t))
  16692     (when (and ov after)
  16693       (delete ov org-inline-image-overlays)
  16694       (delete-overlay ov))))
  16695 
  16696 (defun org-remove-inline-images ()
  16697   "Remove inline display of images."
  16698   (interactive)
  16699   (mapc #'delete-overlay org-inline-image-overlays)
  16700   (setq org-inline-image-overlays nil))
  16701 
  16702 (defvar org-self-insert-command-undo-counter 0)
  16703 (defvar org-speed-command nil)
  16704 
  16705 (defun org-self-insert-command (N)
  16706   "Like `self-insert-command', use overwrite-mode for whitespace in tables.
  16707 If the cursor is in a table looking at whitespace, the whitespace is
  16708 overwritten, and the table is not marked as requiring realignment."
  16709   (interactive "p")
  16710   (org-check-before-invisible-edit 'insert)
  16711   (cond
  16712    ((and org-use-speed-commands
  16713 	 (let ((kv (this-command-keys-vector)))
  16714 	   (setq org-speed-command
  16715 		 (run-hook-with-args-until-success
  16716 		  'org-speed-command-hook
  16717 		  (make-string 1 (aref kv (1- (length kv))))))))
  16718     (cond
  16719      ((commandp org-speed-command)
  16720       (setq this-command org-speed-command)
  16721       (call-interactively org-speed-command))
  16722      ((functionp org-speed-command)
  16723       (funcall org-speed-command))
  16724      ((and org-speed-command (listp org-speed-command))
  16725       (eval org-speed-command))
  16726      (t (let (org-use-speed-commands)
  16727 	  (call-interactively 'org-self-insert-command)))))
  16728    ((and
  16729      (= N 1)
  16730      (not (org-region-active-p))
  16731      (org-at-table-p)
  16732      (progn
  16733        ;; Check if we blank the field, and if that triggers align.
  16734        (and (featurep 'org-table)
  16735 	    org-table-auto-blank-field
  16736 	    (memq last-command
  16737 		  '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c))
  16738 	    (if (or (eq (char-after) ?\s) (looking-at "[^|\n]*  |"))
  16739 		;; Got extra space, this field does not determine
  16740 		;; column width.
  16741 		(let (org-table-may-need-update) (org-table-blank-field))
  16742 	      ;; No extra space, this field may determine column
  16743 	      ;; width.
  16744 	      (org-table-blank-field)))
  16745        t)
  16746      (looking-at "[^|\n]*  |"))
  16747     ;; There is room for insertion without re-aligning the table.
  16748     (self-insert-command N)
  16749     (org-table-with-shrunk-field
  16750      (save-excursion
  16751        (skip-chars-forward "^|")
  16752        ;; Do not delete last space, which is
  16753        ;; `org-table-separator-space', but the regular space before
  16754        ;; it.
  16755        (delete-region (- (point) 2) (1- (point))))))
  16756    (t
  16757     (setq org-table-may-need-update t)
  16758     (self-insert-command N)
  16759     (org-fix-tags-on-the-fly)
  16760     (when org-self-insert-cluster-for-undo
  16761       (if (not (eq last-command 'org-self-insert-command))
  16762 	  (setq org-self-insert-command-undo-counter 1)
  16763 	(if (>= org-self-insert-command-undo-counter 20)
  16764 	    (setq org-self-insert-command-undo-counter 1)
  16765 	  (and (> org-self-insert-command-undo-counter 0)
  16766 	       buffer-undo-list (listp buffer-undo-list)
  16767 	       (not (cadr buffer-undo-list)) ; remove nil entry
  16768 	       (setcdr buffer-undo-list (cddr buffer-undo-list)))
  16769 	  (setq org-self-insert-command-undo-counter
  16770 		(1+ org-self-insert-command-undo-counter))))))))
  16771 
  16772 (defun org-check-before-invisible-edit (kind)
  16773   "Check if editing kind KIND would be dangerous with invisible text around.
  16774 The detailed reaction depends on the user option `org-catch-invisible-edits'."
  16775   ;; First, try to get out of here as quickly as possible, to reduce overhead
  16776   (when (and org-catch-invisible-edits
  16777 	     (or (not (boundp 'visible-mode)) (not visible-mode))
  16778 	     (or (get-char-property (point) 'invisible)
  16779 		 (get-char-property (max (point-min) (1- (point))) 'invisible)))
  16780     ;; OK, we need to take a closer look.  Do not consider
  16781     ;; invisibility obtained through text properties (e.g., link
  16782     ;; fontification), as it cannot be toggled.
  16783     (let* ((invisible-at-point
  16784 	    (pcase (get-char-property-and-overlay (point) 'invisible)
  16785 	      (`(,_ . ,(and (pred overlayp) o)) o)))
  16786 	   ;; Assume that point cannot land in the middle of an
  16787 	   ;; overlay, or between two overlays.
  16788 	   (invisible-before-point
  16789 	    (and (not invisible-at-point)
  16790 		 (not (bobp))
  16791 		 (pcase (get-char-property-and-overlay (1- (point)) 'invisible)
  16792 		   (`(,_ . ,(and (pred overlayp) o)) o))))
  16793 	   (border-and-ok-direction
  16794 	    (or
  16795 	     ;; Check if we are acting predictably before invisible
  16796 	     ;; text.
  16797 	     (and invisible-at-point
  16798 		  (memq kind '(insert delete-backward)))
  16799 	     ;; Check if we are acting predictably after invisible text
  16800 	     ;; This works not well, and I have turned it off.  It seems
  16801 	     ;; better to always show and stop after invisible text.
  16802 	     ;; (and (not invisible-at-point) invisible-before-point
  16803 	     ;;  (memq kind '(insert delete)))
  16804 	     )))
  16805       (when (or invisible-at-point invisible-before-point)
  16806 	(when (eq org-catch-invisible-edits 'error)
  16807 	  (user-error "Editing in invisible areas is prohibited, make them visible first"))
  16808 	(if (and org-custom-properties-overlays
  16809 		 (y-or-n-p "Display invisible properties in this buffer? "))
  16810 	    (org-toggle-custom-properties-visibility)
  16811 	  ;; Make the area visible
  16812 	  (save-excursion
  16813 	    (when invisible-before-point
  16814 	      (goto-char
  16815 	       (previous-single-char-property-change (point) 'invisible)))
  16816 	    ;; Remove whatever overlay is currently making yet-to-be
  16817 	    ;; edited text invisible.  Also remove nested invisibility
  16818 	    ;; related overlays.
  16819 	    (delete-overlay (or invisible-at-point invisible-before-point))
  16820 	    (let ((origin (if invisible-at-point (point) (1- (point)))))
  16821 	      (while (pcase (get-char-property-and-overlay origin 'invisible)
  16822 		       (`(,_ . ,(and (pred overlayp) o))
  16823 			(delete-overlay o)
  16824 			t)))))
  16825 	  (cond
  16826 	   ((eq org-catch-invisible-edits 'show)
  16827 	    ;; That's it, we do the edit after showing
  16828 	    (message
  16829 	     "Unfolding invisible region around point before editing")
  16830 	    (sit-for 1))
  16831 	   ((and (eq org-catch-invisible-edits 'smart)
  16832 		 border-and-ok-direction)
  16833 	    (message "Unfolding invisible region around point before editing"))
  16834 	   (t
  16835 	    ;; Don't do the edit, make the user repeat it in full visibility
  16836 	    (user-error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
  16837 
  16838 (defun org-fix-tags-on-the-fly ()
  16839   "Align tags in headline at point.
  16840 Unlike `org-align-tags', this function does nothing if point is
  16841 either not currently on a tagged headline or on a tag."
  16842   (when (and (org-match-line org-tag-line-re)
  16843 	     (< (point) (match-beginning 1)))
  16844     (org-align-tags)))
  16845 
  16846 (defun org-delete-backward-char (N)
  16847   "Like `delete-backward-char', insert whitespace at field end in tables.
  16848 When deleting backwards, in tables this function will insert whitespace in
  16849 front of the next \"|\" separator, to keep the table aligned.  The table will
  16850 still be marked for re-alignment if the field did fill the entire column,
  16851 because, in this case the deletion might narrow the column."
  16852   (interactive "p")
  16853   (save-match-data
  16854     (org-check-before-invisible-edit 'delete-backward)
  16855     (if (and (= N 1)
  16856 	     (not overwrite-mode)
  16857 	     (not (org-region-active-p))
  16858 	     (not (eq (char-before) ?|))
  16859 	     (save-excursion (skip-chars-backward " \t") (not (bolp)))
  16860 	     (looking-at-p ".*?|")
  16861 	     (org-at-table-p))
  16862 	(progn (forward-char -1) (org-delete-char 1))
  16863       (backward-delete-char N)
  16864       (org-fix-tags-on-the-fly))))
  16865 
  16866 (defun org-delete-char (N)
  16867   "Like `delete-char', but insert whitespace at field end in tables.
  16868 When deleting characters, in tables this function will insert whitespace in
  16869 front of the next \"|\" separator, to keep the table aligned.  The table will
  16870 still be marked for re-alignment if the field did fill the entire column,
  16871 because, in this case the deletion might narrow the column."
  16872   (interactive "p")
  16873   (save-match-data
  16874     (org-check-before-invisible-edit 'delete)
  16875     (cond
  16876      ((or (/= N 1)
  16877 	  (eq (char-after) ?|)
  16878 	  (save-excursion (skip-chars-backward " \t") (bolp))
  16879 	  (not (org-at-table-p)))
  16880       (delete-char N)
  16881       (org-fix-tags-on-the-fly))
  16882      ((looking-at ".\\(.*?\\)|")
  16883       (let* ((update? org-table-may-need-update)
  16884 	     (noalign (looking-at-p ".*?  |")))
  16885 	(delete-char 1)
  16886 	(org-table-with-shrunk-field
  16887 	 (save-excursion
  16888 	   ;; Last space is `org-table-separator-space', so insert
  16889 	   ;; a regular one before it instead.
  16890 	   (goto-char (- (match-end 0) 2))
  16891 	   (insert " ")))
  16892 	;; If there were two spaces at the end, this field does not
  16893 	;; determine the width of the column.
  16894 	(when noalign (setq org-table-may-need-update update?))))
  16895      (t
  16896       (delete-char N)))))
  16897 
  16898 ;; Make `delete-selection-mode' work with Org mode and Orgtbl mode
  16899 (put 'org-self-insert-command 'delete-selection
  16900      (lambda ()
  16901        (not (run-hook-with-args-until-success
  16902              'self-insert-uses-region-functions))))
  16903 (put 'orgtbl-self-insert-command 'delete-selection
  16904      (lambda ()
  16905        (not (run-hook-with-args-until-success
  16906              'self-insert-uses-region-functions))))
  16907 (put 'org-delete-char 'delete-selection 'supersede)
  16908 (put 'org-delete-backward-char 'delete-selection 'supersede)
  16909 (put 'org-yank 'delete-selection 'yank)
  16910 (put 'org-return 'delete-selection t)
  16911 
  16912 ;; Make `flyspell-mode' delay after some commands
  16913 (put 'org-self-insert-command 'flyspell-delayed t)
  16914 (put 'orgtbl-self-insert-command 'flyspell-delayed t)
  16915 (put 'org-delete-char 'flyspell-delayed t)
  16916 (put 'org-delete-backward-char 'flyspell-delayed t)
  16917 
  16918 ;; Make pabbrev-mode expand after Org mode commands
  16919 (put 'org-self-insert-command 'pabbrev-expand-after-command t)
  16920 (put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t)
  16921 
  16922 (defun org-transpose-words ()
  16923   "Transpose words for Org.
  16924 This uses the `org-mode-transpose-word-syntax-table' syntax
  16925 table, which interprets characters in `org-emphasis-alist' as
  16926 word constituents."
  16927   (interactive)
  16928   (with-syntax-table org-mode-transpose-word-syntax-table
  16929     (call-interactively 'transpose-words)))
  16930 
  16931 (defvar org-ctrl-c-ctrl-c-hook nil
  16932   "Hook for functions attaching themselves to `C-c C-c'.
  16933 
  16934 This can be used to add additional functionality to the `C-c C-c'
  16935 key which executes context-dependent commands.  This hook is run
  16936 before any other test, while `org-ctrl-c-ctrl-c-final-hook' is
  16937 run after the last test.
  16938 
  16939 Each function will be called with no arguments.  The function
  16940 must check if the context is appropriate for it to act.  If yes,
  16941 it should do its thing and then return a non-nil value.  If the
  16942 context is wrong, just do nothing and return nil.")
  16943 
  16944 (defvar org-ctrl-c-ctrl-c-final-hook nil
  16945   "Hook for functions attaching themselves to `C-c C-c'.
  16946 
  16947 This can be used to add additional functionality to the `C-c C-c'
  16948 key which executes context-dependent commands.  This hook is run
  16949 after any other test, while `org-ctrl-c-ctrl-c-hook' is run
  16950 before the first test.
  16951 
  16952 Each function will be called with no arguments.  The function
  16953 must check if the context is appropriate for it to act.  If yes,
  16954 it should do its thing and then return a non-nil value.  If the
  16955 context is wrong, just do nothing and return nil.")
  16956 
  16957 (defvar org-tab-first-hook nil
  16958   "Hook for functions to attach themselves to TAB.
  16959 See `org-ctrl-c-ctrl-c-hook' for more information.
  16960 This hook runs as the first action when TAB is pressed, even before
  16961 `org-cycle' messes around with the `outline-regexp' to cater for
  16962 inline tasks and plain list item folding.
  16963 If any function in this hook returns t, any other actions that
  16964 would have been caused by TAB (such as table field motion or visibility
  16965 cycling) will not occur.")
  16966 
  16967 (defvar org-tab-after-check-for-table-hook nil
  16968   "Hook for functions to attach themselves to TAB.
  16969 See `org-ctrl-c-ctrl-c-hook' for more information.
  16970 This hook runs after it has been established that the cursor is not in a
  16971 table, but before checking if the cursor is in a headline or if global cycling
  16972 should be done.
  16973 If any function in this hook returns t, not other actions like visibility
  16974 cycling will be done.")
  16975 
  16976 (defvar org-tab-after-check-for-cycling-hook nil
  16977   "Hook for functions to attach themselves to TAB.
  16978 See `org-ctrl-c-ctrl-c-hook' for more information.
  16979 This hook runs after it has been established that not table field motion and
  16980 not visibility should be done because of current context.  This is probably
  16981 the place where a package like yasnippets can hook in.")
  16982 
  16983 (defvar org-tab-before-tab-emulation-hook nil
  16984   "Hook for functions to attach themselves to TAB.
  16985 See `org-ctrl-c-ctrl-c-hook' for more information.
  16986 This hook runs after every other options for TAB have been exhausted, but
  16987 before indentation and \t insertion takes place.")
  16988 
  16989 (defvar org-metaleft-hook nil
  16990   "Hook for functions attaching themselves to `M-left'.
  16991 See `org-ctrl-c-ctrl-c-hook' for more information.")
  16992 (defvar org-metaright-hook nil
  16993   "Hook for functions attaching themselves to `M-right'.
  16994 See `org-ctrl-c-ctrl-c-hook' for more information.")
  16995 (defvar org-metaup-hook nil
  16996   "Hook for functions attaching themselves to `M-up'.
  16997 See `org-ctrl-c-ctrl-c-hook' for more information.")
  16998 (defvar org-metadown-hook nil
  16999   "Hook for functions attaching themselves to `M-down'.
  17000 See `org-ctrl-c-ctrl-c-hook' for more information.")
  17001 (defvar org-shiftmetaleft-hook nil
  17002   "Hook for functions attaching themselves to `M-S-left'.
  17003 See `org-ctrl-c-ctrl-c-hook' for more information.")
  17004 (defvar org-shiftmetaright-hook nil
  17005   "Hook for functions attaching themselves to `M-S-right'.
  17006 See `org-ctrl-c-ctrl-c-hook' for more information.")
  17007 (defvar org-shiftmetaup-hook nil
  17008   "Hook for functions attaching themselves to `M-S-up'.
  17009 See `org-ctrl-c-ctrl-c-hook' for more information.")
  17010 (defvar org-shiftmetadown-hook nil
  17011   "Hook for functions attaching themselves to `M-S-down'.
  17012 See `org-ctrl-c-ctrl-c-hook' for more information.")
  17013 (defvar org-metareturn-hook nil
  17014   "Hook for functions attaching themselves to `M-RET'.
  17015 See `org-ctrl-c-ctrl-c-hook' for more information.")
  17016 (defvar org-shiftup-hook nil
  17017   "Hook for functions attaching themselves to `S-up'.
  17018 See `org-ctrl-c-ctrl-c-hook' for more information.")
  17019 (defvar org-shiftup-final-hook nil
  17020   "Hook for functions attaching themselves to `S-up'.
  17021 This one runs after all other options except shift-select have been excluded.
  17022 See `org-ctrl-c-ctrl-c-hook' for more information.")
  17023 (defvar org-shiftdown-hook nil
  17024   "Hook for functions attaching themselves to `S-down'.
  17025 See `org-ctrl-c-ctrl-c-hook' for more information.")
  17026 (defvar org-shiftdown-final-hook nil
  17027   "Hook for functions attaching themselves to `S-down'.
  17028 This one runs after all other options except shift-select have been excluded.
  17029 See `org-ctrl-c-ctrl-c-hook' for more information.")
  17030 (defvar org-shiftleft-hook nil
  17031   "Hook for functions attaching themselves to `S-left'.
  17032 See `org-ctrl-c-ctrl-c-hook' for more information.")
  17033 (defvar org-shiftleft-final-hook nil
  17034   "Hook for functions attaching themselves to `S-left'.
  17035 This one runs after all other options except shift-select have been excluded.
  17036 See `org-ctrl-c-ctrl-c-hook' for more information.")
  17037 (defvar org-shiftright-hook nil
  17038   "Hook for functions attaching themselves to `S-right'.
  17039 See `org-ctrl-c-ctrl-c-hook' for more information.")
  17040 (defvar org-shiftright-final-hook nil
  17041   "Hook for functions attaching themselves to `S-right'.
  17042 This one runs after all other options except shift-select have been excluded.
  17043 See `org-ctrl-c-ctrl-c-hook' for more information.")
  17044 
  17045 (defun org-modifier-cursor-error ()
  17046   "Throw an error, a modified cursor command was applied in wrong context."
  17047   (user-error "This command is active in special context like tables, headlines or items"))
  17048 
  17049 (defun org-shiftselect-error ()
  17050   "Throw an error because Shift-Cursor command was applied in wrong context."
  17051   (if (and (boundp 'shift-select-mode) shift-select-mode)
  17052       (user-error "To use shift-selection with Org mode, customize `org-support-shift-select'")
  17053     (user-error "This command works only in special context like headlines or timestamps")))
  17054 
  17055 (defun org-call-for-shift-select (cmd)
  17056   (let ((this-command-keys-shift-translated t))
  17057     (call-interactively cmd)))
  17058 
  17059 (defun org-shifttab (&optional arg)
  17060   "Global visibility cycling or move to previous table field.
  17061 Call `org-table-previous-field' within a table.
  17062 When ARG is nil, cycle globally through visibility states.
  17063 When ARG is a numeric prefix, show contents of this level."
  17064   (interactive "P")
  17065   (cond
  17066    ((org-at-table-p) (call-interactively 'org-table-previous-field))
  17067    ((integerp arg)
  17068     (let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg)))
  17069       (message "Content view to level: %d" arg)
  17070       (org-content (prefix-numeric-value arg2))
  17071       (org-cycle-show-empty-lines t)
  17072       (setq org-cycle-global-status 'overview)
  17073       (run-hook-with-args 'org-cycle-hook 'overview)))
  17074    (t (call-interactively 'org-global-cycle))))
  17075 
  17076 (defun org-shiftmetaleft ()
  17077   "Promote subtree or delete table column.
  17078 Calls `org-promote-subtree', `org-outdent-item-tree', or
  17079 `org-table-delete-column', depending on context.  See the
  17080 individual commands for more information."
  17081   (interactive)
  17082   (cond
  17083    ((run-hook-with-args-until-success 'org-shiftmetaleft-hook))
  17084    ((org-at-table-p) (call-interactively 'org-table-delete-column))
  17085    ((org-at-heading-p) (call-interactively 'org-promote-subtree))
  17086    ((if (not (org-region-active-p)) (org-at-item-p)
  17087       (save-excursion (goto-char (region-beginning))
  17088 		      (org-at-item-p)))
  17089     (call-interactively 'org-outdent-item-tree))
  17090    (t (org-modifier-cursor-error))))
  17091 
  17092 (defun org-shiftmetaright ()
  17093   "Demote subtree or insert table column.
  17094 Calls `org-demote-subtree', `org-indent-item-tree', or
  17095 `org-table-insert-column', depending on context.  See the
  17096 individual commands for more information."
  17097   (interactive)
  17098   (cond
  17099    ((run-hook-with-args-until-success 'org-shiftmetaright-hook))
  17100    ((org-at-table-p) (call-interactively 'org-table-insert-column))
  17101    ((org-at-heading-p) (call-interactively 'org-demote-subtree))
  17102    ((if (not (org-region-active-p)) (org-at-item-p)
  17103       (save-excursion (goto-char (region-beginning))
  17104 		      (org-at-item-p)))
  17105     (call-interactively 'org-indent-item-tree))
  17106    (t (org-modifier-cursor-error))))
  17107 
  17108 (defun org-shiftmetaup (&optional _arg)
  17109   "Drag the line at point up.
  17110 In a table, kill the current row.
  17111 On a clock timestamp, update the value of the timestamp like `S-<up>'
  17112 but also adjust the previous clocked item in the clock history.
  17113 Everywhere else, drag the line at point up."
  17114   (interactive "P")
  17115   (cond
  17116    ((run-hook-with-args-until-success 'org-shiftmetaup-hook))
  17117    ((org-at-table-p) (call-interactively 'org-table-kill-row))
  17118    ((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
  17119 			   (call-interactively 'org-timestamp-up)))
  17120    (t (call-interactively 'org-drag-line-backward))))
  17121 
  17122 (defun org-shiftmetadown (&optional _arg)
  17123   "Drag the line at point down.
  17124 In a table, insert an empty row at the current line.
  17125 On a clock timestamp, update the value of the timestamp like `S-<down>'
  17126 but also adjust the previous clocked item in the clock history.
  17127 Everywhere else, drag the line at point down."
  17128   (interactive "P")
  17129   (cond
  17130    ((run-hook-with-args-until-success 'org-shiftmetadown-hook))
  17131    ((org-at-table-p) (call-interactively 'org-table-insert-row))
  17132    ((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
  17133 			   (call-interactively 'org-timestamp-down)))
  17134    (t (call-interactively 'org-drag-line-forward))))
  17135 
  17136 (defsubst org-hidden-tree-error ()
  17137   (user-error
  17138    "Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>"))
  17139 
  17140 (defun org-metaleft (&optional _arg)
  17141   "Promote heading, list item at point or move table column left.
  17142 
  17143 Calls `org-do-promote', `org-outdent-item' or `org-table-move-column',
  17144 depending on context.  With no specific context, calls the Emacs
  17145 default `backward-word'.  See the individual commands for more
  17146 information.
  17147 
  17148 This function runs the hook `org-metaleft-hook' as a first step,
  17149 and returns at first non-nil value."
  17150   (interactive "P")
  17151   (cond
  17152    ((run-hook-with-args-until-success 'org-metaleft-hook))
  17153    ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left))
  17154    ((org-with-limited-levels
  17155      (or (org-at-heading-p)
  17156 	 (and (org-region-active-p)
  17157 	      (save-excursion
  17158 		(goto-char (region-beginning))
  17159 		(org-at-heading-p)))))
  17160     (when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
  17161     (call-interactively 'org-do-promote))
  17162    ;; At an inline task.
  17163    ((org-at-heading-p)
  17164     (call-interactively 'org-inlinetask-promote))
  17165    ((or (org-at-item-p)
  17166 	(and (org-region-active-p)
  17167 	     (save-excursion
  17168 	       (goto-char (region-beginning))
  17169 	       (org-at-item-p))))
  17170     (when (org-check-for-hidden 'items) (org-hidden-tree-error))
  17171     (call-interactively 'org-outdent-item))
  17172    (t (call-interactively 'backward-word))))
  17173 
  17174 (defun org-metaright (&optional _arg)
  17175   "Demote heading, list item at point or move table column right.
  17176 
  17177 In front of a drawer or a block keyword, indent it correctly.
  17178 
  17179 Calls `org-do-demote', `org-indent-item', `org-table-move-column',
  17180 `org-indent-drawer' or `org-indent-block' depending on context.
  17181 With no specific context, calls the Emacs default `forward-word'.
  17182 See the individual commands for more information.
  17183 
  17184 This function runs the hook `org-metaright-hook' as a first step,
  17185 and returns at first non-nil value."
  17186   (interactive "P")
  17187   (cond
  17188    ((run-hook-with-args-until-success 'org-metaright-hook))
  17189    ((org-at-table-p) (call-interactively 'org-table-move-column))
  17190    ((org-at-drawer-p) (call-interactively 'org-indent-drawer))
  17191    ((org-at-block-p) (call-interactively 'org-indent-block))
  17192    ((org-with-limited-levels
  17193      (or (org-at-heading-p)
  17194 	 (and (org-region-active-p)
  17195 	      (save-excursion
  17196 		(goto-char (region-beginning))
  17197 		(org-at-heading-p)))))
  17198     (when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
  17199     (call-interactively 'org-do-demote))
  17200    ;; At an inline task.
  17201    ((org-at-heading-p)
  17202     (call-interactively 'org-inlinetask-demote))
  17203    ((or (org-at-item-p)
  17204 	(and (org-region-active-p)
  17205 	     (save-excursion
  17206 	       (goto-char (region-beginning))
  17207 	       (org-at-item-p))))
  17208     (when (org-check-for-hidden 'items) (org-hidden-tree-error))
  17209     (call-interactively 'org-indent-item))
  17210    (t (call-interactively 'forward-word))))
  17211 
  17212 (defun org-check-for-hidden (what)
  17213   "Check if there are hidden headlines/items in the current visual line.
  17214 WHAT can be either `headlines' or `items'.  If the current line is
  17215 an outline or item heading and it has a folded subtree below it,
  17216 this function returns t, nil otherwise."
  17217   (let ((re (cond
  17218 	     ((eq what 'headlines) org-outline-regexp-bol)
  17219 	     ((eq what 'items) (org-item-beginning-re))
  17220 	     (t (error "This should not happen"))))
  17221 	beg end)
  17222     (save-excursion
  17223       (catch 'exit
  17224 	(unless (org-region-active-p)
  17225 	  (setq beg (point-at-bol))
  17226 	  (beginning-of-line 2)
  17227 	  (while (and (not (eobp)) ;; this is like `next-line'
  17228 		      (get-char-property (1- (point)) 'invisible))
  17229 	    (beginning-of-line 2))
  17230 	  (setq end (point))
  17231 	  (goto-char beg)
  17232 	  (goto-char (point-at-eol))
  17233 	  (setq end (max end (point)))
  17234 	  (while (re-search-forward re end t)
  17235 	    (when (get-char-property (match-beginning 0) 'invisible)
  17236 	      (throw 'exit t))))
  17237 	nil))))
  17238 
  17239 (defun org-metaup (&optional _arg)
  17240   "Move subtree up or move table row up.
  17241 Calls `org-move-subtree-up' or `org-table-move-row' or
  17242 `org-move-item-up', depending on context.  See the individual commands
  17243 for more information."
  17244   (interactive "P")
  17245   (cond
  17246    ((run-hook-with-args-until-success 'org-metaup-hook))
  17247    ((org-region-active-p)
  17248     (let* ((a (save-excursion
  17249 		(goto-char (min (region-beginning) (region-end)))
  17250 		(line-beginning-position)))
  17251 	   (b (save-excursion
  17252 		(goto-char (max (region-beginning) (region-end)))
  17253 		(if (bolp) (1- (point)) (line-end-position))))
  17254 	   (c (save-excursion
  17255 		(goto-char a)
  17256 		(move-beginning-of-line 0)
  17257 		(point)))
  17258 	   (d (save-excursion
  17259 		(goto-char a)
  17260 		(move-end-of-line 0)
  17261 		(point))))
  17262       (transpose-regions a b c d)
  17263       (goto-char c)))
  17264    ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
  17265    ((and (featurep 'org-inlinetask)
  17266          (org-inlinetask-in-task-p))
  17267     (org-drag-element-backward))
  17268    ((org-at-heading-p) (call-interactively 'org-move-subtree-up))
  17269    ((org-at-item-p) (call-interactively 'org-move-item-up))
  17270    (t (org-drag-element-backward))))
  17271 
  17272 (defun org-metadown (&optional _arg)
  17273   "Move subtree down or move table row down.
  17274 Calls `org-move-subtree-down' or `org-table-move-row' or
  17275 `org-move-item-down', depending on context.  See the individual
  17276 commands for more information."
  17277   (interactive "P")
  17278   (cond
  17279    ((run-hook-with-args-until-success 'org-metadown-hook))
  17280    ((org-region-active-p)
  17281     (let* ((a (save-excursion
  17282 		(goto-char (min (region-beginning) (region-end)))
  17283 		(line-beginning-position)))
  17284 	   (b (save-excursion
  17285 		(goto-char (max (region-beginning) (region-end)))
  17286 		(if (bolp) (1- (point)) (line-end-position))))
  17287 	   (c (save-excursion
  17288 		(goto-char b)
  17289 		(move-beginning-of-line (if (bolp) 1 2))
  17290 		(point)))
  17291 	   (d (save-excursion
  17292 		(goto-char b)
  17293 		(move-end-of-line (if (bolp) 1 2))
  17294 		(point))))
  17295       (transpose-regions a b c d)
  17296       (goto-char d)))
  17297    ((org-at-table-p) (call-interactively 'org-table-move-row))
  17298    ((and (featurep 'org-inlinetask)
  17299          (org-inlinetask-in-task-p))
  17300     (org-drag-element-forward))
  17301    ((org-at-heading-p) (call-interactively 'org-move-subtree-down))
  17302    ((org-at-item-p) (call-interactively 'org-move-item-down))
  17303    (t (org-drag-element-forward))))
  17304 
  17305 (defun org-shiftup (&optional arg)
  17306   "Act on current element according to context.
  17307 Call `org-timestamp-up' or `org-priority-up', or
  17308 `org-previous-item', or `org-table-move-cell-up'.  See the
  17309 individual commands for more information."
  17310   (interactive "P")
  17311   (cond
  17312    ((run-hook-with-args-until-success 'org-shiftup-hook))
  17313    ((and org-support-shift-select (org-region-active-p))
  17314     (org-call-for-shift-select 'previous-line))
  17315    ((org-at-timestamp-p 'lax)
  17316     (call-interactively (if org-edit-timestamp-down-means-later
  17317 			    'org-timestamp-down 'org-timestamp-up)))
  17318    ((and (not (eq org-support-shift-select 'always))
  17319 	 org-priority-enable-commands
  17320 	 (org-at-heading-p))
  17321     (call-interactively 'org-priority-up))
  17322    ((and (not org-support-shift-select) (org-at-item-p))
  17323     (call-interactively 'org-previous-item))
  17324    ((org-clocktable-try-shift 'up arg))
  17325    ((and (not (eq org-support-shift-select 'always))
  17326 	 (org-at-table-p))
  17327     (org-table-move-cell-up))
  17328    ((run-hook-with-args-until-success 'org-shiftup-final-hook))
  17329    (org-support-shift-select
  17330     (org-call-for-shift-select 'previous-line))
  17331    (t (org-shiftselect-error))))
  17332 
  17333 (defun org-shiftdown (&optional arg)
  17334   "Act on current element according to context.
  17335 Call `org-timestamp-down' or `org-priority-down', or
  17336 `org-next-item', or `org-table-move-cell-down'.  See the
  17337 individual commands for more information."
  17338   (interactive "P")
  17339   (cond
  17340    ((run-hook-with-args-until-success 'org-shiftdown-hook))
  17341    ((and org-support-shift-select (org-region-active-p))
  17342     (org-call-for-shift-select 'next-line))
  17343    ((org-at-timestamp-p 'lax)
  17344     (call-interactively (if org-edit-timestamp-down-means-later
  17345 			    'org-timestamp-up 'org-timestamp-down)))
  17346    ((and (not (eq org-support-shift-select 'always))
  17347 	 org-priority-enable-commands
  17348 	 (org-at-heading-p))
  17349     (call-interactively 'org-priority-down))
  17350    ((and (not org-support-shift-select) (org-at-item-p))
  17351     (call-interactively 'org-next-item))
  17352    ((org-clocktable-try-shift 'down arg))
  17353    ((and (not (eq org-support-shift-select 'always))
  17354 	 (org-at-table-p))
  17355     (org-table-move-cell-down))
  17356    ((run-hook-with-args-until-success 'org-shiftdown-final-hook))
  17357    (org-support-shift-select
  17358     (org-call-for-shift-select 'next-line))
  17359    (t (org-shiftselect-error))))
  17360 
  17361 (defun org-shiftright (&optional arg)
  17362   "Act on the current element according to context.
  17363 This does one of the following:
  17364 
  17365 - switch a timestamp at point one day into the future
  17366 - on a headline, switch to the next TODO keyword
  17367 - on an item, switch entire list to the next bullet type
  17368 - on a property line, switch to the next allowed value
  17369 - on a clocktable definition line, move time block into the future
  17370 - in a table, move a single cell right"
  17371   (interactive "P")
  17372   (cond
  17373    ((run-hook-with-args-until-success 'org-shiftright-hook))
  17374    ((and org-support-shift-select (org-region-active-p))
  17375     (org-call-for-shift-select 'forward-char))
  17376    ((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-up-day))
  17377    ((and (not (eq org-support-shift-select 'always))
  17378 	 (org-at-heading-p))
  17379     (let ((org-inhibit-logging
  17380 	   (not org-treat-S-cursor-todo-selection-as-state-change))
  17381 	  (org-inhibit-blocking
  17382 	   (not org-treat-S-cursor-todo-selection-as-state-change)))
  17383       (org-call-with-arg 'org-todo 'right)))
  17384    ((or (and org-support-shift-select
  17385 	     (not (eq org-support-shift-select 'always))
  17386 	     (org-at-item-bullet-p))
  17387 	(and (not org-support-shift-select) (org-at-item-p)))
  17388     (org-call-with-arg 'org-cycle-list-bullet nil))
  17389    ((and (not (eq org-support-shift-select 'always))
  17390 	 (org-at-property-p))
  17391     (call-interactively 'org-property-next-allowed-value))
  17392    ((org-clocktable-try-shift 'right arg))
  17393    ((and (not (eq org-support-shift-select 'always))
  17394 	 (org-at-table-p))
  17395     (org-table-move-cell-right))
  17396    ((run-hook-with-args-until-success 'org-shiftright-final-hook))
  17397    (org-support-shift-select
  17398     (org-call-for-shift-select 'forward-char))
  17399    (t (org-shiftselect-error))))
  17400 
  17401 (defun org-shiftleft (&optional arg)
  17402   "Act on current element according to context.
  17403 This does one of the following:
  17404 
  17405 - switch a timestamp at point one day into the past
  17406 - on a headline, switch to the previous TODO keyword.
  17407 - on an item, switch entire list to the previous bullet type
  17408 - on a property line, switch to the previous allowed value
  17409 - on a clocktable definition line, move time block into the past
  17410 - in a table, move a single cell left"
  17411   (interactive "P")
  17412   (cond
  17413    ((run-hook-with-args-until-success 'org-shiftleft-hook))
  17414    ((and org-support-shift-select (org-region-active-p))
  17415     (org-call-for-shift-select 'backward-char))
  17416    ((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-down-day))
  17417    ((and (not (eq org-support-shift-select 'always))
  17418 	 (org-at-heading-p))
  17419     (let ((org-inhibit-logging
  17420 	   (not org-treat-S-cursor-todo-selection-as-state-change))
  17421 	  (org-inhibit-blocking
  17422 	   (not org-treat-S-cursor-todo-selection-as-state-change)))
  17423       (org-call-with-arg 'org-todo 'left)))
  17424    ((or (and org-support-shift-select
  17425 	     (not (eq org-support-shift-select 'always))
  17426 	     (org-at-item-bullet-p))
  17427 	(and (not org-support-shift-select) (org-at-item-p)))
  17428     (org-call-with-arg 'org-cycle-list-bullet 'previous))
  17429    ((and (not (eq org-support-shift-select 'always))
  17430 	 (org-at-property-p))
  17431     (call-interactively 'org-property-previous-allowed-value))
  17432    ((org-clocktable-try-shift 'left arg))
  17433    ((and (not (eq org-support-shift-select 'always))
  17434 	 (org-at-table-p))
  17435     (org-table-move-cell-left))
  17436    ((run-hook-with-args-until-success 'org-shiftleft-final-hook))
  17437    (org-support-shift-select
  17438     (org-call-for-shift-select 'backward-char))
  17439    (t (org-shiftselect-error))))
  17440 
  17441 (defun org-shiftcontrolright ()
  17442   "Switch to next TODO set."
  17443   (interactive)
  17444   (cond
  17445    ((and org-support-shift-select (org-region-active-p))
  17446     (org-call-for-shift-select 'forward-word))
  17447    ((and (not (eq org-support-shift-select 'always))
  17448 	 (org-at-heading-p))
  17449     (org-call-with-arg 'org-todo 'nextset))
  17450    (org-support-shift-select
  17451     (org-call-for-shift-select 'forward-word))
  17452    (t (org-shiftselect-error))))
  17453 
  17454 (defun org-shiftcontrolleft ()
  17455   "Switch to previous TODO set."
  17456   (interactive)
  17457   (cond
  17458    ((and org-support-shift-select (org-region-active-p))
  17459     (org-call-for-shift-select 'backward-word))
  17460    ((and (not (eq org-support-shift-select 'always))
  17461 	 (org-at-heading-p))
  17462     (org-call-with-arg 'org-todo 'previousset))
  17463    (org-support-shift-select
  17464     (org-call-for-shift-select 'backward-word))
  17465    (t (org-shiftselect-error))))
  17466 
  17467 (defun org-shiftcontrolup (&optional n)
  17468   "Change timestamps synchronously up in CLOCK log lines.
  17469 Optional argument N tells to change by that many units."
  17470   (interactive "P")
  17471   (if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax))
  17472       (let (org-support-shift-select)
  17473 	(org-clock-timestamps-up n))
  17474     (user-error "Not at a clock log")))
  17475 
  17476 (defun org-shiftcontroldown (&optional n)
  17477   "Change timestamps synchronously down in CLOCK log lines.
  17478 Optional argument N tells to change by that many units."
  17479   (interactive "P")
  17480   (if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax))
  17481       (let (org-support-shift-select)
  17482 	(org-clock-timestamps-down n))
  17483     (user-error "Not at a clock log")))
  17484 
  17485 (defun org-increase-number-at-point (&optional inc)
  17486   "Increment the number at point.
  17487 With an optional prefix numeric argument INC, increment using
  17488 this numeric value."
  17489   (interactive "p")
  17490   (if (not (number-at-point))
  17491       (user-error "Not on a number")
  17492     (unless inc (setq inc 1))
  17493     (let ((pos (point))
  17494 	  (beg (skip-chars-backward "-+^/*0-9eE."))
  17495 	  (end (skip-chars-forward "-+^/*0-9eE.")) nap)
  17496       (setq nap (buffer-substring-no-properties
  17497 		 (+ pos beg) (+ pos beg end)))
  17498       (delete-region (+ pos beg) (+ pos beg end))
  17499       (insert (calc-eval (concat (number-to-string inc) "+" nap))))
  17500     (when (org-at-table-p)
  17501       (org-table-align)
  17502       (org-table-end-of-field 1))))
  17503 
  17504 (defun org-decrease-number-at-point (&optional inc)
  17505   "Decrement the number at point.
  17506 With an optional prefix numeric argument INC, decrement using
  17507 this numeric value."
  17508   (interactive "p")
  17509   (org-increase-number-at-point (- (or inc 1))))
  17510 
  17511 (defun org-ctrl-c-ret ()
  17512   "Call `org-table-hline-and-move' or `org-insert-heading'."
  17513   (interactive)
  17514   (cond
  17515    ((org-at-table-p) (call-interactively 'org-table-hline-and-move))
  17516    (t (call-interactively 'org-insert-heading))))
  17517 
  17518 (defun org-copy-visible (beg end)
  17519   "Copy the visible parts of the region."
  17520   (interactive "r")
  17521   (let ((result ""))
  17522     (while (/= beg end)
  17523       (when (get-char-property beg 'invisible)
  17524 	(setq beg (next-single-char-property-change beg 'invisible nil end)))
  17525       (let ((next (next-single-char-property-change beg 'invisible nil end)))
  17526 	(setq result (concat result (buffer-substring beg next)))
  17527 	(setq beg next)))
  17528     (setq deactivate-mark t)
  17529     (kill-new result)
  17530     (message "Visible strings have been copied to the kill ring.")))
  17531 
  17532 (defun org-copy-special ()
  17533   "Copy region in table or copy current subtree.
  17534 Calls `org-table-copy-region' or `org-copy-subtree', depending on
  17535 context.  See the individual commands for more information."
  17536   (interactive)
  17537   (call-interactively
  17538    (if (org-at-table-p) #'org-table-copy-region #'org-copy-subtree)))
  17539 
  17540 (defun org-cut-special ()
  17541   "Cut region in table or cut current subtree.
  17542 Calls `org-table-cut-region' or `org-cut-subtree', depending on
  17543 context.  See the individual commands for more information."
  17544   (interactive)
  17545   (call-interactively
  17546    (if (org-at-table-p) #'org-table-cut-region #'org-cut-subtree)))
  17547 
  17548 (defun org-paste-special (arg)
  17549   "Paste rectangular region into table, or past subtree relative to level.
  17550 Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context.
  17551 See the individual commands for more information."
  17552   (interactive "P")
  17553   (if (org-at-table-p)
  17554       (org-table-paste-rectangle)
  17555     (org-paste-subtree arg)))
  17556 
  17557 (defun org-edit-special (&optional arg)
  17558   "Call a special editor for the element at point.
  17559 When at a table, call the formula editor with `org-table-edit-formulas'.
  17560 When in a source code block, call `org-edit-src-code'.
  17561 When in a fixed-width region, call `org-edit-fixed-width-region'.
  17562 When in an export block, call `org-edit-export-block'.
  17563 When in a LaTeX environment, call `org-edit-latex-environment'.
  17564 When at an INCLUDE, SETUPFILE or BIBLIOGRAPHY keyword, visit the included file.
  17565 When at a footnote reference, call `org-edit-footnote-reference'.
  17566 When at a planning line call, `org-deadline' and/or `org-schedule'.
  17567 When at an active timestamp, call `org-time-stamp'.
  17568 When at an inactive timestamp, call `org-time-stamp-inactive'.
  17569 On a link, call `ffap' to visit the link at point.
  17570 Otherwise, return a user error."
  17571   (interactive "P")
  17572   (let ((element (org-element-at-point)))
  17573     (barf-if-buffer-read-only)
  17574     (pcase (org-element-type element)
  17575       (`src-block
  17576        (if (not arg) (org-edit-src-code)
  17577 	 (let* ((info (org-babel-get-src-block-info))
  17578 		(lang (nth 0 info))
  17579 		(params (nth 2 info))
  17580 		(session (cdr (assq :session params))))
  17581 	   (if (not session) (org-edit-src-code)
  17582 	     ;; At a source block with a session and function called
  17583 	     ;; with an ARG: switch to the buffer related to the
  17584 	     ;; inferior process.
  17585 	     (switch-to-buffer
  17586 	      (funcall (intern (concat "org-babel-prep-session:" lang))
  17587 		       session params))))))
  17588       (`keyword
  17589        (unless (member (org-element-property :key element)
  17590 		       '("BIBLIOGRAPHY" "INCLUDE" "SETUPFILE"))
  17591 	 (user-error "No special environment to edit here"))
  17592        (let ((value (org-element-property :value element)))
  17593 	 (unless (org-string-nw-p value) (user-error "No file to edit"))
  17594 	 (let ((file (and (string-match "\\`\"\\(.*?\\)\"\\|\\S-+" value)
  17595 			  (or (match-string 1 value)
  17596 			      (match-string 0 value)))))
  17597 	   (when (org-url-p file)
  17598 	     (user-error "Files located with a URL cannot be edited"))
  17599 	   (org-link-open-from-string
  17600 	    (format "[[%s]]" (expand-file-name file))))))
  17601       (`table
  17602        (if (eq (org-element-property :type element) 'table.el)
  17603            (org-edit-table.el)
  17604          (call-interactively 'org-table-edit-formulas)))
  17605       ;; Only Org tables contain `table-row' type elements.
  17606       (`table-row (call-interactively 'org-table-edit-formulas))
  17607       (`example-block (org-edit-src-code))
  17608       (`export-block (org-edit-export-block))
  17609       (`fixed-width (org-edit-fixed-width-region))
  17610       (`latex-environment (org-edit-latex-environment))
  17611       (`planning
  17612        (let ((proplist (cadr element)))
  17613          (mapc #'call-interactively
  17614                (remq nil
  17615                      (list
  17616                       (when (plist-get proplist :deadline) #'org-deadline)
  17617                       (when (plist-get proplist :scheduled) #'org-schedule))))))
  17618       (_
  17619        ;; No notable element at point.  Though, we may be at a link or
  17620        ;; a footnote reference, which are objects.  Thus, scan deeper.
  17621        (let ((context (org-element-context element)))
  17622 	 (pcase (org-element-type context)
  17623 	   (`footnote-reference (org-edit-footnote-reference))
  17624 	   (`inline-src-block (org-edit-inline-src-code))
  17625 	   (`latex-fragment (org-edit-latex-fragment))
  17626 	   (`timestamp (if (eq 'inactive (org-element-property :type context))
  17627 			   (call-interactively #'org-time-stamp-inactive)
  17628 			 (call-interactively #'org-time-stamp)))
  17629 	   (`link (call-interactively #'ffap))
  17630 	   (_ (user-error "No special environment to edit here"))))))))
  17631 
  17632 (defun org-ctrl-c-ctrl-c (&optional arg)
  17633   "Set tags in headline, or update according to changed information at point.
  17634 
  17635 This command does many different things, depending on context:
  17636 
  17637 - If column view is active, in agenda or org buffers, quit it.
  17638 
  17639 - If there are highlights, remove them.
  17640 
  17641 - If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location,
  17642   this is what we do.
  17643 
  17644 - If the cursor is on a statistics cookie, update it.
  17645 
  17646 - If the cursor is in a headline, in an agenda or an org buffer,
  17647   prompt for tags and insert them into the current line, aligned
  17648   to `org-tags-column'.  When called with prefix arg, realign all
  17649   tags in the current buffer.
  17650 
  17651 - If the cursor is in one of the special #+KEYWORD lines, this
  17652   triggers scanning the buffer for these lines and updating the
  17653   information.
  17654 
  17655 - If the cursor is inside a table, realign the table.  This command
  17656   works even if the automatic table editor has been turned off.
  17657 
  17658 - If the cursor is on a #+TBLFM line, re-apply the formulas to
  17659   the entire table.
  17660 
  17661 - If the cursor is at a footnote reference or definition, jump to
  17662   the corresponding definition or references, respectively.
  17663 
  17664 - If the cursor is a the beginning of a dynamic block, update it.
  17665 
  17666 - If the current buffer is a capture buffer, close note and file it.
  17667 
  17668 - If the cursor is on a <<<target>>>, update radio targets and
  17669   corresponding links in this buffer.
  17670 
  17671 - If the cursor is on a numbered item in a plain list, renumber the
  17672   ordered list.
  17673 
  17674 - If the cursor is on a checkbox, toggle it.
  17675 
  17676 - If the cursor is on a code block, evaluate it.  The variable
  17677   `org-confirm-babel-evaluate' can be used to control prompting
  17678   before code block evaluation, by default every code block
  17679   evaluation requires confirmation.  Code block evaluation can be
  17680   inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'."
  17681   (interactive "P")
  17682   (cond
  17683    ((bound-and-true-p org-columns-overlays) (org-columns-quit))
  17684    ((or (bound-and-true-p org-clock-overlays) org-occur-highlights)
  17685     (when (boundp 'org-clock-overlays) (org-clock-remove-overlays))
  17686     (org-remove-occur-highlights)
  17687     (message "Temporary highlights/overlays removed from current buffer"))
  17688    ((and (local-variable-p 'org-finish-function)
  17689 	 (fboundp org-finish-function))
  17690     (funcall org-finish-function))
  17691    ((org-babel-hash-at-point))
  17692    ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
  17693    (t
  17694     (let* ((context
  17695 	    (org-element-lineage
  17696 	     (org-element-context)
  17697 	     ;; Limit to supported contexts.
  17698 	     '(babel-call clock dynamic-block footnote-definition
  17699 			  footnote-reference inline-babel-call inline-src-block
  17700 			  inlinetask item keyword node-property paragraph
  17701 			  plain-list planning property-drawer radio-target
  17702 			  src-block statistics-cookie table table-cell table-row
  17703 			  timestamp)
  17704 	     t))
  17705 	   (radio-list-p (org-at-radio-list-p))
  17706 	   (type (org-element-type context)))
  17707       ;; For convenience: at the first line of a paragraph on the same
  17708       ;; line as an item, apply function on that item instead.
  17709       (when (eq type 'paragraph)
  17710 	(let ((parent (org-element-property :parent context)))
  17711 	  (when (and (eq (org-element-type parent) 'item)
  17712 		     (= (line-beginning-position)
  17713 			(org-element-property :begin parent)))
  17714 	    (setq context parent)
  17715 	    (setq type 'item))))
  17716       ;; Act according to type of element or object at point.
  17717       ;;
  17718       ;; Do nothing on a blank line, except if it is contained in
  17719       ;; a source block.  Hence, we first check if point is in such
  17720       ;; a block and then if it is at a blank line.
  17721       (pcase type
  17722 	((or `inline-src-block `src-block)
  17723 	 (unless org-babel-no-eval-on-ctrl-c-ctrl-c
  17724 	   (org-babel-eval-wipe-error-buffer)
  17725 	   (org-babel-execute-src-block
  17726 	    current-prefix-arg (org-babel-get-src-block-info nil context))))
  17727 	((guard (org-match-line "[ \t]*$"))
  17728 	 (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
  17729 	     (user-error
  17730 	      (substitute-command-keys
  17731 	       "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here"))))
  17732 	((or `babel-call `inline-babel-call)
  17733 	 (let ((info (org-babel-lob-get-info context)))
  17734 	   (when info (org-babel-execute-src-block nil info))))
  17735 	(`clock (org-clock-update-time-maybe))
  17736 	(`dynamic-block
  17737 	 (save-excursion
  17738 	   (goto-char (org-element-property :post-affiliated context))
  17739 	   (org-update-dblock)))
  17740 	(`footnote-definition
  17741 	 (goto-char (org-element-property :post-affiliated context))
  17742 	 (call-interactively 'org-footnote-action))
  17743 	(`footnote-reference (call-interactively #'org-footnote-action))
  17744 	((or `headline `inlinetask)
  17745 	 (save-excursion (goto-char (org-element-property :begin context))
  17746 			 (call-interactively #'org-set-tags-command)))
  17747 	(`item
  17748 	 ;; At an item: `C-u C-u' sets checkbox to "[-]"
  17749 	 ;; unconditionally, whereas `C-u' will toggle its presence.
  17750 	 ;; Without a universal argument, if the item has a checkbox,
  17751 	 ;; toggle it.  Otherwise repair the list.
  17752 	 (if (or radio-list-p
  17753 		 (and (boundp org-list-checkbox-radio-mode)
  17754 		      org-list-checkbox-radio-mode))
  17755 	     (org-toggle-radio-button arg)
  17756 	   (let* ((box (org-element-property :checkbox context))
  17757 		  (struct (org-element-property :structure context))
  17758 		  (old-struct (copy-tree struct))
  17759 		  (parents (org-list-parents-alist struct))
  17760 		  (prevs (org-list-prevs-alist struct))
  17761 		  (orderedp (org-not-nil (org-entry-get nil "ORDERED"))))
  17762 	     (org-list-set-checkbox
  17763 	      (org-element-property :begin context) struct
  17764 	      (cond ((equal arg '(16)) "[-]")
  17765 		    ((and (not box) (equal arg '(4))) "[ ]")
  17766 		    ((or (not box) (equal arg '(4))) nil)
  17767 		    ((eq box 'on) "[ ]")
  17768 		    (t "[X]")))
  17769 	     ;; Mimic `org-list-write-struct' but with grabbing a return
  17770 	     ;; value from `org-list-struct-fix-box'.
  17771 	     (org-list-struct-fix-ind struct parents 2)
  17772 	     (org-list-struct-fix-item-end struct)
  17773 	     (org-list-struct-fix-bul struct prevs)
  17774 	     (org-list-struct-fix-ind struct parents)
  17775 	     (let ((block-item
  17776 		    (org-list-struct-fix-box struct parents prevs orderedp)))
  17777 	       (if (and box (equal struct old-struct))
  17778 		   (if (equal arg '(16))
  17779 		       (message "Checkboxes already reset")
  17780 		     (user-error "Cannot toggle this checkbox: %s"
  17781 				 (if (eq box 'on)
  17782 				     "all subitems checked"
  17783 				   "unchecked subitems")))
  17784 		 (org-list-struct-apply-struct struct old-struct)
  17785 		 (org-update-checkbox-count-maybe))
  17786 	       (when block-item
  17787 		 (message "Checkboxes were removed due to empty box at line %d"
  17788 			  (org-current-line block-item)))))))
  17789 	(`plain-list
  17790 	 ;; At a plain list, with a double C-u argument, set
  17791 	 ;; checkboxes of each item to "[-]", whereas a single one
  17792 	 ;; will toggle their presence according to the state of the
  17793 	 ;; first item in the list.  Without an argument, repair the
  17794 	 ;; list.
  17795 	 (if (or radio-list-p
  17796 		 (and (boundp org-list-checkbox-radio-mode)
  17797 		      org-list-checkbox-radio-mode))
  17798 	     (org-toggle-radio-button arg)
  17799 	   (let* ((begin (org-element-property :contents-begin context))
  17800 		  (struct (org-element-property :structure context))
  17801 		  (old-struct (copy-tree struct))
  17802 		  (first-box (save-excursion
  17803 			       (goto-char begin)
  17804 			       (looking-at org-list-full-item-re)
  17805 			       (match-string-no-properties 3)))
  17806 		  (new-box (cond ((equal arg '(16)) "[-]")
  17807 				 ((equal arg '(4)) (unless first-box "[ ]"))
  17808 				 ((equal first-box "[X]") "[ ]")
  17809 				 (t "[X]"))))
  17810 	     (cond
  17811 	      (arg
  17812 	       (dolist (pos
  17813 			(org-list-get-all-items
  17814 			 begin struct (org-list-prevs-alist struct)))
  17815 		 (org-list-set-checkbox pos struct new-box)))
  17816 	      ((and first-box (eq (point) begin))
  17817 	       ;; For convenience, when point is at bol on the first
  17818 	       ;; item of the list and no argument is provided, simply
  17819 	       ;; toggle checkbox of that item, if any.
  17820 	       (org-list-set-checkbox begin struct new-box)))
  17821 	     (when (equal
  17822 		    (org-list-write-struct
  17823 		     struct (org-list-parents-alist struct) old-struct)
  17824 		    old-struct)
  17825 	       (message "Cannot update this checkbox"))
  17826 	     (org-update-checkbox-count-maybe))))
  17827 	(`keyword
  17828 	 (let ((org-inhibit-startup-visibility-stuff t)
  17829 	       (org-startup-align-all-tables nil))
  17830 	   (when (boundp 'org-table-coordinate-overlays)
  17831 	     (mapc #'delete-overlay org-table-coordinate-overlays)
  17832 	     (setq org-table-coordinate-overlays nil))
  17833 	   (org-save-outline-visibility 'use-markers (org-mode-restart)))
  17834 	 (message "Local setup has been refreshed"))
  17835 	((or `property-drawer `node-property)
  17836 	 (call-interactively #'org-property-action))
  17837 	(`radio-target
  17838 	 (call-interactively #'org-update-radio-target-regexp))
  17839 	(`statistics-cookie
  17840 	 (call-interactively #'org-update-statistics-cookies))
  17841 	((or `table `table-cell `table-row)
  17842 	 ;; At a table, generate a plot if on the #+plot line,
  17843          ;; recalculate every field and align it otherwise.  Also
  17844 	 ;; send the table if necessary.
  17845          (cond
  17846           ((and (org-match-line "[ \t]*#\\+plot:")
  17847                 (< (point) (org-element-property :post-affiliated context)))
  17848            (org-plot/gnuplot))
  17849           ;; If the table has a `table.el' type, just give up.
  17850           ((eq (org-element-property :type context) 'table.el)
  17851            (message "%s" (substitute-command-keys "\\<org-mode-map>\
  17852 Use `\\[org-edit-special]' to edit table.el tables")))
  17853           ;; At a table row or cell, maybe recalculate line but always
  17854 	  ;; align table.
  17855           ((or (eq type 'table)
  17856                ;; Check if point is at a TBLFM line.
  17857                (and (eq type 'table-row)
  17858                     (= (point) (org-element-property :end context))))
  17859            (save-excursion
  17860              (if (org-at-TBLFM-p)
  17861                  (progn (require 'org-table)
  17862                         (org-table-calc-current-TBLFM))
  17863                (goto-char (org-element-property :contents-begin context))
  17864                (org-call-with-arg 'org-table-recalculate (or arg t))
  17865                (orgtbl-send-table 'maybe))))
  17866           (t
  17867            (org-table-maybe-eval-formula)
  17868            (cond (arg (call-interactively #'org-table-recalculate))
  17869                  ((org-table-maybe-recalculate-line))
  17870                  (t (org-table-align))))))
  17871 	((or `timestamp (and `planning (guard (org-at-timestamp-p 'lax))))
  17872 	 (org-timestamp-change 0 'day))
  17873 	((and `nil (guard (org-at-heading-p)))
  17874 	 ;; When point is on an unsupported object type, we can miss
  17875 	 ;; the fact that it also is at a heading.  Handle it here.
  17876 	 (call-interactively #'org-set-tags-command))
  17877 	((guard
  17878 	  (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)))
  17879 	(_
  17880 	 (user-error
  17881 	  (substitute-command-keys
  17882 	   "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here"))))))))
  17883 
  17884 (defun org-mode-restart ()
  17885   "Restart `org-mode'."
  17886   (interactive)
  17887   (let ((indent-status (bound-and-true-p org-indent-mode)))
  17888     (funcall major-mode)
  17889     (hack-local-variables)
  17890     (when (and indent-status (not (bound-and-true-p org-indent-mode)))
  17891       (org-indent-mode -1))
  17892     (org-reset-file-cache))
  17893   (message "%s restarted" major-mode))
  17894 
  17895 (defun org-flag-above-first-heading (&optional arg)
  17896   "Hide from bob up to the first heading.
  17897 Move point to the beginning of first heading or end of buffer."
  17898   (goto-char (point-min))
  17899   (unless (org-at-heading-p)
  17900     (outline-next-heading))
  17901   (unless (bobp)
  17902     (org-flag-region 1 (1- (point)) (not arg) 'outline)))
  17903 
  17904 (defun org-show-branches-buffer ()
  17905   "Show all branches in the buffer."
  17906   (org-flag-above-first-heading)
  17907   (outline-hide-sublevels 1)
  17908   (unless (eobp)
  17909     (outline-show-branches)
  17910     (while (outline-get-next-sibling)
  17911       (outline-show-branches)))
  17912   (goto-char (point-min)))
  17913 
  17914 (defun org-kill-note-or-show-branches ()
  17915   "Abort storing current note, or show just branches."
  17916   (interactive)
  17917   (cond (org-finish-function
  17918 	 (let ((org-note-abort t)) (funcall org-finish-function)))
  17919 	((org-before-first-heading-p)
  17920 	 (org-show-branches-buffer)
  17921 	 (org-hide-archived-subtrees (point-min) (point-max)))
  17922 	(t
  17923 	 (let ((beg (progn (org-back-to-heading) (point)))
  17924 	       (end (save-excursion (org-end-of-subtree t t) (point))))
  17925 	   (outline-hide-subtree)
  17926 	   (outline-show-branches)
  17927 	   (org-hide-archived-subtrees beg end)))))
  17928 
  17929 (defun org-delete-indentation (&optional arg)
  17930   "Join current line to previous and fix whitespace at join.
  17931 
  17932 If previous line is a headline add to headline title.  Otherwise
  17933 the function calls `delete-indentation'.
  17934 
  17935 I.e. with a non-nil optional argument, join the line with the
  17936 following one.  If there is a region then join the lines in that
  17937 region."
  17938   (interactive "*P")
  17939   (if (save-excursion
  17940 	(beginning-of-line (if arg 1 0))
  17941 	(let ((case-fold-search nil))
  17942 	  (looking-at org-complex-heading-regexp)))
  17943       ;; At headline.
  17944       (let ((tags-column (when (match-beginning 5)
  17945 			   (save-excursion (goto-char (match-beginning 5))
  17946 					   (current-column))))
  17947 	    (string (concat " " (progn (when arg (forward-line 1))
  17948 				       (org-trim (delete-and-extract-region
  17949 						  (line-beginning-position)
  17950 						  (line-end-position)))))))
  17951 	(unless (bobp) (delete-region (point) (1- (point))))
  17952 	(goto-char (or (match-end 4)
  17953 		       (match-beginning 5)
  17954 		       (match-end 0)))
  17955 	(skip-chars-backward " \t")
  17956 	(save-excursion (insert string))
  17957 	;; Adjust alignment of tags.
  17958 	(cond
  17959 	 ((not tags-column))		;no tags
  17960 	 (org-auto-align-tags (org-align-tags))
  17961 	 (t (org--align-tags-here tags-column)))) ;preserve tags column
  17962     (let ((current-prefix-arg arg))
  17963       (call-interactively #'delete-indentation))))
  17964 
  17965 (defun org-open-line (n)
  17966   "Insert a new row in tables, call `open-line' elsewhere.
  17967 If `org-special-ctrl-o' is nil, just call `open-line' everywhere.
  17968 As a special case, when a document starts with a table, allow to
  17969 call `open-line' on the very first character."
  17970   (interactive "*p")
  17971   (if (and org-special-ctrl-o (/= (point) 1) (org-at-table-p))
  17972       (org-table-insert-row)
  17973     (open-line n)))
  17974 
  17975 (defun org--newline (indent arg interactive)
  17976   "Call `newline-and-indent' or just `newline'.
  17977 If INDENT is non-nil, call `newline-and-indent' with ARG to
  17978 indent unconditionally; otherwise, call `newline' with ARG and
  17979 INTERACTIVE, which can trigger indentation if
  17980 `electric-indent-mode' is enabled."
  17981   (if indent
  17982       (org-newline-and-indent arg)
  17983     (newline arg interactive)))
  17984 
  17985 (defun org-return (&optional indent arg interactive)
  17986   "Goto next table row or insert a newline.
  17987 
  17988 Calls `org-table-next-row' or `newline', depending on context.
  17989 
  17990 When optional INDENT argument is non-nil, call
  17991 `newline-and-indent' with ARG, otherwise call `newline' with ARG
  17992 and INTERACTIVE.
  17993 
  17994 When `org-return-follows-link' is non-nil and point is on
  17995 a timestamp or a link, call `org-open-at-point'.  However, it
  17996 will not happen if point is in a table or on a \"dead\"
  17997 object (e.g., within a comment).  In these case, you need to use
  17998 `org-open-at-point' directly."
  17999   (interactive "i\nP\np")
  18000   (let* ((context (if org-return-follows-link (org-element-context)
  18001 		    (org-element-at-point)))
  18002          (element-type (org-element-type context)))
  18003     (cond
  18004      ;; In a table, call `org-table-next-row'.  However, before first
  18005      ;; column or after last one, split the table.
  18006      ((or (and (eq 'table element-type)
  18007 	       (not (eq 'table.el (org-element-property :type context)))
  18008 	       (>= (point) (org-element-property :contents-begin context))
  18009 	       (< (point) (org-element-property :contents-end context)))
  18010 	  (org-element-lineage context '(table-row table-cell) t))
  18011       (if (or (looking-at-p "[ \t]*$")
  18012 	      (save-excursion (skip-chars-backward " \t") (bolp)))
  18013 	  (insert "\n")
  18014 	(org-table-justify-field-maybe)
  18015 	(call-interactively #'org-table-next-row)))
  18016      ;; On a link or a timestamp, call `org-open-at-point' if
  18017      ;; `org-return-follows-link' allows it.  Tolerate fuzzy
  18018      ;; locations, e.g., in a comment, as `org-open-at-point'.
  18019      ((and org-return-follows-link
  18020 	   (or (and (eq 'link element-type)
  18021 		    ;; Ensure point is not on the white spaces after
  18022 		    ;; the link.
  18023 		    (let ((origin (point)))
  18024 		      (org-with-point-at (org-element-property :end context)
  18025 			(skip-chars-backward " \t")
  18026 			(> (point) origin))))
  18027 	       (org-in-regexp org-ts-regexp-both nil t)
  18028 	       (org-in-regexp org-tsr-regexp-both nil  t)
  18029 	       (org-in-regexp org-link-any-re nil t)))
  18030       (call-interactively #'org-open-at-point))
  18031      ;; Insert newline in heading, but preserve tags.
  18032      ((and (not (bolp))
  18033 	   (let ((case-fold-search nil))
  18034 	     (org-match-line org-complex-heading-regexp)))
  18035       ;; At headline.  Split line.  However, if point is on keyword,
  18036       ;; priority cookie or tags, do not break any of them: add
  18037       ;; a newline after the headline instead.
  18038       (let ((tags-column (and (match-beginning 5)
  18039 			      (save-excursion (goto-char (match-beginning 5))
  18040 					      (current-column))))
  18041 	    (string
  18042 	     (when (and (match-end 4) (org-point-in-group (point) 4))
  18043 	       (delete-and-extract-region (point) (match-end 4)))))
  18044 	;; Adjust tag alignment.
  18045 	(cond
  18046 	 ((not (and tags-column string)))
  18047 	 (org-auto-align-tags (org-align-tags))
  18048 	 (t (org--align-tags-here tags-column))) ;preserve tags column
  18049 	(end-of-line)
  18050 	(org-show-entry)
  18051 	(org--newline indent arg interactive)
  18052 	(when string (save-excursion (insert (org-trim string))))))
  18053      ;; In a list, make sure indenting keeps trailing text within.
  18054      ((and (not (eolp))
  18055 	   (org-element-lineage context '(item)))
  18056       (let ((trailing-data
  18057 	     (delete-and-extract-region (point) (line-end-position))))
  18058 	(org--newline indent arg interactive)
  18059 	(save-excursion (insert trailing-data))))
  18060      (t
  18061       ;; Do not auto-fill when point is in an Org property drawer.
  18062       (let ((auto-fill-function (and (not (org-at-property-p))
  18063 				     auto-fill-function)))
  18064 	(org--newline indent arg interactive))))))
  18065 
  18066 (defun org-return-and-maybe-indent ()
  18067   "Goto next table row, or insert a newline, maybe indented.
  18068 Call `org-table-next-row' or `org-return', depending on context.
  18069 See the individual commands for more information.
  18070 
  18071 When inserting a newline, if `org-adapt-indentation' is t:
  18072 indent the line if `electric-indent-mode' is disabled, don't
  18073 indent it if it is enabled."
  18074   (interactive)
  18075   (org-return (not electric-indent-mode)))
  18076 
  18077 (defun org-ctrl-c-tab (&optional arg)
  18078   "Toggle columns width in a table, or show children.
  18079 Call `org-table-toggle-column-width' if point is in a table.
  18080 Otherwise provide a compact view of the children.  ARG is the
  18081 level to hide."
  18082   (interactive "p")
  18083   (cond
  18084    ((org-at-table-p)
  18085     (call-interactively #'org-table-toggle-column-width))
  18086    ((org-before-first-heading-p)
  18087     (save-excursion
  18088       (org-flag-above-first-heading)
  18089       (outline-hide-sublevels (or arg 1))))
  18090    (t
  18091     (outline-hide-subtree)
  18092     (org-show-children arg))))
  18093 
  18094 (defun org-ctrl-c-star ()
  18095   "Compute table, or change heading status of lines.
  18096 Calls `org-table-recalculate' or `org-toggle-heading',
  18097 depending on context."
  18098   (interactive)
  18099   (cond
  18100    ((org-at-table-p)
  18101     (call-interactively 'org-table-recalculate))
  18102    (t
  18103     ;; Convert all lines in region to list items
  18104     (call-interactively 'org-toggle-heading))))
  18105 
  18106 (defun org-ctrl-c-minus ()
  18107   "Insert separator line in table or modify bullet status of line.
  18108 Also turns a plain line or a region of lines into list items.
  18109 Calls `org-table-insert-hline', `org-toggle-item', or
  18110 `org-cycle-list-bullet', depending on context."
  18111   (interactive)
  18112   (cond
  18113    ((org-at-table-p)
  18114     (call-interactively 'org-table-insert-hline))
  18115    ((org-region-active-p)
  18116     (call-interactively 'org-toggle-item))
  18117    ((org-in-item-p)
  18118     (call-interactively 'org-cycle-list-bullet))
  18119    (t
  18120     (call-interactively 'org-toggle-item))))
  18121 
  18122 (defun org-toggle-heading (&optional nstars)
  18123   "Convert headings to normal text, or items or text to headings.
  18124 If there is no active region, only convert the current line.
  18125 
  18126 With a `\\[universal-argument]' prefix, convert the whole list at
  18127 point into heading.
  18128 
  18129 In a region:
  18130 
  18131 - If the first non blank line is a headline, remove the stars
  18132   from all headlines in the region.
  18133 
  18134 - If it is a normal line, turn each and every normal line (i.e.,
  18135   not an heading or an item) in the region into headings.  If you
  18136   want to convert only the first line of this region, use one
  18137   universal prefix argument.
  18138 
  18139 - If it is a plain list item, turn all plain list items into headings.
  18140 
  18141 When converting a line into a heading, the number of stars is chosen
  18142 such that the lines become children of the current entry.  However,
  18143 when a numeric prefix argument is given, its value determines the
  18144 number of stars to add."
  18145   (interactive "P")
  18146   (let ((skip-blanks
  18147 	 ;; Return beginning of first non-blank line, starting from
  18148 	 ;; line at POS.
  18149 	 (lambda (pos)
  18150 	   (save-excursion
  18151 	     (goto-char pos)
  18152 	     (while (org-at-comment-p) (forward-line))
  18153 	     (skip-chars-forward " \r\t\n")
  18154 	     (point-at-bol))))
  18155 	beg end toggled)
  18156     ;; Determine boundaries of changes.  If a universal prefix has
  18157     ;; been given, put the list in a region.  If region ends at a bol,
  18158     ;; do not consider the last line to be in the region.
  18159 
  18160     (when (and current-prefix-arg (org-at-item-p))
  18161       (when (listp current-prefix-arg) (setq current-prefix-arg 1))
  18162       (org-mark-element))
  18163 
  18164     (if (org-region-active-p)
  18165 	(setq beg (funcall skip-blanks (region-beginning))
  18166 	      end (copy-marker (save-excursion
  18167 				 (goto-char (region-end))
  18168 				 (if (bolp) (point) (point-at-eol)))))
  18169       (setq beg (funcall skip-blanks (point-at-bol))
  18170 	    end (copy-marker (point-at-eol))))
  18171     ;; Ensure inline tasks don't count as headings.
  18172     (org-with-limited-levels
  18173      (save-excursion
  18174        (goto-char beg)
  18175        (cond
  18176 	;; Case 1. Started at an heading: de-star headings.
  18177 	((org-at-heading-p)
  18178 	 (while (< (point) end)
  18179 	   (when (org-at-heading-p t)
  18180 	     (looking-at org-outline-regexp) (replace-match "")
  18181 	     (setq toggled t))
  18182 	   (forward-line)))
  18183 	;; Case 2. Started at an item: change items into headlines.
  18184 	;;         One star will be added by `org-list-to-subtree'.
  18185 	((org-at-item-p)
  18186 	 (while (< (point) end)
  18187 	   (when (org-at-item-p)
  18188 	     ;; Pay attention to cases when region ends before list.
  18189 	     (let* ((struct (org-list-struct))
  18190 		    (list-end
  18191 		     (min (org-list-get-bottom-point struct) (1+ end))))
  18192 	       (save-restriction
  18193 		 (narrow-to-region (point) list-end)
  18194 		 (insert (org-list-to-subtree
  18195 			  (org-list-to-lisp t)
  18196 			  (pcase (org-current-level)
  18197 			    (`nil 1)
  18198 			    (l (1+ (org-reduced-level l)))))
  18199 			 "\n")))
  18200 	     (setq toggled t))
  18201 	   (forward-line)))
  18202 	;; Case 3. Started at normal text: make every line an heading,
  18203 	;;         skipping headlines and items.
  18204 	(t (let* ((stars
  18205 		   (make-string
  18206 		    (if (numberp nstars) nstars (or (org-current-level) 0)) ?*))
  18207 		  (add-stars
  18208 		   (cond (nstars "")	; stars from prefix only
  18209 			 ((equal stars "") "*")	; before first heading
  18210 			 (org-odd-levels-only "**") ; inside heading, odd
  18211 			 (t "*")))	; inside heading, oddeven
  18212 		  (rpl (concat stars add-stars " "))
  18213 		  (lend (when (listp nstars) (save-excursion (end-of-line) (point)))))
  18214 	     (while (< (point) (if (equal nstars '(4)) lend end))
  18215 	       (when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p)))
  18216 			  (looking-at "\\([ \t]*\\)\\(\\S-\\)"))
  18217 		 (replace-match (concat rpl (match-string 2))) (setq toggled t))
  18218 	       (forward-line)))))))
  18219     (unless toggled (message "Cannot toggle heading from here"))))
  18220 
  18221 (defun org-meta-return (&optional arg)
  18222   "Insert a new heading or wrap a region in a table.
  18223 Calls `org-insert-heading', `org-insert-item' or
  18224 `org-table-wrap-region', depending on context.  When called with
  18225 an argument, unconditionally call `org-insert-heading'."
  18226   (interactive "P")
  18227   (org-check-before-invisible-edit 'insert)
  18228   (or (run-hook-with-args-until-success 'org-metareturn-hook)
  18229       (call-interactively (cond (arg #'org-insert-heading)
  18230 				((org-at-table-p) #'org-table-wrap-region)
  18231 				((org-in-item-p) #'org-insert-item)
  18232 				(t #'org-insert-heading)))))
  18233 
  18234 ;;; Menu entries
  18235 (defsubst org-in-subtree-not-table-p ()
  18236   "Are we in a subtree and not in a table?"
  18237   (and (not (org-before-first-heading-p))
  18238        (not (org-at-table-p))))
  18239 
  18240 ;; Define the Org mode menus
  18241 (easy-menu-define org-org-menu org-mode-map "Org menu."
  18242   `("Org"
  18243     ("Show/Hide"
  18244      ["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))]
  18245      ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))]
  18246      ["Sparse Tree..." org-sparse-tree t]
  18247      ["Reveal Context" org-reveal t]
  18248      ["Show All" org-show-all t]
  18249      "--"
  18250      ["Subtree to indirect buffer" org-tree-to-indirect-buffer t])
  18251     "--"
  18252     ["New Heading" org-insert-heading t]
  18253     ("Navigate Headings"
  18254      ["Up" outline-up-heading t]
  18255      ["Next" outline-next-visible-heading t]
  18256      ["Previous" outline-previous-visible-heading t]
  18257      ["Next Same Level" outline-forward-same-level t]
  18258      ["Previous Same Level" outline-backward-same-level t]
  18259      "--"
  18260      ["Jump" org-goto t])
  18261     ("Edit Structure"
  18262      ["Move Subtree Up" org-metaup (org-at-heading-p)]
  18263      ["Move Subtree Down" org-metadown (org-at-heading-p)]
  18264      "--"
  18265      ["Copy Subtree"  org-copy-special (org-in-subtree-not-table-p)]
  18266      ["Cut Subtree"  org-cut-special (org-in-subtree-not-table-p)]
  18267      ["Paste Subtree"  org-paste-special (not (org-at-table-p))]
  18268      "--"
  18269      ["Clone subtree, shift time" org-clone-subtree-with-time-shift t]
  18270      "--"
  18271      ["Copy visible text"  org-copy-visible t]
  18272      "--"
  18273      ["Promote Heading" org-metaleft (org-in-subtree-not-table-p)]
  18274      ["Promote Subtree" org-shiftmetaleft (org-in-subtree-not-table-p)]
  18275      ["Demote Heading"  org-metaright (org-in-subtree-not-table-p)]
  18276      ["Demote Subtree"  org-shiftmetaright (org-in-subtree-not-table-p)]
  18277      "--"
  18278      ["Sort Region/Children" org-sort t]
  18279      "--"
  18280      ["Convert to odd levels" org-convert-to-odd-levels t]
  18281      ["Convert to odd/even levels" org-convert-to-oddeven-levels t])
  18282     ("Editing"
  18283      ["Emphasis..." org-emphasize t]
  18284      ["Add block structure" org-insert-structure-template t]
  18285      ["Edit Source Example" org-edit-special t]
  18286      "--"
  18287      ["Footnote new/jump" org-footnote-action t]
  18288      ["Footnote extra" (org-footnote-action t) :active t :keys "C-u C-c C-x f"])
  18289     ("Archive"
  18290      ["Archive (default method)" org-archive-subtree-default (org-in-subtree-not-table-p)]
  18291      "--"
  18292      ["Move Subtree to Archive file" org-archive-subtree (org-in-subtree-not-table-p)]
  18293      ["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)]
  18294      ["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)])
  18295     "--"
  18296     ("Hyperlinks"
  18297      ["Store Link (Global)" org-store-link t]
  18298      ["Find existing link to here" org-occur-link-in-agenda-files t]
  18299      ["Insert Link" org-insert-link t]
  18300      ["Follow Link" org-open-at-point t]
  18301      "--"
  18302      ["Next link" org-next-link t]
  18303      ["Previous link" org-previous-link t]
  18304      "--"
  18305      ["Descriptive Links"
  18306       org-toggle-link-display
  18307       :style radio
  18308       :selected org-descriptive-links
  18309       ]
  18310      ["Literal Links"
  18311       org-toggle-link-display
  18312       :style radio
  18313       :selected (not org-descriptive-links)])
  18314     "--"
  18315     ("TODO Lists"
  18316      ["TODO/DONE/-" org-todo t]
  18317      ("Select keyword"
  18318       ["Next keyword" org-shiftright (org-at-heading-p)]
  18319       ["Previous keyword" org-shiftleft (org-at-heading-p)]
  18320       ["Complete Keyword" pcomplete (assq :todo-keyword (org-context))]
  18321       ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))]
  18322       ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))])
  18323      ["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"]
  18324      ["Global TODO list" org-todo-list :active t :keys "\\[org-agenda] t"]
  18325      "--"
  18326      ["Enforce dependencies" (customize-variable 'org-enforce-todo-dependencies)
  18327       :selected org-enforce-todo-dependencies :style toggle :active t]
  18328      "Settings for tree at point"
  18329      ["Do Children sequentially" org-toggle-ordered-property :style radio
  18330       :selected (org-entry-get nil "ORDERED")
  18331       :active org-enforce-todo-dependencies :keys "C-c C-x o"]
  18332      ["Do Children parallel" org-toggle-ordered-property :style radio
  18333       :selected (not (org-entry-get nil "ORDERED"))
  18334       :active org-enforce-todo-dependencies :keys "C-c C-x o"]
  18335      "--"
  18336      ["Set Priority" org-priority t]
  18337      ["Priority Up" org-shiftup t]
  18338      ["Priority Down" org-shiftdown t]
  18339      "--"
  18340      ["Get news from all feeds" org-feed-update-all t]
  18341      ["Go to the inbox of a feed..." org-feed-goto-inbox t]
  18342      ["Customize feeds" (customize-variable 'org-feed-alist) t])
  18343     ("TAGS and Properties"
  18344      ["Set Tags" org-set-tags-command (not (org-before-first-heading-p))]
  18345      ["Change tag in region" org-change-tag-in-region (org-region-active-p)]
  18346      "--"
  18347      ["Set property" org-set-property (not (org-before-first-heading-p))]
  18348      ["Column view of properties" org-columns t]
  18349      ["Insert Column View DBlock" org-columns-insert-dblock t])
  18350     ("Dates and Scheduling"
  18351      ["Timestamp" org-time-stamp (not (org-before-first-heading-p))]
  18352      ["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))]
  18353      ("Change Date"
  18354       ["1 Day Later" org-shiftright (org-at-timestamp-p 'lax)]
  18355       ["1 Day Earlier" org-shiftleft (org-at-timestamp-p 'lax)]
  18356       ["1 ... Later" org-shiftup (org-at-timestamp-p 'lax)]
  18357       ["1 ... Earlier" org-shiftdown (org-at-timestamp-p 'lax)])
  18358      ["Compute Time Range" org-evaluate-time-range t]
  18359      ["Schedule Item" org-schedule (not (org-before-first-heading-p))]
  18360      ["Deadline" org-deadline (not (org-before-first-heading-p))]
  18361      "--"
  18362      ["Custom time format" org-toggle-time-stamp-overlays
  18363       :style radio :selected org-display-custom-times]
  18364      "--"
  18365      ["Goto Calendar" org-goto-calendar t]
  18366      ["Date from Calendar" org-date-from-calendar t]
  18367      "--"
  18368      ["Start/Restart Timer" org-timer-start t]
  18369      ["Pause/Continue Timer" org-timer-pause-or-continue t]
  18370      ["Stop Timer" org-timer-pause-or-continue :active t :keys "C-u C-c C-x ,"]
  18371      ["Insert Timer String" org-timer t]
  18372      ["Insert Timer Item" org-timer-item t])
  18373     ("Logging work"
  18374      ["Clock in" org-clock-in :active t :keys "C-c C-x C-i"]
  18375      ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"]
  18376      ["Clock out" org-clock-out t]
  18377      ["Clock cancel" org-clock-cancel t]
  18378      "--"
  18379      ["Mark as default task" org-clock-mark-default-task t]
  18380      ["Clock in, mark as default" (lambda () (interactive) (org-clock-in '(16))) :active t :keys "C-u C-u C-c C-x C-i"]
  18381      ["Goto running clock" org-clock-goto t]
  18382      "--"
  18383      ["Display times" org-clock-display t]
  18384      ["Create clock table" org-clock-report t]
  18385      "--"
  18386      ["Record DONE time"
  18387       (progn (setq org-log-done (not org-log-done))
  18388 	     (message "Switching to %s will %s record a timestamp"
  18389 		      (car org-done-keywords)
  18390 		      (if org-log-done "automatically" "not")))
  18391       :style toggle :selected org-log-done])
  18392     "--"
  18393     ["Agenda Command..." org-agenda t]
  18394     ["Set Restriction Lock" org-agenda-set-restriction-lock t]
  18395     ("File List for Agenda")
  18396     ("Special views current file"
  18397      ["TODO Tree"  org-show-todo-tree t]
  18398      ["Check Deadlines" org-check-deadlines t]
  18399      ["Tags/Property tree" org-match-sparse-tree t])
  18400     "--"
  18401     ["Export/Publish..." org-export-dispatch t]
  18402     ("LaTeX"
  18403      ["Org CDLaTeX mode" org-cdlatex-mode :active (require 'cdlatex nil t)
  18404       :style toggle :selected org-cdlatex-mode]
  18405      ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)]
  18406      ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)]
  18407      ["Modify math symbol" org-cdlatex-math-modify
  18408       (org-inside-LaTeX-fragment-p)]
  18409      ["Insert citation" org-reftex-citation t])
  18410     "--"
  18411     ("Documentation"
  18412      ["Show Version" org-version t]
  18413      ["Info Documentation" org-info t]
  18414      ["Browse Org News" org-browse-news t])
  18415     ("Customize"
  18416      ["Browse Org Group" org-customize t]
  18417      "--"
  18418      ["Expand This Menu" org-create-customize-menu t])
  18419     ["Send bug report" org-submit-bug-report t]
  18420     "--"
  18421     ("Refresh/Reload"
  18422      ["Refresh setup current buffer" org-mode-restart t]
  18423      ["Reload Org (after update)" org-reload t]
  18424      ["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x !"])))
  18425 
  18426 (easy-menu-define org-tbl-menu org-mode-map "Org Table menu."
  18427   '("Table"
  18428     ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)]
  18429     ["Next Field" org-cycle (org-at-table-p)]
  18430     ["Previous Field" org-shifttab (org-at-table-p)]
  18431     ["Next Row" org-return (org-at-table-p)]
  18432     "--"
  18433     ["Blank Field" org-table-blank-field (org-at-table-p)]
  18434     ["Edit Field" org-table-edit-field (org-at-table-p)]
  18435     ["Copy Field from Above" org-table-copy-down (org-at-table-p)]
  18436     "--"
  18437     ("Column"
  18438      ["Move Column Left" org-metaleft (org-at-table-p)]
  18439      ["Move Column Right" org-metaright (org-at-table-p)]
  18440      ["Delete Column" org-shiftmetaleft (org-at-table-p)]
  18441      ["Insert Column" org-shiftmetaright (org-at-table-p)]
  18442      ["Shrink Column" org-table-toggle-column-width (org-at-table-p)])
  18443     ("Row"
  18444      ["Move Row Up" org-metaup (org-at-table-p)]
  18445      ["Move Row Down" org-metadown (org-at-table-p)]
  18446      ["Delete Row" org-shiftmetaup (org-at-table-p)]
  18447      ["Insert Row" org-shiftmetadown (org-at-table-p)]
  18448      ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
  18449      "--"
  18450      ["Insert Hline" org-ctrl-c-minus (org-at-table-p)])
  18451     ("Rectangle"
  18452      ["Copy Rectangle" org-copy-special (org-at-table-p)]
  18453      ["Cut Rectangle" org-cut-special (org-at-table-p)]
  18454      ["Paste Rectangle" org-paste-special (org-at-table-p)]
  18455      ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
  18456     "--"
  18457     ("Calculate"
  18458      ["Set Column Formula" org-table-eval-formula (org-at-table-p)]
  18459      ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
  18460      ["Edit Formulas" org-edit-special (org-at-table-p)]
  18461      "--"
  18462      ["Recalculate line" org-table-recalculate (org-at-table-p)]
  18463      ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
  18464      ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"]
  18465      "--"
  18466      ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)]
  18467      "--"
  18468      ["Sum Column/Rectangle" org-table-sum
  18469       (or (org-at-table-p) (org-region-active-p))]
  18470      ["Which Column?" org-table-current-column (org-at-table-p)])
  18471     ["Debug Formulas"
  18472      org-table-toggle-formula-debugger
  18473      :style toggle :selected (bound-and-true-p org-table-formula-debug)]
  18474     ["Show Col/Row Numbers"
  18475      org-table-toggle-coordinate-overlays
  18476      :style toggle
  18477      :selected (bound-and-true-p org-table-overlay-coordinates)]
  18478     "--"
  18479     ["Create" org-table-create (not (org-at-table-p))]
  18480     ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))]
  18481     ["Import from File" org-table-import (not (org-at-table-p))]
  18482     ["Export to File" org-table-export (org-at-table-p)]
  18483     "--"
  18484     ["Create/Convert from/to table.el" org-table-create-with-table.el t]
  18485     "--"
  18486     ("Plot"
  18487      ["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"]
  18488      ["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"])))
  18489 
  18490 (defun org-info (&optional node)
  18491   "Read documentation for Org in the info system.
  18492 With optional NODE, go directly to that node."
  18493   (interactive)
  18494   (info (format "(org)%s" (or node ""))))
  18495 
  18496 (defun org-browse-news ()
  18497   "Browse the news for the latest major release."
  18498   (interactive)
  18499   (browse-url "https://orgmode.org/Changes.html"))
  18500 
  18501 ;;;###autoload
  18502 (defun org-submit-bug-report ()
  18503   "Submit a bug report on Org via mail.
  18504 
  18505 Don't hesitate to report any problems or inaccurate documentation.
  18506 
  18507 If you don't have setup sending mail from (X)Emacs, please copy the
  18508 output buffer into your mail program, as it gives us important
  18509 information about your Org version and configuration."
  18510   (interactive)
  18511   (require 'reporter)
  18512   (defvar reporter-prompt-for-summary-p)
  18513   (org-load-modules-maybe)
  18514   (org-require-autoloaded-modules)
  18515   (let ((reporter-prompt-for-summary-p "Bug report subject: "))
  18516     (reporter-submit-bug-report
  18517      "emacs-orgmode@gnu.org"
  18518      (org-version nil 'full)
  18519      (let (list)
  18520        (save-window-excursion
  18521 	 (pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*"))
  18522 	 (delete-other-windows)
  18523 	 (erase-buffer)
  18524 	 (insert "You are about to submit a bug report to the Org mailing list.
  18525 
  18526 If your report is about Org installation, please read this section:
  18527 https://orgmode.org/org.html#Installation
  18528 
  18529 Please read https://orgmode.org/org.html#Feedback on how to make
  18530 a good report, it will help Org contributors fixing your problem.
  18531 
  18532 Search https://lists.gnu.org/archive/html/emacs-orgmode/ to see
  18533 if the issue you are about to raise has already been dealt with.
  18534 
  18535 We also would like to add your full Org and Outline configuration
  18536 to the bug report.  It will help us debugging the issue.
  18537 
  18538 *HOWEVER*, some variables you have customized may contain private
  18539 information.  The names of customers, colleagues, or friends, might
  18540 appear in the form of file names, tags, todo states or search strings.
  18541 If you answer \"yes\" to the prompt, you might want to check and remove
  18542 such private information before sending the email.")
  18543 	 (add-text-properties (point-min) (point-max) '(face org-warning))
  18544 	 (when (yes-or-no-p "Include your Org configuration ")
  18545 	   (mapatoms
  18546 	    (lambda (v)
  18547 	      (and (boundp v)
  18548 		   (string-match "\\`\\(org-\\|outline-\\)" (symbol-name v))
  18549 		   (or (and (symbol-value v)
  18550 			    (string-match "\\(-hook\\|-function\\)\\'" (symbol-name v)))
  18551 		       (and
  18552 			(get v 'custom-type) (get v 'standard-value)
  18553 			(not (equal (symbol-value v) (eval (car (get v 'standard-value)))))))
  18554 		   (push v list)))))
  18555 	 (kill-buffer (get-buffer "*Warn about privacy*"))
  18556 	 list))
  18557      nil nil
  18558      "Remember to cover the basics, that is, what you expected to happen and
  18559 what in fact did happen.  You don't know how to make a good report?  See
  18560 
  18561      https://orgmode.org/manual/Feedback.html#Feedback
  18562 
  18563 Your bug report will be posted to the Org mailing list.
  18564 ------------------------------------------------------------------------")
  18565     (save-excursion
  18566       (when (re-search-backward "^\\(Subject: \\)Org mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t)
  18567 	(replace-match "\\1[BUG] \\3 [\\2]")))))
  18568 
  18569 
  18570 (defun org-install-agenda-files-menu ()
  18571   "Install agenda file menu."
  18572   (let ((bl (buffer-list)))
  18573     (save-excursion
  18574       (while bl
  18575 	(set-buffer (pop bl))
  18576 	(when (derived-mode-p 'org-mode) (setq bl nil)))
  18577       (when (derived-mode-p 'org-mode)
  18578 	(easy-menu-change
  18579 	 '("Org") "File List for Agenda"
  18580 	 (append
  18581 	  (list
  18582 	   ["Edit File List" (org-edit-agenda-file-list) t]
  18583 	   ["Add/Move Current File to Front of List" org-agenda-file-to-front t]
  18584 	   ["Remove Current File from List" org-remove-file t]
  18585 	   ["Cycle through agenda files" org-cycle-agenda-files t]
  18586 	   ["Occur in all agenda files" org-occur-in-agenda-files t]
  18587 	   "--")
  18588 	  (mapcar 'org-file-menu-entry
  18589 		  ;; Prevent initialization from failing.
  18590 		  (ignore-errors (org-agenda-files t)))))))))
  18591 
  18592 ;;;; Documentation
  18593 
  18594 (defun org-require-autoloaded-modules ()
  18595   (interactive)
  18596   (mapc #'require
  18597 	'(org-agenda org-archive org-attach org-clock org-colview org-id
  18598 		     org-table org-timer)))
  18599 
  18600 ;;;###autoload
  18601 (defun org-reload (&optional uncompiled)
  18602   "Reload all Org Lisp files.
  18603 With prefix arg UNCOMPILED, load the uncompiled versions."
  18604   (interactive "P")
  18605   (require 'loadhist)
  18606   (let* ((org-dir     (org-find-library-dir "org"))
  18607 	 (contrib-dir (or (org-find-library-dir "org-contribdir") org-dir))
  18608 	 (feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?")
  18609 	 (remove-re (format "\\`%s\\'"
  18610 			    (regexp-opt '("org" "org-loaddefs" "org-version"))))
  18611 	 (feats (delete-dups
  18612 		 (mapcar 'file-name-sans-extension
  18613 			 (mapcar 'file-name-nondirectory
  18614 				 (delq nil
  18615 				       (mapcar 'feature-file
  18616 					       features))))))
  18617 	 (lfeat (append
  18618 		 (sort
  18619 		  (setq feats
  18620 			(delq nil (mapcar
  18621 				   (lambda (f)
  18622 				     (if (and (string-match feature-re f)
  18623 					      (not (string-match remove-re f)))
  18624 					 f nil))
  18625 				   feats)))
  18626 		  'string-lessp)
  18627 		 (list "org-version" "org")))
  18628 	 (load-suffixes (when (boundp 'load-suffixes) load-suffixes))
  18629 	 (load-suffixes (if uncompiled (reverse load-suffixes) load-suffixes))
  18630 	 load-uncore load-misses)
  18631     (setq load-misses
  18632 	  (delq 't
  18633 		(mapcar (lambda (f)
  18634 			  (or (org-load-noerror-mustsuffix (concat org-dir f))
  18635 			      (and (string= org-dir contrib-dir)
  18636 				   (org-load-noerror-mustsuffix (concat contrib-dir f)))
  18637 			      (and (org-load-noerror-mustsuffix (concat (org-find-library-dir f) f))
  18638 				   (push f load-uncore)
  18639 				   't)
  18640 			      f))
  18641 			lfeat)))
  18642     (when load-uncore
  18643       (message "The following feature%s found in load-path, please check if that's correct:\n%s"
  18644 	       (if (> (length load-uncore) 1) "s were" " was")
  18645                (reverse load-uncore)))
  18646     (if load-misses
  18647 	(message "Some error occurred while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s"
  18648 		 (if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full))
  18649       (message "Successfully reloaded Org\n%s" (org-version nil 'full)))))
  18650 
  18651 ;;;###autoload
  18652 (defun org-customize ()
  18653   "Call the customize function with org as argument."
  18654   (interactive)
  18655   (org-load-modules-maybe)
  18656   (org-require-autoloaded-modules)
  18657   (customize-browse 'org))
  18658 
  18659 (defun org-create-customize-menu ()
  18660   "Create a full customization menu for Org mode, insert it into the menu."
  18661   (interactive)
  18662   (org-load-modules-maybe)
  18663   (org-require-autoloaded-modules)
  18664   (easy-menu-change
  18665    '("Org") "Customize"
  18666    `(["Browse Org group" org-customize t]
  18667      "--"
  18668      ,(customize-menu-create 'org)
  18669      ["Set" Custom-set t]
  18670      ["Save" Custom-save t]
  18671      ["Reset to Current" Custom-reset-current t]
  18672      ["Reset to Saved" Custom-reset-saved t]
  18673      ["Reset to Standard Settings" Custom-reset-standard t]))
  18674   (message "\"Org\"-menu now contains full customization menu"))
  18675 
  18676 ;;;; Miscellaneous stuff
  18677 
  18678 ;;; Generally useful functions
  18679 
  18680 (defun org-in-clocktable-p ()
  18681   "Check if the cursor is in a clocktable."
  18682   (let ((pos (point)) start)
  18683     (save-excursion
  18684       (end-of-line 1)
  18685       (and (re-search-backward "^[ \t]*#\\+BEGIN:[ \t]+clocktable" nil t)
  18686 	   (setq start (match-beginning 0))
  18687 	   (re-search-forward "^[ \t]*#\\+END:.*" nil t)
  18688 	   (>= (match-end 0) pos)
  18689 	   start))))
  18690 
  18691 (defun org-in-verbatim-emphasis ()
  18692   (save-match-data
  18693     (and (org-in-regexp org-verbatim-re 2)
  18694 	 (>= (point) (match-beginning 3))
  18695 	 (<= (point) (match-end 4)))))
  18696 
  18697 (defun org-goto-marker-or-bmk (marker &optional bookmark)
  18698   "Go to MARKER, widen if necessary.  When marker is not live, try BOOKMARK."
  18699   (if (and marker (marker-buffer marker)
  18700 	   (buffer-live-p (marker-buffer marker)))
  18701       (progn
  18702 	(pop-to-buffer-same-window (marker-buffer marker))
  18703 	(when (or (> marker (point-max)) (< marker (point-min)))
  18704 	  (widen))
  18705 	(goto-char marker)
  18706 	(org-show-context 'org-goto))
  18707     (if bookmark
  18708 	(bookmark-jump bookmark)
  18709       (error "Cannot find location"))))
  18710 
  18711 (defun org-quote-csv-field (s)
  18712   "Quote field for inclusion in CSV material."
  18713   (if (string-match "[\",]" s)
  18714       (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
  18715     s))
  18716 
  18717 (defun org-force-self-insert (N)
  18718   "Needed to enforce self-insert under remapping."
  18719   (interactive "p")
  18720   (self-insert-command N))
  18721 
  18722 (defun org-quote-vert (s)
  18723   "Replace \"|\" with \"\\vert\"."
  18724   (while (string-match "|" s)
  18725     (setq s (replace-match "\\vert" t t s)))
  18726   s)
  18727 
  18728 (defun org-uuidgen-p (s)
  18729   "Is S an ID created by UUIDGEN?"
  18730   (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s)))
  18731 
  18732 (defun org-in-src-block-p (&optional inside)
  18733   "Whether point is in a code source block.
  18734 When INSIDE is non-nil, don't consider we are within a source
  18735 block when point is at #+BEGIN_SRC or #+END_SRC."
  18736   (let ((case-fold-search t))
  18737     (or (and (eq (get-char-property (point) 'src-block) t))
  18738 	(and (not inside)
  18739 	     (save-match-data
  18740 	       (save-excursion
  18741 		 (beginning-of-line)
  18742 		 (looking-at ".*#\\+\\(begin\\|end\\)_src")))))))
  18743 
  18744 (defun org-context ()
  18745   "Return a list of contexts of the current cursor position.
  18746 If several contexts apply, all are returned.
  18747 Each context entry is a list with a symbol naming the context, and
  18748 two positions indicating start and end of the context.  Possible
  18749 contexts are:
  18750 
  18751 :headline         anywhere in a headline
  18752 :headline-stars   on the leading stars in a headline
  18753 :todo-keyword     on a TODO keyword (including DONE) in a headline
  18754 :tags             on the TAGS in a headline
  18755 :priority         on the priority cookie in a headline
  18756 :item             on the first line of a plain list item
  18757 :item-bullet      on the bullet/number of a plain list item
  18758 :checkbox         on the checkbox in a plain list item
  18759 :table            in an Org table
  18760 :table-special    on a special filed in a table
  18761 :table-table      in a table.el table
  18762 :clocktable       in a clocktable
  18763 :src-block        in a source block
  18764 :link             on a hyperlink
  18765 :keyword          on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT.
  18766 :latex-fragment   on a LaTeX fragment
  18767 :latex-preview    on a LaTeX fragment with overlaid preview image
  18768 
  18769 This function expects the position to be visible because it uses font-lock
  18770 faces as a help to recognize the following contexts: :table-special, :link,
  18771 and :keyword."
  18772   (let* ((f (get-text-property (point) 'face))
  18773 	 (faces (if (listp f) f (list f)))
  18774 	 (case-fold-search t)
  18775 	 (p (point)) clist o)
  18776     ;; First the large context
  18777     (cond
  18778      ((org-at-heading-p t)
  18779       (push (list :headline (point-at-bol) (point-at-eol)) clist)
  18780       (when (progn
  18781 	      (beginning-of-line 1)
  18782 	      (looking-at org-todo-line-tags-regexp))
  18783 	(push (org-point-in-group p 1 :headline-stars) clist)
  18784 	(push (org-point-in-group p 2 :todo-keyword) clist)
  18785 	(push (org-point-in-group p 4 :tags) clist))
  18786       (goto-char p)
  18787       (skip-chars-backward "^[\n\r \t") (or (bobp) (backward-char 1))
  18788       (when (looking-at "\\[#[A-Z0-9]\\]")
  18789 	(push (org-point-in-group p 0 :priority) clist)))
  18790 
  18791      ((org-at-item-p)
  18792       (push (org-point-in-group p 2 :item-bullet) clist)
  18793       (push (list :item (point-at-bol)
  18794 		  (save-excursion (org-end-of-item) (point)))
  18795 	    clist)
  18796       (and (org-at-item-checkbox-p)
  18797 	   (push (org-point-in-group p 0 :checkbox) clist)))
  18798 
  18799      ((org-at-table-p)
  18800       (push (list :table (org-table-begin) (org-table-end)) clist)
  18801       (when (memq 'org-formula faces)
  18802 	(push (list :table-special
  18803 		    (previous-single-property-change p 'face)
  18804 		    (next-single-property-change p 'face))
  18805 	      clist)))
  18806      ((org-at-table-p 'any)
  18807       (push (list :table-table) clist)))
  18808     (goto-char p)
  18809 
  18810     (let ((case-fold-search t))
  18811       ;; New the "medium" contexts: clocktables, source blocks
  18812       (cond ((org-in-clocktable-p)
  18813 	     (push (list :clocktable
  18814 			 (and (or (looking-at "[ \t]*\\(#\\+BEGIN: clocktable\\)")
  18815 				  (re-search-backward "[ \t]*\\(#+BEGIN: clocktable\\)" nil t))
  18816 			      (match-beginning 1))
  18817 			 (and (re-search-forward "[ \t]*#\\+END:?" nil t)
  18818 			      (match-end 0)))
  18819 		   clist))
  18820 	    ((org-in-src-block-p)
  18821 	     (push (list :src-block
  18822 			 (and (or (looking-at "[ \t]*\\(#\\+BEGIN_SRC\\)")
  18823 				  (re-search-backward "[ \t]*\\(#+BEGIN_SRC\\)" nil t))
  18824 			      (match-beginning 1))
  18825 			 (and (search-forward "#+END_SRC" nil t)
  18826 			      (match-beginning 0)))
  18827 		   clist))))
  18828     (goto-char p)
  18829 
  18830     ;; Now the small context
  18831     (cond
  18832      ((org-at-timestamp-p)
  18833       (push (org-point-in-group p 0 :timestamp) clist))
  18834      ((memq 'org-link faces)
  18835       (push (list :link
  18836 		  (previous-single-property-change p 'face)
  18837 		  (next-single-property-change p 'face))
  18838 	    clist))
  18839      ((memq 'org-special-keyword faces)
  18840       (push (list :keyword
  18841 		  (previous-single-property-change p 'face)
  18842 		  (next-single-property-change p 'face))
  18843 	    clist))
  18844      ((setq o (cl-some
  18845 	       (lambda (o)
  18846 		 (and (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay)
  18847 		      o))
  18848 	       (overlays-at (point))))
  18849       (push (list :latex-fragment
  18850 		  (overlay-start o) (overlay-end o))
  18851 	    clist)
  18852       (push (list :latex-preview
  18853 		  (overlay-start o) (overlay-end o))
  18854 	    clist))
  18855      ((org-inside-LaTeX-fragment-p)
  18856       ;; FIXME: positions wrong.
  18857       (push (list :latex-fragment (point) (point)) clist)))
  18858 
  18859     (setq clist (nreverse (delq nil clist)))
  18860     clist))
  18861 
  18862 (defun org-between-regexps-p (start-re end-re &optional lim-up lim-down)
  18863   "Non-nil when point is between matches of START-RE and END-RE.
  18864 
  18865 Also return a non-nil value when point is on one of the matches.
  18866 
  18867 Optional arguments LIM-UP and LIM-DOWN bound the search; they are
  18868 buffer positions.  Default values are the positions of headlines
  18869 surrounding the point.
  18870 
  18871 The functions returns a cons cell whose car (resp. cdr) is the
  18872 position before START-RE (resp. after END-RE)."
  18873   (save-match-data
  18874     (let ((pos (point))
  18875 	  (limit-up (or lim-up (save-excursion (outline-previous-heading))))
  18876 	  (limit-down (or lim-down (save-excursion (outline-next-heading))))
  18877 	  beg end)
  18878       (save-excursion
  18879 	;; Point is on a block when on START-RE or if START-RE can be
  18880 	;; found before it...
  18881 	(and (or (org-in-regexp start-re)
  18882 		 (re-search-backward start-re limit-up t))
  18883 	     (setq beg (match-beginning 0))
  18884 	     ;; ... and END-RE after it...
  18885 	     (goto-char (match-end 0))
  18886 	     (re-search-forward end-re limit-down t)
  18887 	     (> (setq end (match-end 0)) pos)
  18888 	     ;; ... without another START-RE in-between.
  18889 	     (goto-char (match-beginning 0))
  18890 	     (not (re-search-backward start-re (1+ beg) t))
  18891 	     ;; Return value.
  18892 	     (cons beg end))))))
  18893 
  18894 (defun org-in-block-p (names)
  18895   "Non-nil when point belongs to a block whose name belongs to NAMES.
  18896 
  18897 NAMES is a list of strings containing names of blocks.
  18898 
  18899 Return first block name matched, or nil.  Beware that in case of
  18900 nested blocks, the returned name may not belong to the closest
  18901 block from point."
  18902   (save-match-data
  18903     (catch 'exit
  18904       (let ((case-fold-search t)
  18905 	    (lim-up (save-excursion (outline-previous-heading)))
  18906 	    (lim-down (save-excursion (outline-next-heading))))
  18907 	(dolist (name names)
  18908 	  (let ((n (regexp-quote name)))
  18909 	    (when (org-between-regexps-p
  18910 		   (concat "^[ \t]*#\\+begin_" n)
  18911 		   (concat "^[ \t]*#\\+end_" n)
  18912 		   lim-up lim-down)
  18913 	      (throw 'exit n)))))
  18914       nil)))
  18915 
  18916 (defun org-occur-in-agenda-files (regexp &optional _nlines)
  18917   "Call `multi-occur' with buffers for all agenda files."
  18918   (interactive "sOrg-files matching: ")
  18919   (let* ((files (org-agenda-files))
  18920 	 (tnames (mapcar #'file-truename files))
  18921 	 (extra org-agenda-text-search-extra-files))
  18922     (when (eq (car extra) 'agenda-archives)
  18923       (setq extra (cdr extra))
  18924       (setq files (org-add-archive-files files)))
  18925     (dolist (f extra)
  18926       (unless (member (file-truename f) tnames)
  18927 	(unless (member f files) (setq files (append files (list f))))
  18928 	(setq tnames (append tnames (list (file-truename f))))))
  18929     (multi-occur
  18930      (mapcar (lambda (x)
  18931 	       (with-current-buffer
  18932 		   ;; FIXME: Why not just (find-file-noselect x)?
  18933 		   ;; Is it to avoid the "revert buffer" prompt?
  18934 		   (or (get-file-buffer x) (find-file-noselect x))
  18935 		 (widen)
  18936 		 (current-buffer)))
  18937 	     files)
  18938      regexp)))
  18939 
  18940 (add-hook 'occur-mode-find-occurrence-hook
  18941 	  (lambda () (when (derived-mode-p 'org-mode) (org-reveal))))
  18942 
  18943 (defun org-occur-link-in-agenda-files ()
  18944   "Create a link and search for it in the agendas.
  18945 The link is not stored in `org-stored-links', it is just created
  18946 for the search purpose."
  18947   (interactive)
  18948   (let ((link (condition-case nil
  18949 		  (org-store-link nil)
  18950 		(error "Unable to create a link to here"))))
  18951     (org-occur-in-agenda-files (regexp-quote link))))
  18952 
  18953 (defun org-back-over-empty-lines ()
  18954   "Move backwards over whitespace, to the beginning of the first empty line.
  18955 Returns the number of empty lines passed."
  18956   (let ((pos (point)))
  18957     (if (cdr (assq 'heading org-blank-before-new-entry))
  18958 	(skip-chars-backward " \t\n\r")
  18959       (unless (eobp)
  18960 	(forward-line -1)))
  18961     (beginning-of-line 2)
  18962     (goto-char (min (point) pos))
  18963     (count-lines (point) pos)))
  18964 
  18965 ;;; TODO: Only called once, from ox-odt which should probably use
  18966 ;;; org-export-inline-image-p or something.
  18967 (defun org-file-image-p (file)
  18968   "Return non-nil if FILE is an image."
  18969   (save-match-data
  18970     (string-match (image-file-name-regexp) file)))
  18971 
  18972 (defun org-get-cursor-date (&optional with-time)
  18973   "Return the date at cursor in as a time.
  18974 This works in the calendar and in the agenda, anywhere else it just
  18975 returns the current time.
  18976 If WITH-TIME is non-nil, returns the time of the event at point (in
  18977 the agenda) or the current time of the day; otherwise returns the
  18978 earliest time on the cursor date that Org treats as that date
  18979 (bearing in mind `org-extend-today-until')."
  18980   (let (date day defd tp hod mod)
  18981     (when with-time
  18982       (setq tp (get-text-property (point) 'time))
  18983       (when (and tp (string-match "\\([0-2]?[0-9]\\):\\([0-5][0-9]\\)" tp))
  18984 	(setq hod (string-to-number (match-string 1 tp))
  18985 	      mod (string-to-number (match-string 2 tp))))
  18986       (or tp (let ((now (decode-time)))
  18987 	       (setq hod (nth 2 now)
  18988 		     mod (nth 1 now)))))
  18989     (cond
  18990      ((eq major-mode 'calendar-mode)
  18991       (setq date (calendar-cursor-to-date)
  18992 	    defd (encode-time 0 (or mod 0) (or hod org-extend-today-until)
  18993 			      (nth 1 date) (nth 0 date) (nth 2 date))))
  18994      ((eq major-mode 'org-agenda-mode)
  18995       (setq day (get-text-property (point) 'day))
  18996       (when day
  18997 	(setq date (calendar-gregorian-from-absolute day)
  18998 	      defd (encode-time 0 (or mod 0) (or hod org-extend-today-until)
  18999 				(nth 1 date) (nth 0 date) (nth 2 date))))))
  19000     (or defd (current-time))))
  19001 
  19002 (defun org-mark-subtree (&optional up)
  19003   "Mark the current subtree.
  19004 This puts point at the start of the current subtree, and mark at
  19005 the end.  If a numeric prefix UP is given, move up into the
  19006 hierarchy of headlines by UP levels before marking the subtree."
  19007   (interactive "P")
  19008   (org-with-limited-levels
  19009    (cond ((org-at-heading-p) (beginning-of-line))
  19010 	 ((org-before-first-heading-p) (user-error "Not in a subtree"))
  19011 	 (t (outline-previous-visible-heading 1))))
  19012   (when up (while (and (> up 0) (org-up-heading-safe)) (cl-decf up)))
  19013   (if (called-interactively-p 'any)
  19014       (call-interactively 'org-mark-element)
  19015     (org-mark-element)))
  19016 
  19017 ;;; Indentation
  19018 
  19019 (defvar org-element-greater-elements)
  19020 (defun org--get-expected-indentation (element contentsp)
  19021   "Expected indentation column for current line, according to ELEMENT.
  19022 ELEMENT is an element containing point.  CONTENTSP is non-nil
  19023 when indentation is to be computed according to contents of
  19024 ELEMENT."
  19025   (let ((type (org-element-type element))
  19026 	(start (org-element-property :begin element))
  19027 	(post-affiliated (org-element-property :post-affiliated element)))
  19028     (org-with-wide-buffer
  19029      (cond
  19030       (contentsp
  19031        (cl-case type
  19032 	 ((diary-sexp footnote-definition) 0)
  19033 	 ((headline inlinetask nil)
  19034 	  (if (not org-adapt-indentation) 0
  19035 	    (let ((level (org-current-level)))
  19036 	      (if level (1+ level) 0))))
  19037 	 ((item plain-list) (org-list-item-body-column post-affiliated))
  19038 	 (t
  19039 	  (goto-char start)
  19040 	  (current-indentation))))
  19041       ((memq type '(headline inlinetask nil))
  19042        (if (org-match-line "[ \t]*$")
  19043 	   (org--get-expected-indentation element t)
  19044 	 0))
  19045       ((memq type '(diary-sexp footnote-definition)) 0)
  19046       ;; First paragraph of a footnote definition or an item.
  19047       ;; Indent like parent.
  19048       ((< (line-beginning-position) start)
  19049        (org--get-expected-indentation
  19050 	(org-element-property :parent element) t))
  19051       ;; At first line: indent according to previous sibling, if any,
  19052       ;; ignoring footnote definitions and inline tasks, or parent's
  19053       ;; contents.
  19054       ((and ( = (line-beginning-position) start)
  19055 	    (eq org-adapt-indentation t))
  19056        (catch 'exit
  19057 	 (while t
  19058 	   (if (= (point-min) start) (throw 'exit 0)
  19059 	     (goto-char (1- start))
  19060 	     (let* ((previous (org-element-at-point))
  19061 		    (parent previous))
  19062 	       (while (and parent (<= (org-element-property :end parent) start))
  19063 		 (setq previous parent
  19064 		       parent (org-element-property :parent parent)))
  19065 	       (cond
  19066 		((not previous) (throw 'exit 0))
  19067 		((> (org-element-property :end previous) start)
  19068 		 (throw 'exit (org--get-expected-indentation previous t)))
  19069 		((memq (org-element-type previous)
  19070 		       '(footnote-definition inlinetask))
  19071 		 (setq start (org-element-property :begin previous)))
  19072 		(t (goto-char (org-element-property :begin previous))
  19073 		   (throw 'exit
  19074 			  (if (bolp) (current-indentation)
  19075 			    ;; At first paragraph in an item or
  19076 			    ;; a footnote definition.
  19077 			    (org--get-expected-indentation
  19078 			     (org-element-property :parent previous) t))))))))))
  19079       ;; Otherwise, move to the first non-blank line above.
  19080       (t
  19081        (beginning-of-line)
  19082        (let ((pos (point)))
  19083 	 (skip-chars-backward " \r\t\n")
  19084 	 (cond
  19085 	  ;; Two blank lines end a footnote definition or a plain
  19086 	  ;; list.  When we indent an empty line after them, the
  19087 	  ;; containing list or footnote definition is over, so it
  19088 	  ;; qualifies as a previous sibling.  Therefore, we indent
  19089 	  ;; like its first line.
  19090 	  ((and (memq type '(footnote-definition plain-list))
  19091 		(> (count-lines (point) pos) 2))
  19092 	   (goto-char start)
  19093 	   (current-indentation))
  19094 	  ;; Line above is the first one of a paragraph at the
  19095 	  ;; beginning of an item or a footnote definition.  Indent
  19096 	  ;; like parent.
  19097 	  ((< (line-beginning-position) start)
  19098 	   (org--get-expected-indentation
  19099 	    (org-element-property :parent element) t))
  19100 	  ;; Line above is the beginning of an element, i.e., point
  19101 	  ;; was originally on the blank lines between element's start
  19102 	  ;; and contents.
  19103 	  ((= (line-beginning-position) post-affiliated)
  19104 	   (org--get-expected-indentation element t))
  19105 	  ;; POS is after contents in a greater element.  Indent like
  19106 	  ;; the beginning of the element.
  19107 	  ((and (memq type org-element-greater-elements)
  19108 		(let ((cend (org-element-property :contents-end element)))
  19109 		  (and cend (<= cend pos))))
  19110 	   ;; As a special case, if point is at the end of a footnote
  19111 	   ;; definition or an item, indent like the very last element
  19112 	   ;; within.  If that last element is an item, indent like
  19113 	   ;; its contents.
  19114 	   (if (memq type '(footnote-definition item plain-list))
  19115 	       (let ((last (org-element-at-point)))
  19116 		 (goto-char pos)
  19117 		 (org--get-expected-indentation
  19118 		  last (eq (org-element-type last) 'item)))
  19119 	     (goto-char start)
  19120 	     (current-indentation)))
  19121 	  ;; In any other case, indent like the current line.
  19122 	  (t (current-indentation)))))
  19123       ;; Finally, no indentation is needed, fall back to 0.
  19124       (t (current-indentation))))))
  19125 
  19126 (defun org--align-node-property ()
  19127   "Align node property at point.
  19128 Alignment is done according to `org-property-format', which see."
  19129   (when (save-excursion
  19130 	  (beginning-of-line)
  19131 	  (looking-at org-property-re))
  19132     (replace-match
  19133      (concat (match-string 4)
  19134 	     (org-trim
  19135 	      (format org-property-format (match-string 1) (match-string 3))))
  19136      t t)))
  19137 
  19138 (defun org-indent-line ()
  19139   "Indent line depending on context.
  19140 
  19141 Indentation is done according to the following rules:
  19142 
  19143   - Footnote definitions, diary sexps, headlines and inline tasks
  19144     have to start at column 0.
  19145 
  19146   - On the very first line of an element, consider, in order, the
  19147     next rules until one matches:
  19148 
  19149     1. If there's a sibling element before, ignoring footnote
  19150        definitions and inline tasks, indent like its first line.
  19151 
  19152     2. If element has a parent, indent like its contents.  More
  19153        precisely, if parent is an item, indent after the bullet.
  19154        Else, indent like parent's first line.
  19155 
  19156     3. Otherwise, indent relatively to current level, if
  19157        `org-adapt-indentation' is t, or to left margin.
  19158 
  19159   - On a blank line at the end of an element, indent according to
  19160     the type of the element.  More precisely
  19161 
  19162     1. If element is a plain list, an item, or a footnote
  19163        definition, indent like the very last element within.
  19164 
  19165     2. If element is a paragraph, indent like its last non blank
  19166        line.
  19167 
  19168     3. Otherwise, indent like its very first line.
  19169 
  19170   - In the code part of a source block, use language major mode
  19171     to indent current line if `org-src-tab-acts-natively' is
  19172     non-nil.  If it is nil, do nothing.
  19173 
  19174   - Otherwise, indent like the first non-blank line above.
  19175 
  19176 The function doesn't indent an item as it could break the whole
  19177 list structure.  Instead, use \\<org-mode-map>`\\[org-shiftmetaleft]' or \
  19178 `\\[org-shiftmetaright]'.
  19179 
  19180 Also align node properties according to `org-property-format'."
  19181   (interactive)
  19182   (unless (or (org-at-heading-p)
  19183               (and (eq org-adapt-indentation 'headline-data)
  19184                    (not (or (org-at-clock-log-p)
  19185                             (org-at-planning-p)))
  19186                    (save-excursion
  19187                      (beginning-of-line 1)
  19188                      (skip-chars-backward "\n")
  19189                      (or (org-at-heading-p)
  19190                          (looking-back ":END:.*" (point-at-bol))))))
  19191     (let* ((element (save-excursion (beginning-of-line) (org-element-at-point)))
  19192 	   (type (org-element-type element)))
  19193       (cond ((and (memq type '(plain-list item))
  19194 		  (= (line-beginning-position)
  19195 		     (org-element-property :post-affiliated element)))
  19196 	     nil)
  19197 	    ((and (eq type 'latex-environment)
  19198 		  (>= (point) (org-element-property :post-affiliated element))
  19199 		  (< (point)
  19200 		     (org-with-point-at (org-element-property :end element)
  19201 		       (skip-chars-backward " \t\n")
  19202 		       (line-beginning-position 2))))
  19203 	     nil)
  19204 	    ((and (eq type 'src-block)
  19205 		  org-src-tab-acts-natively
  19206 		  (> (line-beginning-position)
  19207 		     (org-element-property :post-affiliated element))
  19208 		  (< (line-beginning-position)
  19209 		     (org-with-point-at (org-element-property :end element)
  19210 		       (skip-chars-backward " \t\n")
  19211 		       (line-beginning-position))))
  19212              ;; At the beginning of a blank line, do some preindentation.  This
  19213              ;; signals org-src--edit-element to preserve the indentation on exit
  19214              (when (and (looking-at-p "^[[:space:]]*$")
  19215                         (not org-src-preserve-indentation))
  19216                (let ((element (org-element-at-point))
  19217                      block-content-ind some-ind)
  19218                  (org-with-point-at (org-element-property :begin element)
  19219                    (setq block-content-ind (+ (current-indentation)
  19220                                               org-edit-src-content-indentation))
  19221                    (forward-line)
  19222 		   (save-match-data (re-search-forward "^[ \t]*\\S-" nil t))
  19223                    (backward-char)
  19224                    (setq some-ind (if (looking-at-p "#\\+end_src")
  19225                                       block-content-ind (current-indentation))))
  19226                  (indent-line-to (min block-content-ind some-ind))))
  19227 	     (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))
  19228 	    (t
  19229 	     (let ((column (org--get-expected-indentation element nil)))
  19230 	       ;; Preserve current column.
  19231 	       (if (<= (current-column) (current-indentation))
  19232 		   (indent-line-to column)
  19233 		 (save-excursion (indent-line-to column))))
  19234 	     ;; Align node property.  Also preserve current column.
  19235 	     (when (eq type 'node-property)
  19236 	       (let ((column (current-column)))
  19237 		 (org--align-node-property)
  19238 		 (org-move-to-column column))))))))
  19239 
  19240 (defun org-indent-region (start end)
  19241   "Indent each non-blank line in the region.
  19242 Called from a program, START and END specify the region to
  19243 indent.  The function will not indent contents of example blocks,
  19244 verse blocks and export blocks as leading white spaces are
  19245 assumed to be significant there."
  19246   (interactive "r")
  19247   (save-excursion
  19248     (goto-char start)
  19249     (skip-chars-forward " \r\t\n")
  19250     (unless (eobp) (beginning-of-line))
  19251     (let ((indent-to
  19252 	   (lambda (ind pos)
  19253 	     ;; Set IND as indentation for all lines between point and
  19254 	     ;; POS.  Blank lines are ignored.  Leave point after POS
  19255 	     ;; once done.
  19256 	     (let ((limit (copy-marker pos)))
  19257 	       (while (< (point) limit)
  19258 		 (unless (looking-at-p "[ \t]*$") (indent-line-to ind))
  19259 		 (forward-line))
  19260 	       (set-marker limit nil))))
  19261 	  (end (copy-marker end)))
  19262       (while (< (point) end)
  19263 	(if (or (looking-at-p " \r\t\n") (org-at-heading-p)) (forward-line)
  19264 	  (let* ((element (org-element-at-point))
  19265 		 (type (org-element-type element))
  19266 		 (element-end (copy-marker (org-element-property :end element)))
  19267 		 (ind (org--get-expected-indentation element nil)))
  19268 	    (cond
  19269 	     ;; Element indented as a single block.  Example blocks
  19270 	     ;; preserving indentation are a special case since the
  19271 	     ;; "contents" must not be indented whereas the block
  19272 	     ;; boundaries can.
  19273 	     ((or (memq type '(export-block latex-environment))
  19274 		  (and (eq type 'example-block)
  19275 		       (not
  19276 			(or org-src-preserve-indentation
  19277 			    (org-element-property :preserve-indent element)))))
  19278 	      (let ((offset (- ind (current-indentation))))
  19279 		(unless (zerop offset)
  19280 		  (indent-rigidly (org-element-property :begin element)
  19281 				  (org-element-property :end element)
  19282 				  offset)))
  19283 	      (goto-char element-end))
  19284 	     ;; Elements indented line wise.  Be sure to exclude
  19285 	     ;; example blocks (preserving indentation) and source
  19286 	     ;; blocks from this category as they are treated
  19287 	     ;; specially later.
  19288 	     ((or (memq type '(paragraph table table-row))
  19289 		  (not (or (org-element-property :contents-begin element)
  19290 			   (memq type '(example-block src-block)))))
  19291 	      (when (eq type 'node-property)
  19292 		(org--align-node-property)
  19293 		(beginning-of-line))
  19294 	      (funcall indent-to ind (min element-end end)))
  19295 	     ;; Elements consisting of three parts: before the
  19296 	     ;; contents, the contents, and after the contents.  The
  19297 	     ;; contents are treated specially, according to the
  19298 	     ;; element type, or not indented at all.  Other parts are
  19299 	     ;; indented as a single block.
  19300 	     (t
  19301 	      (let* ((post (copy-marker
  19302 			    (org-element-property :post-affiliated element)))
  19303 		     (cbeg
  19304 		      (copy-marker
  19305 		       (cond
  19306 			((not (org-element-property :contents-begin element))
  19307 			 ;; Fake contents for source blocks.
  19308 			 (org-with-wide-buffer
  19309 			  (goto-char post)
  19310 			  (line-beginning-position 2)))
  19311 			((memq type '(footnote-definition item plain-list))
  19312 			 ;; Contents in these elements could start on
  19313 			 ;; the same line as the beginning of the
  19314 			 ;; element.  Make sure we start indenting
  19315 			 ;; from the second line.
  19316 			 (org-with-wide-buffer
  19317 			  (goto-char post)
  19318 			  (end-of-line)
  19319 			  (skip-chars-forward " \r\t\n")
  19320 			  (if (eobp) (point) (line-beginning-position))))
  19321 			(t (org-element-property :contents-begin element)))))
  19322 		     (cend (copy-marker
  19323 			    (or (org-element-property :contents-end element)
  19324 				;; Fake contents for source blocks.
  19325 				(org-with-wide-buffer
  19326 				 (goto-char element-end)
  19327 				 (skip-chars-backward " \r\t\n")
  19328 				 (line-beginning-position)))
  19329 			    t)))
  19330 		;; Do not change items indentation individually as it
  19331 		;; might break the list as a whole.  On the other
  19332 		;; hand, when at a plain list, indent it as a whole.
  19333 		(cond ((eq type 'plain-list)
  19334 		       (let ((offset (- ind (current-indentation))))
  19335 			 (unless (zerop offset)
  19336 			   (indent-rigidly (org-element-property :begin element)
  19337 					   (org-element-property :end element)
  19338 					   offset))
  19339 			 (goto-char cbeg)))
  19340 		      ((eq type 'item) (goto-char cbeg))
  19341 		      (t (funcall indent-to ind (min cbeg end))))
  19342 		(when (< (point) end)
  19343 		  (cl-case type
  19344 		    ((example-block verse-block))
  19345 		    (src-block
  19346 		     ;; In a source block, indent source code
  19347 		     ;; according to language major mode, but only if
  19348 		     ;; `org-src-tab-acts-natively' is non-nil.
  19349 		     (when (and (< (point) end) org-src-tab-acts-natively)
  19350 		       (ignore-errors
  19351 			 (org-babel-do-in-edit-buffer
  19352 			  (indent-region (point-min) (point-max))))))
  19353 		    (t (org-indent-region (point) (min cend end))))
  19354 		  (goto-char (min cend end))
  19355 		  (when (< (point) end)
  19356 		    (funcall indent-to ind (min element-end end))))
  19357 		(set-marker post nil)
  19358 		(set-marker cbeg nil)
  19359 		(set-marker cend nil))))
  19360 	    (set-marker element-end nil))))
  19361       (set-marker end nil))))
  19362 
  19363 (defun org-indent-drawer ()
  19364   "Indent the drawer at point."
  19365   (interactive)
  19366   (unless (save-excursion
  19367 	    (beginning-of-line)
  19368 	    (looking-at-p org-drawer-regexp))
  19369     (user-error "Not at a drawer"))
  19370   (let ((element (org-element-at-point)))
  19371     (unless (memq (org-element-type element) '(drawer property-drawer))
  19372       (user-error "Not at a drawer"))
  19373     (org-with-wide-buffer
  19374      (org-indent-region (org-element-property :begin element)
  19375 			(org-element-property :end element))))
  19376   (message "Drawer at point indented"))
  19377 
  19378 (defun org-indent-block ()
  19379   "Indent the block at point."
  19380   (interactive)
  19381   (unless (save-excursion
  19382 	    (beginning-of-line)
  19383 	    (let ((case-fold-search t))
  19384 	      (looking-at-p "[ \t]*#\\+\\(begin\\|end\\)_")))
  19385     (user-error "Not at a block"))
  19386   (let ((element (org-element-at-point)))
  19387     (unless (memq (org-element-type element)
  19388 		  '(comment-block center-block dynamic-block example-block
  19389 				  export-block quote-block special-block
  19390 				  src-block verse-block))
  19391       (user-error "Not at a block"))
  19392     (org-with-wide-buffer
  19393      (org-indent-region (org-element-property :begin element)
  19394 			(org-element-property :end element))))
  19395   (message "Block at point indented"))
  19396 
  19397 
  19398 ;;; Filling
  19399 
  19400 ;; We use our own fill-paragraph and auto-fill functions.
  19401 
  19402 ;; `org-fill-paragraph' relies on adaptive filling and context
  19403 ;; checking.  Appropriate `fill-prefix' is computed with
  19404 ;; `org-adaptive-fill-function'.
  19405 
  19406 ;; `org-auto-fill-function' takes care of auto-filling.  It calls
  19407 ;; `do-auto-fill' only on valid areas with `fill-prefix' shadowed with
  19408 ;; `org-adaptive-fill-function' value.  Internally,
  19409 ;; `org-comment-line-break-function' breaks the line.
  19410 
  19411 ;; `org-setup-filling' installs filling and auto-filling related
  19412 ;; variables during `org-mode' initialization.
  19413 
  19414 (defun org-setup-filling ()
  19415   (require 'org-element)
  19416   ;; Prevent auto-fill from inserting unwanted new items.
  19417   (when (boundp 'fill-nobreak-predicate)
  19418     (setq-local
  19419      fill-nobreak-predicate
  19420      (org-uniquify
  19421       (append fill-nobreak-predicate
  19422 	      '(org-fill-line-break-nobreak-p
  19423 		org-fill-n-macro-as-item-nobreak-p
  19424 		org-fill-paragraph-with-timestamp-nobreak-p)))))
  19425   (let ((paragraph-ending (substring org-element-paragraph-separate 1)))
  19426     (setq-local paragraph-start paragraph-ending)
  19427     (setq-local paragraph-separate paragraph-ending))
  19428   (setq-local fill-paragraph-function 'org-fill-paragraph)
  19429   (setq-local auto-fill-inhibit-regexp nil)
  19430   (setq-local adaptive-fill-function 'org-adaptive-fill-function)
  19431   (setq-local normal-auto-fill-function 'org-auto-fill-function)
  19432   (setq-local comment-line-break-function 'org-comment-line-break-function))
  19433 
  19434 (defun org-fill-line-break-nobreak-p ()
  19435   "Non-nil when a new line at point would create an Org line break."
  19436   (save-excursion
  19437     (skip-chars-backward " \t")
  19438     (skip-chars-backward "\\\\")
  19439     (looking-at "\\\\\\\\\\($\\|[^\\]\\)")))
  19440 
  19441 (defun org-fill-paragraph-with-timestamp-nobreak-p ()
  19442   "Non-nil when a new line at point would split a timestamp."
  19443   (and (org-at-timestamp-p 'lax)
  19444        (not (looking-at org-ts-regexp-both))))
  19445 
  19446 (defun org-fill-n-macro-as-item-nobreak-p ()
  19447   "Non-nil when a new line at point would create a new list."
  19448   ;; During export, a "n" macro followed by a dot or a closing
  19449   ;; parenthesis can end up being parsed as a new list item.
  19450   (looking-at-p "[ \t]*{{{n\\(?:([^\n)]*)\\)?}}}[.)]\\(?:$\\| \\)"))
  19451 
  19452 (defun org-adaptive-fill-function ()
  19453   "Compute a fill prefix for the current line.
  19454 Return fill prefix, as a string, or nil if current line isn't
  19455 meant to be filled.  For convenience, if `adaptive-fill-regexp'
  19456 matches in paragraphs or comments, use it."
  19457   (org-with-wide-buffer
  19458    (unless (org-at-heading-p)
  19459      (let* ((p (line-beginning-position))
  19460 	    (element (save-excursion
  19461 		       (beginning-of-line)
  19462 		       (org-element-at-point)))
  19463 	    (type (org-element-type element))
  19464 	    (post-affiliated (org-element-property :post-affiliated element)))
  19465        (unless (< p post-affiliated)
  19466 	 (cl-case type
  19467 	   (comment
  19468 	    (save-excursion
  19469 	      (beginning-of-line)
  19470 	      (looking-at "[ \t]*")
  19471 	      (concat (match-string 0) "# ")))
  19472 	   (footnote-definition "")
  19473 	   ((item plain-list)
  19474 	    (make-string (org-list-item-body-column post-affiliated) ?\s))
  19475 	   (paragraph
  19476 	    ;; Fill prefix is usually the same as the current line,
  19477 	    ;; unless the paragraph is at the beginning of an item.
  19478 	    (let ((parent (org-element-property :parent element)))
  19479 	      (save-excursion
  19480 		(beginning-of-line)
  19481 		(cond ((eq (org-element-type parent) 'item)
  19482 		       (make-string (org-list-item-body-column
  19483 				     (org-element-property :begin parent))
  19484 				    ?\s))
  19485 		      ((and adaptive-fill-regexp
  19486 			    ;; Locally disable
  19487 			    ;; `adaptive-fill-function' to let
  19488 			    ;; `fill-context-prefix' handle
  19489 			    ;; `adaptive-fill-regexp' variable.
  19490 			    (let (adaptive-fill-function)
  19491 			      (fill-context-prefix
  19492 			       post-affiliated
  19493 			       (org-element-property :end element)))))
  19494 		      ((looking-at "[ \t]+") (match-string 0))
  19495 		      (t  "")))))
  19496 	   (comment-block
  19497 	    ;; Only fill contents if P is within block boundaries.
  19498 	    (let* ((cbeg (save-excursion (goto-char post-affiliated)
  19499 					 (forward-line)
  19500 					 (point)))
  19501 		   (cend (save-excursion
  19502 			   (goto-char (org-element-property :end element))
  19503 			   (skip-chars-backward " \r\t\n")
  19504 			   (line-beginning-position))))
  19505 	      (when (and (>= p cbeg) (< p cend))
  19506 		(if (save-excursion (beginning-of-line) (looking-at "[ \t]+"))
  19507 		    (match-string 0)
  19508 		  ""))))))))))
  19509 
  19510 (defun org-fill-element (&optional justify)
  19511   "Fill element at point, when applicable.
  19512 
  19513 This function only applies to comment blocks, comments, example
  19514 blocks and paragraphs.  Also, as a special case, re-align table
  19515 when point is at one.
  19516 
  19517 If JUSTIFY is non-nil (interactively, with prefix argument),
  19518 justify as well.  If `sentence-end-double-space' is non-nil, then
  19519 period followed by one space does not end a sentence, so don't
  19520 break a line there.  The variable `fill-column' controls the
  19521 width for filling.
  19522 
  19523 For convenience, when point is at a plain list, an item or
  19524 a footnote definition, try to fill the first paragraph within."
  19525   (with-syntax-table org-mode-transpose-word-syntax-table
  19526     ;; Move to end of line in order to get the first paragraph within
  19527     ;; a plain list or a footnote definition.
  19528     (let ((element (save-excursion (end-of-line) (org-element-at-point))))
  19529       ;; First check if point is in a blank line at the beginning of
  19530       ;; the buffer.  In that case, ignore filling.
  19531       (cl-case (org-element-type element)
  19532 	;; Use major mode filling function is source blocks.
  19533 	(src-block (org-babel-do-in-edit-buffer
  19534                     (push-mark (point-min))
  19535                     (goto-char (point-max))
  19536                     (setq mark-active t)
  19537                     (funcall-interactively #'fill-paragraph justify 'region)))
  19538 	;; Align Org tables, leave table.el tables as-is.
  19539 	(table-row (org-table-align) t)
  19540 	(table
  19541 	 (when (eq (org-element-property :type element) 'org)
  19542 	   (save-excursion
  19543 	     (goto-char (org-element-property :post-affiliated element))
  19544 	     (org-table-align)))
  19545 	 t)
  19546 	(paragraph
  19547 	 ;; Paragraphs may contain `line-break' type objects.
  19548 	 (let ((beg (max (point-min)
  19549 			 (org-element-property :contents-begin element)))
  19550 	       (end (min (point-max)
  19551 			 (org-element-property :contents-end element))))
  19552 	   ;; Do nothing if point is at an affiliated keyword.
  19553 	   (if (< (line-end-position) beg) t
  19554 	     ;; Fill paragraph, taking line breaks into account.
  19555 	     (save-excursion
  19556 	       (goto-char beg)
  19557 	       (let ((cuts (list beg)))
  19558 		 (while (re-search-forward "\\\\\\\\[ \t]*\n" end t)
  19559 		   (when (eq 'line-break
  19560 			     (org-element-type
  19561 			      (save-excursion (backward-char)
  19562 					      (org-element-context))))
  19563 		     (push (point) cuts)))
  19564 		 (dolist (c (delq end cuts))
  19565 		   (fill-region-as-paragraph c end justify)
  19566 		   (setq end c))))
  19567 	     t)))
  19568 	;; Contents of `comment-block' type elements should be
  19569 	;; filled as plain text, but only if point is within block
  19570 	;; markers.
  19571 	(comment-block
  19572 	 (let* ((case-fold-search t)
  19573 		(beg (save-excursion
  19574 		       (goto-char (org-element-property :begin element))
  19575 		       (re-search-forward "^[ \t]*#\\+begin_comment" nil t)
  19576 		       (forward-line)
  19577 		       (point)))
  19578 		(end (save-excursion
  19579 		       (goto-char (org-element-property :end element))
  19580 		       (re-search-backward "^[ \t]*#\\+end_comment" nil t)
  19581 		       (line-beginning-position))))
  19582 	   (if (or (< (point) beg) (> (point) end)) t
  19583 	     (fill-region-as-paragraph
  19584 	      (save-excursion (end-of-line)
  19585 			      (re-search-backward "^[ \t]*$" beg 'move)
  19586 			      (line-beginning-position))
  19587 	      (save-excursion (beginning-of-line)
  19588 			      (re-search-forward "^[ \t]*$" end 'move)
  19589 			      (line-beginning-position))
  19590 	      justify))))
  19591 	;; Fill comments.
  19592 	(comment
  19593 	 (let ((begin (org-element-property :post-affiliated element))
  19594 	       (end (org-element-property :end element)))
  19595 	   (when (and (>= (point) begin) (<= (point) end))
  19596 	     (let ((begin (save-excursion
  19597 			    (end-of-line)
  19598 			    (if (re-search-backward "^[ \t]*#[ \t]*$" begin t)
  19599 				(progn (forward-line) (point))
  19600 			      begin)))
  19601 		   (end (save-excursion
  19602 			  (end-of-line)
  19603 			  (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move)
  19604 			      (1- (line-beginning-position))
  19605 			    (skip-chars-backward " \r\t\n")
  19606 			    (line-end-position)))))
  19607 	       ;; Do not fill comments when at a blank line.
  19608 	       (when (> end begin)
  19609 		 (let ((fill-prefix
  19610 			(save-excursion
  19611 			  (beginning-of-line)
  19612 			  (looking-at "[ \t]*#")
  19613 			  (let ((comment-prefix (match-string 0)))
  19614 			    (goto-char (match-end 0))
  19615 			    (if (looking-at adaptive-fill-regexp)
  19616 				(concat comment-prefix (match-string 0))
  19617 			      (concat comment-prefix " "))))))
  19618 		   (save-excursion
  19619 		     (fill-region-as-paragraph begin end justify))))))
  19620 	   t))
  19621 	;; Ignore every other element.
  19622 	(otherwise t)))))
  19623 
  19624 (defun org-fill-paragraph (&optional justify region)
  19625   "Fill element at point, when applicable.
  19626 
  19627 This function only applies to comment blocks, comments, example
  19628 blocks and paragraphs.  Also, as a special case, re-align table
  19629 when point is at one.
  19630 
  19631 For convenience, when point is at a plain list, an item or
  19632 a footnote definition, try to fill the first paragraph within.
  19633 
  19634 If JUSTIFY is non-nil (interactively, with prefix argument),
  19635 justify as well.  If `sentence-end-double-space' is non-nil, then
  19636 period followed by one space does not end a sentence, so don't
  19637 break a line there.  The variable `fill-column' controls the
  19638 width for filling.
  19639 
  19640 The REGION argument is non-nil if called interactively; in that
  19641 case, if Transient Mark mode is enabled and the mark is active,
  19642 fill each of the elements in the active region, instead of just
  19643 filling the current element."
  19644   (interactive (progn
  19645 		 (barf-if-buffer-read-only)
  19646 		 (list (when current-prefix-arg 'full) t)))
  19647   (let ((hash (and (not (buffer-modified-p))
  19648 		   (org-buffer-hash))))
  19649     (cond
  19650      ((and region transient-mark-mode mark-active
  19651 	   (not (eq (region-beginning) (region-end))))
  19652       (let ((origin (point-marker))
  19653 	    (start (region-beginning)))
  19654 	(unwind-protect
  19655 	    (progn
  19656 	      (goto-char (region-end))
  19657 	      (skip-chars-backward " \t\n")
  19658 	      (while (> (point) start)
  19659 		(org-fill-element justify)
  19660 		(org-backward-paragraph)))
  19661 	  (goto-char origin)
  19662 	  (set-marker origin nil))))
  19663      (t
  19664       (save-excursion
  19665 	(when (org-match-line "[ \t]*$")
  19666 	  (skip-chars-forward " \t\n"))
  19667 	(org-fill-element justify))))
  19668     ;; If we didn't change anything in the buffer (and the buffer was
  19669     ;; previously unmodified), then flip the modification status back
  19670     ;; to "unchanged".
  19671     (when (and hash (equal hash (org-buffer-hash)))
  19672       (set-buffer-modified-p nil))
  19673     ;; Return non-nil.
  19674     t))
  19675 
  19676 (defun org-auto-fill-function ()
  19677   "Auto-fill function."
  19678   ;; Check if auto-filling is meaningful.
  19679   (let ((fc (current-fill-column)))
  19680     (when (and fc (> (current-column) fc))
  19681       (let* ((fill-prefix (org-adaptive-fill-function))
  19682 	     ;; Enforce empty fill prefix, if required.  Otherwise, it
  19683 	     ;; will be computed again.
  19684 	     (adaptive-fill-mode (not (equal fill-prefix ""))))
  19685 	(when fill-prefix (do-auto-fill))))))
  19686 
  19687 (defun org-comment-line-break-function (&optional soft)
  19688   "Break line at point and indent, continuing comment if within one.
  19689 The inserted newline is marked hard if variable
  19690 `use-hard-newlines' is true, unless optional argument SOFT is
  19691 non-nil."
  19692   (if soft (insert-and-inherit ?\n) (newline 1))
  19693   (save-excursion (forward-char -1) (delete-horizontal-space))
  19694   (delete-horizontal-space)
  19695   (indent-to-left-margin)
  19696   (insert-before-markers-and-inherit fill-prefix))
  19697 
  19698 
  19699 ;;; Fixed Width Areas
  19700 
  19701 (defun org-toggle-fixed-width ()
  19702   "Toggle fixed-width markup.
  19703 
  19704 Add or remove fixed-width markup on current line, whenever it
  19705 makes sense.  Return an error otherwise.
  19706 
  19707 If a region is active and if it contains only fixed-width areas
  19708 or blank lines, remove all fixed-width markup in it.  If the
  19709 region contains anything else, convert all non-fixed-width lines
  19710 to fixed-width ones.
  19711 
  19712 Blank lines at the end of the region are ignored unless the
  19713 region only contains such lines."
  19714   (interactive)
  19715   (if (not (org-region-active-p))
  19716       ;; No region:
  19717       ;;
  19718       ;; Remove fixed width marker only in a fixed-with element.
  19719       ;;
  19720       ;; Add fixed width maker in paragraphs, in blank lines after
  19721       ;; elements or at the beginning of a headline or an inlinetask,
  19722       ;; and before any one-line elements (e.g., a clock).
  19723       (progn
  19724         (beginning-of-line)
  19725         (let* ((element (org-element-at-point))
  19726                (type (org-element-type element)))
  19727           (cond
  19728            ((and (eq type 'fixed-width)
  19729                  (looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)"))
  19730             (replace-match
  19731 	     "" nil nil nil (if (= (line-end-position) (match-end 0)) 0 1)))
  19732            ((and (memq type '(babel-call clock comment diary-sexp headline
  19733 					 horizontal-rule keyword paragraph
  19734 					 planning))
  19735 		 (<= (org-element-property :post-affiliated element) (point)))
  19736             (skip-chars-forward " \t")
  19737             (insert ": "))
  19738            ((and (looking-at-p "[ \t]*$")
  19739                  (or (eq type 'inlinetask)
  19740                      (save-excursion
  19741                        (skip-chars-forward " \r\t\n")
  19742                        (<= (org-element-property :end element) (point)))))
  19743             (delete-region (point) (line-end-position))
  19744             (org-indent-line)
  19745             (insert ": "))
  19746            (t (user-error "Cannot insert a fixed-width line here")))))
  19747     ;; Region active.
  19748     (let* ((begin (save-excursion
  19749                     (goto-char (region-beginning))
  19750                     (line-beginning-position)))
  19751            (end (copy-marker
  19752                  (save-excursion
  19753                    (goto-char (region-end))
  19754                    (unless (eolp) (beginning-of-line))
  19755                    (if (save-excursion (re-search-backward "\\S-" begin t))
  19756                        (progn (skip-chars-backward " \r\t\n") (point))
  19757                      (point)))))
  19758            (all-fixed-width-p
  19759             (catch 'not-all-p
  19760               (save-excursion
  19761                 (goto-char begin)
  19762                 (skip-chars-forward " \r\t\n")
  19763                 (when (eobp) (throw 'not-all-p nil))
  19764                 (while (< (point) end)
  19765                   (let ((element (org-element-at-point)))
  19766                     (if (eq (org-element-type element) 'fixed-width)
  19767                         (goto-char (org-element-property :end element))
  19768                       (throw 'not-all-p nil))))
  19769                 t))))
  19770       (if all-fixed-width-p
  19771           (save-excursion
  19772             (goto-char begin)
  19773             (while (< (point) end)
  19774               (when (looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)")
  19775                 (replace-match
  19776                  "" nil nil nil
  19777                  (if (= (line-end-position) (match-end 0)) 0 1)))
  19778               (forward-line)))
  19779         (let ((min-ind (point-max)))
  19780           ;; Find minimum indentation across all lines.
  19781           (save-excursion
  19782             (goto-char begin)
  19783             (if (not (save-excursion (re-search-forward "\\S-" end t)))
  19784                 (setq min-ind 0)
  19785               (catch 'zerop
  19786                 (while (< (point) end)
  19787                   (unless (looking-at-p "[ \t]*$")
  19788                     (let ((ind (current-indentation)))
  19789                       (setq min-ind (min min-ind ind))
  19790                       (when (zerop ind) (throw 'zerop t))))
  19791                   (forward-line)))))
  19792           ;; Loop over all lines and add fixed-width markup everywhere
  19793           ;; but in fixed-width lines.
  19794           (save-excursion
  19795             (goto-char begin)
  19796             (while (< (point) end)
  19797               (cond
  19798                ((org-at-heading-p)
  19799                 (insert ": ")
  19800                 (forward-line)
  19801                 (while (and (< (point) end) (looking-at-p "[ \t]*$"))
  19802                   (insert ":")
  19803                   (forward-line)))
  19804                ((looking-at-p "[ \t]*:\\( \\|$\\)")
  19805                 (let* ((element (org-element-at-point))
  19806                        (element-end (org-element-property :end element)))
  19807                   (if (eq (org-element-type element) 'fixed-width)
  19808                       (progn (goto-char element-end)
  19809                              (skip-chars-backward " \r\t\n")
  19810                              (forward-line))
  19811                     (let ((limit (min end element-end)))
  19812                       (while (< (point) limit)
  19813                         (org-move-to-column min-ind t)
  19814                         (insert ": ")
  19815                         (forward-line))))))
  19816                (t
  19817                 (org-move-to-column min-ind t)
  19818                 (insert ": ")
  19819                 (forward-line)))))))
  19820       (set-marker end nil))))
  19821 
  19822 
  19823 ;;; Blocks
  19824 
  19825 (defun org-block-map (function &optional start end)
  19826   "Call FUNCTION at the head of all source blocks in the current buffer.
  19827 Optional arguments START and END can be used to limit the range."
  19828   (let ((start (or start (point-min)))
  19829         (end (or end (point-max))))
  19830     (save-excursion
  19831       (goto-char start)
  19832       (while (and (< (point) end) (re-search-forward org-block-regexp end t))
  19833 	(save-excursion
  19834 	  (save-match-data
  19835             (goto-char (match-beginning 0))
  19836             (funcall function)))))))
  19837 
  19838 (defun org-next-block (arg &optional backward block-regexp)
  19839   "Jump to the next block.
  19840 
  19841 With a prefix argument ARG, jump forward ARG many blocks.
  19842 
  19843 When BACKWARD is non-nil, jump to the previous block.
  19844 
  19845 When BLOCK-REGEXP is non-nil, use this regexp to find blocks.
  19846 Match data is set according to this regexp when the function
  19847 returns.
  19848 
  19849 Return point at beginning of the opening line of found block.
  19850 Throw an error if no block is found."
  19851   (interactive "p")
  19852   (let ((re (or block-regexp "^[ \t]*#\\+BEGIN"))
  19853 	(case-fold-search t)
  19854 	(search-fn (if backward #'re-search-backward #'re-search-forward))
  19855 	(count (or arg 1))
  19856 	(origin (point))
  19857 	last-element)
  19858     (if backward (beginning-of-line) (end-of-line))
  19859     (while (and (> count 0) (funcall search-fn re nil t))
  19860       (let ((element (save-excursion
  19861 		       (goto-char (match-beginning 0))
  19862 		       (save-match-data (org-element-at-point)))))
  19863 	(when (and (memq (org-element-type element)
  19864 			 '(center-block comment-block dynamic-block
  19865 					example-block export-block quote-block
  19866 					special-block src-block verse-block))
  19867 		   (<= (match-beginning 0)
  19868 		       (org-element-property :post-affiliated element)))
  19869 	  (setq last-element element)
  19870 	  (cl-decf count))))
  19871     (if (= count 0)
  19872 	(prog1 (goto-char (org-element-property :post-affiliated last-element))
  19873 	  (save-match-data (org-show-context)))
  19874       (goto-char origin)
  19875       (user-error "No %s code blocks" (if backward "previous" "further")))))
  19876 
  19877 (defun org-previous-block (arg &optional block-regexp)
  19878   "Jump to the previous block.
  19879 With a prefix argument ARG, jump backward ARG many source blocks.
  19880 When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
  19881   (interactive "p")
  19882   (org-next-block arg t block-regexp))
  19883 
  19884 
  19885 ;;; Comments
  19886 
  19887 ;; Org comments syntax is quite complex.  It requires the entire line
  19888 ;; to be just a comment.  Also, even with the right syntax at the
  19889 ;; beginning of line, some elements (e.g., verse-block or
  19890 ;; example-block) don't accept comments.  Usual Emacs comment commands
  19891 ;; cannot cope with those requirements.  Therefore, Org replaces them.
  19892 
  19893 ;; Org still relies on 'comment-dwim', but cannot trust
  19894 ;; 'comment-only-p'.  So, 'comment-region-function' and
  19895 ;; 'uncomment-region-function' both point
  19896 ;; to 'org-comment-or-uncomment-region'.  Eventually,
  19897 ;; 'org-insert-comment' takes care of insertion of comments at the
  19898 ;; beginning of line.
  19899 
  19900 ;; 'org-setup-comments-handling' install comments related variables
  19901 ;; during 'org-mode' initialization.
  19902 
  19903 (defun org-setup-comments-handling ()
  19904   (interactive)
  19905   (setq-local comment-use-syntax nil)
  19906   (setq-local comment-start "# ")
  19907   (setq-local comment-start-skip "^\\s-*#\\(?: \\|$\\)")
  19908   (setq-local comment-insert-comment-function 'org-insert-comment)
  19909   (setq-local comment-region-function 'org-comment-or-uncomment-region)
  19910   (setq-local uncomment-region-function 'org-comment-or-uncomment-region))
  19911 
  19912 (defun org-insert-comment ()
  19913   "Insert an empty comment above current line.
  19914 If the line is empty, insert comment at its beginning.  When
  19915 point is within a source block, comment according to the related
  19916 major mode."
  19917   (if (let ((element (org-element-at-point)))
  19918 	(and (eq (org-element-type element) 'src-block)
  19919 	     (< (save-excursion
  19920 		  (goto-char (org-element-property :post-affiliated element))
  19921 		  (line-end-position))
  19922 		(point))
  19923 	     (> (save-excursion
  19924 		  (goto-char (org-element-property :end element))
  19925 		  (skip-chars-backward " \r\t\n")
  19926 		  (line-beginning-position))
  19927 		(point))))
  19928       (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim))
  19929     (beginning-of-line)
  19930     (if (looking-at "\\s-*$") (delete-region (point) (point-at-eol))
  19931       (open-line 1))
  19932     (org-indent-line)
  19933     (insert "# ")))
  19934 
  19935 (defvar comment-empty-lines)		; From newcomment.el.
  19936 (defun org-comment-or-uncomment-region (beg end &rest _)
  19937   "Comment or uncomment each non-blank line in the region.
  19938 Uncomment each non-blank line between BEG and END if it only
  19939 contains commented lines.  Otherwise, comment them.  If region is
  19940 strictly within a source block, use appropriate comment syntax."
  19941   (if (let ((element (org-element-at-point)))
  19942 	(and (eq (org-element-type element) 'src-block)
  19943 	     (< (save-excursion
  19944 		  (goto-char (org-element-property :post-affiliated element))
  19945 		  (line-end-position))
  19946 		beg)
  19947 	     (>= (save-excursion
  19948 		   (goto-char (org-element-property :end element))
  19949 		   (skip-chars-backward " \r\t\n")
  19950 		   (line-beginning-position))
  19951 		 end)))
  19952       ;; Translate region boundaries for the Org buffer to the source
  19953       ;; buffer.
  19954       (let ((offset (- end beg)))
  19955 	(save-excursion
  19956 	  (goto-char beg)
  19957 	  (org-babel-do-in-edit-buffer
  19958 	   (comment-or-uncomment-region (point) (+ offset (point))))))
  19959     (save-restriction
  19960       ;; Restrict region
  19961       (narrow-to-region (save-excursion (goto-char beg)
  19962 					(skip-chars-forward " \r\t\n" end)
  19963 					(line-beginning-position))
  19964 			(save-excursion (goto-char end)
  19965 					(skip-chars-backward " \r\t\n" beg)
  19966 					(line-end-position)))
  19967       (let ((uncommentp
  19968 	     ;; UNCOMMENTP is non-nil when every non blank line between
  19969 	     ;; BEG and END is a comment.
  19970 	     (save-excursion
  19971 	       (goto-char (point-min))
  19972 	       (while (and (not (eobp))
  19973 			   (let ((element (org-element-at-point)))
  19974 			     (and (eq (org-element-type element) 'comment)
  19975 				  (goto-char (min (point-max)
  19976 						  (org-element-property
  19977 						   :end element)))))))
  19978 	       (eobp))))
  19979 	(if uncommentp
  19980 	    ;; Only blank lines and comments in region: uncomment it.
  19981 	    (save-excursion
  19982 	      (goto-char (point-min))
  19983 	      (while (not (eobp))
  19984 		(when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)")
  19985 		  (replace-match "" nil nil nil 1))
  19986 		(forward-line)))
  19987 	  ;; Comment each line in region.
  19988 	  (let ((min-indent (point-max)))
  19989 	    ;; First find the minimum indentation across all lines.
  19990 	    (save-excursion
  19991 	      (goto-char (point-min))
  19992 	      (while (and (not (eobp)) (not (zerop min-indent)))
  19993 		(unless (looking-at "[ \t]*$")
  19994 		  (setq min-indent (min min-indent (current-indentation))))
  19995 		(forward-line)))
  19996 	    ;; Then loop over all lines.
  19997 	    (save-excursion
  19998 	      (goto-char (point-min))
  19999 	      (while (not (eobp))
  20000 		(unless (and (not comment-empty-lines) (looking-at "[ \t]*$"))
  20001 		  ;; Don't get fooled by invisible text (e.g. link path)
  20002 		  ;; when moving to column MIN-INDENT.
  20003 		  (let ((buffer-invisibility-spec nil))
  20004 		    (org-move-to-column min-indent t))
  20005 		  (insert comment-start))
  20006 		(forward-line)))))))))
  20007 
  20008 (defun org-comment-dwim (_arg)
  20009   "Call the comment command you mean.
  20010 Call `org-toggle-comment' if on a heading, otherwise call
  20011 `comment-dwim', within a source edit buffer if needed."
  20012   (interactive "*P")
  20013   (cond ((org-at-heading-p)
  20014 	 (call-interactively #'org-toggle-comment))
  20015 	((org-in-src-block-p)
  20016 	 (org-babel-do-in-edit-buffer (call-interactively #'comment-dwim)))
  20017 	(t (call-interactively #'comment-dwim))))
  20018 
  20019 
  20020 ;;; Timestamps API
  20021 
  20022 ;; This section contains tools to operate on, or create, timestamp
  20023 ;; objects, as returned by, e.g. `org-element-context'.
  20024 
  20025 (defun org-timestamp-from-string (s)
  20026   "Convert Org timestamp S, as a string, into a timestamp object.
  20027 Return nil if S is not a valid timestamp string."
  20028   (when (org-string-nw-p s)
  20029     (with-temp-buffer
  20030       (save-excursion (insert s))
  20031       (org-element-timestamp-parser))))
  20032 
  20033 (defun org-timestamp-from-time (time &optional with-time inactive)
  20034   "Convert a time value into a timestamp object.
  20035 
  20036 TIME is an Emacs internal time representation, as returned, e.g.,
  20037 by `current-time'.
  20038 
  20039 When optional argument WITH-TIME is non-nil, return a timestamp
  20040 object with a time part, i.e., with hours and minutes.
  20041 
  20042 Return an inactive timestamp if INACTIVE is non-nil.  Otherwise,
  20043 return an active timestamp."
  20044   (pcase-let ((`(,_ ,minute ,hour ,day ,month ,year . ,_) (decode-time time)))
  20045     (org-element-create 'timestamp
  20046 			(list :type (if inactive 'inactive 'active)
  20047 			      :year-start year
  20048 			      :month-start month
  20049 			      :day-start day
  20050 			      :hour-start (and with-time hour)
  20051 			      :minute-start (and with-time minute)))))
  20052 
  20053 (defun org-timestamp-to-time (timestamp &optional end)
  20054   "Convert TIMESTAMP object into an Emacs internal time value.
  20055 Use end of date range or time range when END is non-nil.
  20056 Otherwise, use its start."
  20057   (apply #'encode-time 0
  20058 	 (mapcar
  20059 	  (lambda (prop) (or (org-element-property prop timestamp) 0))
  20060 	  (if end '(:minute-end :hour-end :day-end :month-end :year-end)
  20061 	    '(:minute-start :hour-start :day-start :month-start
  20062 			    :year-start)))))
  20063 
  20064 (defun org-timestamp-has-time-p (timestamp)
  20065   "Non-nil when TIMESTAMP has a time specified."
  20066   (org-element-property :hour-start timestamp))
  20067 
  20068 (defun org-timestamp-format (timestamp format &optional end utc)
  20069   "Format a TIMESTAMP object into a string.
  20070 
  20071 FORMAT is a format specifier to be passed to
  20072 `format-time-string'.
  20073 
  20074 When optional argument END is non-nil, use end of date-range or
  20075 time-range, if possible.
  20076 
  20077 When optional argument UTC is non-nil, time is be expressed as
  20078 Universal Time."
  20079   (format-time-string format (org-timestamp-to-time timestamp end)
  20080 		      (and utc t)))
  20081 
  20082 (defun org-timestamp-split-range (timestamp &optional end)
  20083   "Extract a TIMESTAMP object from a date or time range.
  20084 
  20085 END, when non-nil, means extract the end of the range.
  20086 Otherwise, extract its start.
  20087 
  20088 Return a new timestamp object."
  20089   (let ((type (org-element-property :type timestamp)))
  20090     (if (memq type '(active inactive diary)) timestamp
  20091       (let ((split-ts (org-element-copy timestamp)))
  20092 	;; Set new type.
  20093 	(org-element-put-property
  20094 	 split-ts :type (if (eq type 'active-range) 'active 'inactive))
  20095 	;; Copy start properties over end properties if END is
  20096 	;; non-nil.  Otherwise, copy end properties over `start' ones.
  20097 	(let ((p-alist '((:minute-start . :minute-end)
  20098 			 (:hour-start . :hour-end)
  20099 			 (:day-start . :day-end)
  20100 			 (:month-start . :month-end)
  20101 			 (:year-start . :year-end))))
  20102 	  (dolist (p-cell p-alist)
  20103 	    (org-element-put-property
  20104 	     split-ts
  20105 	     (funcall (if end #'car #'cdr) p-cell)
  20106 	     (org-element-property
  20107 	      (funcall (if end #'cdr #'car) p-cell) split-ts)))
  20108 	  ;; Eventually refresh `:raw-value'.
  20109 	  (org-element-put-property split-ts :raw-value nil)
  20110 	  (org-element-put-property
  20111 	   split-ts :raw-value (org-element-interpret-data split-ts)))))))
  20112 
  20113 (defun org-timestamp-translate (timestamp &optional boundary)
  20114   "Translate TIMESTAMP object to custom format.
  20115 
  20116 Format string is defined in `org-time-stamp-custom-formats',
  20117 which see.
  20118 
  20119 When optional argument BOUNDARY is non-nil, it is either the
  20120 symbol `start' or `end'.  In this case, only translate the
  20121 starting or ending part of TIMESTAMP if it is a date or time
  20122 range.  Otherwise, translate both parts.
  20123 
  20124 Return timestamp as-is if `org-display-custom-times' is nil or if
  20125 it has a `diary' type."
  20126   (let ((type (org-element-property :type timestamp)))
  20127     (if (or (not org-display-custom-times) (eq type 'diary))
  20128 	(org-element-interpret-data timestamp)
  20129       (let ((fmt (funcall (if (org-timestamp-has-time-p timestamp) #'cdr #'car)
  20130 			  org-time-stamp-custom-formats)))
  20131 	(if (and (not boundary) (memq type '(active-range inactive-range)))
  20132 	    (concat (org-timestamp-format timestamp fmt)
  20133 		    "--"
  20134 		    (org-timestamp-format timestamp fmt t))
  20135 	  (org-timestamp-format timestamp fmt (eq boundary 'end)))))))
  20136 
  20137 ;;; Other stuff
  20138 
  20139 (defvar reftex-docstruct-symbol)
  20140 (defvar org--rds)
  20141 
  20142 (defun org-reftex-citation ()
  20143   "Use `reftex-citation' to insert a citation into the buffer.
  20144 This looks for a line like
  20145 
  20146 #+BIBLIOGRAPHY: foo plain option:-d
  20147 
  20148 and derives from it that foo.bib is the bibliography file relevant
  20149 for this document.  It then installs the necessary environment for RefTeX
  20150 to work in this buffer and calls `reftex-citation'  to insert a citation
  20151 into the buffer.
  20152 
  20153 Export of such citations to both LaTeX and HTML is handled by the contributed
  20154 package ox-bibtex by Taru Karttunen."
  20155   (interactive)
  20156   (let ((reftex-docstruct-symbol 'org--rds)
  20157 	org--rds bib)
  20158     (org-with-wide-buffer
  20159      (let ((case-fold-search t)
  20160 	   (re "^[ \t]*#\\+BIBLIOGRAPHY:[ \t]+\\([^ \t\n]+\\)"))
  20161        (if (not (save-excursion
  20162 		  (or (re-search-forward re nil t)
  20163 		      (re-search-backward re nil t))))
  20164 	   (user-error "No bibliography defined in file")
  20165 	 (setq bib (concat (match-string 1) ".bib")
  20166 	       org--rds (list (list 'bib bib))))))
  20167     (call-interactively 'reftex-citation)))
  20168 
  20169 ;;;; Functions extending outline functionality
  20170 
  20171 (defun org-beginning-of-line (&optional n)
  20172   "Go to the beginning of the current visible line.
  20173 
  20174 If this is a headline, and `org-special-ctrl-a/e' is not nil or
  20175 symbol `reversed', on the first attempt move to where the
  20176 headline text starts, and only move to beginning of line when the
  20177 cursor is already before the start of the text of the headline.
  20178 
  20179 If `org-special-ctrl-a/e' is symbol `reversed' then go to the
  20180 start of the text on the second attempt.
  20181 
  20182 With argument N not nil or 1, move forward N - 1 lines first."
  20183   (interactive "^p")
  20184   (let ((origin (point))
  20185 	(special (pcase org-special-ctrl-a/e
  20186 		   (`(,C-a . ,_) C-a) (_ org-special-ctrl-a/e)))
  20187 	deactivate-mark)
  20188     ;; First move to a visible line.
  20189     (if (bound-and-true-p visual-line-mode)
  20190 	(beginning-of-visual-line n)
  20191       (move-beginning-of-line n)
  20192       ;; `move-beginning-of-line' may leave point after invisible
  20193       ;; characters if line starts with such of these (e.g., with
  20194       ;; a link at column 0).  Really move to the beginning of the
  20195       ;; current visible line.
  20196       (beginning-of-line))
  20197     (cond
  20198      ;; No special behavior.  Point is already at the beginning of
  20199      ;; a line, logical or visual.
  20200      ((not special))
  20201      ;; `beginning-of-visual-line' left point before logical beginning
  20202      ;; of line: point is at the beginning of a visual line.  Bail
  20203      ;; out.
  20204      ((and (bound-and-true-p visual-line-mode) (not (bolp))))
  20205      ((let ((case-fold-search nil)) (looking-at org-complex-heading-regexp))
  20206       ;; At a headline, special position is before the title, but
  20207       ;; after any TODO keyword or priority cookie.
  20208       (let ((refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1)))
  20209 			 (line-end-position)))
  20210 	    (bol (point)))
  20211 	(if (eq special 'reversed)
  20212 	    (when (and (= origin bol) (eq last-command this-command))
  20213 	      (goto-char refpos))
  20214 	  (when (or (> origin refpos) (= origin bol))
  20215 	    (goto-char refpos)))))
  20216      ((and (looking-at org-list-full-item-re)
  20217 	   (memq (org-element-type (save-match-data (org-element-at-point)))
  20218 		 '(item plain-list)))
  20219       ;; Set special position at first white space character after
  20220       ;; bullet, and check-box, if any.
  20221       (let ((after-bullet
  20222 	     (let ((box (match-end 3)))
  20223 	       (cond ((not box) (match-end 1))
  20224 		     ((eq (char-after box) ?\s) (1+ box))
  20225 		     (t box)))))
  20226 	(if (eq special 'reversed)
  20227 	    (when (and (= (point) origin) (eq last-command this-command))
  20228 	      (goto-char after-bullet))
  20229 	  (when (or (> origin after-bullet) (= (point) origin))
  20230 	    (goto-char after-bullet)))))
  20231      ;; No special context.  Point is already at beginning of line.
  20232      (t nil))))
  20233 
  20234 (defun org-end-of-line (&optional n)
  20235   "Go to the end of the line, but before ellipsis, if any.
  20236 
  20237 If this is a headline, and `org-special-ctrl-a/e' is not nil or
  20238 symbol `reversed', ignore tags on the first attempt, and only
  20239 move to after the tags when the cursor is already beyond the end
  20240 of the headline.
  20241 
  20242 If `org-special-ctrl-a/e' is symbol `reversed' then ignore tags
  20243 on the second attempt.
  20244 
  20245 With argument N not nil or 1, move forward N - 1 lines first."
  20246   (interactive "^p")
  20247   (let ((origin (point))
  20248 	(special (pcase org-special-ctrl-a/e
  20249 		   (`(,_ . ,C-e) C-e) (_ org-special-ctrl-a/e)))
  20250 	deactivate-mark)
  20251     ;; First move to a visible line.
  20252     (if (bound-and-true-p visual-line-mode)
  20253 	(beginning-of-visual-line n)
  20254       (move-beginning-of-line n))
  20255     (cond
  20256      ;; At a headline, with tags.
  20257      ((and special
  20258 	   (save-excursion
  20259 	     (beginning-of-line)
  20260 	     (let ((case-fold-search nil))
  20261 	       (looking-at org-complex-heading-regexp)))
  20262 	   (match-end 5))
  20263       (let ((tags (save-excursion
  20264 		    (goto-char (match-beginning 5))
  20265 		    (skip-chars-backward " \t")
  20266 		    (point)))
  20267 	    (visual-end (and (bound-and-true-p visual-line-mode)
  20268 			     (save-excursion
  20269 			       (end-of-visual-line)
  20270 			       (point)))))
  20271 	;; If `end-of-visual-line' brings us before end of line or
  20272 	;; even tags, i.e., the headline spans over multiple visual
  20273 	;; lines, move there.
  20274 	(cond ((and visual-end
  20275 		    (< visual-end tags)
  20276 		    (<= origin visual-end))
  20277 	       (goto-char visual-end))
  20278 	      ((eq special 'reversed)
  20279 	       (if (and (= origin (line-end-position))
  20280 			(eq this-command last-command))
  20281 		   (goto-char tags)
  20282 		 (end-of-line)))
  20283 	      (t
  20284 	       (if (or (< origin tags) (= origin (line-end-position)))
  20285 		   (goto-char tags)
  20286 		 (end-of-line))))))
  20287      ((bound-and-true-p visual-line-mode)
  20288       (let ((bol (line-beginning-position)))
  20289 	(end-of-visual-line)
  20290 	;; If `end-of-visual-line' gets us past the ellipsis at the
  20291 	;; end of a line, backtrack and use `end-of-line' instead.
  20292 	(when (/= bol (line-beginning-position))
  20293 	  (goto-char bol)
  20294 	  (end-of-line))))
  20295      (t (end-of-line)))))
  20296 
  20297 (defun org-backward-sentence (&optional _arg)
  20298   "Go to beginning of sentence, or beginning of table field.
  20299 This will call `backward-sentence' or `org-table-beginning-of-field',
  20300 depending on context."
  20301   (interactive)
  20302   (let* ((element (org-element-at-point))
  20303 	 (contents-begin (org-element-property :contents-begin element))
  20304 	 (table (org-element-lineage element '(table) t)))
  20305     (if (and table
  20306 	     (> (point) contents-begin)
  20307 	     (<= (point) (org-element-property :contents-end table)))
  20308 	(call-interactively #'org-table-beginning-of-field)
  20309       (save-restriction
  20310 	(when (and contents-begin
  20311 		   (< (point-min) contents-begin)
  20312 		   (> (point) contents-begin))
  20313 	  (narrow-to-region contents-begin
  20314 			    (org-element-property :contents-end element)))
  20315 	(call-interactively #'backward-sentence)))))
  20316 
  20317 (defun org-forward-sentence (&optional _arg)
  20318   "Go to end of sentence, or end of table field.
  20319 This will call `forward-sentence' or `org-table-end-of-field',
  20320 depending on context."
  20321   (interactive)
  20322   (if (and (org-at-heading-p)
  20323 	   (save-restriction (skip-chars-forward " \t") (not (eolp))))
  20324       (save-restriction
  20325 	(narrow-to-region (line-beginning-position) (line-end-position))
  20326 	(call-interactively #'forward-sentence))
  20327     (let* ((element (org-element-at-point))
  20328 	   (contents-end (org-element-property :contents-end element))
  20329 	   (table (org-element-lineage element '(table) t)))
  20330       (if (and table
  20331 	       (>= (point) (org-element-property :contents-begin table))
  20332 	       (< (point) contents-end))
  20333 	  (call-interactively #'org-table-end-of-field)
  20334 	(save-restriction
  20335 	  (when (and contents-end
  20336 		     (> (point-max) contents-end)
  20337 		     ;; Skip blank lines between elements.
  20338 		     (< (org-element-property :end element)
  20339 			(save-excursion (goto-char contents-end)
  20340 					(skip-chars-forward " \r\t\n"))))
  20341 	    (narrow-to-region (org-element-property :contents-begin element)
  20342 			      contents-end))
  20343 	  ;; End of heading is considered as the end of a sentence.
  20344 	  (let ((sentence-end (concat (sentence-end) "\\|^\\*+ .*$")))
  20345 	    (call-interactively #'forward-sentence)))))))
  20346 
  20347 (defun org-kill-line (&optional _arg)
  20348   "Kill line, to tags or end of line."
  20349   (interactive)
  20350   (cond
  20351    ((or (not org-special-ctrl-k)
  20352 	(bolp)
  20353 	(not (org-at-heading-p)))
  20354     (when (and (get-char-property (line-end-position) 'invisible)
  20355 	       org-ctrl-k-protect-subtree
  20356 	       (or (eq org-ctrl-k-protect-subtree 'error)
  20357 		   (not (y-or-n-p "Kill hidden subtree along with headline? "))))
  20358       (user-error
  20359        (substitute-command-keys
  20360 	"`\\[org-kill-line]' aborted as it would kill a hidden subtree")))
  20361     (call-interactively
  20362      (if (bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line)))
  20363    ((org-match-line org-tag-line-re)
  20364     (let ((end (save-excursion
  20365 		 (goto-char (match-beginning 1))
  20366 		 (skip-chars-backward " \t")
  20367 		 (point))))
  20368       (if (<= end (point))		;on tags part
  20369 	  (kill-region (point) (line-end-position))
  20370 	(kill-region (point) end)))
  20371     ;; Only align tags when we are still on a heading:
  20372     (if (org-at-heading-p) (org-align-tags)))
  20373    (t (kill-region (point) (line-end-position)))))
  20374 
  20375 (defun org-yank (&optional arg)
  20376   "Yank.  If the kill is a subtree, treat it specially.
  20377 This command will look at the current kill and check if is a single
  20378 subtree, or a series of subtrees[1].  If it passes the test, and if the
  20379 cursor is at the beginning of a line or after the stars of a currently
  20380 empty headline, then the yank is handled specially.  How exactly depends
  20381 on the value of the following variables.
  20382 
  20383 `org-yank-folded-subtrees'
  20384     By default, this variable is non-nil, which results in
  20385     subtree(s) being folded after insertion, except if doing so
  20386     would swallow text after the yanked text.
  20387 
  20388 `org-yank-adjusted-subtrees'
  20389     When non-nil (the default value is nil), the subtree will be
  20390     promoted or demoted in order to fit into the local outline tree
  20391     structure, which means that the level will be adjusted so that it
  20392     becomes the smaller one of the two *visible* surrounding headings.
  20393 
  20394 Any prefix to this command will cause `yank' to be called directly with
  20395 no special treatment.  In particular, a simple `\\[universal-argument]' prefix \
  20396 will just
  20397 plainly yank the text as it is.
  20398 
  20399 \[1] The test checks if the first non-white line is a heading
  20400     and if there are no other headings with fewer stars."
  20401   (interactive "P")
  20402   (org-yank-generic 'yank arg))
  20403 
  20404 (defun org-yank-generic (command arg)
  20405   "Perform some yank-like command.
  20406 
  20407 This function implements the behavior described in the `org-yank'
  20408 documentation.  However, it has been generalized to work for any
  20409 interactive command with similar behavior."
  20410 
  20411   ;; pretend to be command COMMAND
  20412   (setq this-command command)
  20413 
  20414   (if arg
  20415       (call-interactively command)
  20416 
  20417     (let ((subtreep ; is kill a subtree, and the yank position appropriate?
  20418 	   (and (org-kill-is-subtree-p)
  20419 		(or (bolp)
  20420 		    (and (looking-at "[ \t]*$")
  20421 			 (string-match
  20422 			  "\\`\\*+\\'"
  20423 			  (buffer-substring (point-at-bol) (point)))))))
  20424 	  swallowp)
  20425       (cond
  20426        ((and subtreep org-yank-folded-subtrees)
  20427 	(let ((beg (point))
  20428 	      end)
  20429 	  (if (and subtreep org-yank-adjusted-subtrees)
  20430 	      (org-paste-subtree nil nil 'for-yank)
  20431 	    (call-interactively command))
  20432 
  20433 	  (setq end (point))
  20434 	  (goto-char beg)
  20435 	  (when (and (bolp) subtreep
  20436 		     (not (setq swallowp
  20437 				(org-yank-folding-would-swallow-text beg end))))
  20438 	    (org-with-limited-levels
  20439 	     (or (looking-at org-outline-regexp)
  20440 		 (re-search-forward org-outline-regexp-bol end t))
  20441 	     (while (and (< (point) end) (looking-at org-outline-regexp))
  20442 	       (org-flag-subtree t)
  20443 	       (org-cycle-show-empty-lines 'folded)
  20444 	       (condition-case nil
  20445 		   (outline-forward-same-level 1)
  20446 		 (error (goto-char end))))))
  20447 	  (when swallowp
  20448 	    (message
  20449 	     "Inserted text not folded because that would swallow text"))
  20450 
  20451 	  (goto-char end)
  20452 	  (skip-chars-forward " \t\n\r")
  20453 	  (beginning-of-line 1)
  20454 	  (push-mark beg 'nomsg)))
  20455        ((and subtreep org-yank-adjusted-subtrees)
  20456 	(let ((beg (point-at-bol)))
  20457 	  (org-paste-subtree nil nil 'for-yank)
  20458 	  (push-mark beg 'nomsg)))
  20459        (t
  20460 	(call-interactively command))))))
  20461 
  20462 (defun org-yank-folding-would-swallow-text (beg end)
  20463   "Would `hide-subtree' at BEG swallow any text after END?"
  20464   (let (level)
  20465     (org-with-limited-levels
  20466      (save-excursion
  20467        (goto-char beg)
  20468        (when (or (looking-at org-outline-regexp)
  20469 		 (re-search-forward org-outline-regexp-bol end t))
  20470 	 (setq level (org-outline-level)))
  20471        (goto-char end)
  20472        (skip-chars-forward " \t\r\n\v\f")
  20473        (not (or (eobp)
  20474 		(and (bolp) (looking-at-p org-outline-regexp)
  20475 		     (<= (org-outline-level) level))))))))
  20476 
  20477 (defun org-back-to-heading (&optional invisible-ok)
  20478   "Call `outline-back-to-heading', but provide a better error message."
  20479   (condition-case nil
  20480       (outline-back-to-heading invisible-ok)
  20481     (error
  20482      (user-error "Before first headline at position %d in buffer %s"
  20483 		 (point) (current-buffer)))))
  20484 
  20485 (defun org-back-to-heading-or-point-min (&optional invisible-ok)
  20486   "Go back to heading or first point in buffer.
  20487 If point is before first heading go to first point in buffer
  20488 instead of back to heading."
  20489   (condition-case nil
  20490       (outline-back-to-heading invisible-ok)
  20491     (error
  20492      (goto-char (point-min)))))
  20493 
  20494 (defun org-before-first-heading-p ()
  20495   "Before first heading?"
  20496   (org-with-limited-levels
  20497    (save-excursion
  20498      (end-of-line)
  20499      (null (re-search-backward org-outline-regexp-bol nil t)))))
  20500 
  20501 (defun org-at-heading-p (&optional _)
  20502   "Non-nil when on a headline."
  20503   (outline-on-heading-p t))
  20504 
  20505 (defun org-in-commented-heading-p (&optional no-inheritance)
  20506   "Non-nil if point is under a commented heading.
  20507 This function also checks ancestors of the current headline,
  20508 unless optional argument NO-INHERITANCE is non-nil."
  20509   (cond
  20510    ((org-before-first-heading-p) nil)
  20511    ((let ((headline (nth 4 (org-heading-components))))
  20512       (and headline
  20513 	   (let ((case-fold-search nil))
  20514 	     (string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)")
  20515 			     headline)))))
  20516    (no-inheritance nil)
  20517    (t
  20518     (save-excursion (and (org-up-heading-safe) (org-in-commented-heading-p))))))
  20519 
  20520 (defun org-in-archived-heading-p (&optional no-inheritance)
  20521   "Non-nil if point is under an archived heading.
  20522 This function also checks ancestors of the current headline,
  20523 unless optional argument NO-INHERITANCE is non-nil."
  20524   (cond
  20525    ((org-before-first-heading-p) nil)
  20526    ((let ((tags (org-get-tags nil 'local)))
  20527       (and tags
  20528 	   (cl-some (apply-partially #'string= org-archive-tag) tags))))
  20529    (no-inheritance nil)
  20530    (t
  20531     (save-excursion (and (org-up-heading-safe) (org-in-archived-heading-p))))))
  20532 
  20533 (defun org-at-comment-p nil
  20534   "Return t if cursor is in a commented line."
  20535   (save-excursion
  20536     (save-match-data
  20537       (beginning-of-line)
  20538       (looking-at org-comment-regexp))))
  20539 
  20540 (defun org-at-keyword-p nil
  20541   "Return t if cursor is at a keyword-line."
  20542   (save-excursion
  20543     (move-beginning-of-line 1)
  20544     (looking-at org-keyword-regexp)))
  20545 
  20546 (defun org-at-drawer-p nil
  20547   "Return t if cursor is at a drawer keyword."
  20548   (save-excursion
  20549     (move-beginning-of-line 1)
  20550     (looking-at org-drawer-regexp)))
  20551 
  20552 (defun org-at-block-p nil
  20553   "Return t if cursor is at a block keyword."
  20554   (save-excursion
  20555     (move-beginning-of-line 1)
  20556     (looking-at org-block-regexp)))
  20557 
  20558 (defun org-point-at-end-of-empty-headline ()
  20559   "If point is at the end of an empty headline, return t, else nil.
  20560 If the heading only contains a TODO keyword, it is still considered
  20561 empty."
  20562   (let ((case-fold-search nil))
  20563     (and (looking-at "[ \t]*$")
  20564 	 org-todo-line-regexp
  20565 	 (save-excursion
  20566 	   (beginning-of-line)
  20567 	   (looking-at org-todo-line-regexp)
  20568 	   (string= (match-string 3) "")))))
  20569 
  20570 (defun org-at-heading-or-item-p ()
  20571   (or (org-at-heading-p) (org-at-item-p)))
  20572 
  20573 (defun org-up-heading-all (arg)
  20574   "Move to the heading line of which the present line is a subheading.
  20575 This function considers both visible and invisible heading lines.
  20576 With argument, move up ARG levels."
  20577   (outline-up-heading arg t))
  20578 
  20579 (defvar-local org--up-heading-cache nil
  20580   "Buffer-local `org-up-heading-safe' cache.")
  20581 (defvar-local org--up-heading-cache-tick nil
  20582   "Buffer `buffer-chars-modified-tick' in `org--up-heading-cache'.")
  20583 (defun org-up-heading-safe ()
  20584   "Move to the heading line of which the present line is a subheading.
  20585 This version will not throw an error.  It will return the level of the
  20586 headline found, or nil if no higher level is found.
  20587 
  20588 Also, this function will be a lot faster than `outline-up-heading',
  20589 because it relies on stars being the outline starters.  This can really
  20590 make a significant difference in outlines with very many siblings."
  20591   (when (ignore-errors (org-back-to-heading t))
  20592     (let (level-cache)
  20593       (unless org--up-heading-cache
  20594         (setq org--up-heading-cache (make-hash-table)))
  20595       (if (and (eq (buffer-chars-modified-tick) org--up-heading-cache-tick)
  20596                (setq level-cache (gethash (point) org--up-heading-cache)))
  20597           (when (<= (point-min) (car level-cache) (point-max))
  20598             ;; Parent is inside accessible part of the buffer.
  20599             (progn (goto-char (car level-cache))
  20600                    (cdr level-cache)))
  20601         ;; Buffer modified.  Invalidate cache.
  20602         (unless (eq (buffer-chars-modified-tick) org--up-heading-cache-tick)
  20603           (setq-local org--up-heading-cache-tick
  20604                       (buffer-chars-modified-tick))
  20605           (clrhash org--up-heading-cache))
  20606         (let* ((level-up (1- (funcall outline-level)))
  20607                (pos (point))
  20608                (result (and (> level-up 0)
  20609 	                    (re-search-backward
  20610                              (format "^\\*\\{1,%d\\} " level-up) nil t)
  20611 	                    (funcall outline-level))))
  20612           (when result (puthash pos (cons (point) result) org--up-heading-cache))
  20613           result)))))
  20614 
  20615 (defun org-up-heading-or-point-min ()
  20616   "Move to the heading line of which the present is a subheading, or point-min.
  20617 This version is needed to make point-min behave like a virtual
  20618 heading of level 0 for property-inheritance.  It will return the
  20619 level of the headline found (down to 0) or nil if already at a
  20620 point before the first headline or at point-min."
  20621   (when (ignore-errors (org-back-to-heading t))
  20622     (if (< 1 (funcall outline-level))
  20623 	(org-up-heading-safe)
  20624       (unless (= (point) (point-min)) (goto-char (point-min))))))
  20625 
  20626 (defun org-first-sibling-p ()
  20627   "Is this heading the first child of its parents?"
  20628   (interactive)
  20629   (let ((re org-outline-regexp-bol)
  20630 	level l)
  20631     (unless (org-at-heading-p t)
  20632       (user-error "Not at a heading"))
  20633     (setq level (funcall outline-level))
  20634     (save-excursion
  20635       (if (not (re-search-backward re nil t))
  20636 	  t
  20637 	(setq l (funcall outline-level))
  20638 	(< l level)))))
  20639 
  20640 (defun org-goto-sibling (&optional previous)
  20641   "Goto the next sibling, even if it is invisible.
  20642 When PREVIOUS is set, go to the previous sibling instead.  Returns t
  20643 when a sibling was found.  When none is found, return nil and don't
  20644 move point."
  20645   (let ((fun (if previous 're-search-backward 're-search-forward))
  20646 	(pos (point))
  20647 	(re org-outline-regexp-bol)
  20648 	level l)
  20649     (when (ignore-errors (org-back-to-heading t))
  20650       (setq level (funcall outline-level))
  20651       (catch 'exit
  20652 	(or previous (forward-char 1))
  20653 	(while (funcall fun re nil t)
  20654 	  (setq l (funcall outline-level))
  20655 	  (when (< l level) (goto-char pos) (throw 'exit nil))
  20656 	  (when (= l level) (goto-char (match-beginning 0)) (throw 'exit t)))
  20657 	(goto-char pos)
  20658 	nil))))
  20659 
  20660 (defun org-show-siblings ()
  20661   "Show all siblings of the current headline."
  20662   (save-excursion
  20663     (while (org-goto-sibling) (org-flag-heading nil)))
  20664   (save-excursion
  20665     (while (org-goto-sibling 'previous)
  20666       (org-flag-heading nil))))
  20667 
  20668 (defun org-goto-first-child ()
  20669   "Goto the first child, even if it is invisible.
  20670 Return t when a child was found.  Otherwise don't move point and
  20671 return nil."
  20672   (let (level (pos (point)) (re org-outline-regexp-bol))
  20673     (when (org-back-to-heading-or-point-min t)
  20674       (setq level (org-outline-level))
  20675       (forward-char 1)
  20676       (if (and (re-search-forward re nil t) (> (org-outline-level) level))
  20677 	  (progn (goto-char (match-beginning 0)) t)
  20678 	(goto-char pos) nil))))
  20679 
  20680 (defun org-show-hidden-entry ()
  20681   "Show an entry where even the heading is hidden."
  20682   (save-excursion
  20683     (org-show-entry)))
  20684 
  20685 (defun org-flag-heading (flag &optional entry)
  20686   "Flag the current heading.  FLAG non-nil means make invisible.
  20687 When ENTRY is non-nil, show the entire entry."
  20688   (save-excursion
  20689     (org-back-to-heading t)
  20690     ;; Check if we should show the entire entry
  20691     (if (not entry)
  20692 	(org-flag-region
  20693 	 (line-end-position 0) (line-end-position) flag 'outline)
  20694       (org-show-entry)
  20695       (save-excursion
  20696 	(and (outline-next-heading)
  20697 	     (org-flag-heading nil))))))
  20698 
  20699 (defun org-get-next-sibling ()
  20700   "Move to next heading of the same level, and return point.
  20701 If there is no such heading, return nil.
  20702 This is like outline-next-sibling, but invisible headings are ok."
  20703   (let ((level (funcall outline-level)))
  20704     (outline-next-heading)
  20705     (while (and (not (eobp)) (> (funcall outline-level) level))
  20706       (outline-next-heading))
  20707     (unless (or (eobp) (< (funcall outline-level) level))
  20708       (point))))
  20709 
  20710 (defun org-get-previous-sibling ()
  20711   "Move to previous heading of the same level, and return point.
  20712 If there is no such heading, return nil."
  20713   (let ((opoint (point))
  20714 	(level (funcall outline-level)))
  20715     (outline-previous-heading)
  20716     (when (and (/= (point) opoint) (outline-on-heading-p t))
  20717       (while (and (> (funcall outline-level) level)
  20718 		  (not (bobp)))
  20719 	(outline-previous-heading))
  20720       (unless (< (funcall outline-level) level)
  20721         (point)))))
  20722 
  20723 (defun org-end-of-subtree (&optional invisible-ok to-heading)
  20724   "Goto to the end of a subtree."
  20725   ;; This contains an exact copy of the original function, but it uses
  20726   ;; `org-back-to-heading-or-point-min', to make it work also in invisible
  20727   ;; trees and before first headline.  And is uses an invisible-ok argument.
  20728   ;; Under Emacs this is not needed, but the old outline.el needs this fix.
  20729   ;; Furthermore, when used inside Org, finding the end of a large subtree
  20730   ;; with many children and grandchildren etc, this can be much faster
  20731   ;; than the outline version.
  20732   (org-back-to-heading-or-point-min invisible-ok)
  20733   (let ((first t)
  20734 	(level (funcall outline-level)))
  20735     (cond ((= level 0)
  20736 	   (goto-char (point-max)))
  20737 	  ((and (derived-mode-p 'org-mode) (< level 1000))
  20738 	   ;; A true heading (not a plain list item), in Org
  20739 	   ;; This means we can easily find the end by looking
  20740 	   ;; only for the right number of stars.  Using a regexp to do
  20741 	   ;; this is so much faster than using a Lisp loop.
  20742 	   (let ((re (concat "^\\*\\{1," (number-to-string level) "\\} ")))
  20743 	     (forward-char 1)
  20744 	     (and (re-search-forward re nil 'move) (beginning-of-line 1))))
  20745 	  (t
  20746 	   ;; something else, do it the slow way
  20747 	   (while (and (not (eobp))
  20748 		       (or first (> (funcall outline-level) level)))
  20749 	     (setq first nil)
  20750 	     (outline-next-heading))))
  20751     (unless to-heading
  20752       (when (memq (preceding-char) '(?\n ?\^M))
  20753 	;; Go to end of line before heading
  20754 	(forward-char -1)
  20755 	(when (memq (preceding-char) '(?\n ?\^M))
  20756 	  ;; leave blank line before heading
  20757 	  (forward-char -1)))))
  20758   (point))
  20759 
  20760 (defun org-end-of-meta-data (&optional full)
  20761   "Skip planning line and properties drawer in current entry.
  20762 
  20763 When optional argument FULL is t, also skip planning information,
  20764 clocking lines and any kind of drawer.
  20765 
  20766 When FULL is non-nil but not t, skip planning information,
  20767 properties, clocking lines and logbook drawers."
  20768   (org-back-to-heading t)
  20769   (forward-line)
  20770   ;; Skip planning information.
  20771   (when (looking-at-p org-planning-line-re) (forward-line))
  20772   ;; Skip property drawer.
  20773   (when (looking-at org-property-drawer-re)
  20774     (goto-char (match-end 0))
  20775     (forward-line))
  20776   ;; When FULL is not nil, skip more.
  20777   (when (and full (not (org-at-heading-p)))
  20778     (catch 'exit
  20779       (let ((end (save-excursion (outline-next-heading) (point)))
  20780 	    (re (concat "[ \t]*$" "\\|" org-clock-line-re)))
  20781 	(while (not (eobp))
  20782 	  (cond ;; Skip clock lines.
  20783 	   ((looking-at-p re) (forward-line))
  20784 	   ;; Skip logbook drawer.
  20785 	   ((looking-at-p org-logbook-drawer-re)
  20786 	    (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t)
  20787 		(forward-line)
  20788 	      (throw 'exit t)))
  20789 	   ;; When FULL is t, skip regular drawer too.
  20790 	   ((and (eq full t) (looking-at-p org-drawer-regexp))
  20791 	    (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t)
  20792 		(forward-line)
  20793 	      (throw 'exit t)))
  20794 	   (t (throw 'exit t))))))))
  20795 
  20796 (defun org--line-fully-invisible-p ()
  20797   "Return non-nil if the current line is fully invisible."
  20798   (let ((line-beg (line-beginning-position))
  20799 	(line-pos (1- (line-end-position)))
  20800 	(is-invisible t))
  20801     (while (and (< line-beg line-pos) is-invisible)
  20802       (setq is-invisible (org-invisible-p line-pos))
  20803       (setq line-pos (1- line-pos)))
  20804     is-invisible))
  20805 
  20806 (defun org-forward-heading-same-level (arg &optional invisible-ok)
  20807   "Move forward to the ARG'th subheading at same level as this one.
  20808 Stop at the first and last subheadings of a superior heading.
  20809 Normally this only looks at visible headings, but when INVISIBLE-OK is
  20810 non-nil it will also look at invisible ones."
  20811   (interactive "p")
  20812   (let ((backward? (and arg (< arg 0))))
  20813     (if (org-before-first-heading-p)
  20814 	(if backward? (goto-char (point-min)) (outline-next-heading))
  20815       (org-back-to-heading invisible-ok)
  20816       (unless backward? (end-of-line))	;do not match current headline
  20817       (let ((level (- (match-end 0) (match-beginning 0) 1))
  20818 	    (f (if backward? #'re-search-backward #'re-search-forward))
  20819 	    (count (if arg (abs arg) 1))
  20820 	    (result (point)))
  20821 	(while (and (> count 0)
  20822 		    (funcall f org-outline-regexp-bol nil 'move))
  20823 	  (let ((l (- (match-end 0) (match-beginning 0) 1)))
  20824 	    (cond ((< l level) (setq count 0))
  20825 		  ((and (= l level)
  20826 			(or invisible-ok
  20827 			    ;; FIXME: See commit a700fadd72 and the
  20828 			    ;; related discussion on why using
  20829 			    ;; `org--line-fully-invisible-p' is needed
  20830 			    ;; here, which is to serve the needs of an
  20831 			    ;; external package.  If the change is
  20832 			    ;; wrong regarding Org itself, it should
  20833 			    ;; be removed.
  20834 			    (not (org--line-fully-invisible-p))))
  20835 		   (cl-decf count)
  20836 		   (when (= l level) (setq result (point)))))))
  20837 	(goto-char result))
  20838       (beginning-of-line))))
  20839 
  20840 (defun org-backward-heading-same-level (arg &optional invisible-ok)
  20841   "Move backward to the ARG'th subheading at same level as this one.
  20842 Stop at the first and last subheadings of a superior heading."
  20843   (interactive "p")
  20844   (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok))
  20845 
  20846 (defun org-next-visible-heading (arg)
  20847   "Move to the next visible heading line.
  20848 With ARG, repeats or can move backward if negative."
  20849   (interactive "p")
  20850   (let ((regexp (concat "^" (org-get-limited-outline-regexp))))
  20851     (if (< arg 0)
  20852 	(beginning-of-line)
  20853       (end-of-line))
  20854     (while (and (< arg 0) (re-search-backward regexp nil :move))
  20855       (unless (bobp)
  20856 	(while (pcase (get-char-property-and-overlay (point) 'invisible)
  20857 		 (`(outline . ,o)
  20858 		  (goto-char (overlay-start o))
  20859 		  (re-search-backward regexp nil :move))
  20860 		 (_ nil))))
  20861       (cl-incf arg))
  20862     (while (and (> arg 0) (re-search-forward regexp nil t))
  20863       (while (pcase (get-char-property-and-overlay (point) 'invisible)
  20864 	       (`(outline . ,o)
  20865 		(goto-char (overlay-end o))
  20866 		(re-search-forward regexp nil :move))
  20867 	       (_
  20868 		(end-of-line)
  20869 		nil)))			;leave the loop
  20870       (cl-decf arg))
  20871     (if (> arg 0) (goto-char (point-max)) (beginning-of-line))))
  20872 
  20873 (defun org-previous-visible-heading (arg)
  20874   "Move to the previous visible heading.
  20875 With ARG, repeats or can move forward if negative."
  20876   (interactive "p")
  20877   (org-next-visible-heading (- arg)))
  20878 
  20879 (defun org-forward-paragraph (&optional arg)
  20880   "Move forward by a paragraph, or equivalent, unit.
  20881 
  20882 With argument ARG, do it ARG times;
  20883 a negative argument ARG = -N means move backward N paragraphs.
  20884 
  20885 The function moves point between two structural
  20886 elements (paragraphs, tables, lists, etc.).
  20887 
  20888 It also provides the following special moves for convenience:
  20889 
  20890   - on a table or a property drawer, move to its beginning;
  20891   - on comment, example, export, source and verse blocks, stop
  20892     at blank lines;
  20893   - skip consecutive clocks, diary S-exps, and keywords."
  20894   (interactive "^p")
  20895   (unless arg (setq arg 1))
  20896   (if (< arg 0) (org-backward-paragraph (- arg))
  20897     (while (and (> arg 0) (not (eobp)))
  20898       (org--forward-paragraph-once)
  20899       (cl-decf arg))
  20900     ;; Return moves left.
  20901     arg))
  20902 
  20903 (defun org-backward-paragraph (&optional arg)
  20904   "Move backward by a paragraph, or equivalent, unit.
  20905 
  20906 With argument ARG, do it ARG times;
  20907 a negative argument ARG = -N means move forward N paragraphs.
  20908 
  20909 The function moves point between two structural
  20910 elements (paragraphs, tables, lists, etc.).
  20911 
  20912 It also provides the following special moves for convenience:
  20913 
  20914   - on a table or a property drawer, move to its beginning;
  20915   - on comment, example, export, source and verse blocks, stop
  20916     at blank lines;
  20917   - skip consecutive clocks, diary S-exps, and keywords."
  20918   (interactive "^p")
  20919   (unless arg (setq arg 1))
  20920   (if (< arg 0) (org-forward-paragraph (- arg))
  20921     (while (and (> arg 0) (not (bobp)))
  20922       (org--backward-paragraph-once)
  20923       (cl-decf arg))
  20924     ;; Return moves left.
  20925     arg))
  20926 
  20927 (defun org--paragraph-at-point ()
  20928   "Return paragraph, or equivalent, element at point.
  20929 
  20930 Paragraph element at point is the element at point, with the
  20931 following special cases:
  20932 
  20933 - treat table rows (resp. node properties) as the table
  20934   \(resp. property drawer) containing them.
  20935 
  20936 - treat plain lists with an item every line as a whole.
  20937 
  20938 - treat consecutive keywords, clocks, and diary-sexps as a single
  20939   block.
  20940 
  20941 Function may return a real element, or a pseudo-element with type
  20942 `pseudo-paragraph'."
  20943   (let* ((e (org-element-at-point))
  20944 	 (type (org-element-type e))
  20945 	 ;; If we need to fake a new pseudo-element, triplet is
  20946 	 ;;
  20947 	 ;;   (BEG END PARENT)
  20948 	 ;;
  20949 	 ;; where BEG and END are element boundaries, and PARENT the
  20950 	 ;; element containing it, or nil.
  20951 	 (triplet
  20952 	  (cond
  20953 	   ((memq type '(table property-drawer))
  20954 	    (list (org-element-property :begin e)
  20955 		  (org-element-property :end e)
  20956 		  (org-element-property :parent e)))
  20957 	   ((memq type '(node-property table-row))
  20958 	    (let ((e (org-element-property :parent e)))
  20959 	      (list (org-element-property :begin e)
  20960 		    (org-element-property :end e)
  20961 		    (org-element-property :parent e))))
  20962 	   ((memq type '(clock diary-sexp keyword))
  20963 	    (let* ((regexp (pcase type
  20964 			     (`clock org-clock-line-re)
  20965 			     (`diary-sexp "%%(")
  20966 			     (_ org-keyword-regexp)))
  20967 		   (end (if (< 0 (org-element-property :post-blank e))
  20968 			    (org-element-property :end e)
  20969 			  (org-with-wide-buffer
  20970 			   (forward-line)
  20971 			   (while (looking-at regexp) (forward-line))
  20972 			   (skip-chars-forward " \t\n")
  20973 			   (line-beginning-position))))
  20974 		   (begin (org-with-point-at (org-element-property :begin e)
  20975 			    (while (and (not (bobp)) (looking-at regexp))
  20976 			      (forward-line -1))
  20977 			    ;; We may have gotten one line too far.
  20978 			    (if (looking-at regexp)
  20979 				(point)
  20980 			      (line-beginning-position 2)))))
  20981 	      (list begin end (org-element-property :parent e))))
  20982 	   ;; Find the full plain list containing point, the check it
  20983 	   ;; contains exactly one line per item.
  20984 	   ((let ((l (org-element-lineage e '(plain-list) t)))
  20985 	      (while (memq (org-element-type (org-element-property :parent l))
  20986 			   '(item plain-list))
  20987 		(setq l (org-element-property :parent l)))
  20988 	      (and l
  20989 		   (org-with-point-at (org-element-property :post-affiliated l)
  20990 		     (forward-line (length (org-element-property :structure l)))
  20991 		     (= (point) (org-element-property :contents-end l)))
  20992 		   ;; Return value.
  20993 		   (list (org-element-property :begin l)
  20994 			 (org-element-property :end l)
  20995 			 (org-element-property :parent l)))))
  20996 	   (t nil))))			;no triplet: return element
  20997     (pcase triplet
  20998       (`(,b ,e ,p)
  20999        (org-element-create
  21000 	'pseudo-paragraph
  21001 	(list :begin b :end e :parent p :post-blank 0 :post-affiliated b)))
  21002       (_ e))))
  21003 
  21004 (defun org--forward-paragraph-once ()
  21005   "Move forward to end of paragraph or equivalent, once.
  21006 See `org-forward-paragraph'."
  21007   (interactive)
  21008   (save-restriction
  21009     (widen)
  21010     (skip-chars-forward " \t\n")
  21011     (cond
  21012      ((eobp) nil)
  21013      ;; When inside a folded part, move out of it.
  21014      ((pcase (get-char-property-and-overlay (point) 'invisible)
  21015 	(`(,(or `outline `org-hide-block) . ,o)
  21016 	 (goto-char (overlay-end o))
  21017 	 (forward-line)
  21018 	 t)
  21019 	(_ nil)))
  21020      (t
  21021       (let* ((element (org--paragraph-at-point))
  21022 	     (type (org-element-type element))
  21023 	     (contents-begin (org-element-property :contents-begin element))
  21024 	     (end (org-element-property :end element))
  21025 	     (post-affiliated (org-element-property :post-affiliated element)))
  21026 	(cond
  21027 	 ((eq type 'plain-list)
  21028 	  (forward-char)
  21029 	  (org--forward-paragraph-once))
  21030 	 ;; If the element is folded, skip it altogether.
  21031 	 ((pcase (org-with-point-at post-affiliated
  21032 		   (get-char-property-and-overlay (line-end-position)
  21033 						  'invisible))
  21034 	    (`(,(or `outline `org-hide-block) . ,o)
  21035 	     (goto-char (overlay-end o))
  21036 	     (forward-line)
  21037 	     t)
  21038 	    (_ nil)))
  21039 	 ;; At a greater element, move inside.
  21040 	 ((and contents-begin
  21041 	       (> contents-begin (point))
  21042 	       (not (eq type 'paragraph)))
  21043 	  (goto-char contents-begin)
  21044 	  ;; Items and footnote definitions contents may not start at
  21045 	  ;; the beginning of the line.  In this case, skip until the
  21046 	  ;; next paragraph.
  21047 	  (cond
  21048 	   ((not (bolp)) (org--forward-paragraph-once))
  21049 	   ((org-previous-line-empty-p) (forward-line -1))
  21050 	   (t nil)))
  21051 	 ;; Move between empty lines in some blocks.
  21052 	 ((memq type '(comment-block example-block export-block src-block
  21053 				     verse-block))
  21054 	  (let ((contents-start
  21055 		 (org-with-point-at post-affiliated
  21056 		   (line-beginning-position 2))))
  21057 	    (if (< (point) contents-start)
  21058 		(goto-char contents-start)
  21059 	      (let ((contents-end
  21060 		     (org-with-point-at end
  21061 		       (skip-chars-backward " \t\n")
  21062 		       (line-beginning-position))))
  21063 		(cond
  21064 		 ((>= (point) contents-end)
  21065 		  (goto-char end)
  21066 		  (skip-chars-backward " \t\n")
  21067 		  (forward-line))
  21068 		 ((re-search-forward "^[ \t]*\n" contents-end :move)
  21069 		  (forward-line -1))
  21070 		 (t nil))))))
  21071 	 (t
  21072 	  ;; Move to element's end.
  21073 	  (goto-char end)
  21074 	  (skip-chars-backward " \t\n")
  21075 	  (forward-line))))))))
  21076 
  21077 (defun org--backward-paragraph-once ()
  21078   "Move backward to start of paragraph or equivalent, once.
  21079 See `org-backward-paragraph'."
  21080   (interactive)
  21081   (save-restriction
  21082     (widen)
  21083     (cond
  21084      ((bobp) nil)
  21085      ;; Blank lines at the beginning of the buffer.
  21086      ((and (org-match-line "^[ \t]*$")
  21087 	   (save-excursion (skip-chars-backward " \t\n") (bobp)))
  21088       (goto-char (point-min)))
  21089      ;; When inside a folded part, move out of it.
  21090      ((pcase (get-char-property-and-overlay (1- (point)) 'invisible)
  21091 	(`(,(or `outline `org-hide-block) . ,o)
  21092 	 (goto-char (1- (overlay-start o)))
  21093 	 (org--backward-paragraph-once)
  21094 	 t)
  21095 	(_ nil)))
  21096      (t
  21097       (let* ((element (org--paragraph-at-point))
  21098 	     (type (org-element-type element))
  21099 	     (begin (org-element-property :begin element))
  21100 	     (post-affiliated (org-element-property :post-affiliated element))
  21101 	     (contents-end (org-element-property :contents-end element))
  21102 	     (end (org-element-property :end element))
  21103 	     (parent (org-element-property :parent element))
  21104 	     (reach
  21105 	      ;; Move to the visible empty line above position P, or
  21106 	      ;; to position P.  Return t.
  21107 	      (lambda (p)
  21108 		(goto-char p)
  21109 		(when (and (org-previous-line-empty-p)
  21110 			   (let ((end (line-end-position 0)))
  21111 			     (or (= end (point-min))
  21112 				 (not (org-invisible-p (1- end))))))
  21113 		  (forward-line -1))
  21114 		t)))
  21115 	(cond
  21116 	 ;; Already at the beginning of an element.
  21117 	 ((= begin (point))
  21118 	  (cond
  21119 	   ;; There is a blank line above.  Move there.
  21120 	   ((and (org-previous-line-empty-p)
  21121                  (let ((lep (line-end-position 0)))
  21122                    ;; When the first headline start at point 2, don't choke while
  21123                    ;; checking with `org-invisible-p'.
  21124                    (or (= lep 1)
  21125 		       (not (org-invisible-p (1- (line-end-position 0)))))))
  21126 	    (forward-line -1))
  21127 	   ;; At the beginning of the first element within a greater
  21128 	   ;; element.  Move to the beginning of the greater element.
  21129 	   ((and parent (= begin (org-element-property :contents-begin parent)))
  21130 	    (funcall reach (org-element-property :begin parent)))
  21131 	   ;; Since we have to move anyway, find the beginning
  21132 	   ;; position of the element above.
  21133 	   (t
  21134 	    (forward-char -1)
  21135 	    (org--backward-paragraph-once))))
  21136 	 ;; Skip paragraphs at the very beginning of footnote
  21137 	 ;; definitions or items.
  21138 	 ((and (eq type 'paragraph)
  21139 	       (org-with-point-at begin (not (bolp))))
  21140 	  (funcall reach (progn (goto-char begin) (line-beginning-position))))
  21141 	 ;; If the element is folded, skip it altogether.
  21142 	 ((org-with-point-at post-affiliated
  21143 	    (org-invisible-p (line-end-position) t))
  21144 	  (funcall reach begin))
  21145 	 ;; At the end of a greater element, move inside.
  21146 	 ((and contents-end
  21147 	       (<= contents-end (point))
  21148 	       (not (eq type 'paragraph)))
  21149 	  (cond
  21150 	   ((memq type '(footnote-definition plain-list))
  21151 	    (skip-chars-backward " \t\n")
  21152 	    (org--backward-paragraph-once))
  21153 	   ((= contents-end (point))
  21154 	    (forward-char -1)
  21155 	    (org--backward-paragraph-once))
  21156 	   (t
  21157 	    (goto-char contents-end))))
  21158 	 ;; Move between empty lines in some blocks.
  21159 	 ((and (memq type '(comment-block example-block export-block src-block
  21160 					  verse-block))
  21161 	       (let ((contents-start
  21162 		      (org-with-point-at post-affiliated
  21163 			(line-beginning-position 2))))
  21164 		 (when (> (point) contents-start)
  21165 		   (let ((contents-end
  21166 			  (org-with-point-at end
  21167 			    (skip-chars-backward " \t\n")
  21168 			    (line-beginning-position))))
  21169 		     (if (> (point) contents-end)
  21170 			 (progn (goto-char contents-end) t)
  21171 		       (skip-chars-backward " \t\n" begin)
  21172 		       (re-search-backward "^[ \t]*\n" contents-start :move)
  21173 		       t))))))
  21174 	 ;; Move to element's start.
  21175 	 (t
  21176 	  (funcall reach begin))))))))
  21177 
  21178 (defun org-forward-element ()
  21179   "Move forward by one element.
  21180 Move to the next element at the same level, when possible."
  21181   (interactive)
  21182   (cond ((eobp) (user-error "Cannot move further down"))
  21183 	((org-with-limited-levels (org-at-heading-p))
  21184 	 (let ((origin (point)))
  21185 	   (goto-char (org-end-of-subtree nil t))
  21186 	   (unless (org-with-limited-levels (org-at-heading-p))
  21187 	     (goto-char origin)
  21188 	     (user-error "Cannot move further down"))))
  21189 	(t
  21190 	 (let* ((elem (org-element-at-point))
  21191 		(end (org-element-property :end elem))
  21192 		(parent (org-element-property :parent elem)))
  21193 	   (cond ((and parent (= (org-element-property :contents-end parent) end))
  21194 		  (goto-char (org-element-property :end parent)))
  21195 		 ((integer-or-marker-p end) (goto-char end))
  21196 		 (t (message "No element at point")))))))
  21197 
  21198 (defun org-backward-element ()
  21199   "Move backward by one element.
  21200 Move to the previous element at the same level, when possible."
  21201   (interactive)
  21202   (cond ((bobp) (user-error "Cannot move further up"))
  21203 	((org-with-limited-levels (org-at-heading-p))
  21204 	 ;; At a headline, move to the previous one, if any, or stay
  21205 	 ;; here.
  21206 	 (let ((origin (point)))
  21207 	   (org-with-limited-levels (org-backward-heading-same-level 1))
  21208 	   ;; When current headline has no sibling above, move to its
  21209 	   ;; parent.
  21210 	   (when (= (point) origin)
  21211 	     (or (org-with-limited-levels (org-up-heading-safe))
  21212 		 (progn (goto-char origin)
  21213 			(user-error "Cannot move further up"))))))
  21214 	(t
  21215 	 (let* ((elem (org-element-at-point))
  21216 		(beg (org-element-property :begin elem)))
  21217 	   (cond
  21218 	    ;; Move to beginning of current element if point isn't
  21219 	    ;; there already.
  21220 	    ((null beg) (message "No element at point"))
  21221 	    ((/= (point) beg) (goto-char beg))
  21222 	    (t (goto-char beg)
  21223 	       (skip-chars-backward " \r\t\n")
  21224 	       (unless (bobp)
  21225 		 (let ((prev (org-element-at-point)))
  21226 		   (goto-char (org-element-property :begin prev))
  21227 		   (while (and (setq prev (org-element-property :parent prev))
  21228 			       (<= (org-element-property :end prev) beg))
  21229 		     (goto-char (org-element-property :begin prev)))))))))))
  21230 
  21231 (defun org-up-element ()
  21232   "Move to upper element."
  21233   (interactive)
  21234   (if (org-with-limited-levels (org-at-heading-p))
  21235       (unless (org-up-heading-safe) (user-error "No surrounding element"))
  21236     (let* ((elem (org-element-at-point))
  21237 	   (parent (org-element-property :parent elem)))
  21238       (if parent (goto-char (org-element-property :begin parent))
  21239 	(if (org-with-limited-levels (org-before-first-heading-p))
  21240 	    (user-error "No surrounding element")
  21241 	  (org-with-limited-levels (org-back-to-heading)))))))
  21242 
  21243 (defun org-down-element ()
  21244   "Move to inner element."
  21245   (interactive)
  21246   (let ((element (org-element-at-point)))
  21247     (cond
  21248      ((memq (org-element-type element) '(plain-list table))
  21249       (goto-char (org-element-property :contents-begin element))
  21250       (forward-char))
  21251      ((memq (org-element-type element) org-element-greater-elements)
  21252       ;; If contents are hidden, first disclose them.
  21253       (when (org-invisible-p (line-end-position)) (org-cycle))
  21254       (goto-char (or (org-element-property :contents-begin element)
  21255 		     (user-error "No content for this element"))))
  21256      (t (user-error "No inner element")))))
  21257 
  21258 (defun org-drag-element-backward ()
  21259   "Move backward element at point."
  21260   (interactive)
  21261   (let ((elem (or (org-element-at-point)
  21262 		  (user-error "No element at point"))))
  21263     (if (eq (org-element-type elem) 'headline)
  21264 	;; Preserve point when moving a whole tree, even if point was
  21265 	;; on blank lines below the headline.
  21266 	(let ((offset (skip-chars-backward " \t\n")))
  21267 	  (unwind-protect (org-move-subtree-up)
  21268 	    (forward-char (- offset))))
  21269       (let ((prev-elem
  21270 	     (save-excursion
  21271 	       (goto-char (org-element-property :begin elem))
  21272 	       (skip-chars-backward " \r\t\n")
  21273 	       (unless (bobp)
  21274 		 (let* ((beg (org-element-property :begin elem))
  21275 			(prev (org-element-at-point))
  21276 			(up prev))
  21277 		   (while (and (setq up (org-element-property :parent up))
  21278 			       (<= (org-element-property :end up) beg))
  21279 		     (setq prev up))
  21280 		   prev)))))
  21281 	;; Error out if no previous element or previous element is
  21282 	;; a parent of the current one.
  21283 	(if (or (not prev-elem) (org-element-nested-p elem prev-elem))
  21284 	    (user-error "Cannot drag element backward")
  21285 	  (let ((pos (point)))
  21286 	    (org-element-swap-A-B prev-elem elem)
  21287 	    (goto-char (+ (org-element-property :begin prev-elem)
  21288 			  (- pos (org-element-property :begin elem))))))))))
  21289 
  21290 (defun org-drag-element-forward ()
  21291   "Move forward element at point."
  21292   (interactive)
  21293   (let* ((pos (point))
  21294 	 (elem (or (org-element-at-point)
  21295 		   (user-error "No element at point"))))
  21296     (when (= (point-max) (org-element-property :end elem))
  21297       (user-error "Cannot drag element forward"))
  21298     (goto-char (org-element-property :end elem))
  21299     (let ((next-elem (org-element-at-point)))
  21300       (when (or (org-element-nested-p elem next-elem)
  21301 		(and (eq (org-element-type next-elem) 'headline)
  21302 		     (not (eq (org-element-type elem) 'headline))))
  21303 	(goto-char pos)
  21304 	(user-error "Cannot drag element forward"))
  21305       ;; Compute new position of point: it's shifted by NEXT-ELEM
  21306       ;; body's length (without final blanks) and by the length of
  21307       ;; blanks between ELEM and NEXT-ELEM.
  21308       (let ((size-next (- (save-excursion
  21309 			    (goto-char (org-element-property :end next-elem))
  21310 			    (skip-chars-backward " \r\t\n")
  21311 			    (forward-line)
  21312 			    ;; Small correction if buffer doesn't end
  21313 			    ;; with a newline character.
  21314 			    (if (and (eolp) (not (bolp))) (1+ (point)) (point)))
  21315 			  (org-element-property :begin next-elem)))
  21316 	    (size-blank (- (org-element-property :end elem)
  21317 			   (save-excursion
  21318 			     (goto-char (org-element-property :end elem))
  21319 			     (skip-chars-backward " \r\t\n")
  21320 			     (forward-line)
  21321 			     (point)))))
  21322 	(org-element-swap-A-B elem next-elem)
  21323 	(goto-char (+ pos size-next size-blank))))))
  21324 
  21325 (defun org-drag-line-forward (arg)
  21326   "Drag the line at point ARG lines forward."
  21327   (interactive "p")
  21328   (dotimes (_ (abs arg))
  21329     (let ((c (current-column)))
  21330       (if (< 0 arg)
  21331 	  (progn
  21332 	    (beginning-of-line 2)
  21333 	    (transpose-lines 1)
  21334 	    (beginning-of-line 0))
  21335 	(transpose-lines 1)
  21336 	(beginning-of-line -1))
  21337       (org-move-to-column c))))
  21338 
  21339 (defun org-drag-line-backward (arg)
  21340   "Drag the line at point ARG lines backward."
  21341   (interactive "p")
  21342   (org-drag-line-forward (- arg)))
  21343 
  21344 (defun org-mark-element ()
  21345   "Put point at beginning of this element, mark at end.
  21346 
  21347 Interactively, if this command is repeated or (in Transient Mark
  21348 mode) if the mark is active, it marks the next element after the
  21349 ones already marked."
  21350   (interactive)
  21351   (let (deactivate-mark)
  21352     (if (and (called-interactively-p 'any)
  21353 	     (or (and (eq last-command this-command) (mark t))
  21354 		 (and transient-mark-mode mark-active)))
  21355 	(set-mark
  21356 	 (save-excursion
  21357 	   (goto-char (mark))
  21358 	   (goto-char (org-element-property :end (org-element-at-point)))
  21359 	   (point)))
  21360       (let ((element (org-element-at-point)))
  21361 	(end-of-line)
  21362 	(push-mark (min (point-max) (org-element-property :end element)) t t)
  21363 	(goto-char (org-element-property :begin element))))))
  21364 
  21365 (defun org-narrow-to-element ()
  21366   "Narrow buffer to current element."
  21367   (interactive)
  21368   (let ((elem (org-element-at-point)))
  21369     (cond
  21370      ((eq (car elem) 'headline)
  21371       (narrow-to-region
  21372        (org-element-property :begin elem)
  21373        (org-element-property :end elem)))
  21374      ((memq (car elem) org-element-greater-elements)
  21375       (narrow-to-region
  21376        (org-element-property :contents-begin elem)
  21377        (org-element-property :contents-end elem)))
  21378      (t
  21379       (narrow-to-region
  21380        (org-element-property :begin elem)
  21381        (org-element-property :end elem))))))
  21382 
  21383 (defun org-transpose-element ()
  21384   "Transpose current and previous elements, keeping blank lines between.
  21385 Point is moved after both elements."
  21386   (interactive)
  21387   (org-skip-whitespace)
  21388   (let ((end (org-element-property :end (org-element-at-point))))
  21389     (org-drag-element-backward)
  21390     (goto-char end)))
  21391 
  21392 (defun org-unindent-buffer ()
  21393   "Un-indent the visible part of the buffer.
  21394 Relative indentation (between items, inside blocks, etc.) isn't
  21395 modified."
  21396   (interactive)
  21397   (unless (eq major-mode 'org-mode)
  21398     (user-error "Cannot un-indent a buffer not in Org mode"))
  21399   (letrec ((parse-tree (org-element-parse-buffer 'greater-element))
  21400 	   (unindent-tree
  21401 	    (lambda (contents)
  21402 	      (dolist (element (reverse contents))
  21403 		(if (memq (org-element-type element) '(headline section))
  21404 		    (funcall unindent-tree (org-element-contents element))
  21405 		  (save-excursion
  21406 		    (save-restriction
  21407 		      (narrow-to-region
  21408 		       (org-element-property :begin element)
  21409 		       (org-element-property :end element))
  21410 		      (org-do-remove-indentation))))))))
  21411     (funcall unindent-tree (org-element-contents parse-tree))))
  21412 
  21413 (defun org-make-options-regexp (kwds &optional extra)
  21414   "Make a regular expression for keyword lines.
  21415 KWDS is a list of keywords, as strings.  Optional argument EXTRA,
  21416 when non-nil, is a regexp matching keywords names."
  21417   (concat "^[ \t]*#\\+\\("
  21418 	  (regexp-opt kwds)
  21419 	  (and extra (concat (and kwds "\\|") extra))
  21420 	  "\\):[ \t]*\\(.*\\)"))
  21421 
  21422 
  21423 ;;; Conveniently switch to Info nodes
  21424 
  21425 (defun org-info-find-node (&optional nodename)
  21426   "Find Info documentation NODENAME or Org documentation according context.
  21427 Started from `gnus-info-find-node'."
  21428   (interactive)
  21429   (Info-goto-node
  21430    (or nodename
  21431        (let ((default-org-info-node "(org) Top"))
  21432          (cond
  21433           ((eq 'org-agenda-mode major-mode) "(org) Agenda Views")
  21434           ((eq 'org-mode major-mode)
  21435            (let* ((context (org-element-at-point))
  21436                   (element-info-nodes ; compare to `org-element-all-elements'.
  21437                    `((babel-call . "(org) Evaluating Code Blocks")
  21438                      (center-block . "(org) Paragraphs")
  21439                      (clock . ,default-org-info-node)
  21440                      (comment . "(org) Comment Lines")
  21441                      (comment-block . "(org) Comment Lines")
  21442                      (diary-sexp . ,default-org-info-node)
  21443                      (drawer . "(org) Drawers")
  21444                      (dynamic-block . "(org) Dynamic Blocks")
  21445                      (example-block . "(org) Literal Examples")
  21446                      (export-block . "(org) ASCII/Latin-1/UTF-8 export")
  21447                      (fixed-width . ,default-org-info-node)
  21448                      (footnote-definition . "(org) Creating Footnotes")
  21449                      (headline . "(org) Document Structure")
  21450                      (horizontal-rule . "(org) Built-in Table Editor")
  21451                      (inlinetask . ,default-org-info-node)
  21452                      (item . "(org) Plain Lists")
  21453                      (keyword . "(org) Per-file keywords")
  21454                      (latex-environment . "(org) LaTeX Export")
  21455                      (node-property . "(org) Properties and Columns")
  21456                      (paragraph . "(org) Paragraphs")
  21457                      (plain-list . "(org) Plain Lists")
  21458                      (planning . "(org) Deadlines and Scheduling")
  21459                      (property-drawer . "(org) Properties and Columns")
  21460                      (quote-block . "(org) Paragraphs")
  21461                      (section . ,default-org-info-node)
  21462                      (special-block . ,default-org-info-node)
  21463                      (src-block . "(org) Working with Source Code")
  21464                      (table . "(org) Tables")
  21465                      (table-row . "(org) Tables")
  21466                      (verse-block . "(org) Paragraphs"))))
  21467              (or (cdr (assoc (car context) element-info-nodes))
  21468                  default-org-info-node)))
  21469           (t default-org-info-node))))))
  21470 
  21471 
  21472 ;;; Finish up
  21473 
  21474 (add-hook 'org-mode-hook     ;remove overlays when changing major mode
  21475 	  (lambda () (add-hook 'change-major-mode-hook
  21476 			       'org-show-all 'append 'local)))
  21477 
  21478 (provide 'org)
  21479 
  21480 (run-hooks 'org-load-hook)
  21481 
  21482 ;;; org.el ends here