module/texinfo/docbook.scm

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