Squeak-dev March 2011

squeak-dev@lists.squeakfoundation.org

84 participants
416 discussions

The Inbox: Tools-fbs.301.mcz
by commits＠source.squeak.org 04 Mar '11

04 Mar '11

A new version of Tools was added to project The Inbox: http://source.squeak.org/inbox/Tools-fbs.301.mcz ==================== Summary ==================== Name: Tools-fbs.301 Author: fbs Time: 3 March 2011, 11:20:00.889 pm UUID: 9f787d80-6eb1-0741-a5ac-57d3a80a3c7a Ancestors: Tools-fbs.300 * Complete removal of systemCategoryListIndex, replaced by selectedSystemCategory. * selectedSystemCategoryListIndex/selectedSystemCategoryListIndex: remain, used by Morphic, and defer to selectedSystemCategory/selectedSystemCategory:. * selectedSystemCategoryName defers to selectedSystemCategory, and all its callers now call selectedSystemCategory. * PackagePaneBrowser>>hasSystemCategorySelected pulled up to Browser. =============== Diff against Tools-fbs.300 =============== Item was changed: CodeHolder subclass: #Browser + instanceVariableNames: 'systemOrganizer classOrganizer metaClassOrganizer classListIndex messageCategoryListIndex messageListIndex editSelection metaClassIndicated selectedSystemCategory' - instanceVariableNames: 'systemOrganizer classOrganizer metaClassOrganizer systemCategoryListIndex classListIndex messageCategoryListIndex messageListIndex editSelection metaClassIndicated' classVariableNames: 'ListClassesHierarchically RecentClasses' poolDictionaries: '' category: 'Tools-Browser'! !Browser commentStamp: '<historical>' prior: 0! I represent a query path into the class descriptions, the software of the system.! Item was changed: ----- Method: Browser class>>newOnCategory: (in category 'instance creation') ----- newOnCategory: aCategory "Browse the system category of the given name. 7/13/96 sw" "Browser newOnCategory: 'Interface-Browser'" + | newBrowser newCat | + newBrowser := self new.. + newCat := aCategory asSymbol. + (newBrowser systemCategoryList includes: newCat) + ifTrue: [ newBrowser selectedSystemCategory: newCat ] + ifFalse: [ ^ self inform: 'No such category' ]. + - | newBrowser catList | - newBrowser := self new. - catList := newBrowser systemCategoryList. - newBrowser systemCategoryListIndex: - (catList indexOf: aCategory asSymbol ifAbsent: [^ self inform: 'No such category']). ^ self openBrowserView: (newBrowser openSystemCatEditString: nil) label: 'Classes in category ', aCategory ! Item was changed: ----- Method: Browser>>addSystemCategory (in category 'system category functions') ----- addSystemCategory "Prompt for a new category name and add it before the current selection, or at the end if no current selection" + | oldSelection newName | - | oldIndex newName | self okToChange ifFalse: [^ self]. + oldSelection := self selectedSystemCategory. - oldIndex := systemCategoryListIndex. newName := self request: 'Please type new category name' initialAnswer: 'Category-Name'. newName isEmpty ifTrue: [^ self] ifFalse: [newName := newName asSymbol]. systemOrganizer addCategory: newName + before: self selectedSystemCategory. + self selectedSystemCategory: + (oldSelection isNil + ifTrue: [ self systemCategoryList last ] + ifFalse: [ oldSelection ]). - before: self selectedSystemCategoryName. - self systemCategoryListIndex: - (oldIndex = 0 - ifTrue: [self systemCategoryList size] - ifFalse: [oldIndex]). self changed: #systemCategoryList.! Item was changed: ----- Method: Browser>>alphabetizeSystemCategories (in category 'system category functions') ----- alphabetizeSystemCategories self okToChange ifFalse: [^ false]. systemOrganizer sortCategories. + self selectedSystemCategory: nil. - self systemCategoryListIndex: 0. self changed: #systemCategoryList. ! Item was changed: ----- Method: Browser>>buildMessageCategoryBrowserEditString: (in category 'message category functions') ----- buildMessageCategoryBrowserEditString: aString "Create and schedule a message category browser for the currently selected message category. The initial text view contains the characters in aString." "wod 6/24/1998: set newBrowser classListIndex so that it works whether the receiver is a standard or a Hierarchy Browser." | newBrowser | messageCategoryListIndex ~= 0 ifTrue: [newBrowser := Browser new. + newBrowser selectedSystemCategory: self selectedSystemCategory. - newBrowser systemCategoryListIndex: systemCategoryListIndex. newBrowser classListIndex: (newBrowser classList indexOf: self selectedClassName). newBrowser metaClassIndicated: metaClassIndicated. newBrowser messageCategoryListIndex: messageCategoryListIndex. newBrowser messageListIndex: messageListIndex. self class openBrowserView: (newBrowser openMessageCatEditString: aString) label: 'Message Category Browser (' , newBrowser selectedClassOrMetaClassName , ')']! Item was changed: ----- Method: Browser>>buildSystemCategoryBrowserEditString: (in category 'system category functions') ----- buildSystemCategoryBrowserEditString: aString "Create and schedule a new system category browser with initial textual contents set to aString." | newBrowser | + self hasSystemCategorySelected - systemCategoryListIndex > 0 ifTrue: [newBrowser := self class new. + newBrowser selectedSystemCategory: self selectedSystemCategory. - newBrowser systemCategoryListIndex: systemCategoryListIndex. newBrowser setClass: self selectedClassOrMetaClass selector: self selectedMessageName. self class openBrowserView: (newBrowser openSystemCatEditString: aString) + label: 'Classes in category ', newBrowser selectedSystemCategory]! - label: 'Classes in category ', newBrowser selectedSystemCategoryName]! Item was changed: ----- Method: Browser>>classListIndex: (in category 'class list') ----- classListIndex: anInteger "Set anInteger to be the index of the current class selection." | className currentMessageCategoryName currentMessageName | currentMessageCategoryName := [self selectedMessageCategoryName] on: Error do: [:ex| ex return: nil]. currentMessageName := [self selectedMessageName] on: Error do: [:ex| ex return: nil]. classListIndex := anInteger. self setClassOrganizer. "Try to reselect the category and/or selector if the new class has them." messageCategoryListIndex := self messageCategoryList indexOf: currentMessageCategoryName ifAbsent: [0]. messageListIndex := messageCategoryListIndex = 0 ifTrue: [0] ifFalse: [self messageList indexOf: currentMessageName ifAbsent: [0]]. messageListIndex ~= 0 ifTrue: [self editSelection: #editMessage] ifFalse: [messageCategoryListIndex ~= 0 ifTrue: [self editSelection: #newMessage] ifFalse: [self classCommentIndicated ifTrue: [] ifFalse: [self editSelection: (anInteger = 0 + ifTrue: [(metaClassIndicated or: [ self hasSystemCategorySelected not ]) - ifTrue: [(metaClassIndicated or: [ self selectedSystemCategoryName isNil ]) ifTrue: [#none] ifFalse: [#newClass]] ifFalse: [#editClass])]]]. contents := nil. self selectedClass isNil ifFalse: [className := self selectedClass name. (RecentClasses includes: className) ifTrue: [RecentClasses remove: className]. RecentClasses addFirst: className. RecentClasses size > 16 ifTrue: [RecentClasses removeLast]]. self changed: #classSelectionChanged. self changed: #classCommentText. self changed: #classListIndex. "update my selection" self changed: #messageCategoryList. self changed: #messageList. self changed: #relabel. self contentsChanged! Item was changed: ----- Method: Browser>>contents (in category 'accessing') ----- contents "Depending on the current selection, different information is retrieved. Answer a string description of that information. This information is the method of the currently selected class and message." | comment theClass latestCompiledMethod | latestCompiledMethod := currentCompiledMethod. currentCompiledMethod := nil. editSelection == #newTrait + ifTrue: [^ClassDescription newTraitTemplateIn: self selectedSystemCategory]. - ifTrue: [^ClassDescription newTraitTemplateIn: self selectedSystemCategoryName]. editSelection == #none ifTrue: [^ '']. editSelection == #editSystemCategories ifTrue: [^ systemOrganizer printString]. editSelection == #newClass ifTrue: [^ (theClass := self selectedClass) ifNil: + [Class template: self selectedSystemCategory] - [Class template: self selectedSystemCategoryName] ifNotNil: + [Class templateForSubclassOf: theClass category: self selectedSystemCategory]]. - [Class templateForSubclassOf: theClass category: self selectedSystemCategoryName]]. editSelection == #editClass ifTrue: [^self classDefinitionText]. editSelection == #editComment ifTrue: [(theClass := self selectedClass) ifNil: [^ '']. comment := theClass comment. currentCompiledMethod := theClass organization commentRemoteStr. ^ comment size = 0 ifTrue: ['This class has not yet been commented.'] ifFalse: [comment]]. editSelection == #hierarchy ifTrue: [^self selectedClassOrMetaClass printHierarchy]. editSelection == #editMessageCategories ifTrue: [^ self classOrMetaClassOrganizer printString]. editSelection == #newMessage ifTrue: [^ (theClass := self selectedClassOrMetaClass) ifNil: [''] ifNotNil: [theClass sourceCodeTemplate]]. editSelection == #editMessage ifTrue: [^ self editContentsWithDefault: [currentCompiledMethod := latestCompiledMethod. self selectedMessage]]. self error: 'Browser internal error: unknown edit selection.'! Item was changed: ----- Method: Browser>>defaultClassList (in category 'class list') ----- defaultClassList "Answer an array of the class names of the selected category. Answer an empty array if no selection exists." + + ^ self hasSystemCategorySelected + ifTrue: [systemOrganizer listAtCategoryNamed: self selectedSystemCategory] + ifFalse: [Array new].! - - ^ self selectedSystemCategoryName isNil - ifTrue: [Array new] - ifFalse: [systemOrganizer listAtCategoryNumber: systemCategoryListIndex]! Item was changed: ----- Method: Browser>>editSystemCategories (in category 'system category functions') ----- editSystemCategories "Retrieve the description of the class categories of the system organizer." self okToChange ifFalse: [^ self]. + self selectedSystemCategory: nil. - self systemCategoryListIndex: 0. self editSelection: #editSystemCategories. self changed: #editSystemCategories. self contentsChanged! Item was changed: ----- Method: Browser>>fileOutSystemCategory (in category 'system category functions') ----- fileOutSystemCategory "Print a description of each class in the selected category onto a file whose name is the category name followed by .st." + self hasSystemCategorySelected + ifTrue: [systemOrganizer fileOutCategory: self selectedSystemCategory]! - self selectedSystemCategoryName notNil - ifTrue: [systemOrganizer fileOutCategory: self selectedSystemCategoryName]! Item was added: + ----- Method: Browser>>hasSystemCategorySelected (in category 'system category list') ----- + hasSystemCategorySelected + ^ self selectedSystemCategory notNil.! Item was changed: ----- Method: Browser>>metaClassIndicated: (in category 'metaclass') ----- metaClassIndicated: trueOrFalse "Indicate whether browsing instance or class messages." metaClassIndicated := trueOrFalse. self setClassOrganizer. + self hasSystemCategorySelected ifTrue: - self selectedSystemCategoryName notNil ifTrue: [self editSelection: (classListIndex = 0 ifTrue: [metaClassIndicated ifTrue: [#none] ifFalse: [#newClass]] ifFalse: [#editClass])]. messageCategoryListIndex := 0. messageListIndex := 0. contents := nil. self changed: #classSelectionChanged. self changed: #messageCategoryList. self changed: #messageList. self changed: #contents. self changed: #annotation. self decorateButtons ! Item was changed: ----- Method: Browser>>noteSelectionIndex:for: (in category 'accessing') ----- noteSelectionIndex: anInteger for: aSymbol aSymbol == #systemCategoryList ifTrue: + [self systemCategoryListIndex: anInteger]. - [systemCategoryListIndex := anInteger]. aSymbol == #classList ifTrue: [classListIndex := anInteger]. aSymbol == #messageCategoryList ifTrue: [messageCategoryListIndex := anInteger]. aSymbol == #messageList ifTrue: [messageListIndex := anInteger].! Item was changed: ----- Method: Browser>>printOutSystemCategory (in category 'system category functions') ----- printOutSystemCategory "Print a description of each class in the selected category as Html." Cursor write showWhile: + [self hasSystemCategorySelected + ifTrue: [systemOrganizer fileOutCategory: self selectedSystemCategory - [systemCategoryListIndex ~= 0 - ifTrue: [systemOrganizer fileOutCategory: self selectedSystemCategoryName asHtml: true ]] ! Item was changed: ----- Method: Browser>>removeSystemCategory (in category 'system category functions') ----- removeSystemCategory "If a class category is selected, create a Confirmer so the user can verify that the currently selected class category and all of its classes should be removed from the system. If so, remove it." + self hasSystemCategorySelected ifFalse: [^ self]. - self selectedSystemCategoryName isNil ifTrue: [^ self]. self okToChange ifFalse: [^ self]. (self classList size = 0 or: [self confirm: 'Are you sure you want to remove this system category and all its classes?']) ifTrue: + [systemOrganizer removeSystemCategory: self selectedSystemCategory. + self selectedSystemCategory: nil. - [systemOrganizer removeSystemCategory: self selectedSystemCategoryName. - self systemCategoryListIndex: 0. self changed: #systemCategoryList]! Item was changed: ----- Method: Browser>>renameSystemCategory (in category 'system category functions') ----- renameSystemCategory "Prompt for a new category name and add it before the current selection, or at the end if no current selection" + | oldSelection newName | + oldSelection := self selectedSystemCategory. + oldSelection isNil - | oldIndex oldName newName | - (oldIndex := systemCategoryListIndex) = 0 ifTrue: [^ self]. "no selection" self okToChange ifFalse: [^ self]. + - oldName := self selectedSystemCategoryName. newName := self request: 'Please type new category name' + initialAnswer: oldSelection. - initialAnswer: oldName. newName isEmpty ifTrue: [^ self] ifFalse: [newName := newName asSymbol]. + oldSelection = newName ifTrue: [^ self]. - oldName = newName ifTrue: [^ self]. systemOrganizer + renameCategory: oldSelection - renameCategory: oldName toBe: newName. + self selectedSystemCategory: oldSelection. - self systemCategoryListIndex: oldIndex. self changed: #systemCategoryList.! Item was changed: ----- Method: Browser>>restoreToCategory:className:protocol:selector:mode:meta: (in category 'multi-window support') ----- restoreToCategory: category className: className protocol: protocol selector: selector mode: editMode meta: metaBool + self selectedSystemCategory: category. - self systemCategoryListIndex: (self systemCategoryList indexOf: category). self classListIndex: (self classListIndexOf: className). self metaClassIndicated: metaBool. self messageCategoryListIndex: (self messageCategoryList indexOf: protocol). self messageListIndex: (self messageList indexOf: selector). editSelection := editMode. self contentsChanged; decorateButtons! Item was changed: ----- Method: Browser>>saveMultiWindowState (in category 'multi-window support') ----- saveMultiWindowState ^Message selector: #restoreToCategory:className:protocol:selector:mode:meta: + arguments: { self selectedSystemCategory. - arguments: { self selectedSystemCategoryName. self selectedClassName. self selectedMessageCategoryName. self selectedMessageName. self editSelection. self metaClassIndicated }! Item was changed: ----- Method: Browser>>selectCategoryForClass: (in category 'system category list') ----- selectCategoryForClass: theClass + self selectedSystemCategory: theClass category.! - - self systemCategoryListIndex: (self systemCategoryList indexOf: theClass category) - ! Item was changed: ----- Method: Browser>>selectedEnvironment (in category 'system category list') ----- selectedEnvironment "Answer the name of the selected system category or nil." + self hasSystemCategorySelected ifFalse: [^nil]. - self selectedSystemCategoryName isNil ifTrue: [^nil]. ^ Smalltalk! Item was added: + ----- Method: Browser>>selectedSystemCategory (in category 'system category list') ----- + selectedSystemCategory + ^ selectedSystemCategory! Item was added: + ----- Method: Browser>>selectedSystemCategory: (in category 'system category list') ----- + selectedSystemCategory: aSymbol + "Set the selected system category. Update all other selections to be deselected." + + selectedSystemCategory := aSymbol. + + classListIndex := 0. + messageCategoryListIndex := 0. + messageListIndex := 0. + self editSelection: ( aSymbol isNil ifTrue: [#none] ifFalse: [#newClass]). + metaClassIndicated := false. + self setClassOrganizer. + contents := nil. + self changed: #systemCategorySelectionChanged. + self changed: #systemCategoryListIndex. "update my selection" + self changed: #classList. + self changed: #messageCategoryList. + self changed: #messageList. + self changed: #relabel. + self contentsChanged! Item was changed: ----- Method: Browser>>selectedSystemCategoryName (in category 'system category list') ----- selectedSystemCategoryName "Answer the name of the selected system category or nil." + ^ self selectedSystemCategory.! - systemCategoryListIndex = 0 ifTrue: [^nil]. - ^self systemCategoryList at: systemCategoryListIndex! Item was changed: ----- Method: Browser>>spawn: (in category 'accessing') ----- spawn: aString "Create and schedule a fresh browser and place aString in its code pane. This method is called when the user issues the #spawn command (cmd-o) in any code pane. Whatever text was in the original code pane comes in to this method as the aString argument; the changes in the original code pane have already been cancelled by the time this method is called, so aString is the only copy of what the user had in his code pane." self selectedClassOrMetaClass ifNotNil: [^ super spawn: aString]. + self hasSystemCategorySelected ifTrue: + ["This choice is slightly useless but is the historical implementation" + ^ self buildSystemCategoryBrowserEditString: aString]. - systemCategoryListIndex ~= 0 - ifTrue: - ["This choice is slightly useless but is the historical implementation" - ^ self buildSystemCategoryBrowserEditString: aString]. ^ super spawn: aString "This bail-out at least saves the text being spawned, which would otherwise be lost"! Item was changed: ----- Method: Browser>>systemCategoryListIndex (in category 'system category list') ----- systemCategoryListIndex "Answer the index of the selected class category." + ^ self systemCategoryList indexOf: self selectedSystemCategory.! - ^systemCategoryListIndex! Item was changed: ----- Method: Browser>>systemCategoryListIndex: (in category 'system category list') ----- systemCategoryListIndex: anInteger "Set the selected system category index to be anInteger. Update all other selections to be deselected." + + self selectedSystemCategory: (self systemCategoryList at: anInteger ifAbsent: [ nil ])! - - systemCategoryListIndex := anInteger. - classListIndex := 0. - messageCategoryListIndex := 0. - messageListIndex := 0. - self editSelection: ( anInteger = 0 ifTrue: [#none] ifFalse: [#newClass]). - metaClassIndicated := false. - self setClassOrganizer. - contents := nil. - self changed: #systemCategorySelectionChanged. - self changed: #systemCategoryListIndex. "update my selection" - self changed: #classList. - self changed: #messageCategoryList. - self changed: #messageList. - self changed: #relabel. - self contentsChanged! Item was changed: ----- Method: Browser>>systemCategorySingleton (in category 'system category list') ----- systemCategorySingleton | cat | + cat := self selectedSystemCategory. - cat := self selectedSystemCategoryName. ^ cat ifNil: [Array new] ifNotNil: [Array with: cat]! Item was changed: ----- Method: Browser>>systemOrganizer: (in category 'initialize-release') ----- systemOrganizer: aSystemOrganizer "Initialize the receiver as a perspective on the system organizer, aSystemOrganizer. Typically there is only one--the system variable SystemOrganization." contents := nil. systemOrganizer := aSystemOrganizer. + selectedSystemCategory := nil. - systemCategoryListIndex := 0. classListIndex := 0. messageCategoryListIndex := 0. messageListIndex := 0. metaClassIndicated := false. self setClassOrganizer. self editSelection: #none.! Item was removed: - ----- Method: Browser>>toggleSystemCategoryListIndex: (in category 'system category list') ----- - toggleSystemCategoryListIndex: anInteger - "If anInteger is the current system category index, deselect it. Else make - it the current system category selection." - - self systemCategoryListIndex: - (systemCategoryListIndex = anInteger - ifTrue: [0] - ifFalse: [anInteger])! Item was changed: ----- Method: Browser>>veryDeepInner: (in category 'copying') ----- veryDeepInner: deepCopier "Copy all of my instance variables. Some need to be not copied at all, but shared. See DeepCopier class comment." super veryDeepInner: deepCopier. "systemOrganizer := systemOrganizer. clone has the old value. we share it" "classOrganizer := classOrganizer clone has the old value. we share it" "metaClassOrganizer := metaClassOrganizer clone has the old value. we share it" + selectedSystemCategory := selectedSystemCategory veryDeepCopyWith: deepCopier. - systemCategoryListIndex := systemCategoryListIndex veryDeepCopyWith: deepCopier. classListIndex := classListIndex veryDeepCopyWith: deepCopier. messageCategoryListIndex := messageCategoryListIndex veryDeepCopyWith: deepCopier. messageListIndex := messageListIndex veryDeepCopyWith: deepCopier. editSelection := editSelection veryDeepCopyWith: deepCopier. metaClassIndicated := metaClassIndicated veryDeepCopyWith: deepCopier. ! Item was changed: ----- Method: CodeHolder>>spawn: (in category 'commands') ----- spawn: aString "Create and schedule a spawned message category browser for the currently selected message category. The initial text view contains the characters in aString. In the spawned browser, preselect the current selector (if any) as the going-in assumption, though upon acceptance this will often change" | newBrowser aCategory aClass | (aClass := self selectedClassOrMetaClass) isNil ifTrue: [^ aString isEmptyOrNil ifFalse: [(Workspace new contents: aString) openLabel: 'spawned workspace']]. (aCategory := self categoryOfCurrentMethod) ifNil: [self buildClassBrowserEditString: aString] ifNotNil: [newBrowser := Browser new setClass: aClass selector: self selectedMessageName. self suggestCategoryToSpawnedBrowser: newBrowser. + ^ Browser openBrowserView: (newBrowser openMessageCatEditString: aString) - Browser openBrowserView: (newBrowser openMessageCatEditString: aString) label: 'category "', aCategory, '" in ', newBrowser selectedClassOrMetaClassName]! Item was changed: ----- Method: FileContentsBrowser>>classList (in category 'class list') ----- classList "Answer an array of the class names of the selected category. Answer an empty array if no selection exists." + (self hasSystemCategorySelected not or:[self selectedPackage isNil]) - (systemCategoryListIndex = 0 or:[self selectedPackage isNil]) ifTrue: [^Array new] ifFalse: [^self selectedPackage classes keys asArray sort].! Item was changed: ----- Method: FileContentsBrowser>>findClass (in category 'class list') ----- findClass | pattern foundClass classNames index foundPackage | self okToChange ifFalse: [^ self classNotFound]. pattern := (UIManager default request: 'Class Name?') asLowercase. pattern isEmpty ifTrue: [^ self]. classNames := Set new. self packages do:[:p| classNames addAll: p classes keys]. classNames := classNames asArray select: [:n | (n asLowercase indexOfSubCollection: pattern startingAt: 1) > 0]. classNames isEmpty ifTrue: [^ self]. index := classNames size = 1 ifTrue: [1] ifFalse: [(UIManager default chooseFrom: classNames lines: #())]. index = 0 ifTrue: [^ self]. foundPackage := nil. foundClass := nil. self packages do:[:p| (p classes includesKey: (classNames at: index)) ifTrue:[ foundClass := p classes at: (classNames at: index). foundPackage := p]]. foundClass isNil ifTrue:[^self]. + self selectedSystemCategory: foundPackage packageName asSymbol. - self systemCategoryListIndex: (self systemCategoryList indexOf: foundPackage packageName asSymbol). self classListIndex: (self classList indexOf: foundClass name). ! Item was changed: ----- Method: FileContentsBrowser>>labelString (in category 'other') ----- labelString "Answer the string for the window title" + ^ 'File Contents Browser ', (self selectedSystemCategory ifNil: [''])! - ^ 'File Contents Browser ', (self selectedSystemCategoryName ifNil: [''])! Item was changed: ----- Method: FileContentsBrowser>>removePackage (in category 'removing') ----- removePackage + self hasSystemCategorySelected ifTrue: [^ self]. - systemCategoryListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. (self confirm: 'Are you sure you want to remove this package and all its classes?') ifFalse:[^self]. + (systemOrganizer listAtCategoryNamed: self selectedSystemCategory) do:[:el| - (systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName) do:[:el| systemOrganizer removeElement: el]. self packages removeKey: self selectedPackage packageName. + systemOrganizer removeCategory: self selectedSystemCategory. + self selectedSystemCategory: nil. - systemOrganizer removeCategory: self selectedSystemCategoryName. - self systemCategoryListIndex: 0. self changed: #systemCategoryList! Item was changed: ----- Method: FileContentsBrowser>>renameClass (in category 'class list') ----- renameClass | oldName newName | classListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. oldName := self selectedClass name. newName := (self request: 'Please type new class name' initialAnswer: oldName) asSymbol. (newName isEmpty or:[newName = oldName]) ifTrue: [^ self]. (self selectedPackage classes includesKey: newName) ifTrue: [^ self error: newName , ' already exists in the package']. + systemOrganizer classify: newName under: self selectedSystemCategory. - systemOrganizer classify: newName under: self selectedSystemCategoryName. systemOrganizer removeElement: oldName. self selectedPackage renameClass: self selectedClass to: newName. self changed: #classList. + self classListIndex: ((systemOrganizer listAtCategoryNamed: self selectedSystemCategory) indexOf: newName). - self classListIndex: ((systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName) indexOf: newName). ! Item was changed: ----- Method: FileContentsBrowser>>selectedPackage (in category 'accessing') ----- selectedPackage | cat | + cat := self selectedSystemCategory. - cat := self selectedSystemCategoryName. cat isNil ifTrue:[^nil]. ^self packages at: cat asString ifAbsent:[nil]! Item was changed: ----- Method: HierarchyBrowser>>classListIndex: (in category 'initialization') ----- classListIndex: newIndex "Cause system organization to reflect appropriate category" | newClassName ind | newIndex ~= 0 ifTrue: [newClassName := (classList at: newIndex) copyWithout: $ . + self selectedSystemCategory: (systemOrganizer categories at: + (systemOrganizer numberOfCategoryOfElement: newClassName))]. - systemCategoryListIndex := - systemOrganizer numberOfCategoryOfElement: newClassName]. ind := super classListIndex: newIndex. self changed: #systemCategorySingleton. ^ ind! Item was changed: ----- Method: PackagePaneBrowser>>classList (in category 'class list') ----- classList "Answer an array of the class names of the selected category. Answer an empty array if no selection exists." ^ self hasSystemCategorySelected + ifFalse: [self packageClasses] + ifTrue: [systemOrganizer listAtCategoryNamed: self selectedSystemCategory]! - ifFalse: - [self packageClasses] - ifTrue: [systemOrganizer listAtCategoryNumber: - (systemOrganizer categories indexOf: self selectedSystemCategoryName asSymbol)]! Item was changed: ----- Method: PackagePaneBrowser>>dstCategoryDstListMorph:internal: (in category 'dragNDrop util') ----- dstCategoryDstListMorph: dstListMorph internal: internal | dropItem | ^ internal & (dstListMorph getListSelector == #systemCategoryList) ifTrue: [(dropItem := dstListMorph potentialDropItem) ifNotNil: [(self package , '-' , dropItem) asSymbol]] + ifFalse: [self selectedSystemCategory]! - ifFalse: [self selectedSystemCategoryName]! Item was removed: - ----- Method: PackagePaneBrowser>>hasSystemCategorySelected (in category 'system category list') ----- - hasSystemCategorySelected - ^ systemCategoryListIndex ~= 0! Item was changed: ----- Method: PackagePaneBrowser>>multiWindowName (in category 'multi-window support') ----- multiWindowName "Answer the string to display for the receiver in a multi-window." ^String streamContents: [:s| | str | self package ifNil: [s nextPut: $a; space; nextPutAll: self defaultBrowserTitle] ifNotNil: [:pkg| self selectedClass + ifNil: [self selectedSystemCategory - ifNil: [self selectedSystemCategoryName ifNil: [s nextPutAll: pkg] ifNotNil: [:cat| s nextPutAll: cat]] ifNotNil: [:class| s nextPutAll: pkg; space; print: class. self metaClassIndicated ifTrue: [s nextPutAll: ' class']]]. (str := self selectedMessageName) notNil ifTrue: [s nextPutAll: '>>'; nextPutAll: str] ifFalse: [(str := self selectedMessageCategoryName) notNil ifTrue: [s space; nextPut: ${; nextPutAll: str; nextPut: $}]]]! Item was changed: ----- Method: PackagePaneBrowser>>packageListIndex: (in category 'package list') ----- packageListIndex: anInteger "Set anInteger to be the index of the current package selection." packageListIndex := anInteger. anInteger = 0 ifFalse: [package := self packageList at: packageListIndex]. messageCategoryListIndex := 0. + self selectedSystemCategory: nil. - systemCategoryListIndex := 0. messageListIndex := 0. classListIndex := 0. self setClassOrganizer. self changed: #packageSelectionChanged. self changed: #packageListIndex. "update my selection" self changed: #systemCategoryList. "update the category list" + self selectedSystemCategory: nil. "update category list selection" - self systemCategoryListIndex: 0. "update category list selection" ! Item was changed: ----- Method: PackagePaneBrowser>>saveMultiWindowState (in category 'multi-window support') ----- saveMultiWindowState ^Message selector: #restoreToPackage:category:className:protocol:selector:mode:meta: arguments: { self package. + self selectedSystemCategory. - self systemCategoryList at: systemCategoryListIndex ifAbsent: []. self selectedClassName. self selectedMessageCategoryName. self selectedMessageName. self editSelection. self metaClassIndicated }! Item was changed: ----- Method: PackagePaneBrowser>>selectCategoryForClass: (in category 'system category list') ----- selectCategoryForClass: theClass "Set the package and category lists to display the given class." + | cat catName | - | cat | cat := theClass category. + self packageListIndex: (self packageList indexOf: (cat copyUpTo: $-)). + catName := (cat copyFrom: ((cat indexOf: $- ifAbsent: [0]) + 1) to: cat size). + self selectedSystemCategory: catName.! - self packageListIndex: (self packageList indexOf: (cat copyUpTo: $-)). - self systemCategoryListIndex: (self systemCategoryList indexOf: - (cat copyFrom: ((cat indexOf: $- ifAbsent: [0]) + 1) to: cat size)).! Item was changed: ----- Method: PackagePaneBrowser>>selectedSystemCategoryName (in category 'system category list') ----- selectedSystemCategoryName "Answer the name of the selected system category or nil." + self hasSystemCategorySelected + ifFalse: [^nil]. - systemCategoryListIndex = 0 - ifTrue: [^nil]. packageListIndex = 0 + ifTrue: [^ self selectedSystemCategory ]. + ^ self package , '-' , self selectedSystemCategory! - ifTrue: [^ self systemCategoryList at: systemCategoryListIndex]. - ^ self package , '-' , (self systemCategoryList at: systemCategoryListIndex)! Item was changed: ----- Method: ParagraphEditor>>browseItHere (in category '*Tools') ----- browseItHere "Retarget the receiver's window to look at the selected class, if appropriate. 3/1/96 sw" | aSymbol b | (((b := model) isKindOf: Browser) and: [b couldBrowseAnyClass]) ifFalse: [^ view flash]. model okToChange ifFalse: [^ view flash]. self selectionInterval isEmpty ifTrue: [self selectWord]. (aSymbol := self selectedSymbol) ifNil: [^ view flash]. self terminateAndInitializeAround: [| foundClass | foundClass := (Smalltalk at: aSymbol ifAbsent: [nil]). foundClass ifNil: [^ view flash]. (foundClass isKindOf: Class) ifTrue: + [model selectedSystemCategory: foundClass category. - [model systemCategoryListIndex: - (model systemCategoryList indexOf: foundClass category). model classListIndex: (model classList indexOf: foundClass name)]]!

