"

 COPYRIGHT (c) 1997 by eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice. This software may not

 be provided or otherwise made available to, or used by, any

 other person. No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libview2' }"

"{ NameSpace: Smalltalk }"

ApplicationModel subclass:#ToolApplicationModel

	instanceVariableNames:'timeBlock'

	classVariableNames:''

	poolDictionaries:''

	category:'Interface-Framework'

!

ToolApplicationModel class instanceVariableNames:'history fileHistory clipboard settings showingHelp instances'

"

 The following class instance variables are inherited by this class:

	ApplicationModel - ClassResources

	Model - 

	Object - 

"

!

Object subclass:#HistoryEntry

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:ToolApplicationModel

!

ToolApplicationModel::HistoryEntry subclass:#HistoryEntryForFile

	instanceVariableNames:'filename'

	classVariableNames:''

	poolDictionaries:''

	privateIn:ToolApplicationModel

!

ToolApplicationModel::HistoryEntry subclass:#HistoryEntryForMethod

	instanceVariableNames:'methodClass methodSelector'

	classVariableNames:''

	poolDictionaries:''

	privateIn:ToolApplicationModel

!

!ToolApplicationModel class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1997 by eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice. This software may not

 be provided or otherwise made available to, or used by, any

 other person. No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    Framework class for tool applications (UIPainter, MenuEditor etc.).

    Provides hooks for modifiedChannels, history management,

    showing help texts, about menu, help menu etc.

    [author:]

        Thomas Zwick, eXept Software AG

"

! !

!ToolApplicationModel class methodsFor:'accessing'!

allToolInstances

    ^ instances ? #()

    "Created: / 4.2.1999 / 15:34:55 / cg"

!

authorLinesForAboutBox

    "extracts the author(s) from the documentation method."

    |firstClassWithDocumentation docMethod src s line lines|

    firstClassWithDocumentation := self class withAllSuperclasses detect:[:metacls| metacls includesSelector:#documentation].

    firstClassWithDocumentation notNil ifTrue:[

        (firstClassWithDocumentation inheritsFrom:ToolApplicationModel class) ifTrue:[

            docMethod := firstClassWithDocumentation compiledMethodAt:#documentation.

            docMethod notNil ifTrue:[

                src := docMethod source.

                src notNil ifTrue:[

                    s := src readStream.

                    s upToAllExcluding:'[author:]'.

                    s nextLine.   "/ skip to end

                    line := s nextLine.   "/ line after [author:]

                    lines := OrderedCollection new.

                    [line notEmptyOrNil] whileTrue:[

                        line := line withoutSeparators.

                        line size > 1 ifTrue:[

                            lines add:line withoutSeparators.

                            line := s nextLine.

                        ] ifFalse:[

                            line := nil

                        ]

                    ].

                    ^ lines.

                ]

            ]

        ]

    ].

    ( #('stx' 'exept') includes:self class package asPackageId module) ifTrue:[

        ^ #('eXept Software AG')

    ].

    ^ #('?')

    "Created: / 01-02-1998 / 15:41:43 / cg"

    "Modified: / 25-10-2006 / 17:29:35 / cg"

!

forgetInstance:anInstance

    instances notNil ifTrue:[

        instances remove:anInstance ifAbsent:[].

        instances := instances asNilIfEmpty.

    ].

    "Modified: / 4.2.1999 / 15:38:49 / cg"

!

label

    "returns the label for the tool instances of this class;

     extracted from the class name;

     can be redefined in subclasses"

    |label|

    label := ''.

    self name do:

    [:c|

        c isUppercase ifTrue: [label := label, $ ].

        label := label, c

    ].

    ^label trimBlanks

    "Modified: / 31.7.1998 / 18:04:18 / cg"

!

rememberInstance:anInstance

    instances isNil ifTrue:[

        instances := WeakIdentitySet new

    ].

    instances add:anInstance

    "Created: / 4.2.1999 / 15:33:43 / cg"

    "Modified: / 4.2.1999 / 15:34:14 / cg"

!

settings

    "returns the settings dictionary"

    settings isNil ifTrue: [settings := IdentityDictionary new].

    ^settings

!

showingHelp

    "returns true if active help is turned on for instances of this class"

    "/ cg: the default is now false - we use flyByHelp now, not the info-area help

    showingHelp isNil ifTrue: [showingHelp := false].

    ^showingHelp

    "

     self withAllSubclassesDo:[:cls | cls showingHelp:false]

     WorkspaceApplication showingHelp

    "

    "Created: / 31-07-1998 / 18:03:38 / cg"

    "Modified (comment): / 06-07-2011 / 18:01:13 / cg"

!

showingHelp: aBoolean

    "enable/disable active help for instances of this class"

    showingHelp := aBoolean

    "

     self withAllSubclassesDo:[:cls | cls showingHelp:false]

    "

    "Modified: / 31-07-1998 / 18:17:14 / cg"

    "Modified (comment): / 06-07-2011 / 17:54:13 / cg"

! !

!ToolApplicationModel class methodsFor:'clipboard'!

clipboard

    "returns the clipboard of this tool class"

    ^clipboard

!

clipboard: anEditObject

    "sets the clipboard for this tool class"

    clipboard := anEditObject

! !

!ToolApplicationModel class methodsFor:'help'!

openAboutSTX

    "opens an about box (on ST/X)"

    |box|

    AboutBox isNil ifTrue:[

        "/ this handles bad installations of ST/X,

        "/ where the AboutBox is missing.

        "/ (May vanish in the future)

        ^ self information:('Smalltalk/X rev.' , Smalltalk versionString)

    ].

    box := AboutBox new.

    box autoHideAfter:10 with:[].

    box showAtCenter

"/    box showAtPointer

    "Modified: / 14.8.1998 / 13:03:58 / cg"

    "Created: / 14.8.1998 / 13:17:43 / cg"

! !

!ToolApplicationModel class methodsFor:'help specs'!

helpSpec

    "This resource specification was automatically generated

     by the UIHelpTool of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the UIHelpTool may not be able to read the specification."

    "

     UIHelpTool openOnClass:ToolApplicationModel

    "

    <resource: #help>

    ^ super helpSpec addPairsFrom:#(

#aboutSTX

'Info about the running ST/X'

#aboutThisAppliaction

'Info about that applications release and author'

#add

'Add functions'

#addTab

'Add another page (tab)'

#commitCancel

'Cancel changes'

#commitOK

'Commit changes'

#edit

'Edit functions'

#editCopy

'Copy the selected item(s) to the clipboard'

#editCut

'Cut the selected item(s) to the clipboard'

#editDelete

'Delete the selected item(s)'

#editSearch

'Search'

#editMoveDown

'Move the selected item one step down (in the order list)'

#editMoveIn

'Move the selected item into the next item (as child item)'

#editMoveInAbove

'Move the selected item into the previous item (as child item)'

#editMoveOut

'Move the selected item out of its parent item'

#editMoveUp

'Move the selected item one step up (in the order list)'

#editPaste

'Paste from the clipboard'

#editRedo

'Redo the last undone action'

#editUndo

'Undo the last action'

#fileBrowseClass

'Open a System Browser on the current class'

#fileDefineClass

'Open a dialog to define the current class'

#fileDefineClassAndSelector

'Open a dialog to define the current class and selector'

#fileExit

'Exit this application'

#generate

'Code generation'

#helpHelpTool

'Show the Help Tools documentation'

#helpShowHelp

'Toggle display of help texts'

#helpTutorial

'Show this applications documentation'

#history

'History functions'

#historyEmptyMenu

'Clear the history'

#historyMenuItem

'Switch to that item'

#settings

'Settings functions'

#test

'Test functions'

)

    "Modified: / 07-06-2018 / 18:16:40 / Claus Gittinger"

