ResourceSelectionBrowser.st
changeset 802 460dc3bb9cf9
parent 789 ee325d04f292
child 812 c1c6844ddd57
equal deleted inserted replaced
801:50231f23e149 802:460dc3bb9cf9
   109 !
   109 !
   110 
   110 
   111 treeViewContents
   111 treeViewContents
   112     "returns the default contents of the root of the class tree list"
   112     "returns the default contents of the root of the class tree list"
   113 
   113 
   114     ^Smalltalk at: #Object
   114     ^ Object
   115 
   115 
   116 
   116     "Modified: / 22.4.1998 / 14:44:11 / cg"
   117 
       
   118 
       
   119 !
   117 !
   120 
   118 
   121 treeViewIcon
   119 treeViewIcon
   122     "returns the icon for aTreeItem as a block"
   120     "returns the icon for aTreeItem as a block"
   123 
   121 
   495 !ResourceSelectionBrowser methodsFor:'callbacks - class list'!
   493 !ResourceSelectionBrowser methodsFor:'callbacks - class list'!
   496 
   494 
   497 treeViewContents
   495 treeViewContents
   498     "returns the contents of the root of the class tree list"
   496     "returns the contents of the root of the class tree list"
   499 
   497 
   500     ^(Smalltalk at: resourceSuperclass) ? self class treeViewContents
   498     |cls|
   501 
   499 
   502 
   500     resourceSuperclass notNil ifTrue:[
       
   501         cls := Smalltalk at: resourceSuperclass.
       
   502     ].
       
   503     ^ cls ? self class treeViewContents
       
   504 
       
   505     "Modified: / 22.4.1998 / 14:43:19 / cg"
   503 !
   506 !
   504 
   507 
   505 validateDoubleClick: aTreeItem
   508 validateDoubleClick: aTreeItem
   506     "returns whether a class may be selected"
   509     "returns whether a class may be selected"
   507 
   510 
   601 
   604 
   602 !ResourceSelectionBrowser methodsFor:'instance creation'!
   605 !ResourceSelectionBrowser methodsFor:'instance creation'!
   603 
   606 
   604 openOnSuperclass: aSuperclassOrSymbol andClass: aClassOrSymbol andSelector: aSelector withResourceTypes: aResourceTypes
   607 openOnSuperclass: aSuperclassOrSymbol andClass: aClassOrSymbol andSelector: aSelector withResourceTypes: aResourceTypes
   605     "opens a ResourceSelectionBrowser on 
   608     "opens a ResourceSelectionBrowser on 
   606 	aSuperclassOrSymbol, 
   609         aSuperclassOrSymbol, 
   607 	and aClassOrSymbol, 
   610         and aClassOrSymbol, 
   608 	and aSelector,
   611         and aSelector,
   609 	with allowed aResourceTypes"
   612         with allowed aResourceTypes"
   610 
   613 
   611     |clsName|
   614     |clsName|
   612 
   615 
   613     resourceMethod := aSelector.
   616     resourceMethod := aSelector.
   614     resourceTypes := aResourceTypes.
   617     resourceTypes := aResourceTypes.
   615     resourceSuperclass := aSuperclassOrSymbol isClass ifTrue: [aSuperclassOrSymbol name] ifFalse: [aSuperclassOrSymbol].
   618     resourceSuperclass := aSuperclassOrSymbol isClass ifTrue: [aSuperclassOrSymbol name] ifFalse: [aSuperclassOrSymbol].
   616     resourceClass := aClassOrSymbol isClass 
   619     resourceClass := nil.
   617 	ifTrue: [aClassOrSymbol name] 
   620 
   618 	ifFalse: [(Smalltalk at: aClassOrSymbol) notNil
   621     aClassOrSymbol isClass 
   619 	    ifTrue: [aClassOrSymbol]
   622         ifTrue: [resourceClass := aClassOrSymbol name] 
   620 	    ifFalse: [nil]].            
   623         ifFalse: [
       
   624             aClassOrSymbol notNil ifTrue:[
       
   625                 (Smalltalk at: aClassOrSymbol) notNil
       
   626                 ifTrue: [resourceClass := aClassOrSymbol]
       
   627             ]
       
   628         ].            
   621     self valueOfResourceSelector value:(aSelector ? '').
   629     self valueOfResourceSelector value:(aSelector ? '').
   622 
   630 
   623     self open.
   631     self open.
   624 
   632 
   625     (clsName := self selectionOfClass value) isNil ifTrue: [^nil].
   633     (clsName := self selectionOfClass value) isNil ifTrue: [^nil].
   626     clsName := (clsName name upTo: $ ) asSymbol.
   634     clsName := (clsName name upTo: $ ) asSymbol.
   627 
   635 
   628     ((Smalltalk at: clsName) isClass and: [accept value]) 
   636     ((Smalltalk at: clsName) isClass and: [accept value]) 
   629     ifTrue:
   637     ifTrue:
   630     [            
   638     [            
   631 	^clsName, ' ', self valueOfResourceSelector value
   639         ^clsName, ' ', self valueOfResourceSelector value
   632     ].
   640     ].
   633     ^nil
   641     ^nil
       
   642 
       
   643     "Modified: / 22.4.1998 / 14:51:03 / cg"
   634 ! !
   644 ! !
   635 
   645 
   636 !ResourceSelectionBrowser methodsFor:'startup / release'!
   646 !ResourceSelectionBrowser methodsFor:'startup / release'!
   637 
   647 
   638 closeCancel
   648 closeCancel
   653 
   663 
   654     |classSelection classNameInputField|
   664     |classSelection classNameInputField|
   655 
   665 
   656     allClasses := self treeViewContents withAllSubclasses reject: [:cls| cls isPrivate].
   666     allClasses := self treeViewContents withAllSubclasses reject: [:cls| cls isPrivate].
   657     classSelection :=  resourceClass. 
   667     classSelection :=  resourceClass. 
   658     (Smalltalk at: classSelection) isNil 
   668 
       
   669     (classSelection isNil or:[Smalltalk at: classSelection]) isNil 
   659         ifTrue: [classSelection :=  self class lastSelection].
   670         ifTrue: [classSelection :=  self class lastSelection].
   660     (Smalltalk at: classSelection) isNil 
   671     (classSelection isNil or:[Smalltalk at: classSelection]) isNil 
   661         ifTrue: [classSelection :=  self treeViewContents].
   672         ifTrue: [classSelection :=  self treeViewContents].
       
   673 
   662     classSelectionBlock := 
   674     classSelectionBlock := 
   663     [:clsPattern|                                  
   675     [:clsPattern|                                  
   664         |foundClass classes|         
   676         |foundClass classes|  
   665         ((foundClass := Smalltalk at: clsPattern printString asSymbol) isClass not or:
   677 
   666         [foundClass name ~= clsPattern])
   678         clsPattern notNil ifTrue:[
       
   679             foundClass := Smalltalk at:(clsPattern printString asSymbol).
       
   680         ].
       
   681         (foundClass isClass not or:[foundClass name ~= clsPattern])
   667         ifTrue:
   682         ifTrue:
   668         [
   683         [
   669             classes := allClasses select: [:cls| cls name size >= clsPattern size].
   684             classes := allClasses select: [:cls| cls name size >= clsPattern size].
   670             1 to: clsPattern size do: 
   685             1 to: clsPattern size do: 
   671             [:i|    
   686             [:i|    
   707         readResourcesProcess := nil.
   722         readResourcesProcess := nil.
   708     ] forkAt: 4. 
   723     ] forkAt: 4. 
   709 
   724 
   710     ^super postBuildWith:aBuilder
   725     ^super postBuildWith:aBuilder
   711 
   726 
       
   727     "Modified: / 22.4.1998 / 14:48:22 / cg"
   712 ! !
   728 ! !
   713 
   729 
   714 !ResourceSelectionBrowser::ResourceMethod methodsFor:'accessing'!
   730 !ResourceSelectionBrowser::ResourceMethod methodsFor:'accessing'!
   715 
   731 
   716 iconOn:aGC
   732 iconOn:aGC