1 0

The Inbox: ToolsTests-fbs.7.mcz
by commits＠source.squeak.org 04 Mar '11

04 Mar '11

A new version of ToolsTests was added to project The Inbox: http://source.squeak.org/inbox/ToolsTests-fbs.7.mcz ==================== Summary ==================== Name: ToolsTests-fbs.7 Author: fbs Time: 3 March 2011, 11:16:07.095 pm UUID: 093622b6-d1fd-4d44-9ee0-0f017d21ee80 Ancestors: ToolsTests-tbn.5 Woefully inadequate test suite for Tools-fbs.300's extensive refactoring. =============== Diff against ToolsTests-tbn.5 =============== Item was changed: ----- Method: BrowserHierarchicalListTest>>hierarchicalClassListForCategory: (in category 'helper') ----- hierarchicalClassListForCategory: category + ^ Browser new + selectedSystemCategory: category; + hierarchicalClassList.! - | b index | - b := Browser new. - index := b systemCategoryList indexOf: category. - b systemCategoryListIndex: index. - ^ b hierarchicalClassList. - ! Item was added: + TestCase subclass: #BrowserTest + instanceVariableNames: 'browser' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolsTests-Browser'! Item was added: + ----- Method: BrowserTest>>setUp (in category 'as yet unclassified') ----- + setUp + browser := Browser new.! Item was added: + ----- Method: BrowserTest>>testDefaultClassList (in category 'as yet unclassified') ----- + testDefaultClassList + browser selectedSystemCategory: nil. + self assert: browser defaultClassList isEmpty. + + browser selectedSystemCategory: Browser category. + self assert: browser defaultClassList = (SystemOrganization listAtCategoryNamed: Browser category)! Item was added: + ----- Method: BrowserTest>>testGetSystemCategoryListIndex (in category 'as yet unclassified') ----- + testGetSystemCategoryListIndex + | cat | + cat := SystemOrganization categories first. + browser selectedSystemCategory: cat. + self assert: browser systemCategoryListIndex = (SystemOrganization categories indexOf: browser selectedSystemCategory).! Item was added: + ----- Method: BrowserTest>>testSelectCategoryForClass (in category 'as yet unclassified') ----- + testSelectCategoryForClass + browser selectCategoryForClass: Browser. + self assert: browser selectedSystemCategory = Browser category. + + browser selectCategoryForClass: TestCase. + self assert: browser selectedSystemCategory = TestCase category.! Item was added: + ----- Method: BrowserTest>>testSelectedEnvironment (in category 'as yet unclassified') ----- + testSelectedEnvironment + browser selectedSystemCategory: Browser category. + self assert: browser selectedEnvironment = Smalltalk. + + browser selectedSystemCategory: nil. + self assert: browser selectedEnvironment isNil.! Item was added: + ----- Method: BrowserTest>>testSelectedSystemCategory (in category 'as yet unclassified') ----- + testSelectedSystemCategory + | cat newCat | + cat := SystemOrganization categories first. + newCat := SystemOrganization categories second. + browser selectedSystemCategory: cat. + self assert: browser selectedSystemCategory = cat. + + browser systemCategoryListIndex: 2. + self assert: browser selectedSystemCategory = newCat.! Item was added: + ----- Method: BrowserTest>>testSystemCategoryListIndex (in category 'as yet unclassified') ----- + testSystemCategoryListIndex + | oldCat | + + browser systemCategoryListIndex: 1. + oldCat := browser selectedSystemCategory. + self assert: browser selectedSystemCategory = SystemOrganization categories first. + + browser systemCategoryListIndex: 2. + self deny: browser selectedSystemCategory = oldCat. + self assert: browser selectedSystemCategory = SystemOrganization categories second.! Item was added: + TestCase subclass: #PackagePaneBrowserTest + instanceVariableNames: 'browser' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolsTests-Browser'! Item was added: + ----- Method: PackagePaneBrowserTest>>setUp (in category 'as yet unclassified') ----- + setUp + browser := PackagePaneBrowser new.! Item was added: + ----- Method: PackagePaneBrowserTest>>testClassList (in category 'as yet unclassified') ----- + testClassList + browser selectedSystemCategory: browser class category. + self assert: browser classList = (SystemOrganization listAtCategoryNamed: browser class category). + + browser selectedSystemCategory: nil. + self assert: browser classList isEmpty.! Item was added: + ----- Method: PackagePaneBrowserTest>>testSelectCategoryForClass (in category 'as yet unclassified') ----- + testSelectCategoryForClass + | catName pkgName | + pkgName := browser class category copyUpTo: $-. + catName := browser class category allButFirst: pkgName size + 1. + browser selectCategoryForClass: browser class. + self assert: browser selectedSystemCategory = catName. + self assert: browser packageListIndex = (browser packageList indexOf: pkgName). + browser selectedSystemCategory: nil. + self assert: browser classList isEmpty.!

