hg/stx-libtool2: UIPainterView.st@e7b7c5379e4b (annotated)

60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1	"
156 b332d7117c40 added copyrights Claus Gittinger <cg@exept.de> parents: 154 diff changeset	2	COPYRIGHT (c) 1995 by Claus Gittinger / eXept Software AG
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	3	All Rights Reserved
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	4
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	5	This software is furnished under a license and may be used
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	6	only in accordance with the terms of that license and with the
742 688fd0a0b0fd code generation comment tz parents: 723 diff changeset	7	inclusion of the above copyright notice. This software may not
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	8	be provided or otherwise made available to, or used by, any
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	9	other person. No title to or ownership of the software is
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	10	hereby transferred.
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	11	"
1387 65c9df9cb1ad change selection behaviour after delete ca parents: 1366 diff changeset	12	"{ Package: 'stx:libtool2' }"
65c9df9cb1ad change selection behaviour after delete ca parents: 1366 diff changeset	13
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	14	UIObjectView subclass:#UIPainterView
278 5b7dfe33b497 drag & drop offset Claus Gittinger <cg@exept.de> parents: 238 diff changeset	15	instanceVariableNames:'treeView listHolder superclassName className methodName
1467 b46624bb6994 use white handles, if the views background color is dark. Claus Gittinger <cg@exept.de> parents: 1450 diff changeset	16	categoryName handleColorBlack handleColorWhite handleMasterColor'
925 e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	17	classVariableNames:'HandCursor RedefineAspectMethods AspectsAsInstances'
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	18	poolDictionaries:''
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	19	category:'Interface-UIPainter'
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	20	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	21
211 45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	22	Object subclass:#ViewProperty
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	23	instanceVariableNames:'view spec identifier'
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	24	classVariableNames:'Identifier'
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	25	poolDictionaries:''
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	26	privateIn:UIPainterView
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	27	!
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	28
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	29	!UIPainterView class methodsFor:'documentation'!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	30
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	31	copyright
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	32	"
156 b332d7117c40 added copyrights Claus Gittinger <cg@exept.de> parents: 154 diff changeset	33	COPYRIGHT (c) 1995 by Claus Gittinger / eXept Software AG
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	34	All Rights Reserved
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	35
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	36	This software is furnished under a license and may be used
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	37	only in accordance with the terms of that license and with the
742 688fd0a0b0fd code generation comment tz parents: 723 diff changeset	38	inclusion of the above copyright notice. This software may not
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	39	be provided or otherwise made available to, or used by, any
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	40	other person. No title to or ownership of the software is
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	41	hereby transferred.
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	42	"
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	43	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	44
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	45	documentation
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	46	"
128 9779b7459a1c selection and update from selection ca parents: 121 diff changeset	47	buildIn view used by the UIPainter; from this view, the layout of the
9779b7459a1c selection and update from selection ca parents: 121 diff changeset	48	new application derives from.
9779b7459a1c selection and update from selection ca parents: 121 diff changeset	49
9779b7459a1c selection and update from selection ca parents: 121 diff changeset	50	[see also:]
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	51	UIBuilder
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	52	UIObjectView
156 b332d7117c40 added copyrights Claus Gittinger <cg@exept.de> parents: 154 diff changeset	53
b332d7117c40 added copyrights Claus Gittinger <cg@exept.de> parents: 154 diff changeset	54	[author:]
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	55	Claus Gittinger
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	56	Claus Atzkern
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	57	"
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	58	! !
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	59
1225 0aa39cc5f0a3 Initialize class vars. Stefan Vogel <sv@exept.de> parents: 1201 diff changeset	60	!UIPainterView class methodsFor:'initialization'!
0aa39cc5f0a3 Initialize class vars. Stefan Vogel <sv@exept.de> parents: 1201 diff changeset	61
0aa39cc5f0a3 Initialize class vars. Stefan Vogel <sv@exept.de> parents: 1201 diff changeset	62	initialize
0aa39cc5f0a3 Initialize class vars. Stefan Vogel <sv@exept.de> parents: 1201 diff changeset	63
1494 115ae5972b27 * empty log message * Claus Gittinger <cg@exept.de> parents: 1474 diff changeset	64	AspectsAsInstances := true. "/ false.
1225 0aa39cc5f0a3 Initialize class vars. Stefan Vogel <sv@exept.de> parents: 1201 diff changeset	65	RedefineAspectMethods := false.
0aa39cc5f0a3 Initialize class vars. Stefan Vogel <sv@exept.de> parents: 1201 diff changeset	66
0aa39cc5f0a3 Initialize class vars. Stefan Vogel <sv@exept.de> parents: 1201 diff changeset	67	"Created: / 22.9.1999 / 12:32:31 / stefan"
0aa39cc5f0a3 Initialize class vars. Stefan Vogel <sv@exept.de> parents: 1201 diff changeset	68	! !
0aa39cc5f0a3 Initialize class vars. Stefan Vogel <sv@exept.de> parents: 1201 diff changeset	69
698 5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	70	!UIPainterView class methodsFor:'code generation mode'!
5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	71
925 e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	72	generateAspectsAsInstanceVariables
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	73	"if on, aspects are held as instance variables;
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	74	if off (the default), they are kept in the bindings dictionary.
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	75	"
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	76	^ AspectsAsInstances
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	77
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	78	"Created: / 29.7.1998 / 11:21:38 / cg"
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	79	"Modified: / 29.7.1998 / 11:22:01 / cg"
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	80	!
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	81
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	82	generateAspectsAsInstanceVariables:aBoolean
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	83	"if on, aspects are held as instance variables;
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	84	if off (the default), they are kept in the bindings dictionary.
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	85	"
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	86	AspectsAsInstances := aBoolean
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	87
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	88	"Created: / 29.7.1998 / 11:21:26 / cg"
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	89	"Modified: / 29.7.1998 / 11:22:11 / cg"
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	90	!
e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	91
742 688fd0a0b0fd code generation comment tz parents: 723 diff changeset	92	redefineAspectMethods
698 5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	93	"redefine methods yes or no. If a method is defined in super class
5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	94	should the message be reinstalled ?
5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	95	"
1225 0aa39cc5f0a3 Initialize class vars. Stefan Vogel <sv@exept.de> parents: 1201 diff changeset	96	^ RedefineAspectMethods
698 5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	97
1225 0aa39cc5f0a3 Initialize class vars. Stefan Vogel <sv@exept.de> parents: 1201 diff changeset	98	"Modified: / 22.9.1999 / 12:33:03 / stefan"
698 5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	99	!
5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	100
742 688fd0a0b0fd code generation comment tz parents: 723 diff changeset	101	redefineAspectMethods:aBoolean
698 5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	102	"redefine methods yes or no. If a method is defined in super class
5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	103	should the message be reinstalled ?
5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	104	"
742 688fd0a0b0fd code generation comment tz parents: 723 diff changeset	105	RedefineAspectMethods := aBoolean
698 5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	106
5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	107
5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	108	! !
5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	109
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	110	!UIPainterView class methodsFor:'defaults'!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	111
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	112	defaultMenuMessage
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	113	"This message is the default yo be sent to the menuHolder to get a menu
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	114	"
121 96d6feeeb049 middleButtonMen: ca parents: 119 diff changeset	115	^ #showMiddleButtonMenu
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	116
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	117
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	118	! !
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	119
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	120	!UIPainterView methodsFor:'accessing'!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	121
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	122	application
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	123	^ nil
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	124
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	125	"Modified: 6.9.1995 / 00:46:44 / claus"
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	126	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	127
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	128	applicationName
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	129	^ self className
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	130	!
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	131
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	132	applicationName:aName
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	133	self className:aName
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	134	!
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	135
1977 cf8a54d02ac0 code cleanup & refactoring Claus Gittinger <cg@exept.de> parents: 1959 diff changeset	136	class:aClass superclassName:aSuperclassName selector:aSelector
cf8a54d02ac0 code cleanup & refactoring Claus Gittinger <cg@exept.de> parents: 1959 diff changeset	137	self assert:(aClass isBehavior).
cf8a54d02ac0 code cleanup & refactoring Claus Gittinger <cg@exept.de> parents: 1959 diff changeset	138	className := aClass name.
cf8a54d02ac0 code cleanup & refactoring Claus Gittinger <cg@exept.de> parents: 1959 diff changeset	139	superclassName := aSuperclassName.
cf8a54d02ac0 code cleanup & refactoring Claus Gittinger <cg@exept.de> parents: 1959 diff changeset	140	methodName := aSelector.
cf8a54d02ac0 code cleanup & refactoring Claus Gittinger <cg@exept.de> parents: 1959 diff changeset	141	!
cf8a54d02ac0 code cleanup & refactoring Claus Gittinger <cg@exept.de> parents: 1959 diff changeset	142
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	143	className
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	144	^ className
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	145	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	146
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	147	className:aName
1977 cf8a54d02ac0 code cleanup & refactoring Claus Gittinger <cg@exept.de> parents: 1959 diff changeset	148	self assert:(aName isString).
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	149	className := aName
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	150	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	151
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	152	className:aClassName superclassName:aSuperclassName selector:aSelector
1977 cf8a54d02ac0 code cleanup & refactoring Claus Gittinger <cg@exept.de> parents: 1959 diff changeset	153	self assert:(aClassName isString).
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	154	className := aClassName.
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	155	superclassName := aSuperclassName.
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	156	methodName := aSelector.
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	157	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	158
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	159	methodName
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	160	^ methodName
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	161	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	162
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	163	methodName:aName
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	164	methodName := aName
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	165	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	166
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	167	selectNames:aStringOrCollection
1031 7ce4b97f2c43 code cleanup Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	168	\|prop coll s n newSel\|
7ce4b97f2c43 code cleanup Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	169
7ce4b97f2c43 code cleanup Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	170	(aStringOrCollection size == 0) ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	171	newSel := nil.
1031 7ce4b97f2c43 code cleanup Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	172	] ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	173	(s := aStringOrCollection) isString ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	174	s size == 1 ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	175	s := s first
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	176	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	177	coll := OrderedCollection new.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	178
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	179	s do:[:aName\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	180	(prop := self propertyOfName:aName) notNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	181	coll add:(prop view)
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	182	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	183	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	184	(n := coll size) == 1 ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	185	newSel := coll at:1
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	186	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	187	n == 0 ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	188	newSel := nil
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	189	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	190	newSel := coll
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	191	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	192	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	193	^ self select:newSel.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	194	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	195	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	196
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	197	prop := self propertyOfName:s.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	198	prop isNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	199	newSel := nil
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	200	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	201	newSel := prop view
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	202	].
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	203	].
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	204
1031 7ce4b97f2c43 code cleanup Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	205	^ self select:newSel
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	206	! !
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	207
111 c6699a14d3d9 tools ca parents: 103 diff changeset	208	!UIPainterView methodsFor:'change & update'!
c6699a14d3d9 tools ca parents: 103 diff changeset	209
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	210	layoutChanged
1445 d2654a3b1e3a * empty log message * Claus Gittinger <cg@exept.de> parents: 1441 diff changeset	211	treeView notNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	212	treeView layoutChanged
1445 d2654a3b1e3a * empty log message * Claus Gittinger <cg@exept.de> parents: 1441 diff changeset	213	]
111 c6699a14d3d9 tools ca parents: 103 diff changeset	214	! !
c6699a14d3d9 tools ca parents: 103 diff changeset	215
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	216	!UIPainterView methodsFor:'copy & cut & paste'!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	217
1744 c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	218	commonContainerOf:someComponents
c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	219	\|container\|
c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	220
c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	221	container := someComponents first container.
c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	222	[container notNil
c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	223	and:[ (someComponents conform:[:eachComponent \| eachComponent isComponentOf:container]) not]]
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	224	whileTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	225	container := container container.
1744 c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	226	].
c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	227	^ container
c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	228	!
c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	229
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	230	copySelection
1959 fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	231	"copy the selection into the cut & paste-buffer"
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	232
698 5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	233	\|specs coll sel\|
5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	234
5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	235	sel := treeView selection.
71 407d25aca670 checkin from browser ca parents: 69 diff changeset	236
128 9779b7459a1c selection and update from selection ca parents: 121 diff changeset	237	coll := self minSetOfSuperViews:(self selection).
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	238
71 407d25aca670 checkin from browser ca parents: 69 diff changeset	239	coll notNil ifTrue:[
776 1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	240	"/ self select:nil.
1870 771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	241	specs := coll collect:[:aView\| self fullSpecFor:aView ].
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	242	self setClipboardObject:specs.
776 1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	243	"/ treeView selection: sel
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	244	].
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	245	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	246
723 60e8ffac2f38 #deleteSelection in #deleteTotalSelection renamed tz parents: 712 diff changeset	247	deleteSelection
1959 fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	248	"delete the selection buffered"
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	249
887 79a6e12e1d0f after deleting a widget do select the neighbour then the parent (step 2) tz parents: 886 diff changeset	250	self deleteSelectionBuffered: true
79a6e12e1d0f after deleting a widget do select the neighbour then the parent (step 2) tz parents: 886 diff changeset	251	!
79a6e12e1d0f after deleting a widget do select the neighbour then the parent (step 2) tz parents: 886 diff changeset	252
79a6e12e1d0f after deleting a widget do select the neighbour then the parent (step 2) tz parents: 886 diff changeset	253	deleteSelectionBuffered: buffered
698 5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	254	"cut the selection into the cut&paste-buffer
1959 fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	255	and open a transaction"
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	256
1574 e4897b61395c Remove unused method var Stefan Vogel <sv@exept.de> parents: 1568 diff changeset	257	\|specs coll index oldSelection newSelection treeModel children size nd\|
71 407d25aca670 checkin from browser ca parents: 69 diff changeset	258
1621 112670159075 cg: check if selection change is allowed BEFORE changing the tm parents: 1574 diff changeset	259	treeView askForSelectionChangeAllowed ifFalse:[^ self].
112670159075 cg: check if selection change is allowed BEFORE changing the tm parents: 1574 diff changeset	260
128 9779b7459a1c selection and update from selection ca parents: 121 diff changeset	261	coll := self minSetOfSuperViews:(self selection).
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	262
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	263	coll notNil ifTrue:[
1870 771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	264	treeView cvsEventsDisabledDo:[
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	265	treeModel := treeView model.
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	266	oldSelection := treeModel selectedNodes at:1 ifAbsent: nil.
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	267
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	268	oldSelection notNil ifTrue:[
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	269	children := oldSelection parent children.
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	270	(size := children size) > 1 ifTrue:[
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	271	index := children identityIndexOf:oldSelection.
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	272	size == index ifTrue:[
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	273	index := index - 1
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	274	].
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	275	newSelection := children at:index ifAbsent:1.
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	276	] ifFalse:[
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	277	newSelection := oldSelection parent
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	278	].
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	279	newSelection := treeModel indexOf:newSelection.
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	280	] ifFalse:[
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	281	newSelection := 1
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	282	].
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	283
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	284	self hideSelection.
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	285	selection := nil.
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	286	specs := coll collect:[:aView\| self fullSpecFor:aView ].
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	287
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	288	self withinTransaction:#cut objects:coll do:[
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	289	coll reverseDo:[:aView\|
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	290	self createUndoRemove:aView.
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	291	self remove:aView.
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	292	]
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	293	].
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	294	buffered ifTrue: [self setClipboardObject:specs].
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	295	treeView selection:nil.
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	296	treeView selection:(Array with: newSelection).
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	297	(nd := treeView selectedNode) notNil ifTrue:[
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	298	self setSelection:nd contents view withRedraw:true.
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	299	]
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	300	]
698 5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	301	]
5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	302	!
5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	303
723 60e8ffac2f38 #deleteSelection in #deleteTotalSelection renamed tz parents: 712 diff changeset	304	deleteTotalSelection
1959 fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	305	"delete the selection"
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	306
887 79a6e12e1d0f after deleting a widget do select the neighbour then the parent (step 2) tz parents: 886 diff changeset	307	self deleteSelectionBuffered: false
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	308	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	309
1832 ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	310	getSelectedViewsAndSpecs
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	311	"return an array filed with selected views and corresponding specs.
1959 fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	312	Nil if there is none."
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	313
1832 ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	314	\|specs coll sel\|
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	315
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	316	sel := treeView selection.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	317
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	318	coll := self minSetOfSuperViews:(self selection).
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	319
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	320	coll isNil ifTrue:[^ nil].
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	321
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	322	specs := coll collect:[:aView\| self fullSpecFor:aView ].
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	323	^ Array with: coll with: specs
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	324	!
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	325
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	326	pasteBuffer
1959 fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	327	"add the objects in the paste-buffer to the object view"
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	328
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	329	\|sel\|
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	330
1872 ab5cc43b193a get selection interface changed ca parents: 1870 diff changeset	331	sel := self pasteSpecifications:(self getClipboardObject) keepLayout:false.
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	332
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	333	sel notNil ifTrue:[
1872 ab5cc43b193a get selection interface changed ca parents: 1870 diff changeset	334	self select:sel.
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	335	].
89 35c5711729c2 so far so good ca parents: 86 diff changeset	336	!
35c5711729c2 so far so good ca parents: 86 diff changeset	337
1338 3c1a528c50db added paste-keeping-absolute-position function Claus Gittinger <cg@exept.de> parents: 1308 diff changeset	338	pasteKeepingPosition
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	339	"add the objects in the paste-buffer to the object view;
1338 3c1a528c50db added paste-keeping-absolute-position function Claus Gittinger <cg@exept.de> parents: 1308 diff changeset	340	translate the layout as appropriate, to position the component
1959 fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	341	at the same absolute position (relative to topView) as before"
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	342
1338 3c1a528c50db added paste-keeping-absolute-position function Claus Gittinger <cg@exept.de> parents: 1308 diff changeset	343	\|sel\|
3c1a528c50db added paste-keeping-absolute-position function Claus Gittinger <cg@exept.de> parents: 1308 diff changeset	344
3c1a528c50db added paste-keeping-absolute-position function Claus Gittinger <cg@exept.de> parents: 1308 diff changeset	345	sel := self
1872 ab5cc43b193a get selection interface changed ca parents: 1870 diff changeset	346	pasteSpecifications:(self getClipboardObject)
ab5cc43b193a get selection interface changed ca parents: 1870 diff changeset	347	keepLayout:true
ab5cc43b193a get selection interface changed ca parents: 1870 diff changeset	348	keepPosition:true
ab5cc43b193a get selection interface changed ca parents: 1870 diff changeset	349	at:nil.
1338 3c1a528c50db added paste-keeping-absolute-position function Claus Gittinger <cg@exept.de> parents: 1308 diff changeset	350
3c1a528c50db added paste-keeping-absolute-position function Claus Gittinger <cg@exept.de> parents: 1308 diff changeset	351	sel notNil ifTrue:[
1872 ab5cc43b193a get selection interface changed ca parents: 1870 diff changeset	352	self select:sel.
1338 3c1a528c50db added paste-keeping-absolute-position function Claus Gittinger <cg@exept.de> parents: 1308 diff changeset	353	].
3c1a528c50db added paste-keeping-absolute-position function Claus Gittinger <cg@exept.de> parents: 1308 diff changeset	354	!
3c1a528c50db added paste-keeping-absolute-position function Claus Gittinger <cg@exept.de> parents: 1308 diff changeset	355
89 35c5711729c2 so far so good ca parents: 86 diff changeset	356	pasteSpecifications:aSpecificationOrList keepLayout:keepLayout
1959 fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	357	"add the specs to the object view; returns list of pasted components"
278 5b7dfe33b497 drag & drop offset Claus Gittinger <cg@exept.de> parents: 238 diff changeset	358
5b7dfe33b497 drag & drop offset Claus Gittinger <cg@exept.de> parents: 238 diff changeset	359	^ self
1959 fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	360	pasteSpecifications:aSpecificationOrList
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	361	keepLayout:keepLayout
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	362	at:nil
278 5b7dfe33b497 drag & drop offset Claus Gittinger <cg@exept.de> parents: 238 diff changeset	363
5b7dfe33b497 drag & drop offset Claus Gittinger <cg@exept.de> parents: 238 diff changeset	364	"Modified: 11.8.1997 / 01:00:35 / cg"
5b7dfe33b497 drag & drop offset Claus Gittinger <cg@exept.de> parents: 238 diff changeset	365	!
5b7dfe33b497 drag & drop offset Claus Gittinger <cg@exept.de> parents: 238 diff changeset	366
5b7dfe33b497 drag & drop offset Claus Gittinger <cg@exept.de> parents: 238 diff changeset	367	pasteSpecifications:aSpecificationOrList keepLayout:keepLayout at:aPointOrNil
1959 fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	368	"add the specs to the object view; returns list of pasted components"
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	369
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	370	^ self
1959 fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	371	pasteSpecifications:aSpecificationOrList
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	372	keepLayout:keepLayout
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	373	keepPosition:false
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	374	at:aPointOrNil
1338 3c1a528c50db added paste-keeping-absolute-position function Claus Gittinger <cg@exept.de> parents: 1308 diff changeset	375	!
3c1a528c50db added paste-keeping-absolute-position function Claus Gittinger <cg@exept.de> parents: 1308 diff changeset	376
3c1a528c50db added paste-keeping-absolute-position function Claus Gittinger <cg@exept.de> parents: 1308 diff changeset	377	pasteSpecifications:aSpecificationOrList keepLayout:keepLayout keepPosition:keepPosition at:aPointOrNil
1878 6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	378	"add the specs to the object view; returns list of pasted components"
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	379
1744 c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	380	\|paste pasteOrigin pasteOffset builder newSel bounds containerToPasteInto\|
1621 112670159075 cg: check if selection change is allowed BEFORE changing the tm parents: 1574 diff changeset	381
112670159075 cg: check if selection change is allowed BEFORE changing the tm parents: 1574 diff changeset	382	treeView askForSelectionChangeAllowed ifFalse:[^ nil].
112670159075 cg: check if selection change is allowed BEFORE changing the tm parents: 1574 diff changeset	383
1744 c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	384	containerToPasteInto := self singleSelection.
c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	385	containerToPasteInto isNil ifTrue:[
1878 6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	386	self selection size > 0 ifTrue:[
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	387	containerToPasteInto := self commonContainerOf:self selection
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	388	] ifFalse:[
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	389	containerToPasteInto := self
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	390	].
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	391	self selection:containerToPasteInto.
1744 c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	392	].
c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	393
c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	394	(self canPasteInto:containerToPasteInto) ifFalse:[
1878 6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	395	containerToPasteInto notNil ifTrue:[
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	396	"/ search up parent list for something we can paste into
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	397	[containerToPasteInto notNil and:[(self canPasteInto:containerToPasteInto) not]] whileTrue:[
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	398	containerToPasteInto := containerToPasteInto container.
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	399	].
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	400	self selection:containerToPasteInto.
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	401	].
1621 112670159075 cg: check if selection change is allowed BEFORE changing the tm parents: 1574 diff changeset	402	].
1752 78d47dc11501 oops - dropping specs Claus Gittinger <cg@exept.de> parents: 1746 diff changeset	403	containerToPasteInto isNil ifTrue:[
1878 6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	404	containerToPasteInto := self
1752 78d47dc11501 oops - dropping specs Claus Gittinger <cg@exept.de> parents: 1746 diff changeset	405	].
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	406
89 35c5711729c2 so far so good ca parents: 86 diff changeset	407	(self canPaste:aSpecificationOrList) ifFalse:[
1878 6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	408	Dialog warn:'Cannot paste into selected component (not a container ?)'.
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	409	^ nil
89 35c5711729c2 so far so good ca parents: 86 diff changeset	410	].
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	411
776 1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	412	aSpecificationOrList isCollection ifTrue:[
1878 6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	413	paste := aSpecificationOrList
776 1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	414	] ifFalse:[
1878 6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	415	paste := Array with:aSpecificationOrList
776 1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	416	].
1878 6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	417	self setClipboardObject:nil.
776 1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	418
1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	419	newSel := OrderedCollection new.
1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	420	builder := UIBuilder new isEditing:true.
1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	421
1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	422	className notNil ifTrue:[
1878 6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	423	builder applicationClass:(self resolveName:className)
776 1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	424	].
1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	425
1338 3c1a528c50db added paste-keeping-absolute-position function Claus Gittinger <cg@exept.de> parents: 1308 diff changeset	426	(keepLayout not or:[keepPosition]) ifTrue:[
1878 6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	427	pasteOffset := 0@0.
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	428
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	429	keepPosition ifTrue:[
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	430	pasteOrigin := device translatePoint:0@0
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	431	fromView:self
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	432	toView:containerToPasteInto.
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	433	] ifFalse:[
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	434	aPointOrNil isNil ifTrue:[
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	435	pasteOrigin := self sensor mousePoint.
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	436	pasteOrigin := device translatePoint:pasteOrigin
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	437	fromView:nil
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	438	toView:containerToPasteInto.
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	439	] ifFalse:[
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	440	pasteOrigin := device translatePoint:aPointOrNil
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	441	fromView:self
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	442	toView:containerToPasteInto.
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	443	]
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	444	].
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	445
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	446	bounds := Rectangle origin:0@0 extent:(containerToPasteInto bounds extent)
776 1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	447	].
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	448
776 1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	449	paste do:[:aSpec\|
1878 6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	450	\|view newOrigin\|
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	451
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	452	view := self addSpec:aSpec builder:builder in:containerToPasteInto.
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	453
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	454	keepPosition ifTrue:[
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	455	self moveObject:view to:(view origin + pasteOrigin).
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	456	] ifFalse:[
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	457	keepLayout ifFalse:[
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	458	(bounds containsPoint:pasteOrigin) ifFalse:[
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	459	newOrigin := pasteOffset.
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	460	] ifTrue:[
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	461	newOrigin := pasteOrigin + pasteOffset.
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	462	].
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	463	self moveObject:view to:newOrigin.
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	464	pasteOffset := pasteOffset + 4
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	465	].
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	466	].
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	467	view realize.
6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	468	newSel add:view.
776 1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	469	].
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	470
776 1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	471	self withinTransaction:#paste objects:newSel do:[
1878 6ae0cf83738f Use #setClipboardText: instead of obsolete #setTextSelection: Stefan Vogel <sv@exept.de> parents: 1872 diff changeset	472	undoHistory addUndoSelector:#undoCreate:
1954 1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	473	withArgs:(newSel collect:[:v\|(self propertyOfView:v) identifier]).
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	474	self undoHistoryChanged.
776 1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	475	].
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	476
776 1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	477	self realizeAllSubViews.
1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	478	newSel do:[:v\| v raise].
1744 c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	479	self elementChangedSize:containerToPasteInto.
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	480
776 1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	481	newSel size == 1 ifTrue:[newSel := newSel at:1].
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	482	^ newSel
1500 36c0b4b268b8 use new translatePoint:fromView:toView: Claus Gittinger <cg@exept.de> parents: 1494 diff changeset	483
36c0b4b268b8 use new translatePoint:fromView:toView: Claus Gittinger <cg@exept.de> parents: 1494 diff changeset	484	"Modified: / 10.10.2001 / 14:15:12 / cg"
89 35c5711729c2 so far so good ca parents: 86 diff changeset	485	!
35c5711729c2 so far so good ca parents: 86 diff changeset	486
35c5711729c2 so far so good ca parents: 86 diff changeset	487	pasteWithLayout
1959 fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	488	"add the objects in the paste-buffer to the object view;
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	489	don't change the layout"
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	490
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	491	\|sel\|
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	492
1872 ab5cc43b193a get selection interface changed ca parents: 1870 diff changeset	493	sel := self pasteSpecifications:(self getClipboardObject) keepLayout:true.
89 35c5711729c2 so far so good ca parents: 86 diff changeset	494
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	495	sel notNil ifTrue:[
1872 ab5cc43b193a get selection interface changed ca parents: 1870 diff changeset	496	self select:sel.
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	497	].
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	498	! !
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	499
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	500	!UIPainterView methodsFor:'drag & drop'!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	501
2116 90fc11105f36 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 2112 diff changeset	502	canDrop:aDropContext
90fc11105f36 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 2112 diff changeset	503	^ self canDropObjects:aDropContext dropObjects
90fc11105f36 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 2112 diff changeset	504
90fc11105f36 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 2112 diff changeset	505	"Created: / 13-10-2006 / 17:46:11 / cg"
90fc11105f36 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 2112 diff changeset	506	!
90fc11105f36 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 2112 diff changeset	507
90fc11105f36 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 2112 diff changeset	508	canDropObjects:aCollectionOfDropObjects
1914 229b3e455c98 code cleanup Claus Gittinger <cg@exept.de> parents: 1894 diff changeset	509	"returns true if something can be dropped"
229b3e455c98 code cleanup Claus Gittinger <cg@exept.de> parents: 1894 diff changeset	510
2112 74dfb69c88d4 * empty log message * Claus Gittinger <cg@exept.de> parents: 2039 diff changeset	511	^ (aCollectionOfDropObjects size == 1
74dfb69c88d4 * empty log message * Claus Gittinger <cg@exept.de> parents: 2039 diff changeset	512	and:[ self enabled
74dfb69c88d4 * empty log message * Claus Gittinger <cg@exept.de> parents: 2039 diff changeset	513	and:[ self numberOfSelections <= 1
74dfb69c88d4 * empty log message * Claus Gittinger <cg@exept.de> parents: 2039 diff changeset	514	and:[ aCollectionOfDropObjects first theObject isKindOf:UISpecification ]]])
74dfb69c88d4 * empty log message * Claus Gittinger <cg@exept.de> parents: 2039 diff changeset	515
2116 90fc11105f36 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 2112 diff changeset	516	"Created: / 13-10-2006 / 16:09:24 / cg"
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	517	!
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	518
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	519	canPaste
1914 229b3e455c98 code cleanup Claus Gittinger <cg@exept.de> parents: 1894 diff changeset	520	"returns true if there is something which can be pasted in the clipboard"
229b3e455c98 code cleanup Claus Gittinger <cg@exept.de> parents: 1894 diff changeset	521
1872 ab5cc43b193a get selection interface changed ca parents: 1870 diff changeset	522	^ self canPaste:(self getClipboardObject)
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	523	!
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	524
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	525	canPaste:something
1914 229b3e455c98 code cleanup Claus Gittinger <cg@exept.de> parents: 1894 diff changeset	526	"returns true if something could be pasted"
229b3e455c98 code cleanup Claus Gittinger <cg@exept.de> parents: 1894 diff changeset	527
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	528	\|el size\|
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	529
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	530	((size := self numberOfSelections) <= 1 and:[self enabled]) ifFalse:[
1914 229b3e455c98 code cleanup Claus Gittinger <cg@exept.de> parents: 1894 diff changeset	531	^ false
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	532	].
1914 229b3e455c98 code cleanup Claus Gittinger <cg@exept.de> parents: 1894 diff changeset	533	something isCollection
229b3e455c98 code cleanup Claus Gittinger <cg@exept.de> parents: 1894 diff changeset	534	ifTrue:[something notEmpty ifTrue:[el := something first]]
229b3e455c98 code cleanup Claus Gittinger <cg@exept.de> parents: 1894 diff changeset	535	ifFalse:[el := something].
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	536
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	537	(el isKindOf:UISpecification) ifFalse:[
1914 229b3e455c98 code cleanup Claus Gittinger <cg@exept.de> parents: 1894 diff changeset	538	^ false
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	539	].
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	540
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	541	size == 1 ifTrue:[
1914 229b3e455c98 code cleanup Claus Gittinger <cg@exept.de> parents: 1894 diff changeset	542	^ self canPasteInto:(self singleSelection)
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	543	].
1914 229b3e455c98 code cleanup Claus Gittinger <cg@exept.de> parents: 1894 diff changeset	544	^ true
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	545	!
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	546
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	547	canPasteInto:aView
1914 229b3e455c98 code cleanup Claus Gittinger <cg@exept.de> parents: 1894 diff changeset	548	"return true, if I can paste into a view"
229b3e455c98 code cleanup Claus Gittinger <cg@exept.de> parents: 1894 diff changeset	549
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	550	\|prop\|
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	551
1870 771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	552	aView isNil ifTrue:[ ^ false ].
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	553
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	554	(prop := self propertyOfView:aView) notNil ifTrue:[
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	555	^ prop spec class supportsSubComponents
89 35c5711729c2 so far so good ca parents: 86 diff changeset	556	].
1870 771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	557	^ aView specClass supportsSubComponents.
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	558	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	559
2116 90fc11105f36 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 2112 diff changeset	560	dropObjects:aCollectionOfDropObjects at:aPoint
1833 6ad211a201cf * empty log message * werner parents: 1832 diff changeset	561	\|spec newSel oldSel dragOffset widg doit\|
6ad211a201cf * empty log message * werner parents: 1832 diff changeset	562
6ad211a201cf * empty log message * werner parents: 1832 diff changeset	563	doit := true.
288 675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	564	self selection notNil ifTrue:[
1953 3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	565	oldSel := self singleSelection.
3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	566
3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	567	"/ search selections hierarchy for a widget into which we can paste
3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	568	widg := oldSel.
3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	569	[widg isNil or:[self canPasteInto:widg]] whileFalse:[
3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	570	widg notNil ifTrue:[
3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	571	widg := widg container
3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	572	].
3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	573	].
3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	574
3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	575	oldSel := nil.
3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	576	self setSelection:widg withRedraw:true.
231 75de472d579f check whether selection is a view or a collection ca parents: 223 diff changeset	577	].
1953 3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	578	spec := (aCollectionOfDropObjects at:1) theObject.
1833 6ad211a201cf * empty log message * werner parents: 1832 diff changeset	579	doit ifTrue:[
1953 3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	580	dragOffset := DragAndDropManager dragOffsetQuerySignal query.
3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	581	newSel := self pasteSpecifications:spec keepLayout:false at:aPoint - dragOffset.
3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	582
3b5022bccca4 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 1914 diff changeset	583	self select:(oldSel ? newSel)
1833 6ad211a201cf * empty log message * werner parents: 1832 diff changeset	584	].
1060 0332a41de5c5 Use #query instead of #raise when invoking QuerySignals Stefan Vogel <sv@exept.de> parents: 1058 diff changeset	585
2116 90fc11105f36 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 2112 diff changeset	586	"Modified: / 18-03-1999 / 18:29:43 / stefan"
90fc11105f36 drag and drop cleanup Claus Gittinger <cg@exept.de> parents: 2112 diff changeset	587	"Created: / 13-10-2006 / 16:09:27 / cg"
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	588	! !
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	589
361 6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	590	!UIPainterView methodsFor:'event handling'!
6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	591
6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	592	keyPress:key x:x y:y view:aView
376 3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	593	"a delegated keyEvent from aView"
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	594
361 6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	595	self keyPress:key x:x y:y
6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	596
376 3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	597	"Modified: / 31.10.1997 / 20:27:22 / cg"
361 6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	598	!
6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	599
6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	600	keyRelease:key x:x y:y view:aView
376 3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	601	"a delegated keyEvent from aView"
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	602
361 6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	603	self keyRelease:key x:x y:y
6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	604
376 3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	605	"Modified: / 31.10.1997 / 20:27:32 / cg"
754 04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	606	!
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	607
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	608	sizeChanged:how
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	609
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	610	super sizeChanged:how.
754 04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	611
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	612	self layoutChanged
361 6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	613	! !
6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	614
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	615	!UIPainterView methodsFor:'generating output'!
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	616
352 088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	617	aspectMethods
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	618	"extract a list of aspect methods - for browsing"
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	619
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	620	\|cls methods\|
352 088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	621
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	622	className isNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	623	self warn:'No class defined !!'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	624	^ #()
352 088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	625	].
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	626
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	627	cls := self resolveName:className.
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	628	methods := IdentitySet new.
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	629
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	630	self aspectSelectorsAndTypesDo:
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	631	[:selector :typeSymbol \|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	632	\|skip\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	633
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	634	(cls includesSelector:selector) ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	635
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	636	skip := false.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	637	(typeSymbol == #modelAspect) ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	638	(cls isSubclassOf:SimpleDialog) ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	639	skip := SimpleDialog includesSelector:(selector asSymbol)
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	640	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	641	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	642	skip ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	643	methods add:(cls compiledMethodAt:selector)
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	644	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	645	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	646	].
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	647
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	648	^ methods
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	649
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	650	"Created: / 25.10.1997 / 18:58:25 / cg"
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	651	"Modified: / 26.10.1997 / 15:06:18 / cg"
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	652	!
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	653
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	654	aspectSelectorsAndTypesDo:aTwoArgBlock
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	655	"evaluate aBlock for every aspect methods selector; 2nd arg describes the aspects type"
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	656
1726 7117789f3020 Remove unused vars Stefan Vogel <sv@exept.de> parents: 1714 diff changeset	657	\|cls selector protoSpec\|
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	658
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	659	className isNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	660	self warn:'No class defined !!'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	661	^ self
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	662	].
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	663
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	664	cls := self resolveName:className.
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	665
352 088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	666	treeView propertiesDo:[:aProp\|
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	667	\|selector\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	668
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	669	(selector := aProp model) notNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	670	selector isArray ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	671	aTwoArgBlock value:(selector asSymbol) value:#modelAspect
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	672	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	673	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	674
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	675	(selector := aProp menu) notNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	676	selector isArray ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	677	aTwoArgBlock value:(selector asSymbol) value:#menu
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	678	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	679	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	680
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	681	(aProp spec aspectSelectors) do:[:aSel \|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	682	aSel isArray ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	683	aTwoArgBlock value:(aSel asSymbol) value:#channelAspect
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	684	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	685	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	686	aProp spec actionSelectors do:[:aSel\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	687	aSel isArray ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	688	aTwoArgBlock value:(aSel asSymbol) value:#actionSelector
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	689	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	690	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	691	aProp spec valueSelectors do:[:aSel\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	692	aSel isArray ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	693	aTwoArgBlock value:(aSel asSymbol) value:#valueSelector
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	694	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	695	]
352 088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	696	].
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	697
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	698	protoSpec := treeView canvasSpec.
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	699
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	700	(selector := protoSpec menu) notNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	701	selector isArray ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	702	aTwoArgBlock value:(selector asSymbol) value:#menu
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	703	].
352 088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	704	].
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	705	!
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	706
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	707	generateActionMethodFor:aspect spec:protoSpec inClass:targetClass
568 7c4482bf37cf allow more than 1 numArg for an action ca parents: 511 diff changeset	708	\|selector args showIt code alreadyInSuperclass numArgs method\|
288 675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	709
675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	710	selector := aspect asSymbol.
141 d06c04391233 generate actions with argument ca parents: 137 diff changeset	711
288 675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	712	alreadyInSuperclass := targetClass superclass canUnderstand:selector.
675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	713
568 7c4482bf37cf allow more than 1 numArg for an action ca parents: 511 diff changeset	714	numArgs := selector numArgs.
7c4482bf37cf allow more than 1 numArg for an action ca parents: 511 diff changeset	715	method := aspect.
7c4482bf37cf allow more than 1 numArg for an action ca parents: 511 diff changeset	716
7c4482bf37cf allow more than 1 numArg for an action ca parents: 511 diff changeset	717	numArgs == 1 ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	718	args := 'anArgument'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	719	showIt := ''' , anArgument printString , '' ...''.\'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	720	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	721	args := ''.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	722	showIt := ' ...''.\'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	723
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	724	numArgs ~~ 0 ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	725	method := ''.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	726
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	727	selector keywords keysAndValuesDo:[:i :key\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	728	method := method, key, 'arg', i printString, ' '
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	729	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	730	]
149 e652608690b1 help ... ca parents: 146 diff changeset	731	].
141 d06c04391233 generate actions with argument ca parents: 137 diff changeset	732
288 675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	733	code := '!!' , targetClass name , ' methodsFor:''actions''!!\\' ,
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	734	method , args , '\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	735	' "automatically generated by UIPainter ..."\\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	736	' "*** the code below performs no action"\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	737	' "*** (except for some feedback on the Transcript)"\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	738	' "*** Please change as required and accept in the browser."\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	739	'\' .
288 675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	740
675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	741	alreadyInSuperclass ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	742	code := code ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	743	' "action for ' , aspect , ' is already provided in a superclass."\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	744	' "It may be redefined here ..."\\'.
288 675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	745	] ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	746	code := code ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	747	' "action to be added ..."\\'.
288 675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	748	].
675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	749
675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	750	code := code ,
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	751	' Transcript showCR:self class name, '': '.
288 675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	752	alreadyInSuperclass ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	753	code := code , 'inherited '.
288 675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	754	].
675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	755	code := code , 'action for ' , aspect , showIt.
675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	756
675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	757	alreadyInSuperclass ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	758	code := code ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	759	' super ' , aspect , args , '.\'.
288 675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	760	].
675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	761
675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	762	code := code ,
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	763	'!! !!\\'.
288 675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	764	^ code withCRs
675327dd4d7d change drop mechanism: ca parents: 285 diff changeset	765
352 088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	766	"Modified: / 25.10.1997 / 19:18:50 / cg"
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	767	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	768
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	769	generateAspectMethodCode
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	770	"generate aspect, action & menu methods
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	771	- but do not overwrite existing ones.
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	772	Return a string ready to compile into the application class."
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	773
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	774	^ self generateAspectMethodCodeFiltering:nil
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	775	!
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	776
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	777	generateAspectMethodCodeFiltering:aFilterOrEmpty
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	778	"generate aspect, action & menu methods
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	779	- but do not overwrite existing ones.
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	780	Return a string ready to compile into the application class."
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	781
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	782	\|cls codePieces skip protoSpec thisCode
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	783	definedMethodSelectors iVars t exportSels\|
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	784
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	785	cls := self targetClass.
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	786	cls isNil ifTrue:[
2024 6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	787	^ nil
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	788	].
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	789
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	790	codePieces := OrderedCollection new.
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	791	definedMethodSelectors := IdentitySet new.
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	792
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	793	treeView propertiesDo:[:aProp\|
2024 6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	794	\|modelSelector\|
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	795
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	796	protoSpec := aProp spec.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	797
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	798	(modelSelector := aProp model) notNil ifTrue:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	799	self generateCodeFrom:(Array with:modelSelector) in:cls
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	800	do:[:aSel\|
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	801	(aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	802	skip := false.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	803
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	804	(cls isSubclassOf:SimpleDialog) ifTrue:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	805	skip := SimpleDialog includesSelector:aSel
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	806	].
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	807	(definedMethodSelectors includes:aSel) ifTrue:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	808	skip := true.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	809	].
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	810
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	811	skip ifFalse:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	812	"/ kludge ..
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	813	"/ (protoSpec isKindOf:ActionButtonSpec)
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	814	(protoSpec defaultModelIsCallBackMethodSelector:aSel)
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	815	ifTrue:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	816	thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls).
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	817	] ifFalse:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	818	thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls).
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	819	].
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	820	codePieces add:thisCode.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	821	definedMethodSelectors add:aSel.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	822	Transcript showCR:'code generated for aspect: ' , aSel
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	823	] ifTrue:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	824	Transcript showCR:'*** no code generated for aspect: ' , aSel , ' (method already exists)'
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	825	].
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	826	].
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	827	].
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	828	].
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	829
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	830	"/ for each aspect, generate getter (if not yet implemented)
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	831	self generateCodeFrom:(aProp spec aspectSelectors) in:cls
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	832	do:[:aSel\|
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	833	(aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	834	(definedMethodSelectors includes:aSel) ifFalse:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	835	thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls).
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	836	codePieces add:thisCode.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	837	definedMethodSelectors add:aSel.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	838	Transcript showCR:'code generated for aspect: ' , aSel
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	839	]
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	840	]
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	841	].
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	842
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	843	"/ exported aspects - need setter methods
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	844	exportSels := (treeView exportedAspects ? #()) collect:[:entry \| (entry subAspect , ':') asSymbol].
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	845	self generateCodeFrom:exportSels in:cls
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	846	do:[:aSel\|
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	847	\|aspect\|
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	848
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	849	(aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	850	(definedMethodSelectors includes:aSel) ifFalse:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	851	aspect := (aSel copyWithoutLast:1) asSymbol.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	852	thisCode := (self generateAspectSetMethodFor:aspect spec:protoSpec inClass:cls).
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	853	codePieces add:thisCode.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	854	definedMethodSelectors add:aSel.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	855	Transcript showCR:'export code generated for aspect: ' , aSel
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	856	]
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	857	]
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	858	].
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	859
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	860	self generateCodeFrom:(aProp spec actionSelectors) in:cls
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	861	do:[:aSel\|
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	862	(aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	863	(definedMethodSelectors includes:aSel) ifFalse:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	864	thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls).
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	865	codePieces add:thisCode.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	866	definedMethodSelectors add:aSel.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	867	Transcript showCR:'action generated for aspect: ' , aSel
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	868	]
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	869	]
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	870	].
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	871
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	872	self generateCodeFrom:(aProp spec valueSelectors) in:cls
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	873	do:[:aSel\|
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	874	(aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	875	(definedMethodSelectors includes:aSel) ifFalse:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	876	"/ uppercase: - assume its a globals name.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	877	aSel isUppercaseFirst ifFalse:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	878	thisCode := (self generateValueMethodFor:aSel spec:protoSpec inClass:cls).
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	879	codePieces add:thisCode.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	880	definedMethodSelectors add:aSel.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	881	Transcript showCR:'code generated for aspect: ' , aSel
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	882	]
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	883	]
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	884	]
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	885	].
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	886	].
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	887
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	888	AspectsAsInstances ifTrue:[
2024 6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	889	iVars := cls instVarNames asOrderedCollection.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	890	definedMethodSelectors do:[:ivar \|
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	891	(iVars includes:ivar) ifFalse:[
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	892	iVars add:ivar
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	893	]
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	894	].
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	895	iVars := iVars asArray.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	896	t := cls shallowCopy.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	897	t setInstanceVariableString:iVars asStringCollection asString.
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	898	codePieces addFirst:(t definition , '!!\' withCRs).
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	899	].
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	900
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	901	^ String
2024 6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	902	streamContents:
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	903	[:codeStream \|
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	904	codePieces do:[:eachPiece \| codeStream nextPutAll:eachPiece].
6e9f614d6c9e * empty log message * Claus Gittinger <cg@exept.de> parents: 1977 diff changeset	905	].
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	906
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	907	"Modified: / 29.7.1998 / 12:21:19 / cg"
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	908	!
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	909
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	910	generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass
1257 acb8c0a58ef3 dataSPec defaultValue when generating aspects Claus Gittinger <cg@exept.de> parents: 1252 diff changeset	911	\|modelClass modelValueString modelValue modelGen code\|
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	912
149 e652608690b1 help ... ca parents: 146 diff changeset	913	modelClass := protoSpec defaultModelClassFor:aspect.
1257 acb8c0a58ef3 dataSPec defaultValue when generating aspects Claus Gittinger <cg@exept.de> parents: 1252 diff changeset	914	modelValueString := protoSpec defaultModelValueStringFor:aspect.
acb8c0a58ef3 dataSPec defaultValue when generating aspects Claus Gittinger <cg@exept.de> parents: 1252 diff changeset	915	modelValueString notNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	916	modelGen := modelValueString
1257 acb8c0a58ef3 dataSPec defaultValue when generating aspects Claus Gittinger <cg@exept.de> parents: 1252 diff changeset	917	] ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	918	modelValue := protoSpec defaultModelValueFor:aspect.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	919	modelValue isNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	920	modelGen := modelClass name , ' new'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	921	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	922	modelGen := modelValue storeString , ' asValue'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	923	].
352 088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	924
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	925	].
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	926
655 093cba68e10a simplified to make microsoft cc happy Claus Gittinger <cg@exept.de> parents: 588 diff changeset	927	code := '!!' , targetClass name , ' methodsFor:''aspects''!!\\' ,
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	928	aspect , '\' ,
352 088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	929	' "automatically generated by UIPainter ..."\\' ,
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	930	' "*** the code below creates a default model when invoked."\' ,
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	931	' "*** (which may not be the one you wanted)"\' ,
1441 36916e4ce9ab generate better comments (in aspect methods) Claus Gittinger <cg@exept.de> parents: 1429 diff changeset	932	' "*** Please change as required and accept it in the browser."\' ,
36916e4ce9ab generate better comments (in aspect methods) Claus Gittinger <cg@exept.de> parents: 1429 diff changeset	933	' "*** (and replace this comment by something more useful ;-)"\' .
655 093cba68e10a simplified to make microsoft cc happy Claus Gittinger <cg@exept.de> parents: 588 diff changeset	934
1474 d2ee565fa32a * empty log message * Claus Gittinger <cg@exept.de> parents: 1467 diff changeset	935
925 e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	936	AspectsAsInstances ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	937	code := code , '\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	938	' ' , aspect , ' isNil ifTrue:[\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	939	' ' , aspect , ' := ' , modelGen , '.\'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	940	modelClass ~~ TriggerValue ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	941	code := code ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	942	'"/ if your app needs to be notified of changes, uncomment one of the lines below:\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	943	'"/ ' , aspect , ' addDependent:self.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	944	'"/ ' , aspect , ' onChangeSend:#', aspect ,'Changed to:self.\'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	945	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	946	code := code ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	947	' ].\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	948	' ^ ' , aspect ,'.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	949	'!! !!\\'
925 e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	950	] ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	951	code := code , '\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	952	' \|holder\|\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	953	'\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	954	' (holder := builder bindingAt:#' , aspect , ') isNil ifTrue:[\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	955	' holder := ', modelGen, '.\',
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	956	' builder aspectAt:#' , aspect , ' put:holder.\'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	957	modelClass ~~ TriggerValue ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	958	code := code ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	959	'"/ if your app needs to be notified of changes, uncomment one of the lines below:\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	960	'"/ holder addDependent:self.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	961	'"/ holder onChangeSend:#', aspect ,'Changed to:self.\'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	962	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	963	code := code ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	964	' ].\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	965	' ^ holder.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	966	'!! !!\\'
925 e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	967	].
1361 9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	968
925 e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	969	^ code withCRs
352 088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	970
925 e6ddd46581c3 added option of generating aspects as instvars. Claus Gittinger <cg@exept.de> parents: 887 diff changeset	971	"Modified: / 29.7.1998 / 11:29:16 / cg"
1225 0aa39cc5f0a3 Initialize class vars. Stefan Vogel <sv@exept.de> parents: 1201 diff changeset	972	"Modified: / 22.9.1999 / 12:33:47 / stefan"
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	973	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	974
1358 c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	975	generateAspectSelectorsMethod
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	976	"generate aspectSelectors method.
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	977	Return a string ready to compile into the application class."
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	978
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	979	\|cls code spec\|
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	980
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	981	cls := self targetClass.
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	982	cls isNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	983	^ nil
1358 c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	984	].
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	985
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	986	spec := treeView exportedAspects.
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	987	spec size == 0 ifTrue:[^ nil].
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	988
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	989	"/ make it an array ...
1362 b710bba663cb fixed generateAspectSelectors code generator Claus Gittinger <cg@exept.de> parents: 1361 diff changeset	990	spec := spec collect:[:entry \| \|subAspect type\|
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	991	subAspect := entry subAspect asSymbol.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	992	(type := entry type) isNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	993	subAspect
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	994	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	995	Array with:subAspect with:type asSymbol
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	996	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	997	].
1358 c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	998	spec := spec asArray.
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	999
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1000	code := '!!' , cls name , ' class methodsFor:''plugIn spec''!!\\' .
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1001
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1002	code := code , 'aspectSelectors
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1003	"This resource specification was automatically generated
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1004	by the UIPainter of ST/X."
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1005
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1006	"Do not manually edit this. If it is corrupted,
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1007	the UIPainter may not be able to read the specification."
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1008
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1009	"Return a description of exported aspects;
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1010	these can be connected to aspects of an embedding application
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1011	(if this app is embedded in a subCanvas)."
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1012
1362 b710bba663cb fixed generateAspectSelectors code generator Claus Gittinger <cg@exept.de> parents: 1361 diff changeset	1013	^ #(\'.
b710bba663cb fixed generateAspectSelectors code generator Claus Gittinger <cg@exept.de> parents: 1361 diff changeset	1014	spec do:[:el \| code := code , (' ' , el storeString , '\') ].
b710bba663cb fixed generateAspectSelectors code generator Claus Gittinger <cg@exept.de> parents: 1361 diff changeset	1015	code := code , ' ).\'.
b710bba663cb fixed generateAspectSelectors code generator Claus Gittinger <cg@exept.de> parents: 1361 diff changeset	1016	code := code , '\!!\'.
1358 c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1017	code := code withCRs.
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1018	^ code
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1019
1362 b710bba663cb fixed generateAspectSelectors code generator Claus Gittinger <cg@exept.de> parents: 1361 diff changeset	1020	"Modified: / 18.2.2000 / 02:08:34 / cg"
1358 c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1021	!
c0116e25a2ac generateAspectSelectorsMethod ca parents: 1347 diff changeset	1022
1361 9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1023	generateAspectSetMethodFor:aspect spec:protoSpec inClass:targetClass
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1024	\|code\|
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1025
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1026	code := '!!' , targetClass name , ' methodsFor:''aspects - exported''!!\\' ,
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1027	aspect , ':something\' ,
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1028	' "automatically generated by UIPainter ..."\\' ,
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1029	' "This method is used when I am embedded as subApplication,"\' ,
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1030	' "and the mainApp wants to connect its aspects to mine."\'.
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1031
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1032	AspectsAsInstances ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1033	code := (code , '\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1034	'"/ ' , aspect , ' notNil ifTrue:[\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1035	'"/ ' , aspect , ' removeDependent:self.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1036	'"/ ].\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1037	' ' , aspect ,' := something.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1038	'"/ ' , aspect ,' notNil ifTrue:[\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1039	'"/ ' , aspect , ' addDependent:self.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1040	'"/ ].\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1041	' ^ self.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1042	'!! !!\\')
1361 9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1043	] ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1044	code := (code , '\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1045	'"/ \|holder\|\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1046	'\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1047	'"/ (holder := builder bindingAt:#' , aspect , ') notNil ifTrue:[\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1048	'"/ holder removeDependent:self.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1049	'"/ ].\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1050	' builder aspectAt:#' , aspect , ' put:something.\',
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1051	'"/ something notNil ifTrue:[\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1052	'"/ something addDependent:self.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1053	'"/ ].\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1054	' ^ self.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1055	'!! !!\\')
1361 9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1056	].
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1057
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1058	^ code withCRs
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1059
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1060	"Modified: / 29.7.1998 / 11:29:16 / cg"
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1061	"Modified: / 22.9.1999 / 12:33:47 / stefan"
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1062	!
9020214f03e6 generate aspect-setters for exported aspects Claus Gittinger <cg@exept.de> parents: 1358 diff changeset	1063
698 5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	1064	generateCodeFrom:aListOfSelectors in:aClass do:aBlock
1696 0cb66a26b156 code cleanup Claus Gittinger <cg@exept.de> parents: 1683 diff changeset	1065	\|realSelectors redefCondition redefMessage\|
0cb66a26b156 code cleanup Claus Gittinger <cg@exept.de> parents: 1683 diff changeset	1066
0cb66a26b156 code cleanup Claus Gittinger <cg@exept.de> parents: 1683 diff changeset	1067	realSelectors := aListOfSelectors select:[:sel \| sel isArray not].
698 5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	1068
744 20cbba6d7e96 oops - no #redefineMethods found tz parents: 742 diff changeset	1069	self class redefineAspectMethods ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1070	redefCondition := [:cls :sel \| (cls includesSelector:sel) not].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1071	redefMessage := ' skipped - already implemented in the class'.
698 5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	1072	] ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1073	redefCondition := [:cls :sel \| (cls canUnderstand:sel) not].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1074	redefMessage := ' skipped - already implemented in the class (or superclass)'.
1696 0cb66a26b156 code cleanup Claus Gittinger <cg@exept.de> parents: 1683 diff changeset	1075	].
0cb66a26b156 code cleanup Claus Gittinger <cg@exept.de> parents: 1683 diff changeset	1076
0cb66a26b156 code cleanup Claus Gittinger <cg@exept.de> parents: 1683 diff changeset	1077	realSelectors do:[:aSelector\|
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1078	(redefCondition value:aClass value:aSelector) ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1079	aBlock value:aSelector asSymbol
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1080	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1081	Transcript showCR:('#' , aSelector , redefMessage)
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1082	]
698 5bf234e0e451 redefine methods flag tz parents: 662 diff changeset	1083	]
376 3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1084	!
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1085
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1086	generateHookMethodFor:selectorSpec comment:commentWhen note:noteOrNil defaultCode:defaultCode inClass:targetClass
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1087	^ ('!!' , targetClass name , ' methodsFor:''hooks''!!\\' ,
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1088	selectorSpec , '\' ,
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1089	' "automatically generated by UIPainter ..."\\' ,
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1090	' "*** the code here does nothing. It is invoked when"\' ,
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1091	' "*** ' , commentWhen , '"\' ,
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1092	' "*** Please change as required and accept in the browser."\' ,
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1093	'\' ,
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1094	' "specific code to be added below ..."\' ,
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1095	' "' , (noteOrNil ? '') , '"\' ,
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1096	'\' ,
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1097	(defaultCode ? '^ self.') ,
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1098	'!! !!\\') withCRs
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1099
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1100	"Modified: / 25.10.1997 / 19:22:17 / cg"
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1101	"Created: / 31.10.1997 / 17:31:53 / cg"
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1102	!
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1103
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1104	generateHookMethods
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1105	"generate hook methods
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1106	- but do not overwrite existing ones.
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1107	Return a string ready to compile into the application class."
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1108
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1109	\|cls\|
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1110
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1111	cls := self targetClass.
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1112	cls isNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1113	^ nil
376 3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1114	].
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1115
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1116	^ self generateHookMethodsInClass:cls.
376 3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1117	!
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1118
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1119	generateHookMethodsInClass:targetClass
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1120	\|code\|
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1121
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1122	code := ''.
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1123
1554 d5e4612bf7cf implements -> includesSelector Claus Gittinger <cg@exept.de> parents: 1543 diff changeset	1124	(targetClass includesSelector:#postBuildWith:) ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1125	code := code
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1126	, (self
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1127	generateHookMethodFor:'postBuildWith:aBuilder'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1128	comment:'the widgets have been built, but before the view is opened'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1129	note:'or after the super send'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1130	defaultCode:' super postBuildWith:aBuilder'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1131	inClass:targetClass)
376 3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1132	].
1554 d5e4612bf7cf implements -> includesSelector Claus Gittinger <cg@exept.de> parents: 1543 diff changeset	1133	(targetClass includesSelector:#postOpenWith:) ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1134	code := code
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1135	, (self
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1136	generateHookMethodFor:'postOpenWith:aBuilder'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1137	comment:'the topView has been opened, but before events are dispatched for it'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1138	note:'or after the super send'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1139	defaultCode:' super postOpenWith:aBuilder'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1140	inClass:targetClass)
376 3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1141	].
1554 d5e4612bf7cf implements -> includesSelector Claus Gittinger <cg@exept.de> parents: 1543 diff changeset	1142	(targetClass includesSelector:#closeRequest) ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1143	code := code
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1144	, (self
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1145	generateHookMethodFor:'closeRequest'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1146	comment:'the topView has been asked to close'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1147	note:'return without the ''super closeRequest'' to stay open'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1148	defaultCode:' ^super closeRequest'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1149	inClass:targetClass)
376 3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1150	].
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1151	^ code
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1152
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1153	"Modified: / 31.10.1997 / 17:30:34 / cg"
3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1154	"Created: / 31.10.1997 / 17:32:49 / cg"
316 053e2d3089b7 support of menu performer ca parents: 315 diff changeset	1155	!
053e2d3089b7 support of menu performer ca parents: 315 diff changeset	1156
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1157	generateMenuMethodFor:menuSel inClass:targetClass
1805 cf1a9d636bf7 category and comment flags now in Userprefs Claus Gittinger <cg@exept.de> parents: 1785 diff changeset	1158	\|selector args showIt code alreadyInSuperclass numArgs method category\|
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1159
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1160	selector := menuSel asSymbol.
1805 cf1a9d636bf7 category and comment flags now in Userprefs Claus Gittinger <cg@exept.de> parents: 1785 diff changeset	1161	category := UserPreferences current categoryForMenuActionsMethods.
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1162
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1163	alreadyInSuperclass := targetClass superclass canUnderstand:selector.
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1164
1805 cf1a9d636bf7 category and comment flags now in Userprefs Claus Gittinger <cg@exept.de> parents: 1785 diff changeset	1165	code := '!!' , targetClass name , ' methodsFor:''' , category , '''!!\\'.
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1166
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1167	selector = 'openAboutThisApplication' ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1168	code := code ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1169	'openAboutThisApplication\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1170	' "opens an about box for this application."\\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1171	' "automatically generated by UIPainter ..."\\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1172
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1173	' \|rev box myClass clsRev image msg\|\\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1174
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1175	' rev := ''''.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1176	' myClass := self class.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1177
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1178	' (clsRev := myClass revision) notNil ifTrue:[\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1179	' rev := '' (rev: '', clsRev printString, '')''].\\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1180
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1181	' msg := Character cr asString , myClass name asBoldText, rev.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1182	' msg := (msg , ''\\* add more info here *\\'') withCRs.\\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1183	' box := AboutBox title:msg.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1184
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1185	' "/ *** add a #defaultIcon method in the class\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1186	' "/ *** and uncomment the following line:\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1187	' "/ image := self class defaultIcon.\\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1188	' image notNil ifTrue:[\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1189	' box image:image\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1190	' ].\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1191	' box label:(resources string:''About %1'' with:myClass name).\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1192	' box autoHideAfter:10 with:[].\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1193	' box showAtPointer.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1194	'!! !!\\'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1195	^ code withCRs
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1196	].
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1197
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1198	selector = 'menuOpen' ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1199	code := code ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1200	'menuOpen\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1201	' "automatically generated by UIPainter ..."\\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1202	' "*** the code below opens a dialog for file selection"\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1203	' "*** and invokes the #doOpen: method with the selected file."\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1204	' "*** Please change as required and accept in the browser."\\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1205	' \|file\|\\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1206	' file :=\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1207	' (FileSelectionBrowser\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1208	' request: ''Open''\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1209	' fileName: ''''\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1210	' "/ inDirectory: lastOpenDirectory\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1211	' withFileFilters: #(''*'')).\\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1212	' file notNil ifTrue:[\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1213	' "/ lastOpenDirectory := file asFilename directory.\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1214	' self doOpen:file\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1215	' ]\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1216	'!! !!\'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1217	^ code withCRs
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1218	].
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1219
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1220	numArgs := selector numArgs.
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1221	method := selector.
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1222
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1223	numArgs == 1 ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1224	args := 'anArgument'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1225	showIt := ''' , anArgument printString , '' ...''.\'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1226	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1227	args := ''.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1228	showIt := ' ...''.\'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1229
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1230	numArgs ~~ 0 ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1231	method := ''.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1232
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1233	selector keywords keysAndValuesDo:[:i :key\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1234	method := method, key, 'arg', i printString, ' '
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1235	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1236	]
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1237	].
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1238
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1239	code := code ,
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1240	method , args , '\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1241	' "automatically generated by UIPainter ..."\\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1242	' "*** the code below performs no action"\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1243	' "*** (except for some feedback on the Transcript)"\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1244	' "*** Please change as required and accept in the browser."\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1245	'\' .
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1246
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1247	alreadyInSuperclass ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1248	code := code ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1249	' "action for ' , selector , ' is already provided in a superclass."\' ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1250	' "It may be redefined here ..."\\'.
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1251	] ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1252	code := code ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1253	' "action to be added ..."\\'.
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1254	].
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1255
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1256	code := code ,
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1257	' Transcript showCR:self class name, '': '.
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1258	alreadyInSuperclass ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1259	code := code , 'inherited '.
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1260	].
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1261	code := code , 'menu action for ' , selector , showIt.
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1262
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1263	alreadyInSuperclass ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1264	code := code ,
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1265	' super ' , selector , args , '.\'.
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1266	].
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1267
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1268	code := code ,
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1269	'!! !!\\'.
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1270	^ code withCRs
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1271
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1272	"Created: / 23.8.1998 / 16:46:51 / cg"
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1273	"Modified: / 23.8.1998 / 18:13:05 / cg"
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1274	!
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1275
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1276	generateMenuMethods
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1277	"generate menu methods
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1278	- but do not overwrite existing ones.
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1279	Return a string ready to compile into the application class."
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1280
1069 7196ca547f5d code cleanup Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	1281	\|cls code menuSelector thisCode
7196ca547f5d code cleanup Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	1282	definedMethodSelectors
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1283	specArray fullSpec winSpec menuSpec
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1284	\|
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1285
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1286	cls := self targetClass.
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1287	cls isNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1288	^ nil
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1289	].
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1290
1058 243d945b1daf name the (full-)spec tm parents: 1050 diff changeset	1291	specArray := treeView generateFullSpecForComponents:#() named:nil.
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1292	fullSpec := specArray decodeAsLiteralArray.
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1293	winSpec := fullSpec window.
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1294	menuSelector := winSpec menu.
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1295
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1296	(menuSelector notNil
1069 7196ca547f5d code cleanup Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	1297	and:[ (cls respondsTo:menuSelector) ]) ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1298	self warn:'No menu defined (yet)'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1299	^ nil.
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1300	].
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1301	menuSpec := cls perform:menuSelector.
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1302	menuSpec := menuSpec decodeAsLiteralArray.
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1303
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1304	definedMethodSelectors := IdentitySet new.
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1305	code := ''.
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1306
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1307	menuSpec allItemsDo:[:item \|
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1308	\|sel\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1309
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1310	(sel := item value) notNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1311	(definedMethodSelectors includes:sel) ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1312	self generateCodeFrom:(Array with:sel) in:cls do:[:aSel\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1313	thisCode := (self generateMenuMethodFor:aSel inClass:cls).
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1314	code := code, thisCode.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1315	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1316	definedMethodSelectors add:sel.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1317	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1318	]
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1319	].
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1320
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1321	(definedMethodSelectors includes:#menuOpen) ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1322	self generateCodeFrom:(Array with:#doOpen:) in:cls do:[:aSel\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1323	thisCode := (self generateMenuMethodFor:aSel inClass:cls).
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1324	code := code, thisCode.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1325	].
965 4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1326	].
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1327
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1328	^ code
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1329
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1330	"Created: / 23.8.1998 / 16:12:09 / cg"
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1331	"Modified: / 23.8.1998 / 18:12:23 / cg"
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1332	!
4f786b46a569 added menu-action code generation Claus Gittinger <cg@exept.de> parents: 925 diff changeset	1333
188 8091a35bccf1 generateValueMethodFor:aspect spec:protoSpec inClass:targetClass ca parents: 180 diff changeset	1334	generateValueMethodFor:aspect spec:protoSpec inClass:targetClass
8091a35bccf1 generateValueMethodFor:aspect spec:protoSpec inClass:targetClass ca parents: 180 diff changeset	1335	^ ('!!' , targetClass name , ' methodsFor:''values''!!\\' ,
8091a35bccf1 generateValueMethodFor:aspect spec:protoSpec inClass:targetClass ca parents: 180 diff changeset	1336	aspect , '\' ,
352 088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	1337	' "automatically generated by UIPainter ..."\\' ,
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	1338	' "*** the code below returns a default value when invoked."\' ,
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	1339	' "*** (which may not be the one you wanted)"\' ,
088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	1340	' "*** Please change as required and accept in the browser."\' ,
188 8091a35bccf1 generateValueMethodFor:aspect spec:protoSpec inClass:targetClass ca parents: 180 diff changeset	1341	'\' ,
8091a35bccf1 generateValueMethodFor:aspect spec:protoSpec inClass:targetClass ca parents: 180 diff changeset	1342	' "value to be added below ..."\' ,
8091a35bccf1 generateValueMethodFor:aspect spec:protoSpec inClass:targetClass ca parents: 180 diff changeset	1343	' Transcript showCR:self class name , '': no value yet for ' , aspect , ' ...''.\' ,
8091a35bccf1 generateValueMethodFor:aspect spec:protoSpec inClass:targetClass ca parents: 180 diff changeset	1344	'\' ,
8091a35bccf1 generateValueMethodFor:aspect spec:protoSpec inClass:targetClass ca parents: 180 diff changeset	1345	'^ nil.' ,
8091a35bccf1 generateValueMethodFor:aspect spec:protoSpec inClass:targetClass ca parents: 180 diff changeset	1346	'!! !!\\') withCRs
8091a35bccf1 generateValueMethodFor:aspect spec:protoSpec inClass:targetClass ca parents: 180 diff changeset	1347
352 088174fc1e71 support for constant lists; Claus Gittinger <cg@exept.de> parents: 335 diff changeset	1348	"Modified: / 25.10.1997 / 19:22:17 / cg"
188 8091a35bccf1 generateValueMethodFor:aspect spec:protoSpec inClass:targetClass ca parents: 180 diff changeset	1349	!
8091a35bccf1 generateValueMethodFor:aspect spec:protoSpec inClass:targetClass ca parents: 180 diff changeset	1350
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1351	generateWindowSpecMethodSource
457 0b39d43d4324 care for exclas in spec-code Claus Gittinger <cg@exept.de> parents: 445 diff changeset	1352	\|spec str code category cls mthd specCode\|
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1353
310 a68c182d050f support of scrollers and menu for the canvas ca parents: 288 diff changeset	1354	spec := OrderedCollection new.
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1355
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1356	self subViews do:[:aView\|
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1357	\|vSpec\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1358
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1359	"/ care for wrapped views ...
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1360	vSpec := self fullSpecFor:aView.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1361	vSpec isNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1362	aView subViews size == 1 ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1363	vSpec := self fullSpecFor:(aView subViews first).
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1364	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1365	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1366	vSpec isNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1367	self warn:'Oops - could not create spec for some view'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1368	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1369	spec add:vSpec
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1370	].
1058 243d945b1daf name the (full-)spec tm parents: 1050 diff changeset	1371
243d945b1daf name the (full-)spec tm parents: 1050 diff changeset	1372	spec := treeView generateFullSpecForComponents:spec named:methodName.
310 a68c182d050f support of scrollers and menu for the canvas ca parents: 288 diff changeset	1373	str := WriteStream on:String new.
a68c182d050f support of scrollers and menu for the canvas ca parents: 288 diff changeset	1374	UISpecification prettyPrintSpecArray:spec on:str indent:5.
464 dd67c1e99fed oops Claus Gittinger <cg@exept.de> parents: 458 diff changeset	1375	specCode := str contents.
457 0b39d43d4324 care for exclas in spec-code Claus Gittinger <cg@exept.de> parents: 445 diff changeset	1376
0b39d43d4324 care for exclas in spec-code Claus Gittinger <cg@exept.de> parents: 445 diff changeset	1377	(specCode includes:$!!) ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1378	"/ oops - must be chunk format ...
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1379	str := WriteStream on:String new.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1380	str nextPutAllAsChunk:specCode.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1381	specCode := str contents.
457 0b39d43d4324 care for exclas in spec-code Claus Gittinger <cg@exept.de> parents: 445 diff changeset	1382	].
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1383
178 fb8451053c96 keep windowSpec methods category if it already exists Claus Gittinger <cg@exept.de> parents: 175 diff changeset	1384	"/ if that method already exists, do not overwrite the category
fb8451053c96 keep windowSpec methods category if it already exists Claus Gittinger <cg@exept.de> parents: 175 diff changeset	1385
fb8451053c96 keep windowSpec methods category if it already exists Claus Gittinger <cg@exept.de> parents: 175 diff changeset	1386	category := 'interface specs'.
330 643ac5544426 use: ca parents: 327 diff changeset	1387	cls := self resolveName:className.
643ac5544426 use: ca parents: 327 diff changeset	1388
643ac5544426 use: ca parents: 327 diff changeset	1389	cls notNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1390	(mthd := cls class compiledMethodAt:methodName asSymbol) notNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1391	category := mthd category.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1392	]
178 fb8451053c96 keep windowSpec methods category if it already exists Claus Gittinger <cg@exept.de> parents: 175 diff changeset	1393	].
fb8451053c96 keep windowSpec methods category if it already exists Claus Gittinger <cg@exept.de> parents: 175 diff changeset	1394
238 882be7e03af4 renamed claus instVar (;-) Claus Gittinger <cg@exept.de> parents: 231 diff changeset	1395	code := '!!'
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1396	, className , ' class methodsFor:' , category storeString
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1397	, '!!' , '\\'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1398
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1399	, methodName , '\'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1400	, ((ResourceSpecEditor codeGenerationCommentForClass: UIPainter) replChar:$!! withString:'!!!!')
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1401	, '\\ "\'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1402	, (' UIPainter new openOnClass:' , className , ' andSelector:#' , methodName , '\').
1013 c6428ebd2f0d checkin from browser Claus Gittinger <cg@exept.de> parents: 995 diff changeset	1403
1050 355a8ff451b6 care for as-yet-unspecified class in show-spec menu item. Claus Gittinger <cg@exept.de> parents: 1039 diff changeset	1404	(cls notNil and:[cls isSubclassOf:ApplicationModel]) ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1405	code := code
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1406	, (' ' , className , ' new openInterface:#' , methodName , '\').
1013 c6428ebd2f0d checkin from browser Claus Gittinger <cg@exept.de> parents: 995 diff changeset	1407	].
c6428ebd2f0d checkin from browser Claus Gittinger <cg@exept.de> parents: 995 diff changeset	1408
c6428ebd2f0d checkin from browser Claus Gittinger <cg@exept.de> parents: 995 diff changeset	1409	code := code
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1410	,(methodName = 'windowSpec'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1411	ifTrue:[' ' , className , ' open\'] ifFalse: [''])
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1412	, ' "\'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1413
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1414	code := code
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1415	, '\'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1416	, ' <resource: #canvas>\\'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1417	, ' ^ ' , specCode
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1418	, '\'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1419	, '!! !!'
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1420	, '\\'.
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1421
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1422	^ code withCRs
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1423
1013 c6428ebd2f0d checkin from browser Claus Gittinger <cg@exept.de> parents: 995 diff changeset	1424	"Modified: / 5.9.1995 / 21:01:35 / claus"
c6428ebd2f0d checkin from browser Claus Gittinger <cg@exept.de> parents: 995 diff changeset	1425	"Modified: / 15.10.1998 / 11:29:53 / cg"
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1426	!
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1427
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1428	targetClass
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1429	\|cls\|
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1430
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1431	className isNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1432	self warn:'No TargetClass defined !!'.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1433	^ nil
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1434	].
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1435	(cls := self resolveName:className) isNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1436	self warn:('Class ', className asString, ' does not exist !!').
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1437	^ nil
1683 f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1438	].
f95658463570 added selective aspect method generation. Claus Gittinger <cg@exept.de> parents: 1671 diff changeset	1439	^ cls.
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1440	! !
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1441
754 04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1442	!UIPainterView methodsFor:'grid manipulation'!
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1443
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1444	newGrid
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1445	"define a new grid - this is a private helper which has to be
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1446	called after any change in the grid. It (re)creates the gridPixmap,
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1447	clears the view and redraws all visible objects."
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1448
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1449	\|defaultViewBackground\|
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1450
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1451	gridPixmap := nil.
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1452	defaultViewBackground := self class defaultViewBackgroundColor.
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1453
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1454	shown ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1455	self viewBackground: (defaultViewBackground isColor
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1456	ifTrue: [defaultViewBackground]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1457	ifFalse:[Black]).
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1458	self clear.
754 04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1459	].
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1460
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1461	gridShown ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1462	self defineGrid.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1463	gridPixmap colorMap: (defaultViewBackground isColor
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1464	ifTrue: [Array with:defaultViewBackground with:Color darkGray]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1465	ifFalse:[Array with:White with:Black]).
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1466	self viewBackground:gridPixmap.
754 04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1467	].
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1468
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1469	self invalidate
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1470
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1471	! !
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1472
1832 ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1473	!UIPainterView methodsFor:'group & ungroup'!
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1474
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1475	group
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1476
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1477	self groupSelectionWithLayout: false
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1478	!
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1479
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1480	groupSelectionWithLayout: withLayout
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1481	\| spec rect views box layout specs canvas view oldSelection cS nViews menu item xOffset yOffset \|
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1482
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1483	menu := Menu new.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1484	menu receiver: self.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1485	item := MenuItem label:'Box' value:[spec := ViewSpec new].
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1486	menu addItem: item.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1487	item := MenuItem label:'TBox' value:[spec := TBoxSpec new].
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1488	menu addItem: item.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1489	item := MenuItem label:'FramedBox' value:[spec := FramedBoxSpec new].
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1490	menu addItem: item.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1491	item := MenuItem label:'HorizontalPanel' value:[spec := HorizontalPanelViewSpec new].
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1492	menu addItem: item.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1493	item := MenuItem label:'VerticalPanel' value:[spec := VerticalPanelViewSpec new].
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1494	menu addItem: item.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1495	(MenuPanel menu: menu) startUp.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1496	canvas := self painter.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1497	cS := canvas getSelectedViewsAndSpecs.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1498	cS isNil ifTrue:[^self].
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1499	views := cS first.
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1500	specs := cS last.
1832 ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1501	rect := views first frame.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1502	2 to: views size do:[:i\| rect := rect merge: (views at: i) frame].
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1503	layout := LayoutFrame leftFraction:0.0 offset: rect origin x
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1504	rightFraction:0.0 offset: rect corner x + 1
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1505	topFraction:0.0 offset: rect origin y
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1506	bottomFraction:0.0 offset:rect corner y + 1.
1832 ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1507	oldSelection := canvas selection.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1508	canvas select: views first superView.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1509	spec layout: layout.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1510	spec class == VerticalPanelViewSpec ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1511	spec verticalLayout: #topSpace.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1512	spec horizontalLayout: #fit.
1832 ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1513	].
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1514	spec class == HorizontalPanelViewSpec ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1515	spec verticalLayout: #fit.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1516	spec horizontalLayout: #leftSpace.
1832 ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1517	].
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1518
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1519	box := self pasteSpecifications:spec keepLayout:true at:nil.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1520
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1521	xOffset := box origin x.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1522	yOffset := box origin y.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1523	withLayout ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1524	1 to: specs size do:[:i\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1525	view := views at: i.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1526	layout := LayoutFrame leftFraction:0.0 offset: (view origin x - xOffset)
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1527	rightFraction:0.0 offset: (view corner x - xOffset + 1)
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1528	topFraction:0.0 offset: (view origin y - yOffset )
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1529	bottomFraction:0.0 offset: (view corner y - yOffset + 1).
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1530	(specs at: i) layout: layout.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1531	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1532	].
1832 ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1533	canvas selection: oldSelection.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1534	canvas deleteSelection.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1535	canvas selection:box.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1536	nViews := canvas pasteSpecifications:specs keepLayout:true.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1537	canvas selection: box.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1538	!
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1539
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1540	groupWithLayout
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1541
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1542	self groupSelectionWithLayout: true
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1543	!
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1544
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1545	ungroup
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1546
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1547	self ungroupSelectionWithLayout: false
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1548	!
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1549
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1550	ungroupSelectionWithLayout: withLayout
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1551
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1552	\| canvas cS views specs frame view layout superView\|
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1553
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1554	canvas := self painter.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1555	cS := canvas getSelectedViewsAndSpecs.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1556	cS isNil ifTrue:[^self].
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1557	views := cS first first subViews copy.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1558	superView := cS first first superView.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1559	cS last first component isNil ifTrue:[^self].
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1560	cS last first component collection isEmpty ifTrue:[^self].
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1561	specs := cS last first component collection copy.
1832 ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1562	frame := cS first first frame.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1563	canvas deleteSelection.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1564	withLayout ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1565	1 to: specs size do:[:i\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1566	view := views at: i.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1567	layout := LayoutFrame leftFraction:0.0 offset: (view origin x + frame origin x)
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1568	rightFraction:0.0 offset: (view corner x + frame origin x + 1)
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1569	topFraction:0.0 offset: (view origin y + frame origin y )
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1570	bottomFraction:0.0 offset: (view corner y + frame origin y + 1).
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1571	(specs at: i) layout: layout.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1572	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1573	].
1832 ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1574	canvas selection: superView.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1575	canvas pasteSpecifications:specs keepLayout:true.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1576	canvas selection: superView.
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1577	!
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1578
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1579	ungroupWithLayout
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1580
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1581	self ungroupSelectionWithLayout: true
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1582	! !
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1583
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1584	!UIPainterView methodsFor:'initialization'!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1585
770 96f106b0a61e set color on device ca parents: 768 diff changeset	1586	create
1959 fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	1587	"colors on device"
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	1588
770 96f106b0a61e set color on device ca parents: 768 diff changeset	1589	super create.
1959 fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	1590	handleColorBlack := handleColorBlack onDevice:device.
fd6bf76e712a * empty log message * Claus Gittinger <cg@exept.de> parents: 1954 diff changeset	1591	handleColorWhite := handleColorWhite onDevice:device.
1201 c88c6cee0cca #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1191 diff changeset	1592	handleMasterColor := handleMasterColor onDevice:device.
770 96f106b0a61e set color on device ca parents: 768 diff changeset	1593	!
96f106b0a61e set color on device ca parents: 768 diff changeset	1594
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1595	initialize
62 0e8573b4329a so far so good ... ca parents: 60 diff changeset	1596	"setup attributes
0e8573b4329a so far so good ... ca parents: 60 diff changeset	1597	"
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1598	super initialize.
770 96f106b0a61e set color on device ca parents: 768 diff changeset	1599	superclassName := 'ApplicationModel'.
96f106b0a61e set color on device ca parents: 768 diff changeset	1600	className := 'NewApplication'.
96f106b0a61e set color on device ca parents: 768 diff changeset	1601	methodName := 'windowSpec'.
96f106b0a61e set color on device ca parents: 768 diff changeset	1602	categoryName := 'Applications'.
96f106b0a61e set color on device ca parents: 768 diff changeset	1603	HandCursor := Cursor leftHand.
1467 b46624bb6994 use white handles, if the views background color is dark. Claus Gittinger <cg@exept.de> parents: 1450 diff changeset	1604	handleColorBlack := Color black.
b46624bb6994 use white handles, if the views background color is dark. Claus Gittinger <cg@exept.de> parents: 1450 diff changeset	1605	handleColorWhite := Color white.
770 96f106b0a61e set color on device ca parents: 768 diff changeset	1606	handleMasterColor := Color red.
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1607
712 bf8aa59e82b6 user friendly names tz parents: 708 diff changeset	1608	self backgroundColor: self class defaultViewBackgroundColor.
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1609	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1610
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1611	setupFromSpec:specOrSpecArray
784 9ae2b94658e5 wait cursor tz parents: 776 diff changeset	1612
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1613	\|spec builder\|
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1614
784 9ae2b94658e5 wait cursor tz parents: 776 diff changeset	1615	Cursor wait showWhile: [
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1616	self removeAll.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1617	specOrSpecArray notNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1618	spec := UISpecification from:specOrSpecArray.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1619	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1620	builder := UIBuilder new isEditing:true.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1621	"set applicationClass, in order that subspecifications may be resolved"
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1622	className notNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1623	builder applicationClass:(self resolveName:className).
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1624	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1625	spec notNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1626	spec window setupView:self topView for:builder.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1627	self addSpec:(spec component) builder:builder in:self.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1628	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1629	self realizeAllSubViews.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1630	spec notNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1631	treeView setAttributesFromWindowSpec:(spec window)
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1632	].
1671 493e0430518e no longer use InputView ca parents: 1664 diff changeset	1633	].
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1634	!
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1635
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1636	treeView:aTreeView
361 6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	1637	treeView := aTreeView.
6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	1638
6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	1639	treeView delegate:(
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1640	"/
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1641	"/ I want to handle everything typed
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1642	"/ in the treeView, except for Return and Cursor-keys
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1643	"/
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1644	KeyboardForwarder
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1645	toView:self
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1646	condition:nil
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1647	filter:[:k \| (k isSymbol
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1648	and:[k ~~ #Return
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1649	and:[k ~~ #Tab
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1650	and:[(k startsWith:#Cursor) not]]])
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1651	]
361 6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	1652	)
6624bb5d9a1a configuration of grid parameters ca parents: 352 diff changeset	1653
376 3023fc08ee35 checkin from browser Claus Gittinger <cg@exept.de> parents: 361 diff changeset	1654	"Modified: / 31.10.1997 / 20:22:09 / cg"
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1655	! !
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1656
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1657	!UIPainterView methodsFor:'menus'!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1658
121 96d6feeeb049 middleButtonMen: ca parents: 119 diff changeset	1659	showMiddleButtonMenu
96d6feeeb049 middleButtonMen: ca parents: 119 diff changeset	1660	"show the middle button menu; this returns nil
62 0e8573b4329a so far so good ... ca parents: 60 diff changeset	1661	"
1635 116bf6f0ff62 can now specify if menu action is to be performed by ca parents: 1621 diff changeset	1662
116bf6f0ff62 can now specify if menu action is to be performed by ca parents: 1621 diff changeset	1663	\|m\|
116bf6f0ff62 can now specify if menu action is to be performed by ca parents: 1621 diff changeset	1664
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1665	self enabled ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1666	m := MenuPanel fromSpec:(UIPainter menuEdit) receiver:self superView application.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1667	self startUpMenu:m
111 c6699a14d3d9 tools ca parents: 103 diff changeset	1668	].
121 96d6feeeb049 middleButtonMen: ca parents: 119 diff changeset	1669	^ nil
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1670	! !
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1671
1714 f57812a56d17 method category rename Claus Gittinger <cg@exept.de> parents: 1696 diff changeset	1672	!UIPainterView methodsFor:'private-handles'!
754 04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1673
1832 ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1674	painter
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1675	^ treeView canvas
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1676	!
ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	1677
754 04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1678	showSelected:aComponent
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1679	"show object selected
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1680	"
1543 09c4ed98434d layout bg parents: 1520 diff changeset	1681	\|wasClipped sel hColor bg\|
754 04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1682
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1683	selectionHiddenLevel == 0 ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1684	sel := treeView selection.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1685	(sel size > 1 and:
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1686	[(treeView model list at: sel first) contents view == aComponent])
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1687	ifTrue: [
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1688	hColor := handleMasterColor
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1689	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1690	bg := aComponent viewBackground.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1691	bg isColor ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1692	bg brightness < 0.5 ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1693	hColor := handleColorWhite
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1694	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1695	hColor := handleColorBlack
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1696	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1697	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1698	hColor := handleColorBlack
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1699	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1700	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1701
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1702	self paint:hColor.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1703
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1704	(wasClipped := clipChildren) ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1705	self clippedByChildren:(clipChildren := false).
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1706	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1707
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1708	self handlesOf:aComponent do:[:aRectangle :what\| \|l t w h\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1709	l := aRectangle left + 1.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1710	t := aRectangle top + 1.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1711	w := aRectangle width - 2.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1712	h := aRectangle height - 2.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1713
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1714	what == #view ifTrue:[self displayRectangleX:l y:t width:w height:h]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1715	ifFalse:[self fillRectangleX:l y:t width:w height:h]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1716	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1717
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1718	wasClipped ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1719	self clippedByChildren:(clipChildren := true).
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1720	]
754 04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1721	]
1543 09c4ed98434d layout bg parents: 1520 diff changeset	1722
09c4ed98434d layout bg parents: 1520 diff changeset	1723	"Modified: / 6.12.2001 / 00:00:16 / cg"
754 04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1724	! !
04e802a6a920 color master selection in red + grid background colored tz parents: 744 diff changeset	1725
335 9f048ededd7d resolveName: ca parents: 330 diff changeset	1726	!UIPainterView methodsFor:'queries'!
9f048ededd7d resolveName: ca parents: 330 diff changeset	1727
9f048ededd7d resolveName: ca parents: 330 diff changeset	1728	resolveName:aName
9f048ededd7d resolveName: ca parents: 330 diff changeset	1729	\|appl\|
9f048ededd7d resolveName: ca parents: 330 diff changeset	1730
9f048ededd7d resolveName: ca parents: 330 diff changeset	1731	appl := self application.
9f048ededd7d resolveName: ca parents: 330 diff changeset	1732
9f048ededd7d resolveName: ca parents: 330 diff changeset	1733	appl notNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1734	^ appl resolveName:aName
335 9f048ededd7d resolveName: ca parents: 330 diff changeset	1735	].
9f048ededd7d resolveName: ca parents: 330 diff changeset	1736	^ Smalltalk resolveName:aName inClass:self class
9f048ededd7d resolveName: ca parents: 330 diff changeset	1737	! !
9f048ededd7d resolveName: ca parents: 330 diff changeset	1738
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1739	!UIPainterView methodsFor:'removing components'!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1740
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1741	remove:anObject
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1742	"remove anObject from the contents do redraw
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1743	"
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	1744	anObject notNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1745	treeView removeView:anObject.
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	1746	]
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1747	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1748
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1749	removeAll
62 0e8573b4329a so far so good ... ca parents: 60 diff changeset	1750	"remove all objects and properties
0e8573b4329a so far so good ... ca parents: 60 diff changeset	1751	"
776 1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	1752	self select:nil.
1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	1753	treeView removeAll.
1df0525eeec9 reuse methods provided by the model ca parents: 770 diff changeset	1754	self removeUndoHistory.
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1755	! !
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1756
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1757	!UIPainterView methodsFor:'searching'!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1758
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1759	findContainerOfView:aView
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1760	"returns the super view assigned to a view
89 35c5711729c2 so far so good ca parents: 86 diff changeset	1761	"
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1762	\|p\|
89 35c5711729c2 so far so good ca parents: 86 diff changeset	1763
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1764	(p := self propertyOfParentForView:aView) isNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1765	^ self
89 35c5711729c2 so far so good ca parents: 86 diff changeset	1766	].
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1767	^ p view
89 35c5711729c2 so far so good ca parents: 86 diff changeset	1768	!
35c5711729c2 so far so good ca parents: 86 diff changeset	1769
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1770	findObjectAt:aPoint
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1771	"find the origin/corner of the currentWidget
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1772	"
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1773	\|view prop\|
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1774
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1775	view := super findObjectAt:aPoint.
1870 771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	1776	prop := self propertyOfView:view.
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1777
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1778	prop notNil ifTrue:[^ prop view].
1870 771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	1779	^ nil
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1780	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1781
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1782	findViewWithId:aViewId
62 0e8573b4329a so far so good ... ca parents: 60 diff changeset	1783	"finds view assigned to identifier and returns the view or nil
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1784	"
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1785	\|prop\|
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1786
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1787	prop := self propertyOfIdentifier:aViewId.
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1788
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1789	prop notNil ifTrue:[^ prop view]
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1790	ifFalse:[^ nil]
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1791	!
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1792
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1793	propertyOfIdentifier:anId
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1794	"returns property assigned to unique identifier
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1795	"
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1796	anId notNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1797	^ treeView propertyDetect:[:p\| p identifier == anId ]
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1798	].
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1799	^ nil
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1800	!
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1801
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1802	propertyOfName:aString
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1803	"returns property assigned to name
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1804	"
111 c6699a14d3d9 tools ca parents: 103 diff changeset	1805	\|name\|
c6699a14d3d9 tools ca parents: 103 diff changeset	1806
c6699a14d3d9 tools ca parents: 103 diff changeset	1807	aString isNil ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1808	name := aString string withoutSeparators.
238 882be7e03af4 renamed claus instVar (;-) Claus Gittinger <cg@exept.de> parents: 231 diff changeset	1809	^ treeView propertyDetect:[:p\| p name = name ].
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1810	].
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1811	^ nil
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1812	!
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1813
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1814	propertyOfParentForView:aSubView
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1815	"returns the property of the parent or nil
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1816	"
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1817	\|item\|
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1818
1870 771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	1819	(item := treeView detectItemCorespondingToView:aSubView) notNil ifTrue:[
771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	1820	(item := item parent) notNil ifTrue:[^ item contents]
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1821	].
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1822	^ nil
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1823	!
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1824
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1825	propertyOfView:aView
1870 771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	1826	"detect the property for the argument, a view. The property of the view or
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1827	the first subview providing the properties is returned. If no property is detected
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1828	nil is returned.
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1829	"
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1830	\|item\|
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1831
1870 771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	1832	item := treeView detectItemCorespondingToView:aView.
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1833
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1834	(item notNil and:[item parent notNil]) ifTrue:[
1870 771fcc38ecb8 set selection interface changed ca parents: 1869 diff changeset	1835	^ item contents
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1836	].
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1837	^ nil
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1838	!
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1839
111 c6699a14d3d9 tools ca parents: 103 diff changeset	1840	uniqueNameFor:aSpecOrString
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1841	"generate and return an unique name for a class
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1842	"
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1843	\|next name size\|
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1844
712 bf8aa59e82b6 user friendly names tz parents: 708 diff changeset	1845	aSpecOrString isString ifFalse:[name := aSpecOrString userFriendlyName]
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1846	ifTrue:[name := aSpecOrString].
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1847
111 c6699a14d3d9 tools ca parents: 103 diff changeset	1848	size := name size + 1.
c6699a14d3d9 tools ca parents: 103 diff changeset	1849	next := 0.
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1850
238 882be7e03af4 renamed claus instVar (;-) Claus Gittinger <cg@exept.de> parents: 231 diff changeset	1851	treeView propertiesDo:[:p\|
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1852	\|n\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1853	n := p name.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1854
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1855	(n size >= size and:[n startsWith:name]) ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1856	next := next max:(p extractNumberStartingAt:size)
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1857	]
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1858	].
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1859	next := next + 1.
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1860	name := name, next printString.
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1861	^ name
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1862
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1863
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1864
662 28d6cac7968b consistent ID-naming of the widgets tz parents: 655 diff changeset	1865
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1866	!
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1867
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1868	uniqueNameOf:aView
111 c6699a14d3d9 tools ca parents: 103 diff changeset	1869	\|prop\|
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1870
111 c6699a14d3d9 tools ca parents: 103 diff changeset	1871	(prop := self propertyOfView:aView) notNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1872	prop name isNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1873	prop name:(self uniqueNameFor:(prop spec)).
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1874	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1875	^ prop name
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1876	].
111 c6699a14d3d9 tools ca parents: 103 diff changeset	1877	^ 'self'
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1878
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1879	! !
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	1880
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1881	!UIPainterView methodsFor:'selection basics'!
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1882
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1883	addToSelection:anObject
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1884	"add an object to the selection
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1885	"
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1886	(self enabled and:[(self isSelected:anObject) not]) ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1887	selection isCollection ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1888	selection isNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1889	selection := anObject
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1890	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1891	selection := OrderedCollection with:selection with:anObject
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1892	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1893	] ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1894	"/ to enforce the change-message (value is identical to oldValue)
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1895	selection isList ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1896	selection add:anObject
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1897	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1898	selection := selection asOrderedCollection.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1899	selection := selection copyWith:anObject
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1900	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1901	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1902	self showSelected:anObject.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1903	treeView cvsSelectionAdd:anObject.
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1904	]
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1905
1347 c4046d0b638e care for multiSelect into a non-list; Claus Gittinger <cg@exept.de> parents: 1338 diff changeset	1906	"Modified: / 11.2.2000 / 01:39:05 / cg"
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1907	!
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1908
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1909	removeFromSelection:anObject
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1910	"remove an object from the selection
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1911	"
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1912	(self isSelected:anObject) ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1913	self showUnselected:anObject.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1914
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1915	selection size > 1 ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1916	selection isList ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1917	selection remove:anObject ifAbsent:nil
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1918	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1919	"/ to enforce the change-message (value is identical to oldValue)
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1920	selection := selection asOrderedCollection.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1921	selection := selection copyWithout:anObject
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1922	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1923	self showSelection.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1924	] ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1925	selection := nil
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1926	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1927	treeView cvsSelectionRemove:anObject.
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1928	]
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1929
1347 c4046d0b638e care for multiSelect into a non-list; Claus Gittinger <cg@exept.de> parents: 1338 diff changeset	1930	"Modified: / 11.2.2000 / 01:41:11 / cg"
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1931	!
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1932
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1933	select:something
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1934	"change selection to something
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1935	"
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1936	(self enabled and:[something ~= self selection]) ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1937	something isNil
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1938	ifTrue: [treeView selection: (Array with: 1)]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1939	ifFalse:[treeView cvsSelection:something].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1940	self setSelection:something withRedraw:true
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1941	]
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1942
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1943	!
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1944
1830 78a5cf39dc0e nextUpInHier werner parents: 1805 diff changeset	1945	selectNextUpInHierarchy
78a5cf39dc0e nextUpInHier werner parents: 1805 diff changeset	1946	\| sel \|
78a5cf39dc0e nextUpInHier werner parents: 1805 diff changeset	1947
78a5cf39dc0e nextUpInHier werner parents: 1805 diff changeset	1948	(sel := self selection) isNil ifTrue:[^self].
78a5cf39dc0e nextUpInHier werner parents: 1805 diff changeset	1949	sel isCollection ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1950	sel := self selection first.
1830 78a5cf39dc0e nextUpInHier werner parents: 1805 diff changeset	1951	].
78a5cf39dc0e nextUpInHier werner parents: 1805 diff changeset	1952	sel := sel superView.
78a5cf39dc0e nextUpInHier werner parents: 1805 diff changeset	1953	sel isNil ifTrue:[^self].
78a5cf39dc0e nextUpInHier werner parents: 1805 diff changeset	1954	treeView cvsSelection: sel.
78a5cf39dc0e nextUpInHier werner parents: 1805 diff changeset	1955	self selection: sel.
78a5cf39dc0e nextUpInHier werner parents: 1805 diff changeset	1956	!
78a5cf39dc0e nextUpInHier werner parents: 1805 diff changeset	1957
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1958	updateSelectionFromModel:aSelOrNil
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1959	"update selection from a new selection
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1960	"
1427 85b9b5da0b8d optimize: undraw selection ca parents: 1402 diff changeset	1961	\|list\|
768 2ef5b8bed914 catch expose events when unselecting ca parents: 760 diff changeset	1962
2039 d91eaf783502 * empty log message * Claus Gittinger <cg@exept.de> parents: 2024 diff changeset	1963	self shown ifFalse:[^ self].
d91eaf783502 * empty log message * Claus Gittinger <cg@exept.de> parents: 2024 diff changeset	1964
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1965	selectionHiddenLevel == 0 ifTrue:[
2039 d91eaf783502 * empty log message * Claus Gittinger <cg@exept.de> parents: 2024 diff changeset	1966	aSelOrNil size ~~ 0 ifTrue:[
d91eaf783502 * empty log message * Claus Gittinger <cg@exept.de> parents: 2024 diff changeset	1967	list := OrderedCollection new.
d91eaf783502 * empty log message * Claus Gittinger <cg@exept.de> parents: 2024 diff changeset	1968
d91eaf783502 * empty log message * Claus Gittinger <cg@exept.de> parents: 2024 diff changeset	1969	self selectionDo:[:el\|
d91eaf783502 * empty log message * Claus Gittinger <cg@exept.de> parents: 2024 diff changeset	1970	(aSelOrNil includes:el) ifFalse:[list add:el]
d91eaf783502 * empty log message * Claus Gittinger <cg@exept.de> parents: 2024 diff changeset	1971	].
d91eaf783502 * empty log message * Claus Gittinger <cg@exept.de> parents: 2024 diff changeset	1972	self showUnselected:list.
d91eaf783502 * empty log message * Claus Gittinger <cg@exept.de> parents: 2024 diff changeset	1973	] ifFalse:[
d91eaf783502 * empty log message * Claus Gittinger <cg@exept.de> parents: 2024 diff changeset	1974	self hideSelection.
d91eaf783502 * empty log message * Claus Gittinger <cg@exept.de> parents: 2024 diff changeset	1975	]
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1976	].
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	1977	self setSelection:aSelOrNil withRedraw:false.
223 203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1978	self showSelection
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1979	! !
203460df426e change selection handling caused by new tree view ca parents: 219 diff changeset	1980
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1981	!UIPainterView methodsFor:'specification'!
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1982
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1983	addSpec:aSpecification builder:aBuilder in:aFrame
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1984	"build view and subviews from aSpecification into a frame. The top view
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1985	is returned. The contained components of a spec are set to nil
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1986	"
330 643ac5544426 use: ca parents: 327 diff changeset	1987	\|cls\|
212 1836a16763cc oops again Claus Gittinger <cg@exept.de> parents: 211 diff changeset	1988
330 643ac5544426 use: ca parents: 327 diff changeset	1989	cls := self resolveName:className.
643ac5544426 use: ca parents: 327 diff changeset	1990
643ac5544426 use: ca parents: 327 diff changeset	1991	cls notNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1992	aBuilder applicationClass:cls.
212 1836a16763cc oops again Claus Gittinger <cg@exept.de> parents: 211 diff changeset	1993	].
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	1994
111 c6699a14d3d9 tools ca parents: 103 diff changeset	1995	aBuilder componentCreationHook:[:aView :aSpec :aBdr\|\|sv p s n\|
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1996	p := ViewProperty new.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1997	s := aSpec copy.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1998	p spec:s.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	1999	p view:aView.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2000
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2001	s class supportsSubComponents ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2002	s component:nil
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2003	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2004
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2005	n := s name.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2006
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2007	(n isNil or:[(self propertyOfName:n) notNil]) ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2008	s name:(self uniqueNameFor:s)
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2009	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2010	treeView addProperty:p.
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2011	].
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2012	^ aSpecification buildViewWithLayoutFor:aBuilder in:aFrame.
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2013
212 1836a16763cc oops again Claus Gittinger <cg@exept.de> parents: 211 diff changeset	2014	"Modified: 4.7.1997 / 23:48:55 / cg"
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2015	!
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2016
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2017	fullSpecFor:anObject
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2018	"generate a full spec for an object
62 0e8573b4329a so far so good ... ca parents: 60 diff changeset	2019	"
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2020	\|mySpec subSpecs\|
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2021
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2022	mySpec := self specFor:anObject.
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2023
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2024	(mySpec notNil and:[mySpec class supportsSubComponents]) ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2025	(anObject subViews notNil) ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2026	anObject subViews do:[:aSubView\|\|spec\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2027	spec := self fullSpecFor:aSubView.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2028	spec notNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2029	subSpecs isNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2030	subSpecs := OrderedCollection new
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2031	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2032	subSpecs add:spec.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2033	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2034	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2035	subSpecs notNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2036	mySpec component:(SpecCollection new collection:subSpecs)
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2037	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2038	]
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2039	].
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2040	^ mySpec
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2041
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2042
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2043
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2044
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2045
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2046
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2047	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2048
1173 7b5f40822819 code cleanup Claus Gittinger <cg@exept.de> parents: 1092 diff changeset	2049	rebuildView:aView fromSpec:aSpec withBuilder:aBuilderOrNil
7b5f40822819 code cleanup Claus Gittinger <cg@exept.de> parents: 1092 diff changeset	2050	\|v builder\|
7b5f40822819 code cleanup Claus Gittinger <cg@exept.de> parents: 1092 diff changeset	2051
7b5f40822819 code cleanup Claus Gittinger <cg@exept.de> parents: 1092 diff changeset	2052	(builder := aBuilderOrNil) isNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2053	"/ create a dummy builder
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2054	builder := UIBuilder new isEditing:true.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2055	className notNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2056	builder applicationClass:(self resolveName:className).
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2057	].
1173 7b5f40822819 code cleanup Claus Gittinger <cg@exept.de> parents: 1092 diff changeset	2058	].
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2059
1252 f886528c2b35 when changing a layoutContainer Claus Gittinger <cg@exept.de> parents: 1230 diff changeset	2060	aSpec class isLayoutContainer ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2061	"/ TODO:
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2062	"/ go through subviews and let them resize to their default/preferred
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2063	"/ needed if we change a containers layout from fit to non-fit.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2064
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2065	(aView subViews ? #()) do:[:aSubView \|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2066	\|fix spec prop\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2067
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2068	(prop := self propertyOfView:aSubView) notNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2069	spec := prop spec.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2070
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2071	spec useDefaultExtent ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2072	fix := aSubView sizeFixed:false.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2073	aSubView extent:aSubView preferredExtent.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2074	aSubView sizeFixed:fix
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2075	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2076	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2077	].
1252 f886528c2b35 when changing a layoutContainer Claus Gittinger <cg@exept.de> parents: 1230 diff changeset	2078	].
f886528c2b35 when changing a layoutContainer Claus Gittinger <cg@exept.de> parents: 1230 diff changeset	2079
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2080	aSpec needsRebuildForAttributes ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2081	"/ needs a full rebuild (in case view class depends upon spec-attribute)
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2082	v := aSpec buildViewWithLayoutFor:builder in:(self findContainerOfView:aView).
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2083	v realize.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2084	aView destroy.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2085	device sync.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2086	device flush.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2087	aView becomeSameAs:v.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2088	"/ inputView raise.
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2089	] ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2090	aSpec setAttributesIn:aView with:builder.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2091	self elementChangedSize:aView.
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2092	].
1832 ba152306fbf5 group & ungroup werner parents: 1830 diff changeset	2093
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2094	!
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2095
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2096	specFor:anObject
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2097	"returns spec assigned to an object
62 0e8573b4329a so far so good ... ca parents: 60 diff changeset	2098	"
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2099	\|prop spec\|
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2100
1744 c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	2101	(prop := self propertyOfView:anObject) isNil ifTrue:[^ nil].
c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	2102	spec := prop spec copy.
c59a91953b64 paste with no container selected: search for a good one Claus Gittinger <cg@exept.de> parents: 1733 diff changeset	2103	spec layoutFromView:anObject.
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2104	^ spec
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2105	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2106
146 ae84facd80be checkin from browser ca parents: 141 diff changeset	2107	specForSelection
ae84facd80be checkin from browser ca parents: 141 diff changeset	2108	"returns spec assigned to current single selection or nil
ae84facd80be checkin from browser ca parents: 141 diff changeset	2109	"
ae84facd80be checkin from browser ca parents: 141 diff changeset	2110	^ self specFor:(self singleSelection)
ae84facd80be checkin from browser ca parents: 141 diff changeset	2111
ae84facd80be checkin from browser ca parents: 141 diff changeset	2112
ae84facd80be checkin from browser ca parents: 141 diff changeset	2113	!
ae84facd80be checkin from browser ca parents: 141 diff changeset	2114
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2115	updateFromSpec:aSpec
a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2116	"update current selected view from specification
62 0e8573b4329a so far so good ... ca parents: 60 diff changeset	2117	"
1173 7b5f40822819 code cleanup Claus Gittinger <cg@exept.de> parents: 1092 diff changeset	2118	\|props name\|
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2119
281 aabb4037f6a3 window spec ca parents: 279 diff changeset	2120	aSpec class == WindowSpec ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2121	^ treeView canvasSpec:aSpec
281 aabb4037f6a3 window spec ca parents: 279 diff changeset	2122	].
aabb4037f6a3 window spec ca parents: 279 diff changeset	2123
78 a0a00603a8b6 keep spec in properties ca parents: 75 diff changeset	2124	self singleSelection notNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2125	self withSelectionHiddenDo:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2126	self transaction:#specification selectionDo:[:aView\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2127	props := self propertyOfView:aView.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2128	name := (aSpec name) withoutSeparators.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2129
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2130	name = props name ifFalse:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2131	(self propertyOfName:name) notNil ifTrue:[
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2132	name := props name
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2133	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2134	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2135
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2136	aSpec name:name.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2137	self createUndoSpecModify:props.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2138	self rebuildView:aView fromSpec:aSpec withBuilder:nil.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2139	props spec:(aSpec copy).
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2140	treeView propertyChanged:props.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2141	]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2142	]
82 99dc76d66eab checkin from browser ca parents: 80 diff changeset	2143	]
212 1836a16763cc oops again Claus Gittinger <cg@exept.de> parents: 211 diff changeset	2144
1520 eb77c52704c7 drop: paste in surrounding view if not possible to drop in selected. Claus Gittinger <cg@exept.de> parents: 1500 diff changeset	2145	"Modified: / 30.10.2001 / 13:59:45 / cg"
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2146	! !
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2147
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2148	!UIPainterView methodsFor:'testing'!
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2149
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2150	canChangeLayoutOfView:aView
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2151	"returns true if the view can change its layout which is dependant on
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2152	its parent view.
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2153	"
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2154	\|item prnt\|
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2155
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2156	( (item := treeView itemOfView:aView) isNil
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2157	or:[(prnt := item parent) isNil]
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2158	) ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2159	^ false
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2160	].
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2161	^ (prnt parent isNil or:[prnt contents spec class isLayoutContainer not])
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2162	!
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2163
1230 23e5d0c133e8 added exchangeLayouts function Claus Gittinger <cg@exept.de> parents: 1225 diff changeset	2164	canExchangeSelectionLayouts
23e5d0c133e8 added exchangeLayouts function Claus Gittinger <cg@exept.de> parents: 1225 diff changeset	2165	"returns true if the selection size is exactly 2
23e5d0c133e8 added exchangeLayouts function Claus Gittinger <cg@exept.de> parents: 1225 diff changeset	2166	and all elements in the selection can be moved or aligned
23e5d0c133e8 added exchangeLayouts function Claus Gittinger <cg@exept.de> parents: 1225 diff changeset	2167	"
23e5d0c133e8 added exchangeLayouts function Claus Gittinger <cg@exept.de> parents: 1225 diff changeset	2168	selection size == 2 ifFalse:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2169	^ false
1230 23e5d0c133e8 added exchangeLayouts function Claus Gittinger <cg@exept.de> parents: 1225 diff changeset	2170	].
23e5d0c133e8 added exchangeLayouts function Claus Gittinger <cg@exept.de> parents: 1225 diff changeset	2171	^ self canMoveOrAlignSelection
23e5d0c133e8 added exchangeLayouts function Claus Gittinger <cg@exept.de> parents: 1225 diff changeset	2172
23e5d0c133e8 added exchangeLayouts function Claus Gittinger <cg@exept.de> parents: 1225 diff changeset	2173	!
23e5d0c133e8 added exchangeLayouts function Claus Gittinger <cg@exept.de> parents: 1225 diff changeset	2174
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2175	canKeepLayoutInSelection
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2176	"returns true if layout can be kept during a paste operation
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2177	"
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2178	\|prop\|
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2179
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2180	prop := self propertyOfView:(self singleSelection).
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2181	^ (prop isNil or:[prop spec class isLayoutContainer not])
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2182	!
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2183
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2184	canMove:something
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2185	"checks whether something is not nil and if all widgets derived from
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2186	something can change their layout ( move, align, ... operation ).
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2187	"
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2188	something notNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2189	self forEach:something do:[:aView\|
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2190	(self canChangeLayoutOfView:aView) ifFalse:[^ false]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2191	].
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2192	^ true
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2193	].
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2194	^ false
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2195	!
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2196
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2197	canMoveOrAlignSelection
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2198	"returns true if a selection exists and all elements in the selection
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2199	can be moved or aligned
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2200	"
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2201	^ self canMove:(self selection)
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2202
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2203	! !
d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2204
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2205	!UIPainterView methodsFor:'transaction'!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2206
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2207	transaction:aType objects:something do:aOneArgBlock
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2208	"opens a transaction and evaluates a block within the transaction; the
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2209	argument to the block is a view from derived from something
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2210	"
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2211	self withinTransaction:aType objects:something do:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2212	self forEach:something do:aOneArgBlock
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2213	]
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2214	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2215
1954 1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2216	withinTransaction:aType objects:objects do:aNoArgBlock
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2217	"evaluate a block with no arguments within a transaction
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2218	"
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2219	\|text size prop\|
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2220
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2221	objects isNil ifTrue:[ ^ self ].
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2222
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2223	size := objects size.
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2224
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2225	objects isCollection ifTrue:[
1954 1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2226	size == 0 ifTrue:[ ^ self ].
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2227	size == 1 ifTrue:[ prop := self propertyOfView:(objects first) ]
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2228	] ifFalse:[
1954 1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2229	prop := self propertyOfView:objects
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2230	].
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2231
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2232	prop notNil ifTrue:[
1954 1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2233	text := prop name
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2234	] ifFalse:[
1954 1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2235	text := size printString, ' elements'
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2236	].
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2237
1954 1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2238	undoHistory withinTransaction:aType text:text do:aNoArgBlock.
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2239	self undoHistoryChanged.
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2240	! !
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2241
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2242	!UIPainterView methodsFor:'undo actions'!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2243
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2244	createUndoLayout:aView
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2245	"create undo action before changing a views layout
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2246	"
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2247	\|lyt args prop\|
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2248
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2249	undoHistory isTransactionOpen ifTrue:[
1954 1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2250	prop := self propertyOfView:aView.
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2251
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2252	prop notNil ifTrue:[
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2253	args := Array new:3.
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2254	args at:1 put:(prop identifier).
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2255
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2256	(lyt := aView geometryLayout) notNil ifTrue:[
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2257	args at:2 put:#geometryLayout:
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2258	] ifFalse:[
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2259	lyt := aView extent.
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2260	args at:2 put:#extent:
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2261	].
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2262	args at:3 put:(lyt copy).
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2263	undoHistory addUndoSelector:#undoLayout: withArgs:args.
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2264	self undoHistoryChanged.
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2265	]
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2266	]
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2267	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2268
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2269	createUndoRemove:aView
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2270	"create undo method before deleting views
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2271	"
285 d80b3c6a4373 don't use superView instead parent properties derived ca parents: 281 diff changeset	2272	\|prop pid\|
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2273
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2274	(prop := self propertyOfView:aView) notNil ifTrue:[
1954 1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2275	(pid := self propertyOfParentForView:aView) notNil ifTrue:[
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2276	pid := pid identifier
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2277	].
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2278
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2279	undoHistory addUndoSelector:#undoRemove:
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2280	withArgs:(Array with:(self fullSpecFor:aView)
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2281	with:(prop identifier)
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2282	with:pid).
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2283	self undoHistoryChanged.
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2284	]
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2285	!
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2286
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2287	createUndoSpecModify:aProp
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2288	"undo method when changing the specification for an object
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2289	"
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2290	aProp notNil ifTrue:[
1954 1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2291	undoHistory addUndoSelector:#undoSpecModify:
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2292	withArgs:(Array with:(aProp spec) with:(aProp identifier)).
1344ec1f99eb * empty log message * Claus Gittinger <cg@exept.de> parents: 1953 diff changeset	2293	self undoHistoryChanged.
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2294	]
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2295	!
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2296
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2297	undoCreate:something
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2298	"undo method for creating or pasting an object
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2299	"
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2300	self forEach:something do:[:anId\|self remove:(self findViewWithId:anId)].
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2301	!
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2302
1520 eb77c52704c7 drop: paste in surrounding view if not possible to drop in selected. Claus Gittinger <cg@exept.de> parents: 1500 diff changeset	2303	undoHistory
eb77c52704c7 drop: paste in surrounding view if not possible to drop in selected. Claus Gittinger <cg@exept.de> parents: 1500 diff changeset	2304	^ undoHistory
eb77c52704c7 drop: paste in surrounding view if not possible to drop in selected. Claus Gittinger <cg@exept.de> parents: 1500 diff changeset	2305
eb77c52704c7 drop: paste in surrounding view if not possible to drop in selected. Claus Gittinger <cg@exept.de> parents: 1500 diff changeset	2306	"Created: / 30.10.2001 / 13:42:45 / cg"
eb77c52704c7 drop: paste in surrounding view if not possible to drop in selected. Claus Gittinger <cg@exept.de> parents: 1500 diff changeset	2307	!
eb77c52704c7 drop: paste in surrounding view if not possible to drop in selected. Claus Gittinger <cg@exept.de> parents: 1500 diff changeset	2308
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2309	undoLayout:args
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2310	"undo method to set the old layout; see 'createUndoLayout:'
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2311	"
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2312	\|view\|
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2313
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2314	(view := self findViewWithId:(args at:1)) notNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2315	view perform:(args at:2) with:(args at:3).
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2316	self layoutChanged.
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2317	]
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2318	!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2319
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2320	undoRemove:args
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2321	"undo method when removing an object; see 'createUndoRemove:'
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2322	"
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2323	\|frame prop view\|
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2324
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2325	(args at:3) notNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2326	frame := self findViewWithId:(args at:3).
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2327	].
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2328	frame isNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2329	frame := self
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2330	].
395 d39076243277 sett UIBuilder isEditing to true ca parents: 392 diff changeset	2331	view := self addSpec:(args at:1) builder:(UIBuilder new isEditing:true) in:frame.
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2332	view realize.
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2333
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2334	prop := self propertyOfView:view.
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2335	prop identifier:(args at:2).
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2336	!
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2337
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2338	undoSpecModify:args
d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2339	"undo method when changing a spec; see 'createUndoSpecModify:'
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2340	"
1173 7b5f40822819 code cleanup Claus Gittinger <cg@exept.de> parents: 1092 diff changeset	2341	\|view spec props\|
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2342
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2343	props := self propertyOfIdentifier:(args at:2).
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2344
134 d5ab85ec27fd undo history; keep view identifier ca parents: 131 diff changeset	2345	props notNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2346	view := props view.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2347	spec := args at:1.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2348
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2349	props spec:spec.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2350	self rebuildView:view fromSpec:spec withBuilder:nil.
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2351	treeView propertyChanged:props.
211 45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2352	]
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2353	! !
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2354
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2355	!UIPainterView::ViewProperty class methodsFor:'instance creation'!
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2356
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2357	new
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2358	Identifier notNil ifTrue:[Identifier := Identifier + 1]
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2359	ifFalse:[Identifier := 1].
211 45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2360
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2361	^ self basicNew initialize
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2362	! !
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2363
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2364	!UIPainterView::ViewProperty methodsFor:'accessing'!
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2365
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2366	identifier
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2367	"return the unique identifier assigned to property
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2368	"
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2369	^ identifier
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2370	!
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2371
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2372	identifier:anIdentifier
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2373	"set the unique identifier assigned to property; called after an restore of
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2374	a deleted instance
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2375	"
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2376	identifier := anIdentifier
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2377	!
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2378
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2379	spec
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2380	"return the value of the instance variable 'spec' (automatically generated)"
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2381
1427 85b9b5da0b8d optimize: undraw selection ca parents: 1402 diff changeset	2382	^ spec
85b9b5da0b8d optimize: undraw selection ca parents: 1402 diff changeset	2383	!
211 45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2384
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2385	spec:something
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2386	"set the value of the instance variable 'spec' (automatically generated)"
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2387
1427 85b9b5da0b8d optimize: undraw selection ca parents: 1402 diff changeset	2388	spec := something.
85b9b5da0b8d optimize: undraw selection ca parents: 1402 diff changeset	2389	!
211 45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2390
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2391	view
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2392	"return the value of the instance variable 'view' (automatically generated)"
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2393
1427 85b9b5da0b8d optimize: undraw selection ca parents: 1402 diff changeset	2394	^ view
85b9b5da0b8d optimize: undraw selection ca parents: 1402 diff changeset	2395	!
211 45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2396
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2397	view:something
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2398	"set the value of the instance variable 'view' (automatically generated)"
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2399
1427 85b9b5da0b8d optimize: undraw selection ca parents: 1402 diff changeset	2400	view := something.
85b9b5da0b8d optimize: undraw selection ca parents: 1402 diff changeset	2401	! !
211 45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2402
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2403	!UIPainterView::ViewProperty methodsFor:'initialization'!
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2404
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2405	initialize
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2406	super initialize.
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2407	identifier := Identifier
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2408	! !
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2409
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2410	!UIPainterView::ViewProperty methodsFor:'misc'!
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2411
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2412	extractNumberStartingAt:anIndex
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2413	"return the number from the name starting at anIndex or 0.
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2414	"
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2415	\|val\|
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2416
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2417	val := 0.
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2418
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2419	self name from:anIndex do:[:c\|
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2420	c isDigit ifTrue:[val := val * 10 + c digitValue]
2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2421	ifFalse:[^ 0]
211 45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2422	].
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2423	^ val
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2424
211 45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2425	! !
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2426
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2427	!UIPainterView::ViewProperty methodsFor:'spec messages'!
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2428
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2429	doesNotUnderstand:aMessage
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2430	spec notNil ifTrue:[
1834 2c640b5f7fa9 * empty log message * werner parents: 1833 diff changeset	2431	(spec respondsTo:(aMessage selector)) ifTrue:[^ aMessage sendTo:spec]
211 45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2432	].
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2433	^ nil
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2434	!
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2435
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2436	layout
1664 782f3bda3c88 bugfix in #layout ca parents: 1635 diff changeset	2437	^ spec layout
211 45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2438	!
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2439
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2440	layout:aLayout
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2441	spec layout:aLayout
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2442	!
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2443
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2444	name
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2445	^ spec name
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2446	!
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2447
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2448	name:aName
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2449	spec name:aName
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2450	! !
45f193f4e870 oops Claus Gittinger <cg@exept.de> parents: 210 diff changeset	2451
60 7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2452	!UIPainterView class methodsFor:'documentation'!
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2453
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2454	version
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2455	^ '$Header$'
7542ab7fbbfe * empty log message * Claus Gittinger <cg@exept.de> parents: 59 diff changeset	2456	! !
1621 112670159075 cg: check if selection change is allowed BEFORE changing the tm parents: 1574 diff changeset	2457
1225 0aa39cc5f0a3 Initialize class vars. Stefan Vogel <sv@exept.de> parents: 1201 diff changeset	2458	UIPainterView initialize!

author	Claus Gittinger <cg@exept.de>
	Tue, 27 Mar 2007 11:16:14 +0200
changeset 2169	e7b7c5379e4b
parent 2116	90fc11105f36
child 2180	0912680e1fa7
permissions	-rw-r--r--