Skip to content

Commit f6106d7

Browse files
rmkaplanrmkaplan
authored
EDITINTERFACE--ED searches for symbols, no error when declining a loadfns (#2301)
* EDITINTERFACE--ED searches for symbols, no error when declining a loadfns * Symbol by type menu pops up when the symbol with different package qualifiers have different types
1 parent 43b11b2 commit f6106d7

File tree

3 files changed

+143
-111
lines changed

3 files changed

+143
-111
lines changed

‎sources/EDITINTERFACE‎

Lines changed: 143 additions & 111 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,16 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
22

3-
(FILECREATED "21-May-2024 22:10:45" {DSK}<home>matt>Interlisp>medley>sources>EDITINTERFACE.;2 47745
3+
(FILECREATED " 2-Oct-2025 10:43:08" 
4+
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>EDITINTERFACE.;57 49004
45

5-
:EDIT-BY "mth"
6+
:EDIT-BY rmk
67

7-
:CHANGES-TO (FNS EDITLOADFNS?)
8-
9-
:PREVIOUS-DATE "22-Jun-2022 13:32:08" {DSK}<home>matt>Interlisp>medley>sources>EDITINTERFACE.;1
10-
)
8+
:CHANGES-TO (VARS EDITINTERFACECOMS)
9+
(FUNCTIONS ED)
1110

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

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

1715
(PRETTYCOMPRINT EDITINTERFACECOMS)
1816

@@ -110,10 +108,11 @@ Copyright (c) 1986-1988, 1990-1991, 2024 by Venue & Xerox Corporation.
110108
(DEFGLOBALVAR XCL::ED-LAST-INFO NIL
111109
"used in ED to stash last call info so (ED NIL) will restart last edit")
112110

113-
(CL:DEFUN ED (CL::NAME CL::OPTIONS) (* ; "Edited 5-Jul-88 16:03 by woz")
114-
115-
(* ;;; "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.")
116-
111+
(CL:DEFUN ED (CL::NAME &OPTIONAL (CL::OPTIONS NIL)) (* ; "Edited 2-Oct-2025 10:42 by rmk")
112+
(* ; "Edited 30-Sep-2025 12:49 by rmk")
113+
(* ; "Edited 20-Dec-2023 00:06 by rmk")
114+
(* ; "Edited 5-Jul-88 16:03 by woz")
115+
(CL:SETQ CL::OPTIONS (MKLIST CL::OPTIONS))
117116
(CL:UNLESS (CL:LISTP CL::OPTIONS)
118117
(CL:SETQ CL::OPTIONS (LIST CL::OPTIONS)))
119118
(CL:WHEN (CL:PATHNAMEP CL::NAME)
@@ -122,95 +121,128 @@ Copyright (c) 1986-1988, 1990-1991, 2024 by Venue & Xerox Corporation.
122121
(CL:PUSHNEW 'FILES CL::OPTIONS))
123122
[COND
124123
(CL::NAME (CL:SETQ XCL::ED-LAST-INFO (CONS CL::NAME CL::OPTIONS)))
125-
(T (CL:WHEN (NULL XCL::ED-LAST-INFO)
124+
(T (CL:UNLESS XCL::ED-LAST-INFO
126125
(CL:FORMAT T "Sorry, there is no previous edit to restart.")
127126
(CL:RETURN-FROM ED NIL))
128127
(CL:SETQ CL::NAME (CAR XCL::ED-LAST-INFO))
129128
(CL:SETQ CL::OPTIONS (CL:APPEND (CDR XCL::ED-LAST-INFO)
130129
CL::OPTIONS]
131-
(LET* ((CL::FROM-DISPLAY (OR (EQ CL::OPTIONS T)
132-
(CL:MEMBER :DISPLAY CL::OPTIONS)
133-
(CL:MEMBER 'DISPLAY CL::OPTIONS)))
134-
(CL::GIVEN-TYPES (for X inside CL::OPTIONS when (NEQ X T) bind TYPE
135-
when (CL:SETQ TYPE (GETFILEPKGTYPE X 'TYPES T CL::NAME)) collect TYPE))
136-
[CL::TYPES-WITH-DEFNS (TYPESOF CL::NAME CL::GIVEN-TYPES NIL
137-
(CL:IF (OR (CL:MEMBER :CURRENT CL::OPTIONS)
138-
(CL:MEMBER 'CURRENT CL::OPTIONS))
139-
'CURRENT
140-
'?)
141-
#'(LAMBDA (X)
142-
(NEQ (GET X 'EDITDEF)
143-
'NILL]
144-
(CL::POSSIBLE-TYPES (COND
145-
([AND (NULL CL::GIVEN-TYPES)
146-
(CL:SYMBOLP CL::NAME)
147-
(NOT (NULL *ED-OFFERS-PROPERTY-LIST*))
148-
(find X on (GETPROPLIST CL::NAME) by (CDDR X)
149-
suchthat (NULL (GET (CAR X)
150-
'PROPTYPE]
151-
152-
(* ;; "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.")
153-
154-
(CONS 'PROPERTY-LIST CL::TYPES-WITH-DEFNS))
155-
(T CL::TYPES-WITH-DEFNS)))
156-
(TYPE))
157-
(CL:WHEN (CL:MEMBER 'PROPERTY-LIST CL::OPTIONS)
158-
159-
(* ;;
160-
 "this will allow PROPERTY-LIST to be specified as a fake filepkg type by the user (caller)")
161-
162-
(CL:SETQ CL::POSSIBLE-TYPES '(PROPERTY-LIST)))
163-
[CL:SETQ TYPE (if (CL:MEMBER :NEW CL::OPTIONS)
164-
then
165-
(* ;; "if :NEW then install a blank definition first")
166-
167-
(OR (INSTALL-PROTOTYPE-DEFN CL::NAME (OR CL::TYPES-WITH-DEFNS
168-
CL::GIVEN-TYPES)
169-
:NEW)
170-
(CL:RETURN-FROM ED NIL))
171-
elseif (CDR CL::POSSIBLE-TYPES)
172-
then
173-
(* ;; "Many types were found/given. Ask the user which to use.")
174-
175-
(if CL::FROM-DISPLAY
176-
then (OR (MENU (create MENU
177-
ITEMS _ CL::POSSIBLE-TYPES
178-
TITLE _ (CL:FORMAT NIL
179-
"Edit which definition of ~S ?"
180-
CL::NAME)))
181-
(CL:RETURN-FROM ED NIL))
182-
else (ASKUSER NIL (CAR CL::POSSIBLE-TYPES)
183-
(CL:FORMAT NIL "Edit which ~A definition of ~S ? "
184-
CL::POSSIBLE-TYPES CL::NAME)
185-
CL::POSSIBLE-TYPES))
186-
elseif (NOT (NULL CL::POSSIBLE-TYPES))
187-
then
188-
(* ;; "Exactly one type was found.")
189-
190-
(if CL::FROM-DISPLAY
191-
then (* ; "prepare the prompt window")
192-
(TERPRI PROMPTWINDOW))
193-
(CL:FORMAT (if CL::FROM-DISPLAY
194-
then PROMPTWINDOW
195-
else T)
196-
"Editing ~A ~A ~S.~%%"
197-
(CAR CL::POSSIBLE-TYPES)
198-
(CL:IF (EQ (CAR CL::POSSIBLE-TYPES)
199-
'PROPERTY-LIST)
200-
"of"
201-
"definition of")
202-
CL::NAME)
203-
(CAR CL::POSSIBLE-TYPES)
204-
else
205-
(* ;; "No types were found. Use the DefDefiner prototyping machinery.")
206-
207-
(OR (INSTALL-PROTOTYPE-DEFN CL::NAME CL::GIVEN-TYPES)
208-
(CL:RETURN-FROM ED NIL]
209-
(CL:IF (EQ TYPE 'PROPERTY-LIST)
210-
(EDITE (GETPROPLIST CL::NAME)
211-
NIL CL::NAME 'PROPLST NIL CL::OPTIONS)
212-
(EDITDEF CL::NAME TYPE NIL NIL CL::OPTIONS))
213-
(CL:RETURN-FROM ED CL::NAME)))
130+
(LET*
131+
((CL::FROM-DISPLAY (OR (EQ CL::OPTIONS T)
132+
(CL:MEMBER :DISPLAY CL::OPTIONS)
133+
(CL:MEMBER 'DISPLAY CL::OPTIONS)))
134+
(CL::GIVEN-TYPES (for CL::X TYPE inside CL::OPTIONS unless (EQ CL::X T)
135+
when (CL:SETQ TYPE (GETFILEPKGTYPE CL::X 'TYPES T CL::NAME)) collect TYPE))
136+
[CL::TYPES-WITH-DEFNS (TYPESOF CL::NAME CL::GIVEN-TYPES NIL (CL:IF (OR (CL:MEMBER :CURRENT
137+
CL::OPTIONS)
138+
(CL:MEMBER 'CURRENT
139+
CL::OPTIONS))
140+
'CURRENT
141+
'?)
142+
#'(LAMBDA (X)
143+
(NEQ (GET X 'EDITDEF)
144+
'NILL]
145+
(CL::POSSIBLE-TYPES (COND
146+
([AND (NULL CL::GIVEN-TYPES)
147+
(CL:SYMBOLP CL::NAME)
148+
*ED-OFFERS-PROPERTY-LIST*
149+
(find CL::X on (GETPROPLIST CL::NAME) by (CDDR CL::X)
150+
suchthat (NULL (GET (CAR CL::X)
151+
'PROPTYPE]
152+
153+
(* ;; "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.")
154+
155+
(CONS 'PROPERTY-LIST CL::TYPES-WITH-DEFNS))
156+
(T CL::TYPES-WITH-DEFNS)))
157+
(TYPE))
158+
(CL:WHEN (CL:MEMBER 'PROPERTY-LIST CL::OPTIONS)
159+
160+
(* ;;
161+
 "this will allow PROPERTY-LIST to be specified as a fake filepkg type by the user (caller)")
162+
163+
(CL:SETQ CL::POSSIBLE-TYPES '(PROPERTY-LIST)))
164+
[CL:UNLESS
165+
(CL:SETQ
166+
TYPE
167+
(if (CL:MEMBER :NEW CL::OPTIONS)
168+
then
169+
(* ;; "if :NEW then install a blank definition first")
170+
171+
(OR (INSTALL-PROTOTYPE-DEFN CL::NAME (OR CL::TYPES-WITH-DEFNS CL::GIVEN-TYPES)
172+
:NEW)
173+
(CL:RETURN-FROM ED NIL))
174+
elseif (CDR CL::POSSIBLE-TYPES)
175+
then
176+
(* ;; "Many types were found/given. Ask the user which to use.")
177+
178+
(if CL::FROM-DISPLAY
179+
then (OR (MENU (create MENU
180+
ITEMS _ CL::POSSIBLE-TYPES
181+
TITLE _ (CL:FORMAT NIL "Edit which definition of ~S ?"
182+
CL::NAME)))
183+
(CL:RETURN-FROM ED NIL))
184+
else (ASKUSER NIL (CAR CL::POSSIBLE-TYPES)
185+
(CL:FORMAT NIL "Edit which ~A definition of ~S ? " CL::POSSIBLE-TYPES
186+
CL::NAME)
187+
CL::POSSIBLE-TYPES))
188+
elseif CL::POSSIBLE-TYPES
189+
then
190+
(* ;; "Exactly one type was found.")
191+
192+
(CL:WHEN CL::FROM-DISPLAY (* ; "prepare the prompt window")
193+
(TERPRI PROMPTWINDOW))
194+
(CL:FORMAT (CL:IF CL::FROM-DISPLAY
195+
PROMPTWINDOW
196+
T)
197+
"Editing ~A ~A ~S.~%%"
198+
(CAR CL::POSSIBLE-TYPES)
199+
(CL:IF (EQ (CAR CL::POSSIBLE-TYPES)
200+
'PROPERTY-LIST)
201+
"of"
202+
"definition of")
203+
CL::NAME)
204+
(CAR CL::POSSIBLE-TYPES)
205+
elseif
206+
[for CL::N CHOICE CL::NTYPES in (CL:FIND-ALL-SYMBOLS CL::NAME)
207+
when (CL:SETQ CL::NTYPES (TYPESOF CL::N CL::GIVEN-TYPES)) collect (CONS CL::N CL::NTYPES)
208+
finally
209+
(if (CDR $$VAL)
210+
then (* ;
211+
 "More than one name, each with at least one type")
212+
[SETQ CHOICE
213+
(MENU (create MENU
214+
TITLE _ (CONCAT " Edit which definition? ")
215+
ITEMS _ (for I in $$VAL
216+
join (for TY in (CDR I)
217+
collect (LIST (CONCAT (MKSTRING (CAR I)
218+
T)
219+
" " TY)
220+
(LIST I TY]
221+
(SETQ CL::NAME (CAR CHOICE))
222+
(RETURN (CADR CHOICE))
223+
elseif (CDDAR $$VAL)
224+
then (* ; "One name with multiple types. ")
225+
[SETQ CHOICE (MENU (create MENU
226+
TITLE _ (CONCAT "Which definition of "
227+
(MKSTRING (CAAR $$VAL)
228+
T)
229+
" ?")
230+
ITEMS _ (for TY in (CDAR $$VAL) collect TY]
231+
(CL:SETQ CL::NAME (CAAR $$VAL))
232+
(RETURN CHOICE)
233+
elseif $$VAL
234+
then (CL:SETQ CL::NAME (CAAR $$VAL))
235+
(RETURN (CADAR $$VAL]
236+
else
237+
(* ;; "No types were found. Use the DefDefiner prototyping machinery.")
238+
239+
(OR (INSTALL-PROTOTYPE-DEFN CL::NAME CL::GIVEN-TYPES)
240+
(CL:RETURN-FROM ED NIL]
241+
(CL:IF (EQ TYPE 'PROPERTY-LIST)
242+
(EDITE (GETPROPLIST CL::NAME)
243+
NIL CL::NAME 'PROPLST NIL CL::OPTIONS)
244+
(EDITDEF CL::NAME TYPE NIL NIL CL::OPTIONS))
245+
(CL:RETURN-FROM ED CL::NAME)))
214246

215247
(CL:DEFUN INSTALL-PROTOTYPE-DEFN (NAME &REST ARGS)
216248

@@ -284,21 +316,22 @@ Copyright (c) 1986-1988, 1990-1991, 2024 by Venue & Xerox Corporation.
284316
(DEFINEQ
285317

286318
(EDITDEF.FNS
287-
[LAMBDA (NAME EDITCOMS OPTIONS) (* ; "Edited 20-Nov-87 14:25 by woz")
288-
319+
[LAMBDA (NAME EDITCOMS OPTIONS) (* ; "Edited 26-Sep-2025 15:23 by rmk")
320+
(* ; "Edited 20-Nov-87 14:25 by woz")
289321
(PROG (DEF)
290322
LP (COND
291323
((EXPRP (SETQ DEF (OR (GET NAME 'ADVISED)
292324
(GET NAME 'BROKEN)
293325
NAME)))
294326
(EDITE (if (LITATOM DEF)
295-
then (GETD DEF)
296-
else DEF)
327+
then (GETD DEF)
328+
else DEF)
297329
EDITCOMS NAME 'FNS NIL OPTIONS)
298330
(RETURN NAME))
299331
([EXPRP (SETQ DEF (GETPROP NAME 'EXPR]
332+
300333
(* ;;
301-
"woz: don't use edit type PROP anymore. Let putdef for fns worry about where the definition goes.")
334+
 "woz: don't use edit type PROP anymore. Let putdef for fns worry about where the definition goes.")
302335

303336
(EDITE DEF EDITCOMS NAME 'FNS NIL OPTIONS)
304337
(RETURN NAME))
@@ -308,7 +341,7 @@ Copyright (c) 1986-1988, 1990-1991, 2024 by Venue & Xerox Corporation.
308341
(* ;; "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.")
309342

310343
(CL:FORMAT *ERROR-OUTPUT* "Could not find fns definition for ~a." NAME)
311-
(ERROR "Could not find fns definition for " NAME T])
344+
(RETURN])
312345

313346
(EDITF
314347
[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.
952985

953986
(ADDTOVAR LAMA )
954987
)
955-
(PUTPROPS EDITINTERFACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 2024))
956988
(DECLARE%: DONTCOPY
957-
(FILEMAP (NIL (4081 10380 (ED 4081 . 10380)) (10382 14358 (INSTALL-PROTOTYPE-DEFN 10382 . 14358)) (
958-
14359 31218 (EDITDEF.FNS 14369 . 15705) (EDITF 15707 . 16587) (EDITFB 16589 . 17437) (EDITFNS 17439 .
959-
18759) (EDITLOADFNS? 18761 . 22637) (EDITMODE 22639 . 24649) (EDITP 24651 . 25162) (EDITV 25164 .
960-
25803) (DC 25805 . 26486) (DF 26488 . 27530) (DP 27532 . 28616) (DV 28618 . 29190) (EDITPROP 29192 .
961-
29411) (EF 29413 . 29742) (EP 29744 . 29927) (EV 29929 . 30108) (EDITE 30110 . 30988) (EDITL 30990 .
962-
31216)) (31568 46885 (NEW/EDITDATE 31578 . 31800) (FIXEDITDATE 31802 . 40409) (EDITDATE? 40411 . 43439
963-
) (EDITDATE 43441 . 44888) (SETINITIALS 44890 . 46883)))))
989+
(FILEMAP (NIL (4073 11670 (ED 4073 . 11670)) (11672 15648 (INSTALL-PROTOTYPE-DEFN 11672 . 15648)) (
990+
15649 32572 (EDITDEF.FNS 15659 . 17059) (EDITF 17061 . 17941) (EDITFB 17943 . 18791) (EDITFNS 18793 .
991+
20113) (EDITLOADFNS? 20115 . 23991) (EDITMODE 23993 . 26003) (EDITP 26005 . 26516) (EDITV 26518 .
992+
27157) (DC 27159 . 27840) (DF 27842 . 28884) (DP 28886 . 29970) (DV 29972 . 30544) (EDITPROP 30546 .
993+
30765) (EF 30767 . 31096) (EP 31098 . 31281) (EV 31283 . 31462) (EDITE 31464 . 32342) (EDITL 32344 .
994+
32570)) (32922 48239 (NEW/EDITDATE 32932 . 33154) (FIXEDITDATE 33156 . 41763) (EDITDATE? 41765 . 44793
995+
) (EDITDATE 44795 . 46242) (SETINITIALS 46244 . 48237)))))
964996
STOP

‎sources/EDITINTERFACE.DFASL‎

16.7 KB
Binary file not shown.

‎sources/EDITINTERFACE.LCOM‎

-16.3 KB
Binary file not shown.

0 commit comments

Comments
 (0)