emacs-orgmode
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Orgmode] [PATCH] org: rework property set


From: Julien Danjou
Subject: [Orgmode] [PATCH] org: rework property set
Date: Mon, 13 Dec 2010 18:29:28 +0100

* 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 initial goal of this patch is to introduce a special variable
`org-property-set-functions-alist'. The goal of this variable is to be
able to read properties values in a more intelligent way from
`org-set-property' or from `org-capture'.

For that, I decided to simplify the `org-set-property' code and to
remove what seems to be code duplication between `org-capture' and
`org-set-property'. I may have done this badly, so I think some one
with expertise of this code (Carsten?) should review the code.

It works but there maybe some corners case that would not be covered
with it.

Finally, with org-property-set-functions-alist we can read property
in a more intelligent way like that:

  (defun org-completing-date (prompt collection
                                     &optional predicate require-match
                                     initial-input hist def 
inherit-input-method)
    (org-read-date nil nil nil nil
                   (when (and def (not (string= def "")))
                     (org-time-string-to-time def))
                   initial-input))

  (setq org-property-set-functions-alist
        '(("BIRTHDAY" . org-completing-date)))

You can read a birthday property value using `org-read-date', which is
by far more convenient than the usual org-completing-read.

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 5c7b038..9a93115 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1288,29 +1288,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 c4fe6a0..6a55d6b 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -13792,6 +13792,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
@@ -13799,31 +13847,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




reply via email to

[Prev in Thread] Current Thread [Next in Thread]