help spec.
"
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.
"
ApplicationModel subclass:#ToolApplicationModel
instanceVariableNames:'timeBlock'
classVariableNames:''
poolDictionaries:''
category:'Interface-Framework'
!
ToolApplicationModel class instanceVariableNames:'history clipboard settings showHelp'
"
The following class instance variables are inherited by this class:
ApplicationModel - ClassResources
Model -
Object -
"
!
!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.
Provides hooks for history management,
showing help texts, about menu, help menu etc.
[author:]
Thomas Zwick, eXept Software AG
"
! !
!ToolApplicationModel class methodsFor:'accessing'!
authorLinesForAboutBox
"extracts the author(s) from the documentation method."
|firstClassWithDocumentation src s line lines|
firstClassWithDocumentation := self class withAllSuperclasses detect:[:metacls| metacls implements:#documentation].
firstClassWithDocumentation notNil ifTrue:[
(firstClassWithDocumentation inheritsFrom:ToolApplicationModel class) ifTrue:[
src := (firstClassWithDocumentation compiledMethodAt:#documentation) 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 notNil and:[line notEmpty]] whileTrue:[
line := line trimBlanks.
line size > 1 ifTrue:[
lines add:line trimBlanks.
line := s nextLine.
] ifFalse:[
line := nil
]
].
^ lines.
]
]
].
^ #('unnown')
"Created: / 1.2.1998 / 15:41:43 / cg"
"Modified: / 1.2.1998 / 15:59:10 / cg"
!
label
"returns the label for the tools 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
!
settings
"returns the settings dictionary"
settings isNil ifTrue: [settings := IdentityDictionary new].
^settings
!
showHelp
"returns whether the active help is turned on"
showHelp isNil ifTrue: [showHelp := true].
^showHelp
!
showHelp: aBoolean
"sets the active help on aBoolean"
^showHelp := aBoolean
! !
!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 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:#(
#about
'About functions.'
#aboutSTX
'Open an InfoBox showing details of the running ST/X.'
#aboutThisAppliaction
'Open an InfoBox about that applications release and its author.'
#add
'Add functions.'
#commitCancel
'Cancels 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
'Moves the selected item one step down in the order list.'
#editMoveIn
'Moves the selected item into next item as child item.'
#editMoveOut
'Moves the selected item out of its parent item.'
#editMoveUp
'Moves 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 and selector.'
#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
'Open an HTML-Browser showing the Help Tools documentation.'
#helpShowHelp
'Toggle display of help texts.'
#helpTutorial
'Open an HTML-Browser showing this applications documentation.'
#history
'History functions.'
#historyEmptyMenu
'Clear the history.'
#historyMenuItem
'Switch to that item.'
#settings
'Settings functions.'
#test
'Test functions.'
)
"Modified: / 29.7.1998 / 22:29:16 / cg"
! !
!ToolApplicationModel class methodsFor:'history'!
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"
^Icon
constantNamed:#'ToolApplicationModel desktopIcon'
ifAbsentPut:
[
|desktopIcon|
desktopIcon := Icon stxIcon.
desktopIcon magnifiedBy: Display preferredIconSize/desktopIcon extent
]
!
menuIcon
"returns the icon used for the menu bar"
^Icon
constantNamed:#'ToolApplicationModel menuIcon'
ifAbsentPut:
[
|menuIcon|
menuIcon := Icon stxIcon.
menuIcon magnifiedBy: MenuPanel defaultFont height/menuIcon height
]
! !
!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
#window:
#(#WindowSpec
#name: 'Commit Buttons'
#layout: #(#LayoutFrame 344 0 371 0 643 0 430 0)
#label: 'Commit Buttons'
#min: #(#Point 100 22)
#max: #(#Point 1152 900)
#bounds: #(#Rectangle 344 371 644 431)
#usePreferredExtent: false
)
#component:
#(#SpecCollection
#collection:
#(
#(#ActionButtonSpec
#name: 'cancelButton'
#layout: #(#LayoutFrame 5 0 0 0 -2 0.5 0 1)
#activeHelpKey: #commitCancel
#label: 'Cancel'
#translateLabel: true
#tabable: true
#model: #cancel
#enableChannel: #valueOfEnablingCommitButtons
)
#(#ActionButtonSpec
#name: 'okButton'
#layout: #(#LayoutFrame 2 0.5 0 0.0 -5 1 0 1.0)
#activeHelpKey: #commitOK
#label: 'OK'
#translateLabel: true
#tabable: true
#model: #accept
#enableChannel: #valueOfEnablingCommitButtons
)
)
)
)
"Modified: / 20.5.1998 / 03:31:54 / cg"
!
windowSpecForCommitWithoutChannels
"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:#windowSpecForCommitWithoutChannels
ToolApplicationModel new openInterface:#windowSpecForCommitWithoutChannels
"
<resource: #canvas>
^
#(#FullSpec
#window:
#(#WindowSpec
#name: 'Commit Buttons Without Channels'
#layout: #(#LayoutFrame 500 0 326 0 799 0 385 0)
#label: 'Commit Buttons Without Channels'
#min: #(#Point 100 22)
#max: #(#Point 1152 900)
#bounds: #(#Rectangle 500 326 800 386)
#usePreferredExtent: false
)
#component:
#(#SpecCollection
#collection:
#(
#(#ActionButtonSpec
#name: 'cancelButton'
#layout: #(#LayoutFrame 5 0 0 0 -2 0.5 0 1)
#activeHelpKey: #commitCancel
#label: 'Cancel'
#translateLabel: true
#tabable: true
#model: #cancel
)
#(#ActionButtonSpec
#name: 'okButton'
#layout: #(#LayoutFrame 2 0.5 0 0.0 -5 1 0 1.0)
#activeHelpKey: #commitOK
#label: 'OK'
#translateLabel: true
#tabable: true
#model: #accept
)
)
)
)
"Modified: / 20.5.1998 / 03:30:09 / cg"
!
windowSpecForInfoBar
"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:#windowSpecForInfoBar
ToolApplicationModel new openInterface:#windowSpecForInfoBar
"
<resource: #canvas>
^
#(#FullSpec
#window:
#(#WindowSpec
#name: 'Info Bar'
#layout: #(#LayoutFrame 233 0 218 0 732 0 563 0)
#label: 'Info Bar'
#min: #(#Point 400 320)
#max: #(#Point 1152 900)
#bounds: #(#Rectangle 233 218 733 564)
#menu: #menu
#usePreferredExtent: false
)
#component:
#(#SpecCollection
#collection:
#(
#(#ViewSpec
#name: 'view'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#component:
#(#SpecCollection
#collection:
#(
#(#LabelSpec
#name: 'infoLabel'
#layout: #(#LayoutFrame 2 0.0 1 0.0 -1 1.0 -1 1.0)
#labelChannel: #valueOfInfoLabel
#level: -1
#adjust: #left
#resizeForLabel: false
)
)
)
)
)
)
)
!
windowSpecForInfoBarWithClock
"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:#windowSpecForInfoBarWithClock
ToolApplicationModel new openInterface:#windowSpecForInfoBarWithClock
"
<resource: #canvas>
^
#(#FullSpec
#window:
#(#WindowSpec
#name: 'Info Bar'
#layout: #(#LayoutFrame 160 0 423 0 659 0 453 0)
#label: 'Info Bar'
#min: #(#Point 400 320)
#max: #(#Point 1152 900)
#bounds: #(#Rectangle 160 423 660 454)
#menu: #menu
#usePreferredExtent: false
)
#component:
#(#SpecCollection
#collection:
#(
#(#ViewSpec
#name: 'view'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#component:
#(#SpecCollection
#collection:
#(
#(#LabelSpec
#name: 'infoLabel'
#layout: #(#LayoutFrame 2 0 1 0.0 -81 1 -1 1.0)
#labelChannel: #valueOfInfoLabel
#level: -1
#adjust: #left
#resizeForLabel: false
)
#(#LabelSpec
#name: 'timeLabel'
#layout: #(#LayoutFrame -79 1 1 0.0 -1 1.0 -1 1.0)
#labelChannel: #valueOfTimeLabel
#level: -1
#adjust: #right
#resizeForLabel: false
)
)
)
)
)
)
)
! !
!ToolApplicationModel class methodsFor:'menu specs'!
menuAbout
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:ToolApplicationModel andSelector:#menuAbout
(Menu new fromLiteralArrayEncoding:(ToolApplicationModel menuAbout)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'About Smalltalk/X...'
#translateLabel: true
#value: #openAbout
#activeHelpKey: #aboutSTX
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'About this Application...'
#translateLabel: true
#value: #openAboutThisApplication
#activeHelpKey: #aboutThisAppliaction
)
) nil
nil
)
"Modified: / 19.5.1998 / 21:44:09 / cg"
!
menuFont
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:ToolApplicationModel andSelector:#menuFont
(Menu new fromLiteralArrayEncoding:(ToolApplicationModel menuFont)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Label...'
#value: #chooseFont:
#argument: 'Label Font'
)
#(#MenuItem
#label: 'Button...'
#value: #chooseFont:
#argument: 'Button Font'
)
#(#MenuItem
#label: 'Edit...'
#value: #chooseFont:
#argument: 'Edit Font'
)
#(#MenuItem
#label: 'List...'
#value: #chooseFont:
#argument: 'List Font'
)
#(#MenuItem
#label: 'Tree List...'
#value: #chooseFont:
#argument: 'Tree List Font'
)
#(#MenuItem
#label: 'Note Book...'
#value: #chooseFont:
#argument: 'Note Book Font'
)
#(#MenuItem
#label: 'Framed Box...'
#value: #chooseFont:
#argument: 'Framed Box Font'
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Reset'
#value: #resetFonts
)
) nil
nil
)
!
menuHelp
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:ToolApplicationModel andSelector:#menuHelp
(Menu new fromLiteralArrayEncoding:(ToolApplicationModel menuHelp)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Documentation'
#translateLabel: true
#value: #openDocumentation
#activeHelpKey: #helpTutorial
#enabled: #valueOfHavingDocumentation
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Show Help Texts'
#translateLabel: true
#activeHelpKey: #helpShowHelp
#indication: #showHelp:
)
) nil
nil
)
! !
!ToolApplicationModel class methodsFor:'queries'!
getAllImageSelectorsFrom: aClass
"returns all image selectors implementing an image spec in class aClass"
|iconClass|
aClass isSymbol
ifTrue: [iconClass := Smalltalk at: aClass]
ifFalse: [iconClass := aClass].
^((iconClass class methodDictionary values select: [:m| m category = 'image specs'])
collect: [:m| m selector]) asSortedCollection asOrderedCollection
!
isVisualStartable
"returns whether this application class can be started via #open"
self == ToolApplicationModel ifTrue:[^false].
^super isVisualStartable
! !
!ToolApplicationModel class methodsFor:'startup / release'!
preSnapshot
"removes the clipboard before snap shoting"
clipboard := nil
!
uninitialize
"resets the class instance variables"
settings := showHelp := history := clipboard := nil
! !
!ToolApplicationModel methodsFor:'aspects'!
valueOfCanCopy
"returns whether can copy as value holder"
^ builder booleanValueAspectFor:#valueOfCanCopy
"Modified: / 21.5.1998 / 03:39:05 / cg"
!
valueOfCanCut
"returns whether can paste as value holder"
^ builder booleanValueAspectFor:#valueOfCanCut
"Modified: / 21.5.1998 / 03:39:13 / cg"
!
valueOfCanPaste
"returns whether can paste as value holder"
^ builder booleanValueAspectFor:#valueOfCanPaste
"Modified: / 21.5.1998 / 03:39:22 / cg"
!
valueOfCanUndo
"returns whether can undo as value holder"
^ builder booleanValueAspectFor:#valueOfCanUndo
"Modified: / 21.5.1998 / 03:39:31 / cg"
!
valueOfEnablingCommitButtons
"returns the enabling of the commit of this tool as value holder"
^ builder booleanValueAspectFor:#valueOfEnablingCommitButtons
"Modified: / 21.5.1998 / 03:39:49 / cg"
!
valueOfHavingDocumentation
"returns the enabling of having documentation for this tool as value holder"
^ (builder booleanValueAspectFor:#valueOfEnablingCommitButtons) value: (self class implements: #openDocumentation)
!
valueOfInfoLabel
"returns the info label as value holder"
^ builder nilValueAspectFor:#valueOfInfoLabel
"Modified: / 21.5.1998 / 03:40:34 / cg"
!
valueOfTimeLabel
"returns the time label as value holder"
^ builder nilValueAspectFor:#valueOfTimeLabel
"Modified: / 21.5.1998 / 03:40:42 / cg"
! !
!ToolApplicationModel methodsFor:'clipboard'!
clipboard
"returns the clipboard"
^self class clipboard
!
clipboard: anEditObject
"sets the clipboard and the value holder for can pasting"
self class clipboard: anEditObject.
self valueOfCanPaste value: anEditObject notNil
! !
!ToolApplicationModel methodsFor:'defaults'!
aboutImage
"the image to be displayed in my about-box;
If nil is returned, thhe ST/X default image is used."
^ nil
"Created: / 25.7.1998 / 20:33:50 / cg"
! !
!ToolApplicationModel methodsFor:'help'!
defaultInfoLabel
"returns the default info label; here an empty string"
^''
!
doShowHelp:aHelpText
"displays aHelpText in the info label or if present detours it to its masterApplication"
aHelpText isNil
ifTrue: [self updateInfoLabel]
ifFalse: [self valueOfInfoLabel value: (aHelpText asString printString readStream through: $.)].
"Created: / 20.6.1998 / 16:37:23 / cg"
!
openAbout
"opens an about box"
|box|
box := AboutBox new.
box autoHideAfter:10 with:[].
box showAtCenter
"Modified: / 25.7.1998 / 20:36:46 / cg"
!
openAboutThisApplication
"opens an about this application box"
|rev box myClass clsRev image|
rev := ''.
myClass := self class.
(clsRev := myClass revision) notNil ifTrue: [rev := ' (rev: ', clsRev printString, ')'].
box := AboutBox title:
'\The application\\' withCRs
, myClass name asBoldText, rev
, '\\has been designed and implemented by: \' withCRs
, ((self class authorLinesForAboutBox collect:[:l | '- ' , l]) asStringWith:$\) withCRs
, '\\' withCRs.
image := self aboutImage.
image notNil ifTrue:[
box image:image
].
box label:'About This Application'.
box autoHideAfter:10 with:[].
box showAtCenter.
"Modified: / 25.7.1998 / 20:37:18 / cg"
!
openHTMLDocument: aHTMLFilename
"opens a HTML browser on aHTMLFilename"
HTMLDocumentView openFullOnDocumentationFile: aHTMLFilename
!
showHelp
"returns whether showing help is turned on/off"
|currentActiveHelp|
currentActiveHelp := ActiveHelp currentHelpListener.
^self class showHelp
and: [currentActiveHelp notNil and: [masterApplication notNil
ifFalse: [currentActiveHelp interestedIn: self window]
ifTrue: [currentActiveHelp interestedIn: masterApplication window]]]
!
showHelp: aValue
"toggles showing help"
(self class showHelp: aValue)
ifTrue: [ActiveHelp startFor: self]
ifFalse: [ActiveHelp stopFor: self. self updateInfoLabel]
!
showHelp:aHelpText for:view
"displays aHelpText in the info label or if present detours it to its masterApplication.
Here, an event is pushed for myself to synchronize the helpDisplay
with event handling."
|wg mySensor|
self showHelp ifFalse: [^true].
masterApplication notNil ifTrue: [masterApplication showHelp: aHelpText for:view].
"/ OLD: show it right here ...
"/ aHelpText isNil
"/ ifTrue: [self updateInfoLabel]
"/ ifFalse: [self valueOfInfoLabel value: (aHelpText asString printString readStream through: $.)].
"/ the nil-tests should not be req'd - but thats a last-minute
"/ change and I dont want to breaks the delivery ...
"/ NEW: push it into the event queue, to have it displayed
"/ syncronously with other events.
"/ (also any errors are reported as occurring in my context;
"/ instead of occurring in the activeHelp context).
(wg := self windowGroup) notNil ifTrue:[
mySensor := wg sensor.
mySensor notNil ifTrue:[
mySensor flushEventsFor:self withType:#doShowHelp:.
mySensor pushUserEvent:#doShowHelp: for:self withArguments:(Array with:aHelpText).
].
].
^true
"Modified: / 20.6.1998 / 16:47:37 / cg"
!
updateInfoLabel
"updates the info label at the bottom"
self valueOfInfoLabel value: self defaultInfoLabel
! !
!ToolApplicationModel methodsFor:'history'!
addToHistory: aHistoryEntry
"adds aHistoryEntry (format: loadMessage -> evalString) at the top of the history,
and checks for maximum size of the history"
aHistoryEntry key size = 0 ifTrue: [^nil].
self history remove: (self history detect: [:histEntry| histEntry key = aHistoryEntry key] ifNone: nil) ifAbsent: nil.
self history addFirst: aHistoryEntry.
[self history size > self class historyMaxSize] whileTrue: [self history removeLast]
!
emptyHistory
"removes all history entries"
^self history removeAll
!
history
"returns the history from tool class"
^self class getHistory
!
historyEntries
"returns the history entries, i.e. the evaluatable values containing the information"
^self history collect: [:asso| asso key]
!
menuHistory
"returns a history submenu"
|menu|
menu := Menu new receiver: self.
(self history collect: [:histEntry| histEntry value]) asSet asOrderedCollection do:
[:historyEntryType|
menu addItemGroup:
((self history
select: [:histEntry|
histEntry value = historyEntryType])
collect: [:histEntry|
MenuItem new
label: histEntry key printString;
value: histEntry value;
argument: histEntry key;
activeHelpKey: #historyMenuItem]).
].
menu addItem: (MenuItem new
label: 'Empty History';
value: #emptyHistory;
activeHelpKey: #historyEmptyMenu;
translateLabel:true).
menu findGuiResourcesIn:self.
^menu
"Modified: / 29.7.1998 / 11:40:11 / cg"
!
removeFromHistory: aHistoryEntry
"removes aHistoryEntry from the history"
self history remove: (self history detect: [:histEntry| histEntry key = aHistoryEntry key] ifNone: nil) ifAbsent: nil.
[self history size > self class historyMaxSize] whileTrue: [self history removeLast]
! !
!ToolApplicationModel methodsFor:'initialization'!
initialize
super initialize.
self createBuilder
"Created: / 20.6.1998 / 14:51:29 / cg"
! !
!ToolApplicationModel methodsFor:'queries'!
allToolInstances
"returns all instances of this tool class"
^self class settings at: #Instances ifAbsent: [^#()]
!
preferredExtent
"preferred extent of my window; top/main menu and top toolbar (named by 'menuToolbarView')
will be considered"
|window menu menuToolbarView preferredExtentOfWindow|
window := self builder window.
menu := window subViews first.
menuToolbarView := builder componentAt: #menuToolbarView.
preferredExtentOfWindow := window extent.
menu class = MenuPanel ifTrue: [preferredExtentOfWindow := preferredExtentOfWindow max: menu preferredExtent].
menuToolbarView notNil ifTrue: [preferredExtentOfWindow := preferredExtentOfWindow max: menuToolbarView preferredExtent].
^window minExtent max: (preferredExtentOfWindow min: window maxExtent)
! !
!ToolApplicationModel methodsFor:'settings'!
allFontViewsDo: aBlock
"evaluates aBlock for all views with fonts"
|fontViews|
fontViews := OrderedCollection new.
self builder windowGroup views do: [:v| v class = MenuPanel ifTrue: [fontViews add: v]].
builder namedComponents do:
[:aView|
aView allSubViewsDo:
[:v|
v font notNil ifTrue: [fontViews add: v]
]
].
fontViews do: aBlock
!
chooseFont: viewFont
"chooses a font for viewFont and puts it into the settings dictionary;
finally update all my views"
|defaultFont font|
viewFont = 'Label Font' ifTrue: [defaultFont := Label defaultFont].
viewFont = 'Button Font' ifTrue: [defaultFont := Button defaultFont].
viewFont = 'Edit Font' ifTrue: [defaultFont := TextView defaultFont].
viewFont = 'List Font' ifTrue: [defaultFont := ListView defaultFont].
viewFont = 'Tree List Font' ifTrue: [defaultFont := SelectionInTreeView defaultFont].
viewFont = 'Note Book Font' ifTrue: [defaultFont := NoteBookView defaultFont].
viewFont = 'Framed Box Font' ifTrue: [defaultFont := FramedBox defaultFont].
(font := FontPanel
fontFromUserInitial: (self class settings at: viewFont asSymbol ifAbsent: nil) ? defaultFont
title: 'Choose ', viewFont) notNil
ifTrue:
[
self class settings at: viewFont asSymbol put: (font on: device).
self updateFonts
].
^font
!
resetFonts
"sets the fonts in the settings to nil and resets the views to its default font"
(self class settings)
at: #'Label Font' put: Label defaultFont;
at: #'Button Font' put: Button defaultFont;
at: #'Edit Font' put: TextView defaultFont;
at: #'List Font' put: ListView defaultFont;
at: #'Tree List Font' put: SelectionInTreeView defaultFont;
at: #'Note Book Font' put: NoteBookView defaultFont;
at: #'Framed Box Font' put: FramedBox defaultFont.
self updateFonts.
(self class settings)
removeKey: #'Label Font' ifAbsent: nil;
removeKey: #'Button Font' ifAbsent: nil;
removeKey: #'Edit Font' ifAbsent: nil;
removeKey: #'List Font' ifAbsent: nil;
removeKey: #'Tree List Font' ifAbsent: nil;
removeKey: #'Note Book Font' ifAbsent: nil;
removeKey: #'Framed Box Font' ifAbsent: nil.
!
updateFonts
"takes defined fonts from the settings and set them to the corresponding views"
|settings labelFont buttonFont editFont listFont treeListFont noteBookFont framedBoxFont updateFontsBlock|
settings := self class settings.
labelFont := settings at: #'Label Font' ifAbsent: nil.
buttonFont := settings at: #'Button Font' ifAbsent: nil.
editFont := settings at: #'Edit Font' ifAbsent: nil.
listFont := settings at: #'List Font' ifAbsent: nil.
treeListFont := settings at: #'Tree List Font' ifAbsent: nil.
noteBookFont := settings at: #'Note Book Font' ifAbsent: nil.
framedBoxFont := settings at: #'Framed Box Font' ifAbsent: nil.
updateFontsBlock :=
[:v|
(labelFont notNil and: [v font ~= labelFont and: [(v class == Label) or: [v isKindOf: Toggle]]])
ifTrue: [v font: labelFont; fixSize; sizeChanged:nil; invalidate].
(buttonFont notNil and: [v font ~= buttonFont and: [v class == Button or: [v class == PopUpList]]])
ifTrue: [v label isString ifTrue: [|e|e := v extent. v font: buttonFont; extent: e; invalidate]].
(editFont notNil and: [v font ~= editFont and: [v isKindOf: TextView]])
ifTrue: [v font: editFont; invalidate].
(listFont notNil and: [v font ~= listFont and: [v class = SelectionInListView or: [v class = DataSetView]]])
ifTrue: [v font: listFont. v invalidate].
(treeListFont notNil and: [v font ~= treeListFont and: [v isKindOf: SelectionInTreeView]])
ifTrue: [v font: treeListFont; invalidate].
(noteBookFont notNil and: [v font ~= noteBookFont and: [v class == NoteBookView]])
ifTrue: [v font: noteBookFont; invalidate].
(framedBoxFont notNil and: [v font ~= framedBoxFont and: [v class == FramedBox]])
ifTrue: [v font: framedBoxFont; invalidate]
].
self allFontViewsDo: [:v| updateFontsBlock value: v]
! !
!ToolApplicationModel methodsFor:'startup / release'!
close
"uninitializes and closes this tool"
self uninitialize.
super close
!
closeRequest
"uninitializes this tool before requesting close"
self uninitialize.
super closeRequest
!
postBuildWith:aBuilder
"sets the preferred extent and the label of the tool window before opening that"
|win|
super postBuildWith:aBuilder.
(win := aBuilder window) isTopView ifTrue:[
win
extent: self preferredExtent;
label: self class label.
].
"Created: / 21.5.1998 / 02:49:09 / cg"
"Modified: / 18.6.1998 / 20:16:25 / cg"
!
postOpenWith:aBuilder
"starts the active help for this tool (if turned on in the settings)
and updates the info label and the fonts (from the settings)"
super postOpenWith:aBuilder.
self class showHelp ifTrue: [ActiveHelp startFor: self].
self updateInfoLabel.
self updateFonts.
!
startClockOnTimedBlock: aBlock
"sets and starts the time block"
timeBlock := aBlock.
aBlock value.
!
uninitialize
"stops the active help this tool and (if defined) removes the time block"
self showHelp ifTrue: [ActiveHelp stopFor: self].
timeBlock notNil ifTrue: [Processor removeTimedBlock:timeBlock. timeBlock := nil].
! !
!ToolApplicationModel class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libview2/ToolApplicationModel.st,v 1.68 1998-07-30 09:19:09 cg Exp $'
! !