[squeak-dev] Squeak 4.6: ToolBuilder-Kernel-mt.89.mczcommits at source.squeak.org commits at source.squeak.orgFri Jun 5 20:19:56 UTC 2015
Chris Muller uploaded a new version of ToolBuilder-Kernel to project Squeak 4.6: http://source.squeak.org/squeak46/ToolBuilder-Kernel-mt.89.mcz ==================== Summary ==================== Name: ToolBuilder-Kernel-mt.89 Author: mt Time: 12 May 2015, 9:02:56.628 pm UUID: 5175a13e-cae3-8f48-bd99-8a7d0d012866 Ancestors: ToolBuilder-Kernel-mt.88 Allow input fields to provide soft-line-wrap. ==================== Snapshot ==================== SystemOrganization addCategory: #'ToolBuilder-Kernel'! Notification subclass: #ProgressInitiationException instanceVariableNames: 'workBlock maxVal minVal aPoint progressTitle' classVariableNames: 'PreferredProgressBarPosition' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !ProgressInitiationException commentStamp: '<historical>' prior: 0! I provide a way to alter the behavior of the old-style progress notifier in String. See examples in: ProgressInitiationException testWithout. ProgressInitiationException testWith. ! ----- Method: ProgressInitiationException class>>display:at:from:to:during: (in category 'signalling') ----- display: aString at: aPoint from: minVal to: maxVal during: workBlock ^ self new display: aString at: (aPoint ifNil: [ self preferredProgressBarPoint ]) from: minVal to: maxVal during: workBlock! ----- Method: ProgressInitiationException class>>display:from:to:during: (in category 'signalling') ----- display: aString from: minVal to: maxVal during: workBlock ^ self display: aString at: nil from: minVal to: maxVal during: workBlock! ----- Method: ProgressInitiationException class>>preferredProgressBarPoint (in category 'accessing') ----- preferredProgressBarPoint ^ self preferredProgressBarPosition = #cursorPoint ifTrue: [ Sensor cursorPoint ] ifFalse: [ UIManager default screenBounds perform: self preferredProgressBarPosition ]! ----- Method: ProgressInitiationException class>>preferredProgressBarPosition (in category 'accessing') ----- preferredProgressBarPosition ^ PreferredProgressBarPosition ifNil: [ #center ]! ----- Method: ProgressInitiationException class>>preferredProgressBarPosition: (in category 'accessing') ----- preferredProgressBarPosition: aSymbol "Specify any of: #center, #topCenter, #bottomCenter, #leftCenter, #rightCenter, #topLeft, #topRight, #bottomLeft or #bottomRight or #cursorPoint." ^ PreferredProgressBarPosition! ----- Method: ProgressInitiationException class>>testInnermost (in category 'examples and tests') ----- testInnermost "test the progress code WITHOUT special handling" ^'Now here''s some Real Progress' displayProgressFrom: 0 to: 10 during: [ :bar | 1 to: 10 do: [ :x | bar value: x. (Delay forMilliseconds: 500) wait. x = 5 ifTrue: [1/0]. "just to make life interesting" ]. 'done' ]. ! ----- Method: ProgressInitiationException class>>testWith (in category 'examples and tests') ----- testWith "test progress code WITH special handling of progress notifications" ^[ self testWithAdditionalInfo ] on: ProgressInitiationException do: [ :ex | ex sendNotificationsTo: [ :min :max :curr | Transcript show: min printString,' ',max printString,' ',curr printString; cr ]. ]. ! ----- Method: ProgressInitiationException class>>testWithAdditionalInfo (in category 'examples and tests') ----- testWithAdditionalInfo ^{'starting'. self testWithout. 'really!!'}! ----- Method: ProgressInitiationException class>>testWithout (in category 'examples and tests') ----- testWithout "test the progress code WITHOUT special handling" ^[self testInnermost] on: ZeroDivide do: [ :ex | ex resume] ! ----- Method: ProgressInitiationException>>defaultAction (in category 'handling') ----- defaultAction self resume! ----- Method: ProgressInitiationException>>defaultResumeValue (in category 'handling') ----- defaultResumeValue ^ UIManager default displayProgress: progressTitle at: aPoint from: minVal to: maxVal during: workBlock! ----- Method: ProgressInitiationException>>display:at:from:to:during: (in category 'initialize-release') ----- display: argString at: argPoint from: argMinVal to: argMaxVal during: argWorkBlock progressTitle := argString. aPoint := argPoint. minVal := argMinVal. maxVal := argMaxVal. workBlock := argWorkBlock. ^self signal! ----- Method: ProgressInitiationException>>sendNotificationsTo: (in category 'initialize-release') ----- sendNotificationsTo: aNewBlock self resume: ( workBlock value: [ :barVal | aNewBlock value: minVal value: maxVal value: barVal ] ) ! ----- Method: String>>displayProgressAt:from:to:during: (in category '*toolbuilder-kernel') ----- displayProgressAt: aPoint from: minVal to: maxVal during: workBlock "Display this string as a caption over a progress bar while workBlock is evaluated. EXAMPLE (Select next 6 lines and Do It) 'Now here''s some Real Progress' displayProgressAt: Sensor cursorPoint from: 0 to: 10 during: [:bar | 1 to: 10 do: [:x | bar value: x. (Delay forMilliseconds: 500) wait]]. HOW IT WORKS (Try this in any other language :-) Since your code (the last 2 lines in the above example) is in a block, this method gets control to display its heading before, and clean up the screen after, its execution. The key, though, is that the block is supplied with an argument, named 'bar' in the example, which will update the bar image every it is sent the message value: x, where x is in the from:to: range. " ^ProgressInitiationException display: self at: aPoint from: minVal to: maxVal during: workBlock! ----- Method: String>>displayProgressFrom:to:during: (in category '*toolbuilder-kernel') ----- displayProgressFrom: minVal to: maxVal during: workBlock "Display this string as a caption over a progress bar while workBlock is evaluated. EXAMPLE (Select next 6 lines and Do It) 'Now here''s some Real Progress' displayProgressFrom: 0 to: 10 during: [:bar | 1 to: 10 do: [:x | bar value: x. (Delay forMilliseconds: 500) wait]]." ^ self displayProgressAt: nil from: minVal to: maxVal during: workBlock! ----- Method: Object>>confirm: (in category '*ToolBuilder-Kernel-error handling') ----- confirm: queryString "Put up a yes/no menu with caption queryString. Answer true if the response is yes, false if no. This is a modal question--the user must respond yes or no." "nil confirm: 'Are you hungry?'" ^ UIManager default confirm: queryString! ----- Method: Object>>confirm:orCancel: (in category '*ToolBuilder-Kernel-error handling') ----- confirm: aString orCancel: cancelBlock "Put up a yes/no/cancel menu with caption aString. Answer true if the response is yes, false if no. If cancel is chosen, evaluate cancelBlock. This is a modal question--the user must respond yes or no." ^ UIManager default confirm: aString orCancel: cancelBlock! ----- Method: Object>>inform: (in category '*ToolBuilder-Kernel-user interface') ----- inform: aString "Display a message for the user to read and then dismiss. 6/9/96 sw" aString isEmptyOrNil ifFalse: [UIManager default inform: aString]! Object subclass: #ToolBuilder instanceVariableNames: 'parent' classVariableNames: 'OpenToolsAttachedToMouseCursor' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !ToolBuilder commentStamp: '<historical>' prior: 0! I am a tool builder, that is an object which knows how to create concrete widgets from abstract specifications. Those specifications are used by tools which want to be able to function in diverse user interface paradigms, such as MVC, Morphic, Tweak, wxWidgets etc. The following five specs must be supported by all implementations: * PluggableButton * PluggableList * PluggableText * PluggablePanel * PluggableWindow The following specs are optional: * PluggableTree: If not supported, the tool builder must answer nil when asked for a pluggableTreeSpec. Substitution will require client support so clients must be aware that some tool builders may not support trees (MVC for example, or Seaside). See examples in FileListPlus or TestRunnerPlus. * PluggableMultiSelectionList: If multi-selection lists are not supported, tool builder will silently support regular single selection lists. * PluggableInputField: Intended as a HINT for the builder that this widget will be used as a single line input field. Unless explicitly supported it will be automatically substituted by PluggableText. * PluggableActionButton: Intended as a HINT for the builder that this widget will be used as push (action) button. Unless explicitly supported it will be automatically substituted by PluggableButton. * PluggableRadioButton: Intended as a HINT for the builder that this widget will be used as radio button. Unless explicitly supported it will be automatically substituted by PluggableButton. * PluggableCheckBox: Intended as a HINT for the builder that this widget will be used as check box. Unless explicitly supported it will be automatically substituted by PluggableButton. ! ----- Method: ToolBuilder class>>build: (in category 'instance creation') ----- build: aClass ^self default build: aClass! ----- Method: ToolBuilder class>>default (in category 'accessing') ----- default "Answer the default tool builder" ^ Project current uiManager toolBuilder ! ----- Method: ToolBuilder class>>findDefault (in category 'accessing') ----- findDefault "Answer a default tool builder" | builderClass | "Note: The way the following is phrased ensures that you can always make 'more specific' builders merely by subclassing a tool builder and implementing a more specific way of reacting to #isActiveBuilder. For example, a BobsUIToolBuilder can subclass MorphicToolBuilder and (if enabled, say Preferences useBobsUITools) will be considered before the parent (generic MorphicToolBuilder)." builderClass := self allSubclasses detect:[:any| any isActiveBuilder and:[ any subclasses noneSatisfy:[:sub| sub isActiveBuilder]]] ifNone:[nil]. builderClass ifNotNil: [^builderClass ]. ^self error: 'ToolBuilder not found'! ----- Method: ToolBuilder class>>isActiveBuilder (in category 'accessing') ----- isActiveBuilder "Answer whether I am the currently active builder" ^false! ----- Method: ToolBuilder class>>open: (in category 'instance creation') ----- open: aClass ^self default open: aClass! ----- Method: ToolBuilder class>>open:label: (in category 'instance creation') ----- open: aClass label: aString ^self default open: aClass label: aString! ----- Method: ToolBuilder class>>openToolsAttachedToMouseCursor (in category 'preferences') ----- openToolsAttachedToMouseCursor <preference: 'Open Tools Attached to Mouse Cursor' categoryList: #(Tools mouse) description: 'If enabled, new tool windows will be attached to the mouse cursor to be positioned on screen with an additional click. Only, if a mouse event triggered that tool.' type: #Boolean> ^ OpenToolsAttachedToMouseCursor ifNil: [false]! ----- Method: ToolBuilder class>>openToolsAttachedToMouseCursor: (in category 'preferences') ----- openToolsAttachedToMouseCursor: aBoolean OpenToolsAttachedToMouseCursor := aBoolean.! ----- Method: ToolBuilder>>build: (in category 'building') ----- build: anObject "Build the given object using this tool builder" ^anObject buildWith: self! ----- Method: ToolBuilder>>buildAll:in: (in category 'building') ----- buildAll: aList in: newParent "Build the given set of widgets in the new parent" | prior | aList ifNil:[^self]. prior := parent. parent := newParent. aList do:[:each| each buildWith: self]. parent := prior. ! ----- Method: ToolBuilder>>buildPluggableActionButton: (in category 'widgets optional') ----- buildPluggableActionButton: spec ^self buildPluggableButton: spec! ----- Method: ToolBuilder>>buildPluggableAlternateMultiSelectionList: (in category 'widgets optional') ----- buildPluggableAlternateMultiSelectionList: aSpec ^ self buildPluggableList: aSpec! ----- Method: ToolBuilder>>buildPluggableButton: (in category 'widgets required') ----- buildPluggableButton: aSpec ^self subclassResponsibility! ----- Method: ToolBuilder>>buildPluggableCheckBox: (in category 'widgets optional') ----- buildPluggableCheckBox: spec ^self buildPluggableButton: spec! ----- Method: ToolBuilder>>buildPluggableCodePane: (in category 'widgets optional') ----- buildPluggableCodePane: aSpec ^self buildPluggableText: aSpec! ----- Method: ToolBuilder>>buildPluggableDropDownList: (in category 'widgets optional') ----- buildPluggableDropDownList: spec ^self buildPluggableList: spec! ----- Method: ToolBuilder>>buildPluggableInputField: (in category 'widgets optional') ----- buildPluggableInputField: aSpec ^self buildPluggableText: aSpec! ----- Method: ToolBuilder>>buildPluggableList: (in category 'widgets required') ----- buildPluggableList: aSpec ^self subclassResponsibility! ----- Method: ToolBuilder>>buildPluggableMenu: (in category 'widgets required') ----- buildPluggableMenu: menuSpec self subclassResponsibility.! ----- Method: ToolBuilder>>buildPluggableMenuItem: (in category 'widgets required') ----- buildPluggableMenuItem: menuSpec self subclassResponsibility.! ----- Method: ToolBuilder>>buildPluggableMultiSelectionList: (in category 'widgets optional') ----- buildPluggableMultiSelectionList: aSpec ^self buildPluggableList: aSpec! ----- Method: ToolBuilder>>buildPluggablePanel: (in category 'widgets required') ----- buildPluggablePanel: aSpec ^self subclassResponsibility! ----- Method: ToolBuilder>>buildPluggableRadioButton: (in category 'widgets optional') ----- buildPluggableRadioButton: spec ^self buildPluggableButton: spec! ----- Method: ToolBuilder>>buildPluggableScrollPane: (in category 'widgets optional') ----- buildPluggableScrollPane: spec ^ spec children ifNotNil: [self buildPluggablePanel: spec] ifNil: [spec morph ifNil: [spec morphClass new]]! ----- Method: ToolBuilder>>buildPluggableSpacer: (in category 'widgets required') ----- buildPluggableSpacer: aSpec ^ self subclassResponsibility! ----- Method: ToolBuilder>>buildPluggableText: (in category 'widgets required') ----- buildPluggableText: aSpec ^self subclassResponsibility! ----- Method: ToolBuilder>>buildPluggableTree: (in category 'widgets required') ----- buildPluggableTree: aSpec ^self subclassResponsibility! ----- Method: ToolBuilder>>buildPluggableWindow: (in category 'widgets required') ----- buildPluggableWindow: aSpec ^self subclassResponsibility! ----- Method: ToolBuilder>>close: (in category 'opening') ----- close: aWidget "Close a previously opened widget" ^self subclassResponsibility! ----- Method: ToolBuilder>>initialize (in category 'initialize') ----- initialize ! ----- Method: ToolBuilder>>open: (in category 'opening') ----- open: anObject "Build and open the object. Answer the widget opened." ^self subclassResponsibility! ----- Method: ToolBuilder>>open:label: (in category 'opening') ----- open: anObject label: aString "Build an open the object, labeling it appropriately. Answer the widget opened." ^self subclassResponsibility! ----- Method: ToolBuilder>>openDebugger: (in category 'opening') ----- openDebugger: aSpec "Build and open a debugger from the given spec. Answer the widget opened. Subclasses can override this method if opening a debugger has specific requirements different from opening other widgets." self open: aSpec ! ----- Method: ToolBuilder>>openDebugger:label: (in category 'opening') ----- openDebugger: aSpec label: aString "Build and open a debugger from the given spec, labeling it appropriately. Answer the widget opened. Subclasses can override this method if opening a debugger has specific requirements different from opening other widgets." ^self open: aSpec label: aString ! ----- Method: ToolBuilder>>openDebugger:label:closing: (in category 'opening') ----- openDebugger: aSpec label: aString closing: topView "Build and open a debugger from the given spec, labeling it appropriately. Answer the widget opened. Subclasses can override this method if opening a debugger has specific requirements different from opening other widgets." self close: topView. self open: aSpec label: aString ! ----- Method: ToolBuilder>>parent (in category 'accessing') ----- parent ^parent! ----- Method: ToolBuilder>>parent: (in category 'accessing') ----- parent: aWidget parent := aWidget! ----- Method: ToolBuilder>>pluggableActionButtonSpec (in category 'defaults') ----- pluggableActionButtonSpec ^PluggableActionButtonSpec! ----- Method: ToolBuilder>>pluggableAlternateMultiSelectionListSpec (in category 'defaults') ----- pluggableAlternateMultiSelectionListSpec ^ PluggableAlternateMultiSelectionListSpec! ----- Method: ToolBuilder>>pluggableButtonSpec (in category 'defaults') ----- pluggableButtonSpec ^PluggableButtonSpec! ----- Method: ToolBuilder>>pluggableCheckBoxSpec (in category 'defaults') ----- pluggableCheckBoxSpec ^PluggableCheckBoxSpec! ----- Method: ToolBuilder>>pluggableCodePaneSpec (in category 'defaults') ----- pluggableCodePaneSpec ^PluggableCodePaneSpec! ----- Method: ToolBuilder>>pluggableDropDownListSpec (in category 'defaults') ----- pluggableDropDownListSpec ^PluggableDropDownListSpec! ----- Method: ToolBuilder>>pluggableInputFieldSpec (in category 'defaults') ----- pluggableInputFieldSpec ^PluggableInputFieldSpec! ----- Method: ToolBuilder>>pluggableListSpec (in category 'defaults') ----- pluggableListSpec ^PluggableListSpec! ----- Method: ToolBuilder>>pluggableMenuSpec (in category 'defaults') ----- pluggableMenuSpec ^ PluggableMenuSpec! ----- Method: ToolBuilder>>pluggableMultiSelectionListSpec (in category 'defaults') ----- pluggableMultiSelectionListSpec ^PluggableMultiSelectionListSpec! ----- Method: ToolBuilder>>pluggablePanelSpec (in category 'defaults') ----- pluggablePanelSpec ^PluggablePanelSpec! ----- Method: ToolBuilder>>pluggableRadioButtonSpec (in category 'defaults') ----- pluggableRadioButtonSpec ^PluggableRadioButtonSpec! ----- Method: ToolBuilder>>pluggableScrollPaneSpec (in category 'defaults') ----- pluggableScrollPaneSpec ^ PluggableScrollPaneSpec! ----- Method: ToolBuilder>>pluggableSpacerSpec (in category 'defaults') ----- pluggableSpacerSpec ^ PluggableSpacerSpec! ----- Method: ToolBuilder>>pluggableTextSpec (in category 'defaults') ----- pluggableTextSpec ^PluggableTextSpec! ----- Method: ToolBuilder>>pluggableTreeSpec (in category 'defaults') ----- pluggableTreeSpec ^PluggableTreeSpec! ----- Method: ToolBuilder>>pluggableWindowSpec (in category 'defaults') ----- pluggableWindowSpec ^PluggableWindowSpec! ----- Method: ToolBuilder>>runModal: (in category 'opening') ----- runModal: aWidget "Run the (previously opened) widget modally, e.g., do not return control to the sender before the user has responded." ^self subclassResponsibility! ----- Method: ToolBuilder>>widgetAt: (in category 'accessing') ----- widgetAt: widgetID "Answer the widget with the given ID" ^self widgetAt: widgetID ifAbsent:[nil]! ----- Method: ToolBuilder>>widgetAt:ifAbsent: (in category 'accessing') ----- widgetAt: widgetID ifAbsent: aBlock "Answer the widget with the given ID" ^aBlock value! Object subclass: #ToolBuilderSpec instanceVariableNames: 'name help' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !ToolBuilderSpec commentStamp: 'ar 2/11/2005 14:59' prior: 0! I am an abstract widget specification. I can be rendered using many different UI frameworks.! ToolBuilderSpec subclass: #PluggableMenuItemSpec instanceVariableNames: 'label action checked enabled separator subMenu checkable' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! ----- Method: PluggableMenuItemSpec>>action (in category 'accessing') ----- action "Answer the action associated with the receiver" ^action! ----- Method: PluggableMenuItemSpec>>action: (in category 'accessing') ----- action: aMessageSend "Answer the action associated with the receiver" action := aMessageSend! ----- Method: PluggableMenuItemSpec>>analyzeLabel (in category 'initialize') ----- analyzeLabel "For Morphic compatiblity. Some labels include markup such as <on>, <off> etc. Analyze the label for these annotations and take appropriate action." | marker | marker := label copyFrom: 1 to: (label indexOf: $>). (marker = '<on>' or:[marker = '<yes>']) ifTrue:[ checkable := true. checked := true. label := label copyFrom: marker size+1 to: label size. ]. (marker = '<off>' or:[marker = '<no>']) ifTrue:[ checkable := true. checked := false. label := label copyFrom: marker size+1 to: label size. ]. ! ----- Method: PluggableMenuItemSpec>>beCheckable (in category 'accessing') ----- beCheckable checkable := true.! ----- Method: PluggableMenuItemSpec>>buildWith: (in category 'building') ----- buildWith: builder ^ builder buildPluggableMenuItem: self! ----- Method: PluggableMenuItemSpec>>checked (in category 'accessing') ----- checked "Answer whether the receiver is checked" ^checked ifNil:[false]! ----- Method: PluggableMenuItemSpec>>checked: (in category 'accessing') ----- checked: aBool "Indicate whether the receiver is checked" checked := aBool.! ----- Method: PluggableMenuItemSpec>>enabled (in category 'accessing') ----- enabled "Answer whether the receiver is enabled" ^enabled ifNil:[true]! ----- Method: PluggableMenuItemSpec>>enabled: (in category 'accessing') ----- enabled: aBool "Indicate whether the receiver is enabled" enabled := aBool! ----- Method: PluggableMenuItemSpec>>initialize (in category 'initialize') ----- initialize checkable := false.! ----- Method: PluggableMenuItemSpec>>isCheckable (in category 'accessing') ----- isCheckable ^ checkable! ----- Method: PluggableMenuItemSpec>>label (in category 'accessing') ----- label "Answer the receiver's label" ^label! ----- Method: PluggableMenuItemSpec>>label: (in category 'accessing') ----- label: aString "Set the receiver's label" label := aString! ----- Method: PluggableMenuItemSpec>>separator (in category 'accessing') ----- separator "Answer whether the receiver should be followed by a separator" ^separator ifNil:[false]! ----- Method: PluggableMenuItemSpec>>separator: (in category 'accessing') ----- separator: aBool "Indicate whether the receiver should be followed by a separator" separator := aBool.! ----- Method: PluggableMenuItemSpec>>subMenu (in category 'accessing') ----- subMenu "Answer the receiver's subMenu" ^subMenu! ----- Method: PluggableMenuItemSpec>>subMenu: (in category 'accessing') ----- subMenu: aMenuSpec "Answer the receiver's subMenu" subMenu := aMenuSpec! ToolBuilderSpec subclass: #PluggableMenuSpec instanceVariableNames: 'label model items' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! ----- Method: PluggableMenuSpec class>>withModel: (in category 'as yet unclassified') ----- withModel: aModel ^ self new model: aModel! ----- Method: PluggableMenuSpec>>add:action: (in category 'construction') ----- add: aString action: aMessageSend | item | item := self addMenuItem. item label: aString. item action: aMessageSend. ^item! ----- Method: PluggableMenuSpec>>add:target:selector:argumentList: (in category 'construction') ----- add: aString target: anObject selector: aSelector argumentList: anArray ^self add: aString action: (MessageSend receiver: anObject selector: aSelector arguments: anArray).! ----- Method: PluggableMenuSpec>>addList: (in category 'construction') ----- addList: aList "Add the given items to this menu, where each item is a pair (<string> <actionSelector>).. If an element of the list is simply the symobl $-, add a line to the receiver. The optional third element of each entry, if present, provides balloon help." aList do: [:tuple | (tuple == #-) ifTrue: [self addSeparator] ifFalse:[ | item | item := self add: tuple first target: model selector: tuple second argumentList: #(). tuple size > 2 ifTrue:[item help: tuple third]]]! ----- Method: PluggableMenuSpec>>addMenuItem (in category 'construction') ----- addMenuItem | item | item := self newMenuItem. self items add: item. ^item! ----- Method: PluggableMenuSpec>>addSeparator (in category 'construction') ----- addSeparator self items isEmpty ifTrue:[^nil]. self items last separator: true.! ----- Method: PluggableMenuSpec>>analyzeItemLabels (in category 'construction') ----- analyzeItemLabels "Analyze the item labels" items do:[:item| item analyzeLabel]. ! ----- Method: PluggableMenuSpec>>buildWith: (in category 'construction') ----- buildWith: builder self analyzeItemLabels. ^ builder buildPluggableMenu: self! ----- Method: PluggableMenuSpec>>items (in category 'accessing') ----- items ^ items ifNil: [items := OrderedCollection new]! ----- Method: PluggableMenuSpec>>label (in category 'accessing') ----- label ^label! ----- Method: PluggableMenuSpec>>label: (in category 'accessing') ----- label: aString label := aString.! ----- Method: PluggableMenuSpec>>model (in category 'accessing') ----- model ^ model! ----- Method: PluggableMenuSpec>>model: (in category 'accessing') ----- model: anObject model := anObject! ----- Method: PluggableMenuSpec>>newMenuItem (in category 'construction') ----- newMenuItem ^PluggableMenuItemSpec new! ToolBuilderSpec subclass: #PluggableWidgetSpec instanceVariableNames: 'model frame color minimumExtent margin padding horizontalResizing verticalResizing' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableWidgetSpec commentStamp: 'ar 2/9/2005 18:40' prior: 0! The abstract superclass for all widgets. Instance variables: model <Object> The object the various requests should be directed to. frame <Rectangle> The associated layout frame for this object (if any). ! PluggableWidgetSpec subclass: #PluggableButtonSpec instanceVariableNames: 'action label state enabled style changeLabelWhen' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableButtonSpec commentStamp: 'ar 2/11/2005 21:57' prior: 0! A button, both for firing as well as used in radio-button style (e.g., carrying a selection). Instance variables: action <Symbol> The action to perform when the button is fired. label <Symbol|String> The selector for retrieving the button's label or label directly. state <Symbol> The selector for retrieving the button's selection state. enabled <Symbo> The selector for retrieving the button's enabled state. color <Symbo> The selector for retrieving the button color. help <String> The balloon help for the button.! PluggableButtonSpec subclass: #PluggableActionButtonSpec instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableActionButtonSpec commentStamp: 'dtl 9/19/2011 07:51' prior: 0! PluggableActionButtonSpec is intended as a HINT for the builder that this widget will be used as push (action) button. Unless explicitly supported it will be automatically substituted by PluggableButton.! ----- Method: PluggableActionButtonSpec>>buildWith: (in category 'building') ----- buildWith: builder ^builder buildPluggableActionButton: self! ----- Method: PluggableButtonSpec>>action (in category 'accessing') ----- action "Answer the action to be performed by the receiver" ^action! ----- Method: PluggableButtonSpec>>action: (in category 'accessing') ----- action: aSymbol "Indicate the action to be performed by the receiver" action := aSymbol! ----- Method: PluggableButtonSpec>>buildWith: (in category 'building') ----- buildWith: builder ^builder buildPluggableButton: self! ----- Method: PluggableButtonSpec>>changeLabelWhen (in category 'accessing') ----- changeLabelWhen "When handled in in an update: handler, treat this symbol as notification that the button label should be updated." ^changeLabelWhen! ----- Method: PluggableButtonSpec>>changeLabelWhen: (in category 'accessing') ----- changeLabelWhen: aSymbol "When the button handles aSymbol in its update: handler, treat it as notification that the button label should be updated." changeLabelWhen := aSymbol! ----- Method: PluggableButtonSpec>>enabled (in category 'accessing') ----- enabled "Answer the selector for retrieving the button's enablement" ^enabled ifNil:[true]! ----- Method: PluggableButtonSpec>>enabled: (in category 'accessing') ----- enabled: aSymbol "Indicate the selector for retrieving the button's enablement" enabled := aSymbol! ----- Method: PluggableButtonSpec>>label (in category 'accessing') ----- label "Answer the label (or the selector for retrieving the label)" ^label! ----- Method: PluggableButtonSpec>>label: (in category 'accessing') ----- label: aSymbol "Indicate the selector for retrieving the label" label := aSymbol.! ----- Method: PluggableButtonSpec>>state (in category 'accessing') ----- state "Answer the selector for retrieving the button's state" ^state! ----- Method: PluggableButtonSpec>>state: (in category 'accessing') ----- state: aSymbol "Indicate the selector for retrieving the button's state" state := aSymbol.! ----- Method: PluggableButtonSpec>>style (in category 'accessing') ----- style "Treat aSymbol as a hint to modify the button appearance." ^style ! ----- Method: PluggableButtonSpec>>style: (in category 'accessing') ----- style: aSymbol "Use aSymbol as a hint to modify the button appearance." style := aSymbol ! PluggableButtonSpec subclass: #PluggableCheckBoxSpec instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableCheckBoxSpec commentStamp: 'ar 2/12/2005 23:13' prior: 0! PluggableCheckBox is intended as a HINT for the builder that this widget will be used as check box. Unless explicitly supported it will be automatically substituted by PluggableButton.! ----- Method: PluggableCheckBoxSpec>>buildWith: (in category 'building') ----- buildWith: builder ^builder buildPluggableCheckBox: self! PluggableButtonSpec subclass: #PluggableRadioButtonSpec instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableRadioButtonSpec commentStamp: 'ar 2/12/2005 23:14' prior: 0! PluggableRadioButton is intended as a HINT for the builder that this widget will be used as radio button. Unless explicitly supported it will be automatically substituted by PluggableButton.! ----- Method: PluggableRadioButtonSpec>>buildWith: (in category 'building') ----- buildWith: builder ^builder buildPluggableRadioButton: self! PluggableWidgetSpec subclass: #PluggableCompositeSpec instanceVariableNames: 'children layout wantsResizeHandles spacing' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableCompositeSpec commentStamp: 'ar 2/11/2005 21:58' prior: 0! A composite user interface element. Instance variables: children <Symbol|Collection> Symbol to retrieve children or children directly layout <Symbol> The layout for this composite. ! ----- Method: PluggableCompositeSpec>>children (in category 'accessing') ----- children "Answer the selector to retrieve this panel's children" ^children! ----- Method: PluggableCompositeSpec>>children: (in category 'accessing') ----- children: aSymbol "Indicate the selector to retrieve this panel's children" children := aSymbol! ----- Method: PluggableCompositeSpec>>layout (in category 'accessing') ----- layout "Answer the symbol indicating the layout of the composite: #proportional (default): Use frames as appropriate. #horizontal: Arrange the elements horizontally #vertical: Arrange the elements vertically. " ^layout ifNil:[#proportional]! ----- Method: PluggableCompositeSpec>>layout: (in category 'accessing') ----- layout: aSymbol "Answer the symbol indicating the layout of the composite: #proportional (default): Use frames as appropriate. #horizontal: Arrange the elements horizontally #vertical: Arrange the elements vertically. " layout := aSymbol! ----- Method: PluggableCompositeSpec>>spacing (in category 'layout hints') ----- spacing "...between components of this widget." ^ spacing! ----- Method: PluggableCompositeSpec>>spacing: (in category 'layout hints') ----- spacing: numberOrPoint spacing := numberOrPoint.! ----- Method: PluggableCompositeSpec>>wantsResizeHandles (in category 'accessing') ----- wantsResizeHandles ^ wantsResizeHandles! ----- Method: PluggableCompositeSpec>>wantsResizeHandles: (in category 'accessing') ----- wantsResizeHandles: aBoolean wantsResizeHandles := aBoolean.! PluggableCompositeSpec subclass: #PluggablePanelSpec instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggablePanelSpec commentStamp: 'ar 2/11/2005 15:01' prior: 0! A panel with a (possibly changing) set of child elements. Expects to see change/update notifications when the childrens change.! ----- Method: PluggablePanelSpec>>buildWith: (in category 'building') ----- buildWith: builder ^builder buildPluggablePanel: self.! PluggableCompositeSpec subclass: #PluggableScrollPaneSpec instanceVariableNames: 'morph morphClass borderWidth vScrollBarPolicy hScrollBarPolicy' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! ----- Method: PluggableScrollPaneSpec>>borderWidth (in category 'accessing') ----- borderWidth ^ borderWidth ifNil: [1]! ----- Method: PluggableScrollPaneSpec>>borderWidth: (in category 'accessing') ----- borderWidth: anObject borderWidth := anObject! ----- Method: PluggableScrollPaneSpec>>buildWith: (in category 'building') ----- buildWith: builder ^ builder buildPluggableScrollPane: self! ----- Method: PluggableScrollPaneSpec>>hScrollBarPolicy (in category 'accessing') ----- hScrollBarPolicy ^ hScrollBarPolicy ifNil: [#always]! ----- Method: PluggableScrollPaneSpec>>hScrollBarPolicy: (in category 'accessing') ----- hScrollBarPolicy: anObject "#always, #never, #whenNeeded" hScrollBarPolicy := anObject! ----- Method: PluggableScrollPaneSpec>>morph (in category 'accessing') ----- morph ^ morph! ----- Method: PluggableScrollPaneSpec>>morph: (in category 'accessing') ----- morph: anObject morph := anObject! ----- Method: PluggableScrollPaneSpec>>morphClass (in category 'accessing') ----- morphClass ^ morphClass! ----- Method: PluggableScrollPaneSpec>>morphClass: (in category 'accessing') ----- morphClass: anObject morphClass := anObject! ----- Method: PluggableScrollPaneSpec>>vScrollBarPolicy (in category 'accessing') ----- vScrollBarPolicy ^ vScrollBarPolicy ifNil: [#always]! ----- Method: PluggableScrollPaneSpec>>vScrollBarPolicy: (in category 'accessing') ----- vScrollBarPolicy: anObject "#always, #never, #whenNeeded" vScrollBarPolicy := anObject! PluggableCompositeSpec subclass: #PluggableWindowSpec instanceVariableNames: 'label extent closeAction isDialog multiWindowStyle' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableWindowSpec commentStamp: '<historical>' prior: 0! A common window. Expects to see change/update notifications when the label should change. Instance variables: label <String|Symbol> The selector under which to retrieve the label or the label directly extent <Point> The (initial) extent of the window. closeAction <Symbol> The action to perform when the window is closed.! ----- Method: PluggableWindowSpec>>buildWith: (in category 'building') ----- buildWith: builder ^builder buildPluggableWindow: self.! ----- Method: PluggableWindowSpec>>closeAction (in category 'accessing') ----- closeAction "Answer the receiver's closeAction" ^closeAction! ----- Method: PluggableWindowSpec>>closeAction: (in category 'accessing') ----- closeAction: aSymbol "Answer the receiver's closeAction" closeAction := aSymbol.! ----- Method: PluggableWindowSpec>>extent (in category 'accessing') ----- extent "Answer the window's (initial) extent" ^extent! ----- Method: PluggableWindowSpec>>extent: (in category 'accessing') ----- extent: aPoint "Indicate the window's (initial) extent" extent := aPoint! ----- Method: PluggableWindowSpec>>isDialog (in category 'accessing') ----- isDialog ^isDialog ifNil: [false] ! ----- Method: PluggableWindowSpec>>isDialog: (in category 'accessing') ----- isDialog: val isDialog := val ! ----- Method: PluggableWindowSpec>>label (in category 'accessing') ----- label "Answer the selector for retrieving the window's label" ^label! ----- Method: PluggableWindowSpec>>label: (in category 'accessing') ----- label: aString "Indicate the selector for retrieving the window's label" label := aString! ----- Method: PluggableWindowSpec>>multiWindowStyle (in category 'accessing') ----- multiWindowStyle "Answer the value of multiWindowStyle, a Symbol or nil" ^multiWindowStyle! ----- Method: PluggableWindowSpec>>multiWindowStyle: (in category 'accessing') ----- multiWindowStyle: aSymbol "Set the value of multiWindowStyle, one of #labelButton or #tabbed" multiWindowStyle := aSymbol! PluggableWidgetSpec subclass: #PluggableDropDownListSpec instanceVariableNames: 'listSelector selectionSelector selectionSetter' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! ----- Method: PluggableDropDownListSpec>>buildWith: (in category 'building') ----- buildWith: builder ^builder buildPluggableDropDownList: self! ----- Method: PluggableDropDownListSpec>>listSelector (in category 'accessing') ----- listSelector "Answer the value of listSelector" ^ listSelector! ----- Method: PluggableDropDownListSpec>>listSelector: (in category 'accessing') ----- listSelector: anObject "Set the value of listSelector" listSelector := anObject! ----- Method: PluggableDropDownListSpec>>selectionSelector (in category 'accessing') ----- selectionSelector "Answer the value of selectionSelector" ^ selectionSelector! ----- Method: PluggableDropDownListSpec>>selectionSelector: (in category 'accessing') ----- selectionSelector: anObject "Set the value of selectionSelector" selectionSelector := anObject! ----- Method: PluggableDropDownListSpec>>selectionSetter (in category 'accessing') ----- selectionSetter "Answer the value of selectionSetter" ^ selectionSetter! ----- Method: PluggableDropDownListSpec>>selectionSetter: (in category 'accessing') ----- selectionSetter: anObject "Set the value of selectionSetter" selectionSetter := anObject! PluggableWidgetSpec subclass: #PluggableListSpec instanceVariableNames: 'list getIndex setIndex getSelected setSelected menu keyPress autoDeselect dragItem dropItem dropAccept doubleClick listSize listItem keystrokePreview icon vScrollBarPolicy hScrollBarPolicy' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableListSpec commentStamp: 'ar 7/15/2005 11:54' prior: 0! A single selection list element. Instance variables: list <Symbol> The selector to retrieve the list elements. getIndex <Symbol> The selector to retrieve the list selection index. setIndex <Symbol> The selector to set the list selection index. getSelected <Symbol> The selector to retrieve the list selection. setSelected <Symbol> The selector to set the list selection. menu <Symbol> The selector to offer (to retrieve?) the context menu. keyPress <Symbol> The selector to invoke for handling keyboard shortcuts. autoDeselect <Boolean> Whether the list should allow automatic deselection or not. dragItem <Symbol> Selector to initiate a drag action on an item dropItem <Symbol> Selector to initiate a drop action of an item dropAccept <Symbol> Selector to determine whether a drop would be accepted! ----- Method: PluggableListSpec>>autoDeselect (in category 'accessing') ----- autoDeselect "Answer whether this tree can be automatically deselected" ^autoDeselect ifNil:[true]! ----- Method: PluggableListSpec>>autoDeselect: (in category 'accessing') ----- autoDeselect: aBool "Indicate whether this tree can be automatically deselected" autoDeselect := aBool! ----- Method: PluggableListSpec>>buildWith: (in category 'building') ----- buildWith: builder ^builder buildPluggableList: self! ----- Method: PluggableListSpec>>doubleClick (in category 'accessing') ----- doubleClick "Answer the selector to perform when a double-click occurs" ^doubleClick! ----- Method: PluggableListSpec>>doubleClick: (in category 'accessing') ----- doubleClick: aSymbol "Set the selector to perform when a double-click occurs" doubleClick := aSymbol.! ----- Method: PluggableListSpec>>dragItem (in category 'accessing') ----- dragItem "Answer the selector for dragging an item" ^dragItem! ----- Method: PluggableListSpec>>dragItem: (in category 'accessing') ----- dragItem: aSymbol "Set the selector for dragging an item" dragItem := aSymbol! ----- Method: PluggableListSpec>>dropAccept (in category 'accessing') ----- dropAccept "Answer the selector to determine whether a drop would be accepted" ^dropAccept! ----- Method: PluggableListSpec>>dropAccept: (in category 'accessing') ----- dropAccept: aSymbol "Answer the selector to determine whether a drop would be accepted" dropAccept := aSymbol.! ----- Method: PluggableListSpec>>dropItem (in category 'accessing') ----- dropItem "Answer the selector for dropping an item" ^dropItem! ----- Method: PluggableListSpec>>dropItem: (in category 'accessing') ----- dropItem: aSymbol "Set the selector for dropping an item" dropItem := aSymbol! ----- Method: PluggableListSpec>>getIndex (in category 'accessing') ----- getIndex "Answer the selector for retrieving the list's selection index" ^getIndex! ----- Method: PluggableListSpec>>getIndex: (in category 'accessing') ----- getIndex: aSymbol "Indicate the selector for retrieving the list's selection index" getIndex := aSymbol! ----- Method: PluggableListSpec>>getSelected (in category 'accessing') ----- getSelected "Answer the selector for retrieving the list selection" ^getSelected! ----- Method: PluggableListSpec>>getSelected: (in category 'accessing') ----- getSelected: aSymbol "Indicate the selector for retrieving the list selection" getSelected := aSymbol! ----- Method: PluggableListSpec>>hScrollBarPolicy (in category 'accessing') ----- hScrollBarPolicy ^ hScrollBarPolicy! ----- Method: PluggableListSpec>>hScrollBarPolicy: (in category 'accessing') ----- hScrollBarPolicy: aSymbol "#always, #never, #whenNeeded" hScrollBarPolicy := aSymbol.! ----- Method: PluggableListSpec>>icon (in category 'accessing') ----- icon ^ icon! ----- Method: PluggableListSpec>>icon: (in category 'accessing') ----- icon: aSelector icon := aSelector! ----- Method: PluggableListSpec>>keyPress (in category 'accessing') ----- keyPress "Answer the selector for invoking the list's keyPress handler" ^keyPress! ----- Method: PluggableListSpec>>keyPress: (in category 'accessing') ----- keyPress: aSymbol "Indicate the selector for invoking the list's keyPress handler" keyPress := aSymbol! ----- Method: PluggableListSpec>>keystrokePreview (in category 'accessing') ----- keystrokePreview "Answer the selector to determine whether to allow the model a preview of keystrokes" ^ keystrokePreview! ----- Method: PluggableListSpec>>keystrokePreview: (in category 'accessing') ----- keystrokePreview: aSymbol "The selector to determine whether to allow the model a preview of keystrokes" keystrokePreview := aSymbol.! ----- Method: PluggableListSpec>>list (in category 'accessing') ----- list "Answer the selector for retrieving the list contents" ^list! ----- Method: PluggableListSpec>>list: (in category 'accessing') ----- list: aSymbol "Indicate the selector for retrieving the list contents" list := aSymbol.! ----- Method: PluggableListSpec>>listItem (in category 'accessing') ----- listItem "Answer the selector for retrieving the list element" ^listItem! ----- Method: PluggableListSpec>>listItem: (in category 'accessing') ----- listItem: aSymbol "Indicate the selector for retrieving the list element" listItem := aSymbol.! ----- Method: PluggableListSpec>>listSize (in category 'accessing') ----- listSize "Answer the selector for retrieving the list size" ^listSize! ----- Method: PluggableListSpec>>listSize: (in category 'accessing') ----- listSize: aSymbol "Indicate the selector for retrieving the list size" listSize := aSymbol.! ----- Method: PluggableListSpec>>menu (in category 'accessing') ----- menu "Answer the selector for retrieving the list's menu" ^menu! ----- Method: PluggableListSpec>>menu: (in category 'accessing') ----- menu: aSymbol "Indicate the selector for retrieving the list's menu" menu := aSymbol! ----- Method: PluggableListSpec>>setIndex (in category 'accessing') ----- setIndex "Answer the selector for setting the list's selection index" ^setIndex! ----- Method: PluggableListSpec>>setIndex: (in category 'accessing') ----- setIndex: aSymbol "Answer the selector for setting the list's selection index" setIndex := aSymbol! ----- Method: PluggableListSpec>>setSelected (in category 'accessing') ----- setSelected "Answer the selector for setting the list selection" ^setSelected! ----- Method: PluggableListSpec>>setSelected: (in category 'accessing') ----- setSelected: aSymbol "Indicate the selector for setting the list selection" setSelected := aSymbol! ----- Method: PluggableListSpec>>vScrollBarPolicy (in category 'accessing') ----- vScrollBarPolicy ^ vScrollBarPolicy! ----- Method: PluggableListSpec>>vScrollBarPolicy: (in category 'accessing') ----- vScrollBarPolicy: aSymbol "#always, #never, #whenNeeded" vScrollBarPolicy := aSymbol.! PluggableListSpec subclass: #PluggableMultiSelectionListSpec instanceVariableNames: 'getSelectionList setSelectionList' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableMultiSelectionListSpec commentStamp: 'ar 2/12/2005 13:31' prior: 0! PluggableMultiSelectionListSpec specifies a list with multiple selection behavior. Instance variables: getSelectionList <Symbol> The message to retrieve the multiple selections. setSelectionList <Symbol> The message to indicate multiple selections.! PluggableMultiSelectionListSpec subclass: #PluggableAlternateMultiSelectionListSpec instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! ----- Method: PluggableAlternateMultiSelectionListSpec>>buildWith: (in category 'building') ----- buildWith: builder ^ builder buildPluggableAlternateMultiSelectionList: self! ----- Method: PluggableMultiSelectionListSpec>>buildWith: (in category 'building') ----- buildWith: builder ^builder buildPluggableMultiSelectionList: self! ----- Method: PluggableMultiSelectionListSpec>>getSelectionList (in category 'accessing') ----- getSelectionList "Answer the message to retrieve the multiple selections" ^getSelectionList! ----- Method: PluggableMultiSelectionListSpec>>getSelectionList: (in category 'accessing') ----- getSelectionList: aSymbol "Indicate the message to retrieve the multiple selections" getSelectionList := aSymbol! ----- Method: PluggableMultiSelectionListSpec>>setSelectionList (in category 'accessing') ----- setSelectionList "Answer the message to indicate multiple selections" ^setSelectionList! ----- Method: PluggableMultiSelectionListSpec>>setSelectionList: (in category 'accessing') ----- setSelectionList: aSymbol "Indicate the message to indicate multiple selections" setSelectionList := aSymbol! PluggableWidgetSpec subclass: #PluggableSpacerSpec instanceVariableNames: 'extent' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! ----- Method: PluggableSpacerSpec>>buildWith: (in category 'building') ----- buildWith: builder ^builder buildPluggableSpacer: self! ----- Method: PluggableSpacerSpec>>color (in category 'accessing') ----- color ^ super color ifNil: [Color transparent]! ----- Method: PluggableSpacerSpec>>extent (in category 'layout hints') ----- extent ^ extent ifNil: [5 at 5]! ----- Method: PluggableSpacerSpec>>extent: (in category 'layout hints') ----- extent: aPoint extent := aPoint.! ----- Method: PluggableSpacerSpec>>fillSpaceHorizontally (in category 'convenience') ----- fillSpaceHorizontally self horizontalResizing: #spaceFill.! ----- Method: PluggableSpacerSpec>>fillSpaceVertically (in category 'convenience') ----- fillSpaceVertically self verticalResizing: #spaceFill.! ----- Method: PluggableSpacerSpec>>horizontalResizing (in category 'accessing') ----- horizontalResizing ^ super horizontalResizing ifNil: [#rigid]! ----- Method: PluggableSpacerSpec>>verticalResizing (in category 'accessing') ----- verticalResizing ^ super verticalResizing ifNil: [#rigid]! PluggableWidgetSpec subclass: #PluggableTextSpec instanceVariableNames: 'getText setText selection menu askBeforeDiscardingEdits editText indicateUnacceptedChanges stylerClass font readOnly softLineWrap hardLineWrap' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableTextSpec commentStamp: 'ar 2/11/2005 21:58' prior: 0! A text editor. Instance variables: getText <Symbol> The selector to retrieve the text. setText <Symbol> The selector to set the text. selection <Symbol> The selector to retrieve the text selection. menu <Symbol> The selector to offer (to retrieve?) the context menu. color <Symbol> The selector to retrieve the background color. ! PluggableTextSpec subclass: #PluggableCodePaneSpec instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableCodePaneSpec commentStamp: 'ar 8/18/2009 00:02' prior: 0! A PluggableTextSpec specifically intended to edit code. Uses Syntax-Highlighting.! ----- Method: PluggableCodePaneSpec>>buildWith: (in category 'building') ----- buildWith: builder ^builder buildPluggableCodePane: self! ----- Method: PluggableCodePaneSpec>>font (in category 'accessing') ----- font ^ font ifNil: [Preferences standardCodeFont]! ----- Method: PluggableCodePaneSpec>>stylerClass (in category 'accessing') ----- stylerClass ^ super stylerClass ifNil: [Smalltalk classNamed: 'SHTextStylerST80']! PluggableTextSpec subclass: #PluggableInputFieldSpec instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableInputFieldSpec commentStamp: 'ar 2/12/2005 23:13' prior: 0! PluggableInputField is intended as a HINT for the builder that this widget will be used as a single line input field. Unless explicitly supported it will be automatically substituted by PluggableText.! ----- Method: PluggableInputFieldSpec>>buildWith: (in category 'building') ----- buildWith: builder ^builder buildPluggableInputField: self! ----- Method: PluggableInputFieldSpec>>hardLineWrap (in category 'accessing') ----- hardLineWrap ^ false! ----- Method: PluggableInputFieldSpec>>softLineWrap (in category 'accessing') ----- softLineWrap ^ super softLineWrap ifNil: [false]! ----- Method: PluggableTextSpec>>askBeforeDiscardingEdits (in category 'accessing') ----- askBeforeDiscardingEdits ^askBeforeDiscardingEdits ifNil:[true]! ----- Method: PluggableTextSpec>>askBeforeDiscardingEdits: (in category 'accessing') ----- askBeforeDiscardingEdits: aBool askBeforeDiscardingEdits := aBool! ----- Method: PluggableTextSpec>>buildWith: (in category 'building') ----- buildWith: builder ^builder buildPluggableText: self! ----- Method: PluggableTextSpec>>editText (in category 'accessing') ----- editText ^ editText! ----- Method: PluggableTextSpec>>editText: (in category 'accessing') ----- editText: aSymbol "Answer the selector for getting informed about any modifications of the text." editText := aSymbol! ----- Method: PluggableTextSpec>>font (in category 'accessing') ----- font ^ font ifNil: [Preferences standardDefaultTextFont]! ----- Method: PluggableTextSpec>>font: (in category 'accessing') ----- font: aFont font := aFont.! ----- Method: PluggableTextSpec>>getText (in category 'accessing') ----- getText "Answer the selector for retrieving the text" ^getText! ----- Method: PluggableTextSpec>>getText: (in category 'accessing') ----- getText: aSymbol "Answer the selector for retrieving the text" getText := aSymbol! ----- Method: PluggableTextSpec>>hardLineWrap (in category 'accessing') ----- hardLineWrap ^ hardLineWrap! ----- Method: PluggableTextSpec>>hardLineWrap: (in category 'accessing') ----- hardLineWrap: aBoolean hardLineWrap := aBoolean.! ----- Method: PluggableTextSpec>>indicateUnacceptedChanges (in category 'accessing') ----- indicateUnacceptedChanges ^ indicateUnacceptedChanges ifNil: [true]! ----- Method: PluggableTextSpec>>indicateUnacceptedChanges: (in category 'accessing') ----- indicateUnacceptedChanges: aBoolean indicateUnacceptedChanges := aBoolean.! ----- Method: PluggableTextSpec>>menu (in category 'accessing') ----- menu "Answer the selector for retrieving the text's menu" ^menu! ----- Method: PluggableTextSpec>>menu: (in category 'accessing') ----- menu: aSymbol "Indicate the selector for retrieving the text's menu" menu := aSymbol! ----- Method: PluggableTextSpec>>readOnly (in category 'accessing') ----- readOnly ^ readOnly ifNil: [false]! ----- Method: PluggableTextSpec>>readOnly: (in category 'accessing') ----- readOnly: aBoolean readOnly := aBoolean.! ----- Method: PluggableTextSpec>>selection (in category 'accessing') ----- selection "Answer the selector for retrieving the text selection" ^selection! ----- Method: PluggableTextSpec>>selection: (in category 'accessing') ----- selection: aSymbol "Indicate the selector for retrieving the text selection" selection := aSymbol! ----- Method: PluggableTextSpec>>setText (in category 'accessing') ----- setText "Answer the selector for setting the text" ^setText! ----- Method: PluggableTextSpec>>setText: (in category 'accessing') ----- setText: aSymbol "Answer the selector for setting the text" setText := aSymbol! ----- Method: PluggableTextSpec>>softLineWrap (in category 'accessing') ----- softLineWrap ^ softLineWrap! ----- Method: PluggableTextSpec>>softLineWrap: (in category 'accessing') ----- softLineWrap: aBoolean softLineWrap := aBoolean.! ----- Method: PluggableTextSpec>>stylerClass (in category 'accessing') ----- stylerClass ^ stylerClass! ----- Method: PluggableTextSpec>>stylerClass: (in category 'accessing') ----- stylerClass: aStylerClass stylerClass := aStylerClass.! PluggableWidgetSpec subclass: #PluggableTreeSpec instanceVariableNames: 'roots getSelectedPath setSelected getSelected setSelectedParent getChildren hasChildren label icon unusedVar menu keyPress wantsDrop dropItem dropAccept autoDeselect dragItem nodeClass columns' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableTreeSpec commentStamp: 'mvdg 3/21/2008 20:59' prior: 0! A pluggable tree widget. PluggableTrees are slightly different from lists in such that they ALWAYS store the actual objects and use the label selector to query for the label of the item. PluggableTrees also behave somewhat differently in such that they do not have a "getSelected" message but only a getSelectedPath message. The difference is that getSelectedPath is used to indicate by the model that the tree should select the appropriate path. This allows disambiguation of items. Because of this, implementations of PluggableTrees must always set their internal selection directly, e.g., rather than sending the model a setSelected message and wait for an update of the #getSelected the implementation must set the selection before sending the #setSelected message. If a client doesn't want this, it can always just signal a change of getSelectedPath to revert to whatever is needed. Instance variables: roots <Symbol> The message to retrieve the roots of the tree. getSelectedPath <Symbol> The message to retrieve the selected path in the tree. setSelected <Symbol> The message to set the selected item in the tree. getChildren <Symbol> The message to retrieve the children of an item hasChildren <Symbol> The message to query for children of an item label <Symbol> The message to query for the label of an item. icon <Symbol> The message to query for the icon of an item. help <Symbol> The message to query for the help of an item. menu <Symbol> The message to query for the tree's menu keyPress <Symbol> The message to process a keystroke. wantsDrop <Symbol> The message to query whether a drop might be accepted. dropItem <Symbol> The message to drop an item. enableDrag <Boolean> Enable dragging from this tree. autoDeselect <Boolean> Whether the tree should allow automatic deselection or not. unusedVar (unused) This variable is a placeholder to fix problems with loading packages in 3.10.! ----- Method: PluggableTreeSpec>>autoDeselect (in category 'accessing') ----- autoDeselect "Answer whether this tree can be automatically deselected" ^autoDeselect ifNil:[true]! ----- Method: PluggableTreeSpec>>autoDeselect: (in category 'accessing') ----- autoDeselect: aBool "Indicate whether this tree can be automatically deselected" autoDeselect := aBool.! ----- Method: PluggableTreeSpec>>buildWith: (in category 'building') ----- buildWith: builder ^builder buildPluggableTree: self! ----- Method: PluggableTreeSpec>>columns (in category 'accessing') ----- columns ^ columns! ----- Method: PluggableTreeSpec>>columns: (in category 'accessing') ----- columns: columnSpecs columns := columnSpecs.! ----- Method: PluggableTreeSpec>>dragItem (in category 'accessing') ----- dragItem ^ dragItem.! ----- Method: PluggableTreeSpec>>dragItem: (in category 'accessing') ----- dragItem: aSymbol "Set the selector for dragging an item" dragItem := aSymbol! ----- Method: PluggableTreeSpec>>dropAccept (in category 'accessing') ----- dropAccept "Answer the selector for querying the receiver about accepting drops" ^dropAccept! ----- Method: PluggableTreeSpec>>dropAccept: (in category 'accessing') ----- dropAccept: aSymbol "Set the selector for querying the receiver about accepting drops" dropAccept := aSymbol! ----- Method: PluggableTreeSpec>>dropItem (in category 'accessing') ----- dropItem "Answer the selector for invoking the tree's dragDrop handler" ^dropItem! ----- Method: PluggableTreeSpec>>dropItem: (in category 'accessing') ----- dropItem: aSymbol "Indicate the selector for invoking the tree's dragDrop handler" dropItem := aSymbol! ----- Method: PluggableTreeSpec>>getChildren (in category 'accessing') ----- getChildren "Answer the message to get the children of this tree" ^getChildren! ----- Method: PluggableTreeSpec>>getChildren: (in category 'accessing') ----- getChildren: aSymbol "Indicate the message to retrieve the children of this tree" getChildren := aSymbol! ----- Method: PluggableTreeSpec>>getSelected (in category 'accessing') ----- getSelected ^ getSelected! ----- Method: PluggableTreeSpec>>getSelected: (in category 'accessing') ----- getSelected: aSymbol "Indicate a single node in the tree. Only works if that node is visible, too. Use #getSelectedPath otherwise." getSelected := aSymbol.! ----- Method: PluggableTreeSpec>>getSelectedPath (in category 'accessing') ----- getSelectedPath "Answer the message to retrieve the selection of this tree" ^getSelectedPath! ----- Method: PluggableTreeSpec>>getSelectedPath: (in category 'accessing') ----- getSelectedPath: aSymbol "Indicate the message to retrieve the selection of this tree" getSelectedPath := aSymbol! ----- Method: PluggableTreeSpec>>hasChildren (in category 'accessing') ----- hasChildren "Answer the message to get the existence of children in this tree" ^hasChildren! ----- Method: PluggableTreeSpec>>hasChildren: (in category 'accessing') ----- hasChildren: aSymbol "Indicate the message to retrieve the existence children in this tree" hasChildren := aSymbol! ----- Method: PluggableTreeSpec>>icon (in category 'accessing') ----- icon "Answer the message to get the icons of this tree" ^icon! ----- Method: PluggableTreeSpec>>icon: (in category 'accessing') ----- icon: aSymbol "Indicate the message to retrieve the icon of this tree" icon := aSymbol! ----- Method: PluggableTreeSpec>>keyPress (in category 'accessing') ----- keyPress "Answer the selector for invoking the tree's keyPress handler" ^keyPress! ----- Method: PluggableTreeSpec>>keyPress: (in category 'accessing') ----- keyPress: aSymbol "Indicate the selector for invoking the tree's keyPress handler" keyPress := aSymbol! ----- Method: PluggableTreeSpec>>label (in category 'accessing') ----- label "Answer the message to get the labels of this tree" ^label! ----- Method: PluggableTreeSpec>>label: (in category 'accessing') ----- label: aSymbol "Indicate the message to retrieve the labels of this tree" label := aSymbol! ----- Method: PluggableTreeSpec>>menu (in category 'accessing') ----- menu "Answer the message to get the menus of this tree" ^menu! ----- Method: PluggableTreeSpec>>menu: (in category 'accessing') ----- menu: aSymbol "Indicate the message to retrieve the menus of this tree" menu := aSymbol! ----- Method: PluggableTreeSpec>>nodeClass (in category 'accessing') ----- nodeClass ^ nodeClass! ----- Method: PluggableTreeSpec>>nodeClass: (in category 'accessing') ----- nodeClass: aListWrapperClass nodeClass := aListWrapperClass.! ----- Method: PluggableTreeSpec>>roots (in category 'accessing') ----- roots "Answer the message to retrieve the roots of this tree" ^roots! ----- Method: PluggableTreeSpec>>roots: (in category 'accessing') ----- roots: aSymbol "Indicate the message to retrieve the roots of this tree" roots := aSymbol! ----- Method: PluggableTreeSpec>>setSelected (in category 'accessing') ----- setSelected "Answer the message to set the selection of this tree" ^setSelected! ----- Method: PluggableTreeSpec>>setSelected: (in category 'accessing') ----- setSelected: aSymbol "Indicate the message to set the selection of this tree" setSelected := aSymbol! ----- Method: PluggableTreeSpec>>setSelectedParent (in category 'accessing') ----- setSelectedParent ^ setSelectedParent! ----- Method: PluggableTreeSpec>>setSelectedParent: (in category 'accessing') ----- setSelectedParent: aSymbol setSelectedParent := aSymbol! ----- Method: PluggableTreeSpec>>wantsDrop (in category 'accessing') ----- wantsDrop "Answer the selector for invoking the tree's wantsDrop handler" ^wantsDrop! ----- Method: PluggableTreeSpec>>wantsDrop: (in category 'accessing') ----- wantsDrop: aSymbol "Indicate the selector for invoking the tree's wantsDrop handler" wantsDrop := aSymbol! ----- Method: PluggableWidgetSpec>>color (in category 'accessing') ----- color "Answer the selector for retrieving the button's color" ^color! ----- Method: PluggableWidgetSpec>>color: (in category 'accessing') ----- color: aSymbol "Indicate the selector for retrieving the button's color" color := aSymbol! ----- Method: PluggableWidgetSpec>>frame (in category 'accessing') ----- frame "Answer the receiver's layout frame" ^frame! ----- Method: PluggableWidgetSpec>>frame: (in category 'accessing') ----- frame: aRectangle "Indicate the receiver's layout frame" frame := aRectangle! ----- Method: PluggableWidgetSpec>>horizontalResizing (in category 'layout hints') ----- horizontalResizing ^ horizontalResizing! ----- Method: PluggableWidgetSpec>>horizontalResizing: (in category 'layout hints') ----- horizontalResizing: aSymbol "#rigid, #spaceFill, #shrinkWrap" horizontalResizing := aSymbol.! ----- Method: PluggableWidgetSpec>>margin (in category 'layout hints') ----- margin "Space outside the widgets border. See: http://www.w3.org/wiki/The_CSS_layout_model_-_boxes_borders_margins_padding" ^ margin! ----- Method: PluggableWidgetSpec>>margin: (in category 'layout hints') ----- margin: numberOrPointOrRectangle margin := numberOrPointOrRectangle.! ----- Method: PluggableWidgetSpec>>minimumExtent (in category 'layout hints') ----- minimumExtent ^ minimumExtent ifNil: [-1 @ -1]! ----- Method: PluggableWidgetSpec>>minimumExtent: (in category 'layout hints') ----- minimumExtent: aPoint minimumExtent := aPoint.! ----- Method: PluggableWidgetSpec>>minimumHeight (in category 'layout hints') ----- minimumHeight ^ self minimumExtent y! ----- Method: PluggableWidgetSpec>>minimumHeight: (in category 'layout hints') ----- minimumHeight: aNumber self minimumExtent: self minimumExtent x @ aNumber.! ----- Method: PluggableWidgetSpec>>minimumWidth (in category 'layout hints') ----- minimumWidth ^ self minimumExtent x! ----- Method: PluggableWidgetSpec>>minimumWidth: (in category 'layout hints') ----- minimumWidth: aNumber self minimumExtent: aNumber @ self minimumExtent y.! ----- Method: PluggableWidgetSpec>>model (in category 'accessing') ----- model "Answer the model for which this widget should be built" ^model! ----- Method: PluggableWidgetSpec>>model: (in category 'accessing') ----- model: aModel "Indicate the model for which this widget should be built" model := aModel.! ----- Method: PluggableWidgetSpec>>padding (in category 'layout hints') ----- padding "Space inside the widget's border. See: http://www.w3.org/wiki/The_CSS_layout_model_-_boxes_borders_margins_padding" ^ padding! ----- Method: PluggableWidgetSpec>>padding: (in category 'layout hints') ----- padding: numberOrPointOrRectangle padding := numberOrPointOrRectangle.! ----- Method: PluggableWidgetSpec>>verticalResizing (in category 'layout hints') ----- verticalResizing ^ verticalResizing! ----- Method: PluggableWidgetSpec>>verticalResizing: (in category 'layout hints') ----- verticalResizing: aSymbol "#rigid, #spaceFill, #shrinkWrap" verticalResizing := aSymbol.! ----- Method: ToolBuilderSpec>>buildWith: (in category 'building') ----- buildWith: aBuilder ^self subclassResponsibility! ----- Method: ToolBuilderSpec>>help (in category 'accessing') ----- help "Answer the message to get the help texts of this element." ^ help! ----- Method: ToolBuilderSpec>>help: (in category 'accessing') ----- help: aSymbol "Indicate the message to retrieve the help texts of this element." help := aSymbol! ----- Method: ToolBuilderSpec>>name (in category 'accessing') ----- name ^ name! ----- Method: ToolBuilderSpec>>name: (in category 'accessing') ----- name: anObject name := anObject! Object subclass: #UIManager instanceVariableNames: 'builderClass' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !UIManager commentStamp: 'dtl 5/2/2010 16:06' prior: 0! UIManager is a dispatcher for various user interface requests, such as menu and dialog interactions. An instance of UIManager is associated with each Project to implement the appropriate functions for Morphic, MVC or other user interfaces.! ----- Method: UIManager class>>default (in category 'class initialization') ----- default ^ Project current uiManager! ----- Method: UIManager class>>getDefault (in category 'class initialization') ----- getDefault "Ensure that a more specific manager can always be made by subclassing a tool builder and implementing a more specific way of reacting to #isActiveManager. For example, a BobsUIManager can subclass MorphicUIManager and (if enabled, say Preferences useBobsUI) will be considered before the parent (generic MorphicUIManager)." ^ (self allSubclasses detect: [:any | any isActiveManager and: [any subclasses noneSatisfy: [:sub | sub isActiveManager]]] ifNone: []) ifNotNilDo: [:mgrClass | mgrClass new]! ----- Method: UIManager class>>isActiveManager (in category 'class initialization') ----- isActiveManager "Answer whether I should act as the active ui manager" ^false! ----- Method: UIManager>>builderClass (in category 'builder') ----- builderClass "Answer the kind of tool builder to use, possibly influenced by project preferences" ^ builderClass ifNil: [ builderClass := ToolBuilder findDefault ]! ----- Method: UIManager>>builderClass: (in category 'accessing') ----- builderClass: aClass builderClass := aClass! ----- Method: UIManager>>chooseClassOrTrait (in category 'ui requests') ----- chooseClassOrTrait "Let the user choose a Class or Trait" ^self chooseClassOrTrait: 'Class name or fragment?'! ----- Method: UIManager>>chooseClassOrTrait: (in category 'ui requests') ----- chooseClassOrTrait: label "Let the user choose a Class or Trait" ^self chooseClassOrTrait: label from: Smalltalk environment! ----- Method: UIManager>>chooseClassOrTrait:from: (in category 'ui requests') ----- chooseClassOrTrait: label from: environment "Let the user choose a Class or Trait." | pattern | pattern := self request: label. ^ self classOrTraitFrom: environment pattern: pattern label: label ! ----- Method: UIManager>>chooseDirectory (in category 'ui requests') ----- chooseDirectory "Let the user choose a directory" ^self chooseDirectoryFrom: FileDirectory default! ----- Method: UIManager>>chooseDirectory: (in category 'ui requests') ----- chooseDirectory: label "Let the user choose a directory" ^self chooseDirectory: label from: FileDirectory default! ----- Method: UIManager>>chooseDirectory:from: (in category 'ui requests') ----- chooseDirectory: label from: dir "Let the user choose a directory" ^self subclassResponsibility! ----- Method: UIManager>>chooseDirectoryFrom: (in category 'ui requests') ----- chooseDirectoryFrom: dir "Let the user choose a directory" ^self chooseDirectory: nil from: dir! ----- Method: UIManager>>chooseFileMatching: (in category 'ui requests') ----- chooseFileMatching: patterns "Let the user choose a file matching the given patterns" ^self chooseFileMatching: patterns label: nil! ----- Method: UIManager>>chooseFileMatching:label: (in category 'ui requests') ----- chooseFileMatching: patterns label: labelString "Let the user choose a file matching the given patterns" ^self subclassResponsibility! ----- Method: UIManager>>chooseFont:for:setSelector:getSelector: (in category 'ui requests') ----- chooseFont: titleString for: aModel setSelector: setSelector getSelector: getSelector "Open a font-chooser for the given model"! ----- Method: UIManager>>chooseFrom: (in category 'ui requests') ----- chooseFrom: aList "Choose an item from the given list. Answer the index of the selected item." ^self chooseFrom: aList lines: #()! ----- Method: UIManager>>chooseFrom:lines: (in category 'ui requests') ----- chooseFrom: aList lines: linesArray "Choose an item from the given list. Answer the index of the selected item." ^self chooseFrom: aList lines: linesArray title: ''! ----- Method: UIManager>>chooseFrom:lines:title: (in category 'ui requests') ----- chooseFrom: aList lines: linesArray title: aString "Choose an item from the given list. Answer the index of the selected item." ^self subclassResponsibility! ----- Method: UIManager>>chooseFrom:title: (in category 'ui requests') ----- chooseFrom: aList title: aString "Choose an item from the given list. Answer the index of the selected item." ^self chooseFrom: aList lines: #() title: aString! ----- Method: UIManager>>chooseFrom:values: (in category 'ui requests') ----- chooseFrom: labelList values: valueList "Choose an item from the given list. Answer the selected item." ^self chooseFrom: labelList values: valueList lines: #()! ----- Method: UIManager>>chooseFrom:values:lines: (in category 'ui requests') ----- chooseFrom: labelList values: valueList lines: linesArray "Choose an item from the given list. Answer the selected item." ^self chooseFrom: labelList values: valueList lines: linesArray title: ''! ----- Method: UIManager>>chooseFrom:values:lines:title: (in category 'ui requests') ----- chooseFrom: labelList values: valueList lines: linesArray title: aString "Choose an item from the given list. Answer the selected item." ^self subclassResponsibility! ----- Method: UIManager>>chooseFrom:values:title: (in category 'ui requests') ----- chooseFrom: labelList values: valueList title: aString "Choose an item from the given list. Answer the selected item." ^self chooseFrom: labelList values: valueList lines: #() title: aString! ----- Method: UIManager>>chooseMultipleFrom: (in category 'ui requests') ----- chooseMultipleFrom: aList "Choose one or more items from the given list. Answer the indices of the selected items." ^ self chooseMultipleFrom: aList lines: #()! ----- Method: UIManager>>chooseMultipleFrom:lines: (in category 'ui requests') ----- chooseMultipleFrom: aList lines: linesArray "Choose one or more items from the given list. Answer the indices of the selected items." ^ self chooseMultipleFrom: aList lines: linesArray title: ''! ----- Method: UIManager>>chooseMultipleFrom:lines:title: (in category 'ui requests') ----- chooseMultipleFrom: aList lines: linesArray title: aString "Choose one or more items from the given list. Answer the indices of the selected items." ^ (self chooseFrom: aList lines: linesArray title: aString) in: [:result | result = 0 ifTrue: [#()] ifFalse: [{result}]]! ----- Method: UIManager>>chooseMultipleFrom:title: (in category 'ui requests') ----- chooseMultipleFrom: aList title: aString "Choose one or more items from the given list. Answer the indices of the selected items." ^self chooseMultipleFrom: aList lines: #() title: aString! ----- Method: UIManager>>chooseMultipleFrom:values: (in category 'ui requests') ----- chooseMultipleFrom: labelList values: valueList "Choose one or more items from the given list. Answer the selected items." ^ self chooseMultipleFrom: labelList values: valueList lines: #()! ----- Method: UIManager>>chooseMultipleFrom:values:lines: (in category 'ui requests') ----- chooseMultipleFrom: labelList values: valueList lines: linesArray "Choose one or more items from the given list. Answer the selected items." ^ self chooseMultipleFrom: labelList values: valueList lines: linesArray title: ''! ----- Method: UIManager>>chooseMultipleFrom:values:lines:title: (in category 'ui requests') ----- chooseMultipleFrom: labelList values: valueList lines: linesArray title: aString "Choose one or more items from the given list. Answer the selected items." ^ (self chooseFrom: labelList values: valueList lines: linesArray title: aString) ifNil: [#()] ifNotNil: [:resultValue | {resultValue}]! ----- Method: UIManager>>chooseMultipleFrom:values:title: (in category 'ui requests') ----- chooseMultipleFrom: labelList values: valueList title: aString "Choose one or more items from the given list. Answer the selected items." ^ self chooseMultipleFrom: labelList values: valueList lines: #() title: aString! ----- Method: UIManager>>classFromPattern:withCaption: (in category 'system introspecting') ----- classFromPattern: pattern withCaption: aCaption "If there is a class or trait whose name exactly given by pattern, return it. If there is only one class or trait in the system whose name matches pattern, return it. Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen. This method ignores separator characters in the pattern" ^self classOrTraitFrom: Smalltalk environment pattern: pattern label: aCaption " self classFromPattern: 'CharRecog' withCaption: '' self classFromPattern: 'rRecog' withCaption: '' self classFromPattern: 'znak' withCaption: '' self classFromPattern: 'orph' withCaption: '' self classFromPattern: 'TCompil' withCaption: '' " ! ----- Method: UIManager>>classOrTraitFrom:pattern:label: (in category 'system introspecting') ----- classOrTraitFrom: environment pattern: pattern label: label "If there is a class or trait whose name exactly given by pattern, return it. If there is only one class or trait in the given environment whose name matches pattern, return it. Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen. This method ignores separator characters in the pattern" | toMatch potentialNames names exactMatch lines reducedIdentifiers selectedIndex | toMatch := pattern copyWithoutAll: Character separators. toMatch ifEmpty: [ ^nil ]. "If there's a class or trait named as pattern, then return it." Symbol hasInterned: pattern ifTrue: [ :symbol | environment at: symbol ifPresent: [ :maybeClassOrTrait | ((maybeClassOrTrait isKindOf: Class) or: [ maybeClassOrTrait isTrait ]) ifTrue: [ ^maybeClassOrTrait ] ] ]. "No exact match, look for potential matches." toMatch := pattern asLowercase copyWithout: $.. potentialNames := (environment classAndTraitNames) asOrderedCollection. names := pattern last = $. "This is some old hack, using String>>#match: may be better." ifTrue: [ potentialNames select: [ :each | each asLowercase = toMatch ] ] ifFalse: [ potentialNames select: [ :each | each includesSubstring: toMatch caseSensitive: false ] ]. exactMatch := names detect: [ :each | each asLowercase = toMatch ] ifNone: [ nil ]. lines := OrderedCollection new. exactMatch ifNotNil: [ lines add: 1 ]. "Also try some fuzzy matching." reducedIdentifiers := pattern suggestedTypeNames select: [ :each | potentialNames includes: each ]. reducedIdentifiers ifNotEmpty: [ names addAll: reducedIdentifiers. lines add: 1 + names size + reducedIdentifiers size ]. "Let the user select if there's more than one possible match. This may give surprising results." selectedIndex := names size = 1 ifTrue: [ 1 ] ifFalse: [ exactMatch ifNotNil: [ names addFirst: exactMatch ]. self chooseFrom: names lines: lines title: label ]. selectedIndex = 0 ifTrue: [ ^nil ]. ^environment at: (names at: selectedIndex) asSymbol! ----- Method: UIManager>>confirm: (in category 'ui requests') ----- confirm: queryString "Put up a yes/no menu with caption queryString. Answer true if the response is yes, false if no. This is a modal question--the user must respond yes or no." ^self subclassResponsibility! ----- Method: UIManager>>confirm:orCancel: (in category 'ui requests') ----- confirm: aString orCancel: cancelBlock "Put up a yes/no/cancel menu with caption aString. Answer true if the response is yes, false if no. If cancel is chosen, evaluate cancelBlock. This is a modal question--the user must respond yes or no." ^self subclassResponsibility! ----- Method: UIManager>>confirm:orCancel:title: (in category 'ui requests') ----- confirm: aString orCancel: cancelBlock title: titleString "Put up a yes/no/cancel menu with caption aString, and titleString to label the dialog. Answer true if the response is yes, false if no. If cancel is chosen, evaluate cancelBlock. This is a modal question--the user must respond yes or no." ^self subclassResponsibility! ----- Method: UIManager>>confirm:title: (in category 'ui requests') ----- confirm: queryString title: titleString "Put up a yes/no menu with caption queryString, and titleString to label the dialog. Answer true if the response is yes, false if no. This is a modal question--the user must respond yes or no." ^self subclassResponsibility! ----- Method: UIManager>>confirm:title:trueChoice:falseChoice: (in category 'ui requests') ----- confirm: queryString title: titleString trueChoice: trueChoice falseChoice: falseChoice "Put up a yes/no menu with caption queryString, and titleString to label the dialog. The actual wording for the two choices will be as provided in the trueChoice and falseChoice parameters. Answer true if the response is the true-choice, false if it is the false-choice. This is a modal question -- the user must respond one way or the other." ^self subclassResponsibility! ----- Method: UIManager>>confirm:trueChoice:falseChoice: (in category 'ui requests') ----- confirm: queryString trueChoice: trueChoice falseChoice: falseChoice "Put up a yes/no menu with caption queryString. The actual wording for the two choices will be as provided in the trueChoice and falseChoice parameters. Answer true if the response is the true-choice, false if it's the false-choice. This is a modal question -- the user must respond one way or the other." ^self subclassResponsibility! ----- Method: UIManager>>displayProgress:at:from:to:during: (in category 'ui requests') ----- displayProgress: titleString at: aPoint from: minVal to: maxVal during: workBlock "Display titleString as a caption over a progress bar while workBlock is evaluated." ^self subclassResponsibility! ----- Method: UIManager>>edit: (in category 'ui requests') ----- edit: aText "Open an editor on the given string/text" ^self edit: aText label: nil! ----- Method: UIManager>>edit:label: (in category 'ui requests') ----- edit: aText label: labelString "Open an editor on the given string/text" ^self edit: aText label: labelString accept: nil! ----- Method: UIManager>>edit:label:accept: (in category 'ui requests') ----- edit: aText label: labelString accept: anAction "Open an editor on the given string/text" ^self subclassResponsibility! ----- Method: UIManager>>inform: (in category 'ui requests') ----- inform: aString "Display a message for the user to read and then dismiss" ^self subclassResponsibility! ----- Method: UIManager>>informUser:during: (in category 'ui requests') ----- informUser: aString during: aBlock "Display a message above (or below if insufficient room) the cursor during execution of the given block. UIManager default informUser: 'Just a sec!!' during: [(Delay forSeconds: 1) wait]. " ^self informUserDuring:[:bar| bar value: aString. aBlock value].! ----- Method: UIManager>>informUserDuring: (in category 'ui requests') ----- informUserDuring: aBlock "Display a message above (or below if insufficient room) the cursor during execution of the given block. UIManager default informUserDuring:[:bar| #(one two three) do:[:info| bar value: info. (Delay forSeconds: 1) wait]]" ^self subclassResponsibility! ----- Method: UIManager>>multiLineRequest:centerAt:initialAnswer:answerHeight: (in category 'ui requests') ----- multiLineRequest: queryString centerAt: aPoint initialAnswer: defaultAnswer answerHeight: answerHeight "Create a multi-line instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. Answer nil if the user cancels. An empty string returned means that the ussr cleared the editing area and then hit 'accept'. Because multiple lines are invited, we ask that the user use the ENTER key, or (in morphic anyway) hit the 'accept' button, to submit; that way, the return key can be typed to move to the next line." ^self subclassResponsibility! ----- Method: UIManager>>newDisplayDepthNoRestore: (in category 'display') ----- newDisplayDepthNoRestore: pixelSize self subclassResponsibility.! ----- Method: UIManager>>request: (in category 'ui requests') ----- request: queryString "Create an instance of me whose question is queryString. Invoke it centered at the cursor, and answer the string the user accepts. Answer the empty string if the user cancels." ^self request: queryString initialAnswer: ''! ----- Method: UIManager>>request:initialAnswer: (in category 'ui requests') ----- request: queryString initialAnswer: defaultAnswer "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. Answer the empty string if the user cancels." ^self subclassResponsibility! ----- Method: UIManager>>request:initialAnswer:centerAt: (in category 'ui requests') ----- request: queryString initialAnswer: defaultAnswer centerAt: aPoint "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. Answer the empty string if the user cancels." ^self subclassResponsibility! ----- Method: UIManager>>requestPassword: (in category 'ui requests') ----- requestPassword: queryString "Create an instance of me whose question is queryString. Invoke it centered at the cursor, and answer the string the user accepts. Answer the empty string if the user cancels." ^self subclassResponsibility! ----- Method: UIManager>>restoreDisplay (in category 'display') ----- restoreDisplay self subclassResponsibility.! ----- Method: UIManager>>restoreDisplayAfter: (in category 'display') ----- restoreDisplayAfter: aBlock self subclassResponsibility.! ----- Method: UIManager>>screenBounds (in category 'accessing') ----- screenBounds ^ Display boundingBox! ----- Method: UIManager>>toolBuilder (in category 'builder') ----- toolBuilder ^ self builderClass new!
More information about the Squeak-dev mailing list |