1 0

Re: [squeak-dev] The Trunk: Morphic-mtf.521.mcz
by Chris Muller 03 Mar '11

03 Mar '11

Ever since this change, I have been getting quite a few accidental drags when selecting methods, which is distracting because, with Maui loaded, it instantiates a naked-object view from the dragged method and I have to close it. The DragThreshold variable is a good idea, but drag-threshold function exists for a reason has effectively been nullified by the default value of 0. Therefore, I would like to change the default value back to 5, and Cobalt will have to adjust it to 0.. - Chris On Mon, Feb 21, 2011 at 3:31 PM, <commits(a)source.squeak.org> wrote: > Matthew Fulmer uploaded a new version of Morphic to project The Trunk: > http://source.squeak.org/trunk/Morphic-mtf.521.mcz > > ==================== Summary ==================== > > Name: Morphic-mtf.521 > Author: mtf > Time: 21 February 2011, 4:29:10.979 pm > UUID: cf57b307-096f-4311-a02e-b1f53d206e9c > Ancestors: Morphic-nice.520 > > created HandMorph >> dragThreshold to hold the default drag threshold > > Changed drag users to use this setting rather than make up their own thresholds > > Finished a partial change of SystemWindow from simulating its own dragging to using the builtin drag mechanism > > Made the default drag threshold zero pixels. it was previously 0, 5, or 10 pixels, depending on the morph > > =============== Diff against Morphic-nice.520 =============== > > Item was changed: > ----- Method: ClickExerciser>>mouseDown: (in category 'event handling') ----- > mouseDown: evt > "Do nothing upon mouse-down except inform the hand to watch for a > double-click; wait until an ensuing click:, doubleClick:, or drag: > message gets dispatched" > Preferences disable: #NewClickTest . > evt hand > waitForClicksOrDrag: self > event: evt > selectors: self selectors > + threshold: HandMorph dragThreshold! > - threshold: 10 > - ! > > Item was changed: > ----- Method: HaloMorph>>blueButtonDown: (in category 'meta-actions') ----- > blueButtonDown: event > "Transfer the halo to the next likely recipient" > target ifNil:[^self delete]. > event hand obtainHalo: self. > positionOffset := event position - (target point: target position in: owner). > self isMagicHalo ifTrue:[ > self isMagicHalo: false. > ^self magicAlpha: 1.0]. > "wait for drags or transfer" > event hand > waitForClicksOrDrag: self > event: event > selectors: { #transferHalo:. nil. nil. #dragTarget:. } > + threshold: HandMorph dragThreshold! > - threshold: 5.! > > Item was changed: > Morph subclass: #HandMorph > instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners mouseClickState mouseOverHandler lastMouseEvent targetOffset damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter' > + classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats NewEventRules NormalCursor PasteBuffer ShowEvents' > - classVariableNames: 'CompositionWindowManager DoubleClickTime EventStats NewEventRules NormalCursor PasteBuffer ShowEvents' > poolDictionaries: 'EventSensorConstants' > category: 'Morphic-Kernel'! > > !HandMorph commentStamp: '<historical>' prior: 0! > The cursor may be thought of as the HandMorph. The hand's submorphs hold anything being carried by dragging. > > There is some minimal support for multiple hands in the same world.! > > Item was added: > + ----- Method: HandMorph class>>dragThreshold (in category 'accessing') ----- > + dragThreshold > + > + ^ DragThreshold > + ! > > Item was added: > + ----- Method: HandMorph class>>dragThreshold: (in category 'accessing') ----- > + dragThreshold: pixels > + > + DragThreshold := pixels! > > Item was changed: > ----- Method: HandMorph class>>initialize (in category 'class initialization') ----- > initialize > "HandMorph initialize" > > PasteBuffer := nil. > DoubleClickTime := 350. > + DragThreshold := 0. > NormalCursor := CursorWithMask normal asCursorForm. > ! > > Item was changed: > ----- Method: HandMorph>>waitForClicksOrDrag:event: (in category 'double click support') ----- > waitForClicksOrDrag: aMorph event: evt > "Wait for mouse button and movement events, informing aMorph about events interesting to it via callbacks. > This message is typically sent to the Hand by aMorph when it first receives a mouse-down event. > The callback methods invoked on aMorph (which are passed a copy of evt) are: > #click: sent when the mouse button goes up within doubleClickTime. > #doubleClick: sent when the mouse goes up, down, and up again all within DoubleClickTime. > #doubleClickTimeout: sent when the mouse does not have a doubleClick within DoubleClickTime. > #startDrag: sent when the mouse moves more than 10 pixels from evt's position within DoubleClickTime. > Note that mouseMove: and mouseUp: events are not sent to aMorph until it becomes the mouse focus, > which is typically done by aMorph in its click:, doubleClick:, or drag: methods." > > + ^self waitForClicksOrDrag: aMorph event: evt selectors: #( #click: #doubleClick: #doubleClickTimeout: #startDrag:) threshold: HandMorph dragThreshold! > - ^self waitForClicksOrDrag: aMorph event: evt selectors: #( #click: #doubleClick: #doubleClickTimeout: #startDrag:) threshold: 10 > - ! > > Item was changed: > ----- Method: Morph>>blueButtonDown: (in category 'meta-actions') ----- > blueButtonDown: anEvent > "Special gestures (cmd-mouse on the Macintosh; Alt-mouse on Windows and Unix) allow a mouse-sensitive morph to be moved or bring up a halo for the morph." > | h tfm doNotDrag | > h := anEvent hand halo. > "Prevent wrap around halo transfers originating from throwing the event back in" > doNotDrag := false. > h ifNotNil:[ > (h innerTarget == self) ifTrue:[doNotDrag := true]. > (h innerTarget hasOwner: self) ifTrue:[doNotDrag := true]. > (self hasOwner: h target) ifTrue:[doNotDrag := true]]. > > tfm := (self transformedFrom: nil) inverseTransformation. > > "cmd-drag on flexed morphs works better this way" > h := self addHalo: (anEvent transformedBy: tfm). > h ifNil: [^ self]. > doNotDrag ifTrue:[^self]. > "Initiate drag transition if requested" > anEvent hand > waitForClicksOrDrag: h > event: (anEvent transformedBy: tfm) > selectors: { nil. nil. nil. #dragTarget:. } > + threshold: HandMorph dragThreshold. > - threshold: 5. > "Pass focus explicitly here" > anEvent hand newMouseFocus: h.! > > Item was changed: > ----- Method: PasteUpMorph>>mouseDown: (in category 'event handling') ----- > mouseDown: evt > "Handle a mouse down event." > | grabbedMorph handHadHalos | > > (Preferences generalizedYellowButtonMenu > and: [evt yellowButtonPressed]) > ifTrue: [^ self yellowButtonActivity: evt shiftPressed]. > > grabbedMorph := self morphToGrab: evt. > grabbedMorph ifNotNil:[ > grabbedMorph isSticky ifTrue:[^self]. > self isPartsBin ifFalse:[^evt hand grabMorph: grabbedMorph]. > grabbedMorph := grabbedMorph partRepresented duplicate. > grabbedMorph restoreSuspendedEventHandler. > (grabbedMorph fullBounds containsPoint: evt position) > ifFalse:[grabbedMorph position: evt position]. > "Note: grabbedMorph is ownerless after duplicate so use #grabMorph:from: instead" > ^ evt hand grabMorph: grabbedMorph from: self]. > > (super handlesMouseDown: evt) > ifTrue:[^super mouseDown: evt]. > > handHadHalos := evt hand halo notNil. > > evt hand removeHalo. "shake off halos" > evt hand releaseKeyboardFocus. "shake of keyboard foci" > > self submorphs > select:[:each | each hasProperty: #morphHierarchy] > thenDo:[:each | each delete]. > > Preferences noviceMode > ifTrue:[ > self submorphs > select:[:each | (each isKindOf: MenuMorph) and:[each stayUp not]] > thenDo:[:each | each delete]. > ]. > > (evt shiftPressed not > and:[ self isWorldMorph not > and:[ self wantsEasySelection not ]]) > ifTrue:[ > "explicitly ignore the event if we're not the world and we'll not select, > so that we could be picked up if need be" > evt wasHandled: false. > ^ self. > ]. > > ( evt shiftPressed or: [ self wantsEasySelection ] ) ifTrue:[ > "We'll select on drag, let's decide what to do on click" > | clickSelector | > > clickSelector := nil. > > evt shiftPressed ifTrue:[ > clickSelector := #findWindow:. > ] > ifFalse:[ > self isWorldMorph ifTrue:[ > clickSelector := handHadHalos > ifTrue: [ #delayedInvokeWorldMenu: ] > ifFalse: [ #invokeWorldMenu: ] > ] > ]. > > evt hand > waitForClicksOrDrag: self > event: evt > selectors: { clickSelector. nil. nil. #dragThroughOnDesktop: } > + threshold: HandMorph dragThreshold. > - threshold: 5. > ] > ifFalse:[ > "We wont select, just bring world menu if I'm the world" > self isWorldMorph ifTrue:[ > handHadHalos > ifTrue: [ self delayedInvokeWorldMenu: evt ] > ifFalse: [ self invokeWorldMenu: evt ] > ] > ]. > ! > > Item was changed: > ----- Method: PluggableListMorph>>mouseDown: (in category 'events') ----- > mouseDown: evt > | selectors row | > evt yellowButtonPressed "First check for option (menu) click" > ifTrue: [^ self yellowButtonActivity: evt shiftPressed]. > row := self rowAtLocation: evt position. > row = 0 ifTrue: [^super mouseDown: evt]. > "self dragEnabled ifTrue: [aMorph highlightForMouseDown]." > selectors := Array > with: #click: > with: (doubleClickSelector ifNotNil:[#doubleClick:]) > with: nil > with: (self dragEnabled ifTrue:[#startDrag:] ifFalse:[nil]). > + evt hand waitForClicksOrDrag: self event: evt selectors: selectors threshold: HandMorph dragThreshold "pixels".! > - evt hand waitForClicksOrDrag: self event: evt selectors: selectors threshold: 10 "pixels".! > > Item was removed: > - ----- Method: PluggableSystemWindowWithLabelButton>>mouseDown: (in category 'events') ----- > - mouseDown: evt > - | wasInactive | > - wasInactive := TopWindow ~~ self. > - self valueOfProperty: #clickPoint ifPresentDo: > - [:firstClick | > - (labelButton containsPoint: evt cursorPoint) ifTrue: > - [^labelButton mouseDown: evt]]. > - super mouseDown: evt. > - (wasInactive > - and: [model windowActiveOnFirstClick not > - and: [labelButton containsPoint: evt cursorPoint]]) ifTrue: > - [^labelButton mouseDown: evt]! > > Item was removed: > - ----- Method: PluggableSystemWindowWithLabelButton>>passivate (in category 'top window') ----- > - passivate > - super passivate. > - self removeProperty: #clickPoint! > > Item was changed: > ----- Method: SimpleHierarchicalListMorph>>mouseDown: (in category 'event handling') ----- > mouseDown: evt > | aMorph selectors | > aMorph := self itemFromPoint: evt position. > (aMorph notNil and:[aMorph inToggleArea: (aMorph point: evt position from: self)]) > ifTrue:[^self toggleExpandedState: aMorph event: evt]. > evt yellowButtonPressed "First check for option (menu) click" > ifTrue: [^ self yellowButtonActivity: evt shiftPressed]. > aMorph ifNil:[^super mouseDown: evt]. > aMorph highlightForMouseDown. > selectors := Array > with: #click: > with: nil > with: nil > with: (self dragEnabled ifTrue:[#startDrag:] ifFalse:[nil]). > + evt hand waitForClicksOrDrag: self event: evt selectors: selectors threshold: HandMorph dragThreshold "pixels".! > - evt hand waitForClicksOrDrag: self event: evt selectors: selectors threshold: 10 "pixels".! > > Item was changed: > ----- Method: SystemWindow>>handlesMouseDown: (in category 'events') ----- > handlesMouseDown: evt > "If I am not the topWindow, then I will only respond to dragging by the title bar. > Any other click will only bring me to the top" > > - (self labelRect containsPoint: evt cursorPoint) > - ifTrue: [^ true]. > ^ self activeOnlyOnTop and: [self ~~ TopWindow]! > > Item was changed: > ----- Method: SystemWindow>>mouseDown: (in category 'events') ----- > mouseDown: evt > > - self setProperty: #clickPoint toValue: evt cursorPoint. > TopWindow == self ifFalse: > [evt hand releaseKeyboardFocus. > self activate]. > + > + "the window was locked, thus we got the event. re-send it now that the window is unlocked again" > + evt wasHandled: false. > + model windowActiveOnFirstClick > + ifTrue: [self processEvent: evt] "re-dispatch to any submorphs" > + ifFalse: [label processEvent: evt]. "dispatch to label so dragging works" > + evt wasHandled: true. > - model windowActiveOnFirstClick ifTrue: > - ["Normally window keeps control of first click. > - Need explicit transmission for first-click activity." > - submorphs do: [:m | (m containsPoint: evt cursorPoint) ifTrue: [m mouseDown: evt]]] > - > ! > > Item was removed: > - ----- Method: SystemWindow>>mouseMove: (in category 'events') ----- > - mouseMove: evt > - "Handle a mouse-move event" > - > - | cp | > - cp := evt cursorPoint. > - self valueOfProperty: #clickPoint ifPresentDo: > - [:firstClick | > - ((self labelRect containsPoint: firstClick) and: [(cp dist: firstClick) > 3]) ifTrue: > - ["If this is a drag that started in the title bar, then pick me up" > - ^ self isSticky ifFalse: > - [self fastFramingOn > - ifTrue: [self doFastFrameDrag: firstClick] > - ifFalse: [evt hand grabMorph: self topRendererOrSelf]]]]. > - model windowActiveOnFirstClick ifTrue: > - ["Normally window takes control on first click. > - Need explicit transmission for first-click activity." > - submorphs do: [:m | (m containsPoint: cp) ifTrue: [m mouseMove: evt]]]! > > Item was changed: > ----- Method: SystemWindow>>startDragFromLabel: (in category 'events') ----- > startDragFromLabel: evt > "When label events are active, we need to pass dragging to the window explicitely > The window only recognizes a drag with an offset of more than 3 pixels" > > + self isSticky ifTrue: [^ self]. > + self fastFramingOn > + ifTrue: [self doFastFrameDrag: evt cursorPoint] > + ifFalse: [evt hand grabMorph: self topRendererOrSelf] > + ! > - self setProperty: #clickPoint toValue: evt cursorPoint - 4. > - self mouseMove: evt.! > > >

