hg/stx-libtool: comparison BrowserView.st

equal deleted inserted replaced

-:ea66390f879b
+:83cb6f5b8a1d
 		lastMethodCategory aspect variableListView fullProtocol
 		lockUpdates autoSearch myLabel acceptClass lastSourceLogMessage
 		lastCategory lastModule lastPackage lastMethodMoveClass
 		namespaceList allNamespaces gotClassList classList selectorList
 		showAllNamespaces classInstVarsInVarList coloringProcess
-		codeModified'
+		codeModified autoSearchIgnoreCase'
 	classVariableNames:'CheckForInstancesWhenRemovingClasses RememberAspect DefaultIcon
 		StopIcon TraceIcon TimeIcon CanvasIcon MenuIcon ImageIcon
 		TabListIcon HierarchicalListIcon TableColumnsIcon HelpIcon
 		ShowResourceIcons ClassHistory'
 	poolDictionaries:''
 "used with class-method list browsing. If true,
 selecting an entry from the list will automatically
 search for the searchstring in the codeView"
 self setSearchPattern:aString.
+autoSearchIgnoreCase := false.
 autoSearch := aString
+"Modified: / 18.6.1998 / 16:49:50 / cg"
+!
+autoSearch:aString ignoreCase:ign
+"used with class-method list browsing. If true,
+selecting an entry from the list will automatically
+search for the searchstring in the codeView"
+self setSearchPattern:aString.
+autoSearchIgnoreCase := ign.
+autoSearch := aString
+"Created: / 18.6.1998 / 16:49:59 / cg"
 !
 destroy
 "relese dependant - destroy popups"
 methodStringSearch
 "launch an enterBox for string to search for"
 self
-	askForSearchTitle:'string to search for in sources:'
+askForSearchTitle:'string to search for in sources:'
-	openWith:#browseForString:in:
+openWith:#browseForString:in:ignoreCase:
-	isSelector:true
+isSelector:true
-	searchArea:#class
+searchArea:#class
+withCaseIgnore:true
-"Modified: 11.11.1996 / 12:44:13 / cg"
+"Modified: / 18.6.1998 / 16:42:11 / cg"
 !
 methodTrace
 "turn on tracing of the current method"
 "
 if there is any autoSearch string, do the search
 "
 autoSearch notNil ifTrue:[
 codeView
 searchFwd:autoSearch
+ignoreCase:autoSearchIgnoreCase
 startingAtLine:1 col:0
 ifAbsent:[]
 ].
 fullProtocol ifTrue:[
 ].
 ]
 "Created: / 23.11.1995 / 14:17:44 / cg"
 "Modified: / 17.6.1996 / 16:47:50 / stefan"
-"Modified: / 12.1.1998 / 19:07:36 / cg"
+"Modified: / 18.6.1998 / 16:50:37 / cg"
 !
 methodTemplate
 "return a method definition template"
 ! !
 !BrowserView methodsFor:'private'!
 askAndBrowseMethodCategory:title action:aBlock
-"convenient method: setup enterBox with initial being current method category"
+"convenient helper method: setup enterBox with initial being current method category"
 |sel box|
 box := self
-		enterBoxTitle:title
+enterBoxTitle:title
-		okText:'browse'
+okText:'browse'
-		label:'browse category'.
+label:'browse category'.
 sel := codeView selection.
 sel isNil ifTrue:[
-	currentMethodCategory notNil ifTrue:[
+currentMethodCategory notNil ifTrue:[
-	    sel := currentMethodCategory
+sel := currentMethodCategory
-	]
+]
 ].
 sel notNil ifTrue:[
-	box initialText:(sel asString withoutSpaces)
+box initialText:(sel asString withoutSpaces)
 ].
 box action:[:aString | self withBusyCursorDo:[aBlock value:aString]].
 box showAtPointer
-"Modified: 18.8.1997 / 15:42:07 / cg"
+"Modified: / 18.6.1998 / 16:40:46 / cg"
 !
 askForMethodCategory
