X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tools-for-build%2Frtf.lisp;fp=tools-for-build%2Frtf.lisp;h=d63805c4bb74e1227f097b247afdd687e2d1f163;hb=1acfa21e0796f5d72d776b0fd53645813d5f2d98;hp=0000000000000000000000000000000000000000;hpb=57f8e261b638ac797036aa4cb66f6e2d604170f5;p=sbcl.git diff --git a/tools-for-build/rtf.lisp b/tools-for-build/rtf.lisp new file mode 100644 index 0000000..d63805c --- /dev/null +++ b/tools-for-build/rtf.lisp @@ -0,0 +1,44 @@ +;;;; Generate RTF out of a regular text file, splitting +;;;; paragraphs on empty lines. +;;;; +;;;; Used to generate License.rtf out of COPYING for the +;;;; Windows installer. + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(defun read-text (pathname) + (let ((pars (list nil))) + (with-open-file (f pathname :external-format :ascii) + (loop for line = (read-line f nil) + for text = (string-trim '(#\Space #\Tab) line) + while line + when (plusp (length text)) + do (setf (car pars) + (if (car pars) + (concatenate 'string (car pars) " " text) + text)) + else + do (push nil pars))) + (nreverse pars))) + +(defun write-rtf (pars pathname) + (with-open-file (f pathname :direction :output :external-format :ascii + :if-exists :supersede) + ;; \rtf0 = RTF 1.0 + ;; \ansi = character set + ;; \deffn = default font + ;; \fonttbl = font table + ;; \fs = font size in half-points + (format f "{\\rtf1\\ansi~ + \\deffn0~ + {\\fonttbl\\f0\\fswiss Helvetica;}~ + \\fs20~ + ~{~A\\par\\par~%~}}~%" + pars)))