module/texinfo/plain-text.scm

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