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

- All source *.st files are now Unicode UTF8 without BOM
Files are in two groups (fileOut works this way in Smalltalk/X):
- containing a unicode character have "{ Encoding: utf8 }" at the header
- ASCII only are without the header
cg@809
     1
"
cg@809
     2
 COPYRIGHT (c) 1997 by eXept Software AG
cg@2621
     3
	      All Rights Reserved
cg@809
     4
cg@809
     5
 This software is furnished under a license and may be used
cg@809
     6
 only in accordance with the terms of that license and with the
cg@809
     7
 inclusion of the above copyright notice.   This software may not
cg@809
     8
 be provided or otherwise made available to, or used by, any
cg@809
     9
 other person.  No title to or ownership of the software is
cg@809
    10
 hereby transferred.
cg@809
    11
"
cg@809
    12
cg@809
    13
cg@2621
    14
"{ NameSpace: Tools }"
ca@33
    15
cg@1213
    16
Object subclass:#NewInspectorList
ca@33
    17
	instanceVariableNames:'inspectedObject instanceNames instanceTypes selection'
ca@33
    18
	classVariableNames:''
ca@33
    19
	poolDictionaries:''
cg@1213
    20
	category:'Interface-NewInspector'
ca@33
    21
!
ca@33
    22
cg@1213
    23
!NewInspectorList class methodsFor:'documentation'!
cg@809
    24
cg@809
    25
copyright
cg@809
    26
"
cg@809
    27
 COPYRIGHT (c) 1997 by eXept Software AG
cg@2621
    28
	      All Rights Reserved
cg@809
    29
cg@809
    30
 This software is furnished under a license and may be used
cg@809
    31
 only in accordance with the terms of that license and with the
cg@809
    32
 inclusion of the above copyright notice.   This software may not
cg@809
    33
 be provided or otherwise made available to, or used by, any
cg@809
    34
 other person.  No title to or ownership of the software is
cg@809
    35
 hereby transferred.
cg@809
    36
"
cg@809
    37
cg@809
    38
! !
ca@33
    39
cg@1213
    40
!NewInspectorList class methodsFor:'instance creation'!
ca@33
    41
ca@33
    42
for:anObject
ca@33
    43
    "create a new list for an instance
ca@33
    44
    "
ca@38
    45
    ^ self new inspect:anObject
ca@38
    46
ca@38
    47
ca@38
    48
!
ca@38
    49
ca@38
    50
new
ca@38
    51
    "create a new instance and set the inspected object to nil
ca@38
    52
    "
ca@38
    53
    ^ self basicNew initialize.
ca@38
    54
ca@38
    55
! !
ca@38
    56
cg@1213
    57
!NewInspectorList class methodsFor:'helpers'!
ca@38
    58
ca@38
    59
asString:aCollection
ca@38
    60
    "converts any collection to a string seperated by spaces. If
ca@38
    61
     the collection is empty or nil, nil is returned otherwise a
ca@38
    62
     string.
ca@38
    63
    "
ca@38
    64
    |string|
ca@38
    65
ca@38
    66
    aCollection isCollection ifTrue:[
cg@2621
    67
	aCollection isString ifTrue:[
cg@2621
    68
	    string := aCollection
cg@2621
    69
	] ifFalse:[
cg@2621
    70
	    string := aCollection asStringWith:Character space
cg@2621
    71
					  from:1 to:(aCollection size)
cg@2621
    72
				  compressTabs:true
cg@2621
    73
					 final:nil
cg@2621
    74
	].
cg@2621
    75
	string := string withoutSeparators.
ca@38
    76
cg@2621
    77
	string notEmpty ifTrue:[
cg@2621
    78
	    ^ string
cg@2621
    79
	]
ca@38
    80
    ].
ca@38
    81
    ^ nil
ca@33
    82
ca@33
    83
ca@33
    84
! !
ca@33
    85
cg@1213
    86
!NewInspectorList class methodsFor:'testing'!
ca@33
    87
ca@33
    88
isDirectory:anInstance
ca@38
    89
    "returns true if the instance is a directory
ca@33
    90
    "
ca@33
    91
    |cls|
ca@33
    92
