#!MUNGERPATH

; Copyright (c) 2001, 2002, 2003, James Bailie <jimmy@mammothcheese.ca>.  
; All rights reserved.
; 
; Redistribution and use in source form, with or without
; modification, are permitted provided that the following conditions are met:
; 
;     * Redistributions of source code must retain the above copyright
; notice, this list of conditions and the following disclaimer.
;     * The name of James Bailie may not be used to endorse or promote 
; products derived from this software without specific prior written permission.
; 
; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS"
; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
; POSSIBILITY OF SUCH DAMAGE.

; This script performs regular-expression based transformations over
; files.  It acts destructively upon its arguments, loading each file
; into the buffer, applying transformations, then overwriting the original
; file.

; Make lisp errors fatal.  After executing this line, the interpreter will
; not return to toplevel, but exit with an exit status of 1, upon
; encountering an error.

(fatal)

; Transforms is a list of lists describing the transformations to be
; performed, listed in the order the user wishes them applied.  The first
; element of each sublist is the regular expression to match against, and
; the second element is its corresponding replacement pattern.  

; The first two sublists shown convert the "minute-sign" quotes around
; double quoted text into paired single quotes, wich groff will replace
; with typographical double-quotes.  The third sublist ensures there are
; two spaces after every sentence in the source text.

(set 'transforms
   '(("(^|[\b\t])\"" "\\1``")
     ("([^\b\t])\"" "\\1''")
     ("([?.!]('')?)(\b|\b\b\b+)((``)?[A-Z])" "\\1\b\b\\4")))

; The regular expressions are first compiled.  The script will exit if any
; compilation attempt fails.

(set 'compile
   (lambda (item)
      (let ((c (regcomp (car item))))
         (if (stringp c)
            (die c)
            (cons c (cdr item))))))

(set 'transforms (mapcar compile transforms))

; Performs the specified transformation on all lines currently in the buffer.

(set 'apply_to_buffer
   (lambda (a)

      (let ((rx (car a))
            (rp (cadr a))

            (f ())
            (l 1)
            (c 0))

         (do
            ; We perform the substitution on the first line of the buffer,
            ; without checking to see if it even contains a match because
            ; "find" ignores matches occurring at the specified starting
            ; location to make it easy to apply "find" repeatedly to its own
            ; return values.  This means a match occuring at the beginning of
            ; the first line in the buffer will not be found, so we always
            ; perform the substitution on the first line.  We could have
            ; passed 1 as the final argument to "find" to cause the search to
            ; "wraparound" and search the portion of the buffer before (or
            ; after, depending upon the search direction) the starting
            ; position, but rx could also match rp, and if it did so, an
            ; inifinite loop would result.

            (insert l (substitute rx rp (retrieve l) 0) 0)

            ; rx may match rp, and the length of the line may have changed, so
            ; we advance the initial search position to where the end of the
            ; line is now.  If we were simply searching for the next match,
            ; and not altering the line, we could feed both l and c back into
            ; find, repeatedly.

            (set 'c (- (car (slice l 0 0 1 1)) 1))
            (set 'l (car (find 1 l c rx 0)))))))

; Open a buffer.

(open)

(next)

(while (next)
   (when (> (read 0 (current)) 0)
      (foreach apply_to_buffer transforms)
      (write 1 (lastline) (current) 1)
      (empty)))

(exit 0)
