org-lint.el 42 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240
  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 'org-element)
  90. (require 'org-macro)
  91. (require 'ox)
  92. (require 'ob)
  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 'spurious-colons
  267. :description "Report spurious colons in tags"))
  268. "List of all available checkers.")
  269. (defun org-lint--collect-duplicates
  270. (ast type extract-key extract-position build-message)
  271. "Helper function to collect duplicates in parse tree AST.
  272. EXTRACT-KEY is a function extracting key. It is called with
  273. a single argument: the element or object. Comparison is done
  274. with `equal'.
  275. EXTRACT-POSITION is a function returning position for the report.
  276. It is called with two arguments, the object or element, and the
  277. key.
  278. BUILD-MESSAGE is a function creating the report message. It is
  279. called with one argument, the key used for comparison."
  280. (let* (keys
  281. originals
  282. reports
  283. (make-report
  284. (lambda (position value)
  285. (push (list position (funcall build-message value)) reports))))
  286. (org-element-map ast type
  287. (lambda (datum)
  288. (let ((key (funcall extract-key datum)))
  289. (cond
  290. ((not key))
  291. ((assoc key keys) (cl-pushnew (assoc key keys) originals)
  292. (funcall make-report (funcall extract-position datum key) key))
  293. (t (push (cons key (funcall extract-position datum key)) keys))))))
  294. (dolist (e originals reports) (funcall make-report (cdr e) (car e)))))
  295. (defun org-lint-duplicate-custom-id (ast)
  296. (org-lint--collect-duplicates
  297. ast
  298. 'node-property
  299. (lambda (property)
  300. (and (eq (compare-strings "CUSTOM_ID" nil nil
  301. (org-element-property :key property) nil nil
  302. t)
  303. t)
  304. (org-element-property :value property)))
  305. (lambda (property _) (org-element-property :begin property))
  306. (lambda (key) (format "Duplicate CUSTOM_ID property \"%s\"" key))))
  307. (defun org-lint-duplicate-name (ast)
  308. (org-lint--collect-duplicates
  309. ast
  310. org-element-all-elements
  311. (lambda (datum) (org-element-property :name datum))
  312. (lambda (datum name)
  313. (goto-char (org-element-property :begin datum))
  314. (re-search-forward
  315. (format "^[ \t]*#\\+[A-Za-z]+: +%s *$" (regexp-quote name)))
  316. (match-beginning 0))
  317. (lambda (key) (format "Duplicate NAME \"%s\"" key))))
  318. (defun org-lint-duplicate-target (ast)
  319. (org-lint--collect-duplicates
  320. ast
  321. 'target
  322. (lambda (target) (split-string (org-element-property :value target)))
  323. (lambda (target _) (org-element-property :begin target))
  324. (lambda (key)
  325. (format "Duplicate target <<%s>>" (mapconcat #'identity key " ")))))
  326. (defun org-lint-duplicate-footnote-definition (ast)
  327. (org-lint--collect-duplicates
  328. ast
  329. 'footnote-definition
  330. (lambda (definition) (org-element-property :label definition))
  331. (lambda (definition _) (org-element-property :post-affiliated definition))
  332. (lambda (key) (format "Duplicate footnote definition \"%s\"" key))))
  333. (defun org-lint-orphaned-affiliated-keywords (ast)
  334. ;; Ignore orphan RESULTS keywords, which could be generated from
  335. ;; a source block returning no value.
  336. (let ((keywords (cl-set-difference org-element-affiliated-keywords
  337. '("RESULT" "RESULTS")
  338. :test #'equal)))
  339. (org-element-map ast 'keyword
  340. (lambda (k)
  341. (let ((key (org-element-property :key k)))
  342. (and (or (let ((case-fold-search t))
  343. (string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key))
  344. (member key keywords))
  345. (list (org-element-property :post-affiliated k)
  346. (format "Orphaned affiliated keyword: \"%s\"" key))))))))
  347. (defun org-lint-obsolete-affiliated-keywords (_)
  348. (let ((regexp (format "^[ \t]*#\\+%s:"
  349. (regexp-opt '("DATA" "LABEL" "RESNAME" "SOURCE"
  350. "SRCNAME" "TBLNAME" "RESULT" "HEADERS")
  351. t)))
  352. reports)
  353. (while (re-search-forward regexp nil t)
  354. (let ((key (upcase (match-string-no-properties 1))))
  355. (when (< (point)
  356. (org-element-property :post-affiliated (org-element-at-point)))
  357. (push
  358. (list (line-beginning-position)
  359. (format
  360. "Obsolete affiliated keyword: \"%s\". Use \"%s\" instead"
  361. key
  362. (pcase key
  363. ("HEADERS" "HEADER")
  364. ("RESULT" "RESULTS")
  365. (_ "NAME"))))
  366. reports))))
  367. reports))
  368. (defun org-lint-deprecated-export-blocks (ast)
  369. (let ((deprecated '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
  370. "ODT" "ORG" "TEXINFO")))
  371. (org-element-map ast 'special-block
  372. (lambda (b)
  373. (let ((type (org-element-property :type b)))
  374. (when (member-ignore-case type deprecated)
  375. (list
  376. (org-element-property :post-affiliated b)
  377. (format
  378. "Deprecated syntax for export block. Use \"BEGIN_EXPORT %s\" \
  379. instead"
  380. type))))))))
  381. (defun org-lint-deprecated-header-syntax (ast)
  382. (let* ((deprecated-babel-properties
  383. (mapcar (lambda (arg) (symbol-name (car arg)))
  384. org-babel-common-header-args-w-values))
  385. (deprecated-re
  386. (format "\\`%s[ \t]" (regexp-opt deprecated-babel-properties t))))
  387. (org-element-map ast '(keyword node-property)
  388. (lambda (datum)
  389. (let ((key (org-element-property :key datum)))
  390. (pcase (org-element-type datum)
  391. (`keyword
  392. (let ((value (org-element-property :value datum)))
  393. (and (string= key "PROPERTY")
  394. (string-match deprecated-re value)
  395. (list (org-element-property :begin datum)
  396. (format "Deprecated syntax for \"%s\". \
  397. Use header-args instead"
  398. (match-string-no-properties 1 value))))))
  399. (`node-property
  400. (and (member-ignore-case key deprecated-babel-properties)
  401. (list
  402. (org-element-property :begin datum)
  403. (format "Deprecated syntax for \"%s\". \
  404. Use :header-args: instead"
  405. key))))))))))
  406. (defun org-lint-missing-language-in-src-block (ast)
  407. (org-element-map ast 'src-block
  408. (lambda (b)
  409. (unless (org-element-property :language b)
  410. (list (org-element-property :post-affiliated b)
  411. "Missing language in source block")))))
  412. (defun org-lint-missing-backend-in-export-block (ast)
  413. (org-element-map ast 'export-block
  414. (lambda (b)
  415. (unless (org-element-property :type b)
  416. (list (org-element-property :post-affiliated b)
  417. "Missing back-end in export block")))))
  418. (defun org-lint-invalid-babel-call-block (ast)
  419. (org-element-map ast 'babel-call
  420. (lambda (b)
  421. (cond
  422. ((not (org-element-property :call b))
  423. (list (org-element-property :post-affiliated b)
  424. "Invalid syntax in babel call block"))
  425. ((let ((h (org-element-property :end-header b)))
  426. (and h (string-match-p "\\`\\[.*\\]\\'" h)))
  427. (list
  428. (org-element-property :post-affiliated b)
  429. "Babel call's end header must not be wrapped within brackets"))))))
  430. (defun org-lint-deprecated-category-setup (ast)
  431. (org-element-map ast 'keyword
  432. (let (category-flag)
  433. (lambda (k)
  434. (cond
  435. ((not (string= (org-element-property :key k) "CATEGORY")) nil)
  436. (category-flag
  437. (list (org-element-property :post-affiliated k)
  438. "Spurious CATEGORY keyword. Set :CATEGORY: property instead"))
  439. (t (setf category-flag t) nil))))))
  440. (defun org-lint-invalid-coderef-link (ast)
  441. (let ((info (list :parse-tree ast)))
  442. (org-element-map ast 'link
  443. (lambda (link)
  444. (let ((ref (org-element-property :path link)))
  445. (and (equal (org-element-property :type link) "coderef")
  446. (not (ignore-errors (org-export-resolve-coderef ref info)))
  447. (list (org-element-property :begin link)
  448. (format "Unknown coderef \"%s\"" ref))))))))
  449. (defun org-lint-invalid-custom-id-link (ast)
  450. (let ((info (list :parse-tree ast)))
  451. (org-element-map ast 'link
  452. (lambda (link)
  453. (and (equal (org-element-property :type link) "custom-id")
  454. (not (ignore-errors (org-export-resolve-id-link link info)))
  455. (list (org-element-property :begin link)
  456. (format "Unknown custom ID \"%s\""
  457. (org-element-property :path link))))))))
  458. (defun org-lint-invalid-fuzzy-link (ast)
  459. (let ((info (list :parse-tree ast)))
  460. (org-element-map ast 'link
  461. (lambda (link)
  462. (and (equal (org-element-property :type link) "fuzzy")
  463. (not (ignore-errors (org-export-resolve-fuzzy-link link info)))
  464. (list (org-element-property :begin link)
  465. (format "Unknown fuzzy location \"%s\""
  466. (let ((path (org-element-property :path link)))
  467. (if (string-prefix-p "*" path)
  468. (substring path 1)
  469. path)))))))))
  470. (defun org-lint-invalid-id-link (ast)
  471. (org-element-map ast 'link
  472. (lambda (link)
  473. (let ((id (org-element-property :path link)))
  474. (and (equal (org-element-property :type link) "id")
  475. (not (org-id-find id))
  476. (list (org-element-property :begin link)
  477. (format "Unknown ID \"%s\"" id)))))))
  478. (defun org-lint-special-property-in-properties-drawer (ast)
  479. (org-element-map ast 'node-property
  480. (lambda (p)
  481. (let ((key (org-element-property :key p)))
  482. (and (member-ignore-case key org-special-properties)
  483. (list (org-element-property :begin p)
  484. (format
  485. "Special property \"%s\" found in a properties drawer"
  486. key)))))))
  487. (defun org-lint-obsolete-properties-drawer (ast)
  488. (org-element-map ast 'drawer
  489. (lambda (d)
  490. (when (equal (org-element-property :drawer-name d) "PROPERTIES")
  491. (let ((section (org-element-lineage d '(section))))
  492. (unless (org-element-map section 'property-drawer #'identity nil t)
  493. (list (org-element-property :post-affiliated d)
  494. (if (save-excursion
  495. (goto-char (org-element-property :post-affiliated d))
  496. (forward-line -1)
  497. (or (org-at-heading-p) (org-at-planning-p)))
  498. "Incorrect contents for PROPERTIES drawer"
  499. "Incorrect location for PROPERTIES drawer"))))))))
  500. (defun org-lint-invalid-effort-property (ast)
  501. (org-element-map ast 'node-property
  502. (lambda (p)
  503. (when (equal "EFFORT" (org-element-property :key p))
  504. (let ((value (org-element-property :value p)))
  505. (and (org-string-nw-p value)
  506. (not (org-duration-p value))
  507. (list (org-element-property :begin p)
  508. (format "Invalid effort duration format: %S" value))))))))
  509. (defun org-lint-link-to-local-file (ast)
  510. (org-element-map ast 'link
  511. (lambda (l)
  512. (when (equal (org-element-property :type l) "file")
  513. (let ((file (org-link-unescape (org-element-property :path l))))
  514. (and (not (file-remote-p file))
  515. (not (file-exists-p file))
  516. (list (org-element-property :begin l)
  517. (format (if (org-element-lineage l '(link))
  518. "Link to non-existent image file \"%s\"\
  519. in link description"
  520. "Link to non-existent local file \"%s\"")
  521. file))))))))
  522. (defun org-lint-non-existent-setupfile-parameter (ast)
  523. (org-element-map ast 'keyword
  524. (lambda (k)
  525. (when (equal (org-element-property :key k) "SETUPFILE")
  526. (let ((file (org-unbracket-string
  527. "\"" "\""
  528. (org-element-property :value k))))
  529. (and (not (file-remote-p file))
  530. (not (file-exists-p file))
  531. (list (org-element-property :begin k)
  532. (format "Non-existent setup file \"%s\"" file))))))))
  533. (defun org-lint-wrong-include-link-parameter (ast)
  534. (org-element-map ast 'keyword
  535. (lambda (k)
  536. (when (equal (org-element-property :key k) "INCLUDE")
  537. (let* ((value (org-element-property :value k))
  538. (path
  539. (and (string-match "^\\(\".+\"\\|\\S-+\\)[ \t]*" value)
  540. (save-match-data
  541. (org-strip-quotes (match-string 1 value))))))
  542. (if (not path)
  543. (list (org-element-property :post-affiliated k)
  544. "Missing location argument in INCLUDE keyword")
  545. (let* ((file (org-string-nw-p
  546. (if (string-match "::\\(.*\\)\\'" path)
  547. (substring path 0 (match-beginning 0))
  548. path)))
  549. (search (and (not (equal file path))
  550. (org-string-nw-p (match-string 1 path)))))
  551. (if (and file
  552. (not (file-remote-p file))
  553. (not (file-exists-p file)))
  554. (list (org-element-property :post-affiliated k)
  555. "Non-existent file argument in INCLUDE keyword")
  556. (let* ((visiting (if file (find-buffer-visiting file)
  557. (current-buffer)))
  558. (buffer (or visiting (find-file-noselect file))))
  559. (unwind-protect
  560. (with-current-buffer buffer
  561. (when (and search
  562. (not
  563. (ignore-errors
  564. (let ((org-link-search-inhibit-query t))
  565. (org-link-search search nil t)))))
  566. (list (org-element-property :post-affiliated k)
  567. (format
  568. "Invalid search part \"%s\" in INCLUDE keyword"
  569. search))))
  570. (unless visiting (kill-buffer buffer))))))))))))
  571. (defun org-lint-obsolete-include-markup (ast)
  572. (let ((regexp (format "\\`\\(?:\".+\"\\|\\S-+\\)[ \t]+%s"
  573. (regexp-opt
  574. '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
  575. "ODT" "ORG" "TEXINFO")
  576. t))))
  577. (org-element-map ast 'keyword
  578. (lambda (k)
  579. (when (equal (org-element-property :key k) "INCLUDE")
  580. (let ((case-fold-search t)
  581. (value (org-element-property :value k)))
  582. (when (string-match regexp value)
  583. (let ((markup (match-string-no-properties 1 value)))
  584. (list (org-element-property :post-affiliated k)
  585. (format "Obsolete markup \"%s\" in INCLUDE keyword. \
  586. Use \"export %s\" instead"
  587. markup
  588. markup))))))))))
  589. (defun org-lint-unknown-options-item (ast)
  590. (let ((allowed (delq nil
  591. (append
  592. (mapcar (lambda (o) (nth 2 o)) org-export-options-alist)
  593. (cl-mapcan
  594. (lambda (b)
  595. (mapcar (lambda (o) (nth 2 o))
  596. (org-export-backend-options b)))
  597. org-export-registered-backends))))
  598. reports)
  599. (org-element-map ast 'keyword
  600. (lambda (k)
  601. (when (string= (org-element-property :key k) "OPTIONS")
  602. (let ((value (org-element-property :value k))
  603. (start 0))
  604. (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-*\\)[ \t]*"
  605. value
  606. start)
  607. (setf start (match-end 0))
  608. (let ((item (match-string 1 value)))
  609. (unless (member item allowed)
  610. (push (list (org-element-property :post-affiliated k)
  611. (format "Unknown OPTIONS item \"%s\"" item))
  612. reports))))))))
  613. reports))
  614. (defun org-lint-invalid-macro-argument-and-template (ast)
  615. (let ((extract-placeholders
  616. (lambda (template)
  617. (let ((start 0)
  618. args)
  619. (while (string-match "\\$\\([1-9][0-9]*\\)" template start)
  620. (setf start (match-end 0))
  621. (push (string-to-number (match-string 1 template)) args))
  622. (sort (org-uniquify args) #'<))))
  623. reports)
  624. ;; Check arguments for macro templates.
  625. (org-element-map ast 'keyword
  626. (lambda (k)
  627. (when (string= (org-element-property :key k) "MACRO")
  628. (let* ((value (org-element-property :value k))
  629. (name (and (string-match "^\\S-+" value)
  630. (match-string 0 value)))
  631. (template (and name
  632. (org-trim (substring value (match-end 0))))))
  633. (cond
  634. ((not name)
  635. (push (list (org-element-property :post-affiliated k)
  636. "Missing name in MACRO keyword")
  637. reports))
  638. ((not (org-string-nw-p template))
  639. (push (list (org-element-property :post-affiliated k)
  640. "Missing template in macro \"%s\"" name)
  641. reports))
  642. (t
  643. (unless (let ((args (funcall extract-placeholders template)))
  644. (equal (number-sequence 1 (or (org-last args) 0)) args))
  645. (push (list (org-element-property :post-affiliated k)
  646. (format "Unused placeholders in macro \"%s\""
  647. name))
  648. reports))))))))
  649. ;; Check arguments for macros.
  650. (org-macro-initialize-templates)
  651. (let ((templates (append
  652. (mapcar (lambda (m) (cons m "$1"))
  653. '("author" "date" "email" "title" "results"))
  654. org-macro-templates)))
  655. (org-element-map ast 'macro
  656. (lambda (macro)
  657. (let* ((name (org-element-property :key macro))
  658. (template (cdr (assoc-string name templates t))))
  659. (if (not template)
  660. (push (list (org-element-property :begin macro)
  661. (format "Undefined macro \"%s\"" name))
  662. reports)
  663. (let ((arg-numbers (funcall extract-placeholders template)))
  664. (when arg-numbers
  665. (let ((spurious-args
  666. (nthcdr (apply #'max arg-numbers)
  667. (org-element-property :args macro))))
  668. (when spurious-args
  669. (push
  670. (list (org-element-property :begin macro)
  671. (format "Unused argument%s in macro \"%s\": %s"
  672. (if (> (length spurious-args) 1) "s" "")
  673. name
  674. (mapconcat (lambda (a) (format "\"%s\"" a))
  675. spurious-args
  676. ", ")))
  677. reports))))))))))
  678. reports))
  679. (defun org-lint-undefined-footnote-reference (ast)
  680. (let ((definitions (org-element-map ast 'footnote-definition
  681. (lambda (f) (org-element-property :label f)))))
  682. (org-element-map ast 'footnote-reference
  683. (lambda (f)
  684. (let ((label (org-element-property :label f)))
  685. (and (eq 'standard (org-element-property :type f))
  686. (not (member label definitions))
  687. (list (org-element-property :begin f)
  688. (format "Missing definition for footnote [%s]"
  689. label))))))))
  690. (defun org-lint-unreferenced-footnote-definition (ast)
  691. (let ((references (org-element-map ast 'footnote-reference
  692. (lambda (f) (org-element-property :label f)))))
  693. (org-element-map ast 'footnote-definition
  694. (lambda (f)
  695. (let ((label (org-element-property :label f)))
  696. (and label
  697. (not (member label references))
  698. (list (org-element-property :post-affiliated f)
  699. (format "No reference for footnote definition [%s]"
  700. label))))))))
  701. (defun org-lint-colon-in-name (ast)
  702. (org-element-map ast org-element-all-elements
  703. (lambda (e)
  704. (let ((name (org-element-property :name e)))
  705. (and name
  706. (string-match-p ":" name)
  707. (list (progn
  708. (goto-char (org-element-property :begin e))
  709. (re-search-forward
  710. (format "^[ \t]*#\\+\\w+: +%s *$" (regexp-quote name)))
  711. (match-beginning 0))
  712. (format
  713. "Name \"%s\" contains a colon; Babel cannot use it as input"
  714. name)))))))
  715. (defun org-lint-misplaced-planning-info (_)
  716. (let ((case-fold-search t)
  717. reports)
  718. (while (re-search-forward org-planning-line-re nil t)
  719. (unless (memq (org-element-type (org-element-at-point))
  720. '(comment-block example-block export-block planning
  721. src-block verse-block))
  722. (push (list (line-beginning-position) "Misplaced planning info line")
  723. reports)))
  724. reports))
  725. (defun org-lint-incomplete-drawer (_)
  726. (let (reports)
  727. (while (re-search-forward org-drawer-regexp nil t)
  728. (let ((name (org-trim (match-string-no-properties 0)))
  729. (element (org-element-at-point)))
  730. (pcase (org-element-type element)
  731. ((or `drawer `property-drawer)
  732. (goto-char (org-element-property :end element))
  733. nil)
  734. ((or `comment-block `example-block `export-block `src-block
  735. `verse-block)
  736. nil)
  737. (_
  738. (push (list (line-beginning-position)
  739. (format "Possible incomplete drawer \"%s\"" name))
  740. reports)))))
  741. reports))
  742. (defun org-lint-indented-diary-sexp (_)
  743. (let (reports)
  744. (while (re-search-forward "^[ \t]+%%(" nil t)
  745. (unless (memq (org-element-type (org-element-at-point))
  746. '(comment-block diary-sexp example-block export-block
  747. src-block verse-block))
  748. (push (list (line-beginning-position) "Possible indented diary-sexp")
  749. reports)))
  750. reports))
  751. (defun org-lint-invalid-block (_)
  752. (let ((case-fold-search t)
  753. (regexp "^[ \t]*#\\+\\(BEGIN\\|END\\)\\(?::\\|_[^[:space:]]*\\)?[ \t]*")
  754. reports)
  755. (while (re-search-forward regexp nil t)
  756. (let ((name (org-trim (buffer-substring-no-properties
  757. (line-beginning-position) (line-end-position)))))
  758. (cond
  759. ((and (string-prefix-p "END" (match-string 1) t)
  760. (not (eolp)))
  761. (push (list (line-beginning-position)
  762. (format "Invalid block closing line \"%s\"" name))
  763. reports))
  764. ((not (memq (org-element-type (org-element-at-point))
  765. '(center-block comment-block dynamic-block example-block
  766. export-block quote-block special-block
  767. src-block verse-block)))
  768. (push (list (line-beginning-position)
  769. (format "Possible incomplete block \"%s\""
  770. name))
  771. reports)))))
  772. reports))
  773. (defun org-lint-invalid-keyword-syntax (_)
  774. (let ((regexp "^[ \t]*#\\+\\([^[:space:]:]*\\)\\(?: \\|$\\)")
  775. (exception-re
  776. (format "[ \t]*#\\+%s\\(\\[.*\\]\\)?:\\(?: \\|$\\)"
  777. (regexp-opt org-element-dual-keywords)))
  778. reports)
  779. (while (re-search-forward regexp nil t)
  780. (let ((name (match-string-no-properties 1)))
  781. (unless (or (string-prefix-p "BEGIN" name t)
  782. (string-prefix-p "END" name t)
  783. (save-excursion
  784. (beginning-of-line)
  785. (let ((case-fold-search t)) (looking-at exception-re))))
  786. (push (list (match-beginning 0)
  787. (format "Possible missing colon in keyword \"%s\"" name))
  788. reports))))
  789. reports))
  790. (defun org-lint-extraneous-element-in-footnote-section (ast)
  791. (org-element-map ast 'headline
  792. (lambda (h)
  793. (and (org-element-property :footnote-section-p h)
  794. (org-element-map (org-element-contents h)
  795. (cl-remove-if
  796. (lambda (e)
  797. (memq e '(comment comment-block footnote-definition
  798. property-drawer section)))
  799. org-element-all-elements)
  800. (lambda (e)
  801. (not (and (eq (org-element-type e) 'headline)
  802. (org-element-property :commentedp e))))
  803. nil t '(footnote-definition property-drawer))
  804. (list (org-element-property :begin h)
  805. "Extraneous elements in footnote section are not exported")))))
  806. (defun org-lint-quote-section (ast)
  807. (org-element-map ast '(headline inlinetask)
  808. (lambda (h)
  809. (let ((title (org-element-property :raw-value h)))
  810. (and (or (string-prefix-p "QUOTE " title)
  811. (string-prefix-p (concat org-comment-string " QUOTE ") title))
  812. (list (org-element-property :begin h)
  813. "Deprecated QUOTE section"))))))
  814. (defun org-lint-file-application (ast)
  815. (org-element-map ast 'link
  816. (lambda (l)
  817. (let ((app (org-element-property :application l)))
  818. (and app
  819. (list (org-element-property :begin l)
  820. (format "Deprecated \"file+%s\" link type" app)))))))
  821. (defun org-lint-wrong-header-argument (ast)
  822. (let* ((reports)
  823. (verify
  824. (lambda (datum language headers)
  825. (let ((allowed
  826. ;; If LANGUAGE is specified, restrict allowed
  827. ;; headers to both LANGUAGE-specific and default
  828. ;; ones. Otherwise, accept headers from any loaded
  829. ;; language.
  830. (append
  831. org-babel-header-arg-names
  832. (cl-mapcan
  833. (lambda (l)
  834. (let ((v (intern (format "org-babel-header-args:%s" l))))
  835. (and (boundp v) (mapcar #'car (symbol-value v)))))
  836. (if language (list language)
  837. (mapcar #'car org-babel-load-languages))))))
  838. (dolist (header headers)
  839. (let ((h (symbol-name (car header)))
  840. (p (or (org-element-property :post-affiliated datum)
  841. (org-element-property :begin datum))))
  842. (cond
  843. ((not (string-prefix-p ":" h))
  844. (push
  845. (list p
  846. (format "Missing colon in header argument \"%s\"" h))
  847. reports))
  848. ((assoc-string (substring h 1) allowed))
  849. (t (push (list p (format "Unknown header argument \"%s\"" h))
  850. reports)))))))))
  851. (org-element-map ast '(babel-call inline-babel-call inline-src-block keyword
  852. node-property src-block)
  853. (lambda (datum)
  854. (pcase (org-element-type datum)
  855. ((or `babel-call `inline-babel-call)
  856. (funcall verify
  857. datum
  858. nil
  859. (cl-mapcan #'org-babel-parse-header-arguments
  860. (list
  861. (org-element-property :inside-header datum)
  862. (org-element-property :end-header datum)))))
  863. (`inline-src-block
  864. (funcall verify
  865. datum
  866. (org-element-property :language datum)
  867. (org-babel-parse-header-arguments
  868. (org-element-property :parameters datum))))
  869. (`keyword
  870. (when (string= (org-element-property :key datum) "PROPERTY")
  871. (let ((value (org-element-property :value datum)))
  872. (when (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)?\\+? *"
  873. value)
  874. (funcall verify
  875. datum
  876. (match-string 1 value)
  877. (org-babel-parse-header-arguments
  878. (substring value (match-end 0))))))))
  879. (`node-property
  880. (let ((key (org-element-property :key datum)))
  881. (when (let ((case-fold-search t))
  882. (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?\\+?"
  883. key))
  884. (funcall verify
  885. datum
  886. (match-string 1 key)
  887. (org-babel-parse-header-arguments
  888. (org-element-property :value datum))))))
  889. (`src-block
  890. (funcall verify
  891. datum
  892. (org-element-property :language datum)
  893. (cl-mapcan #'org-babel-parse-header-arguments
  894. (cons (org-element-property :parameters datum)
  895. (org-element-property :header datum))))))))
  896. reports))
  897. (defun org-lint-wrong-header-value (ast)
  898. (let (reports)
  899. (org-element-map ast
  900. '(babel-call inline-babel-call inline-src-block src-block)
  901. (lambda (datum)
  902. (let* ((type (org-element-type datum))
  903. (language (org-element-property :language datum))
  904. (allowed-header-values
  905. (append (and language
  906. (let ((v (intern (concat "org-babel-header-args:"
  907. language))))
  908. (and (boundp v) (symbol-value v))))
  909. org-babel-common-header-args-w-values))
  910. (datum-header-values
  911. (org-babel-parse-header-arguments
  912. (org-trim
  913. (pcase type
  914. (`src-block
  915. (mapconcat
  916. #'identity
  917. (cons (org-element-property :parameters datum)
  918. (org-element-property :header datum))
  919. " "))
  920. (`inline-src-block
  921. (or (org-element-property :parameters datum) ""))
  922. (_
  923. (concat
  924. (org-element-property :inside-header datum)
  925. " "
  926. (org-element-property :end-header datum))))))))
  927. (dolist (header datum-header-values)
  928. (let ((allowed-values
  929. (cdr (assoc-string (substring (symbol-name (car header)) 1)
  930. allowed-header-values))))
  931. (unless (memq allowed-values '(:any nil))
  932. (let ((values (cdr header))
  933. groups-alist)
  934. (dolist (v (if (stringp values) (split-string values)
  935. (list values)))
  936. (let ((valid-value nil))
  937. (catch 'exit
  938. (dolist (group allowed-values)
  939. (cond
  940. ((not (funcall
  941. (if (stringp v) #'assoc-string #'assoc)
  942. v group))
  943. (when (memq :any group)
  944. (setf valid-value t)
  945. (push (cons group v) groups-alist)))
  946. ((assq group groups-alist)
  947. (push
  948. (list
  949. (or (org-element-property :post-affiliated datum)
  950. (org-element-property :begin datum))
  951. (format
  952. "Forbidden combination in header \"%s\": %s, %s"
  953. (car header)
  954. (cdr (assq group groups-alist))
  955. v))
  956. reports)
  957. (throw 'exit nil))
  958. (t (push (cons group v) groups-alist)
  959. (setf valid-value t))))
  960. (unless valid-value
  961. (push
  962. (list
  963. (or (org-element-property :post-affiliated datum)
  964. (org-element-property :begin datum))
  965. (format "Unknown value \"%s\" for header \"%s\""
  966. v
  967. (car header)))
  968. reports))))))))))))
  969. reports))
  970. (defun org-lint-spurious-colons (ast)
  971. (org-element-map ast '(headline inlinetask)
  972. (lambda (h)
  973. (when (member "" (org-element-property :tags h))
  974. (list (org-element-property :begin h)
  975. "Tags contain a spurious colon")))))
  976. ;;; Reports UI
  977. (defvar org-lint--report-mode-map
  978. (let ((map (make-sparse-keymap)))
  979. (set-keymap-parent map tabulated-list-mode-map)
  980. (define-key map (kbd "RET") 'org-lint--jump-to-source)
  981. (define-key map (kbd "TAB") 'org-lint--show-source)
  982. (define-key map (kbd "C-j") 'org-lint--show-source)
  983. (define-key map (kbd "h") 'org-lint--hide-checker)
  984. (define-key map (kbd "i") 'org-lint--ignore-checker)
  985. map)
  986. "Local keymap for `org-lint--report-mode' buffers.")
  987. (define-derived-mode org-lint--report-mode tabulated-list-mode "OrgLint"
  988. "Major mode used to display reports emitted during linting.
  989. \\{org-lint--report-mode-map}"
  990. (setf tabulated-list-format
  991. `[("Line" 6
  992. (lambda (a b)
  993. (< (string-to-number (aref (cadr a) 0))
  994. (string-to-number (aref (cadr b) 0))))
  995. :right-align t)
  996. ("Trust" 5 t)
  997. ("Warning" 0 t)])
  998. (tabulated-list-init-header))
  999. (defun org-lint--generate-reports (buffer checkers)
  1000. "Generate linting report for BUFFER.
  1001. CHECKERS is the list of checkers used.
  1002. Return an alist (ID [LINE TRUST DESCRIPTION CHECKER]), suitable
  1003. for `tabulated-list-printer'."
  1004. (with-current-buffer buffer
  1005. (save-excursion
  1006. (goto-char (point-min))
  1007. (let ((ast (org-element-parse-buffer))
  1008. (id 0)
  1009. (last-line 1)
  1010. (last-pos 1))
  1011. ;; Insert unique ID for each report. Replace buffer positions
  1012. ;; with line numbers.
  1013. (mapcar
  1014. (lambda (report)
  1015. (list
  1016. (cl-incf id)
  1017. (apply #'vector
  1018. (cons
  1019. (progn
  1020. (goto-char (car report))
  1021. (beginning-of-line)
  1022. (prog1 (number-to-string
  1023. (cl-incf last-line
  1024. (count-lines last-pos (point))))
  1025. (setf last-pos (point))))
  1026. (cdr report)))))
  1027. ;; Insert trust level in generated reports. Also sort them
  1028. ;; by buffer position in order to optimize lines computation.
  1029. (sort (cl-mapcan
  1030. (lambda (c)
  1031. (let ((trust (symbol-name (org-lint-checker-trust c))))
  1032. (mapcar
  1033. (lambda (report)
  1034. (list (car report) trust (nth 1 report) c))
  1035. (save-excursion
  1036. (funcall
  1037. (intern (format "org-lint-%s"
  1038. (org-lint-checker-name c)))
  1039. ast)))))
  1040. checkers)
  1041. #'car-less-than-car))))))
  1042. (defvar-local org-lint--source-buffer nil
  1043. "Source buffer associated to current report buffer.")
  1044. (defvar-local org-lint--local-checkers nil
  1045. "List of checkers used to build current report.")
  1046. (defun org-lint--refresh-reports ()
  1047. (setq tabulated-list-entries
  1048. (org-lint--generate-reports org-lint--source-buffer
  1049. org-lint--local-checkers))
  1050. (tabulated-list-print))
  1051. (defun org-lint--current-line ()
  1052. "Return current report line, as a number."
  1053. (string-to-number (aref (tabulated-list-get-entry) 0)))
  1054. (defun org-lint--current-checker (&optional entry)
  1055. "Return current report checker.
  1056. When optional argument ENTRY is non-nil, use this entry instead
  1057. of current one."
  1058. (aref (if entry (nth 1 entry) (tabulated-list-get-entry)) 3))
  1059. (defun org-lint--display-reports (source checkers)
  1060. "Display linting reports for buffer SOURCE.
  1061. CHECKERS is the list of checkers used."
  1062. (let ((buffer (get-buffer-create "*Org Lint*")))
  1063. (with-current-buffer buffer
  1064. (org-lint--report-mode)
  1065. (setf org-lint--source-buffer source)
  1066. (setf org-lint--local-checkers checkers)
  1067. (org-lint--refresh-reports)
  1068. (tabulated-list-print)
  1069. (add-hook 'tabulated-list-revert-hook #'org-lint--refresh-reports nil t))
  1070. (pop-to-buffer buffer)))
  1071. (defun org-lint--jump-to-source ()
  1072. "Move to source line that generated the report at point."
  1073. (interactive)
  1074. (let ((l (org-lint--current-line)))
  1075. (switch-to-buffer-other-window org-lint--source-buffer)
  1076. (org-goto-line l)
  1077. (org-show-set-visibility 'local)
  1078. (recenter)))
  1079. (defun org-lint--show-source ()
  1080. "Show source line that generated the report at point."
  1081. (interactive)
  1082. (let ((buffer (current-buffer)))
  1083. (org-lint--jump-to-source)
  1084. (switch-to-buffer-other-window buffer)))
  1085. (defun org-lint--hide-checker ()
  1086. "Hide all reports from checker that generated the report at point."
  1087. (interactive)
  1088. (let ((c (org-lint--current-checker)))
  1089. (setf tabulated-list-entries
  1090. (cl-remove-if (lambda (e) (equal c (org-lint--current-checker e)))
  1091. tabulated-list-entries))
  1092. (tabulated-list-print)))
  1093. (defun org-lint--ignore-checker ()
  1094. "Ignore all reports from checker that generated the report at point.
  1095. Checker will also be ignored in all subsequent reports."
  1096. (interactive)
  1097. (setf org-lint--local-checkers
  1098. (remove (org-lint--current-checker) org-lint--local-checkers))
  1099. (org-lint--hide-checker))
  1100. ;;; Public function
  1101. ;;;###autoload
  1102. (defun org-lint (&optional arg)
  1103. "Check current Org buffer for syntax mistakes.
  1104. By default, run all checkers. With a `\\[universal-argument]' prefix ARG, \
  1105. select one
  1106. category of checkers only. With a `\\[universal-argument] \
  1107. \\[universal-argument]' prefix, run one precise
  1108. checker by its name.
  1109. ARG can also be a list of checker names, as symbols, to run."
  1110. (interactive "P")
  1111. (unless (derived-mode-p 'org-mode) (user-error "Not in an Org buffer"))
  1112. (when (called-interactively-p 'any)
  1113. (message "Org linting process starting..."))
  1114. (let ((checkers
  1115. (pcase arg
  1116. (`nil org-lint--checkers)
  1117. (`(4)
  1118. (let ((category
  1119. (completing-read
  1120. "Checker category: "
  1121. (mapcar #'org-lint-checker-categories org-lint--checkers)
  1122. nil t)))
  1123. (cl-remove-if-not
  1124. (lambda (c)
  1125. (assoc-string (org-lint-checker-categories c) category))
  1126. org-lint--checkers)))
  1127. (`(16)
  1128. (list
  1129. (let ((name (completing-read
  1130. "Checker name: "
  1131. (mapcar #'org-lint-checker-name org-lint--checkers)
  1132. nil t)))
  1133. (catch 'exit
  1134. (dolist (c org-lint--checkers)
  1135. (when (string= (org-lint-checker-name c) name)
  1136. (throw 'exit c)))))))
  1137. ((pred consp)
  1138. (cl-remove-if-not (lambda (c) (memq (org-lint-checker-name c) arg))
  1139. org-lint--checkers))
  1140. (_ (user-error "Invalid argument `%S' for `org-lint'" arg)))))
  1141. (if (not (called-interactively-p 'any))
  1142. (org-lint--generate-reports (current-buffer) checkers)
  1143. (org-lint--display-reports (current-buffer) checkers)
  1144. (message "Org linting process completed"))))
  1145. (provide 'org-lint)
  1146. ;;; org-lint.el ends here