Commit | Line | Data |
---|---|---|
47f3ce52 AW |
1 | ;;;; (texinfo plain-text) -- rendering stexinfo as plain text |
2 | ;;;; | |
9cdc5cdb | 3 | ;;;; Copyright (C) 2009, 2010, 2011, 2013 Free Software Foundation, Inc. |
47f3ce52 AW |
4 | ;;;; Copyright (C) 2003,2004,2009 Andy Wingo <wingo at pobox dot com> |
5 | ;;;; | |
6 | ;;;; This library is free software; you can redistribute it and/or | |
7 | ;;;; modify it under the terms of the GNU Lesser General Public | |
8 | ;;;; License as published by the Free Software Foundation; either | |
9 | ;;;; version 3 of the License, or (at your option) any later version. | |
10 | ;;;; | |
11 | ;;;; This library is distributed in the hope that it will be useful, | |
12 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
14 | ;;;; Lesser General Public License for more details. | |
15 | ;;;; | |
16 | ;;;; You should have received a copy of the GNU Lesser General Public | |
17 | ;;;; License along with this library; if not, write to the Free Software | |
18 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
19 | ;;;; | |
20 | \f | |
21 | ;;; Commentary: | |
22 | ;; | |
23 | ;;Transformation from stexi to plain-text. Strives to re-create the | |
24 | ;;output from @code{info}; comes pretty damn close. | |
25 | ;; | |
26 | ;;; Code: | |
27 | ||
28 | (define-module (texinfo plain-text) | |
29 | #:use-module (texinfo) | |
30 | #:use-module (texinfo string-utils) | |
31 | #:use-module (sxml transform) | |
32 | #:use-module (srfi srfi-1) | |
33 | #:use-module (srfi srfi-13) | |
e8a57fb0 | 34 | #:use-module (ice-9 match) |
47f3ce52 AW |
35 | #:export (stexi->plain-text)) |
36 | ||
37 | ;; The return value is a string. | |
38 | (define (arg-ref key %-args) | |
39 | (and=> (and=> (assq key (cdr %-args)) cdr) | |
40 | stexi->plain-text)) | |
41 | (define (arg-req key %-args) | |
42 | (or (arg-ref key %-args) | |
43 | (error "Missing argument:" key %-args))) | |
44 | ||
47f3ce52 AW |
45 | (define (make-ticker str) |
46 | (lambda () str)) | |
47 | (define (make-enumerator n) | |
48 | (lambda () | |
49 | (let ((last n)) | |
50 | (set! n (1+ n)) | |
51 | (format #f "~A. " last)))) | |
52 | ||
9447207f AW |
53 | (define *indent* (make-fluid "")) |
54 | (define *itemizer* (make-fluid (make-ticker "* "))) | |
47f3ce52 AW |
55 | |
56 | (define-macro (with-indent n . body) | |
57 | `(with-fluids ((*indent* (string-append (fluid-ref *indent*) | |
58 | (make-string ,n #\space)))) | |
59 | ,@body)) | |
60 | ||
61 | (define (make-indenter n proc) | |
62 | (lambda args (with-indent n (apply proc args)))) | |
63 | ||
64 | (define (string-indent str) | |
65 | (string-append (fluid-ref *indent*) str "\n")) | |
66 | ||
67 | (define-macro (with-itemizer itemizer . body) | |
68 | `(with-fluids ((*itemizer* ,itemizer)) | |
69 | ,@body)) | |
70 | ||
71 | (define (wrap* . strings) | |
72 | (let ((indent (fluid-ref *indent*))) | |
73 | (fill-string (string-concatenate strings) | |
74 | #:line-width 72 #:initial-indent indent | |
75 | #:subsequent-indent indent))) | |
76 | (define (wrap . strings) | |
77 | (string-append (apply wrap* strings) "\n\n")) | |
78 | (define (wrap-heading . strings) | |
79 | (string-append (apply wrap* strings) "\n")) | |
80 | ||
81 | (define (ref tag args) | |
82 | (let* ((node (arg-req 'node args)) | |
83 | (name (or (arg-ref 'name args) node)) | |
84 | (manual (arg-ref 'manual args))) | |
85 | (string-concatenate | |
86 | (cons* | |
87 | (or (and=> (assq tag '((xref "See ") (pxref "see "))) cadr) "") | |
88 | name | |
89 | (if manual `(" in manual " ,manual) '()))))) | |
90 | ||
91 | (define (uref tag args) | |
92 | (let ((url (arg-req 'url args)) | |
93 | (title (arg-ref 'title args))) | |
94 | (if title | |
95 | (string-append title " (" url ")") | |
96 | (string-append "`" url "'")))) | |
97 | ||
98 | (define (def tag args . body) | |
47f3ce52 AW |
99 | (define (first-line) |
100 | (string-join | |
101 | (filter identity | |
102 | (map (lambda (x) (arg-ref x args)) | |
103 | '(data-type class name arguments))) | |
104 | " ")) | |
105 | ||
106 | (let* ((category (case tag | |
107 | ((defun) "Function") | |
108 | ((defspec) "Special Form") | |
109 | ((defvar) "Variable") | |
110 | (else (arg-req 'category args))))) | |
111 | (string-append | |
112 | (wrap-heading (string-append " - " category ": " (first-line))) | |
113 | (with-indent 5 (stexi->plain-text body))))) | |
114 | ||
115 | (define (enumerate tag . elts) | |
116 | (define (tonumber start) | |
117 | (let ((c (string-ref start 0))) | |
118 | (cond ((number? c) (string->number start)) | |
119 | (else (1+ (- (char->integer c) | |
120 | (char->integer (if (char-upper-case? c) #\A #\a)))))))) | |
121 | (let* ((args? (and (pair? elts) (pair? (car elts)) | |
122 | (eq? (caar elts) '%))) | |
123 | (start (and args? (arg-ref 'start (car elts))))) | |
124 | (with-itemizer (make-enumerator (if start (tonumber start) 1)) | |
125 | (with-indent 5 | |
126 | (stexi->plain-text (if start (cdr elts) elts)))))) | |
127 | ||
128 | (define (itemize tag args . elts) | |
129 | (with-itemizer (make-ticker "* ") | |
130 | (with-indent 5 | |
131 | (stexi->plain-text elts)))) | |
132 | ||
133 | (define (item tag . elts) | |
134 | (let* ((ret (stexi->plain-text elts)) | |
135 | (tick ((fluid-ref *itemizer*))) | |
136 | (tick-pos (- (string-length (fluid-ref *indent*)) | |
137 | (string-length tick)))) | |
138 | (if (and (not (string-null? ret)) (not (negative? tick-pos))) | |
139 | (string-copy! ret tick-pos tick)) | |
140 | ret)) | |
141 | ||
142 | (define (table tag args . body) | |
143 | (stexi->plain-text body)) | |
144 | ||
145 | (define (entry tag args . body) | |
146 | (let ((heading (wrap-heading | |
147 | (stexi->plain-text (arg-req 'heading args))))) | |
148 | (string-append heading | |
149 | (with-indent 5 (stexi->plain-text body))))) | |
150 | ||
151 | (define (make-underliner char) | |
152 | (lambda (tag . body) | |
153 | (let ((str (stexi->plain-text body))) | |
154 | (string-append | |
155 | "\n" | |
156 | (string-indent str) | |
157 | (string-indent (make-string (string-length str) char)) | |
158 | "\n")))) | |
159 | ||
160 | (define chapter (make-underliner #\*)) | |
161 | (define section (make-underliner #\=)) | |
162 | (define subsection (make-underliner #\-)) | |
163 | (define subsubsection (make-underliner #\.)) | |
164 | ||
165 | (define (example tag . body) | |
166 | (let ((ret (stexi->plain-text body))) | |
167 | (string-append | |
168 | (string-concatenate | |
169 | (with-indent 5 (map string-indent (string-split ret #\newline)))) | |
170 | "\n"))) | |
171 | ||
172 | (define (verbatim tag . body) | |
173 | (let ((ret (stexi->plain-text body))) | |
174 | (string-append | |
175 | (string-concatenate | |
176 | (map string-indent (string-split ret #\newline))) | |
177 | "\n"))) | |
178 | ||
179 | (define (fragment tag . body) | |
180 | (string-concatenate (map-in-order stexi->plain-text body))) | |
181 | ||
182 | (define (para tag . body) | |
183 | (wrap (stexi->plain-text body))) | |
184 | ||
185 | (define (make-surrounder str) | |
186 | (lambda (tag . body) | |
187 | (string-append str (stexi->plain-text body) str))) | |
188 | ||
189 | (define (code tag . body) | |
190 | (string-append "`" (stexi->plain-text body) "'")) | |
191 | ||
192 | (define (key tag . body) | |
193 | (string-append "<" (stexi->plain-text body) ">")) | |
194 | ||
195 | (define (var tag . body) | |
196 | (string-upcase (stexi->plain-text body))) | |
197 | ||
198 | (define (passthrough tag . body) | |
199 | (stexi->plain-text body)) | |
200 | ||
47f3ce52 AW |
201 | (define (texinfo tag args . body) |
202 | (let ((title (chapter 'foo (arg-req 'title args)))) | |
203 | (string-append title (stexi->plain-text body)))) | |
204 | ||
205 | (define ignore-list | |
206 | '(page setfilename setchapternewpage iftex ifinfo ifplaintext ifxml sp vskip | |
207 | menu ignore syncodeindex comment c % node anchor)) | |
208 | (define (ignored? tag) | |
209 | (memq tag ignore-list)) | |
210 | ||
211 | (define tag-handlers | |
212 | `((title ,chapter) | |
213 | (chapter ,chapter) | |
214 | (section ,section) | |
215 | (subsection ,subsection) | |
216 | (subsubsection ,subsubsection) | |
217 | (appendix ,chapter) | |
218 | (appendixsec ,section) | |
219 | (appendixsubsec ,subsection) | |
220 | (appendixsubsubsec ,subsubsection) | |
221 | (unnumbered ,chapter) | |
222 | (unnumberedsec ,section) | |
223 | (unnumberedsubsec ,subsection) | |
224 | (unnumberedsubsubsec ,subsubsection) | |
225 | (majorheading ,chapter) | |
226 | (chapheading ,chapter) | |
227 | (heading ,section) | |
228 | (subheading ,subsection) | |
229 | (subsubheading ,subsubsection) | |
230 | ||
231 | (strong ,(make-surrounder "*")) | |
232 | (sample ,code) | |
233 | (samp ,code) | |
234 | (code ,code) | |
9cdc5cdb | 235 | (math ,passthrough) |
47f3ce52 AW |
236 | (kbd ,code) |
237 | (key ,key) | |
238 | (var ,var) | |
239 | (env ,code) | |
240 | (file ,code) | |
241 | (command ,code) | |
242 | (option ,code) | |
243 | (url ,code) | |
244 | (dfn ,(make-surrounder "\"")) | |
245 | (cite ,(make-surrounder "\"")) | |
246 | (acro ,passthrough) | |
247 | (email ,key) | |
248 | (emph ,(make-surrounder "_")) | |
249 | (sc ,var) | |
250 | (copyright ,(lambda args "(C)")) | |
251 | (result ,(lambda args "==>")) | |
2bb7a730 | 252 | (dots ,(lambda args "...")) |
47f3ce52 AW |
253 | (xref ,ref) |
254 | (ref ,ref) | |
255 | (pxref ,ref) | |
256 | (uref ,uref) | |
257 | ||
258 | (texinfo ,texinfo) | |
259 | (quotation ,(make-indenter 5 para)) | |
260 | (itemize ,itemize) | |
261 | (enumerate ,enumerate) | |
262 | (item ,item) | |
263 | (table ,table) | |
264 | (entry ,entry) | |
265 | (example ,example) | |
266 | (lisp ,example) | |
267 | (smallexample ,example) | |
268 | (smalllisp ,example) | |
269 | (verbatim ,verbatim) | |
270 | (*fragment* ,fragment) | |
271 | ||
272 | (deftp ,def) | |
273 | (defcv ,def) | |
274 | (defivar ,def) | |
275 | (deftypeivar ,def) | |
276 | (defop ,def) | |
277 | (deftypeop ,def) | |
278 | (defmethod ,def) | |
279 | (deftypemethod ,def) | |
280 | (defopt ,def) | |
281 | (defvr ,def) | |
282 | (defvar ,def) | |
283 | (deftypevr ,def) | |
284 | (deftypevar ,def) | |
285 | (deffn ,def) | |
286 | (deftypefn ,def) | |
287 | (defmac ,def) | |
288 | (defspec ,def) | |
289 | (defun ,def) | |
290 | (deftypefun ,def))) | |
291 | ||
292 | (define (stexi->plain-text tree) | |
293 | "Transform @var{tree} into plain text. Returns a string." | |
e8a57fb0 LC |
294 | (match tree |
295 | (() "") | |
296 | ((? string?) tree) | |
297 | (((? symbol? tag) body ...) | |
298 | (let ((handler (and (not (ignored? tag)) | |
299 | (or (and=> (assq tag tag-handlers) cadr) | |
300 | para)))) | |
301 | (if handler | |
302 | (apply handler tree) | |
303 | ""))) | |
304 | ((tree ...) | |
305 | (string-concatenate (map-in-order stexi->plain-text tree))) | |
306 | (_ ""))) | |
47f3ce52 AW |
307 | |
308 | ;;; arch-tag: f966c3f6-3b46-4790-bbf9-3ad27e4917c2 |