From mboxrd@z Thu Jan 1 00:00:00 1970 From: Thorsten Jolitz Subject: [RFC] Rewrite `org-entry-properties' using parser Date: Fri, 01 Aug 2014 01:21:47 +0200 Message-ID: <87tx5xunas.fsf@gmail.com> Mime-Version: 1.0 Content-Type: text/plain Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:48703) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XCzfm-00025E-2U for emacs-orgmode@gnu.org; Thu, 31 Jul 2014 19:22:17 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XCzfe-0002ZI-GC for emacs-orgmode@gnu.org; Thu, 31 Jul 2014 19:22:09 -0400 Received: from plane.gmane.org ([80.91.229.3]:56624) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XCzfe-0002Z7-2v for emacs-orgmode@gnu.org; Thu, 31 Jul 2014 19:22:02 -0400 Received: from list by plane.gmane.org with local (Exim 4.69) (envelope-from ) id 1XCzfc-0000AY-Qw for emacs-orgmode@gnu.org; Fri, 01 Aug 2014 01:22:00 +0200 Received: from g231111176.adsl.alicedsl.de ([92.231.111.176]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Fri, 01 Aug 2014 01:22:00 +0200 Received: from tjolitz by g231111176.adsl.alicedsl.de with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Fri, 01 Aug 2014 01:22:00 +0200 List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org 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