extensions.st
author Claus Gittinger <cg@exept.de>
Thu, 15 Mar 2007 20:29:31 +0100
changeset 7750 b7a995d53e6a
parent 7735 a85329ee3b3a
child 7753 6b17045c166a
permissions -rw-r--r--
checkin from browser

"{ Package: 'stx:libtool' }"
!

!ByteArray methodsFor:'inspecting'!

inspectorExtraAttributes
    ^ Dictionary new
	declareAllNewFrom:(super inspectorExtraAttributes ? #());
	add:'-hexadecimal' ->
	    [
		String
		    streamContents:[:s |
			self class isWords ifTrue:[
			    self asWordArray printOn:s base:16 showRadix:true
			] ifFalse:[
			    self class isLongs ifTrue:[
				self asLongIntegerArray printOn:s base:16 showRadix:true
			    ] ifFalse:[
				self asByteArray printOn:s base:16 showRadix:true
			    ]
			]
		    ]
	    ];
	yourself

    "Created: / 18-09-2006 / 21:29:59 / cg"
    "Modified: / 06-10-2006 / 13:57:20 / cg"
! !

!Character methodsFor:'inspecting'!

inspectorExtraAttributes
    ^ Dictionary new
	declareAllNewFrom:(super inspectorExtraAttributes ? #());
	add:'-string' -> [ self stringSpecies with:self ];
	yourself

    "
     $a inspect
    "

    "Created: / 22-10-2006 / 03:52:20 / cg"
! !

!Collection methodsFor:'inspecting'!

inspectorExtraAttributes
    ^ Dictionary new
	declareAllNewFrom:(super inspectorExtraAttributes ? #());
	add:('-size' -> [ self size ]);
	yourself

    "
     'hello' inspect
    "

    "Created: / 06-10-2006 / 13:56:52 / cg"
    "Modified: / 06-10-2006 / 17:43:45 / cg"
! !

!Color methodsFor:'inspecting'!

inspectorClass
    "return the class of an appropriate inspector.
     ST/X has a specialized ColorInspectorView for that"

    ^ ColorInspectorView

    "Modified: 23.4.1996 / 13:39:50 / cg"
! !

!Dictionary methodsFor:'inspecting'!

inspectorClass
    "redefined to use DictionaryInspector
     (instead of the default Inspector)."

    ^ DictionaryInspectorView
! !

!ExecutableFunction methodsFor:'printing & storing'!

printStringForBrowserWithSelector:selector
    "return a printString to represent myself to the user in a browser."

    ^ self printStringForBrowserWithSelector:selector inClass:nil
! !

!Form methodsFor:'inspecting'!

inspectorClass
    "redefined to launch an ImageInspector
     (instead of the default InspectorView)."

    ^ ImageInspectorView
! !

!Image methodsFor:'inspecting'!

inspectorClass
    "redefined to launch an ImageInspector
     (instead of the default InspectorView)."

    (width notNil and:[height notNil]) ifTrue:[
	^ ImageInspectorView
    ].
    ^ super inspectorClass

    "Modified: 10.6.1996 / 18:23:55 / cg"
! !

!Integer methodsFor:'inspecting'!

inspectorExtraAttributes
    ^ Dictionary new
	declareAllNewFrom:(super inspectorExtraAttributes ? #());
	add:'-hexadecimal' -> [ self radixPrintStringRadix:16 ];
	add:'-octal' -> [ self radixPrintStringRadix:8 ];
	add:'-binary' -> [ self radixPrintStringRadix:2 ];
	yourself

    "
     123 inspect
    "

    "Created: / 18-09-2006 / 21:22:46 / cg"
    "Modified: / 06-10-2006 / 13:57:28 / cg"
! !

!Method methodsFor:'inspecting'!

inspectorExtraAttributes
    ^ Dictionary new
	declareAllNewFrom:(super inspectorExtraAttributes ? #());
	add:'-code' -> [ String streamContents:[:s | self decompileTo:s] ];
	add:'-source' -> [ self source ];
	yourself

    "
     (Method compiledMethodAt:#inspectorExtraAttributes) inspect
    "

    "Created: / 18-09-2006 / 21:34:01 / cg"
    "Modified: / 06-10-2006 / 13:57:33 / cg"
! !

!Method methodsFor:'printing & storing'!

printStringForBrowserWithSelector:selector inClass:aClass
    "return a printString to represent myself to the user in a browser.
     Defined here to allow for browsers to deal with nonStandard pseudoMethods"

    |s privInfo moreInfo p info n cls currentChangeSet isInChangeSet mthdPackage
     userPreferences shownSelector suppressPackage timeRounded|

    moreInfo := ''.
    privInfo := ''.
    userPreferences := UserPreferences current.

    self isWrapped ifTrue:[
	(MessageTracer isCounting:self) ifTrue:[
	    (MessageTracer isCountingMemoryUsage:self) ifTrue:[
		moreInfo := moreInfo , (' (mem usage avg: %1 bytes)' bindWith:(MessageTracer memoryUsageOfMethod:self) printString allBold).
	    ] ifFalse:[
		moreInfo := moreInfo , (' (called %1 times)' bindWith:(MessageTracer executionCountOfMethod:self) printString allBold).
	    ]
	] ifFalse:[
	    (MessageTracer isTiming:self) ifTrue:[
		info := MessageTracer executionTimesOfMethod:self.
		((n := info count) == 0) ifTrue:[
		    moreInfo := moreInfo , (' (cnt: %1)' bindWith:n)
		] ifFalse:[
		    timeRounded := [:millis |
			|rnd|
			rnd := (millis > 100)
				 ifTrue:[ 1 ]
				 ifFalse:[
				     (millis > 10)
					ifTrue:[ 0.1 ]
					ifFalse:[
					    (millis > 1)
						ifTrue:[ 0.01 ]
						ifFalse:[ 0.001 ]]].
			millis roundTo:rnd
		    ].

		    (n == 1 or:[ info avgTimeRounded = info minTimeRounded  ]) ifTrue:[
			moreInfo := moreInfo ,
				    (' (t: %1ms cnt: %2)'
					bindWith:((timeRounded value:info avgTimeRounded) printString allBold)
					with:n)
		    ] ifFalse:[
			moreInfo := moreInfo ,
				    (' (avg: %1ms min: %2 max: %3 cnt: %4)'
					bindWith:((timeRounded value:info avgTimeRounded) printString allBold)
					with:((timeRounded value:info minTimeRounded) printString)
					with:((timeRounded value:info maxTimeRounded) printString)
					with:n)
		    ].
		].
	    ] ifFalse:[
		moreInfo := ' !!'
	    ]
	].
    ].
    p := self privacy.

    p ~~ #public ifTrue:[
	privInfo := (' (* ' , p , ' *)') asText emphasizeAllWith:#italic.
    ].

"/    self isInvalid ifTrue:[
"/        moreInfo := ' (** not executable **)'.
"/    ].

    (self isLazyMethod not and:[self isUnloaded]) ifTrue:[
	moreInfo := ' (** unloaded **)'
    ].

    privInfo size ~~ 0 ifTrue:[
	moreInfo := privInfo , ' ' , moreInfo
    ].

    s := shownSelector := (self selectorPrintStringInBrowserFor:selector class:aClass).

    (cls := aClass) isNil ifTrue:[
	cls := self containingClass
    ].

    currentChangeSet := ChangeSet current.
    isInChangeSet := currentChangeSet includesChangeForClass:cls selector:selector.

    isInChangeSet ifTrue:[
	s := s asText emphasisAllAdd:(userPreferences emphasisForChangedCode)
    ].

    (cls isNil or:[(mthdPackage := self package) ~= cls package]) ifTrue:[
	suppressPackage := false.
	mthdPackage = Project noProjectID ifTrue:[
	    mthdPackage := '+'.
	    "/ suppressPackage := true
	].
	suppressPackage ifFalse:[
	    p := ' [' , (mthdPackage ? '?') allItalic , '] '.
	    p := p asText emphasisAllAdd:(userPreferences emphasisForDifferentPackage).
	    s := s , ' ' , p
	].
    ].

    moreInfo size == 0 ifTrue:[^ s].

    s := shownSelector , moreInfo.

    self isInvalid ifTrue:[
	s := s asText emphasizeAllWith:(userPreferences emphasisForObsoleteCode).
    ].
    ^ s

    "Modified: / 23-01-1998 / 13:15:15 / stefan"
    "Created: / 05-02-2000 / 22:55:56 / cg"
    "Modified: / 05-03-2007 / 16:18:53 / cg"
! !

!Method methodsFor:'printing & storing'!

selectorPrintStringInBrowserFor:selector
    ^ selector
! !

!Method methodsFor:'printing & storing'!

selectorPrintStringInBrowserFor:selector class:aClass
    |nsPart selPart idx ns|

    selector isNameSpaceSelector ifFalse:[^ selector].

    idx := selector indexOf:$: startingAt:3.
    nsPart := selector copyFrom:2 to:idx-1.
    ns := Smalltalk at:nsPart asSymbol.
    selPart := selector copyFrom:idx+2.
    ^ selPart , ' {',nsPart,'}'.
! !

!MethodDictionary methodsFor:'inspecting'!

inspectorClass
    "redefined to use DictionaryInspector
     (instead of the default Inspector)."

    ^ DictionaryInspectorView

    "Created: 12.6.1996 / 12:29:13 / stefan"
! !

!NameSpace class methodsFor:'inspecting'!

inspectorClass
    "{ Pragma: +optSpace }"

    "redefined to launch a DictionaryInspector
     (instead of the default Inspector)."

    ^ DictionaryInspectorView


! !

!Object methodsFor:'debugging'!

inspectorExtraAttributes
    "Answers a dictionary of aString -> aBlock.
     aString is name of extra attribute and MUST start with minus ($-).
     aBlock returns the object representing extra attribute."

    ^Dictionary new

    " Try to uncomment following and inspect any object "

"/    ^Dictionary new
"/        add:'-test' -> ['TEST TEST'];
"/        yourself

    "Created: / 16-08-2005 / 20:43:33 / janfrog"
    "Modified: / 02-09-2005 / 19:00:01 / janfrog"
    "Modified: / 04-10-2006 / 14:33:34 / cg"
! !

!Object methodsFor:'error correction'!

notifyTodo:msg position:position
         className:className selector:selector
         severity:severityOrSeveritySymbol priority:priorityOrPrioritySymbol
         equalityParameter:equalityParameter checkAction:checkAction



    (Tools::CompilerWarningToDoListEntry notNil
    and:[Tools::CompilerWarningToDoListEntry isLoaded]) ifFalse:[^ self ].

    Tools::CompilerWarningToDoListEntry
        notifyTodo:msg position:position
        className:className selector:selector
        severity:severityOrSeveritySymbol priority:priorityOrPrioritySymbol
        equalityParameter:equalityParameter checkAction:checkAction

    "Modified: / 15-03-2007 / 20:29:23 / cg"
! !

!OrderedCollection methodsFor:'inspecting'!

inspectorClass
    "redefined to launch an OrderedCollectionInspector
     (instead of the default InspectorView)."

    ^ OrderedCollectionInspectorView

    "
     (OrderedCollection withAll:#(3 2 1)) inspect
     (OrderedCollection withAll:#(3 2 1)) removeFirst; yourself; inspect
     #(0 8 15 3 99 2) asSortedCollection inspect
    "
! !

!RunArray methodsFor:'user interface'!

inspectorClass
    "Re-reimplemented so that we don't get an ordered collection inspector
     which would get very confused when confronted with a runArray."

    ^ InspectorView

    "Modified: / 30.10.1997 / 14:28:20 / cg"
! !

!Set methodsFor:'inspecting'!

inspectorClass
    "redefined to use SetInspector
     (instead of the default Inspector)."

    ^ SetInspectorView
! !

!Smalltalk class methodsFor:'inspecting'!

inspectorClass
    "{ Pragma: +optSpace }"

    "redefined to launch a DictionaryInspector (instead of the default Inspector)."

    ^ DictionaryInspectorView
! !

!Text methodsFor:'inspecting'!

inspectorExtraAttributes
    ^ Dictionary new
	declareAllNewFrom:(super inspectorExtraAttributes ? #());
	add:'-text' -> [ self ];
	yourself

    "
     'hello' allBold inspect
    "

    "Created: / 18-09-2006 / 21:25:52 / cg"
    "Modified: / 06-10-2006 / 13:57:38 / cg"
! !