forked from shirok/Gauche
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathmakedoc.scm
161 lines (147 loc) · 7.1 KB
/
makedoc.scm
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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
;; -*- coding:utf-8 -*-
(use file.util)
(use gauche.process)
(use gauche.version)
(use srfi.13)
(use util.match)
;;;
;;; Call makeinfo to generate various document output
;;;
(define (main args)
(if (match (cdr args)
[("info" input makeinfo gzip) (do-info input makeinfo gzip)]
[("html" input makeinfo) (do-html input makeinfo)]
[("htmls" input makeinfo version) (do-htmls input makeinfo version)]
[("pdf" input makeinfo) (do-pdf input makeinfo)]
[("dvi" input makeinfo) (do-dvi input makeinfo)]
[("epub" input makeinfo) (do-epub input makeinfo)]
[_ (usage)])
0 1))
(define (usage)
(print "Usage: gosh makedoc.scm command args ...")
(print "Valid commands (and args):")
(print " info input MAKEINFO GZIP - generate info doc")
(print " html input MAKEINFO - generate single html")
(print " htmls input MAKEINFO VERSION-STRING - generate html files in subdir")
(print " pdf input MAKEINFO - generate pdf")
(print " dvi input MAKEINFO - generate dvi")
(print " epub input MAKEINFO - generate ePub")
#f)
(define (make-cmd cmd-list)
(cond-expand
[gauche.os.windows
;; for MSYS (mintty)
(if-let1 sh (sys-getenv "SHELL")
`("cmd.exe" "/c" ,sh "-c" ,(string-join
(map (^c (shell-escape-string (x->string c) 'posix))
cmd-list)
" "))
`("cmd.exe" "/c" ,@cmd-list))]
[else cmd-list]))
(define (check-makeinfo-version makeinfo min-version :optional (quiet? #f))
(and-let* ([ makeinfo ]
[msg (process-output->string (make-cmd `(,makeinfo --version)))]
[vers (rxmatch->string #/\d+\.\d+(\.\d+)?/ msg)])
(rlet1 b (version<=? min-version vers)
(when (and (not b) (not quiet?))
(warn "makeinfo version ~a or greater is required, but ~a's \
version is ~a. Skipping.\n" min-version makeinfo vers)))))
(define (do-info input makeinfo gzip)
(define info (path-swap-extension input "info"))
(or (string-null? makeinfo)
(string-null? gzip)
(not (check-makeinfo-version makeinfo "5.0"))
(and (do-process (make-cmd `(,makeinfo ,input)))
(begin (remove-files (glob #"~|info|*.gz"))
(do-process (make-cmd `(,gzip "-n" ,info ,@(glob #"~|info|-[0-9]*"))))))))
(define (do-html input makeinfo)
(or (string-null? makeinfo)
(not (check-makeinfo-version makeinfo "5.0"))
(do-process (make-cmd
`(,makeinfo "--html"
"--no-split"
"--set-customization-variable"
"TOP_NODE_UP_URL=https://practical-scheme.net/gauche"
"-"))
:redirects `((<< 0 ,(alter-top-node input))))))
(define (do-htmls input makeinfo version-info)
(define draft? (#/DRAFT/ version-info))
(define ja? (#/j\.texi$/ input))
(define top-link
(cond [draft? "https://github.com/shirok/Gauche"]
[ja? "https://practical-scheme.net/gauche/memo-j.html"]
[else "https://practical-scheme.net/gauche/memo.html"]))
(define header-style (if draft?
"width:100%;background-color:#f88;"
"width:100%;background-color:#cfc;"))
(define lang (if ja? "ja" "en"))
(define draft-search (if draft?
"<input type=\"hidden\" name=\"v\" value=\"draft\">"
""))
(define header-div #"<div style=\"~|header-style|\">\
<form action=\"https://practical-scheme.net/gauche/man/\"\
style=\"padding:5px 10px\">\
<a href=\"~|top-link|\">For ~|version-info|</a>\
<span style=\"float: right\">\
Search (procedure/syntax/module): \
<input type=\"text\" name=\"p\">\
<input type=\"hidden\" name=\"l\" value=\"~|lang|\">\
~|draft-search|\
</span>\
</form>\
</div>")
(define draft-mark (if draft?
"<div style=\"position:fixed;top:150px;right:0px;\
font:bold 70px Helvetica,sans-serif;\
color:#f00;opacity:0.4;\
transform:rotate(-90deg)\">\
DRAFT\
</div>"
""))
(or (string-null? makeinfo)
(not (check-makeinfo-version makeinfo "5.0"))
(do-process (make-cmd
`(,makeinfo "--html"
"--split=section"
"--set-customization-variable"
,#"AFTER_BODY_OPEN=~|header-div|<hr>"
"--set-customization-variable"
,#"PRE_BODY_CLOSE=<hr>~|header-div|~|draft-mark|"
"--set-customization-variable"
,#"TOP_NODE_UP_URL=~|top-link|"
,@(cond-list
[(check-makeinfo-version makeinfo "6.8" #t) @
`("--set-customization-variable"
"FORMAT_MENU=menu"
"--set-customization-variable"
"CONTENTS_OUTPUT_LOCATION=inline")]
[draft? @
`("-o"
,#"~(path-sans-extension input)-draft")])
"-"))
:redirects `((<< 0 ,(alter-top-node input))))))
;; For html, makeinfo generates "(dir)" link in the top node, which we don't
;; need. TOP_NODE_UP_URL doesn't alter link for "Previous".
;; So we employ this kludge to modify the Top node definition
(define (alter-top-node input)
($ (cut string-join <> "\n" 'suffix)
$ map (^l (if (#/^@node Top,/ l) "@node Top" l))
$ file->string-list input))
;; For pdf and dvi: We need newer luatex (0.95 or later) to process Japanese.
;; But even if you don't have that newer luatex, TeX can handle English
;; version. So, for now, we conditionally switch TeX based on the input
;; file name. We won't need the switching once everybody has newer versions.
;; (NB: Also not you need texinfo-ja to process Japanese version; they've
;; merged only recently (May 2016) and may not be available unless you're
;; using bleeding edge. Cf. http://www.trueroad.jp/2016/05/14-01.html)
(define (do-pdf input makeinfo)
(cond-expand
[gauche.sys.setenv
(when (#/j\.texi$/ input)
(sys-putenv "PDFTEX=luatex"))]
[else])
(do-process (make-cmd `(,makeinfo "--pdf" "--Xopt" "--tidy" ,input))))
(define (do-dvi input makeinfo)
(do-process (make-cmd `(,makeinfo "--dvi" "--Xopt" "--tidy" ,input))))
(define (do-epub input makeinfo)
(do-process (make-cmd `(,makeinfo "--epub3" ,input))))