module/texinfo/plain-text.scm

   1 ;;;; (texinfo plain-text) -- rendering stexinfo as plain text
   2 ;;;;
   3 ;;;;    Copyright (C) 2009, 2010  Free Software Foundation, Inc.
   4 ;;;;    Copyright (C) 2003,2004,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 ;;Transformation from stexi to plain-text. Strives to re-create the
  24 ;;output from @code{info}; comes pretty damn close.
  25 ;;
  26 ;;; Code:
  27
  28 (define-module (texinfo plain-text)
  29   #:use-module (texinfo)
  30   #:use-module (texinfo string-utils)
  31   #:use-module (sxml transform)
  32   #:use-module (srfi srfi-1)
  33   #:use-module (srfi srfi-13)
  34   #:export (stexi->plain-text))
  35
  36 ;; The return value is a string.
  37 (define (arg-ref key %-args)
  38   (and=> (and=> (assq key (cdr %-args)) cdr)
  39          stexi->plain-text))
  40 (define (arg-req key %-args)
  41   (or (arg-ref key %-args)
  42       (error "Missing argument:" key %-args)))
  43
  44 (define *indent* (make-fluid))
  45 (define *itemizer* (make-fluid))
  46
  47 (define (make-ticker str)
  48   (lambda () str))
  49 (define (make-enumerator n)
  50   (lambda ()
  51     (let ((last n))
  52       (set! n (1+ n))
  53       (format #f "~A. " last))))
  54
  55 (fluid-set! *indent* "")
  56 ;; Shouldn't be necessary to do this, but just in case.
  57 (fluid-set! *itemizer* (make-ticker "* "))
  58
  59 (define-macro (with-indent n . body)
  60   `(with-fluids ((*indent* (string-append (fluid-ref *indent*)
  61                                           (make-string ,n #\space))))
  62      ,@body))
  63
  64 (define (make-indenter n proc)
  65   (lambda args (with-indent n (apply proc args))))
  66
  67 (define (string-indent str)
  68   (string-append (fluid-ref *indent*) str "\n"))
  69
  70 (define-macro (with-itemizer itemizer . body)
  71   `(with-fluids ((*itemizer* ,itemizer))
  72      ,@body))
  73
  74 (define (wrap* . strings)
  75   (let ((indent (fluid-ref *indent*)))
  76     (fill-string (string-concatenate strings)
  77                  #:line-width 72 #:initial-indent indent
  78                  #:subsequent-indent indent)))
  79 (define (wrap . strings)
  80   (string-append (apply wrap* strings) "\n\n"))
  81 (define (wrap-heading . strings)
  82   (string-append (apply wrap* strings) "\n"))
  83
  84 (define (ref tag args)
  85   (let* ((node (arg-req 'node args))
  86          (name (or (arg-ref 'name args) node))
  87          (manual (arg-ref 'manual args)))
  88     (string-concatenate
  89      (cons*
  90       (or (and=> (assq tag '((xref "See ") (pxref "see "))) cadr) "")
  91       name
  92       (if manual `(" in manual " ,manual) '())))))
  93
  94 (define (uref tag args)
  95   (let ((url (arg-req 'url args))
  96         (title (arg-ref 'title args)))
  97     (if title
  98         (string-append title " (" url ")")
  99         (string-append "`" url "'"))))
 100
 101 (define (def tag args . body)
 102   (define (list/spaces . elts)
 103     (let lp ((in elts) (out '()))
 104       (cond ((null? in) (reverse! out))
 105             ((null? (car in)) (lp (cdr in) out))
 106             (else (lp (cdr in)
 107                       (cons (car in)
 108                             (if (null? out) out (cons " " out))))))))
 109   (define (first-line)
 110     (string-join
 111      (filter identity
 112              (map (lambda (x) (arg-ref x args))
 113                   '(data-type class name arguments)))
 114      " "))
 115
 116   (let* ((category (case tag
 117                      ((defun) "Function")
 118                      ((defspec) "Special Form")
 119                      ((defvar) "Variable")
 120                      (else (arg-req 'category args)))))
 121     (string-append
 122      (wrap-heading (string-append " - " category ": " (first-line)))
 123      (with-indent 5 (stexi->plain-text body)))))
 124
 125 (define (enumerate tag . elts)
 126   (define (tonumber start)
 127     (let ((c (string-ref start 0)))
 128       (cond ((number? c) (string->number start))
 129             (else (1+ (- (char->integer c)
 130                          (char->integer (if (char-upper-case? c) #\A #\a))))))))
 131   (let* ((args? (and (pair? elts) (pair? (car elts))
 132                      (eq? (caar elts) '%)))
 133          (start (and args? (arg-ref 'start (car elts)))))
 134     (with-itemizer (make-enumerator (if start (tonumber start) 1))
 135       (with-indent 5
 136         (stexi->plain-text (if start (cdr elts) elts))))))
 137
 138 (define (itemize tag args . elts)
 139   (with-itemizer (make-ticker "* ")
 140     (with-indent 5
 141       (stexi->plain-text elts))))
 142
 143 (define (item tag . elts)
 144   (let* ((ret (stexi->plain-text elts))
 145          (tick ((fluid-ref *itemizer*)))
 146          (tick-pos (- (string-length (fluid-ref *indent*))
 147                       (string-length tick))))
 148     (if (and (not (string-null? ret)) (not (negative? tick-pos)))
 149         (string-copy! ret tick-pos tick))
 150     ret))
 151
 152 (define (table tag args . body)
 153   (stexi->plain-text body))
 154
 155 (define (entry tag args . body)
 156   (let ((heading (wrap-heading
 157                   (stexi->plain-text (arg-req 'heading args)))))
 158     (string-append heading
 159                    (with-indent 5 (stexi->plain-text body)))))
 160
 161 (define (make-underliner char)
 162   (lambda (tag . body)
 163     (let ((str (stexi->plain-text body)))
 164       (string-append
 165        "\n"
 166        (string-indent str)
 167        (string-indent (make-string (string-length str) char))
 168        "\n"))))
 169
 170 (define chapter (make-underliner #\*))
 171 (define section (make-underliner #\=))
 172 (define subsection (make-underliner #\-))
 173 (define subsubsection (make-underliner #\.))
 174
 175 (define (example tag . body)
 176   (let ((ret (stexi->plain-text body)))
 177     (string-append
 178      (string-concatenate
 179       (with-indent 5 (map string-indent (string-split ret #\newline))))
 180      "\n")))
 181
 182 (define (verbatim tag . body)
 183   (let ((ret (stexi->plain-text body)))
 184     (string-append
 185      (string-concatenate
 186       (map string-indent (string-split ret #\newline)))
 187      "\n")))
 188
 189 (define (fragment tag . body)
 190   (string-concatenate (map-in-order stexi->plain-text body)))
 191
 192 (define (para tag . body)
 193   (wrap (stexi->plain-text body)))
 194
 195 (define (make-surrounder str)
 196   (lambda (tag . body)
 197     (string-append str (stexi->plain-text body) str)))
 198
 199 (define (code tag . body)
 200   (string-append "`" (stexi->plain-text body) "'"))
 201
 202 (define (key tag . body)
 203   (string-append "<" (stexi->plain-text body) ">"))
 204
 205 (define (var tag . body)
 206   (string-upcase (stexi->plain-text body)))
 207
 208 (define (passthrough tag . body)
 209   (stexi->plain-text body))
 210
 211 (define (texinfo tag args . body)
 212   (let ((title (chapter 'foo (arg-req 'title args))))
 213     (string-append title (stexi->plain-text body))))
 214
 215 (define ignore-list
 216   '(page setfilename setchapternewpage iftex ifinfo ifplaintext ifxml sp vskip
 217     menu ignore syncodeindex comment c % node anchor))
 218 (define (ignored? tag)
 219   (memq tag ignore-list))
 220
 221 (define tag-handlers
 222   `((title        ,chapter)
 223     (chapter      ,chapter)
 224     (section      ,section)
 225     (subsection   ,subsection)
 226     (subsubsection ,subsubsection)
 227     (appendix     ,chapter)
 228     (appendixsec  ,section)
 229     (appendixsubsec ,subsection)
 230     (appendixsubsubsec ,subsubsection)
 231     (unnumbered   ,chapter)
 232     (unnumberedsec ,section)
 233     (unnumberedsubsec ,subsection)
 234     (unnumberedsubsubsec ,subsubsection)
 235     (majorheading ,chapter)
 236     (chapheading  ,chapter)
 237     (heading      ,section)
 238     (subheading   ,subsection)
 239     (subsubheading ,subsubsection)
 240
 241     (strong       ,(make-surrounder "*"))
 242     (sample       ,code)
 243     (samp         ,code)
 244     (code         ,code)
 245     (kbd          ,code)
 246     (key          ,key)
 247     (var          ,var)
 248     (env          ,code)
 249     (file         ,code)
 250     (command      ,code)
 251     (option       ,code)
 252     (url          ,code)
 253     (dfn          ,(make-surrounder "\""))
 254     (cite         ,(make-surrounder "\""))
 255     (acro         ,passthrough)
 256     (email        ,key)
 257     (emph         ,(make-surrounder "_"))
 258     (sc           ,var)
 259     (copyright    ,(lambda args "(C)"))
 260     (result       ,(lambda args "==>"))
 261     (xref         ,ref)
 262     (ref          ,ref)
 263     (pxref        ,ref)
 264     (uref         ,uref)
 265
 266     (texinfo      ,texinfo)
 267     (quotation    ,(make-indenter 5 para))
 268     (itemize      ,itemize)
 269     (enumerate    ,enumerate)
 270     (item         ,item)
 271     (table        ,table)
 272     (entry        ,entry)
 273     (example      ,example)
 274     (lisp         ,example)
 275     (smallexample ,example)
 276     (smalllisp    ,example)
 277     (verbatim     ,verbatim)
 278     (*fragment*   ,fragment)
 279
 280     (deftp        ,def)
 281     (defcv        ,def)
 282     (defivar      ,def)
 283     (deftypeivar  ,def)
 284     (defop        ,def)
 285     (deftypeop    ,def)
 286     (defmethod    ,def)
 287     (deftypemethod  ,def)
 288     (defopt       ,def)
 289     (defvr        ,def)
 290     (defvar       ,def)
 291     (deftypevr    ,def)
 292     (deftypevar   ,def)
 293     (deffn        ,def)
 294     (deftypefn    ,def)
 295     (defmac       ,def)
 296     (defspec      ,def)
 297     (defun        ,def)
 298     (deftypefun   ,def)))
 299
 300 (define (stexi->plain-text tree)
 301   "Transform @var{tree} into plain text. Returns a string."
 302   (cond
 303    ((null? tree) "")
 304    ((string? tree) tree)
 305    ((pair? tree)
 306     (cond
 307      ((symbol? (car tree))
 308       (let ((handler (and (not (ignored? (car tree)))
 309                           (or (and=> (assq (car tree) tag-handlers) cadr)
 310                               para))))
 311         (if handler (apply handler tree) "")))
 312      (else
 313       (string-concatenate (map-in-order stexi->plain-text tree)))))
 314    (else "")))
 315
 316 ;;; arch-tag: f966c3f6-3b46-4790-bbf9-3ad27e4917c2