awesome-emacs/org-roam
1
0
Fork 0
mirror of https://github.com/org-roam/org-roam synced 2025-08-01 12:17:21 -05:00
Code Issues Packages Projects Releases Wiki Activity

(feat): add org-roam-doctor (#570)

Browse Source 
`org-roam-doctor` provides a diagnostic tool for checking an Org-roam
file for things that are broken. Currently implemented is a check for
broken links, and methods to fix them. The checker is designed to be
extensible.
This commit is contained in:
Jethro Kuan
2020-05-10 13:57:18 +08:00
committed by GitHub
parent c70f2d5f54
commit d68d1f8ebb
4 changed files with 268 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
CHANGELOG.md
View File

@ -18,6 +18,7 @@
* [#538](https://github.com/org-roam/org-roam/pull/538) Optionally use text in first headline as title
* [#553](https://github.com/org-roam/org-roam/pull/553) Add prefix argument to `org-roam-db-build-cache` for forcing rebuilds
* [#560](https://github.com/org-roam/org-roam/pull/560) Apply 'error face to distinguish broken links
* [#570](https://github.com/org-roam/org-roam/pull/570) Add `org-roam-doctor` to diagnose org-roam files
## 1.1.0 (21-04-2020)

32
doc/org-roam.org
View File

@ -663,6 +663,38 @@ where =template= is the template key for a template in
=org-roam-capture-ref-templates= (see [[*The Templating System][The Templating System]]). These templates
should contain a =#+ROAM_KEY: ${ref}= in it.
* Diagnosing and Repairing Files
Org-roam provides a utility for diagnosing and repairing problematic files via
=org-roam-doctor=. By default, =org-roam-doctor= runs the check across all Org-roam
files, and this can take some time. To run the check only for the current file,
run =C-u M-x org-roam-doctor=.
- Function: org-roam-doctor &optional this-buffer
Perform a check on Org-roam files to ensure cleanliness. If THIS-BUFFER, run
the check only for the current buffer.
The checks run are defined in =org-roam-doctor--checkers=. Each checker is an instance of =org-roam-doctor-checker=. To define a checker, use =make-org-roam-doctor-checker=. Here is a sample definition:
#+BEGIN_SRC emacs-lisp
(make-org-roam-doctor-checker
:name 'org-roam-doctor-broken-links
:description "Fix broken links."
:actions '(("d" . ("Unlink" . org-roam-doctor--remove-link))
("r" . ("Replace link" . org-roam-doctor--replace-link))
("R" . ("Replace link (keep label)" . org-roam-doctor--replace-link-keep-label))))
#+END_SRC
The =:name= property is the name of the function run. The function takes in the
Org parse tree, and returns a list of =(point error-message)=. =:description= is a
short description of what the checker does. =:actions= is an alist containing
elements of the form =(char . (prompt . function))=. These actions are defined per
checker, to perform autofixes for the errors. For each error detected,
=org-roam-doctor= will move the point to the current error, and pop-up a help
window displaying the error message, as well as the list of actions that can be
taken provided in =:actions=.
* Keystroke Index
:PROPERTIES:
:APPENDIX: t

225
org-roam-doctor.el Normal file
View File

@ -0,0 +1,225 @@
;;; org-roam-doctor.el --- Rudimentary Roam replica with Org-mode -*- coding: utf-8; lexical-binding: t; -*-
;;
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/jethrokuan/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 1.1.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (s "1.12.0") (org "9.3") (emacsql "3.0.0") (emacsql-sqlite "1.0.0"))
;; This file is NOT part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This library provides `org-roam-doctor', a utility for diagnosing and fixing
;; Org-roam files. Running `org-roam-doctor' launches a list of checks defined
;; by `org-roam-doctor--checkers'. Every checker is an instance of
;; `org-roam-doctor-checker'.
;;
;; Each checker is given the Org parse tree (AST), and is expected to return a
;; list of errors. The checker can also provide "actions" for auto-fixing errors
;; (see `org-roam-doctor--remove-link' for an example).
;;
;; The UX experience is inspired by both org-lint and checkdoc, and their code
;; is heavily referenced.
;;
;;; Code:
;; Library Requires
(require 'cl-lib)
(require 'org)
(require 'org-element)
(declare-function org-roam-insert "org-roam")
(declare-function org-roam--get-roam-buffers "org-roam")
(declare-function org-roam--list-all-files "org-roam")
(declare-function org-roam--org-roam-file-p "org-roam")
(cl-defstruct (org-roam-doctor-checker (:copier nil))
(name 'missing-checker-name)
(description "")
(actions nil))
(defconst org-roam-doctor--checkers
(list
(make-org-roam-doctor-checker
:name 'org-roam-doctor-broken-links
:description "Fix broken links."
:actions '(("d" . ("Unlink" . org-roam-doctor--remove-link))
("r" . ("Replace link" . org-roam-doctor--replace-link))
("R" . ("Replace link (keep label)" . org-roam-doctor--replace-link-keep-label))))))
(defun org-roam-doctor-broken-links (ast)
"Checker for detecting broken links.
AST is the org-element parse tree."
(org-element-map ast 'link
(lambda (l)
(when (equal "file" (org-element-property :type l))
(let ((file (org-element-property :path l)))
(or (file-exists-p file)
(file-remote-p file)
`(,(org-element-property :begin l)
,(format (if (org-element-lineage l '(link))
"Link to non-existent image file \"%s\"\
in link description"
"Link to non-existent local file \"%s\"")
file))))))))
(defun org-roam-doctor--check (buffer checkers)
"Check BUFFER for errors.
CHECKERS is the list of checkers used."
(with-current-buffer buffer
(save-excursion
(goto-char (point-min))
(let* ((ast (org-element-parse-buffer))
(errors (sort (cl-mapcan
(lambda (c)
(mapcar
(lambda (report)
(list (set-marker (make-marker) (car report))
(nth 1 report) c))
(save-excursion
(funcall
(org-roam-doctor-checker-name c)
ast))))
checkers)
#'car-less-than-car)))
(dolist (e errors)
(pcase-let ((`(,m ,msg ,checker) e))
(switch-to-buffer buffer)
(goto-char m)
(org-reveal)
(undo-boundary)
(org-roam-doctor--resolve msg checker)
(set-marker m nil)))
errors))))
;;; Actions
(defun org-roam-doctor--recursive-edit ()
"Launch into a recursive edit."
(message "When you're done editing press C-M-c to continue.")
(recursive-edit))
(defun org-roam-doctor--skip ()
"Skip the current error."
(message "Skipping..."))
(defun org-roam-doctor--replace-link ()
"Replace the current link with a new link."
(save-match-data
(unless (org-in-regexp org-link-bracket-re 1)
(user-error "No link at point"))
(let ((orig (buffer-string))
(p (point)))
(condition-case nil
(save-excursion
(replace-match "")
(org-roam-insert))
(quit (progn
(replace-buffer-contents orig)
(goto-char p)))))))
(defun org-roam-doctor--replace-link-keep-label ()
"Replace the current link with a new link, keeping the current link's label."
(save-match-data
(unless (org-in-regexp org-link-bracket-re 1)
(user-error "No link at point"))
(let ((orig (buffer-string))
(p (point)))
(condition-case nil
(save-excursion
(let ((label (if (match-end 2)
(match-string-no-properties 2)
(org-link-unescape (match-string-no-properties 1)))))
(replace-match "")
(org-roam-insert nil nil label)))
(quit (progn
(replace-buffer-contents orig)
(goto-char p)))))))
(defun org-roam-doctor--remove-link ()
"Unlink the text at point."
(unless (org-in-regexp org-link-bracket-re 1)
(user-error "No link at point"))
(save-excursion
(let ((label (if (match-end 2)
(match-string-no-properties 2)
(org-link-unescape (match-string-no-properties 1)))))
(delete-region (match-beginning 0) (match-end 0))
(insert label))))
(defun org-roam-doctor--resolve (msg checker)
"Resolve an error.
MSG is the error that was found, which is displayed in a help buffer.
CHECKER is a org-roam-doctor checker instance."
(let ((actions (org-roam-doctor-checker-actions checker))
c)
(push '("e" . ("Edit" . org-roam-doctor--recursive-edit)) actions)
(push '("s" . ("Skip" . org-roam-doctor--skip)) actions)
(with-output-to-temp-buffer "*Org-roam-doctor Help*"
(mapc #'princ
(list "Error message:\n " msg "\n\n"))
(dolist (action actions)
(princ (format "[%s]: %s\n"
(car action)
(cadr action))))
(princ "\n\n"))
(shrink-window-if-larger-than-buffer
(get-buffer-window "*Org-roam-doctor Help*"))
(message "Press key for command:")
(unwind-protect
(progn
(cl-loop
do (setq c (char-to-string (read-char-exclusive)))
until (assoc c actions)
do (message "Please enter a valid key for command:"))
(funcall (cddr (assoc c actions)))
(redisplay))
(when (get-buffer-window "*Org-roam-doctor Help*")
(delete-window (get-buffer-window "*Org-roam-doctor Help*"))
(kill-buffer "*Org-roam-doctor Help*")))))
;;;###autoload
(defun org-roam-doctor (&optional checkall)
"Perform a check on the current buffer to ensure cleanliness.
If CHECKALL, run the check only for all Org-roam files."
(interactive "P")
(let ((files (if checkall
(org-roam--list-all-files)
(unless (org-roam--org-roam-file-p)
(user-error "Not in an org-roam file"))
`(,(buffer-file-name)))))
(org-roam-doctor-start files org-roam-doctor--checkers)))
(defun org-roam-doctor-start (files checkers)
"Lint FILES using CHECKERS."
(save-window-excursion
(let ((existing-buffers (org-roam--get-roam-buffers)))
(dolist (f files)
(let ((buf (find-file-noselect f)))
(with-current-buffer buf
(org-roam-doctor--check buf checkers))
(unless (memq buf existing-buffers)
(save-buffer buf)
(kill-buffer buf))))))
(message "Linting completed."))
(provide 'org-roam-doctor)
;;; org-roam-doctor.el ends here

18
org-roam.el
View File

@ -52,6 +52,7 @@
(require 'org-roam-graph)
(require 'org-roam-completion)
(require 'org-roam-dailies)
(require 'org-roam-doctor)
;; To detect cite: links
(require 'org-ref nil t)
@ -443,7 +444,7 @@ Examples:
("^_" . "") ;; remove starting underscore
("_$" . ""))) ;; remove ending underscore
(slug (-reduce-from #'cl-replace (strip-nonspacing-marks title) pairs)))
(s-downcase slug))))
(downcase slug))))
;;; Interactive Commands
(defun org-roam--format-link-title (title)
@ -466,11 +467,12 @@ Examples:
target))
description)))
(defun org-roam-insert (prefix &optional filter-fn)
(defun org-roam-insert (&optional lowercase filter-fn description)
"Find an Org-roam file, and insert a relative org link to it at point.
If PREFIX, downcase the title before insertion.
If LOWERCASE, downcase the title before insertion.
FILTER-FN is the name of a function to apply on the candidates
which takes as its argument an alist of path-completions. See
which takes as its argument an alist of path-completions.
If DESCRIPTION is provided, use this as the link label. See
`org-roam--get-title-path-completions' for details."
(interactive "P")
(let* ((region (and (region-active-p)
@ -485,11 +487,11 @@ which takes as its argument an alist of path-completions. See
it)))
(title (org-roam-completion--completing-read "File: " completions
:initial-input region-text))
(region-or-title (or region-text title))
(description (or description region-text title))
(target-file-path (cdr (assoc title completions)))
(link-description (org-roam--format-link-title (if prefix
(downcase region-or-title)
region-or-title))))
(link-description (org-roam--format-link-title (if lowercase
(downcase description)
description))))
(if (and target-file-path
(file-exists-p target-file-path))
(progn