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