From mboxrd@z Thu Jan 1 00:00:00 1970 From: Nicolas Goaziou Subject: Re: [RFC] Org linting library Date: Mon, 20 Apr 2015 11:12:24 +0200 Message-ID: <874mobduyv.fsf@nicolasgoaziou.fr> References: <87a8y4fdmv.fsf@nicolasgoaziou.fr> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:48202) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Yk7jR-0004xE-RQ for emacs-orgmode@gnu.org; Mon, 20 Apr 2015 05:11:12 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Yk7jN-0006iw-8e for emacs-orgmode@gnu.org; Mon, 20 Apr 2015 05:11:09 -0400 Received: from relay4-d.mail.gandi.net ([2001:4b98:c:538::196]:40875) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Yk7jM-0006ic-TA for emacs-orgmode@gnu.org; Mon, 20 Apr 2015 05:11:05 -0400 In-Reply-To: (Charles C. Berry's message of "Sun, 19 Apr 2015 19:15:03 -0700") List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: "Charles C. Berry" Cc: Org Mode List --=-=-= Content-Type: text/plain "Charles C. Berry" writes: >> - orphaned affiliated keywords > > This generates an orphaned keyword warning, but seems innocuous and is > what babel renders. > > #+NAME: abc > #+BEGIN_SRC emacs-lisp > nil #+END_SRC > > #+RESULTS: abc Indeed, it is innocuous. It is meant to catch, e.g., #+CAPTION: my table | table with a spurious newline above | This check has a "low" trust level so false positive are OK. >> - wrong header arguments in src blocks > > IFF the header args are in the #+BEGIN_SRC line. > > #+HEADER lines and header-arg properties are not screened AFAICS. Indeed. Here's an update. Thank you for the feedback. Regards, --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Implement-Org-linting.patch >From 1b6b392f6e8e1bba68e07a36e7f9afc792e699a2 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 15 Apr 2015 22:24:15 +0200 Subject: [PATCH] Implement Org linting * lisp/org-lint.el: New file. --- lisp/org-lint.el | 768 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 768 insertions(+) create mode 100644 lisp/org-lint.el diff --git a/lisp/org-lint.el b/lisp/org-lint.el new file mode 100644 index 0000000..c818ff1 --- /dev/null +++ b/lisp/org-lint.el @@ -0,0 +1,768 @@ +;;; org-lint.el --- Linting for Org documents -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 Free Software Foundation + +;; Author: Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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 of the License, 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 this program. If not, see . + +;;; Commentary: + +;; This library implements linting for Org syntax. The sole public +;; function is `org-lint', which see. + +;; Internally, the library defines a new structure: +;; `org-lint-checker', with the following slots: + +;; - NAME: Unique check identifier, as a symbol. The check is done +;; calling the function `org-lint-NAME' with one mandatory +;; argument, the parse tree describing the current Org buffer. +;; Such function calls are wrapped within a `save-excursion' and +;; point is always at `point-min'. Its return value has to be an +;; alist (POSITION MESSAGE) when POSITION refer to the buffer +;; position of the error, as an integer, and MESSAGE is a strings +;; describing the error. + +;; - DESCRIPTION: Summary about the check, as a string. + +;; - CATEGORIES: Categories relative to the check, as a list of +;; symbol. They are used for filtering when calling `org-lint'. +;; Checkers not explicitly associated to a category are collected +;; in the `default' one. + +;; - TRUST: The trust level one can have in the check. It is either +;; `low' or `high', depending on the heuristics implemented and +;; the nature of the check. This has an indicative value only and +;; is displayed along reports. + +;; All checks have to be listed in `org-lint--checkers'. + +;; Results are displayed in a special "*Org Lint*" buffer with +;; a dedicated major mode, derived from `tabulated-list-mode'. In +;; addition to the usual key-bindings inherited from it, "C-j" +;; displays problematic line reported under point and "RET" jumps to +;; it. + +;; Checks currently implemented are: + +;; - duplicates CUSTOM_ID properties +;; - duplicate NAME values +;; - duplicate targets +;; - duplicate footnote definitions +;; - orphaned affiliated keywords +;; - obsolete affiliated keywords +;; - missing language in src blocks +;; - NAME values with a colon +;; - wrong header arguments in src blocks +;; - misuse of CATEGORY keyword +;; - "coderef" links with unknown destination +;; - "custom-id" links with unknown destination +;; - "fuzzy" links with unknown destination +;; - "id" links with unknown destination +;; - links to non-existent local files +;; - SETUPFILE keywords with non-existent file parameter +;; - INCLUDE keywords with wrong link parameter +;; - special properties in properties drawer +;; - obsolete syntax for PROPERTIES drawers +;; - missing definition for footnote references +;; - missing reference for footnote definitions +;; - non-footnote definitions in footnote section +;; - probable invalid keywords +;; - invalid blocks +;; - probable incomplete drawers +;; - obsolete QUOTE section + + +;;; Code: + +(require 'cl-lib) +(require 'org-element) +(require 'ox) +(require 'ob) + + +;;; Checkers + +(cl-defstruct (org-lint-checker (:copier nil)) + (name 'missing-checker-name) + (description "") + (categories '(default)) + (trust 'high)) ; `low' or `high' + +(defun org-lint-missing-checker-name (_) + (error + "`A checker has no `:name' property. Please verify `org-lint--checkers'")) + +(defconst org-lint--checkers + (list + (make-org-lint-checker + :name 'duplicate-custom-id + :description "Report duplicates CUSTOM_ID properties" + :categories '(link)) + (make-org-lint-checker + :name 'duplicate-name + :description "Report duplicate NAME values" + :categories '(babel link)) + (make-org-lint-checker + :name 'duplicate-target + :description "Report duplicate targets" + :categories '(link)) + (make-org-lint-checker + :name 'duplicate-footnote-definition + :description "Report duplicate footnote definitions" + :categories '(footnote)) + (make-org-lint-checker + :name 'orphaned-affiliated-keywords + :description "Report orphaned affiliated keywords" + :trust 'low) + (make-org-lint-checker + :name 'obsolete-affiliated-keywords + :description "Report obsolete affiliated keywords" + :categories '(obsolete)) + (make-org-lint-checker + :name 'missing-language-in-src-block + :description "Report missing language in src blocks" + :categories '(babel)) + (make-org-lint-checker + :name 'colon-in-name + :description "Report NAME values with a colon" + :categories '(babel)) + (make-org-lint-checker + :name 'wrong-header-argument + :description "Report wrong headers in src blocks, keywords and properties" + :categories '(babel)) + (make-org-lint-checker + :name 'deprecated-category-setup + :description "Report misuse of CATEGORY keyword" + :categories '(obsolete)) + (make-org-lint-checker + :name 'invalid-coderef-link + :description "Report \"coderef\" links with unknown destination" + :categories '(link)) + (make-org-lint-checker + :name 'invalid-custom-id-link + :description "Report \"custom-id\" links with unknown destination" + :categories '(link)) + (make-org-lint-checker + :name 'invalid-fuzzy-link + :description "Report \"fuzzy\" links with unknown destination" + :categories '(link)) + (make-org-lint-checker + :name 'invalid-id-link + :description "Report \"id\" links with unknown destination" + :categories '(link)) + (make-org-lint-checker + :name 'link-to-local-file + :description "Report links to non-existent local files" + :categories '(link) + :trust 'low) + (make-org-lint-checker + :name 'non-existent-setupfile-parameter + :description "Report SETUPFILE keywords with non-existent file parameter" + :trust 'low) + (make-org-lint-checker + :name 'wrong-include-link-parameter + :description "Report INCLUDE keywords with misleading link parameter" + :trust 'low) + (make-org-lint-checker + :name 'special-property-in-properties-drawer + :description "Report special properties in properties drawers" + :categories '(properties)) + (make-org-lint-checker + :name 'obsolete-properties-drawer + :description "Report obsolete syntax for properties drawers" + :categories '(obsolete properties) + :trust 'low) + (make-org-lint-checker + :name 'undefined-footnote-reference + :description "Report missing definition for footnote references" + :categories '(footnote)) + (make-org-lint-checker + :name 'unreferenced-footnote-definition + :description "Report missing reference for footnote definitions" + :categories '(footnote)) + (make-org-lint-checker + :name 'extraneous-element-in-footnote-section + :description "Report non-footnote definitions in footnote section" + :trust 'high + :categories '(footnote)) + (make-org-lint-checker + :name 'invalid-keyword-syntax + :description "Report probable invalid keywords" + :trust 'low) + (make-org-lint-checker + :name 'corrupted-block + :description "Report invalid blocks" + :trust 'low) + (make-org-lint-checker + :name 'incomplete-drawer + :description "Report probable incomplete drawers" + :trust 'low) + (make-org-lint-checker + :name 'quote-section + :description "Report obsolete QUOTE section" + :categories '(obsolete) + :trust 'low)) + "List of all available checkers.") + +(defun org-lint-duplicate-custom-id (ast) + (org-element-map ast '(headline inlinetask) + (let (ids) + (lambda (e) + (let ((custom-id (org-element-property :CUSTOM_ID e))) + (cond + ((not custom-id) nil) + ((member custom-id ids) + (list (org-element-map e 'node-property + (lambda (p) + (and (eq (compare-strings + "CUSTOM_ID" nil nil + (org-element-property :key p) nil nil + t) + t) + (org-element-property :begin p))) + nil t) + (format "Duplicate CUSTOM_ID property \"%s\"" custom-id))) + (t (push custom-id ids) nil))))))) + +(defun org-lint-duplicate-name (ast) + (org-element-map ast org-element-all-elements + (let (names) + (lambda (e) + (let ((name (org-element-property :name e))) + (cond + ((not name) nil) + ((member name names) + (list (progn (goto-char (org-element-property :begin e)) + (let ((case-fold-search t)) + (re-search-forward + (concat "^[ \t]*#\\+NAME: +" (regexp-quote name))) + (match-beginning 0))) + (format "Duplicate NAME \"%s\"" name))) + (t (push name names) nil))))))) + +(defun org-lint-duplicate-target (ast) + (org-element-map ast 'target + (let (targets) + (lambda (o) + (let ((target (org-split-string (org-element-property :value o)))) + (if (member target targets) + (list (org-element-property :begin o) + (format "Duplicate target \"%s\"" + (org-element-property :value o))) + (push target targets) + nil)))))) + +(defun org-lint-duplicate-footnote-definition (ast) + (org-element-map ast 'footnote-definition + (let (labels) + (lambda (f) + (let ((label (org-element-property :label f))) + (cond ((not label) nil) + ((member label labels) + (list (org-element-property :post-affiliated f) + (format "Duplicate footnote definition \"%s\"" label))) + (t (push label labels) nil))))))) + +(defun org-lint-orphaned-affiliated-keywords (ast) + (org-element-map ast 'keyword + (lambda (k) + (let ((key (org-element-property :key k))) + (and (member key org-element-affiliated-keywords) + (list (org-element-property :post-affiliated k) + (format "Orphaned affiliated keyword: \"%s\"" key))))))) + +(defun org-lint-obsolete-affiliated-keywords (_) + (let ((regexp (format "^[ \t]*#\\+%s:" + (regexp-opt '("DATA" "LABEL" "RESNAME" "SOURCE" + "SRCNAME" "TBLNAME" "RESULT" "HEADERS") + t))) + reports) + (while (re-search-forward regexp nil t) + (let ((key (upcase (org-match-string-no-properties 1)))) + (when (< (point) + (org-element-property :post-affiliated (org-element-at-point))) + (push + (list (line-beginning-position) + (format + "Obsolete affiliated keyword: \"%s\". Use \"%s\" instead" + key + (pcase key + ("HEADERS" "HEADER") + ("RESULT" "RESULTS") + (_ "NAME")))) + reports)))) + reports)) + +(defun org-lint-missing-language-in-src-block (ast) + (org-element-map ast 'src-block + (lambda (b) + (unless (org-element-property :language b) + (list (org-element-property :post-affiliated b) + "Missing language in source block"))))) + +(defun org-lint-deprecated-category-setup (ast) + (org-element-map ast 'keyword + (let (category-flag) + (lambda (k) + (cond + ((not (string= (org-element-property :key k) "CATEGORY")) nil) + (category-flag + (list (org-element-property :post-affiliated k) + "Spurious CATEGORY keyword. Set :CATEGORY: property instead")) + (t (setf category-flag t) nil)))))) + +(defun org-lint-invalid-coderef-link (ast) + (let ((info (list :parse-tree ast))) + (org-element-map ast 'link + (lambda (link) + (let ((ref (org-element-property :path link))) + (and (equal (org-element-property :type link) "coderef") + (not (ignore-errors (org-export-resolve-coderef ref info))) + (list (org-element-property :begin link) + (format "Unknown coderef \"%s\"" ref)))))))) + +(defun org-lint-invalid-custom-id-link (ast) + (let ((info (list :parse-tree ast))) + (org-element-map ast 'link + (lambda (link) + (and (equal (org-element-property :type link) "custom-id") + (not (ignore-errors (org-export-resolve-id-link link info))) + (list (org-element-property :begin link) + (format "Unknown custom ID \"%s\"" + (org-element-property :path link)))))))) + +(defun org-lint-invalid-fuzzy-link (ast) + (let ((info (list :parse-tree ast))) + (org-element-map ast 'link + (lambda (link) + (and (equal (org-element-property :type link) "fuzzy") + (not (ignore-errors (org-export-resolve-fuzzy-link link info))) + (list (org-element-property :begin link) + (format "Unknown fuzzy location \"%s\"" + (let ((path (org-element-property :path link))) + (if (string-prefix-p "*" path) + (substring path 1) + path))))))))) + +(defun org-lint-invalid-id-link (ast) + (org-element-map ast 'link + (lambda (link) + (let ((id (org-element-property :path link))) + (and (equal (org-element-property :type link) "id") + (not (org-id-find id)) + (list (org-element-property :begin link) + (format "Unknown ID \"%s\"" id))))))) + +(defun org-lint-special-property-in-properties-drawer (ast) + (org-element-map ast 'node-property + (lambda (p) + (let ((key (org-element-property :key p))) + (and (member-ignore-case key org-special-properties) + (list (org-element-property :begin p) + (format + "Special property \"%s\" found in a properties drawer" + key))))))) + +(defun org-lint-obsolete-properties-drawer (ast) + (org-element-map ast 'drawer + (lambda (d) + (when (equal (org-element-property :drawer-name d) "PROPERTIES") + (let ((section (org-element-lineage d '(section)))) + (unless (org-element-map section 'property-drawer #'identity nil t) + (list (org-element-property :post-affiliated d) + (if (save-excursion + (goto-char (org-element-property :post-affiliated d)) + (forward-line -1) + (or (org-at-heading-p) (org-at-planning-p))) + "Incorrect contents for PROPERTIES drawer" + "Incorrect location for PROPERTIES drawer")))))))) + +(defun org-lint-link-to-local-file (ast) + (org-element-map ast 'link + (lambda (l) + (when (equal (org-element-property :type l) "file") + (let ((file (org-element-property :path l))) + (and (not (file-remote-p file)) + (not (file-exists-p file)) + (list (org-element-property :begin l) + (format "Link to non-existent local file \"%s\"" + file)))))))) + +(defun org-lint-non-existent-setupfile-parameter (ast) + (org-element-map ast 'keyword + (lambda (k) + (when (equal (org-element-property :key k) "SETUPFILE") + (let ((file (org-remove-double-quotes + (org-element-property :value k)))) + (and (not (file-remote-p file)) + (not (file-exists-p file)) + (list (org-element-property :begin k) + (format "Non-existent setup file \"%s\"" file)))))))) + +(defun org-lint-wrong-include-link-parameter (ast) + (org-element-map ast 'keyword + (lambda (k) + (when (equal (org-element-property :key k) "INCLUDE") + (let* ((value (org-element-property :value k)) + (path + (and (string-match "^\\(\".+\"\\|\\S-+\\)[ \t]*" value) + (save-match-data + (org-remove-double-quotes (match-string 1 value)))))) + (if (not path) + (list (org-element-property :post-affiliated k) + "Missing location argument in INCLUDE keyword") + (let* ((file (org-string-nw-p + (if (string-match "::\\(.*\\)\\'" path) + (substring path 0 (match-beginning 0)) + path))) + (search (and (not (equal file path)) + (org-string-nw-p (match-string 1 path))))) + (if (and file + (not (file-remote-p file)) + (not (file-exists-p file))) + (list (org-element-property :post-affiliated k) + "Non-existent file argument in INCLUDE keyword") + (let* ((visiting (if file (find-buffer-visiting file) + (current-buffer))) + (buffer (or visiting (find-file-noselect file)))) + (unwind-protect + (with-current-buffer buffer + (when (and search + (not + (ignore-errors + (let ((org-link-search-inhibit-query t)) + (org-link-search search nil nil t))))) + (list + (org-element-property :post-affiliated k) + (format + "Invalid search part \"%s\" in INCLUDE keyword" + search)))) + (unless visiting (kill-buffer buffer)))))))))))) + +(defun org-lint-undefined-footnote-reference (ast) + (let ((definitions (org-element-map ast 'footnote-definition + (lambda (f) (org-element-property :label f))))) + (org-element-map ast 'footnote-reference + (lambda (f) + (let ((label (org-element-property :label f))) + (and label + (not (member label definitions)) + (list (org-element-property :begin f) + (format "Missing definition for footnote [%s]" + label)))))))) + +(defun org-lint-unreferenced-footnote-definition (ast) + (let ((references (org-element-map ast 'footnote-reference + (lambda (f) (org-element-property :label f))))) + (org-element-map ast 'footnote-definition + (lambda (f) + (let ((label (org-element-property :label f))) + (and label + (not (member label references)) + (list (org-element-property :post-affiliated f) + (format "No reference for footnote definition [%s]" + label)))))))) + +(defun org-lint-colon-in-name (ast) + (org-element-map ast org-element-all-elements + (lambda (e) + (let ((name (org-element-property :name e))) + (and name + (org-string-match-p ":" name) + (list (progn + (goto-char (org-element-property :begin e)) + (let ((case-fold-search t)) + (re-search-forward + (concat "^[ \t]*#\\+NAME: +" (regexp-quote name))) + (match-beginning 0))) + (format + "Name \"%s\" contains a colon; Babel cannot use it as input" + name))))))) + +(defun org-lint-incomplete-drawer (_) + (let (reports) + (while (re-search-forward org-drawer-regexp nil t) + (let ((name (org-trim (org-match-string-no-properties 0))) + (element (org-element-at-point))) + (pcase (org-element-type element) + (`(drawer property-drawer) + (goto-char (org-element-property :end element)) + nil) + (`paragraph + (push (list (line-beginning-position) + (format "Possible incomplete drawer \"%s\"" name)) + reports)) + (_ nil)))) + reports)) + +(defun org-lint-corrupted-block (_) + (let ((case-fold-search t) + (regexp "^[ \t]*#\\+\\(BEGIN\\|END\\)\\(?::\\|_[^[:space:]]*\\)?[ \t]*") + reports) + (while (re-search-forward regexp nil t) + (let ((name (org-trim (buffer-substring-no-properties + (line-beginning-position) (line-end-position))))) + (cond + ((and (string-prefix-p "END" (match-string 1) t) + (not (eolp))) + (push (list (line-beginning-position) + (format "Invalid block closing line \"%s\"" name)) + reports)) + ((eq (org-element-type (org-element-at-point)) 'paragraph) + (push (list (line-beginning-position) + (format "Possible incomplete block \"%s\"" + name)) + reports))))) + reports)) + +(defun org-lint-invalid-keyword-syntax (_) + (let ((regexp "^[ \t]*\\(#\\+[^[:space:]:]*\\)\\(?:[[:space:]]\\|$\\)") + reports) + (while (re-search-forward regexp nil t) + (let ((name (org-match-string-no-properties 1))) + (unless (or (string-prefix-p "#+BEGIN" name t) + (string-prefix-p "#+END" name t)) + (push (list (match-beginning 0) + (format "Possible missing colon in keyword \"%s\"" name)) + reports)))) + reports)) + +(defun org-lint-extraneous-element-in-footnote-section (ast) + (org-element-map ast 'headline + (lambda (h) + (and (org-element-property :footnote-section-p h) + (org-element-map (org-element-contents h) + (org-remove-if + (lambda (e) + (memq e '(comment comment-block footnote-definition + property-drawer section))) + org-element-all-elements) + (lambda (e) + (not (and (eq (org-element-type e) 'headline) + (org-element-property :commentedp e)))) + nil t '(footnote-definition property-drawer)) + (list (org-element-property :begin h) + "Extraneous elements in footnote section"))))) + +(defun org-lint-quote-section (ast) + (org-element-map ast '(headline inlinetask) + (lambda (h) + (let ((title (org-element-property :raw-value h))) + (and (or (string-prefix-p "QUOTE " title) + (string-prefix-p (concat org-comment-string " QUOTE ") title)) + (list (org-element-property :begin h) + "Deprecated QUOTE section")))))) + +(defun org-lint-wrong-header-argument (ast) + (let* ((reports) + (verify + (lambda (datum lang headers) + (let ((allowed + (append + org-babel-header-arg-names + (and lang + (let ((v (intern + (concat "org-babel-header-args:" lang)))) + (and (boundp v) + (mapcar #'car (symbol-value v)))))))) + (dolist (header headers) + (let ((h (substring (symbol-name (car header)) 1))) + (unless (assoc-string h allowed) + (push (list (org-element-property :post-affiliated datum) + (format "Unknown header argument \"%s\"" h)) + reports)))))))) + (org-element-map ast '(keyword node-property src-block) + (lambda (datum) + (pcase (org-element-type datum) + (`keyword + (when (string= (org-element-property :key datum) "PROPERTY") + (let ((value (org-element-property :value datum))) + (when (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)? *" + value) + (funcall verify + datum + (match-string 1 value) + (org-babel-parse-header-arguments + (substring value (match-end 0)))))))) + (`node-property + (let ((key (org-element-property :key datum))) + (when (let ((case-fold-search t)) + (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?" key)) + (funcall verify + datum + (match-string 1 key) + (org-babel-parse-header-arguments + (org-element-property :value datum)))))) + (`src-block + (funcall verify + datum + (org-element-property :language datum) + (cl-mapcan #'org-babel-parse-header-arguments + (cons (org-element-property :parameters datum) + (org-element-property :header datum)))))))) + reports)) + + +;;; Reports UI + +(defvar org-lint--report-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map tabulated-list-mode-map) + (define-key map (kbd "RET") 'org-lint--jump-to-source) + (define-key map (kbd "C-j") 'org-lint--show-source) + map) + "Local keymap for `org-lint--report-mode' buffers.") + +(define-derived-mode org-lint--report-mode tabulated-list-mode "OrgLint" + "Major mode used to display reports emitted during linting. +\\" + (setf tabulated-list-format + `[("Line" 6 + (lambda (a b) + (< (string-to-number (aref (cadr a) 0)) + (string-to-number (aref (cadr b) 0)))) + :right-align t) + ("Trust" 5 t) + ("Warning" 0 nil)]) + (tabulated-list-init-header)) + +(defun org-lint--generate-reports (checkers) + "Run all CHECKERS in current buffer. +Return an alist (ID [LINE TRUST DESCRIPTION]), suitable for +`tabulated-list-printer'." + (save-excursion + (goto-char (point-min)) + (let ((ast (org-element-parse-buffer)) + (id 0) + (last-line 1) + (last-pos 1)) + ;; Insert unique ID for each report. Replace buffer positions + ;; with line numbers. + (mapcar + (lambda (report) + (list + (incf id) + (apply #'vector + (cons + (progn + (goto-char (car report)) + (beginning-of-line) + (prog1 (number-to-string + (incf last-line (count-lines last-pos (point)))) + (setf last-pos (point)))) + (cdr report))))) + ;; Insert trust level in generated reports. Also sort them by + ;; buffer position in order to optimize lines computation. + (sort (cl-mapcan + (lambda (c) + (let ((trust (symbol-name (org-lint-checker-trust c)))) + (mapcar + (lambda (report) (list (car report) trust (nth 1 report))) + (save-excursion + (funcall (intern + (concat "org-lint-" + (symbol-name (org-lint-checker-name c)))) + ast))))) + checkers) + #'car-less-than-car))))) + +(defvar org-lint--source-buffer nil + "Source buffer associated to current report buffer.") +(make-variable-buffer-local 'org-lint--source-buffer) + +(defun org-lint--display-reports (source checkers) + "Display linting reports for buffer SOURCE. +CHECKERS is the list of checkers used." + (let ((buffer (get-buffer-create "*Org Lint*"))) + (with-current-buffer buffer + (org-lint--report-mode) + (setf org-lint--source-buffer source) + (setf tabulated-list-entries + (lambda () + (with-current-buffer source + (org-lint--generate-reports checkers)))) + (tabulated-list-print)) + (pop-to-buffer buffer))) + +(defun org-lint--jump-to-source () + "Move to source line that generated the report at point." + (interactive) + (let ((l (string-to-number (aref (tabulated-list-get-entry) 0)))) + (switch-to-buffer-other-window org-lint--source-buffer) + (org-goto-line l) + (org-show-set-visibility 'local) + (recenter))) + +(defun org-lint--show-source () + "Show source line that generated the report at point." + (interactive) + (let ((buffer (current-buffer)) + (l (string-to-number (aref (tabulated-list-get-entry) 0)))) + (switch-to-buffer-other-window org-lint--source-buffer) + (org-goto-line l) + (org-show-set-visibility 'local) + (recenter) + (switch-to-buffer-other-window buffer))) + + +;;; Public function + +;;;###autoload +(defun org-lint (&optional arg) + "Check current Org buffer for syntax mistakes. + +By default, run all checkers. With a single prefix ARG \ +\\[universal-argument], +select one category of checkers only. With a double prefix +\\[universal-argument] \\[universal-argument], select one precise \ +checker by its name. + +ARG can also be a list of checker names, as symbols, to run." + (interactive "P") + (unless (derived-mode-p 'org-mode) (user-error "Not in an Org buffer")) + (message "Org linting process starting...") + (org-lint--display-reports + (current-buffer) + (pcase arg + (`nil org-lint--checkers) + (`(4) + (let ((category + (completing-read + "Checker category: " + (mapcar #'org-lint-checker-categories org-lint--checkers) + nil t))) + (org-remove-if-not + (lambda (c) (assoc-string (org-lint-checker-categories c) category)) + org-lint--checkers))) + (`(16) + (list + (let ((name (completing-read + "Checker name: " + (mapcar #'org-lint-checker-name org-lint--checkers) + nil t))) + (catch 'exit + (dolist (c org-lint--checkers) + (when (string= (org-lint-checker-name c) name) + (throw 'exit c))))))) + ((pred consp) + (org-remove-if-not (lambda (c) (memq (org-lint-checker-name c) arg)) + org-lint--checkers)) + (_ (user-error "Invalid argument `%S' for `org-lint'" arg)))) + (message "Org linting process completed")) + + +(provide 'org-lint) +;;; org-lint.el ends here -- 2.3.5 --=-=-=--