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