1.0.22.13: fixed bug 426: nested inline expansion failure
[sbcl/tcr.git] / tools-for-build / rtf.lisp
blobd63805c4bb74e1227f097b247afdd687e2d1f163
1 ;;;; Generate RTF out of a regular text file, splitting
2 ;;;; paragraphs on empty lines.
3 ;;;;
4 ;;;; Used to generate License.rtf out of COPYING for the
5 ;;;; Windows installer.
7 ;;;; This software is part of the SBCL system. See the README file for
8 ;;;; more information.
9 ;;;;
10 ;;;; This software is derived from the CMU CL system, which was
11 ;;;; written at Carnegie Mellon University and released into the
12 ;;;; public domain. The software is in the public domain and is
13 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
14 ;;;; files for more information.
16 (defun read-text (pathname)
17 (let ((pars (list nil)))
18 (with-open-file (f pathname :external-format :ascii)
19 (loop for line = (read-line f nil)
20 for text = (string-trim '(#\Space #\Tab) line)
21 while line
22 when (plusp (length text))
23 do (setf (car pars)
24 (if (car pars)
25 (concatenate 'string (car pars) " " text)
26 text))
27 else
28 do (push nil pars)))
29 (nreverse pars)))
31 (defun write-rtf (pars pathname)
32 (with-open-file (f pathname :direction :output :external-format :ascii
33 :if-exists :supersede)
34 ;; \rtf0 = RTF 1.0
35 ;; \ansi = character set
36 ;; \deffn = default font
37 ;; \fonttbl = font table
38 ;; \fs = font size in half-points
39 (format f "{\\rtf1\\ansi~
40 \\deffn0~
41 {\\fonttbl\\f0\\fswiss Helvetica;}~
42 \\fs20~
43 ~{~A\\par\\par~%~}}~%"
44 pars)))