(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 COPYF () (PRIN " FROM") (RFILEVLI) (PRIN " TO") (RFILE 'VLL) (SINP) (IFN INP "FILE NOT FOUND" (OUTPUT (IMPLODE FNAME) (IMPLODE EXT) (IMPLODE DEV)) (COP) (OUTPUT))) (DE RFILEVLI () (RFILE 'VLI) (SETQ EXTF EXT DEVF DEV FNAMEF FNAME)) (DE DELF () (ASKFILE) (IF INP (DEL) "FILE NOT FOUND")) (DE ASKFILE () (PRIN "FILE NAME") (RFILEVLI) (SINP)) (DE SINP () (SETQ INP (INPUT (IMPLODE FNAMEF) (IMPLODE EXTF) (IMPLODE DEVF)))) (DE TYPE () (ASKFILE) (IFN INP "FILE NOT FOUND" (SETQ END 0) (STATUS PRINT 1) (WHERE (EOF () (INCR END) (INPUT)) (WHILE (ZEROP END) (MAPC (LAMBDA (X) (PRIN X)) (READLINE)) (TERPRI))) (STATUS PRINT 0))) (DE RENAME () (COPYF) (IF INP (PROGN (SINP) (DEL))) (INPUT)) (DE SVFILE () (SETQ CPOS 77) (SAVE RFILE COPYF RFILEVLI DELF ASKFILE SINP TYPE RENAME SVFILE))