+"convenient helper method: setup a box asking for a method category"
 |someCategories box txt retVal|
 someCategories := actualClass categories sort.
 box := self listBoxTitle:'accept in which method category ?' okText:'accept' list:someCategories.
 lastMethodCategory isNil ifTrue:[
-	txt := 'new methods'
+txt := 'new methods'
 ] ifFalse:[
-	txt := lastMethodCategory
+txt := lastMethodCategory
 ].
 box initialText:txt.
 box action:[:aString | aString notEmpty ifTrue:[retVal := aString] ].
 box showAtPointer.
 ^ retVal
-"Modified: 27.3.1996 / 15:33:46 / cg"
+"Modified: / 18.6.1998 / 16:41:03 / cg"
 !
 askForSearchSelectorTitle:title openWith:aSelector
-"convenient method: setup enterBox with text from codeView or selected
+"convenient helper method: setup enterBox with text from codeView or selected
 method for browsing based on a selector. Set action and launch box"
 ^ self
-	askForSearchTitle:title
+askForSearchTitle:title
-	openWith:aSelector
+openWith:aSelector
-	isSelector:true
+isSelector:true
-"Modified: 11.11.1996 / 12:43:24 / cg"
+"Modified: / 18.6.1998 / 16:40:39 / cg"
 !
 askForSearchTitle:title openWith:aSelector isSelector:isSelector
-"convenient method: setup enterBox with text from codeView or selected
+"convenient helper method: setup enterBox with text from codeView or selected
 method for browsing based on a selector. Set action and launch box"
 ^ self
-	askForSearchTitle:title
+askForSearchTitle:title
-	openWith:aSelector
+openWith:aSelector
-	isSelector:isSelector
+isSelector:isSelector
-	searchArea:#everywhere
+searchArea:#everywhere
-"Modified: 11.11.1996 / 12:42:46 / cg"
+"Modified: / 18.6.1998 / 16:40:35 / cg"
 !
 askForSearchTitle:title openWith:aSelector isSelector:isSelector searchArea:whereDefault
-"convenient method: setup enterBox with text from codeView or selected
+"convenient helper method: setup enterBox with text from codeView or selected
 method for browsing based on a selector. Set action and launch box.
 SearchArea may be one of #everywhere, #classCategory, #class, #classWithPrivateClasses,
 #classHierarchy or #classHierarchyWithPrivateClasses"
-|box grp panel selectorHolder where whereChannel
+^ self
+askForSearchTitle:title
+openWith:aSelector
+isSelector:isSelector
+searchArea:whereDefault
+withCaseIgnore:false
+"Modified: / 18.6.1998 / 16:40:26 / cg"
+!
+askForSearchTitle:title openWith:aSelector isSelector:isSelector searchArea:whereDefault withCaseIgnore:withCaseIgnore
+"convenient helper method: setup enterBox with text from codeView or selected
+method for browsing based on a selector. Set action and launch box.
+SearchArea may be one of #everywhere, #classCategory, #class, #classWithPrivateClasses,
+#classHierarchy or #classHierarchyWithPrivateClasses"
+|box grp panel selectorHolder where whereChannel caseHolder
 b sel classes areas toSearch cls privates inputField|
 areas := #(everywhere
