emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
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


             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).