
(DF SAVE (L PARM PAGES LINES INP)        
   (PROGN (PRIN "OUTPUT FILE") (RFILE 'VLL))
      (PROGN (SETQ INP (INPUT (IMPLODE FNAME) CMT)) (INPUT))
      (SETQ INP      (AND INP (ASKYN "INCLUDE COMMENTS"))
            PARM     (ASKYN "INCLUDE PARENTHESES MATCHING"))
      (PRINT "COMMENTS" (IF INP "ARE" "ARE NOT") "INCLUDED")
      (PRINT "PARENTHESES MATCHING" (IF PARM "IS" "IS NOT") "INCLUDED")
      (OUTPUT (IMPLODE FNAME) (IMPLODE EXT) (IMPLODE DEV))
      (IF INP (INPUT (IMPLODE FNAME) CMT))
      (SETQ LIN1 () LINES 0 PAGES 1)
      (IF INP (PRINTHEADER))
      (WHILE L
         (IF (AND (GT LINES) (GT (+ LINES (QUO (LEN (FVAL (CAR L))) 9)) 60))
            (PROGN (TERPRI) (PRINCH 12) (INCR PAGES) (SETQ LINES 0)))
         (SETQ COMFLAG ())
         (COND
            (INP
               (IF LIN1
                  ()
                  (READLN)
                  (IF LIN (SETQ LIN1 (IMPLODE LIN)) (SETQ INP ())))
               (IF (EQ (CAR L) LIN1) (SETQ COMFLAG T LIN1 ()))))
         (SETQ LINES (+ 2 LINES (EVAL ['PRET (NEXTL L) PARM])))
         (TERPRI))
      (PROGN (OUTPUT) (INPUT) PAGES))
   


(DE GETCOM (X)        
   (IFN COMLI
         (IFN LIN
            (SETQ COMFLAG ())
            (SETQ COMWORD () COMLI () LIN (CDR LIN))
            (UNTIL (EQ (CAR LIN) (ASCII 9)) (NEWL COMWORD (NEXTL LIN)))
            (UNTIL (NEQ (CAR LIN) (ASCII 9)) (NEXTL LIN))
            (SETQ COMWORD (IMPLODE (FREVERSE COMWORD)) COMS LIN)
            (READLN)
            (WHILE (AND LIN (NEQ (CAR LIN) "."))
               (UNTIL (NEQ (CAR LIN) (ASCII 9)) (NEXTL LIN))
               (PROGN (NCONC COMS (CONS " " LIN)) (READLN)))
            (WHILE COMS
               (SETQ NXTLN () CNT CPOS)
               (UNTIL (OR
                         (EQ CNT 124)
                         (NULL COMS)
                         (IF (EQ (CAR COMS) ";") (NEXTL COMS)))
                  (PROGN (INCR CNT) (NEWL NXTLN (NEXTL COMS))))
               (COND
                  ((AND (EQ CNT 124) COMS)
                     (UNTIL (EQ (CAR NXTLN) " ") (NEWL COMS (NEXTL NXTLN)))
                     (NEXTL NXTLN)))
               (NEWL COMLI (FREVERSE NXTLN)))
            (SETQ COMLI (FREVERSE COMLI))))
      (IF (AND COMFLAG (EQ COMWORD X)) (SETQ COMT T)))
   

(DE ASKYN (PROMPT)        
   (PRIN PROMPT "? (Y/N) : ")
      (TERPRI -1)
      (PROG1 (MEMQ (TYI) '(89 121)) (TERPRI)))
   

(DE READLN ()        
   (SETQ LIN (READLINE)) (IF (EQ (CAR LIN) (ASCII 12)) (READLN)))
   

(DE PRINL (X)        
   (WHILE X (PRIN (NEXTL X))))
   

(DE PRINL1 (W Z)        
   (IF (LT (OUTPOS) CPOS) (OUTPOS CPOS))
      (IF Z (PRIN "  ") (PRIN "; "))
      (PRINL W)
      (PRIN " ;")
      (TERPRA))
   


(DE PRINTHEADER ()        
   (SETQ LINES 2 SKIPLINE 11)
      (STATUS PRINT 1)
      (RMARGIN 127)
      (PRINT ";")
      (UNTIL (ZEROP SKIPLINE) (READLN) (DECR SKIPLINE))
      (WHILE LIN (PRINL LIN) (INCR LINES) (TERPRI) (READLN))
      (PRINT ";")
      (SETQ LIN ()))
   


(DE RFILE (DEFAULT-EXT)        
   (TERPRI -1)
      (INPUT)
      (SETQ FNAME    (MAPCAR
                        (LAMBDA (X)
                           (IF (GE (CASCII X) 97)
                              (ASCII (- (CASCII X) 32))
                              X))
                        (READLINE)))
      (IFN (MEMQ ":" FNAME)
         (SETQ DEV '(D K))
         (SETQ DEV [(NEXTL FNAME)])
         (UNTIL (EQ ":" (CAR FNAME)) (NCONC1 DEV (NEXTL FNAME)))
         (NEXTL FNAME))
      (SETQ L1 (MEMQ "." FNAME))
      (IFN L1
         (SETQ EXT (EXPLODE DEFAULT-EXT))
         (SETQ EXT (CDR L1) FNAME (REVERSE FNAME))
         (UNTIL (EQ "." (CAR FNAME)) (NEXTL FNAME))
         (SETQ FNAME (REVERSE (CDR FNAME)))))
   

(DE SVSAVE ()        
   (SETQ CPOS 77)
      (SAVE SAVE GETCOM ASKYN READLN PRINL PRINL1 PRINTHEADER RFILE SVSAVE))
   
                                                                                                                                                