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

WIP: (org-ql-view) Update header line

Browse source
This commit is contained in:
Adam Porter 2023-12-24 00:59:58 -06:00
parent 9237f0d93b
commit 23e44cb6f1
1 changed files with 33 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

50
org-ql-view.el
View file

@ -1044,38 +1044,52 @@ property."
(declare-function org-ql-search-directories-files "org-ql-search" t) (declare-function org-ql-search-directories-files "org-ql-search" t)
(defun org-ql-view--contract-buffers-files (buffers-files) (defun org-ql-view--contract-buffers-files (in)
"Return BUFFERS-FILES in its \"contracted\" form. "Return IN in its \"contracted\" form.
The contracted form is \"org-agenda-files\" if BUFFERS-FILES The contracted form is \"org-agenda-files\" if IN matches the
matches the value of `org-agenda-files' (either the function or value of `org-agenda-files' (either the function or the
the variable), \"org-directory\" if it matches the value of variable), \"org-directory\" if it matches the value of
`org-ql-search-directories-files', or \"buffer\" if it is the `org-ql-search-directories-files', or \"buffer\" if it is the
current buffer. Otherwise BUFFERS-FILES is returned unchanged." current buffer. Otherwise IN is returned unchanged."
;; Used in `org-ql-view--complete-buffers-files' and ;; Used in `org-ql-view--complete-buffers-files' and
;; `org-ql-view--header-line-format'. ;; `org-ql-view--header-line-format'.
(cl-labels ((expand-files (list) (cl-labels ((expand-elt (it)
(--map (cl-typecase it (cl-typecase it
(string (expand-file-name it)) (string (or (expanded it)
(otherwise it)) (id-location it)
list))) (error "Unknown expansion 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))
(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))))
(format "\"%s\" in %S"
heading (abbreviate-file-name (buffer-file-name (marker-buffer marker)))))))
;; TODO: Test this more exhaustively. ;; TODO: Test this more exhaustively.
(pcase buffers-files (pcase in
((pred listp) ((pred listp)
(pcase (expand-files buffers-files) (pcase (mapcar #'expand-elt in)
((pred (seq-set-equal-p (mapcar #'expand-file-name (org-agenda-files)))) ((pred (seq-set-equal-p (mapcar #'expand-file-name (org-agenda-files))))
"org-agenda-files") "org-agenda-files")
((and (guard (file-exists-p org-directory)) ((and (guard (file-exists-p org-directory))
(pred (seq-set-equal-p (org-ql-search-directories-files (pred (seq-set-equal-p (org-ql-search-directories-files
:directories (list org-directory))))) :directories (list org-directory)))))
"org-directory") "org-directory")
(_ buffers-files))) (_ in)))
((pred (equal (current-buffer))) ((pred (equal (current-buffer)))
"buffer") (buffer-name (current-buffer)))
((or 'org-agenda-files '(function org-agenda-files)) ((or 'org-agenda-files '(function org-agenda-files))
"org-agenda-files") "org-agenda-files")
((and (pred bufferp) (guard (buffer-file-name buffers-files))) ((and (pred bufferp) (guard (buffer-file-name in)))
(buffer-file-name buffers-files)) (buffer-file-name in))
(_ buffers-files)))) (_ (expand-elt in)))))
(defun org-ql-view--complete-buffers-files () (defun org-ql-view--complete-buffers-files ()
"Return value for `org-ql-view-buffers-files' using completion." "Return value for `org-ql-view-buffers-files' using completion."