1;; -*- coding:utf-8 -*-
2
3(use gauche.process)
4(use gauche.version)
5(use file.util)
6(use util.match)
7(use srfi-13)
8
9;;;
10;;;  Call makeinfo to generate various document output
11;;;
12
13(define (main args)
14  (cond-expand
15   ;; do not let LANG setting affect makeinfo
16   [gauche.sys.setenv (sys-putenv "LANG=C")]
17   [else])
18  (if (match (cdr args)
19        [("info" input makeinfo gzip)     (do-info input makeinfo gzip)]
20        [("html" input makeinfo)          (do-html input makeinfo)]
21        [("htmls" input makeinfo version) (do-htmls input makeinfo version)]
22        [("pdf" input makeinfo)           (do-pdf input makeinfo)]
23        [("dvi" input makeinfo)           (do-dvi input makeinfo)]
24        [_ (usage)])
25    0 1))
26
27(define (usage)
28  (print "Usage: gosh makedoc.scm command args ...")
29  (print "Valid commands (and args):")
30  (print "  info input MAKEINFO GZIP            - generate info doc")
31  (print "  html input MAKEINFO                 - generate single html")
32  (print "  htmls input MAKEINFO VERSION-STRING - generate html files in subdir")
33  (print "  pdf input MAKEINFO                  - generate pdf")
34  (print "  dvi input MAKEINFO                  - generate dvi")
35  #f)
36
37(define (make-cmd cmd-list)
38  (cond-expand
39   [gauche.os.windows
40    ;; for MSYS (mintty)
41    (if-let1 sh (sys-getenv "SHELL")
42      `("cmd.exe" "/c" ,sh "-c" ,(string-join
43                                  (map (^c (shell-escape-string (x->string c) 'posix))
44                                       cmd-list)
45                                  " "))
46      `("cmd.exe" "/c" ,@cmd-list))]
47   [else cmd-list]))
48
49(define (check-makeinfo-version makeinfo min-version)
50  (and-let* ([ makeinfo ]
51             [msg (process-output->string (make-cmd `(,makeinfo --version)))]
52             [vers (rxmatch->string #/\d+\.\d+(\.\d+)?/ msg)])
53    (rlet1 b (version<=? min-version vers)
54      (unless b
55        (warn "makeinfo version ~a or greater is required, but ~a's \
56               version is ~a.  Skipping.\n" min-version makeinfo vers)))))
57
58(define (do-info input makeinfo gzip)
59  (define info (path-swap-extension input "info"))
60  (or (string-null? makeinfo)
61      (string-null? gzip)
62      (not (check-makeinfo-version makeinfo "5.0"))
63      (and (do-process (make-cmd `(,makeinfo ,input)))
64           (begin (remove-files (glob #"~|info|*.gz"))
65                  (do-process (make-cmd `(,gzip ,info ,@(glob #"~|info|-[0-9]*"))))))))
66
67(define (do-html input makeinfo)
68  (or (string-null? makeinfo)
69      (not (check-makeinfo-version makeinfo "5.0"))
70      (do-process (make-cmd
71                   `(,makeinfo "--html"
72                               "--no-split"
73                               "--set-customization-variable"
74                               "TOP_NODE_UP_URL=https://practical-scheme.net/gauche"
75                               "-"))
76                  :redirects `((<< 0 ,(alter-top-node input))))))
77
78(define (do-htmls input makeinfo version-info)
79  (define top-link (if (#/j\.texi$/ input)
80                     "https://practical-scheme.net/gauche/memo-j.html"
81                     "https://practical-scheme.net/gauche/memo.html"))
82  (or (string-null? makeinfo)
83      (not (check-makeinfo-version makeinfo "5.0"))
84      (do-process (make-cmd
85                   `(,makeinfo "--html"
86                               "--split=section"
87                               "--set-customization-variable"
88                               ,#"AFTER_BODY_OPEN=<div style=\"width:100%\" class=\"header\"><p style=\"text-align:center\"><a href=\"~|top-link|\">For ~|version-info|</a></p></div><hr>"
89                               "--set-customization-variable"
90                               ,#"PRE_BODY_CLOSE=<hr><div style=\"width:100%\" class=\"footer\"><p style=\"text-align:center\"><a href=\"~|top-link|\">For ~|version-info|</a></p></div>"
91                               "--set-customization-variable"
92                               ,#"TOP_NODE_UP_URL=~|top-link|"
93                               "-"))
94                  :redirects `((<< 0 ,(alter-top-node input))))))
95
96;; For html, makeinfo generates "(dir)" link in the top node, which we don't
97;; need.  TOP_NODE_UP_URL doesn't alter link for "Previous".
98;; So we employ this kludge to modify the Top node definition
99(define (alter-top-node input)
100  ($ (cut string-join <> "\n" 'suffix)
101     $ map (^l (if (#/^@node Top,/ l) "@node Top" l))
102     $ file->string-list input))
103
104;; For pdf and dvi: We need newer luatex (0.95 or later) to process Japanese.
105;; But even if you don't have that newer luatex, TeX can handle English
106;; version.  So, for now, we conditionally switch TeX based on the input
107;; file name.  We won't need the switching once everybody has newer versions.
108;; (NB: Also not you need texinfo-ja to process Japanese version; they've
109;; merged only recently (May 2016) and may not be available unless you're
110;; using bleeding edge.  Cf. http://www.trueroad.jp/2016/05/14-01.html)
111
112(define (do-pdf input makeinfo)
113  (cond-expand
114   [gauche.sys.setenv
115    (when (#/j\.texi$/ input)
116      (sys-putenv "PDFTEX=luatex"))]
117   [else])
118  (do-process (make-cmd `(,makeinfo "--pdf" "--Xopt" "--tidy" ,input))))
119
120(define (do-dvi input makeinfo)
121  (cond-expand
122   [gauche.sys.setenv
123    (when (#/j\.texi$/ input)
124      (sys-putenv "TEX=dviluatex"))]
125   [else])
126  (do-process (make-cmd `(,makeinfo "--dvi" "--Xopt" "--tidy" ,input))))
127
128