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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79

#!/usr/bin/env txr

;; Copyright 2023
;; Kaz Kylheku <kaz@kylheku.com>
;; Vancouver, Canada
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions is met:
;;
;; Redistributions of source code must retain the above copyright notice, this
;; conditions and the following disclaimer.
;;
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;; POSSIBILITY OF SUCH DAMAGE.

(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"
                          "map b \002\r"
                          "map <space> \006")))

(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 cur-mode))
            (`_\b@x\b@x` (output-text x :bital))
            (`_\b_` (output-text "_"
                                 (if (meq cur-mode :bital :ital)
                                   :ital
                                   :bold)))
            (`_\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`))))