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

Tidy: Function, docstrings, commented code

Browse source
This commit is contained in:
Adam Porter 2023-03-16 07:44:10 -05:00
parent e030627aeb
commit 6c18f133e9
1 changed files with 40 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

69
org-ql-completing-read.el
View file

@ -86,6 +86,11 @@ Returns (STRING . MARKER) cons."
(cons (org-entry-get nil "ITEM") (point-marker))) (cons (org-entry-get nil "ITEM") (point-marker)))
(defun org-ql-completing-read-snippet (marker) (defun org-ql-completing-read-snippet (marker)
"Return snippet for entry at MARKER.
Returns value returned by function
`org-ql-completing-read-snippet-function' or
`org-ql-completing-read--snippet-simple', whichever returns a
value, or nil."
(while-no-input (while-no-input
;; Using `while-no-input' here doesn't make it as ;; Using `while-no-input' here doesn't make it as
;; responsive as, e.g. Helm while typing, but it seems to ;; responsive as, e.g. Helm while typing, but it seems to
@ -94,6 +99,17 @@ Returns (STRING . MARKER) cons."
(or (funcall org-ql-completing-read-snippet-function) (or (funcall org-ql-completing-read-snippet-function)
(org-ql-completing-read--snippet-simple))))) (org-ql-completing-read--snippet-simple)))))
(defun org-ql-completing-read-path (marker)
"Return formatted outline path for entry at MARKER."
(org-with-point-at marker
(let* ((path (thread-first (org-get-outline-path nil t)
(org-format-outline-path (window-width) nil "")
(org-split-string "")))
(formatted-path (if org-ql-completing-read-reverse-paths
(concat "\\" (string-join (reverse path) "\\"))
(concat "/" (string-join path "/")))))
formatted-path)))
;;;;; Completing read ;;;;; Completing read
;;;###autoload ;;;###autoload
@ -102,18 +118,10 @@ Returns (STRING . MARKER) cons."
(action #'org-ql-completing-read-action) (action #'org-ql-completing-read-action)
(annotate #'org-ql-completing-read-snippet) (annotate #'org-ql-completing-read-snippet)
(snippet #'org-ql-completing-read-snippet) (snippet #'org-ql-completing-read-snippet)
(path (lambda (marker) (path #'org-ql-completing-read-path)
(org-with-point-at marker
(let* ((path (thread-first (org-get-outline-path nil t)
(org-format-outline-path (window-width) nil "")
(org-split-string "")))
(formatted-path (if org-ql-completing-read-reverse-paths
(concat "\\" (string-join (reverse path) "\\"))
(concat "/" (string-join path "/")))))
formatted-path))))
(action-filter #'list) (action-filter #'list)
(prompt "Find entry: ")) (prompt "Find entry: "))
"Return marker at Org entry in BUFFERS-FILES selected with `org-ql'. "Return marker at entry in BUFFERS-FILES selected with `org-ql'.
PROMPT is shown to the user. PROMPT is shown to the user.
QUERY-PREFIX may be a string to prepend to the query entered by QUERY-PREFIX may be a string to prepend to the query entered by
@ -139,31 +147,34 @@ single predicate)."
;; (message "ORG-QL-COMPLETING-READ: Starts.") ;; (message "ORG-QL-COMPLETING-READ: Starts.")
(let ((table (make-hash-table :test #'equal)) (let ((table (make-hash-table :test #'equal))
(disambiguations (make-hash-table :test #'equal)) (disambiguations (make-hash-table :test #'equal))
(window-width (window-width))
last-input org-outline-path-cache query-tokens) last-input org-outline-path-cache query-tokens)
(cl-labels (;; (debug-message (cl-labels (;; (debug-message
;; (f &rest args) (apply #'message (concat "ORG-QL-COMPLETING-READ: " f) args)) ;; (f &rest args) (apply #'message (concat "ORG-QL-COMPLETING-READ: " f) args))
(action (action ()
() (font-lock-ensure (point-at-bol) (point-at-eol)) (font-lock-ensure (point-at-bol) (point-at-eol))
;; FIXME: We want the fontified heading, and `org-heading-components' returns it ;; FIXME: We want the fontified string, and `org-heading-components' returns it
;; without properties, so we have to use `org-get-heading', which added additional ;; without properties, so we have to use `org-get-heading', which added additional
;; optional arguments in a certain Org version, so in those versions, it will ;; optional arguments in a certain Org version, so in those versions, it will
;; return priority cookies and comment strings. ;; return priority cookies and comment strings.
(let ((heading (org-link-display-format (org-entry-get (point) "ITEM"))))
(if (string-empty-p heading) ;; This function needs to handle multiple candidates per
;; A heading's string can be empty, but we can't use one because it ;; call, so we loop over a list of values by default.
;; wouldn't be useful to the user; and if one is found, it's very (pcase-dolist (`(,string . ,marker) (funcall action-filter (funcall action)))
;; likely to indicate an unnoticed mistake or corruption in the (when string
;; file: so display a warning and don't record it as a candidate. (if (string-empty-p string)
(warn "Empty heading at %S in %S" (point) (buffer-name)) ;; A heading's string can be empty, but we can't use one because it
(when (gethash heading table) ;; wouldn't be useful to the user; and if one is found, it's very
;; Disambiguate heading (even adding the path isn't enough, because that could ;; likely to indicate an unnoticed mistake or corruption in the
;; also be duplicated). ;; file: so display a warning and don't record it as a candidate.
(if-let ((suffix (gethash heading disambiguations))) (warn "Empty heading at %S" marker)
(setf heading (format "%s <%s>" heading (cl-incf suffix))) (when (gethash string table)
(setf heading (format "%s <%s>" heading (puthash heading 2 disambiguations))))) ;; Disambiguate string (even adding the path isn't enough, because that could
(let ((marker (point-marker))) ;; also be duplicated).
(puthash (propertize heading 'org-marker marker) marker table))))) (if-let ((suffix (gethash string disambiguations)))
(setf string (format "%s <%s>" string (cl-incf suffix)))
(setf string (format "%s <%s>" string (puthash string 2 disambiguations)))))
(puthash (propertize string 'org-marker marker) marker table)))))
(path (marker) (path (marker)
(org-with-point-at marker (org-with-point-at marker
(let* ((path (thread-first (org-get-outline-path nil t) (let* ((path (thread-first (org-get-outline-path nil t)