'10/3/99 3:16:46 am'!

'#
# This file is encoded in (so called) SHIFT-JIS,
# line delimitor is CR.
#

Inspector Menu Enhancements
Goodies for VisualWorks 2.5, VisualWorks Non-Commercial 3.0a
Copyleft 1999 NISHIHARA Satoshi

Broken English description

Summary:

This goodies adds a menu item "browse full" to inspector menu.
In VW252-diving-inspector or Tree-Inspector of Jun, this is available.

How to install:

FileIn this goodies and makes a class "InspectorMenuEnhancements" in a 
category "Goodies-Misc". 
AND
If you''re using VW252-diving-inspector on VisualWorks 2.5, 
1 method is modified in a category "field list" of the class "Inspector".
	Inspector>>basicUtilsMenu
1 method is added in a category "private-menu messages" of the class "Inspector".
	Inspector>>fullBrowseField
If you are using VWNC 3.0a or VW 2.5 without diving-inspector, no method 
are modified.

When you want to restore your image, please remove this class 
"InspectorMenuEnhancements" from your system, simply.
Also a menu item "browse full" is removed automatically from 
Inspector menu.


How to use:

When you install this goodies, it adds a menu item "browse full" 
to Inspector menu automatically.

----------------------------------------------------------
�������m (NISHIHARA Satoshi)
e-mail: mailto:nishis@zephyr.dti.ne.jp
URL:    http://www.zephyr.dti.ne.jp/~nishis/
----------------------------------------------------------
'!

Object subclass: #InspectorMenuEnhancements
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Goodies-Misc'!


Object subclass: #InspectorMenuEnhancements
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Goodies-Misc'!
InspectorMenuEnhancements comment:
'#
# This file is encoded in (so called) SHIFT-JIS,
# line delimitor is CR.
#

Inspector Menu Enhancements
Goodies for VisualWorks 2.5, VisualWorks Non-Commercial 3.0a
Copyleft 1999 NISHIHARA Satoshi

Broken English description

Summary:

This goodies adds a menu item "browse full" to inspector menu.
In VW252-diving-inspector or Tree-Inspector of Jun, this is available.

How to install:

FileIn this goodies and makes a class "InspectorMenuEnhancements" in a 
category "Goodies-Misc". 
AND
If you''re using VW252-diving-inspector on VisualWorks 2.5, 
1 method is modified in a category "field list" of the class "Inspector".
	Inspector>>basicUtilsMenu
1 method is added in a category "private-menu messages" of the class "Inspector".
	Inspector>>fullBrowseField
If you are using VWNC 3.0a or VW 2.5 without diving-inspector, no method 
are modified.

When you want to restore your image, please remove this class 
"InspectorMenuEnhancements" from your system, simply.
Also a menu item "browse full" is removed automatically from 
Inspector menu.


How to use:

When you install this goodies, it adds a menu item "browse full" 
to Inspector menu automatically.

----------------------------------------------------------
�������m (NISHIHARA Satoshi)
e-mail: mailto:nishis@zephyr.dti.ne.jp
URL:    http://www.zephyr.dti.ne.jp/~nishis/
----------------------------------------------------------
'!

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

InspectorMenuEnhancements class
	instanceVariableNames: 'enhancements '!


!InspectorMenuEnhancements class methodsFor: 'copyright'!

copyright
	^'Copyleft 1999 NISHIHARA Satoshi.'!

system
	^'Goodies'!

version
	^'001'! !

!InspectorMenuEnhancements class methodsFor: 'class initialization'!

induct
	"InspectorMenuEnhancements induct."

	Inspector flushMenus.
	self enhanceInspectorMenus!

initialize
	"InspectorMenuEnhancements initialize."

	"self induct"!

install
	"InspectorMenuEnhancements install."

	| default done process count |
	Cursor normal show.
	default := false.
	done := false.
	process := 
			[default := Dialog confirm: 'Do you want to enhance the inspector menu?' initialAnswer: default.
			default ifTrue: [self induct].
			done := true] newProcess.
	process priority: Processor activeProcess priority + 0.
	process resume.
	count := 0.
	[done not and: [count < 10]]
		whileTrue: 
			[count := count + 1.
			(Delay forSeconds: 1) wait].
	process terminate.
	done ifFalse: [default ifTrue: [self induct]]!

