From mboxrd@z Thu Jan 1 00:00:00 1970 From: Julien Danjou Subject: [PATCH] org: rework property set Date: Thu, 16 Dec 2010 18:12:43 +0100 Message-ID: <1292519563-20747-1-git-send-email-julien@danjou.info> References: Return-path: Received: from [140.186.70.92] (port=37938 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PTHNo-0004oE-Fo for emacs-orgmode@gnu.org; Thu, 16 Dec 2010 12:12:49 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PTHNn-0003Nk-7i for emacs-orgmode@gnu.org; Thu, 16 Dec 2010 12:12:48 -0500 Received: from coquelicot-s.easter-eggs.com ([213.215.37.94]:38356) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PTHNm-0003NF-PU for emacs-orgmode@gnu.org; Thu, 16 Dec 2010 12:12:47 -0500 In-Reply-To: List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org Cc: 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 --- 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