[Orgmode] [PATCH] org: rework property set

[Julien Danjou]

* org-capture.el (org-capture-fill-template): Use `org-set-property'
directly.

* org.el (org-set-property): Split property and values reading.
(org-read-property-name, org-read-property-value)
(org-set-property-function): New functions.
(org-property-set-functions-alist): New variable.

The goal of this patch is to introduce a special variable
`org-property-set-functions-alist'. This variable allows to read
properties values in a more intelligent way from `org-set-property' or
from `org-capture'.

For that, it simplifies the `org-set-property' code and remove
duplication between `org-capture' and `org-set-property'.

Signed-off-by: Julien Danjou <address@hidden>
---
 lisp/org-capture.el |   24 +---------------
 lisp/org.el         |   78 ++++++++++++++++++++++++++++++++++----------------
 2 files changed, 54 insertions(+), 48 deletions(-)

diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index b85b011..eef8b5a 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1295,29 +1295,7 @@ The template may still contain \"%?\" for cursor 
positioning."
                                                   '(clipboards . 1)
                                                   (car clipboards))))))
           ((equal char "p")
-           (let*
-               ((prop (org-substring-no-properties prompt))
-                (pall (concat prop "_ALL"))
-                (allowed
-                 (with-current-buffer
-                     (get-buffer (file-name-nondirectory file))
-                   (or (cdr (assoc pall org-file-properties))
-                       (cdr (assoc pall org-global-properties))
-                       (cdr (assoc pall org-global-properties-fixed)))))
-                (existing (with-current-buffer
-                              (get-buffer (file-name-nondirectory file))
-                            (mapcar 'list (org-property-values prop))))
-                (propprompt (concat "Value for " prop ": "))
-                (val (if allowed
-                         (org-completing-read
-                          propprompt
-                          (mapcar 'list (org-split-string allowed
-                                                          "[ \t]+"))
-                          nil 'req-match)
-                       (org-completing-read-no-i propprompt
-                                                 existing nil nil
-                                                 "" nil ""))))
-             (org-set-property prop val)))
+           (org-set-property (org-substring-no-properties prompt) nil))
           (char
            ;; These are the date/time related ones
            (setq org-time-was-given (equal (upcase char) char))
diff --git a/lisp/org.el b/lisp/org.el
index 53039e4..78e048d 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -13797,6 +13797,54 @@ formats in the current buffer."
          (hide-entry))
       (org-flag-drawer t))))
 
+(defvar org-property-set-functions-alist nil
+  "Property set function alist.
+Each entry should have the following format:
+
+ (PROPERTY . READ-FUNCTION)
+
+The read function will be called with the same argument as
+`org-completing-read.")
+
+(defun org-set-property-function (property)
+  "Get the function that should be used to set PROPERTY.
+This is computed according to `org-property-set-functions-alist'."
+  (or (cdr (assoc property org-property-set-functions-alist))
+      'org-completing-read))
+
+(defun org-read-property-value (property)
+  "Read PROPERTY value from user."
+  (let* ((completion-ignore-case t)
+        (allowed (org-property-get-allowed-values nil property 'table))
+        (cur (org-entry-get nil property))
+        (prompt (concat property " value"
+                        (if (and cur (string-match "\\S-" cur))
+                            (concat " [" cur "]") "") ": "))
+        (set-function (org-set-property-function property))
+        (val (if allowed
+                 (funcall set-function prompt allowed nil
+                          (not (get-text-property 0 'org-unrestricted
+                                                  (caar allowed))))
+               (let (org-completion-use-ido org-completion-use-iswitchb)
+                 (funcall set-function prompt
+                          (mapcar 'list (org-property-values property))
+                          nil nil "" nil cur)))))
+    (if (equal val "")
+       cur
+      val)))
+
+(defun org-read-property-name ()
+  "Read a property name."
+  (let* ((completion-ignore-case t)
+        (keys (org-buffer-property-keys nil t t))
+        (property (org-icompleting-read "Property: " (mapcar 'list keys))))
+    (if (member property keys)
+       property
+      (or (cdr (assoc (downcase property)
+                     (mapcar (lambda (x) (cons (downcase x) x))
+                             keys)))
+         property))))
+
 (defun org-set-property (property value)
   "In the current entry, set PROPERTY to VALUE.
 When called interactively, this will prompt for a property name, offering
@@ -13804,31 +13852,11 @@ completion on existing and default properties.  And 
then it will prompt
 for a value, offering completion either on allowed values (via an inherited
 xxx_ALL property) or on existing values in other instances of this property
 in the current file."
-  (interactive
-   (let* ((completion-ignore-case t)
-         (keys (org-buffer-property-keys nil t t))
-         (prop0 (org-icompleting-read "Property: " (mapcar 'list keys)))
-         (prop (if (member prop0 keys)
-                   prop0
-                 (or (cdr (assoc (downcase prop0)
-                                 (mapcar (lambda (x) (cons (downcase x) x))
-                                         keys)))
-                     prop0)))
-         (cur (org-entry-get nil prop))
-         (prompt (concat prop " value"
-                         (if (and cur (string-match "\\S-" cur))
-                             (concat " [" cur "]") "") ": "))
-         (allowed (org-property-get-allowed-values nil prop 'table))
-         (existing (mapcar 'list (org-property-values prop)))
-         (val (if allowed
-                  (org-completing-read prompt allowed nil
-                     (not (get-text-property 0 'org-unrestricted
-                                             (caar allowed))))
-                (let (org-completion-use-ido org-completion-use-iswitchb)
-                  (org-completing-read prompt existing nil nil "" nil cur)))))
-     (list prop (if (equal val "") cur val))))
-  (unless (equal (org-entry-get nil property) value)
-    (org-entry-put nil property value)))
+  (interactive (list nil nil))
+  (let* ((property (or property (org-read-property-name)))
+        (value (or value (org-read-property-value property))))
+    (unless (equal (org-entry-get nil property) value)
+      (org-entry-put nil property value))))
 
 (defun org-delete-property (property)
   "In the current entry, delete PROPERTY."
-- 
1.7.2.3