123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241 |
- (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))))))))))))
- (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))
-
- => (lambda (pair)
- (lp (cddr in) (cons `(,(cdr pair) ,@(cdadr in)) out))))
- (else
- (lp (cdr in) (cons (car in) out))))))
|