Compare commits

...
Sign in to create a new pull request.

2 commits

Author SHA1 Message Date
Adam Porter
a00be91ca1 Fix: (property) Calling like (property PROPERTY :inherit t)
Fixes #460.

Reported-by: Stewmath <https://github.com/Stewmath>
2024-09-04 22:05:02 -05:00
Adam Porter
c96af15888 Fix: (org-ql-view--link-follow) Reading link parameters
This is needed due to changes in Emacs 30, but this code was always
mistaken, and it just happened to work.

See <https://github.com/jorgenschaefer/emacs-buttercup/issues/247>.

Fixes #461.

Suggested-by: Ola Nilsson <ola.nilsson@gmail.com>
2024-09-04 22:00:41 -05:00
5 changed files with 110 additions and 63 deletions

View file

@ -555,7 +555,9 @@ Simple links may also be written manually in either sexp or non-sexp form, like:
** 0.8.9-pre
Nothing new yet.
*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

View file

@ -622,7 +622,7 @@ purposes of compatibility with changes in Org 9.4."
(query (url-unhex-string query))
(params (when params (url-parse-query-string params)))
;; `url-parse-query-string' returns "improper" alists, which makes this awkward.
(sort (when-let* ((stored-string (alist-get "sort" params nil nil #'string=))
(sort (when-let* ((stored-string (car (alist-get "sort" params nil nil #'string=)))
(read-value (read stored-string)))
;; Ensure the value is either a symbol or list of symbols (which excludes lambdas).
(unless (or (symbolp read-value) (cl-every #'symbolp read-value))
@ -630,11 +630,11 @@ purposes of compatibility with changes in Org 9.4."
read-value))
read-value))
(org-super-agenda-allow-unsafe-groups nil) ; Disallow unsafe group selectors.
(groups (--when-let (alist-get "super-groups" params nil nil #'string=)
(groups (--when-let (car (alist-get "super-groups" params nil nil #'string=))
(read it)))
(title (--when-let (alist-get "title" params nil nil #'string=)
(title (--when-let (car (alist-get "title" params nil nil #'string=))
(read it)))
(buffers-files (--if-let (alist-get "buffers-files" params nil nil #'string=)
(buffers-files (--if-let (car (alist-get "buffers-files" params nil nil #'string=))
(org-ql-view--expand-buffers-files (read it))
(current-buffer))))
(unless (or (bufferp buffers-files)

View file

@ -1799,7 +1799,24 @@ 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))
(`(,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).
@ -1808,25 +1825,36 @@ interpreted as nil or non-nil)."
(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)))))
(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.

View file

@ -1084,7 +1084,16 @@ File: README.info, Node: 089-pre, Next: 088, Up: Changelog
5.1 0.8.9-pre
=============
Nothing new yet.
*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
maintaining Buttercup
(https://github.com/jorgenschaefer/emacs-buttercup).)

File: README.info, Node: 088, Next: 087, Prev: 089-pre, Up: Changelog
@ -2064,49 +2073,49 @@ Node: Links38939
Node: Tips39626
Node: Changelog39950
Node: 089-pre40900
Node: 08841012
Node: 08742092
Node: 08643320
Node: 08543554
Node: 08444210
Node: 08344662
Node: 08245003
Node: 08145396
Node: 0845817
Node: 07448543
Node: 07348768
Node: 07249502
Node: 07150423
Node: 0751234
Node: 06354100
Node: 06254633
Node: 06154940
Node: 0655510
Node: 05258566
Node: 05158868
Node: 0559293
Node: 04960824
Node: 04861106
Node: 04761455
Node: 04661864
Node: 04562272
Node: 04462633
Node: 04362992
Node: 04263195
Node: 04163356
Node: 0463603
Node: 03267704
Node: 03168107
Node: 0368304
Node: 02371604
Node: 02271838
Node: 02172118
Node: 0272323
Node: 0176401
Node: Notes76502
Node: Comparison with Org Agenda searches76664
Node: org-sidebar77553
Node: License77832
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

View file

@ -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)"