module/texinfo/docbook.scm

   1 ;;;; (texinfo docbook) -- translating sdocbook into stexinfo
   2 ;;;;
   3 ;;;;    Copyright (C) 2009, 2010, 2012  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   #: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))
  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     (acronym . ,(lambda (tag . body)
  93                   `(acronym (% (acronym . ,body)))))
  94     (term . ,detag-one)
  95     (informalexample . ,detag-one)
  96     (section . ,identity)
  97     (subsection . ,identity)
  98     (subsubsection . ,identity)
  99     (ulink . ,(lambda (tag attrs . body)
 100                 (cond
 101                  ((assq 'url (cdr attrs))
 102                   => (lambda (url)
 103                        `(uref (% ,url (title ,@body)))))
 104                  (else
 105                   (car body)))))
 106     (*text* . ,detag-one)
 107     (*default* . ,(lambda (tag . body)
 108                     (let ((subst (assq tag tag-replacements)))
 109                       (cond
 110                        (subst
 111                         (if (and (pair? body) (pair? (car body)) (eq? (caar body) '@))
 112                             (begin
 113                               (warn "Ignoring" tag "attributes" (car body))
 114                               (append (cdr subst) (cdr body)))
 115                             (append (cdr subst) body)))
 116                        ((memq tag ignore-list) #f)
 117                        (else
 118                         (warn "Don't know how to convert" tag "to stexi")
 119                         `(c (% (all ,(stringify (cons tag body))))))))))))
 120
 121 ;;     (variablelist
 122 ;;      ((varlistentry
 123 ;;        . ,(lambda (tag term . body)
 124 ;;             `(entry (% (heading ,@(cdr term))) ,@body)))
 125 ;;       (listitem
 126 ;;        . ,(lambda (tag simpara)
 127 ;;             simpara)))
 128 ;;      . ,(lambda (tag attrs . body)
 129 ;;           `(table (% (formatter (var))) ,@body)))
 130
 131 (define *sdocbook-block-commands*
 132   #;
 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))
 139
 140 (define (inline-command? command)
 141   (not (memq command *sdocbook-block-commands*)))
 142
 143 (define (sdocbook-flatten sdocbook)
 144   "\"Flatten\" a fragment of sdocbook so that block elements do not nest
 145 inside each other.
 146
 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.
 151
 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.
 155
 156 This function takes a nested sdocbook fragment @var{sdocbook} and
 157 flattens all of the sections, such that e.g.
 158 @example
 159  (refsect1 (refsect2 (para \"Hello\")))
 160 @end example
 161 becomes
 162 @example
 163  ((refsect1) (refsect2) (para \"Hello\"))
 164 @end example
 165
 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}.
 172
 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)
 177             block
 178             cont))
 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) '%)
 183                       (cadr node))))
 184       (values (if attrs (cddr node) (cdr node))
 185               '()
 186               '()
 187               (lambda (accum block)
 188                 (values
 189                  `(,command ,@(if attrs (list attrs) '())
 190                             ,@(reverse accum))
 191                  block)))))
 192   (define (fup node paccum pblock pcont kaccum kblock kcont)
 193     (call-with-values (lambda () (kcont kaccum kblock))
 194       (lambda (ret block)
 195         (if (inline-command? (car ret))
 196             (values (cons ret paccum) (append kblock pblock) pcont)
 197             (values paccum (append kblock (cons ret pblock)) pcont)))))
 198   (call-with-values
 199       (lambda () (foldts*-values fdown fup fhere sdocbook '() '() #f))
 200     (lambda (accum block cont)
 201       (reverse block))))
 202
 203 (define (filter-empty-elements sdocbook)
 204   "Filters out empty elements in an sdocbook nodeset. Mostly useful
 205 after running @code{sdocbook-flatten}."
 206   (reverse
 207    (fold
 208     (lambda (x rest)
 209       (if (and (pair? x) (null? (cdr x)))
 210           rest
 211           (cons x rest)))
 212     '()
 213     sdocbook)))
 214
 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}.
 220
 221 For example:
 222 @example
 223  (replace-titles '((refsect1) (title \"Foo\") (para \"Bar.\")))
 224     @result{} '((chapter \"Foo\") (para \"Bar.\"))
 225 @end example
 226 "
 227   (define sections '((refsect1 . chapter)
 228                      (refsect2 . section)
 229                      (refsect3 . subsection)
 230                      (refsect4 . subsubsection)))
 231   (let lp ((in sdocbook-fragment) (out '()))
 232     (cond
 233      ((null? in)
 234       (reverse out))
 235      ((and (pair? (car in)) (assq (caar in) sections))
 236       ;; pull out the title
 237       => (lambda (pair)
 238            (lp (cddr in) (cons `(,(cdr pair) ,@(cdadr in)) out))))
 239      (else
 240       (lp (cdr in) (cons (car in) out))))))