ca@33
    93
    anInstance notNil ifTrue:[
cg@2621
    94
	cls := anInstance class.
ca@33
    95
cg@2621
    96
	cls == Character  ifTrue:[ ^ false ].
cg@2621
    97
	cls == Symbol     ifTrue:[ ^ false ].
cg@2621
    98
	cls == String     ifTrue:[ ^ false ].
cg@2621
    99
	cls == Float      ifTrue:[ ^ false ].
cg@2621
   100
	cls == ShortFloat ifTrue:[ ^ false ].
ca@33
   101
cg@2621
   102
	cls allInstVarNames notEmpty ifTrue:[
cg@2621
   103
	    ^ true
cg@2621
   104
	].
ca@33
   105
cg@2621
   106
	anInstance isVariable ifTrue:[
cg@2621
   107
	    ^ true
cg@2621
   108
	].
ca@33
   109
    ].
ca@33
   110
    ^ false
ca@33
   111
cg@1022
   112
    "Modified: / 4.2.1999 / 20:00:11 / cg"
ca@38
   113
!
ca@38
   114
ca@38
   115
isTraceable:anInstance
ca@38
   116
    "returns true if the instance could be traced or traped
ca@38
   117
    "
ca@38
   118
    |cls|
ca@38
   119
ca@38
   120
    anInstance notNil ifTrue:[
cg@2621
   121
	cls := anInstance class.
ca@38
   122
ca@38
   123
      ^ (     cls ~~ True
cg@2621
   124
	 and:[cls ~~ False
cg@2621
   125
	 and:[cls ~~ SmallInteger]]
cg@2621
   126
	)
ca@38
   127
    ].
ca@38
   128
    ^ false.
ca@38
   129
ca@33
   130
! !
ca@33
   131
cg@1213
   132
!NewInspectorList methodsFor:'accessing'!
ca@33
   133
ca@33
   134
includesSelf:aBoolean
ca@33
   135
    "includes 'self' dependant on the boolean
ca@33
   136
    "
ca@33
   137
    (self includesSelf) ~~ aBoolean ifTrue:[
cg@2621
   138
	aBoolean ifTrue:[
cg@2621
   139
	    instanceNames addFirst:'self'.
cg@2621
   140
	    instanceTypes addFirst:#self.
ca@33
   141
cg@2621
   142
	    selection notNil ifTrue:[selection := selection + 1]
cg@2621
   143
			    ifFalse:[selection := 1]
ca@38
   144
cg@2621
   145
	] ifFalse:[
cg@2621
   146
	    instanceNames removeFirst.
cg@2621
   147
	    instanceTypes removeFirst.
ca@33
   148
cg@2621
   149
	    selection isNil ifFalse:[
cg@2621
   150
		(selection := selection - 1) == 0 ifTrue:[
cg@2621
   151
		    selection := nil
cg@2621
   152
		]
cg@2621
   153
	    ]
cg@2621
   154
	]
ca@33
   155
    ]
ca@33
   156
ca@33
   157
ca@33
   158
!
ca@33
   159
ca@38
   160
list
ca@38
   161
    "returns self
ca@38
   162
    "
ca@38
   163
    ^ self
ca@38
   164
!
ca@38
   165
ca@33
   166
size
ca@38
   167
    "returns size of list
ca@33
   168
    "
ca@33
   169
    ^ instanceNames size
ca@33
   170
ca@38
   171
!
ca@38
   172
ca@38
   173
update
ca@38
   174
    "update list contents
ca@38
   175
    "
ca@38
   176
    |start stop size|
ca@38
   177
ca@38
   178
    inspectedObject isVariable ifTrue:[
cg@2621
   179
	start := instanceNames findFirst:[:el|(el at:1) isDigit].
cg@2621
   180
	stop  := instanceTypes size.
ca@38
   181
cg@2621
   182
	start == 0 ifTrue:[
cg@2621
   183
	    size := stop + 10.  "must be > 1: force a resize the first time"
cg@2621
   184
	] ifFalse:[
cg@2621
   185
	    instanceTypes last ~~ #grow ifTrue:[size := stop]
cg@2621
   186
				       ifFalse:[size := stop-1].
ca@38
   187
cg@2621
   188
	    instanceTypes removeFromIndex:start toIndex:stop.
cg@2621
   189
	    instanceNames removeFromIndex:start toIndex:stop.
cg@2621
   190
	].
cg@2621
   191
	self resizeTo:size.
ca@38
   192
    ]
cg@1022
   193
cg@1022
   194
    "Modified: / 4.2.1999 / 20:00:38 / cg"
ca@33
   195
! !
ca@33
   196
cg@1213
   197
!NewInspectorList methodsFor:'accessing contents'!
ca@33
   198
