Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
254 changes: 143 additions & 111 deletions sources/EDITINTERFACE
Original file line number Diff line number Diff line change
@@ -1,18 +1,16 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "21-May-2024 22:10:45" {DSK}<home>matt>Interlisp>medley>sources>EDITINTERFACE.;2 47745
(FILECREATED " 2-Oct-2025 10:43:08" 
{DSK}<Users>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}<home>matt>Interlisp>medley>sources>EDITINTERFACE.;1
)
:CHANGES-TO (VARS EDITINTERFACECOMS)
(FUNCTIONS ED)

:PREVIOUS-DATE " 1-Oct-2025 23:20:37"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>EDITINTERFACE.;56)

(* ; "
Copyright (c) 1986-1988, 1990-1991, 2024 by Venue & Xerox Corporation.
")

(PRETTYCOMPRINT EDITINTERFACECOMS)

Expand Down Expand Up @@ -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)
Expand All @@ -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)

Expand Down Expand Up @@ -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))
Expand All @@ -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")
Expand Down Expand Up @@ -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
Binary file added sources/EDITINTERFACE.DFASL
Binary file not shown.
Binary file removed sources/EDITINTERFACE.LCOM
Binary file not shown.