summaryrefslogtreecommitdiff
path: root/module/texinfo/docbook.scm
blob: f3f993db85417f71d383f9c4dc9c996d8ff5a80d (plain)
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
;;;; (texinfo docbook) -- translating sdocbook into stexinfo
;;;;
;;;; 	Copyright (C) 2009, 2010, 2012  Free Software Foundation, Inc.
;;;;    Copyright (C) 2007, 2009 Andy Wingo <wingo at pobox dot com>
;;;; 
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;; 

;;; Commentary:
;;
;; @c
;; This module exports procedures for transforming a limited subset of
;; the SXML representation of docbook into stexi. It is not complete by
;; any means. The intention is to gather a number of routines and
;; stylesheets so that external modules can parse specific subsets of
;; docbook, for example that set generated by certain tools.
;;
;;; Code:

(define-module (texinfo docbook)
  #:use-module (sxml fold)
  #:use-module ((srfi srfi-1) #:select (fold))
  #:export (*sdocbook->stexi-rules*
            *sdocbook-block-commands*
            sdocbook-flatten
            filter-empty-elements
            replace-titles))

(define (identity . args)
  args)

(define (identity-deattr tag . body)
  `(,tag ,@(if (and (pair? body) (pair? (car body))
                    (eq? (caar body) '@))
               (cdr body)
               body)))

(define (detag-one tag body)
  body)

(define tag-replacements
  '((parameter var)
    (replaceable var)
    (type code)
    (function code)
    (literal samp)
    (emphasis emph)
    (simpara para)
    (programlisting example)
    (firstterm dfn)
    (filename file)
    (quote cite)
    (application cite)
    (symbol code)
    (note cartouche)
    (envar env)))

(define ignore-list '())

(define (stringify exp)
  (with-output-to-string (lambda () (write exp))))

(define *sdocbook->stexi-rules*
  #;
  "A stylesheet for use with SSAX's @code{pre-post-order}, which defines
a number of generic rules for transforming docbook into texinfo."
  `((@ *preorder* . ,identity)
    (% *preorder* . ,identity)
    (para . ,identity-deattr)
    (orderedlist ((listitem
                   . ,(lambda (tag . body)
                        `(item ,@body))))
                 . ,(lambda (tag . body)
                      `(enumerate ,@body)))
    (itemizedlist ((listitem
                    . ,(lambda (tag . body)
                         `(item ,@body))))
                  . ,(lambda (tag . body)
                       `(itemize ,@body)))
    (acronym . ,(lambda (tag . body)
                  `(acronym (% (acronym . ,body)))))
    (term . ,detag-one)
    (informalexample . ,detag-one)
    (section . ,identity)
    (subsection . ,identity)
    (subsubsection . ,identity)
    (ulink . ,(lambda (tag attrs . body)
                (cond
                 ((assq 'url (cdr attrs))
                  => (lambda (url)
                       `(uref (% ,url (title ,@body)))))
                 (else
                  (car body)))))
    (*text* . ,detag-one)
    (*default* . ,(lambda (tag . body)
                    (let ((subst (assq tag tag-replacements)))
                      (cond
                       (subst
                        (if (and (pair? body) (pair? (car body)) (eq? (caar body) '@))
                            (begin
                              (warn "Ignoring" tag "attributes" (car body))
                              (append (cdr subst) (cdr body)))
                            (append (cdr subst) body)))
                       ((memq tag ignore-list) #f)
                       (else 
                        (warn "Don't know how to convert" tag "to stexi")
                        `(c (% (all ,(stringify (cons tag body))))))))))))

;;     (variablelist
;;      ((varlistentry
;;        . ,(lambda (tag term . body)
;;             `(entry (% (heading ,@(cdr term))) ,@body)))
;;       (listitem
;;        . ,(lambda (tag simpara)
;;             simpara)))
;;      . ,(lambda (tag attrs . body)
;;           `(table (% (formatter (var))) ,@body)))

(define *sdocbook-block-commands*
  #;
  "The set of sdocbook element tags that should not be nested inside
each other. @xref{texinfo docbook sdocbook-flatten,,sdocbook-flatten},
for more information." 
  '(para programlisting informalexample indexterm variablelist
    orderedlist refsect1 refsect2 refsect3 refsect4 title example
    note itemizedlist informaltable))

(define (inline-command? command)
  (not (memq command *sdocbook-block-commands*)))

(define (sdocbook-flatten sdocbook)
  "\"Flatten\" a fragment of sdocbook so that block elements do not nest
inside each other.

Docbook is a nested format, where e.g. a @code{refsect2} normally
appears inside a @code{refsect1}. Logical divisions in the document are
represented via the tree topology; a @code{refsect2} element
@emph{contains} all of the elements in its section.

On the contrary, texinfo is a flat format, in which sections are marked
off by standalone section headers like @code{@@chapter}, and block
elements do not nest inside each other.

This function takes a nested sdocbook fragment @var{sdocbook} and
flattens all of the sections, such that e.g.
@example
 (refsect1 (refsect2 (para \"Hello\")))
@end example
becomes
@example
 ((refsect1) (refsect2) (para \"Hello\"))
@end example

Oftentimes (always?) sectioning elements have @code{<title>} as their
first element child; users interested in processing the @code{refsect*}
elements into proper sectioning elements like @code{chapter} might be
interested in @code{replace-titles} and @code{filter-empty-elements}.
@xref{texinfo docbook replace-titles,,replace-titles}, and @ref{texinfo
docbook filter-empty-elements,,filter-empty-elements}.

Returns a nodeset, as described in @ref{sxml xpath}. That is to say,
this function returns an untagged list of stexi elements."
  (define (fhere str accum block cont)
    (values (cons str accum)
            block
            cont))
  (define (fdown node accum block cont)
    (let ((command (car node))
          (attrs (and (pair? (cdr node)) (pair? (cadr node))
                      (eq? (caadr node) '%)
                      (cadr node))))
      (values (if attrs (cddr node) (cdr node))
              '()
              '()
              (lambda (accum block)
                (values
                 `(,command ,@(if attrs (list attrs) '())
                            ,@(reverse accum))
                 block)))))
  (define (fup node paccum pblock pcont kaccum kblock kcont)
    (call-with-values (lambda () (kcont kaccum kblock))
      (lambda (ret block)
        (if (inline-command? (car ret))
            (values (cons ret paccum) (append kblock pblock) pcont)
            (values paccum (append kblock (cons ret pblock)) pcont)))))
  (call-with-values
      (lambda () (foldts*-values fdown fup fhere sdocbook '() '() #f))
    (lambda (accum block cont)
      (reverse block))))
    
(define (filter-empty-elements sdocbook)
  "Filters out empty elements in an sdocbook nodeset. Mostly useful
after running @code{sdocbook-flatten}."
  (reverse
   (fold
    (lambda (x rest)
      (if (and (pair? x) (null? (cdr x)))
          rest
          (cons x rest)))
    '()
    sdocbook)))

(define (replace-titles sdocbook-fragment)
  "Iterate over the sdocbook nodeset @var{sdocbook-fragment},
transforming contiguous @code{refsect} and @code{title} elements into
the appropriate texinfo sectioning command. Most useful after having run
@code{sdocbook-flatten}.

For example:
@example
 (replace-titles '((refsect1) (title \"Foo\") (para \"Bar.\")))
    @result{} '((chapter \"Foo\") (para \"Bar.\"))
@end example
"
  (define sections '((refsect1 . chapter)
                     (refsect2 . section)
                     (refsect3 . subsection)
                     (refsect4 . subsubsection)))
  (let lp ((in sdocbook-fragment) (out '()))
    (cond
     ((null? in)
      (reverse out))
     ((and (pair? (car in)) (assq (caar in) sections))
      ;; pull out the title
      => (lambda (pair)
           (lp (cddr in) (cons `(,(cdr pair) ,@(cdadr in)) out))))
     (else
      (lp (cdr in) (cons (car in) out))))))