denote-org-extras.el (22748B)
1 ;;; denote-org-extras.el --- Denote extensions for Org mode -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2024 Free Software Foundation, Inc. 4 5 ;; Author: Protesilaos Stavrou <info@protesilaos.com> 6 ;; Maintainer: Protesilaos Stavrou <info@protesilaos.com> 7 ;; URL: https://github.com/protesilaos/denote 8 9 ;; This file is NOT part of GNU Emacs. 10 11 ;; This program is free software; you can redistribute it and/or modify 12 ;; it under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation, either version 3 of the License, or 14 ;; (at your option) any later version. 15 ;; 16 ;; This program is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; GNU General Public License for more details. 20 ;; 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 23 24 ;;; Commentary: 25 ;; 26 ;; WORK-IN-PROGRESS 27 28 ;;; Code: 29 30 (require 'denote) 31 (require 'denote-sort) 32 (require 'org) 33 34 ;;;; Link to file and heading 35 36 (defun denote-org-extras--get-outline (file) 37 "Return `outline-regexp' headings and line numbers of FILE." 38 (with-current-buffer (find-file-noselect file) 39 (let ((outline-regexp (format "^\\(?:%s\\)" (or (bound-and-true-p outline-regexp) "[*\^L]+"))) 40 candidates) 41 (save-excursion 42 (goto-char (point-min)) 43 (while (if (bound-and-true-p outline-search-function) 44 (funcall outline-search-function) 45 (re-search-forward outline-regexp nil t)) 46 (push 47 ;; NOTE 2024-01-20: The -5 (minimum width) is a 48 ;; sufficiently high number to keep the alignment 49 ;; consistent in most cases. Larger files will simply 50 ;; shift the heading text in minibuffer, but this is not an 51 ;; issue anymore. 52 (format "%-5s %s" 53 (line-number-at-pos (point)) 54 (buffer-substring-no-properties (line-beginning-position) (line-end-position))) 55 candidates) 56 (goto-char (1+ (line-end-position))))) 57 (if candidates 58 (nreverse candidates) 59 (user-error "No outline"))))) 60 61 (defun denote-org-extras--outline-prompt (&optional file) 62 "Prompt for outline among headings retrieved by `denote-org-extras--get-outline'. 63 With optional FILE use the outline of it, otherwise use that of 64 the current file." 65 (completing-read 66 (format "Select heading inside `%s': " 67 (propertize (file-name-nondirectory file) 'face 'denote-faces-prompt-current-name)) 68 (denote--completion-table-no-sort 'imenu (denote-org-extras--get-outline (or file buffer-file-name))) 69 nil :require-match)) 70 71 (defun denote-org-extras--get-heading-and-id-from-line (line file) 72 "Return heading text and CUSTOM_ID from the given LINE in FILE." 73 (with-current-buffer (find-file-noselect file) 74 (save-excursion 75 (goto-char (point-min)) 76 (forward-line line) 77 (cons (denote-link-ol-get-heading) (denote-link-ol-get-id))))) 78 79 (defun denote-org-extras-format-link-with-heading (file heading-id description) 80 "Prepare link to FILE with HEADING-ID using DESCRIPTION." 81 (format "[[denote:%s::#%s][%s]]" 82 (denote-retrieve-filename-identifier file) 83 heading-id 84 description)) 85 86 ;;;###autoload 87 (defun denote-org-extras-link-to-heading () 88 "Link to file and then specify a heading to extend the link to. 89 90 The resulting link has the following pattern: 91 92 [[denote:IDENTIFIER::#ORG-HEADING-CUSTOM-ID]][Description::Heading text]]. 93 94 Because only Org files can have links to individual headings, 95 limit the list of possible files to those which include the .org 96 file extension (remember that Denote works with many file types, 97 per the user option `denote-file-type'). 98 99 The user option `denote-org-extras-store-link-to-heading' 100 determined whether the `org-store-link' function can save a link 101 to the current heading. Such links look the same as those of 102 this command, though the functionality defined herein is 103 independent of it. 104 105 To only link to a file, use the `denote-link' command." 106 (declare (interactive-only t)) 107 (interactive nil org-mode) 108 (unless (derived-mode-p 'org-mode) 109 (user-error "Links to headings only work between Org files")) 110 (when-let ((file (denote-file-prompt ".*\\.org")) 111 (file-text (denote--link-get-description file)) 112 (heading (denote-org-extras--outline-prompt file)) 113 (line (string-to-number (car (split-string heading "\t")))) 114 (heading-data (denote-org-extras--get-heading-and-id-from-line line file)) 115 (heading-text (car heading-data)) 116 (heading-id (cdr heading-data)) 117 (description (denote-link-format-heading-description file-text heading-text))) 118 (insert (denote-org-extras-format-link-with-heading file heading-id description)))) 119 120 ;;;; Extract subtree into its own note 121 122 (defun denote-org-extras--get-heading-date () 123 "Try to return a timestamp for the current Org heading. 124 This can be used as the value for the DATE argument of the 125 `denote' command." 126 (when-let ((pos (point)) 127 (timestamp (or (org-entry-get pos "DATE") 128 (org-entry-get pos "CREATED") 129 (org-entry-get pos "CLOSED")))) 130 (date-to-time timestamp))) 131 132 ;;;###autoload 133 (defun denote-org-extras-extract-org-subtree () 134 "Create new Denote note using the current Org subtree as input. 135 Remove the subtree from its current file and move its contents 136 into a new Denote file (a subtree is a heading with all of its 137 contents, including subheadings). 138 139 Take the text of the subtree's top level heading and use it as 140 the title of the new note. 141 142 If the heading has any tags, use them as the keywords of the new 143 note. If the Org file has any #+filetags use them as well (Org's 144 filetags are inherited by the headings). If none of these are 145 true and the user option `denote-prompts' includes an entry for 146 keywords, then prompt for keywords. Else do not include any 147 keywords. 148 149 If the heading has a PROPERTIES drawer, retain it for further 150 review. 151 152 If the heading's PROPERTIES drawer includes a DATE or CREATED 153 property, or there exists a CLOSED statement with a timestamp 154 value, use that to derive the date (or date and time) of the new 155 note (if there is only a date, the time is taken as 00:00). If 156 more than one of these is present, the order of preference is 157 DATE, then CREATED, then CLOSED. If none of these is present, 158 use the current time. If the `denote-prompts' includes an entry 159 for a date, then prompt for a date at this stage (also see 160 `denote-date-prompt-use-org-read-date'). 161 162 For the rest, consult the value of the user option 163 `denote-prompts' in the following scenaria: 164 165 - Optionally prompt for a subdirectory, otherwise produce the new 166 note in the variable `denote-directory'. 167 168 - Optionally prompt for a file signature, otherwise do not use 169 one. 170 171 Make the new note an Org file regardless of the value of 172 `denote-file-type'." 173 (interactive nil org-mode) 174 (unless (derived-mode-p 'org-mode) 175 (user-error "Headings can only be extracted from Org files")) 176 (if-let ((text (org-get-entry)) 177 (heading (denote-link-ol-get-heading))) 178 (let ((tags (org-get-tags)) 179 (date (denote-org-extras--get-heading-date)) 180 subdirectory 181 signature) 182 (dolist (prompt denote-prompts) 183 (pcase prompt 184 ('keywords (when (not tags) 185 (setq tags (denote-keywords-prompt)))) 186 ('subdirectory (setq subdirectory (denote-subdirectory-prompt))) 187 ('date (when (not date) (setq date (denote-date-prompt)))) 188 ('signature (setq signature (denote-signature-prompt))))) 189 (delete-region (org-entry-beginning-position) 190 (save-excursion (org-end-of-subtree t) (point))) 191 (denote heading tags 'org subdirectory date nil signature) 192 (insert text)) 193 (user-error "No subtree to extract; aborting"))) 194 195 ;;;; Convert links from `:denote' to `:file' and vice versa 196 197 ;; TODO 2024-02-28: Do we need to convert between other link types? I 198 ;; think not, since the `denote:' type is modelled after the `file:' 199 ;; one. 200 (defun denote-org-extras--get-link-type-regexp (type) 201 "Return regexp for Org link TYPE. 202 TYPE is a symbol of either `file' or `denote'. 203 204 The regexp consists of four groups. Group 1 is the link type, 2 205 is the target, 3 is the target's search terms, and 4 is the 206 description." 207 (let ((group-1)) 208 (pcase type 209 ('denote (setq group-1 "denote")) 210 ('file (setq group-1 "file")) 211 (_ (error "`%s' is an unknown link type" type))) 212 (format "\\[\\[\\(?1:%s:\\)\\(?:\\(?2:.*?\\)\\(?3:::.*\\)?\\]\\|\\]\\)\\(?4:\\[\\(?:.*?\\)\\]\\)?\\]" group-1))) 213 214 ;;;###autoload 215 (defun denote-org-extras-convert-links-to-file-type () 216 "Convert denote: links to file: links in the current Org buffer. 217 Ignore all other link types. Also ignore links that do not 218 resolve to a file in the variable `denote-directory'." 219 (interactive nil org-mode) 220 (if (derived-mode-p 'org-mode) 221 (progn 222 (goto-char (point-min)) 223 (while (re-search-forward (denote-org-extras--get-link-type-regexp 'denote) nil :no-error) 224 (let* ((id (match-string-no-properties 2)) 225 (search (or (match-string-no-properties 3) "")) 226 (desc (or (match-string-no-properties 4) "")) 227 (file (save-match-data (denote-get-path-by-id id)))) 228 (when id 229 (let ((new-text (if desc 230 (format "[[file:%s%s]%s]" file search desc) 231 (format "[[file:%s%s]]" file search)))) 232 (replace-match new-text :fixed-case :literal))))) 233 ;; TODO 2024-02-28: notify how many changed. 234 (message "Converted `denote:' links to `file:' links")) 235 (user-error "The current file is not using Org mode"))) 236 237 ;;;###autoload 238 (defun denote-org-extras-convert-links-to-denote-type () 239 "Convert file: links to denote: links in the current Org buffer. 240 Ignore all other link types. Also ignore file: links that do not 241 point to a file with a Denote file name." 242 (interactive nil org-mode) 243 (if (derived-mode-p 'org-mode) 244 (progn 245 (goto-char (point-min)) 246 (while (re-search-forward (denote-org-extras--get-link-type-regexp 'file) nil :no-error) 247 (let* ((file (match-string-no-properties 2)) 248 (search (or (match-string-no-properties 3) "")) 249 (desc (or (match-string-no-properties 4) "")) 250 (id (save-match-data (denote-retrieve-filename-identifier file)))) 251 (when id 252 (let ((new-text (if desc 253 (format "[[denote:%s%s]%s]" id search desc) 254 (format "[[denote:%s%s]]" id search)))) 255 (replace-match new-text :fixed-case :literal))))) 256 ;; TODO 2024-02-28: notify how many changed. 257 (message "Converted as `file:' links to `denote:' links")) 258 (user-error "The current file is not using Org mode"))) 259 260 ;;;; Org dynamic blocks 261 262 ;; NOTE 2024-01-22 12:26:13 +0200: The following is copied from the 263 ;; now-deleted denote-org-dblock.el. Its original author was Elias 264 ;; Storms <elias.storms@gmail.com>, with substantial contributions and 265 ;; further developments by me (Protesilaos). 266 267 ;; This section defines Org dynamic blocks using the facility described 268 ;; in the Org manual. Evaluate this: 269 ;; 270 ;; (info "(org) Dynamic Blocks") 271 ;; 272 ;; The dynamic blocks defined herein are documented at length in the 273 ;; Denote manual. See the following node and its subsections: 274 ;; 275 ;; (info "(denote) Use Org dynamic blocks") 276 277 ;;;;; Common helper functions 278 279 (defun denote-org-extras-dblock--files (files-matching-regexp &optional sort-by-component reverse) 280 "Return list of FILES-MATCHING-REGEXP in variable `denote-directory'. 281 SORT-BY-COMPONENT and REVERSE have the same meaning as 282 `denote-sort-files'. If both are nil, do not try to perform any 283 sorting. 284 285 Also see `denote-org-extras-dblock--files-missing-only'." 286 (cond 287 ((and sort-by-component reverse) 288 (denote-sort-get-directory-files files-matching-regexp sort-by-component reverse :omit-current)) 289 (sort-by-component 290 (denote-sort-get-directory-files files-matching-regexp sort-by-component nil :omit-current)) 291 (reverse 292 (denote-sort-get-directory-files files-matching-regexp :no-component-specified reverse :omit-current)) 293 (t 294 (denote-directory-files files-matching-regexp :omit-current)))) 295 296 (defun denote-org-extras-dblock--get-missing-links (regexp) 297 "Return list of missing links to all notes matching REGEXP. 298 Missing links are those for which REGEXP does not have a match in 299 the current buffer." 300 (let ((found-files (denote-directory-files regexp :omit-current)) 301 (linked-files (denote-link--expand-identifiers denote-org-link-in-context-regexp))) 302 (if-let ((final-files (seq-difference found-files linked-files))) 303 final-files 304 (message "All links matching `%s' are present" regexp) 305 '()))) 306 307 (defun denote-org-extras-dblock--files-missing-only (files-matching-regexp &optional sort-by-component reverse) 308 "Return list of missing links to FILES-MATCHING-REGEXP. 309 SORT-BY-COMPONENT and REVERSE have the same meaning as 310 `denote-sort-files'. If both are nil, do not try to perform any 311 sorting. 312 313 Also see `denote-org-extras-dblock--files'." 314 (denote-sort-files 315 (denote-org-extras-dblock--get-missing-links files-matching-regexp) 316 sort-by-component 317 reverse)) 318 319 ;;;;; Dynamic block to insert links 320 321 ;;;###autoload 322 (defun denote-org-extras-dblock-insert-links (regexp) 323 "Create Org dynamic block to insert Denote links matching REGEXP." 324 (interactive 325 (list 326 (denote-files-matching-regexp-prompt)) 327 org-mode) 328 (org-create-dblock (list :name "denote-links" 329 :regexp regexp 330 :sort-by-component nil 331 :reverse-sort nil 332 :id-only nil)) 333 (org-update-dblock)) 334 335 (org-dynamic-block-define "denote-links" 'denote-org-extras-dblock-insert-links) 336 337 (defun org-dblock-write:denote-links (params) 338 "Function to update `denote-links' Org Dynamic blocks. 339 Used by `org-dblock-update' with PARAMS provided by the dynamic block." 340 (let* ((regexp (plist-get params :regexp)) 341 (rx (if (listp regexp) (macroexpand `(rx ,regexp)) regexp)) 342 (sort (plist-get params :sort-by-component)) 343 (reverse (plist-get params :reverse-sort)) 344 (block-name (plist-get params :block-name)) 345 (files (denote-org-extras-dblock--files rx sort reverse))) 346 (when block-name (insert "#+name: " block-name "\n")) 347 (denote-link--insert-links files 'org (plist-get params :id-only) :no-other-sorting) 348 (join-line))) ; remove trailing empty line 349 350 ;;;;; Dynamic block to insert missing links 351 352 ;;;###autoload 353 (defun denote-org-extras-dblock-insert-missing-links (regexp) 354 "Create Org dynamic block to insert Denote links matching REGEXP." 355 (interactive 356 (list 357 (denote-files-matching-regexp-prompt)) 358 org-mode) 359 (org-create-dblock (list :name "denote-missing-links" 360 :regexp regexp 361 :sort-by-component nil 362 :reverse-sort nil 363 :id-only nil)) 364 (org-update-dblock)) 365 366 (org-dynamic-block-define "denote-missing-links" 'denote-org-extras-dblock-insert-links) 367 368 (defun org-dblock-write:denote-missing-links (params) 369 "Function to update `denote-links' Org Dynamic blocks. 370 Used by `org-dblock-update' with PARAMS provided by the dynamic block." 371 (let* ((regexp (plist-get params :regexp)) 372 (rx (if (listp regexp) (macroexpand `(rx ,regexp)) regexp)) 373 (sort (plist-get params :sort-by-component)) 374 (reverse (plist-get params :reverse-sort)) 375 (block-name (plist-get params :block-name)) 376 (files (denote-org-extras-dblock--files-missing-only rx sort reverse))) 377 (when block-name (insert "#+name: " block-name "\n")) 378 (denote-link--insert-links files 'org (plist-get params :id-only) :no-other-sorting) 379 (join-line))) ; remove trailing empty line 380 381 ;;;;; Dynamic block to insert backlinks 382 383 (defun denote-org-extras-dblock--maybe-sort-backlinks (files sort-by-component reverse) 384 "Sort backlink FILES if SORT-BY-COMPONENT and/or REVERSE is non-nil." 385 (cond 386 ((and sort-by-component reverse) 387 (denote-sort-files files sort-by-component reverse)) 388 (sort-by-component 389 (denote-sort-files files sort-by-component)) 390 (reverse 391 (denote-sort-files files :no-component-specified reverse)) 392 (t 393 files))) 394 395 ;;;###autoload 396 (defun denote-org-extras-dblock-insert-backlinks () 397 "Create Org dynamic block to insert Denote backlinks to current file." 398 (interactive nil org-mode) 399 (org-create-dblock (list :name "denote-backlinks" 400 :sort-by-component nil 401 :reverse-sort nil 402 :id-only nil)) 403 (org-update-dblock)) 404 405 (org-dynamic-block-define "denote-backlinks" 'denote-org-extras-dblock-insert-backlinks) 406 407 (defun org-dblock-write:denote-backlinks (params) 408 "Function to update `denote-backlinks' Org Dynamic blocks. 409 Used by `org-dblock-update' with PARAMS provided by the dynamic block." 410 (when-let ((files (denote-link-return-backlinks))) 411 (let* ((sort (plist-get params :sort-by-component)) 412 (reverse (plist-get params :reverse-sort)) 413 (files (denote-org-extras-dblock--maybe-sort-backlinks files sort reverse))) 414 (denote-link--insert-links files 'org (plist-get params :id-only) :no-other-sorting) 415 (join-line)))) ; remove trailing empty line 416 417 ;;;;; Dynamic block to insert entire file contents 418 419 (defun denote-org-extras-dblock--get-file-contents (file &optional no-front-matter add-links) 420 "Insert the contents of FILE. 421 With optional NO-FRONT-MATTER as non-nil, try to remove the front 422 matter from the top of the file. If NO-FRONT-MATTER is a number, 423 remove that many lines starting from the top. If it is any other 424 non-nil value, delete from the top until the first blank line. 425 426 With optional ADD-LINKS as non-nil, first insert a link to the 427 file and then insert its contents. In this case, format the 428 contents as a typographic list. If ADD-LINKS is `id-only', then 429 insert links as `denote-link' does when supplied with an ID-ONLY 430 argument." 431 (when (denote-file-is-note-p file) 432 (with-temp-buffer 433 (when add-links 434 (insert 435 (format "- %s\n\n" 436 (denote-format-link 437 file 438 (denote--link-get-description file) 439 'org 440 (eq add-links 'id-only))))) 441 (let ((beginning-of-contents (point))) 442 (insert-file-contents file) 443 (when no-front-matter 444 (delete-region 445 (if (natnump no-front-matter) 446 (progn (forward-line no-front-matter) (line-beginning-position)) 447 (1+ (re-search-forward "^$" nil :no-error 1))) 448 beginning-of-contents)) 449 (when add-links 450 (indent-region beginning-of-contents (point-max) 2))) 451 (buffer-string)))) 452 453 (defvar denote-org-extras-dblock-file-contents-separator 454 (concat "\n\n" (make-string 50 ?-) "\n\n\n") 455 "Fallback separator used by `denote-org-extras-dblock-add-files'.") 456 457 (defun denote-org-extras-dblock--separator (separator) 458 "Return appropriate value of SEPARATOR for `denote-org-extras-dblock-add-files'." 459 (cond 460 ((null separator) "") 461 ((stringp separator) separator) 462 (t denote-org-extras-dblock-file-contents-separator))) 463 464 (defun denote-org-extras-dblock-add-files (regexp &optional separator no-front-matter add-links sort-by-component reverse) 465 "Insert files matching REGEXP. 466 467 Seaprate them with the optional SEPARATOR. If SEPARATOR is nil, 468 use the `denote-org-extras-dblock-file-contents-separator'. 469 470 If optional NO-FRONT-MATTER is non-nil try to remove the front 471 matter from the top of the file. Do it by finding the first 472 blank line, starting from the top of the buffer. 473 474 If optional ADD-LINKS is non-nil, first insert a link to the file 475 and then insert its contents. In this case, format the contents 476 as a typographic list. 477 478 If optional SORT-BY-COMPONENT is a symbol among `denote-sort-components', 479 sort files matching REGEXP by the corresponding Denote file name 480 component. If the symbol is not among `denote-sort-components', 481 fall back to the default identifier-based sorting. 482 483 If optional REVERSE is non-nil reverse the sort order." 484 (let* ((files (denote-org-extras-dblock--files regexp sort-by-component reverse)) 485 (files-contents (mapcar 486 (lambda (file) (denote-org-extras-dblock--get-file-contents file no-front-matter add-links)) 487 files))) 488 (insert (string-join files-contents (denote-org-extras-dblock--separator separator))))) 489 490 ;;;###autoload 491 (defun denote-org-extras-dblock-insert-files (regexp sort-by-component) 492 "Create Org dynamic block to insert Denote files matching REGEXP. 493 Sort the files according to SORT-BY-COMPONENT, which is a symbol 494 among `denote-sort-components'." 495 (interactive 496 (list 497 (denote-files-matching-regexp-prompt) 498 (denote-sort-component-prompt)) 499 org-mode) 500 (org-create-dblock (list :name "denote-files" 501 :regexp regexp 502 :sort-by-component sort-by-component 503 :reverse-sort nil 504 :no-front-matter nil 505 :file-separator nil 506 :add-links nil)) 507 (org-update-dblock)) 508 509 (org-dynamic-block-define "denote-files" 'denote-org-extras-dblock-insert-files) 510 511 (defun org-dblock-write:denote-files (params) 512 "Function to update `denote-files' Org Dynamic blocks. 513 Used by `org-dblock-update' with PARAMS provided by the dynamic block." 514 (let* ((regexp (plist-get params :regexp)) 515 (rx (if (listp regexp) (macroexpand `(rx ,regexp)) regexp)) 516 (sort (plist-get params :sort-by-component)) 517 (reverse (plist-get params :reverse-sort)) 518 (block-name (plist-get params :block-name)) 519 (separator (plist-get params :file-separator)) 520 (no-f-m (plist-get params :no-front-matter)) 521 (add-links (plist-get params :add-links))) 522 (when block-name (insert "#+name: " block-name "\n")) 523 (when rx (denote-org-extras-dblock-add-files rx separator no-f-m add-links sort reverse))) 524 (join-line)) ; remove trailing empty line 525 526 527 (provide 'denote-org-extras) 528 ;;; denote-org-extras.el ends here