plain-text.scm 9.7 KB

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