dotemacs

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

org-capture.el (81188B)


      1 ;;; org-capture.el --- Fast note taking in Org       -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2010-2023 Free Software Foundation, Inc.
      4 
      5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com>
      6 ;; Keywords: outlines, hypermedia, calendar, wp
      7 ;; URL: https://orgmode.org
      8 ;;
      9 ;; This file is part of GNU Emacs.
     10 ;;
     11 ;; GNU Emacs is free software: you can redistribute it and/or modify
     12 ;; it under the terms of the GNU General Public License as published by
     13 ;; the Free Software Foundation, either version 3 of the License, or
     14 ;; (at your option) any later version.
     15 
     16 ;; GNU Emacs is distributed in the hope that it will be useful,
     17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     19 ;; GNU General Public License for more details.
     20 
     21 ;; You should have received a copy of the GNU General Public License
     22 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     24 ;;
     25 ;;; Commentary:
     26 
     27 ;; This file contains an alternative implementation of the functionality
     28 ;; that used to be provided by org-remember.el.  The implementation is more
     29 ;; streamlined, can produce more target types (e.g. plain list items or
     30 ;; table lines).  Also, it does not use a temporary buffer for editing
     31 ;; the captured entry - instead it uses an indirect buffer that visits
     32 ;; the new entry already in the target buffer (this was an idea by Samuel
     33 ;; Wales).  John Wiegley's excellent `remember.el' is not needed anymore
     34 ;; for this implementation, even though we borrow heavily from its ideas.
     35 
     36 ;; This implementation heavily draws on ideas by James TD Smith and
     37 ;; Samuel Wales, and, of cause, uses John Wiegley's remember.el as inspiration.
     38 
     39 ;;; TODO
     40 
     41 ;; - find a clever way to not always insert an annotation maybe a
     42 ;;   predicate function that can check for conditions for %a to be
     43 ;;   used.  This could be one of the properties.
     44 
     45 ;; - Should there be plist members that arrange for properties to be
     46 ;;   asked for, like James proposed in his RFC?
     47 
     48 ;;; Code:
     49 
     50 (require 'org-macs)
     51 (org-assert-version)
     52 
     53 (require 'cl-lib)
     54 (require 'org)
     55 (require 'org-refile)
     56 
     57 (declare-function org-at-encrypted-entry-p "org-crypt" ())
     58 (declare-function org-at-table-p "org-table" (&optional table-type))
     59 (declare-function org-clock-update-mode-line "org-clock" (&optional refresh))
     60 (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
     61 (declare-function org-datetree-find-month-create (d &optional keep-restriction))
     62 (declare-function org-decrypt-entry "org-crypt" ())
     63 (declare-function org-element-at-point "org-element" (&optional pom cached-only))
     64 (declare-function org-element-lineage "org-element" (datum &optional types with-self))
     65 (declare-function org-element-property "org-element" (property element))
     66 (declare-function org-encrypt-entry "org-crypt" ())
     67 (declare-function org-insert-link "ol" (&optional complete-file link-location default-description))
     68 (declare-function org-link-make-string "ol" (link &optional description))
     69 (declare-function org-table-analyze "org-table" ())
     70 (declare-function org-table-current-dline "org-table" ())
     71 (declare-function org-table-fix-formulas "org-table" (key replace &optional limit delta remove))
     72 (declare-function org-table-goto-line "org-table" (N))
     73 
     74 (defvar dired-buffers)
     75 (defvar crm-separator)
     76 (defvar org-end-time-was-given)
     77 (defvar org-keyword-properties)
     78 (defvar org-remember-default-headline)
     79 (defvar org-remember-templates)
     80 (defvar org-store-link-plist)
     81 (defvar org-table-border-regexp)
     82 (defvar org-table-current-begin-pos)
     83 (defvar org-table-dataline-regexp)
     84 (defvar org-table-fix-formulas-confirm)
     85 (defvar org-table-hline-regexp)
     86 (defvar org-table-hlines)
     87 
     88 (defvar org-capture-clock-was-started nil
     89   "Internal flag, keeping marker to the started clock.")
     90 
     91 (defvar org-capture-last-stored-marker (make-marker)
     92   "Marker pointing to the entry most recently stored with `org-capture'.")
     93 
     94 ;; The following variable is scoped dynamically by org-protocol
     95 ;; to indicate that the link properties have already been stored
     96 (defvar org-capture-link-is-already-stored nil)
     97 
     98 (defvar org-capture-is-refiling nil
     99   "Non-nil when capture process is refiling an entry.")
    100 
    101 (defvar org-capture--prompt-history-table (make-hash-table :test #'equal)
    102   "Hash table for all history lists per prompt.")
    103 
    104 (defvar org-capture--prompt-history nil
    105   "History list for prompt placeholders.")
    106 
    107 (defgroup org-capture nil
    108   "Options concerning capturing new entries."
    109   :tag "Org Capture"
    110   :group 'org)
    111 
    112 (defun org-capture-upgrade-templates (templates)
    113   "Update the template list to the new format.
    114 TEMPLATES is a template list, as in `org-capture-templates'.  The
    115 new format unifies all the date/week tree targets into one that
    116 also allows for an optional outline path to specify a target."
    117   (let ((modified-templates
    118 	 (mapcar
    119 	  (lambda (entry)
    120 	    (pcase entry
    121 	      ;; Match templates with an obsolete "tree" target type. Replace
    122 	      ;; it with common `file+olp-datetree'.  Add new properties
    123 	      ;; (i.e., `:time-prompt' and `:tree-type') if needed.
    124 	      (`(,key ,desc ,type (file+datetree . ,path) ,tpl . ,props)
    125 	       `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl ,@props))
    126 	      (`(,key ,desc ,type (file+datetree+prompt . ,path) ,tpl . ,props)
    127 	       `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl
    128 		      :time-prompt t ,@props))
    129 	      (`(,key ,desc ,type (file+weektree . ,path) ,tpl . ,props)
    130 	       `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl
    131 		      :tree-type week ,@props))
    132 	      (`(,key ,desc ,type (file+weektree+prompt . ,path) ,tpl . ,props)
    133 	       `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl
    134 		      :tree-type week :time-prompt t ,@props))
    135 	      ;; Other templates are left unchanged.
    136 	      (_ entry)))
    137 	  templates)))
    138     (unless (equal modified-templates templates)
    139       (message "Deprecated date/weektree capture templates changed to `file+olp+datetree'."))
    140     modified-templates))
    141 
    142 (defcustom org-capture-templates nil
    143   "Templates for the creation of new entries.
    144 
    145 Each entry is a list with the following items:
    146 
    147 keys         The keys that will select the template, as a string, characters
    148              only, for example \"a\" for a template to be selected with a
    149              single key, or \"bt\" for selection with two keys.  When using
    150              several keys, keys using the same prefix key must be together
    151              in the list and preceded by a 2-element entry explaining the
    152              prefix key, for example
    153 
    154                      (\"b\" \"Templates for marking stuff to buy\")
    155 
    156              The \"C\" key is used by default for quick access to the
    157              customization of the template variable.  But if you want to use
    158              that key for a template, you can.
    159 
    160 description  A short string describing the template, will be shown during
    161              selection.
    162 
    163 type         The type of entry.  Valid types are:
    164                entry       an Org node, with a headline.  Will be filed
    165                            as the child of the target entry or as a
    166                            top-level entry.  Its default template is:
    167                              \"* %?\n %a\"
    168                item        a plain list item, will be placed in the
    169                            first plain list at the target location.
    170                            Its default template is:
    171                              \"- %?\"
    172                checkitem   a checkbox item.  This differs from the
    173                            plain list item only in so far as it uses a
    174                            different default template.  Its default
    175                            template is:
    176                              \"- [ ] %?\"
    177                table-line  a new line in the first table at target location.
    178                            Its default template is:
    179                              \"| %? |\"
    180                plain       text to be inserted as it is.
    181 
    182 target       Specification of where the captured item should be placed.
    183              In Org files, targets usually define a node.  Entries will
    184              become children of this node, other types will be added to the
    185              table or list in the body of this node.
    186 
    187              Most target specifications contain a file name.  If that file
    188              name is the empty string, it defaults to `org-default-notes-file'.
    189              A file can also be given as a variable or as a function called
    190              with no argument.  When an absolute path is not specified for a
    191              target, it is taken as relative to `org-directory'.
    192 
    193              Valid values are:
    194 
    195              (file \"path/to/file\")
    196                  Text will be placed at the beginning or end of that file
    197 
    198              (id \"id of existing Org entry\")
    199                  File as child of this entry, or in the body of the entry
    200 
    201              (file+headline \"path/to/file\" \"node headline\")
    202                  Fast configuration if the target heading is unique in the file
    203 
    204              (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...)
    205                  For non-unique headings, the full outline path is safer
    206 
    207              (file+regexp  \"path/to/file\" \"regexp to find location\")
    208                  File to the entry matching regexp
    209 
    210              (file+olp+datetree \"path/to/file\" \"Level 1 heading\" ...)
    211                  Will create a heading in a date tree for today's date.
    212                  If no heading is given, the tree will be on top level.
    213                  To prompt for date instead of using TODAY, use the
    214                  :time-prompt property.  To create a week-tree, use the
    215                  :tree-type property.
    216 
    217              (file+function \"path/to/file\" function-finding-location)
    218                  A function to find the right location in the file
    219 
    220              (clock)
    221                 File to the entry that is currently being clocked
    222 
    223              (function function-finding-location)
    224                 Most general way: write your own function which both visits
    225                 the file and moves point to the right location
    226 
    227 template     The template for creating the capture item.
    228              If it is an empty string or nil, a default template based on
    229              the entry type will be used (see the \"type\" section above).
    230              Instead of a string, this may also be one of:
    231 
    232                  (file \"/path/to/template-file\")
    233                  (function function-returning-the-template)
    234 
    235              in order to get a template from a file, or dynamically
    236              from a function.
    237 
    238 The rest of the entry is a property list of additional options.  Recognized
    239 properties are:
    240 
    241  :prepend            Normally newly captured information will be appended at
    242                      the target location (last child, last table line,
    243                      last list item...).  Setting this property will
    244                      change that.
    245 
    246  :immediate-finish   When set, do not offer to edit the information, just
    247                      file it away immediately.  This makes sense if the
    248                      template only needs information that can be added
    249                      automatically.
    250 
    251  :jump-to-captured   When set, jump to the captured entry when finished.
    252 
    253  :refile-targets     When exiting capture mode via `org-capture-refile', the
    254                      variable `org-refile-targets' will be temporarily bound
    255                      to the value of this property.
    256 
    257  :empty-lines        Set this to the number of lines that should be inserted
    258                      before and after the new item.  Default 0, only common
    259                      other value is 1.
    260 
    261  :empty-lines-before Set this to the number of lines that should be inserted
    262                      before the new item.  Overrides :empty-lines for the
    263                      number lines inserted before.
    264 
    265  :empty-lines-after  Set this to the number of lines that should be inserted
    266                      after the new item.  Overrides :empty-lines for the
    267                      number of lines inserted after.
    268 
    269  :clock-in           Start the clock in this item.
    270 
    271  :clock-keep         Keep the clock running when filing the captured entry.
    272 
    273  :clock-resume       Start the interrupted clock when finishing the capture.
    274                      Note that :clock-keep has precedence over :clock-resume.
    275                      When setting both to t, the current clock will run and
    276                      the previous one will not be resumed.
    277 
    278  :time-prompt        Prompt for a date/time to be used for date/week trees
    279                      and when filling the template.
    280 
    281  :tree-type          When `week', make a week tree instead of the month-day
    282                      tree.  When `month', make a month tree instead of the
    283                      month-day tree.
    284 
    285  :unnarrowed         Do not narrow the target buffer, simply show the
    286                      full buffer.  Default is to narrow it so that you
    287                      only see the new stuff.
    288 
    289  :table-line-pos     Specification of the location in the table where the
    290                      new line should be inserted.  It should be a string like
    291                      \"II-3\", meaning that the new line should become the
    292                      third line before the second horizontal separator line.
    293 
    294  :kill-buffer        If the target file was not yet visited by a buffer when
    295                      capture was invoked, kill the buffer again after capture
    296                      is finalized.
    297 
    298  :no-save            Do not save the target file after finishing the capture.
    299 
    300  :hook               A nullary function or list of nullary functions run before
    301                      `org-capture-mode-hook' when the template is selected.
    302 
    303  :prepare-finalize   A nullary function or list of nullary functions run before
    304                      `org-capture-prepare-finalize-hook'
    305                      when the template is selected.
    306 
    307  :before-finalize    A nullary function or list of nullary functions run before
    308                      `org-capture-before-finalize-hook'
    309                      when the template is selected.
    310 
    311  :after-finalize     A nullary function or list of nullary functions run before
    312                      `org-capture-after-finalize-hook'
    313                      when the template is selected.
    314 
    315 The template defines the text to be inserted.  Often this is an
    316 Org mode entry (so the first line should start with a star) that
    317 will be filed as a child of the target headline.  It can also be
    318 freely formatted text.  Furthermore, the following %-escapes will
    319 be replaced with content and expanded:
    320 
    321   %[pathname] Insert the contents of the file given by
    322               `pathname'.  These placeholders are expanded at the very
    323               beginning of the process so they can be used to extend the
    324               current template.
    325   %(sexp)     Evaluate elisp `(sexp)' and replace it with the results.
    326               Only placeholders pre-existing within the template, or
    327               introduced with %[pathname] are expanded this way.
    328               Since this happens after expanding non-interactive
    329               %-escapes, those can be used to fill the expression.
    330               The evaluation happens with Org mode set as major mode
    331               in a temporary buffer.
    332   %<...>      The result of `format-time-string' on the ... format
    333               specification.
    334   %t          Time stamp, date only.  The time stamp is the current
    335               time, except when called from agendas with
    336               `\\[org-agenda-capture]' or with
    337               `org-capture-use-agenda-date' set.
    338   %T          Time stamp as above, with date and time.
    339   %u, %U      Like the above, but inactive time stamps.
    340   %i          Initial content, copied from the active region.  If
    341               there is text before %i on the same line, such as
    342               indentation, and %i is not inside a %(sexp), that prefix
    343               will be added before every line in the inserted text.
    344   %a          Annotation, normally the link created with `org-store-link'.
    345   %A          Like %a, but prompt for the description part.
    346   %l          Like %a, but only insert the literal link.
    347   %L          Like %l, but without brackets (the link content itself).
    348   %c          Current kill ring head.
    349   %x          Content of the X clipboard.
    350   %k          Title of currently clocked task.
    351   %K          Link to currently clocked task.
    352   %n          User name (taken from the variable `user-full-name').
    353   %f          File visited by current buffer when `org-capture' was called.
    354   %F          Full path of the file or directory visited by current buffer.
    355   %:keyword   Specific information for certain link types, see below.
    356   %^g         Prompt for tags, with completion on tags in target file.
    357   %^G         Prompt for tags, with completion on all tags in all agenda files.
    358   %^t         Like %t, but prompt for date.  Similarly %^T, %^u, %^U.
    359               You may define a prompt like: %^{Please specify birthday}t.
    360               The default date is that of %t, see above.
    361   %^C         Interactive selection of which kill or clip to use.
    362   %^L         Like %^C, but insert as link.
    363   %^{prop}p   Prompt the user for a value for property `prop'.
    364               A default value can be specified like this:
    365               %^{prop|default}p.
    366   %^{prompt}  Prompt the user for a string and replace this sequence with it.
    367               A default value and a completion table can be specified like this:
    368               %^{prompt|default|completion2|completion3|...}.
    369   %?          After completing the template, position cursor here.
    370   %\\1 ... %\\N Insert the text entered at the nth %^{prompt}, where N
    371               is a number, starting from 1.
    372 
    373 Apart from these general escapes, you can access information specific to
    374 the link type that is created.  For example, calling `org-capture' in emails
    375 or in Gnus will record the author and the subject of the message, which you
    376 can access with \"%:from\" and \"%:subject\", respectively.  Here is a
    377 complete list of what is recorded for each link type.
    378 
    379 Link type               |  Available information
    380 ------------------------+------------------------------------------------------
    381 bbdb                    |  %:type %:name %:company
    382 vm, wl, mh, mew, rmail, |  %:type %:subject %:message-id
    383 gnus                    |  %:from %:fromname %:fromaddress
    384                         |  %:to   %:toname   %:toaddress
    385                         |  %:fromto (either \"to NAME\" or \"from NAME\")
    386                         |  %:date %:date-timestamp (as active timestamp)
    387                         |  %:date-timestamp-inactive (as inactive timestamp)
    388 gnus                    |  %:group, for messages also all email fields
    389 eww, w3, w3m            |  %:type %:url
    390 info                    |  %:type %:file %:node
    391 calendar                |  %:type %:date
    392 
    393 When you need to insert a literal percent sign in the template,
    394 you can escape ambiguous cases with a backward slash, e.g., \\%i."
    395   :group 'org-capture
    396   :package-version '(Org . "9.6")
    397   :set (lambda (s v) (set-default-toplevel-value s (org-capture-upgrade-templates v)))
    398   :type
    399   (let ((file-variants '(choice :tag "Filename       "
    400 				(file :tag "Literal")
    401 				(function :tag "Function")
    402 				(variable :tag "Variable")
    403 				(sexp :tag "Form"))))
    404     `(repeat
    405       (choice :value ("" "" entry (file "~/org/notes.org") "")
    406 	      (list :tag "Multikey description"
    407 		    (string :tag "Keys       ")
    408 		    (string :tag "Description"))
    409 	      (list :tag "Template entry"
    410 		    (string :tag "Keys           ")
    411 		    (string :tag "Description    ")
    412 		    (choice :tag "Capture Type   " :value entry
    413 			    (const :tag "Org entry" entry)
    414 			    (const :tag "Plain list item" item)
    415 			    (const :tag "Checkbox item" checkitem)
    416 			    (const :tag "Plain text" plain)
    417 			    (const :tag "Table line" table-line))
    418 		    (choice :tag "Target location"
    419 			    (list :tag "File"
    420 				  (const :format "" file)
    421 				  ,file-variants)
    422 			    (list :tag "ID"
    423 				  (const :format "" id)
    424 				  (string :tag "  ID"))
    425 			    (list :tag "File & Headline"
    426 				  (const :format "" file+headline)
    427 				  ,file-variants
    428 				  (string :tag "  Headline"))
    429 			    (list :tag "File & Outline path"
    430 				  (const :format "" file+olp)
    431 				  ,file-variants
    432 				  (repeat :tag "Outline path" :inline t
    433 					  (string :tag "Headline")))
    434 			    (list :tag "File & Regexp"
    435 				  (const :format "" file+regexp)
    436 				  ,file-variants
    437 				  (regexp :tag "  Regexp"))
    438 			    (list :tag "File [ & Outline path ] & Date tree"
    439 				  (const :format "" file+olp+datetree)
    440 				  ,file-variants
    441 				  (option (repeat :tag "Outline path" :inline t
    442 						  (string :tag "Headline"))))
    443 			    (list :tag "File & function"
    444 				  (const :format "" file+function)
    445 				  ,file-variants
    446 				  (sexp :tag "  Function"))
    447 			    (list :tag "Current clocking task"
    448 				  (const :format "" clock))
    449 			    (list :tag "Function"
    450 				  (const :format "" function)
    451 				  (sexp :tag "  Function")))
    452 		    (choice :tag "Template       "
    453 			    (string)
    454 			    (list :tag "File"
    455 				  (const :format "" file)
    456 				  (file :tag "Template file"))
    457 			    (list :tag "Function"
    458 				  (const :format "" function)
    459 				  (function :tag "Template function")))
    460 		    (plist :inline t
    461 			   ;; Give the most common options as checkboxes
    462 			   :options (((const :format "%v " :prepend) (const t))
    463 				     ((const :format "%v " :immediate-finish) (const t))
    464 				     ((const :format "%v " :jump-to-captured) (const t))
    465 				     ((const :format "%v " :empty-lines) (const 1))
    466 				     ((const :format "%v " :empty-lines-before) (const 1))
    467 				     ((const :format "%v " :empty-lines-after) (const 1))
    468 				     ((const :format "%v " :clock-in) (const t))
    469 				     ((const :format "%v " :clock-keep) (const t))
    470 				     ((const :format "%v " :clock-resume) (const t))
    471 				     ((const :format "%v " :time-prompt) (const t))
    472 				     ((const :format "%v " :tree-type) (const week))
    473 				     ((const :format "%v " :unnarrowed) (const t))
    474 				     ((const :format "%v " :table-line-pos) (string))
    475 				     ((const :format "%v " :kill-buffer) (const t)))))))))
    476 
    477 (defcustom org-capture-before-finalize-hook nil
    478   "Hook that is run right before a capture process is finalized.
    479 The capture buffer is still current when this hook runs and it is
    480 widened to the entire buffer."
    481   :group 'org-capture
    482   :version "24.1"
    483   :type 'hook)
    484 
    485 (defcustom org-capture-after-finalize-hook nil
    486   "Hook that is run right after a capture process is finalized.
    487 Suitable for window cleanup."
    488   :group 'org-capture
    489   :version "24.1"
    490   :type 'hook)
    491 
    492 (defcustom org-capture-prepare-finalize-hook nil
    493   "Hook that is run before the finalization starts.
    494 The capture buffer is current and still narrowed."
    495   :group 'org-capture
    496   :version "24.1"
    497   :type 'hook)
    498 
    499 (defcustom org-capture-bookmark t
    500   "When non-nil, add bookmark pointing at the last stored position when capturing."
    501   :group 'org-capture
    502   :version "24.3"
    503   :type 'boolean)
    504 
    505 ;;; The property list for keeping information about the capture process
    506 
    507 (defvar org-capture-plist nil
    508   "Plist for the current capture process, global, to avoid having to pass it.")
    509 
    510 (defvar org-capture-current-plist nil
    511   "Local variable holding the plist in a capture buffer.
    512 This is used to store the plist for use when finishing a capture process
    513 because another such process might have changed the global variable by then.
    514 
    515 Each time a new capture buffer has been set up, the global `org-capture-plist'
    516 is copied to this variable, which is local in the indirect buffer.")
    517 
    518 (defvar org-capture-clock-keep nil
    519   "Local variable to store the value of the :clock-keep parameter.
    520 This is needed in case `org-capture-finalize' is called interactively.")
    521 
    522 (defun org-capture-put (&rest elements)
    523   "Add ELEMENTS to the capture property list `org-capture-plist'."
    524   (while elements
    525     (setq org-capture-plist (plist-put org-capture-plist
    526 				       (pop elements) (pop elements)))))
    527 (defun org-capture-get (property &optional local)
    528   "Get PROPERTY from the capture property list `org-capture-plist'.
    529 When LOCAL is set, use the local variable `org-capture-current-plist',
    530 this is necessary after initialization of the capture process,
    531 to avoid conflicts with other active capture processes."
    532   (plist-get (if local org-capture-current-plist org-capture-plist) property))
    533 
    534 ;;; The minor mode
    535 
    536 (defvar org-capture-mode-map
    537   (let ((map (make-sparse-keymap)))
    538     (define-key map "\C-c\C-c" #'org-capture-finalize)
    539     (define-key map "\C-c\C-k" #'org-capture-kill)
    540     (define-key map "\C-c\C-w" #'org-capture-refile)
    541     map)
    542   "Keymap for `org-capture-mode', a minor mode.
    543 Use this map to set additional keybindings for when Org mode is used
    544 for a capture buffer.")
    545 
    546 (defvar org-capture-mode-hook nil
    547   "Hook for the `org-capture-mode' minor mode.")
    548 
    549 (define-minor-mode org-capture-mode
    550   "Minor mode for special key bindings in a capture buffer.
    551 
    552 Turning on this mode runs the normal hook `org-capture-mode-hook'."
    553   :lighter " Cap"
    554   (setq-local
    555    header-line-format
    556    (substitute-command-keys
    557     "\\<org-capture-mode-map>Capture buffer.  Finish \
    558 `\\[org-capture-finalize]', refile `\\[org-capture-refile]', \
    559 abort `\\[org-capture-kill]'.")))
    560 
    561 ;;; The main commands
    562 
    563 (defvar org-capture-initial nil)
    564 (defvar org-capture-entry nil)
    565 
    566 ;;;###autoload
    567 (defun org-capture-string (string &optional keys)
    568   "Capture STRING with the template selected by KEYS."
    569   (interactive "sInitial text: \n")
    570   (let ((org-capture-initial string)
    571 	(org-capture-entry (org-capture-select-template keys)))
    572     (org-capture)))
    573 
    574 (defcustom org-capture-templates-contexts nil
    575   "Alist of capture templates and valid contexts.
    576 
    577 For example, if you have a capture template \"c\" and you want
    578 this template to be accessible only from `message-mode' buffers,
    579 use this:
    580 
    581   (setq org-capture-templates-contexts
    582         \\='((\"c\" ((in-mode . \"message-mode\")))))
    583 
    584 Here are the available contexts definitions:
    585 
    586       in-file: command displayed only in matching files
    587       in-mode: command displayed only in matching modes
    588   not-in-file: command not displayed in matching files
    589   not-in-mode: command not displayed in matching modes
    590     in-buffer: command displayed only in matching buffers
    591 not-in-buffer: command not displayed in matching buffers
    592    [function]: a custom function taking no argument
    593 
    594 If you define several checks, the agenda command will be
    595 accessible if there is at least one valid check.
    596 
    597 You can also bind a key to another capture template depending on
    598 contextual rules.
    599 
    600   (setq org-capture-templates-contexts
    601         \\='((\"c\" \"d\" ((in-mode . \"message-mode\")))))
    602 
    603 Here it means: in `message-mode buffers', use \"c\" as the
    604 key for the capture template otherwise associated with \"d\".
    605 \(The template originally associated with \"d\" is not displayed
    606 to avoid duplicates.)"
    607   :version "24.3"
    608   :group 'org-capture
    609   :type '(repeat (list :tag "Rule"
    610 		       (string :tag "        Capture key")
    611 		       (string :tag "Replace by template")
    612 		       (repeat :tag "Available when"
    613 			       (choice
    614 			        (cons :tag "Condition"
    615 				      (choice
    616 				       (const :tag "In file" in-file)
    617 				       (const :tag "Not in file" not-in-file)
    618 				       (const :tag "In buffer" in-buffer)
    619 				       (const :tag "Not in buffer" not-in-buffer)
    620 				       (const :tag "In mode" in-mode)
    621 				       (const :tag "Not in mode" not-in-mode))
    622 				      (regexp))
    623 			        (function :tag "Custom function"))))))
    624 
    625 (defcustom org-capture-use-agenda-date nil
    626   "Non-nil means use the date at point when capturing from agendas.
    627 When nil, you can still capture using the date at point with
    628 `\\[org-agenda-capture]'."
    629   :group 'org-capture
    630   :version "24.3"
    631   :type 'boolean)
    632 
    633 ;;;###autoload
    634 (defun org-capture (&optional goto keys)
    635   "Capture something.
    636 \\<org-capture-mode-map>
    637 This will let you select a template from `org-capture-templates', and
    638 then file the newly captured information.  The text is immediately
    639 inserted at the target location, and an indirect buffer is shown where
    640 you can edit it.  Pressing `\\[org-capture-finalize]' brings you back to the \
    641 previous
    642 state of Emacs, so that you can continue your work.
    643 
    644 When called interactively with a `\\[universal-argument]' prefix argument \
    645 GOTO, don't
    646 capture anything, just go to the file/headline where the selected
    647 template stores its notes.
    648 
    649 With a `\\[universal-argument] \\[universal-argument]' prefix argument, go to \
    650 the last note stored.
    651 
    652 When called with a `C-0' (zero) prefix, insert a template at point.
    653 
    654 When called with a `C-1' (one) prefix, force prompting for a date when
    655 a datetree entry is made.
    656 
    657 ELisp programs can set KEYS to a string associated with a template
    658 in `org-capture-templates'.  In this case, interactive selection
    659 will be bypassed.
    660 
    661 If `org-capture-use-agenda-date' is non-nil, capturing from the
    662 agenda will use the date at point as the default date.  Then, a
    663 `C-1' prefix will tell the capture process to use the HH:MM time
    664 of the day at point (if any) or the current HH:MM time."
    665   (interactive "P")
    666   (when (and org-capture-use-agenda-date
    667 	     (eq major-mode 'org-agenda-mode))
    668     (setq org-overriding-default-time
    669 	  (org-get-cursor-date (equal goto 1))))
    670   (cond
    671    ((equal goto '(4))  (org-capture-goto-target keys))
    672    ((equal goto '(16)) (org-capture-goto-last-stored))
    673    (t
    674     (let* ((orig-buf (current-buffer))
    675 	   (annotation (if (and (boundp 'org-capture-link-is-already-stored)
    676 				org-capture-link-is-already-stored)
    677 			   (plist-get org-store-link-plist :annotation)
    678 			 (ignore-errors (org-store-link nil))))
    679 	   (entry (or org-capture-entry (org-capture-select-template keys)))
    680 	   initial)
    681       (setq initial (or org-capture-initial
    682 			(and (org-region-active-p)
    683 			     (buffer-substring (point) (mark)))))
    684       (when (stringp initial)
    685 	(remove-text-properties 0 (length initial) '(read-only t) initial))
    686       (when (stringp annotation)
    687 	(remove-text-properties 0 (length annotation)
    688 				'(read-only t) annotation))
    689       (cond
    690        ((equal entry "C")
    691 	(customize-variable 'org-capture-templates))
    692        ((equal entry "q")
    693 	(user-error "Abort"))
    694        (t
    695 	(org-capture-set-plist entry)
    696 	(org-capture-get-template)
    697 	(org-capture-put :original-buffer orig-buf
    698 			 :original-file (or (buffer-file-name orig-buf)
    699 					    (and (featurep 'dired)
    700 						 (car (rassq orig-buf
    701 							     dired-buffers))))
    702 			 :original-file-nondirectory
    703 			 (and (buffer-file-name orig-buf)
    704 			      (file-name-nondirectory
    705 			       (buffer-file-name orig-buf)))
    706 			 :annotation annotation
    707 			 :initial initial
    708 			 :return-to-wconf (current-window-configuration)
    709 			 :default-time (or org-overriding-default-time
    710 					   (org-current-time)))
    711 	(org-capture-set-target-location (and (equal goto 0) 'here))
    712 	(condition-case error
    713 	    (org-capture-put :template (org-capture-fill-template))
    714 	  ((error quit)
    715 	   (if (get-buffer "*Capture*") (kill-buffer "*Capture*"))
    716 	   (error "Capture abort: %s" (error-message-string error))))
    717 
    718 	(setq org-capture-clock-keep (org-capture-get :clock-keep))
    719 	(condition-case error
    720 	    (org-capture-place-template
    721 	     (eq (car (org-capture-get :target)) 'function))
    722 	  ((error quit)
    723 	   (when (and (buffer-base-buffer (current-buffer))
    724 		      (string-prefix-p "CAPTURE-" (buffer-name)))
    725 	     (kill-buffer (current-buffer)))
    726 	   (set-window-configuration (org-capture-get :return-to-wconf))
    727 	   (error "Capture template `%s': %s"
    728 		  (org-capture-get :key)
    729 		  (error-message-string error))))
    730 	(when (and (derived-mode-p 'org-mode) (org-capture-get :clock-in))
    731 	  (condition-case nil
    732 	      (progn
    733 		(when (org-clock-is-active)
    734 		  (org-capture-put :interrupted-clock
    735 				   (copy-marker org-clock-marker)))
    736 		(org-clock-in)
    737 		(setq-local org-capture-clock-was-started
    738                             (copy-marker org-clock-marker)))
    739 	    (error "Could not start the clock in this capture buffer")))
    740 	(when (org-capture-get :immediate-finish)
    741 	  (org-capture-finalize))))))))
    742 
    743 (defun org-capture-get-template ()
    744   "Get the template from a file or a function if necessary."
    745   (org-capture-put
    746    :template
    747    (pcase (org-capture-get :template)
    748      (`nil "")
    749      ((and (pred stringp) template) template)
    750      (`(file ,file)
    751       (let ((filename (expand-file-name file org-directory)))
    752 	(if (file-exists-p filename) (org-file-contents filename)
    753 	  (format "* Template file %S not found" file))))
    754      (`(function ,f)
    755       (if (functionp f) (funcall f)
    756 	(format "* Template function %S not found" f)))
    757      (_ "* Invalid capture template"))))
    758 
    759 (defun org-capture--run-template-functions (keyword &optional local)
    760   "Run functions associated with KEYWORD on template's plist.
    761 For valid values of KEYWORD see `org-capture-templates'.
    762 If LOCAL is non-nil use the buffer-local value of `org-capture-plist'."
    763   ;; Used in place of `run-hooks' because these functions have no associated symbol.
    764   ;; They are stored directly on `org-capture-plist'.
    765   (let ((value (org-capture-get keyword local)))
    766     (if (functionp value)
    767         (funcall value)
    768       (mapc #'funcall value))))
    769 
    770 (defun org-capture-finalize (&optional stay-with-capture)
    771   "Finalize the capture process.
    772 With prefix argument STAY-WITH-CAPTURE, jump to the location of the
    773 captured item after finalizing."
    774   (interactive "P")
    775   (when (org-capture-get :jump-to-captured)
    776     (setq stay-with-capture t))
    777   (unless (and org-capture-mode
    778 	       (buffer-base-buffer (current-buffer)))
    779     (error "This does not seem to be a capture buffer for Org mode"))
    780 
    781   (org-capture--run-template-functions :prepare-finalize 'local)
    782   (run-hooks 'org-capture-prepare-finalize-hook)
    783 
    784   ;; Update `org-capture-plist' with the buffer-local value.  Since
    785   ;; captures can be run concurrently, this is to ensure that
    786   ;; `org-capture-after-finalize-hook' accesses the proper plist.
    787   (setq org-capture-plist org-capture-current-plist)
    788 
    789   ;; Did we start the clock in this capture buffer?
    790   (when (and org-capture-clock-was-started
    791 	     (equal org-clock-marker org-capture-clock-was-started))
    792     ;; Looks like the clock we started is still running.
    793     (if org-capture-clock-keep
    794 	;; User may have completed clocked heading from the template.
    795 	;; Refresh clock mode line.
    796 	(org-clock-update-mode-line t)
    797       ;; Clock out.  Possibly resume interrupted clock.
    798       (let (org-log-note-clock-out) (org-clock-out))
    799       (when (and (org-capture-get :clock-resume 'local)
    800 		 (markerp (org-capture-get :interrupted-clock 'local))
    801 		 (buffer-live-p (marker-buffer
    802 				 (org-capture-get :interrupted-clock 'local))))
    803 	(let ((clock-in-task (org-capture-get :interrupted-clock 'local)))
    804 	  (org-with-point-at clock-in-task (org-clock-in)))
    805 	(message "Interrupted clock has been resumed"))))
    806 
    807   (let ((abort-note nil))
    808     ;; Store the size of the capture buffer
    809     (org-capture-put :captured-entry-size (- (point-max) (point-min)))
    810     (widen)
    811     ;; Store the insertion point in the target buffer
    812     (org-capture-put :insertion-point (point))
    813 
    814     (if org-note-abort
    815 	(let ((beg (org-capture-get :begin-marker 'local))
    816 	      (end (org-capture-get :end-marker 'local)))
    817 	  (if (not (and beg end)) (setq abort-note 'dirty)
    818 	    (setq abort-note t)
    819 	    (org-with-wide-buffer (kill-region beg end))))
    820 
    821       ;; Postprocessing:  Update Statistics cookies, do the sorting
    822       (when (derived-mode-p 'org-mode)
    823 	(save-excursion
    824 	  (when (ignore-errors (org-back-to-heading))
    825 	    (org-update-parent-todo-statistics)
    826 	    (org-update-checkbox-count)))
    827 	;; FIXME Here we should do the sorting
    828 	;; If we have added a table line, maybe recompute?
    829 	(when (and (eq (org-capture-get :type 'local) 'table-line)
    830 		   (org-at-table-p))
    831 	  (if (not (org-table-get-stored-formulas)) (org-table-align)
    832 	    ;; Adjust formulas, if necessary.  We assume a non-nil
    833 	    ;; `:immediate-finish' means that no confirmation is
    834 	    ;; required.  Else, obey `org-table-fix-formulas-confirm'.
    835 	    ;;
    836 	    ;; The delta required to fix formulas depends on the
    837 	    ;; number of rows inserted by the template.
    838 	    (when (or (org-capture-get :immediate-finish)
    839 		      (not org-table-fix-formulas-confirm)
    840 		      (funcall org-table-fix-formulas-confirm "Fix formulas? "))
    841 	      (org-table-fix-formulas
    842 	       "@" nil (1- (org-table-current-dline))
    843 	       (count-lines (org-capture-get :begin-marker 'local)
    844 			    (org-capture-get :end-marker 'local))))
    845 	    (org-table-recalculate 'all)))) ;FIXME: should we iterate?
    846       ;; Store this place as the last one where we stored something
    847       ;; Do the marking in the base buffer, so that it makes sense after
    848       ;; the indirect buffer has been killed.
    849       (org-capture-store-last-position)
    850 
    851       (org-capture--run-template-functions :before-finalize 'local)
    852       ;; Run the hook
    853       (run-hooks 'org-capture-before-finalize-hook))
    854 
    855     (when (org-capture-get :decrypted)
    856       (save-excursion
    857 	(goto-char (org-capture-get :decrypted))
    858 	(org-encrypt-entry)))
    859 
    860     (unless (org-capture-get :no-save) (save-buffer))
    861 
    862     (let ((return-wconf (org-capture-get :return-to-wconf 'local))
    863 	  (new-buffer (org-capture-get :new-buffer 'local))
    864 	  (kill-buffer (org-capture-get :kill-buffer 'local))
    865 	  (base-buffer (buffer-base-buffer (current-buffer))))
    866 
    867       ;; Kill the indirect buffer
    868       (kill-buffer (current-buffer))
    869 
    870       ;; Narrow back the target buffer to its previous state
    871       (with-current-buffer (org-capture-get :buffer)
    872         (let ((reg (org-capture-get :initial-target-region))
    873 	      (pos (org-capture-get :initial-target-position))
    874 	      (ipt (org-capture-get :insertion-point))
    875 	      (size (org-capture-get :captured-entry-size)))
    876 	  (if (not reg)
    877 	      (widen)
    878 	    (cond ((< ipt (car reg))
    879 		   ;; insertion point is before the narrowed region
    880 		   (narrow-to-region (+ size (car reg)) (+ size (cdr reg))))
    881 		  ((> ipt (cdr reg))
    882 		   ;; insertion point is after the narrowed region
    883 		   (narrow-to-region (car reg) (cdr reg)))
    884 		  (t
    885 		   ;; insertion point is within the narrowed region
    886 		   (narrow-to-region (car reg) (+ size (cdr reg)))))
    887 	    ;; now place back the point at its original position
    888 	    (if (< ipt (car reg))
    889 		(goto-char (+ size pos))
    890 	      (goto-char (if (< ipt pos) (+ size pos) pos))))))
    891 
    892       ;; Kill the target buffer if that is desired
    893       (when (and base-buffer new-buffer kill-buffer)
    894 	(with-current-buffer base-buffer (save-buffer))
    895 	(kill-buffer base-buffer))
    896 
    897       ;; Restore the window configuration before capture
    898       (set-window-configuration return-wconf))
    899 
    900     ;; Do not use the local arg to `org-capture--run-template-functions' here.
    901     ;; The buffer-local value has been stored on `org-capture-plist'.
    902     (org-capture--run-template-functions :after-finalize)
    903     (run-hooks 'org-capture-after-finalize-hook)
    904     ;; Special cases
    905     (cond
    906      (abort-note
    907       (cl-case abort-note
    908 	(clean
    909 	 (message "Capture process aborted and target buffer cleaned up"))
    910 	(dirty
    911 	 (error "Capture process aborted, but target buffer could not be \
    912 cleaned up correctly"))))
    913      (stay-with-capture
    914       (org-capture-goto-last-stored)))
    915     ;; Return if we did store something
    916     (not abort-note)))
    917 
    918 (defun org-capture-refile ()
    919   "Finalize the current capture and then refile the entry.
    920 Refiling is done from the base buffer, because the indirect buffer is then
    921 already gone.  Any prefix argument will be passed to the refile command."
    922   (interactive)
    923   (unless (eq (org-capture-get :type 'local) 'entry)
    924     (user-error "Refiling from a capture buffer makes only sense \
    925 for `entry'-type templates"))
    926   (let* ((base (or (buffer-base-buffer) (current-buffer)))
    927 	 (pos (make-marker))
    928 	 (org-capture-is-refiling t)
    929 	 (kill-buffer (org-capture-get :kill-buffer 'local))
    930 	 (jump-to-captured (org-capture-get :jump-to-captured 'local))
    931 	 (refile-targets (org-capture-get :refile-targets 'local)))
    932     ;; Since `org-capture-finalize' may alter buffer contents (e.g.,
    933     ;; empty lines) around entry, use a marker to refer to the
    934     ;; headline to be refiled.  Place the marker in the base buffer,
    935     ;; as the current indirect one is going to be killed.
    936     (set-marker pos (save-excursion (org-back-to-heading t) (point)) base)
    937     ;; `org-capture-finalize' calls `org-capture-goto-last-stored' too
    938     ;; early.  We want to wait for the refiling to be over, so we
    939     ;; control when the latter function is called.
    940     (org-capture-put :kill-buffer nil :jump-to-captured nil)
    941     (let ((org-refile-targets (or refile-targets org-refile-targets)))
    942       (org-capture-finalize)
    943       (save-window-excursion
    944         (with-current-buffer base
    945 	  (org-with-point-at pos
    946 	    (call-interactively 'org-refile)))))
    947     (when kill-buffer
    948       (with-current-buffer base (save-buffer))
    949       (kill-buffer base))
    950     (when jump-to-captured (org-capture-goto-last-stored))))
    951 
    952 (defun org-capture-kill ()
    953   "Abort the current capture process."
    954   (interactive)
    955   ;; FIXME: This does not do the right thing, we need to remove the
    956   ;; new stuff by hand it is easy: undo, then kill the buffer
    957   (let ((org-note-abort t)
    958 	(org-capture-before-finalize-hook nil))
    959     (org-capture-finalize)))
    960 
    961 (defun org-capture-goto-last-stored ()
    962   "Go to the location where the last capture note was stored."
    963   (interactive)
    964   (org-goto-marker-or-bmk org-capture-last-stored-marker
    965 			  (plist-get org-bookmark-names-plist
    966 				     :last-capture))
    967   (message "This is the last note stored by a capture process"))
    968 
    969 ;;; Supporting functions for handling the process
    970 
    971 (defun org-capture-put-target-region-and-position ()
    972   "Store the initial region with `org-capture-put'."
    973   (org-capture-put
    974    :initial-target-region
    975    ;; Check if the buffer is currently narrowed
    976    (when (org-buffer-narrowed-p)
    977      (cons (point-min) (point-max))))
    978   ;; store the current point
    979   (org-capture-put :initial-target-position (point)))
    980 
    981 (defvar org-time-was-given) ; dynamically scoped parameter
    982 (defun org-capture-set-target-location (&optional target)
    983   "Find TARGET buffer and position.
    984 Store them in the capture property list."
    985   (let ((target-entry-p t))
    986     (save-excursion
    987       (pcase (or target (org-capture-get :target))
    988 	(`here
    989 	 (org-capture-put :exact-position (point) :insert-here t))
    990 	(`(file ,path)
    991 	 (set-buffer (org-capture-target-buffer path))
    992 	 (org-capture-put-target-region-and-position)
    993 	 (widen)
    994 	 (setq target-entry-p nil))
    995 	(`(id ,id)
    996 	 (pcase (org-id-find id)
    997 	   (`(,path . ,position)
    998 	    (set-buffer (org-capture-target-buffer path))
    999 	    (widen)
   1000 	    (org-capture-put-target-region-and-position)
   1001 	    (goto-char position))
   1002 	   (_ (error "Cannot find target ID \"%s\"" id))))
   1003 	(`(file+headline ,path ,headline)
   1004 	 (set-buffer (org-capture-target-buffer path))
   1005 	 ;; Org expects the target file to be in Org mode, otherwise
   1006 	 ;; it throws an error.  However, the default notes files
   1007 	 ;; should work out of the box.  In this case, we switch it to
   1008 	 ;; Org mode.
   1009 	 (unless (derived-mode-p 'org-mode)
   1010 	   (org-display-warning
   1011 	    (format "Capture requirement: switching buffer %S to Org mode"
   1012 		    (current-buffer)))
   1013 	   (org-mode))
   1014 	 (org-capture-put-target-region-and-position)
   1015 	 (widen)
   1016 	 (goto-char (point-min))
   1017 	 (if (re-search-forward (format org-complex-heading-regexp-format
   1018 					(regexp-quote headline))
   1019 				nil t)
   1020 	     (beginning-of-line)
   1021 	   (goto-char (point-max))
   1022 	   (unless (bolp) (insert "\n"))
   1023 	   (insert "* " headline "\n")
   1024 	   (beginning-of-line 0)))
   1025 	(`(file+olp ,path . ,outline-path)
   1026 	 (let ((m (org-find-olp (cons (org-capture-expand-file path)
   1027 				      outline-path))))
   1028 	   (set-buffer (marker-buffer m))
   1029 	   (org-capture-put-target-region-and-position)
   1030 	   (widen)
   1031 	   (goto-char m)
   1032 	   (set-marker m nil)))
   1033 	(`(file+regexp ,path ,regexp)
   1034 	 (set-buffer (org-capture-target-buffer path))
   1035 	 (org-capture-put-target-region-and-position)
   1036 	 (widen)
   1037 	 (goto-char (point-min))
   1038 	 (if (not (re-search-forward regexp nil t))
   1039 	     (error "No match for target regexp in file %s" path)
   1040 	   (goto-char (if (org-capture-get :prepend)
   1041 			  (match-beginning 0)
   1042 			(match-end 0)))
   1043 	   (org-capture-put :exact-position (point))
   1044 	   (setq target-entry-p
   1045 		 (and (derived-mode-p 'org-mode) (org-at-heading-p)))))
   1046 	(`(file+olp+datetree ,path . ,outline-path)
   1047 	 (let ((m (if outline-path
   1048 		      (org-find-olp (cons (org-capture-expand-file path)
   1049 					  outline-path))
   1050 		    (set-buffer (org-capture-target-buffer path))
   1051 		    (point-marker))))
   1052 	   (set-buffer (marker-buffer m))
   1053 	   (org-capture-put-target-region-and-position)
   1054 	   (widen)
   1055 	   (goto-char m)
   1056 	   (set-marker m nil)
   1057 	   (require 'org-datetree)
   1058 	   (org-capture-put-target-region-and-position)
   1059 	   (widen)
   1060 	   ;; Make a date/week tree entry, with the current date (or
   1061 	   ;; yesterday, if we are extending dates for a couple of
   1062 	   ;; hours)
   1063 	   (funcall
   1064 	    (pcase (org-capture-get :tree-type)
   1065 	      (`week #'org-datetree-find-iso-week-create)
   1066 	      (`month #'org-datetree-find-month-create)
   1067 	      (_ #'org-datetree-find-date-create))
   1068 	    (calendar-gregorian-from-absolute
   1069 	     (cond
   1070 	      (org-overriding-default-time
   1071 	       ;; Use the overriding default time.
   1072 	       (time-to-days org-overriding-default-time))
   1073 	      ((or (org-capture-get :time-prompt)
   1074 		   (equal current-prefix-arg 1))
   1075                ;; Prompt for date.  Bind `org-end-time-was-given' so
   1076                ;; that `org-read-date-analyze' handles the time range
   1077                ;; case and returns `prompt-time' with the start value.
   1078                (let* ((org-time-was-given nil)
   1079                       (org-end-time-was-given nil)
   1080                       (prompt-time (org-read-date
   1081 				    nil t nil "Date for tree entry:")))
   1082 		 (org-capture-put
   1083 		  :default-time
   1084                   (if (or org-time-was-given
   1085                           (= (time-to-days prompt-time) (org-today)))
   1086                       prompt-time
   1087                     ;; Use 00:00 when no time is given for another
   1088                     ;; date than today?
   1089                     (org-encode-time
   1090                      (apply #'list
   1091                             0 0 org-extend-today-until
   1092                             (cl-cdddr (decode-time prompt-time))))))
   1093 		 (time-to-days prompt-time)))
   1094 	      (t
   1095 	       ;; Current date, possibly corrected for late night
   1096 	       ;; workers.
   1097 	       (org-today))))
   1098 	    ;; the following is the keep-restriction argument for
   1099 	    ;; org-datetree-find-date-create
   1100 	    (when outline-path 'subtree-at-point))))
   1101 	(`(file+function ,path ,function)
   1102 	 (set-buffer (org-capture-target-buffer path))
   1103 	 (org-capture-put-target-region-and-position)
   1104 	 (widen)
   1105 	 (funcall function)
   1106 	 (org-capture-put :exact-position (point))
   1107 	 (setq target-entry-p
   1108 	       (and (derived-mode-p 'org-mode) (org-at-heading-p))))
   1109 	(`(function ,fun)
   1110 	 (funcall fun)
   1111 	 (org-capture-put :exact-position (point))
   1112 	 (setq target-entry-p
   1113 	       (and (derived-mode-p 'org-mode) (org-at-heading-p))))
   1114 	(`(clock)
   1115 	 (if (and (markerp org-clock-hd-marker)
   1116 		  (marker-buffer org-clock-hd-marker))
   1117 	     (progn (set-buffer (marker-buffer org-clock-hd-marker))
   1118 		    (org-capture-put-target-region-and-position)
   1119 		    (widen)
   1120 		    (goto-char org-clock-hd-marker))
   1121 	   (user-error "No running clock that could be used as capture target")))
   1122 	(target (error "Invalid capture target specification: %S" target)))
   1123 
   1124       (org-capture-put :buffer (current-buffer)
   1125 		       :pos (point)
   1126 		       :target-entry-p target-entry-p
   1127 		       :decrypted
   1128 		       (and (featurep 'org-crypt)
   1129 			    (org-at-encrypted-entry-p)
   1130 			    (save-excursion
   1131 			      (org-decrypt-entry)
   1132 			      (and (org-back-to-heading t) (point))))))))
   1133 
   1134 (defun org-capture-expand-file (file)
   1135   "Expand functions, symbols and file names for FILE.
   1136 When FILE is a function, call it.  When it is a form, evaluate
   1137 it.  When it is a variable, return its value.  When it is
   1138 a string, treat it as a file name, possibly expanding it
   1139 according to `org-directory', and return it.  If it is the empty
   1140 string, however, return `org-default-notes-file'.  In any other
   1141 case, raise an error."
   1142   (let ((location (cond ((equal file "") org-default-notes-file)
   1143 			((stringp file) (expand-file-name file org-directory))
   1144 			((functionp file) (funcall file))
   1145 			((and (symbolp file) (boundp file)) (symbol-value file))
   1146 			(t nil))))
   1147     (or (org-string-nw-p location)
   1148 	(error "Invalid file location: %S" location))))
   1149 
   1150 (defun org-capture-target-buffer (file)
   1151   "Get a buffer for FILE.
   1152 FILE is a generalized file location, as handled by
   1153 `org-capture-expand-file'."
   1154   (let ((file (org-capture-expand-file file)))
   1155     (or (org-find-base-buffer-visiting file)
   1156 	(progn (org-capture-put :new-buffer t)
   1157 	       (find-file-noselect file)))))
   1158 
   1159 (defun org-capture-place-template (&optional inhibit-wconf-store)
   1160   "Insert the template at the target location, and display the buffer.
   1161 When INHIBIT-WCONF-STORE is non-nil, don't store the window configuration, as it
   1162 may have been stored before."
   1163   (unless inhibit-wconf-store
   1164     (org-capture-put :return-to-wconf (current-window-configuration)))
   1165   (delete-other-windows)
   1166   (org-switch-to-buffer-other-window
   1167    (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE"))
   1168   (widen)
   1169   (org-fold-show-all)
   1170   (goto-char (org-capture-get :pos))
   1171   (setq-local outline-level 'org-outline-level)
   1172   (pcase (org-capture-get :type)
   1173     ((or `nil `entry) (org-capture-place-entry))
   1174     (`table-line (org-capture-place-table-line))
   1175     (`plain (org-capture-place-plain-text))
   1176     (`item (org-capture-place-item))
   1177     (`checkitem (org-capture-place-item)))
   1178   (setq-local org-capture-current-plist org-capture-plist)
   1179   (org-capture--run-template-functions :hook 'local)
   1180   (org-capture-mode 1))
   1181 
   1182 (defun org-capture-place-entry ()
   1183   "Place the template as a new Org entry."
   1184   (let ((template (org-capture-get :template))
   1185 	(reversed? (org-capture-get :prepend))
   1186 	(exact-position (org-capture-get :exact-position))
   1187 	(insert-here? (org-capture-get :insert-here))
   1188 	(level 1))
   1189     (org-capture-verify-tree template)
   1190     (when exact-position (goto-char exact-position))
   1191     (cond
   1192      ;; Force insertion at point.
   1193      (insert-here?
   1194       ;; FIXME: level should probably set directly within (let ...).
   1195       (setq level (org-get-valid-level
   1196                    (if (or (org-at-heading-p)
   1197                            (ignore-errors
   1198 			     (save-excursion (org-back-to-heading t))))
   1199                        (org-outline-level)
   1200                      1))))
   1201      ;; Insert as a child of the current entry.
   1202      ((org-capture-get :target-entry-p)
   1203       (setq level (org-get-valid-level
   1204 		   (if (org-at-heading-p) (org-outline-level) 1)
   1205 		   1))
   1206       (if reversed? (outline-next-heading) (org-end-of-subtree t t)))
   1207      ;; Insert as a top-level entry at the beginning of the file.
   1208      (reversed?
   1209       (goto-char (point-min))
   1210       (unless (org-at-heading-p) (outline-next-heading)))
   1211      ;; Otherwise, insert as a top-level entry at the end of the file.
   1212      (t (goto-char (point-max))
   1213         ;; Make sure that last point is not folded.
   1214         (org-fold-core-cycle-over-indirect-buffers
   1215           (org-fold-region (max 1 (1- (point-max))) (point-max) nil))))
   1216     (let ((origin (point-marker)))
   1217       (unless (bolp) (insert "\n"))
   1218       (org-capture-empty-lines-before)
   1219       (let ((beg (point)))
   1220 	(save-restriction
   1221 	  (when insert-here? (narrow-to-region beg beg))
   1222 	  (org-paste-subtree level template 'for-yank))
   1223 	(org-capture-position-for-last-stored beg)
   1224 	(org-capture-empty-lines-after)
   1225 	(unless (org-at-heading-p) (outline-next-heading))
   1226 	(org-capture-mark-kill-region origin (point))
   1227 	(org-capture-narrow beg (if (eobp) (point) (1- (point))))
   1228 	(org-capture--position-cursor beg (point))))))
   1229 
   1230 (defun org-capture-place-item ()
   1231   "Place the template as a new plain list item."
   1232   (let ((prepend? (org-capture-get :prepend))
   1233 	(template (org-remove-indentation (org-capture-get :template)))
   1234 	item)
   1235     ;; Make template suitable for insertion.  In particular, add
   1236     ;; a main bullet if it is missing.
   1237     (unless (string-match-p (concat "\\`" (org-item-re)) template)
   1238       (setq template (concat "- " (mapconcat #'identity
   1239 					     (split-string template "\n")
   1240 					     "\n  "))))
   1241     ;; Delimit the area where we should look for a plain list.
   1242     (pcase-let ((`(,beg . ,end)
   1243 		 (cond ((org-capture-get :exact-position)
   1244 			;; User gave a specific position.  Start
   1245 			;; looking for lists from here.
   1246 			(org-with-point-at (org-capture-get :exact-position)
   1247 			  (cons (line-beginning-position)
   1248 				(if (org-capture-get :insert-here)
   1249 				    (line-beginning-position)
   1250 				  (org-entry-end-position)))))
   1251 		       ((org-capture-get :target-entry-p)
   1252 			;; At a heading, limit search to its body.
   1253 			(cons (line-beginning-position 2)
   1254 			      (org-entry-end-position)))
   1255 		       (t
   1256 			;; Table is not necessarily under a heading.
   1257 			;; Search whole buffer.
   1258 			(cons (point-min) (point-max))))))
   1259       ;; Find the first plain list in the delimited area.
   1260       (goto-char beg)
   1261       (let ((item-regexp (org-item-beginning-re)))
   1262 	(catch :found
   1263 	  (while (re-search-forward item-regexp end t)
   1264 	    (when (setq item (org-element-lineage
   1265 			      (org-element-at-point) '(plain-list) t))
   1266 	      (goto-char (org-element-property (if prepend? :post-affiliated
   1267 						 :contents-end)
   1268 					       item))
   1269 	      (throw :found t)))
   1270 	  ;; No list found.  Move to the location when to insert
   1271 	  ;; template.  Skip planning info and properties drawers, if
   1272 	  ;; any.
   1273 	  (goto-char (cond ((org-capture-get :insert-here) beg)
   1274 			   ((not prepend?) end)
   1275 			   ((org-before-first-heading-p) beg)
   1276 			   (t (max (save-excursion
   1277 				     (org-end-of-meta-data)
   1278 				     (point))
   1279 				   beg)))))))
   1280     ;; Insert template.
   1281     (let ((origin (point-marker)))
   1282       (unless (bolp) (insert "\n"))
   1283       ;; When a new list is created, always obey to `:empty-lines' and
   1284       ;; friends.
   1285       ;;
   1286       ;; When capturing in an existing list, do not change blank lines
   1287       ;; above or below the list; consider it to be a stable
   1288       ;; structure.  However, we can control how many blank lines
   1289       ;; separate items.  So obey to `:empty-lines' between items as
   1290       ;; long as it does not insert more than one empty line.  In the
   1291       ;; specific case of empty lines above, it means we only obey the
   1292       ;; parameter when appending an item.
   1293       (unless (and item prepend?)
   1294 	(org-capture-empty-lines-before
   1295 	 (and item
   1296 	      (not prepend?)
   1297 	      (min 1 (or (org-capture-get :empty-lines-before)
   1298 			 (org-capture-get :empty-lines)
   1299 			 0)))))
   1300       (org-capture-position-for-last-stored (point))
   1301       (let ((beg (line-beginning-position))
   1302 	    (end (progn
   1303 		   (insert (org-trim template) "\n")
   1304 		   (point-marker))))
   1305 	(when item
   1306 	  (let ((i (save-excursion
   1307 		     (goto-char (org-element-property :post-affiliated item))
   1308 		     (org-current-text-indentation))))
   1309 	    (save-excursion
   1310 	      (goto-char beg)
   1311 	      (save-excursion
   1312 		(while (< (point) end)
   1313 		  (indent-to i)
   1314 		  (forward-line)))
   1315 	      ;; Pre-pending an item could change the type of the list
   1316 	      ;; if there is a mismatch.  In this situation,
   1317 	      ;; prioritize the existing list.
   1318 	      (when prepend?
   1319 		(let ((ordered? (eq 'ordered (org-element-property :type item))))
   1320 		  (when (org-xor ordered?
   1321 				 (string-match-p "\\`[A-Za-z0-9]\\([.)]\\)"
   1322 						 template))
   1323 		    (org-cycle-list-bullet (if ordered? "1." "-")))))
   1324 	      ;; Eventually repair the list for proper indentation and
   1325 	      ;; bullets.
   1326 	      (org-list-repair))))
   1327 	;; Limit number of empty lines.  See above for details.
   1328 	(unless (and item (not prepend?))
   1329 	  (org-capture-empty-lines-after
   1330 	   (and item
   1331 		prepend?
   1332 		(min 1 (or (org-capture-get :empty-lines-after)
   1333 			   (org-capture-get :empty-lines)
   1334 			   0)))))
   1335 	(org-capture-mark-kill-region origin (point))
   1336 	;; ITEM always end with a newline character.  Make sure we do
   1337 	;; not narrow at the beginning of the next line, possibly
   1338 	;; altering its structure (e.g., when it is a headline).
   1339 	(org-capture-narrow beg (1- end))
   1340 	(org-capture--position-cursor beg end)))))
   1341 
   1342 (defun org-capture-place-table-line ()
   1343   "Place the template as a table line."
   1344   (require 'org-table)
   1345   (let ((text
   1346 	 (pcase (org-trim (org-capture-get :template))
   1347 	   ((pred (string-match-p org-table-border-regexp))
   1348 	    "| %?Bad template |")
   1349 	   (text (concat text "\n"))))
   1350 	(table-line-pos (org-capture-get :table-line-pos))
   1351 	beg end)
   1352     (cond
   1353      ((org-capture-get :exact-position)
   1354       (org-with-point-at (org-capture-get :exact-position)
   1355 	(setq beg (line-beginning-position))
   1356 	(setq end (if (org-capture-get :insert-here) beg
   1357 		    (org-entry-end-position)))))
   1358      ((not (org-capture-get :target-entry-p))
   1359       ;; Table is not necessarily under a heading.  Find first table
   1360       ;; in the buffer.
   1361       (setq beg (point-min) end (point-max)))
   1362      (t
   1363       ;; We are at a heading, limit search to the body.
   1364       (setq beg (line-beginning-position 2))
   1365       (setq end (save-excursion (outline-next-heading) (point)))))
   1366     (goto-char beg)
   1367     ;; Narrow to the table, possibly creating one if necessary.
   1368     (catch :found
   1369       (while (re-search-forward org-table-dataline-regexp end t)
   1370 	(pcase (org-element-lineage (org-element-at-point) '(table) t)
   1371 	  (`nil nil)
   1372 	  ((pred (lambda (e) (eq 'table.el (org-element-property :type e))))
   1373 	   nil)
   1374 	  (table
   1375 	   (goto-char (org-element-property :contents-end table))
   1376 	   (narrow-to-region (org-element-property :post-affiliated table)
   1377 			     (point))
   1378 	   (throw :found t))))
   1379       ;; No table found.  Create it with an empty header.
   1380       (goto-char end)
   1381       (unless (bolp) (insert "\n"))
   1382       (let ((origin (point-marker)))
   1383 	(insert "|   |\n|---|\n")
   1384 	(narrow-to-region origin (point))))
   1385     ;; In the current table, find the appropriate location for TEXT.
   1386     (cond
   1387      ((org-capture-get :insert-here) nil)
   1388      ((and table-line-pos
   1389 	   (string-match "\\(I+\\)\\([-+][0-9]+\\)" table-line-pos))
   1390       (goto-char (point-min))
   1391       (let ((line
   1392 	     (condition-case _
   1393 		 (progn
   1394 		   (save-match-data (org-table-analyze))
   1395 		   (aref org-table-hlines
   1396 			 (- (match-end 1) (match-beginning 1))))
   1397 	       (error
   1398 		(error "Invalid table line specification %S" table-line-pos))))
   1399 	    (delta (string-to-number (match-string 2 table-line-pos))))
   1400 	(forward-line (+ line delta (if (< delta 0) 0 -1)))
   1401 	(forward-line)))		;insert below
   1402      ((org-capture-get :prepend)
   1403       (goto-char (point-min))
   1404       (cond
   1405        ((not (re-search-forward org-table-hline-regexp nil t)))
   1406        ((re-search-forward org-table-dataline-regexp nil t) (beginning-of-line))
   1407        (t (goto-char (org-table-end)))))
   1408      (t
   1409       (goto-char (org-table-end))))
   1410     ;; Insert text and position point according to template.
   1411     (let ((origin (point-marker)))
   1412       (unless (bolp) (insert "\n"))
   1413       (let ((beg (point))
   1414 	    (end (save-excursion
   1415 		   (insert text)
   1416 		   (point))))
   1417 	(org-capture-position-for-last-stored 'table-line)
   1418 	(org-capture-mark-kill-region origin end)
   1419 	;; TEXT is guaranteed to end with a newline character.  Ignore
   1420 	;; it when narrowing so as to not alter data on the next line.
   1421 	(org-capture-narrow beg (1- end))
   1422 	(org-capture--position-cursor beg (1- end))))))
   1423 
   1424 (defun org-capture-place-plain-text ()
   1425   "Place the template plainly.
   1426 If the target locator points at an Org node, place the template into
   1427 the text of the entry, before the first child.  If not, place the
   1428 template at the beginning or end of the file.
   1429 Of course, if exact position has been required, just put it there."
   1430   (cond
   1431    ((org-capture-get :exact-position)
   1432     (goto-char (org-capture-get :exact-position)))
   1433    ((org-capture-get :target-entry-p)
   1434     ;; Place the text into this entry.
   1435     (if (org-capture-get :prepend)
   1436 	;; Skip meta data and drawers.
   1437 	(org-end-of-meta-data t)
   1438       ;; Go to end of the entry text, before the next headline.
   1439       (outline-next-heading)))
   1440    (t
   1441     ;; Beginning or end of file.
   1442     (goto-char (if (org-capture-get :prepend) (point-min) (point-max)))))
   1443   (let ((origin (point-marker)))
   1444     (unless (bolp) (insert "\n"))
   1445     (org-capture-empty-lines-before)
   1446     (org-capture-position-for-last-stored (point))
   1447     (let ((beg (point)))
   1448       (insert (org-capture-get :template))
   1449       (unless (bolp) (insert "\n"))
   1450       ;; Ignore the final newline character so as to not alter data
   1451       ;; after inserted text.  Yet, if the template is empty, make
   1452       ;; sure END matches BEG instead of pointing before it.
   1453       (let ((end (max beg (1- (point)))))
   1454 	(org-capture-empty-lines-after)
   1455 	(org-capture-mark-kill-region origin (point))
   1456 	(org-capture-narrow beg end)
   1457 	(org-capture--position-cursor beg end)))))
   1458 
   1459 (defun org-capture-mark-kill-region (beg end)
   1460   "Mark region between BEG and END to be killed on aborted capture."
   1461   (let ((m1 (copy-marker beg))
   1462 	(m2 (copy-marker end t)))
   1463     (org-capture-put :begin-marker m1)
   1464     (org-capture-put :end-marker m2)))
   1465 
   1466 (defun org-capture-position-for-last-stored (position)
   1467   "Put POSITION on `org-capture-plist' for future use as `last capture`."
   1468   (cond
   1469    ((integerp position)
   1470     (org-capture-put :position-for-last-stored
   1471 		     (move-marker (make-marker) position
   1472 				  (or (buffer-base-buffer (current-buffer))
   1473 				      (current-buffer)))))
   1474    ((eq position 'table-line)
   1475     (org-capture-put :position-for-last-stored
   1476 		     (list 'table-line
   1477 			   (org-table-current-dline))))
   1478    (t (error "This should not happen"))))
   1479 
   1480 (defun org-capture-store-last-position ()
   1481   "Store the last-captured position."
   1482   (let* ((where (org-capture-get :position-for-last-stored 'local))
   1483 	 (pos (cond
   1484 	       ((markerp where)
   1485 		(prog1 (marker-position where)
   1486 		  (move-marker where nil)))
   1487 	       ((and (listp where) (eq (car where) 'table-line))
   1488 		(if (org-at-table-p)
   1489 		    (save-excursion
   1490 		      (org-table-goto-line (nth 1 where))
   1491                       (line-beginning-position))
   1492 		  (point))))))
   1493     (with-current-buffer (buffer-base-buffer (current-buffer))
   1494       (org-with-point-at pos
   1495 	(when org-capture-bookmark
   1496 	  (let ((bookmark (plist-get org-bookmark-names-plist :last-capture)))
   1497 	    (when bookmark (with-demoted-errors "Bookmark set error: %S"
   1498 	                     (bookmark-set bookmark)))))
   1499 	(move-marker org-capture-last-stored-marker (point))))))
   1500 
   1501 (defun org-capture-narrow (beg end)
   1502   "Possibly narrow to region between BEG and END.
   1503 If configuration contains non-nil :unnarrowed property, do not narrow."
   1504   (unless (org-capture-get :unnarrowed)
   1505     (narrow-to-region beg end)))
   1506 
   1507 (defun org-capture--position-cursor (beg end)
   1508   "Move point to first \"%?\" location or at start of template.
   1509 BEG and END are buffer positions at the beginning and end position
   1510 of the template."
   1511   (goto-char beg)
   1512   (when (search-forward "%?" end t)
   1513     (replace-match "")))
   1514 
   1515 (defun org-capture-empty-lines-before (&optional n)
   1516   "Insert N empty lines before the insertion point.
   1517 Point will be after the empty lines, so insertion can directly be done.
   1518 If N is nil, :empty-lines-before or :empty-lines are considered."
   1519   (setq n (or n (org-capture-get :empty-lines-before)
   1520 	      (org-capture-get :empty-lines) 0))
   1521   (let ((pos (point)))
   1522     (org-back-over-empty-lines)
   1523     (delete-region (point) pos)
   1524     (when (> n 0) (newline n))))
   1525 
   1526 (defun org-capture-empty-lines-after (&optional n)
   1527   "Set the correct number of empty lines after the inserted string.
   1528 Point will remain at the first line after the inserted text.
   1529 If N is nil, :empty-lines-after or :empty-lines are considered."
   1530   (setq n (or n (org-capture-get :empty-lines-after)
   1531 	      (org-capture-get :empty-lines) 0))
   1532   (org-back-over-empty-lines)
   1533   (while (looking-at "[ \t]*\n") (replace-match ""))
   1534   (let ((pos (point)))
   1535     (when (> n 0) (newline n))
   1536     (goto-char pos)))
   1537 
   1538 (defvar org-clock-marker) ; Defined in org.el
   1539 
   1540 (defun org-capture-set-plist (entry)
   1541   "Initialize the property list for ENTRY from the template definition."
   1542   (setq org-capture-plist (copy-sequence (nthcdr 5 entry)))
   1543   (org-capture-put :key (car entry) :description (nth 1 entry)
   1544 		   :target (nth 3 entry))
   1545   (let ((txt (nth 4 entry)) (type (or (nth 2 entry) 'entry)))
   1546     (when (or (not txt) (and (stringp txt) (not (string-match "\\S-" txt))))
   1547       ;; The template may be empty or omitted for special types.
   1548       ;; Here we insert the default templates for such cases.
   1549       (cond
   1550        ((eq type 'item) (setq txt "- %?"))
   1551        ((eq type 'checkitem) (setq txt "- [ ] %?"))
   1552        ((eq type 'table-line) (setq txt "| %? |"))
   1553        ((member type '(nil entry)) (setq txt "* %?\n  %a"))))
   1554     (org-capture-put :template txt :type type)))
   1555 
   1556 (defun org-capture-goto-target (&optional template-key)
   1557   "Go to the target location of a capture template.
   1558 If TEMPLATE-KEY is nil, the user is queried for the template."
   1559   (interactive)
   1560   (let ((entry (org-capture-select-template template-key)))
   1561     (unless entry (error "No capture template selected"))
   1562     (org-capture-set-plist entry)
   1563     (org-capture-set-target-location)
   1564     (pop-to-buffer-same-window (org-capture-get :buffer))
   1565     (goto-char (org-capture-get :pos))))
   1566 
   1567 (defun org-capture-get-indirect-buffer (&optional buffer prefix)
   1568   "Make an indirect BUFFER for a capture process.
   1569 Use PREFIX as a prefix for the name of the indirect buffer."
   1570   (setq buffer (or buffer (current-buffer)))
   1571   (let ((n 1) (base (buffer-name buffer)) bname)
   1572     (setq bname (concat prefix "-" base))
   1573     (while (buffer-live-p (get-buffer bname))
   1574       (setq bname (concat prefix "-" (number-to-string (cl-incf n)) "-" base)))
   1575     (condition-case nil
   1576         (make-indirect-buffer buffer bname 'clone)
   1577       (error
   1578        (let ((buf (make-indirect-buffer buffer bname)))
   1579 	 (with-current-buffer buf (org-mode))
   1580 	 buf)))))
   1581 
   1582 (defun org-capture-verify-tree (tree)
   1583   "Throw error if TREE is not a valid tree."
   1584   (unless (org-kill-is-subtree-p tree)
   1585     (error "Template is not a valid Org entry or tree")))
   1586 
   1587 ;;; The template code
   1588 (defun org-capture-select-template (&optional keys)
   1589   "Select a capture template.
   1590 Lisp programs can force the template by setting KEYS to a string."
   1591   (let ((org-capture-templates
   1592 	 (or (org-contextualize-keys
   1593 	      (org-capture-upgrade-templates org-capture-templates)
   1594 	      org-capture-templates-contexts)
   1595 	     '(("t" "Task" entry (file+headline "" "Tasks")
   1596 		"* TODO %?\n  %u\n  %a")))))
   1597     (if keys
   1598 	(or (assoc keys org-capture-templates)
   1599 	    (error "No capture template referred to by \"%s\" keys" keys))
   1600       (org-mks org-capture-templates
   1601 	       "Select a capture template\n========================="
   1602 	       "Template key: "
   1603 	       '(("C" "Customize org-capture-templates")
   1604 		 ("q" "Abort"))))))
   1605 
   1606 (defvar org-capture--clipboards nil
   1607   "List various clipboards values.")
   1608 
   1609 (defun org-capture-fill-template (&optional template initial annotation)
   1610   "Fill a TEMPLATE and return the filled template as a string.
   1611 The template may still contain \"%?\" for cursor positioning.
   1612 INITIAL content and/or ANNOTATION may be specified, but will be overridden
   1613 by their respective `org-store-link-plist' properties if present.
   1614 
   1615 Expansion occurs in a temporary Org mode buffer."
   1616   (let* ((template (or template (org-capture-get :template)))
   1617 	 (buffer (org-capture-get :buffer))
   1618 	 (file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
   1619 	 (time (let* ((c (or (org-capture-get :default-time) (current-time)))
   1620 		      (d (decode-time c)))
   1621 		 (if (< (nth 2 d) org-extend-today-until)
   1622 		     (org-encode-time 0 59 23 (1- (nth 3 d)) (nth 4 d) (nth 5 d))
   1623 		   c)))
   1624 	 (v-t (format-time-string (org-time-stamp-format nil) time))
   1625 	 (v-T (format-time-string (org-time-stamp-format t) time))
   1626 	 (v-u (format-time-string (org-time-stamp-format nil t) time))
   1627 	 (v-U (format-time-string (org-time-stamp-format t t) time))
   1628 	 (v-c (and kill-ring (current-kill 0)))
   1629 	 (v-x (or (org-get-x-clipboard 'PRIMARY)
   1630 		  (org-get-x-clipboard 'CLIPBOARD)
   1631 		  (org-get-x-clipboard 'SECONDARY)
   1632 		  ""))			;ensure it is a string
   1633 	 ;; `initial' and `annotation' might have been passed.  But if
   1634 	 ;; the property list has them, we prefer those values.
   1635 	 (v-i (or (plist-get org-store-link-plist :initial)
   1636 		  (and (stringp initial) (org-no-properties initial))
   1637 		  (org-capture-get :initial)
   1638 		  ""))
   1639 	 (v-a
   1640 	  (let ((a (or (plist-get org-store-link-plist :annotation)
   1641 		       annotation
   1642 		       (org-capture-get :annotation)
   1643 		       "")))
   1644 	    ;; Is the link empty?  Then we do not want it...
   1645 	    (if (equal a "[[]]") "" a)))
   1646 	 (l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]")
   1647 	 (v-A (if (and v-a (string-match l-re v-a))
   1648 		  (replace-match "[[\\1][%^{Link description}]]" nil nil v-a)
   1649 		v-a))
   1650 	 (v-l (if (and v-a (string-match l-re v-a))
   1651 		  (replace-match "[[\\1]]" nil nil v-a)
   1652 		v-a))
   1653 	 (v-L (if (and v-a (string-match l-re v-a))
   1654 		  (replace-match "\\1" nil nil v-a)
   1655 		v-a))
   1656 	 (v-n user-full-name)
   1657 	 (v-k (if (marker-buffer org-clock-marker)
   1658 		  (org-no-properties org-clock-heading)
   1659 		""))
   1660 	 (v-K (if (marker-buffer org-clock-marker)
   1661 		  (org-link-make-string
   1662 		   (format "%s::*%s"
   1663 			   (buffer-file-name (marker-buffer org-clock-marker))
   1664 			   v-k)
   1665 		   v-k)
   1666 		""))
   1667 	 (v-f (or (org-capture-get :original-file-nondirectory) ""))
   1668 	 (v-F (or (org-capture-get :original-file) ""))
   1669 	 (org-capture--clipboards
   1670 	  (delq nil
   1671 		(list v-i
   1672 		      (org-get-x-clipboard 'PRIMARY)
   1673 		      (org-get-x-clipboard 'CLIPBOARD)
   1674 		      (org-get-x-clipboard 'SECONDARY)
   1675 		      v-c))))
   1676     (setq org-store-link-plist (plist-put org-store-link-plist :annotation v-a))
   1677     (setq org-store-link-plist (plist-put org-store-link-plist :initial v-i))
   1678     (unless template
   1679       (setq template "")
   1680       (message "no template") (ding)
   1681       (sit-for 1))
   1682     (save-window-excursion
   1683       (org-switch-to-buffer-other-window (get-buffer-create "*Capture*"))
   1684       (erase-buffer)
   1685       (setq buffer-file-name nil)
   1686       (setq mark-active nil)
   1687       (insert template)
   1688       (org-mode)
   1689       (goto-char (point-min))
   1690       ;; %[] insert contents of a file.
   1691       (save-excursion
   1692 	(while (re-search-forward "%\\[\\(.+\\)\\]" nil t)
   1693 	  (let ((filename (expand-file-name (match-string 1)))
   1694 		(beg (copy-marker (match-beginning 0)))
   1695 		(end (copy-marker (match-end 0))))
   1696 	    (unless (org-capture-escaped-%)
   1697 	      (delete-region beg end)
   1698 	      (set-marker beg nil)
   1699 	      (set-marker end nil)
   1700 	      (condition-case error
   1701 		  (insert-file-contents filename)
   1702 		(error
   1703 		 (insert (format "%%![could not insert %s: %s]"
   1704 				 filename
   1705 				 error))))))))
   1706       ;; Mark %() embedded elisp for later evaluation.
   1707       (org-capture-expand-embedded-elisp 'mark)
   1708       ;; Expand non-interactive templates.
   1709       (let ((regexp "%\\(:[-A-Za-z]+\\|<\\([^>\n]+\\)>\\|[aAcfFikKlLntTuUx]\\)"))
   1710 	(save-excursion
   1711 	  (while (re-search-forward regexp nil t)
   1712 	    ;; `org-capture-escaped-%' may modify buffer and cripple
   1713 	    ;; match-data.  Use markers instead.  Ditto for other
   1714 	    ;; templates.
   1715 	    (let ((pos (copy-marker (match-beginning 0)))
   1716 		  (end (copy-marker (match-end 0)))
   1717 		  (value (match-string 1))
   1718 		  (time-string (match-string 2)))
   1719 	      (unless (org-capture-escaped-%)
   1720 		(delete-region pos end)
   1721 		(set-marker pos nil)
   1722 		(set-marker end nil)
   1723 		(let* ((inside-sexp? (org-capture-inside-embedded-elisp-p))
   1724 		       (replacement
   1725 			(pcase (string-to-char value)
   1726 			  (?< (format-time-string time-string time))
   1727 			  (?:
   1728 			   (or (plist-get org-store-link-plist (intern value))
   1729 			       ""))
   1730 			  (?i
   1731 			   (if inside-sexp? v-i
   1732 			     ;; Outside embedded Lisp, repeat leading
   1733 			     ;; characters before initial place holder
   1734 			     ;; every line.
   1735 			     (let ((lead (concat "\n"
   1736 						 (org-current-line-string t))))
   1737 			       (replace-regexp-in-string "\n" lead v-i nil t))))
   1738 			  (?a v-a)
   1739 			  (?A v-A)
   1740 			  (?c v-c)
   1741 			  (?f v-f)
   1742 			  (?F v-F)
   1743 			  (?k v-k)
   1744 			  (?K v-K)
   1745 			  (?l v-l)
   1746 			  (?L v-L)
   1747 			  (?n v-n)
   1748 			  (?t v-t)
   1749 			  (?T v-T)
   1750 			  (?u v-u)
   1751 			  (?U v-U)
   1752 			  (?x v-x))))
   1753 		  (insert
   1754 		   (if inside-sexp?
   1755 		       ;; Escape sensitive characters.
   1756 		       (replace-regexp-in-string "[\\\"]" "\\\\\\&" replacement)
   1757 		     replacement))))))))
   1758       ;; Expand %() embedded Elisp.  Limit to Sexp originally marked.
   1759       (org-capture-expand-embedded-elisp)
   1760       ;; Expand interactive templates.  This is the last step so that
   1761       ;; template is mostly expanded when prompting happens.  Turn on
   1762       ;; Org mode and set local variables.  This is to support
   1763       ;; completion in interactive prompts.
   1764       (let ((org-inhibit-startup t)) (org-mode))
   1765       (org-clone-local-variables buffer "\\`org-")
   1766       (let (strings)			; Stores interactive answers.
   1767 	(save-excursion
   1768 	  (let ((regexp "%\\^\\(?:{\\([^}]*\\)}\\)?\\([CgGLptTuU]\\)?"))
   1769 	    (while (re-search-forward regexp nil t)
   1770 	      (let* ((items (and (match-end 1)
   1771 				 (save-match-data
   1772 				   (split-string (match-string-no-properties 1)
   1773 						 "|"))))
   1774 		     (key (match-string 2))
   1775 		     (beg (copy-marker (match-beginning 0)))
   1776 		     (end (copy-marker (match-end 0)))
   1777 		     (prompt (nth 0 items))
   1778 		     (default (nth 1 items))
   1779 		     (completions (nthcdr 2 items)))
   1780 		(unless (org-capture-escaped-%)
   1781 		  (delete-region beg end)
   1782 		  (set-marker beg nil)
   1783 		  (set-marker end nil)
   1784 		  (pcase key
   1785 		    ((or "G" "g")
   1786 		     (let* ((org-last-tags-completion-table
   1787 			     (org-global-tags-completion-table
   1788 			      (cond ((equal key "G") (org-agenda-files))
   1789 				    (file (list file))
   1790 				    (t nil))))
   1791 			    (org-add-colon-after-tag-completion t)
   1792 			    (ins (mapconcat
   1793 				  #'identity
   1794 				  (let ((crm-separator "[ \t]*:[ \t]*"))
   1795                                     (completing-read-multiple
   1796 				     (if prompt (concat prompt ": ") "Tags: ")
   1797 				     org-last-tags-completion-table nil nil nil
   1798 				     'org-tags-history))
   1799 				  ":")))
   1800 		       (when (org-string-nw-p ins)
   1801 			 (unless (eq (char-before) ?:) (insert ":"))
   1802 			 (insert ins)
   1803 			 (unless (eq (char-after) ?:) (insert ":"))
   1804 			 (when (org-at-heading-p) (org-align-tags)))))
   1805 		    ((or "C" "L")
   1806 		     (let ((insert-fun (if (equal key "C") #'insert
   1807 					 (lambda (s) (org-insert-link 0 s)))))
   1808 		       (pcase org-capture--clipboards
   1809 			 (`nil nil)
   1810 			 (`(,value) (funcall insert-fun value))
   1811 			 (`(,first-value . ,_)
   1812 			  (funcall insert-fun
   1813 				   (read-string "Clipboard/kill value: "
   1814 						first-value
   1815 						'org-capture--clipboards
   1816 						first-value)))
   1817 			 (_ (error "Invalid `org-capture--clipboards' value: %S"
   1818 				   org-capture--clipboards)))))
   1819 		    ("p"
   1820 		     ;; We remove keyword properties inherited from
   1821 		     ;; target buffer so `org-read-property-value' has
   1822 		     ;; a chance to find allowed values in sub-trees
   1823 		     ;; from the target buffer.
   1824 		     (setq-local org-keyword-properties nil)
   1825 		     (let* ((origin (set-marker (make-marker)
   1826 						(org-capture-get :pos)
   1827 						(org-capture-get :buffer)))
   1828 			    ;; Find location from where to get allowed
   1829 			    ;; values.  If `:target-entry-p' is
   1830 			    ;; non-nil, the current headline in the
   1831 			    ;; target buffer is going to be a parent
   1832 			    ;; headline, so location is fine.
   1833 			    ;; Otherwise, find the parent headline in
   1834 			    ;; the target buffer.
   1835 			    (pom (if (org-capture-get :target-entry-p) origin
   1836 				   (let ((level (progn
   1837 						  (while (org-up-heading-safe))
   1838 						  (org-current-level))))
   1839 				     (org-with-point-at origin
   1840 				       (let ((l (if (org-at-heading-p)
   1841 						    (org-current-level)
   1842 						  most-positive-fixnum)))
   1843 					 (while (and l (>= l level))
   1844 					   (setq l (org-up-heading-safe)))
   1845 					 (if l (point-marker)
   1846 					   (point-min-marker)))))))
   1847 			    (value
   1848 			     (org-read-property-value prompt pom default)))
   1849 		       (org-set-property prompt value)))
   1850 		    ((or "t" "T" "u" "U")
   1851 		     ;; These are the date/time related ones.
   1852 		     (let* ((upcase? (equal (upcase key) key))
   1853 			    (org-end-time-was-given nil)
   1854 			    (time (org-read-date upcase? t nil prompt)))
   1855 		       (org-insert-time-stamp
   1856 			time (or org-time-was-given upcase?)
   1857 			(member key '("u" "U"))
   1858 			nil nil (list org-end-time-was-given))))
   1859 		    (`nil
   1860 		     ;; Load history list for current prompt.
   1861 		     (setq org-capture--prompt-history
   1862 			   (gethash prompt org-capture--prompt-history-table))
   1863                      (push (org-completing-read
   1864                             (org-format-prompt (or prompt "Enter string") default)
   1865 			    completions
   1866 			    nil nil nil 'org-capture--prompt-history default)
   1867 			   strings)
   1868 		     (insert (car strings))
   1869 		     ;; Save updated history list for current prompt.
   1870 		     (puthash prompt org-capture--prompt-history
   1871 			      org-capture--prompt-history-table))
   1872 		    (_
   1873 		     (error "Unknown template placeholder: \"%%^%s\""
   1874 			    key))))))))
   1875 	;; Replace %n escapes with nth %^{...} string.
   1876 	(setq strings (nreverse strings))
   1877 	(save-excursion
   1878 	  (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t)
   1879 	    (unless (org-capture-escaped-%)
   1880 	      (replace-match
   1881 	       (nth (1- (string-to-number (match-string 1))) strings)
   1882 	       nil t)))))
   1883       ;; Make sure there are no empty lines before the text, and that
   1884       ;; it ends with a newline character or it is empty.
   1885       (skip-chars-forward " \t\n")
   1886       (delete-region (point-min) (line-beginning-position))
   1887       (goto-char (point-max))
   1888       (skip-chars-backward " \t\n")
   1889       (if (bobp) (delete-region (point) (line-end-position))
   1890 	(end-of-line)
   1891 	(delete-region (point) (point-max))
   1892 	(insert "\n"))
   1893       ;; Return the expanded template and kill the capture buffer.
   1894       (untabify (point-min) (point-max))
   1895       (set-buffer-modified-p nil)
   1896       (prog1 (buffer-substring-no-properties (point-min) (point-max))
   1897 	(kill-buffer (current-buffer))))))
   1898 
   1899 (defun org-capture-escaped-% ()
   1900   "Non-nil if % was escaped.
   1901 If yes, unescape it now.  Assume `match-data' contains the
   1902 placeholder to check."
   1903   (save-excursion
   1904     (goto-char (match-beginning 0))
   1905     (let ((n (abs (skip-chars-backward "\\\\"))))
   1906       (delete-char (/ (1+ n) 2))
   1907       (= (% n 2) 1))))
   1908 
   1909 (defun org-capture-expand-embedded-elisp (&optional mark)
   1910   "Evaluate embedded elisp %(sexp) and replace with the result.
   1911 When optional MARK argument is non-nil, mark Sexp with a text
   1912 property (`org-embedded-elisp') for later evaluation.  Only
   1913 marked Sexp are evaluated when this argument is nil."
   1914   (save-excursion
   1915     (goto-char (point-min))
   1916     (while (re-search-forward "%(" nil t)
   1917       (cond
   1918        ((get-text-property (match-beginning 0) 'org-embedded-elisp)
   1919 	(goto-char (match-beginning 0))
   1920 	(let ((template-start (point)))
   1921 	  (forward-char 1)
   1922 	  (let* ((sexp (read (current-buffer)))
   1923 		 (result (org-eval
   1924 			  (org-capture--expand-keyword-in-embedded-elisp
   1925 			   sexp))))
   1926 	    (delete-region template-start (point))
   1927 	    (cond
   1928 	     ((not result) nil)
   1929 	     ((stringp result) (insert result))
   1930 	     (t (error
   1931 		 "Capture template sexp `%s' must evaluate to string or nil"
   1932 		 sexp))))))
   1933        ((not mark) nil)
   1934        ;; Only mark valid and non-escaped sexp.
   1935        ((org-capture-escaped-%) nil)
   1936        (t
   1937 	(let ((end (with-syntax-table emacs-lisp-mode-syntax-table
   1938 		     (ignore-errors (scan-sexps (1- (point)) 1)))))
   1939 	  (when end
   1940 	    (put-text-property (- (point) 2) end 'org-embedded-elisp t))))))))
   1941 
   1942 (defun org-capture--expand-keyword-in-embedded-elisp (attr)
   1943   "Recursively replace capture link keywords in ATTR sexp.
   1944 Such keywords are prefixed with \"%:\".  See
   1945 `org-capture-template' for more information."
   1946   (cond ((consp attr)
   1947 	 (mapcar 'org-capture--expand-keyword-in-embedded-elisp attr))
   1948 	((symbolp attr)
   1949 	 (let* ((attr-symbol (symbol-name attr))
   1950 		(key (and (string-match "%\\(:.*\\)" attr-symbol)
   1951 			  (intern (match-string 1 attr-symbol)))))
   1952 	   (or (plist-get org-store-link-plist key)
   1953 	       attr)))
   1954 	(t attr)))
   1955 
   1956 (defun org-capture-inside-embedded-elisp-p ()
   1957   "Non-nil if point is inside of embedded elisp %(sexp).
   1958 Assume sexps have been marked with
   1959 `org-capture-expand-embedded-elisp' beforehand."
   1960   (get-text-property (point) 'org-embedded-elisp))
   1961 
   1962 ;;;###autoload
   1963 (defun org-capture-import-remember-templates ()
   1964   "Set `org-capture-templates' to be similar to `org-remember-templates'."
   1965   (interactive)
   1966   (when (and (yes-or-no-p
   1967 	      "Import old remember templates into org-capture-templates? ")
   1968 	     (yes-or-no-p
   1969 	      "Note that this will remove any templates currently defined in `org-capture-templates'.  Do you still want to go ahead? "))
   1970     (require 'org-remember)
   1971     (setq org-capture-templates
   1972 	  (mapcar
   1973 	   (lambda (entry)
   1974 	     (let ((desc (car entry))
   1975 		   (key (char-to-string (nth 1 entry)))
   1976 		   (template (nth 2 entry))
   1977 		   (file (or (nth 3 entry) org-default-notes-file))
   1978 		   (position (or (nth 4 entry) org-remember-default-headline))
   1979 		   (type 'entry)
   1980 		   (prepend org-reverse-note-order)
   1981 		   immediate target jump-to-captured)
   1982 	       (cond
   1983 		((member position '(top bottom))
   1984 		 (setq target (list 'file file)
   1985 		       prepend (eq position 'top)))
   1986 		((eq position 'date-tree)
   1987 		 (setq target (list 'file+datetree file)
   1988 		       prepend nil))
   1989 		(t (setq target (list 'file+headline file position))))
   1990 
   1991 	       (when (string-match "%!" template)
   1992 		 (setq template (replace-match "" t t template)
   1993 		       immediate t))
   1994 
   1995 	       (when (string-match "%&" template)
   1996 		 (setq jump-to-captured t))
   1997 
   1998 	       (append (list key desc type target template)
   1999 		       (and prepend '(:prepend t))
   2000 		       (and immediate '(:immediate-finish t))
   2001 		       (and jump-to-captured '(:jump-to-captured t)))))
   2002 
   2003 	   org-remember-templates))))
   2004 
   2005 
   2006 (provide 'org-capture)
   2007 
   2008 ;;; org-capture.el ends here