[squeak-dev] The Inbox: ToolBuilder-Morphic-ct.320.mczcommits at source.squeak.org commits at source.squeak.orgThu Jul 14 14:15:43 UTC 2022
A new version of ToolBuilder-Morphic was added to project The Inbox: http://source.squeak.org/inbox/ToolBuilder-Morphic-ct.320.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-ct.320 Author: ct Time: 9 July 2022, 7:31:16.926611 pm UUID: b0d78612-83dd-624c-81ed-41909b6f1026 Ancestors: ToolBuilder-Morphic-ct.319 Merges polish-file-dialogs: Cleans up, tests, and improves the convenience of file selection dialogs. UI improvements: * Add input field for file path to all dialogs. In file dialogs, a directory path can be entered to navigate to the relevant directory in the tree. * Update enablement of canAccept button based on input * Improve automatic selection of filenames * Use explicit help texts instead of filling the input field with a help message * Fixes handling of patterns/suffixes in save dialog * Double click a file/directory to choose it * Save dialog: Assure that the name of an existing directory cannot be chosen as a new file name * Small MVC improvements (however, modal invocation in MVC is still broken at the moment) Refactoring: * Overall deduplication * Consistent spelling of fileName (instead of filename) * Add new suite of acceptance tests Revision: * Fix default selection in directory chooser * Improve todo notes * Update tests to recent ClassTestCase refactoring * Prepare tree selection for path normalization =============== Diff against ToolBuilder-Morphic-ct.319 =============== Item was removed: - SystemOrganization addCategory: #'ToolBuilder-Morphic'! - SystemOrganization addCategory: #'ToolBuilder-Morphic-Tools'! Item was removed: - ----- Method: DialogWindow>>openAsTool (in category '*ToolBuilder-Morphic-opening') ----- - openAsTool - - ^ self getUserResponse! Item was removed: - FileAbstractSelectionDialog subclass: #DirectoryChooserDialog - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic-Tools'! - - !DirectoryChooserDialog commentStamp: 'tpr 4/2/2018 09:52' prior: 0! - A DirectoryChooserDialog is a modal dialog to allow choosing a directory. The actual directory chosen is returned, or nil if no selection was made. - - Normal usage would be - myDirectory := DirectoryChooserDialog openOn: myApplicationDefaultDirectory label: 'Choose the directory to use' - ! Item was removed: - ----- Method: DirectoryChooserDialog class>>findAFolderForProject:label: (in category 'instance creation') ----- - findAFolderForProject: aProject label: labelString - "Select a directory for either saving or loading a project file" - "Temporary simple version without the 'interesting' blue ui stuff - See FileList2 class>>#modalFolderSelectorForProject: for the full horror" - ^self openOn: FileDirectory default label: labelString! Item was removed: - ----- Method: DirectoryChooserDialog class>>openOn:label: (in category 'instance creation') ----- - openOn: aDirectory label: labelString - "open a directory chooser starting with aDirectory" - - "DirectoryChooserDialog openOn: FileDirectory default label: 'Choose the directory to use' " - - ^super new - directory: aDirectory; - message: labelString; - getUserResponse! Item was removed: - ----- Method: DirectoryChooserDialog>>acceptFileName (in category 'initialize-release') ----- - acceptFileName - "User clicked to accept the current state so save the directory and close the dialog" - - finalChoice := directory. - self changed: #close! Item was removed: - ----- Method: DirectoryChooserDialog>>buildButtonsWith: (in category 'toolbuilder') ----- - buildButtonsWith: builder - "add a 'new directory' button to the beginning of the row of buttons" - ^{ builder pluggableButtonSpec new - model: self; - label: 'New Directory' translated; - color: (self userInterfaceTheme get: #buttonColor for: #DialogWindow); - action: #newDirectoryName}, (super buildButtonsWith: builder)! Item was removed: - ----- Method: DirectoryChooserDialog>>buildDirectoryTreeWith: (in category 'toolbuilder') ----- - buildDirectoryTreeWith: builder - - ^ (super buildDirectoryTreeWith: builder) - hScrollBarPolicy: #never; "Use the dialog grips to see more" - yourself! Item was removed: - ----- Method: DirectoryChooserDialog>>buildWith: (in category 'toolbuilder') ----- - buildWith: builder - "assemble the spec for the chooser dialog UI" - - | windowSpec window | - windowSpec := self buildWindowWith: builder specs: { - (self frameOffsetFromTop: 0 - fromLeft: 0 - width: 1 - offsetFromBottom: 0) -> [self buildDirectoryTreeWith: builder]. - }. - windowSpec buttons addAll: ( self buildButtonsWith: builder ). - window := builder build: windowSpec. - window addKeyboardCaptureFilter: self. - self changed: #selectedPath. - ^window - ! Item was removed: - ----- Method: DirectoryChooserDialog>>finalChoice (in category 'ui details') ----- - finalChoice - "return the chosen directory that was saved by an accept click or nil; client must check for validity" - - ^ finalChoice - ifNotNil: [self directory]! Item was removed: - ----- Method: DirectoryChooserDialog>>initialExtent (in category 'toolbuilder') ----- - initialExtent - "Since this is a single list it can be a bit narrower than a FileChooserDialog" - - ^ super initialExtent * (0.6 @ 1)! Item was removed: - ----- Method: DirectoryChooserDialog>>userMessage (in category 'ui details') ----- - userMessage - "return the string to present to the user in order to explain the purpose of this dialog appearing" - - ^message ifNil: ['Choose a directory name' translated]! Item was removed: - ----- Method: DirectoryChooserDialog>>windowTitle (in category 'ui details') ----- - windowTitle - - ^ 'Choose Directory' translated! Item was removed: - Model subclass: #FileAbstractSelectionDialog - instanceVariableNames: 'patternList directory directoryCache message listIndex fileName finalChoice nameList sizeList dateList suffixList' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic-Tools'! - - !FileAbstractSelectionDialog commentStamp: 'tpr 11/21/2017 18:18' prior: 0! - FileAbstractSelectionDialog is the abstract superclass for the file chooser & saver modal dialogs. - - The UI provides a message to the user, a text input field, a directory tree widget and a list of files within any chosen directory, and buttons to accept the selected file name/path or cancel the operation. See subclass comments and class side methods for specific usage examples. - - Instance Variables - directory: <FileDirectory> used for the currently selected directory - directoryCache: <WeakIdentityKeyDictionary> used to cache a boolean to help us more quickly populate the directory tree widget when revisiting a directory - fileName: <String|nil> the name of the currently selected file, if any - finalChoice: <String|nil> pathname of the finally chosen file, returned as the result of accepting; nil is returned otherwise - list: <Array> the list of String of filenames (and date/size) that match the current pattern - listIndex: <Integer> list index of the currently selected file - patternList: <OrderedCollection of String> the patterns are held as a collection of string that may include * or # wildcards. See FileAbstractSelectionDialog>>#parsePatternString for details - message: <String> a message to the user to explain what is expected - nameList,DateList, sizeList: <Array> the list of file names matching the pattern and the appropriate date and size values, formatted for a PluggableMultiColumnListMorph! Item was removed: - ----- Method: FileAbstractSelectionDialog>>acceptFileName (in category 'initialize-release') ----- - acceptFileName - "User clicked to accept the current state so save the filename and close the dialog" - - finalChoice := fileName. - self changed: #close! Item was removed: - ----- Method: FileAbstractSelectionDialog>>buildButtonsWith: (in category 'toolbuilder') ----- - buildButtonsWith: builder - - ^ { - builder pluggableButtonSpec new - model: self; - label: 'Accept' translated; - color: (self userInterfaceTheme get: #okColor for: #DialogWindow); - action: #acceptFileName. - builder pluggableButtonSpec new - model: self; - label: 'Cancel' translated; - color: (self userInterfaceTheme get: #cancelColor for: #DialogWindow); - action: #cancelFileChooser}! Item was removed: - ----- Method: FileAbstractSelectionDialog>>buildDirectoryTreeWith: (in category 'toolbuilder') ----- - buildDirectoryTreeWith: builder - | treeSpec | - treeSpec := builder pluggableTreeSpec new. - treeSpec - model: self ; - roots: #rootDirectoryList ; - hasChildren: #hasMoreDirectories: ; - getChildren: #subDirectoriesOf: ; - getSelectedPath: #selectedPath ; - setSelected: #setDirectoryTo: ; - getSelected: #directory; - label: #directoryNameOf: ; - menu: nil ; - autoDeselect: false . - ^ treeSpec! Item was removed: - ----- Method: FileAbstractSelectionDialog>>buildFileListWith: (in category 'toolbuilder') ----- - buildFileListWith: builder - | listSpec | - listSpec := builder pluggableListSpec new. - listSpec - model: self ; - list: #fileList ; - getIndex: #fileListIndex ; - setIndex: #fileListIndex: ; - menu: nil ; - keyPress: nil ; - frame: - (self - frameOffsetFromTop:0 - fromLeft: 0 - width: 1 - bottomFraction: 1) . - ^listSpec! Item was removed: - ----- Method: FileAbstractSelectionDialog>>buildTextInputWith: (in category 'toolbuilder') ----- - buildTextInputWith: builder - | textSpec | - textSpec := builder pluggableInputFieldSpec new. - textSpec - model: self; - name: #inputText ; - font: self textViewFont; - getText: #inputText; - setText: #selectFilename:; - selection: #contentsSelection. - ^textSpec - ! Item was removed: - ----- Method: FileAbstractSelectionDialog>>buildWindowWith: (in category 'toolbuilder') ----- - buildWindowWith: builder - "Since a file chooser is a modal dialog we over-ride the normal window build to use a dialog as the top component" - - | windowSpec | - windowSpec := builder pluggableDialogSpec new. - windowSpec model: self; - label: #windowTitle; - message: #userMessage; - extent: self initialExtent; - children: OrderedCollection new; - buttons: OrderedCollection new. - ^windowSpec! Item was removed: - ----- Method: FileAbstractSelectionDialog>>buildWith: (in category 'toolbuilder') ----- - buildWith: builder - "assemble the spec for the common chooser/saver dialog UI" - - ^self subclassResponsibility! Item was removed: - ----- Method: FileAbstractSelectionDialog>>buttonHeight (in category 'ui details') ----- - buttonHeight - - ^ ToolBuilder default buttonRowHeight! Item was removed: - ----- Method: FileAbstractSelectionDialog>>cancelFileChooser (in category 'initialize-release') ----- - cancelFileChooser - "User clicked to cancel the current state so nil the filename and close the dialog" - - directory := finalChoice := fileName := nil. - self changed: #close.! Item was removed: - ----- Method: FileAbstractSelectionDialog>>defaultPatternList (in category 'path and pattern') ----- - defaultPatternList - - ^#('*')! Item was removed: - ----- Method: FileAbstractSelectionDialog>>directory (in category 'directory tree') ----- - directory - "If nobody has set a specific directory we need a plausible default" - - ^ directory ifNil: [ directory := FileDirectory default]! Item was removed: - ----- Method: FileAbstractSelectionDialog>>directory: (in category 'directory tree') ----- - directory: aFileDirectory - "Set the path of the directory to be displayed in the directory tree pane" - - directory := aFileDirectory! Item was removed: - ----- Method: FileAbstractSelectionDialog>>directoryNameOf: (in category 'directory tree') ----- - directoryNameOf: aDirectory - "Return a name for the selected directory in the tree view" - - ^aDirectory localName! Item was removed: - ----- Method: FileAbstractSelectionDialog>>entriesMatching: (in category 'file list') ----- - entriesMatching: patternList - "Answer a list of directory entries which match any of the patterns. - See #parsePatternString for the pattern rules" - - | entries | - "This odd clause helps supports MVC projects; the file list & directory views are built from a list that includes directories. In Morphic we filter out the directories because they are entirely handled by the direcctory tree morph" - entries := Smalltalk isMorphic - ifTrue:[self directory fileEntries ] - ifFalse:[self directory entries]. - - (patternList anySatisfy: [:each | each = '*']) - ifTrue: [^ entries]. - - ^ entries select: [:entry | patternList anySatisfy: [:each | each match: entry name]]! Item was removed: - ----- Method: FileAbstractSelectionDialog>>fileList (in category 'file list') ----- - fileList - "return the list of files in the currently selected directory; if we haven't yet read an actual directory return empty lists for now" - - nameList ifNil: [nameList := dateList := sizeList := #()]. - ^nameList! Item was removed: - ----- Method: FileAbstractSelectionDialog>>fileListIndex (in category 'file list') ----- - fileListIndex - "return the index in the list of files for the currently selected file; we initialise this to 0 so that the initial listmorph doesn't get upset before we actually populate it with file details - which we don't do until a directory is selected" - - ^listIndex! Item was removed: - ----- Method: FileAbstractSelectionDialog>>fileListIndex: (in category 'file list') ----- - fileListIndex: anInteger - "We've selected the file at the given index, so find the file name." - - self okToChange ifFalse: [^ self]. - listIndex := anInteger. - listIndex = 0 - ifTrue: [fileName := nil] - ifFalse: [fileName := nameList at: anInteger]. "open the file selected" - - self - changed: #fileListIndex; - changed: #inputText! Item was removed: - ----- Method: FileAbstractSelectionDialog>>filterEvent:for: (in category 'event handling') ----- - filterEvent: aKeyboardEvent for: aMorph - - | char | - aKeyboardEvent isKeystroke ifFalse: [^ aKeyboardEvent]. - aKeyboardEvent anyModifierKeyPressed ifTrue: [^ aKeyboardEvent]. - - char := aKeyboardEvent keyCharacter. - - (char = Character cr or: [char = Character enter]) - ifTrue: [self acceptFileName. aKeyboardEvent ignore]. - char = Character escape - ifTrue: [self cancelFileChooser. aKeyboardEvent ignore]. - - ^ aKeyboardEvent! Item was removed: - ----- Method: FileAbstractSelectionDialog>>finalChoice (in category 'initialize-release') ----- - finalChoice - "return the chosen directory/filename that was saved by an accept click or nil; client must check for validity" - ^ finalChoice - ifNotNil: [self directory fullNameFor: finalChoice]! Item was removed: - ----- Method: FileAbstractSelectionDialog>>frameOffsetFromTop:fromLeft:width:bottomFraction: (in category 'ui details') ----- - frameOffsetFromTop: height fromLeft: leftFraction width: widthFraction bottomFraction: bottomFraction - "return a layout frame that starts at the fixed upper offset and goes down to the bottomFraction, and runs widthFraction from the leftFraction" - - ^LayoutFrame new - topFraction: 0 offset: height; - leftFraction: leftFraction offset: 0; - rightFraction: (leftFraction + widthFraction) offset: 0; - bottomFraction: bottomFraction offset: 0; - yourself.! Item was removed: - ----- Method: FileAbstractSelectionDialog>>frameOffsetFromTop:fromLeft:width:offsetFromBottom: (in category 'ui details') ----- - frameOffsetFromTop: height fromLeft: leftFraction width: widthFraction offsetFromBottom: bottomOffset - "return a layout frame that starts at the fixed upper offset and goes down to the bottom - the offsetn, and runs widthFraction from the leftFraction" - - ^LayoutFrame new - topFraction: 0 offset: height; - leftFraction: leftFraction offset: 0; - rightFraction: (leftFraction + widthFraction) offset: 0; - bottomFraction: 1 offset: bottomOffset negated; - yourself.! Item was removed: - ----- Method: FileAbstractSelectionDialog>>getUserResponse (in category 'toolbuilder') ----- - getUserResponse - "open the dialog modally and get a user response" - - ToolBuilder open: self. - ^self finalChoice! Item was removed: - ----- Method: FileAbstractSelectionDialog>>hasMoreDirectories: (in category 'directory tree') ----- - hasMoreDirectories: aDirectory - "The directory tree morph needs to know if a specific directory has subdirectories; we cache the answer to speed up later visits to the same directory" - - ^directoryCache at: aDirectory ifAbsentPut:[ - [aDirectory hasSubDirectories] on: Error do:[:ex| true]. - ].! Item was removed: - ----- Method: FileAbstractSelectionDialog>>initialExtent (in category 'toolbuilder') ----- - initialExtent - - ^ (super initialExtent * (0.8 @ 0.7) * RealEstateAgent scaleFactor) truncated! Item was removed: - ----- Method: FileAbstractSelectionDialog>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - directoryCache := WeakIdentityKeyDictionary new. - listIndex := 0. - patternList := self defaultPatternList. - suffixList := OrderedCollection new! Item was removed: - ----- Method: FileAbstractSelectionDialog>>listForPatterns: (in category 'path and pattern') ----- - listForPatterns: arrayOfPatterns - "build lists of name, date and size for those file names which match any of the patterns in the array. - We use a Set to avoid duplicates and sort them by name" - - | newList | - newList := Set new. - newList addAll: (self entriesMatching: arrayOfPatterns). - - newList := newList sorted: [:a :b| - a name <= b name]. - nameList := newList collect:[:e| e name]. - dateList := newList collect:[:e| ((Date fromSeconds: e modificationTime ) - printFormat: #(3 2 1 $. 1 1 2)) , ' ' , - (String streamContents: [:s | - (Time fromSeconds: e modificationTime \\ 86400) - print24: true on: s])]. - sizeList := newList collect:[:e| e fileSize asStringWithCommas] - ! Item was removed: - ----- Method: FileAbstractSelectionDialog>>message: (in category 'ui details') ----- - message: aStringOrText - "set the user message to be dispalyed at the top of the dialog - it should guide the user as to what they must do" - - message := aStringOrText! Item was removed: - ----- Method: FileAbstractSelectionDialog>>newDirectoryName (in category 'directory tree') ----- - newDirectoryName - "Create a new directory; will be a subdirectory of the current chosen directory. - If the user input is empty, or if the directory creation fails, fail this method. - Update the directory tree display afterwards and set the current directory to the newly created directory" - |userInput| - userInput := UIManager default request: 'New directory name' translated initialAnswer: 'newDir'. - userInput isEmptyOrNil ifTrue: [^nil]. - - [self directory createDirectory: userInput] ifError:[^nil]. "I hate using ifError: - it's so indiscriminate. Really ought to be a more precise error to catch properly" - - self changed: #rootDirectoryList. - self directory: (self directory / userInput). - self changed: #selectedPath! Item was removed: - ----- Method: FileAbstractSelectionDialog>>parsePatternString: (in category 'file list') ----- - parsePatternString: aStringOrNil - "The pattern is a string that may have three simple tokens included along with normal characters; - a) a ; or LF or CR splits the string into separate patterns and filenames matching any of them will be included in list - b) a * matches any number of characters - c) a # matches one character" - - | patterns | - aStringOrNil ifNil:[^self defaultPatternList]. - patterns := OrderedCollection new. - (aStringOrNil findTokens: (String with: Character cr with: Character lf with: $;)) - do: [ :each | - (each includes: $*) | (each includes: $#) - ifTrue: [ patterns add: each] - ifFalse: [each isEmptyOrNil - ifTrue: [ patterns add: '*'] - ifFalse: [ patterns add: '*' , each , '*']]]. - - ^patterns! Item was removed: - ----- Method: FileAbstractSelectionDialog>>pattern: (in category 'path and pattern') ----- - pattern: textOrStringOrNil - "Make sure the pattern source string is neither nil nor empty. - We can strictly speaking handle arbitrary patterns to match against the filenames but in general we need to use suffices, so see #suffix: and #suffixList: " - - patternList := self parsePatternString: textOrStringOrNil! Item was removed: - ----- Method: FileAbstractSelectionDialog>>rootDirectoryList (in category 'directory tree') ----- - rootDirectoryList - "Return a list of know root directories; forms the root nodes ot the directory tree morph" - - | dirList dir | - dir := FileDirectory root. - dirList := self subDirectoriesOf: dir. - dirList isEmpty ifTrue:[dirList := Array with: FileDirectory default]. - ^dirList ,(ServerDirectory servers values) "looks odd because #servers returns the Dictionary of known servers with local names instead of the actaul server directories"! Item was removed: - ----- Method: FileAbstractSelectionDialog>>selectedPath (in category 'path and pattern') ----- - selectedPath - "Return an array of directories representing the path from directory up to the root; used to build the directory tree morph" - - | top here | - top := FileDirectory root. - here := self directory. - ^(Array streamContents:[:s| | next | - s nextPut: here. - [next := here containingDirectory. - top pathName = next pathName] whileFalse:[ - s nextPut: next. - here := next. - ]]) reversed.! Item was removed: - ----- Method: FileAbstractSelectionDialog>>setDirectoryTo: (in category 'directory tree') ----- - setDirectoryTo: dir - "Set the current directory shown in the FileList. - Does not allow setting the directory to nil since this blows up in various places." - - dir ifNil:[^self]. - "okToChange is probably redundant. - modelSleep/Wake is related to use of ServerDirectories, which are not yet hooked up" - self okToChange ifFalse: [ ^ self ]. - self modelSleep. - self directory: dir. - self modelWakeUp. - self changed: #directory. - self updateFileList. - self changed: #inputText! Item was removed: - ----- Method: FileAbstractSelectionDialog>>subDirectoriesOf: (in category 'directory tree') ----- - subDirectoriesOf: aDirectory - "provide a list of subdirectory names sorted alphnum-no-case" - - ^(aDirectory directoryNames sorted: [:a :b| (a compare: b) <= 2]) collect:[:each| aDirectory directoryNamed: each].! Item was removed: - ----- Method: FileAbstractSelectionDialog>>suffix: (in category 'path and pattern') ----- - suffix: textOrStringOrNil - "Make a pattern from a single filename suffix string, i.e. 'jpg'" - - self suffixList: (Array with: textOrStringOrNil )! Item was removed: - ----- Method: FileAbstractSelectionDialog>>suffixList: (in category 'path and pattern') ----- - suffixList: listOfStrings - "Make a pattern list from a one or more filename suffix strings in a list , i.e. #('jpg' 'mpeg') " - listOfStrings isEmptyOrNil - ifTrue: [ patternList := self defaultPatternList ] - ifFalse: - [ patternList := OrderedCollection new. - listOfStrings do: - [ : each | each isEmptyOrNil ifFalse: - [ patternList add: '*.' , each. - suffixList add: each ] ] ]! Item was removed: - ----- Method: FileAbstractSelectionDialog>>textViewFont (in category 'ui details') ----- - textViewFont - - ^ TextStyle defaultFont! Item was removed: - ----- Method: FileAbstractSelectionDialog>>textViewHeight (in category 'ui details') ----- - textViewHeight - - ^ ToolBuilder default inputFieldHeight! Item was removed: - ----- Method: FileAbstractSelectionDialog>>topConstantHeightFrame:fromLeft:width: (in category 'ui details') ----- - topConstantHeightFrame: height fromLeft: leftFraction width: widthFraction - "return a layout to make a fixed height frame that starts at the top of its parent and runs widthFraction from the leftFraction." - - ^LayoutFrame new - topFraction: 0 offset: 0; - leftFraction: leftFraction offset: 0; - rightFraction: (leftFraction + widthFraction) offset: 0; - bottomFraction: 0 offset: height; - yourself.! Item was removed: - ----- Method: FileAbstractSelectionDialog>>updateFileList (in category 'file list') ----- - updateFileList - "Update my files list with file names in the current directory that match the patternList." - - Cursor wait - showWhile: [self listForPatterns: patternList. - listIndex := 0. - self changed: #fileList]! Item was removed: - ----- Method: FileAbstractSelectionDialog>>userMessage (in category 'ui details') ----- - userMessage - - ^ message ifNil: ['']! Item was removed: - FileAbstractSelectionDialog subclass: #FileChooserDialog - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic-Tools'! - - !FileChooserDialog commentStamp: 'dtl 12/21/2017 22:18' prior: 0! - A FileChooserDialog is a modal dialog to allow choosing a file. The full file name is returned, or nil if no selection was made. - - Normal usage would be - myFilename := FileChooserDialog openOn: myApplicationDefaultDirectory pattern: '*.myapp' label: 'Choose the file to load' - to find a file with a name matching *.myapp and with the directory initial choice set to myApplicationDefaultDirectory. Only filenames matching the pattern will appear in the file list view. - ! Item was removed: - ----- Method: FileChooserDialog class>>openOn: (in category 'instance creation') ----- - openOn: aDirectory - "Open a modal dialog to choose a file. Start the dialog with aDirectory selected - and files matching the default 'everything' pattern" - - "FileChooserDialog openOn: FileDirectory default" - - ^self openOn: aDirectory pattern: nil label: nil - ! Item was removed: - ----- Method: FileChooserDialog class>>openOn:pattern:label: (in category 'instance creation') ----- - openOn: aDirectory pattern: matchString label: labelString - "Open a modal dialog to choose a file. Start the dialog with aDirectory selected - and files matching the matchString pattern. Set the user message to labelString." - - "FileChooserDialog openOn: FileDirectory default pattern: '*.changes' label: 'Do something with the selected files' " - - ^self new - directory: aDirectory; - pattern: matchString; - message: labelString; - getUserResponse! Item was removed: - ----- Method: FileChooserDialog class>>openOn:suffixList:label: (in category 'instance creation') ----- - openOn: aDirectory suffixList: aCollection label: labelString - "Open a modal dialog to choose a file. Start the dialog with aDirectory selected and files matching the file name suffixes in aCollection. Set the user message to labelString." - - "FileChooserDialog openOn: FileDirectory default suffixList: { 'changes' . 'image' } label: 'Do something with the selected files' " - - ^self new - directory: aDirectory; - suffixList: aCollection; - message: labelString; - getUserResponse! Item was removed: - ----- Method: FileChooserDialog class>>openOnPattern:label: (in category 'instance creation') ----- - openOnPattern: matchString label: labelString - "Open a modal dialog to choose a file. Start the dialog with a default directory - selected and with files matching the default 'everything' pattern Set the user - message to labelString" - - "FileChooserDialog openOnPattern: '*.changes' label: 'Do something with the selected files' " - - ^self openOn: nil pattern: matchString label: labelString - ! Item was removed: - ----- Method: FileChooserDialog class>>openOnSuffixList:label: (in category 'instance creation') ----- - openOnSuffixList: patternList label: labelString - "Open a modal dialog to choose a file. Start the dialog with a default directory - selected and with files matching the file name suffixes in patternList. Set the - user message to labelString." - - "FileChooserDialog openOnSuffixList: { 'changes' . 'image' } label: 'Do something with the selected files' " - - ^self openOn: nil suffixList: patternList label: labelString - ! Item was removed: - ----- Method: FileChooserDialog>>buildWith: (in category 'toolbuilder') ----- - buildWith: builder - "assemble the spec for the chooser dialog UI" - - | windowSpec window | - windowSpec := self buildWindowWith: builder specs: { - (self frameOffsetFromTop: 0 - fromLeft: 0.35 - width: 0.65 - offsetFromBottom: 0) -> [self buildFileListWith: builder]. - (self frameOffsetFromTop: 0 - fromLeft: 0 - width: 0.35 - offsetFromBottom: 0) -> [self buildDirectoryTreeWith: builder]. - }. - windowSpec buttons addAll: ( self buildButtonsWith: builder ). - window := builder build: windowSpec. - window addKeyboardCaptureFilter: self. - self changed: #selectedPath. - ^window - ! Item was removed: - ----- Method: FileChooserDialog>>userMessage (in category 'ui details') ----- - userMessage - "return the string to present to the user in order to explain the purpose of this dialog appearing" - - ^message ifNil: ['Choose a file name' translated]! Item was removed: - ----- Method: FileChooserDialog>>windowTitle (in category 'ui details') ----- - windowTitle - "return the window label; would be some application dependent string but I suspect we will want to make the outer morph a dialogue box with no label anyway" - - ^ 'Choose File' translated! Item was removed: - FileAbstractSelectionDialog subclass: #FileSaverDialog - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic-Tools'! - - !FileSaverDialog commentStamp: 'dtl 12/21/2017 22:47' prior: 0! - A FileSaverDialog is a modal dialog for choosing a file name to use for saving a file. - - Users can enter a filename in the text input view that will - a) if it exists in the current directry listing, be selected - b) over ride any filenames in the current directory, providing a way to specify a completely new file. - This will not affect the selected directory path. - - Normal usage would be - myFilename := FileSaverDialog openOnInitialFilename: myApp saveFileName - which would derive a directory, an initial filename and filename suffix from the given file name. Thus a typical application save might be - ... openOnInitialFilename: '/home/pi/myApp/examplePicture.jpg' - and would set the initial directory to /home/pi/myapp, the initial filename to examplePicture.jpg and set a suffix pattern of 'jpg'. Only filenames with the specified suffix will appear in the file list view. It is possible to specify several suffices, (see #suffixList:) and use wildcards within the suffix. - - myFilename := FileSaverDialog openOn: myApplicationDefaultDirectory initialFilename: 'foo.myapp' - would set directory initial choice set to myApplicationDefaultDirectory and ignore any directory found in the filename. It would be quite possible to choose a file from any other directory and with any other name that matches the suffix if the user wishes, so the file name must be carefully checked. - - The full set of options would involve - myFilename := FileSaverDialog openOn: myApplicationDefaultDirectory initialFilename: 'foo.myapp' suffix: 'mya' message: 'Save your myApp file to ... ' - - It is also possible to set a more general pattern to match filenames against but since this seems less useful for normal application usage there are no convenience messages as yet. - - See the class side methods for details. See my parent class for most implementation details! Item was removed: - ----- Method: FileSaverDialog class>>openOn: (in category 'instance creation') ----- - openOn: aDirectory - "open a modal dialog to save a file. Start the dialog with aDirectory selected - and no suggested file name" - - "FileSaverDialog openOn: FileDirectory default" - - ^self openOn: aDirectory initialFilename: nil label: nil - ! Item was removed: - ----- Method: FileSaverDialog class>>openOn:initialFilename: (in category 'instance creation') ----- - openOn: aDirectory initialFilename: aString - "Open a modal dialog to save a file. Start the dialog with aDirectory selected - and aString as the suggested file name. Note that we set the directory after - the initialFilename becuase we want a specific directory and not neccesarily - the directory of the file." - - "FileSaverDialog openOn: FileDirectory default initialFilename: 'aSuggestedFileName' " - - ^self openOn: aDirectory initialFilename: aString label: nil - ! Item was removed: - ----- Method: FileSaverDialog class>>openOn:initialFilename:label: (in category 'instance creation') ----- - openOn: aDirectory initialFilename: aString label: labelString - "Open a modal dialog to save a file. Start the dialog with aDirectory selected - and aString as the suggested file name. Set the user message to labelString. - Note that we set the directory after the initialFilename becuase we want a - specific directory and not neccesarily the directory of the file" - - "FileSaverDialog openOn: FileDirectory default initialFilename: 'aSuggestedFileName' label: 'Select a flie and do something with it' " - - ^self new - directory: aDirectory; - initialFilename: aString; "Might include a path and thus override aDirectory." - message: labelString; - getUserResponse - - ! Item was removed: - ----- Method: FileSaverDialog class>>openOnInitialFilename: (in category 'instance creation') ----- - openOnInitialFilename: filenameString - "Open a modal dialog to save a file. Start the dialog with the default directory - selected and the suggested file name." - - "FileSaverDialog openOnInitialFilename: 'aSuggestedFileName' " - - ^self openOn: nil initialFilename: filenameString label: nil - ! Item was removed: - ----- Method: FileSaverDialog class>>openOnInitialFilename:label: (in category 'instance creation') ----- - openOnInitialFilename: filenameString label: labelString - "Open a modal dialog to save a file. Start the dialog with the default directory - selected and the suggested file name, set the user message to labelString" - - "FileSaverDialog openOnInitialFilename: 'aSuggestedFileName' label: 'Select a flie and do something with it' " - - ^self openOn: nil initialFilename: filenameString label: labelString - ! Item was removed: - ----- Method: FileSaverDialog>>acceptFileName (in category 'initialize-release') ----- - acceptFileName - "make sure to accept any edit in the filename before closing" - - self changed: #acceptChanges. - ^super acceptFileName! Item was removed: - ----- Method: FileSaverDialog>>buildButtonsWith: (in category 'toolbuilder') ----- - buildButtonsWith: builder - "add a 'new directory' button to the beginning of the row of buttons" - ^{ builder pluggableButtonSpec new - model: self; - label: 'New Directory' translated; - color: (self userInterfaceTheme get: #buttonColor for: #DialogWindow); - action: #newDirectoryName}, (super buildButtonsWith: builder)! Item was removed: - ----- Method: FileSaverDialog>>buildWith: (in category 'toolbuilder') ----- - buildWith: builder - "assemble the spec for the saver dialog UI and build the window" - - | window windowSpec | - windowSpec := self buildWindowWith: builder specs: { - (self topConstantHeightFrame: self textViewHeight - fromLeft: 0 - width: 1) -> [self buildTextInputWith: builder]. - (self frameOffsetFromTop: self textViewHeight - fromLeft: 0.35 - width: 0.65 - offsetFromBottom: 0) -> [self buildFileListWith: builder]. - (self frameOffsetFromTop: self textViewHeight - fromLeft: 0 - width: 0.35 - offsetFromBottom: 0) -> [self buildDirectoryTreeWith: builder]. - }. - windowSpec buttons addAll: ( self buildButtonsWith: builder ). - window := builder build: windowSpec. - window addKeyboardCaptureFilter: self. - self changed: #selectedPath. - self inputText: fileName. - window positionOverWidgetNamed: #inputText. - ^window - ! Item was removed: - ----- Method: FileSaverDialog>>contentsSelection (in category 'ui details') ----- - contentsSelection - ^ 1 to: 9999! Item was removed: - ----- Method: FileSaverDialog>>initialFilename: (in category 'initialize-release') ----- - initialFilename: aFilenameOrNil - "Set the initial choice of filename to highlight. - We split the potential filename to see if it includes a path and if so, use that as the chosen directory - the client can manually change that with a subsequent send of #directory: if wanted. - We split the root filename to find an extension and use that as the suffix - again, the client can manually change that later" - - | e f p | - aFilenameOrNil ifNil:[^self]. - - p := FileDirectory dirPathFor: aFilenameOrNil. - p isEmpty ifFalse:[self directory: (FileDirectory on: p)]. - f := FileDirectory localNameFor: aFilenameOrNil. - fileName := f. - e := FileDirectory extensionFor: f. - e isEmpty ifFalse:[self suffix: e]! Item was removed: - ----- Method: FileSaverDialog>>inputText (in category 'filename') ----- - inputText - "return the filename to appear in the text field" - - ^fileName ifNil:['Enter a filename here or choose from list' translated]! Item was removed: - ----- Method: FileSaverDialog>>inputText: (in category 'filename') ----- - inputText: aText - "Initialize the filename entry field to aString. If a file with that name already exists, set up to highlight it." - aText ifNil: [^ self]. - fileName := aText asString. - self selectExistingFilename! Item was removed: - ----- Method: FileSaverDialog>>selectExistingFilename (in category 'private') ----- - selectExistingFilename - "Answer whether an existing file in the list matches my proposed filename, selecting it if it does." - ^ (patternList anySatisfy: - [ : each | (each - compare: fileName - caseSensitive: FileDirectory default isCaseSensitive) = 2 ]) - and: - [ listIndex := nameList findFirst: [ : each | each = fileName ]. - true ]! Item was removed: - ----- Method: FileSaverDialog>>selectFilename: (in category 'filename') ----- - selectFilename: aText - "The user has entered a potential filename in the text field. Check it against the current pattern; if it is ok we can accept it and then if it is a file in the current list, highlight it. If it would not match the pattern, alert the user." - fileName := aText asString. - ^ self selectExistingFilename - ifTrue: - [ self changed: #fileListIndex. - true ] - ifFalse: - [ suffixList size = 1 - ifTrue: - [ | suffix | - ((suffix := '.' , suffixList anyOne) - compare: (fileName last: (suffix size min: fileName size)) - caseSensitive: FileDirectory default isCaseSensitive) = 2 ifFalse: [ fileName := fileName , suffix ]. - true ] - ifFalse: - [ suffixList - at: - (UIManager default - chooseFrom: suffixList - title: 'Please choose the type of file to save.' translated) - ifPresent: - [ : choice | fileName := fileName , '.' , choice. - true ] - ifAbsent: - [ suffixList isEmpty or: - [ self inform: ('WARNING: File not saved!! A filename matching one of {1} patterns is required.' translated format: {patternList asArray}). - false ] ] ] ]! Item was removed: - ----- Method: FileSaverDialog>>userMessage (in category 'ui details') ----- - userMessage - "return the string to present to the user in order to explain the purpose of this dialog appearing" - - ^message ifNil: ['Choose a file name; you can also edit the name below to create a new file name' translated]! Item was removed: - ----- Method: FileSaverDialog>>windowTitle (in category 'ui details') ----- - windowTitle - "return the window label; would be some application dependent string but I suspect we will want to make the outer morph a dialogue box with no label anyway" - - ^ 'Save As File' translated! Item was removed: - Model subclass: #ListChooser - instanceVariableNames: 'selectedIndex items searchText addAllowed result title listMorph dialogMorph' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic-Tools'! - - !ListChooser commentStamp: 'MAD 3/14/2010 16:20' prior: 0! - I am a simple dialog to allow the user to pick from a list of strings or symbols. - I support keyboard and mouse navigation, and interactive filtering of the displayed items. - - You can specify whether you want the index, or the value of the selected item. If you're interested in the value, you can also allow users to Add a new value not in the list. - - cmd-s or <enter> or double-click answers the currently selected item's value/index; - cmd-l or <escape> or closing the window answers nil/zero. - - Now using ToolBuilder, so needs Morphic-MAD.381. - - Released under the MIT Licence.! Item was removed: - ----- Method: ListChooser class>>chooseFrom: (in category 'instance creation') ----- - chooseFrom: aList - - ^ self - chooseFrom: aList - title: self defaultTitle! Item was removed: - ----- Method: ListChooser class>>chooseFrom:title: (in category 'instance creation') ----- - chooseFrom: aList title: aString - ^ self - chooseIndexFrom: aList - title: aString - addAllowed: false! Item was removed: - ----- Method: ListChooser class>>chooseIndexFrom: (in category 'instance creation') ----- - chooseIndexFrom: aList - - ^ self - chooseIndexFrom: aList - title: self defaultTitle! Item was removed: - ----- Method: ListChooser class>>chooseIndexFrom:title: (in category 'instance creation') ----- - chooseIndexFrom: aList title: aString - - ^ self - chooseIndexFrom: aList - title: aString - addAllowed: false! Item was removed: - ----- Method: ListChooser class>>chooseIndexFrom:title:addAllowed: (in category 'instance creation') ----- - chooseIndexFrom: aList title: aString addAllowed: aBoolean - - ^ self new - chooseIndexFrom: aList - title: aString - addAllowed: aBoolean! Item was removed: - ----- Method: ListChooser class>>chooseItemFrom: (in category 'instance creation') ----- - chooseItemFrom: aList - - ^ self - chooseItemFrom: aList - title: self defaultTitle! Item was removed: - ----- Method: ListChooser class>>chooseItemFrom:title: (in category 'instance creation') ----- - chooseItemFrom: aList title: aString - ^ self - chooseItemFrom: aList - title: aString - addAllowed: false! Item was removed: - ----- Method: ListChooser class>>chooseItemFrom:title:addAllowed: (in category 'instance creation') ----- - chooseItemFrom: aList title: aString addAllowed: aBoolean - - ^ self new - chooseItemFrom: aList - title: aString - addAllowed: aBoolean! Item was removed: - ----- Method: ListChooser class>>defaultTitle (in category 'instance creation') ----- - defaultTitle - - ^ 'Please choose' translated! Item was removed: - ----- Method: ListChooser class>>testDictionary (in category 'examples') ----- - testDictionary - ^ self - chooseItemFrom: (Dictionary newFrom: {#a->1. 2->#b.}) - title: 'Pick from Dictionary' "gives values, not keys"! Item was removed: - ----- Method: ListChooser class>>testIndex (in category 'examples') ----- - testIndex - ^ self - chooseIndexFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection - title: 'Pick a class'! Item was removed: - ----- Method: ListChooser class>>testItem (in category 'examples') ----- - testItem - ^ self - chooseItemFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection - title: 'Pick a class'! Item was removed: - ----- Method: ListChooser class>>testItemAdd (in category 'examples') ----- - testItemAdd - ^ self - chooseItemFrom: (Smalltalk classNames , Smalltalk traitNames) asOrderedCollection - title: 'Pick or Add:' - addAllowed: true! Item was removed: - ----- Method: ListChooser class>>testLongTitle (in category 'examples') ----- - testLongTitle - ^ self - chooseItemFrom: #(this is a list of values that aren/t the point here) - title: 'Pick from some values from this list'! Item was removed: - ----- Method: ListChooser class>>testSet (in category 'examples') ----- - testSet - ^ self - chooseItemFrom: #(a list of values as a Set) asSet - title: 'Pick from Set'! Item was removed: - ----- Method: ListChooser class>>themeProperties (in category 'preferences') ----- - themeProperties - - ^ super themeProperties, { - { #okColor. 'Colors'. 'Color for the OK button.' }. - { #cancelColor. 'Colors'. 'Color for the Cancel button.' }. - { #addColor. 'Colors'. 'Color for a normal button.' }. - { #disabledColor. 'Colors'. 'Color for a disabled button.' }. - }! Item was removed: - ----- Method: ListChooser>>accept (in category 'actions') ----- - accept - "if the user submits with no valid entry, make them start over" - - | choice | - self canAccept ifFalse: [ - self canAdd ifTrue: [^ self add]. - ^ self changed: #textSelection]. - - choice := self selectedItem. - - self canAdd ifTrue: [ - "Ask the user whether to add the new item or choose the list selection." - (UserDialogBoxMorph - confirm: 'You can either choose an existing item or add a new one.\What do you want?' translated withCRs - title: 'Choose or Add' translated - trueChoice: choice asString - falseChoice: self searchText asString at: self currentHand position) - ifNil: ["Cancelled" self result: nil. ^ self] - ifNotNil: [:answer | - answer ifTrue: [self result: choice] ifFalse: [self result: self searchText asString]] - ] ifFalse: [self result: choice]. - - self changed: #close.! Item was removed: - ----- Method: ListChooser>>acceptColor (in category 'colors') ----- - acceptColor - - self canAdd ifTrue: [^ self addColor]. - - ^ self canAccept - ifTrue: [ self userInterfaceTheme okColor ifNil: [(Color r: 0.49 g: 0.749 b: 0.49)] ] - ifFalse: [ self userInterfaceTheme disabledColor ifNil: [Color lightGray] ]! Item was removed: - ----- Method: ListChooser>>acceptLabel (in category 'colors') ----- - acceptLabel - - ^ self canAdd - ifFalse: ['Choose' translated] - ifTrue: [self canAccept - ifTrue: ['Choose or Add' translated] - ifFalse: ['Add' translated]]! Item was removed: - ----- Method: ListChooser>>acceptText: (in category 'actions') ----- - acceptText: someText - "the text morph wants to tell us about its contents but I don't care, I'm only interested in the list" - self accept! Item was removed: - ----- Method: ListChooser>>add (in category 'actions') ----- - add - "if the user submits with no valid entry, make them start over" - self canAdd ifFalse: [^ self changed: #textSelection]. - self result: self searchText asString. - self changed: #close.! Item was removed: - ----- Method: ListChooser>>addAllowed (in category 'accessing') ----- - addAllowed - - ^ addAllowed ifNil: [false]! Item was removed: - ----- Method: ListChooser>>addAllowed: (in category 'accessing') ----- - addAllowed: anObject - - addAllowed := anObject! Item was removed: - ----- Method: ListChooser>>addColor (in category 'colors') ----- - addColor - - ^ self canAdd - ifTrue: [ self userInterfaceTheme addColor ifNil: [Color blue muchLighter] ] - ifFalse: [ self userInterfaceTheme disabledColor ifNil: [Color lightGray] ]! Item was removed: - ----- Method: ListChooser>>applyUserInterfaceTheme (in category 'updating') ----- - applyUserInterfaceTheme - - super applyUserInterfaceTheme. - - self - changed: #okColor; - changed: #cancelColor; - changed: #addColor.! Item was removed: - ----- Method: ListChooser>>buildWith: (in category 'building') ----- - buildWith: builder - - | dialogSpec searchBarHeight listSpec fieldSpec | - - searchBarHeight := self searchBarHeight. - - dialogSpec := builder pluggableDialogSpec new - model: self; - title: #title; - closeAction: #closed; - extent: self initialExtent; - autoCancel: true; "Behave like a pop-up menu. Historical reasons." - children: OrderedCollection new; - buttons: OrderedCollection new; - yourself. - - listSpec := builder pluggableListSpec new. - listSpec - model: self; - list: #items; - getIndex: #selectedIndex; - setIndex: #selectedIndex:; - doubleClick: #accept; - "keystrokePreview: #keyStrokeFromList:;" - autoDeselect: false; - filterableList: true; - clearFilterAutomatically: false; - name: #list; - frame: (LayoutFrame fractions: (0 at 0 corner: 1 at 1) offsets: (0 at searchBarHeight corner: 0 at 0)). - dialogSpec children add: listSpec. - - fieldSpec := builder pluggableInputFieldSpec new. - fieldSpec - model: self; - name: #searchText ; - getText: #searchText; - editText: #searchText:; - setText: #acceptText:; - selection: #textSelection; - menu: nil; - indicateUnacceptedChanges: false; - askBeforeDiscardingEdits: false; - help: (self addAllowed ifTrue: ['Type new or filter existing...' translated] ifFalse: ['Type to filter existing...' translated]); - frame: (LayoutFrame fractions: (0 at 0 corner: 1 at 0) offsets: (0 at 0 corner: 0 at searchBarHeight)). - dialogSpec children add: fieldSpec. - - "Buttons" - dialogSpec buttons add: ( - builder pluggableButtonSpec new - model: self; - label: #acceptLabel; - action: #accept; - enabled: #canAcceptOrAdd; - color: #acceptColor). - - dialogSpec buttons add: ( - builder pluggableButtonSpec new - model: self; - label: 'Cancel' translated; - action: #cancel; - color: #cancelColor). - - dialogMorph := builder build: dialogSpec. - dialogMorph addKeyboardCaptureFilter: self ; positionOverWidgetNamed: #searchText. - listMorph := builder widgetAt: #list. - listMorph allowEmptyFilterResult: true. - - ^ dialogMorph! Item was removed: - ----- Method: ListChooser>>canAccept (in category 'testing') ----- - canAccept - ^ self selectedIndex > 0! Item was removed: - ----- Method: ListChooser>>canAcceptOrAdd (in category 'testing') ----- - canAcceptOrAdd - ^ self canAccept or: [self canAdd]! Item was removed: - ----- Method: ListChooser>>canAdd (in category 'testing') ----- - canAdd - ^ self addAllowed - and: [self searchText asString withBlanksTrimmed notEmpty] - and: [self selectedItem asString ~= self searchText asString]! Item was removed: - ----- Method: ListChooser>>cancel (in category 'actions') ----- - cancel - - self result: nil. - self changed: #close.! Item was removed: - ----- Method: ListChooser>>cancelColor (in category 'colors') ----- - cancelColor - - ^ self userInterfaceTheme cancelColor ifNil: [Color r: 1 g: 0.6 b: 0.588]! Item was removed: - ----- Method: ListChooser>>chooseIndexFrom:title: (in category 'initialize-release') ----- - chooseIndexFrom: labelList title: aString - | choice | - choice := self chooseItemFrom: labelList title: aString addAllowed: false. - ^ self items indexOf: choice! Item was removed: - ----- Method: ListChooser>>chooseIndexFrom:title:addAllowed: (in category 'initialize-release') ----- - chooseIndexFrom: labelList title: aString addAllowed: aBoolean - | choice | - choice := self chooseItemFrom: labelList title: aString addAllowed: false. - self addAllowed: aBoolean. - ^ self items indexOf: choice! Item was removed: - ----- Method: ListChooser>>chooseItemFrom:title:addAllowed: (in category 'initialize-release') ----- - chooseItemFrom: labelList title: aString addAllowed: aBoolean - - self items: labelList asOrderedCollection. - self title: aString. - self addAllowed: aBoolean. - - ToolBuilder open: self. - ^ self result! Item was removed: - ----- Method: ListChooser>>closed (in category 'actions') ----- - closed - - self selectedIndex: 0.! Item was removed: - ----- Method: ListChooser>>filterEvent:for: (in category 'event handling') ----- - filterEvent: aKeyboardEvent for: aMorph - - | char | - aKeyboardEvent isKeystroke ifFalse: [^ aKeyboardEvent]. - aKeyboardEvent anyModifierKeyPressed ifTrue: [^ aKeyboardEvent]. - - char := aKeyboardEvent keyCharacter. - - char = Character backspace - ifTrue: [self searchText: (self searchText asString ifNotEmpty: [:s | s allButLast]). ^ aKeyboardEvent ignore]. - char = Character delete - ifTrue: [self searchText: (self searchText asString ifNotEmpty: [:s | s allButFirst]). ^ aKeyboardEvent ignore]. - (char = Character cr or: [char = Character enter]) - ifTrue: [self accept. aKeyboardEvent ignore]. - char = Character escape - ifTrue: [self cancel. aKeyboardEvent ignore]. - (char asInteger between: 32 and: 126) - ifTrue: [self searchText: self searchText asString, char asString. aKeyboardEvent ignore]. - (char = Character arrowUp or: [char = Character arrowDown - or: [char = Character pageUp or: [char = Character pageDown - or: [char = Character home or: [char = Character end]]]]]) - ifTrue: [listMorph keyStroke: aKeyboardEvent. ^aKeyboardEvent ignore]. - - ^ aKeyboardEvent! Item was removed: - ----- Method: ListChooser>>initialExtent (in category 'building') ----- - initialExtent - - | listFont listStyle itemCount maxItemSize | - listFont := Preferences standardListFont. - listStyle := listFont asNewTextStyle. - itemCount := items size. - maxItemSize := (items take: 15) inject: 0 into: [:max :item | max max: item asString size]. - - ^ (listStyle compositionWidthFor: (maxItemSize min: 50 max: 35)) - @ ((ToolBuilder default listHeightFor: (itemCount min: 15 max: 5)) - + self searchBarHeight - + ToolBuilder default dialogSpacing)! Item was removed: - ----- Method: ListChooser>>items (in category 'accessing') ----- - items - - ^ items! Item was removed: - ----- Method: ListChooser>>items: (in category 'accessing') ----- - items: anObject - - items := anObject! Item was removed: - ----- Method: ListChooser>>preferredExtent (in category 'building') ----- - preferredExtent - - | listFont cellSize | - listFont := Preferences standardListFont. - cellSize := (listFont widthOf: $x) @ listFont lineGridForMorphs. - - ^ ((items inject: 0 into: [:max :item | max max: (listFont widthOfString: item asString)]) + cellSize x "breathing space") - @ ((ToolBuilder default listHeightFor: items size) - + self searchBarHeight - + ToolBuilder default dialogSpacing)! Item was removed: - ----- Method: ListChooser>>result (in category 'accessing') ----- - result - - ^ result! Item was removed: - ----- Method: ListChooser>>result: (in category 'accessing') ----- - result: anObject - - result := anObject! Item was removed: - ----- Method: ListChooser>>searchBarHeight (in category 'building') ----- - searchBarHeight - - ^ ToolBuilder default inputFieldHeight! Item was removed: - ----- Method: ListChooser>>searchText (in category 'accessing') ----- - searchText - ^ searchText ifNil: [ searchText := '' ]! Item was removed: - ----- Method: ListChooser>>searchText: (in category 'accessing') ----- - searchText: aString - searchText := aString. - listMorph listFilterSet: aString asString. - - self changed: #searchText. - self changed: #canAcceptOrAdd. - self changed: #acceptLabel. - self changed: #buttons.! Item was removed: - ----- Method: ListChooser>>selectedIndex (in category 'accessing') ----- - selectedIndex - ^ selectedIndex ifNil: [ self items size min: 1 ]! Item was removed: - ----- Method: ListChooser>>selectedIndex: (in category 'accessing') ----- - selectedIndex: anInt - selectedIndex := anInt. - self changed: #selectedIndex.! Item was removed: - ----- Method: ListChooser>>selectedItem (in category 'accessing') ----- - selectedItem - - ^ self items at: self selectedIndex ifAbsent: []! Item was removed: - ----- Method: ListChooser>>textSelection (in category 'accessing') ----- - textSelection - ^ self searchText size +1 to: self searchText size ! Item was removed: - ----- Method: ListChooser>>title (in category 'accessing') ----- - title - - ^ (title isNil or: [ title isEmpty ]) - ifTrue: [ title := self class defaultTitle ] - ifFalse: [ title ]! Item was removed: - ----- Method: ListChooser>>title: (in category 'accessing') ----- - title: aString - title := aString.! Item was removed: - Model subclass: #ListMultipleChooser - instanceVariableNames: 'selection labels values title choice' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic-Tools'! - - !ListMultipleChooser commentStamp: 'mt 4/14/2015 17:09' prior: 0! - I am like the ListChooser but for multiple choices. I have no extra search field. Enable the preference #filterableLists if lists get too big to choose from. Also, I do not support adding new items to the choice.! Item was removed: - ----- Method: ListMultipleChooser class>>chooseFrom:title: (in category 'instance creation') ----- - chooseFrom: someLabels title: aString - - ^ self chooseIndexListFrom: someLabels title: aString! Item was removed: - ----- Method: ListMultipleChooser class>>chooseIndexListFrom:title: (in category 'instance creation') ----- - chooseIndexListFrom: someObjects title: aString - - ^ self new - title: aString; - labels: (someObjects collect: [:ea | ea asString]); - choose! Item was removed: - ----- Method: ListMultipleChooser class>>chooseItemListFrom:title: (in category 'instance creation') ----- - chooseItemListFrom: someObjects title: aString - - ^ self new - title: aString; - labels: (someObjects collect: [:ea | ea asString]); - values: someObjects; - choose! Item was removed: - ----- Method: ListMultipleChooser class>>defaultTitle (in category 'instance creation') ----- - defaultTitle - - ^ 'Please choose multiple' translated! Item was removed: - ----- Method: ListMultipleChooser class>>themeProperties (in category 'preferences') ----- - themeProperties - - ^ super themeProperties, { - { #okColor. 'Colors'. 'Color for the OK button.' }. - { #cancelColor. 'Colors'. 'Color for the Cancel button.' }. - }! Item was removed: - ----- Method: ListMultipleChooser>>accept (in category 'actions') ----- - accept - - choice := #accepted. - self changed: #close.! Item was removed: - ----- Method: ListMultipleChooser>>applyUserInterfaceTheme (in category 'updating') ----- - applyUserInterfaceTheme - - super applyUserInterfaceTheme. - - self - changed: #okColor; - changed: #cancelColor.! Item was removed: - ----- Method: ListMultipleChooser>>buildWith: (in category 'toolbuilder') ----- - buildWith: builder - - | dialogSpec choicesSpec | - dialogSpec := builder pluggableDialogSpec new - model: self; - extent: self initialExtent; - title: #title; - children: OrderedCollection new; - buttons: OrderedCollection new. - - choicesSpec := builder pluggableMultiSelectionListSpec new - model: self; - list: #labels; - setIndex: #selectedIndex:; - getIndex: #selectedIndex; - setSelectionList: #selectionAt:put:; - getSelectionList: #selectionAt:; - frame: (0 at 0 corner: 1 at 1). - dialogSpec children add: choicesSpec. - - "Buttons" - dialogSpec buttons add: ( - builder pluggableButtonSpec new - model: self; - label: 'accept'; - color: (self userInterfaceTheme okColor ifNil: [Color r: 0.49 g: 0.749 b: 0.49]); - action: #accept). - - dialogSpec buttons add: ( - builder pluggableButtonSpec new - model: self; - label: 'cancel'; - color: (self userInterfaceTheme cancelColor ifNil: [Color r: 1 g: 0.6 b: 0.588]); - action: #cancel). - - ^ builder build: dialogSpec! Item was removed: - ----- Method: ListMultipleChooser>>cancel (in category 'actions') ----- - cancel - - choice := #cancelled. - self changed: #close.! Item was removed: - ----- Method: ListMultipleChooser>>choose (in category 'actions') ----- - choose - - - " self changed: #inputRequested with: #selectedIndex. - " - ToolBuilder open: self. - ^ self selectedValues! Item was removed: - ----- Method: ListMultipleChooser>>initialExtent (in category 'toolbuilder') ----- - initialExtent - - | listFont listStyle itemCount maxItemSize | - listFont := Preferences standardListFont. - listStyle := listFont asNewTextStyle. - itemCount := labels size. - maxItemSize := (labels take: 15) inject: 0 into: [:max :item | max max: item asString size]. - - ^ (listStyle compositionWidthFor: (maxItemSize min: 50 max: 35)) - @ (ToolBuilder default listHeightFor: (itemCount min: 15 max: 5))! Item was removed: - ----- Method: ListMultipleChooser>>labels (in category 'accessing') ----- - labels - - ^ labels! Item was removed: - ----- Method: ListMultipleChooser>>labels: (in category 'accessing') ----- - labels: someStrings - - labels := someStrings. - self changed: #labels.! Item was removed: - ----- Method: ListMultipleChooser>>preferredExtent (in category 'toolbuilder') ----- - preferredExtent - - | listFont cellSize | - listFont := Preferences standardListFont. - cellSize := (listFont widthOf: $x) @ listFont lineGridForMorphs. - - ^ ((labels inject: 0 into: [:max :item | max max: (listFont widthOfString: item asString)]) + cellSize x "breathing space") - @ (ToolBuilder default listHeightFor: labels size)! Item was removed: - ----- Method: ListMultipleChooser>>selectedIndex (in category 'accessing') ----- - selectedIndex - "Sigh. Required from widget..." - ^ 0! Item was removed: - ----- Method: ListMultipleChooser>>selectedIndex: (in category 'accessing') ----- - selectedIndex: anIndex - "Sigh. Required from widget..." - self changed: #selectedIndex.! Item was removed: - ----- Method: ListMultipleChooser>>selectedValues (in category 'accessing') ----- - selectedValues - - | i | - choice ~~ #accepted ifTrue: [^ nil]. - - i := 0. - ^ self values select: [:object | i := i + 1. self selection at: i]! Item was removed: - ----- Method: ListMultipleChooser>>selection (in category 'accessing') ----- - selection - - ^ selection ifNil: [selection := Array new: self values size withAll: false]! Item was removed: - ----- Method: ListMultipleChooser>>selectionAt: (in category 'accessing') ----- - selectionAt: index - - ^ self selection at: index! Item was removed: - ----- Method: ListMultipleChooser>>selectionAt:put: (in category 'accessing') ----- - selectionAt: index put: boolean - - self selection at: index put: boolean. - self changed: #selectionAt:! Item was removed: - ----- Method: ListMultipleChooser>>title (in category 'accessing') ----- - title - - ^ (title isNil or: [ title isEmpty ]) - ifTrue: [ title := self class defaultTitle ] - ifFalse: [ title ]! Item was removed: - ----- Method: ListMultipleChooser>>title: (in category 'accessing') ----- - title: aString - - title := aString. - self changed: #title.! Item was removed: - ----- Method: ListMultipleChooser>>values (in category 'accessing') ----- - values - - ^ values ifNil: [values := (1 to: self labels size) asArray]! Item was removed: - ----- Method: ListMultipleChooser>>values: (in category 'accessing') ----- - values: someObjects - - values := someObjects.! Item was removed: - ----- Method: MenuMorph>>openAsTool (in category '*ToolBuilder-Morphic-opening') ----- - openAsTool - - self popUpInWorld: Project current world.! Item was removed: - ----- Method: Morph>>buildWith: (in category '*ToolBuilder-Morphic-opening') ----- - buildWith: aToolBuilder - "A Morph is already built, so simply return myself" - ^self! Item was removed: - ----- Method: Morph>>inspectorClass (in category '*ToolBuilder-Morphic') ----- - inspectorClass - - ^ MorphInspector! Item was removed: - ----- Method: Morph>>openAsTool (in category '*ToolBuilder-Morphic-opening') ----- - openAsTool - - self openInWorld.! Item was removed: - Inspector subclass: #MorphInspector - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic-Tools'! - - !MorphInspector commentStamp: 'mt 4/22/2020 08:13' prior: 0! - I am an inspector for morphs. In addition to field values I display properties of the morph, and add additional selections to the field item menu.! Item was removed: - ----- Method: MorphInspector>>addFieldItemsTo: (in category 'menu - construction') ----- - addFieldItemsTo: aMenu - - super addFieldItemsTo: aMenu. - - self isMorphSelected ifFalse: [^ self]. - - aMenu addLine. - - aMenu addTranslatedList: #( - ('open screenshot in hand' openScreenshotInHand) - ('open screenshot in world' openScreenshotInWorld)).! Item was removed: - ----- Method: MorphInspector>>fieldExtent (in category 'fields') ----- - fieldExtent - - ^ (self newFieldForType: #misc key: #extent) - name: 'extent' translated; emphasizeName; - valueGetter: [:morph | morph extent]; - valueSetter: [:morph :newExtent | morph extent: newExtent]; - yourself! Item was removed: - ----- Method: MorphInspector>>fieldScreenshot (in category 'fields') ----- - fieldScreenshot - - ^ (self newFieldForType: #misc key: #screenshot) - name: 'screenshot' translated; emphasizeName; - printValueAsIs; - valueGetter: [:morph | - | screenshot | - screenshot := morph imageForm. - FormInspector new embedForm: screenshot inText: screenshot printString]; - valueGetterExpression: 'self imageForm'; - yourself! Item was removed: - ----- Method: MorphInspector>>isMorphSelected (in category 'morphs') ----- - isMorphSelected - - ^ [self selectionOrObject isMorph] ifError: [false]! Item was removed: - ----- Method: MorphInspector>>openScreenshotInHand (in category 'menu - commands') ----- - openScreenshotInHand - - ^ self selectedMorph imageForm asMorph openInHand! Item was removed: - ----- Method: MorphInspector>>openScreenshotInWorld (in category 'menu - commands') ----- - openScreenshotInWorld - - ^ self selectedMorph imageForm asMorph openInWorld! Item was removed: - ----- Method: MorphInspector>>selectedMorph (in category 'morphs') ----- - selectedMorph - - ^ self selectionOrObject! Item was removed: - ----- Method: MorphInspector>>streamBaseFieldsOn: (in category 'fields - streaming') ----- - streamBaseFieldsOn: aStream - - super streamBaseFieldsOn: aStream. - aStream - nextPut: self fieldExtent; - nextPut: self fieldScreenshot.! Item was removed: - ----- Method: MorphInspector>>streamInstanceVariablesOn: (in category 'fields - streaming') ----- - streamInstanceVariablesOn: aStream - - super streamInstanceVariablesOn: aStream. - self streamPropertiesOn: aStream.! Item was removed: - ----- Method: MorphInspector>>streamPropertiesOn: (in category 'fields - streaming') ----- - streamPropertiesOn: aStream - "Prepend all properties with # (hash) so that users can distinguish them from regular instance variables. Trigger both #layoutChanged and #changed to be sure that any value changes yield the expected visual updates. Note that this is required because we invade the morph's privacy by exposing its extension object this way; normal updates are handled only through the morph's public interface. For example, compare Morph >> #visible: with MorphExtension >> #visible:." - - | extension field | - (extension := self object extension) ifNil: [^ self]. - - extension sortedPropertyNames do: [:property | - (extension respondsTo: property) - ifTrue: [field := (self newFieldForType: #property key: property) - name: property printString; - valueGetter: [:morph | morph extension perform: property]; - valueSetter: [:morph :value | - morph extension perform: property asSimpleSetter with: value. - morph layoutChanged; changed]; - yourself] - ifFalse: [field := (self newFieldForType: #property key: property) - name: property printString; - valueGetter: [:morph | morph extension valueOfProperty: property]; - valueSetter: [:morph :value | - morph extension setProperty: property toValue: value. - morph layoutChanged; changed]; - yourself]. - - aStream nextPut: field].! Item was removed: - ToolBuilder subclass: #MorphicToolBuilder - instanceVariableNames: 'widgets panes parentMenu' - classVariableNames: 'ButtonBorderWidth ButtonMargins ListBorderWidth ListMargins TextBorderWidth TextMargins' - poolDictionaries: '' - category: 'ToolBuilder-Morphic'! - - !MorphicToolBuilder commentStamp: 'ar 2/11/2005 15:02' prior: 0! - The Morphic tool builder.! Item was removed: - ----- Method: MorphicToolBuilder class>>applyUserInterfaceTheme (in category 'preferences') ----- - applyUserInterfaceTheme - - TextBorderWidth := nil. - ListBorderWidth := nil. - ButtonBorderWidth := nil. - - TextMargins := nil. - ListMargins := nil. - ButtonMargins := nil.! Item was removed: - ----- Method: MorphicToolBuilder class>>getBoundsForWindow: (in category 'services') ----- - getBoundsForWindow: morph - - ^ morph bounds! Item was removed: - ----- Method: MorphicToolBuilder class>>isActiveBuilder (in category 'accessing') ----- - isActiveBuilder - "Answer whether I am the currently active builder" - ^Smalltalk isMorphic! Item was removed: - ----- Method: MorphicToolBuilder class>>setBoundsForWindow:to: (in category 'services') ----- - setBoundsForWindow: morph to: rectangle - - ^ morph bounds: rectangle! Item was removed: - ----- Method: MorphicToolBuilder class>>themePriority (in category 'preferences') ----- - themePriority - - ^ 65! Item was removed: - ----- Method: MorphicToolBuilder class>>themeProperties (in category 'preferences') ----- - themeProperties - "Let theme switches clear my cache. See #applyUserInterfaceTheme." - - ^ { - { #textBorderWidth. 'tool construction'. ''}. - { #listBorderWidth. 'tool construction'. ''}. - { #buttonBorderWidth. 'tool construction'. ''}. - { #textMargins. 'tool construction'. ''}. - { #listMargins. 'tool construction'. ''}. - { #buttonMargins. 'tool construction'. ''}. - }! Item was removed: - ----- Method: MorphicToolBuilder>>add:to: (in category 'private') ----- - add: aMorph to: aParent - - aMorph layoutFrame - ifNotNil: [aParent addMorph: aMorph fullFrame: aMorph layoutFrame] - ifNil: [aParent addMorphBack: aMorph].! Item was removed: - ----- Method: MorphicToolBuilder>>alternateMultiSelectListClass (in category 'widget classes') ----- - alternateMultiSelectListClass - ^ AlternatePluggableListMorphOfMany ! Item was removed: - ----- Method: MorphicToolBuilder>>applyUserInterfaceTheme (in category 'updating') ----- - applyUserInterfaceTheme - "See class side."! Item was removed: - ----- Method: MorphicToolBuilder>>asFrame: (in category 'private') ----- - asFrame: aRectangle - | frame | - aRectangle ifNil:[^nil]. - frame := LayoutFrame new. - frame - leftFraction: aRectangle left; - rightFraction: aRectangle right; - topFraction: aRectangle top; - bottomFraction: aRectangle bottom. - ^frame! Item was removed: - ----- Method: MorphicToolBuilder>>buildHelpFor:spec: (in category 'private') ----- - buildHelpFor: widget spec: aSpec - aSpec help ifNotNil: [:stringOrSymbol | - stringOrSymbol isSymbol - ifTrue: [widget balloonTextSelector: stringOrSymbol] - ifFalse: [widget balloonText: stringOrSymbol]].! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableAlternateMultiSelectionList: (in category 'widgets optional') ----- - buildPluggableAlternateMultiSelectionList: aSpec - | listMorph listClass | - aSpec getSelected ifNotNil: [ ^ self error: 'There is no PluggableAlternateListMorphOfManyByItem' ]. - listClass := self alternateMultiSelectListClass. - listMorph := listClass - on: aSpec model - list: aSpec list - primarySelection: aSpec getIndex - changePrimarySelection: aSpec setIndex - listSelection: aSpec getSelectionList - changeListSelection: aSpec setSelectionList - menu: aSpec menu. - listMorph - setProperty: #highlightSelector toValue: #highlightMessageList:with: ; - enableDragNDrop: SystemBrowser browseWithDragNDrop ; - menuTitleSelector: #messageListSelectorTitle. - self - register: listMorph - id: aSpec name. - listMorph - keystrokeActionSelector: aSpec keyPress ; - getListElementSelector: aSpec listItem ; - getListSizeSelector: aSpec listSize; - getIconSelector: aSpec icon; - getHelpSelector: aSpec helpItem. - - self buildHelpFor: listMorph spec: aSpec. - - self - setFrame: aSpec frame - in: listMorph. - self setLayoutHintsFor: listMorph spec: aSpec. - parent ifNotNil: [ self add: listMorph to: parent ]. - panes ifNotNil: [ aSpec list ifNotNil:[panes add: aSpec list ] ]. - ^ listMorph! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableButton: (in category 'widgets required') ----- - buildPluggableButton: aSpec - | widget label state action enabled | - label := aSpec label. - state := aSpec state. - action := aSpec action. - widget := self buttonClass on: aSpec model - getState: (state isSymbol ifTrue:[state]) - action: nil - label: (label isSymbol ifTrue:[label]). - widget style: aSpec style. - aSpec changeLabelWhen - ifNotNil: [ :event | widget whenChanged: event update: aSpec label]. - self register: widget id: aSpec name. - enabled := aSpec enabled. - enabled isSymbol - ifTrue:[widget getEnabledSelector: enabled] - ifFalse:[widget enabled:enabled]. - widget action: action. - aSpec color isColor - ifTrue: [widget offColor: aSpec color] - ifFalse: [widget getColorSelector: aSpec color]. - self buildHelpFor: widget spec: aSpec. - (label isSymbol or:[label == nil]) ifFalse:[widget label: label]. - self setFrame: aSpec frame in: widget. - self setLayoutHintsFor: widget spec: aSpec. - parent ifNotNil:[self add: widget to: parent]. - ^widget! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableCheckBox: (in category 'widgets optional') ----- - buildPluggableCheckBox: spec - - | widget label state action | - label := spec label. - state := spec state. - action := spec action. - widget := self checkBoxClass on: spec model - getState: (state isSymbol ifTrue:[state]) - action: (action isSymbol ifTrue:[action]) - label: (label isSymbol ifTrue:[label]). - self register: widget id: spec name. - - widget installButton. - spec color ifNotNil: [:c | widget color: c]. - self setFrame: spec frame in: widget. - self setLayoutHintsFor: widget spec: spec. - parent ifNotNil: [:p | self add: widget to: p]. - ^widget! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableCodePane: (in category 'widgets optional') ----- - buildPluggableCodePane: aSpec - - | widget | - widget := super buildPluggableCodePane: aSpec. - - "Override code-specific default properties." - widget wantsWrapBorder: PluggableTextMorph visualWrapBorder. - PluggableTextMorph softLineWrapAtVisualWrapBorder - ifTrue: [widget averageLineLength: PluggableTextMorph visualWrapBorderLimit]. - widget wrapFlag: (aSpec softLineWrap ifNil: [PluggableTextMorph softLineWrap]). - ^ widget! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableDialog: (in category 'widgets optional') ----- - buildPluggableDialog: aSpec - - | widget | - - widget := self dialogClass new. - self register: widget id: aSpec name. - - widget model: aSpec model. - - "Set child dependent layout properties. The pane morph holds the special contents." - widget paneMorph wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [true]). - self setLayoutHintsFor: widget paneMorph spec: aSpec. - widget paneMorph layoutInset: (aSpec padding ifNil: [self dialogPadding]). - widget morphicLayerNumber: widget class dialogLayer. - - "Performance. Flip the #wantsPaneSplitters flag only after all children where added." - widget paneMorph cellGap: 0. - widget paneMorph wantsPaneSplitters: false; wantsGrips: false. - widget paneMorph removePaneSplitters; removeGrips. - - "Now create the children." - panes := OrderedCollection new. - aSpec children isSymbol - ifTrue: [ - widget getChildrenSelector: aSpec children. - widget update: aSpec children] - ifFalse: [ - self buildAll: aSpec children in: widget paneMorph]. - - "Avoid strange behavior in #addMorph:fullFrame:" - widget paneMorph cellGap: (aSpec spacing ifNil: [self dialogSpacing]). - widget paneMorph wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [true]). - widget paneMorph wantsPaneSplitters ifTrue: [ - widget paneMorph wantsGrips: true. - widget paneMorph addPaneSplitters; addCornerGrips"; addEdgeGrips". - widget paneMorph grips do: [:ea | ea showHandle: true]]. - - "Increase the line width of the dialog's message to allow that longer messages accompany complex paneMorph contents." - widget messageMorph averageLineLength: 65. - - "Now create the buttons." - aSpec buttons isSymbol - ifTrue: [ - widget getButtonsSelector: aSpec buttons. - widget update: aSpec buttons] - ifFalse: [ - self buildAll: aSpec buttons in: widget buttonRowMorph. - widget updateButtonProperties]. - - aSpec title ifNotNil: [:label | - label isSymbol - ifTrue:[widget getTitleSelector: label; update: label] - ifFalse:[widget title: label]]. - aSpec message ifNotNil: [:label | - label isSymbol - ifTrue:[widget getMessageSelector: label; update: label] - ifFalse:[widget message: label]]. - - "Interaction behavior." - aSpec autoCancel ifNotNil: [:b | widget autoCancel: b]. - aSpec exclusive ifNotNil: [:b | widget exclusive: b]. - - widget closeDialogSelector: aSpec closeAction. - self buildHelpFor: widget spec: aSpec. - - "Everything is shrink-wrapped around the pane morph." - widget paneMorph extent: (aSpec extent ifNil:[widget initialExtent]) - + (widget paneMorph layoutInset * 2) asPoint. - - ^ widget! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableDropDownList: (in category 'widgets optional') ----- - buildPluggableDropDownList: spec - - | widget model listSelector selectionSelector selectionSetter | - model := spec model. - listSelector := spec listSelector. - selectionSelector := spec selectionSelector. - selectionSetter := spec selectionSetter. - widget := self dropDownListClass new - model: model; - listSelector: listSelector; - selectionSelector: selectionSelector; - selectionSetter: selectionSetter; - yourself. - self register: widget id: spec name. - - widget installDropDownList. - self setFrame: spec frame in: widget. - self setLayoutHintsFor: widget spec: spec. - parent ifNotNil:[self add: widget to: parent]. - ^widget! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableInputField: (in category 'widgets optional') ----- - buildPluggableInputField: aSpec - | widget | - widget := self buildPluggableText: aSpec. - widget minimumHeight: 0. - widget acceptOnCR: true. - widget hideScrollBarsIndefinitely. - ^widget! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableList: (in category 'widgets required') ----- - buildPluggableList: aSpec - | widget listClass getIndex setIndex | - aSpec getSelected ifNil:[ - listClass := self listClass. - getIndex := aSpec getIndex. - setIndex := aSpec setIndex. - ] ifNotNil:[ - listClass := self listByItemClass. - getIndex := aSpec getSelected. - setIndex := aSpec setSelected. - ]. - widget := listClass on: aSpec model - list: aSpec list - selected: getIndex - changeSelected: setIndex - menu: aSpec menu - keystroke: aSpec keyPress. - self register: widget id: aSpec name. - - widget - dragItemSelector: aSpec dragItem; - dropItemSelector: aSpec dropItem; - wantsDropSelector: aSpec dropAccept; - dragStartedSelector: aSpec dragStarted; - dragTypeSelector: aSpec dragType. - - self setListPropertiesFor: widget spec: aSpec. - ^widget! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableMenu: (in category 'widgets required') ----- - buildPluggableMenu: menuSpec - | prior menu | - prior := parentMenu. - parentMenu := menu := self menuClass new. - menuSpec label ifNotNil:[parentMenu addTitle: menuSpec label]. - menuSpec items do:[:each| each buildWith: self]. - parentMenu := prior. - ^menu! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableMenuItem: (in category 'widgets required') ----- - buildPluggableMenuItem: itemSpec - | item action label menu | - item := self menuItemClass new. - label := (itemSpec isCheckable - ifTrue: [ itemSpec checked ifTrue: ['<on>'] ifFalse: ['<off>']] - ifFalse: ['']), itemSpec label. - item contents: label. - item isEnabled: itemSpec enabled. - (action := itemSpec action) ifNotNil:[ - item - target: action receiver; - selector: action selector; - arguments: action arguments. - ]. - (menu := itemSpec subMenu) ifNotNil:[ - item subMenu: (menu buildWith: self). - ]. - parentMenu ifNotNil:[parentMenu addMorphBack: item]. - itemSpec separator ifTrue:[parentMenu addLine]. - ^item! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableMultiColumnList: (in category 'widgets required') ----- - buildPluggableMultiColumnList: aSpec - - | widget listClass getIndex setIndex | - aSpec getSelected - ifNil: [ - listClass := self multiColumnListClass. - getIndex := aSpec getIndex. - setIndex := aSpec setIndex] - ifNotNil: [ - listClass := self multiColumnListByItemClass. - getIndex := aSpec getSelected. - setIndex := aSpec setSelected]. - widget := listClass - on: aSpec model - list: aSpec list - selected: getIndex - changeSelected: setIndex - menu: aSpec menu - keystroke: aSpec keyPress. - self register: widget id: aSpec name. - - " widget - dragItemSelector: aSpec dragItem; - dropItemSelector: aSpec dropItem; - wantsDropSelector: aSpec dropAccept; - dragStartedSelector: aSpec dragStarted." - - self setListPropertiesFor: widget spec: aSpec. - - "Be sure to enable the horizontal scrollbar if not all columns are #spaceFill." - (aSpec columnResizings anySatisfy: [:sym | sym ~= #spaceFill]) ifTrue: [widget hScrollBarPolicy: #whenNeeded]. - - widget - cellPositioningForColumns: aSpec itemAlignments; - cellInsetForColumns: aSpec itemPaddings; - hResizingForColumns: aSpec columnResizings; - spaceFillWeightForColumns: aSpec columnSpaceFillWeights. - widget updateColumns. - - ^ widget! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableMultiSelectionList: (in category 'widgets optional') ----- - buildPluggableMultiSelectionList: aSpec - | widget listClass | - aSpec getSelected ifNotNil:[^self error:'There is no PluggableListMorphOfManyByItem']. - listClass := self multiSelectListClass. - widget := listClass on: aSpec model - list: aSpec list - primarySelection: aSpec getIndex - changePrimarySelection: aSpec setIndex - listSelection: aSpec getSelectionList - changeListSelection: aSpec setSelectionList - menu: aSpec menu. - widget keystrokeActionSelector: aSpec keyPress. - self register: widget id: aSpec name. - self setListPropertiesFor: widget spec: aSpec. - ^widget! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggablePanel: (in category 'widgets required') ----- - buildPluggablePanel: aSpec - - | widget | - widget := self panelClass new. - self register: widget id: aSpec name. - - widget model: aSpec model. - - "Set child dependent layout properties." - self setLayoutHintsFor: widget spec: aSpec. - widget layoutInset: (aSpec padding ifNil: [self panelPadding]). - widget wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [false]). - "widget wantsGrips: true." - widget cellGap: (aSpec spacing ifNil: [ - widget wantsPaneSplitters - ifTrue: [self windowSpacing] - ifFalse: [self panelSpacing]]). - - "Now create the children." - aSpec children isSymbol - ifTrue: [ - widget getChildrenSelector: aSpec children. - widget update: widget getChildrenSelector] - ifFalse: [ - widget rebuildPaneAfter: [ - self buildAll: aSpec children in: widget]]. - - self setFrame: aSpec frame in: widget. - self setLayout: aSpec layout in: widget. - - parent ifNotNil:[self add: widget to: parent]. - - widget borderWidth: 0. - self buildHelpFor: widget spec: aSpec. - widget color: Color transparent. - - ^ widget! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableScrollPane: (in category 'widgets optional') ----- - buildPluggableScrollPane: spec - - | widget panel | - widget := self scrollPaneClass new. - widget model: spec model. - self register: widget id: spec name. - - spec children - ifNotNil: [:obj | - "Create panel morph to scroll it." - panel := self pluggablePanelSpec new - model: spec model; - children: obj; - layout: spec layout; - horizontalResizing: (spec layout == #proportional ifTrue: [#rigid] ifFalse: [#shrinkWrap]); - verticalResizing: (spec layout == #proportional ifTrue: [#rigid] ifFalse: [#shrinkWrap]); - buildWith: self. - widget morph: panel. - ] - ifNil: [spec morph - ifNotNil: [:m | widget morph: m] - ifNil: [widget morphClass: spec morphClass]]. - - self setFrame: spec frame in: widget. - self setLayoutHintsFor: widget spec: spec. - - parent ifNotNil: [self add: widget to: parent]. - - spec borderWidth ifNotNil: [:w | widget borderWidth: w]. - - "Set scroll bar policies. By default, use scroll bars only when needed. Do not follow system-wide preferences here." - spec hScrollBarPolicy - caseOf: { - [#always] -> [widget alwaysShowHScrollBar]. - [#never] -> [widget hideHScrollBarIndefinitely]. - [#whenNeeded] -> [widget showHScrollBarOnlyWhenNeeded] } - otherwise: [widget showHScrollBarOnlyWhenNeeded]. - spec vScrollBarPolicy - caseOf: { - [#always] -> [widget alwaysShowVScrollBar]. - [#never] -> [widget hideVScrollBarIndefinitely]. - [#whenNeeded] -> [widget showVScrollBarOnlyWhenNeeded] } - otherwise: [widget showVScrollBarOnlyWhenNeeded]. - - ^ widget! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableSpacer: (in category 'widgets required') ----- - buildPluggableSpacer: spec - - | widget | - widget := self spacerClass new. - self register: widget id: spec name. - - widget borderWidth: 0. - widget color: (spec color ifNil: [Color transparent]). - widget extent: spec extent. - - self buildHelpFor: widget spec: spec. - - self setFrame: spec frame in: widget. - self setLayoutHintsFor: widget spec: spec. - - parent ifNotNil:[self add: widget to: parent]. - ^widget! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableText: (in category 'widgets required') ----- - buildPluggableText: aSpec - | widget | - widget := self textPaneClass new. - aSpec stylerClass ifNotNil: [:c | widget styler: (c new view: widget)]. - widget - on: aSpec model - text: aSpec getText - accept: aSpec setText - readSelection: aSpec selection - menu: aSpec menu. - aSpec textStyle - ifNotNil: [:ts | - ts isSymbol - ifTrue: [widget getTextStyleSelector: ts; update: ts] - ifFalse: [widget setTextStyle: ts]] - ifNil: [ - aSpec font ifNotNil: [:f | - f isSymbol - ifTrue: [widget getFontSelector: f] - ifFalse: [widget setTextStyle: f asNewTextStyle]] ]. - - widget readOnly: aSpec readOnly. - widget plainTextOnly: aSpec plainTextOnly. - widget editTextSelector: aSpec editText. - widget wantsFrameAdornments: aSpec indicateUnacceptedChanges. - - widget askBeforeDiscardingEdits: aSpec askBeforeDiscardingEdits. - widget setProperty: #alwaysAccept toValue: aSpec askBeforeDiscardingEdits not. - - widget wrapFlag: (aSpec softLineWrap ifNil: [true]). - - self register: widget id: aSpec name. - widget getColorSelector: aSpec color. - widget getTextColorSelector: aSpec textColor. - self buildHelpFor: widget spec: aSpec. - - self setFrame: aSpec frame in: widget. - self setLayoutHintsForTextField: widget spec: aSpec. - - parent ifNotNil:[self add: widget to: parent]. - ^widget! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableTree: (in category 'widgets required') ----- - buildPluggableTree: aSpec - | widget | - widget := self treeClass new. - self register: widget id: aSpec name. - - widget getLabelSelector: aSpec label. - widget getIconSelector: aSpec icon. - - widget model: aSpec model. - widget nodeClass: aSpec nodeClass. - - widget getRootsSelector: aSpec roots. - widget getChildrenSelector: aSpec getChildren. - widget hasChildrenSelector: aSpec hasChildren. - - widget getSelectedSelector: aSpec getSelected. - widget setSelectedSelector: aSpec setSelected. - widget getSelectedPathSelector: aSpec getSelectedPath. - widget setSelectedPathSelector: aSpec setSelectedPath. - - widget setSelectedParentSelector: aSpec setSelectedParent. - - widget getHelpSelector: aSpec help. - widget getMenuSelector: aSpec menu. - - widget keystrokeActionSelector: aSpec keyPress. - widget autoDeselect: aSpec autoDeselect. - widget doubleClickSelector: aSpec doubleClick. - - widget dropItemSelector: aSpec dropItem. - widget wantsDropSelector: aSpec dropAccept. - widget dragItemSelector: aSpec dragItem. - widget dragStartedSelector: aSpec dragStarted. - widget dragTypeSelector: aSpec dragType. - - widget columns: aSpec columns. - - "Override default scroll bar policies if needed. Widget will use preference values otherwise." - aSpec hScrollBarPolicy ifNotNil: [:policy | - policy caseOf: { - [#always] -> [widget alwaysShowHScrollBar]. - [#never] -> [widget hideHScrollBarIndefinitely]. - [#whenNeeded] -> [widget showHScrollBarOnlyWhenNeeded]. } ]. - aSpec vScrollBarPolicy ifNotNil: [:policy | - policy caseOf: { - [#always] -> [widget alwaysShowVScrollBar]. - [#never] -> [widget hideVScrollBarIndefinitely]. - [#whenNeeded] -> [widget showVScrollBarOnlyWhenNeeded]. } ]. - - self setFrame: aSpec frame in: widget. - self setLayoutHintsFor: widget spec: aSpec. - - parent ifNotNil:[self add: widget to: parent]. - " panes ifNotNil:[ - aSpec roots ifNotNil:[panes add: aSpec roots]. - ]. " - ^widget! Item was removed: - ----- Method: MorphicToolBuilder>>buildPluggableWindow: (in category 'widgets required') ----- - buildPluggableWindow: aSpec - | widget | - - aSpec layout == #proportional ifFalse:[ - "This needs to be implemented - probably by adding a single pane and then the rest" - ^self error: 'Not implemented'. - ]. - - widget := (self windowClassFor: aSpec) new. - self register: widget id: aSpec name. - - widget model: aSpec model. - - "Set child dependent layout properties." - MorphicProject worldGridEnabled ifTrue: [ - "Snap both #position and #extent to grid." - aSpec horizontalResizing ifNil: [aSpec horizontalResizing: #spaceFill]. - aSpec verticalResizing ifNil: [aSpec verticalResizing: #spaceFill]]. - self setLayoutHintsFor: widget spec: aSpec. - widget layoutInset: (aSpec padding ifNil: [self windowPadding]). - widget morphicLayerNumber: widget class windowLayer. - - self flag: #todo. "ct: Below, there is a lot of duplication with #buildPluggablePanel:. Can we factor out some of this, or even just collect all children in a PluggablePanelMorph?" - widget cellGap: (aSpec spacing ifNil: [self windowSpacing]). - widget wantsGrips: true. - widget wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [true]). - - "Now create the children." - panes := OrderedCollection new. - aSpec children isSymbol - ifTrue: [ - widget getChildrenSelector: aSpec children. - widget update: aSpec children] - ifFalse: [ - widget rebuildPaneAfter: [ - self buildAll: aSpec children in: widget]]. - widget setUpdatablePanesFrom: panes. - - aSpec defaultFocus ifNotNil: [:name | - widget defaultFocusMorph: name]. - - aSpec label ifNotNil: [:label| - label isSymbol - ifTrue:[widget getLabelSelector: label] - ifFalse:[widget setLabel: label]]. - - aSpec multiWindowStyle notNil ifTrue: - [widget savedMultiWindowState: (SavedMultiWindowState on: aSpec model)]. - - widget closeWindowSelector: aSpec closeAction. - self buildHelpFor: widget spec: aSpec. - - widget bounds: (RealEstateAgent - initialFrameFor: widget - initialExtent: ((aSpec extent ifNil:[widget initialExtent]) * RealEstateAgent windowScaleFactor * RealEstateAgent scaleFactor) rounded - world: self currentWorld). - - widget refreshWindowColor. - - ^ widget! Item was removed: - ----- Method: MorphicToolBuilder>>buttonClass (in category 'widget classes') ----- - buttonClass - ^ PluggableButtonMorphPlus! Item was removed: - ----- Method: MorphicToolBuilder>>buttonRowHeight (in category 'layout hints') ----- - buttonRowHeight - - | multiplier | - ButtonMargins ifNil: [ - ButtonMargins := (PluggableButtonMorph labelMargins - ifNil: [0] ifNotNil: [:margins | - margins isRectangle - ifTrue: [margins top + margins bottom] - ifFalse: [margins isPoint - ifTrue: [margins y + margins y] - ifFalse: [margins + margins]]]) ]. - - multiplier := MorphicProject useCompactButtons - ifTrue: [1.0] ifFalse: [1.6]. - - ButtonBorderWidth ifNil: [ButtonBorderWidth := (((UserInterfaceTheme current get: #borderWidth for: PluggableTextMorph) ifNil: [1]) * RealEstateAgent scaleFactor) truncated * 2]. - - ^ (Preferences standardButtonFont lineGrid asFloat * multiplier) truncated "already includes the system's current #scaleFactor" - + ButtonMargins "already includes the system's current #scaleFactor" - + ButtonBorderWidth! Item was removed: - ----- Method: MorphicToolBuilder>>canApplyUserInterfaceTheme (in category 'updating') ----- - canApplyUserInterfaceTheme - - ^ false! Item was removed: - ----- Method: MorphicToolBuilder>>checkBoxClass (in category 'widget classes') ----- - checkBoxClass - ^ PluggableCheckBoxMorph! Item was removed: - ----- Method: MorphicToolBuilder>>close: (in category 'opening') ----- - close: aWidget - "Close a previously opened widget" - aWidget delete! Item was removed: - ----- Method: MorphicToolBuilder>>codePaneClass (in category 'widget classes') ----- - codePaneClass - ^ PluggableTextMorphPlus! Item was removed: - ----- Method: MorphicToolBuilder>>dialogClass (in category 'widget classes') ----- - dialogClass - ^ PluggableDialogWindow! Item was removed: - ----- Method: MorphicToolBuilder>>dialogPadding (in category 'layout hints') ----- - dialogPadding - - ^ ProportionalSplitterMorph gripThickness "already scaled"! Item was removed: - ----- Method: MorphicToolBuilder>>dialogSpacing (in category 'layout hints') ----- - dialogSpacing - - ^ ProportionalSplitterMorph gripThickness "already scaled"! Item was removed: - ----- Method: MorphicToolBuilder>>dropDownListClass (in category 'widget classes') ----- - dropDownListClass - ^ PluggableDropDownListMorph! Item was removed: - ----- Method: MorphicToolBuilder>>helpFieldHeightFor: (in category 'layout hints') ----- - helpFieldHeightFor: numLines - - ^ self textFieldHeightFor: numLines font: Preferences standardBalloonHelpFont! Item was removed: - ----- Method: MorphicToolBuilder>>inputFieldHeightFor: (in category 'layout hints') ----- - inputFieldHeightFor: numLines - - ^ self textFieldHeightFor: numLines font: TextStyle defaultFont! Item was removed: - ----- Method: MorphicToolBuilder>>listByItemClass (in category 'widget classes') ----- - listByItemClass - ^ PluggableListMorphByItemPlus! Item was removed: - ----- Method: MorphicToolBuilder>>listClass (in category 'widget classes') ----- - listClass - ^ PluggableListMorphPlus! Item was removed: - ----- Method: MorphicToolBuilder>>listHeightFor: (in category 'layout hints') ----- - listHeightFor: numLines - - ListMargins ifNil: [ - ListMargins := PluggableListMorph listMargins - ifNil: [0] ifNotNil: [:margins | - margins isRectangle - ifTrue: [margins top + margins bottom] - ifFalse: [margins isPoint - ifTrue: [margins y + margins y] - ifFalse: [margins + margins]]] ]. - - ListBorderWidth ifNil: [ListBorderWidth := (((UserInterfaceTheme current get: #borderWidth for: PluggableTextMorph) ifNil: [1]) * RealEstateAgent scaleFactor) truncated * 2]. - - ^ (Preferences standardListFont lineGridForMorphs * numLines) "already includes the system's current #scaleFactor" - + ListMargins "already includes the system's current #scaleFactor" - + ListBorderWidth! Item was removed: - ----- Method: MorphicToolBuilder>>menuClass (in category 'widget classes') ----- - menuClass - ^ MenuMorph! Item was removed: - ----- Method: MorphicToolBuilder>>menuItemClass (in category 'widget classes') ----- - menuItemClass - ^ MenuItemMorph! Item was removed: - ----- Method: MorphicToolBuilder>>multiColumnListByItemClass (in category 'widget classes') ----- - multiColumnListByItemClass - ^ PluggableMultiColumnListMorphByItem! Item was removed: - ----- Method: MorphicToolBuilder>>multiColumnListClass (in category 'widget classes') ----- - multiColumnListClass - ^ PluggableMultiColumnListMorph! Item was removed: - ----- Method: MorphicToolBuilder>>multiSelectListClass (in category 'widget classes') ----- - multiSelectListClass - ^ PluggableListMorphOfMany! Item was removed: - ----- Method: MorphicToolBuilder>>open: (in category 'opening') ----- - open: anObject - "Build and open the object. Answer the widget opened." - - ^ (self build: anObject) openAsTool! Item was removed: - ----- Method: MorphicToolBuilder>>open:label: (in category 'opening') ----- - open: anObject label: aString - "Build an open the object, labeling it appropriately if it is a window. Answer the widget opened." - - | morph | - morph := self open: anObject. - morph isSystemWindow - ifTrue: [morph setLabel: aString] - ifFalse: [morph name: aString]. - ^ morph! Item was removed: - ----- Method: MorphicToolBuilder>>panelClass (in category 'widget classes') ----- - panelClass - ^ PluggablePanelMorph! Item was removed: - ----- Method: MorphicToolBuilder>>register:id: (in category 'private') ----- - register: widget id: id - id ifNil:[^self]. - widgets ifNil:[widgets := Dictionary new]. - widgets at: id put: widget. - widget setNameTo: id.! Item was removed: - ----- Method: MorphicToolBuilder>>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." - [aWidget world notNil] whileTrue: [ - aWidget outermostWorldMorph doOneCycle. - ]. - ! Item was removed: - ----- Method: MorphicToolBuilder>>scrollPaneClass (in category 'widget classes') ----- - scrollPaneClass - ^ PluggableScrollPane! Item was removed: - ----- Method: MorphicToolBuilder>>setFrame:in: (in category 'private') ----- - setFrame: aRectangle in: widget - | frame | - aRectangle ifNil:[^nil]. - frame := aRectangle isRectangle - ifTrue: [self asFrame: aRectangle] - ifFalse: [aRectangle]. "assume LayoutFrame" - widget layoutFrame: frame. - widget hResizing: #spaceFill; vResizing: #spaceFill.! Item was removed: - ----- Method: MorphicToolBuilder>>setLayout:in: (in category 'private') ----- - setLayout: layout in: widget - layout == #proportional ifTrue:[ - widget layoutPolicy: ProportionalLayout new. - ^self]. - layout == #horizontal ifTrue:[ - widget layoutPolicy: TableLayout new. - widget listDirection: #leftToRight. - "widget cellInset: 1 at 1. - widget layoutInset: 1 at 1." - widget color: Color transparent. - "and then some..." - ^self]. - layout == #vertical ifTrue:[ - widget layoutPolicy: TableLayout new. - widget listDirection: #topToBottom. - "widget cellInset: 1 at 1. - widget layoutInset: 1 at 1." - widget color: Color transparent. - "and then some..." - ^self]. - ^self error: 'Unknown layout: ', layout.! Item was removed: - ----- Method: MorphicToolBuilder>>setLayoutHintsFor:spec: (in category 'private') ----- - setLayoutHintsFor: widget spec: aSpec - - aSpec minimumWidth >= 0 - ifTrue: [widget minimumWidth: aSpec minimumWidth]. - aSpec minimumHeight >= 0 - ifTrue: [widget minimumHeight: aSpec minimumHeight]. - aSpec padding - ifNotNil: [:p | widget layoutInset: p]. - "aSpec margin - ifNotNil: [:m | widget layoutOutset: m]." - - widget hResizing: (aSpec horizontalResizing ifNil: [#spaceFill]). - widget vResizing: (aSpec verticalResizing ifNil: [#spaceFill]).! Item was removed: - ----- Method: MorphicToolBuilder>>setLayoutHintsForTextField:spec: (in category 'private') ----- - setLayoutHintsForTextField: widget spec: aSpec - - aSpec minimumWidth >= 0 - ifTrue: [widget minimumWidth: aSpec minimumWidth]. - aSpec minimumHeight >= 0 - ifTrue: [widget minimumHeight: aSpec minimumHeight]. - aSpec padding - ifNotNil: [:p | widget textMorph margins: p]. - "aSpec margin - ifNotNil: [:m | widget layoutOutset: m]." - - widget hResizing: (aSpec horizontalResizing ifNil: [#spaceFill]). - widget vResizing: (aSpec verticalResizing ifNil: [#spaceFill]).! Item was removed: - ----- Method: MorphicToolBuilder>>setListPropertiesFor:spec: (in category 'private') ----- - setListPropertiesFor: widget spec: aSpec - - "Override default scroll bar policies if needed. Widget will use preference values otherwise." - aSpec hScrollBarPolicy ifNotNil: [:policy | - policy caseOf: { - [#always] -> [widget alwaysShowHScrollBar]. - [#never] -> [widget hideHScrollBarIndefinitely]. - [#whenNeeded] -> [widget showHScrollBarOnlyWhenNeeded]. } ]. - aSpec vScrollBarPolicy ifNotNil: [:policy | - policy caseOf: { - [#always] -> [widget alwaysShowVScrollBar]. - [#never] -> [widget hideVScrollBarIndefinitely]. - [#whenNeeded] -> [widget showVScrollBarOnlyWhenNeeded]. } ]. - - widget - getListElementSelector: aSpec listItem; - getListSizeSelector: aSpec listSize; - getIconSelector: aSpec icon; - getHelpSelector: aSpec helpItem; - doubleClickSelector: aSpec doubleClick. - - widget - autoDeselect: aSpec autoDeselect; - keystrokePreviewSelector: aSpec keystrokePreview. - - aSpec filterableList ifNotNil: [:b | widget filterableList: b]. - aSpec clearFilterAutomatically ifNotNil: [:b | widget clearFilterAutomatically: b]. - - aSpec color ifNotNil: [:c | widget color: c]. - self buildHelpFor: widget spec: aSpec. - - self setFrame: aSpec frame in: widget. - self setLayoutHintsFor: widget spec: aSpec. - aSpec itemAlignment ifNotNil: [:alignment | widget listMorph cellPositioning: alignment]. - aSpec itemPadding ifNotNil: [:padding | widget listMorph cellInset: padding]. - - parent ifNotNil:[self add: widget to: parent]. - (panes notNil and: [aSpec list notNil]) ifTrue: [panes add: aSpec list]. - ! Item was removed: - ----- Method: MorphicToolBuilder>>spacerClass (in category 'widget classes') ----- - spacerClass - - ^ BorderedMorph "See #displayScaleChangedBy:"! Item was removed: - ----- Method: MorphicToolBuilder>>textFieldHeightFor:font: (in category 'layout hints') ----- - textFieldHeightFor: numLines font: font - - TextMargins ifNil: [ - TextMargins := PluggableTextMorph textMargins - ifNil: [0] ifNotNil: [:margins | - margins isRectangle - ifTrue: [margins top + margins bottom] - ifFalse: [margins isPoint - ifTrue: [margins y + margins y] - ifFalse: [margins + margins]]] ]. - - TextBorderWidth ifNil: [TextBorderWidth := (((UserInterfaceTheme current get: #borderWidth for: PluggableTextMorph) ifNil: [1]) * RealEstateAgent scaleFactor) truncated * 2]. - - ^ (font lineGrid * numLines) "already includes the system's current #scaleFactor" - + TextMargins "already includes the system's current #scaleFactor" - + TextBorderWidth! Item was removed: - ----- Method: MorphicToolBuilder>>textPaneClass (in category 'widget classes') ----- - textPaneClass - ^ PluggableTextMorphPlus! Item was removed: - ----- Method: MorphicToolBuilder>>treeClass (in category 'widget classes') ----- - treeClass - ^ PluggableTreeMorph! Item was removed: - ----- Method: MorphicToolBuilder>>widgetAt:ifAbsent: (in category 'private') ----- - widgetAt: id ifAbsent: aBlock - widgets ifNil:[^aBlock value]. - ^widgets at: id ifAbsent: aBlock! Item was removed: - ----- Method: MorphicToolBuilder>>windowClass (in category 'widget classes') ----- - windowClass - ^ PluggableSystemWindow! Item was removed: - ----- Method: MorphicToolBuilder>>windowClassFor: (in category 'widget classes') ----- - windowClassFor: aSpec - ^aSpec multiWindowStyle - caseOf: - { [nil] -> [PluggableSystemWindow]. - [#labelButton] -> [PluggableSystemWindowWithLabelButton] } - otherwise: [PluggableSystemWindowWithLabelButton]! Item was removed: - ----- Method: MorphicToolBuilder>>windowPadding (in category 'layout hints') ----- - windowPadding - - ^ ProportionalSplitterMorph gripThickness "already scaled"! Item was removed: - ----- Method: MorphicToolBuilder>>windowSpacing (in category 'layout hints') ----- - windowSpacing - - ^ ProportionalSplitterMorph gripThickness "already scaled"! Item was removed: - UIManager subclass: #MorphicUIManager - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic'! - - !MorphicUIManager commentStamp: 'dtl 5/2/2010 16:07' prior: 0! - MorphicUIManager is a UIManager that implements user interface requests for a Morphic user interface.! Item was removed: - ----- Method: MorphicUIManager class>>isActiveManager (in category 'accessing') ----- - isActiveManager - "Answer whether I should act as the active ui manager" - ^Smalltalk isMorphic! Item was removed: - ----- Method: MorphicUIManager>>chooseClassOrTrait:from: (in category 'ui requests') ----- - chooseClassOrTrait: label from: environment - "Let the user choose a Class or Trait. Use ListChooser in Morphic." - - ^self chooseClassOrTrait: label from: environment withRecentList: nil! Item was removed: - ----- Method: MorphicUIManager>>chooseClassOrTrait:from:withRecentList: (in category 'ui requests') ----- - chooseClassOrTrait: label from: environment withRecentList: recentListWithFormatting - "Let the user choose a Class or Trait. Use ListChooser in Morphic." - - | names index | - names := environment classAndTraitNames. - recentListWithFormatting ifNotNil: - [names := names asOrderedCollection addAllFirst: recentListWithFormatting; yourself ]. - index := self - chooseFrom: names - lines: #() - title: label. - index = 0 ifTrue: [ ^nil ]. - ^environment - at: (names at: index) asSymbol "Drop formatting" - ifAbsent: [ nil ]! Item was removed: - ----- Method: MorphicUIManager>>chooseDirectory:from: (in category 'ui requests') ----- - chooseDirectory: label from: dir - "Let the user choose a file matching the given patterns. Returns a file name." - self askForProvidedAnswerTo: label ifSupplied: [:answer | - ^ answer]. - - ^ DirectoryChooserDialog openOn: dir label: label! Item was removed: - ----- Method: MorphicUIManager>>chooseFileMatching:label: (in category 'ui requests') ----- - chooseFileMatching: patterns label: aString - "Let the user choose a file matching the given patterns. Returns a file name." - self askForProvidedAnswerTo: aString ifSupplied: [:answer | - ^ answer]. - - ^ FileChooserDialog openOnPattern: patterns label: aString! Item was removed: - ----- Method: MorphicUIManager>>chooseFileMatchingSuffixes:label: (in category 'ui requests') ----- - chooseFileMatchingSuffixes: suffixList label: aString - "Let the user choose a file matching the given suffixes. Returns a file name." - self askForProvidedAnswerTo: aString ifSupplied: [:answer | - ^ answer]. - - ^ FileChooserDialog openOnSuffixList: suffixList label: aString. - ! Item was removed: - ----- Method: MorphicUIManager>>chooseFont:for:setSelector:getSelector: (in category 'ui requests') ----- - chooseFont: titleString for: aModel setSelector: setSelector getSelector: getSelector - "Open a font-chooser for the given model" - self askForProvidedAnswerTo: titleString ifSupplied: [:answer | - ^ answer]. - - ^FontChooserTool default - openWithWindowTitle: titleString - for: aModel - setSelector: setSelector - getSelector: getSelector! Item was removed: - ----- Method: MorphicUIManager>>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. Cancel value is 0. - If you are choosing an option from a short list (see for example ZipArchiveMember>>#extractInDirectory:overwrite:) use MorphicUIManager>>#chooseOptionFrom:lines:title: instead." - self - askForProvidedAnswerTo: aString - ifSupplied: - [:answer | - (answer = #cancel or: [answer isNil]) ifTrue: [^ 0]. - ^ aList indexOf: answer]. - - aList ifEmpty: [^ 0]. - ^ ListChooser chooseFrom: aList title: aString! Item was removed: - ----- Method: MorphicUIManager>>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." - - | index | - self - askForProvidedAnswerTo: aString - ifSupplied: - [:answer | - (answer = #cancel or: [answer isNil]) ifTrue: [^ nil]. - ^ valueList at: (labelList indexOf: answer) ifAbsent: - [answer isNumber - ifTrue: [valueList at: answer ifAbsent: [nil]] - ifFalse: [nil]]]. - - index := self chooseFrom: labelList lines: linesArray title: aString. - ^ index = 0 - ifTrue: [ nil ] - ifFalse: [ valueList at: index ]! Item was removed: - ----- Method: MorphicUIManager>>chooseFromOrAddTo:lines:title: (in category 'ui requests') ----- - chooseFromOrAddTo: aList lines: linesArray title: aString - - self askForProvidedAnswerTo: aString ifSupplied: [:answer | - ^ answer]. - - ^ ListChooser - chooseItemFrom: aList - title: aString - addAllowed: true! Item was removed: - ----- Method: MorphicUIManager>>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 askForProvidedAnswerTo: aString ifSupplied: [:answer | - ^ answer]. - - ^ ListMultipleChooser - chooseFrom: aList - title: aString! Item was removed: - ----- Method: MorphicUIManager>>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 askForProvidedAnswerTo: aString ifSupplied: [:answer | - ^ answer]. - - ^ (ListMultipleChooser - chooseFrom: labelList - title: aString) ifNotNil: [:indexList | - indexList collect: [:index | valueList at: index]]! Item was removed: - ----- Method: MorphicUIManager>>chooseOptionFrom:lines:title: (in category 'ui requests') ----- - chooseOptionFrom: aList lines: linesArray title: aString - | dialog | - "Choose an option from the given list. Answer the index of the selected item. Cancel value is 0. - - There are several (historical) reasons for needing a button dialog instead of a list chooser for small lists: - 1) Unfortunately, there is existing code that uses this call to create simple confirmation dialogs with a list of #(yes no cancel). - 2) Unfortunately, there is existing code that uses this call to mimic a drop-down menu with a (compact) pop-up menu. - This method *only* provides the short list UI" - self - askForProvidedAnswerTo: aString - ifSupplied: - [:answer | - (answer = #cancel or: [answer isNil]) ifTrue: [^ 0]. - ^ aList indexOf: answer]. - - aList ifEmpty: [^ 0]. - dialog := DialogWindow new - title: ListChooser defaultTitle; - message: aString; - filterEnabled: true; - autoCancel: true; "Like a pop-up menu, click anywhere to dismiss." - yourself. - aList withIndexDo: - [:ea :index | - dialog createButton: ea value: index]. - dialog selectedButtonIndex: 1. - ^ dialog getUserResponseAtHand ifNil: [0]! Item was removed: - ----- Method: MorphicUIManager>>chooseOptionFrom:values:lines:title: (in category 'ui requests') ----- - chooseOptionFrom: labelList values: valueList lines: linesArray title: aString - "Choose an item from the given list. Answer the selected item." - - | index | - self - askForProvidedAnswerTo: aString - ifSupplied: - [:answer | - (answer = #cancel or: [answer isNil]) ifTrue: [^ nil]. - ^ valueList at: (labelList indexOf: answer) ifAbsent: - [answer isNumber - ifTrue: [valueList at: answer ifAbsent: [nil]] - ifFalse: [nil]]]. - - index := self chooseOptionFrom: labelList lines: linesArray title: aString. - ^ index = 0 - ifTrue: [ nil ] - ifFalse: [ valueList at: index ]! Item was removed: - ----- Method: MorphicUIManager>>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 askForProvidedAnswerTo: queryString ifSupplied: [:answer | - ^ answer]. - - ^ UserDialogBoxMorph confirm: queryString! Item was removed: - ----- Method: MorphicUIManager>>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 askForProvidedAnswerTo: aString ifSupplied: [:answer | - ^ (answer = #cancel or: [answer isNil]) - ifTrue: [cancelBlock value] - ifFalse: [answer]]. - - ^ UserDialogBoxMorph confirm: aString orCancel: cancelBlock! Item was removed: - ----- Method: MorphicUIManager>>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 askForProvidedAnswerTo: aString ifSupplied: [:answer | - ^ (answer = #cancel or: [answer isNil]) - ifTrue: [cancelBlock value] - ifFalse: [answer]]. - - ^ UserDialogBoxMorph - confirm: aString - orCancel: cancelBlock - title: titleString - at: nil! Item was removed: - ----- Method: MorphicUIManager>>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 askForProvidedAnswerTo: queryString ifSupplied: [:answer | - ^ answer]. - - ^ UserDialogBoxMorph confirm: queryString title: titleString! Item was removed: - ----- Method: MorphicUIManager>>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 askForProvidedAnswerTo: queryString ifSupplied: [:answer | - ^ answer isBoolean - ifTrue: [answer] - ifFalse: [trueChoice = answer]]. - - ^ UserDialogBoxMorph confirm: queryString title: titleString trueChoice: trueChoice falseChoice: falseChoice ! Item was removed: - ----- Method: MorphicUIManager>>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 askForProvidedAnswerTo: queryString ifSupplied: [:answer | - ^ answer]. - - ^ UserDialogBoxMorph confirm: queryString trueChoice: trueChoice falseChoice: falseChoice ! Item was removed: - ----- Method: MorphicUIManager>>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." - | result progress | - progress := SystemProgressMorph - position: aPoint - label: titleString - min: minVal - max: maxVal. - [ [ result := workBlock value: progress ] - on: ProgressNotification - do: - [ : ex | ex extraParam isString ifTrue: - [ SystemProgressMorph uniqueInstance - labelAt: progress - put: ex extraParam ]. - ex resume ] ] ensure: [ SystemProgressMorph close: progress ]. - ^ result! Item was removed: - ----- Method: MorphicUIManager>>edit:label:accept: (in category 'ui requests') ----- - edit: aText label: labelString accept: anAction - "Open an editor on the given string/text. By default, don't style in such edit: requests." - - ^ self edit: aText label: labelString shouldStyle: false accept: anAction! Item was removed: - ----- Method: MorphicUIManager>>edit:label:shouldStyle:accept: (in category 'ui requests') ----- - edit: aText label: labelString shouldStyle: aBoolean accept: anAction - "Open an editor on the given string/text. Note that we do not send #open but #new to avoid any default actions to be configured." - - | workspace | - workspace := Workspace new - shouldStyle: aBoolean; - contents: aText; - acceptAction: anAction. - ^ workspace openLabel: (labelString ifNil: [workspace labelString])! Item was removed: - ----- Method: MorphicUIManager>>inform: (in category 'ui requests') ----- - inform: aString - "Display a message for the user to read and then dismiss" - self askForProvidedAnswerTo: aString ifSupplied: [:answer | - ^ answer]. - - ^ UserDialogBoxMorph inform: aString! Item was removed: - ----- Method: MorphicUIManager>>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]]" - SystemProgressMorph - informUserAt: nil during: aBlock.! Item was removed: - ----- Method: MorphicUIManager>>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 askForProvidedAnswerTo: queryString ifSupplied: [:answer | - ^ answer = #default - ifTrue: [defaultAnswer] - ifFalse: [answer]]. - - ^ FillInTheBlankMorph - request: queryString - initialAnswer: defaultAnswer - centerAt: aPoint - inWorld: self currentWorld - onCancelReturn: nil - acceptOnCR: false! Item was removed: - ----- Method: MorphicUIManager>>openPluggableFileList:label:in: (in category 'ui project indirecting') ----- - openPluggableFileList: aPluggableFileList label: aString in: aWorld - "PluggableFileList is being deprecated and this can go away soon" - ^aPluggableFileList morphicOpenLabel: aString in: aWorld! Item was removed: - ----- Method: MorphicUIManager>>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 askForProvidedAnswerTo: queryString ifSupplied: [:answer | - ^ answer = #default - ifTrue: [defaultAnswer] - ifFalse: [answer]]. - - ^FillInTheBlankMorph request: queryString initialAnswer: defaultAnswer ! Item was removed: - ----- Method: MorphicUIManager>>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 askForProvidedAnswerTo: queryString ifSupplied: [:answer | - ^ answer = #default - ifTrue: [defaultAnswer] - ifFalse: [answer]]. - - ^ FillInTheBlankMorph request: queryString initialAnswer: defaultAnswer centerAt: aPoint! Item was removed: - ----- Method: MorphicUIManager>>request:initialAnswer:onCancelReturn: (in category 'ui requests') ----- - request: queryString initialAnswer: defaultAnswer onCancelReturn: cancelResponse - "Create an instance of me whose question is queryString with the given initial answer. Answer the string the user accepts. Answer cancelResponse if the user cancels." - - self askForProvidedAnswerTo: queryString ifSupplied: [:answer | - ^ answer = #default - ifTrue: [defaultAnswer] - ifFalse: [answer]]. - - ^ FillInTheBlankMorph - request: queryString - initialAnswer: defaultAnswer - onCancelReturn: cancelResponse! Item was removed: - ----- Method: MorphicUIManager>>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 askForProvidedAnswerTo: queryString ifSupplied: [:answer | - ^ answer]. - - ^ FillInTheBlankMorph requestPassword: queryString! Item was removed: - ----- Method: MorphicUIManager>>saveFilenameRequest:initialAnswer: (in category 'ui requests') ----- - saveFilenameRequest: queryString initialAnswer: defaultAnswer - "Open a FileSaverDialog to ask for a place and filename to use for saving a file. The initial suggestion for the filename is defaultAnswer but the user may choose any existing file or type in a new name entirely" - self askForProvidedAnswerTo: queryString ifSupplied: [:answer | - ^ answer = #default - ifTrue: [defaultAnswer] - ifFalse: [answer]]. - - ^ FileSaverDialog openOnInitialFilename: defaultAnswer label: queryString - ! Item was removed: - ----- Method: MorphicUIManager>>startUpMenu:withCaption:icon:at:allowKeyboard: (in category 'ui project indirecting') ----- - startUpMenu: aMenu withCaption: captionOrNil icon: aForm at: location allowKeyboard: aBoolean - "A menu needs to startup and depends on the current type of ui manager for what sort of startup to do. Very ugly, and really needs replacing with a much better menu system" - - ^aMenu morphicStartUpWithCaption: captionOrNil icon: aForm at: location allowKeyboard: aBoolean - ! Item was removed: - PluggableButtonMorph subclass: #PluggableButtonMorphPlus - instanceVariableNames: 'enabled action getColorSelector getEnabledSelector updateMap disabledColor disabledTextColor' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic'! - - !PluggableButtonMorphPlus commentStamp: 'ar 2/11/2005 21:53' prior: 0! - An extended version of PluggableButtonMorph supporting enablement, color and block/message actions.! Item was removed: - ----- Method: PluggableButtonMorphPlus class>>themeProperties (in category 'preferences') ----- - themeProperties - - ^ super themeProperties, { - { #disabledColor. 'Colors'. 'Color when button cannot be clicked.' }. - { #disabledTextColor. 'Colors'. 'Color for label when button cannot be clicked.' }. - }! Item was removed: - ----- Method: PluggableButtonMorphPlus>>action (in category 'accessing') ----- - action - ^action! Item was removed: - ----- Method: PluggableButtonMorphPlus>>action: (in category 'accessing') ----- - action: anAction - action := nil. - anAction isSymbol ifTrue:[^super action: anAction]. - action := anAction.! Item was removed: - ----- Method: PluggableButtonMorphPlus>>applyUserInterfaceTheme (in category 'updating') ----- - applyUserInterfaceTheme - - super applyUserInterfaceTheme.! Item was removed: - ----- Method: PluggableButtonMorphPlus>>browseImplementationOfActionSelector (in category 'debug menu') ----- - browseImplementationOfActionSelector - - action - ifNil: [super browseImplementationOfActionSelector] - ifNotNil: [action homeMethod browse].! Item was removed: - ----- Method: PluggableButtonMorphPlus>>debugAction (in category 'debug menu') ----- - debugAction - - action ifNil: [^ super debugAction]. - (Process - forBlock: [self performAction] - runUntil: [:context | context closure = action]) - debugWithTitle: ('Debug button action "{1}" in model "{2}"' translated format: {self label. self target printString}).! Item was removed: - ----- Method: PluggableButtonMorphPlus>>enabled (in category 'accessing') ----- - enabled - ^ enabled ifNil: [enabled := true]! Item was removed: - ----- Method: PluggableButtonMorphPlus>>enabled: (in category 'accessing') ----- - enabled: aBool - enabled := aBool. - self updateFillStyle.! Item was removed: - ----- Method: PluggableButtonMorphPlus>>getColorSelector (in category 'accessing') ----- - getColorSelector - ^getColorSelector! Item was removed: - ----- Method: PluggableButtonMorphPlus>>getColorSelector: (in category 'accessing') ----- - getColorSelector: aSymbol - getColorSelector := aSymbol. - self update: getColorSelector.! Item was removed: - ----- Method: PluggableButtonMorphPlus>>getEnabledSelector (in category 'accessing') ----- - getEnabledSelector - ^getEnabledSelector! Item was removed: - ----- Method: PluggableButtonMorphPlus>>getEnabledSelector: (in category 'accessing') ----- - getEnabledSelector: aSymbol - getEnabledSelector := aSymbol. - self update: getEnabledSelector.! Item was removed: - ----- Method: PluggableButtonMorphPlus>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - ^ enabled! Item was removed: - ----- Method: PluggableButtonMorphPlus>>handlesMouseOver: (in category 'event handling') ----- - handlesMouseOver: evt - ^ enabled! Item was removed: - ----- Method: PluggableButtonMorphPlus>>handlesMouseOverDragging: (in category 'event handling') ----- - handlesMouseOverDragging: evt - ^ enabled! Item was removed: - ----- Method: PluggableButtonMorphPlus>>initialize (in category 'initialize-release') ----- - initialize - - enabled := true. - super initialize.! Item was removed: - ----- Method: PluggableButtonMorphPlus>>performAction (in category 'action') ----- - performAction - enabled ifFalse:[^self]. - action ifNotNil:[^action value]. - ^super performAction! Item was removed: - ----- Method: PluggableButtonMorphPlus>>setDefaultParameters (in category 'initialize-release') ----- - setDefaultParameters - - disabledColor := (self userInterfaceTheme disabledColor ifNil: [Color transparent]). - disabledTextColor := (self userInterfaceTheme disabledTextColor ifNil: [Color gray: 0.6]). - - super setDefaultParameters. - ! Item was removed: - ----- Method: PluggableButtonMorphPlus>>textColorToUse (in category 'drawing') ----- - textColorToUse - - ^ self enabled - ifTrue: [super textColorToUse] - ifFalse: [disabledTextColor ifNil: [Color gray: 0.6]]! Item was removed: - ----- Method: PluggableButtonMorphPlus>>update: (in category 'updating') ----- - update: what - - super update: what. - - getColorSelector ifNotNil: [:sel | - what == sel ifTrue: [self offColor: (model perform: sel)]]. - - getEnabledSelector ifNotNil: [:sel | - what == sel ifTrue: [self enabled: (model perform: sel)]]. - - updateMap ifNotNil: - [(updateMap at: what ifAbsent: []) - ifNotNil: [ :newTarget | self update: newTarget]]. - ! Item was removed: - ----- Method: PluggableButtonMorphPlus>>updateFillStylePressing:hovering: (in category 'initialize-release') ----- - updateFillStylePressing: isPressing hovering: isHovering - - enabled ifFalse: [ - self color: (disabledColor ifNil: [Color transparent]). - self borderStyle baseColor: disabledTextColor. - ^ self]. - - super updateFillStylePressing: isPressing hovering: isHovering.! Item was removed: - ----- Method: PluggableButtonMorphPlus>>updateMap (in category 'updating') ----- - updateMap - ^ updateMap ifNil: [updateMap := Dictionary new] - ! Item was removed: - ----- Method: PluggableButtonMorphPlus>>whenChanged:update: (in category 'updating') ----- - whenChanged: notification update: target - "On receipt of a notification, such as #contents notification from a CodeHolder, - invoke an update as if target had been the original notification." - - self updateMap at: notification put: target! Item was removed: - AlignmentMorph subclass: #PluggableCheckBoxMorph - instanceVariableNames: 'model actionSelector valueSelector label' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic'! Item was removed: - ----- Method: PluggableCheckBoxMorph class>>on:getState:action:label: (in category 'instance creation') ----- - on: anObject getState: getStateSel action: actionSel label: labelSel - - ^ self new - on: anObject - getState: getStateSel - action: actionSel - label: labelSel - menu: nil - ! Item was removed: - ----- Method: PluggableCheckBoxMorph>>actionSelector (in category 'accessing') ----- - actionSelector - "Answer the value of actionSelector" - - ^ actionSelector! Item was removed: - ----- Method: PluggableCheckBoxMorph>>actionSelector: (in category 'accessing') ----- - actionSelector: anObject - "Set the value of actionSelector" - - actionSelector := anObject! Item was removed: - ----- Method: PluggableCheckBoxMorph>>basicPanel (in category 'installing') ----- - basicPanel - ^BorderedMorph new - beTransparent; - extent: 0 at 0; - borderWidth: 0; - layoutInset: 0; - cellGap: 0; - layoutPolicy: TableLayout new; - listCentering: #topLeft; - cellPositioning: #center; - hResizing: #spaceFill; - vResizing: #shrinkWrap; - yourself! Item was removed: - ----- Method: PluggableCheckBoxMorph>>horizontalPanel (in category 'installing') ----- - horizontalPanel - ^self basicPanel - cellPositioning: #center; - listDirection: #leftToRight; - yourself.! Item was removed: - ----- Method: PluggableCheckBoxMorph>>initialize (in category 'initialization') ----- - initialize - - super initialize. - self color: Color transparent.! Item was removed: - ----- Method: PluggableCheckBoxMorph>>installButton (in category 'installing') ----- - installButton - - | aButton | - aButton := UpdatingThreePhaseButtonMorph checkBox - target: self model; - actionSelector: self actionSelector; - getSelector: self valueSelector; - label: self label; - yourself. - - self addMorph: (self horizontalPanel - addMorphBack: aButton; - - yourself).! Item was removed: - ----- Method: PluggableCheckBoxMorph>>isButton (in category 'classification') ----- - isButton - - ^ true! Item was removed: - ----- Method: PluggableCheckBoxMorph>>label (in category 'accessing') ----- - label - "Answer the value of label" - - ^ label! Item was removed: - ----- Method: PluggableCheckBoxMorph>>label: (in category 'accessing') ----- - label: anObject - "Set the value of label" - - label := anObject! Item was removed: - ----- Method: PluggableCheckBoxMorph>>model (in category 'accessing') ----- - model - "Answer the value of model" - - ^ model. - ! Item was removed: - ----- Method: PluggableCheckBoxMorph>>model: (in category 'accessing') ----- - model: anObject - "Set the value of model" - - model := anObject! Item was removed: - ----- Method: PluggableCheckBoxMorph>>on:getState:action:label:menu: (in category 'initialization') ----- - on: anObject getState: getStateSel action: actionSel label: labelSel menu: menuSel - - self model: anObject. - self valueSelector: getStateSel. - self actionSelector: actionSel. - self label: (self model perform: labelSel). - ! Item was removed: - ----- Method: PluggableCheckBoxMorph>>valueSelector (in category 'accessing') ----- - valueSelector - "Answer the value of valueSelector" - - ^ valueSelector! Item was removed: - ----- Method: PluggableCheckBoxMorph>>valueSelector: (in category 'accessing') ----- - valueSelector: anObject - "Set the value of valueSelector" - - valueSelector := anObject! Item was removed: - DialogWindow subclass: #PluggableDialogWindow - instanceVariableNames: 'model getTitleSelector getMessageSelector getChildrenSelector getButtonsSelector closeDialogSelector' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic'! Item was removed: - ----- Method: PluggableDialogWindow>>closeDialogSelector (in category 'accessing') ----- - closeDialogSelector - - ^ closeDialogSelector! Item was removed: - ----- Method: PluggableDialogWindow>>closeDialogSelector: (in category 'accessing') ----- - closeDialogSelector: anObject - - closeDialogSelector := anObject! Item was removed: - ----- Method: PluggableDialogWindow>>createTitle: (in category 'initialization') ----- - createTitle: aString - "Overridden to add an extra expand button. Yet, it depends on the model's interface whether that button will be visible. See #model:." - - | box expandButton| - super createTitle: aString. - - expandButton := SystemWindowButton new - name: #expandButton; - color: Color transparent; - target: self; - actionSelector: #expandDialogPane; - balloonText: 'Expand this dialog' translated; - borderWidth: 0; - yourself. - SystemWindow expandBoxImage scaleIconToDisplay in: [:icon | - expandButton labelGraphic: icon; extent: icon extent]. - - box := self submorphNamed: #title. - box addMorphBack: expandButton.! Item was removed: - ----- Method: PluggableDialogWindow>>delete (in category 'submorphs - add/remove') ----- - delete - - self model okToClose ifFalse: [^ self]. - - self closeDialogSelector ifNotNil: [:sel | self model perform: sel]. - - self model - windowIsClosing; - release. - self model: nil. - - super delete.! Item was removed: - ----- Method: PluggableDialogWindow>>expandDialogPane (in category 'running') ----- - expandDialogPane - "Expand the dialog pane to its preferred extent, including the pane's extra layout inset used for grips. Then try again to move to the dialog's preferred position." - - | extra | - self flag: #preferredExtentWorkaround. "mt: Working with a widget's min, max, and preferred extent is still very awkward using proportional layouts and layout frames. For now, approximate extra spacing to accommodate ListChooser and ListMultipleChooser only." - extra := PluggableListMorph listMargins. - extra := extra topLeft + extra bottomRight. - - self paneMorph extent: - (self model preferredExtent - + (self paneMorph layoutInset * 2) asPoint - + extra). - self moveToPreferredPosition.! Item was removed: - ----- Method: PluggableDialogWindow>>getButtonsSelector (in category 'accessing') ----- - getButtonsSelector - - ^ getButtonsSelector! Item was removed: - ----- Method: PluggableDialogWindow>>getButtonsSelector: (in category 'accessing') ----- - getButtonsSelector: anObject - - getButtonsSelector := anObject! Item was removed: - ----- Method: PluggableDialogWindow>>getChildrenSelector (in category 'accessing') ----- - getChildrenSelector - - ^ getChildrenSelector! Item was removed: - ----- Method: PluggableDialogWindow>>getChildrenSelector: (in category 'accessing') ----- - getChildrenSelector: anObject - - getChildrenSelector := anObject! Item was removed: - ----- Method: PluggableDialogWindow>>getMessageSelector (in category 'accessing') ----- - getMessageSelector - - ^ getMessageSelector! Item was removed: - ----- Method: PluggableDialogWindow>>getMessageSelector: (in category 'accessing') ----- - getMessageSelector: anObject - - getMessageSelector := anObject! Item was removed: - ----- Method: PluggableDialogWindow>>getTitleSelector (in category 'accessing') ----- - getTitleSelector - - ^ getTitleSelector! Item was removed: - ----- Method: PluggableDialogWindow>>getTitleSelector: (in category 'accessing') ----- - getTitleSelector: anObject - - getTitleSelector := anObject! Item was removed: - ----- Method: PluggableDialogWindow>>initialExtent (in category 'initialization') ----- - initialExtent - "Avoid screen-scaling to let the model determine the best initial extent, which might already be based on visible contents such as texts rendered in the default font." - - ^ model initialExtent! Item was removed: - ----- Method: PluggableDialogWindow>>isMorphicModel (in category 'testing') ----- - isMorphicModel - "I am a MorphicModel because I am a Morph and I offer a #model. Now, my debug menu shows more entries." - - self flag: #discuss. "mt: Maybe subclass from MorphicModel like SystemWindow?" - ^ true! Item was removed: - ----- Method: PluggableDialogWindow>>model (in category 'accessing') ----- - model - ^ model! Item was removed: - ----- Method: PluggableDialogWindow>>model: (in category 'accessing') ----- - model: newModel - - model ifNotNil: [model removeDependent: self]. - newModel ifNotNil: [ - newModel addDependent: self. - (newModel respondsTo: #preferredExtent) - ifFalse: [((self submorphNamed: #title) submorphNamed: #expandButton) delete]]. - model := newModel.! Item was removed: - ----- Method: PluggableDialogWindow>>update: (in category 'updating') ----- - update: what - - what ifNil:[^self]. - - what == self getTitleSelector ifTrue:[self title: (model perform: self getTitleSelector)]. - what == self getMessageSelector ifTrue:[self message: (model perform: self getMessageSelector)]. - - what == self getChildrenSelector ifTrue:[ - self paneMorph removeAllMorphs. - (self model perform: self getChildrenSelector) - do: [:m| m hResizing: #spaceFill; vResizing: #spaceFill]; - in: [:children | self paneMorph addAllMorphs: children]]. - - what == self getButtonsSelector ifTrue:[ - self buttonRow - removeAllMorphs; - addAllMorphs: (self model perform: self getButtonsSelector). - self updateButtonProperties]. - - what == #close ifTrue: [^ self delete]. - - super update: what.! Item was removed: - ----- Method: PluggableDialogWindow>>updateButtonProperties (in category 'updating') ----- - updateButtonProperties - - self buttons do: [:ea | - ea setProperty: #normalColor toValue: ea offColor. - ea setProperty: #normalLabel toValue: ea label. - ea hResizing: #rigid; vResizing: #rigid]. - - self updateButtonExtent.! Item was removed: - AlignmentMorph subclass: #PluggableDropDownListMorph - instanceVariableNames: 'model listSelector selectionSelector selectionSetter' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic'! Item was removed: - ----- Method: PluggableDropDownListMorph>>basicPanel (in category 'drawing') ----- - basicPanel - ^BorderedMorph new - beTransparent; - extent: 0 at 0; - borderWidth: 0; - layoutInset: 0; - cellGap: 0; - layoutPolicy: TableLayout new; - listCentering: #topLeft; - cellPositioning: #center; - hResizing: #spaceFill; - vResizing: #shrinkWrap; - yourself! Item was removed: - ----- Method: PluggableDropDownListMorph>>currentSelection (in category 'accessing') ----- - currentSelection - - ^ self model perform: selectionSelector! Item was removed: - ----- Method: PluggableDropDownListMorph>>currentSelection: (in category 'accessing') ----- - currentSelection: obj - - ^ self model perform: selectionSetter with: obj! Item was removed: - ----- Method: PluggableDropDownListMorph>>horizontalPanel (in category 'drawing') ----- - horizontalPanel - ^self basicPanel - cellPositioning: #center; - listDirection: #leftToRight; - yourself.! Item was removed: - ----- Method: PluggableDropDownListMorph>>installDropDownList (in category 'drawing') ----- - installDropDownList - - | aButton aLabel | - aButton := PluggableButtonMorph on: self model getState: nil action: nil. - aLabel := (StringMorph contents: self model currentRemoteVatId translated - font: (StrikeFont familyName: TextStyle defaultFont familyName - pointSize: TextStyle defaultFont pointSize - 1)). - self addMorph: (self horizontalPanel - addMorphBack: aLabel; - addMorphBack: aButton; - yourself).! Item was removed: - ----- Method: PluggableDropDownListMorph>>list (in category 'accessing') ----- - list - "Answer the value of list" - - ^ self model perform: self listSelector. - ! Item was removed: - ----- Method: PluggableDropDownListMorph>>listSelector (in category 'accessing') ----- - listSelector - "Answer the value of listSelector" - - ^ listSelector! Item was removed: - ----- Method: PluggableDropDownListMorph>>listSelector: (in category 'accessing') ----- - listSelector: anObject - "Set the value of listSelector" - - listSelector := anObject! Item was removed: - ----- Method: PluggableDropDownListMorph>>model (in category 'accessing') ----- - model - ^ model! Item was removed: - ----- Method: PluggableDropDownListMorph>>model: (in category 'accessing') ----- - model: anObject - "Set the value of model" - - model := anObject! Item was removed: - ----- Method: PluggableDropDownListMorph>>selectionSelector (in category 'accessing') ----- - selectionSelector - "Answer the value of selectionSelector" - - ^ selectionSelector! Item was removed: - ----- Method: PluggableDropDownListMorph>>selectionSelector: (in category 'accessing') ----- - selectionSelector: anObject - "Set the value of selectionSelector" - - selectionSelector := anObject! Item was removed: - ----- Method: PluggableDropDownListMorph>>selectionSetter (in category 'accessing') ----- - selectionSetter - "Answer the value of selectionSetter" - - ^ selectionSetter! Item was removed: - ----- Method: PluggableDropDownListMorph>>selectionSetter: (in category 'accessing') ----- - selectionSetter: anObject - "Set the value of selectionSetter" - - selectionSetter := anObject! Item was removed: - PluggableListMorphPlus subclass: #PluggableListMorphByItemPlus - instanceVariableNames: 'itemList' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic'! - - !PluggableListMorphByItemPlus commentStamp: 'mt 10/13/2019 11:01' prior: 0! - Like PluggableListMorphPlus but maps #setIndexSelector and #getIndexSelector to actual items instead of indexes.! Item was removed: - ----- Method: PluggableListMorphByItemPlus>>changeModelSelection: (in category 'model access') ----- - changeModelSelection: anInteger - "Change the model's selected item to be the one at the given index." - - setIndexSelector ifNotNil: [ - model - perform: setIndexSelector - with: (self getFullList at: anInteger ifAbsent: [nil])].! Item was removed: - ----- Method: PluggableListMorphByItemPlus>>getCurrentSelectionIndex (in category 'model access') ----- - getCurrentSelectionIndex - "Answer the index of the current selection." - - ^ getIndexSelector - ifNil: [0] - ifNotNil: [self getFullList indexOf: (model perform: getIndexSelector)]! Item was removed: - PluggableListMorph subclass: #PluggableListMorphPlus - instanceVariableNames: 'dragItemSelector dropItemSelector wantsDropSelector dragTypeSelector dragStartedSelector' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic'! - - !PluggableListMorphPlus commentStamp: 'ar 7/15/2005 11:10' prior: 0! - Extensions for PluggableListMorph needed by ToolBuilder! Item was removed: - ----- Method: PluggableListMorphPlus>>acceptDroppingMorph:event: (in category 'drag and drop') ----- - acceptDroppingMorph: aTransferMorph event: evt - - dropItemSelector ifNil: [^ self]. - potentialDropRow ifNil: [^ self]. - - model - perform: dropItemSelector - withEnoughArguments: { - aTransferMorph passenger. - self modelIndexFor: potentialDropRow. - aTransferMorph shouldCopy. - aTransferMorph}. - - self resetPotentialDropRow. - evt hand releaseMouseFocus: self. - Cursor normal show. - ! Item was removed: - ----- Method: PluggableListMorphPlus>>dragItemSelector (in category 'accessing') ----- - dragItemSelector - ^dragItemSelector! Item was removed: - ----- Method: PluggableListMorphPlus>>dragItemSelector: (in category 'accessing') ----- - dragItemSelector: aSymbol - dragItemSelector := aSymbol. - aSymbol ifNotNil:[self dragEnabled: true].! Item was removed: - ----- Method: PluggableListMorphPlus>>dragStartedSelector (in category 'accessing') ----- - dragStartedSelector - ^ dragStartedSelector! Item was removed: - ----- Method: PluggableListMorphPlus>>dragStartedSelector: (in category 'accessing') ----- - dragStartedSelector: symbol - dragStartedSelector := symbol.! Item was removed: - ----- Method: PluggableListMorphPlus>>dragTypeSelector (in category 'accessing') ----- - dragTypeSelector - ^dragTypeSelector! Item was removed: - ----- Method: PluggableListMorphPlus>>dragTypeSelector: (in category 'accessing') ----- - dragTypeSelector: aSymbol - dragTypeSelector := aSymbol.! Item was removed: - ----- Method: PluggableListMorphPlus>>dropItemSelector (in category 'accessing') ----- - dropItemSelector - ^dropItemSelector! Item was removed: - ----- Method: PluggableListMorphPlus>>dropItemSelector: (in category 'accessing') ----- - dropItemSelector: aSymbol - dropItemSelector := aSymbol. - aSymbol ifNotNil:[self dropEnabled: true].! Item was removed: - ----- Method: PluggableListMorphPlus>>startDrag: (in category 'drag and drop') ----- - startDrag: evt - - | item itemMorph modelIndex | - dragItemSelector ifNil:[^self]. - evt hand hasSubmorphs ifTrue: [^ self]. - self model okToChange ifFalse: [^ self]. - - "Ensure selection to save additional click." - (self modelIndexFor: (self rowAtLocation: evt position)) in: [:evtIndex | - self selectionIndex = evtIndex ifFalse: [self changeModelSelection: evtIndex]]. - - item := self selection ifNil: [^ self]. - itemMorph := StringMorph contents: item asStringOrText. - modelIndex := self modelIndexFor: self selectionIndex. - - [ "Initiate drag." - (self model perform: dragItemSelector with: modelIndex) ifNotNil: [:passenger | | ddm | - ddm := (self valueOfProperty: #dragTransferClass ifAbsent: [TransferMorph]) withPassenger: passenger from: self. - ddm dragTransferType: (self dragTypeSelector ifNotNil: [:s | self model perform: s with: modelIndex]). - ddm updateFromUserInputEvent: evt. - self dragStartedSelector ifNotNil: [:s | self model perform: s with: itemMorph with: ddm]. - evt hand grabMorph: ddm. - self mouseEnterDragging: evt "Enable internal move"]. - ] ensure: [Cursor normal show]! Item was removed: - ----- Method: PluggableListMorphPlus>>wantsDropSelector (in category 'accessing') ----- - wantsDropSelector - ^wantsDropSelector! Item was removed: - ----- Method: PluggableListMorphPlus>>wantsDropSelector: (in category 'accessing') ----- - wantsDropSelector: aSymbol - wantsDropSelector := aSymbol! Item was removed: - ----- Method: PluggableListMorphPlus>>wantsDroppedMorph:event: (in category 'drag and drop') ----- - wantsDroppedMorph: aTransferMorph event: anEvent - - dropItemSelector ifNil: [^ false]. - aTransferMorph isTransferMorph ifFalse: [^ false]. - wantsDropSelector ifNil: [^ true]. - - ^ model perform: wantsDropSelector withEnoughArguments: { - aTransferMorph passenger. - aTransferMorph dragTransferType. - aTransferMorph source. - aTransferMorph}! Item was removed: - AlignmentMorph subclass: #PluggablePanelMorph - instanceVariableNames: 'model getChildrenSelector' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic'! - - !PluggablePanelMorph commentStamp: 'ar 2/11/2005 20:13' prior: 0! - A pluggable panel morph which deals with changing children.! Item was removed: - ----- Method: PluggablePanelMorph>>canBeEncroached (in category 'private') ----- - canBeEncroached - ^ submorphs allSatisfy: - [ : each | each canBeEncroached ]! Item was removed: - ----- Method: PluggablePanelMorph>>children (in category 'accessing') ----- - children - ^ model perform: getChildrenSelector! Item was removed: - ----- Method: PluggablePanelMorph>>displayScaleChangedBy: (in category 'layout') ----- - displayScaleChangedBy: factor - "Overwritten the reset the #cellGap (and #splitters)." - - | priorCellGap | - priorCellGap := self cellGap. "Can be #panelSpacing, #windowSpacing, or -1 in browsers...." - super displayScaleChangedBy: factor. - - self cellGap: (priorCellGap * factor) rounded. - self layoutInset: (self layoutInset * factor) rounded.! Item was removed: - ----- Method: PluggablePanelMorph>>getChildrenSelector (in category 'accessing') ----- - getChildrenSelector - ^getChildrenSelector! Item was removed: - ----- Method: PluggablePanelMorph>>getChildrenSelector: (in category 'accessing') ----- - getChildrenSelector: aSymbol - getChildrenSelector := aSymbol.! Item was removed: - ----- Method: PluggablePanelMorph>>model (in category 'accessing') ----- - model - ^model! Item was removed: - ----- Method: PluggablePanelMorph>>model: (in category 'accessing') ----- - model: aModel - model ifNotNil:[model removeDependent: self]. - model := aModel. - model ifNotNil:[model addDependent: self].! Item was removed: - ----- Method: PluggablePanelMorph>>rebuildPaneAfter: (in category 'private') ----- - rebuildPaneAfter: replacePaneMorphsBlock - "Performance. Reset layout properties during children update to avoid intermediate relayouting." - - | cellGap wantsGrips wantsPaneSplitters | - self flag: #duplication. "See PluggableSystemWindow>>#rebuildPaneAfter: and MorphicToolBuilder>>#buildPluggableWindow:." - - cellGap := self cellGap. - wantsGrips := self wantsGrips. - wantsPaneSplitters := self wantsPaneSplitters. - - self cellGap: 0. - self wantsPaneSplitters: false; wantsGrips: false. - self removePaneSplitters; removeGrips. - - ^ replacePaneMorphsBlock ensure: [ - wantsPaneSplitters ifTrue: [ - self wantsPaneSplitters: wantsPaneSplitters. - self addPaneSplitters]. - wantsGrips ifTrue: [ - self wantsGrips: wantsGrips. - self addGrips]. - self cellGap: cellGap]! Item was removed: - ----- Method: PluggablePanelMorph>>update: (in category 'update') ----- - update: selectorSymbolOrNil - - selectorSymbolOrNil ifNil: [^ self]. - selectorSymbolOrNil = getChildrenSelector ifTrue: [ - self rebuildPaneAfter: [ - | children | - children := self children. - self - removeAllMorphs; - addAllMorphs: children. - self containingWindow ifNotNil: [:window | - children do: [:child | - child adoptPaneColor: window paneColor]]. - - "Let my children take all the place unless my extent is described by them." - self hResizing ~~ #shrinkWrap ifTrue: - [self submorphsDo: [:m | m hResizing: #spaceFill]]. - self vResizing ~~ #shrinkWrap ifTrue: - [self submorphsDo: [:m | m vResizing: #spaceFill]]. - - "Tell dependents about this update. There is no pluggable notification for changed submorphs." - self changed: #submorphs]].! Item was removed: - SystemWindow subclass: #PluggableSystemWindow - instanceVariableNames: 'getLabelSelector getChildrenSelector closeWindowSelector' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic'! - - !PluggableSystemWindow commentStamp: 'ar 2/11/2005 20:14' prior: 0! - A pluggable system window. Fixes the issues with label retrieval and adds support for changing children.! Item was removed: - ----- Method: PluggableSystemWindow>>addPaneMorph: (in category 'accessing') ----- - addPaneMorph: aMorph - self addMorph: aMorph fullFrame: aMorph layoutFrame! Item was removed: - ----- Method: PluggableSystemWindow>>closeWindowSelector (in category 'accessing') ----- - closeWindowSelector - ^closeWindowSelector! Item was removed: - ----- Method: PluggableSystemWindow>>closeWindowSelector: (in category 'accessing') ----- - closeWindowSelector: aSymbol - closeWindowSelector := aSymbol! Item was removed: - ----- Method: PluggableSystemWindow>>delete (in category 'initialization') ----- - delete - (model notNil and: [ closeWindowSelector notNil ]) ifTrue: [ model perform: closeWindowSelector ]. - super delete! Item was removed: - ----- Method: PluggableSystemWindow>>getChildrenSelector (in category 'accessing') ----- - getChildrenSelector - ^getChildrenSelector! Item was removed: - ----- Method: PluggableSystemWindow>>getChildrenSelector: (in category 'accessing') ----- - getChildrenSelector: aSymbol - getChildrenSelector := aSymbol! Item was removed: - ----- Method: PluggableSystemWindow>>getLabelSelector (in category 'accessing') ----- - getLabelSelector - ^getLabelSelector! Item was removed: - ----- Method: PluggableSystemWindow>>getLabelSelector: (in category 'accessing') ----- - getLabelSelector: aSymbol - getLabelSelector := aSymbol. - self update: aSymbol.! Item was removed: - ----- Method: PluggableSystemWindow>>label (in category 'accessing') ----- - label - ^label contents! Item was removed: - ----- Method: PluggableSystemWindow>>label: (in category 'accessing') ----- - label: aString - self setLabel: aString.! Item was removed: - ----- Method: PluggableSystemWindow>>rebuildPaneAfter: (in category 'private') ----- - rebuildPaneAfter: replacePaneMorphsBlock - "Performance. Reset layout properties during children update to avoid intermediate relayouting." - - | cellGap wantsGrips wantsPaneSplitters | - self flag: #duplication. "See PluggablePanelMorph>>#rebuildPaneAfter: and MorphicToolBuilder>>#buildPluggableWindow:." - - cellGap := self cellGap. - wantsGrips := self wantsGrips. - wantsPaneSplitters := self wantsPaneSplitters. - - self cellGap: 0. - self wantsPaneSplitters: false; wantsGrips: false. - self removePaneSplitters; removeGrips. - - ^ replacePaneMorphsBlock ensure: [ - wantsPaneSplitters ifTrue: [ - self wantsPaneSplitters: wantsPaneSplitters. - self addPaneSplitters]. - wantsGrips ifTrue: [ - self wantsGrips: wantsGrips. - self addGrips]. - self cellGap: cellGap]! Item was removed: - ----- Method: PluggableSystemWindow>>update: (in category 'updating') ----- - update: what - what ifNil:[^self]. - what == getLabelSelector ifTrue:[self setLabel: (model perform: getLabelSelector)]. - what == getChildrenSelector ifTrue: [ - self rebuildPaneAfter: [ - paneMorphs ifNil: [paneMorphs := #()]. - self removeAllMorphsIn: paneMorphs. - paneMorphs := model perform: getChildrenSelector. - self addAllMorphs: paneMorphs. - paneMorphs do: [:child | - child adoptPaneColor: self paneColor]. - paneMorphs do: [:m | m hResizing: #spaceFill; vResizing: #spaceFill]]]. - what == #windowColorToUse ifTrue: [ - self paneColor = model windowColorToUse ifFalse: - [self refreshWindowColor]]. - ^super update: what! Item was removed: - PluggableTextMorph subclass: #PluggableTextMorphPlus - instanceVariableNames: 'getColorSelector acceptAction unstyledAcceptText styler getTextColorSelector' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic'! - - !PluggableTextMorphPlus commentStamp: 'ar 2/11/2005 21:53' prior: 0! - A pluggable text morph with support for color.! Item was removed: - ----- Method: PluggableTextMorphPlus class>>themeProperties (in category 'preferences') ----- - themeProperties - - ^ super themeProperties, { - { #stylerClass. 'Editing'. 'The styler class you want to use for syntax highlighting' }. - { #balloonTextColor. 'Colors'. 'Color to use when drawing the balloon text on an empty text field.' }. - { #balloonTextFont. 'Fonts'. 'Font to use when drawing the balloon text on an empty text field.' }. - }! Item was removed: - ----- Method: PluggableTextMorphPlus>>accept (in category 'updating') ----- - accept - super accept. - acceptAction ifNotNil:[acceptAction value: textMorph text].! Item was removed: - ----- Method: PluggableTextMorphPlus>>acceptAction (in category 'accessing') ----- - acceptAction - ^acceptAction! Item was removed: - ----- Method: PluggableTextMorphPlus>>acceptAction: (in category 'accessing') ----- - acceptAction: anAction - acceptAction := anAction! Item was removed: - ----- Method: PluggableTextMorphPlus>>acceptTextInModel (in category 'styling') ----- - acceptTextInModel - - self okToStyle ifFalse:[^super acceptTextInModel]. - "#correctFrom:to:with: is sent when the method source is - manipulated during compilation (removing unused temps, - changing selectors etc). But #correctFrom:to:with: operates - on the textMorph's text, and we may be saving an unstyled - copy of the text. This means that these corrections will be lost - unless we also apply the corrections to the unstyled copy that - we are saving. - So remember the unstyled copy in unstyledAcceptText, so - that when #correctFrom:to:with: is received we can also apply - the correction to it" - unstyledAcceptText := styler unstyledTextFrom: textMorph text. - [^setTextSelector isNil or: - [setTextSelector numArgs = 2 - ifTrue: [model perform: setTextSelector with: unstyledAcceptText with: self] - ifFalse: [model perform: setTextSelector with: unstyledAcceptText]] - ] ensure:[unstyledAcceptText := nil]! Item was removed: - ----- Method: PluggableTextMorphPlus>>applyUserInterfaceTheme (in category 'updating') ----- - applyUserInterfaceTheme - - super applyUserInterfaceTheme. - - self styler ifNotNil: [:s | - s reset. - self updateStyle].! Item was removed: - ----- Method: PluggableTextMorphPlus>>balloonText (in category 'accessing') ----- - balloonText - "Overridden to send selector to model and not self. Do not use #perform:orSendTo: because super does more than just the send.." - - self balloonTextSelector ifNotNil: [:selector | - (self model respondsTo: selector) ifTrue: [ - ^ self model perform: selector]]. - - ^ super balloonText! Item was removed: - ----- Method: PluggableTextMorphPlus>>correctFrom:to:with: (in category 'styling') ----- - correctFrom: start to: stop with: aString - "see the comment in #acceptTextInModel " - unstyledAcceptText ifNotNil:[unstyledAcceptText replaceFrom: start to: stop with: aString ]. - ^ super correctFrom: start to: stop with: aString! Item was removed: - ----- Method: PluggableTextMorphPlus>>drawBalloonTextOn: (in category 'drawing') ----- - drawBalloonTextOn: aCanvas - "Show balloon text in the text morph if it has no contents. Catch errors to guard against broken models." - - | helpText helpFont helpColor box | - textMorph contents ifNotEmpty: [ ^ self ]. - helpText := [ self balloonText ] on: Error do: [ :err | '<error in #balloonText>' ]. - helpText ifNil: [ ^ self ]. - - helpFont := self textMorph textStyle defaultFont. - "self userInterfaceTheme balloonTextFont ifNil: [TextStyle defaultFont]." - helpColor := self userInterfaceTheme balloonTextColor ifNil: [Color gray: 0.7]. - - box := self innerBounds insetBy: (self textMorph margins ifNil: [0]). - box := box insetBy: (0 @ helpFont lineGapSlice corner: 0 at 0). - - aCanvas drawString: helpText in: box font: helpFont color: helpColor.! Item was removed: - ----- Method: PluggableTextMorphPlus>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - - super drawOn: aCanvas. - self drawBalloonTextOn: aCanvas.! Item was removed: - ----- Method: PluggableTextMorphPlus>>getColorSelector (in category 'accessing') ----- - getColorSelector - ^getColorSelector! Item was removed: - ----- Method: PluggableTextMorphPlus>>getColorSelector: (in category 'accessing') ----- - getColorSelector: aSymbol - getColorSelector := aSymbol. - self update: getColorSelector.! Item was removed: - ----- Method: PluggableTextMorphPlus>>getMenu: (in category 'menu') ----- - getMenu: shiftKeyState - "Answer the menu for this text view. We override the superclass implementation to - so we can give the selection interval to the model." - - | menu aMenu | - getMenuSelector == nil ifTrue: [^ nil]. - getMenuSelector numArgs < 3 ifTrue: [^ super getMenu: shiftKeyState]. - menu := MenuMorph new defaultTarget: model. - getMenuSelector numArgs = 3 ifTrue: - [aMenu := model - perform: getMenuSelector - with: menu - with: shiftKeyState - with: self selectionInterval. - getMenuTitleSelector ifNotNil: - [aMenu addTitle: (model perform: getMenuTitleSelector)]. - ^ aMenu]. - ^ self error: 'The getMenuSelector must be a 1- or 2 or 3-keyword symbol'! Item was removed: - ----- Method: PluggableTextMorphPlus>>getTextColorSelector (in category 'accessing') ----- - getTextColorSelector - ^getTextColorSelector! Item was removed: - ----- Method: PluggableTextMorphPlus>>getTextColorSelector: (in category 'accessing') ----- - getTextColorSelector: aSymbol - getTextColorSelector := aSymbol. - self update: getTextColorSelector.! Item was removed: - ----- Method: PluggableTextMorphPlus>>hasUnacceptedEdits: (in category 'styling') ----- - hasUnacceptedEdits: aBoolean - "re-implemented to re-style the text iff aBoolean is true" - - super hasUnacceptedEdits: aBoolean. - aBoolean ifTrue: [ self updateStyle ].! Item was removed: - ----- Method: PluggableTextMorphPlus>>okToStyle (in category 'testing') ----- - okToStyle - - ^ (styler isNil or: [self plainTextOnly]) - ifTrue: [false] - ifFalse: [model aboutToStyle: styler requestor: self]! Item was removed: - ----- Method: PluggableTextMorphPlus>>setText: (in category 'styling') ----- - setText: aText - - self okToStyle ifFalse:[^super setText: aText]. - super setText: (styler format: aText asText). - aText size < 4096 - ifTrue:[self updateStyleNow] - ifFalse:[self updateStyle]! Item was removed: - ----- Method: PluggableTextMorphPlus>>styler (in category 'accessing') ----- - styler - "The styler responsible for highlighting text in the receiver" - ^styler! Item was removed: - ----- Method: PluggableTextMorphPlus>>styler: (in category 'accessing') ----- - styler: anObject - "The styler responsible for highlighting text in the receiver" - styler := anObject! Item was removed: - ----- Method: PluggableTextMorphPlus>>stylerStyled: (in category 'styling') ----- - stylerStyled: styledCopyOfText - "Sent after the styler completed styling the underlying text. The behavior is similar to #handleInteraction:event: but we do not have to copy text ore make those other checks." - - textMorph contents runs: styledCopyOfText runs . - - textMorph paragraph composeAll. - textMorph editor recomputeSelection. - textMorph updateFromParagraph. - - textMorph editor blinkParen. - self scrollSelectionIntoView.! Item was removed: - ----- Method: PluggableTextMorphPlus>>stylerStyledInBackground: (in category 'styling') ----- - stylerStyledInBackground: styledCopyOfText - "Sent after the styler completed styling of the text" - - "It is possible that the text string has changed since the styling began. Disregard the styles if styledCopyOfText's string differs with the current textMorph contents string" - textMorph contents string = styledCopyOfText string - ifTrue: [self stylerStyled: styledCopyOfText]! Item was removed: - ----- Method: PluggableTextMorphPlus>>update: (in category 'updating') ----- - update: what - what ifNil:[^self]. - what == getColorSelector ifTrue: [self color: (model perform: getColorSelector)]. - what == getTextColorSelector ifTrue: [self setTextColor: (model perform: getTextColorSelector)]. - what == #style ifTrue: [self updateStyle]. - - - ^super update: what! Item was removed: - ----- Method: PluggableTextMorphPlus>>updateStyle (in category 'styling') ----- - updateStyle - - self okToStyle - ifTrue: [styler styleInBackgroundProcess: textMorph contents].! Item was removed: - ----- Method: PluggableTextMorphPlus>>updateStyleNow (in category 'styling') ----- - updateStyleNow - - self okToStyle - ifTrue: [styler style: textMorph contents].! Item was removed: - ----- Method: PluggableTextMorphPlus>>useDefaultStyler (in category 'initialize') ----- - useDefaultStyler - "This should be changed to a proper registry but as long as there is only shout this will do" - - (TextStyler for: #Smalltalk) - ifNotNil: [:stylerClass | self styler: (stylerClass new view: self)].! Item was removed: - ListItemWrapper subclass: #PluggableTreeItemNode - instanceVariableNames: 'parent index' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolBuilder-Morphic'! - - !PluggableTreeItemNode commentStamp: 'mt 2/1/2016 10:24' prior: 0! - Tree item for PluggableTreeMorph. My model is the tree morph. I keep track of my parent item and the index in my parent's list of children to support selective refreshing.! Item was removed: - ----- Method: PluggableTreeItemNode>>acceptDroppingObject: (in category 'accessing') ----- - acceptDroppingObject: anotherItem - ^model dropNode: anotherItem on: self! Item was removed: - ----- Method: PluggableTreeItemNode>>asString (in category 'accessing') ----- - asString - ^model printNode: self! Item was removed: - ----- Method: PluggableTreeItemNode>>balloonText (in category 'accessing') ----- - balloonText - ^model balloonTextForNode: self! Item was removed: - ----- Method: PluggableTreeItemNode>>canBeDragged (in category 'accessing') ----- - canBeDragged - ^model isDraggableNode: self! Item was removed: - ----- Method: PluggableTreeItemNode>>contents (in category 'accessing') ----- - contents - ^model contentsOfNode: self! Item was removed: - ----- Method: PluggableTreeItemNode>>hasContents (in category 'accessing') ----- - hasContents - ^model hasNodeContents: self! Item was removed: - ----- Method: PluggableTreeItemNode>>icon (in category 'accessing') ----- - icon - ^model iconOfNode: self! Item was removed: - ----- Method: PluggableTreeItemNode>>index (in category 'accessing') ----- - index - - ^ index! Item was removed: - ----- Method: PluggableTreeItemNode>>index: (in category 'accessing') ----- - index: anInteger - - index := anInteger.! Item was removed: - ----- Method: PluggableTreeItemNode>>item (in category 'accessing') ----- - item - ^item! Item was removed: - ----- Method: PluggableTreeItemNode>>parent (in category 'accessing') ----- - parent - ^ parent! Item was removed: - ----- Method: PluggableTreeItemNode>>parent: (in category 'accessing') ----- - parent: aNode - parent := aNode.! Item was removed: - ----- Method: PluggableTreeItemNode>>refresh (in category 'private') ----- - refresh - - self parent ifNil: [^ self]. - self setItem: (self parent contents - at: self index - ifAbsent: [self error: 'No support for changed child count yet!!']) - item.! Item was removed: - ----- Method: PluggableTreeItemNode>>wantsDroppedObject: (in category 'accessing') ----- - wantsDroppedObject: anotherItem - ^model wantsDroppedNode: anotherItem on: self! Item was removed: - SimpleHierarchicalListMorph subclass: #PluggableTreeMorph - instanceVariableNames: 'rootWrappers selectedWrapper getRootsSelector getChildrenSelector hasChildrenSelector getLabelSelector getIconSelector getSelectedPathSelector setSelectedPathSelector setSelectedParentSelector getHelpSelector dropItemSelector wantsDropSelector dragItemSelector dragTypeSelector nodeClass lastKeystrokeTime lastKeystrokes dragStartedSelector doubleClickSelector' - classVariableNames: 'FilterByLabelsOnly MaximumSearchDepth' - poolDictionaries: '' - category: 'ToolBuilder-Morphic'! - - !PluggableTreeMorph commentStamp: 'ar 2/12/2005 04:38' prior: 0! - A pluggable tree morph.! Item was removed: - ----- Method: PluggableTreeMorph class>>filterByLabelsOnly (in category 'preferences') ----- - filterByLabelsOnly - <preference: 'Filterable Trees by labels only' - category: 'scrolling' - description: 'When using the Filterable Lists option, set this to only match the labels, not the contents, of hierarchical lists. Otherwise, search both labels and contents will be matched.' - type: #Boolean> - ^ FilterByLabelsOnly ifNil: [ false ]! Item was removed: - ----- Method: PluggableTreeMorph class>>filterByLabelsOnly: (in category 'preferences') ----- - filterByLabelsOnly: aBoolean - FilterByLabelsOnly := aBoolean! Item was removed: - ----- Method: PluggableTreeMorph class>>maximumSearchDepth (in category 'preferences') ----- - maximumSearchDepth - <preference: 'Maximum tree search depth' - category: 'scrolling' - description: 'When using the Filterable Lists option, this specifies the maximum depth that will be searched below the current selection in of the hierarchy.' - type: #Number> - ^ MaximumSearchDepth ifNil: [ 1 ]! Item was removed: - ----- Method: PluggableTreeMorph class>>maximumSearchDepth: (in category 'preferences') ----- - maximumSearchDepth: anInteger - MaximumSearchDepth := anInteger.! Item was removed: - ----- Method: PluggableTreeMorph>>acceptDroppingMorph:event: (in category 'drag and drop') ----- - acceptDroppingMorph: aTransferMorph event: evt - - dropItemSelector ifNil: [^ self]. - potentialDropMorph ifNil: [^ self]. - - model - perform: dropItemSelector - withEnoughArguments: { - aTransferMorph passenger. - potentialDropMorph withoutListWrapper. - aTransferMorph shouldCopy. - aTransferMorph}. - - self resetPotentialDropMorph. - evt hand releaseMouseFocus: self. - Cursor normal show! Item was removed: - ----- Method: PluggableTreeMorph>>balloonTextForNode: (in category 'node access') ----- - balloonTextForNode: node - getHelpSelector ifNil:[^nil]. - ^model perform: getHelpSelector with: node item! Item was removed: - ----- Method: PluggableTreeMorph>>basicKeyPressed: (in category 'event handling') ----- - basicKeyPressed: aChar - - self updateLastKeystrokes: aChar. - - model okToChange ifFalse: [^ false]. - - PluggableListMorph filterableLists - ifTrue: [self triggerFilterTree] - ifFalse: [self selectNextMorphByFilter]. - - ^ true! Item was removed: - ----- Method: PluggableTreeMorph>>bottomVisibleRowIndex (in category 'geometry') ----- - bottomVisibleRowIndex - | itemAtBottom | - itemAtBottom := self itemFromPoint: self bottomLeft + (3 @ -3). - ^ itemAtBottom - ifNil: [ scroller submorphs size ] - ifNotNil: - [ : item | scroller submorphs indexOf: item ]! Item was removed: - ----- Method: PluggableTreeMorph>>charactersOccluded (in category 'geometry') ----- - charactersOccluded - ^ self visibleItems - inject: 0 - into: - [ : sum : each | sum + each charactersOccluded ]! Item was removed: - ----- Method: PluggableTreeMorph>>contentsOfNode: (in category 'node access') ----- - contentsOfNode: node - - | children | - getChildrenSelector ifNil: [^#()]. - children := model perform: getChildrenSelector with: node item. - ^ self nodesForChildren: children inNode: node - ! Item was removed: - ----- Method: PluggableTreeMorph>>doubleClick: (in category 'event handling') ----- - doubleClick: evt - - | aMorph | - aMorph := self itemFromPoint: evt position. - self model perform: self doubleClickSelector with: aMorph withoutListWrapper - ! Item was removed: - ----- Method: PluggableTreeMorph>>doubleClickEnabled (in category 'accessing') ----- - doubleClickEnabled - - ^ self doubleClickSelector notNil! Item was removed: - ----- Method: PluggableTreeMorph>>doubleClickSelector (in category 'accessing') ----- - doubleClickSelector - - ^ doubleClickSelector! Item was removed: - ----- Method: PluggableTreeMorph>>doubleClickSelector: (in category 'accessing') ----- - doubleClickSelector: anObject - - doubleClickSelector := anObject! Item was removed: - ----- Method: PluggableTreeMorph>>dragItemSelector (in category 'accessing') ----- - dragItemSelector - ^dragItemSelector! Item was removed: - ----- Method: PluggableTreeMorph>>dragItemSelector: (in category 'accessing') ----- - dragItemSelector: aSymbol - dragItemSelector := aSymbol. - aSymbol ifNotNil:[self dragEnabled: true].! Item was removed: - ----- Method: PluggableTreeMorph>>dragStartedSelector (in category 'accessing') ----- - dragStartedSelector - ^ dragStartedSelector! Item was removed: - ----- Method: PluggableTreeMorph>>dragStartedSelector: (in category 'accessing') ----- - dragStartedSelector: aSymbol - dragStartedSelector := aSymbol.! Item was removed: - ----- Method: PluggableTreeMorph>>dragTypeSelector (in category 'accessing') ----- - dragTypeSelector - ^dragTypeSelector! Item was removed: - ----- Method: PluggableTreeMorph>>dragTypeSelector: (in category 'accessing') ----- - dragTypeSelector: aSymbol - dragTypeSelector := aSymbol.! Item was removed: - ----- Method: PluggableTreeMorph>>dropItemSelector (in category 'accessing') ----- - dropItemSelector - ^dropItemSelector! Item was removed: - ----- Method: PluggableTreeMorph>>dropItemSelector: (in category 'accessing') ----- - dropItemSelector: aSymbol - dropItemSelector := aSymbol. - aSymbol ifNotNil:[self dropEnabled: true].! Item was removed: - ----- Method: PluggableTreeMorph>>dropNode:on: (in category 'node access') ----- - dropNode: srcNode on: dstNode - dropItemSelector ifNil:[^nil]. - model perform: dropItemSelector with: srcNode item with: dstNode item! Item was removed: - ----- Method: PluggableTreeMorph>>filterTree (in category 'filtering') ----- - filterTree - self hasFilter ifFalse: - [ self removeFilter. - ^ self ]. - self indicateFiltered. - "Clean up the tree." - (self selectedMorph - ifNil: [ self roots ] - ifNotNil: - [ : m | {m} ]) do: - [ : item | | filteredItems | - item applyFilter: lastKeystrokes. - item visible ifFalse: - [ "Do not hide the item where the filter is based on." - item show. - item isExpanded ifFalse: [ item toggleExpandedState ] ]. - filteredItems := self filteredItems. - "If configured as a navigation tool, advance the selection." - (PluggableTreeMorph maximumSearchDepth = 1 and: [ PluggableTreeMorph filterByLabelsOnly not ]) ifTrue: - [ |toBeExpanded| - (filteredItems notEmpty and: [ selectedMorph ~= filteredItems last ]) ifTrue: - [ self setSelectedMorph: - (toBeExpanded := selectedMorph - ifNil: [ filteredItems first ] - ifNotNil: [ filteredItems after: selectedMorph ]). - toBeExpanded isExpanded ifFalse: [ toBeExpanded toggleExpandedState ] ] ] ]. - self adjustSubmorphPositions! Item was removed: - ----- Method: PluggableTreeMorph>>filteredItems (in category 'filtering') ----- - filteredItems - "Answer the items which visible because they matched the current filters." - ^ self items select: [ : each | each visible ]! Item was removed: - ----- Method: PluggableTreeMorph>>getChildrenSelector (in category 'accessing') ----- - getChildrenSelector - ^getChildrenSelector! Item was removed: - ----- Method: PluggableTreeMorph>>getChildrenSelector: (in category 'accessing') ----- - getChildrenSelector: aSymbol - getChildrenSelector := aSymbol.! Item was removed: - ----- Method: PluggableTreeMorph>>getCurrentSelectionItem (in category 'selection') ----- - getCurrentSelectionItem - "Our models are supposed to return real objects, not wrappers. See PluggableTreeItemNode." - - | selectedObject | - selectedObject := self getSelectedSelector - ifNil: [^ nil] - ifNotNil: [:symbol | model perform: symbol]. - ^ scroller submorphs - detect: [:each | each complexContents item == selectedObject] - ifFound: [:each | each complexContents] - ifNone: [nil]! Item was removed: - ----- Method: PluggableTreeMorph>>getHelpSelector (in category 'accessing') ----- - getHelpSelector - ^getHelpSelector! Item was removed: - ----- Method: PluggableTreeMorph>>getHelpSelector: (in category 'accessing') ----- - getHelpSelector: aSymbol - getHelpSelector := aSymbol! Item was removed: - ----- Method: PluggableTreeMorph>>getIconSelector (in category 'accessing') ----- - getIconSelector - ^getIconSelector! Item was removed: - ----- Method: PluggableTreeMorph>>getIconSelector: (in category 'accessing') ----- - getIconSelector: aSymbol - getIconSelector := aSymbol! Item was removed: - ----- Method: PluggableTreeMorph>>getLabelSelector (in category 'accessing') ----- - getLabelSelector - ^getLabelSelector! Item was removed: - ----- Method: PluggableTreeMorph>>getLabelSelector: (in category 'accessing') ----- - getLabelSelector: aSymbol - getLabelSelector := aSymbol! Item was removed: - ----- Method: PluggableTreeMorph>>getMenuSelector (in category 'accessing') ----- - getMenuSelector - ^getMenuSelector! Item was removed: - ----- Method: PluggableTreeMorph>>getMenuSelector: (in category 'accessing') ----- - getMenuSelector: aSymbol - getMenuSelector := aSymbol! Item was removed: - ----- Method: PluggableTreeMorph>>getRootsSelector (in category 'accessing') ----- - getRootsSelector - ^getRootsSelector! Item was removed: - ----- Method: PluggableTreeMorph>>getRootsSelector: (in category 'accessing') ----- - getRootsSelector: aSelector - getRootsSelector := aSelector. - self update: getRootsSelector.! Item was removed: - ----- Method: PluggableTreeMorph>>getSelectedPath (in category 'selection') ----- - getSelectedPath - - ^ self getSelectedPathSelector ifNotNil: [:sel | model perform: sel]! Item was removed: - ----- Method: PluggableTreeMorph>>getSelectedPathSelector (in category 'accessing') ----- - getSelectedPathSelector - ^getSelectedPathSelector! Item was removed: - ----- Method: PluggableTreeMorph>>getSelectedPathSelector: (in category 'accessing') ----- - getSelectedPathSelector: aSymbol - getSelectedPathSelector := aSymbol. - self update: getSelectedPathSelector.! Item was removed: - ----- Method: PluggableTreeMorph>>getSelectedSelector (in category 'accessing') ----- - getSelectedSelector - ^getSelectionSelector! Item was removed: - ----- Method: PluggableTreeMorph>>getSelectedSelector: (in category 'accessing') ----- - getSelectedSelector: aSymbol - getSelectionSelector := aSymbol. - self update: getSelectionSelector.! Item was removed: - ----- Method: PluggableTreeMorph>>hasChildrenSelector (in category 'accessing') ----- - hasChildrenSelector - ^hasChildrenSelector! Item was removed: - ----- Method: PluggableTreeMorph>>hasChildrenSelector: (in category 'accessing') ----- - hasChildrenSelector: aSymbol - hasChildrenSelector := aSymbol! Item was removed: - ----- Method: PluggableTreeMorph>>hasFilter (in category 'filtering') ----- - hasFilter - ^ lastKeystrokes isEmptyOrNil not! Item was removed: - ----- Method: PluggableTreeMorph>>hasNodeContents: (in category 'node access') ----- - hasNodeContents: node - hasChildrenSelector ifNil:[^node contents isEmpty not]. - ^model perform: hasChildrenSelector with: node item! Item was removed: - ----- Method: PluggableTreeMorph>>iconOfNode: (in category 'node access') ----- - iconOfNode: node - getIconSelector ifNil:[^nil]. - ^model perform: getIconSelector with: node item! Item was removed: - ----- Method: PluggableTreeMorph>>indicateFiltered (in category 'filtering') ----- - indicateFiltered - "self color: (Color gray: 0.95)."! Item was removed: - ----- Method: PluggableTreeMorph>>indicateUnfiltered (in category 'filtering') ----- - indicateUnfiltered - self color: (self userInterfaceTheme color ifNil: [Color white]). - scroller submorphsDo: [:m | - m visible: true; backgroundColor: nil]. - self adjustSubmorphPositions.! Item was removed: - ----- Method: PluggableTreeMorph>>initialize (in category 'initialization') ----- - initialize - - super initialize. - - "Filter" - lastKeystrokeTime := 0. - lastKeystrokes := ''! Item was removed: - ----- Method: PluggableTreeMorph>>instantiateNodeWithContents:index:parent: (in category 'node access') ----- - instantiateNodeWithContents: item index: aNumber parent: anObject - - ^ (self nodeClass with: item model: self) - index: aNumber; - parent: anObject! Item was removed: - ----- Method: PluggableTreeMorph>>isDraggableNode: (in category 'node access') ----- - isDraggableNode: node - ^true! Item was removed: - ----- Method: PluggableTreeMorph>>items (in category 'accessing') ----- - items - ^ scroller submorphs! Item was removed: - ----- Method: PluggableTreeMorph>>keyStroke: (in category 'event handling') ----- - keyStroke: event - - ^ (super keyStroke: event) - ifTrue: [true] - ifFalse: [self basicKeyPressed: event keyCharacter].! Item was removed: - ----- Method: PluggableTreeMorph>>keyboardFocusChange: (in category 'event handling') ----- - keyboardFocusChange: aBoolean - aBoolean ifFalse: - [ PluggableListMorph clearFilterAutomatically ifTrue: - [ self hasFilter ifTrue: [ self removeFilter ] ] ]. - super keyboardFocusChange: aBoolean.! Item was removed: - ----- Method: PluggableTreeMorph>>keystrokeActionSelector (in category 'accessing') ----- - keystrokeActionSelector - ^keystrokeActionSelector! Item was removed: - ----- Method: PluggableTreeMorph>>keystrokeActionSelector: (in category 'accessing') ----- - keystrokeActionSelector: aSymbol - keystrokeActionSelector := aSymbol! Item was removed: - ----- Method: PluggableTreeMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - | aMorph selectors | - - aMorph := self itemFromPoint: evt position. - evt yellowButtonPressed "First check for option (menu) click" - ifTrue: [ - (PluggableListMorph menuRequestUpdatesSelection and: [model okToChange]) ifTrue: [ - aMorph == selectedMorph - ifFalse: [self setSelectedMorph: aMorph]]. - ^ self yellowButtonActivity: evt shiftPressed]. - (aMorph notNil and:[aMorph inToggleArea: (aMorph point: evt position from: self)]) - ifTrue:[^self toggleExpandedState: aMorph event: evt]. - aMorph ifNil:[^super mouseDown: evt]. - - aMorph highlightForMouseDown. - self setProperty: #highlightedMorph toValue: aMorph. - - selectors := Array - with: #click: - with: (self doubleClickEnabled ifTrue: [#doubleClick:] ifFalse: [nil]) - with: nil - with: (self dragEnabled ifTrue:[#startDrag:] ifFalse:[nil]). - evt hand waitForClicksOrDrag: self event: evt selectors: selectors threshold: HandMorph dragThreshold "pixels".! Item was removed: - ----- Method: PluggableTreeMorph>>nodeClass (in category 'accessing') ----- - nodeClass - ^ nodeClass ifNil: [PluggableTreeItemNode]! Item was removed: - ----- Method: PluggableTreeMorph>>nodeClass: (in category 'accessing') ----- - nodeClass: aListWrapperClass - nodeClass := aListWrapperClass.! Item was removed: - ----- Method: PluggableTreeMorph>>nodesForChildren:inNode: (in category 'node access') ----- - nodesForChildren: aCollection inNode: anObject - - ^ aCollection isSequenceable - ifTrue: [aCollection withIndexCollect: - [:item :index | - self instantiateNodeWithContents: item index: index parent: anObject]] - ifFalse: [ | count | - count := 0. "artificial index." - aCollection collect: - [:item | - count := count + 1. - self instantiateNodeWithContents: item index: count parent: anObject]]! Item was removed: - ----- Method: PluggableTreeMorph>>printNode: (in category 'node access') ----- - printNode: node - getLabelSelector ifNil:[^node item printString]. - ^model perform: getLabelSelector with: node item! Item was removed: - ----- Method: PluggableTreeMorph>>removeFilter (in category 'filtering') ----- - removeFilter - lastKeystrokes := String empty. - self indicateUnfiltered.! Item was removed: - ----- Method: PluggableTreeMorph>>selectNextMorphByFilter (in category 'filtering') ----- - selectNextMorphByFilter! Item was removed: - ----- Method: PluggableTreeMorph>>selectPath: (in category 'selection') ----- - selectPath: path - - self - selectPath: path - in: (scroller submorphs at: 1 ifAbsent: [^self]).! Item was removed: - ----- Method: PluggableTreeMorph>>selectPath:in: (in category 'selection') ----- - selectPath: path in: listItem - path ifNil: [^self]. - path isEmpty ifTrue: [^self setSelectedMorph: nil]. - listItem withSiblingsDo: [:each | - (each complexContents item = path first) ifTrue: [ - each isExpanded ifFalse: [ - each toggleExpandedState. - self adjustSubmorphPositions. - ]. - each changed. - path size = 1 ifTrue: [ - ^self setSelectedMorph: each - ]. - each firstChild ifNil: [^self setSelectedMorph: nil]. - ^self selectPath: path allButFirst in: each firstChild - ]. - ]. - ^self setSelectedMorph: nil - - ! Item was removed: - ----- Method: PluggableTreeMorph>>selectedMorph: (in category 'selection') ----- - selectedMorph: aMorph - - super selectedMorph: aMorph. - - "If the update came from the model, make my state consistent again." - selectedWrapper := aMorph complexContents. - self setSelectedParentMorph: aMorph.! Item was removed: - ----- Method: PluggableTreeMorph>>setSelectedMorph: (in category 'selection') ----- - setSelectedMorph: aMorph - - selectedWrapper := aMorph complexContents. - - "Let the model now about the selected object, not wrapper." - setSelectionSelector ifNotNil: [:symbol | - model - perform: symbol - with: (selectedWrapper ifNotNil: [:w | w item])]. - - self setSelectedParentMorph: aMorph. - self setSelectedPath: aMorph.! Item was removed: - ----- Method: PluggableTreeMorph>>setSelectedParentMorph: (in category 'selection') ----- - setSelectedParentMorph: aMorph - - "The model may not have access to the parent object in terms of this tree structure." - setSelectedParentSelector ifNotNil: [:symbol | - model - perform: symbol - with: (selectedWrapper ifNotNil: [:w | w parent ifNotNil: [:pw | pw item]])].! Item was removed: - ----- Method: PluggableTreeMorph>>setSelectedParentSelector (in category 'accessing') ----- - setSelectedParentSelector - ^ setSelectedParentSelector! Item was removed: - ----- Method: PluggableTreeMorph>>setSelectedParentSelector: (in category 'accessing') ----- - setSelectedParentSelector: aSymbol - setSelectedParentSelector := aSymbol.! Item was removed: - ----- Method: PluggableTreeMorph>>setSelectedPath: (in category 'selection') ----- - setSelectedPath: aMorph - - | items wrapperPath | - setSelectedPathSelector ifNotNil: [:setSelectedPathSelector | - wrapperPath := selectedWrapper - ifNil: [#()] - ifNotNil: [ - wrapperPath := {selectedWrapper} asOrderedCollection. - [wrapperPath last parent notNil] - whileTrue: [wrapperPath addLast: wrapperPath last parent]. - wrapperPath]. - items := wrapperPath collect: [:w | w item]. - model - perform: setSelectedPathSelector - with: items]. - - ! Item was removed: - ----- Method: PluggableTreeMorph>>setSelectedPathSelector (in category 'accessing') ----- - setSelectedPathSelector - ^ setSelectedPathSelector - ! Item was removed: - ----- Method: PluggableTreeMorph>>setSelectedPathSelector: (in category 'accessing') ----- - setSelectedPathSelector: aSymbol - setSelectedPathSelector := aSymbol. - ! Item was removed: - ----- Method: PluggableTreeMorph>>setSelectedSelector (in category 'accessing') ----- - setSelectedSelector - ^setSelectionSelector! Item was removed: - ----- Method: PluggableTreeMorph>>setSelectedSelector: (in category 'accessing') ----- - setSelectedSelector: aSymbol - setSelectionSelector := aSymbol! Item was removed: - ----- Method: PluggableTreeMorph>>specialKeyPressed: (in category 'event handling') ----- - specialKeyPressed: asciiValue - - (super specialKeyPressed: asciiValue) - ifTrue: [^ true]. - - (#(8 13) includes: asciiValue) ifTrue: [ - "backspace key" - self removeFilter. - ^ true]. - - ^ false! Item was removed: - ----- Method: PluggableTreeMorph>>startDrag: (in category 'drag and drop') ----- - startDrag: evt - - | itemMorph | - self dragItemSelector ifNil: [^ self]. - evt hand hasSubmorphs ifTrue: [^ self]. - self model okToChange ifFalse: [^ self]. - - itemMorph := scroller submorphs - detect: [:any | any highlightedForMouseDown] - ifNone: [^ self]. - - "Prepare visuals." - itemMorph highlightForMouseDown: false. - self setSelectedMorph: itemMorph. - - [ "Initiate drag." - (self model perform: self dragItemSelector with: itemMorph withoutListWrapper) ifNotNil: [:passenger | | ddm | - ddm := (self valueOfProperty: #dragTransferClass ifAbsent: [TransferMorph]) withPassenger: passenger from: self. - ddm dragTransferType: (self dragTypeSelector ifNotNil: [:s | self model perform: s with: itemMorph withoutListWrapper]). - ddm updateFromUserInputEvent: evt. - self dragStartedSelector ifNotNil: [:s | self model perform: s with: itemMorph with: ddm]. - evt hand grabMorph: ddm]. - ] ensure: [ - Cursor normal show. - evt hand releaseMouseFocus: self].! Item was removed: - ----- Method: PluggableTreeMorph>>topVisibleRowIndex (in category 'geometry') ----- - topVisibleRowIndex - ^ scroller submorphs indexOf: (self itemFromPoint: self topLeft+(3 at 3))! Item was removed: - ----- Method: PluggableTreeMorph>>triggerFilterTree (in category 'filtering') ----- - triggerFilterTree - - self removeAlarm: #filterTree. - self addAlarm: #filterTree after: 300.! Item was removed: - ----- Method: PluggableTreeMorph>>update: (in category 'updating') ----- - update: what - what ifNil:[^self]. - what == getRootsSelector ifTrue:[ - self wrapRoots: (model perform: getRootsSelector). - ^ self]. - - what == getSelectedPathSelector ifTrue:[ - self selectPath: self getSelectedPath. - ^ self]. - - what == #expandRootsRequested ifTrue: [ - self expandRoots. - ^ self]. - - super update: what. - ! Item was removed: - ----- Method: PluggableTreeMorph>>update:with: (in category 'updating') ----- - update: what with: anObject - - super update: what with: anObject. - - what == #objectChanged ifTrue: [ - self updateFromChangedObject: anObject].! Item was removed: - ----- Method: PluggableTreeMorph>>updateFromChangedObject: (in category 'updating') ----- - updateFromChangedObject: anObject - - scroller submorphs - detect: [:morph | morph complexContents item == anObject] - ifFound: [:morph | self updateMorph: morph] - ifNone: ["Ignore the request. Object may not be visible anyway."].! Item was removed: - ----- Method: PluggableTreeMorph>>updateLastKeystrokes: (in category 'event handling') ----- - updateLastKeystrokes: aChar - - | milliseconds slowKeyStroke | - milliseconds := Time millisecondClockValue. - slowKeyStroke := (Time milliseconds: milliseconds since: lastKeystrokeTime) - > (PluggableListMorph filterableLists ifTrue: [ 500 ] ifFalse: [ 300 ]). - lastKeystrokeTime := milliseconds. - - slowKeyStroke - ifTrue: [lastKeystrokes := aChar asLowercase asString] - ifFalse: [lastKeystrokes := lastKeystrokes , aChar asLowercase asString.].! Item was removed: - ----- Method: PluggableTreeMorph>>updateMorph: (in category 'updating') ----- - updateMorph: morph - - morph complexContents refresh. - morph refresh. - - morph isExpanded - ifFalse: [self changed] - ifTrue: [ - morph - toggleExpandedState; - toggleExpandedState. - self adjustSubmorphPositions]. - ! Item was removed: - ----- Method: PluggableTreeMorph>>updateNode: (in category 'node access') ----- - updateNode: node - ! Item was removed: - ----- Method: PluggableTreeMorph>>visibleItems (in category 'geometry') ----- - visibleItems - ^ self items ifNotEmpty: - [ : items | items - copyFrom: self topVisibleRowIndex - to: self bottomVisibleRowIndex ]! Item was removed: - ----- Method: PluggableTreeMorph>>wantsDropSelector (in category 'accessing') ----- - wantsDropSelector - ^wantsDropSelector! Item was removed: - ----- Method: PluggableTreeMorph>>wantsDropSelector: (in category 'accessing') ----- - wantsDropSelector: aSymbol - wantsDropSelector := aSymbol! Item was removed: - ----- Method: PluggableTreeMorph>>wantsDroppedMorph:event: (in category 'drag and drop') ----- - wantsDroppedMorph: aTransferMorph event: anEvent - - dropItemSelector ifNil: [^ false]. - wantsDropSelector ifNil: [^ true]. - - aTransferMorph isTransferMorph ifFalse: [^ false]. - - ^ model perform: wantsDropSelector withEnoughArguments: { - aTransferMorph passenger. - aTransferMorph dragTransferType. - aTransferMorph source. - aTransferMorph}! Item was removed: - ----- Method: PluggableTreeMorph>>wantsDroppedNode:on: (in category 'node access') ----- - wantsDroppedNode: srcNode on: dstNode - dropItemSelector ifNil:[^false]. - wantsDropSelector ifNil:[^true]. - ^(model perform: wantsDropSelector with: srcNode with: dstNode) == true! Item was removed: - ----- Method: PluggableTreeMorph>>wrapRoots: (in category 'updating') ----- - wrapRoots: someObjects - - rootWrappers := someObjects collect: [:item| - self nodeClass with: item model: self]. - self list: rootWrappers.! Item was removed: - ----- Method: SystemWindow>>openAsTool (in category '*ToolBuilder-Morphic-opening') ----- - openAsTool - "Open this window as a tool, that is, honor the preferences such as #reuseWindows and #openToolsAttachedToMouseCursor." - - | meOrSimilarWindow | - meOrSimilarWindow := self openInWorldExtent: self extent. - (Project uiManager openToolsAttachedToMouseCursor - and: [ | event | - event := self currentEvent. - event isMouse and: [event isMouseUp]]) - ifTrue: [ - meOrSimilarWindow setProperty: #initialDrop toValue: true. - meOrSimilarWindow hasDropShadow: false. - self currentHand attachMorph: meOrSimilarWindow]. - ^ meOrSimilarWindow - !
More information about the Squeak-dev mailing list |