mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
ff95e10225
* module/texinfo/docbook.scm (*sdocbook-block-commands*): informaltable is a block element.
240 lines
8.4 KiB
Scheme
240 lines
8.4 KiB
Scheme
;;;; (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))))))
|