# HG changeset patch # User tz # Date 891689675 -7200 # Node ID cecf78615ed198d18d0a56627df57831cf651775 # Parent 27936ff059d35f3d98977b5ed567cdc969ae9199 *** empty log message *** diff -r 27936ff059d3 -r cecf78615ed1 TabItemEditor.st --- a/TabItemEditor.st Thu Apr 02 21:16:00 1998 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1369 +0,0 @@ -" - 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. -" - - - -ToolApplicationModel subclass:#TabItemEditor - instanceVariableNames:'rebuildMode testView className selector aspects listOfTabs - hasChanged selectedIndex' - classVariableNames:'' - poolDictionaries:'' - category:'Interface-UIPainter' -! - -!TabItemEditor 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 -" - create and modify or inspect a list of tabs - - [start with:] - TabItemEditor open - - [see also:] - TabItem - TabView - NoteBookView - UIPainter - - [author:] - Claus Atzkern, eXept Software AG -" - - -! ! - -!TabItemEditor class methodsFor:'help specs'! - -helpSpec - "return a dictionary filled with helpKey -> helptext associations. - These are used by the activeHelp tool." - - " - UIHelpTool openOnClass:TabItemEditor - " - - ^ super helpSpec addPairsFrom:#( - -#addTabItem -'Adds a new tab item.' - -#argument -'a user defined argument not explicitly used by the tab item.' - -#canSelect -'Turns on/off selection behavior of the tab item.' - -#color -'define the foreground color of the label. The default derives from the style sheet.' - -#fileCreateAspectMethod -'Creates the aspect method for the tab list.' - -#fileNew -'Creates a new tab list.' - -#fileReload -'Reload tab list from current class and selector.' - -#fileSave -'Saves current tab list.' - -#label -'Label of the tab item.' - -#labelDerivesFromApplication -'if the value is off (the default), the tabs label is the string as entered in the label aspect. Otherwise, its the name of the message sent to the application - this should return a string or bitmap image, which is used as logo in the tab.' - -#testPreview -'Turns on/off preview of the tab list.' - -) -! ! - -!TabItemEditor class methodsFor:'interface specs'! - -nameAndSelectorSpec - "this window spec was automatically generated by the ST/X UIPainter" - - "do not manually edit this - the painter/builder may not be able to - handle the specification if its corrupted." - - " - UIPainter new openOnClass:TabItemEditor andSelector:#nameAndSelectorSpec - TabItemEditor new openInterface:#nameAndSelectorSpec - " - - - - ^ - - #(#FullSpec - #'window:' - #(#WindowSpec - #'name:' 'Tab Item Editor' - #'layout:' #(#LayoutFrame 141 0 424 0 456 0 551 0) - #'label:' 'Tab Item Editor' - #'min:' #(#Point 10 10) - #'max:' #(#Point 1152 900) - #'bounds:' #(#Rectangle 141 424 457 552) - #'usePreferredExtent:' false - ) - #'component:' - #(#SpecCollection - #'collection:' - #( - #(#FramedBoxSpec - #'name:' 'framedBox1' - #'layout:' #(#LayoutFrame 0 0.0 3 0.0 0 1.0 -33 1.0) - #'label:' 'Define class and selector' - #'labelPosition:' #topLeft - ) - #(#LabelSpec - #'name:' 'ClassLabel' - #'layout:' #(#AlignmentOrigin 58 0.11 37 0 1 0.5) - #'label:' 'Class:' - #'adjust:' #right - #'resizeForLabel:' true - ) - #(#InputFieldSpec - #'name:' 'ClassField' - #'layout:' #(#LayoutFrame 62 0.11 26 0 -18 1.0 48 0) - #'tabable:' true - #'model:' #className - ) - #(#LabelSpec - #'name:' 'SelectorLabel' - #'layout:' #(#AlignmentOrigin 58 0.11 62 0 1 0.5) - #'label:' 'Selector:' - #'adjust:' #right - #'resizeForLabel:' true - ) - #(#InputFieldSpec - #'name:' 'SelectorField' - #'layout:' #(#LayoutFrame 62 0.11 51 0 -18 1.0 73 0) - #'tabable:' true - #'model:' #selector - ) - #(#UISubSpecification - #'name:' 'CommitPanel' - #'layout:' #(#LayoutFrame 0 0.0 -29 1 0 1.0 -5 1) - #'majorKey:' #ToolApplicationModel - #'minorKey:' #windowSpecForCommitWithoutChannels - ) - ) - ) - ) -! - -tabSpec - "this window spec was automatically generated by the ST/X UIPainter" - - "do not manually edit this - the painter/builder may not be able to - handle the specification if its corrupted." - - " - UIPainter new openOnClass:TabItemEditor andSelector:#tabSpec - TabItemEditor new openInterface:#tabSpec - " - - - - ^ - - #(#FullSpec - #'window:' - #(#WindowSpec - #'name:' 'Tab Basic' - #'layout:' #(#LayoutFrame 134 0 107 0 496 0 332 0) - #'label:' 'Tab Basic' - #'min:' #(#Point 10 10) - #'max:' #(#Point 1280 1024) - #'bounds:' #(#Rectangle 134 107 497 333) - #'usePreferredExtent:' false - ) - #'component:' - #(#SpecCollection - #'collection:' - #( - #(#LabelSpec - #'name:' 'Label' - #'layout:' #(#AlignmentOrigin 104 0 26 0 1 0.5) - #'label:' 'Label:' - #'resizeForLabel:' true - ) - #(#InputFieldSpec - #'name:' 'LabelField' - #'layout:' #(#LayoutFrame 107 0 15 0 -5 1.0 37 0) - #'activeHelpKey:' #label - #'model:' #label - ) - #(#CheckBoxSpec - #'name:' 'TranslateLabel' - #'layout:' #(#LayoutOrigin 104 0 42 0) - #'activeHelpKey:' #labelDerivesFromApplication - #'model:' #translateLabel - #'label:' 'Label derives from Application' - ) - #(#ColorMenuSpec - #'name:' 'ForegroundColorMenu' - #'layout:' #(#LayoutFrame 75 0 124 0 -7 1.0 146 0) - #'activeHelpKey:' #color - #'model:' #labelForegroundColor - #'labelsAreColored:' false - ) - #(#LabelSpec - #'name:' 'ForegroundLabel' - #'layout:' #(#AlignmentOrigin 73 0 136 0 1 0.5) - #'label:' 'Color:' - #'adjust:' #right - #'resizeForLabel:' true - ) - #(#CheckBoxSpec - #'name:' 'CanSelect' - #'layout:' #(#LayoutFrame 107 0 176 0 226 0 198 0) - #'activeHelpKey:' #canSelect - #'model:' #enabled - #'label:' 'Can Select' - ) - #(#LabelSpec - #'name:' 'ArgumentLabel' - #'layout:' #(#AlignmentOrigin 104 0 91 0 1 0.5) - #'label:' 'Argument:' - #'resizeForLabel:' true - ) - #(#InputFieldSpec - #'name:' 'ArgumentField' - #'layout:' #(#LayoutFrame 107 0 80 0 -5 1.0 102 0) - #'activeHelpKey:' #argument - #'model:' #editAgument - ) - ) - ) - ) -! - -windowSpec - "this window spec was automatically generated by the ST/X UIPainter" - - "do not manually edit this - the painter/builder may not be able to - handle the specification if its corrupted." - - " - UIPainter new openOnClass:TabItemEditor andSelector:#windowSpec - TabItemEditor new openInterface:#windowSpec - " - "TabItemEditor open" - - - - ^ - - #(#FullSpec - #'window:' - #(#WindowSpec - #'name:' 'TabItem Editor' - #'layout:' #(#LayoutFrame 275 0 353 0 743 0 681 0) - #'label:' 'TabItem Editor' - #'min:' #(#Point 10 10) - #'max:' #(#Point 1152 900) - #'bounds:' #(#Rectangle 275 353 744 682) - #'menu:' #menu - #'usePreferredExtent:' false - ) - #'component:' - #(#SpecCollection - #'collection:' - #( - #(#MenuPanelSpec - #'name:' 'menuToolbarView' - #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 34 0) - #'menu:' #menuToolbar - #'showSeparatingLines:' true - ) - #(#VariableHorizontalPanelSpec - #'name:' 'VariablePanel' - #'layout:' #(#LayoutFrame 0 0.0 36 0.0 0 1.0 -26 1.0) - #'component:' - #(#SpecCollection - #'collection:' - #( - #(#SequenceViewSpec - #'name:' 'columnView' - #'enableChannel:' #isNotModified - #'model:' #selectionHolder - #'menu:' #menuEdit - #'hasHorizontalScrollBar:' true - #'hasVerticalScrollBar:' true - #'miniScrollerHorizontal:' true - #'useIndex:' true - #'sequenceList:' #listOfLabels - ) - #(#ViewSpec - #'name:' 'specView' - #'component:' - #(#SpecCollection - #'collection:' - #( - #(#ViewSpec - #'name:' 'TestView' - #'layout:' #(#LayoutFrame 1 0.0 0 0.0 0 1.0 0 1.0) - #'component:' - #(#SpecCollection - #'collection:' - #( - #(#TabViewSpec - #'name:' 'TestTabsView' - #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 0.5) - ) - ) - ) - ) - #(#SubCanvasSpec - #'name:' 'specCanvas' - #'layout:' #(#LayoutFrame 1 0.0 0 0.0 0 1.0 -30 1.0) - #'specHolder:' #specChannel - ) - #(#HorizontalPanelViewSpec - #'name:' 'modifyPanel' - #'layout:' #(#LayoutFrame 1 0.0 -30 1.0 0 1.0 0 1.0) - #'component:' - #(#SpecCollection - #'collection:' - #( - #(#ActionButtonSpec - #'name:' 'cancelButton' - #'label:' 'Cancel' - #'model:' #cancel - #'enableChannel:' #modifiedChannel - #'extent:' #(#Point 166 24) - ) - #(#ActionButtonSpec - #'name:' 'acceptButton' - #'label:' 'OK' - #'model:' #accept - #'enableChannel:' #modifiedChannel - #'extent:' #(#Point 167 24) - ) - ) - ) - #'horizontalLayout:' #fitSpace - #'verticalLayout:' #fitSpace - #'horizontalSpace:' 3 - #'verticalSpace:' 3 - ) - ) - ) - #'level:' -1 - ) - ) - ) - #'handles:' #(#Any 0.259875 1.0) - ) - #(#UISubSpecification - #'name:' 'infoBarSubSpec' - #'layout:' #(#LayoutFrame 0 0.0 -24 1 0 1.0 0 1.0) - #'majorKey:' #ToolApplicationModel - #'minorKey:' #windowSpecForInfoBar - ) - ) - ) - ) -! ! - -!TabItemEditor class methodsFor:'menu specs'! - -menu - "this window spec was automatically generated by the ST/X MenuEditor" - - "do not manually edit this - the builder may not be able to - handle the specification if its corrupted." - - " - MenuEditor new openOnClass:TabItemEditor andSelector:#menu - (Menu new fromLiteralArrayEncoding:(TabItemEditor menu)) startUp - " - - - - ^ - - #(#Menu - - #( - #(#MenuItem - #'label:' 'About' - #'activeHelpKey:' #about - #'labelImage:' #(#ResourceRetriever nil #menuIcon) - #'submenuChannel:' #menuAbout - ) - #(#MenuItem - #'label:' 'File' - #'activeHelpKey:' #file - #'submenu:' - #(#Menu - - #( - #(#MenuItem - #'label:' 'New' - #'value:' #doNew - #'activeHelpKey:' #fileNew - ) - #(#MenuItem - #'label:' '-' - ) - #(#MenuItem - #'label:' 'Reload' - #'value:' #doReload - #'activeHelpKey:' #fileReload - #'enabled:' #hasClassAndSelector - ) - #(#MenuItem - #'label:' '-' - ) - #(#MenuItem - #'label:' 'Save' - #'value:' #doInstallSpec - #'activeHelpKey:' #fileSave - #'enabled:' #isNotModified - ) - #(#MenuItem - #'label:' '-' - ) - #(#MenuItem - #'label:' 'Define Class And Selector...' - #'value:' #doDefineClassAndSelector - #'activeHelpKey:' #fileDefineClassAndSelector - ) - #(#MenuItem - #'label:' 'Create Aspect Method' - #'value:' #doInstallAspect - #'activeHelpKey:' #fileCreateAspectMethod - #'enabled:' #hasClassAndSelector - ) - #(#MenuItem - #'label:' '-' - ) - #(#MenuItem - #'label:' 'Exit' - #'value:' #closeRequest - #'activeHelpKey:' #fileExit - #'enabled:' #isNotModified - ) - ) nil - nil - ) - ) - #(#MenuItem - #'label:' 'Edit' - #'activeHelpKey:' #edit - #'submenuChannel:' #menuEdit - ) - #(#MenuItem - #'label:' 'Add' - #'activeHelpKey:' #add - #'submenu:' - #(#Menu - - #( - #(#MenuItem - #'label:' 'Tab Item' - #'value:' #doCreateTab - #'activeHelpKey:' #addTabItem - #'enabled:' #isNotModified - #'labelImage:' #(#ResourceRetriever nil #newTabItemIcon 'Tab Item') - ) - ) nil - nil - ) - ) - #(#MenuItem - #'label:' 'Test' - #'activeHelpKey:' #test - #'submenu:' - #(#Menu - - #( - #(#MenuItem - #'label:' 'Preview' - #'activeHelpKey:' #testPreview - #'enabled:' #canShowTestMode - #'indication:' #testMode - ) - ) nil - nil - ) - ) - #(#MenuItem - #'label:' 'History' - #'activeHelpKey:' #history - #'submenuChannel:' #menuHistory - ) - #(#MenuItem - #'label:' 'Help' - #'startGroup:' #right - #'activeHelpKey:' #help - #'submenuChannel:' #menuHelp - ) - ) nil - nil - ) -! - -menuEdit - "this window spec was automatically generated by the ST/X MenuEditor" - - "do not manually edit this - the builder may not be able to - handle the specification if its corrupted." - - " - MenuEditor new openOnClass:TabItemEditor andSelector:#menuEdit - (Menu new fromLiteralArrayEncoding:(TabItemEditor menuEdit)) startUp - " - - - - ^ - - #(#Menu - - #( - #(#MenuItem - #'label:' 'Cut' - #'value:' #doCutTab - #'activeHelpKey:' #editCut - #'enabled:' #isColumnSelected - ) - #(#MenuItem - #'label:' 'Copy' - #'value:' #doCopyTab - #'activeHelpKey:' #editCopy - #'enabled:' #isColumnSelected - ) - #(#MenuItem - #'label:' 'Paste' - #'value:' #doPasteTab - #'activeHelpKey:' #editPaste - #'enabled:' #valueOfHavingClipboard - ) - #(#MenuItem - #'label:' '-' - ) - #(#MenuItem - #'label:' 'Move Up' - #'value:' #'doMoveTabUpOrDown:' - #'activeHelpKey:' #editMoveUp - #'enabled:' #canMoveTabUpOrDown - #'argument:' #up - #'labelImage:' #(#ResourceRetriever #ToolApplicationModel #upIcon 'Move Up') - ) - #(#MenuItem - #'label:' 'Move Down' - #'value:' #'doMoveTabUpOrDown:' - #'activeHelpKey:' #editMoveDown - #'enabled:' #canMoveTabUpOrDown - #'argument:' #down - #'labelImage:' #(#ResourceRetriever #ToolApplicationModel #downIcon 'Move Down') - ) - ) nil - nil - ) -! - -menuToolbar - "this window spec was automatically generated by the ST/X MenuEditor" - - "do not manually edit this - the builder may not be able to - handle the specification if its corrupted." - - " - MenuEditor new openOnClass:TabItemEditor andSelector:#menuToolbar - (Menu new fromLiteralArrayEncoding:(TabItemEditor menuToolbar)) startUp - " - - - - ^ - - #(#Menu - - #( - #(#MenuItem - #'label:' 'New' - #'isButton:' true - #'value:' #doNew - #'activeHelpKey:' #fileNew - #'labelImage:' #(#ResourceRetriever nil #newIcon) - ) - #(#MenuItem - #'label:' 'Save' - #'isButton:' true - #'value:' #doInstallSpec - #'activeHelpKey:' #fileSave - #'enabled:' #isNotModified - #'labelImage:' #(#ResourceRetriever nil #saveIcon) - ) - #(#MenuItem - #'label:' '' - ) - #(#MenuItem - #'label:' 'Add Tab Item' - #'isButton:' true - #'value:' #doCreateTab - #'activeHelpKey:' #addTabItem - #'enabled:' #isNotModified - #'labelImage:' #(#ResourceRetriever nil #newTabItemIcon) - ) - #(#MenuItem - #'label:' '' - ) - #(#MenuItem - #'label:' 'Move Tab Up' - #'isButton:' true - #'value:' #'doMoveTabUpOrDown:' - #'activeHelpKey:' #editMoveUp - #'enabled:' #canMoveTabUpOrDown - #'argument:' #up - #'labelImage:' #(#ResourceRetriever nil #upIcon) - ) - #(#MenuItem - #'label:' 'Move Tab Down' - #'isButton:' true - #'value:' #'doMoveTabUpOrDown:' - #'activeHelpKey:' #editMoveDown - #'enabled:' #canMoveTabUpOrDown - #'argument:' #down - #'labelImage:' #(#ResourceRetriever nil #downIcon) - ) - #(#MenuItem - #'label:' '' - ) - #(#MenuItem - #'label:' 'Preview' - #'activeHelpKey:' #testPreview - #'enabled:' #canShowTestMode - #'indication:' #testMode - ) - ) nil - nil - ) -! ! - -!TabItemEditor class methodsFor:'resources'! - -newTabItemIcon - "Generated by the Image Editor" - " - ImageEditor openOnClass:self andSelector:#newTabItemIcon - " - - - - ^Icon - constantNamed:#'TabItemEditor newTabItemIcon' - ifAbsentPut:[(Depth2Image new) width: 22; height: 22; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'U@@@@EUPUEUUVEUPUF**+EUPUF**+EUPUF**+EUP@F**+@@@EV***UV@F*****+@F KNC*+NF(("H*+@F((BC +EF(("H*+@F(("C*+MF*****+@F"@ H*K@F"""(LK@F"" ("K@F"""(*K@F"" H*K@F*****+HK??????@@@@@@@@@'); colorMap:(((Array new:4) at:1 put:((Color black)); at:2 put:((Color white)); at:3 put:((Color grey:66.9978)); at:4 put:((Color grey:49.9962)); yourself)); mask:((Depth1Image new) width: 22; height: 22; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'G?<@G?<@G?<@G?<@G?<@??? 1]) - - - - -! - -modified - "returns true if current tab is modified - " - ^ self modifiedChannel value -! - -modified:aState - "change modification state - " - rebuildMode ifFalse:[ - self modifiedChannel value:aState. - self isNotModified value:(aState not). - ] -! ! - -!TabItemEditor methodsFor:'aspects'! - -aspectFor:aKey - "returns aspect for a key or nil - " - ^ aspects at:aKey ifAbsent:[ super aspectFor:aKey ] - - -! - -canMoveTabUpOrDown - - |holder| - - (holder := builder bindingAt:#canMoveTabUpOrDown) isNil ifTrue:[ - builder aspectAt:#canMoveTabUpOrDown put:(holder := false asValue). - ]. - ^ holder - -! - -canShowTestMode - - |holder| - - (holder := builder bindingAt:#canShowTestMode) isNil ifTrue:[ - builder aspectAt:#canShowTestMode put:(holder := false asValue). - ]. - ^ holder - -! - -hasClassAndSelector - - |holder| - - (holder := builder bindingAt:#hasClassAndSelector) isNil ifTrue:[ - builder aspectAt:#hasClassAndSelector put:(holder := false asValue). - ]. - ^ holder - -! - -isNotModified - "returns true if current tab spec is not modified - " - |holder| - - (holder := builder bindingAt:#isNotModified) isNil ifTrue:[ - builder aspectAt:#isNotModified put:(holder := true asValue). - ]. - ^ holder -! - -listOfLabels - "returns a holder which keeps the list of tab labels - " - |list| - - (list := builder bindingAt:#listOfLabels) isNil ifTrue:[ - builder aspectAt:#listOfLabels put:(list := List new). - ]. - ^ list -! - -modifiedChannel - "channel which is true if the current tab specification is modified - " - |holder| - - (holder := builder bindingAt:#modifiedChannel) isNil ifTrue:[ - builder aspectAt:#modifiedChannel put:(holder := false asValue). - ]. - ^ holder -! - -selectionHolder - "holder which keeps the current selection - " - |holder| - - (holder := builder bindingAt:#selectionHolder) isNil ifTrue:[ - holder := AspectAdaptor new subject:self; forAspect:#selectedIndex. - builder aspectAt:#selectionHolder put:holder. - ]. - ^ holder -! - -specChannel - "holder which keeps the current tab specification - " - |holder| - - (holder := builder bindingAt:#specChannel) isNil ifTrue:[ - builder aspectAt:#specChannel put:(holder := ValueHolder new). - ]. - ^ holder -! - -testMode - - |holder| - - (holder := builder bindingAt:#testMode) isNil ifTrue:[ - builder aspectAt:#testMode put:(holder := false asValue). - holder addDependent: self - ]. - ^ holder - -! ! - -!TabItemEditor methodsFor:'building'! - -buildFrom:aClass andSelector:aSelector - "build from class and selector - " - |spec list validClSl| - - self doNew. - - selector := nil. - className := self resolveName:aClass. - validClSl := false. - - className notNil ifTrue:[ - aSelector notNil ifTrue:[ - validClSl := true. - selector := aSelector asSymbol. - - (className respondsTo:selector) ifTrue:[ - spec := className perform:selector. - list := self listOfLabels. - - spec size ~~ 0 ifTrue:[ - - rebuildMode := true. - - spec do:[:aTab| - list add:aTab label. - listOfTabs add:aTab. - ]. - rebuildMode := false. - self addToHistory:(className name, ' ', selector) -> #loadFromMessage: - ] - ] - ] - ]. - - self hasClassAndSelector value:validClSl. - self modified:false. - hasChanged := false. - - listOfTabs notEmpty ifTrue:[ - self selectionHolder value:1 - ]. - - self updateInfoLabel -! - -loadFromMessage:aMessage - "load tabs from class and selector derived from history - " - |msg cls| - - aMessage notNil ifTrue:[ - msg := aMessage asCollectionOfWords. - - (msg size == 2 and:[(cls := self resolveName:(msg at:1)) notNil]) ifTrue:[ - self buildFrom:cls andSelector:((msg at:2) asSymbol) - ] - ] -! ! - -!TabItemEditor methodsFor:'change & update'! - -update:something with:aParameter from:someObject - "one of my aspects has changed; update modified channel - " - self modified:true. - - someObject = self testMode - ifTrue: - [ - someObject value - ifTrue: [self doTest] - ifFalse:[testView lower. self selectionHolder value:1]. - - self updateInfoLabel - ] -! ! - -!TabItemEditor methodsFor:'help'! - -defaultInfoLabel - - self testMode value - ifTrue: [^'Test mode'] - ifFalse: [ - className isNil ifTrue: [^'No tab list class defined']. - ^className name, ' >> ', selector printString] -! ! - -!TabItemEditor methodsFor:'selection'! - -selectedIndex - ^ selectedIndex -! - -selectedIndex:anIndex - |s oldSel| - - self listOfLabels notEmpty ifTrue: [self canShowTestMode value: true]. - anIndex notNil ifTrue: [self testMode value: false]. - - oldSel := selectedIndex. - selectedIndex := anIndex ? 0. - - selectedIndex == oldSel ifTrue:[^ self]. - - oldSel == 0 ifTrue:[ - self specChannel value:(self class tabSpec) - ] ifFalse:[ - selectedIndex == 0 ifTrue:[ - self specChannel value:nil - ] - ]. - self cancel. - - testView notNil ifTrue:[ - testView lower. - ]. - -! ! - -!TabItemEditor methodsFor:'startup / release'! - -closeRequest - - hasChanged ifTrue:[ - ( YesNoBox title:'Tab spec was modified!!' - yesText:'Waste it and proceed' - noText:'Cancel' - ) confirm ifFalse:[ - ^ self - ]. - hasChanged := false. - ]. - super closeRequest. -! - -initialize - "setup aspects used by column description specifications - " - |holder| - - super initialize. - - aspects := IdentityDictionary new. - listOfTabs := OrderedCollection new. - hasChanged := false. - selectedIndex := 0. - rebuildMode := false. - - #( - label - translateLabel - labelForegroundColor - enabled - editAgument - - ) do:[:aKey| - aspects at:aKey put:(holder := ValueHolder new). - holder addDependent:self. - ]. - - -! - -openModalOnClass:aClass andSelector:aSelector - - className := aClass. - selector := aSelector. - - super openInterfaceModal. - - -! - -openOnClass:aClass andSelector:aSelector - - className := aClass. - selector := aSelector. - - super openInterface. - - -! - -postBuildWith:builder - self buildFrom:className andSelector:selector. - testView := builder componentAt:#TestView. -! ! - -!TabItemEditor methodsFor:'user interactions'! - -doCopyTab - "copy selected tab - " - selectedIndex ~~ 0 ifTrue:[ - self clipboard:(listOfTabs at:selectedIndex) deepCopy - ] -! - -doCreateTab - - |tab| - self testMode value: false. - tab := TabItem label:'Tab Item ', (listOfTabs size + 1) printString. - - listOfTabs add:tab afterIndex:selectedIndex. - self listOfLabels add:(tab label) afterIndex:selectedIndex. - hasChanged := true. - - selectedIndex == 0 ifTrue:[ - self selectionHolder value:1 - ] ifFalse:[ - self selectionHolder value:selectedIndex + 1. - self cancel. - ] -! - -doCutTab - "cut selected tab - " - |list index| - - (index := selectedIndex) ~~ 0 ifTrue:[ - self testMode value: false. - list := self listOfLabels. - self clipboard:(listOfTabs at:index) deepCopy. - self selectionHolder value:0. - listOfTabs removeIndex:index. - list removeIndex:index. - hasChanged := true. - - index > list size ifTrue:[ - index := index - 1 - ]. - self selectionHolder value:index. - self listOfLabels isEmpty ifTrue: [self canShowTestMode value: false]. - ] - -! - -doDefineClassAndSelector - "launch a dialog to define class and selector - " - |cls sel bindings| - - bindings := IdentityDictionary new. - - [true] whileTrue:[ - cls := className notNil ifTrue:[className name] ifFalse:['NewApplication']. - sel := selector ? 'tabItemList'. - - bindings at:#className put:cls asValue. - bindings at:#selector put:sel asValue. - - (self openDialogInterface:#nameAndSelectorSpec withBindings:bindings) - ifFalse:[ ^ self ]. - - cls := (bindings at:#className) value withoutSeparators. - sel := (bindings at:#selector) value withoutSeparators. - - (cls := self resolveName:cls) notNil ifTrue:[ - className := cls. - - sel notNil ifTrue:[ - selector := sel asSymbol. - self hasClassAndSelector value:true. - - listOfTabs size == 0 ifTrue:[ - self buildFrom:className andSelector:selector - ]. - ^ self - ] - ] - ] -! - -doInstallAspect - "generate aspect method - " - |code| - - className isNil ifTrue:[ ^ self information:'No valid class defined!!']. - selector isNil ifTrue:[ ^ self information:'No selector defined!!' ]. - - (className canUnderstand:selector) ifTrue:[ - "/ method already exists, do not overwrite the method automaticaly - - ( YesNoBox title:'method ' - , (Text string:('#', selector) emphasis:#bold) - , ' already exists' - yesText:'overwrite' - noText:'cancel' - ) confirm ifFalse:[ - ^ self - ] - ]. - - code := '!!' , className name , ' methodsFor:''aspects''!!\\' , - selector , '\' , - ' "automatically generated by TabItem Editor ..."\' , - '\' , - ' |list|\' , - '\' , - ' (list := builder bindingAt:#' , selector , ') isNil ifTrue:[\' , - ' builder aspectAt:#' , selector, ' put:(list := self class ', selector, ').\' , - ' ].\' , - ' ^ list\' , - '!! !!\\'. - - (ReadStream on:(code withCRs)) fileIn - - -! - -doInstallSpec - "generate code for class and instance - " - |code spec category mthd| - - (className isNil or:[selector isNil]) ifTrue:[ - self doDefineClassAndSelector - ]. - className isNil ifTrue:[ ^ self information:'No valid class defined!!']. - selector isNil ifTrue:[ ^ self information:'No selector defined!!' ]. - listOfTabs isEmpty ifTrue:[ ^ self information:'No valid tabs defined!!' ]. - - spec := WriteStream on:String new. - UISpecification prettyPrintSpecArray:(listOfTabs literalArrayEncoding) on:spec indent:5. - spec := spec contents. - - "/ if that method already exists, do not overwrite the category - - category := 'interface specs'. - - (mthd := className class compiledMethodAt:selector) notNil ifTrue:[ - category := mthd category. - ]. - - code := Character excla asString - , className name , ' class methodsFor:' , category storeString - , Character excla asString , '\\' - - , selector , '\' - , ' "this window spec was automatically generated by the ST/X TabItemEditor"\\' - , ' "do not manually edit this - the builder may not be able to\' - , ' handle the specification if its corrupted."\\' - , ' "\' - , ' TabItemEditor new openOnClass:' , className name , ' andSelector:#' , selector , '\' - , ' "\'. - - code := code - , '\' - , ' \\' - , ' ^\' - , ' ', spec, '\' - , ' collect:[:aTab| TabItem new fromLiteralArrayEncoding:aTab ]' - , '\' - , Character excla asString - , ' ' - , Character excla asString - , '\\'. - - code := code withCRs. - (ReadStream on:code) fileIn. - hasChanged := false. - self addToHistory:(className name, ' ', selector) -> #loadFromMessage:. - - (className canUnderstand:selector) ifFalse:[ - (YesNoBox confirm:'install aspect method') ifTrue:[ - self doInstallAspect - ] - ] - - -! - -doMoveTabUpOrDown:what - "step up or down - " - |tab list index| - - (selectedIndex ~~ 0 and:[listOfTabs size > 1]) ifFalse:[ - ^ self - ]. - - list := self listOfLabels. - tab := listOfTabs at:selectedIndex. - - list removeIndex:selectedIndex. - listOfTabs removeIndex:selectedIndex. - - what == #down ifTrue:[ - index := selectedIndex > list size ifTrue:[1] - ifFalse:[selectedIndex + 1] - ] ifFalse:[ - index := selectedIndex == 1 ifTrue:[list size + 1] - ifFalse:[selectedIndex - 1] - ]. - - list add:(tab label) beforeIndex:index. - listOfTabs add:tab beforeIndex:index. - hasChanged := true. - - rebuildMode := true. - self selectionHolder value:index. - rebuildMode := false. - - -! - -doNew - - self testMode value: false. - - self modified:false. - - rebuildMode := true. - - self selectionHolder value:0. - self listOfLabels removeAll. - listOfTabs removeAll. - - testView notNil ifTrue:[ - testView lower - ]. - - hasChanged := true. - rebuildMode := false. - - self canShowTestMode value: false -! - -doPasteTab - "paste a tab - " - |tab| - - self testMode value: false. - tab := self class clipboard deepCopy. - listOfTabs add:tab afterIndex:selectedIndex. - self listOfLabels add:(tab label) afterIndex:selectedIndex. - hasChanged := true. - - selectedIndex == 0 ifTrue:[ - self selectionHolder value:1 - ] ifFalse:[ - self selectionHolder value:selectedIndex + 1. - self cancel. - ] -! - -doReload - "reload from class and selector - " - self buildFrom:className andSelector:selector -! - -doTest - "run a test - " - |tabView list| - - self selectionHolder value:nil. - - listOfTabs size ~~ 0 ifTrue:[ - list := listOfTabs collect:[:aTab||t| - t := aTab copy. - t setAttributesFromClass:className. - t - ] - ] ifFalse:[ - list := nil - ]. - tabView := builder componentAt:#TestTabsView. - tabView list:list. - testView raise. - - - -! ! - -!TabItemEditor class methodsFor:'documentation'! - -version - ^ '$Header$' -! !