3 2

RE: Squeak/Pharo/Cuis on Android
by Dimitry Golubovsky 03 Mar '11

03 Mar '11

Hi, Torsten Bergmann wrote: What is the state of Squeak/Pharo/Cuis for Android tablets and phone? Lots of questions: - what is the state of VM/images? - any comments/hints on devices, speed and memory consumption? - is it worth to buy one to run Smalltalk for own stuff? - anyone written apps with Smalltalk for Android? - is it possible to interface with native stuff. state of touch support, ... -------------------------------------------------------------------------------------------- I am working on my fork of the squeak android port: http://code.google.com/p/squeakvm-tablet/ - is my fork http://code.google.com/p/squeak-android-vm/ - is the parent project State of VM: I mostly borrowed the JNI part of the parent project, making small adjustments as needed. There will be more as I need to interface TTS (speech synthesizer), and this requires some callbacks to Java code. I haven't come up with a final solution yet. Images: I have inherited the image from the parent project (based on v3.9) and am currently working on visual theme adjustment - see my recent message (with questions) on this list. Like the parent project, my port cannot save the image. But it can load the image from sdcard, so it can be tweaked on a PC and transferred to the device via USB or WiFi. Devices: I am specifically targeting tablets rather than telephones. My testbed is called "Pandigital Novel eReader" with 9in 800x480 screen, chosen mainly for its low price (~$190) and it was sold physically in a Bed Bath & Beyond store. It is rather slow; I posted my tinyBenchmark results here: http://code.google.com/p/squeakvm-tablet/wiki/TinyBenchmark along with other people's reports found on this mailing list. The device has 256M of RAM, does not seem to run out of memory with Squeak. Is it worth to buy: Well I have a certain problem to solve where low price and tablet form-factor are necessary, so my choice is driven by this. I did some price comparisons, and IMHO (deeply IMHO!!!) decent performance can these days be gotten from ARM devices privced well over $300, but Intel EEE tablets or IdeaPad tablets start in lower $400, and they run usual Windows (or Linux if one prefers to install) and then you can have your regular Squeak/whatever w/o any porting. So YMMV Anyone written apps: maybe I will be one but I haven't written it yet ;) And my problems are kind of specific... Native stuff: not sure if FFI plugin is integrated with this image, however all the VM code is there, so perhaps in some quick and dirty ways manually written plugins could be thrown in... Touch support: I have recently committed code which enables hardware buttons to modify color of mouse for one subsequent click. Such way I was able to do middle (blue) click inside a workspace where 0 tinyBenchmark was typed, select Print-it, and after a while I got the results. I can cause right (yellow) click to bring on halos. I also got soft keyboard to work, but have troubles getting events from the DEL key (looks like I need to subclass the keyboard, or install some special listener in the view, I am not sure yet). In a workspace I typed Morph new openInWorld. did a middle click, selected do-it, and a blue square appeared in the left upper corner of the screen. I was able to move it with my finger (although it disappears while being dragged) to the center of the screen, then I brought up halo and deleted it. Hope I answered all questions ;) Thanks for your interest. -- Dimitry Golubovsky Anywhere on the Web

