diff options
Diffstat (limited to 'lisp/org/org-capture.el')
| -rw-r--r-- | lisp/org/org-capture.el | 221 |
1 files changed, 183 insertions, 38 deletions
diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index 8a271b8d055..39804ac3c01 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -24,14 +24,14 @@ ;; ;;; Commentary: -;; This file contains an alternative implementation of the same functionality -;; that is also provided by org-remember.el. The implementation is more +;; 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 for this -;; implementation, even though we borrow heavily from its ideas. +;; 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. @@ -50,7 +50,6 @@ (eval-when-compile (require 'cl)) (require 'org) -(require 'org-mks) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) @@ -182,6 +181,8 @@ properties are: template only needs information that can be added automatically. + :jump-to-captured When set, jump to the captured entry when finished. + :empty-lines Set this to the number of lines the should be inserted before and after the new item. Default 0, only common other value is 1. @@ -223,7 +224,9 @@ freely formatted text. Furthermore, the following %-escapes will be replaced with content and expanded in this order: %[pathname] Insert the contents of the file given by `pathname'. - %(sexp) Evaluate elisp `(sexp)' and replace with the result. + %(sexp) Evaluate elisp `(sexp)' and replace it with the results. + For convenience, %:keyword (see below) placeholders within + the expression will be expanded prior to this. %<...> The result of format-time-string on the ... format specification. %t Time stamp, date only. %T Time stamp with date and time. @@ -237,7 +240,7 @@ be replaced with content and expanded in this order: %x Content of the X clipboard. %k Title of currently clocked task. %K Link to currently clocked task. - %n User name (taken from `user-full-name'). + %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. @@ -338,11 +341,15 @@ calendar | %:type %:date" ;; 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 " :unnarrowed) (const t)) + ((const :format "%v " :table-line-pos) (const t)) ((const :format "%v " :kill-buffer) (const t)))))))) (defcustom org-capture-before-finalize-hook nil @@ -439,6 +446,7 @@ Turning on this mode runs the normal hook `org-capture-mode-hook'." ;;;###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))) @@ -459,6 +467,8 @@ Here are the available contexts definitions: 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 @@ -484,6 +494,8 @@ to avoid duplicates.)" (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)) @@ -491,7 +503,7 @@ to avoid duplicates.)" (defcustom org-capture-use-agenda-date nil "Non-nil means use the date at point when capturing from agendas. -When nil, you can still capturing using the date at point with \\[org-agenda-capture]]." +When nil, you can still capture using the date at point with \\[org-agenda-capture]." :group 'org-capture :version "24.3" :type 'boolean) @@ -514,17 +526,19 @@ stored. When called with a `C-0' (zero) prefix, insert a template at point. -Lisp programs can set KEYS to a string associated with a template +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." +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))) + (org-get-cursor-date (equal goto 1)))) (cond ((equal goto '(4)) (org-capture-goto-target)) ((equal goto '(16)) (org-capture-goto-last-stored)) @@ -563,8 +577,9 @@ agenda will use the date at point as the default date." (file-name-nondirectory (buffer-file-name orig-buf))) :annotation annotation - :initial initial) - (org-capture-put :default-time + :initial initial + :return-to-wconf (current-window-configuration) + :default-time (or org-overriding-default-time (org-current-time))) (org-capture-set-target-location) @@ -579,7 +594,8 @@ agenda will use the date at point as the default date." ;;insert at point (org-capture-insert-template-here) (condition-case error - (org-capture-place-template) + (org-capture-place-template + (equal (car (org-capture-get :target)) 'function)) ((error quit) (if (and (buffer-base-buffer (current-buffer)) (string-match "\\`CAPTURE-" (buffer-name))) @@ -600,7 +616,7 @@ agenda will use the date at point as the default date." (error "Could not start the clock in this capture buffer"))) (if (org-capture-get :immediate-finish) - (org-capture-finalize nil))))))))) + (org-capture-finalize))))))))) (defun org-capture-get-template () "Get the template from a file or a function if necessary." @@ -625,6 +641,8 @@ agenda will use the date at point as the default date." 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")) @@ -771,14 +789,14 @@ already gone. Any prefix argument will be passed to the refile command." (let ((pos (point)) (base (buffer-base-buffer (current-buffer))) (org-refile-for-capture t)) - (org-capture-finalize) (save-window-excursion (with-current-buffer (or base (current-buffer)) (save-excursion (save-restriction (widen) (goto-char pos) - (call-interactively 'org-refile))))))) + (call-interactively 'org-refile))))) + (org-capture-finalize))) (defun org-capture-kill () "Abort the current capture process." @@ -893,7 +911,8 @@ Store them in the capture property list." (current-time)))) (org-capture-put :default-time - (cond ((and (not org-time-was-given) + (cond ((and (or (not (boundp 'org-time-was-given)) + (not org-time-was-given)) (not (= (time-to-days prompt-time) (org-today)))) ;; Use 00:00 when no time is given for another date than today? (apply 'encode-time (append '(0 0 0) (cdddr (decode-time prompt-time))))) @@ -964,14 +983,17 @@ it. When it is a variable, retrieve the value. Return whatever we get." (find-file-noselect (expand-file-name file org-directory))))) (defun org-capture-steal-local-variables (buffer) - "Install Org-mode local variables." + "Install Org-mode local variables of BUFFER." (mapc (lambda (v) (ignore-errors (org-set-local (car v) (cdr v)))) (buffer-local-variables buffer))) -(defun org-capture-place-template () - "Insert the template at the target location, and display the buffer." - (org-capture-put :return-to-wconf (current-window-configuration)) +(defun org-capture-place-template (&optional inhibit-wconf-store) + "Insert the template at the target location, and display the buffer. +When `inhibit-wconf-store', 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")) @@ -1250,8 +1272,11 @@ Of course, if exact position has been required, just put it there." (save-restriction (widen) (goto-char pos) - (with-demoted-errors - (bookmark-set "org-capture-last-stored")) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-capture))) + (when bookmark-name + (with-demoted-errors + (bookmark-set bookmark-name)))) (move-marker org-capture-last-stored-marker (point))))))) (defun org-capture-narrow (beg end) @@ -1261,7 +1286,7 @@ Of course, if exact position has been required, just put it there." (goto-char beg))) (defun org-capture-empty-lines-before (&optional n) - "Arrange for the correct number of empty lines before the insertion point. + "Set the correct number of empty lines before the insertion point. Point will be after the empty lines, so insertion can directly be done." (setq n (or n (org-capture-get :empty-lines-before) (org-capture-get :empty-lines) 0)) @@ -1271,7 +1296,7 @@ Point will be after the empty lines, so insertion can directly be done." (if (> n 0) (newline n)))) (defun org-capture-empty-lines-after (&optional n) - "Arrange for the correct number of empty lines after the inserted string. + "Set the correct number of empty lines after the inserted string. Point will remain at the first line after the inserted text." (setq n (or n (org-capture-get :empty-lines-after) (org-capture-get :empty-lines) 0)) @@ -1284,6 +1309,7 @@ Point will remain at the first line after the inserted text." (defvar org-clock-marker) ; Defined in org.el (defun org-capture-insert-template-here () + "Insert the capture template at point." (let* ((template (org-capture-get :template)) (type (org-capture-get :type)) beg end pp) @@ -1366,8 +1392,106 @@ Use PREFIX as a prefix for the name of the indirect buffer." (unless (org-kill-is-subtree-p tree) (error "Template is not a valid Org entry or tree"))) -;;; The template code +(defun org-mks (table title &optional prompt specials) + "Select a member of an alist with multiple keys. +TABLE is the alist which should contain entries where the car is a string. +There should be two types of entries. + +1. prefix descriptions like (\"a\" \"Description\") + This indicates that `a' is a prefix key for multi-letter selection, and + that there are entries following with keys like \"ab\", \"ax\"... + +2. Selectable members must have more than two elements, with the first + being the string of keys that lead to selecting it, and the second a + short description string of the item. + +The command will then make a temporary buffer listing all entries +that can be selected with a single key, and all the single key +prefixes. When you press the key for a single-letter entry, it is selected. +When you press a prefix key, the commands (and maybe further prefixes) +under this key will be shown and offered for selection. + +TITLE will be placed over the selection in the temporary buffer, +PROMPT will be used when prompting for a key. SPECIAL is an alist with +also (\"key\" \"description\") entries. When one of these is selection, +only the bare key is returned." + (setq prompt (or prompt "Select: ")) + (let (tbl orig-table dkey ddesc des-keys allowed-keys + current prefix rtn re pressed buffer (inhibit-quit t)) + (save-window-excursion + (setq buffer (org-switch-to-buffer-other-window "*Org Select*")) + (setq orig-table table) + (catch 'exit + (while t + (erase-buffer) + (insert title "\n\n") + (setq tbl table + des-keys nil + allowed-keys nil + cursor-type nil) + (setq prefix (if current (concat current " ") "")) + (while tbl + (cond + ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1)) + ;; This is a description on this level + (setq dkey (caar tbl) ddesc (cadar tbl)) + (pop tbl) + (push dkey des-keys) + (push dkey allowed-keys) + (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n") + ;; Skip keys which are below this prefix + (setq re (concat "\\`" (regexp-quote dkey))) + (let (case-fold-search) + (while (and tbl (string-match re (caar tbl))) (pop tbl)))) + ((= 2 (length (car tbl))) + ;; Not yet a usable description, skip it + ) + (t + ;; usable entry on this level + (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n") + (push (caar tbl) allowed-keys) + (pop tbl)))) + (when specials + (insert "-------------------------------------------------------------------------------\n") + (let ((sp specials)) + (while sp + (insert (format "[%s] %s\n" + (caar sp) (nth 1 (car sp)))) + (push (caar sp) allowed-keys) + (pop sp)))) + (push "\C-g" allowed-keys) + (goto-char (point-min)) + (if (not (pos-visible-in-window-p (point-max))) + (org-fit-window-to-buffer)) + (message prompt) + (setq pressed (char-to-string (read-char-exclusive))) + (while (not (member pressed allowed-keys)) + (message "Invalid key `%s'" pressed) (sit-for 1) + (message prompt) + (setq pressed (char-to-string (read-char-exclusive)))) + (when (equal pressed "\C-g") + (kill-buffer buffer) + (error "Abort")) + (when (and (not (assoc pressed table)) + (not (member pressed des-keys)) + (assoc pressed specials)) + (throw 'exit (setq rtn pressed))) + (unless (member pressed des-keys) + (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table)) + orig-table)))) + (setq current (concat current pressed)) + (setq table (mapcar + (lambda (x) + (if (and (> (length (car x)) 1) + (equal (substring (car x) 0 1) pressed)) + (cons (substring (car x) 1) (cdr x)) + nil)) + table)) + (setq table (remove nil table))))) + (when buffer (kill-buffer buffer)) + rtn)) +;;; 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." @@ -1496,10 +1620,8 @@ The template may still contain \"%?\" for cursor positioning." (setq v-i (mapconcat 'identity (org-split-string initial "\n") (concat "\n" lead)))))) - (replace-match - (or (org-add-props (eval (intern (concat "v-" (match-string 1)))) - '(org-protected t)) "") - t t))) + (replace-match (or (eval (intern (concat "v-" (match-string 1)))) "") + t t))) ;; From the property list (when plist-p @@ -1515,8 +1637,7 @@ The template may still contain \"%?\" for cursor positioning." (let ((org-inhibit-startup t)) (org-mode)) ;; Interactive template entries (goto-char (point-min)) - (while (and (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) - (not (get-text-property (1- (point)) 'org-protected))) + (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) (unless (org-capture-escaped-%) (setq char (if (match-end 3) (match-string-no-properties 3)) prompt (if (match-end 2) (match-string-no-properties 2))) @@ -1621,9 +1742,29 @@ The template may still contain \"%?\" for cursor positioning." (goto-char (match-beginning 0)) (let ((template-start (point))) (forward-char 1) - (let ((result (org-eval (read (current-buffer))))) + (let* ((sexp (read (current-buffer))) + (result (org-eval + (org-capture--expand-keyword-in-embedded-elisp sexp)))) (delete-region template-start (point)) - (insert result)))))) + (when result + (if (stringp result) + (insert result) + (error "Capture template sexp `%s' must evaluate to string or nil" + sexp)))))))) + +(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 () "Return non-nil if point is inside of embedded elisp %(sexp)." @@ -1643,7 +1784,7 @@ The template may still contain \"%?\" for cursor positioning." ;;;###autoload (defun org-capture-import-remember-templates () - "Set org-capture-templates to be similar to `org-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? ") @@ -1660,7 +1801,7 @@ The template may still contain \"%?\" for cursor positioning." (position (or (nth 4 entry) org-remember-default-headline)) (type 'entry) (prepend org-reverse-note-order) - immediate target) + immediate target jump-to-captured) (cond ((member position '(top bottom)) (setq target (list 'file file) @@ -1674,9 +1815,13 @@ The template may still contain \"%?\" for cursor positioning." (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) (if prepend '(:prepend t)) - (if immediate '(:immediate-finish t))))) + (if immediate '(:immediate-finish t)) + (if jump-to-captured '(:jump-to-captured t))))) org-remember-templates)))) |