Character style stripper.

[Qobi@ZERMATT.LCS.MIT.EDU (Jeffrey Mark Siskind)]

    Date: Mon, 27 Aug 90 16:58 PDT
    From: RDP@ALAN.kahuna.decnet.lockheed.com (Robert D. Pfeiffer)

    [I think this has come up before but I couldn't find any mail in my
    archives.  If it has, I apologize for the redundancy.]

    I need a character-style stripping utility.  Ideally, I could just
    specify a pathname with wild inferiors and it would do the rest.
    Anyone?

    Thanks in advance,

    Bob Pfeiffer
    RDP@ALAN.LASC.Lockheed.COM
Here are some usefull CP commands that I have defined. The command
Strip Fonts does what you want. I have included the other commands
because the are also usefull their intent is mostly self evident.
Except for Split File, which is used to take out excerpts of a
code file (between the ;;;begin and ;;;end comments) and stuff it
into a LaTeX file for inclusion in a document. That way code and
documents can be kept in sync.
        Enjoy,
        Jeff
---
1;;; -*- Mode: LISP; Package: USER; Base: 10; Syntax: Common-lisp -*-

;;; LaHaShem HaAretz U'Mloah

0(cp:define-command (2COM-SPLIT-FILE
0                    :command-table "Global"
                    :provide-output-destination-keyword nil)
    ((source-file
      'pathname
      :documentation "A pathname of a file to split into components"
      :prompt "A pathname to split"))
   (catch :exit
     (with-open-file (source-stream source-file :direction :in)
       (loop for line = (read-line source-stream nil :eof)
             until (eq line :eof)
             when (string= line ";;;begin" :end1 8)
               do (with-open-file (destination-stream
                                   (merge-pathnames (substring line 9)
                                                    source-file)
                                   :direction :out)
                    (format destination-stream "\\begin{verbatim}~%")
                    (loop for line = (read-line source-stream nil :eof)
                          when (eq line :eof)
                            do (format destination-stream
                                       "\\end{verbatim}~%")
                               (throw :exit :exit)
                          until (string= line ";;;end" :end1 6)
                          do (format destination-stream "~A~%" line)
                          finally (format destination-stream
                                          "\\end{verbatim}~%"))))))
   t)

(cp:define-command (2COM-STRIP-FONTS
0                    :command-table "Global"
                    :provide-output-destination-keyword nil)
    ((source-file
      'pathname
      :documentation "A pathname of a file to strip font information"
      :prompt "A pathname to strip")
     (destination-file
      'pathname
      :documentation "A pathname of a file to receive the fontless information"
      :prompt "A pathname to receive fontless data"))
   (catch :exit
     (with-open-file (source-stream source-file :direction :in)
       (with-open-file (destination-stream destination-file :direction :out)
         (loop for character = (read-char source-stream nil :eof)
               until (eq character :eof)
               do (write-char
                   (code-char (char-code character) (char-bits character))
                   destination-stream)))))
   t)

(cp:define-command (2COM-CLEANUP-LATEX-FILES
0                    :name "Cleanup LaTeX Files"
                    :command-table "Global"
                    :provide-output-destination-keyword nil)
    ((directory 'pathname
                :documentation "A directory to cleanup LaTeX files"
                :prompt "A directory"))
   (loop for type in '("aux" "log" "toc" "lof" "lot" "bbl" "blg")
         for pathname = (merge-pathnames
                         (make-pathname :name :wild :type type :version :wild)
                         directory)
         do
     (loop for file in (directory pathname)
           do (delete-file file)
              (format t "~&~A deleted." file)))
   t)

(cp:define-command (2COM-DELETE-OLD-VERSIONS
0                    :command-table "Global"
                    :provide-output-destination-keyword nil)
    ((directory 'pathname
                :documentation "A directory to delete old versions of files"
                :prompt "A directory"))
   (loop for file in (set-difference
                      (directory (send directory :new-version :wild))
                      (directory (send directory :new-version :newest)))
         do (delete-file file)
            (format t "~&~A deleted." file))
   t)

1;;; Tam V'Nishlam Shevah L'El Borei Olam