org-lint.el 43 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263
  1. ;;; org-lint.el --- Linting for Org documents -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2015-2019 Free Software Foundation, Inc.
  3. ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
  4. ;; Keywords: outlines, hypermedia, calendar, wp
  5. ;; This file is part of GNU Emacs.
  6. ;; GNU Emacs is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation, either version 3 of the License, or
  9. ;; (at your option) any later version.
  10. ;; GNU Emacs is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
  16. ;;; Commentary:
  17. ;; This library implements linting for Org syntax. The sole public
  18. ;; function is `org-lint', which see.
  19. ;; Internally, the library defines a new structure:
  20. ;; `org-lint-checker', with the following slots:
  21. ;; - NAME: Unique check identifier, as a non-nil symbol that doesn't
  22. ;; start with an hyphen.
  23. ;;
  24. ;; The check is done calling the function `org-lint-NAME' with one
  25. ;; mandatory argument, the parse tree describing the current Org
  26. ;; buffer. Such function calls are wrapped within
  27. ;; a `save-excursion' and point is always at `point-min'. Its
  28. ;; return value has to be an alist (POSITION MESSAGE) when
  29. ;; POSITION refer to the buffer position of the error, as an
  30. ;; integer, and MESSAGE is a string describing the error.
  31. ;; - DESCRIPTION: Summary about the check, as a string.
  32. ;; - CATEGORIES: Categories relative to the check, as a list of
  33. ;; symbol. They are used for filtering when calling `org-lint'.
  34. ;; Checkers not explicitly associated to a category are collected
  35. ;; in the `default' one.
  36. ;; - TRUST: The trust level one can have in the check. It is either
  37. ;; `low' or `high', depending on the heuristics implemented and
  38. ;; the nature of the check. This has an indicative value only and
  39. ;; is displayed along reports.
  40. ;; All checks have to be listed in `org-lint--checkers'.
  41. ;; Results are displayed in a special "*Org Lint*" buffer with
  42. ;; a dedicated major mode, derived from `tabulated-list-mode'.
  43. ;;
  44. ;; In addition to the usual key-bindings inherited from it, "C-j" and
  45. ;; "TAB" display problematic line reported under point whereas "RET"
  46. ;; jumps to it. Also, "h" hides all reports similar to the current
  47. ;; one. Additionally, "i" removes them from subsequent reports.
  48. ;; Checks currently implemented are:
  49. ;; - duplicate CUSTOM_ID properties
  50. ;; - duplicate NAME values
  51. ;; - duplicate targets
  52. ;; - duplicate footnote definitions
  53. ;; - orphaned affiliated keywords
  54. ;; - obsolete affiliated keywords
  55. ;; - missing language in source blocks
  56. ;; - missing back-end in export blocks
  57. ;; - invalid Babel call blocks
  58. ;; - NAME values with a colon
  59. ;; - deprecated export block syntax
  60. ;; - deprecated Babel header properties
  61. ;; - wrong header arguments in source blocks
  62. ;; - misuse of CATEGORY keyword
  63. ;; - "coderef" links with unknown destination
  64. ;; - "custom-id" links with unknown destination
  65. ;; - "fuzzy" links with unknown destination
  66. ;; - "id" links with unknown destination
  67. ;; - links to non-existent local files
  68. ;; - SETUPFILE keywords with non-existent file parameter
  69. ;; - INCLUDE keywords with wrong link parameter
  70. ;; - obsolete markup in INCLUDE keyword
  71. ;; - unknown items in OPTIONS keyword
  72. ;; - spurious macro arguments or invalid macro templates
  73. ;; - special properties in properties drawer
  74. ;; - obsolete syntax for PROPERTIES drawers
  75. ;; - Invalid EFFORT property value
  76. ;; - missing definition for footnote references
  77. ;; - missing reference for footnote definitions
  78. ;; - non-footnote definitions in footnote section
  79. ;; - probable invalid keywords
  80. ;; - invalid blocks
  81. ;; - misplaced planning info line
  82. ;; - incomplete drawers
  83. ;; - indented diary-sexps
  84. ;; - obsolete QUOTE section
  85. ;; - obsolete "file+application" link
  86. ;; - spurious colons in tags
  87. ;;; Code:
  88. (require 'cl-lib)
  89. (require 'ob)
  90. (require 'ol)
  91. (require 'org-macro)
  92. (require 'ox)
  93. ;;; Checkers
  94. (cl-defstruct (org-lint-checker (:copier nil))
  95. (name 'missing-checker-name)
  96. (description "")
  97. (categories '(default))
  98. (trust 'high)) ; `low' or `high'
  99. (defun org-lint-missing-checker-name (_)
  100. (error
  101. "`A checker has no `:name' property. Please verify `org-lint--checkers'"))
  102. (defconst org-lint--checkers
  103. (list
  104. (make-org-lint-checker
  105. :name 'duplicate-custom-id
  106. :description "Report duplicates CUSTOM_ID properties"
  107. :categories '(link))
  108. (make-org-lint-checker
  109. :name 'duplicate-name
  110. :description "Report duplicate NAME values"
  111. :categories '(babel link))
  112. (make-org-lint-checker
  113. :name 'duplicate-target
  114. :description "Report duplicate targets"
  115. :categories '(link))
  116. (make-org-lint-checker
  117. :name 'duplicate-footnote-definition
  118. :description "Report duplicate footnote definitions"
  119. :categories '(footnote))
  120. (make-org-lint-checker
  121. :name 'orphaned-affiliated-keywords
  122. :description "Report orphaned affiliated keywords"
  123. :trust 'low)
  124. (make-org-lint-checker
  125. :name 'obsolete-affiliated-keywords
  126. :description "Report obsolete affiliated keywords"
  127. :categories '(obsolete))
  128. (make-org-lint-checker
  129. :name 'deprecated-export-blocks
  130. :description "Report deprecated export block syntax"
  131. :categories '(obsolete export)
  132. :trust 'low)
  133. (make-org-lint-checker
  134. :name 'deprecated-header-syntax
  135. :description "Report deprecated Babel header syntax"
  136. :categories '(obsolete babel)
  137. :trust 'low)
  138. (make-org-lint-checker
  139. :name 'missing-language-in-src-block
  140. :description "Report missing language in source blocks"
  141. :categories '(babel))
  142. (make-org-lint-checker
  143. :name 'missing-backend-in-export-block
  144. :description "Report missing back-end in export blocks"
  145. :categories '(export))
  146. (make-org-lint-checker
  147. :name 'invalid-babel-call-block
  148. :description "Report invalid Babel call blocks"
  149. :categories '(babel))
  150. (make-org-lint-checker
  151. :name 'colon-in-name
  152. :description "Report NAME values with a colon"
  153. :categories '(babel))
  154. (make-org-lint-checker
  155. :name 'wrong-header-argument
  156. :description "Report wrong babel headers"
  157. :categories '(babel))
  158. (make-org-lint-checker
  159. :name 'wrong-header-value
  160. :description "Report invalid value in babel headers"
  161. :categories '(babel)
  162. :trust 'low)
  163. (make-org-lint-checker
  164. :name 'deprecated-category-setup
  165. :description "Report misuse of CATEGORY keyword"
  166. :categories '(obsolete))
  167. (make-org-lint-checker
  168. :name 'invalid-coderef-link
  169. :description "Report \"coderef\" links with unknown destination"
  170. :categories '(link))
  171. (make-org-lint-checker
  172. :name 'invalid-custom-id-link
  173. :description "Report \"custom-id\" links with unknown destination"
  174. :categories '(link))
  175. (make-org-lint-checker
  176. :name 'invalid-fuzzy-link
  177. :description "Report \"fuzzy\" links with unknown destination"
  178. :categories '(link))
  179. (make-org-lint-checker
  180. :name 'invalid-id-link
  181. :description "Report \"id\" links with unknown destination"
  182. :categories '(link))
  183. (make-org-lint-checker
  184. :name 'link-to-local-file
  185. :description "Report links to non-existent local files"
  186. :categories '(link)
  187. :trust 'low)
  188. (make-org-lint-checker
  189. :name 'non-existent-setupfile-parameter
  190. :description "Report SETUPFILE keywords with non-existent file parameter"
  191. :trust 'low)
  192. (make-org-lint-checker
  193. :name 'wrong-include-link-parameter
  194. :description "Report INCLUDE keywords with misleading link parameter"
  195. :categories '(export)
  196. :trust 'low)
  197. (make-org-lint-checker
  198. :name 'obsolete-include-markup
  199. :description "Report obsolete markup in INCLUDE keyword"
  200. :categories '(obsolete export)
  201. :trust 'low)
  202. (make-org-lint-checker
  203. :name 'unknown-options-item
  204. :description "Report unknown items in OPTIONS keyword"
  205. :categories '(export)
  206. :trust 'low)
  207. (make-org-lint-checker
  208. :name 'invalid-macro-argument-and-template
  209. :description "Report spurious macro arguments or invalid macro templates"
  210. :categories '(export)
  211. :trust 'low)
  212. (make-org-lint-checker
  213. :name 'special-property-in-properties-drawer
  214. :description "Report special properties in properties drawers"
  215. :categories '(properties))
  216. (make-org-lint-checker
  217. :name 'obsolete-properties-drawer
  218. :description "Report obsolete syntax for properties drawers"
  219. :categories '(obsolete properties))
  220. (make-org-lint-checker
  221. :name 'invalid-effort-property
  222. :description "Report invalid duration in EFFORT property"
  223. :categories '(properties))
  224. (make-org-lint-checker
  225. :name 'undefined-footnote-reference
  226. :description "Report missing definition for footnote references"
  227. :categories '(footnote))
  228. (make-org-lint-checker
  229. :name 'unreferenced-footnote-definition
  230. :description "Report missing reference for footnote definitions"
  231. :categories '(footnote))
  232. (make-org-lint-checker
  233. :name 'extraneous-element-in-footnote-section
  234. :description "Report non-footnote definitions in footnote section"
  235. :categories '(footnote))
  236. (make-org-lint-checker
  237. :name 'invalid-keyword-syntax
  238. :description "Report probable invalid keywords"
  239. :trust 'low)
  240. (make-org-lint-checker
  241. :name 'invalid-block
  242. :description "Report invalid blocks"
  243. :trust 'low)
  244. (make-org-lint-checker
  245. :name 'misplaced-planning-info
  246. :description "Report misplaced planning info line"
  247. :trust 'low)
  248. (make-org-lint-checker
  249. :name 'incomplete-drawer
  250. :description "Report probable incomplete drawers"
  251. :trust 'low)
  252. (make-org-lint-checker
  253. :name 'indented-diary-sexp
  254. :description "Report probable indented diary-sexps"
  255. :trust 'low)
  256. (make-org-lint-checker
  257. :name 'quote-section
  258. :description "Report obsolete QUOTE section"
  259. :categories '(obsolete)
  260. :trust 'low)
  261. (make-org-lint-checker
  262. :name 'file-application
  263. :description "Report obsolete \"file+application\" link"
  264. :categories '(link obsolete))
  265. (make-org-lint-checker
  266. :name 'percent-encoding-link-escape
  267. :description "Report obsolete escape syntax in links"
  268. :categories '(link obsolete)
  269. :trust 'low)
  270. (make-org-lint-checker
  271. :name 'spurious-colons
  272. :description "Report spurious colons in tags"
  273. :categories '(tags)))
  274. "List of all available checkers.")
  275. (defun org-lint--collect-duplicates
  276. (ast type extract-key extract-position build-message)
  277. "Helper function to collect duplicates in parse tree AST.
  278. EXTRACT-KEY is a function extracting key. It is called with
  279. a single argument: the element or object. Comparison is done
  280. with `equal'.
  281. EXTRACT-POSITION is a function returning position for the report.
  282. It is called with two arguments, the object or element, and the
  283. key.
  284. BUILD-MESSAGE is a function creating the report message. It is
  285. called with one argument, the key used for comparison."
  286. (let* (keys
  287. originals
  288. reports
  289. (make-report
  290. (lambda (position value)
  291. (push (list position (funcall build-message value)) reports))))
  292. (org-element-map ast type
  293. (lambda (datum)
  294. (let ((key (funcall extract-key datum)))
  295. (cond
  296. ((not key))
  297. ((assoc key keys) (cl-pushnew (assoc key keys) originals)
  298. (funcall make-report (funcall extract-position datum key) key))
  299. (t (push (cons key (funcall extract-position datum key)) keys))))))
  300. (dolist (e originals reports) (funcall make-report (cdr e) (car e)))))
  301. (defun org-lint-duplicate-custom-id (ast)
  302. (org-lint--collect-duplicates
  303. ast
  304. 'node-property
  305. (lambda (property)
  306. (and (eq (compare-strings "CUSTOM_ID" nil nil
  307. (org-element-property :key property) nil nil
  308. t)
  309. t)
  310. (org-element-property :value property)))
  311. (lambda (property _) (org-element-property :begin property))
  312. (lambda (key) (format "Duplicate CUSTOM_ID property \"%s\"" key))))
  313. (defun org-lint-duplicate-name (ast)
  314. (org-lint--collect-duplicates
  315. ast
  316. org-element-all-elements
  317. (lambda (datum) (org-element-property :name datum))
  318. (lambda (datum name)
  319. (goto-char (org-element-property :begin datum))
  320. (re-search-forward
  321. (format "^[ \t]*#\\+[A-Za-z]+: +%s *$" (regexp-quote name)))
  322. (match-beginning 0))
  323. (lambda (key) (format "Duplicate NAME \"%s\"" key))))
  324. (defun org-lint-duplicate-target (ast)
  325. (org-lint--collect-duplicates
  326. ast
  327. 'target
  328. (lambda (target) (split-string (org-element-property :value target)))
  329. (lambda (target _) (org-element-property :begin target))
  330. (lambda (key)
  331. (format "Duplicate target <<%s>>" (mapconcat #'identity key " ")))))
  332. (defun org-lint-duplicate-footnote-definition (ast)
  333. (org-lint--collect-duplicates
  334. ast
  335. 'footnote-definition
  336. (lambda (definition) (org-element-property :label definition))
  337. (lambda (definition _) (org-element-property :post-affiliated definition))
  338. (lambda (key) (format "Duplicate footnote definition \"%s\"" key))))
  339. (defun org-lint-orphaned-affiliated-keywords (ast)
  340. ;; Ignore orphan RESULTS keywords, which could be generated from
  341. ;; a source block returning no value.
  342. (let ((keywords (cl-set-difference org-element-affiliated-keywords
  343. '("RESULT" "RESULTS")
  344. :test #'equal)))
  345. (org-element-map ast 'keyword
  346. (lambda (k)
  347. (let ((key (org-element-property :key k)))
  348. (and (or (let ((case-fold-search t))
  349. (string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key))
  350. (member key keywords))
  351. (list (org-element-property :post-affiliated k)
  352. (format "Orphaned affiliated keyword: \"%s\"" key))))))))
  353. (defun org-lint-obsolete-affiliated-keywords (_)
  354. (let ((regexp (format "^[ \t]*#\\+%s:"
  355. (regexp-opt '("DATA" "LABEL" "RESNAME" "SOURCE"
  356. "SRCNAME" "TBLNAME" "RESULT" "HEADERS")
  357. t)))
  358. reports)
  359. (while (re-search-forward regexp nil t)
  360. (let ((key (upcase (match-string-no-properties 1))))
  361. (when (< (point)
  362. (org-element-property :post-affiliated (org-element-at-point)))
  363. (push
  364. (list (line-beginning-position)
  365. (format
  366. "Obsolete affiliated keyword: \"%s\". Use \"%s\" instead"
  367. key
  368. (pcase key
  369. ("HEADERS" "HEADER")
  370. ("RESULT" "RESULTS")
  371. (_ "NAME"))))
  372. reports))))
  373. reports))
  374. (defun org-lint-deprecated-export-blocks (ast)
  375. (let ((deprecated '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
  376. "ODT" "ORG" "TEXINFO")))
  377. (org-element-map ast 'special-block
  378. (lambda (b)
  379. (let ((type (org-element-property :type b)))
  380. (when (member-ignore-case type deprecated)
  381. (list
  382. (org-element-property :post-affiliated b)
  383. (format
  384. "Deprecated syntax for export block. Use \"BEGIN_EXPORT %s\" \
  385. instead"
  386. type))))))))
  387. (defun org-lint-deprecated-header-syntax (ast)
  388. (let* ((deprecated-babel-properties
  389. (mapcar (lambda (arg) (symbol-name (car arg)))
  390. org-babel-common-header-args-w-values))
  391. (deprecated-re
  392. (format "\\`%s[ \t]" (regexp-opt deprecated-babel-properties t))))
  393. (org-element-map ast '(keyword node-property)
  394. (lambda (datum)
  395. (let ((key (org-element-property :key datum)))
  396. (pcase (org-element-type datum)
  397. (`keyword
  398. (let ((value (org-element-property :value datum)))
  399. (and (string= key "PROPERTY")
  400. (string-match deprecated-re value)
  401. (list (org-element-property :begin datum)
  402. (format "Deprecated syntax for \"%s\". \
  403. Use header-args instead"
  404. (match-string-no-properties 1 value))))))
  405. (`node-property
  406. (and (member-ignore-case key deprecated-babel-properties)
  407. (list
  408. (org-element-property :begin datum)
  409. (format "Deprecated syntax for \"%s\". \
  410. Use :header-args: instead"
  411. key))))))))))
  412. (defun org-lint-missing-language-in-src-block (ast)
  413. (org-element-map ast 'src-block
  414. (lambda (b)
  415. (unless (org-element-property :language b)
  416. (list (org-element-property :post-affiliated b)
  417. "Missing language in source block")))))
  418. (defun org-lint-missing-backend-in-export-block (ast)
  419. (org-element-map ast 'export-block
  420. (lambda (b)
  421. (unless (org-element-property :type b)
  422. (list (org-element-property :post-affiliated b)
  423. "Missing back-end in export block")))))
  424. (defun org-lint-invalid-babel-call-block (ast)
  425. (org-element-map ast 'babel-call
  426. (lambda (b)
  427. (cond
  428. ((not (org-element-property :call b))
  429. (list (org-element-property :post-affiliated b)
  430. "Invalid syntax in babel call block"))
  431. ((let ((h (org-element-property :end-header b)))
  432. (and h (string-match-p "\\`\\[.*\\]\\'" h)))
  433. (list
  434. (org-element-property :post-affiliated b)
  435. "Babel call's end header must not be wrapped within brackets"))))))
  436. (defun org-lint-deprecated-category-setup (ast)
  437. (org-element-map ast 'keyword
  438. (let (category-flag)
  439. (lambda (k)
  440. (cond
  441. ((not (string= (org-element-property :key k) "CATEGORY")) nil)
  442. (category-flag
  443. (list (org-element-property :post-affiliated k)
  444. "Spurious CATEGORY keyword. Set :CATEGORY: property instead"))
  445. (t (setf category-flag t) nil))))))
  446. (defun org-lint-invalid-coderef-link (ast)
  447. (let ((info (list :parse-tree ast)))
  448. (org-element-map ast 'link
  449. (lambda (link)
  450. (let ((ref (org-element-property :path link)))
  451. (and (equal (org-element-property :type link) "coderef")
  452. (not (ignore-errors (org-export-resolve-coderef ref info)))
  453. (list (org-element-property :begin link)
  454. (format "Unknown coderef \"%s\"" ref))))))))
  455. (defun org-lint-invalid-custom-id-link (ast)
  456. (let ((info (list :parse-tree ast)))
  457. (org-element-map ast 'link
  458. (lambda (link)
  459. (and (equal (org-element-property :type link) "custom-id")
  460. (not (ignore-errors (org-export-resolve-id-link link info)))
  461. (list (org-element-property :begin link)
  462. (format "Unknown custom ID \"%s\""
  463. (org-element-property :path link))))))))
  464. (defun org-lint-invalid-fuzzy-link (ast)
  465. (let ((info (list :parse-tree ast)))
  466. (org-element-map ast 'link
  467. (lambda (link)
  468. (and (equal (org-element-property :type link) "fuzzy")
  469. (not (ignore-errors (org-export-resolve-fuzzy-link link info)))
  470. (list (org-element-property :begin link)
  471. (format "Unknown fuzzy location \"%s\""
  472. (let ((path (org-element-property :path link)))
  473. (if (string-prefix-p "*" path)
  474. (substring path 1)
  475. path)))))))))
  476. (defun org-lint-invalid-id-link (ast)
  477. (org-element-map ast 'link
  478. (lambda (link)
  479. (let ((id (org-element-property :path link)))
  480. (and (equal (org-element-property :type link) "id")
  481. (not (org-id-find id))
  482. (list (org-element-property :begin link)
  483. (format "Unknown ID \"%s\"" id)))))))
  484. (defun org-lint-special-property-in-properties-drawer (ast)
  485. (org-element-map ast 'node-property
  486. (lambda (p)
  487. (let ((key (org-element-property :key p)))
  488. (and (member-ignore-case key org-special-properties)
  489. (list (org-element-property :begin p)
  490. (format
  491. "Special property \"%s\" found in a properties drawer"
  492. key)))))))
  493. (defun org-lint-obsolete-properties-drawer (ast)
  494. (org-element-map ast 'drawer
  495. (lambda (d)
  496. (when (equal (org-element-property :drawer-name d) "PROPERTIES")
  497. (let ((section (org-element-lineage d '(section))))
  498. (unless (org-element-map section 'property-drawer #'identity nil t)
  499. (list (org-element-property :post-affiliated d)
  500. (if (save-excursion
  501. (goto-char (org-element-property :post-affiliated d))
  502. (forward-line -1)
  503. (or (org-at-heading-p) (org-at-planning-p)))
  504. "Incorrect contents for PROPERTIES drawer"
  505. "Incorrect location for PROPERTIES drawer"))))))))
  506. (defun org-lint-invalid-effort-property (ast)
  507. (org-element-map ast 'node-property
  508. (lambda (p)
  509. (when (equal "EFFORT" (org-element-property :key p))
  510. (let ((value (org-element-property :value p)))
  511. (and (org-string-nw-p value)
  512. (not (org-duration-p value))
  513. (list (org-element-property :begin p)
  514. (format "Invalid effort duration format: %S" value))))))))
  515. (defun org-lint-link-to-local-file (ast)
  516. (org-element-map ast 'link
  517. (lambda (l)
  518. (when (equal "file" (org-element-property :type l))
  519. (let ((file (org-element-property :path l)))
  520. (and (not (file-remote-p file))
  521. (not (file-exists-p file))
  522. (list (org-element-property :begin l)
  523. (format (if (org-element-lineage l '(link))
  524. "Link to non-existent image file \"%s\"\
  525. in link description"
  526. "Link to non-existent local file \"%s\"")
  527. file))))))))
  528. (defun org-lint-non-existent-setupfile-parameter (ast)
  529. (org-element-map ast 'keyword
  530. (lambda (k)
  531. (when (equal (org-element-property :key k) "SETUPFILE")
  532. (let ((file (org-unbracket-string
  533. "\"" "\""
  534. (org-element-property :value k))))
  535. (and (not (org-file-url-p file))
  536. (not (file-remote-p file))
  537. (not (file-exists-p file))
  538. (list (org-element-property :begin k)
  539. (format "Non-existent setup file %S" file))))))))
  540. (defun org-lint-wrong-include-link-parameter (ast)
  541. (org-element-map ast 'keyword
  542. (lambda (k)
  543. (when (equal (org-element-property :key k) "INCLUDE")
  544. (let* ((value (org-element-property :value k))
  545. (path
  546. (and (string-match "^\\(\".+\"\\|\\S-+\\)[ \t]*" value)
  547. (save-match-data
  548. (org-strip-quotes (match-string 1 value))))))
  549. (if (not path)
  550. (list (org-element-property :post-affiliated k)
  551. "Missing location argument in INCLUDE keyword")
  552. (let* ((file (org-string-nw-p
  553. (if (string-match "::\\(.*\\)\\'" path)
  554. (substring path 0 (match-beginning 0))
  555. path)))
  556. (search (and (not (equal file path))
  557. (org-string-nw-p (match-string 1 path)))))
  558. (if (and file
  559. (not (file-remote-p file))
  560. (not (file-exists-p file)))
  561. (list (org-element-property :post-affiliated k)
  562. "Non-existent file argument in INCLUDE keyword")
  563. (let* ((visiting (if file (find-buffer-visiting file)
  564. (current-buffer)))
  565. (buffer (or visiting (find-file-noselect file)))
  566. (org-link-search-must-match-exact-headline t))
  567. (unwind-protect
  568. (with-current-buffer buffer
  569. (when (and search
  570. (not (ignore-errors
  571. (org-link-search search nil t))))
  572. (list (org-element-property :post-affiliated k)
  573. (format
  574. "Invalid search part \"%s\" in INCLUDE keyword"
  575. search))))
  576. (unless visiting (kill-buffer buffer))))))))))))
  577. (defun org-lint-obsolete-include-markup (ast)
  578. (let ((regexp (format "\\`\\(?:\".+\"\\|\\S-+\\)[ \t]+%s"
  579. (regexp-opt
  580. '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
  581. "ODT" "ORG" "TEXINFO")
  582. t))))
  583. (org-element-map ast 'keyword
  584. (lambda (k)
  585. (when (equal (org-element-property :key k) "INCLUDE")
  586. (let ((case-fold-search t)
  587. (value (org-element-property :value k)))
  588. (when (string-match regexp value)
  589. (let ((markup (match-string-no-properties 1 value)))
  590. (list (org-element-property :post-affiliated k)
  591. (format "Obsolete markup \"%s\" in INCLUDE keyword. \
  592. Use \"export %s\" instead"
  593. markup
  594. markup))))))))))
  595. (defun org-lint-unknown-options-item (ast)
  596. (let ((allowed (delq nil
  597. (append
  598. (mapcar (lambda (o) (nth 2 o)) org-export-options-alist)
  599. (cl-mapcan
  600. (lambda (b)
  601. (mapcar (lambda (o) (nth 2 o))
  602. (org-export-backend-options b)))
  603. org-export-registered-backends))))
  604. reports)
  605. (org-element-map ast 'keyword
  606. (lambda (k)
  607. (when (string= (org-element-property :key k) "OPTIONS")
  608. (let ((value (org-element-property :value k))
  609. (start 0))
  610. (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-*\\)[ \t]*"
  611. value
  612. start)
  613. (setf start (match-end 0))
  614. (let ((item (match-string 1 value)))
  615. (unless (member item allowed)
  616. (push (list (org-element-property :post-affiliated k)
  617. (format "Unknown OPTIONS item \"%s\"" item))
  618. reports))))))))
  619. reports))
  620. (defun org-lint-invalid-macro-argument-and-template (ast)
  621. (let ((extract-placeholders
  622. (lambda (template)
  623. (let ((start 0)
  624. args)
  625. (while (string-match "\\$\\([1-9][0-9]*\\)" template start)
  626. (setf start (match-end 0))
  627. (push (string-to-number (match-string 1 template)) args))
  628. (sort (org-uniquify args) #'<))))
  629. reports)
  630. ;; Check arguments for macro templates.
  631. (org-element-map ast 'keyword
  632. (lambda (k)
  633. (when (string= (org-element-property :key k) "MACRO")
  634. (let* ((value (org-element-property :value k))
  635. (name (and (string-match "^\\S-+" value)
  636. (match-string 0 value)))
  637. (template (and name
  638. (org-trim (substring value (match-end 0))))))
  639. (cond
  640. ((not name)
  641. (push (list (org-element-property :post-affiliated k)
  642. "Missing name in MACRO keyword")
  643. reports))
  644. ((not (org-string-nw-p template))
  645. (push (list (org-element-property :post-affiliated k)
  646. "Missing template in macro \"%s\"" name)
  647. reports))
  648. (t
  649. (unless (let ((args (funcall extract-placeholders template)))
  650. (equal (number-sequence 1 (or (org-last args) 0)) args))
  651. (push (list (org-element-property :post-affiliated k)
  652. (format "Unused placeholders in macro \"%s\""
  653. name))
  654. reports))))))))
  655. ;; Check arguments for macros.
  656. (org-macro-initialize-templates)
  657. (let ((templates (append
  658. (mapcar (lambda (m) (cons m "$1"))
  659. '("author" "date" "email" "title" "results"))
  660. org-macro-templates)))
  661. (org-element-map ast 'macro
  662. (lambda (macro)
  663. (let* ((name (org-element-property :key macro))
  664. (template (cdr (assoc-string name templates t))))
  665. (if (not template)
  666. (push (list (org-element-property :begin macro)
  667. (format "Undefined macro \"%s\"" name))
  668. reports)
  669. (let ((arg-numbers (funcall extract-placeholders template)))
  670. (when arg-numbers
  671. (let ((spurious-args
  672. (nthcdr (apply #'max arg-numbers)
  673. (org-element-property :args macro))))
  674. (when spurious-args
  675. (push
  676. (list (org-element-property :begin macro)
  677. (format "Unused argument%s in macro \"%s\": %s"
  678. (if (> (length spurious-args) 1) "s" "")
  679. name
  680. (mapconcat (lambda (a) (format "\"%s\"" a))
  681. spurious-args
  682. ", ")))
  683. reports))))))))))
  684. reports))
  685. (defun org-lint-undefined-footnote-reference (ast)
  686. (let ((definitions (org-element-map ast 'footnote-definition
  687. (lambda (f) (org-element-property :label f)))))
  688. (org-element-map ast 'footnote-reference
  689. (lambda (f)
  690. (let ((label (org-element-property :label f)))
  691. (and (eq 'standard (org-element-property :type f))
  692. (not (member label definitions))
  693. (list (org-element-property :begin f)
  694. (format "Missing definition for footnote [%s]"
  695. label))))))))
  696. (defun org-lint-unreferenced-footnote-definition (ast)
  697. (let ((references (org-element-map ast 'footnote-reference
  698. (lambda (f) (org-element-property :label f)))))
  699. (org-element-map ast 'footnote-definition
  700. (lambda (f)
  701. (let ((label (org-element-property :label f)))
  702. (and label
  703. (not (member label references))
  704. (list (org-element-property :post-affiliated f)
  705. (format "No reference for footnote definition [%s]"
  706. label))))))))
  707. (defun org-lint-colon-in-name (ast)
  708. (org-element-map ast org-element-all-elements
  709. (lambda (e)
  710. (let ((name (org-element-property :name e)))
  711. (and name
  712. (string-match-p ":" name)
  713. (list (progn
  714. (goto-char (org-element-property :begin e))
  715. (re-search-forward
  716. (format "^[ \t]*#\\+\\w+: +%s *$" (regexp-quote name)))
  717. (match-beginning 0))
  718. (format
  719. "Name \"%s\" contains a colon; Babel cannot use it as input"
  720. name)))))))
  721. (defun org-lint-misplaced-planning-info (_)
  722. (let ((case-fold-search t)
  723. reports)
  724. (while (re-search-forward org-planning-line-re nil t)
  725. (unless (memq (org-element-type (org-element-at-point))
  726. '(comment-block example-block export-block planning
  727. src-block verse-block))
  728. (push (list (line-beginning-position) "Misplaced planning info line")
  729. reports)))
  730. reports))
  731. (defun org-lint-incomplete-drawer (_)
  732. (let (reports)
  733. (while (re-search-forward org-drawer-regexp nil t)
  734. (let ((name (org-trim (match-string-no-properties 0)))
  735. (element (org-element-at-point)))
  736. (pcase (org-element-type element)
  737. ((or `drawer `property-drawer)
  738. (goto-char (org-element-property :end element))
  739. nil)
  740. ((or `comment-block `example-block `export-block `src-block
  741. `verse-block)
  742. nil)
  743. (_
  744. (push (list (line-beginning-position)
  745. (format "Possible incomplete drawer \"%s\"" name))
  746. reports)))))
  747. reports))
  748. (defun org-lint-indented-diary-sexp (_)
  749. (let (reports)
  750. (while (re-search-forward "^[ \t]+%%(" nil t)
  751. (unless (memq (org-element-type (org-element-at-point))
  752. '(comment-block diary-sexp example-block export-block
  753. src-block verse-block))
  754. (push (list (line-beginning-position) "Possible indented diary-sexp")
  755. reports)))
  756. reports))
  757. (defun org-lint-invalid-block (_)
  758. (let ((case-fold-search t)
  759. (regexp "^[ \t]*#\\+\\(BEGIN\\|END\\)\\(?::\\|_[^[:space:]]*\\)?[ \t]*")
  760. reports)
  761. (while (re-search-forward regexp nil t)
  762. (let ((name (org-trim (buffer-substring-no-properties
  763. (line-beginning-position) (line-end-position)))))
  764. (cond
  765. ((and (string-prefix-p "END" (match-string 1) t)
  766. (not (eolp)))
  767. (push (list (line-beginning-position)
  768. (format "Invalid block closing line \"%s\"" name))
  769. reports))
  770. ((not (memq (org-element-type (org-element-at-point))
  771. '(center-block comment-block dynamic-block example-block
  772. export-block quote-block special-block
  773. src-block verse-block)))
  774. (push (list (line-beginning-position)
  775. (format "Possible incomplete block \"%s\""
  776. name))
  777. reports)))))
  778. reports))
  779. (defun org-lint-invalid-keyword-syntax (_)
  780. (let ((regexp "^[ \t]*#\\+\\([^[:space:]:]*\\)\\(?: \\|$\\)")
  781. (exception-re
  782. (format "[ \t]*#\\+%s\\(\\[.*\\]\\)?:\\(?: \\|$\\)"
  783. (regexp-opt org-element-dual-keywords)))
  784. reports)
  785. (while (re-search-forward regexp nil t)
  786. (let ((name (match-string-no-properties 1)))
  787. (unless (or (string-prefix-p "BEGIN" name t)
  788. (string-prefix-p "END" name t)
  789. (save-excursion
  790. (beginning-of-line)
  791. (let ((case-fold-search t)) (looking-at exception-re))))
  792. (push (list (match-beginning 0)
  793. (format "Possible missing colon in keyword \"%s\"" name))
  794. reports))))
  795. reports))
  796. (defun org-lint-extraneous-element-in-footnote-section (ast)
  797. (org-element-map ast 'headline
  798. (lambda (h)
  799. (and (org-element-property :footnote-section-p h)
  800. (org-element-map (org-element-contents h)
  801. (cl-remove-if
  802. (lambda (e)
  803. (memq e '(comment comment-block footnote-definition
  804. property-drawer section)))
  805. org-element-all-elements)
  806. (lambda (e)
  807. (not (and (eq (org-element-type e) 'headline)
  808. (org-element-property :commentedp e))))
  809. nil t '(footnote-definition property-drawer))
  810. (list (org-element-property :begin h)
  811. "Extraneous elements in footnote section are not exported")))))
  812. (defun org-lint-quote-section (ast)
  813. (org-element-map ast '(headline inlinetask)
  814. (lambda (h)
  815. (let ((title (org-element-property :raw-value h)))
  816. (and (or (string-prefix-p "QUOTE " title)
  817. (string-prefix-p (concat org-comment-string " QUOTE ") title))
  818. (list (org-element-property :begin h)
  819. "Deprecated QUOTE section"))))))
  820. (defun org-lint-file-application (ast)
  821. (org-element-map ast 'link
  822. (lambda (l)
  823. (let ((app (org-element-property :application l)))
  824. (and app
  825. (list (org-element-property :begin l)
  826. (format "Deprecated \"file+%s\" link type" app)))))))
  827. (defun org-lint-percent-encoding-link-escape (ast)
  828. (org-element-map ast 'link
  829. (lambda (l)
  830. (when (eq 'bracket (org-element-property :format l))
  831. (let* ((uri (org-element-property :path l))
  832. (start 0)
  833. (obsolete-flag
  834. (catch :obsolete
  835. (while (string-match "%\\(..\\)?" uri start)
  836. (setq start (match-end 0))
  837. (unless (member (match-string 1 uri) '("25" "5B" "5D" "20"))
  838. (throw :obsolete nil)))
  839. (string-match-p "%" uri))))
  840. (when obsolete-flag
  841. (list (org-element-property :begin l)
  842. "Link escaped with obsolete percent-encoding syntax")))))))
  843. (defun org-lint-wrong-header-argument (ast)
  844. (let* ((reports)
  845. (verify
  846. (lambda (datum language headers)
  847. (let ((allowed
  848. ;; If LANGUAGE is specified, restrict allowed
  849. ;; headers to both LANGUAGE-specific and default
  850. ;; ones. Otherwise, accept headers from any loaded
  851. ;; language.
  852. (append
  853. org-babel-header-arg-names
  854. (cl-mapcan
  855. (lambda (l)
  856. (let ((v (intern (format "org-babel-header-args:%s" l))))
  857. (and (boundp v) (mapcar #'car (symbol-value v)))))
  858. (if language (list language)
  859. (mapcar #'car org-babel-load-languages))))))
  860. (dolist (header headers)
  861. (let ((h (symbol-name (car header)))
  862. (p (or (org-element-property :post-affiliated datum)
  863. (org-element-property :begin datum))))
  864. (cond
  865. ((not (string-prefix-p ":" h))
  866. (push
  867. (list p
  868. (format "Missing colon in header argument \"%s\"" h))
  869. reports))
  870. ((assoc-string (substring h 1) allowed))
  871. (t (push (list p (format "Unknown header argument \"%s\"" h))
  872. reports)))))))))
  873. (org-element-map ast '(babel-call inline-babel-call inline-src-block keyword
  874. node-property src-block)
  875. (lambda (datum)
  876. (pcase (org-element-type datum)
  877. ((or `babel-call `inline-babel-call)
  878. (funcall verify
  879. datum
  880. nil
  881. (cl-mapcan #'org-babel-parse-header-arguments
  882. (list
  883. (org-element-property :inside-header datum)
  884. (org-element-property :end-header datum)))))
  885. (`inline-src-block
  886. (funcall verify
  887. datum
  888. (org-element-property :language datum)
  889. (org-babel-parse-header-arguments
  890. (org-element-property :parameters datum))))
  891. (`keyword
  892. (when (string= (org-element-property :key datum) "PROPERTY")
  893. (let ((value (org-element-property :value datum)))
  894. (when (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)?\\+? *"
  895. value)
  896. (funcall verify
  897. datum
  898. (match-string 1 value)
  899. (org-babel-parse-header-arguments
  900. (substring value (match-end 0))))))))
  901. (`node-property
  902. (let ((key (org-element-property :key datum)))
  903. (when (let ((case-fold-search t))
  904. (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?\\+?"
  905. key))
  906. (funcall verify
  907. datum
  908. (match-string 1 key)
  909. (org-babel-parse-header-arguments
  910. (org-element-property :value datum))))))
  911. (`src-block
  912. (funcall verify
  913. datum
  914. (org-element-property :language datum)
  915. (cl-mapcan #'org-babel-parse-header-arguments
  916. (cons (org-element-property :parameters datum)
  917. (org-element-property :header datum))))))))
  918. reports))
  919. (defun org-lint-wrong-header-value (ast)
  920. (let (reports)
  921. (org-element-map ast
  922. '(babel-call inline-babel-call inline-src-block src-block)
  923. (lambda (datum)
  924. (let* ((type (org-element-type datum))
  925. (language (org-element-property :language datum))
  926. (allowed-header-values
  927. (append (and language
  928. (let ((v (intern (concat "org-babel-header-args:"
  929. language))))
  930. (and (boundp v) (symbol-value v))))
  931. org-babel-common-header-args-w-values))
  932. (datum-header-values
  933. (org-babel-parse-header-arguments
  934. (org-trim
  935. (pcase type
  936. (`src-block
  937. (mapconcat
  938. #'identity
  939. (cons (org-element-property :parameters datum)
  940. (org-element-property :header datum))
  941. " "))
  942. (`inline-src-block
  943. (or (org-element-property :parameters datum) ""))
  944. (_
  945. (concat
  946. (org-element-property :inside-header datum)
  947. " "
  948. (org-element-property :end-header datum))))))))
  949. (dolist (header datum-header-values)
  950. (let ((allowed-values
  951. (cdr (assoc-string (substring (symbol-name (car header)) 1)
  952. allowed-header-values))))
  953. (unless (memq allowed-values '(:any nil))
  954. (let ((values (cdr header))
  955. groups-alist)
  956. (dolist (v (if (stringp values) (split-string values)
  957. (list values)))
  958. (let ((valid-value nil))
  959. (catch 'exit
  960. (dolist (group allowed-values)
  961. (cond
  962. ((not (funcall
  963. (if (stringp v) #'assoc-string #'assoc)
  964. v group))
  965. (when (memq :any group)
  966. (setf valid-value t)
  967. (push (cons group v) groups-alist)))
  968. ((assq group groups-alist)
  969. (push
  970. (list
  971. (or (org-element-property :post-affiliated datum)
  972. (org-element-property :begin datum))
  973. (format
  974. "Forbidden combination in header \"%s\": %s, %s"
  975. (car header)
  976. (cdr (assq group groups-alist))
  977. v))
  978. reports)
  979. (throw 'exit nil))
  980. (t (push (cons group v) groups-alist)
  981. (setf valid-value t))))
  982. (unless valid-value
  983. (push
  984. (list
  985. (or (org-element-property :post-affiliated datum)
  986. (org-element-property :begin datum))
  987. (format "Unknown value \"%s\" for header \"%s\""
  988. v
  989. (car header)))
  990. reports))))))))))))
  991. reports))
  992. (defun org-lint-spurious-colons (ast)
  993. (org-element-map ast '(headline inlinetask)
  994. (lambda (h)
  995. (when (member "" (org-element-property :tags h))
  996. (list (org-element-property :begin h)
  997. "Tags contain a spurious colon")))))
  998. ;;; Reports UI
  999. (defvar org-lint--report-mode-map
  1000. (let ((map (make-sparse-keymap)))
  1001. (set-keymap-parent map tabulated-list-mode-map)
  1002. (define-key map (kbd "RET") 'org-lint--jump-to-source)
  1003. (define-key map (kbd "TAB") 'org-lint--show-source)
  1004. (define-key map (kbd "C-j") 'org-lint--show-source)
  1005. (define-key map (kbd "h") 'org-lint--hide-checker)
  1006. (define-key map (kbd "i") 'org-lint--ignore-checker)
  1007. map)
  1008. "Local keymap for `org-lint--report-mode' buffers.")
  1009. (define-derived-mode org-lint--report-mode tabulated-list-mode "OrgLint"
  1010. "Major mode used to display reports emitted during linting.
  1011. \\{org-lint--report-mode-map}"
  1012. (setf tabulated-list-format
  1013. `[("Line" 6
  1014. (lambda (a b)
  1015. (< (string-to-number (aref (cadr a) 0))
  1016. (string-to-number (aref (cadr b) 0))))
  1017. :right-align t)
  1018. ("Trust" 5 t)
  1019. ("Warning" 0 t)])
  1020. (tabulated-list-init-header))
  1021. (defun org-lint--generate-reports (buffer checkers)
  1022. "Generate linting report for BUFFER.
  1023. CHECKERS is the list of checkers used.
  1024. Return an alist (ID [LINE TRUST DESCRIPTION CHECKER]), suitable
  1025. for `tabulated-list-printer'."
  1026. (with-current-buffer buffer
  1027. (save-excursion
  1028. (goto-char (point-min))
  1029. (let ((ast (org-element-parse-buffer))
  1030. (id 0)
  1031. (last-line 1)
  1032. (last-pos 1))
  1033. ;; Insert unique ID for each report. Replace buffer positions
  1034. ;; with line numbers.
  1035. (mapcar
  1036. (lambda (report)
  1037. (list
  1038. (cl-incf id)
  1039. (apply #'vector
  1040. (cons
  1041. (progn
  1042. (goto-char (car report))
  1043. (beginning-of-line)
  1044. (prog1 (number-to-string
  1045. (cl-incf last-line
  1046. (count-lines last-pos (point))))
  1047. (setf last-pos (point))))
  1048. (cdr report)))))
  1049. ;; Insert trust level in generated reports. Also sort them
  1050. ;; by buffer position in order to optimize lines computation.
  1051. (sort (cl-mapcan
  1052. (lambda (c)
  1053. (let ((trust (symbol-name (org-lint-checker-trust c))))
  1054. (mapcar
  1055. (lambda (report)
  1056. (list (car report) trust (nth 1 report) c))
  1057. (save-excursion
  1058. (funcall
  1059. (intern (format "org-lint-%s"
  1060. (org-lint-checker-name c)))
  1061. ast)))))
  1062. checkers)
  1063. #'car-less-than-car))))))
  1064. (defvar-local org-lint--source-buffer nil
  1065. "Source buffer associated to current report buffer.")
  1066. (defvar-local org-lint--local-checkers nil
  1067. "List of checkers used to build current report.")
  1068. (defun org-lint--refresh-reports ()
  1069. (setq tabulated-list-entries
  1070. (org-lint--generate-reports org-lint--source-buffer
  1071. org-lint--local-checkers))
  1072. (tabulated-list-print))
  1073. (defun org-lint--current-line ()
  1074. "Return current report line, as a number."
  1075. (string-to-number (aref (tabulated-list-get-entry) 0)))
  1076. (defun org-lint--current-checker (&optional entry)
  1077. "Return current report checker.
  1078. When optional argument ENTRY is non-nil, use this entry instead
  1079. of current one."
  1080. (aref (if entry (nth 1 entry) (tabulated-list-get-entry)) 3))
  1081. (defun org-lint--display-reports (source checkers)
  1082. "Display linting reports for buffer SOURCE.
  1083. CHECKERS is the list of checkers used."
  1084. (let ((buffer (get-buffer-create "*Org Lint*")))
  1085. (with-current-buffer buffer
  1086. (org-lint--report-mode)
  1087. (setf org-lint--source-buffer source)
  1088. (setf org-lint--local-checkers checkers)
  1089. (org-lint--refresh-reports)
  1090. (tabulated-list-print)
  1091. (add-hook 'tabulated-list-revert-hook #'org-lint--refresh-reports nil t))
  1092. (pop-to-buffer buffer)))
  1093. (defun org-lint--jump-to-source ()
  1094. "Move to source line that generated the report at point."
  1095. (interactive)
  1096. (let ((l (org-lint--current-line)))
  1097. (switch-to-buffer-other-window org-lint--source-buffer)
  1098. (org-goto-line l)
  1099. (org-show-set-visibility 'local)
  1100. (recenter)))
  1101. (defun org-lint--show-source ()
  1102. "Show source line that generated the report at point."
  1103. (interactive)
  1104. (let ((buffer (current-buffer)))
  1105. (org-lint--jump-to-source)
  1106. (switch-to-buffer-other-window buffer)))
  1107. (defun org-lint--hide-checker ()
  1108. "Hide all reports from checker that generated the report at point."
  1109. (interactive)
  1110. (let ((c (org-lint--current-checker)))
  1111. (setf tabulated-list-entries
  1112. (cl-remove-if (lambda (e) (equal c (org-lint--current-checker e)))
  1113. tabulated-list-entries))
  1114. (tabulated-list-print)))
  1115. (defun org-lint--ignore-checker ()
  1116. "Ignore all reports from checker that generated the report at point.
  1117. Checker will also be ignored in all subsequent reports."
  1118. (interactive)
  1119. (setf org-lint--local-checkers
  1120. (remove (org-lint--current-checker) org-lint--local-checkers))
  1121. (org-lint--hide-checker))
  1122. ;;; Public function
  1123. ;;;###autoload
  1124. (defun org-lint (&optional arg)
  1125. "Check current Org buffer for syntax mistakes.
  1126. By default, run all checkers. With a `\\[universal-argument]' prefix ARG, \
  1127. select one
  1128. category of checkers only. With a `\\[universal-argument] \
  1129. \\[universal-argument]' prefix, run one precise
  1130. checker by its name.
  1131. ARG can also be a list of checker names, as symbols, to run."
  1132. (interactive "P")
  1133. (unless (derived-mode-p 'org-mode) (user-error "Not in an Org buffer"))
  1134. (when (called-interactively-p 'any)
  1135. (message "Org linting process starting..."))
  1136. (let ((checkers
  1137. (pcase arg
  1138. (`nil org-lint--checkers)
  1139. (`(4)
  1140. (let ((category
  1141. (completing-read
  1142. "Checker category: "
  1143. (mapcar #'org-lint-checker-categories org-lint--checkers)
  1144. nil t)))
  1145. (cl-remove-if-not
  1146. (lambda (c)
  1147. (assoc-string (org-lint-checker-categories c) category))
  1148. org-lint--checkers)))
  1149. (`(16)
  1150. (list
  1151. (let ((name (completing-read
  1152. "Checker name: "
  1153. (mapcar #'org-lint-checker-name org-lint--checkers)
  1154. nil t)))
  1155. (catch 'exit
  1156. (dolist (c org-lint--checkers)
  1157. (when (string= (org-lint-checker-name c) name)
  1158. (throw 'exit c)))))))
  1159. ((pred consp)
  1160. (cl-remove-if-not (lambda (c) (memq (org-lint-checker-name c) arg))
  1161. org-lint--checkers))
  1162. (_ (user-error "Invalid argument `%S' for `org-lint'" arg)))))
  1163. (if (not (called-interactively-p 'any))
  1164. (org-lint--generate-reports (current-buffer) checkers)
  1165. (org-lint--display-reports (current-buffer) checkers)
  1166. (message "Org linting process completed"))))
  1167. (provide 'org-lint)
  1168. ;;; org-lint.el ends here