partially rewrite accessor-values-internal
[sbcl.git] / tools-for-build / rtf.lisp
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.
6
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.
15
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)))
30
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 ~}}"      ; each par used to end with
44                                          ; ~%, but resulting Rtf looks
45                                          ; strange (WinXP, WiX 3.0.x,
46                                          ; ?)
47                          pars)))