From d68d1f8ebb8bf6213b053a775a8f22f31433cade Mon Sep 17 00:00:00 2001 From: Jethro Kuan Date: Sun, 10 May 2020 13:57:18 +0800 Subject: [PATCH] (feat): add `org-roam-doctor` (#570) `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. --- CHANGELOG.md | 1 + doc/org-roam.org | 32 +++++++ org-roam-doctor.el | 225 +++++++++++++++++++++++++++++++++++++++++++++ org-roam.el | 18 ++-- 4 files changed, 268 insertions(+), 8 deletions(-) create mode 100644 org-roam-doctor.el diff --git a/CHANGELOG.md b/CHANGELOG.md index 91e6245..d0b2e01 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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) diff --git a/doc/org-roam.org b/doc/org-roam.org index a08a389..de5441e 100644 --- a/doc/org-roam.org +++ b/doc/org-roam.org @@ -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 diff --git a/org-roam-doctor.el b/org-roam-doctor.el new file mode 100644 index 0000000..1455a86 --- /dev/null +++ b/org-roam-doctor.el @@ -0,0 +1,225 @@ +;;; org-roam-doctor.el --- Rudimentary Roam replica with Org-mode -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Copyright © 2020 Jethro Kuan + +;; Author: Jethro Kuan +;; 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 diff --git a/org-roam.el b/org-roam.el index 3e850d7..d31add2 100644 --- a/org-roam.el +++ b/org-roam.el @@ -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