denote-lint

a Emacs package to detect broken denote links
git clone https://git.trogloxene.org/denote-lint.git
Log | Files | Refs

denote-lint.el (18081B)

      1 ;;; denote-lint.el --- Check for broken Denote links  -*- lexical-binding: t; -*-
      2 
      3 ;;; Commentary:
      4 
      5 ;; This package provides commands to detect broken Denote links in Org
      6 ;; files under `denote-directory'.
      7 ;;
      8 ;; The supported link shapes are:
      9 ;;
     10 ;;   - Plain file links:
     11 ;;       [[denote:IDENTIFIER][description]]
     12 ;;
     13 ;;   - Links to a heading by its text:
     14 ;;       [[denote:IDENTIFIER::*heading text][description]]
     15 ;;
     16 ;;   - Links to a heading by its CUSTOM_ID:
     17 ;;       [[denote:IDENTIFIER::#h:UUID][description]]
     18 ;;
     19 ;; Links that use any other `::search' option are reported as
     20 ;; "unsupported" because the checker cannot reliably verify them.
     21 ;;
     22 ;; The main entry point is the command `denote-lint'.
     23 ;;
     24 ;; By default the scan runs asynchronously in a sub-process so that Emacs
     25 ;; stays responsive.  Set `denote-lint-async-by-default' to nil to keep
     26 ;; the original synchronous behavior.
     27 
     28 ;;; Code:
     29 
     30 (require 'denote)
     31 (require 'org)
     32 (require 'org-element)
     33 (require 'url-util)
     34 (require 'async)
     35 
     36 (defgroup denote-lint nil
     37   "Check for broken Denote links."
     38   :group 'denote)
     39 
     40 (defcustom denote-lint-report-buffer-name "*Denote Lint*"
     41   "Name of the buffer used to display broken Denote links."
     42   :type 'string
     43   :group 'denote-lint)
     44 
     45 (defcustom denote-lint-grep-buffer-name "*Denote Lint Grep*"
     46   "Name of the buffer used to display grep-style Denote lint results."
     47   :type 'string
     48   :group 'denote-lint)
     49 
     50 (defcustom denote-lint-async-by-default t
     51   "When non-nil, run lint commands asynchronously.
     52 Applies to `denote-lint', `denote-lint-current-buffer',
     53 `denote-lint-grep', and `denote-lint-grep-current-buffer'."
     54   :type 'boolean
     55   :group 'denote-lint)
     56 
     57 (defvar denote-lint--async-process nil
     58   "Process object of the currently running asynchronous lint, if any.")
     59 
     60 (defvar denote-lint--async-org-heading-regexp nil
     61   "Captured `org-complex-heading-regexp' from the parent process.
     62 This is set in async child processes to match the parent's Org
     63 configuration, including custom `org-todo-keywords'.")
     64 
     65 (defun denote-lint--cancel-async ()
     66   "Cancel any running asynchronous lint process."
     67   (when (and denote-lint--async-process
     68              (process-live-p denote-lint--async-process))
     69     (kill-process denote-lint--async-process))
     70   (setq denote-lint--async-process nil))
     71 
     72 (defun denote-lint--capture-org-heading-regexp ()
     73   "Return the current `org-complex-heading-regexp'.
     74 Ensures an Org buffer exists so that the variable is initialized with
     75 any custom `org-todo-keywords' in effect."
     76   (with-temp-buffer
     77     (org-mode)
     78     org-complex-heading-regexp))
     79 
     80 (defun denote-lint--async-setup-org-heading-regexp ()
     81   "Hook to use the captured parent heading regexp in temp Org buffers.
     82 Applied to `org-mode-hook' by the async child process."
     83   (when denote-lint--async-org-heading-regexp
     84     (setq-local org-complex-heading-regexp denote-lint--async-org-heading-regexp)))
     85 
     86 (defcustom denote-lint-file-regexp ".*\\.org"
     87   "Regexp to select source files to scan.
     88 The regexp is matched against file names relative to `denote-directory'.
     89 The default value limits the scan to Org files."
     90   :type 'string
     91   :group 'denote-lint)
     92 
     93 ;;; Link extraction
     94 
     95 (defun denote-lint--query-link-p (target)
     96   "Return non-nil if TARGET is a Denote query link.
     97 Query links have the form `query-contents:...' or
     98 `query-filenames:...' and are intentionally not checked."
     99   (or (string-prefix-p "query-contents:" target)
    100       (string-prefix-p "query-filenames:" target)))
    101 
    102 (defun denote-lint--extract-links (file)
    103   "Extract all denote links from FILE.
    104 Return a list of plists with keys :source-file, :line, :link-text,
    105 :target and :description.  Query links are excluded."
    106   (with-temp-buffer
    107     (insert-file-contents file)
    108     (org-mode)
    109     (let ((case-fold-search nil)
    110           links)
    111       (org-element-map (org-element-parse-buffer) 'link
    112         (lambda (link)
    113           (when (and (eq (org-element-property :format link) 'bracket)
    114                      (string= (org-element-property :type link) "denote"))
    115             (let* ((begin (org-element-property :begin link))
    116                    (link-end (org-element-property :end link))
    117                    (target (org-element-property :path link))
    118                    (description (when-let* ((contents-begin (org-element-property :contents-begin link))
    119                                             (contents-end (org-element-property :contents-end link)))
    120                                   (buffer-substring-no-properties contents-begin contents-end)))
    121                    (link-text (buffer-substring-no-properties begin link-end)))
    122               (unless (denote-lint--query-link-p target)
    123                 (push (list :source-file file
    124                             :line (line-number-at-pos begin)
    125                             :link-text link-text
    126                             :target target
    127                             :description description)
    128                       links))))))
    129       (nreverse links))))
    130 
    131 ;;; Heading verification
    132 
    133 (defun denote-lint--heading-text-exists-p (path heading-text)
    134   "Return non-nil if PATH contains an Org heading equal to HEADING-TEXT."
    135   (with-temp-buffer
    136     (insert-file-contents path)
    137     (org-mode)
    138     (goto-char (point-min))
    139     (catch 'found
    140       (while (re-search-forward org-complex-heading-regexp nil t)
    141         (let ((title (match-string 4)))
    142           (when (and title
    143                      (string= (string-trim-right title) heading-text))
    144             (throw 'found t))))
    145       nil)))
    146 
    147 (defun denote-lint--custom-id-exists-p (path custom-id)
    148   "Return non-nil if PATH contains an Org entry with CUSTOM_ID equal to CUSTOM-ID."
    149   (with-temp-buffer
    150     (insert-file-contents path)
    151     (org-mode)
    152     (goto-char (point-min))
    153     (not (null (org-find-property "CUSTOM_ID" custom-id)))))
    154 
    155 (defun denote-lint--heading-link-valid-p (path search)
    156   "Return non-nil if PATH contains the object specified by SEARCH.
    157 SEARCH is the part after `::' in a denote link.  It can be:
    158 
    159   - `*heading text'   -> look for an Org heading with that text
    160   - `#h:UUID'         -> look for an Org CUSTOM_ID property
    161   - anything else     -> signal that the search is unsupported"
    162   (cond
    163    ((string-prefix-p "*" search)
    164     (denote-lint--heading-text-exists-p path (substring search 1)))
    165    ((string-prefix-p "#" search)
    166     (denote-lint--custom-id-exists-p path (substring search 1)))
    167    (t 'unsupported)))
    168 
    169 ;;; Link validation
    170 
    171 (defun denote-lint--check-link (link)
    172   "Check LINK and return it with an added :reason if it is broken.
    173 LINK is a plist as produced by `denote-lint--extract-links'.  Return
    174 nil when the link is fine."
    175   (let* ((target (plist-get link :target))
    176          (resolved (denote-link--ol-resolve-link-to-target target t))
    177          (path (nth 0 resolved))
    178          (query (nth 1 resolved))
    179          (file-search (nth 2 resolved)))
    180     (cond
    181      ((null path)
    182       (plist-put (copy-sequence link) :reason
    183                  (list 'missing-file query)))
    184      ((and file-search (not (string-empty-p file-search)))
    185       (let ((valid-p (denote-lint--heading-link-valid-p path file-search)))
    186         (cond
    187          ((eq valid-p 'unsupported)
    188           (plist-put (copy-sequence link) :reason
    189                      (list 'unsupported-search file-search)))
    190          ((null valid-p)
    191           (plist-put (copy-sequence link) :reason
    192                      (list 'missing-heading file-search)))
    193          (t nil))))
    194      (t nil))))
    195 
    196 (defun denote-lint--collect-broken-links (files)
    197   "Scan FILES and return a list of broken denote links."
    198   (let (broken)
    199     (dolist (file files (nreverse broken))
    200       (dolist (link (denote-lint--extract-links file))
    201         (when-let* ((broken-link (denote-lint--check-link link)))
    202           (push broken-link broken))))))
    203 
    204 (defun denote-lint--reason-category (link)
    205   "Return the reason category of a broken LINK.
    206 Possible values are `missing-file', `missing-heading' and
    207 `unsupported-search'."
    208   (car (plist-get link :reason)))
    209 
    210 (defun denote-lint--reason-detail (link)
    211   "Return the human-readable detail of a broken LINK's reason."
    212   (cadr (plist-get link :reason)))
    213 
    214 (defun denote-lint--link-display-target (link)
    215   "Return a short string describing the target of LINK."
    216   (let ((target (plist-get link :target)))
    217     (or target (plist-get link :link-text))))
    218 
    219 ;;; Report buffer
    220 
    221 (defun denote-lint--source-file-title (file)
    222   "Return a title string for FILE.
    223 If the file has a Denote title, use it; otherwise use the file name."
    224   (condition-case nil
    225       (let ((file-type (denote-filetype-heuristics file)))
    226         (or (denote-retrieve-front-matter-title-value file file-type)
    227             (file-name-nondirectory file)))
    228     (error (file-name-nondirectory file))))
    229 
    230 (defun denote-lint--insert-report-table (links)
    231   "Insert an Org table describing broken LINKS."
    232   (insert "\n|-\n| Source | Line | Target | Reason |\n|-\n")
    233   (dolist (link links)
    234     (let* ((source-file (plist-get link :source-file))
    235            (source-id (denote-retrieve-filename-identifier source-file))
    236            (line (plist-get link :line))
    237            (target (denote-lint--link-display-target link))
    238            (link-text (or (plist-get link :link-text) target))
    239            (encoded-link-text (url-hexify-string link-text))
    240            (reason (pcase (denote-lint--reason-category link)
    241                      ('missing-file "missing file")
    242                      ('missing-heading "missing heading")
    243                      ('unsupported-search "unsupported search")
    244                      (_ "unknown")))
    245            (detail (denote-lint--reason-detail link))
    246            (title (denote-lint--source-file-title source-file)))
    247       (insert "|[[elisp:(denote-lint--jump-to-link \""
    248               source-id "\" " (number-to-string line) " \""
    249               encoded-link-text
    250               "\")][" title "]]"
    251               "|" (number-to-string line)
    252               "|" target
    253               "|" reason
    254               (if detail
    255                   (concat " (" detail ")")
    256                 "")
    257               "|\n")))
    258   (insert "|-\n")
    259   (org-table-align))
    260 
    261 (defun denote-lint--display-report (broken-links)
    262   "Display BROKEN-LINKS in `denote-lint-report-buffer-name'."
    263   (let ((buffer (get-buffer-create denote-lint-report-buffer-name)))
    264     (with-current-buffer buffer
    265       (denote-lint--insert-report broken-links)
    266       (goto-char (point-min)))
    267     (display-buffer buffer)
    268     (message "Denote lint complete: %s issue%s found"
    269              (length broken-links)
    270              (if (= 1 (length broken-links)) "" "s"))))
    271 
    272 (defun denote-lint--collect-broken-links-async (files callback)
    273   "Scan FILES asynchronously and call CALLBACK with broken links.
    274 Any previously running asynchronous lint is cancelled first."
    275   (denote-lint--cancel-async)
    276   (message "Scanning Denote files asynchronously...")
    277   (let ((captured-heading-regexp (denote-lint--capture-org-heading-regexp)))
    278     (setq denote-lint--async-process
    279           (async-start
    280            `(lambda ()
    281               (condition-case err
    282                   (progn
    283                     (setq load-path ',load-path)
    284                     ,(async-inject-variables "\\`denote-.*\\'")
    285                     ,(async-inject-variables "\\`denote-lint-.*\\'")
    286                     (require 'denote-lint)
    287                     (setq denote-lint--async-org-heading-regexp ',captured-heading-regexp)
    288                     (add-hook 'org-mode-hook #'denote-lint--async-setup-org-heading-regexp)
    289                     (denote-lint--collect-broken-links ',files))
    290                 (error (list 'denote-lint-async-error (error-message-string err)))))
    291            (lambda (result)
    292              (setq denote-lint--async-process nil)
    293              (if (and (listp result) (eq 'denote-lint-async-error (car result)))
    294                  (message "Denote lint async error: %s" (cadr result))
    295                (funcall callback result)))))))
    296 
    297 (defun denote-lint--insert-report (broken-links)
    298   "Insert an Org report describing BROKEN-LINKS."
    299   (erase-buffer)
    300   (org-mode)
    301   (insert "#+title: Denote Link Lint Report\n"
    302           "#+date: ")
    303   (org-insert-time-stamp (current-time) t t)
    304   (insert "\n\n")
    305   (if (null broken-links)
    306       (insert "No broken Denote links found.\n")
    307     (insert "Found " (number-to-string (length broken-links))
    308             " broken or unverifiable Denote link"
    309             (if (= 1 (length broken-links)) "" "s")
    310             ".\n\n"
    311             "Click the Source link to jump to the dead link.\n\n")
    312     (let ((missing-file (seq-filter
    313                          (lambda (l) (eq 'missing-file (denote-lint--reason-category l)))
    314                          broken-links))
    315           (missing-heading (seq-filter
    316                             (lambda (l) (eq 'missing-heading (denote-lint--reason-category l)))
    317                             broken-links))
    318           (unsupported (seq-filter
    319                         (lambda (l) (eq 'unsupported-search (denote-lint--reason-category l)))
    320                         broken-links)))
    321       (when missing-file
    322         (insert "* Missing files\n")
    323         (denote-lint--insert-report-table missing-file))
    324       (when missing-heading
    325         (insert "* Missing headings\n")
    326         (denote-lint--insert-report-table missing-heading))
    327       (when unsupported
    328         (insert "* Unsupported heading searches\n")
    329         (insert "These links use a search option that this checker cannot verify.\n")
    330         (denote-lint--insert-report-table unsupported)))))
    331 
    332 (defun denote-lint--jump-to-link (source-id line link-text)
    333   "Open the file identified by SOURCE-ID and jump to the link.
    334 LINE is the expected line number.  LINK-TEXT is the encoded raw
    335 link text as it appears in the source file, which is decoded before
    336 searching."
    337   (interactive)
    338   (setq link-text (url-unhex-string link-text))
    339   (let* ((file (denote-get-path-by-id source-id))
    340          (buffer (find-file-noselect file)))
    341     (pop-to-buffer buffer)
    342     (widen)
    343     (goto-char (point-min))
    344     (forward-line (1- line))
    345     (when org-link-descriptive
    346       (org-toggle-link-display))
    347     (let ((case-fold-search nil))
    348       (if (or (search-forward link-text nil t)
    349               (progn
    350                 (goto-char (point-min))
    351                 (forward-line (1- line))
    352                 (search-forward (regexp-quote link-text) nil t)))
    353           (message "Link found")
    354         (message "Could not locate link to %s" link-text)))))
    355 
    356 ;;; Grep report buffer
    357 
    358 (defun denote-lint--format-grep-line (link)
    359   "Return a grep-style line for a broken LINK."
    360   (let* ((source-file (plist-get link :source-file))
    361          (line (plist-get link :line))
    362          (target (denote-lint--link-display-target link))
    363          (reason (pcase (denote-lint--reason-category link)
    364                    ('missing-file "missing file")
    365                    ('missing-heading "missing heading")
    366                    ('unsupported-search "unsupported search")
    367                    (_ "unknown"))))
    368     (format "%s:%s: %s - %s"
    369             (expand-file-name source-file)
    370             line
    371             reason
    372             target)))
    373 
    374 (defun denote-lint--display-grep-report (broken-links)
    375   "Display BROKEN-LINKS in `denote-lint-grep-buffer-name'."
    376   (let ((buffer (get-buffer-create denote-lint-grep-buffer-name)))
    377     (with-current-buffer buffer
    378       (let ((inhibit-read-only t))
    379         (erase-buffer)
    380         (if (null broken-links)
    381             (insert "No broken Denote links found.\n")
    382           (dolist (link broken-links)
    383             (insert (denote-lint--format-grep-line link) "\n"))))
    384       (grep-mode)
    385       (goto-char (point-min)))
    386     (display-buffer buffer)
    387     (message "Denote lint grep complete: %s issue%s found"
    388              (length broken-links)
    389              (if (= 1 (length broken-links)) "" "s"))))
    390 
    391 (defun denote-lint--run (files display-fn progress-message)
    392   "Check FILES for broken Denote links and pass them to DISPLAY-FN.
    393 When `denote-lint-async-by-default' is non-nil, run asynchronously
    394 and ignore PROGRESS-MESSAGE; otherwise print PROGRESS-MESSAGE and
    395 run synchronously."
    396   (if denote-lint-async-by-default
    397       (denote-lint--collect-broken-links-async files display-fn)
    398     (message progress-message)
    399     (funcall display-fn (denote-lint--collect-broken-links files))))
    400 
    401 ;;;###autoload
    402 (defun denote-lint-current-buffer ()
    403   "Check the current Denote buffer for broken links and show a report.
    404 When `denote-lint-async-by-default' is non-nil, run asynchronously."
    405   (interactive)
    406   (unless (and buffer-file-name
    407                (denote-file-has-denoted-filename-p buffer-file-name))
    408     (user-error "Current file is not a Denote note"))
    409   (denote-lint--run (list buffer-file-name)
    410                     #'denote-lint--display-report
    411                     "Scanning current buffer for broken Denote links..."))
    412 
    413 ;;;###autoload
    414 (defun denote-lint ()
    415   "Check all Org Denote files for broken links and show a report.
    416 When `denote-lint-async-by-default' is non-nil, run asynchronously."
    417   (interactive)
    418   (denote-lint--run (denote-directory-files denote-lint-file-regexp nil t)
    419                     #'denote-lint--display-report
    420                     "Scanning Denote files for broken links..."))
    421 
    422 ;;;###autoload
    423 (defun denote-lint-grep-current-buffer ()
    424   "Check the current Denote buffer for broken links and show results in a grep buffer.
    425 When `denote-lint-async-by-default' is non-nil, run asynchronously."
    426   (interactive)
    427   (unless (and buffer-file-name
    428                (denote-file-has-denoted-filename-p buffer-file-name))
    429     (user-error "Current file is not a Denote note"))
    430   (denote-lint--run (list buffer-file-name)
    431                     #'denote-lint--display-grep-report
    432                     "Scanning current buffer for broken Denote links..."))
    433 
    434 ;;;###autoload
    435 (defun denote-lint-grep ()
    436   "Check all Org Denote files for broken links and show results in a grep buffer.
    437 When `denote-lint-async-by-default' is non-nil, run asynchronously."
    438   (interactive)
    439   (denote-lint--run (denote-directory-files denote-lint-file-regexp nil t)
    440                     #'denote-lint--display-grep-report
    441                     "Scanning Denote files for broken links..."))
    442 
    443 (provide 'denote-lint)
    444 ;;; denote-lint.el ends here