From: Thorsten Jolitz <tjolitz@gmail.com>
To: emacs-orgmode@gnu.org
Subject: [RFC] Rewrite `org-entry-properties' using parser
Date: Fri, 01 Aug 2014 01:21:47 +0200 [thread overview]
Message-ID: <87tx5xunas.fsf@gmail.com> (raw)
Hi List,
here is my first take of rewriting `org-entry-properties'.
The existing function predates the new parser and some Org variables,
and thus does the parsing and the property classification itself. The
new version leaves parsing to the parser and property classification
(mostly) to existing Org variables, resulting in much simpler code.
OTOH, the new version offers more fine-grained control over property
selection. I was a bit unhappy when the use of property-drawers as
simple key-val databases and meta-data stores for USERS was kind of
deprecated with the introduction of the new parser (in favor of usage by
the SYSTEM). This improved with introduction of the 'prop:t' export
option, and the new version of `org-entry-properties' should be powerful
and convenient enough to separate user and system data stored in the
same property-drawers.
Implementation goals were:
1. (almost) full backward-compability. The parser upcases user
properties, thus case-sensitivity is lost after parsing and old
applications that rely on the difference between "foo", "Foo" and
"FOO" as property keys will break
2. allow retrieving all property-classes defined in Org-mode separately
3. allow filtering out parser-specific properties
4. allow retrieving all "non-org" properties (user and application defined)
5. allow retrieving properties by regexp-matching, e.g. props prefixed
with "foo_" by application 'foo'.
I did not bother to prepare a patch yet since this should be reviewed
and tested:
- Are some options useless?
- Do the return values of the options make sense?
- Is property-classification consistent (e.g. "TODO" in
`org-special-properties', but :todo-keyword and :todo-type in the
parse-tree)?
- I actually reimplemented the docstring of the old function instead of
the rather complicated code - did I get the semantics right?
- are there bugs?
- etc ...
Here is an Org file with the new version of `org-entry-properties',
helper functions and some 20 ERT-tests. Please have a look.
* org-entry-properties
** new function (org.el)
#+begin_src emacs-lisp
(defun org-entry-properties (&optional pom which specific)
"Get all properties of the entry at point-or-marker POM.
This includes the TODO keyword, the tags, time strings for
deadline, scheduled, and clocking, and any additional properties
defined in the entry.
The return value is an alist, except if WHICH has value `parser',
then a plist filtered for the properties set by
`org-element-parse-headline' is returned. Keys may occur multiple
times if the property key was used several times. POM may also
be nil, in which case the current entry is used.
WHICH can have several meaningful values:
- nil or `all' :: get all regular (non parser) properties
- `special' :: get properties that are member of
`org-special-properties'
- `standard' :: get properties of that subclass
- `parser' :: get properties set by parser (as plist)
- `custom' :: get properties that are member of
`org-custom-properties'
- `default' :: get properties that are member of
`org-default-properties'
- `document' :: get properties that are member of
`org-element-document-properties'
- `file' :: get properties that are member of
`org-file-properties'
- `global' :: get properties that are member of
`org-global-properties'
- `global-fixed' :: get properties that are member of
`org-global-properties-fixed'
- `non-org' :: get properties that are not member of any of the
preceeding classes (except `all')
- any string :: get only exactly this property
- form :: get properties string-matched by (rx-to-string form),
with FORM being a regular expression in sexp form
SPECIFIC can be a string, symbol or keyword, all types will be
converted to an upcased string. It is the specific property we
are interested in. This argument only exists for historical
reasons and backward portability, since giving a string value to
WHICH has the same effect as giving a value to SPECIFIC. However,
if SPECIFIC is non-nil, it takes precedence over WHICH."
(setq which (or which 'all))
(org-with-wide-buffer
(org-with-point-at pom
(when (and (derived-mode-p 'org-mode)
(ignore-errors (org-back-to-heading t)))
(let ((elem (org-element-at-point)))
(when (eq (car elem) 'headline)
(let* ((specific-prop
(cond
((or (org-string-nw-p specific)
(org-string-nw-p which))
(upcase
(or (org-string-nw-p specific)
(org-string-nw-p which))))
((keywordp specific)
(car (org-split-string
(format "%s" specific) ":")))
((and (not (booleanp specific))
(symbolp specific))
(upcase (format "%s" specific)))
(t nil)))
(props-plist (cadr elem))
(props-alist-strg-keys
(org-plist-to-alist props-plist nil t))
(parser-keywords
(list :raw-value :title :alt-title :begin :end
:pre-blank :post-blank :contents-begin
:contents-end :level :priority :tags
:todo-keyword :todo-type :scheduled
:deadline :closed :archivedp :commentedp
:footnote-section-p))
(parser-keywords-but-special-props
(list :raw-value :title :alt-title :begin :end
:pre-blank :post-blank :contents-begin
:contents-end :level :archivedp
:commentedp :footnote-section-p))
;; FIXME necessary?
;; for backward compability only
(excluded
'("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED"))
sym)
(if specific-prop
(assoc specific-prop props-alist-strg-keys)
(let ((all-but-parser
(progn
(setplist 'sym props-plist)
(mapc (lambda (--kw)
(remprop 'sym --kw))
parser-keywords-but-special-props)
(org-plist-to-alist
(symbol-plist 'sym) nil t)))
(downcased-special-props
(mapcar 'downcase org-special-properties)))
(case which
('all all-but-parser)
('non-org (remove-if
(lambda (--item)
(member
(car --item)
(append
org-special-properties
org-default-properties
org-custom-properties
org-element-document-properties
org-global-properties
org-global-properties-fixed
org-file-properties)))
all-but-parser))
;; FIXME necessary?
;; for backward compability only
('standard (remove-if
(lambda (--item)
(member (car --item) excluded))
all-but-parser))
;; return plist
('parser (setplist 'sym props-plist)
(mapc (lambda (--kw)
(remprop 'sym --kw))
(set-difference
(org-plist-keys props-plist t)
parser-keywords))
(symbol-plist 'sym))
('special (remove-if-not
(lambda (--item)
(member
(car --item)
downcased-special-props))
props-alist-strg-keys))
('default (remove-if-not
(lambda (--item)
(member (car --item)
org-default-properties))
props-alist-strg-keys))
('custom (remove-if-not
(lambda (--item)
(member (car --item)
org-custom-properties))
props-alist-strg-keys))
('document (remove-if-not
(lambda (--item)
(member
(car --item)
org-element-document-properties))
props-alist-strg-keys))
('global (remove-if-not
(lambda (--item)
(member (car --item)
org-global-properties))
props-alist-strg-keys))
('global-fixed (remove-if-not
(lambda (--item)
(assoc
(car --item)
org-global-properties-fixed))
props-alist-strg-keys))
('file (remove-if-not
(lambda (--item)
(member (car --item)
org-file-properties))
props-alist-strg-keys))
(t (when (consp which)
(ignore-errors
(let ((rgxp (rx-to-string which)))
(remove-if-not
(lambda (--item)
(string-match rgxp (car --item)))
all-but-parser)))))))))))))))
#+end_src
** helper function (org-macs.el)
#+begin_src emacs-lisp
;; copied from kv.el
(defun org-plist-to-alist (plist &optional keys-are-keywords keys-to-string)
"Convert PLIST to an alist.
The keys are expected to be :prefixed and the colons are removed
unless KEYS-ARE-KEYWORDS is `t'. The keys in the resulting alist
are symbols unless KEYS-TO-STRING is non-nil."
(when plist
(loop for (key value . rest) on plist by 'cddr
collect
(cons (cond
(keys-are-keywords key)
(keys-to-string
(format "%s" (org-keyword-to-symbol key)))
(t (org-keyword-to-symbol key)))
value))))
;; copied from kv.el
(defun org-alist-keys (alist)
"Get just the keys from the alist."
(mapcar (lambda (pair) (car pair)) alist))
;; copied from kv.el
(defun org-alist-values (alist)
"Get just the values from the alist."
(mapcar (lambda (pair) (cdr pair)) alist))
(defun org-plist-keys (plist &optional as-keywords-p)
"Get just the keys from the plist.
The keys are expected to be :prefixed and the colons are removed
unless AS-KEYWORDS-P is non-nil."
(org-alist-keys
(org-plist-to-alist plist as-keywords-p)))
(defun org-plist-values (plist)
"Get just the values from the plist."
(org-alist-values
(org-plist-to-alist plist)))
;; copied from kv.el
(defun org-keyword-to-symbol (keyword)
"A keyword is a symbol leading with a :.
Converting to a symbol means dropping the :."
(if (keywordp keyword)
(intern (substring (symbol-name keyword) 1))
keyword))
#+end_src
** tests (test-org.el)
#+begin_src emacs-lisp
;;; Properties
(defconst test-org/org-entry-properties-temp-text
"* DONE [#A] headline <2014-07-31 Do> :tag:
DEADLINE: <2014-08-01 Fr 08:00>
- State \"DONE\" from \"WAITING\" [2014-07-31 Do 22:45]
- State \"WAITING\" from \"TODO\" [2014-07-31 Do 14:46] \\
testing
:PROPERTIES:
:CATEGORY: mycat
:VISIBILITY_ALL: folded children all
:foo-key1: val1
:foo-key2: val2
:ID: 3996b55d-d678-43a4-af1f-48ed22b5f414
:CUSTOM_ID: abc123
:bar: loo
:END:
[2014-07-31 Do 14:45]
"
"Headline used to test `org-entry-properties'.")
(ert-deftest test-org/org-entry-properties-1 ()
"Test of `org-entry-properties' specifications."
(should
(equal '(("priority" . 65) ("tags" "tag") ("todo-keyword" . "DONE") ("todo-type" . done) ("deadline" timestamp (:type active :raw-value "<2014-08-01 Fr 08:00>" :year-start 2014 :month-start 8 :day-start 1 :hour-start 8 :minute-start 0 :year-end 2014 :month-end 8 :day-end 1 :hour-end 8 :minute-end 0 :begin 56 :end 77 :post-blank 0)) ("CATEGORY" . "mycat") ("VISIBILITY_ALL" . "folded children all") ("FOO-KEY1" . "val1") ("FOO-KEY2" . "val2") ("ID" . "3996b55d-d678-43a4-af1f-48ed22b5f414") ("CUSTOM_ID" . "abc123") ("BAR" . "loo"))
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil nil nil)))))
(ert-deftest test-org/org-entry-properties-2 ()
"Test of `org-entry-properties' specifications."
(should
(equal '(("priority" . 65) ("tags" "tag") ("todo-keyword" . "DONE") ("todo-type" . done) ("deadline" timestamp (:type active :raw-value "<2014-08-01 Fr 08:00>" :year-start 2014 :month-start 8 :day-start 1 :hour-start 8 :minute-start 0 :year-end 2014 :month-end 8 :day-end 1 :hour-end 8 :minute-end 0 :begin 56 :end 77 :post-blank 0)) ("CATEGORY" . "mycat") ("VISIBILITY_ALL" . "folded children all") ("FOO-KEY1" . "val1") ("FOO-KEY2" . "val2") ("ID" . "3996b55d-d678-43a4-af1f-48ed22b5f414") ("CUSTOM_ID" . "abc123") ("BAR" . "loo"))
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil nil t)))))
(ert-deftest test-org/org-entry-properties-3 ()
"Test 3 of `org-entry-properties' specifications."
(should
(equal nil
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil nil 'foo)))))
(ert-deftest test-org/org-entry-properties-4 ()
"Test 4 of `org-entry-properties' specifications."
(should
(equal '("BAR" . "loo")
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil nil "bar")))))
(ert-deftest test-org/org-entry-properties-5 ()
"Test 5 of `org-entry-properties' specifications."
(should
(equal '(("priority" . 65) ("tags" "tag") ("todo-keyword" . "DONE") ("todo-type" . done) ("deadline" timestamp (:type active :raw-value "<2014-08-01 Fr 08:00>" :year-start 2014 :month-start 8 :day-start 1 :hour-start 8 :minute-start 0 :year-end 2014 :month-end 8 :day-end 1 :hour-end 8 :minute-end 0 :begin 56 :end 77 :post-blank 0)) ("CATEGORY" . "mycat") ("VISIBILITY_ALL" . "folded children all") ("FOO-KEY1" . "val1") ("FOO-KEY2" . "val2") ("ID" . "3996b55d-d678-43a4-af1f-48ed22b5f414") ("CUSTOM_ID" . "abc123") ("BAR" . "loo"))
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil nil '(loo))))))
(ert-deftest test-org/org-entry-properties-6 ()
"Test of `org-entry-properties' specifications."
(should
(equal nil
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil t)))))
(ert-deftest test-org/org-entry-properties-7 ()
"Test of `org-entry-properties' specifications."
(should
(equal nil
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil 'foo)))))
(ert-deftest test-org/org-entry-properties-8 ()
"Test of `org-entry-properties' specifications."
(should
(equal '("BAR" . "loo")
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil "bar")))))
(ert-deftest test-org/org-entry-properties-9 ()
"Test of `org-entry-properties' specifications."
(should
(equal '(("priority" . 65) ("tags" "tag") ("todo-keyword" . "DONE") ("todo-type" . done) ("deadline" timestamp (:type active :raw-value "<2014-08-01 Fr 08:00>" :year-start 2014 :month-start 8 :day-start 1 :hour-start 8 :minute-start 0 :year-end 2014 :month-end 8 :day-end 1 :hour-end 8 :minute-end 0 :begin 56 :end 77 :post-blank 0)) ("CATEGORY" . "mycat") ("VISIBILITY_ALL" . "folded children all") ("FOO-KEY1" . "val1") ("FOO-KEY2" . "val2") ("ID" . "3996b55d-d678-43a4-af1f-48ed22b5f414") ("CUSTOM_ID" . "abc123") ("BAR" . "loo"))
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil 'all)))))
(ert-deftest test-org/org-entry-properties-10 ()
"Test of `org-entry-properties' specifications."
(should
(equal '(("priority" . 65) ("tags" "tag") ("todo-keyword" . "DONE") ("todo-type" . done) ("deadline" timestamp (:type active :raw-value "<2014-08-01 Fr 08:00>" :year-start 2014 :month-start 8 :day-start 1 :hour-start 8 :minute-start 0 :year-end 2014 :month-end 8 :day-end 1 :hour-end 8 :minute-end 0 :begin 56 :end 77 :post-blank 0)) ("VISIBILITY_ALL" . "folded children all") ("FOO-KEY1" . "val1") ("FOO-KEY2" . "val2") ("ID" . "3996b55d-d678-43a4-af1f-48ed22b5f414") ("BAR" . "loo"))
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil 'non-org)))))
(ert-deftest test-org/org-entry-properties-11 ()
"Test of `org-entry-properties' specifications."
(should
(equal '(("priority" . 65) ("tags" "tag") ("todo-keyword" . "DONE") ("todo-type" . done) ("deadline" timestamp (:type active :raw-value "<2014-08-01 Fr 08:00>" :year-start 2014 :month-start 8 :day-start 1 :hour-start 8 :minute-start 0 :year-end 2014 :month-end 8 :day-end 1 :hour-end 8 :minute-end 0 :begin 56 :end 77 :post-blank 0)) ("CATEGORY" . "mycat") ("VISIBILITY_ALL" . "folded children all") ("FOO-KEY1" . "val1") ("FOO-KEY2" . "val2") ("ID" . "3996b55d-d678-43a4-af1f-48ed22b5f414") ("CUSTOM_ID" . "abc123") ("BAR" . "loo"))
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil 'standard)))))
(ert-deftest test-org/org-entry-properties-12 ()
"Test of `org-entry-properties' specifications."
(should (equal '(:raw-value "headline <2014-07-31 Do>" :begin 1 :end 448 :pre-blank 0 :contents-begin 44 :contents-end 448 :level 1 :priority 65 :tags ("tag") :todo-keyword "DONE" :todo-type done :deadline (timestamp (:type active :raw-value "<2014-08-01 Fr 08:00>" :year-start 2014 :month-start 8 :day-start 1 :hour-start 8 :minute-start 0 :year-end 2014 :month-end 8 :day-end 1 :hour-end 8 :minute-end 0 :begin 56 :end 77 :post-blank 0)))
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil 'parser)))))
(ert-deftest test-org/org-entry-properties-13 ()
"Test of `org-entry-properties' specifications."
(should (equal '(("priority" . 65) ("tags" "tag") ("deadline" timestamp (:type active :raw-value "<2014-08-01 Fr 08:00>" :year-start 2014 :month-start 8 :day-start 1 :hour-start 8 :minute-start 0 :year-end 2014 :month-end 8 :day-end 1 :hour-end 8 :minute-end 0 :begin 56 :end 77 :post-blank 0)))
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil 'special)))))
(ert-deftest test-org/org-entry-properties-14 ()
"Test of `org-entry-properties' specifications."
(should
(equal '(("CATEGORY" . "mycat") ("CUSTOM_ID" . "abc123"))
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil 'default)))))
(ert-deftest test-org/org-entry-properties-15 ()
"Test of `org-entry-properties' specifications."
(should
(equal nil
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil 'custom)))))
(ert-deftest test-org/org-entry-properties-16 ()
"Test of `org-entry-properties' specifications."
(should
(equal nil
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil 'document)))))
(ert-deftest test-org/org-entry-properties-17 ()
"Test of `org-entry-properties' specifications."
(should
(equal nil
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil 'global)))))
(ert-deftest test-org/org-entry-properties-18 ()
"Test of `org-entry-properties' specifications."
(should
(equal '(("VISIBILITY_ALL" . "folded children all"))
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil 'global-fixed)))))
(ert-deftest test-org/org-entry-properties-19 ()
"Test of `org-entry-properties' specifications."
(should
(equal nil
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil 'file)))))
(ert-deftest test-org/org-entry-properties-20 ()
"Test of `org-entry-properties' specifications."
(should
(equal nil
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil '(loo))))))
(ert-deftest test-org/org-entry-properties-21 ()
"Test of `org-entry-properties' specifications."
(should
(equal '(("FOO-KEY1" . "val1") ("FOO-KEY2" . "val2"))
(org-test-with-temp-text
test-org/org-entry-properties-temp-text
(org-entry-properties nil '(and "foo-"))))))
#+end_src
--
cheers,
Thorsten
next reply other threads:[~2014-07-31 23:22 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2014-07-31 23:21 Thorsten Jolitz [this message]
2014-08-01 11:44 ` [RFC] Rewrite `org-entry-properties' using parser Bastien
2014-08-01 12:44 ` Thorsten Jolitz
2014-08-01 13:28 ` Nicolas Goaziou
2014-08-05 12:52 ` Thorsten Jolitz
2014-08-06 9:59 ` Rasmus
2014-08-06 12:04 ` Nicolas Goaziou
2014-08-21 0:16 ` Thorsten Jolitz
2014-08-01 18:41 ` Erik Hetzner
2014-08-03 18:59 ` John Kitchin
2014-08-04 3:45 ` Erik Hetzner
2014-08-04 4:07 ` Aaron Ecay
2014-08-04 14:11 ` Erik Hetzner
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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87tx5xunas.fsf@gmail.com \
--to=tjolitz@gmail.com \
--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 external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.