-	       classCategory
+classCategory
-	       class
+class
-	       classHierarchy
+classHierarchy
-	       classWithPrivateClasses
+classWithPrivateClasses
-	       classHierarchyWithPrivateClasses).
+classHierarchyWithPrivateClasses).
 isSelector ifTrue:[
-	sel := self selectorToSearchFor.
+sel := self selectorToSearchFor.
 ] ifFalse:[
-	sel := self stringToSearchFor.
+sel := self stringToSearchFor.
 ].
 selectorHolder := sel asValue.
 box := Dialog new.
 (box addTextLabel:(resources string:title)) adjust:#left.
 inputField := box addInputFieldOn:selectorHolder tabable:true.
 inputField selectAll.
 inputField entryCompletionBlock:[:contents |
-	|s what m|
+|s what m|
-	s := contents withoutSpaces.
+s := contents withoutSpaces.
-	box topView withWaitCursorDo:[
+box topView withWaitCursorDo:[
-	    what := Smalltalk selectorCompletion:s.
+what := Smalltalk selectorCompletion:s.
-	    inputField contents:what first.
+inputField contents:what first.
-	    (what at:2) size ~~ 1 ifTrue:[
+(what at:2) size ~~ 1 ifTrue:[
-		self beep
+self beep
-	    ]
+]
-	]
+]
+].
+withCaseIgnore ifTrue:[
+"/        box addVerticalSpace.
+box addCheckBox:(resources string:'ignore case') on:(caseHolder := false asValue).
+"/        box addVerticalSpace.
 ].
 (currentClassCategory notNil or:[currentClass notNil]) ifTrue:[
-	box addHorizontalLine.
+box addHorizontalLine.
-	box addVerticalSpace.
+box addVerticalSpace.
-	(box addTextLabel:(resources string:'search in:')) adjust:#left.
+(box addTextLabel:(resources string:'search in:')) adjust:#left.
-	panel := VerticalPanelView "HorizontalPanelView" new.
+panel := VerticalPanelView "HorizontalPanelView" new.
-	panel horizontalLayout:#fitSpace.
+panel horizontalLayout:#fitSpace.
-	grp := RadioButtonGroup new.
+grp := RadioButtonGroup new.
-	b := CheckBox "RadioButton" label:(resources string:'everywhere').
+b := CheckBox "RadioButton" label:(resources string:'everywhere').
-	panel add:b. grp add:b.
+panel add:b. grp add:b.
-	box makeTabable:b.
+box makeTabable:b.
-	currentClassCategory notNil ifTrue:[
+currentClassCategory notNil ifTrue:[
-	    b := CheckBox "RadioButton" label:(resources string:'class category').
+b := CheckBox "RadioButton" label:(resources string:'class category').
-	    panel add:b. grp add:b.
+panel add:b. grp add:b.
-	    box makeTabable:b.
+box makeTabable:b.
-	].
+].
-	currentClass notNil ifTrue:[
+currentClass notNil ifTrue:[
-	    b := CheckBox "RadioButton" label:(resources string:'class').
+b := CheckBox "RadioButton" label:(resources string:'class').
-	    panel add:b.grp add:b.
+panel add:b.grp add:b.
-	    box makeTabable:b.
+box makeTabable:b.
-	    b := CheckBox "RadioButton" label:(resources string:'class & subclasses').
+b := CheckBox "RadioButton" label:(resources string:'class & subclasses').
-	    panel add:b. grp add:b.
+panel add:b. grp add:b.
-	    box makeTabable:b.
+box makeTabable:b.
-	    currentClass subclasses size == 0 ifTrue:[
+currentClass subclasses size == 0 ifTrue:[
-		b disable.
+b disable.
-	    ].
+].
-	    b := CheckBox "RadioButton" label:(resources string:'class & private classes').
+b := CheckBox "RadioButton" label:(resources string:'class & private classes').
-	    panel add:b.grp add:b.
+panel add:b.grp add:b.
-	    box makeTabable:b.
+box makeTabable:b.
-	    currentClass privateClasses size == 0 ifTrue:[
+currentClass privateClasses size == 0 ifTrue:[
-		b disable
+b disable
-	    ].
+].
-	    b := CheckBox "RadioButton" label:(resources string:'class & subclasses & all private classes').
+b := CheckBox "RadioButton" label:(resources string:'class & subclasses & all private classes').
-	    panel add:b. grp add:b.
+panel add:b. grp add:b.
-	    box makeTabable:b.
+box makeTabable:b.
-	    currentClass subclasses size == 0 ifTrue:[
+currentClass subclasses size == 0 ifTrue:[
-		b disable.
+b disable.
-	    ] ifFalse:[
+] ifFalse:[
 "/ this takes too long ...
 "/                toSearch := IdentitySet new.
 "/                currentClass withAllSubclasses do:[:cls | toSearch add:cls privateClasses].
 "/                toSearch size == 0 ifTrue:[
 "/                    b disable
 "/                ]
-	    ]
+]
-	].
+].
-	whereDefault notNil ifTrue:[
+whereDefault notNil ifTrue:[
-	    where := areas indexOf:whereDefault.
+where := areas indexOf:whereDefault.
-	    where == 0 ifTrue:[where := 1].
+where == 0 ifTrue:[where := 1].
-	] ifFalse:[
+] ifFalse:[
-	    where := 1.
+where := 1.
-	].
+].
-	grp value:where.
+grp value:where.
-	whereChannel := grp.
+whereChannel := grp.
-	box addComponent:panel indent:0.  "/ panel has its own idea of indenting
+box addComponent:panel indent:0.  "/ panel has its own idea of indenting
-	box addVerticalSpace.
+box addVerticalSpace.
-	box addHorizontalLine.
+box addHorizontalLine.
 ] ifFalse:[
-	whereChannel := 1 asValue.
+whereChannel := 1 asValue.
 ].
 box addAbortButton.
 box addOkButtonLabelled:(resources string:'browse').
 box label:(resources string:'search').
 box open.
 box accepted ifTrue:[
-	sel := selectorHolder value.
+sel := selectorHolder value.
-	where := whereChannel value.
+where := whereChannel value.
-	sel isEmpty ifTrue:[
+sel isEmpty ifTrue:[
-	    self warn:'nothing entered for search'.
+self warn:'nothing entered for search'.
-	    ^ self.
+^ self.
-	].
+].
-	where isNil ifTrue:[
+where isNil ifTrue:[
-	    self warn:'no class(es) for search'.
+self warn:'no class(es) for search'.
-	    ^ self.
+^ self.
-	].
+].
-	where := areas at:where ifAbsent:#class.
+where := areas at:where ifAbsent:#class.
-	where == #everywhere ifTrue:[
+where == #everywhere ifTrue:[
-	    classes := Smalltalk allClasses.
+classes := Smalltalk allClasses.
-	] ifFalse:[
+] ifFalse:[
-	    where == #classCategory ifTrue:[
+where == #classCategory ifTrue:[
-		classes := Smalltalk allClassesInCategory:currentClassCategory
+classes := Smalltalk allClassesInCategory:currentClassCategory
-	    ] ifFalse:[
+] ifFalse:[
-		(where == #class or:[where == #classWithPrivateClasses]) ifTrue:[
+(where == #class or:[where == #classWithPrivateClasses]) ifTrue:[
-		    currentClass isNil ifTrue:[
+currentClass isNil ifTrue:[
-			classes := #()
+classes := #()
-		    ] ifFalse:[
+] ifFalse:[
-			classes := Array with:currentClass
+classes := Array with:currentClass
-		    ]
+]
-		] ifFalse:[
+] ifFalse:[
-		    (where == #classHierarchy or:[where == #classHierarchyWithPrivateClasses]) ifTrue:[
+(where == #classHierarchy or:[where == #classHierarchyWithPrivateClasses]) ifTrue:[
-			classes := currentClass withAllSubclasses
+classes := currentClass withAllSubclasses
-		    ]
+]
-		]
+]
-	    ]
+]
-	].
+].
-	(where == #classWithPrivateClasses or:[where == #classHierarchyWithPrivateClasses]) ifTrue:[
+(where == #classWithPrivateClasses or:[where == #classHierarchyWithPrivateClasses]) ifTrue:[
-	    toSearch := IdentitySet withAll:classes.
+toSearch := IdentitySet withAll:classes.
-	    classes := IdentitySet withAll:toSearch.
+classes := IdentitySet withAll:toSearch.
-	    [toSearch notEmpty] whileTrue:[
+[toSearch notEmpty] whileTrue:[
-		cls := toSearch removeFirst.
+cls := toSearch removeFirst.
-		privates := cls privateClasses.
+privates := cls privateClasses.
-		privates notNil ifTrue:[
+privates notNil ifTrue:[
-		    toSearch addAll:cls privateClasses.
+toSearch addAll:cls privateClasses.
-		    classes addAll:cls privateClasses.
+classes addAll:cls privateClasses.
-		]
+]
-	    ].
+].
-	    classes := classes asOrderedCollection.
+classes := classes asOrderedCollection.
-	].
+].
-	classes isEmpty ifTrue:[
+classes isEmpty ifTrue:[
-	    self warn:'no class(es) given for search'.
+self warn:'no class(es) given for search'.
-	] ifFalse:[
+] ifFalse:[
-	    self withSearchCursorDo:[
+self withSearchCursorDo:[
-		SystemBrowser perform:aSelector with:sel with:classes
+withCaseIgnore ifTrue:[
-	    ]
+SystemBrowser perform:aSelector with:sel with:classes with:caseHolder value
-	]
+] ifFalse:[
+SystemBrowser perform:aSelector with:sel with:classes
+]
+]
+]
 ]
