[squeak-dev] The Inbox: Morphic-WoC.1465.mczcommits at source.squeak.org commits at source.squeak.orgTue Oct 16 09:50:26 UTC 2018
A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-WoC.1465.mcz ==================== Summary ==================== Name: Morphic-WoC.1465 Author: WoC Time: 16 October 2018, 11:49:58.726164 am UUID: 64438ccc-853d-4526-96d1-31bfa1a2e42e Ancestors: Morphic-eem.1464, Morphic-kks.1457 HandMorph now generates left and right scroll events (only up and down were generated before). The now generated events also fix a scroll bug, that I always had on mac, that caused the text field to jump back to the top while scrolling down. Also implemented a method that can check if altKey is pressed during an event, similar to commandKeyPressed and controlKeyPressed. =============== Diff against Morphic-eem.1464 =============== Item was changed: ----- Method: Canvas>>frameAndFillRoundRect:radius:fillStyle:borderStyle: (in category 'drawing-rectangles') ----- frameAndFillRoundRect: aRectangle radius: cornerRadius fillStyle: fillStyle borderStyle: borderStyle self frameAndFillRoundRect: aRectangle radius: cornerRadius + fillStyle: fillStyle asColor - fillStyle: fillStyle borderWidth: borderStyle width borderColor: borderStyle color.! Item was added: + ----- Method: HandMorph>>calculateScrollDeltaFrom: (in category 'nil') ----- + calculateScrollDeltaFrom: direction + + | x y | + x := 0. + y := 0. + + (direction anyMask: 2r0001 "wheel right") ifTrue: [x := 120]. + (direction anyMask: 2r0010 "wheel left") ifTrue: [x := -120]. + + (direction anyMask: 2r1000 "wheel up") ifTrue: [y := 120]. + (direction anyMask: 2r0100 "wheel down") ifTrue: [y := -120]. + + ^ x @ y! Item was changed: ----- Method: HandMorph>>filterEvent:for: (in category 'events-filtering') ----- filterEvent: aKeyboardEvent for: aMorphOrNil "Fixes VM behavior. Usually, there are no mouse wheel events generated by the VM but CTRL+UP/DOWN. Convert these into mouse wheel events. We installed ourself as keyboard filter only!! No need to check whether this is a keyboard event or not!! See HandMorph >> #initForEvents. Might be removed in the future if this mapping gets obsolete." HandMorph synthesizeMouseWheelEvents ifFalse: [^ aKeyboardEvent]. (aKeyboardEvent isKeystroke and: [aKeyboardEvent controlKeyPressed]) ifTrue: [ aKeyboardEvent keyCharacter caseOf: { [Character arrowUp] -> [^ self generateMouseWheelEvent: aKeyboardEvent direction: 2r1000]. [Character arrowDown] -> [^ self generateMouseWheelEvent: aKeyboardEvent direction: 2r0100]. + [Character arrowRight] -> [^ self generateMouseWheelEvent: aKeyboardEvent direction: 2r0001]. + [Character arrowLeft] -> [^ self generateMouseWheelEvent: aKeyboardEvent direction: 2r0010]. } otherwise: [^ aKeyboardEvent]]. ^ aKeyboardEvent! Item was changed: ----- Method: HandMorph>>generateMouseWheelEvent:direction: (in category 'private events') ----- generateMouseWheelEvent: keystrokeEvent direction: direction "Generate the appropriate mouse wheel event from the keystrokeEvent. Before calling this, ensure that the control key is pressed. This method can be discarded once the VM produces real mouse wheel events." ^ MouseWheelEvent new setType: #mouseWheel position: keystrokeEvent position + delta: (self calculateScrollDeltaFrom: direction) - delta: 0 @ ((direction anyMask: 2r1000 "wheel up") ifTrue: [120] ifFalse: [-120]) direction: direction buttons: (keystrokeEvent buttons bitAnd: 2r01111) "drop control key pressed for this conversion" hand: keystrokeEvent hand stamp: keystrokeEvent timeStamp! Item was changed: ----- Method: Morph>>openNearMorph: (in category 'initialization') ----- openNearMorph: aMorph self openNear: aMorph boundsInWorld + in: (aMorph world ifNil: [ self world ])! - in: (aMorph world - ifNil: [self world - ifNil: [Project current world]])! Item was changed: ----- Method: PasteUpMorph>>findWindow: (in category 'world menu') ----- findWindow: evt "Present a menu names of windows and naked morphs, and activate the one that gets chosen. Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo." | menu expanded collapsed nakedMorphs | menu := MenuMorph new. expanded := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not]. collapsed := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed]. nakedMorphs := self submorphsSatisfying: [:m | (m isSystemWindow not and: [(m isStickySketchMorph) not]) and: [(m isFlapTab) not]]. (expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty)) ifTrue: [^ Beeper beep]. (expanded sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: + [:w | menu add: w label target: w action: #beKeyWindow. - [:w | menu add: (w label contractTo: 80) target: w action: #beKeyWindow. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. (expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty)) ifFalse: [menu addLine]. (collapsed sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: + [:w | menu add: w label target: w action: #collapseOrExpand. - [:w | menu add: (w label contractTo: 80) target: w action: #collapseOrExpand. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. nakedMorphs isEmpty ifFalse: [menu addLine]. (nakedMorphs sort: [:w1 :w2 | w1 nameForFindWindowFeature caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) do: + [:w | menu add: w nameForFindWindowFeature target: w action: #comeToFrontAndAddHalo]. - [:w | menu add: (w nameForFindWindowFeature contractTo: 80) target: w action: #comeToFrontAndAddHalo]. menu addTitle: 'find window' translated. menu popUpEvent: evt in: self.! Item was changed: ----- Method: PasteUpMorph>>tryInvokeHalo: (in category 'events-processing') ----- tryInvokeHalo: aUserInputEvent "Invoke halos around the top-most world container at aUserInputEvent's #position. If it was already halo'd, zero-in on its next inward component morph at that position. Holding Shift during the click reverses this traversal order." | stack innermost haloTarget | Preferences noviceMode ifTrue: [ ^ self ]. Morph haloForAll ifFalse: [ ^ self ]. "the stack is the top-most morph to bottom-most." stack := (self morphsAt: aUserInputEvent position unlocked: true) select: [ : each | each wantsHaloFromClick or: [ each handlesMouseDown: aUserInputEvent ] ]. innermost := aUserInputEvent hand halo ifNil: [ stack first ] ifNotNil: [ : existingHalo | stack allButFirst "existingHalo is first on the stack, not a target" detect: [ : each | each owner == self ] ifFound: [ : worldContainer | "Is existingHalo's target part of the same worldContainer as the morph clicked?" (existingHalo target withAllOwners includes: worldContainer) + ifTrue: [ "same hierarchy, let #transferHalo: continue to handle it for now." ^ self ] - ifTrue: [ "same hierarchy, let #transferHalo: continue to handle it for now." ^self ] ifFalse: [ "different hierarchy, remove + add." aUserInputEvent hand removeHalo. aUserInputEvent shiftPressed ifTrue: [ stack second "first is still the just removed halo" ] ifFalse: [ worldContainer ] ] ] + ifNone: [ "Shouldn't get here, but defensive code." self ] ]. - ifNone: [ "existingHalo is on the World, defer to #transferHalo: for now." ^self ] ]. "If modifier key is pressed, start at innermost (the target), otherwise the outermost (direct child of the world (self))." + haloTarget := aUserInputEvent shiftPressed - haloTarget := (innermost == self or: [aUserInputEvent shiftPressed]) ifTrue: [ innermost ] + ifFalse: [ innermost == self ifTrue: [innermost] ifFalse: [(innermost withAllOwners copyWithout: self) last] ]. + haloTarget wantsHaloFromClick ifFalse: [ "haloTarget has its own event handler." ^ self ]. - ifFalse: - [ "Find the outermost owner that wants it." - innermost withAllOwners reversed allButFirst - detect: [ : each | each wantsHaloFromClick ] - ifNone: [ "haloTarget has its own mouseDown handler, don't halo." ^ self ] ]. "Now that we have the haloTarget, show the halo." aUserInputEvent hand newMouseFocus: haloTarget event: aUserInputEvent. haloTarget invokeHaloOrMove: aUserInputEvent. "aUserInputEvent has been consumed, don't let it cause any further side-effects." aUserInputEvent ignore! Item was changed: ----- Method: PasteUpMorph>>tryInvokeKeyboardShortcut: (in category 'events-processing') ----- tryInvokeKeyboardShortcut: aKeyboardEvent aKeyboardEvent commandKeyPressed ifFalse: [^ self]. aKeyboardEvent keyCharacter caseOf: { [$R] -> [Utilities browseRecentSubmissions]. [$L] -> [self findAFileList: aKeyboardEvent]. [$O] -> [self findAMonticelloBrowser]. [$P] -> [self findAPreferencesPanel: aKeyboardEvent]. "[$Z] -> [ChangeList browseRecentLog]." [$]] -> [Smalltalk snapshot: true andQuit: false]. + [$+] -> [Preferences increaseFontSize]. + [$-] -> [Preferences decreaseFontSize]. + [$=] -> [Preferences restoreDefaultFonts]. } otherwise: [^ self "no hit"]. aKeyboardEvent ignore "hit!!".! Item was changed: ----- Method: SmalltalkEditor class>>initializeShiftCmdKeyShortcuts (in category 'keyboard shortcut tables') ----- initializeShiftCmdKeyShortcuts "Initialize the shift-command-key (or control-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" + "wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the + capitalized versions of the letters. + TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values." + + "SmalltalkEditor initialize" + | cmds | super initializeShiftCmdKeyShortcuts. + cmds := #( $a argAdvance: $b browseItHere: $d debugIt: $e methodStringsContainingIt: $f displayIfFalse: $g fileItIn: $i exploreIt: $n referencesToIt: $s invokePrettyPrint: $t displayIfTrue: $v pasteInitials: $w methodNamesContainingIt: ). 1 to: cmds size by: 2 do: [ :i | shiftCmdActions at: ((cmds at: i) asciiValue + 1) put: (cmds at: i + 1). "plain keys" shiftCmdActions at: ((cmds at: i) asciiValue - 32 + 1) put: (cmds at: i + 1). "shifted keys" shiftCmdActions at: ((cmds at: i) asciiValue - 96 + 1) put: (cmds at: i + 1). "ctrl keys" + ].! - ]. - "shift+cmd _ (underscore)" - shiftCmdActions at: $_ asciiValue+1 put: #flattenSelection:! Item was removed: - ----- Method: SmalltalkEditor>>flattenSelection: (in category 'editing keys') ----- - flattenSelection: dummy - "Replace all lines and consecutive whitespace characters of the current selection with one line separated by single spaces." - self replaceSelectionWith: self selection string condensedIntoOneLine. - ^ true! Item was changed: ----- Method: TextEditor>>backTo: (in category 'typing support') ----- backTo: startIndex "During typing, backspace to startIndex. If there already is a selection, just delete that selection. Otherwise, check if we did something else than backward-deletion and start a new command if so." + morph readOnly ifTrue: [^ self]. - morph readOnly ifTrue: [^ false]. self hasSelection ifTrue: [ "Add checkpoint in undo history." self replaceSelectionWith: self nullText. ^ true]. startIndex > self text size ifTrue: [^ false]. self selectInvisiblyFrom: startIndex to: self stopIndex-1. self isTypingIn ifTrue: [ self history current type = #backward ifFalse: [self closeTypeIn] ifTrue: [ "Accumulate all deleted characters in current undo command." self history current contentsBefore replaceFrom: 1 to: 0 with: self selection. self history current intervalBefore in: [:i | self history current intervalBefore: (startIndex to: i last)]]]. self openTypeInFor: #backward. self zapSelectionWith: self nullText. ^ false! Item was changed: ----- Method: TextEditor>>changeAlignment (in category 'menu messages') ----- changeAlignment + | aList reply | + aList := #(leftFlush centered justified rightFlush). + reply := UIManager default chooseFrom: aList values: aList. + reply ifNil:[^self]. - | options reply | - options := self existingIndentation - caseOf: - {[0]-> [ #('leftFlush' 'indented' 'centered' 'justified' 'rightFlush') ]. - [1] -> [ #('leftFlush' 'indented more' 'centered' 'justified' 'rightFlush') ]} - otherwise: [ #('leftFlush' 'indented less' 'indented more' 'centered' 'justified' 'rightFlush') ]. - reply := UIManager default chooseFrom: options values: options. - reply ifNil: [ ^ self ]. self setAlignment: reply. paragraph composeAll. self recomputeSelection. ^ true! Item was removed: - ----- Method: TextEditor>>existingIndentation (in category 'private') ----- - existingIndentation - ^ paragraph text indentationAmountAt: (self encompassLine: self selectionInterval)! Item was changed: ----- Method: TextEditor>>setAlignment: (in category 'menu messages') ----- + setAlignment: aSymbol + | attr interval | + attr := TextAlignment perform: aSymbol. - setAlignment: selectionString - | attr interval | - attr := selectionString - caseOf: - { [ 'indented' ] -> [ TextIndent amount: 1 ]. - [ 'indented more' ] -> [ TextIndent amount: self existingIndentation+1 ]. - [ 'indented less' ] -> [ TextIndent amount: (self existingIndentation-1 max: 0) ]} - otherwise: - [ TextAlignment perform: selectionString asSymbol ]. interval := self encompassLine: self selectionInterval. + paragraph - paragraph replaceFrom: interval first to: interval last with: ((paragraph text copyFrom: interval first to: interval last) addAttribute: attr)! Item was changed: ----- Method: TheWorldMainDockingBar class>>setMenuPreference:to: (in category 'preferences') ----- setMenuPreference: aPreferenceSymbol to: aBoolean | project | (project := Project current) isMorphic ifTrue: [ project projectPreferenceFlagDictionary at: aPreferenceSymbol put: aBoolean. + (aBoolean ~= (Preferences perform: aPreferenceSymbol)) - (aBoolean ~= (Preferences preferenceAt: aPreferenceSymbol)) ifTrue: [Preferences setPreference: aPreferenceSymbol toValue: aBoolean]]. self updateInstances.! Item was changed: ----- Method: TheWorldMainDockingBar class>>updateInstances (in category 'events') ----- updateInstances "The class has changed, time to update the instances" + "TheWorldMainDockingBar updateInstances" + - self setTimeStamp. Project current in: [:project | project isMorphic ifTrue: [ project assureMainDockingBarPresenceMatchesPreference]].! Item was changed: ----- Method: TheWorldMainDockingBar>>helpMenuOn: (in category 'submenu - help') ----- helpMenuOn: aDockingBar aDockingBar addItem: [ :it | it contents: 'Help' translated; addSubMenu: [ :menu | menu addItem: [:item | item contents: 'Squeak Help' translated; help: 'Integrated Help System' translated; target: self; selector: #squeakHelp]. menu addLine. menu addItem:[:item| item contents: 'Online Resources' translated; help: 'Online resources for Squeak' translated; target: self; icon: MenuIcons smallHelpIcon; selector: #squeakOnlineResources]. menu addItem:[:item| item contents: 'Squeak Swiki' translated; help: 'A very simple way to access Squeak Swiki resources in the image' translated; target: self; selector: #swiki]. menu addItem:[:item| item contents: 'Keyboard Shortcuts' translated; help: 'Keyboard bindings used in Squeak' translated; target: self; selector: #commandKeyHelp ]. menu addItem:[:item| item contents: 'Font Size Summary' translated; help: 'Font size summary.' translated; target: self; selector: #fontSizeSummary ]. menu addItem:[:item| item contents: 'Useful Expressions' translated; help: 'Useful expressions' translated; target: self; selector: #usefulExpressions ]. menu addLine. menu addItem:[:item| item contents: 'Terse Guide to Squeak' translated; help: 'Concise information about language and environment' translated; target: self; selector: #terseGuideToSqueak]. menu addItem:[:item| item contents: 'Extending the system' translated; help: 'Includes code snippets to evaluate for extending the system' translated; target: self; icon: MenuIcons smallHelpIcon; selector: #extendingTheSystem]. + menu addItem:[:item| + item + contents: 'How to Contribute to Squeak' translated; + help: 'Instructions for uploading changesets to improve and enhance Squeak' translated; + target: self; + selector: #squeakHowToContribute]. menu addLine. menu addItem:[:item| item contents: 'Release Notes' translated; help: 'Changes in this release' translated ; target: self; selector: #releaseNotes]. menu addItem:[:item| item contents: 'Working With Squeak' translated; help: 'Information for new users' ; target: self; selector: #workingWithSqueak]. menu addItem:[:item| item contents: 'The Squeak User Interface' translated; help: 'Descriptions of some of the more-unusual UI elements in Squeak' ; target: self; selector: #squeakUserInterface]. menu addItem:[:item| item contents: 'License Information' translated; help: String empty ; target: self; selector: #licenseInformation]. menu addLine. menu addItem: [:item | item contents: 'About Squeak' translated; help: 'SystemReporter status of the image and runtime environment' translated; target: self; selector: #aboutSqueak]. ]]! Item was changed: ----- Method: TheWorldMainDockingBar>>listWindowsOn: (in category 'submenu - windows') ----- listWindowsOn: menu | windows | windows := self allVisibleWindows sorted: [:winA :winB | ((winA model isNil or: [winB model isNil]) or: [winA model name = winB model name]) ifTrue: [winA label < winB label] ifFalse: [winA model name < winB model name]]. windows ifEmpty: [ menu addItem: [ :item | item contents: 'No Windows' translated; isEnabled: false ] ]. windows do: [ :each | | windowColor | windowColor := (each model respondsTo: #windowColorToUse) ifTrue: [each model windowColorToUse] ifFalse: [UserInterfaceTheme current get: #uniformWindowColor for: Model]. menu addItem: [ :item | item contents: (self windowMenuItemLabelFor: each); icon: (self colorIcon: windowColor); target: each; selector: #comeToFront; subMenuUpdater: self selector: #windowMenuFor:on: arguments: { each }; action: [ each beKeyWindow; expand ] ] ]. menu addLine; - add: 'Collapse all windows' target: (Project current world) selector: #collapseAllWindows; add: 'Close all windows' target: self selector: #closeAllWindowsUnsafe; addItem: [:item | item contents: 'Close all windows without changes'; target: self; icon: MenuIcons smallBroomIcon; selector: #closeAllWindows]; add: 'Close all windows but workspaces' target: self selector: #closeAllWindowsButWorkspaces.! Item was removed: - ----- Method: TheWorldMainDockingBar>>messageNamesMenuItemOn: (in category 'submenu - tools') ----- - messageNamesMenuItemOn: menu - - menu addItem: [:item | - item - contents: 'Message Names' translated; - help: 'Open the Message Names tool' translated; - icon: (self colorIcon: MessageNames basicNew windowColorToUse); - target: StandardToolSet; - selector: #openMessageNames]! Item was added: + ----- Method: TheWorldMainDockingBar>>squeakHowToContribute (in category 'submenu - help') ----- + squeakHowToContribute + self + openHelp: #SqueakProjectHelp + topic: #squeakHowToContribute! Item was changed: ----- Method: TheWorldMainDockingBar>>themesAndWindowColorsOn: (in category 'submenu - extras') ----- themesAndWindowColorsOn: menu + | themes | + themes := UserInterfaceTheme allThemes asArray sorted: [:t1 :t2 | + t1 name <= t2 name]. + menu addItem:[:item| item contents: (Model useColorfulWindows ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Colorful Windows' translated; target: self; selector: #toggleColorfulWindows]. menu addItem:[:item| item contents: (SystemWindow gradientWindow not ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Flat Widget Look' translated; target: self; selector: #toggleGradients]. menu addLine. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Soft Shadows' translated; target: self; selector: #toggleSoftShadows]. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow not]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Hard Shadows' translated; target: self; selector: #toggleHardShadows]. menu addLine. menu addItem:[:item | item contents: (SystemWindow roundedWindowCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Window/Dialog/Menu Look' translated; target: self; selector: #toggleRoundedWindowLook]. menu addItem:[:item | item contents: (PluggableButtonMorph roundedButtonCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Button/Scrollbar Look' translated; target: self; selector: #toggleRoundedButtonLook]. + + + menu addLine. + - themes := UserInterfaceTheme allThemes asArray sort: #name ascending. themes ifEmpty: [ menu addItem: [ :item | item contents: '(No UI themes found.)' translated; isEnabled: false ] ]. themes do: [ :each | menu addItem: [ :item | item contents: (UserInterfaceTheme current == each ifTrue: ['<yes>'] ifFalse: ['<no>']), each name; target: each; selector: #apply ] ]. menu - addLine ; - add: 'Increase Font Size' translated target: Preferences selector: #increaseFontSize ; - add: 'Decrease Font Size' translated target: Preferences selector: #decreaseFontSize ; - addLine. - menu addLine; add: 'Restore UI Theme Background' translated target: self selector: #restoreThemeBackground; add: 'Edit Current UI Theme...' translated target: self selector: #editCurrentTheme.! Item was changed: ----- Method: TheWorldMainDockingBar>>toolsMenuOn: (in category 'construction') ----- toolsMenuOn: aDockingBar aDockingBar addItem: [ :item | item contents: 'Tools' translated; addSubMenu: [ :menu | self browserMenuItemOn: menu; workspaceMenuItemOn: menu; transcriptMenuItemOn: menu; testRunnerMenuItemOn: menu; + methodFinderMenuItemOn: menu. - methodFinderMenuItemOn: menu; - messageNamesMenuItemOn: menu. menu addLine. self monticelloBrowserMenuItemOn: menu; monticelloConfigurationsMenuItemOn: menu; simpleChangeSorterMenuItemOn: menu; dualChangeSorterMenuItemOn: menu. menu addLine. self processBrowserMenuItemOn: menu; preferenceBrowserMenuItemOn: menu; fileListMenuItemOn: menu. ] ]! Item was added: + ----- Method: UserInputEvent>>altKeyPressed (in category 'modifier state') ----- + altKeyPressed + "Answer true if the alt key on the keyboard was being held down when this event occurred." + + ^ buttons anyMask: 32! Item was changed: + (PackageInfo named: 'Morphic') postscript: 'Project allMorphicProjects do: [:p | + p world allMorphsDo: [:m | + (m isKindOf: BorderedMorph) ifTrue: [ + m borderColor: (m instVarNamed: #borderColor). + m borderWidth: (m instVarNamed: #borderWidth)]]].'! - (PackageInfo named: 'Morphic') postscript: 'SmalltalkEditor initializeShiftCmdKeyShortcuts'!
More information about the Squeak-dev mailing list |