"

 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' }"

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 upToAll:'[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 isEmpty ifTrue:[instances := nil].

    ].

    "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"

    showingHelp isNil ifTrue: [showingHelp := true].

    ^showingHelp

    "Created: / 31.7.1998 / 18:03:38 / cg"

    "Modified: / 31.7.1998 / 18:16:55 / cg"

!

showingHelp: aBoolean

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

    ^ showingHelp := aBoolean

    "Modified: / 31.7.1998 / 18:17:14 / 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'!

flyByHelpSpec

    <resource: #help>

    ^super flyByHelpSpec addPairsFrom:#(

"/#commitCancel

"/'Cancels'

"/

"/#commitOK

"/'Commit'

#editCopy

"/ 'Copy to clipboard'

'Copy'

#editCut

"/ 'Move to clipboard'

'Cut'

#editDelete

'Delete'

#editMoveDown

'Move Down'

#editMoveIn

'Move Into Next'

#editMoveInAbove

'Move Into Previous'

#editMoveOut

'Move Out'

#editMoveUp

'Move Up'

#editPaste

'Paste'

#editUndo

'Undo'

#fileBrowseClass

'Browse class'

#fileDefineClass

'Define class'

#fileDefineClassAndSelector

'Define class & selector'

#fileExit

'Exit'

#helpShowHelp

'Toggle help'

)

!

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:#(

#about

'Info functions.'

#aboutSTX

'Info about the running ST/X.'

#aboutThisAppliaction

'Info about that applications release and author.'

#add

'Add functions.'

#commitCancel

'Cancel changes.'

#commitOK

'Commit changes.'

#edit

'Edit functions.'

#editCopy

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

#editCut

'Move the selected item(s) to the clipboard.'

#editDelete

'Delete the selected item(s).'

#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.'

#editUndo

'Undo the last action.'

#file

'File functions.'

#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.'

#help

'Help functions.'

#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.'

)

! !

!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: Display 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 myDevice|

            menuIcon := Icon stxIcon.

            myDevice := Screen current.

            menuIcon magnifiedBy: (MenuPanel defaultFont heightOn:myDevice)/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

        #window: 

       #(#WindowSpec