ca@33
   199
inspectedObject
ca@33
   200
    "returns current inspected object
ca@33
   201
    "
ca@33
   202
    ^ inspectedObject
ca@33
   203
ca@33
   204
ca@33
   205
!
ca@33
   206
ca@33
   207
instanceNames
ca@33
   208
    "returns list of instance names
ca@33
   209
    "
ca@33
   210
    ^ instanceNames
ca@33
   211
ca@33
   212
ca@33
   213
!
ca@33
   214
ca@33
   215
instanceTypeAt:anIndex
ca@38
   216
    "returns type assigned to the list entry (#directory #normal #self #grow)
ca@38
   217
     In case of an invalid index nil is returned.
ca@33
   218
    "
ca@38
   219
    (anIndex isNil or:[anIndex > instanceTypes size]) ifFalse:[^ instanceTypes at:anIndex]
cg@2621
   220
						       ifTrue:[^ nil].
ca@33
   221
ca@33
   222
ca@33
   223
!
ca@33
   224
ca@33
   225
instanceTypes
ca@38
   226
    "returns list of types (#directory #normal #self #grow)
ca@33
   227
    "
ca@33
   228
    ^ instanceTypes
ca@33
   229
ca@33
   230
ca@33
   231
!
ca@33
   232
ca@33
   233
instanceVarAt:anIndex
cg@2621
   234
    "returns the instnace variable assigned to the index or
ca@38
   235
     nil in case of an invalid index.
ca@33
   236
    "
cg@327
   237
    |nm|
ca@33
   238
ca@38
   239
    (anIndex isNil or:[anIndex > instanceTypes size]) ifFalse:[
cg@2621
   240
	nm := instanceNames at:anIndex.
ca@33
   241
cg@2621
   242
	(nm at:1) isDigit ifFalse:[
cg@2621
   243
	    self includesSelf ifFalse:[
cg@2621
   244
		^ inspectedObject instVarAt:anIndex
cg@2621
   245
	    ].
cg@2621
   246
	    anIndex == 1 ifFalse:[^ inspectedObject instVarAt:(anIndex-1)]
cg@2621
   247
			  ifTrue:[^ inspectedObject]
cg@2621
   248
	].
ca@33
   249
      ^ inspectedObject basicAt:(Number readFrom:nm onError:0)
ca@33
   250
    ].
ca@33
   251
    ^ nil
ca@33
   252
ca@33
   253
ca@33
   254
! !
ca@33
   255
cg@1213
   256
!NewInspectorList methodsFor:'initialization'!
ca@33
   257
ca@38
   258
initialize
ca@38
   259
    "initialize instance attributes
ca@33
   260
    "
ca@38
   261
    super initialize.
ca@33
   262
ca@38
   263
    instanceNames := OrderedCollection new.
ca@38
   264
    instanceTypes := OrderedCollection new.
ca@33
   265
ca@33
   266
! !
ca@33
   267
cg@1213
   268
!NewInspectorList methodsFor:'private'!
ca@33
   269
ca@38
   270
resizeTo:aNumber
ca@38
   271
    "resize list to minimum aNumber
ca@33
   272
    "
ca@38
   273
    |lstVarId basicSize newLastId obj instSize|
ca@33
   274
ca@33
   275
    (inspectedObject isVariable and:[self class isDirectory:inspectedObject]) ifFalse:[
cg@2621
   276
	^ self
ca@33
   277
    ].
ca@33
   278
ca@38
   279
    instanceTypes size == 0 ifTrue:[
cg@2621
   280
	lstVarId := 0
ca@38
   281
    ] ifFalse:[
cg@2621
   282
	instSize := inspectedObject class instSize.
ca@33
   283
cg@2621
   284
	instanceTypes first == #self ifTrue:[
cg@2621
   285
	    instSize := instSize + 1
cg@2621
   286
	].
cg@2621
   287
	instanceTypes last == #grow ifTrue:[
cg@2621
   288
	    instanceNames removeLast.       " ..    "
cg@2621
   289
	    instanceTypes removeLast.       " #grow "
cg@2621
   290
	].
cg@2621
   291
	lstVarId := instanceTypes size - instSize.
ca@38
   292
    ].
ca@38
   293
ca@38
   294
    (basicSize := inspectedObject basicSize) == lstVarId ifTrue:[
cg@2621
   295
	^ self
ca@38
   296
    ].
ca@38
   297
    newLastId := (1 bitShift:((aNumber-1) highBit)) max:128.