obsolete
	self uninduct.
	Browser withAllSubclasses do: [:each | each allInstances do: [:it | it updateCategories]].
	super obsolete!

uninduct
	"InspectorMenuEnhancements uninduct."

	| aClass aSelector treeInspectorClass |
	enhancements notNil
		ifTrue: 
			[enhancements copy
				do: 
					[:anArray | 
					aClass := Compiler evaluate: (anArray at: 1)
								logged: false.
					aSelector := anArray at: 3.
					self uninstallEnhanceClass: aClass selector: aSelector].
			enhancements := nil].
	Inspector flushMenus.
	treeInspectorClass := Smalltalk at: #JunTreeInspector ifAbsent: [nil].
	treeInspectorClass notNil ifTrue: [treeInspectorClass flushMenus]!

uninstall
	"InspectorMenuEnhancements uninstall."

	self uninduct! !

!InspectorMenuEnhancements class methodsFor: 'enhancements'!

basicUtilsMenuInInspector
	"InspectorMenuEnhancements basicUtilsMenuInInspector."

	self
		installEnhanceClassName: #Inspector
		protocol: 'field list'
		code: 'basicUtilsMenu
	"Inspector flushMenus"

	| menu labels values |
	menu := Menu
		labels: ''browse\basic inspect\owners\history\show all fields'' withCRs
		values: #(browseField basicInspectField ownerOfField history showAllFields).
	labels := OrderedCollection new.
	values := OrderedCollection new.
	labels add: ''browse full''.
	values add: [self fullBrowseField].
	menu addItemGroupLabels: labels asArray values: values asArray.
	^menu'!

fullBrowseFieldInInspector
	"InspectorMenuEnhancements fullBrowseFieldInInspector."

	self
		installEnhanceClassName: #Inspector
		protocol: 'private-menu messages'
		code: 'fullBrowseField
	| fieldValue aClass meta category aBrowser |
	fieldValue := self fieldValue.
	aClass := (meta := fieldValue class isMeta) 
		ifTrue: [fieldValue]
		ifFalse: [fieldValue class].
	category := aClass category.
	aBrowser := Browser new.
	aBrowser meta: meta.
	aBrowser open.
	aBrowser categoryList selection: category.
	aBrowser classList selection: aClass name'! !

!InspectorMenuEnhancements class methodsFor: 'menu enhancements'!

