(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "18-Oct-93 15:30:38" "{Pele:mv:envos}Sources>CLTL2>EDITINTERFACE.;2" 40076 previous date%: "12-Jan-92 12:30:13" "{Pele:mv:envos}Sources>CLTL2>EDITINTERFACE.;1" ) (* ; " Copyright (c) 1986, 1987, 1988, 1990, 1991, 1992, 1993 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT EDITINTERFACECOMS) (RPAQQ EDITINTERFACECOMS [ (* ;; "This is John Wozencraft's simplified edit interface, created December 1990.") (PROP (Definition-for-EDITL Definition-for-EDITE Definition-for-EDITDATE) TELETYPE DISPLAY) (GLOBALVARS *LAST-DF* *LAST-DV* *LAST-DC* *LAST-DP*) (INITVARS (*LAST-DF*) (*LAST-DV*) (*LAST-DC*) (*LAST-DP*)) (INITVARS (*EDITMODE* 'TELETYPE) (*DISPLAY-EDITOR*)) (* ;; "init *EDITMODE* to TELETYPE, since that's the only editor we know is loaded. other editors should set *DISPLAY-EDITOR* and call EDITMODE as appropriate.") (VARS DUMMY-EDIT-FUNCTION-BODY) (VARIABLES *ED-OFFERS-PROPERTY-LIST* XCL::ED-LAST-INFO) (FUNCTIONS ED INSTALL-PROTOTYPE-DEFN) (FNS EDITDEF.FNS EDITF EDITFB EDITFNS EDITLOADFNS? EDITMODE EDITP EDITV DC DF DP DV EDITPROP EF EP EV EDITE EDITL) [COMS (* ;; "Time stamp on functions when edited") (* ;; "User enables this by an (ADDTOVAR INITIALSLIST (USERNAME )) in his INIT.LISP. E.g. (ADDTOVAR INITIALSLIST (MASINTER )) The date fixup is enabled by the variable INITIALS. The function SETINITIALS sets INITIALS from INITIALSLIST and USERNAME at load time, and after a sysin.") (FNS NEW/EDITDATE FIXEDITDATE EDITDATE? EDITDATE SETINITIALS) (INITVARS (INITIALS) (INITIALSLST) (DEFAULTINITIALS T)) (VARIABLES *REPLACE-OLD-EDIT-DATES*) (P (MOVD? 'EDITDATE 'TTY/EDITDATE] [INITVARS (COMMON-SOURCE-MANAGER-TYPES '(FUNCTIONS VARIABLES STRUCTURES TYPES SETFS OPTIMIZERS] (PROP FILETYPE EDITINTERFACE) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA EV EP EF DV DP DF DC EDITV EDITP EDITFNS EDITF) (NLAML) (LAMA]) (* ;; "This is John Wozencraft's simplified edit interface, created December 1990.") (PUTPROPS TELETYPE Definition-for-EDITL TTY/EDITL) (PUTPROPS DISPLAY Definition-for-EDITL TTY/EDITL) (PUTPROPS TELETYPE Definition-for-EDITE TTY/EDITE) (PUTPROPS DISPLAY Definition-for-EDITE TTY/EDITE) (PUTPROPS TELETYPE Definition-for-EDITDATE TTY/EDITDATE) (PUTPROPS DISPLAY Definition-for-EDITDATE TTY/EDITDATE) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS *LAST-DF* *LAST-DV* *LAST-DC* *LAST-DP*) ) (RPAQ? *LAST-DF* ) (RPAQ? *LAST-DV* ) (RPAQ? *LAST-DC* ) (RPAQ? *LAST-DP* ) (RPAQ? *EDITMODE* 'TELETYPE) (RPAQ? *DISPLAY-EDITOR* ) (* ;; "init *EDITMODE* to TELETYPE, since that's the only editor we know is loaded. other editors should set *DISPLAY-EDITOR* and call EDITMODE as appropriate." ) (RPAQQ DUMMY-EDIT-FUNCTION-BODY [LAMBDA (ARGS |...|) BODY]) (LISP:DEFVAR *ED-OFFERS-PROPERTY-LIST* T "Controls whether ED offers property list as an editable aspect") (DEFGLOBALVAR XCL::ED-LAST-INFO NIL "used in ED to stash last call info so (ED NIL) will restart last edit") (LISP:DEFUN ED (LISP::NAME LISP::OPTIONS) (* ; "Edited 5-Jul-88 16:03 by woz") (* ;;; "Standard Common Lisp editor entry. CLtL say's ED does something reasonable when passed a pathname. We coerce name into something that might be the name of something with an IL:FILES definition, & try to edit that. Then save call info in ED-LAST-INFO, so (ED) will start last edit over again.") (LISP:UNLESS (LISP:LISTP LISP::OPTIONS) (LISP:SETQ LISP::OPTIONS (LIST LISP::OPTIONS))) (LISP:WHEN (LISP:PATHNAMEP LISP::NAME) (LISP:WHEN (LISP::LOGICAL-PATHNAME-P LISP::NAME) (LISP:SETQ LISP::NAME (LISP:TRANSLATE-LOGICAL-PATHNAME LISP::NAME))) (LISP:SETQ LISP::NAME (NAMEFIELD (LISP:STRING-UPCASE (LISP:NAMESTRING LISP::NAME)) T)) (LISP:PUSHNEW 'FILES LISP::OPTIONS)) [COND (LISP::NAME (LISP:SETQ XCL::ED-LAST-INFO (CONS LISP::NAME LISP::OPTIONS))) (T (LISP:WHEN (NULL XCL::ED-LAST-INFO) (LISP:FORMAT T "Sorry, there is no previous edit to restart.") (LISP:RETURN-FROM ED NIL)) (LISP:SETQ LISP::NAME (CAR XCL::ED-LAST-INFO)) (LISP:SETQ LISP::OPTIONS (LISP:APPEND (CDR XCL::ED-LAST-INFO) LISP::OPTIONS] (LET* ((LISP::FROM-DISPLAY (OR (EQ LISP::OPTIONS T) (LISP:MEMBER :DISPLAY LISP::OPTIONS) (LISP:MEMBER 'DISPLAY LISP::OPTIONS))) (LISP::GIVEN-TYPES (for X inside LISP::OPTIONS when (NEQ X T) bind TYPE when (LISP:SETQ TYPE (GETFILEPKGTYPE X 'TYPES T LISP::NAME)) collect TYPE)) [LISP::TYPES-WITH-DEFNS (TYPESOF LISP::NAME LISP::GIVEN-TYPES NIL (LISP:IF (OR (LISP:MEMBER :CURRENT LISP::OPTIONS) (LISP:MEMBER 'CURRENT LISP::OPTIONS)) 'CURRENT '?) #'(LAMBDA (X) (NEQ (GET X 'EDITDEF) 'NILL] (LISP::POSSIBLE-TYPES (COND ([AND (NULL LISP::GIVEN-TYPES) (LISP:SYMBOLP LISP::NAME) (NOT (NULL *ED-OFFERS-PROPERTY-LIST*)) (find X on (GETPROPLIST LISP::NAME) by (CDDR X) suchthat (NULL (GET (CAR X) 'PROPTYPE] (* ;; "if we're supposed to offer PROPERTY-LIST as an edit type, and this name has a property list with other than system properties on it, then add IL:PROPERTY-LIST to the possible types.") (CONS 'PROPERTY-LIST LISP::TYPES-WITH-DEFNS)) (T LISP::TYPES-WITH-DEFNS))) (TYPE)) (LISP:WHEN (LISP:MEMBER 'PROPERTY-LIST LISP::OPTIONS) (* ;;  "this will allow PROPERTY-LIST to be specified as a fake filepkg type by the user (caller)") (LISP:SETQ LISP::POSSIBLE-TYPES '(PROPERTY-LIST))) [LISP:SETQ TYPE (if (LISP:MEMBER :NEW LISP::OPTIONS) then (* ;; "if :NEW then install a blank definition first") (OR (INSTALL-PROTOTYPE-DEFN LISP::NAME (OR LISP::TYPES-WITH-DEFNS LISP::GIVEN-TYPES) :NEW) (LISP:RETURN-FROM ED NIL)) elseif (CDR LISP::POSSIBLE-TYPES) then (* ;; "Many types were found/given. Ask the user which to use.") (if LISP::FROM-DISPLAY then (OR (MENU (create MENU ITEMS _ LISP::POSSIBLE-TYPES TITLE _ (LISP:FORMAT NIL "Edit which definition of ~S ?" LISP::NAME))) (LISP:RETURN-FROM ED NIL)) else (ASKUSER NIL (CAR LISP::POSSIBLE-TYPES) (LISP:FORMAT NIL "Edit which ~A definition of ~S ? " LISP::POSSIBLE-TYPES LISP::NAME) LISP::POSSIBLE-TYPES)) elseif (NOT (NULL LISP::POSSIBLE-TYPES)) then (* ;; "Exactly one type was found.") (if LISP::FROM-DISPLAY then (* ; "prepare the prompt window") (TERPRI PROMPTWINDOW)) (LISP:FORMAT (if LISP::FROM-DISPLAY then PROMPTWINDOW else T) "Editing ~A ~A ~S.~%%" (CAR LISP::POSSIBLE-TYPES) (LISP:IF (EQ (CAR LISP::POSSIBLE-TYPES) 'PROPERTY-LIST) "of" "definition of") LISP::NAME) (CAR LISP::POSSIBLE-TYPES) else (* ;;  "No types were found. Use the DefDefiner prototyping machinery.") (OR (INSTALL-PROTOTYPE-DEFN LISP::NAME LISP::GIVEN-TYPES) (LISP:RETURN-FROM ED NIL] (LISP:IF (EQ TYPE 'PROPERTY-LIST) (EDITE (GETPROPLIST LISP::NAME) NIL LISP::NAME 'PROPLST NIL LISP::OPTIONS) (EDITDEF LISP::NAME TYPE NIL NIL LISP::OPTIONS)) (LISP:RETURN-FROM ED LISP::NAME))) (LISP:DEFUN INSTALL-PROTOTYPE-DEFN (NAME &REST ARGS) (* ;;; "Explain to the user that the given name has no definitions (of the given type, if any) and give them the chance to pick a new, dummy definition to install under that name. Return the file-manager type of the definition installed. If TYPES were supplied, the one returned should be one of them. If no dummy was selected, return NIL. If the third arg in :NEW then don't bother with the %"no defn found%" message, cause the user intends to intall anew.") [LISP:FLET [(MAKE-AND-INSTALL (TYPE DEFINER) (LET ((DFNFLG 'PROP)) (DECLARE (LISP:SPECIAL DFNFLG)) (EVAL (XCL::MAKE-PROTOTYPE NAME TYPE DEFINER] (LET* ((DEFINER-HELP-STRING (LISP:FORMAT NIL "Installs a definition for ~S using this definer." NAME )) [REQUESTED-TYPES (AND (LISTP ARGS) (MKLIST (CAR ARGS] (NEW-DEFN-FLG (AND (LISTP ARGS) (EQ (CADR ARGS) :NEW))) [TYPES-WITH-PROTOTYPES (IF (NULL REQUESTED-TYPES) THEN (XCL::PROTOTYPE-DEFN-TYPES) ELSE (INTERSECTION REQUESTED-TYPES (XCL::PROTOTYPE-DEFN-TYPES] PROTOTYPE-TYPE) (IF (AND NEW-DEFN-FLG TYPES-WITH-PROTOTYPES) THEN (IF (CDR TYPES-WITH-PROTOTYPES) THEN (LISP:FORMAT T "Installing new definition for ~S~%%" NAME) ELSE (LISP:FORMAT T "Installing new ~S definition for ~S~%%" (CAR TYPES-WITH-PROTOTYPES ) NAME)) ELSEIF (NULL REQUESTED-TYPES) THEN (LISP:FORMAT T "~S has no definitions.~%%" NAME) ELSEIF (NULL (CDR REQUESTED-TYPES)) THEN (LISP:FORMAT T "~S has no ~A definition.~%%" NAME (CAR REQUESTED-TYPES)) ELSE (LISP:FORMAT T "~S has no definition of any of these types:~%% ~A~%%" NAME REQUESTED-TYPES)) [IF (NULL TYPES-WITH-PROTOTYPES) THEN (LISP:RETURN-FROM INSTALL-PROTOTYPE-DEFN NIL) ELSEIF (NULL (CDR TYPES-WITH-PROTOTYPES)) THEN (SETQ PROTOTYPE-TYPE (CAR TYPES-WITH-PROTOTYPES)) ELSE (LISP:FORMAT T "Select a type of dummy definition to install.~%%") (LET* ([MENU (CREATE MENU TITLE _ "Select a type for a dummy defn:" ITEMS _ (APPEND [FOR TYPE IN TYPES-WITH-PROTOTYPES COLLECT `(,TYPE '(:TYPE ,TYPE) "Displays a menu of definers for this type." (SUBITEMS ,@(FOR DEFINER IN ( XCL::PROTOTYPE-DEFINERS-FOR-TYPE TYPE) COLLECT `(,DEFINER '(:DEFINER ,TYPE ,DEFINER) ,DEFINER-HELP-STRING] (LIST '("Don't make a dummy defn" NIL] (RESULT (MENU MENU))) (LISP:ECASE (LISP:FIRST RESULT) (:TYPE (SETQ PROTOTYPE-TYPE (LISP:SECOND RESULT))) (:DEFINER (MAKE-AND-INSTALL (LISP:SECOND RESULT) (LISP:THIRD RESULT)) (LISP:RETURN-FROM INSTALL-PROTOTYPE-DEFN (LISP:SECOND RESULT))) ((NIL) (LISP:RETURN-FROM INSTALL-PROTOTYPE-DEFN NIL)))] (LISP:FORMAT T "Select a definer to use for a dummy definition.~%%") (LET [(DEFINER (MENU (CREATE MENU TITLE _ "Select a definer for a dummy defn:" ITEMS _ (APPEND (XCL::PROTOTYPE-DEFINERS-FOR-TYPE PROTOTYPE-TYPE) (LIST '("Don't make a dummy defn" NIL] (IF DEFINER THEN (MAKE-AND-INSTALL PROTOTYPE-TYPE DEFINER) PROTOTYPE-TYPE ELSE NIL]) (DEFINEQ (EDITDEF.FNS [LAMBDA (NAME EDITCOMS OPTIONS) (* ; "Edited 20-Nov-87 14:25 by woz") (PROG (DEF) LP (COND ((EXPRP (SETQ DEF (OR (GET NAME 'ADVISED) (GET NAME 'BROKEN) NAME))) (EDITE (if (LITATOM DEF) then (GETD DEF) else DEF) EDITCOMS NAME 'FNS NIL OPTIONS) (RETURN NAME)) ([EXPRP (SETQ DEF (GETPROP NAME 'EXPR] (* ;; "woz: don't use edit type PROP anymore. Let putdef for fns worry about where the definition goes.") (EDITE DEF EDITCOMS NAME 'FNS NIL OPTIONS) (RETURN NAME)) ((EDITFB NAME) (GO LP)) (T (* ;; "Used to call EDITFERROR to check for MACROS definition or install dummy FNS defintion. FNS can no longer be coerced to MACROS, and the new prototype stuff handles the other case. So if we're here, it's because EDITFB failed to find the definition, and thus NAME is not editable.") (LISP:FORMAT *ERROR-OUTPUT* "Could not find fns definition for ~a." NAME) (ERROR "Could not find fns definition for " NAME T]) (EDITF [NLAMBDA EDITFX (* ; "Edited 11-Jun-90 15:44 by jds") (SETQ EDITFX (NLAMBDA.ARGS EDITFX)) (LET ((FNTYPE 'FNS)) (EDITDEF (if EDITFX then (COND ((HASDEF (CAR EDITFX) 'FUNCTIONS '? EDITFX) (SETQ FNTYPE 'FUNCTIONS) (CAR EDITFX)) ((HASDEF (CAR EDITFX) 'FNS '? EDITFX) (CAR EDITFX))) else (PROGN (PRIN1 "Editing " T) (PRINT LASTWORD T))) FNTYPE NIL (CDR EDITFX]) (EDITFB [LAMBDA (FN) (* ; "Edited 27-Jan-87 14:50 by Pavel") (PROG (FL TEM) (COND ((SETQ FL (EDITLOADFNS? FN (AND (NULL EDITLOADFNSFLG) '"not editable, do you want to load it PROP from") (NULL EDITLOADFNSFLG))) (LOADFNS FN FL 'PROP)) ((AND (EQ (NARGS 'WHEREIS) 4) (SETQ FL (EDITLOADFNS? FN '"not editable; do you want to LOADFROM PROP the file" T T))) (LOADFROM FL (LIST FN) 'PROP)) (T (RETURN))) (COND ((GETPROP FN 'EXPR) (RETURN T)) (T (PRINTOUT T "** Not found on " FL T]) (EDITFNS [NLAMBDA X (* DD%: " 7-Oct-81 20:56") (* ;; "FNS is a list (or name of a list) of functions to be edited; (CDR X) are the operations to be performed.") (SETQ X (MKLIST X)) (MAPC [COND ((LISTP (CAR X)) (STKEVAL 'EDITFNS (CAR X) NIL 'INTERNAL)) (T (* ;  "If (CAR X) is name of a file, do editfns on its functions.") (OR (LISTP (EVALV (CAR X) 'EDITFNS)) (AND (GETPROP (OR (AND DWIMFLG (MISSPELLED? (CAR X) 70 FILELST NIL X)) (CAR X)) 'FILE) (FILEFNSLST (CAR X))) (STKEVAL 'EDITFNS (CAR X) 'INTERNAL] (FUNCTION (LAMBDA (Y) (ERSETQ (APPLY 'EDITF (CONS (PROG1 (PRIN2 Y T T) (SPACES 1 T)) (CDR X]) (EDITLOADFNS? [LAMBDA (FN STR ASKFLG FILES) (* lmm "20-Nov-86 21:23") (* ;; "Value is name of file from which function or functions can be loaded. If STR is non-NIL, user is asked to approve, and STR used in the message. EDITLOADFNS? is also used by prettyprint") (AND FN FILEPKGFLG (PROG ((LST (WHEREIS FN 'FNS FILES)) FILE DATES FD) (OR (COND ((EQ FILES T) (* ;; "if FILES = T, means consult data base. if user has removed a function from one of those files, as evidenced by the fact that editloafns? was called with files=T, then dont offer that file.") (SETQ LST (LDIFFERENCE LST FILELST))) (T LST)) (RETURN)) [SETQ FILE (COND ((CDR LST) (PRIN2 FN T) (MAPRINT LST T " is contained on " " " " and ") (OR (ASKUSER NIL NIL "indicate which file to use: " (MAKEKEYLST LST) T) (RETURN))) (T (CAR LST] [SETQ DATES (LISTP (GETPROP FILE 'FILEDATES] (* ;;  "only look at file in FILEDATES if the file has been LOADed or LOADFROMd") (SETQ FILE (OR (AND DATES (FMEMB (CDAR (GETPROP FILE 'FILE)) '(LOADFNS T)) (INFILEP (CDAR DATES))) (FINDFILE FILE T) (RETURN))) [COND ((AND DATES (NEQ FILE (CDAR DATES))) (* ;  "found a different file than in FILEDATES") (COND ((EQUAL (CAAR DATES) (SETQ FD (FILEDATE FILE))) (* ;  "found a goood version of file on a different name. smash name") (/RPLACD (CAR DATES) FILE)) (T (LISP:FORMAT *TERMINAL-IO* "*** Note: loading definition from ~A dated ~A~&while file ~A dated ~A is the version currently loaded." FILE FD (CDAR DATES) (CAAR DATES] (COND ((STREQUAL STR "")) ((NULL ASKFLG) (if STR then (EXEC-FORMAT "~&~A~A" STR FILE) else (EXEC-FORMAT "~&Loading definition of ~S from ~A." FN FILE))) ((NEQ (ASKUSER DWIMWAIT 'Y (LIST FN STR FILE) NIL T) 'Y) (RETURN))) (RETURN FILE]) (EDITMODE [LAMBDA (NEWMODE) (* ;;; "WOZ- 1/9/91. Took (setq newmode (il:u-case newmode)) out because it puts newmode in the IL: package. This doesn't work with my new definition of what an editor is, ie a symbol whos function cell can be applied to (structure props options). The rest of the old code , eg Definition-for-EDITL remains until DEDIT goes away and the TTY/EDITOR becomes a programmatic structure editor only.") (PROG1 (if (NOT (DISPLAYSTREAMP (TTYDISPLAYSTREAM))) then (* ;; "not a display, always say teletype. This is mainly for chatserver") 'TELETYPE else (SELECTQ *EDITMODE* (DISPLAY *DISPLAY-EDITOR*) *EDITMODE*)) (* ;; "return old value, and, if new value given, set it.") (LISP:WHEN NEWMODE (LET (new.display.editor) (if (EQ NEWMODE 'STANDARD) then (* ; "Obselete terminology") (SETQ NEWMODE 'TELETYPE) elseif (AND (EQ NEWMODE 'DISPLAY) *DISPLAY-EDITOR*) then (SETQ NEWMODE *DISPLAY-EDITOR*) elseif (NEQ NEWMODE 'TELETYPE) then (* ;  "if we've been called with the name of a display editor, make it the default display editor") (SETQ new.display.editor NEWMODE)) (if (NOT (GETPROP NEWMODE 'Definition-for-EDITL)) then (LISP:CERROR "Ignore call to EDITMODE" "~S is unrecognized argument to EDITMODE" NEWMODE) else (if new.display.editor then (SETQ *DISPLAY-EDITOR* new.display.editor)) (SETQ *EDITMODE* NEWMODE)))))]) (EDITP [NLAMBDA EDITPX (* lmm "10-Jun-85 17:12") (SETQ EDITPX (NLAMBDA.ARGS EDITPX)) (PROG ((ATM (CAR EDITPX))) [COND ((AND DWIMFLG (NLISTP (GETPROPLIST ATM))) (SETQ ATM (OR (MISSPELLED? ATM 75 USERWORDS NIL NIL (FUNCTION GETPROPLIST)) ATM] (EDITE (GETPROPLIST ATM) (CDR EDITPX) ATM 'PROPLST) (RETURN ATM]) (EDITV [NLAMBDA EDITVX (* lmm " 2-Sep-85 13:17") (SETQ EDITVX (NLAMBDA.ARGS EDITVX)) (LET* [[VAR (OR (CAR EDITVX) (PROGN (PRIN1 "= " T) (PRINT LASTWORD T] (FRAME (AND VAR (STKSCAN VAR] (if FRAME then (EDITE (ENVEVAL VAR FRAME NIL T) (CDR EDITVX) VAR) elseif (SETQ VAR (HASDEF VAR 'VARS 'CURRENT T)) then (EDITDEF VAR 'VARS 'CURRENT (CDR EDITVX)) else (ERROR VAR "not editable"]) (DC [NLAMBDA FILE (* ; "Edited 18-Mar-87 16:03 by woz") (* ; "Edits COMS of file FILE") (LET ((*EDITMODE* 'DISPLAY) (ARGS (NLAMBDA.ARGS FILE))) (* ;; "(APPLY (QUOTE EDITV) (FILECOMS (OR (HASDEF (CAR (NLAMBDA.ARGS FILE)) (QUOTE FILE) NIL T) (ERROR FILE 'is not a loaded file' T))))") (if (LISTP ARGS) then (SETQ *LAST-DC* (CAR ARGS))) (if *LAST-DC* then (ED *LAST-DC* '(FILES :DONTWAIT)) else (ERROR "No saved file name." "Edit aborted."]) (DF [NLAMBDA FN (* ; "Edited 18-Mar-87 17:00 by woz") (LET ((*EDITMODE* 'DISPLAY) (ARGS (NLAMBDA.ARGS FN))) (* ;; "(APPLY (COND ((EQ (CADR (LISTP FN)) (QUOTE NEW)) (QUOTE EDITFERROR)) (T (QUOTE EDITF))) (NLAMBDA.ARGS FN))") (* ;; "DF used to look for MACROS under EDITFERROR. Decided this is bad, because could get the macro without noticing the fns if the file was sysloaded. Now just look for FUNCTIONS and FNS.") (if (LISTP ARGS) then (SETQ *LAST-DF* (CAR ARGS))) (if *LAST-DF* then [ED *LAST-DF* (if (AND (CDR ARGS) (EQ (CADR ARGS) 'NEW)) then '(FUNCTIONS FNS :DONTWAIT :NEW) else '(FUNCTIONS FNS :DONTWAIT] else (ERROR "No saved function name." "Edit aborted."]) (DP [NLAMBDA ATOM (* ; "Edited 18-Mar-87 16:16 by woz") (LET ((*EDITMODE* 'DISPLAY) (ARGS (NLAMBDA.ARGS ATOM))) (* ;  "(APPLY (QUOTE EDITPROP) (NLAMBDA.ARGS ATOM))") [if (LISTP ARGS) then (if (CDR ARGS) then (* ;  "specific PROP to edit. remember (ATOM PROP)") (SETQ *LAST-DP* ARGS) else (* ;  "edit whole plist. remember ATOM") (SETQ *LAST-DP* (CAR ARGS] (if *LAST-DP* then [ED *LAST-DP* (if (LISTP *LAST-DP*) then '(PROPS :DONTWAIT) else '(PROPERTY-LIST :DONTWAIT] else (ERROR "No saved symbol name." "Edit aborted."]) (DV [NLAMBDA VAR (* ; "Edited 18-Mar-87 12:43 by woz") (LET ((*EDITMODE* 'DISPLAY) (ARGS (NLAMBDA.ARGS VAR))) (* ;  "(APPLY (QUOTE EDITV) (NLAMBDA.ARGS VAR))") (if (LISTP ARGS) then (SETQ *LAST-DV* (CAR ARGS))) (if *LAST-DV* then (ED *LAST-DV* '(VARIABLES VARS :DONTWAIT)) else (ERROR "No saved variable name." "Edit aborted."]) (EDITPROP [LAMBDA (NAME PROP) (* bas%: "21-MAR-83 20:29") (COND (PROP (EDITDEF (LIST NAME PROP) 'PROPS)) (T (APPLY 'EDITP NAME]) (EF [NLAMBDA FN (* jow "16-Oct-86 11:41") (LET ((*EDITMODE* 'TELETYPE)) (APPLY (COND ((EQ (CADR (LISTP FN)) 'NEW) 'EDITFERROR) (T 'EDITF)) (NLAMBDA.ARGS FN]) (EP [NLAMBDA ATOM (* jow "16-Oct-86 11:42") (LET ((*EDITMODE* 'TELETYPE)) (APPLY 'EDITPROP (NLAMBDA.ARGS ATOM]) (EV [NLAMBDA VAR (* jow "16-Oct-86 11:42") (LET ((*EDITMODE* 'TELETYPE)) (APPLY 'EDITV (NLAMBDA.ARGS VAR]) (EDITE [LAMBDA (EXPR COMS ATM TYPE IFCHANGEDFN OPTIONS) (* ; "Edited 17-Mar-87 11:59 by woz") (if (AND EXPR (NLISTP EXPR) (SELECTQ (EDITMODE) (TELETYPE (* ; "don't inspect") NIL) (SEDIT (NOT (STRINGP EXPR)) (* ;  "Sedit can't handle strings, it returns the old string") T) T)) then (* ;; "this used to be done by redefining EDITE on the file INSPECT. Its not clear that it is still a good idea") (INSPECT EXPR) else (LISP:FUNCALL (GET (EDITMODE) 'Definition-for-EDITE) EXPR COMS ATM TYPE IFCHANGEDFN OPTIONS]) (EDITL [LAMBDA (L COMS ATM MESS EDITCHANGES) (* lmm "12-Nov-86 15:18") (LISP:FUNCALL (GET (EDITMODE) 'Definition-for-EDITL) L COMS ATM MESS EDITCHANGES]) ) (* ;; "Time stamp on functions when edited") (* ;; "User enables this by an (ADDTOVAR INITIALSLIST (USERNAME )) in his INIT.LISP. E.g. (ADDTOVAR INITIALSLIST (MASINTER )) The date fixup is enabled by the variable INITIALS. The function SETINITIALS sets INITIALS from INITIALSLIST and USERNAME at load time, and after a sysin." ) (DEFINEQ (NEW/EDITDATE [LAMBDA (OLDATE INITLS) (* lmm "12-Nov-86 15:18") (LISP:FUNCALL (GET (EDITMODE) 'Definition-for-EDITDATE) OLDATE INITLS]) (FIXEDITDATE [LAMBDA (EXPR) (* NOBIND "18-JUL-78 21:11") (* ;  "Inserts or replaces previous edit date") (AND INITIALS (LISTP EXPR) (FMEMB (CAR EXPR) LAMBDASPLST) (LISTP (CDR EXPR)) (PROG ((E (CDDR EXPR))) RETRY [COND ((NLISTP E) (RETURN)) ((LISTP (CAR E)) (SELECTQ (CAAR E) ((CLISP%: DECLARE) (SETQ E (CDR E)) (GO RETRY)) (BREAK1 (COND ((EQ (CAR (CADAR E)) 'PROGN) (SETQ E (CDR (CADAR E))) (GO RETRY)))) (ADV-PROG (* ;  "No easy way to mark cleanly the date of an advised function") (RETURN)) (COND ((AND (EQ (CAAR E) COMMENTFLG) (EQ (CADAR E) 'DECLARATIONS%:)) (SETQ E (CDR E)) (GO RETRY] (COND ((AND (LISTP (CDR E)) (EDITDATE? (CAR E))) (/RPLACA E (EDITDATE (CAR E) INITIALS))) (T (/ATTACH (EDITDATE NIL INITIALS) E))) (RETURN EXPR]) (EDITDATE? [LAMBDA (COMMENT) (* ; "Edited 29-Oct-87 16:41 by drc:") (* ;;; "Tests to see if a given common is in fact an edit date -- this has to be general enough to recognize the most comment comment forms while specific enough to not recognize things that are not edit dates. We settle for the conservative form of (* initials date-string), since only truly ancient edit dates look any different from that") (DECLARE (LOCALVARS . T)) (AND *REPLACE-OLD-EDIT-DATES* (LISTP COMMENT) (EQMEMB (CAR COMMENT) COMMENTFLG) (LISTP (CDR COMMENT)) (LISTP (CDDR COMMENT)) (NULL (CDDDR COMMENT)) (STRINGP (CADDR COMMENT)) (LET ((INITIALS? (CADR COMMENT))) (AND (NOT (EQMEMB INITIALS? COMMENTFLG)) (OR (EQ INITIALS? INITIALS) (if (LITATOM INITIALS?) then (if (for I from 1 to (NCHARS INITIALS?) always (EQ (NTHCHARCODE INITIALS? I) (CHARCODE ";"))) then (* ; " an sedit comment") (AND (EQ INITIALS? ';) (STRPOS "Edited " (CADDR COMMENT) 1 NIL T) (>= (LISP:LENGTH (CADDR COMMENT)) (LISP:LENGTH "Edited 01-jan-86 00:00 by "))) else (* ; "an old-style comment") T) elseif (STRINGP INITIALS?) then (* ;  "make sure it's not a string-body comment.") (ILESSP (NCHARS INITIALS?) 12]) (EDITDATE [LAMBDA (OLDATE INITLS) (* ;  "Edited 20-Nov-86 23:23 by Masinter") (* ;; "Generates a new date from an old one") (LET [(NEWDATE (LIST '; (CONCAT "Edited " (DATE (DATEFORMAT NO.SECONDS)) " by " INITLS] (COND ((EQMEMB (CAR (LISTP OLDATE)) COMMENTFLG) (* ;; "Destructively alter old date. This is for benefit of DEDIT being able to find the old form to reprint") (/RPLACD OLDATE NEWDATE)) (T (CONS (OR (CAR (LISTP COMMENTFLG)) COMMENTFLG) NEWDATE]) (SETINITIALS [LAMBDA NIL (* ;  "Edited 20-Nov-86 23:22 by MASINTER") (* ;;; "Sets the default initials to appear in edited code, and sets the user's first name. Called following GREET via POSTGREETFORMS.") (LET ((DFNFLG T) (FILEPKGFLG NIL) (USER (USERNAME NIL NIL T)) POS TRIPLE) (SETQ POS (STRPOS "." USER)) (* ; "Find out if there's a period in the name, which would indicate that there's a registry on the end.") [COND ((AND POS DEFAULTREGISTRY (STRING-EQUAL (SUBSTRING USER (ADD1 POS) -1) DEFAULTREGISTRY)) (* ;; "If there's a registry on the end, and it's the default registry, remove the registry. We assume that DEFAULTREGISTRY has been set by the time that GREET has finished.") (SETQ USER (SUBSTRING USER 1 (SUB1 POS] (COND [(find old TRIPLE in INITIALSLST suchthat (STRING-EQUAL USER (CAR TRIPLE) )) (* ;  "OK we found his last name on the INITIALSLST. Now break out his initials and first name") (COND ((NLISTP (CDR TRIPLE)) (* ; "old style") (SAVESET 'INITIALS (CDR TRIPLE))) (T (SAVESET 'FIRSTNAME (CADR TRIPLE)) (SAVESET 'INITIALS (CADDR TRIPLE] (T (SAVESET 'INITIALS (COND ((NOT DEFAULTINITIALS) NIL) ((NEQ DEFAULTINITIALS T) DEFAULTINITIALS) (T USER]) ) (RPAQ? INITIALS ) (RPAQ? INITIALSLST ) (RPAQ? DEFAULTINITIALS T) (LISP:DEFVAR *REPLACE-OLD-EDIT-DATES* T "NIL or T; if NIL, old edit dates will not be replaced") (MOVD? 'EDITDATE 'TTY/EDITDATE) (RPAQ? COMMON-SOURCE-MANAGER-TYPES '(FUNCTIONS VARIABLES STRUCTURES TYPES SETFS OPTIMIZERS)) (PUTPROPS EDITINTERFACE FILETYPE LISP:COMPILE-FILE) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA EV EP EF DV DP DF DC EDITV EDITP EDITFNS EDITF) (ADDTOVAR NLAML ) (ADDTOVAR LAMA ) ) (PUTPROPS EDITINTERFACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 1992 1993)) (DECLARE%: DONTCOPY (FILEMAP (NIL (15224 32017 (EDITDEF.FNS 15234 . 16576) (EDITF 16578 . 17460) (EDITFB 17462 . 18310) (EDITFNS 18312 . 19575) (EDITLOADFNS? 19577 . 23356) (EDITMODE 23358 . 25372) (EDITP 25374 . 25885) ( EDITV 25887 . 26532) (DC 26534 . 27200) (DF 27202 . 28258) (DP 28260 . 29418) (DV 29420 . 29986) ( EDITPROP 29988 . 30203) (EF 30205 . 30530) (EP 30532 . 30711) (EV 30713 . 30888) (EDITE 30890 . 31787) (EDITL 31789 . 32015)) (32367 39397 (NEW/EDITDATE 32377 . 32599) (FIXEDITDATE 32601 . 34437) ( EDITDATE? 34439 . 36612) (EDITDATE 36614 . 37359) (SETINITIALS 37361 . 39395))))) STOP