From mboxrd@z Thu Jan 1 00:00:00 1970 From: Nicolas Goaziou Subject: Re: [RFC] Org linting library Date: Wed, 22 Apr 2015 21:27:46 +0200 Message-ID: <87zj60c6a5.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]:47293) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Yl0I1-0002rc-DL for emacs-orgmode@gnu.org; Wed, 22 Apr 2015 15:26:30 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Yl0Hy-0004Gn-QI for emacs-orgmode@gnu.org; Wed, 22 Apr 2015 15:26:29 -0400 Received: from relay4-d.mail.gandi.net ([2001:4b98:c:538::196]:34346) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Yl0Hy-0004GW-Bx for emacs-orgmode@gnu.org; Wed, 22 Apr 2015 15:26:26 -0400 Received: from selenimh (unknown [IPv6:2a01:6600:8080:9601::2de]) (Authenticated sender: mail@nicolasgoaziou.fr) by relay4-d.mail.gandi.net (Postfix) with ESMTPSA id C05E0172089 for ; Wed, 22 Apr 2015 21:26:24 +0200 (CEST) In-Reply-To: <87a8y4fdmv.fsf@nicolasgoaziou.fr> (Nicolas Goaziou's message of "Sun, 19 Apr 2015 15:31:36 +0200") 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: Org Mode List --=-=-= Content-Type: text/plain Here's another update. I added a few more tests. If there's no more bug report or feedback, I'll simply put it in a "wip-lint" branch until Org 8.4 starts its development cycle. Regards, --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=org-lint.el Content-Transfer-Encoding: quoted-printable ;;; 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 string ;; 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" and ;; "TAB" display problematic line reported under point whereas "RET" ;; jumps to it. ;; Checks currently implemented are: ;; - duplicate CUSTOM_ID properties ;; - duplicate NAME values ;; - duplicate targets ;; - duplicate footnote definitions ;; - orphaned affiliated keywords ;; - obsolete affiliated keywords ;; - missing language in src blocks ;; - invalid Babel call 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 ;; - unknown items in OPTIONS keyword ;; - spurious macro arguments or invalid macro templates ;; - 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 ;; - misplaced planning info line ;; - incomplete drawers ;; - indented diary-sexps ;; - obsolete QUOTE section ;;; Code: (require 'cl-lib) (require 'org-element) (require 'org-macro) (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 'invalid-babel-call-block :description "Report invalid Babel call 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 babel headers" :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 paramete= r" :trust 'low) (make-org-lint-checker :name 'wrong-include-link-parameter :description "Report INCLUDE keywords with misleading link parameter" :categories '(export) :trust 'low) (make-org-lint-checker :name 'unknown-options-item :description "Report unknown items in OPTIONS keyword" :categories '(export) :trust 'low) (make-org-lint-checker :name 'invalid-macro-argument-and-template :description "Report spurious macro arguments or invalid macro template= s" :categories '(export) :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)) (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" :categories '(footnote)) (make-org-lint-checker :name 'invalid-keyword-syntax :description "Report probable invalid keywords" :trust 'low) (make-org-lint-checker :name 'invalid-block :description "Report invalid blocks" :trust 'low) (make-org-lint-checker :name 'misplaced-planning-info :description "Report misplaced planning info line" :trust 'low) (make-org-lint-checker :name 'incomplete-drawer :description "Report probable incomplete drawers" :trust 'low) (make-org-lint-checker :name 'indented-diary-sexp :description "Report probable indented diary-sexps" :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-invalid-babel-call-block (ast) (org-element-map ast 'babel-call (lambda (b) (cond ((not (org-element-property :call b)) (list (org-element-property :post-affiliated b) "Invalid syntax in babel call block")) ((let ((h (org-element-property :end-header b))) (and h (org-string-match-p "\\`\\[.*\\]\\'" h))) (list (org-element-property :post-affiliated b) "Babel call's end header must not be wrapped within brackets")))))) (defun org-lint-deprecated-category-setup (ast) (org-element-map ast 'keyword (let (category-flag) (lambda (k) (cond ((not (string=3D (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-unknown-options-item (ast) (let ((allowed (delq nil (append (mapcar (lambda (o) (nth 2 o)) org-export-options-alist) (cl-mapcan (lambda (b) (mapcar (lambda (o) (nth 2 o)) (org-export-backend-options b))) org-export-registered-backends)))) reports) (org-element-map ast 'keyword (lambda (k) (when (string=3D (org-element-property :key k) "OPTIONS") (let ((value (org-element-property :value k)) (start 0)) (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-*\\)[ \t]*" value start) (setf start (match-end 0)) (let ((item (match-string 1 value))) (unless (member item allowed) (push (list (org-element-property :post-affiliated k) (format "Unknown OPTIONS item \"%s\"" item)) reports)))))))) reports)) (defun org-lint-invalid-macro-argument-and-template (ast) (let ((extract-placeholders (lambda (template) (let ((start 0) args) (while (string-match "\\$\\([1-9][0-9]*\\)" template start) (setf start (match-end 0)) (push (string-to-number (match-string 1 template)) args)) (sort (org-uniquify args) #'<)))) reports) ;; Check arguments for macro templates. (org-element-map ast 'keyword (lambda (k) (when (string=3D (org-element-property :key k) "MACRO") (let* ((value (org-element-property :value k)) (name (and (string-match "^\\S-+" value) (match-string 0 value))) (template (and name (org-trim (substring value (match-end 0)))))) (cond ((not name) (push (list (org-element-property :post-affiliated k) "Missing name in MACRO keyword") reports)) ((not (org-string-nw-p template)) (push (list (org-element-property :post-affiliated k) "Missing template in macro \"%s\"" name) reports)) (t (unless (let ((args (funcall extract-placeholders template))) (equal (number-sequence 1 (org-last args)) args)) (push (list (org-element-property :post-affiliated k) (format "Unused placeholders in macro \"%s\"" name)) reports)))))))) ;; Check arguments for macros. (org-macro-initialize-templates) (let ((templates (append (mapcar (lambda (m) (cons m "$1")) '("author" "date" "email" "title" "results")) org-macro-templates))) (org-element-map ast 'macro (lambda (macro) (let* ((name (org-element-property :key macro)) (template (cdr (assoc-string name templates t)))) (if (not template) (push (list (org-element-property :begin macro) (format "Undefined macro \"%s\"" name)) reports) (let ((spurious-args (nthcdr (apply #'max (funcall extract-placeholders template)) (org-element-property :args macro)))) (when spurious-args (push (list (org-element-property :begin macro) (format "Unused argument%s in macro \"%s\": %s" (if (> (length spurious-args) 1) "s" "") name (mapconcat (lambda (a) (format "\"%s\"" a)) spurious-args ", "))) reports)))))))) reports)) (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-misplaced-planning-info (_) (let ((case-fold-search t) reports) (while (re-search-forward org-planning-line-re nil t) (unless (memq (org-element-type (org-element-at-point)) '(comment-block example-block export-block planning src-block verse-block)) (push (list (line-beginning-position) "Misplaced planning info line") reports))) reports)) (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) ((or `drawer `property-drawer) (goto-char (org-element-property :end element)) nil) ((or `comment-block `example-block `export-block `src-block `verse-block) nil) (_ (push (list (line-beginning-position) (format "Possible incomplete drawer \"%s\"" name)) reports))))) reports)) (defun org-lint-indented-diary-sexp (_) (let (reports) (while (re-search-forward "^[ \t]+%%(" nil t) (unless (memq (org-element-type (org-element-at-point)) '(comment-block diary-sexp example-block export-block src-block verse-block)) (push (list (line-beginning-position) "Possible indented diary-sexp") reports))) reports)) (defun org-lint-invalid-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)) ((not (memq (org-element-type (org-element-at-point)) '(center-block comment-block dynamic-block example-block export-block quote-block special-block src-block verse-block))) (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 language headers) (let ((allowed ;; If LANGUAGE is specified, restrict allowed ;; headers to both LANGUAGE-specific and default ;; ones. Otherwise, accept headers from any loaded ;; language. (append org-babel-header-arg-names (cl-mapcan (lambda (l) (let ((v (intern (format "org-babel-header-args:%s" l)))) (and (boundp v) (mapcar #'car (symbol-value v))))) (if language (list language) (mapcar #'car org-babel-load-languages)))))) (dolist (header headers) (let ((h (substring (symbol-name (car header)) 1))) (unless (assoc-string h allowed) (push (list (or (org-element-property :post-affiliated datum) (org-element-property :begin datum)) (format "Unknown header argument \"%s\"" h)) reports)))))))) (org-element-map ast '(babel-call inline-babel-call inline-src-block ke= yword node-property src-block) (lambda (datum) (pcase (org-element-type datum) ((or `babel-call `inline-babel-call) (funcall verify datum nil (cl-mapcan #'org-babel-parse-header-arguments (list (org-element-property :inside-header datum) (org-element-property :end-header datum))))) (`inline-src-block (funcall verify datum (org-element-property :language datum) (org-babel-parse-header-arguments (org-element-property :parameters datum)))) (`keyword (when (string=3D (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 "TAB") 'org-lint--show-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 (format "org-lint-%s" (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))) (org-lint--jump-to-source) (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=3D (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 --=-=-=--