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)))