1 ;;; ste-lint.el --- Lint Org prose against ASD-STE100 -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2026 4 5 ;; This file is NOT part of GNU Emacs. 6 7 ;;; Commentary: 8 9 ;; This file finds Simplified Technical English (ASD-STE100) smells in the 10 ;; prose of Org files. It has two entry points: 11 ;; 12 ;; - `ste-lint-batch' lints files from the command line: 13 ;; 14 ;; emacs -Q --batch -l ste-lint.el -f ste-lint-batch FILE-OR-DIR... 15 ;; 16 ;; Each finding goes to standard error as one line in the GNU format 17 ;; "FILE:LINE:COLUMN: SEVERITY [CATEGORY] MATCH -- SUGGESTION". The exit 18 ;; status is 1 when there is at least one ERROR finding, and 0 otherwise. 19 ;; With no argument, the command lints every Org file below the current 20 ;; directory. 21 ;; 22 ;; - `ste-lint-flymake-setup' adds a Flymake backend to an Org buffer. 23 ;; Findings then show in the buffer while you type. Agents can read them 24 ;; with the `get-diagnostics' MCP tool. 25 ;; 26 ;; The Org parser decides what is prose. The linter checks headline titles 27 ;; and paragraphs. It does not check drawers, property drawers, planning 28 ;; lines, keywords, tables, source blocks, example blocks, quote blocks, verse 29 ;; blocks, or dynamic blocks. Inside the prose, the linter masks inline code, 30 ;; verbatim text, timestamps, link targets, and similar markup. It keeps the 31 ;; text positions, so that each finding points to its exact place. 32 ;; 33 ;; The rule tables below hold every rule. Each rule traces to ASD-STE100. 34 ;; They are a port of the rule tables of the ste-lint.pl script in the 35 ;; EUSCDanubeWikiCDK package. 36 ;; 37 ;; Severity: 38 ;; ERROR -- an unambiguous STE100 violation. It fails the batch run. 39 ;; WARN -- a judgment call with more false positives. It does not fail. 40 41 ;;; Code: 42 43 (require 'cl-lib) 44 (require 'flymake) 45 (require 'org) 46 (require 'org-element) 47 48 (defgroup ste-lint nil 49 "Lint Org prose against ASD-STE100." 50 :group 'org) 51 52 (defcustom ste-lint-max-words-description 25 53 "Maximum number of words in a descriptive sentence." 54 :type 'integer) 55 56 (defcustom ste-lint-max-words-procedure 20 57 "Maximum number of words in a sentence of a procedure step. 58 The linter treats each item of an ordered list as a procedure step." 59 :type 'integer) 60 61 ;;;; Rule tables 62 63 (defconst ste-lint-pattern-rules 64 (list 65 (list :category "contraction" 66 :severity 'error 67 ;; An apostrophe followed by "s" is not a rule: it is almost always 68 ;; a possessive. 69 :regexp (rx word-boundary 70 (group-n 1 (+ word) 71 (or (seq "n" (any "'’") "t") 72 (seq (any "'’") (or "ll" "re" "ve" "d" "m")))) 73 word-boundary) 74 :suggestion "Write the full form, for example \"do not\".") 75 (list :category "latin-abbreviation" 76 :severity 'error 77 :regexp (rx word-boundary 78 (group-n 1 (or "e.g." "i.e." "etc." "vs." "viz." 79 (seq "et" (+ blank) "al.") "cf." "n.b."))) 80 :suggestion (concat "Write plain English, for example \"for example\"" 81 " or \"that is\", or list the items.")) 82 (list :category "semicolon" 83 :severity 'error 84 :skip (rx word-boundary "TL;DR" word-boundary) 85 :regexp (rx (group-n 1 ";")) 86 :suggestion "Write two sentences.") 87 (list :category "ampersand" 88 :severity 'warn 89 ;; Only an ampersand with white space on each side is the word "and". 90 :regexp (rx blank (group-n 1 "&") blank) 91 :suggestion "Write \"and\".") 92 (list :category "slash-conjunction" 93 :severity 'warn 94 :regexp (rx word-boundary 95 (group-n 1 (or "and/or" "he/she" "his/her" "him/her" 96 "she/he" "either/or")) 97 word-boundary) 98 :suggestion "Name one term, or write \"x or y\".") 99 (list :category "instruction-mood" 100 :severity 'warn 101 :regexp (rx word-boundary 102 (group-n 1 "you" (+ blank) 103 (or "should" "must" "can" "may" "will" 104 (seq "need" (+ blank) "to") 105 (seq "have" (+ blank) "to"))) 106 word-boundary) 107 :suggestion "Use the imperative, for example \"Run the script\".") 108 (list :category "nominalization" 109 :severity 'warn 110 :regexp (rx word-boundary 111 (group-n 1 112 (or "do" "perform" (seq "carry" (+ blank) "out") 113 "conduct" "make" "provide") 114 (+ blank) 115 (? (or "a" "an" "the") (+ blank)) 116 (+ word) 117 (or "tion" "ment" "ance" "ence" "al" "ing") 118 word-boundary 119 (? (+ blank) "of"))) 120 :suggestion "Use the verb, for example \"deploy\".")) 121 "Rules that a regular expression triggers. 122 Each rule is a plist. `:regexp' is the trigger, and its group 1 is the 123 reported match. `:skip' is an optional regular expression for idioms that 124 the rule must ignore.") 125 126 (defconst ste-lint-substitution-rules 127 '(("wordy-phrase" warn 128 ("utilize" . "use") ("utilizes" . "uses") ("utilized" . "used") 129 ("utilizing" . "using") ("in order to" . "to") 130 ("it is necessary to" . "you must") ("prior to" . "before") 131 ("subsequent to" . "after") ("terminate" . "stop") 132 ("terminates" . "stops") ("terminated" . "stopped") 133 ("initiate" . "start") ("initiates" . "starts") 134 ("initiated" . "started") ("execute" . "do or run") 135 ("executes" . "does or runs") ("executed" . "done or run") 136 ("a number of" . "several") ("a large number of" . "many") 137 ("the majority of" . "most") ("in the event that" . "if") 138 ("due to the fact that" . "because") 139 ("in the process of" . "(drop it, or name the step)") 140 ("at this point in time" . "now") ("with regard to" . "about") 141 ("in terms of" . "for or about") ("in the case of" . "for") 142 ("is able to" . "can") ("are able to" . "can")) 143 ("phrasal-verb" warn 144 ("carry out" . "do or run") ("carries out" . "does or runs") 145 ("carried out" . "did or ran") ("put out" . "extinguish") 146 ("give off" . "release") ("gives off" . "releases") 147 ("gave off" . "released") 148 ("set up" . "configure or install (as a verb)") 149 ("shut down" . "stop") ("turn off" . "disable") 150 ("turn on" . "enable") ("spin up" . "start or launch") 151 ("kick off" . "start") ("roll out" . "deploy or release") 152 ("back up" . "save a copy of (as a verb)")) 153 ("weak-wording" warn 154 ("make sure" . "confirm that") ("a lot of" . "many or much") 155 ("lots of" . "many or much") 156 ("and so on" . "(list the items, or omit)") ("as well as" . "and")) 157 ("gendered-language" warn 158 ("he" . "they, or name the role") ("she" . "they, or name the role") 159 ("his" . "their, or name the role") 160 ("hers" . "theirs, or name the role") 161 ("him" . "them, or name the role") ("manpower" . "staff or effort") 162 ("man-hours" . "person-hours"))) 163 "Words and phrases with a preferred replacement. 164 Each entry is (CATEGORY SEVERITY (PHRASE . REPLACEMENT)...). A phrase 165 matches on word boundaries and without regard to case. The words of a 166 phrase can have any white space between them, which includes a line break.") 167 168 (defconst ste-lint-excluded-ancestors 169 '(drawer property-drawer quote-block verse-block dynamic-block) 170 "Element types whose paragraphs the linter does not check. 171 Drawers hold logbook history. Quote and verse blocks hold quoted text. 172 Dynamic blocks hold generated text.") 173 174 (defconst ste-lint--word-like-objects 175 '(code verbatim inline-src-block inline-babel-call timestamp entity 176 latex-fragment macro export-snippet) 177 "Object types that the linter replaces with one word.") 178 179 (defconst ste-lint--noise-objects 180 '(statistics-cookie footnote-reference line-break target radio-target) 181 "Object types that the linter replaces with white space.") 182 183 (defconst ste-lint--syntax-table 184 (let ((table (make-syntax-table text-mode-syntax-table))) 185 (modify-syntax-entry ?' "." table) 186 (modify-syntax-entry ?’ "." table) 187 table) 188 "Syntax table for the rule matches. 189 An apostrophe is punctuation, so that the rules see the parts of a 190 contraction as separate words.") 191 192 ;;;; Findings 193 194 (cl-defstruct (ste-lint-finding (:constructor ste-lint--make-finding) 195 (:copier nil)) 196 "One STE smell in a buffer." 197 beg end severity category match suggestion) 198 199 (defun ste-lint--squeeze (string) 200 "Return STRING with each run of white space changed to one space." 201 (string-trim (replace-regexp-in-string "[[:space:]]+" " " string))) 202 203 ;;;; Prose extraction 204 205 (defun ste-lint--fill (text from to char base) 206 "Fill TEXT from buffer position FROM to TO with CHAR. 207 BASE is the buffer position of the first character of TEXT." 208 (let ((start (max 0 (- from base))) 209 (end (min (length text) (- to base)))) 210 (cl-loop for index from start below end 211 do (aset text index char)))) 212 213 (defun ste-lint--object-end (object) 214 "Return the end of OBJECT, without its trailing white space." 215 (- (org-element-property :end object) 216 (or (org-element-property :post-blank object) 0))) 217 218 (defun ste-lint--masked-text (data beg end) 219 "Return the prose of the buffer from BEG to END, masked. 220 DATA is the Org element or the secondary string that holds the prose. 221 The result has the same length as the buffer text. Inline code and 222 similar markup become a run of the letter x, which counts as one word. 223 Link targets become white space. Line breaks become spaces." 224 (let ((text (buffer-substring-no-properties beg end))) 225 (org-element-map data 226 (append '(link) ste-lint--word-like-objects ste-lint--noise-objects) 227 (lambda (object) 228 (let ((type (org-element-type object)) 229 (object-beg (org-element-property :begin object)) 230 (object-end (ste-lint--object-end object)) 231 (contents-beg (org-element-property :contents-begin object)) 232 (contents-end (org-element-property :contents-end object))) 233 (cond 234 ((and (eq type 'link) contents-beg) 235 (ste-lint--fill text object-beg contents-beg ?\s beg) 236 (ste-lint--fill text contents-end object-end ?\s beg)) 237 ((or (eq type 'link) (memq type ste-lint--word-like-objects)) 238 (ste-lint--fill text object-beg object-end ?x beg)) 239 (t 240 (ste-lint--fill text object-beg object-end ?\s beg)))))) 241 (subst-char-in-string ?\n ?\s text t))) 242 243 (defun ste-lint--title-region (headline) 244 "Return the region of the title of HEADLINE as (BEG . END), or nil. 245 The region excludes the stars, the keyword, the priority, and the tags." 246 (save-excursion 247 (goto-char (org-element-property :begin headline)) 248 (let ((case-fold-search nil)) 249 (when (and (looking-at org-complex-heading-regexp) 250 (match-beginning 4)) 251 (cons (match-beginning 4) (match-end 4)))))) 252 253 (defun ste-lint--procedure-p (paragraph) 254 "Return non-nil if PARAGRAPH is in an item of an ordered list." 255 (let ((item (org-element-lineage paragraph '(item)))) 256 (and item 257 (eq (org-element-property 258 :type (org-element-property :parent item)) 259 'ordered)))) 260 261 ;;;; Rule engine 262 263 (defun ste-lint--blank-matches (regexp text) 264 "Return a copy of TEXT with each match of REGEXP filled with spaces." 265 (replace-regexp-in-string 266 regexp (lambda (match) (make-string (length match) ?\s)) text t t)) 267 268 (defun ste-lint--phrase-regexp (phrase) 269 "Return a regular expression for PHRASE on word boundaries. 270 Any white space can separate the words of PHRASE." 271 (concat "\\b\\(" 272 (mapconcat #'regexp-quote (split-string phrase " ") "[[:space:]]+") 273 "\\)\\b")) 274 275 (defun ste-lint--collect (regexp text offset severity category suggestion) 276 "Return a finding for each match of group 1 of REGEXP in TEXT. 277 OFFSET is the buffer position of the first character of TEXT. SEVERITY, 278 CATEGORY, and SUGGESTION go into each finding." 279 (let ((start 0) 280 findings) 281 (while (string-match regexp text start) 282 (push (ste-lint--make-finding 283 :beg (+ offset (match-beginning 1)) 284 :end (+ offset (match-end 1)) 285 :severity severity 286 :category category 287 :match (ste-lint--squeeze (match-string 1 text)) 288 :suggestion suggestion) 289 findings) 290 (setq start (max (match-end 0) (1+ (match-beginning 0))))) 291 (nreverse findings))) 292 293 (defun ste-lint--apply-pattern-rules (text offset) 294 "Return the findings of `ste-lint-pattern-rules' in TEXT at OFFSET." 295 (cl-loop 296 for rule in ste-lint-pattern-rules 297 for skip = (plist-get rule :skip) 298 nconc (ste-lint--collect 299 (plist-get rule :regexp) 300 (if skip (ste-lint--blank-matches skip text) text) 301 offset 302 (plist-get rule :severity) 303 (plist-get rule :category) 304 (plist-get rule :suggestion)))) 305 306 (defun ste-lint--apply-substitution-rules (text offset) 307 "Return the findings of `ste-lint-substitution-rules' in TEXT at OFFSET." 308 (cl-loop 309 for (category severity . phrases) in ste-lint-substitution-rules 310 nconc (cl-loop 311 for (phrase . replacement) in phrases 312 nconc (ste-lint--collect 313 (ste-lint--phrase-regexp phrase) text offset severity 314 category (format "Consider \"%s\" instead." replacement))))) 315 316 (defun ste-lint--check-sentences (text offset max-words) 317 "Return a finding for each sentence of TEXT with more than MAX-WORDS words. 318 OFFSET is the buffer position of the first character of TEXT." 319 (let ((start 0) 320 (length (length text)) 321 findings) 322 (while (and (< start length) 323 (string-match "[^[:space:]]" text start)) 324 (let* ((sentence-beg (match-beginning 0)) 325 (sentence-end (if (string-match 326 "[.!?]+\\(?:[[:space:]]\\|\\'\\)" 327 text sentence-beg) 328 (match-end 0) 329 length)) 330 (words (cl-count-if 331 (lambda (word) (string-match-p "[[:word:]]" word)) 332 (split-string 333 (substring text sentence-beg sentence-end) 334 "[[:space:]]+" t)))) 335 (when (> words max-words) 336 (push (ste-lint--make-finding 337 :beg (+ offset sentence-beg) 338 :end (+ offset 339 (length (string-trim-right 340 (substring text 0 sentence-end)))) 341 :severity 'warn 342 :category "sentence-length" 343 :match (format "%d words" words) 344 :suggestion (format "Split the sentence (maximum %d words)." 345 max-words)) 346 findings)) 347 (setq start sentence-end))) 348 (nreverse findings))) 349 350 (defun ste-lint--check-unit (data beg end max-words) 351 "Return the findings for the prose of DATA from BEG to END. 352 If MAX-WORDS is non-nil, also check the length of each sentence." 353 (let ((text (ste-lint--masked-text data beg end)) 354 (case-fold-search t)) 355 (with-syntax-table ste-lint--syntax-table 356 (append (ste-lint--apply-pattern-rules text beg) 357 (ste-lint--apply-substitution-rules text beg) 358 (and max-words 359 (ste-lint--check-sentences text beg max-words)))))) 360 361 ;;;; Buffer and file entry points 362 363 (defun ste-lint-buffer () 364 "Return the STE findings for the Org prose of the current buffer. 365 The findings are sorted by position." 366 (let (findings) 367 (org-element-map (org-element-parse-buffer) '(headline paragraph) 368 (lambda (element) 369 (pcase (org-element-type element) 370 ('headline 371 (let ((region (ste-lint--title-region element))) 372 (when region 373 (push (ste-lint--check-unit 374 (org-element-property :title element) 375 (car region) (cdr region) nil) 376 findings)))) 377 ('paragraph 378 (unless (org-element-lineage element ste-lint-excluded-ancestors) 379 (push (ste-lint--check-unit 380 element 381 (org-element-property :contents-begin element) 382 (org-element-property :contents-end element) 383 (if (ste-lint--procedure-p element) 384 ste-lint-max-words-procedure 385 ste-lint-max-words-description)) 386 findings)))))) 387 (sort (apply #'append findings) 388 (lambda (a b) (< (ste-lint-finding-beg a) (ste-lint-finding-beg b)))))) 389 390 (defun ste-lint-file (file) 391 "Return the STE findings of the Org FILE. 392 Each element is (LINE COLUMN FINDING). COLUMN counts from 1." 393 (with-temp-buffer 394 (insert-file-contents file) 395 (let ((org-inhibit-startup t) 396 (org-mode-hook nil)) 397 (org-mode)) 398 (mapcar (lambda (finding) 399 (save-excursion 400 (goto-char (ste-lint-finding-beg finding)) 401 (list (line-number-at-pos) (1+ (current-column)) finding))) 402 (ste-lint-buffer)))) 403 404 (defun ste-lint--severity-label (severity) 405 "Return the printed label of SEVERITY." 406 (if (eq severity 'error) "ERROR" "WARN")) 407 408 (defun ste-lint--expand-files (paths) 409 "Return the Org files that PATHS name. 410 A directory gives every Org file below it, without hidden directories." 411 (cl-loop 412 for path in paths 413 nconc (if (file-directory-p path) 414 (directory-files-recursively 415 path "\\.org\\'" nil 416 (lambda (dir) 417 (not (string-prefix-p "." (file-name-nondirectory dir))))) 418 (list path)))) 419 420 (defun ste-lint-batch () 421 "Lint the files and directories on the command line, then exit. 422 With no argument, lint every Org file below `default-directory'. Exit 423 with status 1 if there is at least one ERROR finding." 424 (let ((files (ste-lint--expand-files 425 (or command-line-args-left (list default-directory)))) 426 (errors 0) 427 (warnings 0)) 428 (setq command-line-args-left nil) 429 (dolist (file files) 430 (if (not (file-readable-p file)) 431 (message "warning: cannot read %s" file) 432 (pcase-dolist (`(,line ,column ,finding) (ste-lint-file file)) 433 (if (eq (ste-lint-finding-severity finding) 'error) 434 (cl-incf errors) 435 (cl-incf warnings)) 436 (message "%s:%d:%d: %s [%s] %s -- %s" 437 file line column 438 (ste-lint--severity-label 439 (ste-lint-finding-severity finding)) 440 (ste-lint-finding-category finding) 441 (ste-lint-finding-match finding) 442 (ste-lint-finding-suggestion finding))))) 443 (message "%d error(s), %d warning(s)." errors warnings) 444 (kill-emacs (if (> errors 0) 1 0)))) 445 446 ;;;; Flymake 447 448 (defun ste-lint-flymake (report-fn &rest _args) 449 "Report the STE findings of the current buffer to Flymake. 450 REPORT-FN is the Flymake callback." 451 (funcall report-fn 452 (mapcar (lambda (finding) 453 (flymake-make-diagnostic 454 (current-buffer) 455 (ste-lint-finding-beg finding) 456 (ste-lint-finding-end finding) 457 (if (eq (ste-lint-finding-severity finding) 'error) 458 :error 459 :warning) 460 (format "STE [%s] %s -- %s" 461 (ste-lint-finding-category finding) 462 (ste-lint-finding-match finding) 463 (ste-lint-finding-suggestion finding)))) 464 (ste-lint-buffer)))) 465 466 ;;;###autoload 467 (defun ste-lint-flymake-setup () 468 "Turn on the STE checks of Flymake in the current Org buffer." 469 (interactive) 470 (add-hook 'flymake-diagnostic-functions #'ste-lint-flymake nil t) 471 (flymake-mode 1)) 472 473 (provide 'ste-lint) 474 475 ;;; ste-lint.el ends here 476