[Pkg] The Treated Inbox: Morphic-kfr.2001.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Jun 22 13:11:50 UTC 2022
Marcel Taeumel uploaded a new version of Morphic to project The Treated Inbox:
http://source.squeak.org/treated/Morphic-kfr.2001.mcz
==================== Summary ====================
Name: Morphic-kfr.2001
Author: kfr
Time: 4 June 2022, 8:17:55.548458 pm
UUID: a69ddb4a-4949-e248-a87d-f503f56582df
Ancestors: Morphic-kfr.2000, Morphic-mt.1999
Open a HelpBrowser with TextLink.
Example:
TerseGuideHelp Help
Select text, press Alt+5 (CMD on Mac) and select 'Link to help on class'
(A link of this format: 'My Link<TerseGuideHelp Help>' will hide the part between < & > )
Dependent on Collections-kfr.1011 and Tools-kfr.1161
=============== Diff against Morphic-mt.1999 ===============
Item was changed:
----- Method: ColorPickerMorph>>modalBalloonHelpAtPoint: (in category 'private') -----
modalBalloonHelpAtPoint: cursorPoint
self flag: #arNote. "Throw this away. There needs to be another way."
self submorphsDo:
[:m |
m wantsBalloon
ifTrue:
[(m valueOfProperty: #balloon) isNil
ifTrue:
+ [(m containsPoint: cursorPoint) ifTrue: [m showBalloon: m balloonText at: (m topCenter ).
+ m setProperty: #balloon toValue: true]]
+ ifFalse: [(m containsPoint: cursorPoint) ifFalse: [self deleteBalloon.
+ m setProperty: #balloon toValue:nil]]]]!
- [(m containsPoint: cursorPoint) ifTrue: [m showBalloon: m balloonText]]
- ifFalse: [(m containsPoint: cursorPoint) ifFalse: [m deleteBalloon]]]]!
Item was changed:
----- Method: ColorPickerMorph>>pickUpColorFor: (in category 'menu') -----
pickUpColorFor: aMorph
"Show the eyedropper cursor, and modally track the mouse through a mouse-down and mouse-up cycle"
| aHand localPt c |
aHand := aMorph ifNil: [self activeHand] ifNotNil: [aMorph activeHand].
aHand ifNil: [aHand := self currentHand].
self addToWorld: aHand world near: (aMorph ifNil: [aHand world]) fullBounds.
self owner ifNil: [^ self].
aHand showTemporaryCursor: (ScriptingSystem formAtKey: #Eyedropper)
+ hotSpotOffset: 2 at 14. "<<<< the form was changed a bit??"
- hotSpotOffset: 6 negated @ 4 negated. "<<<< the form was changed a bit??"
self updateContinuously: false.
[Sensor anyButtonPressed]
whileFalse:
[self trackColorUnderMouse].
self deleteAllBalloons.
localPt := Sensor cursorPoint - self topLeft.
self inhibitDragging ifFalse: [
(DragBox containsPoint: localPt) ifTrue:
["Click or drag the drag-dot means to anchor as a modeless picker"
^ self anchorAndRunModeless: aHand].
].
(clickedTranslucency := TransparentBox containsPoint: localPt)
ifTrue: [selectedColor := originalColor].
self updateContinuously: true.
[Sensor anyButtonPressed]
whileTrue:
[self updateTargetColorWith: self indicateColorUnderMouse].
c := self getColorFromKedamaWorldIfPossible: Sensor cursorPoint.
c ifNotNil: [selectedColor := c].
aHand newMouseFocus: nil;
showTemporaryCursor: nil;
flushEvents.
self delete.
!
Item was changed:
----- Method: LegacyShortcutsFilter class>>filterEvent:for: (in category 'event filter') -----
filterEvent: aKeyboardEvent for: textMorph
-
aKeyboardEvent isKeystroke ifFalse: [^ aKeyboardEvent].
aKeyboardEvent commandKeyPressed ifFalse: [^ aKeyboardEvent].
Preferences cmdKeysInText ifFalse: [^ aKeyboardEvent].
+
-
- (Smalltalk platformName = 'Mac OS' and: [aKeyboardEvent shiftPressed])
- ifTrue: ["Work around an issue in the VM where SHIFT is not honored
- in the KeyChar event's character. This should only be the case for
- KeyDown events to encode virtual-key presses. The VM should not
- do this for KeyChar events. Works for U.S. keyboard layout only."
- aKeyboardEvent keyValue: (
- aKeyboardEvent keyCharacter caseOf: {
- [$9] -> [$(]. [$0] -> [$)].
- [$,] -> [$<]. [$.] -> [$>].
- [$[] -> [${]. [$]] -> [$}].
- [$'] -> [$"] }
- otherwise: [aKeyboardEvent keyCharacter]) asInteger].
-
('()[]{}|''"<>' includes: aKeyboardEvent keyCharacter)
ifTrue: [textMorph
handleInteraction: [(textMorph editor enclose: aKeyboardEvent) ifTrue: [aKeyboardEvent ignore]]
fromEvent: aKeyboardEvent].
^ aKeyboardEvent
"
Preferences cmdKeysInText
Preferences cmdGesturesEnabled
Preferences honorDesktopCmdKeys
PasteUpMorph globalCommandKeysEnabled.
"!
Item was changed:
----- Method: Morph>>changeColor (in category 'menus') -----
changeColor
"Change the color of the receiver -- triggered, e.g. from a menu"
NewColorPickerMorph useIt
ifTrue: [ (NewColorPickerMorph on: self) openNear: self fullBoundsInWorld ]
ifFalse:
+ [ self removeHalo."Halo can obscure the color picker"
+ ColorPickerMorph new
- [ ColorPickerMorph new
choseModalityFromPreference ;
sourceHand: self activeHand ;
target: self ;
selector: #fillStyle: ;
originalColor: self color ;
putUpFor: self
near: self fullBoundsInWorld ]!
Item was changed:
----- Method: PasteUpMorph>>windowEvent: (in category 'event handling') -----
windowEvent: anEvent
self windowEventHandler
ifNotNil: [^self windowEventHandler windowEvent: anEvent].
anEvent type
caseOf: {
[#windowClose] -> [
Preferences eToyFriendly
ifTrue: [ProjectNavigationMorph basicNew quitSqueak]
ifFalse: [TheWorldMenu basicNew quitSession]].
[#windowDeactivated] -> [
+ "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus. If enabled, disable #mouseOverForKeyboardFocus temporarily because when inactive, we *can't* set the externally controlled keyboard focus."
- "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus."
(self valueOfProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus |
"There is currently no exact-once guarantee for this event type from the VM. Mark any older host focus morph as inactive, it will be held as the previousFocus of the next host focus morph."
hostFocus active: false].
self setProperty: #windowHostFocusMorph toValue: (WindowHostFocusMorph new
in: [:hostFocus |
hostFocus previousFocus: anEvent hand keyboardFocus.
+ anEvent hand newKeyboardFocus: hostFocus.
+ Preferences mouseOverForKeyboardFocus ifTrue: [
+ hostFocus previousMouseOverForKeyboardFocus: true.
+ Preferences setPreference: #mouseOverForKeyboardFocus toValue: false]];
- anEvent hand newKeyboardFocus: hostFocus.];
yourself)].
[#windowActivated] -> [
+ "Alright, the spook is over!! We have back control over the keyboard focus, delete the windowHostFocusMorph and restore the previous focus holder and the #mouseOverForKeyboardFocus preference."
- "Alright, the spook is over!! We have back control over the keyboard focus, delete the windowHostFocusMorph and restore the previous focus holder."
(self removeProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus |
hostFocus active: false.
(anEvent hand keyboardFocus == hostFocus and: [hostFocus previousFocus notNil]) ifTrue:
+ [anEvent hand newKeyboardFocus: hostFocus previousFocus].
+ hostFocus previousMouseOverForKeyboardFocus ifNotNil: [:value |
+ Preferences setPreference: #mouseOverForKeyboardFocus toValue: value]]]. }
- [anEvent hand newKeyboardFocus: hostFocus previousFocus]]]. }
otherwise: []!
Item was changed:
----- Method: SmalltalkEditor>>emphasisExtras (in category 'editing keys') -----
emphasisExtras
^#(
'Do it'
'Print it'
'Style it'
'Link to comment of class'
'Link to definition of class'
'Link to hierarchy of class'
+ 'Link to help on class'
'Link to method'
'URL Link...'
'Custom attribute...'
).!
Item was changed:
----- Method: SmalltalkEditor>>handleEmphasisExtra:with: (in category 'editing keys') -----
handleEmphasisExtra: index with: aKeyboardEvent
"Handle an extra emphasis menu item"
| action attribute thisSel |
action := {
[attribute := TextDoIt new.
thisSel := attribute analyze: self selection].
[attribute := TextPrintIt new.
thisSel := attribute analyze: self selection].
[thisSel := self styleSelection].
[attribute := TextLink new.
thisSel := attribute analyze: self selection asString with: 'Comment'].
[attribute := TextLink new.
thisSel := attribute analyze: self selection asString with: 'Definition'].
[attribute := TextLink new.
thisSel := attribute analyze: self selection asString with: 'Hierarchy'].
[attribute := TextLink new.
+ thisSel := attribute analyze: self selection asString with: 'Help'].
+ [attribute := TextLink new.
thisSel := attribute analyze: self selection asString].
[attribute := TextURL new.
thisSel := attribute analyze: self selection asString].
[thisSel := self selection.
attribute := self requestAttribute].
["Edit hidden info"
thisSel := self hiddenInfo. "includes selection"
attribute := TextEmphasis normal].
["Copy hidden info"
self copyHiddenInfo.
^true]. "no other action"
} at: index.
action value.
+
-
thisSel ifNil: [^ true]. "Could not figure out what to link to"
(thisSel isEmpty and: [attribute notNil])
ifTrue: [
| oldAttributes |
"only change emphasisHere while typing"
oldAttributes := paragraph text attributesAt: self pointIndex.
emphasisHere := Text addAttribute: attribute toArray: oldAttributes]
ifFalse: [
self replaceSelectionWith: (attribute ifNil: [thisSel] ifNotNil: [thisSel asText addAttribute: attribute]) ].
^ true!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>findWorkspace (in category 'submenu - windows') -----
- findWorkspace
-
- | allWorkspaces labels values |
- allWorkspaces := Set new.
- Project allMorphicProjects do:
- [:project|
- (self allVisibleWindowsIn: project world) do:
- [:window|
- (window model isKindOf: Workspace) ifTrue:
- [allWorkspaces add:
- { window model.
- window.
- project.
- window model contents ifEmpty:
- [(window model dependents detect: [:d| d isTextView] ifNone: nil) textMorph contents] }]]].
- allWorkspaces isEmpty ifTrue:
- [^ self inform: 'No workspaces found.' translated].
- "Sort workspaces with non-empty ones first..."
- labels := OrderedCollection new.
- values := OrderedCollection new.
- (allWorkspaces sorted:
- [:t1 :t2|
- t1 last isEmpty == t2 last isEmpty
- ifTrue: [t1 second label <= t2 second label]
- ifFalse: [t1 last notEmpty]]) do:
- [:tuple|
- labels add: tuple second label, ': ', ((tuple last asString contractTo: 512) ifEmpty: ['(empty)']).
- values add: (MessageSend receiver: self selector: #selectWorkspace:window:inProject:contents: arguments: tuple)].
- (Project uiManager
- chooseFrom: labels
- values: values
- title: 'Find Workspace' translated) value.!
Item was changed:
----- Method: TheWorldMainDockingBar>>listWindowsOn: (in category 'submenu - windows') -----
listWindowsOn: menu
| windows |
menu
addLine;
add: 'Collapse all windows' target: (Project current world) selector: #collapseAllWindows;
addItem: [:item | item
contents: 'Find Workspace...';
+ subMenuUpdater: self
+ selector: #workspacesMenuFor:
+ arguments: #()];
- target: self;
- selector: #findWorkspace];
addLine;
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;
addLine.
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 ] ] ].!
Item was added:
+ ----- Method: TheWorldMainDockingBar>>workspacesMenuFor: (in category 'submenu - windows') -----
+ workspacesMenuFor: anUpdatingMenuMorph
+
+ | allWorkspaces |
+ allWorkspaces := Set new.
+ Project allMorphicProjects do:
+ [:project|
+ (self allVisibleWindowsIn: project world) do:
+ [:window|
+ (window model isKindOf: Workspace) ifTrue:
+ [allWorkspaces add:
+ { window model.
+ window.
+ project.
+ window model contents ifEmpty:
+ [(window model dependents detect: [:d| d isTextView] ifNone: nil) textMorph contents] }]]].
+ allWorkspaces isEmpty ifTrue:
+ [^anUpdatingMenuMorph addItem:
+ [:item | item
+ contents: 'no workspaces found']].
+ "Sort workspaces with non-empty ones first..."
+ (allWorkspaces sorted:
+ [:t1 :t2|
+ t1 last isEmpty == t2 last isEmpty
+ ifTrue: [t1 second label <= t2 second label]
+ ifFalse: [t1 last notEmpty]]) do:
+ [:tuple|
+ anUpdatingMenuMorph addItem:
+ [:item | item
+ contents: tuple second label, ': ', ((tuple last asString contractTo: 128) ifEmpty: ['(empty)']);
+ target: self;
+ selector: #selectWorkspace:window:inProject:contents:;
+ arguments: tuple]]!
Item was changed:
----- Method: WindowHostFocusMorph>>active: (in category 'accessing') -----
active: aBoolean
- active := aBoolean.
+ active := aBoolean.!
- active
- ifTrue: [
- "If #mouseOverForKeyboardFocus is enabled, disable it temporarily because when WindowHostFocusMorph 'has the focus', Squeak as a whole *doesn't*, and we *can't* set the externally controlled keyboard focus."
- self saveMouseOverForKeyboardFocus]
- ifFalse: [
- "Restore the #mouseOverForKeyboardFocus preference that we (maybe) saved when we were activated."
- self restoreMouseOverForKeyboardFocus]!
Item was added:
+ ----- Method: WindowHostFocusMorph>>previousMouseOverForKeyboardFocus (in category 'accessing') -----
+ previousMouseOverForKeyboardFocus
+
+ ^ previousMouseOverForKeyboardFocus!
Item was added:
+ ----- Method: WindowHostFocusMorph>>previousMouseOverForKeyboardFocus: (in category 'accessing') -----
+ previousMouseOverForKeyboardFocus: aBoolean
+
+ previousMouseOverForKeyboardFocus := aBoolean.!
Item was removed:
- ----- Method: WindowHostFocusMorph>>restoreMouseOverForKeyboardFocus (in category 'accessing') -----
- restoreMouseOverForKeyboardFocus
- previousMouseOverForKeyboardFocus ifNotNil: [:value |
- previousMouseOverForKeyboardFocus := nil.
- Preferences setPreference: #mouseOverForKeyboardFocus toValue: value].!
Item was removed:
- ----- Method: WindowHostFocusMorph>>saveMouseOverForKeyboardFocus (in category 'accessing') -----
- saveMouseOverForKeyboardFocus
- Preferences mouseOverForKeyboardFocus ifTrue: [
- previousMouseOverForKeyboardFocus := true.
- Preferences setPreference: #mouseOverForKeyboardFocus toValue: false].!
Item was changed:
+ (PackageInfo named: 'Morphic') postscript: 'Preferences maxBalloonHelpLineLength: 45.
+
+ "See commentary in MorphicProject >> #startUpActions."
+ WorldState disableDeferredUpdates: Smalltalk platformName = ''Mac OS''.'!
- (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances. "Updates menu for Windows > Find Workspace ..."'!
More information about the Packages
mailing list