! !

!ToolApplicationModel class methodsFor:'history'!

getFileHistory

    "returns the file-history for this tool class"

    fileHistory isNil ifTrue: [fileHistory := OrderedCollection new].

    ^ fileHistory

!

getHistory

    "returns the history for this tool class"

    history isNil ifTrue: [history := OrderedCollection new].

    ^history

!

historyMaxSize

    "returns the maximum size for the history of this tool class"

    ^10

! !

!ToolApplicationModel class methodsFor:'image specs'!

desktopIcon

    "returns the icon used for the desktop"

    <resource: #programImage>

    ^Icon

        constantNamed:#'ToolApplicationModel desktopIcon'

        ifAbsentPut:

        [

            |desktopIcon|

            desktopIcon := Icon stxIcon.

            desktopIcon magnifiedBy:Screen current preferredIconSize/desktopIcon extent

        ]

    "Modified: / 24.8.1998 / 21:34:38 / cg"

!

menuIcon

    "returns the icon used for the menu bar"

    <resource: #programImage>

    ^Icon

        constantNamed:#'ToolApplicationModel menuIcon'

        ifAbsentPut:

        [

            |menuIcon|

            menuIcon := Icon stxIcon.

            menuIcon magnifiedBy: (MenuPanel defaultFont heightOn:Screen current)/menuIcon height

        ]

    "Modified: / 24.8.1998 / 21:34:33 / cg"

! !

!ToolApplicationModel class methodsFor:'interface specs'!

windowSpecForCommit

    "This resource specification was automatically generated

     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the UIPainter may not be able to read the specification."

    "

     UIPainter new openOnClass:ToolApplicationModel andSelector:#windowSpecForCommit

     ToolApplicationModel new openInterface:#windowSpecForCommit

    "

    <resource: #canvas>

    ^ 

    #(FullSpec

       name: windowSpecForCommit

       uuid: 'eb8ebdbe-761b-11e9-98ea-b8f6b1108e05'

       window: 

      (WindowSpec

         label: 'Commit Buttons'

         name: 'Commit Buttons'

         uuid: '443e85f0-c5a3-11e7-82f7-c42c033b4871'

         min: (Point 100 22)

         max: (Point 1152 900)

         bounds: (Rectangle 0 0 300 60)

       )

       component: 

      (SpecCollection

         collection: (

          (HorizontalPanelViewSpec

             name: 'HorizontalPanel1'

             layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)

             uuid: '443e8d2a-c5a3-11e7-82f7-c42c033b4871'

             horizontalLayout: fitSpace

             verticalLayout: center

             horizontalSpace: 2

             verticalSpace: 1

             reverseOrderIfOKAtLeft: true

             component: 

            (SpecCollection

               collection: (

                (ActionButtonSpec

                   label: 'Cancel'

                   name: 'cancelButton'

                   activeHelpKey: commitCancel

                   uuid: '443e93e2-c5a3-11e7-82f7-c42c033b4871'

                   translateLabel: true

                   tabable: true

                   model: cancel

                   enableChannel: enablingCommitButtonsHolder

                   extent: (Point 146 30)

                 )

                (ActionButtonSpec

                   label: 'OK'

                   name: 'okButton'

                   activeHelpKey: commitOK

                   uuid: '443e9bda-c5a3-11e7-82f7-c42c033b4871'

                   translateLabel: true

                   tabable: true

                   model: accept

                   enableChannel: enablingCommitButtonsHolder

                   extent: (Point 147 30)

                 )

                )