dbo/.emacs.d
dbo
/
.emacs.d
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Try to increase readability of db/org-backlinks implementation 

Mostly making use of pcase-*, but I am not quite sure whether the `(,foo . ,bar)
syntax really helps …

Also adjusted some comments and some formatting.
This commit is contained in:
Daniel - 2022-06-11 09:22:08 +02:00
parent b03a8f9517
commit 7e2860a9d9
Signed by: dbo
GPG Key ID: 784AA8DF0CCDF625
1 changed files with 31 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
site-lisp/db-org.el
View File

@ -1061,50 +1061,53 @@ PARAMS may contain the following values:
(org-with-point-at mark (org-with-point-at mark
(when-let ((id-at-point (org-id-get))) (when-let ((id-at-point (org-id-get)))
(cons id-at-point (cons id-at-point
(db/org--backlinks-for-id id-at-point org-ql-match archives)))))) (db/org--backlinks-for-id id-at-point
org-ql-match
archives))))))
(cl-remove-if #'null))) (cl-remove-if #'null)))
;; Change entries in headlines from the format (headline-id backlink-ids...) ;; Change entries in headlines from the format (headline-id backlink-ids...)
;; to (backlink-id headline-ids ...) for grouping them in the output later ;; to (backlink-id headline-ids ...) for grouping them in the output later.
(setq headlines (setq headlines
(->> headlines (->> headlines
(-mapcat #'(lambda (headline) ;; Transform (headline-id backlink-ids) to pairs
(mapcar #'(lambda (backlink) ;; (headline-id . backlink-id)
(cons backlink (car headline))) (-mapcat (pcase-lambda (`(,headline . ,backlinks))
(cdr headline)))) (mapcar #'(lambda (backlink)
;; Group by backlinks (first entry), returns list of non-empty (cons backlink headline))
;; lists backlinks)))
;; Group by backlinks (first entry), returns alist of
;; backlink-ids and list of pairs (backlink-id . headline-id)
(-group-by #'car) (-group-by #'car)
;; Flatten list, to get a list of (backlink-id headline-ids...) ;; Flatten list, to get a list of (backlink-id headline-ids...)
(-map #'(lambda (group) (-map (pcase-lambda (`(,backlink . ,backlink-headline-conses))
(cons (car group) (-map #'cdr (cdr group))))))) (cons backlink (-map #'cdr backlink-headline-conses))))))
;; Replace IDs by headlines and add priority for sorting ;; Replace IDs by headlines and add priority for sorting
(setq output-lines (setq output-lines
(->> headlines (->> headlines
(-map #'(lambda (line) (-map (pcase-lambda (`(,backlink-id . ,headline-ids))
(list (db/org--format-link-from-org-id (cl-first line)) (list (db/org--format-link-from-org-id backlink-id)
(org-entry-get (org-id-find (cl-first line) 'marker) (org-entry-get (org-id-find backlink-id 'marker)
"PRIORITY") "PRIORITY")
(-map #'db/org--format-link-from-org-id (cdr line))))) (-map #'db/org--format-link-from-org-id headline-ids))))
(-sort #'(lambda (line-1 line-2) (-sort (pcase-lambda (`(_ ,prio-1 _) `(_ ,prio-2 _))
(string< (cl-second line-1) (cl-second line-2)))))) (string< prio-1 prio-2)))))
;; Format output-lines as Org table ;; Format output-lines as Org table
(insert (format "| Backlink | Prio | Backlink Target(s) |\n|---|")) (insert (format "| Backlink | Prio | Backlink Target(s) |\n|---|"))
(when output-lines (when output-lines
(let (pp) ; pervious-priority, to draw hlines between groups of same priority (let (pp) ; pervious-priority, to draw hlines between groups of same priority
(dolist (line output-lines) (pcase-dolist (`(,backlink ,priority ,backlink-targets) output-lines)
(when (and pp (not (equal pp (cl-second line)))) (when (and pp (not (equal pp priority)))
(insert "\n|--|")) (insert "\n|--|"))
(setq pp (cl-second line)) (setq pp priority)
(insert (insert
(format "\n| %s | %s | %s |" (format "\n| %s | %s | %s |"
(cl-first line) ; actual backlink backlink
pp ; current priority priority
(apply #'concat ; backlink targets, separated by comma (apply #'concat (-interpose ", " backlink-targets)))))
(-interpose ", " (cl-third line)))))) (insert "\n|---|")))
(insert "\n|---|")))
(org-table-align))) (org-table-align)))
(defun db/org-insert-backlink-block () (defun db/org-insert-backlink-block ()