jiri/org-ql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

WIP: (org-ql-search) Handle narrowing, and improve titles

Browse source
This commit is contained in:
Adam Porter 2023-12-24 05:41:25 -06:00
parent 1fce6cc364
commit 71c8079e22
3 changed files with 31 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

25
org-ql-search.el
View file

@ -168,8 +168,9 @@ SUPER-GROUPS: An `org-super-agenda' group set. See variable
`org-super-agenda-groups' and Info node `(org-super-agenda)Group `org-super-agenda-groups' and Info node `(org-super-agenda)Group
selectors'. selectors'.
NARROW: When non-nil, don't widen buffers before NARROW: When non-nil, don't widen buffers before searching.
searching. Interactively, with prefix, leave narrowed. Interactively, when buffer is narrowed, search within subtree
narrowed to.
SORT: One or a list of `org-ql' sorting functions, like `date' or SORT: One or a list of `org-ql' sorting functions, like `date' or
`priority' (see Info node `(org-ql)Listing / acting-on results'). `priority' (see Info node `(org-ql)Listing / acting-on results').
@ -181,13 +182,19 @@ display the results. By default, the value of
`org-ql-view-buffer' is used, and a new buffer is created if `org-ql-view-buffer' is used, and a new buffer is created if
necessary." necessary."
(declare (indent defun)) (declare (indent defun))
(interactive (list (org-ql-view--complete-buffers-files) (interactive
(read-string "Query: " (when org-ql-view-query (let* ((in (org-ql-view--complete-buffers-files))
(format "%S" org-ql-view-query))) (query (read-string "Query: " (when org-ql-view-query
;; FIXME: Automatically narrow when searching current buffer and it's narrowed (use ID if it has one, otherwise use a marker--and then add an ID later if bookmarking the search and it doesn't have one). (format "%S" org-ql-view-query))))
:narrow (or org-ql-view-narrow (eq current-prefix-arg '(4))) (narrow (if (equal in (current-buffer))
:super-groups (org-ql-view--complete-super-groups) (or org-ql-view-narrow
:sort (org-ql-view--complete-sort))) (when (buffer-narrowed-p)
(setf in (or (org-id-get (point-min))
(copy-marker (point-min))))))
org-ql-view-narrow)))
(list in query :narrow narrow
:super-groups (org-ql-view--complete-super-groups)
:sort (org-ql-view--complete-sort))))
;; NOTE: Using `with-temp-buffer' is a hack to work around the fact that `make-local-variable' ;; NOTE: Using `with-temp-buffer' is a hack to work around the fact that `make-local-variable'
;; does not work reliably from inside a `let' form when the target buffer is current on entry ;; does not work reliably from inside a `let' form when the target buffer is current on entry
;; to or exit from the `let', even though `make-local-variable' is actually done in ;; to or exit from the `let', even though `make-local-variable' is actually done in

20
org-ql-view.el
View file

@ -1056,20 +1056,28 @@ current buffer. Otherwise IN is returned unchanged."
(cl-labels ((expand-elt (it) (cl-labels ((expand-elt (it)
(cl-typecase it (cl-typecase it
(string (or (expanded it) (string (or (expanded it)
(id-location it) (location-of it)
(error "Unknown expansion for %S" it))) (error "Unknown expansion for %S" it)))
(marker (or (location-of it)
(error "Unknown location for %S" it)))
(otherwise it))) (otherwise it)))
(expanded (filename) (expanded (filename)
(when-let ((expanded (expand-file-name filename)) (when-let ((expanded (expand-file-name filename))
((file-readable-p expanded))) ((file-readable-p expanded)))
expanded)) expanded))
(id-location (id) (location-of (place)
(when-let ((marker (org-id-find id 'marker)) (when-let ((marker (cl-etypecase place
(marker place)
(string (org-id-find place 'marker))))
(heading (org-link-display-format (org-entry-get marker "ITEM")))) (heading (org-link-display-format (org-entry-get marker "ITEM"))))
(setf heading (if (string-empty-p heading) (setf heading (if (string-empty-p heading)
id place
;; FIXME: The help-echo gets overridden elsewhere. (or (org-id-get marker)
(propertize heading 'help-echo (format "ID: %s" id)))) (string-join (org-with-point-at marker
(org-get-outline-path t))
" › ")))
;; FIXME: The help-echo gets overridden elsewhere.
heading (propertize heading 'help-echo (format "%s" place)))
(format "\"%s\" in %S" (format "\"%s\" in %S"
heading (abbreviate-file-name (buffer-file-name (marker-buffer marker))))))) heading (abbreviate-file-name (buffer-file-name (marker-buffer marker)))))))
;; TODO: Test this more exhaustively. ;; TODO: Test this more exhaustively.

1
org-ql.el
View file

@ -383,6 +383,7 @@ each priority the newest items would appear first."
;; NOTE: This exhaustive pcase is essential to opening links ;; NOTE: This exhaustive pcase is essential to opening links
;; safely, as it rejects, e.g. lambdas in the IN argument. ;; safely, as it rejects, e.g. lambdas in the IN argument.
((cl-type buffer) it) ((cl-type buffer) it)
((cl-type marker) it)
((and (cl-type string) ((and (cl-type string)
(pred file-readable-p)) (pred file-readable-p))
(or (find-buffer-visiting it) (or (find-buffer-visiting it)