NewInspectorList.st
author Claus Gittinger <cg@exept.de>
Wed, 29 Jul 2009 20:02:02 +0200
changeset 2570 4e663bc64364
parent 1213 6cf7a4c2dfce
child 2621 285fa261cbcb
permissions -rw-r--r--
changed #requestPackage
cg@809
     1
"
cg@809
     2
 COPYRIGHT (c) 1997 by eXept Software AG
cg@809
     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
ca@33
    14
"{ NameSpace: NewInspector }"
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@809
    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:[
ca@38
    67
        aCollection isString ifTrue:[
ca@38
    68
            string := aCollection
ca@38
    69
        ] ifFalse:[
ca@38
    70
            string := aCollection asStringWith:Character space
ca@38
    71
                                          from:1 to:(aCollection size)
ca@38
    72
                                  compressTabs:true 
ca@38
    73
                                         final:nil
ca@38
    74
        ].
ca@38
    75
        string := string withoutSeparators.
ca@38
    76
ca@38
    77
        string notEmpty ifTrue:[
ca@38
    78
            ^ string
ca@38
    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:[
ca@33
    94
        cls := anInstance class.
ca@33
    95
ca@33
    96
        cls == Character  ifTrue:[ ^ false ].
ca@33
    97
        cls == Symbol     ifTrue:[ ^ false ].
ca@33
    98
        cls == String     ifTrue:[ ^ false ].
cg@1022
    99
        cls == Float      ifTrue:[ ^ false ].
cg@1022
   100
        cls == ShortFloat ifTrue:[ ^ false ].
ca@33
   101
ca@33
   102
        cls allInstVarNames notEmpty ifTrue:[
ca@33
   103
            ^ true
ca@33
   104
        ].
ca@33
   105
ca@33
   106
        anInstance isVariable ifTrue:[
ca@33
   107
            ^ true
ca@33
   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:[
ca@38
   121
        cls := anInstance class.
ca@38
   122
ca@38
   123
      ^ (     cls ~~ True
ca@38
   124
         and:[cls ~~ False
ca@38
   125
         and:[cls ~~ SmallInteger]]
ca@38
   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:[
ca@33
   138
        aBoolean ifTrue:[
ca@33
   139
            instanceNames addFirst:'self'.
ca@33
   140
            instanceTypes addFirst:#self.
ca@33
   141
ca@38
   142
            selection notNil ifTrue:[selection := selection + 1]
ca@38
   143
                            ifFalse:[selection := 1]
ca@38
   144
ca@33
   145
        ] ifFalse:[
ca@33
   146
            instanceNames removeFirst.
ca@33
   147
            instanceTypes removeFirst.
ca@33
   148
ca@33
   149
            selection isNil ifFalse:[
ca@33
   150
                (selection := selection - 1) == 0 ifTrue:[
ca@33
   151
                    selection := nil
ca@33
   152
                ]
ca@33
   153
            ]
ca@33
   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:[
ca@38
   179
        start := instanceNames findFirst:[:el|(el at:1) isDigit].
ca@38
   180
        stop  := instanceTypes size.
ca@38
   181
ca@38
   182
        start == 0 ifTrue:[
ca@38
   183
            size := stop + 10.  "must be > 1: force a resize the first time"   
ca@38
   184
        ] ifFalse:[
ca@38
   185
            instanceTypes last ~~ #grow ifTrue:[size := stop]
ca@38
   186
                                       ifFalse:[size := stop-1].
ca@38
   187
ca@38
   188
            instanceTypes removeFromIndex:start toIndex:stop.
ca@38
   189
            instanceNames removeFromIndex:start toIndex:stop.
ca@38
   190
        ].
ca@38
   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]
ca@38
   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
ca@38
   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:[
ca@33
   240
        nm := instanceNames at:anIndex.
ca@33
   241
ca@33
   242
        (nm at:1) isDigit ifFalse:[
ca@33
   243
            self includesSelf ifFalse:[
ca@33
   244
                ^ inspectedObject instVarAt:anIndex
ca@33
   245
            ].
ca@33
   246
            anIndex == 1 ifFalse:[^ inspectedObject instVarAt:(anIndex-1)]
ca@33
   247
                          ifTrue:[^ inspectedObject]
ca@33
   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:[
ca@33
   276
        ^ self
ca@33
   277
    ].
ca@33
   278
ca@38
   279
    instanceTypes size == 0 ifTrue:[
ca@38
   280
        lstVarId := 0
ca@38
   281
    ] ifFalse:[
ca@38
   282
        instSize := inspectedObject class instSize.
ca@33
   283
ca@38
   284
        instanceTypes first == #self ifTrue:[
ca@38
   285
            instSize := instSize + 1
ca@38
   286
        ].
ca@33
   287
        instanceTypes last == #grow ifTrue:[
ca@33
   288
            instanceNames removeLast.       " ..    "
ca@33
   289
            instanceTypes removeLast.       " #grow "
ca@38
   290
        ].
ca@38
   291
        lstVarId := instanceTypes size - instSize.
ca@38
   292
    ].
ca@38
   293
ca@38
   294
    (basicSize := inspectedObject basicSize) == lstVarId ifTrue:[
ca@38
   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:[
ca@38
   300
        newLastId := basicSize
ca@33
   301
    ].
ca@33
   302
ca@33
   303
    [lstVarId ~~ newLastId] whileTrue:[
ca@33
   304
        lstVarId := lstVarId + 1.
ca@33
   305
        obj := inspectedObject basicAt:lstVarId.
ca@33
   306
ca@33
   307
        (self class isDirectory:obj) ifTrue:[instanceTypes add:#directory]
ca@33
   308
                                    ifFalse:[instanceTypes add:#normal].
ca@33
   309
ca@33
   310
        instanceNames add:(lstVarId printString, '   ', obj class name printString).
ca@33
   311
    ].
ca@33
   312
ca@33
   313
    lstVarId ~~ basicSize ifTrue:[
ca@33
   314
        instanceNames add:'..'.
ca@33
   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:[
ca@38
   352
        self resizeTo:selection.
ca@33
   353
ca@38
   354
        selection > instanceTypes size ifTrue:[
ca@38
   355
            selection := nil
ca@38
   356
        ]
ca@38
   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:[
ca@38
   394
        text := self class asString:aText.
ca@38
   395
ca@38
   396
        text notNil ifTrue:[
ca@38
   397
            self includesSelf ifFalse:[slNr := selection]
ca@38
   398
                               ifTrue:[slNr := selection-1].
ca@38
   399
ca@38
   400
            value := inspectedObject class evaluatorClass 
ca@38
   401
                       evaluate:text
ca@38
   402
                       receiver:inspectedObject 
ca@38
   403
                      notifying:aView.
ca@38
   404
ca@38
   405
            slNr ~~ 0 ifTrue:[
ca@38
   406
                (inspectedObject class isVariable) ifFalse:[
ca@38
   407
                    inspectedObject instVarAt:slNr put:value
ca@38
   408
                ] ifTrue:[
ca@38
   409
                    slNr <= (inspectedObject class instSize) ifTrue:[
ca@38
   410
                        inspectedObject instVarAt:slNr put:value
ca@38
   411
                    ] ifFalse:[
ca@38
   412
                        slNr := slNr - inspectedObject class instSize.
ca@38
   413
                        inspectedObject basicAt:slNr put:value
ca@38
   414
                    ]
ca@38
   415
                ]
ca@38
   416
            ].
ca@38
   417
            inspectedObject changed.
ca@38
   418
            self update.
ca@38
   419
          ^ inspectedObject
ca@38
   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:[
ca@38
   435
        code := self class asString:aCode.
ca@38
   436
ca@38
   437
        code notNil ifTrue:[
ca@38
   438
            evaluator := selInstVar class evaluatorClass.
ca@38
   439
            successFg := true.
ca@38
   440
ca@38
   441
            evaluator notNil ifTrue:[
ca@38
   442
                result := evaluator evaluate:code 
ca@38
   443
                                          in:nil 
ca@38
   444
                                    receiver:selInstVar 
ca@38
   445
                                   notifying:aView 
ca@38
   446
                                      logged:true 
ca@38
   447
                                      ifFail:[successFg := false].
ca@38
   448
ca@38
   449
                successFg ifTrue:[
ca@38
   450
                    self update. 
ca@38
   451
                  ^ result 
ca@38
   452
                ]
ca@33
   453
            ]
ca@38
   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:[
ca@38
   469
        inspectedObject := anObject.
ca@38
   470
ca@38
   471
        (self class isDirectory:inspectedObject) ifFalse:[
ca@38
   472
            instanceNames := OrderedCollection new.
ca@38
   473
            instanceTypes := OrderedCollection new.
ca@38
   474
        ] ifTrue:[    
ca@38
   475
            instanceNames := inspectedObject class allInstVarNames.
ca@38
   476
            varNamesSize  := instanceNames size.
ca@38
   477
            instanceTypes := OrderedCollection new:varNamesSize.
ca@38
   478
ca@38
   479
            1 to:varNamesSize do:[:i|
ca@38
   480
                (self class isDirectory:(inspectedObject instVarAt:i)) ifTrue:[
ca@38
   481
                    instanceTypes add:#directory
ca@38
   482
                ] ifFalse:[
ca@38
   483
                    instanceTypes add:#normal
ca@38
   484
                ]
ca@38
   485
            ].
ca@38
   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
! !