#!/usr/bin/env txrlisp

;; 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 nowrap"
                          "map q :q!\r"
                          "map b \002\r"
                          "map <space> \006")))

(defvarl cols (or (getenv "MANWIDTH")
                  (getenv "COLUMNS")
                  "80"))

(defun grave-accent (x)
  (casequal x
    ("a" "à")
    ("e" "è")
    ("u" "ù")
    ("A" "À")
    ("E" "È")
    ("U" "Ù")
    (t x)))

(defun acute-accent (x)
  (casequal x
    ("e" "é")
    ("E" "É")
    (t x)))

(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.)?(\b.)?/ t line)))
          (match-case tok
            ("")
            (`@{x #/ +/}` (output-text x cur-mode))
            (`@{x #/[eE]/}\b@x\b´\b´` (output-text (acute-accent x) :bold))
            (`@{x #/[aAeEuU]/}\b@x\b\`\b\`` (output-text (grave-accent x) :bold))
            (`_\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 #/[eE]/}\b´` (output-text (acute-accent x) cur-mode))
            (`@{x #/[aAeEuU]/}\b\`` (output-text (grave-accent x) cur-mode))
            (`@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.@cols`)
                                    (remove-path rendered-file)))
      (with-stream (s (open-file rendered-file "w"))
        (let ((hfilt (op regsub #/[\x2010\x2013\x2014\x2212]/ "-"))
              (ofilt (make-overstrike-filter (lambda (str) (put-string str s)))))
          (whilet ((line (get-line)))
            (flow line hfilt ofilt))))
      (sh `vim +'@{vim-commands}' '@{rendered-file}' < /dev/tty`))))