org-lint.el 42 KB

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