Merge Org version 8.2.3a.

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))))