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

Compare commits

base: dbo:949b49226d9606770a46233bb231cf264b6c2a94
Branches Tags
dbo:master
...
compare: dbo:10e01d4b3b3ef573a60f36ddbc38aadff9d24fe3
Branches Tags
dbo:master

3 Commits
949b49226d ... 10e01d4b3b

Author SHA1 Message Date
Daniel - 10e01d4b3b
Transpose output of backlink dynamic block to emphasize backlinks 
We are interested in the backlinks so we now put them first.  The backlink
targets (i.e., current item or any of its parents) are now grouped after the
priority of the item containing the backlink.
 2022-06-10 18:46:22 +02:00
Daniel - b84eb291e3
Use org-ql regexp search to find backlins 
This is because org-ql link queries seem to be broken when target links contain
brackets in their description.
 2022-06-09 21:27:35 +02:00
Daniel - 72c67796c2
Another try to the fix org-ql link regexp generator 
The previous version caused stack overflows in the regexp matcher, supposedly
because of matching newlines in the description.  This should not happend
anymore, but description won't be matched anymore of they contain a line break.
 2022-06-09 21:20:55 +02:00
2 changed files with 47 additions and 23 deletions
Show Stats Expand all files Collapse all files

13
init.el
View File

@ -974,23 +974,22 @@ respectively."
(description target)
(rx-to-string `(seq (or bol (1+ blank))
"[[" (0+ (not (any "]"))) (regexp ,target) (0+ (not (any "]")))
;; Added `anything'
"][" (0+ anything) (regexp ,description) (0+ anything)
;; Added .* wildcards
"][" (regexp ".*") (regexp ,description) (regexp ".*")
"]]")))
;; Note that these actually allow empty descriptions
;; or targets, depending on what they are matching.
(match-desc
(match) (rx-to-string `(seq (or bol (1+ blank))
"[[" (0+ (not (any "]")))
;; Added `anything'
"][" (0+ anything) (regexp ,match) (0+ anything)
;; Added .* wildcards
"][" (regexp ".*") (regexp ,match) (regexp ".*")
"]]")))
(match-target
(match) (rx-to-string `(seq (or bol (1+ blank))
"[[" (0+ (not (any "]"))) (regexp ,match) (0+ (not (any "]")))
;; Added `anything'
"][" (0+ anything)
"]]"))))
;; Removed pattern for description
"][" ))))
(cond (description-or-target
(rx-to-string `(or (regexp ,(no-desc description-or-target))
(regexp ,(match-desc description-or-target))

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

@ -1004,9 +1004,12 @@ referenced in `org-agenda-text-search-extra-files'."
(pop extra-files))
(setq files (append files extra-files))
;; Search directly for “[[id:ITEM-ID]” instead of using the regular
;; expression for links, as the latter seems to be broken (as of
;; [2022-06-09] when descriptions contain brackets
(org-ql-query :select '(org-id-get-create)
:from files
:where (let ((link-expression `(link :target ,item-id)))
:where (let ((link-expression `(regexp ,(format "\\[\\[id:%s\\]" item-id))))
(if org-ql-match
`(and ,link-expression ,org-ql-match)
link-expression)))))
@ -1046,7 +1049,7 @@ PARAMS may contain the following values:
:archives If non-nil, include archives"
(let* ((org-ql-match (plist-get params :org-ql-match))
(archives (plist-get params :archives))
headlines)
headlines output-lines)
;; Get all backlinks as list of Org mode IDs. Each list consists of the ID
;; of the headline (current or partent), followed by the IDs linking back to
@ -1061,20 +1064,42 @@ PARAMS may contain the following values:
(db/org--backlinks-for-id id-at-point org-ql-match archives))))))
(cl-remove-if #'null)))
;; Formatting.
(insert (format "| Item | Backlinks | Priority |\n|---|"))
(dolist (headline headlines)
(when (cdr headline) ; do not print backlinks if there are none
(insert (format "\n| %s |\n|---|" (db/org--format-link-from-org-id (car headline))))
(let ((backlink-lines (-> (mapcar #'(lambda (backlink-id)
(list (db/org--format-link-from-org-id backlink-id)
(org-entry-get (org-id-find backlink-id 'marker)
"PRIORITY")))
(cdr headline))
(cl-sort #'string< :key #'cl-second))))
(dolist (line backlink-lines)
(insert (apply #'format "\n| | %s | %s |" line)))
(insert "\n|---|"))))
;; Change entries in headlines from the format (headline-id backlink-ids...)
;; to (backlink-id headline-ids ...) for grouping them in the output later
(setq headlines
(->> headlines
(-mapcat #'(lambda (headline)
(mapcar #'(lambda (backlink)
(cons backlink (car headline)))
(cdr headline))))
;; Group by backlinks (first entry), returns list of non-empty
;; lists
(-group-by #'car)
;; Flatten list, to get a list of (backlink-id headline-ids...)
(-map #'(lambda (group)
(cons (car group) (-map #'cdr (cdr group)))))))
;; Replace IDs by headlines and add priority for sorting
(setq output-lines
(->> headlines
(-map #'(lambda (line)
(list (db/org--format-link-from-org-id (cl-first line))
(org-entry-get (org-id-find (cl-first line) 'marker)
"PRIORITY")
(-map #'db/org--format-link-from-org-id (cdr line)))))
(-sort #'(lambda (line-1 line-2)
(string< (cl-second line-1) (cl-second line-2))))))
;; Format output-lines as Org table
(insert (format "| Backlink | Prio | Backlink Target(s) |\n|---|"))
(when output-lines
(dolist (line output-lines)
(insert (format "\n| %s | %s | %s |"
(cl-first line) ; backlink
(cl-second line) ; priority
(apply #'concat (-interpose ", " (cl-third line))) ; backlink targets
)))
(insert "\n|---|"))
(org-table-align)))
(defun db/org-insert-backlink-block ()