UIPainterView.st
author Claus Gittinger <cg@exept.de>
Tue, 14 May 2019 09:46:21 +0200
changeset 3663 9d49ecf8661a
parent 3575 a9fc2d3553f3
permissions -rw-r--r--
#UI_ENHANCEMENT by cg
class: TabListEditor class
changed:
#canvasSpec
#menu
#windowSpec
     1 "
     2  COPYRIGHT (c) 1995 by Claus Gittinger / eXept Software AG
     3 	      All Rights Reserved
     4 
     5  This software is furnished under a license and may be used
     6  only in accordance with the terms of that license and with the
     7  inclusion of the above copyright notice. This software may not
     8  be provided or otherwise made available to, or used by, any
     9  other person.  No title to or ownership of the software is
    10  hereby transferred.
    11 "
    12 "{ Package: 'stx:libtool2' }"
    13 
    14 "{ NameSpace: Smalltalk }"
    15 
    16 UIObjectView subclass:#UIPainterView
    17 	instanceVariableNames:'treeView listHolder superclassName className methodName
    18 		categoryName handleColorBlack handleColorWhite handleMasterColor
    19 		sketchPainter listOfAspectsHolder'
    20 	classVariableNames:'HandCursor RedefineAspectMethods AspectsAsInstances'
    21 	poolDictionaries:''
    22 	category:'Interface-UIPainter'
    23 !
    24 
    25 Object subclass:#ViewProperty
    26 	instanceVariableNames:'view spec identifier'
    27 	classVariableNames:'Identifier'
    28 	poolDictionaries:''
    29 	privateIn:UIPainterView
    30 !
    31 
    32 !UIPainterView class methodsFor:'documentation'!
    33 
    34 copyright
    35 "
    36  COPYRIGHT (c) 1995 by Claus Gittinger / eXept Software AG
    37 	      All Rights Reserved
    38 
    39  This software is furnished under a license and may be used
    40  only in accordance with the terms of that license and with the
    41  inclusion of the above copyright notice. This software may not
    42  be provided or otherwise made available to, or used by, any
    43  other person.  No title to or ownership of the software is
    44  hereby transferred.
    45 "
    46 !
    47 
    48 documentation
    49 "
    50     buildIn view used by the UIPainter; from this view, the layout of the
    51     new application derives from.
    52 
    53     [see also:]
    54 	UIBuilder
    55 	UIObjectView
    56 
    57     [author:]
    58 	Claus Gittinger
    59 	Claus Atzkern
    60 "
    61 ! !
    62 
    63 !UIPainterView class methodsFor:'initialization'!
    64 
    65 initialize
    66 
    67     AspectsAsInstances := true. "/ false.
    68     RedefineAspectMethods := false.
    69 
    70     "Created: / 22.9.1999 / 12:32:31 / stefan"
    71 ! !
    72 
    73 !UIPainterView class methodsFor:'code generation mode'!
    74 
    75 generateAspectsAsInstanceVariables
    76     "if on, aspects are held as instance variables;
    77      if off (the default), they are kept in the bindings dictionary."
    78 
    79     ^ AspectsAsInstances
    80 
    81     "Created: / 29.7.1998 / 11:21:38 / cg"
    82     "Modified: / 29.7.1998 / 11:22:01 / cg"
    83 !
    84 
    85 generateAspectsAsInstanceVariables:aBoolean
    86     "if on, aspects are held as instance variables;
    87      if off (the default), they are kept in the bindings dictionary."
    88 
    89     AspectsAsInstances := aBoolean
    90 
    91     "Created: / 29.7.1998 / 11:21:26 / cg"
    92     "Modified: / 29.7.1998 / 11:22:11 / cg"
    93 !
    94 
    95 generateCommentedCode
    96     "comments in generated aspect methods; yes or no."
    97 
    98     ^ UserPreferences current generateComments
    99     and:[ UserPreferences current generateCommentsForAspectMethods ]
   100 !
   101 
   102 generateCommentedCode:aBoolean
   103     "comments in generated aspect methods; yes or no."
   104 
   105     UserPreferences current generateComments ifFalse:[
   106         aBoolean ifTrue:[
   107             UserPreferences current generateComments:true
   108         ].
   109     ].
   110 
   111     UserPreferences current 
   112         generateCommentsForAspectMethods:aBoolean.
   113 !
   114 
   115 redefineAspectMethods
   116     "redefine methods yes or no. 
   117      If a method is defined in super class should the message be reinstalled ?"
   118 
   119     ^ RedefineAspectMethods
   120 
   121     "Modified: / 22.9.1999 / 12:33:03 / stefan"
   122 !
   123 
   124 redefineAspectMethods:aBoolean
   125     "redefine methods yes or no.
   126      If a method is defined in super class should the message be reinstalled ?"
   127 
   128     RedefineAspectMethods := aBoolean
   129 ! !
   130 
   131 !UIPainterView class methodsFor:'defaults'!
   132 
   133 defaultMenuMessage
   134     "This message is the default yo be sent to the menuHolder to get a menu
   135     "
   136     ^ #showMiddleButtonMenu
   137 
   138 
   139 ! !
   140 
   141 !UIPainterView methodsFor:'accessing'!
   142 
   143 application
   144     ^ nil
   145 
   146     "Modified: 6.9.1995 / 00:46:44 / claus"
   147 !
   148 
   149 applicationName
   150     ^ self className
   151 !
   152 
   153 applicationName:aName
   154     self className:aName
   155 !
   156 
   157 class:aClass superclassName:aSuperclassName selector:aSelector
   158     self assert:(aClass isBehavior).
   159     className      := aClass name.
   160     superclassName := aSuperclassName.
   161     methodName     := aSelector.
   162 !
   163 
   164 className
   165     ^ className
   166 !
   167 
   168 className:aName
   169     self assert:(aName isString).
   170     className := aName
   171 !
   172 
   173 className:aClassName superclassName:aSuperclassName selector:aSelector
   174     self assert:(aClassName isString).
   175     className      := aClassName.
   176     superclassName := aSuperclassName.
   177     methodName     := aSelector.
   178 !
   179 
   180 listOfAspectsHolder:something
   181     listOfAspectsHolder := something.
   182 !
   183 
   184 methodName
   185     ^ methodName
   186 !
   187 
   188 methodName:aName
   189     methodName := aName
   190 !
   191 
   192 selectNames:aStringOrCollection
   193     |prop coll s n newSel|
   194 
   195     (aStringOrCollection size == 0) ifTrue:[
   196 	newSel := nil.
   197     ] ifFalse:[
   198 	(s := aStringOrCollection) isString ifFalse:[
   199 	    s size == 1 ifTrue:[
   200 		s := s first
   201 	    ] ifFalse:[
   202 		coll := OrderedCollection new.
   203 
   204 		s do:[:aName|
   205 		    (prop := self propertyOfName:aName) notNil ifTrue:[
   206 			coll add:(prop view)
   207 		    ]
   208 		].
   209 		(n := coll size) == 1 ifTrue:[
   210 		    newSel := coll at:1
   211 		] ifFalse:[
   212 		    n == 0 ifTrue:[
   213 			newSel := nil
   214 		    ] ifFalse:[
   215 			newSel := coll
   216 		    ]
   217 		].
   218 		^ self select:newSel.
   219 	    ]
   220 	].
   221 
   222 	prop := self propertyOfName:s.
   223 	prop isNil ifTrue:[
   224 	    newSel := nil
   225 	] ifFalse:[
   226 	    newSel := prop view
   227 	].
   228     ].
   229 
   230     ^ self select:newSel
   231 ! !
   232 
   233 !UIPainterView methodsFor:'change & update'!
   234 
   235 layoutChanged
   236     treeView notNil ifTrue:[
   237 	treeView layoutChanged
   238     ]
   239 ! !
   240 
   241 !UIPainterView methodsFor:'copy & cut & paste'!
   242 
   243 changeSelectionAfterPasteOf:sel
   244     sel notNil ifTrue:[
   245         self select:sel.
   246     ].
   247 !
   248 
   249 commonContainerOf:someComponents
   250     |container|
   251 
   252     container := someComponents first container.
   253     [container notNil
   254      and:[ (someComponents conform:[:eachComponent | eachComponent isComponentOf:container]) not]]
   255 	whileTrue:[
   256 	container := container container.
   257     ].
   258     ^ container
   259 !
   260 
   261 copySelection
   262     "copy the selection into the cut & paste-buffer"
   263 
   264     |specs coll|
   265 
   266     coll := self minClosedViewSetFor:(self selection).
   267 
   268     coll notNil ifTrue:[
   269 "/        self select:nil.
   270         specs := coll collect:[:eachView | self fullSpecWithAbsolutePositionFor:eachView].
   271         self setClipboardObject:specs.
   272 "/        treeView selection: sel
   273     ].
   274 !
   275 
   276 deleteSelection
   277     "delete the selection buffered"
   278 
   279     self deleteSelectionBuffered: true
   280 !
   281 
   282 deleteSelectionBuffered:buffered
   283     "cut the selection. If buffered is true, place it into the cut&paste-buffer"
   284 
   285     |specs viewsToRemove newSelection firstView|
   286 
   287     treeView askForSelectionChangeAllowed ifFalse:[^ self].
   288 
   289     viewsToRemove := self minClosedViewSetFor:(self selection).
   290     viewsToRemove isEmptyOrNil ifTrue:[ ^ self].
   291 
   292     buffered ifTrue:[
   293         specs := viewsToRemove collect:[:aView| self fullSpecWithAbsolutePositionFor:aView ].
   294         self setClipboardObject:specs
   295     ].
   296     firstView    := viewsToRemove first.
   297     newSelection := self findContainerOfView:firstView.
   298 
   299     newSelection isNil ifTrue:[
   300         newSelection := self.
   301     ] ifFalse:[
   302         viewsToRemove size == 1 ifTrue:[
   303             |subviews index|
   304 
   305             "/ newSelection components notEmptyOrNil ifTrue:[ self halt ].
   306             subviews := newSelection subViews.
   307 
   308             subviews size > 1 ifTrue:[
   309                 index := subviews findFirst:[:eachView| eachView isSameOrComponentOf:firstView ].
   310                 index > 0 ifTrue:[
   311                     newSelection := subviews
   312                             at:(index + 1)
   313                             ifAbsent:[subviews at:index -1].
   314                 ].
   315             ].
   316         ].
   317     ].
   318 
   319     self withSelectionHiddenDo:[
   320         self select:newSelection.
   321 
   322         treeView canvasEventsDisabledDo:[
   323             self withinTransaction:#cut objects:viewsToRemove do:[
   324                 viewsToRemove reverseDo:[:aView|
   325                     self createUndoRemove:aView.
   326                     self remove:aView.
   327                 ]
   328             ].
   329         ].
   330         self windowGroup processRealExposeEvents.
   331     ].
   332 !
   333 
   334 deleteTotalSelection
   335     "delete the selection"
   336 
   337     self deleteSelectionBuffered: false
   338 !
   339 
   340 getSelectedViewsAndSpecs
   341     "return an array filed with selected views and corresponding specs.
   342      Nil if there is none."
   343 
   344     |specs coll sel|
   345 
   346     sel := treeView selection.
   347 
   348     coll := self minClosedViewSetFor:(self selection).
   349 
   350     coll isNil ifTrue:[^ nil].
   351 
   352     specs := coll collect:[:aView| self fullSpecFor:aView ].
   353     ^ Array with: coll with: specs
   354 !
   355 
   356 pasteBuffer
   357     "add the objects in the paste-buffer to the object view; 
   358      don't change the layout if more than a single item has been selected"
   359 
   360     |sel clipboard|
   361 
   362     self enabled ifFalse:[
   363         Dialog warn:'Operation currently disabled (In geometry test mode)'.
   364         ^ self
   365     ]. 
   366 
   367     clipboard := self getClipboardObject.
   368     clipboard isString ifTrue:[
   369         Dialog warn:'can only paste widgets here'.
   370     ] ifFalse:[
   371         sel := self pasteSpecifications:clipboard keepLayout:true "(clipboard size > 1)".
   372         self changeSelectionAfterPasteOf:sel.
   373     ].
   374 !
   375 
   376 pasteKeepingPosition
   377     "add the objects in the paste-buffer to the object view;
   378      translate the layout as appropriate, to position the component
   379      at the same absolute position (relative to topView) as before"
   380 
   381     |sel|
   382 
   383     sel := self
   384         pasteSpecifications:(self getClipboardObject)
   385         keepLayout:true
   386         keepPosition:true
   387         at:#keep.
   388 
   389     self changeSelectionAfterPasteOf:sel.
   390 !
   391 
   392 pasteSpecifications:aSpecificationOrList into:aContainerOrNil beforeIndex:anIndexOrNil keepLayout:keepLayout keepPosition:keepPosition at:aPointOrNilOrKeep
   393     "add the specs to the object view; 
   394      if given a collection of specs, returns a list of pasted widgets;
   395      if given a single spec, returns that view (sigh - a stupid bw-compatibility kludge)"
   396 
   397     |sensor specsToPaste pasteOffset builder newSel 
   398      bounds containerToPasteInto pastePoint beforeIndex count|
   399 
   400     treeView askForSelectionChangeAllowed ifFalse:[^ nil].
   401 
   402     sensor := self window sensor.
   403 
   404     containerToPasteInto := aContainerOrNil.
   405 
   406     (aPointOrNilOrKeep == #keep
   407     or:[ sensor shiftDown
   408     or:[ sensor ctrlDown ]]) ifTrue:[
   409         "/ paste into the selection
   410         containerToPasteInto isNil ifTrue:[
   411             containerToPasteInto := self singleSelection.
   412         ].
   413     ] ifFalse:[
   414         "/ ignore the selection and paste where we drop!!
   415         pastePoint := aPointOrNilOrKeep.
   416         pastePoint isNil ifTrue:[
   417             pastePoint := device 
   418                                 translatePoint:(sensor mousePoint)
   419                                 fromView:nil
   420                                 toView:self.
   421         ].
   422         containerToPasteInto isNil ifTrue:[
   423             containerToPasteInto := self findObjectAt:pastePoint.
   424         ].
   425     ].
   426 
   427     containerToPasteInto isNil ifTrue:[
   428         self selection size > 0 ifTrue:[
   429             containerToPasteInto := self commonContainerOf:self selection
   430         ] ifFalse:[
   431             containerToPasteInto := self
   432         ].
   433 "/        self selection:containerToPasteInto.
   434     ].
   435 
   436     "/ search up parent list for something we can paste into
   437     [containerToPasteInto notNil and:[(self canPasteInto:containerToPasteInto) not]] whileTrue:[
   438         containerToPasteInto == self ifTrue:[
   439             containerToPasteInto := nil
   440         ] ifFalse:[
   441             containerToPasteInto := containerToPasteInto container.
   442         ].
   443     ].
   444     containerToPasteInto isNil ifTrue:[
   445         containerToPasteInto := self
   446     ].
   447 
   448     (self canPaste:aSpecificationOrList into:containerToPasteInto)
   449     ifFalse:[
   450         self enabled ifTrue:[
   451             Dialog warn:'Cannot paste into selected component (not a container ?)'.
   452         ] ifFalse:[
   453             Dialog warn:'Operation currently disabled (In geometry test mode)'.
   454         ]. 
   455         ^ nil
   456     ].
   457 
   458     self hideSelection.
   459 
   460     aSpecificationOrList isCollection ifTrue:[
   461         specsToPaste := aSpecificationOrList
   462     ] ifFalse:[
   463         specsToPaste := Array with:aSpecificationOrList
   464     ].
   465 "/    self setClipboardObject:nil.
   466 
   467     newSel  := OrderedCollection new.
   468     builder := UIBuilder new isEditing:true.
   469 
   470     className notNil ifTrue:[
   471         builder applicationClass:(self resolveName:className)
   472     ].
   473     bounds := Rectangle origin:0@0 extent:(containerToPasteInto bounds extent).
   474 
   475     pasteOffset := 0.
   476 
   477     (anIndexOrNil notNil and:[anIndexOrNil > 0]) ifTrue:[
   478         beforeIndex := anIndexOrNil.
   479     ].
   480     specsToPaste do:[:eachSpec|
   481         |view newOrigin uiPainterAttributes thisAbsOrigin|
   482 
   483         uiPainterAttributes := eachSpec otherAttributeAt:#uiPainterAttributes.
   484         eachSpec otherAttributeAt:#uiPainterAttributes put:nil.
   485 
   486         view := self addSpec:eachSpec builder:builder in:containerToPasteInto beforeIndex:beforeIndex.
   487         beforeIndex notNil ifTrue:[
   488             beforeIndex := beforeIndex + 1
   489         ].
   490 
   491         containerToPasteInto isLayoutWrapper ifTrue:[
   492             eachSpec layout:(#extent->view extent)
   493         ].
   494         
   495         (keepLayout or:[eachSpec keepUILayout]) ifTrue:[
   496             eachSpec layout isAssociation ifTrue:[
   497                 eachSpec layout key == #extent ifTrue:[
   498                     view pixelExtent:eachSpec layout value
   499                 ] ifFalse:[
   500                     "/ self halt.
   501                     view geometryLayout:eachSpec layout value
   502                 ].
   503             ] ifFalse:[    
   504                 view geometryLayout:eachSpec layout.
   505             ]
   506         ] ifFalse:[
   507             (keepPosition and:[ uiPainterAttributes notNil ]) ifTrue:[
   508                 aPointOrNilOrKeep == #keep ifTrue:[
   509                     newOrigin := uiPainterAttributes at:#origin.
   510                 ] ifFalse:[
   511                     thisAbsOrigin := uiPainterAttributes at:#absOrigin.
   512 
   513                     newOrigin := device 
   514                                         translatePoint:thisAbsOrigin
   515                                         fromView:self
   516                                         toView:containerToPasteInto.
   517                 ].
   518             ] ifFalse:[
   519                 pastePoint isNil ifTrue:[ pastePoint := 0@0 ].
   520                 newOrigin := device 
   521                                     translatePoint:pastePoint asPoint
   522                                     fromView:self
   523                                     toView:containerToPasteInto.
   524             ].
   525 
   526             (bounds containsPoint:newOrigin) ifFalse:[
   527                 newOrigin := pasteOffset asPoint.
   528                 pasteOffset := pasteOffset + 4.
   529             ].
   530             newOrigin notNil ifTrue:[
   531                 self moveObject:view to:newOrigin.
   532             ].
   533         ].
   534         view realized ifFalse:[
   535             view realize.
   536         ].
   537         newSel add:view.
   538     ].
   539 
   540     self 
   541         withinTransaction:#paste 
   542         objects:newSel 
   543         do:[
   544             undoHistory 
   545                 addUndoSelector:#undoCreate:
   546                 withArgs:(newSel collect:[:v| (self propertyOfView:v) identifier]).
   547             self undoHistoryChanged.
   548         ].
   549 
   550     self realizeAllSubViews.
   551     "/ newSel do:[:v| v raise].
   552     self elementChangedSize:containerToPasteInto.
   553 
   554     "/ nil wg if embedded in a browser
   555     self windowGroup notNil ifTrue:[
   556         "/ because the new-created view will destroy the handles, when it redraws itself,
   557         "/ give it a chance to do so, before we return. (bail out after half a second, in case of trouble)
   558         count := 0.
   559         [ (newSel conform:[:v | v shown]) or:[count > 50] ] whileFalse:[
   560             self windowGroup repairDamage.
   561             Delay waitForSeconds:0.01.
   562             count := count+1.
   563         ].
   564         Delay waitForSeconds:0.01.
   565         self windowGroup repairDamage.
   566     ].
   567 
   568     newSel size == 1 ifTrue:[newSel := newSel at:1].
   569     ^ newSel
   570 
   571     "Modified: / 16-11-2017 / 23:49:56 / cg"
   572     "Modified: / 18-07-2018 / 09:15:44 / Claus Gittinger"
   573 !
   574 
   575 pasteSpecifications:aSpecificationOrList into:aContainerOrNil keepLayout:keepLayout keepPosition:keepPosition at:aPointOrNilOrKeep 
   576     "add the specs to the object view; returns list of pasted widgets"
   577     
   578     ^ self 
   579         pasteSpecifications:aSpecificationOrList
   580         into:aContainerOrNil
   581         beforeIndex:nil
   582         keepLayout:keepLayout
   583         keepPosition:keepPosition
   584         at:aPointOrNilOrKeep
   585 !
   586 
   587 pasteSpecifications:aSpecificationOrList keepLayout:keepLayout
   588     "add the specs to the object view; returns list of pasted widgets"
   589 
   590     ^ self
   591         pasteSpecifications:aSpecificationOrList
   592         keepLayout:keepLayout
   593         keepPosition:true
   594         at:#keep "/ nil
   595 
   596     "Modified: 11.8.1997 / 01:00:35 / cg"
   597 !
   598 
   599 pasteSpecifications:aSpecificationOrList keepLayout:keepLayout at:aPointOrNil
   600     "add the specs to the object view; returns list of pasted widgets"
   601 
   602     ^ self
   603         pasteSpecifications:aSpecificationOrList
   604         keepLayout:keepLayout
   605         keepPosition:true
   606         at:aPointOrNil
   607 !
   608 
   609 pasteSpecifications:aSpecificationOrList keepLayout:keepLayout keepPosition:keepPosition at:aPointOrNilOrKeep
   610     "add the specs to the object view; returns list of pasted widgets"
   611 
   612     ^ self pasteSpecifications:aSpecificationOrList
   613         into:nil
   614         beforeIndex:nil
   615         keepLayout:keepLayout
   616         keepPosition:keepPosition
   617         at:aPointOrNilOrKeep
   618 !
   619 
   620 pasteWithLayout
   621     "add the objects in the paste-buffer to the object view - keep the old layout"
   622 
   623     |sel|
   624 
   625     sel := self 
   626             pasteSpecifications:(self getClipboardObject)
   627             keepLayout:true
   628             keepPosition:true
   629             at:#keep.
   630     self changeSelectionAfterPasteOf:sel.
   631 !
   632 
   633 pasteWithoutLayout
   634     "add the objects in the paste-buffer to the object view - do not keep the old layout"
   635 
   636     |sel|
   637 
   638     sel := self 
   639             pasteSpecifications:(self getClipboardObject)
   640             keepLayout:false
   641             keepPosition:true
   642             at:#keep.
   643     self changeSelectionAfterPasteOf:sel.
   644 !
   645 
   646 replaceSelectionBy:aNewSpec
   647     "replace the selected widget by another one."
   648 
   649     |oldSelection treeModel newView oldView container specs index|
   650 
   651     (self singleSelection notNil and:[treeView askForSelectionChangeAllowed]) ifFalse:[
   652         ^ self
   653     ].
   654     
   655     treeModel    := treeView model.
   656     oldSelection := treeModel selectedNodes at:1 ifAbsent: nil.
   657     oldSelection isNil ifTrue:[^ self].
   658 
   659     oldView := oldSelection contents view.
   660 
   661     (oldSelection hasChildren and:[aNewSpec class supportsSubComponents]) ifTrue:[
   662         specs := 
   663             oldSelection children collect:[:each|
   664                 self fullSpecWithAbsolutePositionFor:(each contents view)
   665             ].
   666     ].
   667 
   668     aNewSpec
   669         otherAttributeAt:#uiPainterAttributes 
   670         put:(Dictionary new
   671                 at:#origin put:oldView origin;
   672                 at:#extent put:oldView extent;
   673                 at:#absOrigin put:(oldView originRelativeTo:self);
   674                 yourself).
   675 
   676     index := oldSelection parent children identityIndexOf:oldSelection.
   677     container := self singleSelection container.
   678     
   679     self withinTransaction:#replaceBy objects:(Array with:oldView) do:[
   680         self withSelectionHiddenDo:[
   681             newView := self 
   682                     pasteSpecifications:(Array with:aNewSpec)
   683                     into:container
   684                     beforeIndex:index
   685                     keepLayout:true
   686                     keepPosition:true
   687                     at:#keep.
   688 
   689             self deleteSelectionBuffered:false.
   690 
   691             specs size > 0 ifTrue:[
   692                 self pasteSpecifications:specs 
   693                             into:newView
   694                             keepLayout:(aNewSpec class canResizeSubComponents)
   695                             keepPosition:(aNewSpec class isLayoutContainer not)
   696                             at:index.
   697             ].
   698             self select:newView.
   699        ].
   700     ].
   701     ^ newView.
   702 ! !
   703 
   704 !UIPainterView methodsFor:'drag & drop'!
   705 
   706 canDrop:aDropContext
   707     ^ self canDropObjects:aDropContext dropObjects
   708 
   709     "Created: / 13-10-2006 / 17:46:11 / cg"
   710 !
   711 
   712 canDropObjects:aCollectionOfDropObjects
   713     "returns true if something can be dropped"
   714 
   715     ^ (true "aCollectionOfDropObjects size == 1" 
   716     and:[ self enabled 
   717     and:[ true "self numberOfSelections <= 1"
   718     and:[ aCollectionOfDropObjects conform:[:each| each theObject isKindOf:UISpecification]
   719               ]]])
   720 
   721     "Created: / 13-10-2006 / 16:09:24 / cg"
   722 !
   723 
   724 canPaste
   725     "returns true if there is something which can be pasted in the clipboard"
   726 
   727     ^ self canPaste:(self getClipboardObject)
   728 !
   729 
   730 canPaste:something
   731     "returns true if something could be pasted"
   732 
   733     ^ self canPaste:something into:(self singleSelection)
   734 !
   735 
   736 canPaste:something into:containerToPasteInto
   737     "returns true if something could be pasted"
   738 
   739     (self enabled) ifFalse:[
   740         ^ false
   741     ].
   742     something isCollection ifTrue:[
   743         something isEmpty ifTrue:[ ^ false].
   744         ^ something conform:[:el | (self canPaste:el into:containerToPasteInto)]
   745     ].
   746 
   747     (something isKindOf:UISpecification) ifFalse:[
   748         ^ false
   749     ].
   750 
   751     ^ self canPasteInto:containerToPasteInto
   752 !
   753 
   754 canPasteInto:aView
   755     "return true, if I can paste into a view"
   756 
   757     |prop|
   758 
   759     aView isNil ifTrue:[ ^ false ].
   760     aView == self ifTrue:[ ^ true ].
   761 
   762     (prop := self propertyOfView:aView) notNil ifTrue:[
   763         ^ prop spec class supportsSubComponents
   764     ].
   765     ^ aView specClass supportsSubComponents.
   766 !
   767 
   768 dropObjects:aCollectionOfDropObjects at:aPoint
   769     |spec newSel oldSel dragOffset dropPoint widg|
   770 
   771     self selection notNil ifTrue:[
   772         oldSel := self singleSelection.
   773 
   774         "/ search selections hierarchy for a widget into which we can paste
   775         widg := oldSel.
   776         [widg isNil or:[self canPasteInto:widg]] whileFalse:[
   777             widg notNil ifTrue:[
   778                 widg := widg container
   779             ].
   780         ].
   781 
   782         oldSel := nil.
   783         self setSelection:widg withRedraw:true.
   784     ].
   785     spec := (aCollectionOfDropObjects at:1) theObject.
   786 
   787     dragOffset := DragAndDropManager dragOffsetQuerySignal query.
   788     aPoint isNil ifTrue:[
   789         dropPoint := #keep.
   790     ] ifFalse:[
   791         dropPoint := aPoint - dragOffset.
   792     ].
   793     newSel := self pasteSpecifications:spec keepLayout:false keepPosition:false at:dropPoint.
   794 
   795     self select:(oldSel ? newSel).
   796 
   797     "Modified: / 18-03-1999 / 18:29:43 / stefan"
   798     "Created: / 13-10-2006 / 16:09:27 / cg"
   799 ! !
   800 
   801 !UIPainterView methodsFor:'drawing'!
   802 
   803 clearRectangle:visRect
   804     super clearRectangle:visRect.
   805     sketchPainter notNil ifTrue:[
   806         sketchPainter redrawInTargetView
   807     ].
   808 
   809     "Created: / 16-01-2008 / 17:52:27 / cg"
   810 !
   811 
   812 clearView
   813     super clearView.
   814     sketchPainter notNil ifTrue:[
   815         sketchPainter redrawInTargetView
   816     ].
   817 
   818     "Created: / 16-01-2008 / 17:46:08 / cg"
   819 !
   820 
   821 useSketchFile:aFilename 
   822     "a little neat goody: allow for a tablet-sketch file (WALTROP digital notepad)
   823      to be used as a background of the UIPainter window. This allows for sketches to
   824      be drawn, shown in the UIPainter, and then used as a placement hint (manual placement)
   825      for the user. Not a high-tech solution, but helped a lot, when we protoyped GUIs."
   826 
   827     |mime sketchPainterClass|
   828 
   829     mime := aFilename asFilename mimeTypeFromName.
   830     mime isNil ifTrue:[
   831         mime := aFilename asFilename mimeTypeOfContents.
   832     ].
   833 
   834     mime notNil ifTrue:[
   835         (mime startsWith:'image') ifTrue:[
   836             self viewBackground:(ImageReader fromFile:aFilename).
   837             ^ self.
   838         ].
   839         mime = 'application/x-waltop-digital-notepad' ifTrue:[
   840             sketchPainterClass := TOPFileDrawer.
   841         ].
   842     ].
   843     sketchPainterClass isNil ifTrue:[
   844         self error:'Unsupported sketch file format'
   845     ].
   846 
   847     sketchPainter := sketchPainterClass new.
   848     sketchPainter targetView:self.
   849     sketchPainter readFile:aFilename.
   850     sketchPainter ajustSketch.
   851     self invalidate.
   852 
   853     "Created: / 16-01-2008 / 17:46:26 / cg"
   854 ! !
   855 
   856 !UIPainterView methodsFor:'event handling'!
   857 
   858 keyPress:key x:x y:y view:aView
   859     "a delegated keyEvent from aView"
   860 
   861     self keyPress:key x:x y:y
   862 
   863     "Modified: / 31.10.1997 / 20:27:22 / cg"
   864 !
   865 
   866 keyRelease:key x:x y:y view:aView
   867     "a delegated keyEvent from aView"
   868 
   869     self keyRelease:key x:x y:y
   870 
   871     "Modified: / 31.10.1997 / 20:27:32 / cg"
   872 !
   873 
   874 sizeChanged:how
   875 
   876     super sizeChanged:how.
   877 
   878     self layoutChanged
   879 ! !
   880 
   881 !UIPainterView methodsFor:'generating output'!
   882 
   883 aspectMethods
   884     "extract a list of aspect methods - for browsing"
   885 
   886     |cls methods|
   887 
   888     className isNil ifTrue:[
   889 	self warn:'No class defined !!'.
   890 	^ #()
   891     ].
   892 
   893     cls := self resolveName:className.
   894     methods := IdentitySet new.
   895 
   896     self aspectSelectorsAndTypesDo:
   897 	[:selector :typeSymbol |
   898 	    |skip|
   899 
   900 	    (cls includesSelector:selector) ifTrue:[
   901 
   902 		skip := false.
   903 		(typeSymbol == #modelAspect) ifTrue:[
   904 		    (cls isSubclassOf:SimpleDialog) ifTrue:[
   905 			skip := SimpleDialog includesSelector:(selector asSymbol)
   906 		    ].
   907 		].
   908 		skip ifFalse:[
   909 		    methods add:(cls compiledMethodAt:selector)
   910 		].
   911 	    ]
   912 	].
   913 
   914     ^ methods
   915 
   916     "Created: / 25.10.1997 / 18:58:25 / cg"
   917     "Modified: / 26.10.1997 / 15:06:18 / cg"
   918 !
   919 
   920 aspectSelectorsAndTypesDo:aTwoArgBlock
   921     "evaluate aBlock for every aspect methods selector; 2nd arg describes the aspects type"
   922 
   923     |cls selector protoSpec|
   924 
   925     className isNil ifTrue:[
   926         self warn:'No class defined !!'.
   927         ^ self
   928     ].
   929 
   930     cls := self resolveName:className.
   931 
   932     treeView propertiesDo:[:aProp|
   933         |selector|
   934 
   935         (selector := aProp model) notNil ifTrue:[
   936             selector isArray ifFalse:[
   937                 aTwoArgBlock value:(selector asSymbol) value:#modelAspect
   938             ].
   939         ].
   940 
   941         (selector := aProp menu) notNil ifTrue:[
   942             selector isArray ifFalse:[
   943                 aTwoArgBlock value:(selector asSymbol) value:#menu
   944             ].
   945         ].
   946 
   947         (aProp spec aspectSelectors) do:[:aSel |
   948             (aSel isString or:[aSel isSymbol]) ifTrue:[
   949                 aTwoArgBlock value:(aSel asSymbol) value:#channelAspect
   950             ].
   951         ].
   952         aProp spec actionSelectors do:[:aSel|
   953             (aSel isString or:[aSel isSymbol]) ifTrue:[
   954                 aTwoArgBlock value:(aSel asSymbol) value:#actionSelector
   955             ].
   956         ].
   957         aProp spec valueSelectors do:[:aSel|
   958             (aSel isString or:[aSel isSymbol]) ifTrue:[
   959                 aTwoArgBlock value:(aSel asSymbol) value:#valueSelector
   960             ].
   961         ]
   962     ].
   963 
   964     protoSpec := treeView canvasSpec.
   965 
   966     (selector := protoSpec menu) notNil ifTrue:[
   967         selector isArray ifFalse:[
   968             aTwoArgBlock value:(selector asSymbol) value:#menu
   969         ].
   970     ].
   971 !
   972 
   973 generateActionMethodFor:aspect spec:protoSpec inClass:targetClass
   974     |selector args showIt codeStream alreadyInSuperclass numArgs method|
   975 
   976     selector := aspect asSymbol.
   977 
   978     alreadyInSuperclass := targetClass superclass canUnderstand:selector.
   979 
   980     numArgs := selector numArgs.
   981     method  := aspect.
   982 
   983     numArgs == 1 ifTrue:[
   984         args := 'anArgument'.
   985         showIt := ''' , anArgument printString , ''...''.'.
   986     ] ifFalse:[
   987         args := ''.
   988         showIt := ' ...''.'.
   989 
   990         numArgs ~~ 0 ifTrue:[
   991             method := ''.
   992 
   993             selector keywords keysAndValuesDo:[:i :key|
   994                 method := method, key, 'arg', i printString, ' '
   995             ]
   996         ]
   997     ].
   998     codeStream := WriteStream on:(String new:100).
   999     codeStream  
  1000         nextPutLine:('!!',targetClass name,' methodsFor:''actions''!!');
  1001         nextPutLine:(method,args);
  1002         nextPutLine:'    <resource: #uiCallback>';
  1003         cr.
  1004 
  1005     self class generateCommentedCode ifTrue:[
  1006         codeStream
  1007             nextPutAll:'    "automatically generated by UIPainter..."
  1008 
  1009     "*** the code below performs no action"
  1010     "*** (except for some feedback on the Transcript)"
  1011     "*** Please change as required and accept in the browser."
  1012     "*** (and replace this comment by something more useful ;-)"
  1013 
  1014 '.
  1015 
  1016         alreadyInSuperclass ifTrue:[
  1017             codeStream  
  1018                 nextPutLine:'    "action for ' , aspect , ' is already provided in a superclass."';
  1019                 nextPutLine:'    "It may be redefined here..."';
  1020                 cr.
  1021         ] ifFalse:[
  1022             codeStream  
  1023                 nextPutLine:'    "action to be defined here..."';
  1024                 cr.
  1025         ].
  1026     ].
  1027 
  1028     codeStream  
  1029         nextPutAll:'    Logger info:'''.
  1030 
  1031     alreadyInSuperclass ifTrue:[
  1032         codeStream  
  1033             nextPutAll:'inherited '.
  1034     ].
  1035     codeStream  
  1036         nextPutAll:'action for ';
  1037         nextPutAll:aspect;
  1038         nextPutLine:showIt.
  1039 
  1040     alreadyInSuperclass ifTrue:[
  1041         codeStream  
  1042             nextPutAll:'    super ';
  1043             nextPutAll:aspect;
  1044             nextPutAll:args;
  1045             nextPutLine:'.'.
  1046     ].
  1047 
  1048     codeStream  
  1049         nextPutLine:'!! !!'; cr.
  1050 
  1051     ^ codeStream contents.
  1052 
  1053     "Modified: / 12-01-2008 / 10:21:52 / cg"
  1054 !
  1055 
  1056 generateAspectMethodCode
  1057     "generate aspect, action & menu methods
  1058      - but do not overwrite existing ones.
  1059      Return a string ready to compile into the application class.
  1060      TODO: refactor and move to CodeGenerator"
  1061 
  1062     ^ self generateAspectMethodCodeFiltering:nil
  1063 !
  1064 
  1065 generateAspectMethodCodeFiltering:aFilterOrEmpty
  1066     "generate aspect, action & menu methods
  1067      - but do not overwrite existing ones.
  1068      Return a string ready to compile into the application class.
  1069      TODO: refactor and move to CodeGenerator"
  1070 
  1071     |cls codePieces skip protoSpec thisCode
  1072      definedMethodSelectors iVars t exportSels|
  1073 
  1074     cls := self targetClass.
  1075     cls isNil ifTrue:[
  1076         ^ nil
  1077     ].
  1078 
  1079     codePieces := OrderedCollection new.
  1080     definedMethodSelectors := IdentitySet new.
  1081 
  1082     treeView propertiesDo:[:aProp|
  1083         |modelSelector|
  1084 
  1085         protoSpec := aProp spec.
  1086 
  1087         (modelSelector := aProp model) notNil ifTrue:[
  1088             self generateCodeFrom:(Array with:modelSelector) in:cls
  1089                 do:[:aSel|
  1090                     (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
  1091                         skip := false.
  1092 
  1093                         (cls isSubclassOf:SimpleDialog) ifTrue:[
  1094                             skip := SimpleDialog includesSelector:aSel
  1095                         ].
  1096                         (definedMethodSelectors includes:aSel) ifTrue:[
  1097                             skip := true.
  1098                         ].
  1099 
  1100                         skip ifFalse:[
  1101                             "/ kludge ..
  1102                             "/ (protoSpec isKindOf:ActionButtonSpec)
  1103                             (protoSpec defaultModelIsCallBackMethodSelector:aSel)
  1104                             ifTrue:[
  1105                                 thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls).
  1106                             ] ifFalse:[
  1107                                 thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls).
  1108                             ].
  1109                             codePieces add:thisCode.
  1110                             definedMethodSelectors add:aSel.
  1111                             Transcript showCR:'code generated for aspect: ' , aSel
  1112                         ] ifTrue:[
  1113                             Transcript showCR:'*** no code generated for aspect: ' , aSel , ' (method already exists)'
  1114                         ].
  1115                     ].
  1116                 ].
  1117         ].
  1118 
  1119         "/ for each aspect, generate getter (if not yet implemented)
  1120         self generateCodeFrom:(aProp spec aspectSelectors) in:cls
  1121                 do:[:aSel|
  1122                     (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
  1123                         (definedMethodSelectors includes:aSel) ifFalse:[
  1124                             thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls).
  1125                             codePieces add:thisCode.
  1126                             definedMethodSelectors add:aSel.
  1127                             Transcript showCR:'code generated for aspect: ' , aSel
  1128                         ]
  1129                     ]
  1130                 ].
  1131 
  1132         "/ exported aspects - need setter methods
  1133         exportSels := (treeView exportedAspects ? #()) collect:[:entry | (entry subAspect) asMutator].
  1134         self generateCodeFrom:exportSels in:cls
  1135                 do:[:aSel|
  1136                     |aspect|
  1137 
  1138                     (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
  1139                         (definedMethodSelectors includes:aSel) ifFalse:[
  1140                             aspect := (aSel copyButLast) asSymbol.
  1141                             thisCode := (self generateAspectSetMethodFor:aspect spec:protoSpec inClass:cls).
  1142                             codePieces add:thisCode.
  1143                             definedMethodSelectors add:aSel.
  1144                             Transcript showCR:'export code generated for aspect: ' , aSel
  1145                         ]
  1146                     ]
  1147                 ].
  1148 
  1149         self generateCodeFrom:(aProp spec actionSelectors) in:cls
  1150                 do:[:aSel|
  1151                     (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
  1152                         (definedMethodSelectors includes:aSel) ifFalse:[
  1153                             thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls).
  1154                             codePieces add:thisCode.
  1155                             definedMethodSelectors add:aSel.
  1156                             Transcript showCR:'action generated for aspect: ' , aSel
  1157                         ]
  1158                     ]
  1159                 ].
  1160 
  1161         self generateCodeFrom:(aProp spec valueSelectors) in:cls
  1162                 do:[:aSel|
  1163                     (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
  1164                         (definedMethodSelectors includes:aSel) ifFalse:[
  1165                             "/ uppercase: - assume its a globals name.
  1166                             aSel isUppercaseFirst ifFalse:[
  1167                                 thisCode := (self generateValueMethodFor:aSel spec:protoSpec inClass:cls).
  1168                                 codePieces add:thisCode.
  1169                                 definedMethodSelectors add:aSel.
  1170                                 Transcript showCR:'code generated for aspect: ' , aSel
  1171                             ]
  1172                         ]
  1173                     ]
  1174                 ].
  1175     ].
  1176 
  1177     AspectsAsInstances ifTrue:[
  1178         iVars := cls instVarNames asOrderedCollection.
  1179         definedMethodSelectors do:[:ivar |
  1180             (iVars includes:ivar) ifFalse:[
  1181                 iVars add:ivar
  1182             ]
  1183         ].
  1184         iVars := iVars asArray.
  1185         t := cls shallowCopy.
  1186         t setInstanceVariableString:iVars asStringCollection asString.
  1187         codePieces addFirst:(t definition , '!!\' withCRs).
  1188     ].
  1189 
  1190     ^ String
  1191         streamContents:
  1192             [:codeStream |
  1193                 codePieces do:[:eachPiece | codeStream nextPutAll:eachPiece].
  1194             ].
  1195 
  1196     "Modified: / 29.7.1998 / 12:21:19 / cg"
  1197 !
  1198 
  1199 generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass
  1200     |modelClass modelValueString modelValue modelGen codeStream|
  1201 
  1202     modelClass := protoSpec defaultModelClassFor:aspect.
  1203     modelValueString := protoSpec defaultModelValueStringFor:aspect.
  1204     modelValueString notNil ifTrue:[
  1205         modelGen := modelValueString
  1206     ] ifFalse:[
  1207         modelValue := protoSpec defaultModelValueFor:aspect.
  1208         modelValue isNil ifTrue:[
  1209             modelGen := modelClass name , ' new'
  1210         ] ifFalse:[
  1211             modelGen := modelValue storeString , ' asValue'
  1212         ].
  1213 
  1214     ].
  1215 
  1216     codeStream := WriteStream on:(String new:100).
  1217     codeStream  
  1218         nextPutLine:('!!' , targetClass name , ' methodsFor:''aspects''!!');
  1219         nextPutLine:aspect;
  1220         nextPutLine:'    <resource: #uiAspect>';
  1221         cr.
  1222 
  1223     self class generateCommentedCode ifTrue:[
  1224         codeStream  
  1225             nextPutAll:'    "automatically generated by UIPainter ..."
  1226 
  1227     "*** the code below creates a default model when invoked."
  1228     "*** (which may not be the one you wanted)"
  1229     "*** Please change as required and accept it in the browser."
  1230     "*** (and replace this comment by something more useful ;-)"
  1231 
  1232 '.
  1233     ].
  1234 
  1235     AspectsAsInstances ifTrue:[
  1236         codeStream
  1237             nextPutLine:('    ',aspect,' isNil ifTrue:[');
  1238             nextPutLine:('        ',aspect,' := ',modelGen,'.').
  1239 
  1240         modelClass ~~ TriggerValue ifTrue:[
  1241             self class generateCommentedCode ifTrue:[
  1242                 codeStream
  1243                     nextPutLine:'"/ if your app needs to be notified of changes, uncomment one of the lines below:'.
  1244             ].
  1245             codeStream
  1246                 nextPutLine:'"/       ',aspect,' addDependent:self.';
  1247                 nextPutLine:'"/       ',aspect,' onChangeSend:#',aspect,'Changed to:self.'.
  1248         ].
  1249         codeStream
  1250             nextPutLine:'    ].';
  1251             nextPutLine:'    ^ ',aspect,'.'.
  1252     ] ifFalse:[
  1253         codeStream
  1254             nextPutLine:('    |holder|');
  1255             cr;
  1256             nextPutLine:('    (holder := builder bindingAt:#',aspect,') isNil ifTrue:[');
  1257             nextPutLine:('        holder := ',modelGen,'.');
  1258             nextPutLine:('        builder aspectAt:#',aspect,' put:holder.').
  1259 
  1260         modelClass ~~ TriggerValue ifTrue:[
  1261             self class generateCommentedCode ifTrue:[
  1262                 codeStream
  1263                     nextPutLine:'"/ if your app needs to be notified of changes, uncomment one of the lines below:'.
  1264             ].
  1265             codeStream
  1266                 nextPutLine:'"/       holder addDependent:self.';
  1267                 nextPutLine:'"/       holder onChangeSend:#',aspect,'Changed to:self.'.
  1268         ].
  1269         codeStream
  1270             nextPutLine:'    ].';
  1271             nextPutLine:'    ^ holder.'.
  1272     ].
  1273 
  1274     codeStream
  1275         nextPutLine:'!! !!'; cr.
  1276 "/ self halt.
  1277     ^ codeStream contents.
  1278 
  1279     "Modified: / 22-09-1999 / 12:33:47 / stefan"
  1280     "Modified: / 12-01-2008 / 10:21:43 / cg"
  1281 !
  1282 
  1283 generateAspectSelectorsMethod
  1284     "generate aspectSelectors method.
  1285      Return a string ready to compile into the application class."
  1286 
  1287     |cls code spec|
  1288 
  1289     cls := self targetClass.
  1290     cls isNil ifTrue:[
  1291 	^ nil
  1292     ].
  1293 
  1294     spec := treeView exportedAspects.
  1295     spec size == 0 ifTrue:[^ nil].
  1296 
  1297     "/ make it an array ...
  1298     spec := spec collect:[:entry | |subAspect type|
  1299 		subAspect := entry subAspect asSymbol.
  1300 		(type := entry type) isNil ifTrue:[
  1301 		    subAspect
  1302 		] ifFalse:[
  1303 		    Array with:subAspect with:type asSymbol
  1304 		].
  1305 	    ].
  1306     spec := spec asArray.
  1307 
  1308     code := '!!' , cls name , ' class methodsFor:''plugIn spec''!!\\' .
  1309 
  1310     code := code , 'aspectSelectors
  1311     "This resource specification was automatically generated
  1312      by the UIPainter of ST/X."
  1313 
  1314     "Do not manually edit this. If it is corrupted,
  1315      the UIPainter may not be able to read the specification."
  1316 
  1317     "Return a description of exported aspects;
  1318      these can be connected to aspects of an embedding application
  1319      (if this app is embedded in a subCanvas)."
  1320 
  1321     ^ #(\'.
  1322     spec do:[:el | code := code , ('        ' , el storeString , '\') ].
  1323     code := code , '      ).\'.
  1324     code := code , '\!!\'.
  1325     code := code withCRs.
  1326     ^ code
  1327 
  1328     "Modified: / 18.2.2000 / 02:08:34 / cg"
  1329 !
  1330 
  1331 generateAspectSetMethodFor:aspect spec:protoSpec inClass:targetClass
  1332     |code|
  1333 
  1334     code := '!!' , targetClass name , ' methodsFor:''aspects - exported''!!\\' ,
  1335       aspect , ':something\' ,
  1336       '    "automatically generated by UIPainter ..."\\' ,
  1337       '    "This method is used when I am embedded as subApplication,"\' ,
  1338       '    "and the mainApp wants to connect its aspects to mine."\'.
  1339 
  1340     AspectsAsInstances ifTrue:[
  1341 	code := (code , '\' ,
  1342 	  '"/     ' , aspect , ' notNil ifTrue:[\' ,
  1343 	  '"/        ' , aspect , ' removeDependent:self.\' ,
  1344 	  '"/     ].\' ,
  1345 	  '    ' , aspect ,' := something.\' ,
  1346 	  '"/     ' , aspect ,' notNil ifTrue:[\' ,
  1347 	  '"/        ' , aspect , ' addDependent:self.\' ,
  1348 	  '"/     ].\' ,
  1349 	  '    ^ self.\' ,
  1350 	  '!! !!\\')
  1351     ] ifFalse:[
  1352 	code := (code , '\' ,
  1353 	  '"/     |holder|\' ,
  1354 	  '\' ,
  1355 	  '"/     (holder := builder bindingAt:#' , aspect , ') notNil ifTrue:[\' ,
  1356 	  '"/         holder removeDependent:self.\' ,
  1357 	  '"/     ].\' ,
  1358 	  '    builder aspectAt:#' , aspect , ' put:something.\',
  1359 	  '"/     something notNil ifTrue:[\' ,
  1360 	  '"/         something addDependent:self.\' ,
  1361 	  '"/     ].\' ,
  1362 	  '    ^ self.\' ,
  1363 	  '!! !!\\')
  1364     ].
  1365 
  1366     ^ code withCRs
  1367 
  1368     "Modified: / 29.7.1998 / 11:29:16 / cg"
  1369     "Modified: / 22.9.1999 / 12:33:47 / stefan"
  1370 !
  1371 
  1372 generateCodeFrom:aListOfSelectors in:aClass do:aBlock
  1373     |realSelectors redefCondition redefMessage|
  1374 
  1375     realSelectors := aListOfSelectors select:[:sel | sel isString or:[sel isSymbol]].
  1376 
  1377     self class redefineAspectMethods ifTrue:[
  1378         redefCondition := [:cls :sel | (cls includesSelector:sel) not].
  1379         redefMessage := ' skipped - already implemented in the class'.
  1380     ] ifFalse:[
  1381         redefCondition := [:cls :sel | (cls canUnderstand:sel) not].
  1382         redefMessage := ' skipped - already implemented in the class (or superclass)'.
  1383     ].
  1384 
  1385     realSelectors do:[:aSelector|
  1386         (redefCondition value:aClass value:aSelector) ifTrue:[
  1387             aBlock value:aSelector asSymbol
  1388         ] ifFalse:[
  1389             Transcript showCR:('#' , aSelector , redefMessage)
  1390         ]
  1391     ]
  1392 !
  1393 
  1394 generateHookMethodFor:selectorSpec comment:commentWhen note:noteOrNil defaultCode:defaultCode inClass:targetClass
  1395     ^ ('!!' , targetClass name , ' methodsFor:''hooks''!!\\' ,
  1396       selectorSpec , '\' ,
  1397       '    "automatically generated by UIPainter ..."\\' ,
  1398       '    "*** the code here does nothing. It is invoked when"\' ,
  1399       '    "*** ' , commentWhen , '"\' ,
  1400       '    "*** Please change as required and accept in the browser."\' ,
  1401       '\' ,
  1402       '    "specific code to be added below ..."\' ,
  1403       '    "' , (noteOrNil ? '') , '"\' ,
  1404       '\' ,
  1405       (defaultCode ? '^ self.') ,
  1406       '!! !!\\') withCRs
  1407 
  1408     "Modified: / 25.10.1997 / 19:22:17 / cg"
  1409     "Created: / 31.10.1997 / 17:31:53 / cg"
  1410 !
  1411 
  1412 generateHookMethods
  1413     "generate hook methods
  1414      - but do not overwrite existing ones.
  1415      Return a string ready to compile into the application class."
  1416 
  1417     |cls|
  1418 
  1419     cls := self targetClass.
  1420     cls isNil ifTrue:[
  1421 	^ nil
  1422     ].
  1423 
  1424     ^ self generateHookMethodsInClass:cls.
  1425 !
  1426 
  1427 generateHookMethodsInClass:targetClass
  1428     |code|
  1429 
  1430     code := ''.
  1431 
  1432     (targetClass includesSelector:#postBuildWith:) ifFalse:[
  1433 	code := code
  1434 		, (self
  1435 		    generateHookMethodFor:'postBuildWith:aBuilder'
  1436 		    comment:'the widgets have been built, but before the view is opened'
  1437 		    note:'or after the super send'
  1438 		    defaultCode:'    super postBuildWith:aBuilder'
  1439 		    inClass:targetClass)
  1440     ].
  1441     (targetClass includesSelector:#postOpenWith:) ifFalse:[
  1442 	code := code
  1443 		, (self
  1444 		    generateHookMethodFor:'postOpenWith:aBuilder'
  1445 		    comment:'the topView has been opened, but before events are dispatched for it'
  1446 		    note:'or after the super send'
  1447 		    defaultCode:'    super postOpenWith:aBuilder'
  1448 		    inClass:targetClass)
  1449     ].
  1450     (targetClass includesSelector:#closeRequest) ifFalse:[
  1451 	code := code
  1452 		, (self
  1453 		    generateHookMethodFor:'closeRequest'
  1454 		    comment:'the topView has been asked to close'
  1455 		    note:'return without the ''super closeRequest'' to stay open'
  1456 		    defaultCode:'    ^super closeRequest'
  1457 		    inClass:targetClass)
  1458     ].
  1459     ^ code
  1460 
  1461     "Modified: / 31.10.1997 / 17:30:34 / cg"
  1462     "Created: / 31.10.1997 / 17:32:49 / cg"
  1463 !
  1464 
  1465 generateMenuMethodFor:menuSel inClass:targetClass
  1466     |selector args showIt code alreadyInSuperclass numArgs method category|
  1467 
  1468     selector := menuSel asSymbol.
  1469     category := UserPreferences current categoryForMenuActionsMethods.
  1470 
  1471     alreadyInSuperclass := targetClass superclass canUnderstand:selector.
  1472 
  1473     code := '!!' , targetClass name , ' methodsFor:''' , category , '''!!\\'.
  1474 
  1475     selector = 'openAboutThisApplication' ifTrue:[
  1476 	code := code ,
  1477 		'openAboutThisApplication\' ,
  1478 		'    "opens an about box for this application."\\' ,
  1479 		'    "automatically generated by UIPainter ..."\\' ,
  1480 
  1481 		'    |rev box myClass clsRev image msg|\\' ,
  1482 
  1483 		'    rev := ''''.\' ,
  1484 		'    myClass := self class.\' ,
  1485 
  1486 		'    (clsRev := myClass revision) notNil ifTrue:[\' ,
  1487 		'       rev := ''  (rev: '', clsRev printString, '')''].\\' ,
  1488 
  1489 		'    msg := Character cr asString , myClass name asBoldText, rev.\' ,
  1490 		'    msg := (msg , ''\\*** add more info here ***\\'') withCRs.\\' ,
  1491 		'    box := AboutBox title:msg.\' ,
  1492 
  1493 		'    "/ *** add a #defaultIcon method in the class\' ,
  1494 		'    "/ *** and uncomment the following line:\' ,
  1495 		'    "/ image := self class defaultIcon.\\' ,
  1496 		'    image notNil ifTrue:[\' ,
  1497 		'        box image:image\' ,
  1498 		'    ].\' ,
  1499 		'    box   label:(resources string:''About %1'' with:myClass name).\' ,
  1500 		'    box   autoHideAfter:10 with:[].\' ,
  1501 		'    box   showAtPointer.\' ,
  1502 		'!! !!\\'.
  1503 	^ code withCRs
  1504     ].
  1505 
  1506     selector = 'menuOpen' ifTrue:[
  1507 	code := code ,
  1508 		'menuOpen\' ,
  1509 		'    "automatically generated by UIPainter ..."\\' ,
  1510 		'    "*** the code below opens a dialog for file selection"\' ,
  1511 		'    "*** and invokes the #doOpen: method with the selected file."\' ,
  1512 		'    "*** Please change as required and accept in the browser."\\' ,
  1513 		'    |file|\\' ,
  1514 		'    file :=\' ,
  1515 		'        (FileSelectionBrowser\' ,
  1516 		'            request: ''Open''\' ,
  1517 		'            fileName: ''''\' ,
  1518 		'            "/ inDirectory: lastOpenDirectory\' ,
  1519 		'            withFileFilters: #(''*'')).\\' ,
  1520 		'    file notNil ifTrue:[\' ,
  1521 		'       "/ lastOpenDirectory := file asFilename directory.\' ,
  1522 		'       self doOpen:file\' ,
  1523 		'    ]\' ,
  1524 		'!! !!\'.
  1525 	^ code withCRs
  1526     ].
  1527 
  1528     numArgs := selector numArgs.
  1529     method  := selector.
  1530 
  1531     numArgs == 1 ifTrue:[
  1532 	args := 'anArgument'.
  1533 	showIt := ''' , anArgument printString , '' ...''.\'.
  1534     ] ifFalse:[
  1535 	args := ''.
  1536 	showIt := ' ...''.\'.
  1537 
  1538 	numArgs ~~ 0 ifTrue:[
  1539 	    method := ''.
  1540 
  1541 	    selector keywords keysAndValuesDo:[:i :key|
  1542 		method := method, key, 'arg', i printString, ' '
  1543 	    ]
  1544 	]
  1545     ].
  1546 
  1547     code := code ,
  1548 		method , args , '\' ,
  1549 		'    "automatically generated by UIPainter ..."\\' ,
  1550 		'    "*** the code below performs no action"\' ,
  1551 		'    "*** (except for some feedback on the Transcript)"\' ,
  1552 		'    "*** Please change as required and accept in the browser."\' ,
  1553 		'\' .
  1554 
  1555     alreadyInSuperclass ifTrue:[
  1556 	code := code ,
  1557 		    '    "action for ' , selector , ' is already provided in a superclass."\' ,
  1558 		    '    "It may be redefined here ..."\\'.
  1559     ] ifFalse:[
  1560 	code := code ,
  1561 		    '    "action to be added ..."\\'.
  1562     ].
  1563 
  1564     code := code ,
  1565 		'    Transcript showCR:self class name, '': '.
  1566     alreadyInSuperclass ifTrue:[
  1567 	code := code , 'inherited '.
  1568     ].
  1569     code := code , 'menu action for ' , selector , showIt.
  1570 
  1571     alreadyInSuperclass ifTrue:[
  1572 	code := code ,
  1573 			'    super ' , selector , args , '.\'.
  1574     ].
  1575 
  1576     code := code ,
  1577 		'!! !!\\'.
  1578     ^ code withCRs
  1579 
  1580     "Created: / 23.8.1998 / 16:46:51 / cg"
  1581     "Modified: / 23.8.1998 / 18:13:05 / cg"
  1582 !
  1583 
  1584 generateMenuMethods
  1585     "generate menu methods
  1586      - but do not overwrite existing ones.
  1587      Return a string ready to compile into the application class."
  1588 
  1589     |cls code menuSelector thisCode
  1590      definedMethodSelectors
  1591      spec specArray fullSpec winSpec menuSpec|
  1592 
  1593     cls := self targetClass.
  1594     cls isNil ifTrue:[
  1595         ^ nil
  1596     ].
  1597 
  1598     spec := treeView generateFullSpecForComponents:#() named:nil.
  1599     specArray := spec literalArrayEncoding.
  1600     fullSpec := specArray decodeAsLiteralArray.
  1601     winSpec := fullSpec window.
  1602     menuSelector := winSpec menu.
  1603 
  1604     (menuSelector notNil
  1605     and:[ (cls respondsTo:menuSelector) ]) ifFalse:[
  1606         self warn:'No menu defined (yet)'.
  1607         ^ nil.
  1608     ].
  1609     menuSpec := cls perform:menuSelector.
  1610     menuSpec := menuSpec decodeAsLiteralArray.
  1611 
  1612     definedMethodSelectors := IdentitySet new.
  1613     code := ''.
  1614 
  1615     menuSpec allItemsDo:[:item |
  1616         |sel|
  1617 
  1618         (sel := item value) notNil ifTrue:[
  1619             (definedMethodSelectors includes:sel) ifFalse:[
  1620                 self generateCodeFrom:(Array with:sel) in:cls do:[:aSel|
  1621                     thisCode := (self generateMenuMethodFor:aSel inClass:cls).
  1622                     code := code, thisCode.
  1623                 ].
  1624                 definedMethodSelectors add:sel.
  1625             ].
  1626         ]
  1627     ].
  1628 
  1629     (definedMethodSelectors includes:#menuOpen) ifTrue:[
  1630         self generateCodeFrom:(Array with:#doOpen:) in:cls do:[:aSel|
  1631             thisCode := (self generateMenuMethodFor:aSel inClass:cls).
  1632             code := code, thisCode.
  1633         ].
  1634     ].
  1635 
  1636     ^ code
  1637 
  1638     "Created: / 23.8.1998 / 16:12:09 / cg"
  1639     "Modified: / 23.8.1998 / 18:12:23 / cg"
  1640 !
  1641 
  1642 generateValueMethodFor:aspect spec:protoSpec inClass:targetClass
  1643     ^ ('!!' , targetClass name , ' methodsFor:''values''!!\\' ,
  1644       aspect , '\' ,
  1645       '    "automatically generated by UIPainter ..."\\' ,
  1646       '    "*** the code below returns a default value when invoked."\' ,
  1647       '    "*** (which may not be the one you wanted)"\' ,
  1648       '    "*** Please change as required and accept in the browser."\' ,
  1649       '\' ,
  1650       '    "value to be added below ..."\' ,
  1651       '    Transcript showCR:self class name , '': no value yet for ' , aspect , ' ...''.\' ,
  1652       '\' ,
  1653       '^ nil.' ,
  1654       '!! !!\\') withCRs
  1655 
  1656     "Modified: / 25.10.1997 / 19:22:17 / cg"
  1657 !
  1658 
  1659 generateWindowSpec
  1660     |spec addToSpec specsAlready|
  1661 
  1662     spec := OrderedCollection new.
  1663     specsAlready := IdentitySet new.
  1664 
  1665     addToSpec :=
  1666         [:aView|
  1667             |vSpec|
  1668             "/ care for wrapped views ...
  1669             vSpec := self fullSpecFor:aView.
  1670             vSpec isNil ifTrue:[
  1671                 aView subViews size == 1 ifTrue:[
  1672                     vSpec := self fullSpecFor:(aView subViews first).
  1673                 ]
  1674             ].
  1675             vSpec isNil ifTrue:[
  1676                 (Dialog 
  1677                     confirm:('Oops - could not create spec for view: %1\\Continue ?' bindWith:aView printString) withCRs
  1678                     noLabel:'Abort')
  1679                 ifFalse:[
  1680                     AbortOperationRequest raise
  1681                 ].
  1682             ].
  1683             (specsAlready includes:vSpec) ifTrue:[self halt].
  1684             specsAlready add:vSpec.
  1685             spec add:vSpec
  1686         ].
  1687 
  1688     self subViews do:addToSpec.
  1689     self components do:addToSpec.
  1690     spec := treeView generateFullSpecForComponents:spec named:methodName.
  1691     ^ spec
  1692 
  1693     "Modified: / 30-07-2013 / 09:13:13 / cg"
  1694 !
  1695 
  1696 generateWindowSpecMethodSource
  1697     ^ self 
  1698         generateWindowSpecMethodSourceFor:(self generateWindowSpec) 
  1699         class:className 
  1700         selector:methodName
  1701 
  1702     "Modified: / 5.9.1995 / 21:01:35 / claus"
  1703     "Modified: / 15.10.1998 / 11:29:53 / cg"
  1704 !
  1705 
  1706 generateWindowSpecMethodSourceFor:spec class:className selector:methodName
  1707     |specArray str code category cls mthd specCode|
  1708 
  1709     specArray := spec literalArrayEncoding.
  1710 
  1711     str  := WriteStream on:''.
  1712     UISpecification prettyPrintSpecArray:specArray on:str indent:4.
  1713     specCode := str contents.
  1714 
  1715     (specCode includes:$!!) ifTrue:[
  1716         "/ oops - must be chunk format ...
  1717         str  := WriteStream on:''.
  1718         str nextPutAllAsChunk:specCode.
  1719         specCode := str contents.
  1720     ].
  1721 
  1722     "/ if that method already exists, do not overwrite the category
  1723 
  1724     category := 'interface specs'.
  1725     cls := self resolveName:className.
  1726 
  1727     cls notNil ifTrue:[
  1728         (mthd := cls class compiledMethodAt:methodName asSymbol) notNil ifTrue:[
  1729             category := mthd category.
  1730         ]
  1731     ].
  1732 
  1733     code := '!!'
  1734             , className , ' class methodsFor:' , category storeString
  1735             , '!!' , '\\'
  1736 
  1737             , methodName , '\'
  1738             , ((ResourceSpecEditor codeGenerationCommentForClass: UIPainter) replChar:$!! withString:'!!!!')
  1739             , '\\    "\'
  1740             , ('     UIPainter new openOnClass:' , className , ' andSelector:#' , methodName , '\').
  1741 
  1742     (cls notNil and:[cls isSubclassOf:ApplicationModel]) ifTrue:[
  1743         code := code
  1744             , ('     ' , className , ' new openInterface:#' , methodName , '\').
  1745     ].
  1746 
  1747     code := code
  1748             ,(methodName = 'windowSpec'
  1749                 ifTrue:['     ' , className , ' open\'] ifFalse: [''])
  1750             , '    "\'.
  1751 
  1752     code := code
  1753             , '\'
  1754             , '    <resource: #canvas>\\'.
  1755     code := code withCRs.
  1756     code := code
  1757             , '    ^ ' , specCode
  1758             , '\' withCRs
  1759             , '!! !!'
  1760             , '\\' withCRs.
  1761 
  1762     ^ code
  1763 !
  1764 
  1765 listOfAspects
  1766     |cls aspects|
  1767 
  1768     listOfAspectsHolder notNil ifTrue:[
  1769         ^ listOfAspectsHolder value
  1770     ].
  1771 
  1772     aspects := IdentitySet new.
  1773 
  1774     cls := self targetClass.
  1775     cls notNil ifTrue:[
  1776         cls withAllSuperclassesDo:[:cls |
  1777             cls methodsDo:[:m |
  1778                 ((m resources ? #()) includes:#uiAspect) ifTrue:[
  1779                     aspects add:m selector
  1780                 ].                  
  1781             ]
  1782         ]
  1783     ].
  1784 
  1785     treeView propertiesDo:[:aProp|
  1786         |modelSelector|
  1787 
  1788         (modelSelector := aProp model) notNil ifTrue:[
  1789             aspects add:modelSelector asSymbol
  1790         ].
  1791 
  1792 "/        aspects addAll:aProp spec actionSelectors.
  1793 
  1794         aspects addAll:(aProp spec valueSelectors select:[:a | a isString or:[a isSymbol]]).
  1795         aspects addAll:(aProp spec aspectSelectors select:[:a | a isString or:[a isSymbol]]).
  1796     ].
  1797 
  1798     ^ aspects asOrderedCollection sort.
  1799 
  1800     "Created: / 12-01-2008 / 19:24:45 / cg"
  1801 !
  1802 
  1803 listOfCallbacks
  1804     |cls aspects|
  1805 
  1806     aspects := IdentitySet new.
  1807 
  1808     cls := self targetClass.
  1809     cls notNil ifTrue:[
  1810         cls methodsDo:[:m |
  1811             ((m resources ? #()) includes:#uiCallback) ifTrue:[
  1812                 aspects add:m selector
  1813             ].                  
  1814         ]
  1815     ].
  1816 
  1817     treeView propertiesDo:[:aProp|
  1818         |modelSelector|
  1819 
  1820         aspects addAll:aProp spec actionSelectors.
  1821 "/        aspects addAll:aProp spec valueSelectors.
  1822 "/        aspects addAll:aProp spec aspectSelectors.
  1823     ].
  1824 
  1825     ^ aspects asOrderedCollection sort.
  1826 
  1827     "Created: / 12-01-2008 / 19:25:19 / cg"
  1828 !
  1829 
  1830 targetClass
  1831     |cls|
  1832 
  1833     className isNil ifTrue:[
  1834         self warn:'No TargetClass defined !!'.
  1835         ^ nil
  1836     ].
  1837     (cls := self resolveName:className) isNil ifTrue:[
  1838 "/        self warn:('Class ', className asString, ' does not exist !!').
  1839         ^ nil
  1840     ].
  1841     ^ cls.
  1842 ! !
  1843 
  1844 !UIPainterView methodsFor:'grid manipulation'!
  1845 
  1846 newGrid
  1847     "define a new grid - this is a private helper which has to be
  1848      called after any change in the grid. It (re)creates the gridPixmap,
  1849      clears the view and redraws all visible objects."
  1850 
  1851     |defaultViewBackground|
  1852 
  1853     gridPixmap := nil.
  1854     defaultViewBackground := self class defaultViewBackgroundColor.
  1855 
  1856     shown ifTrue:[
  1857         self viewBackground: (defaultViewBackground isColor
  1858             ifTrue: [defaultViewBackground]
  1859             ifFalse:[self blackColor]).
  1860         self clear.
  1861     ].
  1862 
  1863     gridShown ifTrue:[
  1864         self defineGrid.
  1865         gridPixmap colorMap: (defaultViewBackground isColor
  1866             ifTrue: [Array with:defaultViewBackground with:Color darkGray]
  1867             ifFalse:[Array with:self whiteColor with:self blackColor]).
  1868         self viewBackground:gridPixmap.
  1869     ].
  1870 
  1871     self invalidate
  1872 ! !
  1873 
  1874 !UIPainterView methodsFor:'group & ungroup'!
  1875 
  1876 group
  1877 
  1878     self groupSelectionWithLayout: false
  1879 !
  1880 
  1881 groupSelectionWithLayout: withLayout
  1882     |minViews specs spec menu newView target keepLyt keepPos rectangle|
  1883 
  1884     self canGroup ifFalse:[^ self ].
  1885 
  1886     keepLyt := withLayout.
  1887     keepPos := true.
  1888 
  1889     menu := Menu new.
  1890     menu receiver: self.
  1891     menu addItem:(MenuItem label:'Box' itemValue:[spec := ViewSpec new]).
  1892     menu addItem:(MenuItem label:'TBox' itemValue:[spec := TBoxSpec new]).
  1893     menu addItem:(MenuItem label:'FramedBox' itemValue:[spec := FramedBoxSpec new]).
  1894 
  1895     menu addItem:(MenuItem 
  1896                     label:'HorizontalPanel'
  1897                     itemValue:[
  1898                         keepLyt := keepPos := false.
  1899                         spec := HorizontalPanelViewSpec new.
  1900                         spec verticalLayout: #fit.
  1901                         spec horizontalLayout: #leftSpace.
  1902                     ]).
  1903     menu addItem:(MenuItem 
  1904                     label:'VerticalPanel'
  1905                     itemValue:[
  1906                         keepLyt := keepPos := false.
  1907                         spec := VerticalPanelViewSpec new.
  1908                         spec verticalLayout: #topSpace.
  1909                         spec horizontalLayout: #fit.
  1910                     ]).
  1911 
  1912     menu startUp.
  1913     spec isNil ifTrue:[^ self].
  1914 
  1915     minViews := self minClosedViewSetFor:(self selection).
  1916     minViews size > 1 ifFalse:[^ self].
  1917 
  1918     specs     := OrderedCollection new.
  1919     rectangle := minViews first frame copy.
  1920 
  1921     minViews do:[:eachView|
  1922         specs add:(self fullSpecWithAbsolutePositionFor:eachView).
  1923         rectangle := rectangle quickMerge:(eachView frame).
  1924     ].
  1925     spec layout:rectangle.
  1926 
  1927     target := self findContainerOfView:(minViews first).
  1928 
  1929     self withinTransaction:#group objects:(Array with:target) do:[ |widgets|
  1930         self deleteSelectionBuffered:false.
  1931 
  1932         spec otherAttributeAt:#uiPainterAttributes put:(Dictionary new
  1933                 at:#origin put:(rectangle origin);
  1934                 at:#extent put:(rectangle extent);
  1935                 at:#absOrigin put:(rectangle origin);
  1936                 yourself).
  1937 
  1938         newView := self pasteSpecifications:(Array with:spec) 
  1939                     into:target
  1940                     keepLayout:true
  1941                     keepPosition:true
  1942                     at:#keep.
  1943 
  1944         widgets := self pasteSpecifications:specs
  1945                 into:newView
  1946                 keepLayout:keepLyt
  1947                 keepPosition:keepPos
  1948                 at:nil.
  1949     ].
  1950     self select:newView.
  1951 !
  1952 
  1953 groupWithLayout
  1954 
  1955     self groupSelectionWithLayout: true
  1956 !
  1957 
  1958 ungroup
  1959 
  1960     self ungroupSelectionWithLayout: false
  1961 !
  1962 
  1963 ungroupSelectionWithLayout: withLayout
  1964 
  1965     | canvas cS views specs frame view layout superView|
  1966 
  1967     self canUngroup ifFalse:[^ self ].
  1968 
  1969     canvas := self painter.
  1970     cS := canvas getSelectedViewsAndSpecs.
  1971     cS isNil ifTrue:[^self].
  1972     views := cS first first subViews copy.
  1973     superView := cS first first superView.
  1974     cS last first component isNil ifTrue:[^self].
  1975     cS last first component collection isEmpty ifTrue:[^self].
  1976     specs := cS last first component collection copy.
  1977     frame := cS first first frame.
  1978     canvas deleteSelection.
  1979     withLayout ifFalse:[
  1980         1 to: specs size do:[:i|
  1981             view := views at: i.
  1982             layout :=  LayoutFrame leftFraction:0.0 offset: (view origin x + frame origin x)
  1983                                   rightFraction:0.0 offset: (view corner x + frame origin x + 1)
  1984                                     topFraction:0.0 offset: (view origin y + frame origin y )
  1985                                  bottomFraction:0.0 offset: (view corner y + frame origin y + 1).
  1986             (specs at: i) layout: layout.
  1987         ].
  1988     ].
  1989     canvas selection: superView.
  1990     canvas pasteSpecifications:specs keepLayout:true.
  1991     canvas selection: superView.
  1992 !
  1993 
  1994 ungroupWithLayout
  1995 
  1996     self ungroupSelectionWithLayout: true
  1997 ! !
  1998 
  1999 !UIPainterView methodsFor:'initialization'!
  2000 
  2001 create
  2002     "colors on device"
  2003     
  2004     super create.
  2005     handleColorBlack := handleColorBlack onDevice:device.
  2006     handleColorWhite := handleColorWhite onDevice:device.
  2007     handleMasterColor := handleMasterColor onDevice:device.
  2008 !
  2009 
  2010 initialize
  2011     "setup attributes
  2012     "
  2013     super initialize.
  2014     superclassName    := 'ApplicationModel'.
  2015     className         := 'NewApplication'.
  2016     methodName        := 'windowSpec'.
  2017     categoryName      := 'Applications'.
  2018     HandCursor        := Cursor leftHand.
  2019     handleColorBlack  := self blackColor.
  2020     handleColorWhite  := self whiteColor.
  2021     handleMasterColor := Color red.
  2022 
  2023     self backgroundColor: self class defaultViewBackgroundColor.
  2024 !
  2025 
  2026 setupFromSpec:specOrSpecArray
  2027     |spec builder specWindow|
  2028 
  2029     Cursor wait showWhile: [
  2030         self removeAll.
  2031         specOrSpecArray notNil ifTrue:[
  2032             spec := UISpecification from:specOrSpecArray.
  2033         ].
  2034         builder := UIBuilder new isEditing:true.
  2035         "set applicationClass, in order that subspecifications may be resolved"
  2036         className notNil ifTrue:[
  2037             builder applicationClass:(self resolveName:className).
  2038         ].
  2039         spec notNil ifTrue:[
  2040             specWindow := spec window.
  2041         ].
  2042         specWindow notNil ifTrue:[
  2043             specWindow setupView:self topView for:builder.
  2044             self addSpec:(spec component) builder:builder in:self.
  2045         ].
  2046         self realizeAllSubViews.
  2047         specWindow notNil ifTrue:[
  2048             treeView setAttributesFromWindowSpec:specWindow
  2049         ].
  2050     ].
  2051 !
  2052 
  2053 treeView:aTreeView
  2054     treeView := aTreeView.
  2055 
  2056     "I want to see the events of the treeView"
  2057     treeView delegate:(
  2058         "/
  2059         "/ I want to handle everything typed
  2060         "/ in the treeView, except for Return and Cursor-keys
  2061         "/
  2062         KeyboardForwarder
  2063             toView:self
  2064             condition:nil
  2065             filter:[:k | (k isSymbol
  2066                          and:[k ~~ #Return
  2067                          and:[k ~~ #Tab
  2068                          and:[(k startsWith:#Cursor) not]]])
  2069                    ]
  2070     )
  2071 
  2072     "Modified: / 31.10.1997 / 20:22:09 / cg"
  2073 ! !
  2074 
  2075 !UIPainterView methodsFor:'menus'!
  2076 
  2077 showMiddleButtonMenu
  2078     "show the middle button menu; this returns nil"
  2079 
  2080     |m|
  2081 
  2082     self enabled ifTrue:[
  2083         m := MenuPanel fromSpec:(UIPainter menuEdit) receiver:self superView application.
  2084         self startUpMenu:m
  2085     ].
  2086     ^ nil
  2087 
  2088     "Modified: / 31-10-2007 / 11:10:10 / cg"
  2089 ! !
  2090 
  2091 !UIPainterView methodsFor:'private-handles'!
  2092 
  2093 painter
  2094     ^ treeView canvas
  2095 !
  2096 
  2097 showSelected:aComponent
  2098     "show object selected
  2099     "
  2100     |wasClipped sel hInsideColor hOutsideColor bg|
  2101 
  2102     selectionHiddenLevel == 0 ifTrue:[
  2103         sel := treeView selection.
  2104         (sel size > 1 and: [(treeView model list at: sel first) contents view == aComponent])
  2105         ifTrue: [
  2106             hInsideColor := handleMasterColor.
  2107         ] ifFalse:[
  2108             bg := aComponent viewBackground.
  2109             bg isColor ifTrue:[
  2110                 bg brightness < 0.5 ifTrue:[
  2111                     hInsideColor := handleColorWhite
  2112                 ] ifFalse:[
  2113                     hInsideColor := handleColorBlack
  2114                 ]
  2115             ] ifFalse:[
  2116                 hInsideColor := handleColorBlack
  2117             ]
  2118         ].
  2119 
  2120         hInsideColor brightness < 0.5 ifTrue:[
  2121             hOutsideColor := handleColorWhite
  2122         ] ifFalse:[
  2123             hOutsideColor := handleColorBlack
  2124         ].
  2125 
  2126         (wasClipped := clipChildren) ifTrue:[
  2127             gc clippedByChildren:(clipChildren := false).
  2128         ].
  2129 
  2130         self handlesOf:aComponent do:[:aRectangle :what| 
  2131             |l t w h|
  2132 
  2133             l := aRectangle left.
  2134             t := aRectangle top.
  2135             w := aRectangle width.
  2136             h := aRectangle height.
  2137 
  2138             gc paint:hOutsideColor.
  2139             gc displayRectangleX:l y:t width:w height:h.
  2140 
  2141             gc paint:hInsideColor.
  2142 
  2143             what == #view ifTrue:[
  2144                 gc displayRectangleX:l+1 y:t+1 width:w-2 height:h-2
  2145             ] ifFalse:[
  2146                 gc fillRectangleX:l+1 y:t+1 width:w-2 height:h-2
  2147             ]
  2148         ].
  2149 
  2150         wasClipped ifTrue:[
  2151             gc clippedByChildren:(clipChildren := true).
  2152         ]
  2153     ]
  2154 
  2155     "Modified: / 6.12.2001 / 00:00:16 / cg"
  2156 ! !
  2157 
  2158 !UIPainterView methodsFor:'queries'!
  2159 
  2160 isEditingSpecOnly
  2161     "/ should not be invoked
  2162     self breakPoint:#ca.
  2163     ^ false.
  2164 !
  2165 
  2166 isNotEditingSpecOnly
  2167     "/ should not be invoked
  2168     self breakPoint:#ca.
  2169     ^ true.
  2170 !
  2171 
  2172 resolveName:aName
  2173     |appl|
  2174 
  2175     appl := self application.
  2176 
  2177     appl notNil ifTrue:[
  2178 	^ appl resolveName:aName
  2179     ].
  2180     ^ Smalltalk resolveName:aName inClass:self class
  2181 ! !
  2182 
  2183 !UIPainterView methodsFor:'removing components'!
  2184 
  2185 remove:anObject
  2186     "remove anObject from the contents do redraw
  2187     "
  2188     anObject notNil ifTrue:[
  2189 	treeView removeView:anObject.
  2190     ]
  2191 !
  2192 
  2193 removeAll
  2194     "remove all objects and properties
  2195     "
  2196     self select:nil.
  2197     treeView removeAll.
  2198     self removeUndoHistory.
  2199 ! !
  2200 
  2201 !UIPainterView methodsFor:'searching'!
  2202 
  2203 findContainerOfView:aView
  2204     "returns the super view assigned to a view
  2205     "
  2206     |p|
  2207 
  2208     (p := self propertyOfParentForView:aView) isNil ifTrue:[
  2209 	^ self
  2210     ].
  2211     ^ p view
  2212 !
  2213 
  2214 findObjectAt:aPoint
  2215     |view prop|
  2216 
  2217     view := super findObjectAt:aPoint.
  2218     view isNil ifTrue:[^ nil].
  2219 
  2220     "/ stupid check, if I know about this view
  2221     prop := self propertyOfView:view.
  2222     prop notNil ifTrue:[^ prop view].
  2223     self halt:'nil property'.
  2224     ^ nil
  2225 !
  2226 
  2227 findViewWithId:aViewId
  2228     "finds view assigned to identifier and returns the view or nil
  2229     "
  2230     |prop|
  2231 
  2232     prop := self propertyOfIdentifier:aViewId.
  2233 
  2234     prop notNil ifTrue:[^ prop view]
  2235 	       ifFalse:[^ nil]
  2236 !
  2237 
  2238 propertyOfIdentifier:anId
  2239     "returns property assigned to unique identifier
  2240     "
  2241     anId notNil ifTrue:[
  2242 	^ treeView propertyDetect:[:p| p identifier == anId ]
  2243     ].
  2244     ^ nil
  2245 !
  2246 
  2247 propertyOfName:aString
  2248     "returns the property for a given widgets name (name in tree)"
  2249 
  2250     |name|
  2251 
  2252     aString isNil ifFalse:[
  2253         name := aString string withoutSeparators.
  2254         ^ treeView propertyDetect:[:p| p name = name ].
  2255     ].
  2256     ^ nil
  2257 !
  2258 
  2259 propertyOfParentForView:aSubView
  2260     "returns the property of the parent or nil
  2261     "
  2262     |item|
  2263 
  2264     (item := treeView detectItemCorespondingToView:aSubView) notNil ifTrue:[
  2265         (item := item parent) notNil ifTrue:[^ item contents]
  2266     ].
  2267     ^ nil
  2268 !
  2269 
  2270 propertyOfView:aView
  2271     "detect the property for the argument, a view. The property of the view or
  2272      the first subview providing the properties is returned. If no property is detected
  2273      nil is returned.
  2274     "
  2275     |item|
  2276 
  2277     item := treeView detectItemCorespondingToView:aView.
  2278     (item notNil and:[item parent notNil]) ifTrue:[
  2279         ^ item contents
  2280     ].
  2281     ^ nil
  2282 !
  2283 
  2284 uniqueNameFor:aSpecOrString
  2285     "generate and return a unique name for a specClass or an items name.
  2286      (unique name in the tree)"
  2287 
  2288     |maxUsedIndex name nameLen|
  2289 
  2290     name := aSpecOrString isString 
  2291                 ifFalse:[aSpecOrString userFriendlyName]
  2292                 ifTrue:[aSpecOrString].
  2293 
  2294     nameLen := name size.
  2295     maxUsedIndex := 0.
  2296 
  2297     treeView propertiesDo:[:p|
  2298         |thisName|
  2299 
  2300         thisName := p name.
  2301 
  2302         (thisName size > nameLen and:[thisName startsWith:name]) ifTrue:[
  2303             maxUsedIndex := maxUsedIndex max:(p extractNumberStartingAt:nameLen+1)
  2304         ]
  2305     ].
  2306     ^ name, (maxUsedIndex+1) printString.
  2307 !
  2308 
  2309 uniqueNameOf:aView
  2310     |prop|
  2311 
  2312     (prop := self propertyOfView:aView) notNil ifTrue:[
  2313 	prop name isNil ifTrue:[
  2314 	    prop name:(self uniqueNameFor:(prop spec)).
  2315 	].
  2316 	^ prop name
  2317     ].
  2318     ^ 'self'
  2319 
  2320 ! !
  2321 
  2322 !UIPainterView methodsFor:'selection basics'!
  2323 
  2324 addToSelection:anObject
  2325     "add an object to the selection
  2326     "
  2327     (self enabled and:[(self isSelected:anObject) not]) ifTrue:[
  2328         selection isCollection ifFalse:[
  2329             selection isNil ifTrue:[
  2330                 selection := anObject
  2331             ] ifFalse:[
  2332                 selection := OrderedCollection with:selection with:anObject
  2333             ]
  2334         ] ifTrue:[
  2335             "/ to enforce the change-message (value is identical to oldValue)
  2336             selection isList ifTrue:[
  2337                 selection add:anObject
  2338             ] ifFalse:[
  2339                 selection := selection asOrderedCollection.
  2340                 selection := selection copyWith:anObject
  2341             ]
  2342         ].
  2343         self showSelected:anObject.
  2344         treeView canvasSelectionAdd:anObject.
  2345     ]
  2346 
  2347     "Modified: / 11.2.2000 / 01:39:05 / cg"
  2348 !
  2349 
  2350 removeFromSelection:anObject
  2351     "remove an object from the selection
  2352     "
  2353     (self isSelected:anObject) ifTrue:[
  2354         self showUnselected:anObject.
  2355 
  2356         selection size > 1 ifTrue:[
  2357             selection isList ifTrue:[
  2358                 selection remove:anObject ifAbsent:nil
  2359             ] ifFalse:[
  2360                 "/ to enforce the change-message (value is identical to oldValue)
  2361                 selection := selection asOrderedCollection.
  2362                 selection := selection copyWithout:anObject
  2363             ].
  2364             self showSelection.
  2365         ] ifFalse:[
  2366             selection := nil
  2367         ].
  2368         treeView canvasSelectionRemove:anObject.
  2369     ]
  2370 
  2371     "Modified: / 11.2.2000 / 01:41:11 / cg"
  2372 !
  2373 
  2374 select:something
  2375     "change selection to something
  2376     "
  2377     (self enabled and:[something ~= self selection]) ifTrue:[
  2378         something isNil
  2379             ifTrue: [treeView selection: (Array with: 1)]
  2380             ifFalse:[treeView canvasSelection:something].
  2381         self setSelection:something withRedraw:true
  2382     ]
  2383 !
  2384 
  2385 selectNextUpInHierarchy
  2386     | sel |
  2387 
  2388     (sel := self selection) isNil ifTrue:[^self].
  2389     sel isCollection ifTrue:[
  2390         sel := self selection first.
  2391     ].
  2392     sel := sel superView.
  2393     sel isNil ifTrue:[^self].
  2394     treeView canvasSelection: sel.
  2395     self selection: sel.
  2396 !
  2397 
  2398 selectedNodes
  2399     ^ treeView model selectedNodes
  2400 !
  2401 
  2402 updateSelectionFromModel:aSelOrNil
  2403     "update selection from a new selection
  2404     "
  2405     |list|
  2406 
  2407     "/ do not return here if not shown - we NEED the correct selection
  2408     selectionHiddenLevel == 0 ifTrue:[
  2409         aSelOrNil size ~~ 0 ifTrue:[
  2410             list := OrderedCollection new.
  2411 
  2412             self selectionDo:[:el|
  2413                 (aSelOrNil includes:el) ifFalse:[list add:el]
  2414             ].
  2415             self shown ifTrue:[self showUnselected:list].
  2416         ] ifFalse:[
  2417             self shown ifTrue:[self hideSelection].
  2418         ]
  2419     ].
  2420     self repairDamage.
  2421     self setSelection:aSelOrNil withRedraw:false.
  2422     self showSelection.
  2423 ! !
  2424 
  2425 !UIPainterView methodsFor:'specification'!
  2426 
  2427 addSpec:aSpecification builder:aBuilder in:aFrame
  2428     "build view and subviews from aSpecification into a frame. The top view
  2429      is returned. The contained components of a spec are set to nil
  2430     "
  2431     ^ self addSpec:aSpecification builder:aBuilder in:aFrame beforeIndex:nil.
  2432 !
  2433 
  2434 addSpec:aSpecification builder:aBuilder in:aFrame beforeIndex:anIndexOrNil
  2435     "build view and subviews from aSpecification into a frame. The top view
  2436      is returned. The contained components of a spec are set to nil
  2437     "
  2438     |cls newView viewPosition subviewToRealize|
  2439 
  2440     cls := self resolveName:className.
  2441 
  2442     cls notNil ifTrue:[
  2443         aBuilder applicationClass:cls.
  2444     ].
  2445 
  2446     (     anIndexOrNil notNil
  2447      and:[anIndexOrNil between:1 and:(aFrame subViews size)]
  2448     ) ifTrue:[
  2449         viewPosition := anIndexOrNil.
  2450     ].
  2451 
  2452     "/ remember view<->spec associations to tree
  2453     aBuilder 
  2454         componentCreationHook:[:aView :aSpec :builder|
  2455             |newProperty copyOfSpec nameOfSpec beforeIndex|
  2456 
  2457             (viewPosition notNil and:[aSpecification == aSpec]) ifTrue:[
  2458                 subviewToRealize := aView.
  2459 
  2460                 [ (subviewToRealize notNil and:[subviewToRealize superView ~~ aFrame]) ] whileTrue:[
  2461                     subviewToRealize := subviewToRealize superView.
  2462                 ].
  2463                 subviewToRealize notNil ifTrue:[
  2464                     beforeIndex := viewPosition.
  2465                     aFrame changeSequenceOrderFor:subviewToRealize to:viewPosition.
  2466                 ].
  2467             ].
  2468 
  2469             newProperty := ViewProperty new.
  2470             copyOfSpec := aSpec copy.
  2471             newProperty spec:copyOfSpec.
  2472             newProperty view:aView.
  2473 
  2474             "/ break refs to child-specs
  2475             "/ (not needed, as we keep the child info in the view hierarchy)
  2476             copyOfSpec class supportsSubComponents ifTrue:[
  2477                 copyOfSpec component:nil
  2478             ].
  2479 
  2480             nameOfSpec := copyOfSpec name.
  2481             "/ old: enforce a name
  2482             "/ (nameOfSpec isNil or:[(self propertyOfName:nameOfSpec) notNil]) ifTrue:[
  2483             "/     copyOfSpec name:(nameOfSpec := self uniqueNameFor:copyOfSpec)
  2484             "/ ].
  2485             "/ aView name:nameOfSpec.
  2486             "/ new:
  2487             (nameOfSpec isNil "notEmptyOrNil" or:[ (self propertyOfName:nameOfSpec) notNil]) ifTrue:[
  2488                 copyOfSpec name:(nameOfSpec := self uniqueNameFor:copyOfSpec).
  2489                 aView name:nameOfSpec.
  2490             ].
  2491             "/ end
  2492 
  2493             treeView addProperty:newProperty beforeIndex:beforeIndex.
  2494         ].
  2495 
  2496     newView := aSpecification buildViewWithLayoutFor:aBuilder in:aFrame.
  2497 
  2498     subviewToRealize notNil ifTrue:[
  2499         subviewToRealize realize.
  2500 
  2501         aFrame components notEmptyOrNil ifTrue:[ self halt ].
  2502         aFrame subViews from:(viewPosition + 1 ) do:[:v|
  2503             v shown ifTrue:[v raise]
  2504         ].
  2505     ].
  2506     ^ newView
  2507 
  2508     "Modified: / 17-08-2011 / 13:56:24 / cg"
  2509 !
  2510 
  2511 fullSpecFor:aView
  2512     "generate a full spec for aView (or component)"
  2513 
  2514     |mySpec subSpecs|
  2515 
  2516     mySpec := self specFor:aView.
  2517     (mySpec notNil and:[mySpec class supportsSubComponents]) ifTrue:[
  2518         subSpecs isNil ifTrue:[
  2519             subSpecs := OrderedCollection new
  2520         ].
  2521 
  2522         ((aView components ? #()) , (aView subViews ? #())) do:[:aSubViewOrComponent |
  2523             |spec|
  2524 
  2525             spec := self fullSpecFor:aSubViewOrComponent.
  2526             spec notNil ifTrue:[
  2527                 subSpecs add:spec.
  2528             ].
  2529         ].
  2530 
  2531         subSpecs notEmptyOrNil ifTrue:[
  2532             mySpec component:(SpecCollection new collection:subSpecs)
  2533         ]
  2534     ].
  2535     ^ mySpec
  2536 
  2537     "Modified: / 30-07-2013 / 09:12:18 / cg"
  2538 !
  2539 
  2540 fullSpecWithAbsolutePositionFor:aView
  2541     |spec|
  2542 
  2543     spec := self fullSpecFor:aView.
  2544     spec 
  2545         otherAttributeAt:#uiPainterAttributes 
  2546         put:(Dictionary new
  2547                 at:#origin put:aView origin;
  2548                 at:#extent put:aView extent;
  2549                 at:#absOrigin put:(aView originRelativeTo:self);
  2550                 yourself).
  2551     ^ spec
  2552 !
  2553 
  2554 rebuildView:aView fromSpec:aSpec withBuilder:aBuilderOrNil
  2555     self
  2556         rebuildView:aView fromSpec:aSpec withBuilder:aBuilderOrNil forceNewView:false
  2557 !
  2558 
  2559 rebuildView:aView fromSpec:aSpec withBuilder:aBuilderOrNil forceNewView:forceNewView
  2560     |v builder|
  2561 
  2562     (builder := aBuilderOrNil) isNil ifTrue:[
  2563         "/ create a dummy builder
  2564         builder := UIBuilder new isEditing:true.
  2565         className notNil ifTrue:[
  2566             builder applicationClass:(self resolveName:className).
  2567         ].
  2568     ].
  2569 
  2570     aSpec class isLayoutContainer ifTrue:[
  2571         "/ TODO:
  2572         "/ go through subviews and let them resize to their default/preferred
  2573         "/ needed if we change a containers layout from fit to non-fit.
  2574 
  2575         (aView subViews ? #()) do:[:aSubView |
  2576             |fix spec prop container|
  2577 
  2578             (prop := self propertyOfView:aSubView) notNil ifTrue:[
  2579                 spec := prop spec.
  2580 
  2581                 spec useDefaultExtent ifTrue:[
  2582                     fix := aSubView sizeFixed:false.
  2583                     aView class == VerticalPanelView ifTrue:[
  2584                         aSubView height:aSubView preferredHeight.
  2585                     ] ifFalse:[
  2586                         aView class == HorizontalPanelView ifTrue:[
  2587                             aSubView width:aSubView preferredWidth.
  2588                         ] ifFalse:[
  2589                             aSubView extent:aSubView preferredExtent.
  2590                         ].
  2591                     ].
  2592                     aSubView sizeFixed:fix
  2593                 ]
  2594             ]
  2595         ].
  2596     ].
  2597 
  2598     (forceNewView or:[aSpec needsRebuildForAttributes]) ifTrue:[
  2599         "/ needs a full rebuild (in case view class depends upon spec-attribute)
  2600         v := aSpec buildViewWithLayoutFor:builder in:(self findContainerOfView:aView).
  2601         v realize.
  2602         aView destroy.
  2603         self sync.
  2604         aView becomeSameAs:v.
  2605         "/ inputView raise.
  2606     ] ifFalse:[
  2607         aSpec setAttributesIn:aView with:builder.
  2608         self elementChangedSize:aView.
  2609     ].
  2610 !
  2611 
  2612 specFor:aView
  2613     "returns a copy of the spec assigned to an object"
  2614 
  2615     |prop spec|
  2616 
  2617     (prop := self propertyOfView:aView) isNil ifTrue:[^ nil].
  2618     "/ attention: the above prop may be a superview's prop,
  2619     "/ for subviews which have not been built by me
  2620     "/ (for example, in a box with a given viewClass like Inspector,
  2621     "/ we would return the boxes spec for the subviews.
  2622     "/ This is definitely NOT what we want (as it generates wrong specs).
  2623     "/ therefore check:
  2624     prop view == aView ifFalse:[^ nil].
  2625 
  2626     spec := prop spec copy.
  2627     spec layoutFromView:aView.
  2628     ^ spec
  2629 
  2630     "Modified (comment): / 30-07-2013 / 09:47:51 / cg"
  2631 !
  2632 
  2633 specForSelection
  2634     "returns the spec assigned to current single selection or nil.
  2635      Nil is also returned for multiple selections (sigh)"
  2636 
  2637     |theSpec|
  2638 
  2639     theSpec := self specFor:(self singleSelection).
  2640     theSpec isNil ifTrue:[
  2641         treeView isCanvasSelected ifTrue:[
  2642             theSpec := treeView canvasSpec.
  2643         ]
  2644     ].
  2645     ^ theSpec
  2646 !
  2647 
  2648 updateFromSpec:aSpec
  2649     "update current selected view from specification
  2650     "
  2651     |props name|
  2652 
  2653     aSpec class == WindowSpec ifTrue:[
  2654          ^ treeView canvasSpec:aSpec
  2655     ].
  2656 
  2657     self singleSelection notNil ifTrue:[
  2658         self withSelectionHiddenDo:[
  2659             self transaction:#specification selectionDo:[:aView|
  2660 
  2661                 props   := self propertyOfView:aView.
  2662                 name    := (aSpec name) withoutSeparators.
  2663 
  2664                 name isNil ifTrue:[
  2665                     "/ not yet given a name
  2666                     (name ~= props name) ifTrue:[
  2667                         (self propertyOfName:name) notNil ifTrue:[
  2668                             name := props name
  2669                         ]
  2670                     ].
  2671                 ].
  2672                 aSpec name:name.
  2673                 self createUndoSpecModify:props.
  2674                 self rebuildView:aView fromSpec:aSpec withBuilder:nil.
  2675                 props spec:(aSpec copy).
  2676                 treeView propertyChanged:props.
  2677             ]
  2678         ]
  2679     ]
  2680 
  2681     "Modified: / 17-08-2011 / 13:56:38 / cg"
  2682     "Modified (format): / 18-08-2011 / 02:19:01 / cg"
  2683 ! !
  2684 
  2685 !UIPainterView methodsFor:'testing'!
  2686 
  2687 canChangeLayoutOfView:aView
  2688     "returns true if the view can change its layout.
  2689      This is dependent on its parent view."
  2690 
  2691     |item parent|
  2692 
  2693     item := treeView itemOfView:aView.
  2694     item isNil ifTrue:[
  2695         "/ I don't know anything about that view (cg: how can this happen ?)
  2696         "/ self breakPoint:#cg.
  2697         ^ false
  2698     ].
  2699     parent := item parent.
  2700     parent isNil ifTrue:[
  2701         "/ that view has no parent (cg: does this mean its the canvas itself ?)
  2702         "/ self breakPoint:#cg.
  2703         ^ false
  2704     ].
  2705     parent contents view == self ifTrue:[
  2706         "aView is a direct subview of the canvas
  2707          -- and the canvas supports layout changes of its subviews"
  2708         ^ true.
  2709     ].
  2710     ^ parent contents spec class isLayoutContainer not
  2711 !
  2712 
  2713 canExchangeSelectionLayouts
  2714     "returns true if the selection size is exactly 2
  2715      and all elements in the selection can be moved or aligned
  2716     "
  2717     selection size ~~ 2 ifTrue:[
  2718         ^ false
  2719     ].
  2720     ^ self canMoveOrAlignSelection
  2721 !
  2722 
  2723 canGroup
  2724     "test whether selected elements can be grouped; minimum two elements
  2725      must be selected and all must have the same parent"
  2726 
  2727     |selectedNodes parent|
  2728 
  2729     selectedNodes := self selectedNodes.
  2730 
  2731     selectedNodes size < 2ifTrue:[ ^ false ].
  2732 
  2733     parent := selectedNodes first parent.
  2734     parent isNil ifTrue:[ ^ false ].    "/ test whether not the canvas itself is selected
  2735 
  2736     selectedNodes do:[:each|
  2737         each parent ~~ parent ifTrue:[^ false ].
  2738     ].
  2739 
  2740     ^true
  2741 !
  2742 
  2743 canKeepLayoutInSelection
  2744     "returns true if layout can be kept during a paste operation
  2745     "
  2746     |prop|
  2747 
  2748     prop := self propertyOfView:(self singleSelection).
  2749   ^ (prop isNil or:[prop spec class isLayoutContainer not])
  2750 !
  2751 
  2752 canMove:something
  2753     "checks whether something is not nil and if all widgets derived from
  2754      something can change their layout ( move, align, ... operation ).
  2755     "
  2756     something notNil ifTrue:[
  2757         something doIfNotNil:[:aView|
  2758             (self canChangeLayoutOfView:aView) ifFalse:[^ false]
  2759         ].
  2760         ^ true
  2761     ].
  2762     ^ false
  2763 
  2764     "Modified: / 11-04-2018 / 18:19:47 / stefan"
  2765 !
  2766 
  2767 canMoveOrAlignSelection
  2768     "returns true if a selection exists and all elements in the selection
  2769      can be moved or aligned
  2770     "
  2771     ^ self canMove:(self selection)
  2772 !
  2773 
  2774 canResize:something
  2775     "checks whether something is not nil and if all widgets derived from
  2776      something can be resized."
  2777 
  2778     something notNil ifTrue:[
  2779         something doIfNotNil:[:aView|
  2780             (self canResizeView:aView) ifFalse:[^ false]
  2781         ].
  2782         ^ true
  2783     ].
  2784     ^ false
  2785 
  2786     "Modified: / 11-04-2018 / 18:20:09 / stefan"
  2787 !
  2788 
  2789 canResizeSelection
  2790     "returns true if a selection exists and all elements in the selection
  2791      can be resized"
  2792 
  2793     ^ self canResize:(self selection)
  2794 !
  2795 
  2796 canResizeView:aView
  2797     "returns true if the view can be resized.
  2798      This is dependent on its parent view."
  2799 
  2800     |item parent|
  2801 
  2802     item := treeView itemOfView:aView.
  2803     item isNil ifTrue:[
  2804         "/ I don't know anything about that view (cg: how can this happen ?)
  2805         "/ self breakPoint:#cg.
  2806         ^ false
  2807     ].
  2808     parent := item parent.
  2809     parent isNil ifTrue:[
  2810         "/ that view has no parent (cg: does this mean its the canvas itself ?)
  2811         "/ self breakPoint:#cg.
  2812         ^ false
  2813     ].
  2814     parent contents view == self ifTrue:[
  2815         "aView is a direct subview of the canvas
  2816          -- and the canvas supports resizing of its subviews"
  2817         ^ true.
  2818     ].
  2819     ^ parent contents spec class canResizeSubComponents
  2820 !
  2821 
  2822 canUngroup
  2823     "test whether the selected element can be ungrouped; only one
  2824      element is selected and has children"
  2825 
  2826     "/ the #ungroupSelectionWithLayout: dosnot work yet - so disable
  2827 
  2828 "/    |selectedNodes node|
  2829 "/
  2830 "/    selectedNodes := self selectedNodes.
  2831 "/
  2832 "/
  2833 "/    selectedNodes size == 1 ifTrue:[
  2834 "/        node := selectedNodes first.
  2835 "/        node parent isNil ifTrue:[ ^ false ].    "/ test whether not the canvas itself is selected
  2836 "/
  2837 "/        ^ node hasChildren
  2838 "/    ].
  2839     ^ false
  2840 ! !
  2841 
  2842 !UIPainterView methodsFor:'transaction'!
  2843 
  2844 transaction:aType objects:something do:aOneArgBlock
  2845     "opens a transaction and evaluates a block within the transaction; the
  2846      argument to the block is a view from derived from something
  2847     "
  2848     self withinTransaction:aType objects:something do:[
  2849         something doIfNotNil:aOneArgBlock
  2850     ]
  2851 
  2852     "Modified: / 11-04-2018 / 18:20:27 / stefan"
  2853 !
  2854 
  2855 withinTransaction:aType objects:objects do:aNoArgBlock
  2856     "evaluate a block within a transaction"
  2857 
  2858     |text size prop|
  2859 
  2860     objects isNil ifTrue:[ ^ self ].
  2861 
  2862     size := objects size.
  2863 
  2864     objects isCollection ifTrue:[
  2865         size == 0 ifTrue:[ ^ self ].
  2866         size == 1 ifTrue:[ 
  2867             prop := self propertyOfView:(objects first) 
  2868         ]
  2869     ] ifFalse:[
  2870         prop := self propertyOfView:objects
  2871     ].
  2872 
  2873     prop notNil ifTrue:[
  2874         text := prop name
  2875     ] ifFalse:[
  2876         text := size printString, ' elements'
  2877     ].
  2878 
  2879     undoHistory withinTransaction:aType text:text do:aNoArgBlock.
  2880     self undoHistoryChanged.
  2881 ! !
  2882 
  2883 !UIPainterView methodsFor:'undo actions'!
  2884 
  2885 createUndoLayout:aView
  2886     "create undo action before changing a view's layout"
  2887 
  2888     |lyt args prop|
  2889 
  2890     undoHistory isTransactionOpen ifTrue:[
  2891         prop := self propertyOfView:aView.
  2892 
  2893         prop notNil ifTrue:[
  2894             args := Array new:3.
  2895             args at:1 put:(prop identifier).
  2896 
  2897             (lyt := aView geometryLayout) notNil ifTrue:[
  2898                 args at:2 put:#geometryLayout:
  2899             ] ifFalse:[
  2900                 lyt := aView extent.
  2901                 args at:2 put:#extent:
  2902             ].
  2903             args at:3 put:(lyt copy).
  2904             undoHistory addUndoSelector:#undoLayout: withArgs:args.
  2905             self undoHistoryChanged.
  2906         ]
  2907     ]
  2908 
  2909     "Modified (comment): / 31-08-2017 / 20:17:23 / cg"
  2910 !
  2911 
  2912 createUndoRemove:aView
  2913     "create undo method before deleting views
  2914     "
  2915     |item itemParent prop args|
  2916 
  2917     item := treeView detectItemCorespondingToView:aView.
  2918     item isNil ifTrue:[^ self ].
  2919 
  2920     itemParent := item parent.
  2921     itemParent isNil ifTrue:[^ self ].
  2922 
  2923     prop  := item contents.
  2924 
  2925     args := Array
  2926             with:(self fullSpecFor:aView)
  2927             with:(prop identifier)
  2928             with:(itemParent contents identifier)
  2929             with:(itemParent indexOfChild:item).
  2930 
  2931 
  2932     undoHistory addUndoSelector:#'undoRemove:' withArgs:args.
  2933     self undoHistoryChanged.
  2934 !
  2935 
  2936 createUndoSpecModify:aProp
  2937     "undo method when changing the specification for an object
  2938     "
  2939     aProp notNil ifTrue:[
  2940         undoHistory addUndoSelector:#undoSpecModify:
  2941                            withArgs:(Array with:(aProp spec) with:(aProp identifier)).
  2942         self undoHistoryChanged.
  2943     ]
  2944 !
  2945 
  2946 createUndoStartPointEndPoint:aComponent
  2947     "create an undo action before changing aComponent"
  2948 
  2949     |args prop|
  2950 
  2951     undoHistory isTransactionOpen ifTrue:[
  2952         prop := self propertyOfView:aComponent.
  2953 
  2954         prop notNil ifTrue:[
  2955             args := Array new:4.
  2956             args at:1 put:(prop identifier).
  2957             args at:2 put:#'startPoint:endPoint:'.
  2958             args at:3 put:(aComponent startPoint).
  2959             args at:4 put:(aComponent endPoint).
  2960             undoHistory addUndoSelector:#undoStartPointEndPoint: withArgs:args.
  2961             self undoHistoryChanged.
  2962         ]
  2963     ]
  2964 !
  2965 
  2966 undoCreate:something
  2967     "undo method for creating or pasting an object"
  2968 
  2969     something doIfNotNil:[:anId|self remove:(self findViewWithId:anId)].
  2970 
  2971     "Modified: / 11-04-2018 / 18:20:46 / stefan"
  2972 !
  2973 
  2974 undoHistory
  2975     ^ undoHistory
  2976 
  2977     "Created: / 30.10.2001 / 13:42:45 / cg"
  2978 !
  2979 
  2980 undoLayout:args
  2981     "undo method to set the old layout; see 'createUndoLayout:'
  2982     "
  2983     |view|
  2984 
  2985     (view := self findViewWithId:(args at:1)) notNil ifTrue:[
  2986         view perform:(args at:2) with:(args at:3).
  2987         self elementChangedSize:view.
  2988         self layoutChanged.
  2989     ]
  2990 !
  2991 
  2992 undoRemove:args
  2993     "undo method when removing an object; see 'createUndoRemove:'
  2994     "
  2995     |frame prop view position parentId|
  2996 
  2997     position := args at:4 ifAbsent:nil.
  2998     parentId := args at:3 ifAbsent:nil.
  2999 
  3000     parentId notNil ifTrue:[
  3001         frame := self findViewWithId:parentId.
  3002     ].
  3003 
  3004     frame isNil ifTrue:[ frame := self. ].
  3005 
  3006     view := self addSpec:(args at:1)
  3007                  builder:(UIBuilder new isEditing:true)
  3008                       in:frame 
  3009              beforeIndex:position.
  3010 
  3011     view realize.
  3012     prop := self propertyOfView:view.
  3013     prop identifier:(args at:2).
  3014 !
  3015 
  3016 undoSpecModify:args
  3017     "undo method when changing a spec; see 'createUndoSpecModify:'
  3018     "
  3019     |view spec props|
  3020 
  3021     props := self propertyOfIdentifier:(args at:2).
  3022 
  3023     props notNil ifTrue:[
  3024 	view    := props view.
  3025 	spec    := args at:1.
  3026 
  3027 	props spec:spec.
  3028 	self rebuildView:view fromSpec:spec withBuilder:nil.
  3029 	treeView propertyChanged:props.
  3030     ]
  3031 !
  3032 
  3033 undoStartPointEndPoint:args
  3034     "undo method to set the old start/endPoint; see 'createUndoStartPointEndPoint:'
  3035     "
  3036     |view|
  3037 
  3038     (view := self findViewWithId:(args at:1)) notNil ifTrue:[
  3039         view perform:(args at:2) with:(args at:3) with:(args at:4).
  3040         self elementChangedSize:view.
  3041         self layoutChanged.
  3042     ]
  3043 ! !
  3044 
  3045 !UIPainterView::ViewProperty class methodsFor:'instance creation'!
  3046 
  3047 new
  3048     Identifier notNil ifTrue:[Identifier := Identifier + 1]
  3049 		     ifFalse:[Identifier := 1].
  3050 
  3051   ^ self basicNew initialize
  3052 ! !
  3053 
  3054 !UIPainterView::ViewProperty methodsFor:'accessing'!
  3055 
  3056 identifier
  3057     "return the unique identifier assigned to property
  3058     "
  3059     ^ identifier
  3060 !
  3061 
  3062 identifier:anIdentifier
  3063     "set the unique identifier assigned to property; called after an restore of
  3064      a deleted instance
  3065     "
  3066     identifier := anIdentifier
  3067 !
  3068 
  3069 spec
  3070     "return the value of the instance variable 'spec' (automatically generated)"
  3071 
  3072     ^ spec
  3073 !
  3074 
  3075 spec:something
  3076     "set the value of the instance variable 'spec' (automatically generated)"
  3077 
  3078     spec := something.
  3079 !
  3080 
  3081 view
  3082     "return the value of the instance variable 'view' (automatically generated)"
  3083 
  3084     ^ view
  3085 !
  3086 
  3087 view:something
  3088     "set the value of the instance variable 'view' (automatically generated)"
  3089 
  3090     view := something.
  3091 ! !
  3092 
  3093 !UIPainterView::ViewProperty methodsFor:'initialization'!
  3094 
  3095 initialize
  3096     super initialize.
  3097     identifier := Identifier
  3098 ! !
  3099 
  3100 !UIPainterView::ViewProperty methodsFor:'misc'!
  3101 
  3102 extractNumberStartingAt:anIndex
  3103     "return the number from the name starting at anIndex (or 0 if there is no number)."
  3104 
  3105     "/ cg: code cleanup.
  3106     ^ Integer 
  3107         readFrom:(self name readStream skip:(anIndex-1))
  3108         onError:0
  3109 
  3110 "/    |val|
  3111 "/
  3112 "/    val := 0.
  3113 "/
  3114 "/    self name from:anIndex do:[:c|
  3115 "/        c isDigit ifTrue:[val := val * 10 + c digitValue]
  3116 "/                 ifFalse:[^ 0]
  3117 "/    ].
  3118 "/    ^ val
  3119 
  3120     "
  3121      (self basicNew spec:(ButtonSpec new name:'button12')) extractNumberStartingAt:7 
  3122     "
  3123 ! !
  3124 
  3125 !UIPainterView::ViewProperty methodsFor:'spec messages'!
  3126 
  3127 doesNotUnderstand:aMessage
  3128     spec notNil ifTrue:[
  3129         (spec respondsTo:(aMessage selector)) ifTrue:[^ aMessage sendTo:spec]
  3130     ].
  3131     ('[UIPainter::ViewProperty] warning: message ignored: ',aMessage selector) errorPrintCR.
  3132     ^ nil
  3133 !
  3134 
  3135 layout
  3136     ^ spec layout
  3137 !
  3138 
  3139 layout:aLayout
  3140     spec layout:aLayout
  3141 !
  3142 
  3143 name
  3144     ^ spec name
  3145 !
  3146 
  3147 name:aName
  3148     spec name:aName
  3149 ! !
  3150 
  3151 !UIPainterView class methodsFor:'documentation'!
  3152 
  3153 version
  3154     ^ '$Header$'
  3155 !
  3156 
  3157 version_CVS
  3158     ^ '$Header$'
  3159 ! !
  3160 
  3161 
  3162 UIPainterView initialize!