diff options
Diffstat (limited to 'elpa/org-9.5.2/org-lint.el')
| -rw-r--r-- | elpa/org-9.5.2/org-lint.el | 1321 |
1 files changed, 0 insertions, 1321 deletions
diff --git a/elpa/org-9.5.2/org-lint.el b/elpa/org-9.5.2/org-lint.el deleted file mode 100644 index da5e6ae..0000000 --- a/elpa/org-9.5.2/org-lint.el +++ /dev/null @@ -1,1321 +0,0 @@ -;;; org-lint.el --- Linting for Org documents -*- lexical-binding: t; -*- - -;; Copyright (C) 2015-2021 Free Software Foundation, Inc. - -;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr> -;; Keywords: outlines, hypermedia, calendar, wp - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://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 non-nil symbol that doesn't -;; start with an hyphen. -;; -;; 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. Also, "h" hides all reports similar to the current -;; one. Additionally, "i" removes them from subsequent reports. - -;; 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 source blocks -;; - missing back-end in export blocks -;; - invalid Babel call blocks -;; - NAME values with a colon -;; - deprecated export block syntax -;; - deprecated Babel header properties -;; - wrong header arguments in source 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 -;; - obsolete markup in INCLUDE keyword -;; - unknown items in OPTIONS keyword -;; - spurious macro arguments or invalid macro templates -;; - special properties in properties drawer -;; - obsolete syntax for PROPERTIES drawers -;; - Invalid EFFORT property value -;; - 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 -;; - obsolete "file+application" link -;; - spurious colons in tags - - -;;; Code: - -(require 'cl-lib) -(require 'ob) -(require 'ol) -(require 'org-attach) -(require 'org-macro) -(require 'ox) - - -;;; 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 'deprecated-export-blocks - :description "Report deprecated export block syntax" - :categories '(obsolete export) - :trust 'low) - (make-org-lint-checker - :name 'deprecated-header-syntax - :description "Report deprecated Babel header syntax" - :categories '(obsolete babel) - :trust 'low) - (make-org-lint-checker - :name 'missing-language-in-src-block - :description "Report missing language in source blocks" - :categories '(babel)) - (make-org-lint-checker - :name 'missing-backend-in-export-block - :description "Report missing back-end in export blocks" - :categories '(export)) - (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 'wrong-header-value - :description "Report invalid value in babel headers" - :categories '(babel) - :trust 'low) - (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" - :categories '(export) - :trust 'low) - (make-org-lint-checker - :name 'obsolete-include-markup - :description "Report obsolete markup in INCLUDE keyword" - :categories '(obsolete 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 templates" - :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 'invalid-effort-property - :description "Report invalid duration in EFFORT property" - :categories '(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) - (make-org-lint-checker - :name 'file-application - :description "Report obsolete \"file+application\" link" - :categories '(link obsolete)) - (make-org-lint-checker - :name 'percent-encoding-link-escape - :description "Report obsolete escape syntax in links" - :categories '(link obsolete) - :trust 'low) - (make-org-lint-checker - :name 'spurious-colons - :description "Report spurious colons in tags" - :categories '(tags))) - "List of all available checkers.") - -(defun org-lint--collect-duplicates - (ast type extract-key extract-position build-message) - "Helper function to collect duplicates in parse tree AST. - -EXTRACT-KEY is a function extracting key. It is called with -a single argument: the element or object. Comparison is done -with `equal'. - -EXTRACT-POSITION is a function returning position for the report. -It is called with two arguments, the object or element, and the -key. - -BUILD-MESSAGE is a function creating the report message. It is -called with one argument, the key used for comparison." - (let* (keys - originals - reports - (make-report - (lambda (position value) - (push (list position (funcall build-message value)) reports)))) - (org-element-map ast type - (lambda (datum) - (let ((key (funcall extract-key datum))) - (cond - ((not key)) - ((assoc key keys) (cl-pushnew (assoc key keys) originals) - (funcall make-report (funcall extract-position datum key) key)) - (t (push (cons key (funcall extract-position datum key)) keys)))))) - (dolist (e originals reports) (funcall make-report (cdr e) (car e))))) - -(defun org-lint-duplicate-custom-id (ast) - (org-lint--collect-duplicates - ast - 'node-property - (lambda (property) - (and (eq (compare-strings "CUSTOM_ID" nil nil - (org-element-property :key property) nil nil - t) - t) - (org-element-property :value property))) - (lambda (property _) (org-element-property :begin property)) - (lambda (key) (format "Duplicate CUSTOM_ID property \"%s\"" key)))) - -(defun org-lint-duplicate-name (ast) - (org-lint--collect-duplicates - ast - org-element-all-elements - (lambda (datum) (org-element-property :name datum)) - (lambda (datum name) - (goto-char (org-element-property :begin datum)) - (re-search-forward - (format "^[ \t]*#\\+[A-Za-z]+:[ \t]*%s[ \t]*$" (regexp-quote name))) - (match-beginning 0)) - (lambda (key) (format "Duplicate NAME \"%s\"" key)))) - -(defun org-lint-duplicate-target (ast) - (org-lint--collect-duplicates - ast - 'target - (lambda (target) (split-string (org-element-property :value target))) - (lambda (target _) (org-element-property :begin target)) - (lambda (key) - (format "Duplicate target <<%s>>" (mapconcat #'identity key " "))))) - -(defun org-lint-duplicate-footnote-definition (ast) - (org-lint--collect-duplicates - ast - 'footnote-definition - (lambda (definition) (org-element-property :label definition)) - (lambda (definition _) (org-element-property :post-affiliated definition)) - (lambda (key) (format "Duplicate footnote definition \"%s\"" key)))) - -(defun org-lint-orphaned-affiliated-keywords (ast) - ;; Ignore orphan RESULTS keywords, which could be generated from - ;; a source block returning no value. - (let ((keywords (cl-set-difference org-element-affiliated-keywords - '("RESULT" "RESULTS") - :test #'equal))) - (org-element-map ast 'keyword - (lambda (k) - (let ((key (org-element-property :key k))) - (and (or (let ((case-fold-search t)) - (string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key)) - (member key 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 (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-deprecated-export-blocks (ast) - (let ((deprecated '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD" - "ODT" "ORG" "TEXINFO"))) - (org-element-map ast 'special-block - (lambda (b) - (let ((type (org-element-property :type b))) - (when (member-ignore-case type deprecated) - (list - (org-element-property :post-affiliated b) - (format - "Deprecated syntax for export block. Use \"BEGIN_EXPORT %s\" \ -instead" - type)))))))) - -(defun org-lint-deprecated-header-syntax (ast) - (let* ((deprecated-babel-properties - ;; DIR is also used for attachments. - (delete "dir" - (mapcar (lambda (arg) (downcase (symbol-name (car arg)))) - org-babel-common-header-args-w-values))) - (deprecated-re - (format "\\`%s[ \t]" (regexp-opt deprecated-babel-properties t)))) - (org-element-map ast '(keyword node-property) - (lambda (datum) - (let ((key (org-element-property :key datum))) - (pcase (org-element-type datum) - (`keyword - (let ((value (org-element-property :value datum))) - (and (string= key "PROPERTY") - (string-match deprecated-re value) - (list (org-element-property :begin datum) - (format "Deprecated syntax for \"%s\". \ -Use header-args instead" - (match-string-no-properties 1 value)))))) - (`node-property - (and (member-ignore-case key deprecated-babel-properties) - (list - (org-element-property :begin datum) - (format "Deprecated syntax for \"%s\". \ -Use :header-args: instead" - key)))))))))) - -(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-missing-backend-in-export-block (ast) - (org-element-map ast 'export-block - (lambda (b) - (unless (org-element-property :type b) - (list (org-element-property :post-affiliated b) - "Missing back-end in export 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 (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= (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 ((headline? (org-element-lineage d '(headline))) - (before - (mapcar #'org-element-type - (assq d (reverse (org-element-contents - (org-element-property :parent d))))))) - (list (org-element-property :post-affiliated d) - (if (or (and headline? (member before '(nil (planning)))) - (and (null headline?) (member before '(nil (comment))))) - "Incorrect contents for PROPERTIES drawer" - "Incorrect location for PROPERTIES drawer"))))))) - -(defun org-lint-invalid-effort-property (ast) - (org-element-map ast 'node-property - (lambda (p) - (when (equal "EFFORT" (org-element-property :key p)) - (let ((value (org-element-property :value p))) - (and (org-string-nw-p value) - (not (org-duration-p value)) - (list (org-element-property :begin p) - (format "Invalid effort duration format: %S" value)))))))) - -(defun org-lint-link-to-local-file (ast) - (org-element-map ast 'link - (lambda (l) - (let ((type (org-element-property :type l))) - (pcase type - ((or "attachment" "file") - (let* ((path (org-element-property :path l)) - (file (if (string= type "file") - path - (org-with-point-at (org-element-property :begin l) - (org-attach-expand path))))) - (and (not (file-remote-p file)) - (not (file-exists-p file)) - (list (org-element-property :begin l) - (format (if (org-element-lineage l '(link)) - "Link to non-existent image file %S \ -in description" - "Link to non-existent local file %S") - file))))) - (_ nil)))))) - -(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-unbracket-string - "\"" "\"" - (org-element-property :value k)))) - (and (not (org-url-p file)) - (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-strip-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))) - (org-link-search-must-match-exact-headline t)) - (unwind-protect - (with-current-buffer buffer - (when (and search - (not (ignore-errors - (org-link-search search 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-obsolete-include-markup (ast) - (let ((regexp (format "\\`\\(?:\".+\"\\|\\S-+\\)[ \t]+%s" - (regexp-opt - '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD" - "ODT" "ORG" "TEXINFO") - t)))) - (org-element-map ast 'keyword - (lambda (k) - (when (equal (org-element-property :key k) "INCLUDE") - (let ((case-fold-search t) - (value (org-element-property :value k))) - (when (string-match regexp value) - (let ((markup (match-string-no-properties 1 value))) - (list (org-element-property :post-affiliated k) - (format "Obsolete markup \"%s\" in INCLUDE keyword. \ -Use \"export %s\" instead" - markup - markup)))))))))) - -(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= (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)) - (unless (match-string 2 value) - (push (list (org-element-property :post-affiliated k) - (format "Missing value for option item %S" item)) - reports)))))))) - reports)) - -(defun org-lint-invalid-macro-argument-and-template (ast) - (let* ((reports nil) - (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) #'<)))) - (check-arity - (lambda (arity macro) - (let* ((name (org-element-property :key macro)) - (pos (org-element-property :begin macro)) - (args (org-element-property :args macro)) - (l (length args))) - (cond - ((< l (1- (car arity))) - (push (list pos (format "Missing arguments in macro %S" name)) - reports)) - ((< l (car arity)) - (push (list pos (format "Missing argument in macro %S" name)) - reports)) - ((> l (1+ (cdr arity))) - (push (let ((spurious-args (nthcdr (cdr arity) args))) - (list pos - (format "Spurious arguments in macro %S: %s" - name - (mapconcat #'org-trim spurious-args ", ")))) - reports)) - ((> l (cdr arity)) - (push (list pos - (format "Spurious argument in macro %S: %s" - name - (org-last args))) - reports)) - (t nil)))))) - ;; Check arguments for macro templates. - (org-element-map ast 'keyword - (lambda (k) - (when (string= (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 (or (org-last args) 0)) 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)))) - (pcase template - (`nil - (push (list (org-element-property :begin macro) - (format "Undefined macro %S" name)) - reports)) - ((guard (string= name "keyword")) - (funcall check-arity '(1 . 1) macro)) - ((guard (string= name "modification-time")) - (funcall check-arity '(1 . 2) macro)) - ((guard (string= name "n")) - (funcall check-arity '(0 . 2) macro)) - ((guard (string= name "property")) - (funcall check-arity '(1 . 2) macro)) - ((guard (string= name "time")) - (funcall check-arity '(1 . 1) macro)) - ((pred functionp)) ;ignore (eval ...) templates - (_ - (let* ((arg-numbers (funcall extract-placeholders template)) - (arity (if (null arg-numbers) - '(0 . 0) - (let ((m (apply #'max arg-numbers))) - (cons m m))))) - (funcall check-arity arity macro)))))))) - 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 (eq 'standard (org-element-property :type f)) - (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 - (string-match-p ":" name) - (list (progn - (goto-char (org-element-property :begin e)) - (re-search-forward - (format "^[ \t]*#\\+\\w+: +%s *$" (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 (match-string-no-properties 0))) - (element (org-element-at-point))) - (pcase (org-element-type element) - (`drawer - ;; Find drawer opening lines within non-empty drawers. - (let ((end (org-element-property :contents-end element))) - (when end - (while (re-search-forward org-drawer-regexp end t) - (let ((n (org-trim (match-string-no-properties 0)))) - (push (list (line-beginning-position) - (format "Possible misleading drawer entry %S" n)) - reports)))) - (goto-char (org-element-property :end element)))) - (`property-drawer - (goto-char (org-element-property :end element))) - ((or `comment-block `example-block `export-block `src-block - `verse-block) - nil) - (_ - ;; Find drawer opening lines outside of any drawer. - (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:]:]*\\)\\(?: \\|$\\)") - (exception-re - (format "[ \t]*#\\+%s\\(\\[.*\\]\\)?:\\(?: \\|$\\)" - (regexp-opt org-element-dual-keywords))) - reports) - (while (re-search-forward regexp nil t) - (let ((name (match-string-no-properties 1))) - (unless (or (string-prefix-p "BEGIN" name t) - (string-prefix-p "END" name t) - (save-excursion - (beginning-of-line) - (let ((case-fold-search t)) (looking-at exception-re)))) - (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) - (cl-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 are not exported"))))) - -(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-file-application (ast) - (org-element-map ast 'link - (lambda (l) - (let ((app (org-element-property :application l))) - (and app - (list (org-element-property :begin l) - (format "Deprecated \"file+%s\" link type" app))))))) - -(defun org-lint-percent-encoding-link-escape (ast) - (org-element-map ast 'link - (lambda (l) - (when (eq 'bracket (org-element-property :format l)) - (let* ((uri (org-element-property :path l)) - (start 0) - (obsolete-flag - (catch :obsolete - (while (string-match "%\\(..\\)?" uri start) - (setq start (match-end 0)) - (unless (member (match-string 1 uri) '("25" "5B" "5D" "20")) - (throw :obsolete nil))) - (string-match-p "%" uri)))) - (when obsolete-flag - (list (org-element-property :begin l) - "Link escaped with obsolete percent-encoding syntax"))))))) - -(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 (symbol-name (car header))) - (p (or (org-element-property :post-affiliated datum) - (org-element-property :begin datum)))) - (cond - ((not (string-prefix-p ":" h)) - (push - (list p - (format "Missing colon in header argument \"%s\"" h)) - reports)) - ((assoc-string (substring h 1) allowed)) - (t (push (list p (format "Unknown header argument \"%s\"" h)) - reports))))))))) - (org-element-map ast '(babel-call inline-babel-call inline-src-block keyword - 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= (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)) - -(defun org-lint-wrong-header-value (ast) - (let (reports) - (org-element-map ast - '(babel-call inline-babel-call inline-src-block src-block) - (lambda (datum) - (let* ((type (org-element-type datum)) - (language (org-element-property :language datum)) - (allowed-header-values - (append (and language - (let ((v (intern (concat "org-babel-header-args:" - language)))) - (and (boundp v) (symbol-value v)))) - org-babel-common-header-args-w-values)) - (datum-header-values - (org-babel-parse-header-arguments - (org-trim - (pcase type - (`src-block - (mapconcat - #'identity - (cons (org-element-property :parameters datum) - (org-element-property :header datum)) - " ")) - (`inline-src-block - (or (org-element-property :parameters datum) "")) - (_ - (concat - (org-element-property :inside-header datum) - " " - (org-element-property :end-header datum)))))))) - (dolist (header datum-header-values) - (let ((allowed-values - (cdr (assoc-string (substring (symbol-name (car header)) 1) - allowed-header-values)))) - (unless (memq allowed-values '(:any nil)) - (let ((values (cdr header)) - groups-alist) - (dolist (v (if (stringp values) (split-string values) - (list values))) - (let ((valid-value nil)) - (catch 'exit - (dolist (group allowed-values) - (cond - ((not (funcall - (if (stringp v) #'assoc-string #'assoc) - v group)) - (when (memq :any group) - (setf valid-value t) - (push (cons group v) groups-alist))) - ((assq group groups-alist) - (push - (list - (or (org-element-property :post-affiliated datum) - (org-element-property :begin datum)) - (format - "Forbidden combination in header \"%s\": %s, %s" - (car header) - (cdr (assq group groups-alist)) - v)) - reports) - (throw 'exit nil)) - (t (push (cons group v) groups-alist) - (setf valid-value t)))) - (unless valid-value - (push - (list - (or (org-element-property :post-affiliated datum) - (org-element-property :begin datum)) - (format "Unknown value \"%s\" for header \"%s\"" - v - (car header))) - reports)))))))))))) - reports)) - -(defun org-lint-spurious-colons (ast) - (org-element-map ast '(headline inlinetask) - (lambda (h) - (when (member "" (org-element-property :tags h)) - (list (org-element-property :begin h) - "Tags contain a spurious colon"))))) - - - -;;; 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) - (define-key map (kbd "h") 'org-lint--hide-checker) - (define-key map (kbd "i") 'org-lint--ignore-checker) - 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. -\\{org-lint--report-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 t)]) - (tabulated-list-init-header)) - -(defun org-lint--generate-reports (buffer checkers) - "Generate linting report for BUFFER. - -CHECKERS is the list of checkers used. - -Return an alist (ID [LINE TRUST DESCRIPTION CHECKER]), suitable -for `tabulated-list-printer'." - (with-current-buffer buffer - (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 - (cl-incf id) - (apply #'vector - (cons - (progn - (goto-char (car report)) - (beginning-of-line) - (prog1 (number-to-string - (cl-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) c)) - (save-excursion - (funcall - (intern (format "org-lint-%s" - (org-lint-checker-name c))) - ast))))) - checkers) - #'car-less-than-car)))))) - -(defvar-local org-lint--source-buffer nil - "Source buffer associated to current report buffer.") - -(defvar-local org-lint--local-checkers nil - "List of checkers used to build current report.") - -(defun org-lint--refresh-reports () - (setq tabulated-list-entries - (org-lint--generate-reports org-lint--source-buffer - org-lint--local-checkers)) - (tabulated-list-print)) - -(defun org-lint--current-line () - "Return current report line, as a number." - (string-to-number (aref (tabulated-list-get-entry) 0))) - -(defun org-lint--current-checker (&optional entry) - "Return current report checker. -When optional argument ENTRY is non-nil, use this entry instead -of current one." - (aref (if entry (nth 1 entry) (tabulated-list-get-entry)) 3)) - -(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 org-lint--local-checkers checkers) - (org-lint--refresh-reports) - (add-hook 'tabulated-list-revert-hook #'org-lint--refresh-reports nil t)) - (pop-to-buffer buffer))) - -(defun org-lint--jump-to-source () - "Move to source line that generated the report at point." - (interactive) - (let ((l (org-lint--current-line))) - (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))) - -(defun org-lint--hide-checker () - "Hide all reports from checker that generated the report at point." - (interactive) - (let ((c (org-lint--current-checker))) - (setf tabulated-list-entries - (cl-remove-if (lambda (e) (equal c (org-lint--current-checker e))) - tabulated-list-entries)) - (tabulated-list-print))) - -(defun org-lint--ignore-checker () - "Ignore all reports from checker that generated the report at point. -Checker will also be ignored in all subsequent reports." - (interactive) - (setf org-lint--local-checkers - (remove (org-lint--current-checker) org-lint--local-checkers)) - (org-lint--hide-checker)) - - -;;; Public function - -;;;###autoload -(defun org-lint (&optional arg) - "Check current Org buffer for syntax mistakes. - -By default, run all checkers. With a `\\[universal-argument]' prefix ARG, \ -select one -category of checkers only. With a `\\[universal-argument] \ -\\[universal-argument]' prefix, run 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")) - (when (called-interactively-p 'any) - (message "Org linting process starting...")) - (let ((checkers - (pcase arg - (`nil org-lint--checkers) - (`(4) - (let ((category - (completing-read - "Checker category: " - (mapcar #'org-lint-checker-categories org-lint--checkers) - nil t))) - (cl-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) - (cl-remove-if-not (lambda (c) (memq (org-lint-checker-name c) arg)) - org-lint--checkers)) - (_ (user-error "Invalid argument `%S' for `org-lint'" arg))))) - (if (not (called-interactively-p 'any)) - (org-lint--generate-reports (current-buffer) checkers) - (org-lint--display-reports (current-buffer) checkers) - (message "Org linting process completed")))) - -(provide 'org-lint) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-lint.el ends here |