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