1 ;;;; (texinfo docbook) -- translating sdocbook into stexinfo
3 ;;;; Copyright (C) 2009, 2010, 2012 Free Software Foundation, Inc.
4 ;;;; Copyright (C) 2007, 2009 Andy Wingo <wingo at pobox dot com>
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.
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.
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
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.
32 (define-module (texinfo docbook)
33 #:use-module (sxml fold)
34 #:use-module ((srfi srfi-1) #:select (fold))
35 #:export (*sdocbook->stexi-rules*
36 *sdocbook-block-commands*
41 (define (identity . args)
44 (define (identity-deattr tag . body)
45 `(,tag ,@(if (and (pair? body) (pair? (car body))
50 (define (detag-one tag body)
53 (define tag-replacements
61 (programlisting example)
70 (define ignore-list '())
72 (define (stringify exp)
73 (with-output-to-string (lambda () (write exp))))
75 (define *sdocbook->stexi-rules*
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)
85 . ,(lambda (tag . body)
87 (itemizedlist ((listitem
88 . ,(lambda (tag . body)
90 . ,(lambda (tag . body)
92 (acronym . ,(lambda (tag . body)
93 `(acronym (% (acronym . ,body)))))
95 (informalexample . ,detag-one)
97 (subsection . ,identity)
98 (subsubsection . ,identity)
99 (ulink . ,(lambda (tag attrs . body)
101 ((assq 'url (cdr attrs))
103 `(uref (% ,url (title ,@body)))))
106 (*text* . ,detag-one)
107 (*default* . ,(lambda (tag . body)
108 (let ((subst (assq tag tag-replacements)))
111 (if (and (pair? body) (pair? (car body)) (eq? (caar body) '@))
113 (warn "Ignoring" tag "attributes" (car body))
114 (append (cdr subst) (cdr body)))
115 (append (cdr subst) body)))
116 ((memq tag ignore-list) #f)
118 (warn "Don't know how to convert" tag "to stexi")
119 `(c (% (all ,(stringify (cons tag body))))))))))))
123 ;; . ,(lambda (tag term . body)
124 ;; `(entry (% (heading ,@(cdr term))) ,@body)))
126 ;; . ,(lambda (tag simpara)
128 ;; . ,(lambda (tag attrs . body)
129 ;; `(table (% (formatter (var))) ,@body)))
131 (define *sdocbook-block-commands*
133 "The set of sdocbook element tags that should not be nested inside
134 each other. @xref{texinfo docbook sdocbook-flatten,,sdocbook-flatten},
135 for more information."
136 '(para programlisting informalexample indexterm variablelist
137 orderedlist refsect1 refsect2 refsect3 refsect4 title example
138 note itemizedlist informaltable))
140 (define (inline-command? command)
141 (not (memq command *sdocbook-block-commands*)))
143 (define (sdocbook-flatten sdocbook)
144 "\"Flatten\" a fragment of sdocbook so that block elements do not nest
147 Docbook is a nested format, where e.g. a @code{refsect2} normally
148 appears inside a @code{refsect1}. Logical divisions in the document are
149 represented via the tree topology; a @code{refsect2} element
150 @emph{contains} all of the elements in its section.
152 On the contrary, texinfo is a flat format, in which sections are marked
153 off by standalone section headers like @code{@@chapter}, and block
154 elements do not nest inside each other.
156 This function takes a nested sdocbook fragment @var{sdocbook} and
157 flattens all of the sections, such that e.g.
159 (refsect1 (refsect2 (para \"Hello\")))
163 ((refsect1) (refsect2) (para \"Hello\"))
166 Oftentimes (always?) sectioning elements have @code{<title>} as their
167 first element child; users interested in processing the @code{refsect*}
168 elements into proper sectioning elements like @code{chapter} might be
169 interested in @code{replace-titles} and @code{filter-empty-elements}.
170 @xref{texinfo docbook replace-titles,,replace-titles}, and @ref{texinfo
171 docbook filter-empty-elements,,filter-empty-elements}.
173 Returns a nodeset, as described in @ref{sxml xpath}. That is to say,
174 this function returns an untagged list of stexi elements."
175 (define (fhere str accum block cont)
176 (values (cons str accum)
179 (define (fdown node accum block cont)
180 (let ((command (car node))
181 (attrs (and (pair? (cdr node)) (pair? (cadr node))
182 (eq? (caadr node) '%)
184 (values (if attrs (cddr node) (cdr node))
187 (lambda (accum block)
189 `(,command ,@(if attrs (list attrs) '())
192 (define (fup node paccum pblock pcont kaccum kblock kcont)
193 (call-with-values (lambda () (kcont kaccum kblock))
195 (if (inline-command? (car ret))
196 (values (cons ret paccum) (append kblock pblock) pcont)
197 (values paccum (append kblock (cons ret pblock)) pcont)))))
199 (lambda () (foldts*-values fdown fup fhere sdocbook '() '() #f))
200 (lambda (accum block cont)
203 (define (filter-empty-elements sdocbook)
204 "Filters out empty elements in an sdocbook nodeset. Mostly useful
205 after running @code{sdocbook-flatten}."
209 (if (and (pair? x) (null? (cdr x)))
215 (define (replace-titles sdocbook-fragment)
216 "Iterate over the sdocbook nodeset @var{sdocbook-fragment},
217 transforming contiguous @code{refsect} and @code{title} elements into
218 the appropriate texinfo sectioning command. Most useful after having run
219 @code{sdocbook-flatten}.
223 (replace-titles '((refsect1) (title \"Foo\") (para \"Bar.\")))
224 @result{} '((chapter \"Foo\") (para \"Bar.\"))
227 (define sections '((refsect1 . chapter)
229 (refsect3 . subsection)
230 (refsect4 . subsubsection)))
231 (let lp ((in sdocbook-fragment) (out '()))
235 ((and (pair? (car in)) (assq (caar in) sections))
236 ;; pull out the title
238 (lp (cddr in) (cons `(,(cdr pair) ,@(cdadr in)) out))))
240 (lp (cdr in) (cons (car in) out))))))