UI: add support to "pin" menus, i.e., turn them into a floating toolboxes
This spares us the need of explicit toolbar in the UI and gives the
user the freedom of turning every menu into always-visible toolbar
is it suits her (actual) need. This idea is taken from good old
NeXTstep UI.
For now, this is only supported for "Exec" menu, but the support is
generic so it would work any menu.
--- a/VDBAbstractApplication.st Tue Mar 13 00:08:25 2018 +0000
+++ b/VDBAbstractApplication.st Wed Mar 14 10:07:45 2018 +0000
@@ -313,6 +313,84 @@
(debugger instVarNamed:#connection) recorder inspect
"Created: / 09-09-2014 / 00:12:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+doOpenToolApplication:application
+ application allButOpen.
+ self doOpenToolWindow: application window
+
+ "Created: / 11-06-2017 / 20:21:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 14-03-2018 / 09:48:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+doOpenToolApplicationClass:applicationClassName
+ | applicationClass application |
+
+ applicationClass := Smalltalk at:applicationClassName asSymbol.
+ applicationClass isNil ifTrue:[
+ Dialog
+ warn:('No application class named %1' bindWith:applicationClassName).
+ ^ self.
+ ].
+ application := applicationClass new.
+ application debuggerHolder:self debuggerHolder.
+ self doOpenToolApplication:application
+
+ "Created: / 11-06-2017 / 20:21:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+doOpenToolWindow:window
+ | screen |
+
+ window realize.
+ "/ On X11, use ICCCM hints to tell the WM about a transient tool window
+ "/ and let WM to handle this according to DE standards. It has the nice
+ "/ side effect (on most modern WM) that these windows don't show up in
+ "/ pager / task list and go away when browser's main window is minimuzed
+ screen := Screen current.
+ (screen notNil and:[ screen platformName == #X11 ]) ifTrue:[
+ screen setTransient:window topView id for:self window topView id.
+ "/ Also, use EWMH hint to tell the WM that the window is
+ "/ a sort of floating tool so WM can decorate it according to
+ "/ DE standards.
+ screen setWindowType:#'_NET_WM_WINDOW_TYPE_UTILITY'
+ in:window topView id
+ ].
+ window openInGroup: self window windowGroup.
+
+ "Created: / 14-03-2018 / 09:47:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+doPinMenuAs: label item: tearOffMenuItem
+ | menu window panel |
+
+ menu := tearOffMenuItem menuPanel asMenu.
+
+ "/ Remove the 'Tear Off' menu item...
+
+ menu items last value = #doPinMenuAs:item: ifTrue:[
+ menu items removeLast.
+
+ "/ And possible separator above it...
+
+ (menu items last value isNil and:[ menu items last label = '-' ]) ifTrue:[
+ menu items removeLast.
+ ].
+ ].
+ window := StandardSystemView new.
+ window label: (resources string: label).
+ panel := MenuPanel in:window.
+ panel
+ originator: self;
+ layout: (0.0 @ 0.0 corner:1.0 @ 1.0) asLayout;
+ verticalLayout:true.
+ panel
+ menu:menu;
+ receiver:self.
+ window extent:panel preferredExtent.
+ self doOpenToolWindow:window
+
+ "Created: / 16-03-2018 / 10:20:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!VDBAbstractApplication methodsFor:'startup & release'!
--- a/VDBDebuggerApplication.st Tue Mar 13 00:08:25 2018 +0000
+++ b/VDBDebuggerApplication.st Wed Mar 14 10:07:45 2018 +0000
@@ -323,12 +323,14 @@
enabled: canExecRunHolder
label: 'Run'
itemValue: doExecRun
+ isVisible: true
labelImage: (ResourceRetriever VDBIconLibrary actionRun16x16 'Run')
)
(MenuItem
enabled: canExecResumeHolder
label: 'Resume'
itemValue: doExecResume
+ isVisible: true
shortcutKey: DebuggerContinue
labelImage: (ResourceRetriever VDBIconLibrary actionContinue16x16 'Resume')
)
@@ -336,28 +338,33 @@
enabled: canExecSuspendHolder
label: 'Suspend'
itemValue: doExecSuspend
+ isVisible: true
labelImage: (ResourceRetriever VDBIconLibrary actionStop16x16 'Suspend')
)
(MenuItem
enabled: canExecTerminateHolder
label: 'Terminate'
itemValue: doExecTerminate
+ isVisible: true
labelImage: (ResourceRetriever VDBIconLibrary actionTerminate6x16 'Terminate')
)
(MenuItem
enabled: canExecRestartHolder
label: 'Restart'
itemValue: doExecRestart
+ isVisible: true
shortcutKey: DebuggerRestart
labelImage: (ResourceRetriever VDBIconLibrary actionTerminateAndRun6x16 'Restart')
)
(MenuItem
label: '-'
+ isVisible: true
)
(MenuItem
enabled: canExecStepOverHolder
label: 'Step Over'
itemValue: doExecStepOver
+ isVisible: true
shortcutKey: DebuggerNext
labelImage: (ResourceRetriever VDBIconLibrary actionStepOver6x16 'Step Over')
)
@@ -365,6 +372,7 @@
enabled: canExecStepIntoHolder
label: 'Step Into'
itemValue: doExecStepInto
+ isVisible: true
shortcutKey: DebuggerSend
labelImage: (ResourceRetriever VDBIconLibrary actionStepInto6x16 'Step Into')
)
@@ -372,8 +380,20 @@
enabled: canExecStepReturnHolder
label: 'Step Return'
itemValue: doExecStepReturn
+ isVisible: true
labelImage: (ResourceRetriever VDBIconLibrary actionStepReturn6x16 'Step Return')
)
+ (MenuItem
+ label: '-'
+ isVisible: true
+ )
+ (MenuItem
+ label: 'Pin Menu'
+ itemValue: doPinMenuAs:item:
+ isVisible: true
+ labelImage: (ResourceRetriever VDBIconLibrary pin 'Pin Menu')
+ argument: 'Execute'
+ )
)
nil
nil
@@ -430,22 +450,22 @@
(
(MenuItem
label: 'Stack'
- itemValue: doViewOpenClass:
+ itemValue: doOpenToolApplicationClass:
argument: VDBStackApplication
)
(MenuItem
label: 'Frame'
- itemValue: doViewOpenClass:
+ itemValue: doOpenToolApplicationClass:
argument: VDBFrameApplication
)
(MenuItem
label: 'Breakpoints'
- itemValue: doViewOpenClass:
+ itemValue: doOpenToolApplicationClass:
argument: VDBBreakpointListApplication
)
(MenuItem
label: 'Memory'
- itemValue: doViewOpenClass:
+ itemValue: doOpenToolApplicationClass:
argument: VDBMemoryApplication
)
(MenuItem
@@ -500,6 +520,8 @@
nil
nil
)
+
+ "Modified: / 14-03-2018 / 09:46:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
toolbarMenu
@@ -864,11 +886,11 @@
debugger announcer unsubscribe: flasher.
Transcript topView raise; flash.
].
- debugger announcer when: GDBEventSetProcessingFinished do: flasher
+ debugger announcer when: GDBEventSetProcessingFinished do: flasher
].
"Created: / 02-02-2018 / 11:46:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 12-02-2018 / 09:20:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 02-02-2018 / 21:02:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
onRunningEvent: aGDBStoppedEvent
@@ -977,41 +999,6 @@
debugger enablePrettyPrinting
"Modified: / 12-06-2017 / 09:42:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-doViewOpen: application
- | screen |
-
- application open.
- "/ On X11, use ICCCM hints to tell the WM about a transient tool window
- "/ and let WM to handle this according to DE standards. It has the nice
- "/ side effect (on most modern WM) that these windows don't show up in
- "/ pager / task list and go away when browser's main window is minimuzed
- screen := Screen current.
- (screen notNil and:[ screen platformName == #X11 ]) ifTrue:[
- screen setTransient: application window topView id for: self window topView id.
- "/ Also, use EWMH hint to tell the WM that the window is
- "/ a sort of floating tool so WM can decorate it according to
- "/ DE standards.
- screen setWindowType:#'_NET_WM_WINDOW_TYPE_UTILITY' in:application window topView id
- ].
-
- "Created: / 11-06-2017 / 20:21:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-doViewOpenClass: applicationClassName
- | applicationClass application |
-
- applicationClass := Smalltalk at: applicationClassName asSymbol.
- applicationClass isNil ifTrue:[
- Dialog warn: ('No application class named %1' bindWith: applicationClassName).
- ^ self.
- ].
- application := applicationClass new.
- application debuggerHolder: self debuggerHolder.
- self doViewOpen: application
-
- "Created: / 11-06-2017 / 20:21:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!VDBDebuggerApplication methodsFor:'menu actions-exec'!