"
jv:vdb - Visual / VM Debugger
Copyright (C) 2015-now Jan Vrany

This software is licensed under 'Creative Commons Attribution-NonCommercial 4.0 International License'

You may find a full license text in LICENSE.txt or at http://creativecommons.org/licenses/by-nc/4.0/
"
"{ Package: 'jv:vdb' }"

"{ NameSpace: Smalltalk }"

ApplicationModel subclass:#VDBAbstractApplication
	instanceVariableNames:'window windowVisible debuggerHolder debugger titleHolder'
	classVariableNames:'DefaultTextFont DefaultMenuFont'
	poolDictionaries:''
	category:'VDB-UI-Abstract'
!

!VDBAbstractApplication class methodsFor:'documentation'!

copyright
"
jv:vdb - Visual / VM Debugger
Copyright (C) 2015-now Jan Vrany

This software is licensed under 'Creative Commons Attribution-NonCommercial 4.0 International License'

You may find a full license text in LICENSE.txt or at http://creativecommons.org/licenses/by-nc/4.0/
"
! !

!VDBAbstractApplication class methodsFor:'accessing - defaults'!

defaultMenuFont
    "Return a default font to be used in list and text views. VDB UI is designed
     so that it expects thos font to be monospaced but does not enforce it."     

    DefaultMenuFont isNil ifTrue:[ ^ MenuPanel defaultFont asSize: self defaultTextFont size ].
    ^ DefaultMenuFont

    "Created: / 31-08-2018 / 08:41:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

defaultTextFont
    "Return a default font to be used in list and text views. VDB UI is designed
     so that it expects thos font to be monospaced but does not enforce it."     

    DefaultTextFont isNil ifTrue:[ ^ CodeView defaultFont ].
    ^ DefaultTextFont

    "Created: / 20-08-2018 / 10:49:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

defaultTextFont: aFont
    "Set a default font to be used in list and text views. VDB UI is designed
     so that it expects thos font to be monospaced but does not enforce it."     

    DefaultTextFont := aFont

    "Created: / 20-08-2018 / 10:54:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

defaultWindowTitle
    "Returns default window title for this application. By default,
     extracts the title from #windowSpec. 
     
     Subclasses may (must) override this method." 
     
    | m |

    m := self class lookupMethodFor: #windowSpec.
    m mclass theNonMetaclass isAbstract ifTrue:[ 
        self subclassResponsibility: 'Override #defaultWindowTitle in concrete classes'.
    ].
    ^ (self defaultWindowTitleFromSpec: self windowSpec) ? (self name)

    "Created: / 03-10-2018 / 15:36:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

defaultWindowTitleFromSpec: spec
    "Given a window spec, return the specified (window) label. 
     If no window label is specified, retun `nil`"

    spec do: [:e | 
        (e isArray and:[ e first == #WindowSpec ]) ifTrue:[
            ^ self resources string: (e at: 3)
        ]
    ].
    ^ nil

    "Created: / 03-10-2018 / 15:44:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VDBAbstractApplication class methodsFor:'interface opening'!

openFor: debugger
    self new 
        debugger: debugger;
        open.

    "Created: / 06-06-2014 / 21:35:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VDBAbstractApplication class methodsFor:'interface specs'!

windowSpec 
    self subclassResponsibility

    "Created: / 01-06-2017 / 12:14:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VDBAbstractApplication class methodsFor:'plugin spec'!

aspectSelectors
    ^ #(
        debuggerHolder
    )

    "Created: / 06-06-2014 / 21:47:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VDBAbstractApplication class methodsFor:'testing'!

isAbstract
    ^ self == VDBAbstractApplication
! !

!VDBAbstractApplication methodsFor:'acessing'!

debugger
    ^ debugger

    "Created: / 06-06-2014 / 21:37:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

debugger: dbg
    self debuggerHolder value: dbg

    "Created: / 06-06-2014 / 21:36:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

masterApplication: anApplicationModel
    super masterApplication: anApplicationModel.
    (anApplicationModel isKindOf: VDBAbstractApplication) ifTrue:[ 
        self debuggerHolder: anApplicationModel debuggerHolder.
    ].

    "Created: / 17-09-2014 / 22:45:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

