Tests/OrgCoreTests/EmacsOracle.swift
180 lines · 9054 bytes
1import Foundation
2@testable import OrgCore
3
4/// Runs cases through `emacs -Q --batch` with Org's settings pinned, so commands can be
5/// compared with Emacs byte for byte. One Emacs process runs a whole batch.
6///
7/// Pinned versions: Emacs 31.1, Org 9.8.7 (design, "Testing"). `ORGSTAR_EMACS` overrides the
8/// executable.
9enum EmacsOracle {
10 struct Case: Codable {
11 var text: String
12 /// Emacs point: 1 plus the number of characters (code points) before it.
13 var point: Int
14 /// An Emacs Lisp form to run with point there.
15 var form: String
16 }
17
18 struct Result: Codable, Equatable {
19 var text: String
20 var point: Int
21 /// The error message, or empty.
22 var error: String
23 }
24
25 static let script = #"""
26 ;;; -*- lexical-binding: t -*-
27 (require 'org)
28 (require 'json)
29 (require 'cl-lib)
30 (setq org-todo-keywords '((sequence "TODO" "DONE"))
31 org-log-done nil
32 org-adapt-indentation nil
33 org-tags-column -77
34 org-priority-highest ?A
35 org-priority-lowest ?C
36 org-priority-default ?B)
37 ;; Buffer-local when set, so set the default for the case buffers.
38 (setq-default indent-tabs-mode nil)
39 ;; Archive files open in Org mode, as in usual configurations.
40 (add-to-list 'auto-mode-alist '("\\.org_archive\\'" . org-mode))
41 (let* ((input (with-temp-buffer
42 (let ((coding-system-for-read 'utf-8-unix))
43 (insert-file-contents (getenv "ORACLE_INPUT")))
44 (json-parse-buffer :object-type 'alist :array-type 'list)))
45 (results nil))
46 (dolist (c input)
47 (with-temp-buffer
48 (insert (alist-get 'text c))
49 (org-mode)
50 ;; `#+STARTUP' may fold the buffer; cases run with everything visible.
51 (org-fold-show-all)
52 ;; Fontified, as in a displayed buffer: widths follow what is visible.
53 (font-lock-ensure)
54 (goto-char (alist-get 'point c))
55 ;; As an interactive call, not a repeat: some commands cycle differently on repeats.
56 (setq this-command 'orgstar-oracle last-command nil)
57 (let ((err (condition-case e
58 (progn (eval (car (read-from-string (alist-get 'form c))) t) "")
59 (error (error-message-string e)))))
60 (push `((text . ,(buffer-substring-no-properties (point-min) (point-max)))
61 (point . ,(point))
62 (error . ,err))
63 results))))
64 (let ((coding-system-for-write 'utf-8-unix))
65 (with-temp-file (getenv "ORACLE_OUTPUT")
66 (insert (json-encode (nreverse results))))))
67 """#
68
69 static var executable: String { ProcessInfo.processInfo.environment["ORGSTAR_EMACS"] ?? "emacs" }
70
71 static var isAvailable: Bool {
72 (try? run(["--version"]))?.contains("GNU Emacs") ?? false
73 }
74
75 static func run(_ cases: [Case]) throws -> [Result] {
76 let folder = FileManager.default.temporaryDirectory.appendingPathComponent("orgstar-oracle-\(UUID().uuidString)")
77 try FileManager.default.createDirectory(at: folder, withIntermediateDirectories: true)
78 defer { try? FileManager.default.removeItem(at: folder) }
79 let scriptURL = folder.appendingPathComponent("oracle.el")
80 let input = folder.appendingPathComponent("input.json")
81 let output = folder.appendingPathComponent("output.json")
82 try script.write(to: scriptURL, atomically: true, encoding: .utf8)
83 try JSONEncoder().encode(cases).write(to: input)
84 _ = try run(["-Q", "--batch", "-l", scriptURL.path], environment: ["ORACLE_INPUT": input.path, "ORACLE_OUTPUT": output.path, "TZ": "UTC"])
85 return try JSONDecoder().decode([Result].self, from: Data(contentsOf: output))
86 }
87
88 @discardableResult
89 static func run(_ arguments: [String], environment: [String: String] = [:]) throws -> String {
90 let process = Process()
91 process.executableURL = URL(fileURLWithPath: "/usr/bin/env")
92 process.arguments = [executable] + arguments
93 process.environment = ProcessInfo.processInfo.environment.merging(environment) { $1 }
94 let pipe = Pipe()
95 process.standardOutput = pipe
96 process.standardError = pipe
97 try process.run()
98 let data = pipe.fileHandleForReading.readDataToEndOfFile()
99 process.waitUntilExit()
100 return String(decoding: data, as: UTF8.self)
101 }
102
103 /// Evaluates `form`, which returns a list of strings, in an org-mode buffer visiting a
104 /// file that holds `text`; `prelude` runs first (settings). The strings come back in order.
105 static func evaluate(_ text: String, _ form: String, prelude: String = "", file: String = "oracle.org") throws -> [String] {
106 let folder = FileManager.default.temporaryDirectory.appendingPathComponent("orgstar-eval-\(UUID().uuidString)")
107 try FileManager.default.createDirectory(at: folder, withIntermediateDirectories: true)
108 defer { try? FileManager.default.removeItem(at: folder) }
109 let url = folder.appendingPathComponent(file)
110 try text.write(to: url, atomically: true, encoding: .utf8)
111 let output = folder.appendingPathComponent("out.json")
112 let script = folder.appendingPathComponent("eval.el")
113 try """
114 ;;; -*- lexical-binding: t -*-
115 (require 'org)
116 (require 'json)
117 \(prelude)
118 (with-current-buffer (find-file-noselect "\(url.path)")
119 (org-mode)
120 (let ((result \(form)))
121 (let ((coding-system-for-write 'utf-8-unix))
122 (with-temp-file (getenv "ORACLE_OUTPUT")
123 (insert (json-encode (vconcat result)))))))
124 """.write(to: script, atomically: true, encoding: .utf8)
125 let log = try run(["-Q", "--batch", "-l", script.path], environment: ["ORACLE_OUTPUT": output.path, "TZ": "UTC"])
126 guard let data = try? Data(contentsOf: output) else { throw EvaluateError(log: log) }
127 return try JSONDecoder().decode([String].self, from: data)
128 }
129
130 struct EvaluateError: Error { let log: String }
131
132 /// UTF-16 offset to Emacs point.
133 static func point(_ offset: Int, in text: String) -> Int {
134 let index = String.Index(utf16Offset: offset, in: text)
135 return text.unicodeScalars[..<index].count + 1
136 }
137
138 /// Emacs point to UTF-16 offset.
139 static func offset(_ point: Int, in text: String) -> Int {
140 text.unicodeScalars.prefix(point - 1).reduce(0) { $0 + $1.utf16.count }
141 }
142
143 /// UTF-16 offsets of every unicode scalar boundary, including the end.
144 static func positions(_ text: String) -> [Int] {
145 var positions = [0]
146 var offset = 0
147 for scalar in text.unicodeScalars {
148 offset += scalar.utf16.count
149 positions.append(offset)
150 }
151 return positions
152 }
153}
154
155/// The options as Emacs Lisp bindings around `form`.
156func withOptions(_ options: EditingOptions, _ form: String) -> String {
157 func flag(_ value: Bool) -> String { value ? "t" : "nil" }
158 return "(let ((org-tags-column \(options.tagsColumn)) (org-insert-heading-respect-content \(flag(options.insertHeadingRespectContent))) (org-M-RET-may-split-line \(flag(options.metaReturnMaySplitLine))) (org-list-allow-alphabetical \(flag(options.listAllowAlphabetical))) (fill-column \(options.fillColumn)) (sentence-end-double-space nil) (org-hide-emphasis-markers \(flag(options.hideEmphasisMarkers))) (org-pretty-entities \(flag(options.prettyEntities))) (org-use-sub-superscripts \(options.subSuperscriptsNeedBraces ? "'{}" : "t"))) (font-lock-flush) (font-lock-ensure) \(form))"
159}
160
161/// The options in the user's Doom Emacs.
162let doomOptions = EditingOptions(tagsColumn: 0, insertHeadingRespectContent: true, metaReturnMaySplitLine: false, listAllowAlphabetical: true, fillColumn: 80, hideEmphasisMarkers: true, prettyEntities: true, subSuperscriptsNeedBraces: true)
163
164/// Runs a command the way an editor would: build a context, run, apply the edits.
165func runCommand(_ command: any OrgCommand, _ text: String, caret: Int, answers: [String: String] = [:], options: EditingOptions = .org,
166 calendar: Calendar = .current) -> (text: String, caret: Int, failure: String?) {
167 let context = EditContext(revision: 0, text: text, tree: OrgParser.parse(text), selection: [caret..<caret], calendar: calendar, answers: answers, options: options)
168 switch command.run(in: context) {
169 case .commit(let result):
170 var new = text
171 for edit in result.edits.sorted(by: { $0.range.lowerBound > $1.range.lowerBound }) { new = edit.apply(to: new) }
172 return (new, result.selection?.first?.lowerBound ?? caret, nil)
173 case .failed(let message):
174 return (text, caret, message)
175 case .prompt(let prompt):
176 return (text, caret, "prompt: \(prompt.key)")
177 case .external(let request):
178 return (text, caret, "external: \(request)")
179 }
180}