github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-12 00:42:56 +00:00
Code Issues Projects Releases Wiki Activity

Fixed issue 1883

Browse Source 
Fixed issue 1883, error in printing class from CLOS browser
This commit is contained in:
Arun Welch 2025-06-10 18:50:06 -05:00
parent 38f417907a
commit 60195c4f31
2 changed files with 40 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
clos/NEW-CLOS-BROWSER
View File

@ -1,18 +1,18 @@
(DEFINE-FILE-INFO PACKAGE (PROGN (DEFPACKAGE "CLOS-BROWSER" (USE "CLOS") (EXPORT "CLOS-ICON" (DEFINE-FILE-INFO PACKAGE (PROGN (DEFPACKAGE "CLOS-BROWSER" (USE "CLOS" "LISP") (EXPORT "CLOS-ICON"
"CLOS-BROWSER" "ADD-BROWSER-METHOD" "BROWSE-CLASS")) (CLFIND-PACKAGE "USER")) READTABLE "XCL" BASE "CLOS-BROWSER" "ADD-BROWSER-METHOD" "BROWSE-CLASS")) (CLFIND-PACKAGE "USER")) READTABLE "XCL" BASE
10) 10)
(IL:FILECREATED " 5-Dec-2023 12:07:41" IL:{CLOS}NEW-CLOS-BROWSER.\;3 91622 (IL:FILECREATED "28-Apr-2025 18:32:38" 
IL:|{DSK}<Users>arunwelch>DOCUMENTS>MEDLEY-WORKSPACE>RELEASE>NEW-CLOS-BROWSER.;4| 91934
:EDIT-BY "mth" :EDIT-BY "akw"
:CHANGES-TO (IL:PROPS (IL:NEW-CLOS-BROWSER IL:MAKEFILE-ENVIRONMENT)) :CHANGES-TO (IL:PROPS (IL:NEW-CLOS-BROWSER IL:MAKEFILE-ENVIRONMENT))
:PREVIOUS-DATE " 5-Dec-2023 00:58:05" IL:{CLOS}NEW-CLOS-BROWSER.\;2) :PREVIOUS-DATE "26-Apr-2025 17:16:46"
IL:|{DSK}<Users>arunwelch>DOCUMENTS>MEDLEY-WORKSPACE>RELEASE>NEW-CLOS-BROWSER.;3|)
; Copyright (c) 1991, 2020, 2023 by Venue.
(IL:PRETTYCOMPRINT IL:NEW-CLOS-BROWSERCOMS) (IL:PRETTYCOMPRINT IL:NEW-CLOS-BROWSERCOMS)
(IL:RPAQQ IL:NEW-CLOS-BROWSERCOMS (IL:RPAQQ IL:NEW-CLOS-BROWSERCOMS
@ -275,7 +275,7 @@
(IL:PUTPROPS IL:NEW-CLOS-BROWSER IL:MAKEFILE-ENVIRONMENT (:PACKAGE (PROGN (XCL:DEFPACKAGE (IL:PUTPROPS IL:NEW-CLOS-BROWSER IL:MAKEFILE-ENVIRONMENT (:PACKAGE (PROGN (XCL:DEFPACKAGE
"CLOS-BROWSER" "CLOS-BROWSER"
(:USE "CLOS") (:USE "CLOS" "LISP")
(:EXPORT "CLOS-ICON" (:EXPORT "CLOS-ICON"
"CLOS-BROWSER" "CLOS-BROWSER"
"ADD-BROWSER-METHOD" "ADD-BROWSER-METHOD"
@ -1159,9 +1159,14 @@ Below this line operates on individual slots and methods."
(DOCUMENTATION (SLOT-VALUE CLOS-BROWSER::SELF 'CLOS-BROWSER::CLASS))) (DOCUMENTATION (SLOT-VALUE CLOS-BROWSER::SELF 'CLOS-BROWSER::CLASS)))
(DEFMETHOD CLOS-BROWSER::PRINT-CLASS ((CLOS-BROWSER::SELF CLOS-BROWSER::CLOS-BROWSER-NODE)) (DEFMETHOD CLOS-BROWSER::PRINT-CLASS ((CLOS-BROWSER::SELF CLOS-BROWSER::CLOS-BROWSER-NODE))
(IF (IL:HASDEF (SLOT-VALUE (SLOT-VALUE CLOS-BROWSER::SELF 'CLOS-BROWSER::CLASS)
'CLOS::NAME)
'CLOS-BROWSER::CLASSES)
(PPRINT (IL:GETDEF (SLOT-VALUE (SLOT-VALUE CLOS-BROWSER::SELF `CLOS-BROWSER::CLASS) (PPRINT (IL:GETDEF (SLOT-VALUE (SLOT-VALUE CLOS-BROWSER::SELF `CLOS-BROWSER::CLASS)
'CLOS::NAME) 'CLOS::NAME)
'CLOS-BROWSER::CLASSES))) 'CLOS-BROWSER::CLASSES))
(IL:PROMPTPRINT "No Printable Definition for the class " (SLOT-VALUE CLOS-BROWSER::SELF
'WEB::NAME))))
(DEFMETHOD CLOS-BROWSER::SPECIALIZE-CLASS ((CLOS-BROWSER::NODE CLOS-BROWSER::CLOS-BROWSER-NODE) (DEFMETHOD CLOS-BROWSER::SPECIALIZE-CLASS ((CLOS-BROWSER::NODE CLOS-BROWSER::CLOS-BROWSER-NODE)
&OPTIONAL CLOS-BROWSER::FORM CLOS-BROWSER::NEW-CLASS-NAME) &OPTIONAL CLOS-BROWSER::FORM CLOS-BROWSER::NEW-CLASS-NAME)
@ -1211,7 +1216,8 @@ Below this line operates on individual slots and methods."
(RETURN)))))) (RETURN))))))
(IL:SETCURSOR CLOS-BROWSER::ORIGINALCURSOR)))))) (IL:SETCURSOR CLOS-BROWSER::ORIGINALCURSOR))))))
(DEFUN CLOS-BROWSER::LYRIC-COMPLETE-SPECIALIZE (IGNORE STRUCTURE) (DEFUN CLOS-BROWSER::LYRIC-COMPLETE-SPECIALIZE (IGNORE STRUCTURE)
(IL:* IL:\; "Edited 26-Apr-2025 14:31 by arunwelch")
(LET ((CLOS-BROWSER::ORIGINALCURSOR (IL:CURSOR))) (LET ((CLOS-BROWSER::ORIGINALCURSOR (IL:CURSOR)))
(UNWIND-PROTECT (UNWIND-PROTECT
(PROGN (IL:SETCURSOR IL:WAITINGCURSOR) (PROGN (IL:SETCURSOR IL:WAITINGCURSOR)
@ -1224,8 +1230,7 @@ Below this line operates on individual slots and methods."
(IL:* IL:|;;| "check for bug") (IL:* IL:|;;| "check for bug")
(WHEN (SYMBOLP CLOS-BROWSER::SUB-CLASS) (WHEN (SYMBOLP CLOS-BROWSER::SUB-CLASS)
(SETQ CLOS-BROWSER::SUB-CLASS (CLOS::SYMBOL-CLASS CLOS-BROWSER::SUB-CLASS (SETQ CLOS-BROWSER::SUB-CLASS (FIND-CLASS CLOS-BROWSER::SUB-CLASS)))
)))
(DOLIST (CLOS-BROWSER::BROWSER (SLOT-VALUE CLOS-BROWSER:CLOS-ICON (DOLIST (CLOS-BROWSER::BROWSER (SLOT-VALUE CLOS-BROWSER:CLOS-ICON
'CLOS-BROWSER::CLASS-BROWSERS)) 'CLOS-BROWSER::CLASS-BROWSERS))
(DOLIST (CLOS-BROWSER::SUPER-CLASS (SLOT-VALUE CLOS-BROWSER::SUB-CLASS (DOLIST (CLOS-BROWSER::SUPER-CLASS (SLOT-VALUE CLOS-BROWSER::SUB-CLASS
@ -1387,12 +1392,10 @@ Below this line operates on individual slots and methods."
(0 (FORMAT T "Unspecialized methods cannot be copied. ~A" (CLOS::FULL-METHOD-NAME (0 (FORMAT T "Unspecialized methods cannot be copied. ~A" (CLOS::FULL-METHOD-NAME
CLOS-BROWSER::METHOD NIL))) CLOS-BROWSER::METHOD NIL)))
(1 (SETQ CLOS-BROWSER::FROM-CLASS (CAR CLOS-BROWSER::NON-T-CLASSES))) (1 (SETQ CLOS-BROWSER::FROM-CLASS (CAR CLOS-BROWSER::NON-T-CLASSES)))
(OTHERWISE (SETQ CLOS-BROWSER::FROM-CLASS (CLOS::SYMBOL-CLASS (OTHERWISE (SETQ CLOS-BROWSER::FROM-CLASS (FIND-CLASS (IL:PROMPTFORWORD
(IL:PROMPTFORWORD (FORMAT NIL (FORMAT NIL
"Which class in ~A do you wish to move from?" "Which class in ~A do you wish to move from?"
( (CLOS::FULL-METHOD-NAME
CLOS::FULL-METHOD-NAME
CLOS-BROWSER::METHOD CLOS-BROWSER::METHOD
NIL)))))))) NIL))))))))
@ -1465,7 +1468,7 @@ Below this line operates on individual slots and methods."
 "fix bug in the inconsistent way CLOS objects store T class specializers and do method lookup.")  "fix bug in the inconsistent way CLOS objects store T class specializers and do method lookup.")
(WHEN (EQ CLOS-BROWSER::CLASS T) (WHEN (EQ CLOS-BROWSER::CLASS T)
(SETQ CLOS-BROWSER::CLASS (CLOS::SYMBOL-CLASS T))) (SETQ CLOS-BROWSER::CLASS (FIND-CLASS T)))
(LET ((CLOS-BROWSER::NODE (CLOS-BROWSER::BROWSER-CONTAINS-P (LET ((CLOS-BROWSER::NODE (CLOS-BROWSER::BROWSER-CONTAINS-P
CLOS-BROWSER::CLASS CLOS-BROWSER::BROWSER))) CLOS-BROWSER::CLASS CLOS-BROWSER::BROWSER)))
(WHEN CLOS-BROWSER::NODE (WHEN CLOS-BROWSER::NODE
@ -1582,7 +1585,8 @@ Below this line operates on individual slots and methods."
(IL:|if| PACKAGE (IL:|if| PACKAGE
IL:|then| (IN-PACKAGE PACKAGE)))) IL:|then| (IN-PACKAGE PACKAGE))))
(DEFUN CLOS-BROWSER::CLASSES-IN-PACKAGE (PACKAGE &OPTIONAL CLOS-BROWSER::MAP-ON-PACKAGE) (DEFUN CLOS-BROWSER::CLASSES-IN-PACKAGE (PACKAGE &OPTIONAL CLOS-BROWSER::MAP-ON-PACKAGE)
(IL:* IL:\; "Edited 26-Apr-2025 14:25 by arunwelch")
"Retrieves a list of all the classes for a given package. When map-on-package is t this can be very slow." "Retrieves a list of all the classes for a given package. When map-on-package is t this can be very slow."
(IL:* IL:|;;| "The maphash is always fast, whereas for some strange reason map-on-package varys among packages greatly.") (IL:* IL:|;;| "The maphash is always fast, whereas for some strange reason map-on-package varys among packages greatly.")
@ -1594,7 +1598,7 @@ Below this line operates on individual slots and methods."
(DO-SYMBOLS (CLOS-BROWSER::SYM PACKAGE) (DO-SYMBOLS (CLOS-BROWSER::SYM PACKAGE)
(IF (AND (EQ (SYMBOL-PACKAGE CLOS-BROWSER::SYM) (IF (AND (EQ (SYMBOL-PACKAGE CLOS-BROWSER::SYM)
PACKAGE) PACKAGE)
(CLOS::SYMBOL-CLASS CLOS-BROWSER::SYM T)) (FIND-CLASS CLOS-BROWSER::SYM T))
(PUSH CLOS-BROWSER::SYM CLOS-BROWSER::CLASSES))) (PUSH CLOS-BROWSER::SYM CLOS-BROWSER::CLASSES)))
(MAPHASH #'(LAMBDA (CLOS-BROWSER::KEY CLOS-BROWSER::VAL) (MAPHASH #'(LAMBDA (CLOS-BROWSER::KEY CLOS-BROWSER::VAL)
(IF (EQ (SYMBOL-PACKAGE CLOS-BROWSER::KEY) (IF (EQ (SYMBOL-PACKAGE CLOS-BROWSER::KEY)
@ -1623,17 +1627,16 @@ Below this line operates on individual slots and methods."
IL:|BackgroundMenuCommands|) IL:|BackgroundMenuCommands|)
(SETQ IL:|BackgroundMenu| NIL) (SETQ IL:|BackgroundMenu| NIL)
(IL:PUTPROPS IL:NEW-CLOS-BROWSER IL:COPYRIGHT ("Venue" 1991 2020 2023))
(IL:DECLARE\: IL:DONTCOPY (IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL (11770 13440 (CLOS-BROWSER:BROWSE-CLASS 11770 . 13440)) (13442 14785 ( (IL:FILEMAP (NIL (11846 13516 (CLOS-BROWSER:BROWSE-CLASS 11846 . 13516)) (13518 14861 (
CLOS-BROWSER::COLLECT-FAMILY 13442 . 14785)) (14787 16819 (CLOS-BROWSER::MAKE-NODES 14787 . 16819)) ( CLOS-BROWSER::COLLECT-FAMILY 13518 . 14861)) (14863 16895 (CLOS-BROWSER::MAKE-NODES 14863 . 16895)) (
16821 17496 (CLOS-BROWSER::CLOS-BROWSER-CLOSE-FN 16821 . 17496)) (17498 18430 (CLOS-BROWSER::BROWSER-CONTAINS-P 16897 17572 (CLOS-BROWSER::CLOS-BROWSER-CLOSE-FN 16897 . 17572)) (17574 18506 (CLOS-BROWSER::BROWSER-CONTAINS-P
17498 . 18430)) (42263 42587 (CLOS-BROWSER::EDIT 42263 . 42587)) (42589 48183 ( 17574 . 18506)) (42339 42663 (CLOS-BROWSER::EDIT 42339 . 42663)) (42665 48259 (
CLOS-BROWSER::MAKE-METHOD-MENU-ITEMS 42589 . 48183)) (48185 49663 (CLOS-BROWSER::MAKE-TOP-LEVEL-METHOD-MENU-ITEMS CLOS-BROWSER::MAKE-METHOD-MENU-ITEMS 42665 . 48259)) (48261 49739 (CLOS-BROWSER::MAKE-TOP-LEVEL-METHOD-MENU-ITEMS
48185 . 49663)) (49665 50955 (CLOS-BROWSER::MAKE-MULTI-METHOD-SUB-MENU 49665 . 50955)) (64981 65598 ( 48261 . 49739)) (49741 51031 (CLOS-BROWSER::MAKE-MULTI-METHOD-SUB-MENU 49741 . 51031)) (65408 66025 (
CLOS-BROWSER::COMPLETE-ADD-METHOD 64981 . 65598)) (65600 67812 (CLOS-BROWSER::COMPLETE-SPECIALIZE CLOS-BROWSER::COMPLETE-ADD-METHOD 65408 . 66025)) (66027 68239 (CLOS-BROWSER::COMPLETE-SPECIALIZE
65600 . 67812)) (67814 69482 (CLOS-BROWSER::LYRIC-COMPLETE-SPECIALIZE 67814 . 69482)) (69484 69649 ( 66027 . 68239)) (68241 69946 (CLOS-BROWSER::LYRIC-COMPLETE-SPECIALIZE 68241 . 69946)) (69948 70113 (
CLOS-BROWSER::THIS-CLASS-NODE-P 69484 . 69649)) (69651 69753 (CLOS::CLASS-DIRECT-METHODS 69651 . 69753 CLOS-BROWSER::THIS-CLASS-NODE-P 69948 . 70113)) (70115 70217 (CLOS::CLASS-DIRECT-METHODS 70115 . 70217
)) (86457 87472 (CLOS-BROWSER::REPLACE-SPECIALIZERS 86457 . 87472)) (87783 89367 (CLOS-BROWSER::IN-SELECT-PACKAGE )) (86738 87753 (CLOS-BROWSER::REPLACE-SPECIALIZERS 86738 . 87753)) (88064 89648 (CLOS-BROWSER::IN-SELECT-PACKAGE
87783 . 89367)) (89369 90516 (CLOS-BROWSER::CLASSES-IN-PACKAGE 89369 . 90516))))) 88064 . 89648)) (89650 90900 (CLOS-BROWSER::CLASSES-IN-PACKAGE 89650 . 90900)))))
IL:STOP IL:STOP

BIN
clos/NEW-CLOS-BROWSER.DFASL
View File

Binary file not shown.