(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP") (FILECREATED "16-May-90 18:05:30" |{DSK}local>lde>lispcore>sources>GAINSPACE.;2| 12014 |changes| |to:| (VARS GAINSPACECOMS) |previous| |date:| " 3-Dec-86 22:18:00" |{DSK}local>lde>lispcore>sources>GAINSPACE.;1|) ; Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved. (PRETTYCOMPRINT GAINSPACECOMS) (RPAQQ GAINSPACECOMS ((DECLARE\: DOEVAL@COMPILE DONTCOPY (RECORDS GAINSPACE) (GLOBALVARS GAINSPACEFORMS SMASHPROPSMENU SMASHPROPSLST SMASHPROPSLST1 DWIMWAIT ARCHIVELST LASTHISTORY ARCHIVEFLG LISPXCOMS LISPXHISTORY EDITHISTORY)) (FNS GAINSPACE ERASEPROPS PURGEHISTORY PURGEHISTORY1 PURGEHISTORY2) (VARS SMASHPROPSMENU (SMASHPROPSLST)) (ADDVARS (GAINSPACEFORMS ((CAR LISPXHISTORY) "purge history lists" (PURGEHISTORY RESPONSE) ((Y "es") (N "o") (E . "verything"))) (T "discard definitions on property lists" (SETQ SMASHPROPSLST1 (CONS 'EXPR (CONS 'CODE (CONS 'SUBR SMASHPROPSLST1))) )) (T "discard old values of variables" (SETQ SMASHPROPSLST1 (CONS 'VALUE SMASHPROPSLST1 ))) (T "erase properties" (ERASEPROPS RESPONSE) ((Y "es" EXPLAINSTRING "Yes - you will be asked which properties are to be erased") (N "o") (A "ll" CONFIRMFLG T EXPLAINSTRING "All - all properties on mentioned on SMASHPROPSMENU") (E "dit " EXPLAINSTRING "Edit - you will be allowed to edit a list of property names"))) (CLISPARRAY "erase CLISP translations" (CLRHASH CLISPARRAY)) (CHANGESARRAY "erase changes array" (CLRHASH CHANGESARRAY)) (SYSHASHARRAY "erase system hash array" (CLRHASH)) ((GETPROP 'EDIT 'LASTVALUE) "discard context of last edit" (REMPROP 'EDIT 'LASTVALUE)) (GREETHIST "discard information saved for undoing your greeting" (SETQ GREETHIST )))))) (DECLARE\: DOEVAL@COMPILE DONTCOPY (DECLARE\: EVAL@COMPILE (RECORD GAINSPACE (PRECHECK MESSAGE FORM KEYLST) (SYSTEM)) ) (DECLARE\: DOEVAL@COMPILE DONTCOPY (GLOBALVARS GAINSPACEFORMS SMASHPROPSMENU SMASHPROPSLST SMASHPROPSLST1 DWIMWAIT ARCHIVELST LASTHISTORY ARCHIVEFLG LISPXCOMS LISPXHISTORY EDITHISTORY) ) ) (DEFINEQ (gainspace (lambda nil (* |wt:| 30-jul-77 13 35) (setq smashpropslst1 nil) (mapc gainspaceforms (function (lambda (x) (prog (response) (and (neq (position t) 0) (terpri t)) (ersetq (and (eval (|fetch| (gainspace precheck) |of| x)) (neq (setq response (askuser dwimwait 'n (list (|fetch| (gainspace message) |of| x)) (|fetch| (gainspace keylst) |of| x) t)) 'n) (eval (|fetch| (gainspace form) |of| x))))))) ) (cond (smashpropslst1 (terpri t) (prin1 "mapatoms called to erase the indicated properties..." t) (mapatoms (function (lambda (atm) (remproplist atm smashpropslst1)))) (mapc smashpropslst1 (function (lambda (x) (and (listp x) (eval x))))))) '|done|)) (eraseprops (lambda (response) (* |wt:| 30-jul-77 12 43) (setq smashpropslst1 (union smashpropslst1 smashpropslst)) (* |smashpropslst| |lets| |user| |prespecify| |properties| |to| |always| |be|  |smashed,| |and| |not| |to| |ask| |him.|) (selectq response (y (terpri t) (prin1 "indicate which ones: " t) (mapc smashpropsmenu (function (lambda (x) (and (some (cdr x) (function (lambda (x) (and (litatom x) (not (memb x smashpropslst1)) )))) (eq (askuser nil nil (list (car x)) nil t) 'y) (setq smashpropslst1 (union (cdr x) smashpropslst1))))))) ((a e) (setq smashpropslst1 (mapconc smashpropsmenu (function (lambda (x) (append (cdr x)))))) (and (eq response 'e) (edite (sort smashpropslst1)))) (help)))) (purgehistory (lambda (type) (* |wt:| "14-NOV-78 02:03") (resetvars (archiveflg) (selectq type (e (setq archiveflg t)) (y (setq type (askuser nil nil "purge everything, or just the properties, e.g. SIDE, LISPXPRINT, etc. ? " '((y "es - everything" return t) (n "o - just the properties" return 'nil) (e "verything" return t) (j "ust the properties" return 'nil)) t)) (terpri t) (setq archiveflg (eq (askuser nil nil "ARCHIVELST and named commands too ? " nil t) 'y))) (help)) (purgehistory1 lispxhistory type) (purgehistory1 edithistory type) (purgehistory1 lasthistory type) (cond (archiveflg (purgehistory1 archivelst type) (mapc lispxcoms (function (lambda (com) (and (litatom com) (cond (type (remprop com '*history*)) (t (purgehistory2 (caddr (getprop com '*history*)))))) ))))) (return)))) (purgehistory1 (lambda (lst flg) (* dd\: "26-Oct-81 12:48") (cond ((nlistp lst)) (flg (rplaca lst nil)) ((eq lst edithistory) (mapc (car lst) (function (lambda (entry) (* caddr |of| |the| |entry| |is| |used| |for| |saving| |side| |information|  |on| |the| |edito| |history| |list.| |however,| |can't| |just| |rplacd| cdr  |because| |that| |node| |is| |reused| |by| |historysave.|) (rplnode (cddr entry) (constant (character (charcode bell)))))))) (t (mapc (car lst) (function purgehistory2)))))) (purgehistory2 (lambda (entry) (* |wt:| 2-dec-75 15 46) (prog (tem) (cond ((setq tem (listget1 entry '*group*)) (rplacd (cddr entry) (list '*group* tem '*history* (listget1 entry '*history*))) (mapc tem (function purgehistory2))) (t (rplacd (cddr entry) nil)))))) ) (RPAQQ SMASHPROPSMENU (("old values of variables" VALUE) ("function definitions on property lists" EXPR CODE) ("advice information" ADVISED ADVICE READVICE (SETQ ADVISEDFNS NIL)) ("filemaps" FILEMAP) ("clisp information (warning: this will disable clisp!)" ACCESSFN BROADSCOPE CLISPCLASS CLISPCLASSDEF CLISPFORM CLISPIFYISPROP CLISPINFIX CLISPISFORM CLISPISPROP CLISPNEG CLISPTYPE CLISPWORD CLMAPS I.S.OPR I.S.TYPE LISPFN SETFN UNARYOP) ("compiler information (warning: this will disable the compiler!)" AMAC BLKLIBRARYDEF CROPS CTYPE GLOBALVAR MACRO MAKE OPD UBOX) ("definitions of named history commands" *HISTORY*) ("context of edits exited via save command" EDIT-SAVE))) (RPAQQ SMASHPROPSLST NIL) (ADDTOVAR GAINSPACEFORMS ((CAR LISPXHISTORY) "purge history lists" (PURGEHISTORY RESPONSE) ((Y "es") (N "o") (E . "verything"))) (T "discard definitions on property lists" (SETQ SMASHPROPSLST1 (CONS 'EXPR (CONS 'CODE (CONS 'SUBR SMASHPROPSLST1)))) ) (T "discard old values of variables" (SETQ SMASHPROPSLST1 (CONS 'VALUE SMASHPROPSLST1))) (T "erase properties" (ERASEPROPS RESPONSE) ((Y "es" EXPLAINSTRING "Yes - you will be asked which properties are to be erased") (N "o") (A "ll" CONFIRMFLG T EXPLAINSTRING "All - all properties on mentioned on SMASHPROPSMENU") (E "dit " EXPLAINSTRING "Edit - you will be allowed to edit a list of property names"))) (CLISPARRAY "erase CLISP translations" (CLRHASH CLISPARRAY)) (CHANGESARRAY "erase changes array" (CLRHASH CHANGESARRAY)) (SYSHASHARRAY "erase system hash array" (CLRHASH)) ((GETPROP 'EDIT 'LASTVALUE) "discard context of last edit" (REMPROP 'EDIT 'LASTVALUE)) (GREETHIST "discard information saved for undoing your greeting" (SETQ GREETHIST))) (PUTPROPS GAINSPACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1990)) (DECLARE\: DONTCOPY (FILEMAP (NIL (3185 9621 (GAINSPACE 3195 . 5141) (ERASEPROPS 5143 . 6702) (PURGEHISTORY 6704 . 8454) ( PURGEHISTORY1 8456 . 9189) (PURGEHISTORY2 9191 . 9619))))) STOP