ca@38
   298
ca@38
   299
    (newLastId + 64) > basicSize ifTrue:[
cg@2621
   300
	newLastId := basicSize
ca@33
   301
    ].
ca@33
   302
ca@33
   303
    [lstVarId ~~ newLastId] whileTrue:[
cg@2621
   304
	lstVarId := lstVarId + 1.
cg@2621
   305
	obj := inspectedObject basicAt:lstVarId.
ca@33
   306
cg@2621
   307
	(self class isDirectory:obj) ifTrue:[instanceTypes add:#directory]
cg@2621
   308
				    ifFalse:[instanceTypes add:#normal].
ca@33
   309
cg@2621
   310
	instanceNames add:(lstVarId printString, '   ', obj class name printString).
ca@33
   311
    ].
ca@33
   312
ca@33
   313
    lstVarId ~~ basicSize ifTrue:[
cg@2621
   314
	instanceNames add:'..'.
cg@2621
   315
	instanceTypes add:#grow
ca@33
   316
    ].
ca@33
   317
! !
ca@33
   318
cg@1213
   319
!NewInspectorList methodsFor:'selections'!
ca@33
   320
ca@33
   321
selectedInstanceType
ca@38
   322
    "returns type assigned to the selected list entry (#directory #normal #self #grow).
ca@38
   323
     In case of no selection nil is returned.
ca@33
   324
    "
ca@33
   325
    ^ self instanceTypeAt:selection
ca@33
   326
ca@33
   327
ca@33
   328
!
ca@33
   329
ca@33
   330
selectedInstanceVar
ca@33
   331
    "returns current inspected instance variable or nil
ca@33
   332
    "
ca@33
   333
    ^ self instanceVarAt:selection
ca@33
   334
ca@33
   335
ca@33
   336
!
ca@33
   337
ca@33
   338
selection
ca@33
   339
    "returns current selection number or nil
ca@33
   340
    "
ca@33
   341
    ^ selection
ca@33
   342
ca@33
   343
ca@33
   344
!
ca@33
   345
ca@38
   346
setSelection:aNrOrNil
ca@38
   347
    "change current selection to a number or nil; may resize the lists
ca@33
   348
    "
ca@38
   349
    selection := aNrOrNil.
ca@33
   350
ca@38
   351
    (selection isNil or:[instanceTypes size > selection]) ifFalse:[
cg@2621
   352
	self resizeTo:selection.
ca@33
   353
cg@2621
   354
	selection > instanceTypes size ifTrue:[
cg@2621
   355
	    selection := nil
cg@2621
   356
	]
cg@2621
   357
    ]
ca@38
   358
! !
ca@38
   359
cg@1213
   360
!NewInspectorList methodsFor:'testing'!
ca@38
   361
ca@38
   362
includesSelf
ca@38
   363
    "returns true if 'self' is included in the list
ca@38
   364
    "
ca@38
   365
    ^ (instanceTypes notEmpty and:[instanceTypes first == #self])
ca@38
   366
ca@38
   367
ca@38
   368
!
ca@38
   369
ca@38
   370
isEmpty
ca@38
   371
    "returns true if the list is empty
ca@38
   372
    "
ca@38
   373
    ^ instanceNames isEmpty
ca@38
   374
ca@38
   375
!
ca@38
   376
ca@38
   377
notEmpty
ca@38
   378
    "returns true if the list is not empty
ca@38
   379
    "
ca@38
   380
    ^ instanceNames notEmpty
ca@38
   381
ca@38
   382
! !
ca@38
   383
cg@1213
   384
!NewInspectorList methodsFor:'user interaction'!
ca@38
   385
ca@38
   386
accept:aText notifying:aView
ca@38
   387
    "evaluating aText on the selected instance var; if an error occurs #Error
ca@38
   388
     is returned otherwise the inspected object instance. On success the list
ca@38
   389
     will be updated.
ca@38
   390
    "
ca@38
   391
    |text slNr value|
ca@38
   392
ca@38
   393
    selection notNil ifTrue:[
cg@2621
   394
	text := self class asString:aText.
ca@38
   395
cg@2621
   396
	text notNil ifTrue:[
cg@2621
   397
	    self includesSelf ifFalse:[slNr := selection]
cg@2621
   398
			       ifTrue:[slNr := selection-1].
ca@38
   399
cg@2621
   400
	    value := inspectedObject class evaluatorClass
cg@2621
   401
		       evaluate:text
cg@2621
   402
		       receiver:inspectedObject
cg@2621
   403
		      notifying:aView.
ca@38
   404
cg@2621
   405
	    slNr ~~ 0 ifTrue:[
cg@2621
   406
		(inspectedObject class isVariable) ifFalse:[
cg@2621
   407
		    inspectedObject instVarAt:slNr put:value
cg@2621
   408
		] ifTrue:[
cg@2621
   409
		    slNr <= (inspectedObject class instSize) ifTrue:[
cg@2621
   410
			inspectedObject instVarAt:slNr put:value
cg@2621
   411
		    ] ifFalse:[
cg@2621
   412
			slNr := slNr - inspectedObject class instSize.
cg@2621
   413
			inspectedObject basicAt:slNr put:value
cg@2621
   414
		    ]
cg@2621
   415
		]
cg@2621
   416
	    ].
cg@2621
   417
	    inspectedObject changed.
cg@2621
   418
	    self update.
cg@2621
   419
	  ^ inspectedObject
cg@2621
   420
	]
ca@38
   421
    ].
ca@38
   422
    ^ #Error
ca@38
   423
!
ca@38
   424
ca@38
   425
doIt:aCode notifying:aView
ca@38
   426
    "evaluating aCode on the selected instance var; if an error occurs #Error
ca@38
   427
     is returned otherwise the result returned from the evaluator. On success
ca@38
   428
     the list will be updated.
ca@38
   429
    "
ca@38
   430
    |successFg result evaluator selInstVar code|
ca@38
   431
ca@38
   432
    selInstVar := self selectedInstanceVar.
ca@38
   433
ca@38
   434
    selInstVar notNil ifTrue:[
cg@2621
   435
	code := self class asString:aCode.
ca@38
   436
cg@2621
   437
	code notNil ifTrue:[
cg@2621
   438
	    evaluator := selInstVar class evaluatorClass.
cg@2621
   439
	    successFg := true.
ca@38
   440
cg@2621
   441
	    evaluator notNil ifTrue:[
cg@2621
   442
		result := evaluator evaluate:code
cg@2621
   443
					  in:nil
cg@2621
   444
				    receiver:selInstVar
cg@2621
   445
				   notifying:aView
cg@2621
   446
				      logged:true
cg@2621
   447
				      ifFail:[successFg := false].
ca@38
   448
cg@2621
   449
		successFg ifTrue:[
cg@2621
   450
		    self update.
cg@2621
   451
		  ^ result
cg@2621
   452
		]
cg@2621
   453
	    ]
cg@2621
   454
	]
ca@38
   455
    ].
ca@38
   456
    ^ #Error.
ca@33
   457
ca@38
   458
ca@38
   459
!
ca@38
   460
ca@38
   461
inspect:anObject
ca@38
   462
    "inspect a new instance; update contents
ca@38
   463
    "
ca@38
   464
    |varNamesSize|
ca@38
   465
ca@38
   466
    selection := nil.
ca@38
   467
ca@38
   468
    anObject == inspectedObject ifFalse:[
cg@2621
   469
	inspectedObject := anObject.
ca@38
   470
cg@2621
   471
	(self class isDirectory:inspectedObject) ifFalse:[
cg@2621
   472
	    instanceNames := OrderedCollection new.
cg@2621
   473
	    instanceTypes := OrderedCollection new.
cg@2621
   474
	] ifTrue:[
cg@2621
   475
	    instanceNames := inspectedObject class allInstVarNames.
cg@2621
   476
	    varNamesSize  := instanceNames size.
cg@2621
   477
	    instanceTypes := OrderedCollection new:varNamesSize.
ca@38
   478
cg@2621
   479
	    1 to:varNamesSize do:[:i|
cg@2621
   480
		(self class isDirectory:(inspectedObject instVarAt:i)) ifTrue:[
cg@2621
   481
		    instanceTypes add:#directory
cg@2621
   482
		] ifFalse:[
cg@2621
   483
		    instanceTypes add:#normal
cg@2621
   484
		]
cg@2621
   485
	    ].
cg@2621
   486
	]
ca@38
   487
    ].
ca@38
   488
    self update
ca@33
   489
! !
ca@33
   490
cg@1213
   491
!NewInspectorList class methodsFor:'documentation'!
ca@33
   492
ca@33
   493
version
ca@33
   494
    ^ '$Header$'
ca@33
   495
! !