67 " |
67 " |
68 ! ! |
68 ! ! |
69 |
69 |
70 !ResourceSelectionBrowser class methodsFor:'instance creation'! |
70 !ResourceSelectionBrowser class methodsFor:'instance creation'! |
71 |
71 |
72 request: aTitle onSuperclass: aSuperclass andClass: aClass andSelector: aSelector withResourceTypes: resourceTypes |
72 request:aTitle onSuperclass:aSuperclass andClass:aClassOrClassName andSelector:aSelector withResourceTypes:resourceTypes |
73 "opens a ResourceSelectionBrowser |
73 "opens a ResourceSelectionBrowser; return a Message-object or nil." |
74 with aTitle |
74 |
75 on aSuperclassOrSymbol, |
75 ^ (self new |
76 and aClassOrSymbol, |
76 title: aTitle) |
77 and aSelector, |
77 openOnSuperclass:aSuperclass |
78 with allowed aResourceTypes" |
78 andClass:aClassOrClassName |
79 " |
79 andSelector:aSelector |
80 ResourceSelectionBrowser |
80 withResourceTypes:resourceTypes |
|
81 |
|
82 " |
|
83 ResourceSelectionBrowser |
81 request: 'Select a Resource Selector' |
84 request: 'Select a Resource Selector' |
82 onSuperclass: #ApplicationModel |
85 onSuperclass: #ApplicationModel |
83 andClass: #MenuEditor |
86 andClassNamed: #MenuEditor |
84 andSelector: #menuItemImage |
87 andSelector: #menuItemImage |
85 withResourceTypes: #(image) |
88 withResourceTypes: #(image) |
86 " |
89 " |
87 |
|
88 ^self new |
|
89 title: aTitle; |
|
90 openOnSuperclass: aSuperclass |
|
91 andClass: aClass |
|
92 andSelector: aSelector |
|
93 withResourceTypes: resourceTypes |
|
94 ! ! |
90 ! ! |
95 |
91 |
96 !ResourceSelectionBrowser class methodsFor:'callbacks-default'! |
92 !ResourceSelectionBrowser class methodsFor:'callbacks-default'! |
97 |
93 |
98 treeViewClassHierarchyChildren |
94 treeViewClassHierarchyChildren |
702 "returns the contents of the root of the class tree list" |
698 "returns the contents of the root of the class tree list" |
703 |
699 |
704 |cls| |
700 |cls| |
705 |
701 |
706 resourceSuperclass notNil ifTrue:[ |
702 resourceSuperclass notNil ifTrue:[ |
707 cls := Smalltalk at: resourceSuperclass. |
703 cls := Smalltalk classNamed: resourceSuperclass. |
708 ]. |
704 ]. |
709 cls notNil ifTrue:[^ cls]. |
705 cls notNil ifTrue:[^ cls]. |
710 ^ self class treeViewClassHierarchyContents |
706 ^ self class treeViewClassHierarchyContents |
711 |
|
712 ! |
707 ! |
713 |
708 |
714 validateDoubleClick: aTreeItem |
709 validateDoubleClick: aTreeItem |
715 "returns whether a class may be selected" |
710 "returns whether a class may be selected" |
716 |
711 |
733 ClassPresentation = #'Class Hierarchy' |
728 ClassPresentation = #'Class Hierarchy' |
734 "/ ifTrue: [sel := self selectionOfClassHierarchy value] |
729 "/ ifTrue: [sel := self selectionOfClassHierarchy value] |
735 ifFalse: [sel := self selectionOfClassCategories value]. |
730 ifFalse: [sel := self selectionOfClassCategories value]. |
736 |
731 |
737 sel notNil ifTrue:[ |
732 sel notNil ifTrue:[ |
738 resourceClass := sel name. |
733 resourceClass := sel. |
739 ]. |
734 ]. |
740 self updateResourceMethodList. |
735 self updateResourceMethodList. |
741 ! |
736 ! |
742 |
737 |
743 classSelectionUpdate:clsPattern |
738 classSelectionUpdate:clsPattern |
755 foundClass := classes at: 1 ifAbsent:[]. |
750 foundClass := classes at: 1 ifAbsent:[]. |
756 ]. |
751 ]. |
757 |
752 |
758 foundClass notNil ifTrue: [ |
753 foundClass notNil ifTrue: [ |
759 foundClass := foundClass autoload. |
754 foundClass := foundClass autoload. |
760 resourceClass := foundClass name. |
755 resourceClass := foundClass. |
761 |
756 |
762 ClassPresentation = #'Class Hierarchy' ifTrue: [ |
757 ClassPresentation = #'Class Hierarchy' ifTrue: [ |
763 |searchArgs nonSuperclasses hierItem| |
758 |searchArgs nonSuperclasses hierItem| |
764 |
759 |
765 false "foundClass isPrivate" |
760 false "foundClass isPrivate" |
766 ifFalse: [searchArgs := foundClass withAllSuperclasses reverse] |
761 ifFalse: [searchArgs := foundClass withAllSuperclasses reverse] |
767 ifTrue: [searchArgs := foundClass owningClass withAllSuperclasses reverse. searchArgs add: foundClass] |
762 ifTrue: [searchArgs := foundClass owningClass withAllSuperclasses reverse. |
768 . |
763 searchArgs add: foundClass]. |
769 (nonSuperclasses := self treeViewClassHierarchyContents allSuperclasses) notNil |
764 (nonSuperclasses := self treeViewClassHierarchyContents allSuperclasses) notNil |
770 ifTrue: [searchArgs := searchArgs reject: [:cls| nonSuperclasses includes: cls]]. |
765 ifTrue: [searchArgs := searchArgs reject: [:cls| nonSuperclasses includes: cls]]. |
771 |
766 |
772 hierItem := self rootOfClassHierarchy detectChild:[:child :arg| child contents == arg] arguments:searchArgs. |
767 hierItem := self rootOfClassHierarchy detectChild:[:child :arg| child contents == arg] arguments:searchArgs. |
773 hierItem notNil ifTrue:[ |
768 hierItem notNil ifTrue:[ |
807 updateResourceMethodList |
802 updateResourceMethodList |
808 "read the allowed resource methods of the selected class" |
803 "read the allowed resource methods of the selected class" |
809 |
804 |
810 |class className item| |
805 |class className item| |
811 |
806 |
812 resourceClass notNil ifTrue:[ |
807 (class := resourceClass) isNil ifTrue:[ |
813 class := Smalltalk at:resourceClass asSymbol. |
|
814 ]. |
|
815 class isNil ifTrue:[ |
|
816 ClassPresentation = #'Class Hierarchy' |
808 ClassPresentation = #'Class Hierarchy' |
817 ifTrue: [item := self selectionOfClassHierarchy value ] |
809 ifTrue: [item := self selectionOfClassHierarchy value ] |
818 ifFalse: [item := self selectionOfClassCategories value ]. |
810 ifFalse: [item := self selectionOfClassCategories value ]. |
|
811 |
819 item notNil ifTrue:[ |
812 item notNil ifTrue:[ |
820 className := item name. |
813 className := item name. |
821 class := Smalltalk at:className asSymbol |
814 class := Smalltalk at:className asSymbol |
822 ]. |
815 ]. |
823 ]. |
816 ]. |
846 ] |
839 ] |
847 ! ! |
840 ! ! |
848 |
841 |
849 !ResourceSelectionBrowser methodsFor:'instance creation'! |
842 !ResourceSelectionBrowser methodsFor:'instance creation'! |
850 |
843 |
851 openOnSuperclass: aSuperclassOrSymbol andClass: aClassOrSymbol andSelector: aSelector withResourceTypes: aResourceTypes |
844 openOnSuperclass: aSuperclassOrSymbol andClass:aClassOrClassName andSelector: aSelector withResourceTypes: aResourceTypes |
852 "opens a ResourceSelectionBrowser on |
845 "opens a ResourceSelectionBrowser; return a Message-object or nil" |
853 aSuperclassOrSymbol, |
846 |
854 and aClassOrSymbol, |
847 |selectedClass enteredClassName className cls| |
855 and aSelector, |
|
856 with allowed aResourceTypes" |
|
857 |
|
858 |clsName clsNameString cls| |
|
859 |
848 |
860 resourceMethod := aSelector. |
849 resourceMethod := aSelector. |
861 resourceTypes := aResourceTypes. |
850 resourceTypes := aResourceTypes. |
862 resourceSuperclass := aSuperclassOrSymbol isClass ifTrue: [aSuperclassOrSymbol name] ifFalse: [aSuperclassOrSymbol]. |
851 resourceSuperclass := aSuperclassOrSymbol isClass ifTrue: [aSuperclassOrSymbol name] ifFalse: [aSuperclassOrSymbol]. |
863 resourceClass := nil. |
852 resourceClass := nil. |
864 |
853 |
865 aClassOrSymbol isClass |
854 aClassOrClassName notNil ifTrue:[ |
866 ifTrue: [cls := aClassOrSymbol. resourceClass := aClassOrSymbol name] |
855 aClassOrClassName isClass ifTrue: [ |
867 ifFalse: [ |
856 cls := aClassOrClassName. |
868 aClassOrSymbol size > 0 ifTrue:[ |
857 resourceClass := aClassOrClassName |
869 (cls := Smalltalk at: aClassOrSymbol) notNil |
858 ] ifFalse: [ |
870 ifTrue: [resourceClass := aClassOrSymbol] |
859 cls := Smalltalk classNamed: aClassOrClassName. |
|
860 cls notNil ifTrue:[ |
|
861 resourceClass := cls |
871 ] |
862 ] |
872 ]. |
863 ] |
|
864 ]. |
873 self valueOfResourceSelector value:(aSelector ? ''). |
865 self valueOfResourceSelector value:(aSelector ? ''). |
874 cls notNil ifTrue:[ |
|
875 "/ TODO: update tree |
|
876 ]. |
|
877 self open. |
866 self open. |
878 |
867 |
879 (clsName := self selectionOfClassHierarchy value) isNil ifTrue:[ |
868 (selectedClass := self selectionOfClassHierarchy value) isNil ifTrue:[ |
880 (clsName := self selectionOfClassCategories value) isNil ifTrue:[ |
869 (selectedClass := self selectionOfClassCategories value) isNil ifTrue:[ |
881 (clsNameString := self valueOfClassName value) isNil ifTrue:[ |
870 (enteredClassName := self valueOfClassName value) isNil ifTrue:[ |
882 accept value ifTrue:[ |
871 accept value ifTrue:[ |
883 self warn:'No valid class selected/entered'. |
872 self warn:'No valid class selected/entered'. |
884 ]. |
873 ]. |
885 ^ nil |
874 ^ nil |
886 ] |
875 ] |
887 ] |
876 ] |
888 ]. |
877 ]. |
889 |
878 |
890 clsNameString isNil ifTrue:[ |
879 className := enteredClassName. |
891 clsNameString := clsName name upTo:Character space |
880 className isNil ifTrue:[ |
892 ]. |
881 className := selectedClass name |
893 clsNameString := clsNameString asSymbol. |
882 ]. |
894 |
883 cls := Smalltalk classNamed:className. |
895 ((Smalltalk at: clsNameString) isClass and:[accept value]) ifTrue:[ |
884 (cls isClass and:[accept value]) ifTrue:[ |
896 ^ clsNameString, ' ', self valueOfResourceSelector value |
885 ^ Method::MethodWhoInfo class:cls selector:(self valueOfResourceSelector value) |
897 ]. |
886 ]. |
898 |
887 |
899 accept value ifTrue:[ |
888 accept value ifTrue:[ |
900 self warn:'No valid class selected/entered'. |
889 self warn:'No valid class selected/entered'. |
901 ]. |
890 ]. |
911 create a class selection block, an entry completion block for the class name field" |
900 create a class selection block, an entry completion block for the class name field" |
912 |
901 |
913 |classSelection classNameInputField| |
902 |classSelection classNameInputField| |
914 |
903 |
915 allClasses := self treeViewClassHierarchyContents withAllSubclasses reject: [:cls| cls isPrivate]. |
904 allClasses := self treeViewClassHierarchyContents withAllSubclasses reject: [:cls| cls isPrivate]. |
916 classSelection := resourceClass. |
905 classSelection := resourceClass isNil ifTrue:[nil] ifFalse:[resourceClass name]. |
917 |
906 |
918 (classSelection isNil or:[Smalltalk at: classSelection]) isNil |
907 (classSelection isNil or:[ (Smalltalk classNamed: classSelection) isNil]) |
919 ifTrue: [classSelection := self class lastSelection]. |
908 ifTrue: [classSelection := self class lastSelection]. |
920 "/ (classSelection isNil or:[Smalltalk at: classSelection]) isNil |
909 "/ (classSelection isNil or:[Smalltalk at: classSelection]) isNil |
921 "/ ifTrue: [classSelection := self treeViewContents]. |
910 "/ ifTrue: [classSelection := self treeViewContents]. |
922 |
911 |
923 classSelectionBlock := [:clsPattern | self classSelectionUpdate:clsPattern]. |
912 classSelectionBlock := [:clsPattern | self classSelectionUpdate:clsPattern]. |
924 self valueOfClassName value: classSelection. |
913 self valueOfClassName value:classSelection. |
925 |
914 |
926 (classNameInputField := builder componentAt: #classNameInputField) |
915 (classNameInputField := builder componentAt: #classNameInputField) |
927 entryCompletionBlock: |
916 entryCompletionBlock: |
928 [:value| |
917 [:value| |
929 |s what m| |
918 |s what m| |