From: Julien Danjou <julien@danjou.info>
To: emacs-orgmode@gnu.org
Cc: Julien Danjou <julien@danjou.info>
Subject: [PATCH] org: rework property set
Date: Thu, 16 Dec 2010 18:12:43 +0100 [thread overview]
Message-ID: <1292519563-20747-1-git-send-email-julien@danjou.info> (raw)
In-Reply-To: <E06772F2-8CFB-49A3-8473-EE0CC9485A68@gmail.com>
* 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
next prev parent reply other threads:[~2010-12-16 17:12 UTC|newest]
Thread overview: 44+ messages / expand[flat|nested] mbox.gz Atom feed top
2010-12-13 17:29 [PATCH] org: rework property set Julien Danjou
2010-12-13 21:21 ` Bernt Hansen
2010-12-14 9:01 ` Julien Danjou
2010-12-14 10:15 ` Giovanni Ridolfi
2010-12-14 10:30 ` Julien Danjou
2010-12-14 12:28 ` Bernt Hansen
2010-12-16 13:34 ` Carsten Dominik
2010-12-16 13:45 ` Julien Danjou
2010-12-16 13:55 ` Carsten Dominik
2010-12-16 17:12 ` Julien Danjou [this message]
2010-12-17 17:39 ` Carsten Dominik
[not found] ` <julien@danjou.info>
2010-12-14 14:50 ` Nick Dokos
2011-03-17 17:27 ` Re: Problem with agenda and diary Nick Dokos
2011-03-17 18:18 ` Tassilo Horn
2011-03-17 19:06 ` Dan Griswold
2011-03-17 19:45 ` Nick Dokos
2011-03-17 20:37 ` Dan Griswold
2011-03-17 22:01 ` Nick Dokos
2011-03-17 22:11 ` Nick Dokos
2011-03-18 10:36 ` Julien Danjou
2011-03-18 10:36 ` Julien Danjou
2011-03-18 14:04 ` Nick Dokos
2011-03-18 14:14 ` Nick Dokos
2011-03-18 14:56 ` Bernt Hansen
2011-03-18 15:20 ` Bastien
2011-03-18 15:33 ` Nick Dokos
2011-03-18 16:27 ` Julien Danjou
2011-03-19 10:20 ` Bastien
2011-03-19 10:20 ` Bastien
2011-03-18 14:22 ` Julien Danjou
2011-03-18 14:51 ` Julien Danjou, Nick Dokos
2011-03-18 15:05 ` Bastien
-- strict thread matches above, loose matches on Subject: below --
2011-03-17 13:30 Dan Griswold
2011-03-17 13:39 ` Erik Iverson
2011-03-17 13:48 ` Tassilo Horn
2011-03-17 14:45 ` Julien Danjou
2011-03-17 15:34 ` Tassilo Horn
2011-03-17 16:46 ` Julien Danjou
2011-03-17 20:28 ` Sébastien Vauban
2011-03-17 22:06 ` Nick Dokos
2011-03-17 23:43 ` Sébastien Vauban
2011-03-18 0:20 ` Nick Dokos
2011-03-18 10:07 ` Bastien
2011-03-17 14:48 ` Dan Griswold
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1292519563-20747-1-git-send-email-julien@danjou.info \
--to=julien@danjou.info \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).