From: Nicolas Goaziou <mail@nicolasgoaziou.fr>
To: Org Mode List <emacs-orgmode@gnu.org>
Subject: [RFC] Org linting library
Date: Sun, 19 Apr 2015 15:31:36 +0200 [thread overview]
Message-ID: <87a8y4fdmv.fsf@nicolasgoaziou.fr> (raw)
[-- Attachment #1: Type: text/plain, Size: 2677 bytes --]
Hello,
The following 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
- 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
Since it relies on lexical binding, `pcase' and `string-prefix-p', it
cannot be added to Org 8.3, but can make it into Org 8.4, if deemed
useful enough.
Feedback welcome.
Regards,
--
Nicolas Goaziou 0x80A93738
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Implement-Org-linting.patch --]
[-- Type: text/x-diff, Size: 24656 bytes --]
From 8324f1422953caab5566950f989e95fd4325a0b0 Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <mail@nicolasgoaziou.fr>
Date: Wed, 15 Apr 2015 22:24:15 +0200
Subject: [PATCH] Implement Org linting
* lisp/org-lint.el: New file.
---
lisp/org-lint.el | 681 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 681 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..009a503
--- /dev/null
+++ b/lisp/org-lint.el
@@ -0,0 +1,681 @@
+;;; org-lint.el --- Linting for Org documents -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation
+
+;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; 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
+;; - 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
+
+\f
+;;; Code:
+
+(require 'cl-lib)
+(require 'org-element)
+(require 'ox)
+(require 'ob)
+
+\f
+;;; 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 header arguments in src blocks"
+ :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 '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-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)
+ (org-element-map ast 'src-block
+ (lambda (b)
+ (let* ((language (org-element-property :language b))
+ (allowed
+ (mapcar #'symbol-name
+ (append
+ org-babel-header-arg-names
+ (let ((v (intern (concat "org-babel-header-args:"
+ language))))
+ (and (boundp v)
+ (mapcar #'car (symbol-value v))))))))
+ (dolist (header (mapcar
+ (lambda (e) (substring (symbol-name (car e)) 1))
+ (org-babel-parse-header-arguments
+ (org-element-property :parameters b))))
+ (unless (member header allowed)
+ (push (list (org-element-property :post-affiliated b)
+ (format "Unknown header argument \"%s\"" header))
+ reports))))))
+ reports))
+
+\f
+;;; 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.
+\\<package-menu-mode-map>"
+ (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)))
+
+\f
+;;; 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
next reply other threads:[~2015-04-19 13:30 UTC|newest]
Thread overview: 53+ messages / expand[flat|nested] mbox.gz Atom feed top
2015-04-19 13:31 Nicolas Goaziou [this message]
2015-04-19 14:23 ` [RFC] Org linting library Rasmus
2015-04-19 16:24 ` Nicolas Goaziou
2015-04-19 19:32 ` Marco Wahl
2015-04-20 10:42 ` Nicolas Goaziou
2015-04-20 2:15 ` Charles C. Berry
2015-04-20 9:12 ` Nicolas Goaziou
2015-04-22 19:27 ` Nicolas Goaziou
2015-04-22 19:31 ` Sebastien Vauban
2015-04-22 19:40 ` Nicolas Goaziou
2015-04-23 10:47 ` Eric Abrahamsen
2015-04-23 16:25 ` Sebastien Vauban
2015-04-26 12:50 ` Nicolas Goaziou
2015-04-27 15:22 ` Doug Lewan
2015-05-19 11:54 ` Andreas Leha
2015-05-19 13:39 ` Nicolas Goaziou
2015-05-19 14:54 ` Andreas Leha
2015-05-19 19:09 ` Nicolas Goaziou
2015-05-19 20:02 ` Andreas Leha
2015-05-19 21:03 ` Nicolas Goaziou
2015-05-19 21:10 ` Andreas Leha
2015-05-19 21:26 ` Nicolas Goaziou
2015-05-19 21:35 ` Andreas Leha
2015-05-19 13:32 ` Rainer M Krug
2015-05-19 13:43 ` Andreas Leha
2015-05-20 15:01 ` Rainer M Krug
2015-05-20 15:08 ` Rainer M Krug
2015-05-20 15:24 ` Rainer M Krug
2015-05-20 20:42 ` Andreas Leha
2015-05-20 21:15 ` Rainer M Krug
2015-05-20 21:46 ` Nicolas Goaziou
2015-05-21 8:40 ` Rainer M Krug
2015-05-21 16:24 ` Nicolas Goaziou
2015-05-21 18:18 ` Rainer M Krug
2015-05-21 18:23 ` Rainer M Krug
2015-05-21 18:30 ` Rainer M Krug
2015-05-21 21:53 ` Nicolas Goaziou
2015-05-22 8:10 ` Rainer M Krug
2015-05-22 19:08 ` Nicolas Goaziou
2015-05-23 12:00 ` Rainer M Krug
2015-05-24 15:19 ` Nicolas Goaziou
2015-05-24 15:52 ` Rainer M Krug
2015-05-27 9:31 ` Andreas Leha
2015-05-27 10:49 ` Nicolas Goaziou
2015-05-19 13:47 ` Nicolas Goaziou
2015-06-05 10:51 ` Rainer M Krug
2015-06-05 21:40 ` Nicolas Goaziou
2015-06-06 14:44 ` Rainer M Krug
2015-06-06 23:22 ` Nicolas Goaziou
2015-06-08 7:50 ` Rainer M Krug
2015-06-09 7:30 ` Nicolas Goaziou
2015-06-09 7:50 ` Rainer M Krug
2015-06-16 21:54 ` Nicolas Goaziou
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87a8y4fdmv.fsf@nicolasgoaziou.fr \
--to=mail@nicolasgoaziou.fr \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).