; STORED ON: EDIT.VLI This file contains the VLISP editor and may be loaded by: (INPUT EDIT) VLISP.INI must be loaded for these routines to be used. When this file is loaded the following resources are used: Atoms = 332 Lists = 669 Numbers = 1 To enter the editor type: (EDIT Func-name) The edit commands are as follows: (where m,n are integers between 0 and 32767) "E" EXIT Exit from the editor and pretty print the edited function "0E" Exit from the editor "n " SELECT Select the nth list element as the new edit list " " the first list element as the new edit list "B" BACKUP Backup from the last select command "nB" Backup from the last n select commands "0B" Backup to the original edit list - i.e. (FVAL Func-name) "n,mS" SAVE Save the n'th thru m'th list elements in *0 "nS" Save the n'th list element in *0 "S" Save the first list element in *0 "n,mD" DELETE Save the n'th thru m'th elements in *0, then delete them from the list "nD" Save the n'th element in *0, then delete it from the list "D" Save the first element in *0, then delete it from the list "nU" UNSAVE expand the edit list by one element by using *0 as the new n'th element "U" expand the edit list by one element by using *0 as the new first element "0U" expand the edit list by one element by using *0 as the new last element "nV" expand the edit list by l [where l = (length *0)] by inserting *0 into the edit list before the n'th element "V" expand the edit list by l [where l = (length *0)] by inserting *0 into the edit list before the first element "0V" expand the edit list by l [where l = (length *0)] by appending *0 to the end of the edit list "nI" INSERT same as "nU" except instead of *0 use an expresssion input from the terminal "I" same as "U" except instead of *0 use an expresssion input from the terminal "0I" same as "0U" except instead of *0 use an expresssion input from the terminal "nJ" same as "nV" except instead of *0 use an expresssion input from the terminal "J" same as "V" except instead of *0 use an expresssion input from the terminal "0J" same as "0V" except instead of *0 use an expresssion input from the terminal "T" TYPE retype the entire edit list "n,mT" type elements n thru m of the edit list "nT" type elements n thru m of the edit list, where m = length of edit list ",nT" type the first n elements of the edit list "P" PUT *1 <-- *0 (Save the expression in *0 in *1) "nP" *n <-- *0 (Save the expression in *0 in *n) [use the put command after save or delete commands when the saved expression must not be lost by succeeding save or delete commands] "G" GET *0 <-- *1 (Retrieve the expression in *1) "nG" *0 <-- *n (Retrieve the expression in *n) [use the get command before U or V commands to retrieve saved expressions] "0R" RECALL Display the expression saved by the last S or D command (i.e. display *0) "R" Display the expression saved by the last P command (i.e. display *1) "nR" Display the expression saved by the last nP command (i.e. display *n) "X" EXCHANGE read two expressions form the terminal ("OLD","NEW"). Replace all occurances of "OLD" in the edit list with "NEW". note: Whenever the editor is displaying text on the terminal, you may cancel the rest of the printout by hitting the space bar (cancels all succeeding elements after completing current one). ; (DF EDIT (F) ; this is the VLISP editor, call with F as the function to be edited ; (SETQ ** (FVAL (CAR F)) **1 ** EXITFLG () BACKLST ()) ; ** is the edit list, **1 is the original edit list ; ; !........?::::::::::::?.............................! ; (SETQ PAR () PNUM 0 COMT () CPOS 68) ; initialize variables for PT (the pretty printer) ; (STATUS PRINT 0) (LMARGIN 0) (PEL) ; print the edit list, using sequence numbers ; (UNTIL EXITFLG ; repeat this loop until the exit command has been ; ; a executed ; (GETCMD) ; get a command from the user ; (SELECTQ ; b ; (ASCII CHR) ("e" ; exit command ; ; c ; (SETQ EXITFLG T) (IFN (ZEROP ARG) (EVAL ['PRET (CAR F) T]))) ; if ARG is nonzero, pretty print the function ; ; d !.....?:::::::::::::::?!dc ; (" " (SELECT) (PEL)) ; select command ; ("b" (BACKUP) (PEL)) ; backup command ; ("i" (PRIN1 "INSERT") (INSRT (READ)) (PEL)) ; insert commands ; ; !.....................?::::::::::::?......! ; ("j" (PRIN1 "INSERT") (JNSRT (READ)) (PEL)) ; !.....................?::::::::::::?......! ; ("u" (INSRT (COPY *0)) (PEL)) ; unsave commands ; ; !....?:::::::::::::::?......! ; ("v" (JNSRT (COPY *0)) (PEL)) ; !....?:::::::::::::::?......! ; ("t" (IF ARG0T (PEL1 ARG0 ARG) (PEL1 ARG (LENGTH **)))) ; watch command ; ; q !.........................?::::::::::::::::::::?!q ; ("p" (SET (IMP*) *0)) ; put command ; ; !....?:::::::::::::?! ; ("g" (SETQ *0 (EVAL (IMP*)))) ; get command ; ; v !........?:::::::::::?!v ; ("r" (PEL2 (EVAL (IMP*)))) ; recall command ; ; z !.....?:::::::::::?!z ; ("s" (SV*0)) ("d" (SV*0) (DELET) (PEL)) ("x" ; F ; (PRIN1 "OLD") ; exchange command ; (SETQ OLDS (READ)) (PRIN1 "NEW") (RPLACB ** (SUBST (READ) OLDS **)) ; !..........?::::::::::::::::::::?! ; (PEL)) ; F ; ((TYO 7))))) ; beep if illegal command ; ; !.......!ba ; (DE PRIN1 (A) ; output A, does not output a carriage return ; (PRIN A) (TERPRI -1)) (DE IMP* () ; generates atom names to be used form expression storage via the PUT command ; (IMPLODE (CONS "*" (EXPLODE ARG)))) ; !........?::::::::::::::::::::::?! ; (DE SELECT () ; select one of the list elements as the new edit list ; (IF (OR (NOT (ARGOK)) (ATOM (ARG **))) ; dont allow an atom to be the new edit list ; ; a !...?:::::::::::?.?:::::::::::::?! ; (TYO 7) ; beep if bad select argument ; (NEWL BACKLST ARG) ; add the selection to the backup list ; (SETQ ** (ARG **)))) ; select the new edit list ; ; !................!a ; (DE BACKUP () ; backup from one or more select commands ; (IF (ZEROP ARG) ; 0B will cause edit list to reinitialize to **1 ; ; a ; (SETQ BACKLST) ; 0B comes here - clear backup list ; (UNTIL (LT (DECR ARG)) (NEXTL BACKLST))) ; nB comes here - remove n elements from backup list ; ; !......?:::::::::::::?................!a ; (SETQ ** **1 BK (REVERSE BACKLST)) ; reinitialize ** to original edit list (**1) ; ; !................................! ; (WHILE BK (SETQ ** ((NEXTL BK) **)))) ; step through ** using backup list backwards ; ; g !........?:::::::::::::?!g ; (DE SV*0 () ; save one or more elements of the edit list in *0 ; (IFN (ARGOK) ; check for valid arguments ; ; a ; (TYO 7) ; beep if invalid ; (IFN ARG0T ; are there 1 or 2 arguments? ; ; c ; (SETQ *0 (ARG **)) ; 1 arg: save element number ARG of the edit list in *0 ; (SETQ *0 (COPY (NTH ARG0 **))) ; 2 args: save elements ARG0 thru ARG in *0 ; ; !........?::::::::::::::::::?! ; (RPLACD (NTH (ADD1 (- ARG ARG0)) *0))))) ; d !....?:::::::::::::::::?...!dca ; (DE DELET () ; delete one or more elements from the edit list ; (IF (ARGOK) ; check for valid arguments ; ; a ; (IF ARG0T ; are there 1 or 2 arguments? ; ; c ; (IF (EQ ARG0 1) ; come here for 2 arguments ; ; d ; (RPLACB ** (NTH (ADD1 ARG) **)) ; come here if ARG0 = 1 ; ; !..........?:::::::::::::::::?! ; (RPLACD (NTH (SUB1 ARG0) **) (NTH (ADD1 ARG) **))) ; come here if ARG0 > 1 ; ; !.......?::::::::::::::::::?.?:::::::::::::::::?!d ; (IF (EQ ARG 1) ; come here for 1 argument ; ; k ; (RPLACB ** (CDR **)) ; come here if ARG = 1 ; (RPLACD (NTH (SUB1 ARG) **) (NTH (ADD1 ARG) **)))))) ; come here if ARG > 1 ; ; !.......?:::::::::::::::::?.?:::::::::::::::::?!kca ; (DE ARGOK () ; check the arguments for validity ; (AND ; a ; (GT ARG) ; ARG must be greater than 0 ; (LE ARG (LENGTH **)) ; ARG cant be larger than the length of the edit list ; (OR (NOT ARG0T) (AND (GT ARG0) (LE ARG0 ARG))))) ; if there are 2 arguments, the first arg (ARG0) must be ; ; !...............?:::::::::::::::::::::::::::?!a greater than 0 and less than or equal to ARG ; (DE GETCMD () ; get a command sequence from the user ; (SETQ ARG0T) ; indicate that there is only one argument ; (PRIN "CMD: ") ; prompt the user for a command ; (TERPRI -1) (ARGCHR) ; get the first argument and command character ; (IFN (EQ (ASCII CHR) ",") () (SETQ ARG0T T ARG0 ARG) (ARGCHR)); if command is "," get a second argument and a new ; ; !....?::::::::::::::::::?....................................! command character ; (IF (AND (GE CHR 65) (LE CHR 90)) (SETQ CHR (+ CHR 32))) ; convert an upper case command character to lower case ; ; !...?:::::::::::::::::::::::::::?.?:::::::::::::::::::?! ; (TERPRI)) ; go to next line ; (DE ARGCHR () ; get a numeric argument and a command character from the user ; (SETQ ARG 1) ; use 1 as a default value if argument not present ; (SETQ CHR (TYI)) ; get a character ; (IFN (ISDIGIT CHR) ; is it a digit? ; ; a ; () (SETQ ARG 0) ; yes, initialize ARG to 0 ; (WHILE (ISDIGIT CHR) ; keep going until the command character is found ; ; c ; (SETQ ARG (+ CHR ("*" ARG 10) -48) CHR (TYI))))) ; convert from decimal ascii ; ; !.........?::::::::::::::::::::::?..........!ca ; (DE ISDIGIT (CHR) ; return true if CHR is a "0" thru "9" ; (AND (GE CHR 48) (LE CHR 57))) (DE PEL () ; pretty print the edit list while numbering the list elements ; (PEL1 1 (LENGTH **))) (DE PEL1 (EL1 EL2) ; print elements EL1 thru EL2 of the edit list ; (SETQ EL (SUB1 EL1)) (WHILE (AND (LE (INCR EL) EL2) (NEQ (TYS) 32)) ; cancel rest of output if spacebar is pressed ; ; a !....?::::::::::::::::?.?::::::::::::?! ; (PRIN EL " -->") ; print the element number ; (OUTPOS 8) (LMARGIN 8) (PEL2 (EL **)))) ; print the element starting in column 8 ; ; !............!a ; (DE PEL2 (X) ; pretty print the expression X ; (STATUS PRINT 7) (PT X 0 T) (STATUS PRINT 0) (LMARGIN 0) (TERPRI)) (DE INSRT (INSR) ; insert INSR as the new Nth element of ** ; (COND ; a ; ((EQ ARG 1) (RPLACB ** (MCONS INSR (CAR **) (CDR **)))) ; come here if ARG = 1 ; ; b !..........?::::::::::::::::::::::::::::?!b ; ((ARGOK) ; h ; (RPLACD (NTH (SUB1 ARG) **) (CONS INSR (NTH ARG **)))) ; come here if ARG is in range ; ; !.......?:::::::::::::::::?.?::::::::::::::::::::::?!h ; (T (NCONC1 ** INSR)))) ; if out of range, put INSR at the end of the edit list ; ; !..................!a ; (DE JNSRT (INSR) ; merge the list INSR into the edit list ; (IF (ATOM INSR) (SETQ INSR [INSR])) ; make sure its a list ; ; !...............?::::::::::::::::?! ; (COND ; b ; ((EQ ARG 1) (SETQ ** (NCONC INSR **))) ; come here if ARG = 1 ; ; !...........?:::::::::::::::::::::::?! ; ((ARGOK) ; d ; (RPLACD (NTH (SUB1 ARG) **) (NCONC INSR (NTH ARG **)))) ; come here if ARG is in range ; ; !.......?:::::::::::::::::?.?:::::::::::::::::::::::?!d ; (T (NCONC ** INSR)))) ; if out of range, put INSR at the end of the edit list ; ; !.................!b ; (DE SVEDIT () ; save all functions needed for the editor ; (SAVE ; a ; EDIT PRIN1 IMP* SELECT BACKUP SV*0 DELET ARGOK GETCMD ARGCHR ISDIGIT PEL PEL1 PEL2 INSRT JNSRT SVEDIT)) ; a ;