UIPainterView.st
author Patrik Svestka <patrik.svestka@gmail.com>
Wed, 14 Nov 2018 12:07:51 +0100
branchjv
changeset 3630 5e718e0a754e
parent 3360 b7f7e48455dd
child 3387 462d9e0dea1f
permissions -rw-r--r--
Issue #239: Fix all Smalltak/X source files to be in unicode (UTF8 without BOM) and prefixed by "{ Encoding: utf8 }" when any unicode character is present

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