Skip to content

Commit

Permalink
WIP: (org-ql-search) Handle narrowing, and improve titles
Browse files Browse the repository at this point in the history
  • Loading branch information
alphapapa committed Dec 24, 2023
1 parent 2dc3ce8 commit 31b4677
Show file tree
Hide file tree
Showing 3 changed files with 31 additions and 15 deletions.
25 changes: 16 additions & 9 deletions org-ql-search.el
Original file line number Diff line number Diff line change
Expand Up @@ -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
selectors'.
NARROW: When non-nil, don't widen buffers before
searching. Interactively, with prefix, leave narrowed.
NARROW: When non-nil, don't widen buffers before searching.
Interactively, when buffer is narrowed, search within subtree
narrowed to.
SORT: One or a list of `org-ql' sorting functions, like `date' or
`priority' (see Info node `(org-ql)Listing / acting-on results').
Expand All @@ -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
necessary."
(declare (indent defun))
(interactive (list (org-ql-view--complete-buffers-files)
(read-string "Query: " (when org-ql-view-query
(format "%S" 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).
:narrow (or org-ql-view-narrow (eq current-prefix-arg '(4)))
:super-groups (org-ql-view--complete-super-groups)
:sort (org-ql-view--complete-sort)))
(interactive
(let* ((in (org-ql-view--complete-buffers-files))
(query (read-string "Query: " (when org-ql-view-query
(format "%S" org-ql-view-query))))
(narrow (if (equal in (current-buffer))
(or org-ql-view-narrow
(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'
;; 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
Expand Down
20 changes: 14 additions & 6 deletions org-ql-view.el
Original file line number Diff line number Diff line change
Expand Up @@ -1055,20 +1055,28 @@ current buffer. Otherwise IN is returned unchanged."
(cl-labels ((expand-elt (it)
(cl-typecase it
(string (or (expanded it)
(id-location it)
(location-of it)
(error "Unknown expansion for %S" it)))
(marker (or (location-of it)
(error "Unknown location for %S" it)))
(otherwise it)))
(expanded (filename)
(when-let ((expanded (expand-file-name filename))
((file-readable-p expanded)))
expanded))
(id-location (id)
(when-let ((marker (org-id-find id 'marker))
(location-of (place)
(when-let ((marker (cl-etypecase place
(marker place)
(string (org-id-find place 'marker))))
(heading (org-link-display-format (org-entry-get marker "ITEM"))))
(setf heading (if (string-empty-p heading)
id
;; FIXME: The help-echo gets overridden elsewhere.
(propertize heading 'help-echo (format "ID: %s" id))))
place
(or (org-id-get marker)
(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"
heading (abbreviate-file-name (buffer-file-name (marker-buffer marker)))))))
;; TODO: Test this more exhaustively.
Expand Down
1 change: 1 addition & 0 deletions org-ql.el
Original file line number Diff line number Diff line change
Expand Up @@ -383,6 +383,7 @@ each priority the newest items would appear first."
;; NOTE: This exhaustive pcase is essential to opening links
;; safely, as it rejects, e.g. lambdas in the IN argument.
((cl-type buffer) it)
((cl-type marker) it)
((and (cl-type string)
(pred file-readable-p))
(or (find-buffer-visiting it)
Expand Down

0 comments on commit 31b4677

Please sign in to comment.