menuFont
    "Return a Font to be used in pinned menu panels. Default value
     is to use menu's default font at the same size at #textFont"

    ^ self class defaultMenuFont

    "Created: / 31-08-2018 / 08:38:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

textFont
    "Return a Font to be used in list and text views. VDB UI is designed
     so that it expects thos font to be monospaced but does not enforce it."

    ^ self class defaultTextFont

    "Created: / 20-08-2018 / 10:14:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

title
    ^ self titleHolder value

    "Created: / 10-06-2014 / 14:53:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

title: aString
    self titleHolder value: aString

    "Created: / 10-06-2014 / 14:53:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VDBAbstractApplication methodsFor:'aspects'!

debuggerHolder
    "return/create the 'debuggerHolder' value holder (automatically generated)"

    debuggerHolder isNil ifTrue:[
        debuggerHolder := ValueHolder new.
        debuggerHolder addDependent:self.
    ].
    ^ debuggerHolder
!

debuggerHolder:aValueModel
    "set the 'debuggerHolder' value holder (automatically generated)"

    |oldValue newValue|

    debuggerHolder notNil ifTrue:[
        oldValue := debuggerHolder value.
        debuggerHolder removeDependent:self.
    ].
    debuggerHolder := aValueModel.
    debuggerHolder notNil ifTrue:[
        debuggerHolder addDependent:self.
    ].
    newValue := debuggerHolder value.
    oldValue ~~ newValue ifTrue:[
        self update:#value with:newValue from:debuggerHolder.
    ].
!

titleHolder
    "return/create the 'titleHolder' value holder (automatically generated)"

    titleHolder isNil ifTrue:[
        titleHolder := ValueHolder with: self class defaultWindowTitle
    ].
    ^ titleHolder

    "Modified: / 03-10-2018 / 15:36:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VDBAbstractApplication methodsFor:'binding access'!

menuExtendersFor: key do: block
    "Evaluates a block for each selector that extends particular menu.
     Extender methods have to be annotated by <menuextension: key> annotation
     and must take one argument (an instance of Menu that the menu extension
     extends."

    | cls |

    cls := self class.
    [ cls notNil ] whileTrue:[
        cls selectorsAndMethodsDo:[ :selector :method |
            method annotationsAt: #menuextension: do: [ :annotation |
                annotation arguments first == key ifTrue:[
                    block value: selector
                ].
            ]
        ].
        cls := cls superclass.
    ].

    "Created: / 25-01-2014 / 12:40:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 24-02-2014 / 22:44:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

menuFor:key
    | menu |

    menu := super menuFor: key.  
    thisContext isRecursive ifFalse:[
        self menuExtendersFor: key do:[:each |
            self perform: each with: menu
        ].
    ].

    ^ menu

    "Modified: / 18-06-1998 / 20:33:56 / cg"
    "Modified (comment): / 06-02-2018 / 20:35:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VDBAbstractApplication methodsFor:'change & update'!

update:aspect with:aParameter from:changedObject
    "Invoked when an object that I depend upon sends a change notification."

    changedObject == debuggerHolder ifTrue:[
        debuggerHolder value == debugger ifFalse:[
            debugger notNil ifTrue:[ 
                self unsubscribe.
            ].
            debugger := debuggerHolder value.
            debugger notNil ifTrue:[ 
                self subscribe.
            ].
        ].
        ^ self.
    ].
    changedObject == window ifTrue:[         
        aspect == #visibility ifTrue:[
            windowVisible ~~ window shown ifTrue:[ 
                windowVisible := window shown.
                self updateAfterWindowVisibilityChanged.
            ]. 

        ].

    ].

    super update:aspect with:aParameter from:changedObject

    "Modified: / 07-10-2018 / 22:51:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

updateAfterWindowVisibilityChanged
    "/ Nothing by default, to be overriden by subclasses.

    "Created: / 07-10-2018 / 22:51:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VDBAbstractApplication methodsFor:'delayed actions (enqueue)'!

