Commit | Line | Data |
---|---|---|
47f3ce52 AW |
1 | ;;;; (texinfo docbook) -- translating sdocbook into stexinfo |
2 | ;;;; | |
ac37b82d | 3 | ;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. |
47f3ce52 AW |
4 | ;;;; Copyright (C) 2007, 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 | ;; @c | |
24 | ;; This module exports procedures for transforming a limited subset of | |
25 | ;; the SXML representation of docbook into stexi. It is not complete by | |
26 | ;; any means. The intention is to gather a number of routines and | |
27 | ;; stylesheets so that external modules can parse specific subsets of | |
28 | ;; docbook, for example that set generated by certain tools. | |
29 | ;; | |
30 | ;;; Code: | |
31 | ||
32 | (define-module (texinfo docbook) | |
ac37b82d LC |
33 | #:use-module (sxml fold) |
34 | #:use-module ((srfi srfi-1) #:select (fold)) | |
35 | #:export (*sdocbook->stexi-rules* | |
36 | *sdocbook-block-commands* | |
37 | sdocbook-flatten | |
38 | filter-empty-elements | |
39 | replace-titles)) | |
47f3ce52 AW |
40 | |
41 | (define (identity . args) | |
42 | args) | |
43 | ||
44 | (define (identity-deattr tag . body) | |
45 | `(,tag ,@(if (and (pair? body) (pair? (car body)) | |
46 | (eq? (caar body) '@)) | |
47 | (cdr body) | |
48 | body))) | |
49 | ||
50 | (define (detag-one tag body) | |
51 | body) | |
52 | ||
53 | (define tag-replacements | |
54 | '((parameter var) | |
55 | (replaceable var) | |
56 | (type code) | |
57 | (function code) | |
58 | (literal samp) | |
59 | (emphasis emph) | |
60 | (simpara para) | |
61 | (programlisting example) | |
62 | (firstterm dfn) | |
63 | (filename file) | |
64 | (quote cite) | |
65 | (application cite) | |
66 | (symbol code) | |
67 | (note cartouche) | |
68 | (envar env))) | |
69 | ||
70 | (define ignore-list '()) | |
71 | ||
72 | (define (stringify exp) | |
73 | (with-output-to-string (lambda () (write exp)))) | |
74 | ||
75 | (define *sdocbook->stexi-rules* | |
76 | #; | |
77 | "A stylesheet for use with SSAX's @code{pre-post-order}, which defines | |
78 | a number of generic rules for transforming docbook into texinfo." | |
79 | `((@ *preorder* . ,identity) | |
80 | (% *preorder* . ,identity) | |
81 | (para . ,identity-deattr) | |
82 | (orderedlist ((listitem | |
83 | . ,(lambda (tag . body) | |
84 | `(item ,@body)))) | |
85 | . ,(lambda (tag . body) | |
86 | `(enumerate ,@body))) | |
87 | (itemizedlist ((listitem | |
88 | . ,(lambda (tag . body) | |
89 | `(item ,@body)))) | |
90 | . ,(lambda (tag . body) | |
91 | `(itemize ,@body))) | |
92 | (term . ,detag-one) | |
93 | (informalexample . ,detag-one) | |
94 | (section . ,identity) | |
95 | (subsection . ,identity) | |
96 | (subsubsection . ,identity) | |
97 | (ulink . ,(lambda (tag attrs . body) | |
98 | `(uref (% ,(assq 'url (cdr attrs)) | |
99 | (title ,@body))))) | |
100 | (*text* . ,detag-one) | |
101 | (*default* . ,(lambda (tag . body) | |
102 | (let ((subst (assq tag tag-replacements))) | |
103 | (cond | |
104 | (subst | |
105 | (if (and (pair? body) (pair? (car body)) (eq? (caar body) '@)) | |
106 | (begin | |
107 | (warn "Ignoring" tag "attributes" (car body)) | |
108 | (append (cdr subst) (cdr body))) | |
109 | (append (cdr subst) body))) | |
110 | ((memq tag ignore-list) #f) | |
111 | (else | |
112 | (warn "Don't know how to convert" tag "to stexi") | |
113 | `(c (% (all ,(stringify (cons tag body)))))))))))) | |
114 | ||
115 | ;; (variablelist | |
116 | ;; ((varlistentry | |
117 | ;; . ,(lambda (tag term . body) | |
118 | ;; `(entry (% (heading ,@(cdr term))) ,@body))) | |
119 | ;; (listitem | |
120 | ;; . ,(lambda (tag simpara) | |
121 | ;; simpara))) | |
122 | ;; . ,(lambda (tag attrs . body) | |
123 | ;; `(table (% (formatter (var))) ,@body))) | |
124 | ||
125 | (define *sdocbook-block-commands* | |
126 | #; | |
127 | "The set of sdocbook element tags that should not be nested inside | |
128 | each other. @xref{texinfo docbook sdocbook-flatten,,sdocbook-flatten}, | |
129 | for more information." | |
130 | '(para programlisting informalexample indexterm variablelist | |
131 | orderedlist refsect1 refsect2 refsect3 refsect4 title example | |
132 | note itemizedlist)) | |
133 | ||
134 | (define (inline-command? command) | |
135 | (not (memq command *sdocbook-block-commands*))) | |
136 | ||
137 | (define (sdocbook-flatten sdocbook) | |
138 | "\"Flatten\" a fragment of sdocbook so that block elements do not nest | |
139 | inside each other. | |
140 | ||
141 | Docbook is a nested format, where e.g. a @code{refsect2} normally | |
142 | appears inside a @code{refsect1}. Logical divisions in the document are | |
143 | represented via the tree topology; a @code{refsect2} element | |
144 | @emph{contains} all of the elements in its section. | |
145 | ||
146 | On the contrary, texinfo is a flat format, in which sections are marked | |
147 | off by standalone section headers like @code{@@chapter}, and block | |
148 | elements do not nest inside each other. | |
149 | ||
150 | This function takes a nested sdocbook fragment @var{sdocbook} and | |
151 | flattens all of the sections, such that e.g. | |
152 | @example | |
153 | (refsect1 (refsect2 (para \"Hello\"))) | |
154 | @end example | |
155 | becomes | |
156 | @example | |
157 | ((refsect1) (refsect2) (para \"Hello\")) | |
158 | @end example | |
159 | ||
160 | Oftentimes (always?) sectioning elements have @code{<title>} as their | |
161 | first element child; users interested in processing the @code{refsect*} | |
162 | elements into proper sectioning elements like @code{chapter} might be | |
163 | interested in @code{replace-titles} and @code{filter-empty-elements}. | |
164 | @xref{texinfo docbook replace-titles,,replace-titles}, and @ref{texinfo | |
165 | docbook filter-empty-elements,,filter-empty-elements}. | |
166 | ||
167 | Returns a nodeset, as described in @ref{sxml xpath}. That is to say, | |
168 | this function returns an untagged list of stexi elements." | |
169 | (define (fhere str accum block cont) | |
170 | (values (cons str accum) | |
171 | block | |
172 | cont)) | |
173 | (define (fdown node accum block cont) | |
174 | (let ((command (car node)) | |
175 | (attrs (and (pair? (cdr node)) (pair? (cadr node)) | |
176 | (eq? (caadr node) '%) | |
177 | (cadr node)))) | |
178 | (values (if attrs (cddr node) (cdr node)) | |
179 | '() | |
180 | '() | |
181 | (lambda (accum block) | |
182 | (values | |
183 | `(,command ,@(if attrs (list attrs) '()) | |
184 | ,@(reverse accum)) | |
185 | block))))) | |
186 | (define (fup node paccum pblock pcont kaccum kblock kcont) | |
187 | (call-with-values (lambda () (kcont kaccum kblock)) | |
188 | (lambda (ret block) | |
189 | (if (inline-command? (car ret)) | |
190 | (values (cons ret paccum) (append kblock pblock) pcont) | |
191 | (values paccum (append kblock (cons ret pblock)) pcont))))) | |
192 | (call-with-values | |
193 | (lambda () (foldts*-values fdown fup fhere sdocbook '() '() #f)) | |
194 | (lambda (accum block cont) | |
195 | (reverse block)))) | |
196 | ||
197 | (define (filter-empty-elements sdocbook) | |
198 | "Filters out empty elements in an sdocbook nodeset. Mostly useful | |
199 | after running @code{sdocbook-flatten}." | |
200 | (reverse | |
201 | (fold | |
202 | (lambda (x rest) | |
203 | (if (and (pair? x) (null? (cdr x))) | |
204 | rest | |
205 | (cons x rest))) | |
206 | '() | |
207 | sdocbook))) | |
208 | ||
209 | (define (replace-titles sdocbook-fragment) | |
210 | "Iterate over the sdocbook nodeset @var{sdocbook-fragment}, | |
211 | transforming contiguous @code{refsect} and @code{title} elements into | |
212 | the appropriate texinfo sectioning command. Most useful after having run | |
213 | @code{sdocbook-flatten}. | |
214 | ||
215 | For example: | |
216 | @example | |
217 | (replace-titles '((refsect1) (title \"Foo\") (para \"Bar.\"))) | |
218 | @result{} '((chapter \"Foo\") (para \"Bar.\")) | |
219 | @end example | |
220 | " | |
221 | (define sections '((refsect1 . chapter) | |
222 | (refsect2 . section) | |
223 | (refsect3 . subsection) | |
224 | (refsect4 . subsubsection))) | |
225 | (let lp ((in sdocbook-fragment) (out '())) | |
226 | (cond | |
227 | ((null? in) | |
228 | (reverse out)) | |
229 | ((and (pair? (car in)) (assq (caar in) sections)) | |
230 | ;; pull out the title | |
231 | => (lambda (pair) | |
232 | (lp (cddr in) (cons `(,(cdr pair) ,@(cdadr in)) out)))) | |
233 | (else | |
234 | (lp (cdr in) (cons (car in) out)))))) |