-"Created: 11.11.1996 / 12:42:14 / cg"
+"Created: / 18.6.1998 / 16:39:44 / cg"
-"Modified: 28.7.1997 / 18:04:04 / cg"
+"Modified: / 18.6.1998 / 16:40:30 / cg"
 !
 busyLabel:what with:someArgument
 "set the title for some warning"
 |oldCode newCode cls|
 codeView modified ifFalse:[
 oldCodeList := codeView list copy.
 codeView modified ifFalse:[
-oldCode := oldCodeList asStringWithoutEmphasis.
+oldCodeList isNil ifFalse:[
-codeView modified ifFalse:[
+oldCode := oldCodeList asStringWithoutEmphasis.
-"/ oldCode := oldCodeList asStringWithoutEmphasis.
-cls := actualClass.
 codeView modified ifFalse:[
-newCode := highlighter formatMethod:oldCode in:cls.
+"/ oldCode := oldCodeList asStringWithoutEmphasis.
-"/ must add this event - and not been interrupted
+cls := actualClass.
-"/ by any arriving key-event.
 codeView modified ifFalse:[
-newCode := newCode asStringCollection.
+newCode := highlighter formatMethod:oldCode in:cls.
+"/ must add this event - and not been interrupted
+"/ by any arriving key-event.
 codeView modified ifFalse:[
-coloringProcess := nil.
+newCode := newCode asStringCollection.
-self sensor
+codeView modified ifFalse:[
-pushUserEvent:#syntaxHighlightedCode: for:self
+coloringProcess := nil.
-withArguments:(Array with:newCode).
+self sensor
+pushUserEvent:#syntaxHighlightedCode: for:self
+withArguments:(Array with:newCode).
+]
 ]
-]
+].
 ].
 ].
 ].
 ].
 coloringProcess := nil.
 codeView modified:false.
 codeView modifiedChannel onChangeSend:#codeChanged to:self.
 "Created: / 31.3.1998 / 14:25:29 / cg"
-"Modified: / 18.6.1998 / 09:24:34 / cg"
+"Modified: / 18.6.1998 / 16:39:14 / cg"
 !
 stopSyntaxHighlightProcess
 "stop any background process, which does the syntax coloring."
 ! !
 !BrowserView class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.420 1998-06-18 13:11:17 cg Exp $'
+^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.421 1998-06-18 14:54:51 cg Exp $'
 ! !
 BrowserView initialize!

changeset 1704	83cb6f5b8a1d
parent 1701	a008f66ec076
child 1709	2aa28cabbfb2