; STORED ON: SAVE.VLI AUTHOR: PAUL MENNEN DATE: 6-NOV-80 The functions in this file can be loaded when desired by: (INPUT SAVE) This file contains the routines necessary to be able to save a function or a group of functions on a file using the pretty printer and also using a comment file if desired. This set of routines requires that the initialization file (VLISP.INI) be loaded The following resources are used when this file is loaded: Atoms = 259 Lists = 651 ; (DF SAVE (L PARM PAGES LINES INP) ; calling sequence: (save FNC1 FNC2 ... FNCn) first user is asked for output file name. (default ext. = VLL, default device = DK:) then a file to be used as comment file is looked for on system device with same name as output file but with extention CMT. if such a file is found, the user is asked if these comments should be included in output. then user is asked if paren matching is desired. then save outputs the functions FNCi using PRET and returns # of pages printed. for an example of how a comment file is structured, see VLISP.CMT ; (PROGN (PRIN "OUTPUT FILE") (RFILE 'VLL)) ; ask for output file with default extention VLL ; ; !.......................................! ; (PROGN (SETQ INP (INPUT (IMPLODE FNAME) CMT)) (INPUT)) ; see if a comment file exists but close it ; ; b !.........?:::::::::::::::::::::::::?! b afterwards ; (SETQ INP (AND INP (ASKYN "INCLUDE COMMENTS")) ; if there is a comment file, ask user if he ; ; g !..................................! wants to use it ; PARM (ASKYN "INCLUDE PARENTHESES MATCHING")) ; ask user if he wants paren matching ; ; g ; (PRINT "COMMENTS" (IF INP "ARE" "ARE NOT") "INCLUDED") ; tell user weather comments are being printed ; ; !....................................................! ; (PRINT "PARENTHESES MATCHING" (IF PARM "IS" "IS NOT") "INCLUDED") ; tell user if paren matching is being used ; ; !...............................................................! ; (OUTPUT (IMPLODE FNAME) (IMPLODE EXT) (IMPLODE DEV)) ; open output file ; ; !..................................................! ; (IF INP (INPUT (IMPLODE FNAME) CMT)) ; open input file if comment file is active ; ; !.......?:::::::::::::::::::::::::?! ; (SETQ LIN1 () LINES 0 PAGES 1) ; initialize several variables ; (IF INP (PRINTHEADER)) ; if we have a valid comment file, print the ; ; file header ; (WHILE L ; do this for all functions to be saved ; ; m ; (IF (AND (GT LINES) (GT (+ LINES (QUO (LEN (FVAL (CAR L))) 9)) 60)) ; does it look like the next function will fit ; ; n o q r s !....?::::::::::::?! sr qo on what remains of this page? ; (PROGN (TERPRI) (PRINCH 12) (INCR PAGES) (SETQ LINES 0))) ; no, skip tho the next page using form feed ; ; !......................................................!n character (ascii 12) ; (SETQ COMFLAG ()) ; clear comment flag for every function ; (COND ; B ; (INP ; do we have a comment file? ; ; C ; (IF LIN1 ; yes, if LIN1 is not null, then LIN1 contains ; ; D the function name associated with the next ; ; group of comments in the file, LIN1 is not ; ; null we dont need to read another line ; () (READLN) ; LIN1 is null, go read the next line (should ; ; contain function name) ; (IF LIN (SETQ LIN1 (IMPLODE LIN)) (SETQ INP ()))) ; if the line was empty, terminate input file ; ; !.......?:::::::::::::::::::::::?..............!D usage (INP = nil) otherwize assemble the ; ; function name into LIN1 ; (IF (EQ (CAR L) LIN1) (SETQ COMFLAG T LIN1 ())))) ; if the function name is the same as the next ; ; !...?:::::::::::::::?.........................!CB function to be saved, set the comment flag ; (SETQ LINES (+ 2 LINES (EVAL ['PRET (NEXTL L) PARM]))) ; pretty print the next function and keep track ; ; M N !.....?::::::::::::::::::::?!NM of lines used on this page ; (TERPRI)) ; skip a line between functions ; ; m ; (PROGN (OUTPUT) (INPUT) PAGES)) ; close input and output files, return # of ; ; pages printed ; (DE GETCOM (X) ; ; (IFN COMLI ; does COMLI contain a set of comment lines ; ; a waiting for the right time to be printed? ; ; yes, skip to last line of this routine ; (IFN LIN ; COMLI is empty, thus we need to get the next ; ; b set of comments from the file. is the next ; ; line empty? (the line has allready been read ; ; for us) ; (SETQ COMFLAG ()) ; its a blank line, must be the end of the ; ; comments for this function ; (SETQ COMWORD () COMLI () LIN (CDR LIN)) ; remove first character from LIN (its a ".") ; ; !......................................! ; (UNTIL (EQ (CAR LIN) (ASCII 9)) (NEWL COMWORD (NEXTL LIN))) ; put all the characters up to the first tab ; ; !......?::::::::::::::::::::::?.?::::::::::::::::::::::::?! into COMWORD, comword will be the keyword ; ; used to match up the comment lines with the ; ; program text ; (UNTIL (NEQ (CAR LIN) (ASCII 9)) (NEXTL LIN)) ; discard all of the tabs separating comword ; ; !......?:::::::::::::::::::::::?............! from the comment ; (SETQ COMWORD (IMPLODE (FREVERSE COMWORD)) COMS LIN) ; assemble comword, COMS is a temporary ; ; !.............?::::::::::::::::::::::::::?.........! collection for this set of comment lines ; (READLN) (WHILE (AND LIN (NEQ (CAR LIN) ".")) ; this comment includes all succeeding lines ; ; h !........?:::::::::::::::::?! that dont begin with a "." ; (UNTIL (NEQ (CAR LIN) (ASCII 9)) (NEXTL LIN)) ; this is another continuation line, remove all ; ; !......?:::::::::::::::::::::::?............! leading tabs ; (PROGN (NCONC COMS (CONS " " LIN)) (READLN))) ; append the continuation line to COMS ; ; !......?:::::::::::::::::::::::::?.........!h ; (WHILE COMS ; now break up the characters in COMS into ; ; r separete lines short enough to fit. we will be ; ; done when all characters are removed from COMS ; (SETQ NXTLN () CNT CPOS) ; NXTLN will contain the next line to be split ; ; off of COMS ; (UNTIL (OR ; continue to add characters to NXTLN until one ; ; s t of the following 3 conditions ; (EQ CNT 124) ; we have no more room on the line ; (NULL COMS) ; we have used up all comment characters ; (IF (EQ (CAR COMS) ";") (NEXTL COMS))) ; a semicolon can be used to force seperation of ; ; !...?:::::::::::::::::?.............!t comments in specific places (also prevents ; ; harmful semicolons in comments) ; (PROGN (INCR CNT) (NEWL NXTLN (NEXTL COMS)))) ; remove the next character from COMS into NXTLN ; ; !.................?:::::::::::::::::::::::?!s ; (COND ; C ; ((AND (EQ CNT 124) COMS) ; have we stoped NXTLN because there is no more ; ; D!.....................! room for the remaining characters? ; (UNTIL (EQ (CAR NXTLN) " ") (NEWL COMS (NEXTL NXTLN))) ; yes, we have to back up so that we split the ; ; !......?::::::::::::::::::?.?:::::::::::::::::::::::?! line at word boundries ; (NEXTL NXTLN))) ; remove the unneeded space between the words ; ; DC that were split up ; (NEWL COMLI (FREVERSE NXTLN))) ; add the next line to the comment line list ; ; !...........................!r (COMLI) ; (SETQ COMLI (FREVERSE COMLI)))) ; get the comment lines back into proper order ; ; !...........................!ba ; (IF (AND COMFLAG (EQ COMWORD X)) (SETQ COMT T))) ; if the COMWORD is equal to the atom we are now ; ; !...?::::::::::::::::::::::::::?..............! printing, set COMT to let TERP know to print ; ; the comments in COMLI ; (DE ASKYN (PROMPT) ; (ASK Yes No) Ask the user a yes or no question. PROMPT contains characters used to prompt the user for a yes/no response. If response is Y or y, return T, otherwise return NIL. ; (PRIN PROMPT "? (Y/N) : ") ; print prompt message ; (TERPRI -1) (PROG1 (MEMQ (TYI) '(89 121)) (TERPRI))) ; returns T or NIL ; ; !......?::::::::::::::::::::?.........! ; (DE READLN () ; read the next line from the comment file and put the characters read into list LIN. note that lines beginning with a form feed (ascii 12) and ending with a carriage return are ignored by this routine, so that the can be used to break up the comment file into convienient pages. ; (SETQ LIN (READLINE)) (IF (EQ (CAR LIN) (ASCII 12)) (READLN))) ; !...................! !...?:::::::::::::::::::::::?.........! ; (DE PRINL (X) ; send all characters in list X to the output device ; (WHILE X (PRIN (NEXTL X)))) ; !........?::::::::::::::?! ; (DE PRINL1 (W Z) ; print the comment line W surrounded by semicolons at the proper output positions ; (IF (LT (OUTPOS) CPOS) (OUTPOS CPOS)) ; advance to the comment position if we have not ; ; !...?::::::::::::::::?..............! allready gone beyond it ; (IF Z (PRIN " ") (PRIN "; ")) ; if W is to be attached after a paren matching ; ; line then the semicolon isnt needed here ; (PRINL W) ; print the comment characters ; (PRIN " ;") ; indicate the end of the comment line ; (TERPRA)) ; advance to the next line ; (DE PRINTHEADER () ; this routine prints a header at the beginning of the output file and can contain any descriptive information desired. ; (SETQ LINES 2 SKIPLINE 11) (STATUS PRINT 1) ; the whole header is a comment ; (RMARGIN 127) (PRINT ";") (UNTIL (ZEROP SKIPLINE) (READLN) (DECR SKIPLINE)) ; skip the first 10 lines of comment file and ; ; !...............................................! read the eleventh ; (WHILE LIN (PRINL LIN) (INCR LINES) (TERPRI) (READLN)) ; print all lines read until a blank line is ; ; !....................................................! encountered ; (PRINT ";") ; end the comment ; (SETQ LIN ())) (DE RFILE (DEFAULT-EXT) ; ask the user for a file name in the standard RT11 style (DDD:NNNNNN.EEE) The default device is always DK: and DEFAULT-EXT is the default extention. Three variables are returned (DEV,FNAME,EXT) which will contain the users response in the form of lists of characters ; (TERPRI -1) ; output the prompt message ; (INPUT) ; for readline ; (SETQ FNAME (MAPCAR ; set FNAME to contain input string ; ; a b ; (LAMBDA (X) ; c ; (IF (GE (CASCII X) 97) ; e !................! ; (ASCII (- (CASCII X) 32)) ; convert all lower case characters to upper case ; ; !......?:::::::::::::::?! ; X)) ; ec ; (READLINE))) ; ba ; (IFN (MEMQ ":" FNAME) ; is a device specified? ; ; i ; (SETQ DEV '(D K)) ; No, default to DK ; (SETQ DEV [(NEXTL FNAME)]) ; yes, start collecting into DEV all the ; ; !.........?:::::::::::::?! characters which belong to the device name ; (UNTIL (EQ ":" (CAR FNAME)) (NCONC1 DEV (NEXTL FNAME))) ; we are done when semicolon is encountered ; ; !......?::::::::::::::::::?.?::::::::::::::::::::::::?! ; (NEXTL FNAME)) ; delete the semicolon ; ; i ; (SETQ L1 (MEMQ "." FNAME)) ; L1 contains part of string beginning with "." ; (IFN L1 ; is an extention specified? ; ; n ; (SETQ EXT (EXPLODE DEFAULT-EXT)) ; no, use the default extention ; ; !..............................! ; (SETQ EXT (CDR L1) FNAME (REVERSE FNAME)) ; yes, EXT is L1 with "." removed ; ; !.......................................! ; (UNTIL (EQ "." (CAR FNAME)) (NEXTL FNAME)) ; strip off extention characters from FNAME ; ; !......?::::::::::::::::::?..............! ; (SETQ FNAME (REVERSE (CDR FNAME))))) ; and put FNAME back into normal order ; ; !...........?:::::::::::::::::::?!n ; (DE SVSAVE () ; this routine saves al of the routines on this file (SAVE.VLI) ; (SETQ CPOS 77) (SAVE SAVE GETCOM ASKYN READLN PRINL PRINL1 PRINTHEADER RFILE SVSAVE))