Tests/OrgCoreTests/EmacsOracle.swift

  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) -> (text: String, caret: Int, failure: String?) {
166    let context = EditContext(revision: 0, text: text, tree: OrgParser.parse(text), selection: [caret..<caret], answers: answers, options: options)
167    switch command.run(in: context) {
168    case .commit(let result):
169        var new = text
170        for edit in result.edits.sorted(by: { $0.range.lowerBound > $1.range.lowerBound }) { new = edit.apply(to: new) }
171        return (new, result.selection?.first?.lowerBound ?? caret, nil)
172    case .failed(let message):
173        return (text, caret, message)
174    case .prompt(let prompt):
175        return (text, caret, "prompt: \(prompt.key)")
176    case .external(let request):
177        return (text, caret, "external: \(request)")
178    }
179}