mnpgr.tl


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

#!/usr/bin/env txr

(defvarl home-dir (getenv "HOME"))

(defvarl mnpgr-dir (path-cat home-dir ".mnpgr-dir"))

(defvarl vim-commands
         (join-with "|" '("set syntax=mnpgr"
                          "set conceallevel=2 concealcursor=nc"
                          "map q :q!\r")))

(defun make-overstrike-filter (put-string-fn)
  (let ((cur-mode :norm)
        (closer ""))
    (flet ((output-text (str mode)
             (when (neq mode cur-mode)
               [put-string-fn closer]
               (caseq (set cur-mode mode)
                 (:bold [put-string-fn "{B{"]
                        (set closer "}B}"))
                 (:ital [put-string-fn "{I{"]
                        (set closer "}I}"))
                 (:bital [put-string-fn "{C{"]
                         (set closer "}C}"))
                 (:norm (set closer ""))))
             [put-string-fn str]))
      (lambda (line)
        (each ((tok (tok #/.\b.(\b.)?/ t line)))
          (match-case tok
            ("")
            (`@{x #/ +/}` (output-text x :norm))
            (`_\b@x\b@x` (output-text x :bital))
            (`_\b@x` (output-text x :ital))
            (`@x\b@x` (output-text x :bold))
            (@else (output-text else :norm))))
        (output-text "\n" :norm)))))

(compile-only   ;; I.e. do not execute these forms during compilation
  (ensure-dir mnpgr-dir)

  (match @(or `@page(@section)`     ;; for "man whatever"
              `@page\\.@section`)   ;; for "man -l file.1"
         (getenv "MAN_PN")
    (with-resources ((rendered-file (path-cat mnpgr-dir `@page.@section`)
                                    (remove-path rendered-file)))
      (with-stream (s (open-file rendered-file "w"))
        (let ((ofilt (make-overstrike-filter (lambda (str) (put-string str s)))))
          (whilet ((line (get-line)))
            [ofilt line])))
      (sh `vim +'@{vim-commands}' '@{rendered-file}' < /dev/tty`))))