diff options
Diffstat (limited to 'elpa/org-9.5.2/org-capture.el')
| -rw-r--r-- | elpa/org-9.5.2/org-capture.el | 1965 |
1 files changed, 1965 insertions, 0 deletions
diff --git a/elpa/org-9.5.2/org-capture.el b/elpa/org-9.5.2/org-capture.el new file mode 100644 index 0000000..a9350c5 --- /dev/null +++ b/elpa/org-9.5.2/org-capture.el @@ -0,0 +1,1965 @@ +;;; org-capture.el --- Fast note taking in Org -*- lexical-binding: t; -*- + +;; Copyright (C) 2010-2021 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten.dominik@gmail.com> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: https://orgmode.org +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains an alternative implementation of the functionality +;; that used to be provided by org-remember.el. The implementation is more +;; streamlined, can produce more target types (e.g. plain list items or +;; table lines). Also, it does not use a temporary buffer for editing +;; the captured entry - instead it uses an indirect buffer that visits +;; the new entry already in the target buffer (this was an idea by Samuel +;; Wales). John Wiegley's excellent `remember.el' is not needed anymore +;; for this implementation, even though we borrow heavily from its ideas. + +;; This implementation heavily draws on ideas by James TD Smith and +;; Samuel Wales, and, of cause, uses John Wiegley's remember.el as inspiration. + +;;; TODO + +;; - find a clever way to not always insert an annotation maybe a +;; predicate function that can check for conditions for %a to be +;; used. This could be one of the properties. + +;; - Should there be plist members that arrange for properties to be +;; asked for, like James proposed in his RFC? + +;;; Code: + +(require 'cl-lib) +(require 'org) +(require 'org-refile) + +(declare-function org-at-encrypted-entry-p "org-crypt" ()) +(declare-function org-at-table-p "org-table" (&optional table-type)) +(declare-function org-clock-update-mode-line "org-clock" (&optional refresh)) +(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) +(declare-function org-datetree-find-month-create (d &optional keep-restriction)) +(declare-function org-decrypt-entry "org-crypt" ()) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-lineage "org-element" (datum &optional types with-self)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-encrypt-entry "org-crypt" ()) +(declare-function org-insert-link "ol" (&optional complete-file link-location default-description)) +(declare-function org-link-make-string "ol" (link &optional description)) +(declare-function org-table-analyze "org-table" ()) +(declare-function org-table-current-dline "org-table" ()) +(declare-function org-table-fix-formulas "org-table" (key replace &optional limit delta remove)) +(declare-function org-table-goto-line "org-table" (N)) + +(defvar dired-buffers) +(defvar crm-separator) +(defvar org-end-time-was-given) +(defvar org-keyword-properties) +(defvar org-remember-default-headline) +(defvar org-remember-templates) +(defvar org-store-link-plist) +(defvar org-table-border-regexp) +(defvar org-table-current-begin-pos) +(defvar org-table-dataline-regexp) +(defvar org-table-fix-formulas-confirm) +(defvar org-table-hline-regexp) +(defvar org-table-hlines) + +(defvar org-capture-clock-was-started nil + "Internal flag, noting if the clock was started.") + +(defvar org-capture-last-stored-marker (make-marker) + "Marker pointing to the entry most recently stored with `org-capture'.") + +;; The following variable is scoped dynamically by org-protocol +;; to indicate that the link properties have already been stored +(defvar org-capture-link-is-already-stored nil) + +(defvar org-capture-is-refiling nil + "Non-nil when capture process is refiling an entry.") + +(defvar org-capture--prompt-history-table (make-hash-table :test #'equal) + "Hash table for all history lists per prompt.") + +(defvar org-capture--prompt-history nil + "History list for prompt placeholders.") + +(defgroup org-capture nil + "Options concerning capturing new entries." + :tag "Org Capture" + :group 'org) + +(defun org-capture-upgrade-templates (templates) + "Update the template list to the new format. +TEMPLATES is a template list, as in `org-capture-templates'. The +new format unifies all the date/week tree targets into one that +also allows for an optional outline path to specify a target." + (let ((modified-templates + (mapcar + (lambda (entry) + (pcase entry + ;; Match templates with an obsolete "tree" target type. Replace + ;; it with common `file+olp-datetree'. Add new properties + ;; (i.e., `:time-prompt' and `:tree-type') if needed. + (`(,key ,desc ,type (file+datetree . ,path) ,tpl . ,props) + `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl ,@props)) + (`(,key ,desc ,type (file+datetree+prompt . ,path) ,tpl . ,props) + `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl + :time-prompt t ,@props)) + (`(,key ,desc ,type (file+weektree . ,path) ,tpl . ,props) + `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl + :tree-type week ,@props)) + (`(,key ,desc ,type (file+weektree+prompt . ,path) ,tpl . ,props) + `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl + :tree-type week :time-prompt t ,@props)) + ;; Other templates are left unchanged. + (_ entry))) + templates))) + (unless (equal modified-templates templates) + (message "Deprecated date/weektree capture templates changed to `file+olp+datetree'.")) + modified-templates)) + +(defcustom org-capture-templates nil + "Templates for the creation of new entries. + +Each entry is a list with the following items: + +keys The keys that will select the template, as a string, characters + only, for example \"a\" for a template to be selected with a + single key, or \"bt\" for selection with two keys. When using + several keys, keys using the same prefix key must be together + in the list and preceded by a 2-element entry explaining the + prefix key, for example + + (\"b\" \"Templates for marking stuff to buy\") + + The \"C\" key is used by default for quick access to the + customization of the template variable. But if you want to use + that key for a template, you can. + +description A short string describing the template, will be shown during + selection. + +type The type of entry. Valid types are: + entry an Org node, with a headline. Will be filed + as the child of the target entry or as a + top-level entry. Its default template is: + \"* %?\n %a\" + item a plain list item, will be placed in the + first plain list at the target location. + Its default template is: + \"- %?\" + checkitem a checkbox item. This differs from the + plain list item only in so far as it uses a + different default template. Its default + template is: + \"- [ ] %?\" + table-line a new line in the first table at target location. + Its default template is: + \"| %? |\" + plain text to be inserted as it is. + +target Specification of where the captured item should be placed. + In Org files, targets usually define a node. Entries will + become children of this node, other types will be added to the + table or list in the body of this node. + + Most target specifications contain a file name. If that file + name is the empty string, it defaults to `org-default-notes-file'. + A file can also be given as a variable or as a function called + with no argument. When an absolute path is not specified for a + target, it is taken as relative to `org-directory'. + + Valid values are: + + (file \"path/to/file\") + Text will be placed at the beginning or end of that file + + (id \"id of existing Org entry\") + File as child of this entry, or in the body of the entry + + (file+headline \"path/to/file\" \"node headline\") + Fast configuration if the target heading is unique in the file + + (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...) + For non-unique headings, the full outline path is safer + + (file+regexp \"path/to/file\" \"regexp to find location\") + File to the entry matching regexp + + (file+olp+datetree \"path/to/file\" \"Level 1 heading\" ...) + Will create a heading in a date tree for today's date. + If no heading is given, the tree will be on top level. + To prompt for date instead of using TODAY, use the + :time-prompt property. To create a week-tree, use the + :tree-type property. + + (file+function \"path/to/file\" function-finding-location) + A function to find the right location in the file + + (clock) + File to the entry that is currently being clocked + + (function function-finding-location) + Most general way: write your own function which both visits + the file and moves point to the right location + +template The template for creating the capture item. + If it is an empty string or nil, a default template based on + the entry type will be used (see the \"type\" section above). + Instead of a string, this may also be one of: + + (file \"/path/to/template-file\") + (function function-returning-the-template) + + in order to get a template from a file, or dynamically + from a function. + +The rest of the entry is a property list of additional options. Recognized +properties are: + + :prepend Normally newly captured information will be appended at + the target location (last child, last table line, + last list item...). Setting this property will + change that. + + :immediate-finish When set, do not offer to edit the information, just + file it away immediately. This makes sense if the + template only needs information that can be added + automatically. + + :jump-to-captured When set, jump to the captured entry when finished. + + :refile-targets When exiting capture mode via `org-capture-refile', the + variable `org-refile-targets' will be temporarily bound + to the value of this property. + + :empty-lines Set this to the number of lines that should be inserted + before and after the new item. Default 0, only common + other value is 1. + + :empty-lines-before Set this to the number of lines that should be inserted + before the new item. Overrides :empty-lines for the + number lines inserted before. + + :empty-lines-after Set this to the number of lines that should be inserted + after the new item. Overrides :empty-lines for the + number of lines inserted after. + + :clock-in Start the clock in this item. + + :clock-keep Keep the clock running when filing the captured entry. + + :clock-resume Start the interrupted clock when finishing the capture. + Note that :clock-keep has precedence over :clock-resume. + When setting both to t, the current clock will run and + the previous one will not be resumed. + + :time-prompt Prompt for a date/time to be used for date/week trees + and when filling the template. + + :tree-type When `week', make a week tree instead of the month-day + tree. When `month', make a month tree instead of the + month-day tree. + + :unnarrowed Do not narrow the target buffer, simply show the + full buffer. Default is to narrow it so that you + only see the new stuff. + + :table-line-pos Specification of the location in the table where the + new line should be inserted. It should be a string like + \"II-3\", meaning that the new line should become the + third line before the second horizontal separator line. + + :kill-buffer If the target file was not yet visited by a buffer when + capture was invoked, kill the buffer again after capture + is finalized. + + :no-save Do not save the target file after finishing the capture. + +The template defines the text to be inserted. Often this is an +Org mode entry (so the first line should start with a star) that +will be filed as a child of the target headline. It can also be +freely formatted text. Furthermore, the following %-escapes will +be replaced with content and expanded: + + %[pathname] Insert the contents of the file given by + `pathname'. These placeholders are expanded at the very + beginning of the process so they can be used to extend the + current template. + %(sexp) Evaluate elisp `(sexp)' and replace it with the results. + Only placeholders pre-existing within the template, or + introduced with %[pathname] are expanded this way. + Since this happens after expanding non-interactive + %-escapes, those can be used to fill the expression. + %<...> The result of `format-time-string' on the ... format + specification. + %t Time stamp, date only. The time stamp is the current + time, except when called from agendas with + `\\[org-agenda-capture]' or with + `org-capture-use-agenda-date' set. + %T Time stamp as above, with date and time. + %u, %U Like the above, but inactive time stamps. + %i Initial content, copied from the active region. If + there is text before %i on the same line, such as + indentation, and %i is not inside a %(sexp), that prefix + will be added before every line in the inserted text. + %a Annotation, normally the link created with `org-store-link'. + %A Like %a, but prompt for the description part. + %l Like %a, but only insert the literal link. + %L Like %l, but without brackets (the link content itself). + %c Current kill ring head. + %x Content of the X clipboard. + %k Title of currently clocked task. + %K Link to currently clocked task. + %n User name (taken from the variable `user-full-name'). + %f File visited by current buffer when `org-capture' was called. + %F Full path of the file or directory visited by current buffer. + %:keyword Specific information for certain link types, see below. + %^g Prompt for tags, with completion on tags in target file. + %^G Prompt for tags, with completion on all tags in all agenda files. + %^t Like %t, but prompt for date. Similarly %^T, %^u, %^U. + You may define a prompt like: %^{Please specify birthday}t. + The default date is that of %t, see above. + %^C Interactive selection of which kill or clip to use. + %^L Like %^C, but insert as link. + %^{prop}p Prompt the user for a value for property `prop'. + A default value can be specified like this: + %^{prop|default}p. + %^{prompt} Prompt the user for a string and replace this sequence with it. + A default value and a completion table can be specified like this: + %^{prompt|default|completion2|completion3|...}. + %? After completing the template, position cursor here. + %\\1 ... %\\N Insert the text entered at the nth %^{prompt}, where N + is a number, starting from 1. + +Apart from these general escapes, you can access information specific to +the link type that is created. For example, calling `org-capture' in emails +or in Gnus will record the author and the subject of the message, which you +can access with \"%:from\" and \"%:subject\", respectively. Here is a +complete list of what is recorded for each link type. + +Link type | Available information +------------------------+------------------------------------------------------ +bbdb | %:type %:name %:company +vm, wl, mh, mew, rmail, | %:type %:subject %:message-id +gnus | %:from %:fromname %:fromaddress + | %:to %:toname %:toaddress + | %:fromto (either \"to NAME\" or \"from NAME\") + | %:date %:date-timestamp (as active timestamp) + | %:date-timestamp-inactive (as inactive timestamp) +gnus | %:group, for messages also all email fields +eww, w3, w3m | %:type %:url +info | %:type %:file %:node +calendar | %:type %:date + +When you need to insert a literal percent sign in the template, +you can escape ambiguous cases with a backward slash, e.g., \\%i." + :group 'org-capture + :package-version '(Org . "9.5") + :set (lambda (s v) (set s (org-capture-upgrade-templates v))) + :type + (let ((file-variants '(choice :tag "Filename " + (file :tag "Literal") + (function :tag "Function") + (variable :tag "Variable") + (sexp :tag "Form")))) + `(repeat + (choice :value ("" "" entry (file "~/org/notes.org") "") + (list :tag "Multikey description" + (string :tag "Keys ") + (string :tag "Description")) + (list :tag "Template entry" + (string :tag "Keys ") + (string :tag "Description ") + (choice :tag "Capture Type " :value entry + (const :tag "Org entry" entry) + (const :tag "Plain list item" item) + (const :tag "Checkbox item" checkitem) + (const :tag "Plain text" plain) + (const :tag "Table line" table-line)) + (choice :tag "Target location" + (list :tag "File" + (const :format "" file) + ,file-variants) + (list :tag "ID" + (const :format "" id) + (string :tag " ID")) + (list :tag "File & Headline" + (const :format "" file+headline) + ,file-variants + (string :tag " Headline")) + (list :tag "File & Outline path" + (const :format "" file+olp) + ,file-variants + (repeat :tag "Outline path" :inline t + (string :tag "Headline"))) + (list :tag "File & Regexp" + (const :format "" file+regexp) + ,file-variants + (regexp :tag " Regexp")) + (list :tag "File [ & Outline path ] & Date tree" + (const :format "" file+olp+datetree) + ,file-variants + (option (repeat :tag "Outline path" :inline t + (string :tag "Headline")))) + (list :tag "File & function" + (const :format "" file+function) + ,file-variants + (sexp :tag " Function")) + (list :tag "Current clocking task" + (const :format "" clock)) + (list :tag "Function" + (const :format "" function) + (sexp :tag " Function"))) + (choice :tag "Template " + (string) + (list :tag "File" + (const :format "" file) + (file :tag "Template file")) + (list :tag "Function" + (const :format "" function) + (function :tag "Template function"))) + (plist :inline t + ;; Give the most common options as checkboxes + :options (((const :format "%v " :prepend) (const t)) + ((const :format "%v " :immediate-finish) (const t)) + ((const :format "%v " :jump-to-captured) (const t)) + ((const :format "%v " :empty-lines) (const 1)) + ((const :format "%v " :empty-lines-before) (const 1)) + ((const :format "%v " :empty-lines-after) (const 1)) + ((const :format "%v " :clock-in) (const t)) + ((const :format "%v " :clock-keep) (const t)) + ((const :format "%v " :clock-resume) (const t)) + ((const :format "%v " :time-prompt) (const t)) + ((const :format "%v " :tree-type) (const week)) + ((const :format "%v " :unnarrowed) (const t)) + ((const :format "%v " :table-line-pos) (string)) + ((const :format "%v " :kill-buffer) (const t))))))))) + +(defcustom org-capture-before-finalize-hook nil + "Hook that is run right before a capture process is finalized. +The capture buffer is still current when this hook runs and it is +widened to the entire buffer." + :group 'org-capture + :version "24.1" + :type 'hook) + +(defcustom org-capture-after-finalize-hook nil + "Hook that is run right after a capture process is finalized. +Suitable for window cleanup." + :group 'org-capture + :version "24.1" + :type 'hook) + +(defcustom org-capture-prepare-finalize-hook nil + "Hook that is run before the finalization starts. +The capture buffer is current and still narrowed." + :group 'org-capture + :version "24.1" + :type 'hook) + +(defcustom org-capture-bookmark t + "When non-nil, add bookmark pointing at the last stored position when capturing." + :group 'org-capture + :version "24.3" + :type 'boolean) + +;;; The property list for keeping information about the capture process + +(defvar org-capture-plist nil + "Plist for the current capture process, global, to avoid having to pass it.") + +(defvar org-capture-current-plist nil + "Local variable holding the plist in a capture buffer. +This is used to store the plist for use when finishing a capture process +because another such process might have changed the global variable by then. + +Each time a new capture buffer has been set up, the global `org-capture-plist' +is copied to this variable, which is local in the indirect buffer.") + +(defvar org-capture-clock-keep nil + "Local variable to store the value of the :clock-keep parameter. +This is needed in case `org-capture-finalize' is called interactively.") + +(defun org-capture-put (&rest elements) + "Add ELEMENTS to the capture property list `org-capture-plist'." + (while elements + (setq org-capture-plist (plist-put org-capture-plist + (pop elements) (pop elements))))) +(defun org-capture-get (property &optional local) + "Get PROPERTY from the capture property list `org-capture-plist'. +When LOCAL is set, use the local variable `org-capture-current-plist', +this is necessary after initialization of the capture process, +to avoid conflicts with other active capture processes." + (plist-get (if local org-capture-current-plist org-capture-plist) property)) + +;;; The minor mode + +(defvar org-capture-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-c" #'org-capture-finalize) + (define-key map "\C-c\C-k" #'org-capture-kill) + (define-key map "\C-c\C-w" #'org-capture-refile) + map) + "Keymap for `org-capture-mode', a minor mode. +Use this map to set additional keybindings for when Org mode is used +for a capture buffer.") + +(defvar org-capture-mode-hook nil + "Hook for the `org-capture-mode' minor mode.") + +(define-minor-mode org-capture-mode + "Minor mode for special key bindings in a capture buffer. + +Turning on this mode runs the normal hook `org-capture-mode-hook'." + :lighter " Cap" + (setq-local + header-line-format + (substitute-command-keys + "\\<org-capture-mode-map>Capture buffer. Finish \ +`\\[org-capture-finalize]', refile `\\[org-capture-refile]', \ +abort `\\[org-capture-kill]'."))) + +;;; The main commands + +(defvar org-capture-initial nil) +(defvar org-capture-entry nil) + +;;;###autoload +(defun org-capture-string (string &optional keys) + "Capture STRING with the template selected by KEYS." + (interactive "sInitial text: \n") + (let ((org-capture-initial string) + (org-capture-entry (org-capture-select-template keys))) + (org-capture))) + +(defcustom org-capture-templates-contexts nil + "Alist of capture templates and valid contexts. + +For example, if you have a capture template \"c\" and you want +this template to be accessible only from `message-mode' buffers, +use this: + + \\='((\"c\" ((in-mode . \"message-mode\")))) + +Here are the available contexts definitions: + + in-file: command displayed only in matching files + in-mode: command displayed only in matching modes + not-in-file: command not displayed in matching files + not-in-mode: command not displayed in matching modes + in-buffer: command displayed only in matching buffers +not-in-buffer: command not displayed in matching buffers + [function]: a custom function taking no argument + +If you define several checks, the agenda command will be +accessible if there is at least one valid check. + +You can also bind a key to another capture template depending on +contextual rules. + + \\='((\"c\" \"d\" ((in-mode . \"message-mode\")))) + +Here it means: in `message-mode buffers', use \"c\" as the +key for the capture template otherwise associated with \"d\". +\(The template originally associated with \"d\" is not displayed +to avoid duplicates.)" + :version "24.3" + :group 'org-capture + :type '(repeat (list :tag "Rule" + (string :tag " Capture key") + (string :tag "Replace by template") + (repeat :tag "Available when" + (choice + (cons :tag "Condition" + (choice + (const :tag "In file" in-file) + (const :tag "Not in file" not-in-file) + (const :tag "In buffer" in-buffer) + (const :tag "Not in buffer" not-in-buffer) + (const :tag "In mode" in-mode) + (const :tag "Not in mode" not-in-mode)) + (regexp)) + (function :tag "Custom function")))))) + +(defcustom org-capture-use-agenda-date nil + "Non-nil means use the date at point when capturing from agendas. +When nil, you can still capture using the date at point with +`\\[org-agenda-capture]'." + :group 'org-capture + :version "24.3" + :type 'boolean) + +;;;###autoload +(defun org-capture (&optional goto keys) + "Capture something. +\\<org-capture-mode-map> +This will let you select a template from `org-capture-templates', and +then file the newly captured information. The text is immediately +inserted at the target location, and an indirect buffer is shown where +you can edit it. Pressing `\\[org-capture-finalize]' brings you back to the \ +previous +state of Emacs, so that you can continue your work. + +When called interactively with a `\\[universal-argument]' prefix argument \ +GOTO, don't +capture anything, just go to the file/headline where the selected +template stores its notes. + +With a `\\[universal-argument] \\[universal-argument]' prefix argument, go to \ +the last note stored. + +When called with a `C-0' (zero) prefix, insert a template at point. + +When called with a `C-1' (one) prefix, force prompting for a date when +a datetree entry is made. + +ELisp programs can set KEYS to a string associated with a template +in `org-capture-templates'. In this case, interactive selection +will be bypassed. + +If `org-capture-use-agenda-date' is non-nil, capturing from the +agenda will use the date at point as the default date. Then, a +`C-1' prefix will tell the capture process to use the HH:MM time +of the day at point (if any) or the current HH:MM time." + (interactive "P") + (when (and org-capture-use-agenda-date + (eq major-mode 'org-agenda-mode)) + (setq org-overriding-default-time + (org-get-cursor-date (equal goto 1)))) + (cond + ((equal goto '(4)) (org-capture-goto-target keys)) + ((equal goto '(16)) (org-capture-goto-last-stored)) + (t + (let* ((orig-buf (current-buffer)) + (annotation (if (and (boundp 'org-capture-link-is-already-stored) + org-capture-link-is-already-stored) + (plist-get org-store-link-plist :annotation) + (ignore-errors (org-store-link nil)))) + (entry (or org-capture-entry (org-capture-select-template keys))) + initial) + (setq initial (or org-capture-initial + (and (org-region-active-p) + (buffer-substring (point) (mark))))) + (when (stringp initial) + (remove-text-properties 0 (length initial) '(read-only t) initial)) + (when (stringp annotation) + (remove-text-properties 0 (length annotation) + '(read-only t) annotation)) + (cond + ((equal entry "C") + (customize-variable 'org-capture-templates)) + ((equal entry "q") + (user-error "Abort")) + (t + (org-capture-set-plist entry) + (org-capture-get-template) + (org-capture-put :original-buffer orig-buf + :original-file (or (buffer-file-name orig-buf) + (and (featurep 'dired) + (car (rassq orig-buf + dired-buffers)))) + :original-file-nondirectory + (and (buffer-file-name orig-buf) + (file-name-nondirectory + (buffer-file-name orig-buf))) + :annotation annotation + :initial initial + :return-to-wconf (current-window-configuration) + :default-time (or org-overriding-default-time + (org-current-time))) + (org-capture-set-target-location (and (equal goto 0) 'here)) + (condition-case error + (org-capture-put :template (org-capture-fill-template)) + ((error quit) + (if (get-buffer "*Capture*") (kill-buffer "*Capture*")) + (error "Capture abort: %s" (error-message-string error)))) + + (setq org-capture-clock-keep (org-capture-get :clock-keep)) + (condition-case error + (org-capture-place-template + (eq (car (org-capture-get :target)) 'function)) + ((error quit) + (when (and (buffer-base-buffer (current-buffer)) + (string-prefix-p "CAPTURE-" (buffer-name))) + (kill-buffer (current-buffer))) + (set-window-configuration (org-capture-get :return-to-wconf)) + (error "Capture template `%s': %s" + (org-capture-get :key) + (error-message-string error)))) + (when (and (derived-mode-p 'org-mode) (org-capture-get :clock-in)) + (condition-case nil + (progn + (when (org-clock-is-active) + (org-capture-put :interrupted-clock + (copy-marker org-clock-marker))) + (org-clock-in) + (setq-local org-capture-clock-was-started t)) + (error "Could not start the clock in this capture buffer"))) + (when (org-capture-get :immediate-finish) + (org-capture-finalize)))))))) + +(defun org-capture-get-template () + "Get the template from a file or a function if necessary." + (org-capture-put + :template + (pcase (org-capture-get :template) + (`nil "") + ((and (pred stringp) template) template) + (`(file ,file) + (let ((filename (expand-file-name file org-directory))) + (if (file-exists-p filename) (org-file-contents filename) + (format "* Template file %S not found" file)))) + (`(function ,f) + (if (functionp f) (funcall f) + (format "* Template function %S not found" f))) + (_ "* Invalid capture template")))) + +(defun org-capture-finalize (&optional stay-with-capture) + "Finalize the capture process. +With prefix argument STAY-WITH-CAPTURE, jump to the location of the +captured item after finalizing." + (interactive "P") + (when (org-capture-get :jump-to-captured) + (setq stay-with-capture t)) + (unless (and org-capture-mode + (buffer-base-buffer (current-buffer))) + (error "This does not seem to be a capture buffer for Org mode")) + + (run-hooks 'org-capture-prepare-finalize-hook) + + ;; Update `org-capture-plist' with the buffer-local value. Since + ;; captures can be run concurrently, this is to ensure that + ;; `org-capture-after-finalize-hook' accesses the proper plist. + (setq org-capture-plist org-capture-current-plist) + + ;; Did we start the clock in this capture buffer? + (when (and org-capture-clock-was-started + org-clock-marker + (eq (marker-buffer org-clock-marker) (buffer-base-buffer)) + (>= org-clock-marker (point-min)) + (< org-clock-marker (point-max))) + ;; Looks like the clock we started is still running. + (if org-capture-clock-keep + ;; User may have completed clocked heading from the template. + ;; Refresh clock mode line. + (org-clock-update-mode-line t) + ;; Clock out. Possibly resume interrupted clock. + (let (org-log-note-clock-out) (org-clock-out)) + (when (and (org-capture-get :clock-resume 'local) + (markerp (org-capture-get :interrupted-clock 'local)) + (buffer-live-p (marker-buffer + (org-capture-get :interrupted-clock 'local)))) + (let ((clock-in-task (org-capture-get :interrupted-clock 'local))) + (org-with-point-at clock-in-task (org-clock-in))) + (message "Interrupted clock has been resumed")))) + + (let ((abort-note nil)) + ;; Store the size of the capture buffer + (org-capture-put :captured-entry-size (- (point-max) (point-min))) + (widen) + ;; Store the insertion point in the target buffer + (org-capture-put :insertion-point (point)) + + (if org-note-abort + (let ((beg (org-capture-get :begin-marker 'local)) + (end (org-capture-get :end-marker 'local))) + (if (not (and beg end)) (setq abort-note 'dirty) + (setq abort-note t) + (org-with-wide-buffer (kill-region beg end)))) + + ;; Postprocessing: Update Statistics cookies, do the sorting + (when (derived-mode-p 'org-mode) + (save-excursion + (when (ignore-errors (org-back-to-heading)) + (org-update-parent-todo-statistics) + (org-update-checkbox-count))) + ;; FIXME Here we should do the sorting + ;; If we have added a table line, maybe recompute? + (when (and (eq (org-capture-get :type 'local) 'table-line) + (org-at-table-p)) + (if (not (org-table-get-stored-formulas)) (org-table-align) + ;; Adjust formulas, if necessary. We assume a non-nil + ;; `:immediate-finish' means that no confirmation is + ;; required. Else, obey `org-table-fix-formulas-confirm'. + ;; + ;; The delta required to fix formulas depends on the + ;; number of rows inserted by the template. + (when (or (org-capture-get :immediate-finish) + (not org-table-fix-formulas-confirm) + (funcall org-table-fix-formulas-confirm "Fix formulas? ")) + (org-table-fix-formulas + "@" nil (1- (org-table-current-dline)) + (count-lines (org-capture-get :begin-marker 'local) + (org-capture-get :end-marker 'local)))) + (org-table-recalculate 'all)))) ;FIXME: should we iterate? + ;; Store this place as the last one where we stored something + ;; Do the marking in the base buffer, so that it makes sense after + ;; the indirect buffer has been killed. + (org-capture-store-last-position) + + ;; Run the hook + (run-hooks 'org-capture-before-finalize-hook)) + + (when (org-capture-get :decrypted) + (save-excursion + (goto-char (org-capture-get :decrypted)) + (org-encrypt-entry))) + + (unless (org-capture-get :no-save) (save-buffer)) + + (let ((return-wconf (org-capture-get :return-to-wconf 'local)) + (new-buffer (org-capture-get :new-buffer 'local)) + (kill-buffer (org-capture-get :kill-buffer 'local)) + (base-buffer (buffer-base-buffer (current-buffer)))) + + ;; Kill the indirect buffer + (kill-buffer (current-buffer)) + + ;; Narrow back the target buffer to its previous state + (with-current-buffer (org-capture-get :buffer) + (let ((reg (org-capture-get :initial-target-region)) + (pos (org-capture-get :initial-target-position)) + (ipt (org-capture-get :insertion-point)) + (size (org-capture-get :captured-entry-size))) + (if (not reg) + (widen) + (cond ((< ipt (car reg)) + ;; insertion point is before the narrowed region + (narrow-to-region (+ size (car reg)) (+ size (cdr reg)))) + ((> ipt (cdr reg)) + ;; insertion point is after the narrowed region + (narrow-to-region (car reg) (cdr reg))) + (t + ;; insertion point is within the narrowed region + (narrow-to-region (car reg) (+ size (cdr reg))))) + ;; now place back the point at its original position + (if (< ipt (car reg)) + (goto-char (+ size pos)) + (goto-char (if (< ipt pos) (+ size pos) pos)))))) + + ;; Kill the target buffer if that is desired + (when (and base-buffer new-buffer kill-buffer) + (with-current-buffer base-buffer (save-buffer)) + (kill-buffer base-buffer)) + + ;; Restore the window configuration before capture + (set-window-configuration return-wconf)) + + (run-hooks 'org-capture-after-finalize-hook) + ;; Special cases + (cond + (abort-note + (cl-case abort-note + (clean + (message "Capture process aborted and target buffer cleaned up")) + (dirty + (error "Capture process aborted, but target buffer could not be \ +cleaned up correctly")))) + (stay-with-capture + (org-capture-goto-last-stored))) + ;; Return if we did store something + (not abort-note))) + +(defun org-capture-refile () + "Finalize the current capture and then refile the entry. +Refiling is done from the base buffer, because the indirect buffer is then +already gone. Any prefix argument will be passed to the refile command." + (interactive) + (unless (eq (org-capture-get :type 'local) 'entry) + (user-error "Refiling from a capture buffer makes only sense \ +for `entry'-type templates")) + (let* ((base (or (buffer-base-buffer) (current-buffer))) + (pos (make-marker)) + (org-capture-is-refiling t) + (kill-buffer (org-capture-get :kill-buffer 'local)) + (jump-to-captured (org-capture-get :jump-to-captured 'local)) + (refile-targets (org-capture-get :refile-targets 'local))) + ;; Since `org-capture-finalize' may alter buffer contents (e.g., + ;; empty lines) around entry, use a marker to refer to the + ;; headline to be refiled. Place the marker in the base buffer, + ;; as the current indirect one is going to be killed. + (set-marker pos (save-excursion (org-back-to-heading t) (point)) base) + ;; `org-capture-finalize' calls `org-capture-goto-last-stored' too + ;; early. We want to wait for the refiling to be over, so we + ;; control when the latter function is called. + (org-capture-put :kill-buffer nil :jump-to-captured nil) + (let ((org-refile-targets (or refile-targets org-refile-targets))) + (org-capture-finalize) + (save-window-excursion + (with-current-buffer base + (org-with-point-at pos + (call-interactively 'org-refile))))) + (when kill-buffer + (with-current-buffer base (save-buffer)) + (kill-buffer base)) + (when jump-to-captured (org-capture-goto-last-stored)))) + +(defun org-capture-kill () + "Abort the current capture process." + (interactive) + ;; FIXME: This does not do the right thing, we need to remove the + ;; new stuff by hand it is easy: undo, then kill the buffer + (let ((org-note-abort t) + (org-capture-before-finalize-hook nil)) + (org-capture-finalize))) + +(defun org-capture-goto-last-stored () + "Go to the location where the last capture note was stored." + (interactive) + (org-goto-marker-or-bmk org-capture-last-stored-marker + (plist-get org-bookmark-names-plist + :last-capture)) + (message "This is the last note stored by a capture process")) + +;;; Supporting functions for handling the process + +(defun org-capture-put-target-region-and-position () + "Store the initial region with `org-capture-put'." + (org-capture-put + :initial-target-region + ;; Check if the buffer is currently narrowed + (when (org-buffer-narrowed-p) + (cons (point-min) (point-max)))) + ;; store the current point + (org-capture-put :initial-target-position (point))) + +(defvar org-time-was-given) ; dynamically scoped parameter +(defun org-capture-set-target-location (&optional target) + "Find TARGET buffer and position. +Store them in the capture property list." + (let ((target-entry-p t)) + (save-excursion + (pcase (or target (org-capture-get :target)) + (`here + (org-capture-put :exact-position (point) :insert-here t)) + (`(file ,path) + (set-buffer (org-capture-target-buffer path)) + (org-capture-put-target-region-and-position) + (widen) + (setq target-entry-p nil)) + (`(id ,id) + (pcase (org-id-find id) + (`(,path . ,position) + (set-buffer (org-capture-target-buffer path)) + (widen) + (org-capture-put-target-region-and-position) + (goto-char position)) + (_ (error "Cannot find target ID \"%s\"" id)))) + (`(file+headline ,path ,headline) + (set-buffer (org-capture-target-buffer path)) + ;; Org expects the target file to be in Org mode, otherwise + ;; it throws an error. However, the default notes files + ;; should work out of the box. In this case, we switch it to + ;; Org mode. + (unless (derived-mode-p 'org-mode) + (org-display-warning + (format "Capture requirement: switching buffer %S to Org mode" + (current-buffer))) + (org-mode)) + (org-capture-put-target-region-and-position) + (widen) + (goto-char (point-min)) + (if (re-search-forward (format org-complex-heading-regexp-format + (regexp-quote headline)) + nil t) + (beginning-of-line) + (goto-char (point-max)) + (unless (bolp) (insert "\n")) + (insert "* " headline "\n") + (beginning-of-line 0))) + (`(file+olp ,path . ,outline-path) + (let ((m (org-find-olp (cons (org-capture-expand-file path) + outline-path)))) + (set-buffer (marker-buffer m)) + (org-capture-put-target-region-and-position) + (widen) + (goto-char m) + (set-marker m nil))) + (`(file+regexp ,path ,regexp) + (set-buffer (org-capture-target-buffer path)) + (org-capture-put-target-region-and-position) + (widen) + (goto-char (point-min)) + (if (not (re-search-forward regexp nil t)) + (error "No match for target regexp in file %s" path) + (goto-char (if (org-capture-get :prepend) + (match-beginning 0) + (match-end 0))) + (org-capture-put :exact-position (point)) + (setq target-entry-p + (and (derived-mode-p 'org-mode) (org-at-heading-p))))) + (`(file+olp+datetree ,path . ,outline-path) + (let ((m (if outline-path + (org-find-olp (cons (org-capture-expand-file path) + outline-path)) + (set-buffer (org-capture-target-buffer path)) + (point-marker)))) + (set-buffer (marker-buffer m)) + (org-capture-put-target-region-and-position) + (widen) + (goto-char m) + (set-marker m nil) + (require 'org-datetree) + (org-capture-put-target-region-and-position) + (widen) + ;; Make a date/week tree entry, with the current date (or + ;; yesterday, if we are extending dates for a couple of + ;; hours) + (funcall + (pcase (org-capture-get :tree-type) + (`week #'org-datetree-find-iso-week-create) + (`month #'org-datetree-find-month-create) + (_ #'org-datetree-find-date-create)) + (calendar-gregorian-from-absolute + (cond + (org-overriding-default-time + ;; Use the overriding default time. + (time-to-days org-overriding-default-time)) + ((or (org-capture-get :time-prompt) + (equal current-prefix-arg 1)) + ;; Prompt for date. Bind `org-end-time-was-given' so + ;; that `org-read-date-analyze' handles the time range + ;; case and returns `prompt-time' with the start value. + (let* ((org-time-was-given nil) + (org-end-time-was-given nil) + (prompt-time (org-read-date + nil t nil "Date for tree entry:"))) + (org-capture-put + :default-time + (if (or org-time-was-given + (= (time-to-days prompt-time) (org-today))) + prompt-time + ;; Use 00:00 when no time is given for another + ;; date than today? + (apply #'encode-time 0 0 + org-extend-today-until + (cl-cdddr (decode-time prompt-time))))) + (time-to-days prompt-time))) + (t + ;; Current date, possibly corrected for late night + ;; workers. + (org-today)))) + ;; the following is the keep-restriction argument for + ;; org-datetree-find-date-create + (when outline-path 'subtree-at-point)))) + (`(file+function ,path ,function) + (set-buffer (org-capture-target-buffer path)) + (org-capture-put-target-region-and-position) + (widen) + (funcall function) + (org-capture-put :exact-position (point)) + (setq target-entry-p + (and (derived-mode-p 'org-mode) (org-at-heading-p)))) + (`(function ,fun) + (funcall fun) + (org-capture-put :exact-position (point)) + (setq target-entry-p + (and (derived-mode-p 'org-mode) (org-at-heading-p)))) + (`(clock) + (if (and (markerp org-clock-hd-marker) + (marker-buffer org-clock-hd-marker)) + (progn (set-buffer (marker-buffer org-clock-hd-marker)) + (org-capture-put-target-region-and-position) + (widen) + (goto-char org-clock-hd-marker)) + (user-error "No running clock that could be used as capture target"))) + (target (error "Invalid capture target specification: %S" target))) + + (org-capture-put :buffer (current-buffer) + :pos (point) + :target-entry-p target-entry-p + :decrypted + (and (featurep 'org-crypt) + (org-at-encrypted-entry-p) + (save-excursion + (org-decrypt-entry) + (and (org-back-to-heading t) (point)))))))) + +(defun org-capture-expand-file (file) + "Expand functions, symbols and file names for FILE. +When FILE is a function, call it. When it is a form, evaluate +it. When it is a variable, return its value. When it is +a string, treat it as a file name, possibly expanding it +according to `org-directory', and return it. If it is the empty +string, however, return `org-default-notes-file'. In any other +case, raise an error." + (let ((location (cond ((equal file "") org-default-notes-file) + ((stringp file) (expand-file-name file org-directory)) + ((functionp file) (funcall file)) + ((and (symbolp file) (boundp file)) (symbol-value file)) + (t nil)))) + (or (org-string-nw-p location) + (error "Invalid file location: %S" location)))) + +(defun org-capture-target-buffer (file) + "Get a buffer for FILE. +FILE is a generalized file location, as handled by +`org-capture-expand-file'." + (let ((file (org-capture-expand-file file))) + (or (org-find-base-buffer-visiting file) + (progn (org-capture-put :new-buffer t) + (find-file-noselect file))))) + +(defun org-capture-place-template (&optional inhibit-wconf-store) + "Insert the template at the target location, and display the buffer. +When INHIBIT-WCONF-STORE is non-nil, don't store the window configuration, as it +may have been stored before." + (unless inhibit-wconf-store + (org-capture-put :return-to-wconf (current-window-configuration))) + (delete-other-windows) + (org-switch-to-buffer-other-window + (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE")) + (widen) + (org-show-all) + (goto-char (org-capture-get :pos)) + (setq-local outline-level 'org-outline-level) + (pcase (org-capture-get :type) + ((or `nil `entry) (org-capture-place-entry)) + (`table-line (org-capture-place-table-line)) + (`plain (org-capture-place-plain-text)) + (`item (org-capture-place-item)) + (`checkitem (org-capture-place-item))) + (setq-local org-capture-current-plist org-capture-plist) + (org-capture-mode 1)) + +(defun org-capture-place-entry () + "Place the template as a new Org entry." + (let ((template (org-capture-get :template)) + (reversed? (org-capture-get :prepend)) + (exact-position (org-capture-get :exact-position)) + (insert-here? (org-capture-get :insert-here)) + (level 1)) + (org-capture-verify-tree template) + (when exact-position (goto-char exact-position)) + (cond + ;; Force insertion at point. + (insert-here? + ;; FIXME: level should probably set directly within (let ...). + (setq level (org-get-valid-level + (if (or (org-at-heading-p) + (ignore-errors + (save-excursion (org-back-to-heading t)))) + (org-outline-level) + 1)))) + ;; Insert as a child of the current entry. + ((org-capture-get :target-entry-p) + (setq level (org-get-valid-level + (if (org-at-heading-p) (org-outline-level) 1) + 1)) + (if reversed? (outline-next-heading) (org-end-of-subtree t t))) + ;; Insert as a top-level entry at the beginning of the file. + (reversed? + (goto-char (point-min)) + (unless (org-at-heading-p) (outline-next-heading))) + ;; Otherwise, insert as a top-level entry at the end of the file. + (t (goto-char (point-max)))) + (let ((origin (point))) + (unless (bolp) (insert "\n")) + (org-capture-empty-lines-before) + (let ((beg (point))) + (save-restriction + (when insert-here? (narrow-to-region beg beg)) + (org-paste-subtree level template 'for-yank)) + (org-capture-position-for-last-stored beg) + (org-capture-empty-lines-after) + (unless (org-at-heading-p) (outline-next-heading)) + (org-capture-mark-kill-region origin (point)) + (org-capture-narrow beg (if (eobp) (point) (1- (point)))) + (org-capture--position-cursor beg (point)))))) + +(defun org-capture-place-item () + "Place the template as a new plain list item." + (let ((prepend? (org-capture-get :prepend)) + (template (org-remove-indentation (org-capture-get :template))) + item) + ;; Make template suitable for insertion. In particular, add + ;; a main bullet if it is missing. + (unless (string-match-p (concat "\\`" (org-item-re)) template) + (setq template (concat "- " (mapconcat #'identity + (split-string template "\n") + "\n ")))) + ;; Delimit the area where we should look for a plain list. + (pcase-let ((`(,beg . ,end) + (cond ((org-capture-get :exact-position) + ;; User gave a specific position. Start + ;; looking for lists from here. + (org-with-point-at (org-capture-get :exact-position) + (cons (line-beginning-position) + (if (org-capture-get :insert-here) + (line-beginning-position) + (org-entry-end-position))))) + ((org-capture-get :target-entry-p) + ;; At a heading, limit search to its body. + (cons (line-beginning-position 2) + (org-entry-end-position))) + (t + ;; Table is not necessarily under a heading. + ;; Search whole buffer. + (cons (point-min) (point-max)))))) + ;; Find the first plain list in the delimited area. + (goto-char beg) + (let ((item-regexp (org-item-beginning-re))) + (catch :found + (while (re-search-forward item-regexp end t) + (when (setq item (org-element-lineage + (org-element-at-point) '(plain-list) t)) + (goto-char (org-element-property (if prepend? :post-affiliated + :contents-end) + item)) + (throw :found t))) + ;; No list found. Move to the location when to insert + ;; template. Skip planning info and properties drawers, if + ;; any. + (goto-char (cond ((org-capture-get :insert-here) beg) + ((not prepend?) end) + ((org-before-first-heading-p) beg) + (t (max (save-excursion + (org-end-of-meta-data) + (point)) + beg))))))) + ;; Insert template. + (let ((origin (point))) + (unless (bolp) (insert "\n")) + ;; When a new list is created, always obey to `:empty-lines' and + ;; friends. + ;; + ;; When capturing in an existing list, do not change blank lines + ;; above or below the list; consider it to be a stable + ;; structure. However, we can control how many blank lines + ;; separate items. So obey to `:empty-lines' between items as + ;; long as it does not insert more than one empty line. In the + ;; specific case of empty lines above, it means we only obey the + ;; parameter when appending an item. + (unless (and item prepend?) + (org-capture-empty-lines-before + (and item + (not prepend?) + (min 1 (or (org-capture-get :empty-lines-before) + (org-capture-get :empty-lines) + 0))))) + (org-capture-position-for-last-stored (point)) + (let ((beg (line-beginning-position)) + (end (progn + (insert (org-trim template) "\n") + (point-marker)))) + (when item + (let ((i (save-excursion + (goto-char (org-element-property :post-affiliated item)) + (current-indentation)))) + (save-excursion + (goto-char beg) + (save-excursion + (while (< (point) end) + (indent-to i) + (forward-line))) + ;; Pre-pending an item could change the type of the list + ;; if there is a mismatch. In this situation, + ;; prioritize the existing list. + (when prepend? + (let ((ordered? (eq 'ordered (org-element-property :type item)))) + (when (org-xor ordered? + (string-match-p "\\`[A-Za-z0-9]\\([.)]\\)" + template)) + (org-cycle-list-bullet (if ordered? "1." "-"))))) + ;; Eventually repair the list for proper indentation and + ;; bullets. + (org-list-repair)))) + ;; Limit number of empty lines. See above for details. + (unless (and item (not prepend?)) + (org-capture-empty-lines-after + (and item + prepend? + (min 1 (or (org-capture-get :empty-lines-after) + (org-capture-get :empty-lines) + 0))))) + (org-capture-mark-kill-region origin (point)) + ;; ITEM always end with a newline character. Make sure we do + ;; not narrow at the beginning of the next line, possibly + ;; altering its structure (e.g., when it is a headline). + (org-capture-narrow beg (1- end)) + (org-capture--position-cursor beg end))))) + +(defun org-capture-place-table-line () + "Place the template as a table line." + (require 'org-table) + (let ((text + (pcase (org-trim (org-capture-get :template)) + ((pred (string-match-p org-table-border-regexp)) + "| %?Bad template |") + (text (concat text "\n")))) + (table-line-pos (org-capture-get :table-line-pos)) + beg end) + (cond + ((org-capture-get :exact-position) + (org-with-point-at (org-capture-get :exact-position) + (setq beg (line-beginning-position)) + (setq end (if (org-capture-get :insert-here) beg + (org-entry-end-position))))) + ((not (org-capture-get :target-entry-p)) + ;; Table is not necessarily under a heading. Find first table + ;; in the buffer. + (setq beg (point-min) end (point-max))) + (t + ;; We are at a heading, limit search to the body. + (setq beg (line-beginning-position 2)) + (setq end (save-excursion (outline-next-heading) (point))))) + (goto-char beg) + ;; Narrow to the table, possibly creating one if necessary. + (catch :found + (while (re-search-forward org-table-dataline-regexp end t) + (pcase (org-element-lineage (org-element-at-point) '(table) t) + (`nil nil) + ((pred (lambda (e) (eq 'table.el (org-element-property :type e)))) + nil) + (table + (goto-char (org-element-property :contents-end table)) + (narrow-to-region (org-element-property :post-affiliated table) + (point)) + (throw :found t)))) + ;; No table found. Create it with an empty header. + (goto-char end) + (unless (bolp) (insert "\n")) + (let ((origin (point))) + (insert "| |\n|---|\n") + (narrow-to-region origin (point)))) + ;; In the current table, find the appropriate location for TEXT. + (cond + ((org-capture-get :insert-here) nil) + ((and table-line-pos + (string-match "\\(I+\\)\\([-+][0-9]+\\)" table-line-pos)) + (goto-char (point-min)) + (let ((line + (condition-case _ + (progn + (save-match-data (org-table-analyze)) + (aref org-table-hlines + (- (match-end 1) (match-beginning 1)))) + (error + (error "Invalid table line specification %S" table-line-pos)))) + (delta (string-to-number (match-string 2 table-line-pos)))) + (forward-line (+ line delta (if (< delta 0) 0 -1))) + (forward-line))) ;insert below + ((org-capture-get :prepend) + (goto-char (point-min)) + (cond + ((not (re-search-forward org-table-hline-regexp nil t))) + ((re-search-forward org-table-dataline-regexp nil t) (beginning-of-line)) + (t (goto-char (org-table-end))))) + (t + (goto-char (org-table-end)))) + ;; Insert text and position point according to template. + (let ((origin (point))) + (unless (bolp) (insert "\n")) + (let ((beg (point)) + (end (save-excursion + (insert text) + (point)))) + (org-capture-position-for-last-stored 'table-line) + (org-capture-mark-kill-region origin end) + ;; TEXT is guaranteed to end with a newline character. Ignore + ;; it when narrowing so as to not alter data on the next line. + (org-capture-narrow beg (1- end)) + (org-capture--position-cursor beg (1- end)))))) + +(defun org-capture-place-plain-text () + "Place the template plainly. +If the target locator points at an Org node, place the template into +the text of the entry, before the first child. If not, place the +template at the beginning or end of the file. +Of course, if exact position has been required, just put it there." + (cond + ((org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position))) + ((org-capture-get :target-entry-p) + ;; Place the text into this entry. + (if (org-capture-get :prepend) + ;; Skip meta data and drawers. + (org-end-of-meta-data t) + ;; Go to end of the entry text, before the next headline. + (outline-next-heading))) + (t + ;; Beginning or end of file. + (goto-char (if (org-capture-get :prepend) (point-min) (point-max))))) + (let ((origin (point))) + (unless (bolp) (insert "\n")) + (org-capture-empty-lines-before) + (org-capture-position-for-last-stored (point)) + (let ((beg (point))) + (insert (org-capture-get :template)) + (unless (bolp) (insert "\n")) + ;; Ignore the final newline character so as to not alter data + ;; after inserted text. Yet, if the template is empty, make + ;; sure END matches BEG instead of pointing before it. + (let ((end (max beg (1- (point))))) + (org-capture-empty-lines-after) + (org-capture-mark-kill-region origin (point)) + (org-capture-narrow beg end) + (org-capture--position-cursor beg end))))) + +(defun org-capture-mark-kill-region (beg end) + "Mark region between BEG and END to be killed on aborted capture." + (let ((m1 (copy-marker beg)) + (m2 (copy-marker end t))) + (org-capture-put :begin-marker m1) + (org-capture-put :end-marker m2))) + +(defun org-capture-position-for-last-stored (position) + "Put POSITION on `org-capture-plist' for future use as `last capture`." + (cond + ((integerp position) + (org-capture-put :position-for-last-stored + (move-marker (make-marker) position + (or (buffer-base-buffer (current-buffer)) + (current-buffer))))) + ((eq position 'table-line) + (org-capture-put :position-for-last-stored + (list 'table-line + (org-table-current-dline)))) + (t (error "This should not happen")))) + +(defun org-capture-store-last-position () + "Store the last-captured position." + (let* ((where (org-capture-get :position-for-last-stored 'local)) + (pos (cond + ((markerp where) + (prog1 (marker-position where) + (move-marker where nil))) + ((and (listp where) (eq (car where) 'table-line)) + (if (org-at-table-p) + (save-excursion + (org-table-goto-line (nth 1 where)) + (point-at-bol)) + (point)))))) + (with-current-buffer (buffer-base-buffer (current-buffer)) + (org-with-point-at pos + (when org-capture-bookmark + (let ((bookmark (plist-get org-bookmark-names-plist :last-capture))) + (when bookmark (with-demoted-errors (bookmark-set bookmark))))) + (move-marker org-capture-last-stored-marker (point)))))) + +(defun org-capture-narrow (beg end) + "Possibly narrow to region between BEG and END. +If configuration contains non-nil :unnarrowed property, do not narrow." + (unless (org-capture-get :unnarrowed) + (narrow-to-region beg end))) + +(defun org-capture--position-cursor (beg end) + "Move point to first \"%?\" location or at start of template. +BEG and END are buffer positions at the beginning and end position +of the template." + (goto-char beg) + (when (search-forward "%?" end t) + (replace-match ""))) + +(defun org-capture-empty-lines-before (&optional n) + "Insert N empty lines before the insertion point. +Point will be after the empty lines, so insertion can directly be done. +If N is nil, :empty-lines-before or :empty-lines are considered." + (setq n (or n (org-capture-get :empty-lines-before) + (org-capture-get :empty-lines) 0)) + (let ((pos (point))) + (org-back-over-empty-lines) + (delete-region (point) pos) + (when (> n 0) (newline n)))) + +(defun org-capture-empty-lines-after (&optional n) + "Set the correct number of empty lines after the inserted string. +Point will remain at the first line after the inserted text. +If N is nil, :empty-lines-after or :empty-lines are considered." + (setq n (or n (org-capture-get :empty-lines-after) + (org-capture-get :empty-lines) 0)) + (org-back-over-empty-lines) + (while (looking-at "[ \t]*\n") (replace-match "")) + (let ((pos (point))) + (when (> n 0) (newline n)) + (goto-char pos))) + +(defvar org-clock-marker) ; Defined in org.el + +(defun org-capture-set-plist (entry) + "Initialize the property list for ENTRY from the template definition." + (setq org-capture-plist (copy-sequence (nthcdr 5 entry))) + (org-capture-put :key (car entry) :description (nth 1 entry) + :target (nth 3 entry)) + (let ((txt (nth 4 entry)) (type (or (nth 2 entry) 'entry))) + (when (or (not txt) (and (stringp txt) (not (string-match "\\S-" txt)))) + ;; The template may be empty or omitted for special types. + ;; Here we insert the default templates for such cases. + (cond + ((eq type 'item) (setq txt "- %?")) + ((eq type 'checkitem) (setq txt "- [ ] %?")) + ((eq type 'table-line) (setq txt "| %? |")) + ((member type '(nil entry)) (setq txt "* %?\n %a")))) + (org-capture-put :template txt :type type))) + +(defun org-capture-goto-target (&optional template-key) + "Go to the target location of a capture template. +If TEMPLATE-KEY is nil, the user is queried for the template." + (interactive) + (let ((entry (org-capture-select-template template-key))) + (unless entry (error "No capture template selected")) + (org-capture-set-plist entry) + (org-capture-set-target-location) + (pop-to-buffer-same-window (org-capture-get :buffer)) + (goto-char (org-capture-get :pos)))) + +(defun org-capture-get-indirect-buffer (&optional buffer prefix) + "Make an indirect BUFFER for a capture process. +Use PREFIX as a prefix for the name of the indirect buffer." + (setq buffer (or buffer (current-buffer))) + (let ((n 1) (base (buffer-name buffer)) bname) + (setq bname (concat prefix "-" base)) + (while (buffer-live-p (get-buffer bname)) + (setq bname (concat prefix "-" (number-to-string (cl-incf n)) "-" base))) + (condition-case nil + (make-indirect-buffer buffer bname 'clone) + (error + (let ((buf (make-indirect-buffer buffer bname))) + (with-current-buffer buf (org-mode)) + buf))))) + +(defun org-capture-verify-tree (tree) + "Throw error if TREE is not a valid tree." + (unless (org-kill-is-subtree-p tree) + (error "Template is not a valid Org entry or tree"))) + +;;; The template code +(defun org-capture-select-template (&optional keys) + "Select a capture template. +Lisp programs can force the template by setting KEYS to a string." + (let ((org-capture-templates + (or (org-contextualize-keys + (org-capture-upgrade-templates org-capture-templates) + org-capture-templates-contexts) + '(("t" "Task" entry (file+headline "" "Tasks") + "* TODO %?\n %u\n %a"))))) + (if keys + (or (assoc keys org-capture-templates) + (error "No capture template referred to by \"%s\" keys" keys)) + (org-mks org-capture-templates + "Select a capture template\n=========================" + "Template key: " + '(("C" "Customize org-capture-templates") + ("q" "Abort")))))) + +(defvar org-capture--clipboards nil + "List various clipboards values.") + +(defun org-capture-fill-template (&optional template initial annotation) + "Fill a TEMPLATE and return the filled template as a string. +The template may still contain \"%?\" for cursor positioning. +INITIAL content and/or ANNOTATION may be specified, but will be overridden +by their respective `org-store-link-plist' properties if present." + (let* ((template (or template (org-capture-get :template))) + (buffer (org-capture-get :buffer)) + (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) + (time (let* ((c (or (org-capture-get :default-time) (current-time))) + (d (decode-time c))) + (if (< (nth 2 d) org-extend-today-until) + (encode-time 0 59 23 (1- (nth 3 d)) (nth 4 d) (nth 5 d)) + c))) + (v-t (format-time-string (org-time-stamp-format nil) time)) + (v-T (format-time-string (org-time-stamp-format t) time)) + (v-u (format-time-string (org-time-stamp-format nil t) time)) + (v-U (format-time-string (org-time-stamp-format t t) time)) + (v-c (and kill-ring (current-kill 0))) + (v-x (or (org-get-x-clipboard 'PRIMARY) + (org-get-x-clipboard 'CLIPBOARD) + (org-get-x-clipboard 'SECONDARY) + "")) ;ensure it is a string + ;; `initial' and `annotation' might have been passed. But if + ;; the property list has them, we prefer those values. + (v-i (or (plist-get org-store-link-plist :initial) + (and (stringp initial) (org-no-properties initial)) + (org-capture-get :initial) + "")) + (v-a + (let ((a (or (plist-get org-store-link-plist :annotation) + annotation + (org-capture-get :annotation) + ""))) + ;; Is the link empty? Then we do not want it... + (if (equal a "[[]]") "" a))) + (l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]") + (v-A (if (and v-a (string-match l-re v-a)) + (replace-match "[[\\1][%^{Link description}]]" nil nil v-a) + v-a)) + (v-l (if (and v-a (string-match l-re v-a)) + (replace-match "[[\\1]]" nil nil v-a) + v-a)) + (v-L (if (and v-a (string-match l-re v-a)) + (replace-match "\\1" nil nil v-a) + v-a)) + (v-n user-full-name) + (v-k (if (marker-buffer org-clock-marker) + (org-no-properties org-clock-heading) + "")) + (v-K (if (marker-buffer org-clock-marker) + (org-link-make-string + (format "%s::*%s" + (buffer-file-name (marker-buffer org-clock-marker)) + v-k) + v-k) + "")) + (v-f (or (org-capture-get :original-file-nondirectory) "")) + (v-F (or (org-capture-get :original-file) "")) + (org-capture--clipboards + (delq nil + (list v-i + (org-get-x-clipboard 'PRIMARY) + (org-get-x-clipboard 'CLIPBOARD) + (org-get-x-clipboard 'SECONDARY) + v-c)))) + (setq org-store-link-plist (plist-put org-store-link-plist :annotation v-a)) + (setq org-store-link-plist (plist-put org-store-link-plist :initial v-i)) + (unless template + (setq template "") + (message "no template") (ding) + (sit-for 1)) + (save-window-excursion + (org-switch-to-buffer-other-window (get-buffer-create "*Capture*")) + (erase-buffer) + (setq buffer-file-name nil) + (setq mark-active nil) + (insert template) + (goto-char (point-min)) + ;; %[] insert contents of a file. + (save-excursion + (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) + (let ((filename (expand-file-name (match-string 1))) + (beg (copy-marker (match-beginning 0))) + (end (copy-marker (match-end 0)))) + (unless (org-capture-escaped-%) + (delete-region beg end) + (set-marker beg nil) + (set-marker end nil) + (condition-case error + (insert-file-contents filename) + (error + (insert (format "%%![couldn not insert %s: %s]" + filename + error)))))))) + ;; Mark %() embedded elisp for later evaluation. + (org-capture-expand-embedded-elisp 'mark) + ;; Expand non-interactive templates. + (let ((regexp "%\\(:[-A-Za-z]+\\|<\\([^>\n]+\\)>\\|[aAcfFikKlLntTuUx]\\)")) + (save-excursion + (while (re-search-forward regexp nil t) + ;; `org-capture-escaped-%' may modify buffer and cripple + ;; match-data. Use markers instead. Ditto for other + ;; templates. + (let ((pos (copy-marker (match-beginning 0))) + (end (copy-marker (match-end 0))) + (value (match-string 1)) + (time-string (match-string 2))) + (unless (org-capture-escaped-%) + (delete-region pos end) + (set-marker pos nil) + (set-marker end nil) + (let* ((inside-sexp? (org-capture-inside-embedded-elisp-p)) + (replacement + (pcase (string-to-char value) + (?< (format-time-string time-string time)) + (?: + (or (plist-get org-store-link-plist (intern value)) + "")) + (?i + (if inside-sexp? v-i + ;; Outside embedded Lisp, repeat leading + ;; characters before initial place holder + ;; every line. + (let ((lead (concat "\n" + (org-current-line-string t)))) + (replace-regexp-in-string "\n" lead v-i nil t)))) + (?a v-a) + (?A v-A) + (?c v-c) + (?f v-f) + (?F v-F) + (?k v-k) + (?K v-K) + (?l v-l) + (?L v-L) + (?n v-n) + (?t v-t) + (?T v-T) + (?u v-u) + (?U v-U) + (?x v-x)))) + (insert + (if inside-sexp? + ;; Escape sensitive characters. + (replace-regexp-in-string "[\\\"]" "\\\\\\&" replacement) + replacement)))))))) + ;; Expand %() embedded Elisp. Limit to Sexp originally marked. + (org-capture-expand-embedded-elisp) + ;; Expand interactive templates. This is the last step so that + ;; template is mostly expanded when prompting happens. Turn on + ;; Org mode and set local variables. This is to support + ;; completion in interactive prompts. + (let ((org-inhibit-startup t)) (org-mode)) + (org-clone-local-variables buffer "\\`org-") + (let (strings) ; Stores interactive answers. + (save-excursion + (let ((regexp "%\\^\\(?:{\\([^}]*\\)}\\)?\\([CgGLptTuU]\\)?")) + (while (re-search-forward regexp nil t) + (let* ((items (and (match-end 1) + (save-match-data + (split-string (match-string-no-properties 1) + "|")))) + (key (match-string 2)) + (beg (copy-marker (match-beginning 0))) + (end (copy-marker (match-end 0))) + (prompt (nth 0 items)) + (default (nth 1 items)) + (completions (nthcdr 2 items))) + (unless (org-capture-escaped-%) + (delete-region beg end) + (set-marker beg nil) + (set-marker end nil) + (pcase key + ((or "G" "g") + (let* ((org-last-tags-completion-table + (org-global-tags-completion-table + (cond ((equal key "G") (org-agenda-files)) + (file (list file)) + (t nil)))) + (org-add-colon-after-tag-completion t) + (ins (mapconcat + #'identity + (let ((crm-separator "[ \t]*:[ \t]*")) + (completing-read-multiple + (if prompt (concat prompt ": ") "Tags: ") + org-last-tags-completion-table nil nil nil + 'org-tags-history)) + ":"))) + (when (org-string-nw-p ins) + (unless (eq (char-before) ?:) (insert ":")) + (insert ins) + (unless (eq (char-after) ?:) (insert ":")) + (when (org-at-heading-p) (org-align-tags))))) + ((or "C" "L") + (let ((insert-fun (if (equal key "C") #'insert + (lambda (s) (org-insert-link 0 s))))) + (pcase org-capture--clipboards + (`nil nil) + (`(,value) (funcall insert-fun value)) + (`(,first-value . ,_) + (funcall insert-fun + (read-string "Clipboard/kill value: " + first-value + 'org-capture--clipboards + first-value))) + (_ (error "Invalid `org-capture--clipboards' value: %S" + org-capture--clipboards))))) + ("p" + ;; We remove keyword properties inherited from + ;; target buffer so `org-read-property-value' has + ;; a chance to find allowed values in sub-trees + ;; from the target buffer. + (setq-local org-keyword-properties nil) + (let* ((origin (set-marker (make-marker) + (org-capture-get :pos) + (org-capture-get :buffer))) + ;; Find location from where to get allowed + ;; values. If `:target-entry-p' is + ;; non-nil, the current headline in the + ;; target buffer is going to be a parent + ;; headline, so location is fine. + ;; Otherwise, find the parent headline in + ;; the target buffer. + (pom (if (org-capture-get :target-entry-p) origin + (let ((level (progn + (while (org-up-heading-safe)) + (org-current-level)))) + (org-with-point-at origin + (let ((l (if (org-at-heading-p) + (org-current-level) + most-positive-fixnum))) + (while (and l (>= l level)) + (setq l (org-up-heading-safe))) + (if l (point-marker) + (point-min-marker))))))) + (value + (org-read-property-value prompt pom default))) + (org-set-property prompt value))) + ((or "t" "T" "u" "U") + ;; These are the date/time related ones. + (let* ((upcase? (equal (upcase key) key)) + (org-end-time-was-given nil) + (time (org-read-date upcase? t nil prompt))) + (org-insert-time-stamp + time (or org-time-was-given upcase?) + (member key '("u" "U")) + nil nil (list org-end-time-was-given)))) + (`nil + ;; Load history list for current prompt. + (setq org-capture--prompt-history + (gethash prompt org-capture--prompt-history-table)) + (push (org-completing-read + (concat (or prompt "Enter string") + (and default (format " [%s]" default)) + ": ") + completions + nil nil nil 'org-capture--prompt-history default) + strings) + (insert (car strings)) + ;; Save updated history list for current prompt. + (puthash prompt org-capture--prompt-history + org-capture--prompt-history-table)) + (_ + (error "Unknown template placeholder: \"%%^%s\"" + key)))))))) + ;; Replace %n escapes with nth %^{...} string. + (setq strings (nreverse strings)) + (save-excursion + (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t) + (unless (org-capture-escaped-%) + (replace-match + (nth (1- (string-to-number (match-string 1))) strings) + nil t))))) + ;; Make sure there are no empty lines before the text, and that + ;; it ends with a newline character or it is empty. + (skip-chars-forward " \t\n") + (delete-region (point-min) (line-beginning-position)) + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (if (bobp) (delete-region (point) (line-end-position)) + (end-of-line) + (delete-region (point) (point-max)) + (insert "\n")) + ;; Return the expanded template and kill the capture buffer. + (untabify (point-min) (point-max)) + (set-buffer-modified-p nil) + (prog1 (buffer-substring-no-properties (point-min) (point-max)) + (kill-buffer (current-buffer)))))) + +(defun org-capture-escaped-% () + "Non-nil if % was escaped. +If yes, unescape it now. Assume `match-data' contains the +placeholder to check." + (save-excursion + (goto-char (match-beginning 0)) + (let ((n (abs (skip-chars-backward "\\\\")))) + (delete-char (/ (1+ n) 2)) + (= (% n 2) 1)))) + +(defun org-capture-expand-embedded-elisp (&optional mark) + "Evaluate embedded elisp %(sexp) and replace with the result. +When optional MARK argument is non-nil, mark Sexp with a text +property (`org-embedded-elisp') for later evaluation. Only +marked Sexp are evaluated when this argument is nil." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "%(" nil t) + (cond + ((get-text-property (match-beginning 0) 'org-embedded-elisp) + (goto-char (match-beginning 0)) + (let ((template-start (point))) + (forward-char 1) + (let* ((sexp (read (current-buffer))) + (result (org-eval + (org-capture--expand-keyword-in-embedded-elisp + sexp)))) + (delete-region template-start (point)) + (cond + ((not result) nil) + ((stringp result) (insert result)) + (t (error + "Capture template sexp `%s' must evaluate to string or nil" + sexp)))))) + ((not mark) nil) + ;; Only mark valid and non-escaped sexp. + ((org-capture-escaped-%) nil) + (t + (let ((end (with-syntax-table emacs-lisp-mode-syntax-table + (ignore-errors (scan-sexps (1- (point)) 1))))) + (when end + (put-text-property (- (point) 2) end 'org-embedded-elisp t)))))))) + +(defun org-capture--expand-keyword-in-embedded-elisp (attr) + "Recursively replace capture link keywords in ATTR sexp. +Such keywords are prefixed with \"%:\". See +`org-capture-template' for more information." + (cond ((consp attr) + (mapcar 'org-capture--expand-keyword-in-embedded-elisp attr)) + ((symbolp attr) + (let* ((attr-symbol (symbol-name attr)) + (key (and (string-match "%\\(:.*\\)" attr-symbol) + (intern (match-string 1 attr-symbol))))) + (or (plist-get org-store-link-plist key) + attr))) + (t attr))) + +(defun org-capture-inside-embedded-elisp-p () + "Non-nil if point is inside of embedded elisp %(sexp). +Assume sexps have been marked with +`org-capture-expand-embedded-elisp' beforehand." + (get-text-property (point) 'org-embedded-elisp)) + +;;;###autoload +(defun org-capture-import-remember-templates () + "Set `org-capture-templates' to be similar to `org-remember-templates'." + (interactive) + (when (and (yes-or-no-p + "Import old remember templates into org-capture-templates? ") + (yes-or-no-p + "Note that this will remove any templates currently defined in `org-capture-templates'. Do you still want to go ahead? ")) + (require 'org-remember) + (setq org-capture-templates + (mapcar + (lambda (entry) + (let ((desc (car entry)) + (key (char-to-string (nth 1 entry))) + (template (nth 2 entry)) + (file (or (nth 3 entry) org-default-notes-file)) + (position (or (nth 4 entry) org-remember-default-headline)) + (type 'entry) + (prepend org-reverse-note-order) + immediate target jump-to-captured) + (cond + ((member position '(top bottom)) + (setq target (list 'file file) + prepend (eq position 'top))) + ((eq position 'date-tree) + (setq target (list 'file+datetree file) + prepend nil)) + (t (setq target (list 'file+headline file position)))) + + (when (string-match "%!" template) + (setq template (replace-match "" t t template) + immediate t)) + + (when (string-match "%&" template) + (setq jump-to-captured t)) + + (append (list key desc type target template) + (and prepend '(:prepend t)) + (and immediate '(:immediate-finish t)) + (and jump-to-captured '(:jump-to-captured t))))) + + org-remember-templates)))) + + +(provide 'org-capture) + +;;; org-capture.el ends here |