hg/stx-libtool: comparison BrowserView.st

equal deleted inserted replaced

-:200617958f79
+:9beb5abaa3a5
 ^Icon
 constantNamed:#'BrowserView traceIcon'
 ifAbsentPut:[(Depth2Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@B**** ****(B%UU(@)UUZ@B%UZ@@)UV @B%V @@)U(@@B%(@@@)Z@@@B*@@@@* @@@B @@@@(@@@@@@@@@a') ; colorMapFromArray:#[0 0 0 255 255 255 255 0 0 0 255 0]; mask:((Depth1Image new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@A??''?>O?0??A?8G? O<@?0A>@G8@O@@<@A @F@@@@b') ; yourself); yourself]! !
 !BrowserView class methodsFor:'interface specs'!
+methodMoveDialogSpec
+"This resource specification was automatically generated
+by the UIPainter of ST/X."
+"Do not manually edit this!! If it is corrupted,
+the UIPainter may not be able to read the specification."
+"
+UIPainter new openOnClass:BrowserView andSelector:#methodMoveDialogSpec
+BrowserView new openInterface:#methodMoveDialogSpec
+"
+<resource: #canvas>
+^
+#(#FullSpec
+#window:
+#(#WindowSpec
+#name: 'Move method to:'
+#layout: #(#LayoutFrame 290 0 207 0 628 0 334 0)
+#label: 'Move method to:'
+#min: #(#Point 10 10)
+#max: #(#Point 1280 1024)
+#bounds: #(#Rectangle 290 207 629 335)
+#usePreferredExtent: false
+)
+#component:
+#(#SpecCollection
+#collection:
+#(
+#(#LabelSpec
+#name: 'Label1'
+#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 38 0)
+#label: 'Move method to which class:'
+#translateLabel: true
+#adjust: #left
+)
+#(#ComboBoxSpec
+#name: 'ComboBox1'
+#layout: #(#LayoutFrame 0 0.0 41 0 0 1.0 66 0)
+#model: #className
+#comboList: #classList
+#useIndex: true
+)
+#(#HorizontalPanelViewSpec
+#name: 'HorizontalPanel1'
+#layout: #(#LayoutFrame 0 0.0 -48 1.0 0 1.0 0 1.0)
+#component:
+#(#SpecCollection
+#collection:
+#(
+#(#ActionButtonSpec
+#name: 'Button1'
+#label: 'Cancel'
+#translateLabel: true
+#model: #cancel
+#extent: #(#Point 165 27)
+)
+#(#ActionButtonSpec
+#name: 'Button2'
+#label: 'Move'
+#translateLabel: true
+#model: #accept
+#isDefault: true
+#extent: #(#Point 165 27)
+)
+)
+)
+#horizontalLayout: #fitSpace
+#verticalLayout: #centerMax
+#horizontalSpace: 3
+#verticalSpace: 3
+)
+)
+)
+)
+!
 repositoryLoadSpec
 "This resource specification was automatically generated
 by the UIPainter of ST/X."
 isSelector:true
 "Modified: 10.7.1996 / 12:40:07 / cg"
 !
+methodInheritance
+"launch a browser showing inherited (and overwritten) methods"
+|methodList|
+currentClass isNil ifTrue:[^ self].
+currentSelector isNil ifTrue:[^ self].
+methodList := OrderedCollection new.
+actualClass allSuperclasses do:[:aClass |
+|m|
+m := aClass compiledMethodAt:currentSelector.
+m notNil ifTrue:[
+methodList addFirst:m
+]
+].
+methodList size == 0 ifTrue:[
+^ self information:(resources
+string:'''%1'' does not redefine any inherited method'
+with:currentSelector).
+].
+methodList addLast:(actualClass compiledMethodAt:currentSelector).
+SystemBrowser
+browseMethods:methodList
+title:(resources string:'''%1'' inheritance & redefinition' with:currentSelector)
+sort:false
+!
 methodInspect
 "inspect  the current method"
 self checkMethodSelected ifFalse:[^ self].
 currentMethod inspect.
 fileItems :=           #(
 ('fileOut'       methodFileOut  )
 ('printOut'      methodPrintOut )
 ('-'             nil            )
 ('SPAWN_METHOD'  methodSpawn    )
+('inheritance'   methodInheritance )
 ('-'             nil            )
 ).
 sepLocalItems := #(('-')).
 !
 methodMove
 "move the current method into another class; typically a superclass"
-|newClass newClassName sup initial movedMethod list holders|
+|newClass newClassName sup initial movedMethod
+supers subs list holders|
 self checkMethodSelected ifFalse:[^ self].
 lastMethodMoveClass ~= currentClass name ifTrue:[
 initial := lastMethodMoveClass.
 ] ifFalse:[
 initial := nil.
 ].
 ].
+supers := (currentClass allSuperclasses reverse collect:[:cls | cls name]).
+subs := (currentClass allSubclasses collect:[:cls | cls name]).
+list := supers.
+(supers notEmpty and:[subs notEmpty]) ifTrue:[
+list := list , (Array with:'---- ' , currentClass name , ' ----')
+].
+list := list , subs.
 "/ preps to use windowSpecs ...
-"/
-"/    list := (currentClass allSuperclasses collect:[:cls | cls name]).
-"/    list := list , (currentClass allSubclasses collect:[:cls | cls name]).
 "/
 "/    holders := IdentityDictionary new.
 "/    holders at:#className put:initial asValue.
 "/    holders at:#classList put:list.
 "/
 "/    (SystemBrowser
-"/        openDialogInterface:#methodMoveDialogSpec
+"/      openDialogInterface:#methodMoveDialogSpec
-"/        withBindings:holders) ifTrue:[
+"/      withBindings:holders) ifFalse:[
-"/        newClassName := (holders at:#className) value.
+"/        ^ self
 "/    ].
+"/    newClassName := (holders at:#className) value.
 newClassName := Dialog
 request:(resources string:'move current method to which class:')
 initialAnswer:initial
 okLabel:(resources string:'move')
 title:(resources string:'move method')
-onCancel:nil.
+onCancel:nil
+list:list.
 newClassName isNil ifTrue:[^ self].
+(newClassName startsWith:'---- ') ifTrue:[^ self].
 newClass := Smalltalk classNamed:newClassName.
 newClass isNil ifTrue:[
 self warn:'no such class'.
 ^ self
 ! !
 !BrowserView class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.454 1998-10-05 10:20:55 cg Exp $'
+^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.455 1998-10-09 14:15:46 cg Exp $'
 ! !
 BrowserView initialize!

changeset 1918	9beb5abaa3a5
parent 1913	b5d55f160224
child 1934	f10eff0533d0