enqueueMessage:selector for: object arguments: arguments
    "enqueue a message to be sent to someone later, when my process
     is back in its eventLoop. Also, filter duplicates.
     This is useful, to buffer redraws and avoid flicker due to multiple
     redraws (especially in browsers, when reacting on changeMessages resulting
     from changes made in other browsers)"   

    | w wg |

    
    "/ Technicallly, this is done by pushing an user event onto
    "/ and event queue and leting window's event dispatcher to 
    "/ trigger the update. 
    "/ 
    "/ However, the complication comes when updated is enqueued 
    "/ for application which is is not fully initialized or it is
    "/ not shown (such as in tab which is not visible). In that
    "/ case there's no sensor (event queue) associated with 
    "/ application's (sub) window. 
    "/ 
    "/ Since these updates re often equeued from an GDB event handler
    "/ and since they often involve sending more commands to GDB, we
    "/ really need them to be processed within an window event queue -
    "/ sending commands from GDB event dispatch process is not permitted
    "/ by GDB API. 
    "/ 
    "/ Hence, if there's no sensor already set up for the window, use
    "/ `WindowGroup activeGroup sensor`. In most cases that'd be the 
    "/ "right" one. If it's not, it should not harm. 
    "/ 
    "/ If there's no active window group, then process the
    "/ udate in special separate thread. This should be rare. 
    w := self window.
    w notNil ifTrue:[           
        wg := w windowGroup.
    ].        
    wg isNil ifTrue:[ 
        wg := WindowGroup activeGroup
    ].
    wg notNil ifTrue:[ 
        wg sensor enqueueMessage: selector for:object arguments: arguments        
    ] ifFalse:[
        [ object perform: selector withArguments: arguments ] fork.
    ]

    "Created: / 18-02-2019 / 10:22:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VDBAbstractApplication methodsFor:'dependents access'!

release
    "remove all dependencies from the receiver"

    super release.
    self unsubscribe

    "Created: / 06-06-2014 / 22:13:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VDBAbstractApplication methodsFor:'hooks'!

commonPostBuild
    window isNil ifTrue:[
        window := builder window.
        window notNil ifTrue:[
            windowVisible := window shown.
            window addDependent: self.
        ].
    ].

    "Created: / 07-10-2018 / 21:09:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 22-02-2019 / 21:14:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

commonPostOpen
    window := builder window.
    window notNil ifTrue:[
        windowVisible := window shown.
        window addDependent: self.
    ].
    super commonPostOpen

    "Created: / 22-02-2019 / 12:52:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

postBuildWith:aBuilder
    super postBuildWith: aBuilder.  
    (aBuilder window respondsTo: #labelChannel:) ifTrue:[
        aBuilder window labelChannel: self titleHolder.
    ].

    "Created: / 11-07-2017 / 16:33:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 11-07-2017 / 19:37:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VDBAbstractApplication methodsFor:'initialization & release'!

initialize
    super initialize.
    windowVisible := false.

    "Created: / 14-02-2019 / 16:40:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

subscribe   
    "Register for debugger events. To be overrided by subclasses"

    "Created: / 06-06-2014 / 21:26:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

unsubscribe
    "Unsubscribe myself fo debugger events"
    (debugger notNil and:[debugger isConnected]) ifTrue:[ 
        debugger announcer unsubscribe: self.
    ].

    "Created: / 06-06-2014 / 21:26:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 01-06-2017 / 13:43:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VDBAbstractApplication methodsFor:'menu actions'!

doInspectApplication
    self inspect

    "Created: / 06-02-2018 / 12:54:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

doInspectDebugger
   debugger inspect

    "Modified: / 09-09-2014 / 00:09:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

doInspectSessionRecord
   (debugger instVarNamed:#connection) recorder inspect

    "Created: / 09-09-2014 / 00:12:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

doOpenToolApplication:application 
    application allButOpen.
    application masterApplication: self topMasterApplication.
    self doOpenToolWindow: application window

    "Created: / 11-06-2017 / 20:21:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 29-07-2018 / 16:30:57 / 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.
    window raise.

    "Created: / 14-03-2018 / 09:47:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 10-06-2019 / 14:16:00 / 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
        font: self menuFont;
        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>"
    "Modified: / 31-08-2018 / 08:38:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VDBAbstractApplication methodsFor:'startup & release'!

releaseAsSubCanvas
    "a subcanvas is closed or switching to a new application.
     Can be redefined to perform a self release in this case."

    self release

    "Created: / 06-06-2014 / 22:12:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VDBAbstractApplication class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'
! !