diff --git a/sources/EDITINTERFACE b/sources/EDITINTERFACE index 1ce6c0681..6b5204b69 100644 --- a/sources/EDITINTERFACE +++ b/sources/EDITINTERFACE @@ -1,18 +1,16 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "21-May-2024 22:10:45" {DSK}matt>Interlisp>medley>sources>EDITINTERFACE.;2 47745 +(FILECREATED " 2-Oct-2025 10:43:08"  +{DSK}kaplan>Local>medley3.5>working-medley>sources>EDITINTERFACE.;57 49004 - :EDIT-BY "mth" + :EDIT-BY rmk - :CHANGES-TO (FNS EDITLOADFNS?) - - :PREVIOUS-DATE "22-Jun-2022 13:32:08" {DSK}matt>Interlisp>medley>sources>EDITINTERFACE.;1 -) + :CHANGES-TO (VARS EDITINTERFACECOMS) + (FUNCTIONS ED) + :PREVIOUS-DATE " 1-Oct-2025 23:20:37" +{DSK}kaplan>Local>medley3.5>working-medley>sources>EDITINTERFACE.;56) -(* ; " -Copyright (c) 1986-1988, 1990-1991, 2024 by Venue & Xerox Corporation. -") (PRETTYCOMPRINT EDITINTERFACECOMS) @@ -110,10 +108,11 @@ Copyright (c) 1986-1988, 1990-1991, 2024 by Venue & Xerox Corporation. (DEFGLOBALVAR XCL::ED-LAST-INFO NIL "used in ED to stash last call info so (ED NIL) will restart last edit") -(CL:DEFUN ED (CL::NAME CL::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.") - +(CL:DEFUN ED (CL::NAME &OPTIONAL (CL::OPTIONS NIL)) (* ; "Edited 2-Oct-2025 10:42 by rmk") + (* ; "Edited 30-Sep-2025 12:49 by rmk") + (* ; "Edited 20-Dec-2023 00:06 by rmk") + (* ; "Edited 5-Jul-88 16:03 by woz") + (CL:SETQ CL::OPTIONS (MKLIST CL::OPTIONS)) (CL:UNLESS (CL:LISTP CL::OPTIONS) (CL:SETQ CL::OPTIONS (LIST CL::OPTIONS))) (CL:WHEN (CL:PATHNAMEP CL::NAME) @@ -122,95 +121,128 @@ Copyright (c) 1986-1988, 1990-1991, 2024 by Venue & Xerox Corporation. (CL:PUSHNEW 'FILES CL::OPTIONS)) [COND (CL::NAME (CL:SETQ XCL::ED-LAST-INFO (CONS CL::NAME CL::OPTIONS))) - (T (CL:WHEN (NULL XCL::ED-LAST-INFO) + (T (CL:UNLESS XCL::ED-LAST-INFO (CL:FORMAT T "Sorry, there is no previous edit to restart.") (CL:RETURN-FROM ED NIL)) (CL:SETQ CL::NAME (CAR XCL::ED-LAST-INFO)) (CL:SETQ CL::OPTIONS (CL:APPEND (CDR XCL::ED-LAST-INFO) CL::OPTIONS] - (LET* ((CL::FROM-DISPLAY (OR (EQ CL::OPTIONS T) - (CL:MEMBER :DISPLAY CL::OPTIONS) - (CL:MEMBER 'DISPLAY CL::OPTIONS))) - (CL::GIVEN-TYPES (for X inside CL::OPTIONS when (NEQ X T) bind TYPE - when (CL:SETQ TYPE (GETFILEPKGTYPE X 'TYPES T CL::NAME)) collect TYPE)) - [CL::TYPES-WITH-DEFNS (TYPESOF CL::NAME CL::GIVEN-TYPES NIL - (CL:IF (OR (CL:MEMBER :CURRENT CL::OPTIONS) - (CL:MEMBER 'CURRENT CL::OPTIONS)) - 'CURRENT - '?) - #'(LAMBDA (X) - (NEQ (GET X 'EDITDEF) - 'NILL] - (CL::POSSIBLE-TYPES (COND - ([AND (NULL CL::GIVEN-TYPES) - (CL:SYMBOLP CL::NAME) - (NOT (NULL *ED-OFFERS-PROPERTY-LIST*)) - (find X on (GETPROPLIST CL::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 CL::TYPES-WITH-DEFNS)) - (T CL::TYPES-WITH-DEFNS))) - (TYPE)) - (CL:WHEN (CL:MEMBER 'PROPERTY-LIST CL::OPTIONS) - - (* ;; - "this will allow PROPERTY-LIST to be specified as a fake filepkg type by the user (caller)") - - (CL:SETQ CL::POSSIBLE-TYPES '(PROPERTY-LIST))) - [CL:SETQ TYPE (if (CL:MEMBER :NEW CL::OPTIONS) - then - (* ;; "if :NEW then install a blank definition first") - - (OR (INSTALL-PROTOTYPE-DEFN CL::NAME (OR CL::TYPES-WITH-DEFNS - CL::GIVEN-TYPES) - :NEW) - (CL:RETURN-FROM ED NIL)) - elseif (CDR CL::POSSIBLE-TYPES) - then - (* ;; "Many types were found/given. Ask the user which to use.") - - (if CL::FROM-DISPLAY - then (OR (MENU (create MENU - ITEMS _ CL::POSSIBLE-TYPES - TITLE _ (CL:FORMAT NIL - "Edit which definition of ~S ?" - CL::NAME))) - (CL:RETURN-FROM ED NIL)) - else (ASKUSER NIL (CAR CL::POSSIBLE-TYPES) - (CL:FORMAT NIL "Edit which ~A definition of ~S ? " - CL::POSSIBLE-TYPES CL::NAME) - CL::POSSIBLE-TYPES)) - elseif (NOT (NULL CL::POSSIBLE-TYPES)) - then - (* ;; "Exactly one type was found.") - - (if CL::FROM-DISPLAY - then (* ; "prepare the prompt window") - (TERPRI PROMPTWINDOW)) - (CL:FORMAT (if CL::FROM-DISPLAY - then PROMPTWINDOW - else T) - "Editing ~A ~A ~S.~%%" - (CAR CL::POSSIBLE-TYPES) - (CL:IF (EQ (CAR CL::POSSIBLE-TYPES) - 'PROPERTY-LIST) - "of" - "definition of") - CL::NAME) - (CAR CL::POSSIBLE-TYPES) - else - (* ;; "No types were found. Use the DefDefiner prototyping machinery.") - - (OR (INSTALL-PROTOTYPE-DEFN CL::NAME CL::GIVEN-TYPES) - (CL:RETURN-FROM ED NIL] - (CL:IF (EQ TYPE 'PROPERTY-LIST) - (EDITE (GETPROPLIST CL::NAME) - NIL CL::NAME 'PROPLST NIL CL::OPTIONS) - (EDITDEF CL::NAME TYPE NIL NIL CL::OPTIONS)) - (CL:RETURN-FROM ED CL::NAME))) + (LET* + ((CL::FROM-DISPLAY (OR (EQ CL::OPTIONS T) + (CL:MEMBER :DISPLAY CL::OPTIONS) + (CL:MEMBER 'DISPLAY CL::OPTIONS))) + (CL::GIVEN-TYPES (for CL::X TYPE inside CL::OPTIONS unless (EQ CL::X T) + when (CL:SETQ TYPE (GETFILEPKGTYPE CL::X 'TYPES T CL::NAME)) collect TYPE)) + [CL::TYPES-WITH-DEFNS (TYPESOF CL::NAME CL::GIVEN-TYPES NIL (CL:IF (OR (CL:MEMBER :CURRENT + CL::OPTIONS) + (CL:MEMBER 'CURRENT + CL::OPTIONS)) + 'CURRENT + '?) + #'(LAMBDA (X) + (NEQ (GET X 'EDITDEF) + 'NILL] + (CL::POSSIBLE-TYPES (COND + ([AND (NULL CL::GIVEN-TYPES) + (CL:SYMBOLP CL::NAME) + *ED-OFFERS-PROPERTY-LIST* + (find CL::X on (GETPROPLIST CL::NAME) by (CDDR CL::X) + suchthat (NULL (GET (CAR CL::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 CL::TYPES-WITH-DEFNS)) + (T CL::TYPES-WITH-DEFNS))) + (TYPE)) + (CL:WHEN (CL:MEMBER 'PROPERTY-LIST CL::OPTIONS) + + (* ;; + "this will allow PROPERTY-LIST to be specified as a fake filepkg type by the user (caller)") + + (CL:SETQ CL::POSSIBLE-TYPES '(PROPERTY-LIST))) + [CL:UNLESS + (CL:SETQ + TYPE + (if (CL:MEMBER :NEW CL::OPTIONS) + then + (* ;; "if :NEW then install a blank definition first") + + (OR (INSTALL-PROTOTYPE-DEFN CL::NAME (OR CL::TYPES-WITH-DEFNS CL::GIVEN-TYPES) + :NEW) + (CL:RETURN-FROM ED NIL)) + elseif (CDR CL::POSSIBLE-TYPES) + then + (* ;; "Many types were found/given. Ask the user which to use.") + + (if CL::FROM-DISPLAY + then (OR (MENU (create MENU + ITEMS _ CL::POSSIBLE-TYPES + TITLE _ (CL:FORMAT NIL "Edit which definition of ~S ?" + CL::NAME))) + (CL:RETURN-FROM ED NIL)) + else (ASKUSER NIL (CAR CL::POSSIBLE-TYPES) + (CL:FORMAT NIL "Edit which ~A definition of ~S ? " CL::POSSIBLE-TYPES + CL::NAME) + CL::POSSIBLE-TYPES)) + elseif CL::POSSIBLE-TYPES + then + (* ;; "Exactly one type was found.") + + (CL:WHEN CL::FROM-DISPLAY (* ; "prepare the prompt window") + (TERPRI PROMPTWINDOW)) + (CL:FORMAT (CL:IF CL::FROM-DISPLAY + PROMPTWINDOW + T) + "Editing ~A ~A ~S.~%%" + (CAR CL::POSSIBLE-TYPES) + (CL:IF (EQ (CAR CL::POSSIBLE-TYPES) + 'PROPERTY-LIST) + "of" + "definition of") + CL::NAME) + (CAR CL::POSSIBLE-TYPES) + elseif + [for CL::N CHOICE CL::NTYPES in (CL:FIND-ALL-SYMBOLS CL::NAME) + when (CL:SETQ CL::NTYPES (TYPESOF CL::N CL::GIVEN-TYPES)) collect (CONS CL::N CL::NTYPES) + finally + (if (CDR $$VAL) + then (* ; + "More than one name, each with at least one type") + [SETQ CHOICE + (MENU (create MENU + TITLE _ (CONCAT " Edit which definition? ") + ITEMS _ (for I in $$VAL + join (for TY in (CDR I) + collect (LIST (CONCAT (MKSTRING (CAR I) + T) + " " TY) + (LIST I TY] + (SETQ CL::NAME (CAR CHOICE)) + (RETURN (CADR CHOICE)) + elseif (CDDAR $$VAL) + then (* ; "One name with multiple types. ") + [SETQ CHOICE (MENU (create MENU + TITLE _ (CONCAT "Which definition of " + (MKSTRING (CAAR $$VAL) + T) + " ?") + ITEMS _ (for TY in (CDAR $$VAL) collect TY] + (CL:SETQ CL::NAME (CAAR $$VAL)) + (RETURN CHOICE) + elseif $$VAL + then (CL:SETQ CL::NAME (CAAR $$VAL)) + (RETURN (CADAR $$VAL] + else + (* ;; "No types were found. Use the DefDefiner prototyping machinery.") + + (OR (INSTALL-PROTOTYPE-DEFN CL::NAME CL::GIVEN-TYPES) + (CL:RETURN-FROM ED NIL] + (CL:IF (EQ TYPE 'PROPERTY-LIST) + (EDITE (GETPROPLIST CL::NAME) + NIL CL::NAME 'PROPLST NIL CL::OPTIONS) + (EDITDEF CL::NAME TYPE NIL NIL CL::OPTIONS)) + (CL:RETURN-FROM ED CL::NAME))) (CL:DEFUN INSTALL-PROTOTYPE-DEFN (NAME &REST ARGS) @@ -284,21 +316,22 @@ Copyright (c) 1986-1988, 1990-1991, 2024 by Venue & Xerox Corporation. (DEFINEQ (EDITDEF.FNS - [LAMBDA (NAME EDITCOMS OPTIONS) (* ; "Edited 20-Nov-87 14:25 by woz") - + [LAMBDA (NAME EDITCOMS OPTIONS) (* ; "Edited 26-Sep-2025 15:23 by rmk") + (* ; "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) + 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.") + "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)) @@ -308,7 +341,7 @@ Copyright (c) 1986-1988, 1990-1991, 2024 by Venue & Xerox Corporation. (* ;; "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.") (CL:FORMAT *ERROR-OUTPUT* "Could not find fns definition for ~a." NAME) - (ERROR "Could not find fns definition for " NAME T]) + (RETURN]) (EDITF [NLAMBDA EDITFX (* ; "Edited 11-Jun-90 15:44 by jds") @@ -952,13 +985,12 @@ Copyright (c) 1986-1988, 1990-1991, 2024 by Venue & Xerox Corporation. (ADDTOVAR LAMA ) ) -(PUTPROPS EDITINTERFACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 2024)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4081 10380 (ED 4081 . 10380)) (10382 14358 (INSTALL-PROTOTYPE-DEFN 10382 . 14358)) ( -14359 31218 (EDITDEF.FNS 14369 . 15705) (EDITF 15707 . 16587) (EDITFB 16589 . 17437) (EDITFNS 17439 . -18759) (EDITLOADFNS? 18761 . 22637) (EDITMODE 22639 . 24649) (EDITP 24651 . 25162) (EDITV 25164 . -25803) (DC 25805 . 26486) (DF 26488 . 27530) (DP 27532 . 28616) (DV 28618 . 29190) (EDITPROP 29192 . -29411) (EF 29413 . 29742) (EP 29744 . 29927) (EV 29929 . 30108) (EDITE 30110 . 30988) (EDITL 30990 . -31216)) (31568 46885 (NEW/EDITDATE 31578 . 31800) (FIXEDITDATE 31802 . 40409) (EDITDATE? 40411 . 43439 -) (EDITDATE 43441 . 44888) (SETINITIALS 44890 . 46883))))) + (FILEMAP (NIL (4073 11670 (ED 4073 . 11670)) (11672 15648 (INSTALL-PROTOTYPE-DEFN 11672 . 15648)) ( +15649 32572 (EDITDEF.FNS 15659 . 17059) (EDITF 17061 . 17941) (EDITFB 17943 . 18791) (EDITFNS 18793 . +20113) (EDITLOADFNS? 20115 . 23991) (EDITMODE 23993 . 26003) (EDITP 26005 . 26516) (EDITV 26518 . +27157) (DC 27159 . 27840) (DF 27842 . 28884) (DP 28886 . 29970) (DV 29972 . 30544) (EDITPROP 30546 . +30765) (EF 30767 . 31096) (EP 31098 . 31281) (EV 31283 . 31462) (EDITE 31464 . 32342) (EDITL 32344 . +32570)) (32922 48239 (NEW/EDITDATE 32932 . 33154) (FIXEDITDATE 33156 . 41763) (EDITDATE? 41765 . 44793 +) (EDITDATE 44795 . 46242) (SETINITIALS 46244 . 48237))))) STOP diff --git a/sources/EDITINTERFACE.DFASL b/sources/EDITINTERFACE.DFASL new file mode 100644 index 000000000..796736036 Binary files /dev/null and b/sources/EDITINTERFACE.DFASL differ diff --git a/sources/EDITINTERFACE.LCOM b/sources/EDITINTERFACE.LCOM deleted file mode 100644 index bf5ab7925..000000000 Binary files a/sources/EDITINTERFACE.LCOM and /dev/null differ