From 86d338729f17f8830a7b7dd6164fd8d8765a6df3 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 4 Sep 2024 20:48:51 -0500 Subject: [PATCH] Fix: (property) Calling like (property PROPERTY :inherit t) Supporting this form isn't really required, since it violates the CL-style argument parsing of CL-DEFUN, but it's convenient, and probably saves some hair-pulling for users who are less familiar with Elisp. Fixes #460. Reported-by: Stewmath --- README.org | 1 + org-ql.el | 54 +++++++++++++++++++------- org-ql.info | 90 +++++++++++++++++++++++--------------------- tests/test-org-ql.el | 10 ++++- 4 files changed, 98 insertions(+), 57 deletions(-) diff --git a/README.org b/README.org index 3ec87f8..bb6c589 100644 --- a/README.org +++ b/README.org @@ -556,6 +556,7 @@ Simple links may also be written manually in either sexp or non-sexp form, like: ** 0.8.9-pre *Fixes* ++ Predicate ~property~ when called with argument form ~(property "PROPERTY-NAME" :inherit t)~. ([[https://github.com/alphapapa/org-ql/issues/460][#460]]. Thanks to [[https://github.com/Stewmath][Stewmath]] for reporting.) + Reading of view settings from Org links in upcoming Emacs version. ([[https://github.com/alphapapa/org-ql/issues/461][#461]]. Thanks to [[https://github.com/snogge][Ola Nilsson]] for help debugging, and for maintaining [[https://github.com/jorgenschaefer/emacs-buttercup][Buttercup]].) ** 0.8.8 diff --git a/org-ql.el b/org-ql.el index 5149c78..9ff8d71 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1799,34 +1799,62 @@ interpreted as nil or non-nil)." ;; predicate test for whether an entry has local ;; properties when no arguments are given. (list 'property "")) - (`(,predicate-names ,property ,value . ,plist) + (`(,predicate-names ,property) ;; Convert keyword property arguments to strings. Non-sexp ;; queries result in keyword property arguments (because to do ;; otherwise would require ugly special-casing in the parsing). (when (keywordp property) (setf property (substring (symbol-name property) 1))) - (list 'property property value - :inherit (cond ((plist-member plist :inherit) (plist-get plist :inherit)) - ((listp org-use-property-inheritance) ''selective) - (t org-use-property-inheritance))))) + (list 'property property)) + (`(,predicate-names ,property . ,rest) + (pcase rest + (`(,value) + ;; Convert keyword property arguments to strings. Non-sexp + ;; queries result in keyword property arguments (because to do + ;; otherwise would require ugly special-casing in the parsing). + (when (keywordp property) + (setf property (substring (symbol-name property) 1))) + (list 'property property value)) + ((and `(,value . ,plist) + (guard (not (keywordp value)))) + ;; Convert keyword property arguments to strings. Non-sexp + ;; queries result in keyword property arguments (because to do + ;; otherwise would require ugly special-casing in the parsing). + (when (keywordp property) + (setf property (substring (symbol-name property) 1))) + (list 'property property value + :inherit (cond ((plist-member plist :inherit) (plist-get plist :inherit)) + ((listp org-use-property-inheritance) ''selective) + (t org-use-property-inheritance)))) + ((and plist (guard (keywordp (car rest)))) + ;; Convert keyword property arguments to strings. Non-sexp + ;; queries result in keyword property arguments (because to do + ;; otherwise would require ugly special-casing in the parsing). + (when (keywordp property) + (setf property (substring (symbol-name property) 1))) + (list 'property property nil + :inherit (cond ((plist-member plist :inherit) (plist-get plist :inherit)) + ((listp org-use-property-inheritance) ''selective) + (t org-use-property-inheritance))))))) ;; MAYBE: Should case folding be disabled for properties? What about values? ;; MAYBE: Support (property) without args. ;; NOTE: When inheritance is enabled, the preamble can't be used, ;; which will make the search slower. - :preambles ((`(,predicate-names ,property ,value . ,(map :inherit)) + :preambles (((and `(,predicate-names ,property ,value) + (guard (atom value))) ;; We do NOT return nil, because the predicate still needs to be tested, ;; because the regexp could match a string not inside a property drawer. - (list :regexp (unless inherit - (rx-to-string `(seq bol (0+ space) ":" ,property ":" - (1+ space) ,value (0+ space) eol))) + (list :regexp (rx-to-string `(seq bol (0+ space) ":" ,property ":" + (1+ space) ,value (0+ space) eol)) :query query)) - (`(,predicate-names ,property . ,(map :inherit)) - ;; We do NOT return nil, because the predicate still needs to be tested, + ((and `(,predicate-names ,property ,value . ,plist) + (guard (keywordp (car plist)))) + ;; WE do NOT return nil, because the predicate still needs to be tested, ;; because the regexp could match a string not inside a property drawer. ;; NOTE: The preamble only matches if there appears to be a value. ;; A line like ":ID: " without any other text does not match. - (list :regexp (unless inherit + (list :regexp (unless (plist-get plist :inherit) (rx-to-string `(seq bol (0+ space) ":" ,property ":" (1+ space) (minimal-match (1+ not-newline)) eol))) :query query))) @@ -1838,7 +1866,7 @@ interpreted as nil or non-nil)." ;; Check that PROPERTY exists (org-ql--value-at (point) (lambda () - (org-entry-get (point) property)))) + (org-entry-get (point) property inherit)))) (_ ;; Check that PROPERTY has VALUE. diff --git a/org-ql.info b/org-ql.info index c0a424c..c11c851 100644 --- a/org-ql.info +++ b/org-ql.info @@ -1085,6 +1085,10 @@ File: README.info, Node: 089-pre, Next: 088, Up: Changelog ============= *Fixes* + • Predicate ‘property’ when called with argument form ‘(property + "PROPERTY-NAME" :inherit t)’. (#460 + (https://github.com/alphapapa/org-ql/issues/460). Thanks to + Stewmath (https://github.com/Stewmath) for reporting.) • Reading of view settings from Org links in upcoming Emacs version. (#461 (https://github.com/alphapapa/org-ql/issues/461). Thanks to Ola Nilsson (https://github.com/snogge) for help debugging, and for @@ -2069,49 +2073,49 @@ Node: Links38939 Node: Tips39626 Node: Changelog39950 Node: 089-pre40900 -Node: 08841308 -Node: 08742388 -Node: 08643616 -Node: 08543850 -Node: 08444506 -Node: 08344958 -Node: 08245299 -Node: 08145692 -Node: 0846113 -Node: 07448839 -Node: 07349064 -Node: 07249798 -Node: 07150719 -Node: 0751530 -Node: 06354396 -Node: 06254929 -Node: 06155236 -Node: 0655806 -Node: 05258862 -Node: 05159164 -Node: 0559589 -Node: 04961120 -Node: 04861402 -Node: 04761751 -Node: 04662160 -Node: 04562568 -Node: 04462929 -Node: 04363288 -Node: 04263491 -Node: 04163652 -Node: 0463899 -Node: 03268000 -Node: 03168403 -Node: 0368600 -Node: 02371900 -Node: 02272134 -Node: 02172414 -Node: 0272619 -Node: 0176697 -Node: Notes76798 -Node: Comparison with Org Agenda searches76960 -Node: org-sidebar77849 -Node: License78128 +Node: 08841554 +Node: 08742634 +Node: 08643862 +Node: 08544096 +Node: 08444752 +Node: 08345204 +Node: 08245545 +Node: 08145938 +Node: 0846359 +Node: 07449085 +Node: 07349310 +Node: 07250044 +Node: 07150965 +Node: 0751776 +Node: 06354642 +Node: 06255175 +Node: 06155482 +Node: 0656052 +Node: 05259108 +Node: 05159410 +Node: 0559835 +Node: 04961366 +Node: 04861648 +Node: 04761997 +Node: 04662406 +Node: 04562814 +Node: 04463175 +Node: 04363534 +Node: 04263737 +Node: 04163898 +Node: 0464145 +Node: 03268246 +Node: 03168649 +Node: 0368846 +Node: 02372146 +Node: 02272380 +Node: 02172660 +Node: 0272865 +Node: 0176943 +Node: Notes77044 +Node: Comparison with Org Agenda searches77206 +Node: org-sidebar78095 +Node: License78374  End Tag Table diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 6717472..444cb22 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -1337,7 +1337,15 @@ with keyword arg NOW in PLIST." (org-ql-it "with a property and a value" (org-ql-expect ('(property "agenda-group" "plans")) - '("Take over the universe" "Write a symphony")))) + '("Take over the universe" "Write a symphony"))) + + (org-ql-it "with a property and \"nil :inherit t\"" + (org-ql-expect ('(property "agenda-group" nil :inherit t)) + '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Spaceship lease" "Recurring" "/r/emacs" "Shop for groceries" "Sunrise/sunset" "Write a symphony"))) + + (org-ql-it "with a property and \":inherit t\"" + (org-ql-expect ('(property "agenda-group" :inherit t)) + '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Spaceship lease" "Recurring" "/r/emacs" "Shop for groceries" "Sunrise/sunset" "Write a symphony")))) (describe "(regexp)"