1 0

Cog VM "right" clicks?
by Frank Shearar 03 Mar '11

03 Mar '11

I'm running trunk on "Teleplace VM 1.0.15 (release) from Oct 4 2010", and just found out that I can't alt-click in a Browser to add a new system category. (I don't know the correct mouse button colour terminology.) I can do the usual click, and the halo-showing click, but not the click I need to carry on my "browser whitewash" work. What to do?

2 1

Initial screen position of world menu?
by Dimitry Golubovsky 03 Mar '11

03 Mar '11

Hi, I am working on adjusting the Squeak visual theme for use on a tablet touch screen. It seems like the image used originally with the Android port was derived from Squeak 3.9, and many packages were removed to reduce size, so modern theme builders are likely not included on the image (nor do I want to load them into the image anyway), so I have to go directly into theme methods and change code there. One thing I need to do is to change the initial placement of click-induced menus (e. g. world menu) relative to the screen position where mouse click (tap on screen) was made. It is currently so that the menu's title bar spans to the right of the mouse click position (and the whole menu is right-downwards), and it may be only span to the left if the click was made too close to the right edge of the screen. As a consequence, if I tap the screen with my right hand's finger, the menu opens to the right, and is partly obscured by the finger. The menu acts more reliably if I keep sliding the finger vertically until the item I need is highlighted, and then lift the finger from the screen. All this time I can barely see the menu as the finger obscures the view. How can I make any menu resluting from mouse click to open to the left of the click location? (that is, where is the code responsible for that so I could include it in the theme). OTOH someone might use their left hand, so the right side placement of the menu is OK for them. So I'd like to add this as a theme preference. Thanks for any ideas. -- Dimitry Golubovsky Anywhere on the Web

1 0

Deoptimized calls fail in Cog (was Re: [squeak-dev] The Trunk: Compiler-nice.189.mcz)
by Juan Vuletich 03 Mar '11

03 Mar '11

Hi Folks, commits(a)source.squeak.org wrote: > Nicolas Cellier uploaded a new version of Compiler to project The Trunk: > http://source.squeak.org/trunk/Compiler-nice.189.mcz > > ==================== Summary ==================== > > Name: Compiler-nice.189 > Author: nice > Time: 13 February 2011, 7:44:38.363 pm > UUID: 3f6f02cd-1acf-48de-a388-b5ac55e27055 > Ancestors: Compiler-nice.188 > > Enable cascading of special messages by deoptimizing, thanks Eliot. > This is mostly useless, but it removes an arbitrary limitation of the language. > > =============== Diff against Compiler-nice.188 =============== > I integrated this nice code in Cuis, and tried: true ifTrue: [ Transcript cr; show: 'was true' ]; yourself I found that this works ok with the interpreter but does nothing in Cog. A bug, right? Cheers, Juan Vuletich

3 13

Browser whitewash
by Eliot Miranda 02 Mar '11

02 Mar '11

Hi All, while all these cool new browsers are great I get on well with the standard browser and my multi-window hack around it. But the multi-window hack shows up one major weakness with the default Browser, and that is it's use of list indices (systemCategoryListIndex classListIndex messageCategoryListIndex messageListIndex). These should just be systemCategoryName, className, messageProtocol (categories are in System-Organization; classes have protocols) messageSelector. If this happened the indices the browser has into the system would never become obsolete as does happen for example when one adds a class to a category, invalidating any classListIndex values into the same category, or systemCategoryListIndexes as happens often when the SystemOrganization changes on loading a package. So if anyone is looking for a small useful project, someone who probably has RB chops, how about reimplementing Browser so that it is essentially unchanged except for the indexes being ripped out, buried and stomped on? If someone did this I'd get round to using menu pragmas throughout and integrating the RB into the base Browser. cheers Eliot

4 5

The Inbox: Network-fbs.109.mcz
by commits＠source.squeak.org 02 Mar '11

02 Mar '11

A new version of Network was added to project The Inbox: http://source.squeak.org/inbox/Network-fbs.109.mcz ==================== Summary ==================== Name: Network-fbs.109 Author: fbs Time: 2 March 2011, 9:47:50.318 pm UUID: 2fa743f8-8956-ef47-9bb0-b97bcc55c02d Ancestors: Network-fbs.108 Cees de Groot's fix for <http://bugs.squeak.org/view.php?id=7199>. It looks fine, and provides much-needed control over socket connection timeouts. =============== Diff against Network-fbs.108 =============== Item was changed: ----- Method: ProtocolClient>>ensureConnection (in category 'private') ----- ensureConnection self isConnected ifTrue: [^self]. self stream ifNotNil: [self stream close]. + self stream: (SocketStream openConnectionToHost: self host port: self port timeout: self standardTimeout). - self stream: (SocketStream openConnectionToHost: self host port: self port). self checkResponse. self login! Item was added: + ----- Method: ProtocolClient>>standardTimeout (in category 'private') ----- + standardTimeout + + ^ Socket standardTimeout! Item was changed: ----- Method: SocketStream class>>openConnectionToHost:port: (in category 'instance creation') ----- openConnectionToHost: hostIP port: portNumber + ^ self openConnectionToHost: hostIP port: portNumber timeout: Socket standardTimeout! - | socket | - socket := Socket new. - socket connectTo: hostIP port: portNumber. - ^self on: socket! Item was added: + ----- Method: SocketStream class>>openConnectionToHost:port:timeout: (in category 'instance creation') ----- + openConnectionToHost: hostIP port: portNumber timeout: timeout + | socket | + socket _ Socket new. + socket connectTo: hostIP port: portNumber waitForConnectionFor: timeout. + ^self on: socket!

1 0

The Inbox: Tools-fbs.300.mcz
by commits＠source.squeak.org 02 Mar '11

02 Mar '11

A new version of Tools was added to project The Inbox: http://source.squeak.org/inbox/Tools-fbs.300.mcz ==================== Summary ==================== Name: Tools-fbs.300 Author: fbs Time: 2 March 2011, 9:44:48.578 pm UUID: 6ecc489f-5915-1b47-883b-25666a27aabd Ancestors: Tools-dtl.299 Baby steps to Browser index death: change "systemCategoryListIndex <op> 0" to "self selectedSystemCategoryName isNil/notNil". =============== Diff against Tools-dtl.299 =============== Item was changed: ----- Method: Browser>>addSystemCategory (in category 'system category functions') ----- addSystemCategory "Prompt for a new category name and add it before the current selection, or at the end if no current selection" | oldIndex newName | self okToChange ifFalse: [^ self]. oldIndex := systemCategoryListIndex. newName := self request: 'Please type new category name' initialAnswer: 'Category-Name'. newName isEmpty ifTrue: [^ self] ifFalse: [newName := newName asSymbol]. systemOrganizer addCategory: newName + before: self selectedSystemCategoryName. - before: (systemCategoryListIndex = 0 - ifTrue: [nil] - ifFalse: [self selectedSystemCategoryName]). self systemCategoryListIndex: (oldIndex = 0 ifTrue: [self systemCategoryList size] ifFalse: [oldIndex]). self changed: #systemCategoryList.! Item was changed: ----- Method: Browser>>classListIndex: (in category 'class list') ----- classListIndex: anInteger "Set anInteger to be the index of the current class selection." | className currentMessageCategoryName currentMessageName | currentMessageCategoryName := [self selectedMessageCategoryName] on: Error do: [:ex| ex return: nil]. currentMessageName := [self selectedMessageName] on: Error do: [:ex| ex return: nil]. classListIndex := anInteger. self setClassOrganizer. "Try to reselect the category and/or selector if the new class has them." messageCategoryListIndex := self messageCategoryList indexOf: currentMessageCategoryName ifAbsent: [0]. messageListIndex := messageCategoryListIndex = 0 ifTrue: [0] ifFalse: [self messageList indexOf: currentMessageName ifAbsent: [0]]. messageListIndex ~= 0 ifTrue: [self editSelection: #editMessage] ifFalse: [messageCategoryListIndex ~= 0 ifTrue: [self editSelection: #newMessage] ifFalse: [self classCommentIndicated ifTrue: [] ifFalse: [self editSelection: (anInteger = 0 + ifTrue: [(metaClassIndicated or: [ self selectedSystemCategoryName isNil ]) - ifTrue: [(metaClassIndicated or: [ systemCategoryListIndex = 0 ]) ifTrue: [#none] ifFalse: [#newClass]] ifFalse: [#editClass])]]]. contents := nil. self selectedClass isNil ifFalse: [className := self selectedClass name. (RecentClasses includes: className) ifTrue: [RecentClasses remove: className]. RecentClasses addFirst: className. RecentClasses size > 16 ifTrue: [RecentClasses removeLast]]. self changed: #classSelectionChanged. self changed: #classCommentText. self changed: #classListIndex. "update my selection" self changed: #messageCategoryList. self changed: #messageList. self changed: #relabel. self contentsChanged! Item was changed: ----- Method: Browser>>defaultClassList (in category 'class list') ----- defaultClassList "Answer an array of the class names of the selected category. Answer an empty array if no selection exists." + ^ self selectedSystemCategoryName isNil - ^ systemCategoryListIndex = 0 ifTrue: [Array new] ifFalse: [systemOrganizer listAtCategoryNumber: systemCategoryListIndex]! Item was changed: ----- Method: Browser>>fileOutSystemCategory (in category 'system category functions') ----- fileOutSystemCategory "Print a description of each class in the selected category onto a file whose name is the category name followed by .st." + self selectedSystemCategoryName notNil - systemCategoryListIndex ~= 0 ifTrue: [systemOrganizer fileOutCategory: self selectedSystemCategoryName]! Item was changed: ----- Method: Browser>>metaClassIndicated: (in category 'metaclass') ----- metaClassIndicated: trueOrFalse "Indicate whether browsing instance or class messages." metaClassIndicated := trueOrFalse. self setClassOrganizer. + self selectedSystemCategoryName notNil ifTrue: - systemCategoryListIndex > 0 ifTrue: [self editSelection: (classListIndex = 0 ifTrue: [metaClassIndicated ifTrue: [#none] ifFalse: [#newClass]] ifFalse: [#editClass])]. messageCategoryListIndex := 0. messageListIndex := 0. contents := nil. self changed: #classSelectionChanged. self changed: #messageCategoryList. self changed: #messageList. self changed: #contents. self changed: #annotation. self decorateButtons ! Item was changed: ----- Method: Browser>>removeSystemCategory (in category 'system category functions') ----- removeSystemCategory "If a class category is selected, create a Confirmer so the user can verify that the currently selected class category and all of its classes should be removed from the system. If so, remove it." + self selectedSystemCategoryName isNil ifTrue: [^ self]. - systemCategoryListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. (self classList size = 0 or: [self confirm: 'Are you sure you want to remove this system category and all its classes?']) ifTrue: [systemOrganizer removeSystemCategory: self selectedSystemCategoryName. self systemCategoryListIndex: 0. self changed: #systemCategoryList]! Item was changed: ----- Method: Browser>>selectedEnvironment (in category 'system category list') ----- selectedEnvironment "Answer the name of the selected system category or nil." + self selectedSystemCategoryName isNil ifTrue: [^nil]. - systemCategoryListIndex = 0 ifTrue: [^nil]. ^ Smalltalk!

1 0

Jump to page: