Re: [PATCH] org: rework property set

[Carsten Dominik <carsten.dominik@gmail.com>]

This is a perfect patch submission, thanks a lot for taking the time  
to fix it.

Accepted.

- Carsten

On Dec 16, 2010, at 6:12 PM, Julien Danjou wrote:

> * 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 <julien@danjou.info>
> ---
> 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
>
>
> _______________________________________________
> Emacs-orgmode mailing list
> Please use `Reply All' to send replies to the list.
> Emacs-orgmode@gnu.org
> http://lists.gnu.org/mailman/listinfo/emacs-orgmode