HCoop / bpt / emacs.git / blame
| Commit | Line | Data |
|---|---|---|
| 86fbb8ca CD |
1 | ;;; org-capture.el --- Fast note taking in Org-mode |
| 2 | ||
| 3 | ;; Copyright (C) 2010 Free Software Foundation, Inc. | |
| 4 | ||
| 5 | ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
| 6 | ;; Keywords: outlines, hypermedia, calendar, wp | |
| 7 | ;; Homepage: http://orgmode.org | |
| afe98dfa | 8 | ;; Version: 7.3 |
| 86fbb8ca CD |
9 | ;; |
| 10 | ;; This file is part of GNU Emacs. | |
| 11 | ;; | |
| 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
| 13 | ;; it under the terms of the GNU General Public License as published by | |
| 14 | ;; the Free Software Foundation, either version 3 of the License, or | |
| 15 | ;; (at your option) any later version. | |
| 16 | ||
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 20 | ;; GNU General Public License for more details. | |
| 21 | ||
| 22 | ;; You should have received a copy of the GNU General Public License | |
| 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
| 24 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 25 | ;; | |
| 26 | ;;; Commentary: | |
| 27 | ||
| 28 | ;; This file contains an alternative implementation of the same functionality | |
| 29 | ;; that is also provided by org-remember.el. The implementation is more | |
| 30 | ;; streamlined, can produce more target types (e.g. plain list items or | |
| 31 | ;; table lines). Also, it does not use a temporary buffer for editing | |
| 32 | ;; the captured entry - instead it uses an indirect buffer that visits | |
| 33 | ;; the new entry already in the target buffer (this was an idea by Samuel | |
| 34 | ;; Wales). John Wiegley's excellent `remember.el' is not needed for this | |
| 35 | ;; implementation, even though we borrow heavily from its ideas. | |
| 36 | ||
| 37 | ;; This implementation heavily draws on ideas by James TD Smith and | |
| 38 | ;; Samuel Wales, and, of cause, uses John Wiegley's remember.el as inspiration. | |
| 39 | ||
| 40 | ;;; TODO | |
| 41 | ||
| 42 | ;; - find a clever way to not always insert an annotation maybe a | |
| 43 | ;; predicate function that can check for conditions for %a to be | |
| 44 | ;; used. This could be one of the properties. | |
| 45 | ||
| 46 | ;; - Should there be plist members that arrange for properties to be | |
| 47 | ;; asked for, like James proposed in his RFC? | |
| 48 | ||
| 49 | ;;; Code: | |
| 50 | ||
| 51 | (eval-when-compile | |
| 52 | (require 'cl)) | |
| 53 | (require 'org) | |
| 54 | (require 'org-mks) | |
| 55 | ||
| 56 | (declare-function org-datetree-find-date-create "org-datetree" | |
| 57 | (DATE &optional KEEP-RESTRICTION)) | |
| 58 | (declare-function org-table-get-specials "org-table" ()) | |
| 59 | (declare-function org-table-goto-line "org-table" (N)) | |
| 60 | (defvar org-remember-default-headline) | |
| 61 | (defvar org-remember-templates) | |
| 62 | (defvar org-table-hlines) | |
| 63 | ||
| 64 | (defvar org-capture-clock-was-started nil | |
| 65 | "Internal flag, noting if the clock was started.") | |
| 66 | ||
| 67 | (defvar org-capture-last-stored-marker (make-marker) | |
| 68 | "Marker pointing to the entry most recently stored with `org-capture'.") | |
| 69 | ||
| 70 | ;; The following variable is scoped dynamically by org-protocol | |
| 71 | ;; to indicate that the link properties have already been stored | |
| 72 | (defvar org-capture-link-is-already-stored nil) | |
| 73 | ||
| 74 | (defgroup org-capture nil | |
| 75 | "Options concerning capturing new entries." | |
| 76 | :tag "Org Capture" | |
| 77 | :group 'org) | |
| 78 | ||
| afe98dfa | 79 | ;;;###autoload |
| 86fbb8ca CD |
80 | (defcustom org-capture-templates nil |
| 81 | "Templates for the creation of new entries. | |
| 82 | ||
| 83 | Each entry is a list with the following items: | |
| 84 | ||
| 85 | keys The keys that will select the template, as a string, characters | |
| 86 | only, for example \"a\" for a template to be selected with a | |
| 87 | single key, or \"bt\" for selection with two keys. When using | |
| 88 | several keys, keys using the same prefix key must be together | |
| 89 | in the list and preceded by a 2-element entry explaining the | |
| 90 | prefix key, for example | |
| 91 | ||
| 92 | (\"b\" \"Templates for marking stuff to buy\") | |
| 93 | ||
| 94 | The \"C\" key is used by default for quick access to the | |
| 95 | customization of the template variable. But if you want to use | |
| 96 | that key for a template, you can. | |
| 97 | ||
| 98 | description A short string describing the template, will be shown during | |
| 99 | selection. | |
| 100 | ||
| 101 | type The type of entry. Valid types are: | |
| 102 | entry an Org-mode node, with a headline. Will be | |
| 103 | filed as the child of the target entry or as | |
| 104 | a top-level entry. | |
| 105 | item a plain list item, will be placed in the | |
| 106 | first plain list at the target | |
| 107 | location. | |
| 108 | checkitem a checkbox item. This differs from the | |
| 109 | plain list item only is so far as it uses a | |
| 110 | different default template. | |
| 111 | table-line a new line in the first table at target location. | |
| 112 | plain text to be inserted as it is. | |
| 113 | ||
| 114 | target Specification of where the captured item should be placed. | |
| 115 | In Org-mode files, targets usually define a node. Entries will | |
| 116 | become children of this node, other types will be added to the | |
| 117 | table or list in the body of this node. | |
| 118 | ||
| 119 | Valid values are: | |
| 120 | ||
| 121 | (file \"path/to/file\") | |
| 122 | Text will be placed at the beginning or end of that file | |
| 123 | ||
| 124 | (id \"id of existing org entry\") | |
| 125 | File as child of this entry, or in the body of the entry | |
| 126 | ||
| 127 | (file+headline \"path/to/file\" \"node headline\") | |
| 128 | Fast configuration if the target heading is unique in the file | |
| 129 | ||
| 130 | (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...) | |
| 131 | For non-unique headings, the full path is safer | |
| 132 | ||
| 133 | (file+regexp \"path/to/file\" \"regexp to find location\") | |
| 134 | File to the entry matching regexp | |
| 135 | ||
| 136 | (file+datetree \"path/to/file\") | |
| 137 | Will create a heading in a date tree | |
| 138 | ||
| 139 | (file+function \"path/to/file\" function-finding-location) | |
| 140 | A function to find the right location in the file | |
| 141 | ||
| 142 | (clock) | |
| 143 | File to the entry that is currently being clocked | |
| 144 | ||
| 145 | (function function-finding-location) | |
| 146 | Most general way, write your own function to find both | |
| 147 | file and location | |
| 148 | ||
| 149 | template The template for creating the capture item. If you leave this | |
| 150 | empty, an appropriate default template will be used. See below | |
| 151 | for more details. Instead of a string, this may also be one of | |
| 152 | ||
| 153 | (file \"/path/to/template-file\") | |
| 154 | (function function-returning-the-template) | |
| 155 | ||
| 156 | in order to get a template from a file, or dynamically | |
| 157 | from a function. | |
| 158 | ||
| 159 | The rest of the entry is a property list of additional options. Recognized | |
| 160 | properties are: | |
| 161 | ||
| 162 | :prepend Normally newly captured information will be appended at | |
| 163 | the target location (last child, last table line, | |
| 164 | last list item...). Setting this property will | |
| 165 | change that. | |
| 166 | ||
| 167 | :immediate-finish When set, do not offer to edit the information, just | |
| 168 | file it away immediately. This makes sense if the | |
| 169 | template only needs information that can be added | |
| 170 | automatically. | |
| 171 | ||
| 172 | :empty-lines Set this to the number of lines the should be inserted | |
| 173 | before and after the new item. Default 0, only common | |
| 174 | other value is 1. | |
| 175 | ||
| 176 | :clock-in Start the clock in this item. | |
| 177 | ||
| 178 | :clock-resume Start the interrupted clock when finishing the capture. | |
| 179 | ||
| 180 | :unnarrowed Do not narrow the target buffer, simply show the | |
| 181 | full buffer. Default is to narrow it so that you | |
| 182 | only see the new stuff. | |
| 183 | ||
| 184 | :table-line-pos Specification of the location in the table where the | |
| 185 | new line should be inserted. It looks like \"II-3\" | |
| 186 | which means that the new line should become the third | |
| 187 | line before the second horizontal separator line. | |
| 188 | ||
| afe98dfa CD |
189 | :kill-buffer If the target file was not yet visited by a buffer when |
| 190 | capture was invoked, kill the buffer again after capture | |
| 191 | is finalized. | |
| 192 | ||
| 86fbb8ca CD |
193 | The template defines the text to be inserted. Often this is an org-mode |
| 194 | entry (so the first line should start with a star) that will be filed as a | |
| 195 | child of the target headline. It can also be freely formatted text. | |
| 196 | Furthermore, the following %-escapes will be replaced with content: | |
| 197 | ||
| 198 | %^{prompt} prompt the user for a string and replace this sequence with it. | |
| 199 | A default value and a completion table ca be specified like this: | |
| 200 | %^{prompt|default|completion2|completion3|...} | |
| 201 | %t time stamp, date only | |
| 202 | %T time stamp with date and time | |
| 203 | %u, %U like the above, but inactive time stamps | |
| 204 | %^t like %t, but prompt for date. Similarly %^T, %^u, %^U. | |
| 205 | You may define a prompt like %^{Please specify birthday | |
| 206 | %n user name (taken from `user-full-name') | |
| 207 | %a annotation, normally the link created with `org-store-link' | |
| 208 | %i initial content, copied from the active region. If %i is | |
| 209 | indented, the entire inserted text will be indented as well. | |
| 210 | %c current kill ring head | |
| 211 | %x content of the X clipboard | |
| 212 | %^C interactive selection of which kill or clip to use | |
| 213 | %^L like %^C, but insert as link | |
| 214 | %k title of currently clocked task | |
| 215 | %K link to currently clocked task | |
| 216 | %^g prompt for tags, with completion on tags in target file | |
| 217 | %^G prompt for tags, with completion on all tags in all agenda files | |
| 218 | %^{prop}p prompt the user for a value for property `prop' | |
| 219 | %:keyword specific information for certain link types, see below | |
| 220 | %[pathname] insert the contents of the file given by `pathname' | |
| 221 | %(sexp) evaluate elisp `(sexp)' and replace with the result | |
| 222 | ||
| 223 | %? After completing the template, position cursor here. | |
| 224 | ||
| 225 | Apart from these general escapes, you can access information specific to the | |
| 226 | link type that is created. For example, calling `org-capture' in emails | |
| 227 | or gnus will record the author and the subject of the message, which you | |
| afe98dfa | 228 | can access with \"%:from\" and \"%:subject\", respectively. Here is a |
| 86fbb8ca CD |
229 | complete list of what is recorded for each link type. |
| 230 | ||
| afe98dfa CD |
231 | Link type | Available information |
| 232 | ------------------------+------------------------------------------------------ | |
| 233 | bbdb | %:type %:name %:company | |
| 234 | vm, wl, mh, mew, rmail | %:type %:subject %:message-id | |
| 235 | | %:from %:fromname %:fromaddress | |
| 236 | | %:to %:toname %:toaddress | |
| 237 | | %:fromto (either \"to NAME\" or \"from NAME\") | |
| 238 | | %:date | |
| 239 | | %:date-timestamp (as active timestamp) | |
| 240 | | %:date-timestamp-inactive (as inactive timestamp) | |
| 241 | gnus | %:group, for messages also all email fields | |
| 242 | w3, w3m | %:type %:url | |
| 243 | info | %:type %:file %:node | |
| 244 | calendar | %:type %:date" | |
| 86fbb8ca CD |
245 | :group 'org-capture |
| 246 | :type | |
| 247 | '(repeat | |
| 248 | (choice :value ("" "" entry (file "~/org/notes.org") "") | |
| 249 | (list :tag "Multikey description" | |
| 250 | (string :tag "Keys ") | |
| 251 | (string :tag "Description")) | |
| 252 | (list :tag "Template entry" | |
| 253 | (string :tag "Keys ") | |
| 254 | (string :tag "Description ") | |
| 255 | (choice :tag "Capture Type " :value entry | |
| 256 | (const :tag "Org entry" entry) | |
| 257 | (const :tag "Plain list item" item) | |
| 258 | (const :tag "Checkbox item" checkitem) | |
| 259 | (const :tag "Plain text" plain) | |
| 260 | (const :tag "Table line" table-line)) | |
| 261 | (choice :tag "Target location" | |
| 262 | (list :tag "File" | |
| 263 | (const :format "" file) | |
| 264 | (file :tag " File")) | |
| 265 | (list :tag "ID" | |
| 266 | (const :format "" id) | |
| 267 | (string :tag " ID")) | |
| 268 | (list :tag "File & Headline" | |
| 269 | (const :format "" file+headline) | |
| 270 | (file :tag " File ") | |
| 271 | (string :tag " Headline")) | |
| 272 | (list :tag "File & Outline path" | |
| 273 | (const :format "" file+olp) | |
| 274 | (file :tag " File ") | |
| 275 | (repeat :tag "Outline path" :inline t | |
| 276 | (string :tag "Headline"))) | |
| 277 | (list :tag "File & Regexp" | |
| 278 | (const :format "" file+regexp) | |
| 279 | (file :tag " File ") | |
| 280 | (regexp :tag " Regexp")) | |
| 281 | (list :tag "File & Date tree" | |
| 282 | (const :format "" file+datetree) | |
| 283 | (file :tag " File")) | |
| 284 | (list :tag "File & function" | |
| 285 | (const :format "" file+function) | |
| 286 | (file :tag " File ") | |
| 287 | (sexp :tag " Function")) | |
| 288 | (list :tag "Current clocking task" | |
| 289 | (const :format "" clock)) | |
| 290 | (list :tag "Function" | |
| 291 | (const :format "" function) | |
| 292 | (sexp :tag " Function"))) | |
| 293 | (choice :tag "Template" | |
| 294 | (string) | |
| 295 | (list :tag "File" | |
| 296 | (const :format "" file) | |
| 297 | (file :tag "Template file")) | |
| 298 | (list :tag "Function" | |
| 299 | (const :format "" function) | |
| afe98dfa | 300 | (function :tag "Template function"))) |
| 86fbb8ca CD |
301 | (plist :inline t |
| 302 | ;; Give the most common options as checkboxes | |
| 303 | :options (((const :format "%v " :prepend) (const t)) | |
| 304 | ((const :format "%v " :immediate-finish) (const t)) | |
| 305 | ((const :format "%v " :empty-lines) (const 1)) | |
| 306 | ((const :format "%v " :clock-in) (const t)) | |
| 307 | ((const :format "%v " :clock-resume) (const t)) | |
| afe98dfa CD |
308 | ((const :format "%v " :unnarrowed) (const t)) |
| 309 | ((const :format "%v " :kill-buffer) (const t)))))))) | |
| 86fbb8ca CD |
310 | |
| 311 | (defcustom org-capture-before-finalize-hook nil | |
| 312 | "Hook that is run right before a remember process is finalized. | |
| 313 | The remember buffer is still current when this hook runs." | |
| 314 | :group 'org-capture | |
| 315 | :type 'hook) | |
| 316 | ||
| 317 | ;;; The property list for keeping information about the capture process | |
| 318 | ||
| 319 | (defvar org-capture-plist nil | |
| 320 | "Plist for the current capture process, global, to avoid having to pass it.") | |
| 321 | (defvar org-capture-current-plist nil | |
| 322 | "Local variable holding the plist in a capture buffer. | |
| 323 | This is used to store the plist for use when finishing a capture process. | |
| 324 | Another such process might have changed the global variable by then.") | |
| 325 | ||
| 326 | (defun org-capture-put (&rest stuff) | |
| 327 | (while stuff | |
| 328 | (setq org-capture-plist (plist-put org-capture-plist | |
| 329 | (pop stuff) (pop stuff))))) | |
| 330 | (defun org-capture-get (prop &optional local) | |
| 331 | (plist-get (if local org-capture-current-plist org-capture-plist) prop)) | |
| 332 | ||
| 333 | (defun org-capture-member (prop) | |
| 334 | (plist-get org-capture-plist prop)) | |
| 335 | ||
| 336 | ;;; The minor mode | |
| 337 | ||
| 338 | (defvar org-capture-mode-map (make-sparse-keymap) | |
| 339 | "Keymap for `org-capture-mode', a minor mode. | |
| 340 | Use this map to set additional keybindings for when Org-mode is used | |
| 341 | for a Remember buffer.") | |
| 342 | ||
| 343 | (defvar org-capture-mode-hook nil | |
| 344 | "Hook for the minor `org-capture-mode'.") | |
| 345 | ||
| 346 | (define-minor-mode org-capture-mode | |
| 347 | "Minor mode for special key bindings in a remember buffer." | |
| 348 | nil " Rem" org-capture-mode-map | |
| 349 | (org-set-local | |
| 350 | 'header-line-format | |
| 351 | "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.") | |
| 352 | (run-hooks 'org-capture-mode-hook)) | |
| 353 | (define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize) | |
| 354 | (define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill) | |
| 355 | (define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile) | |
| 356 | ||
| 357 | ;;; The main commands | |
| 358 | ||
| 359 | ;;;###autoload | |
| 360 | (defun org-capture (&optional goto keys) | |
| 361 | "Capture something. | |
| 362 | \\<org-capture-mode-map> | |
| 363 | This will let you select a template from `org-capture-templates', and then | |
| 364 | file the newly captured information. The text is immediately inserted | |
| 365 | at the target location, and an indirect buffer is shown where you can | |
| 366 | edit it. Pressing \\[org-capture-finalize] brings you back to the previous state | |
| 367 | of Emacs, so that you can continue your work. | |
| 368 | ||
| 369 | When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture | |
| 370 | anything, just go to the file/headline where the selected template | |
| 371 | stores its notes. With a double prefix argument \ | |
| 372 | \\[universal-argument] \\[universal-argument], go to the last note | |
| 373 | stored. | |
| 374 | ||
| 375 | When called with a `C-0' (zero) prefix, insert a template at point. | |
| 376 | ||
| 377 | Lisp programs can set KEYS to a string associated with a template in | |
| 378 | `org-capture-templates'. In this case, interactive selection will be | |
| 379 | bypassed." | |
| 380 | (interactive "P") | |
| 381 | (cond | |
| 382 | ((equal goto '(4)) (org-capture-goto-target)) | |
| 383 | ((equal goto '(16)) (org-capture-goto-last-stored)) | |
| 384 | (t | |
| 385 | ;; FIXME: Are these needed? | |
| 386 | (let* ((orig-buf (current-buffer)) | |
| 387 | (annotation (if (and (boundp 'org-capture-link-is-already-stored) | |
| 388 | org-capture-link-is-already-stored) | |
| 389 | (plist-get org-store-link-plist :annotation) | |
| 390 | (org-store-link nil))) | |
| 391 | (initial (and (org-region-active-p) | |
| 392 | (buffer-substring (point) (mark)))) | |
| 393 | (entry (org-capture-select-template keys))) | |
| afe98dfa CD |
394 | (when (stringp initial) |
| 395 | (remove-text-properties 0 (length initial) '(read-only t) initial)) | |
| 396 | (when (stringp annotation) | |
| 397 | (remove-text-properties 0 (length annotation) | |
| 398 | '(read-only t) annotation)) | |
| 86fbb8ca CD |
399 | (cond |
| 400 | ((equal entry "C") | |
| 401 | (customize-variable 'org-capture-templates)) | |
| 402 | ((equal entry "q") | |
| 403 | (error "Abort")) | |
| 404 | (t | |
| 405 | (org-capture-set-plist entry) | |
| 406 | (org-capture-get-template) | |
| 407 | (org-capture-put :original-buffer orig-buf :annotation annotation | |
| 408 | :initial initial) | |
| 409 | (org-capture-put :default-time | |
| 410 | (or org-overriding-default-time | |
| 411 | (org-current-time))) | |
| 412 | (org-capture-set-target-location) | |
| 413 | (condition-case error | |
| 414 | (org-capture-put :template (org-capture-fill-template)) | |
| 415 | ((error quit) | |
| 416 | (if (get-buffer "*Capture*") (kill-buffer "*Capture*")) | |
| 417 | (error "Capture abort: %s" error))) | |
| 418 | ||
| 419 | (if (equal goto 0) | |
| 420 | ;;insert at point | |
| 421 | (org-capture-insert-template-here) | |
| 422 | (condition-case error | |
| 423 | (org-capture-place-template) | |
| 424 | ((error quit) | |
| 425 | (if (and (buffer-base-buffer (current-buffer)) | |
| 426 | (string-match "\\`CAPTURE-" (buffer-name))) | |
| 427 | (kill-buffer (current-buffer))) | |
| 428 | (set-window-configuration (org-capture-get :return-to-wconf)) | |
| 429 | (error "Capture template `%s': %s" | |
| 430 | (org-capture-get :key) | |
| 431 | (nth 1 error)))) | |
| 432 | (if (org-capture-get :immediate-finish) | |
| 433 | (org-capture-finalize) | |
| 434 | (if (and (org-mode-p) | |
| 435 | (org-capture-get :clock-in)) | |
| 436 | (condition-case nil | |
| 437 | (progn | |
| 438 | (if (org-clock-is-active) | |
| 439 | (org-capture-put :interrupted-clock | |
| 440 | (copy-marker org-clock-marker))) | |
| 441 | (org-clock-in) | |
| 442 | (org-set-local 'org-capture-clock-was-started t)) | |
| 443 | (error | |
| 444 | "Could not start the clock in this capture buffer"))))))))))) | |
| 445 | ||
| 446 | ||
| 447 | (defun org-capture-get-template () | |
| 448 | "Get the template from a file or a function if necessary." | |
| 449 | (let ((txt (org-capture-get :template)) file) | |
| 450 | (cond | |
| 451 | ((and (listp txt) (eq (car txt) 'file)) | |
| 452 | (if (file-exists-p | |
| 453 | (setq file (expand-file-name (nth 1 txt) org-directory))) | |
| 454 | (setq txt (org-file-contents file)) | |
| 455 | (setq txt (format "* Template file %s not found" (nth 1 txt))))) | |
| 456 | ((and (listp txt) (eq (car txt) 'function)) | |
| 457 | (if (fboundp (nth 1 txt)) | |
| 458 | (setq txt (funcall (nth 1 txt))) | |
| 459 | (setq txt (format "* Template function %s not found" (nth 1 txt))))) | |
| 460 | ((not txt) (setq txt "")) | |
| 461 | ((stringp txt)) | |
| 462 | (t (setq txt "* Invalid capture template"))) | |
| 463 | (org-capture-put :template txt))) | |
| 464 | ||
| 465 | (defun org-capture-finalize () | |
| 466 | "Finalize the capture process." | |
| 467 | (interactive) | |
| 468 | (unless (and org-capture-mode | |
| 469 | (buffer-base-buffer (current-buffer))) | |
| 470 | (error "This does not seem to be a capture buffer for Org-mode")) | |
| 471 | ||
| 472 | ;; Did we start the clock in this capture buffer? | |
| 473 | (when (and org-capture-clock-was-started | |
| 474 | org-clock-marker (marker-buffer org-clock-marker) | |
| 475 | (equal (marker-buffer org-clock-marker) (buffer-base-buffer)) | |
| 476 | (> org-clock-marker (point-min)) | |
| 477 | (< org-clock-marker (point-max))) | |
| 478 | ;; Looks like the clock we started is still running. Clock out. | |
| 479 | (let (org-log-note-clock-out) (org-clock-out)) | |
| 480 | (when (and (org-capture-get :clock-resume 'local) | |
| 481 | (markerp (org-capture-get :interrupted-clock 'local)) | |
| 482 | (buffer-live-p (marker-buffer | |
| 483 | (org-capture-get :interrupted-clock 'local)))) | |
| afe98dfa CD |
484 | (let ((clock-in-task (org-capture-get :interrupted-clock 'local))) |
| 485 | (org-with-point-at clock-in-task | |
| 486 | (org-clock-in))) | |
| 86fbb8ca CD |
487 | (message "Interrupted clock has been resumed"))) |
| 488 | ||
| 489 | (let ((beg (point-min)) | |
| 490 | (end (point-max)) | |
| 491 | (abort-note nil)) | |
| 492 | (widen) | |
| 493 | ||
| 494 | (if org-note-abort | |
| 495 | (let ((m1 (org-capture-get :begin-marker 'local)) | |
| 496 | (m2 (org-capture-get :end-marker 'local))) | |
| 497 | (if (and m1 m2 (= m1 beg) (= m2 end)) | |
| 498 | (progn | |
| 499 | (setq abort-note 'clean) | |
| 500 | (kill-region m1 m2)) | |
| 501 | (setq abort-note 'dirty))) | |
| 502 | ||
| 503 | ;; Make sure that the empty lines after are correct | |
| 504 | (when (and (> (point-max) end) ; indeed, the buffer was still narrowed | |
| 505 | (member (org-capture-get :type 'local) | |
| 506 | '(entry item checkitem plain))) | |
| 507 | (save-excursion | |
| 508 | (goto-char end) | |
| 509 | (or (bolp) (newline)) | |
| 510 | (org-capture-empty-lines-after | |
| 511 | (or (org-capture-get :empty-lines 'local) 0)))) | |
| 512 | ;; Postprocessing: Update Statistics cookies, do the sorting | |
| 513 | (when (org-mode-p) | |
| 514 | (save-excursion | |
| 515 | (when (ignore-errors (org-back-to-heading)) | |
| 516 | (org-update-parent-todo-statistics) | |
| 517 | (org-update-checkbox-count))) | |
| 518 | ;; FIXME Here we should do the sorting | |
| 519 | ;; If we have added a table line, maybe recompute? | |
| 520 | (when (and (eq (org-capture-get :type 'local) 'table-line) | |
| 521 | (org-at-table-p)) | |
| 522 | (if (org-table-get-stored-formulas) | |
| 523 | (org-table-recalculate 'all) ;; FIXME: Should we iterate??? | |
| 524 | (org-table-align))) | |
| 525 | ) | |
| 526 | ;; Store this place as the last one where we stored something | |
| 527 | ;; Do the marking in the base buffer, so that it makes sense after | |
| 528 | ;; the indirect buffer has been killed. | |
| 529 | (org-capture-bookmark-last-stored-position) | |
| 530 | ||
| 531 | ;; Run the hook | |
| 532 | (run-hooks 'org-capture-before-finalize-hook) | |
| 533 | ) | |
| 534 | ||
| 535 | ;; Kill the indirect buffer | |
| 536 | (save-buffer) | |
| afe98dfa CD |
537 | (let ((return-wconf (org-capture-get :return-to-wconf 'local)) |
| 538 | (new-buffer (org-capture-get :new-buffer 'local)) | |
| 539 | (kill-buffer (org-capture-get :kill-buffer 'local)) | |
| 540 | (base-buffer (buffer-base-buffer (current-buffer)))) | |
| 541 | ||
| 542 | ;; Kill the indiret buffer | |
| 86fbb8ca | 543 | (kill-buffer (current-buffer)) |
| afe98dfa CD |
544 | |
| 545 | ;; Kill the target buffer if that is desired | |
| 546 | (when (and base-buffer new-buffer kill-buffer) | |
| 547 | (with-current-buffer base-buffer (save-buffer)) | |
| 548 | (kill-buffer base-buffer)) | |
| 549 | ||
| 86fbb8ca CD |
550 | ;; Restore the window configuration before capture |
| 551 | (set-window-configuration return-wconf)) | |
| 552 | (when abort-note | |
| 553 | (cond | |
| 554 | ((equal abort-note 'clean) | |
| afe98dfa | 555 | (message "Capture process aborted and target buffer cleaned up")) |
| 86fbb8ca CD |
556 | ((equal abort-note 'dirty) |
| 557 | (error "Capture process aborted, but target buffer could not be cleaned up correctly")))))) | |
| 558 | ||
| 559 | (defun org-capture-refile () | |
| 560 | "Finalize the current capture and then refile the entry. | |
| 561 | Refiling is done from the base buffer, because the indirect buffer is then | |
| 562 | already gone." | |
| 563 | (interactive) | |
| 564 | (unless (eq (org-capture-get :type 'local) 'entry) | |
| 565 | (error | |
| 566 | "Refiling from a capture buffer makes only sense for `entry'-type templates")) | |
| 567 | (let ((pos (point)) | |
| 568 | (base (buffer-base-buffer (current-buffer))) | |
| 569 | (org-refile-for-capture t)) | |
| 570 | (org-capture-finalize) | |
| 571 | (save-window-excursion | |
| 572 | (with-current-buffer (or base (current-buffer)) | |
| 573 | (save-excursion | |
| 574 | (save-restriction | |
| 575 | (widen) | |
| 576 | (goto-char pos) | |
| 577 | (call-interactively 'org-refile))))))) | |
| 578 | ||
| 579 | (defun org-capture-kill () | |
| 580 | "Abort the current capture process." | |
| 581 | (interactive) | |
| 582 | ;; FIXME: This does not do the right thing, we need to remove the new stuff | |
| 583 | ;; By hand it is easy: undo, then kill the buffer | |
| 584 | (let ((org-note-abort t) (org-capture-before-finalize-hook nil)) | |
| 585 | (org-capture-finalize))) | |
| 586 | ||
| 587 | (defun org-capture-goto-last-stored () | |
| 588 | "Go to the location where the last remember note was stored." | |
| 589 | (interactive) | |
| 590 | (org-goto-marker-or-bmk org-capture-last-stored-marker | |
| 591 | "org-capture-last-stored") | |
| 592 | (message "This is the last note stored by a capture process")) | |
| 593 | ||
| 594 | ;;; Supporting functions for handling the process | |
| 595 | ||
| 596 | (defun org-capture-set-target-location (&optional target) | |
| 597 | "Find target buffer and position and store then in the property list." | |
| 598 | (let ((target-entry-p t)) | |
| 599 | (setq target (or target (org-capture-get :target))) | |
| 600 | (save-excursion | |
| 601 | (cond | |
| 602 | ((eq (car target) 'file) | |
| 603 | (set-buffer (org-capture-target-buffer (nth 1 target))) | |
| 604 | (setq target-entry-p nil)) | |
| 605 | ||
| 606 | ((eq (car target) 'id) | |
| 607 | (let ((loc (org-id-find (nth 1 target)))) | |
| 608 | (if (not loc) | |
| 609 | (error "Cannot find target ID \"%s\"" (nth 1 target)) | |
| 610 | (set-buffer (org-capture-target-buffer (car loc))) | |
| 611 | (goto-char (cdr loc))))) | |
| 612 | ||
| 613 | ((eq (car target) 'file+headline) | |
| 614 | (set-buffer (org-capture-target-buffer (nth 1 target))) | |
| 615 | (let ((hd (nth 2 target))) | |
| 616 | (goto-char (point-min)) | |
| afe98dfa CD |
617 | (unless (org-mode-p) |
| 618 | (error "Target buffer for file+headline should be in Org mode")) | |
| 86fbb8ca CD |
619 | (if (re-search-forward |
| 620 | (format org-complex-heading-regexp-format (regexp-quote hd)) | |
| 621 | nil t) | |
| 622 | (goto-char (point-at-bol)) | |
| 623 | (goto-char (point-max)) | |
| 624 | (or (bolp) (insert "\n")) | |
| 625 | (insert "* " hd "\n") | |
| 626 | (beginning-of-line 0)))) | |
| 627 | ||
| 628 | ((eq (car target) 'file+olp) | |
| 629 | (let ((m (org-find-olp (cdr target)))) | |
| 630 | (set-buffer (marker-buffer m)) | |
| 631 | (goto-char m))) | |
| 632 | ||
| 633 | ((eq (car target) 'file+regexp) | |
| 634 | (set-buffer (org-capture-target-buffer (nth 1 target))) | |
| 635 | (goto-char (point-min)) | |
| 636 | (if (re-search-forward (nth 2 target) nil t) | |
| 637 | (progn | |
| 638 | (goto-char (if (org-capture-get :prepend) | |
| 639 | (match-beginning 0) (match-end 0))) | |
| 640 | (org-capture-put :exact-position (point)) | |
| 641 | (setq target-entry-p (and (org-mode-p) (org-at-heading-p)))) | |
| 642 | (error "No match for target regexp in file %s" (nth 1 target)))) | |
| 643 | ||
| 644 | ((eq (car target) 'file+datetree) | |
| 645 | (require 'org-datetree) | |
| 646 | (set-buffer (org-capture-target-buffer (nth 1 target))) | |
| 647 | ;; Make a date tree entry, with the current date (or yesterday, | |
| 648 | ;; if we are extending dates for a couple of hours) | |
| 649 | (org-datetree-find-date-create | |
| 650 | (calendar-gregorian-from-absolute | |
| 651 | (if org-overriding-default-time | |
| 652 | (time-to-days org-overriding-default-time) | |
| 653 | (time-to-days | |
| 654 | (time-subtract (current-time) | |
| 655 | (list 0 (* 3600 org-extend-today-until) 0))))))) | |
| 656 | ||
| 657 | ((eq (car target) 'file+function) | |
| 658 | (set-buffer (org-capture-target-buffer (nth 1 target))) | |
| 659 | (funcall (nth 2 target)) | |
| 660 | (org-capture-put :exact-position (point)) | |
| 661 | (setq target-entry-p (and (org-mode-p) (org-at-heading-p)))) | |
| 662 | ||
| 663 | ((eq (car target) 'function) | |
| 664 | (funcall (nth 1 target)) | |
| 665 | (org-capture-put :exact-position (point)) | |
| 666 | (setq target-entry-p (and (org-mode-p) (org-at-heading-p)))) | |
| 667 | ||
| 668 | ((eq (car target) 'clock) | |
| 669 | (if (and (markerp org-clock-hd-marker) | |
| 670 | (marker-buffer org-clock-hd-marker)) | |
| 671 | (progn (set-buffer (marker-buffer org-clock-hd-marker)) | |
| 672 | (goto-char org-clock-hd-marker)) | |
| 673 | (error "No running clock that could be used as capture target"))) | |
| 674 | ||
| 675 | (t (error "Invalid capture target specification"))) | |
| 676 | ||
| 677 | (org-capture-put :buffer (current-buffer) :pos (point) | |
| 678 | :target-entry-p target-entry-p)))) | |
| 679 | ||
| 680 | (defun org-capture-target-buffer (file) | |
| 681 | "Get a buffer for FILE." | |
| afe98dfa CD |
682 | (setq file (or (org-string-nw-p file) |
| 683 | org-default-notes-file | |
| 684 | (error "No notes file specified, and no default available"))) | |
| 86fbb8ca | 685 | (or (org-find-base-buffer-visiting file) |
| afe98dfa CD |
686 | (progn (org-capture-put :new-buffer t) |
| 687 | (find-file-noselect (expand-file-name file org-directory))))) | |
| 86fbb8ca CD |
688 | |
| 689 | (defun org-capture-steal-local-variables (buffer) | |
| 690 | "Install Org-mode local variables." | |
| 691 | (mapc (lambda (v) | |
| 692 | (ignore-errors (org-set-local (car v) (cdr v)))) | |
| 693 | (buffer-local-variables buffer))) | |
| 694 | ||
| 695 | (defun org-capture-place-template () | |
| 696 | "Insert the template at the target location, and display the buffer." | |
| 697 | (org-capture-put :return-to-wconf (current-window-configuration)) | |
| 698 | (delete-other-windows) | |
| 699 | (org-switch-to-buffer-other-window | |
| 700 | (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE")) | |
| afe98dfa | 701 | (widen) |
| 86fbb8ca CD |
702 | (show-all) |
| 703 | (goto-char (org-capture-get :pos)) | |
| 704 | (org-set-local 'org-capture-target-marker | |
| 705 | (move-marker (make-marker) (point))) | |
| 706 | (let* ((template (org-capture-get :template)) | |
| 707 | (type (org-capture-get :type))) | |
| 708 | (case type | |
| 709 | ((nil entry) (org-capture-place-entry)) | |
| 710 | (table-line (org-capture-place-table-line)) | |
| 711 | (plain (org-capture-place-plain-text)) | |
| afe98dfa CD |
712 | (item (org-capture-place-item)) |
| 713 | (checkitem (org-capture-place-item)))) | |
| 86fbb8ca CD |
714 | (org-capture-mode 1) |
| 715 | (org-set-local 'org-capture-current-plist org-capture-plist)) | |
| 716 | ||
| 717 | (defun org-capture-place-entry () | |
| 718 | "Place the template as a new Org entry." | |
| 719 | (let* ((txt (org-capture-get :template)) | |
| 720 | (reversed (org-capture-get :prepend)) | |
| 721 | (target-entry-p (org-capture-get :target-entry-p)) | |
| 722 | level beg end file) | |
| 723 | ||
| 724 | (cond | |
| 725 | ((org-capture-get :exact-position) | |
| 726 | (goto-char (org-capture-get :exact-position))) | |
| 727 | ((not target-entry-p) | |
| 728 | ;; Insert as top-level entry, either at beginning or at end of file | |
| 729 | (setq level 1) | |
| 730 | (if reversed | |
| 731 | (progn (goto-char (point-min)) | |
| afe98dfa CD |
732 | (or (org-at-heading-p) |
| 733 | (outline-next-heading))) | |
| 86fbb8ca CD |
734 | (goto-char (point-max)) |
| 735 | (or (bolp) (insert "\n")))) | |
| 736 | (t | |
| 737 | ;; Insert as a child of the current entry | |
| 738 | (and (looking-at "\\*+") | |
| 739 | (setq level (- (match-end 0) (match-beginning 0)))) | |
| 740 | (setq level (org-get-valid-level (or level 1) 1)) | |
| 741 | (if reversed | |
| 742 | (progn | |
| 743 | (outline-next-heading) | |
| 744 | (or (bolp) (insert "\n"))) | |
| 745 | (org-end-of-subtree t t) | |
| 746 | (or (bolp) (insert "\n"))))) | |
| 747 | (org-capture-empty-lines-before) | |
| 748 | (setq beg (point)) | |
| 749 | (org-paste-subtree level txt 'for-yank) | |
| 750 | (org-capture-empty-lines-after 1) | |
| 751 | (org-capture-position-for-last-stored beg) | |
| 752 | (outline-next-heading) | |
| 753 | (setq end (point)) | |
| 754 | (org-capture-mark-kill-region beg (1- end)) | |
| 755 | (org-capture-narrow beg (1- end)) | |
| afe98dfa | 756 | (goto-char beg) |
| 86fbb8ca CD |
757 | (if (re-search-forward "%\\?" end t) (replace-match "")))) |
| 758 | ||
| 759 | (defun org-capture-place-item () | |
| 760 | "Place the template as a new plain list item." | |
| 761 | (let* ((txt (org-capture-get :template)) | |
| 762 | (target-entry-p (org-capture-get :target-entry-p)) | |
| 763 | (ind 0) | |
| 764 | beg end) | |
| 765 | (cond | |
| 766 | ((org-capture-get :exact-position) | |
| 767 | (goto-char (org-capture-get :exact-position))) | |
| 768 | ((not target-entry-p) | |
| 769 | ;; Insert as top-level entry, either at beginning or at end of file | |
| 770 | (setq beg (point-min) end (point-max))) | |
| 771 | (t | |
| 772 | (setq beg (1+ (point-at-eol)) | |
| 773 | end (save-excursion (outline-next-heading) (point))))) | |
| 774 | (if (org-capture-get :prepend) | |
| 775 | (progn | |
| 776 | (goto-char beg) | |
| afe98dfa | 777 | (if (org-search-forward-unenclosed org-item-beginning-re end t) |
| 86fbb8ca CD |
778 | (progn |
| 779 | (goto-char (match-beginning 0)) | |
| 780 | (setq ind (org-get-indentation))) | |
| 781 | (goto-char end) | |
| 782 | (setq ind 0))) | |
| 783 | (goto-char end) | |
| afe98dfa | 784 | (if (org-search-backward-unenclosed org-item-beginning-re beg t) |
| 86fbb8ca CD |
785 | (progn |
| 786 | (setq ind (org-get-indentation)) | |
| 787 | (org-end-of-item)) | |
| 788 | (setq ind 0))) | |
| 789 | ;; Remove common indentation | |
| 790 | (setq txt (org-remove-indentation txt)) | |
| 791 | ;; Make sure this is indeed an item | |
| 792 | (unless (string-match (concat "\\`" (org-item-re)) txt) | |
| 793 | (setq txt (concat "- " | |
| 794 | (mapconcat 'identity (split-string txt "\n") | |
| 795 | "\n ")))) | |
| 796 | ;; Set the correct indentation, depending on context | |
| 797 | (setq ind (make-string ind ?\ )) | |
| 798 | (setq txt (concat ind | |
| 799 | (mapconcat 'identity (split-string txt "\n") | |
| 800 | (concat "\n" ind)) | |
| 801 | "\n")) | |
| 802 | ;; Insert, with surrounding empty lines | |
| 803 | (org-capture-empty-lines-before) | |
| 804 | (setq beg (point)) | |
| 805 | (insert txt) | |
| 806 | (or (bolp) (insert "\n")) | |
| 807 | (org-capture-empty-lines-after 1) | |
| 808 | (org-capture-position-for-last-stored beg) | |
| 809 | (forward-char 1) | |
| 810 | (setq end (point)) | |
| 811 | (org-capture-mark-kill-region beg (1- end)) | |
| 812 | (org-capture-narrow beg (1- end)) | |
| 813 | (if (re-search-forward "%\\?" end t) (replace-match "")))) | |
| 814 | ||
| 815 | (defun org-capture-place-table-line () | |
| 816 | "Place the template as a table line." | |
| 817 | (require 'org-table) | |
| 818 | (let* ((txt (org-capture-get :template)) | |
| 819 | (target-entry-p (org-capture-get :target-entry-p)) | |
| 820 | (table-line-pos (org-capture-get :table-line-pos)) | |
| 821 | ind beg end) | |
| 822 | (cond | |
| 823 | ((org-capture-get :exact-position) | |
| 824 | (goto-char (org-capture-get :exact-position))) | |
| 825 | ((not target-entry-p) | |
| 826 | ;; Table is not necessarily under a heading | |
| 827 | (setq beg (point-min) end (point-max))) | |
| 828 | (t | |
| 829 | ;; WE are at a heading, limit search to the body | |
| 830 | (setq beg (1+ (point-at-eol)) | |
| 831 | end (save-excursion (outline-next-heading) (point))))) | |
| 832 | (if (re-search-forward org-table-dataline-regexp end t) | |
| 833 | (let ((b (org-table-begin)) (e (org-table-end))) | |
| 834 | (goto-char e) | |
| 835 | (if (looking-at "[ \t]*#\\+TBLFM:") | |
| 836 | (forward-line 1)) | |
| 837 | (narrow-to-region b (point))) | |
| 838 | (goto-char end) | |
| 839 | (insert "\n| |\n|----|\n| |\n") | |
| 840 | (narrow-to-region (1+ end) (point))) | |
| 841 | ;; We are narrowed to the table, or to an empty line if there was no table | |
| 842 | ||
| 843 | ;; Check if the template is good | |
| 844 | (if (not (string-match org-table-dataline-regexp txt)) | |
| 845 | (setq txt "| %?Bad template |\n")) | |
| 846 | (cond | |
| 847 | ((and table-line-pos | |
| 848 | (string-match "\\(I+\\)\\([-+][0-9]\\)" table-line-pos)) | |
| 849 | ;; we have a complex line specification | |
| 850 | (goto-char (point-min)) | |
| 851 | (let ((nh (- (match-end 1) (match-beginning 1))) | |
| 852 | (delta (string-to-number (match-string 2 table-line-pos))) | |
| 853 | ll) | |
| 854 | ;; The user wants a special position in the table | |
| 855 | (org-table-get-specials) | |
| 856 | (setq ll (ignore-errors (aref org-table-hlines nh))) | |
| 857 | (unless ll (error "Invalid table line specification \"%s\"" | |
| 858 | table-line-pos)) | |
| 859 | (setq ll (+ ll delta (if (< delta 0) 0 -1))) | |
| 860 | (org-goto-line ll) | |
| 861 | (org-table-insert-row 'below) | |
| 862 | (beginning-of-line 1) | |
| 863 | (delete-region (point) (1+ (point-at-eol))) | |
| 864 | (setq beg (point)) | |
| 865 | (insert txt) | |
| 866 | (setq end (point)))) | |
| 867 | ((org-capture-get :prepend) | |
| 868 | (goto-char (point-min)) | |
| 869 | (re-search-forward org-table-hline-regexp nil t) | |
| 870 | (beginning-of-line 1) | |
| 871 | (re-search-forward org-table-dataline-regexp nil t) | |
| 872 | (beginning-of-line 1) | |
| 873 | (setq beg (point)) | |
| 874 | (org-table-insert-row) | |
| 875 | (beginning-of-line 1) | |
| 876 | (delete-region (point) (1+ (point-at-eol))) | |
| 877 | (insert txt) | |
| 878 | (setq end (point))) | |
| 879 | (t | |
| 880 | (goto-char (point-max)) | |
| 881 | (re-search-backward org-table-dataline-regexp nil t) | |
| 882 | (beginning-of-line 1) | |
| 883 | (org-table-insert-row 'below) | |
| 884 | (beginning-of-line 1) | |
| 885 | (delete-region (point) (1+ (point-at-eol))) | |
| 886 | (setq beg (point)) | |
| 887 | (insert txt) | |
| 888 | (setq end (point)))) | |
| 889 | (goto-char beg) | |
| 890 | (org-capture-position-for-last-stored 'table-line) | |
| 891 | (if (re-search-forward "%\\?" end t) (replace-match "")) | |
| 892 | (org-table-align))) | |
| 893 | ||
| 894 | (defun org-capture-place-plain-text () | |
| 895 | "Place the template plainly." | |
| 896 | (let* ((txt (org-capture-get :template)) | |
| 897 | beg end) | |
| 898 | (goto-char (cond | |
| 899 | ((org-capture-get :exact-position)) | |
| 900 | ((org-capture-get :prepend) (point-min)) | |
| 901 | (t (point-max)))) | |
| 902 | (or (bolp) (newline)) | |
| 903 | (org-capture-empty-lines-before) | |
| 904 | (setq beg (point)) | |
| 905 | (insert txt) | |
| 906 | (org-capture-empty-lines-after 1) | |
| 907 | (org-capture-position-for-last-stored beg) | |
| 908 | (setq end (point)) | |
| 909 | (org-capture-mark-kill-region beg (1- end)) | |
| 910 | (org-capture-narrow beg (1- end)) | |
| 911 | (if (re-search-forward "%\\?" end t) (replace-match "")))) | |
| 912 | ||
| 913 | (defun org-capture-mark-kill-region (beg end) | |
| 914 | "Mark the region that will have to be killed when aborting capture." | |
| 915 | (let ((m1 (move-marker (make-marker) beg)) | |
| 916 | (m2 (move-marker (make-marker) end))) | |
| 917 | (org-capture-put :begin-marker m1) | |
| 918 | (org-capture-put :end-marker m2))) | |
| 919 | ||
| 920 | (defun org-capture-position-for-last-stored (where) | |
| 921 | "Memorize the position that should later become the position of last capture." | |
| 922 | (cond | |
| 923 | ((integerp where) | |
| 924 | (org-capture-put :position-for-last-stored | |
| 925 | (move-marker (make-marker) where | |
| 926 | (or (buffer-base-buffer (current-buffer)) | |
| 927 | (current-buffer))))) | |
| 928 | ((eq where 'table-line) | |
| 929 | (org-capture-put :position-for-last-stored | |
| 930 | (list 'table-line | |
| 931 | (org-table-current-dline)))) | |
| 932 | (t (error "This should not happen")))) | |
| 933 | ||
| 934 | (defun org-capture-bookmark-last-stored-position () | |
| 935 | "Bookmark the last-captured position." | |
| 936 | (let* ((where (org-capture-get :position-for-last-stored 'local)) | |
| 937 | (pos (cond | |
| 938 | ((markerp where) | |
| 939 | (prog1 (marker-position where) | |
| 940 | (move-marker where nil))) | |
| 941 | ((and (listp where) (eq (car where) 'table-line)) | |
| 942 | (if (org-at-table-p) | |
| 943 | (save-excursion | |
| 944 | (org-table-goto-line (nth 1 where)) | |
| 945 | (point-at-bol)) | |
| 946 | (point)))))) | |
| 947 | (with-current-buffer (buffer-base-buffer (current-buffer)) | |
| 948 | (save-excursion | |
| 949 | (save-restriction | |
| 950 | (widen) | |
| 951 | (goto-char pos) | |
| 952 | (bookmark-set "org-capture-last-stored") | |
| 953 | (move-marker org-capture-last-stored-marker (point))))))) | |
| 954 | ||
| 955 | (defun org-capture-narrow (beg end) | |
| 956 | "Narrow, unless configuration says not to narrow." | |
| 957 | (unless (org-capture-get :unnarrowed) | |
| 958 | (narrow-to-region beg end) | |
| 959 | (goto-char beg))) | |
| 960 | ||
| 961 | (defun org-capture-empty-lines-before (&optional n) | |
| 962 | "Arrange for the correct number of empty lines before the insertion point. | |
| 963 | Point will be after the empty lines, so insertion can directly be done." | |
| 964 | (setq n (or n (org-capture-get :empty-lines) 0)) | |
| 965 | (let ((pos (point))) | |
| 966 | (org-back-over-empty-lines) | |
| 967 | (delete-region (point) pos) | |
| afe98dfa | 968 | (if (> n 0) (newline n)))) |
| 86fbb8ca CD |
969 | |
| 970 | (defun org-capture-empty-lines-after (&optional n) | |
| 971 | "Arrange for the correct number of empty lines after the inserted string. | |
| 972 | Point will remain at the first line after the inserted text." | |
| 973 | (setq n (or n (org-capture-get :empty-lines) 0)) | |
| 974 | (org-back-over-empty-lines) | |
| 975 | (while (looking-at "[ \t]*\n") (replace-match "")) | |
| 976 | (let ((pos (point))) | |
| afe98dfa | 977 | (if (> n 0) (newline n)) |
| 86fbb8ca CD |
978 | (goto-char pos))) |
| 979 | ||
| 980 | (defvar org-clock-marker) ; Defined in org.el | |
| 981 | ;;;###autoload | |
| 982 | (defun org-capture-insert-template-here () | |
| 983 | (let* ((template (org-capture-get :template)) | |
| 984 | (type (org-capture-get :type)) | |
| 985 | beg end pp) | |
| 986 | (or (bolp) (newline)) | |
| 987 | (setq beg (point)) | |
| 988 | (cond | |
| 989 | ((and (eq type 'entry) (org-mode-p)) | |
| 990 | (org-paste-subtree nil template t)) | |
| 991 | ((and (memq type '(item checkitem)) | |
| 992 | (org-mode-p) | |
| 993 | (save-excursion (skip-chars-backward " \t\n") | |
| 994 | (setq pp (point)) | |
| 995 | (org-in-item-p))) | |
| 996 | (goto-char pp) | |
| 997 | (org-insert-item) | |
| 998 | (skip-chars-backward " ") | |
| 999 | (skip-chars-backward "-+*0123456789).") | |
| 1000 | (delete-region (point) (point-at-eol)) | |
| 1001 | (setq beg (point)) | |
| 1002 | (org-remove-indentation template) | |
| 1003 | (insert template) | |
| 1004 | (org-capture-empty-lines-after) | |
| 1005 | (goto-char beg) | |
| afe98dfa | 1006 | (org-list-repair) |
| 86fbb8ca CD |
1007 | (org-end-of-item) |
| 1008 | (setq end (point))) | |
| 1009 | (t (insert template))) | |
| 1010 | (setq end (point)) | |
| 1011 | (goto-char beg) | |
| 1012 | (if (re-search-forward "%\\?" end t) | |
| 1013 | (replace-match "")))) | |
| 1014 | ||
| 1015 | (defun org-capture-set-plist (entry) | |
| 1016 | "Initialize the property list from the template definition." | |
| 1017 | (setq org-capture-plist (copy-sequence (nthcdr 5 entry))) | |
| 1018 | (org-capture-put :key (car entry) :description (nth 1 entry) | |
| 1019 | :target (nth 3 entry)) | |
| 1020 | (let ((txt (nth 4 entry)) (type (or (nth 2 entry) 'entry))) | |
| 1021 | (when (or (not txt) (and (stringp txt) (not (string-match "\\S-" txt)))) | |
| 1022 | ;; The template may be empty or omitted for special types. | |
| 1023 | ;; Here we insert the default templates for such cases. | |
| 1024 | (cond | |
| 1025 | ((eq type 'item) (setq txt "- %?")) | |
| 1026 | ((eq type 'checkitem) (setq txt "- [ ] %?")) | |
| 1027 | ((eq type 'table-line) (setq txt "| %? |")) | |
| 1028 | ((member type '(nil entry)) (setq txt "* %?\n %a")))) | |
| 1029 | (org-capture-put :template txt :type type))) | |
| 1030 | ||
| 1031 | (defun org-capture-goto-target (&optional template-key) | |
| 1032 | "Go to the target location of a capture template. | |
| 1033 | The user is queried for the template." | |
| 1034 | (interactive) | |
| 1035 | (let* (org-select-template-temp-major-mode | |
| 1036 | (entry (org-capture-select-template template-key))) | |
| 1037 | (unless entry | |
| 1038 | (error "No capture template selected")) | |
| 1039 | (org-capture-set-plist entry) | |
| 1040 | (org-capture-set-target-location) | |
| 1041 | (switch-to-buffer (org-capture-get :buffer)) | |
| 1042 | (goto-char (org-capture-get :pos)))) | |
| 1043 | ||
| 1044 | (defun org-capture-get-indirect-buffer (&optional buffer prefix) | |
| 1045 | "Make an indirect buffer for a capture process. | |
| 1046 | Use PREFIX as a prefix for the name of the indirect buffer." | |
| 1047 | (setq buffer (or buffer (current-buffer))) | |
| 1048 | (let ((n 1) (base (buffer-name buffer)) bname) | |
| 1049 | (setq bname (concat prefix "-" base)) | |
| 1050 | (while (buffer-live-p (get-buffer bname)) | |
| 1051 | (setq bname (concat prefix "-" (number-to-string (incf n)) "-" base))) | |
| 1052 | (condition-case nil | |
| 1053 | (make-indirect-buffer buffer bname 'clone) | |
| 1054 | (error (make-indirect-buffer buffer bname))))) | |
| 1055 | ||
| 1056 | ||
| 1057 | ;;; The template code | |
| 1058 | ||
| 1059 | (defun org-capture-select-template (&optional keys) | |
| 1060 | "Select a capture template. | |
| 1061 | Lisp programs can force the template by setting KEYS to a string." | |
| afe98dfa CD |
1062 | (if org-capture-templates |
| 1063 | (if keys | |
| 1064 | (or (assoc keys org-capture-templates) | |
| 1065 | (error "No capture template referred to by \"%s\" keys" keys)) | |
| 1066 | (if (= 1 (length org-capture-templates)) | |
| 1067 | (car org-capture-templates) | |
| 1068 | (org-mks org-capture-templates | |
| 1069 | "Select a capture template\n=========================" | |
| 1070 | "Template key: " | |
| 1071 | '(("C" "Customize org-capture-templates") | |
| 1072 | ("q" "Abort"))))) | |
| 1073 | ;; Use an arbitrary default template | |
| 1074 | '("t" "Task" entry (file+headline "" "Tasks") "* TODO %?\n %u\n %a"))) | |
| 86fbb8ca CD |
1075 | |
| 1076 | (defun org-capture-fill-template (&optional template initial annotation) | |
| 1077 | "Fill a template and return the filled template as a string. | |
| 1078 | The template may still contain \"%?\" for cursor positioning." | |
| 1079 | (setq template (or template (org-capture-get :template))) | |
| 1080 | (when (stringp initial) | |
| 1081 | (setq initial (org-no-properties initial)) | |
| 1082 | (remove-text-properties 0 (length initial) '(read-only t) initial)) | |
| 1083 | (let* ((buffer (org-capture-get :buffer)) | |
| 1084 | (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) | |
| 1085 | (ct (org-capture-get :default-time)) | |
| 1086 | (dct (decode-time ct)) | |
| 1087 | (ct1 | |
| 1088 | (if (< (nth 2 dct) org-extend-today-until) | |
| 1089 | (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) | |
| 1090 | ct)) | |
| 1091 | (plist-p (if org-store-link-plist t nil)) | |
| 1092 | (v-c (and (> (length kill-ring) 0) (current-kill 0))) | |
| 1093 | (v-x (or (org-get-x-clipboard 'PRIMARY) | |
| 1094 | (org-get-x-clipboard 'CLIPBOARD) | |
| 1095 | (org-get-x-clipboard 'SECONDARY))) | |
| 1096 | (v-t (format-time-string (car org-time-stamp-formats) ct)) | |
| 1097 | (v-T (format-time-string (cdr org-time-stamp-formats) ct)) | |
| 1098 | (v-u (concat "[" (substring v-t 1 -1) "]")) | |
| 1099 | (v-U (concat "[" (substring v-T 1 -1) "]")) | |
| 1100 | ;; `initial' and `annotation' might habe been passed. | |
| 1101 | ;; But if the property list has them, we prefer those values | |
| 1102 | (v-i (or (plist-get org-store-link-plist :initial) | |
| 1103 | initial | |
| 1104 | (org-capture-get :initial) | |
| 1105 | "")) | |
| 1106 | (v-a (or (plist-get org-store-link-plist :annotation) | |
| 1107 | annotation | |
| 1108 | (org-capture-get :annotation) | |
| 1109 | "")) | |
| 1110 | ;; Is the link empty? Then we do not want it... | |
| 1111 | (v-a (if (equal v-a "[[]]") "" v-a)) | |
| 1112 | (clipboards (remove nil (list v-i | |
| 1113 | (org-get-x-clipboard 'PRIMARY) | |
| 1114 | (org-get-x-clipboard 'CLIPBOARD) | |
| 1115 | (org-get-x-clipboard 'SECONDARY) | |
| 1116 | v-c))) | |
| 1117 | (v-A (if (and v-a | |
| 1118 | (string-match | |
| 1119 | "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a)) | |
| 1120 | (replace-match "[\\1[%^{Link description}]]" nil nil v-a) | |
| 1121 | v-a)) | |
| 1122 | (v-n user-full-name) | |
| 1123 | (v-k (if (marker-buffer org-clock-marker) | |
| 1124 | (org-substring-no-properties org-clock-heading))) | |
| 1125 | (v-K (if (marker-buffer org-clock-marker) | |
| 1126 | (org-make-link-string | |
| 1127 | (buffer-file-name (marker-buffer org-clock-marker)) | |
| 1128 | org-clock-heading))) | |
| 1129 | v-I | |
| 1130 | (org-startup-folded nil) | |
| 1131 | (org-inhibit-startup t) | |
| 1132 | org-time-was-given org-end-time-was-given x | |
| 1133 | prompt completions char time pos default histvar) | |
| 1134 | ||
| 1135 | (setq org-store-link-plist | |
| 1136 | (plist-put org-store-link-plist :annotation v-a) | |
| 1137 | org-store-link-plist | |
| 1138 | (plist-put org-store-link-plist :initial v-i)) | |
| afe98dfa | 1139 | (setq initial v-i) |
| 86fbb8ca CD |
1140 | |
| 1141 | (unless template (setq template "") (message "No template") (ding) | |
| 1142 | (sit-for 1)) | |
| 1143 | (save-window-excursion | |
| 1144 | (delete-other-windows) | |
| 1145 | (switch-to-buffer (get-buffer-create "*Capture*")) | |
| 1146 | (erase-buffer) | |
| 1147 | (insert template) | |
| 1148 | (goto-char (point-min)) | |
| 1149 | (org-capture-steal-local-variables buffer) | |
| 1150 | (setq buffer-file-name nil) | |
| 1151 | ||
| 1152 | ;; %[] Insert contents of a file. | |
| 1153 | (goto-char (point-min)) | |
| 1154 | (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) | |
| 1155 | (unless (org-capture-escaped-%) | |
| 1156 | (let ((start (match-beginning 0)) | |
| 1157 | (end (match-end 0)) | |
| 1158 | (filename (expand-file-name (match-string 1)))) | |
| 1159 | (goto-char start) | |
| 1160 | (delete-region start end) | |
| 1161 | (condition-case error | |
| 1162 | (insert-file-contents filename) | |
| 1163 | (error (insert (format "%%![Couldn't insert %s: %s]" | |
| 1164 | filename error))))))) | |
| 1165 | ;; %() embedded elisp | |
| 1166 | (goto-char (point-min)) | |
| 1167 | (while (re-search-forward "%\\((.+)\\)" nil t) | |
| 1168 | (unless (org-capture-escaped-%) | |
| 1169 | (goto-char (match-beginning 0)) | |
| 1170 | (let ((template-start (point))) | |
| 1171 | (forward-char 1) | |
| 1172 | (let ((result | |
| 1173 | (condition-case error | |
| 1174 | (eval (read (current-buffer))) | |
| 1175 | (error (format "%%![Error: %s]" error))))) | |
| 1176 | (delete-region template-start (point)) | |
| 1177 | (insert result))))) | |
| 1178 | ||
| 1179 | ;; Simple %-escapes | |
| afe98dfa | 1180 | (goto-char (point-min)) |
| 86fbb8ca CD |
1181 | (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) |
| 1182 | (unless (org-capture-escaped-%) | |
| 1183 | (when (and initial (equal (match-string 0) "%i")) | |
| 1184 | (save-match-data | |
| 1185 | (let* ((lead (buffer-substring | |
| 1186 | (point-at-bol) (match-beginning 0)))) | |
| 1187 | (setq v-i (mapconcat 'identity | |
| 1188 | (org-split-string initial "\n") | |
| 1189 | (concat "\n" lead)))))) | |
| 1190 | (replace-match | |
| 1191 | (or (eval (intern (concat "v-" (match-string 1)))) "") | |
| 1192 | t t))) | |
| 1193 | ||
| 1194 | ;; From the property list | |
| 1195 | (when plist-p | |
| 1196 | (goto-char (point-min)) | |
| 1197 | (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) | |
| 1198 | (unless (org-capture-escaped-%) | |
| 1199 | (and (setq x (or (plist-get org-store-link-plist | |
| 1200 | (intern (match-string 1))) "")) | |
| 1201 | (replace-match x t t))))) | |
| 1202 | ||
| 1203 | ;; Turn on org-mode in temp buffer, set local variables | |
| 1204 | ;; This is to support completion in interactive prompts | |
| 1205 | (let ((org-inhibit-startup t)) (org-mode)) | |
| 1206 | ;; Interactive template entries | |
| 1207 | (goto-char (point-min)) | |
| 1208 | (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" | |
| 1209 | nil t) | |
| 1210 | (unless (org-capture-escaped-%) | |
| 1211 | (setq char (if (match-end 3) (match-string 3)) | |
| 1212 | prompt (if (match-end 2) (match-string 2))) | |
| 1213 | (goto-char (match-beginning 0)) | |
| 1214 | (replace-match "") | |
| 1215 | (setq completions nil default nil) | |
| 1216 | (when prompt | |
| 1217 | (setq completions (org-split-string prompt "|") | |
| 1218 | prompt (pop completions) | |
| 1219 | default (car completions) | |
| 1220 | histvar (intern (concat | |
| 1221 | "org-capture-template-prompt-history::" | |
| 1222 | (or prompt ""))) | |
| 1223 | completions (mapcar 'list completions))) | |
| afe98dfa | 1224 | (unless (boundp histvar) (set histvar nil)) |
| 86fbb8ca CD |
1225 | (cond |
| 1226 | ((member char '("G" "g")) | |
| 1227 | (let* ((org-last-tags-completion-table | |
| 1228 | (org-global-tags-completion-table | |
| 1229 | (if (equal char "G") | |
| 1230 | (org-agenda-files) | |
| 1231 | (and file (list file))))) | |
| 1232 | (org-add-colon-after-tag-completion t) | |
| 1233 | (ins (org-icompleting-read | |
| 1234 | (if prompt (concat prompt ": ") "Tags: ") | |
| 1235 | 'org-tags-completion-function nil nil nil | |
| 1236 | 'org-tags-history))) | |
| 1237 | (setq ins (mapconcat 'identity | |
| 1238 | (org-split-string | |
| afe98dfa | 1239 | ins (org-re "[^[:alnum:]_@#%]+")) |
| 86fbb8ca CD |
1240 | ":")) |
| 1241 | (when (string-match "\\S-" ins) | |
| 1242 | (or (equal (char-before) ?:) (insert ":")) | |
| 1243 | (insert ins) | |
| afe98dfa CD |
1244 | (or (equal (char-after) ?:) (insert ":")) |
| 1245 | (and (org-on-heading-p) (org-set-tags nil 'align))))) | |
| 86fbb8ca CD |
1246 | ((equal char "C") |
| 1247 | (cond ((= (length clipboards) 1) (insert (car clipboards))) | |
| 1248 | ((> (length clipboards) 1) | |
| 1249 | (insert (read-string "Clipboard/kill value: " | |
| 1250 | (car clipboards) '(clipboards . 1) | |
| 1251 | (car clipboards)))))) | |
| 1252 | ((equal char "L") | |
| 1253 | (cond ((= (length clipboards) 1) | |
| 1254 | (org-insert-link 0 (car clipboards))) | |
| 1255 | ((> (length clipboards) 1) | |
| 1256 | (org-insert-link 0 (read-string "Clipboard/kill value: " | |
| 1257 | (car clipboards) | |
| 1258 | '(clipboards . 1) | |
| 1259 | (car clipboards)))))) | |
| 1260 | ((equal char "p") | |
| 1261 | (let* | |
| 1262 | ((prop (org-substring-no-properties prompt)) | |
| 1263 | (pall (concat prop "_ALL")) | |
| 1264 | (allowed | |
| 1265 | (with-current-buffer | |
| 1266 | (get-buffer (file-name-nondirectory file)) | |
| 1267 | (or (cdr (assoc pall org-file-properties)) | |
| 1268 | (cdr (assoc pall org-global-properties)) | |
| 1269 | (cdr (assoc pall org-global-properties-fixed))))) | |
| 1270 | (existing (with-current-buffer | |
| 1271 | (get-buffer (file-name-nondirectory file)) | |
| 1272 | (mapcar 'list (org-property-values prop)))) | |
| 1273 | (propprompt (concat "Value for " prop ": ")) | |
| 1274 | (val (if allowed | |
| 1275 | (org-completing-read | |
| 1276 | propprompt | |
| 1277 | (mapcar 'list (org-split-string allowed | |
| 1278 | "[ \t]+")) | |
| 1279 | nil 'req-match) | |
| 1280 | (org-completing-read-no-i propprompt | |
| 1281 | existing nil nil | |
| 1282 | "" nil "")))) | |
| 1283 | (org-set-property prop val))) | |
| 1284 | (char | |
| 1285 | ;; These are the date/time related ones | |
| 1286 | (setq org-time-was-given (equal (upcase char) char)) | |
| 1287 | (setq time (org-read-date (equal (upcase char) char) t nil | |
| 1288 | prompt)) | |
| 1289 | (if (equal (upcase char) char) (setq org-time-was-given t)) | |
| 1290 | (org-insert-time-stamp time org-time-was-given | |
| 1291 | (member char '("u" "U")) | |
| 1292 | nil nil (list org-end-time-was-given))) | |
| 1293 | (t | |
| 1294 | (let (org-completion-use-ido) | |
| 1295 | (insert (org-completing-read-no-i | |
| 1296 | (concat (if prompt prompt "Enter string") | |
| 1297 | (if default (concat " [" default "]")) | |
| 1298 | ": ") | |
| 1299 | completions nil nil nil histvar default))))))) | |
| 1300 | ;; Make sure there are no empty lines before the text, and that | |
| 1301 | ;; it ends with a newline character | |
| 1302 | (goto-char (point-min)) | |
| 1303 | (while (looking-at "[ \t]*\n") (replace-match "")) | |
| 1304 | (if (re-search-forward "[ \t\n]*\\'" nil t) (replace-match "\n")) | |
| 1305 | ;; Return the expanded tempate and kill the temporary buffer | |
| 1306 | (untabify (point-min) (point-max)) | |
| 1307 | (set-buffer-modified-p nil) | |
| 1308 | (prog1 (buffer-string) (kill-buffer (current-buffer)))))) | |
| 1309 | ||
| 1310 | (defun org-capture-escaped-% () | |
| 1311 | "Check if % was escaped - if yes, unescape it now." | |
| 1312 | (if (equal (char-before (match-beginning 0)) ?\\) | |
| 1313 | (progn | |
| 1314 | (delete-region (1- (match-beginning 0)) (match-beginning 0)) | |
| 1315 | t) | |
| 1316 | nil)) | |
| 1317 | ||
| 1318 | ;;;###autoload | |
| 1319 | (defun org-capture-import-remember-templates () | |
| 1320 | "Set org-capture-templates to be similar to `org-remember-templates'." | |
| 1321 | (interactive) | |
| 1322 | (when (and (yes-or-no-p | |
| 1323 | "Import old remember templates into org-capture-templates? ") | |
| 1324 | (yes-or-no-p | |
| 1325 | "Note that this will remove any templates currently defined in `org-capture-templates'. Do you still want to go ahead? ")) | |
| 1326 | (require 'org-remember) | |
| 1327 | (setq org-capture-templates | |
| 1328 | (mapcar | |
| 1329 | (lambda (entry) | |
| 1330 | (let ((desc (car entry)) | |
| 1331 | (key (char-to-string (nth 1 entry))) | |
| 1332 | (template (nth 2 entry)) | |
| 1333 | (file (or (nth 3 entry) org-default-notes-file)) | |
| 1334 | (position (or (nth 4 entry) org-remember-default-headline)) | |
| 1335 | (type 'entry) | |
| 1336 | (prepend org-reverse-note-order) | |
| 1337 | immediate target) | |
| 1338 | (cond | |
| 1339 | ((member position '(top bottom)) | |
| 1340 | (setq target (list 'file file) | |
| 1341 | prepend (eq position 'top))) | |
| 1342 | ((eq position 'date-tree) | |
| 1343 | (setq target (list 'file+datetree file) | |
| 1344 | prepend nil)) | |
| 1345 | (t (setq target (list 'file+headline file position)))) | |
| 1346 | ||
| 1347 | (when (string-match "%!" template) | |
| 1348 | (setq template (replace-match "" t t template) | |
| 1349 | immediate t)) | |
| 1350 | ||
| 1351 | (append (list key desc type target template) | |
| 1352 | (if prepend '(:prepend t)) | |
| 1353 | (if immediate '(:immediate-finish t))))) | |
| 1354 | ||
| 1355 | org-remember-templates)))) | |
| 1356 | ||
| 1357 | (provide 'org-capture) | |
| 1358 | ||
| 1359 | ;; arch-tag: 986bf41b-8ada-4e28-bf20-e8388a7205a0 | |
| 1360 | ||
| 1361 | ;;; org-capture.el ends here | |
| 1362 | ||
| 1363 |