module/texinfo/docbook.scm

   1 ;;;; (texinfo docbook) -- translating sdocbook into stexinfo
   2 ;;;;
   3 ;;;;    Copyright (C) 2009, 2010  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     (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))))))