enhanceBasicUtilsMenu
	"InspectorMenuEnhancements enhanceBasicUtilsMenu."

	| menu labels values |
	menu := Inspector classPool at: #BasicUtilsMenu ifAbsent: [nil].
	menu isNil
		ifTrue: 
			[Object messageNotUnderstoodSignal
				handle: 
					[:exception | 
					| anInspector |
					anInspector := Inspector inspect: Object new.
					anInspector field: #self.
					menu := anInspector fieldMenu]
				do: [menu := (Inspector new) basicUtilsMenu].
			Inspector classPool at: #BasicUtilsMenu put: menu].
	(menu menuItemLabeled: 'browse full' ifNone: [nil]) notNil ifTrue: [^menu].
	labels := OrderedCollection new.
	values := OrderedCollection new.
	labels add: 'browse full'.
	values add: [:controller | self fullBrowseField: controller].
	menu addItemGroupLabels: labels asArray values: values asArray.
	^menu!

enhanceFieldMenu
	"InspectorMenuEnhancements enhanceFieldMenu."

	| menu labels values treeInspectorClass |
	treeInspectorClass := Smalltalk at: #JunTreeInspector ifAbsent: [^nil].
	menu := treeInspectorClass classPool at: #TreeListMenu ifAbsent: [nil].
	menu isNil
		ifTrue: 
			[Object messageNotUnderstoodSignal
				handle: 
					[:exception | 
					| anInspector |
					anInspector := (treeInspectorClass inspect: Object new) open.
					anInspector field: anInspector fieldTreeList root.
					menu := anInspector fieldMenu]
				do: [menu := treeInspectorClass treeListPopUpMenu].
			treeInspectorClass classPool at: #TreeListMenu put: menu].
	(menu menuItemLabeled: 'browse full' ifNone: [nil]) notNil ifTrue: [^menu].
	labels := OrderedCollection new.
	values := OrderedCollection new.
	labels add: 'browse full'.
	values add: [:controller | self fullBrowseField: controller].
	menu addItemGroupLabels: labels asArray values: values asArray.
	^menu!

enhanceInspectorMenus
	"InspectorMenuEnhancements enhanceInspectorMenus."

	self isDivingInspectorInstalled 
		ifTrue: 
			[self fullBrowseFieldInInspector.
			self basicUtilsMenuInInspector]
		ifFalse: [self enhanceBasicUtilsMenu].
	Browser withAllSubclasses do: [:each | each allInstances do: [:it | it updateCategories]].
	(Smalltalk at: #JunTreeInspector ifAbsent: [nil]) notNil 
		ifTrue: [InspectorMenuEnhancements enhanceFieldMenu]! !

!InspectorMenuEnhancements class methodsFor: 'menu messages'!

fullBrowseField: aController
	| fieldValue aClass meta category aBrowser |
	(aController performer isKindOf: Inspector) ifFalse: [^nil].
	fieldValue := aController performer fieldValue.
	aClass := (meta := fieldValue class isMeta) 
		ifTrue: [fieldValue]
		ifFalse: [fieldValue class].
	category := aClass category.
	aBrowser := Browser new.
	aBrowser meta: meta.
	aBrowser open.
	aBrowser categoryList selection: category.
	aBrowser classList selection: aClass name! !

!InspectorMenuEnhancements class methodsFor: 'saving'!

save
	"InspectorMenuEnhancements save."

	| encodingName fileName classCollection aStream |
	encodingName := #default.
	fileName := 'InspctEn.st'.
	classCollection := self saveClasses.
	aStream := (fileName asFilename withEncoding: encodingName) writeStream.
	[Cursor write
		showWhile: 
			[| timeStamp |
			timeStamp := Date today shortPrintString , ' ' , Time now shortPrintString.
			aStream cr.
			aStream nextChunkPut: timeStamp printString.
			aStream cr; cr.
			(self comment isNil or: [self comment isEmpty])
				ifFalse: 
					[aStream nextChunkPut: self comment printString.
					aStream cr; cr].
			classCollection
				do: 
					[:aClass | 
					aStream nextChunkPut: aClass definition.
					aStream cr; cr].
			classCollection
				do: 
					[:aClass | 
					| sourceCodeStream |
					aStream nextPut: Character newPage.
					aStream cr.
					sourceCodeStream := SourceCodeStream on: aStream.
					aClass fileOutSourceOn: sourceCodeStream.
					aStream cr]]]
		valueNowOrOnUnwindDo: [aStream close].
	^classCollection!

saveClasses
	"InspectorMenuEnhancements saveClasses."

	| patternCollection classCollection |
	patternCollection := #('*InspectorMenuEnhancements*').
	classCollection := Smalltalk organization superclassOrder: self category.
	classCollection := classCollection
				select: 
					[:aClass | 
					| string something |
					string := aClass name asString.
					something := patternCollection detect: [:it | it match: string]
								ifNone: [nil].
					something notNil].
	^classCollection! !

!InspectorMenuEnhancements class methodsFor: 'private'!

divingInspectorVW252
	^'VW252-diving-inspector' copy!

installEnhanceClassName: aClassSymbol protocol: aProtocol code: aCode 
	| aClass aSelector anArray oldCode aCategory |
	aClass := Smalltalk at: aClassSymbol ifAbsent: [nil].
	aClass isBehavior ifFalse: [^self].
	aSelector := Parser new parseSelector: aCode.
	aSelector isNil ifTrue: [^self].
	enhancements isNil ifTrue: [enhancements := OrderedCollection new].
	anArray := enhancements
				detect: 
					[:array | 
					| bool |
					bool := aClass name asString = (array at: 1).
					bool := bool and: [aSelector = (array at: 3)].
					bool yourself]
				ifNone: [nil].
	anArray isNil
		ifTrue: 
			[(aClass includesSelector: aSelector)
				ifTrue: 
					[oldCode := aClass sourceCodeAt: aSelector.
					aCategory := aClass organization categoryOfElement: aSelector.
					aCategory isNil ifTrue: [aCategory := #undefined]]
				ifFalse: 
					[oldCode := nil.
					aCategory := aProtocol].
			enhancements add: (Array
					with: aClass name asString
					with: aCategory asString
					with: aSelector
					with: oldCode)].
	aClass compile: aCode classified: aProtocol!

isDivingInspectorInstalled
	"InspectorMenuEnhancements isDivingInspectorInstalled."

	^ChangeSet patches includes: self divingInspectorVW252!

stringMatch: string and: pattern 
	"InspectorMenuEnhancements stringMatch: 'Jun Aoki' and: 'Ju*[A-B]?ki'."

	| s1 s2 |
	s1 := WriteStream on: (String new: 20).
	s1 nextPutAll: string.
	s1 nextPut: (Character value: 0).
	s2 := WriteStream on: (String new: 20).
	s2 nextPutAll: pattern.
	s2 nextPut: (Character value: 0).
	^self
		stringMatch: s1 contents
		sIndex: 1
		and: s2 contents
		pIndex: 1!

stringMatch: string sIndex: sindex and: pattern pIndex: pindex 
	| scc c si pi ok lc |
	si := sindex.
	pi := pindex.
	scc := string at: si.
	si := si + 1.
	c := pattern at: pi.
	pi := pi + 1.
	c = $[
		ifTrue: 
			[ok := false.
			lc := 255.
			
			[c := pattern at: pi.
			pi := pi + 1.
			c ~= (Character value: 0)]
				whileTrue: [c = $]
						ifTrue: [ok
								ifTrue: [^self
										stringMatch: string
										sIndex: si
										and: pattern
										pIndex: pi]
								ifFalse: [^false]]
						ifFalse: [c = $-
								ifTrue: 
									[(lc <= scc and: [scc <= (pattern at: pi)])
										ifTrue: [ok := true].
									pi := pi + 1]
								ifFalse: 
									[lc := c.
									scc = c ifTrue: [ok := true]]]]].
	c = $? ifTrue: [scc ~= (Character value: 0)
			ifTrue: [^self
					stringMatch: string
					sIndex: si
					and: pattern
					pIndex: pi]
			ifFalse: [^false]].
	c = $*
		ifTrue: 
			[(pattern at: pi)
				= (Character value: 0) ifTrue: [^true].
			si := si - 1.
			[(string at: si)
				~= (Character value: 0)]
				whileTrue: 
					[(self
						stringMatch: string
						sIndex: si
						and: pattern
						pIndex: pi)
						ifTrue: [^true].
					si := si + 1].
			^false].
	c = (Character value: 0) ifTrue: [^scc = (Character value: 0)].
	c ~= scc ifTrue: [^false].
	scc ~= (Character value: 0)
		ifTrue: [^self
				stringMatch: string
				sIndex: si
				and: pattern
				pIndex: pi]
		ifFalse: [^false]!

uninstallEnhanceClass: aClass selector: aSelector 
	| anArray aProtocol oldCode |
	aClass isBehavior ifFalse: [^self].
	(aSelector isKindOf: Symbol)
		ifFalse: [^self].
	enhancements isNil ifTrue: [^self].
	anArray := enhancements
				detect: 
					[:array | 
					| bool |
					bool := aClass name asString = (array at: 1).
					bool := bool and: [aSelector = (array at: 3)].
					bool yourself]
				ifNone: [nil].
	anArray isNil ifTrue: [^self].
	aProtocol := anArray at: 2.
	oldCode := anArray at: 4.
	oldCode isNil
		ifTrue: ["remove method"
			aClass removeSelector: aSelector]
		ifFalse: ["restore method"
			aClass compile: oldCode classified: aProtocol].
	enhancements remove: anArray! !

InspectorMenuEnhancements initialize!