'10/3/99 3:17:57 am'!

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

Visual Launcher Enhancements
Goodies for VisualWorks 2.5
Copyleft 1999 NISHIHARA Satoshi

Broken English description

Summary:

This goodies adds some menu items in Visual Launcher alike VisualWorks Non-Commercial 3.0a.

How to install:

FileIn this goodies and makes a class "VisualLauncherEnhancements" in a 
category "Goodies-Misc". 

When you want to restore your image, please remove this class 
"VisualLauncherEnhancements" from your system, simply.
Also added menu items are removed automatically from 
VisualLauncher.


How to use:

same as you use.

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

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

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

Visual Launcher Enhancements
Goodies for VisualWorks 2.5
Copyleft 1999 NISHIHARA Satoshi

Broken English description

Summary:

This goodies adds some menu items in Visual Launcher alike VisualWorks Non-Commercial 3.0a.

How to install:

FileIn this goodies and makes a class "VisualLauncherEnhancements" in a 
category "Goodies-Misc". 

When you want to restore your image, please remove this class 
"VisualLauncherEnhancements" from your system, simply.
Also added menu items are removed automatically from 
VisualLauncher.


How to use:

same as you use.

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

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

VisualLauncherEnhancements class
	instanceVariableNames: 'enhancements '!


!VisualLauncherEnhancements class methodsFor: 'copyright'!

copyright
	^'Copyleft 1999 NISHIHARA Satoshi.'!

system
	^'Goodies'!

version
	^'001'! !

!VisualLauncherEnhancements class methodsFor: 'class initialization'!

induct
	"VisualLauncherEnhancements induct."

	self allCallsOnOrInBrowser.
	self browseGlobalInBrowser.
	self browseGlobalInVisualLauncher.
	self browseInspectInVisualLauncher.
	self changesCondenseChangesInVisualLauncher.
	self winNewLauncherInVisualLauncher.
	self openInstallationWorkspaceInVisualLauncher.
	self openSystemWorkspaceInVisualLauncher.
	self openTranscriptInVisualLauncher.
	self refreshWindowsInVisualLauncher.
	self menuBarInVisualLauncher.

	self refreshVisualLauncher!

initialize
	"VisualLauncherEnhancements initialize."

	"self induct"!

install
	"VisualLauncherEnhancements install."

	| default done process count |
	self postfix == #'25' ifFalse: [^nil].
	Cursor normal show.
	default := false.
	done := false.
	process := 
			[default := Dialog confirm: 'Do you want to enhance the Visual Launcher?' 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.
	super obsolete!

uninduct
	"VisualLauncherEnhancements uninduct."

	| aClass aSelector |
	enhancements notNil
		ifTrue: 
			[enhancements copy
				do: 
					[:anArray | 
					aClass := Compiler evaluate: (anArray at: 1)
								logged: false.
					aSelector := anArray at: 3.
					self uninstallEnhanceClass: aClass selector: aSelector.
					aClass organization removeEmptyCategories].
			enhancements := nil].
	self refreshVisualLauncher!

uninstall
	"VisualLauncherEnhancements uninstall."

	self uninduct! !

!VisualLauncherEnhancements class methodsFor: 'enhancements'!

allCallsOnOrInBrowser
	"VisualLauncherEnhancements allCallsOnOrInBrowser."

	self
		installEnhanceClass: Browser class
		protocol: 'private retrieving'
		code: 'allCallsOn: firstLiteral or: secondLiteral
	"Answer a SortedCollection of all the methods that
	 call on either aLiteral or secondLiteral."

	| aCollection |
	aCollection := SortedCollection new.
	Cursor execute showWhile:
		[Smalltalk allBehaviorsDo:
			[:class |
			((class whichSelectorsReferTo: secondLiteral) asSet
				addAll: (class whichSelectorsReferTo: firstLiteral);
				yourself) do:
				[:sel | 
				aCollection add: class name , '' '' , sel]]].
	^aCollection'!

browseGlobalInBrowser
	"VisualLauncherEnhancements browseGlobalInBrowser."

	self
		installEnhanceClass: Browser class
		protocol: 'private browsing'
		code: 'browseGlobal
	"Browse references to a global variable (either in Smalltalk or Undeclared).
	 Try to track down references that go through the global''s name as well as
	 direct references via its association, e.g. Smalltalk at: #UnixProcess"

	| response key assoc refs |
	response := Dialog request: ''Browse references to which global?''.
	response isEmpty ifTrue: [^self].
	(key := Symbol findInterned: response) isNil ifTrue:
		[^Dialog warn: ''no such global called '', response].
	assoc := (Smalltalk includesKey: key)
				ifTrue: [Smalltalk bindingFor: key]
				ifFalse:
					[(Undeclared includesKey: key)
						ifTrue: [Undeclared bindingFor: key]].
	refs := assoc isNil
			ifTrue: [self allCallsOn: key]
			ifFalse: [self allCallsOn: key or: assoc].
	self listBrowserClass
		openListBrowserOn: refs
		label: ''References to '' , response, ((Undeclared includesKey: key)
												ifTrue: ['' (which is undeclared)'']
												ifFalse: [''''])
		initialSelection: response'!

browseGlobalInVisualLauncher
	"VisualLauncherEnhancements browseGlobalInVisualLauncher."

	self
		installEnhanceClass: VisualLauncher
		protocol: 'private actions'
		code: 'browseGlobal
	"Browse references to a global variable (either in Smalltalk or Undeclared).
	 Try to track down references that go through the global''s name as well as
	 direct references via its association, e.g. Smalltalk at: #UnixProcess"

	self openApplicationForClassNamed: #Browser withSelector: #browseGlobal'!

browseInspectInVisualLauncher
	"VisualLauncherEnhancements browseInspectInVisualLauncher."

	self
		installEnhanceClass: VisualLauncher
		protocol: 'private actions'
		code: 'browseInspect
	"Inspect the result of evaluating an expression."

	| response |
	response := Dialog request: ''Inspect what?'' initialAnswer: ''expression''.
	response isEmpty ifTrue: [^self].
	(Compiler evaluate: response) inspect'!

changesCondenseChangesInVisualLauncher
	"VisualLauncherEnhancements changesCondenseChangesInVisualLauncher."

	self
		installEnhanceClass: VisualLauncher
		protocol: 'private actions'
		code: 'changesCondenseChanges
	"do condense changes."

	| msg |
	msg := String new writeStream.
	msg nextPutAll: '' Condense the Changes file. ''.
	msg crtab; nextPutAll: '' Are you sure? ''.
	(Dialog confirm: msg contents)
		ifTrue: 
			[SourceFileManager default condenseChanges]'!

menuBarInVisualLauncher
	"VisualLauncherEnhancements menuBarInVisualLauncher."

	self
		installEnhanceClass: VisualLauncher class
		protocol: 'resources'
		code: 'menuBar
	"MenuEditor new openOnClass: self andSelector: #menuBar"

	<resource: #menu>
	^#(#Menu #(
			#(#MenuItem 
				#rawLabel: ''&File'' 
				#submenu: #(#Menu #(
						#(#MenuItem 
							#rawLabel: ''&Save As...'' 
							#value: #imageSaveAs ) 
						#(#MenuItem 
							#rawLabel: ''&Perm Save As...'' 
							#value: #filePermSaveAs ) 
						#(#MenuItem 
							#rawLabel: ''Perm &Undo As...'' 
							#value: #filePermUndoAs ) 
						#(#MenuItem 
							#rawLabel: ''&Collect Garbage'' 
							#value: #collectGarbage ) 
						#(#MenuItem 
							#rawLabel: ''Collect All &Garbage'' 
							#value: #collectAllGarbage ) 
						#(#MenuItem 
							#rawLabel: ''Se&ttings'' 
							#value: #visualWorksSettings ) 
						#(#MenuItem 
							#rawLabel: ''E&xit VisualWorks...'' 
							#value: #visualWorksExit ) ) #(3 2 1 1 ) nil ) ) 
			#(#MenuItem 
				#rawLabel: ''&Browse'' 
				#submenu: #(#Menu #(
						#(#MenuItem 
							#rawLabel: ''&All Classes'' 
							#value: #browseAllClasses 
							#labelImage: #(#ResourceRetriever nil #allClassesIcon ) ) 
						#(#MenuItem 
							#rawLabel: ''Class &Named...'' 
							#value: #browseClassNamed ) 
						#(#MenuItem 
							#rawLabel: ''&Resources'' 
							#value: #browseApplications 
							#labelImage: #(#ResourceRetriever nil #finderIcon ) ) 
						#(#MenuItem 
							#rawLabel: ''References &To...'' 
							#value: #browseSendersOf ) 
						#(#MenuItem 
							#rawLabel: ''&Implementors Of...'' 
							#value: #browseImplementorsOf ) 
						#(#MenuItem 
							#rawLabel: ''Refs to Global...'' 
							#value: #browseGlobal ) 
						#(#MenuItem 
							#rawLabel: ''Inspect...'' 
							#value: #browseInspect ) ) #(3 3 1 ) nil ) ) 
			#(#MenuItem 
				#rawLabel: ''&Tools'' 
				#submenu: #(#Menu #(
						#(#MenuItem 
							#rawLabel: ''&File List'' 
							#value: #openFileList 
							#labelImage: #(#ResourceRetriever nil #fileListIcon ) ) 
						#(#MenuItem 
							#rawLabel: ''File &Editor...'' 
							#value: #openFileEditor ) 
						#(#MenuItem 
							#rawLabel: ''&Workspace'' 
							#value: #toolsNewWorkspace 
							#labelImage: #(#ResourceRetriever nil #workspaceIcon ) ) 
						#(#MenuItem 
							#rawLabel: ''Parcel &List'' 
							#value: #openParcelList ) 
						#(#MenuItem 
							#rawLabel: ''&New Canvas'' 
							#value: #toolsNewCanvas 
							#labelImage: #(#ResourceRetriever nil #newCanvasIcon ) ) 
						#(#MenuItem 
							#rawLabel: ''&Palette'' 
							#value: #toolsPalette ) 
						#(#MenuItem 
							#rawLabel: ''&Canvas Tool'' 
							#value: #toolsCanvasTool ) 
						#(#MenuItem 
							#rawLabel: ''&Image Editor'' 
							#value: #toolsMaskEditor ) 
						#(#MenuItem 
							#rawLabel: ''&Menu Editor'' 
							#value: #toolsMenuEditor ) 
						#(#MenuItem 
							#rawLabel: ''&Advanced'' 
							#nameKey: #advanced ) 
						#(#MenuItem 
							#rawLabel: ''&DLL and C Connect'' 
							#nameKey: #dllcc 
							#value: #openExternalFinder 
							#labelImage: #(#ResourceRetriever nil #extFinderIcon ) ) 
						#(#MenuItem 
							#rawLabel: ''System &Transcript'' 
							#nameKey: #transcript 
							#value: #toggleSystemTranscript 
							#indication: true ) ) #(4 5 2 1 ) nil ) ) 
			#(#MenuItem 
				#rawLabel: ''&Changes'' 
				#submenu: #(#Menu #(
						#(#MenuItem 
							#rawLabel: ''Open Change &List'' 
							#value: #changesOpenChangeList ) 
						#(#MenuItem 
							#rawLabel: ''&File Out Changes...'' 
							#value: #changesFileOutChanges ) 
						#(#MenuItem 
							#rawLabel: ''&Empty Changes...'' 
							#value: #changesEmptyChanges ) 
						#(#MenuItem 
							#rawLabel: ''Changed &Methods'' 
							#value: #changesChangedMethods ) 
						#(#MenuItem 
							#rawLabel: ''Inspect &ChangeSet'' 
							#value: #changesInspectChangeSet ) 
						#(#MenuItem 
							#rawLabel: ''Con&dense Changes'' 
							#value: #changesCondenseChanges ) 
						#(#MenuItem 
							#rawLabel: ''Open &Project'' 
							#value: #changesOpenProject ) 
						#(#MenuItem 
							#rawLabel: ''E&xit Project'' 
							#value: #changesExitProject ) ) #(1 4 1 2 ) nil ) ) 
			#(#MenuItem 
				#rawLabel: ''&Database'' 
				#submenu: #(#Menu #(
						#(#MenuItem 
							#rawLabel: ''Ad Hoc &SQL'' 
							#nameKey: #adHoc 
							#value: #openAdHocQuery ) 
						#(#MenuItem 
							#rawLabel: ''Data &Modeler'' 
							#nameKey: #dataModeler 
							#value: #openDataModelBrowser 
							#labelImage: #(#ResourceRetriever nil #dbToolIcon ) ) 
						#(#MenuItem 
							#rawLabel: ''Canvas &Composer'' 
							#nameKey: #canvasComposer 
							#value: #openCanvasComposer ) 
						#(#MenuItem 
							#rawLabel: ''New Data &Form...'' 
							#nameKey: #dataForm 
							#value: #newDataForm ) 
						#(#MenuItem 
							#rawLabel: ''New Database &Application...'' 
							#nameKey: #dataBaseAp 
							#value: #newDataMain ) ) #(1 4 ) nil ) ) 
			#(#MenuItem 
				#rawLabel: ''&Window'' 
				#submenu: #(#Menu #(
						#(#MenuItem 
							#rawLabel: ''Re&fresh All'' 
							#value: #winRefreshAll ) 
						#(#MenuItem 
							#rawLabel: ''&Collapse All'' 
							#value: #winCollapseAll ) 
						#(#MenuItem 
							#rawLabel: ''Re&store All'' 
							#value: #winRestoreAll ) 
						#(#MenuItem 
							#rawLabel: ''&Windows'' 
							#nameKey: #windowsMenu ) 
						#(#MenuItem 
							#rawLabel: ''New Launcher'' 
							#value: #winNewLauncher ) ) #(3 1 1 ) nil ) ) 
			#(#MenuItem 
				#rawLabel: ''&Help'' 
				#submenu: #(#Menu #(
						#(#MenuItem 
							#rawLabel: ''Open Online &Documentation'' 
							#value: #openHelpBrowser 
							#labelImage: #(#ResourceRetriever nil #helpIcon ) ) 
						#(#MenuItem 
							#rawLabel: ''&Quick Start Guides...'' 
							#value: #openGuidingDialog ) 
						#(#MenuItem 
							#rawLabel: ''About &VisualWorks...'' 
							#value: #helpAbout ) ) #(2 1 ) nil ) ) 
			#(#MenuItem 
				#rawLabel: ''&Misc'' 
				#submenu: #(#Menu #(
						#(#MenuItem 
							#rawLabel: ''refresh windows'' 
							#value: #refreshWindows ) 
						#(#MenuItem 
							#rawLabel: ''system workspace'' 
							#value: #openSystemWorkspace ) 
						#(#MenuItem 
							#rawLabel: ''installation workspace'' 
							#value: #openInstallationWorkspace ) 
						#(#MenuItem 
							#rawLabel: ''transcript'' 
							#value: #openTranscript ) ) #(1 3 ) nil ) ) ) #(8 ) nil ) decodeAsLiteralArray'!

openInstallationWorkspaceInVisualLauncher
	"VisualLauncherEnhancements openInstallationWorkspaceInVisualLauncher."

	self
		installEnhanceClass: VisualLauncher
		protocol: 'private actions'
		code: 'openInstallationWorkspace
	ComposedTextView openInstallationWorkspace'!

openSystemWorkspaceInVisualLauncher
	"VisualLauncherEnhancements openSystemWorkspaceInVisualLauncher."

	self
		installEnhanceClass: VisualLauncher
		protocol: 'private actions'
		code: 'openSystemWorkspace
	ComposedTextView openSystemWorkspace'!

openTranscriptInVisualLauncher
	"VisualLauncherEnhancements openTranscriptInVisualLauncher."

	self
		installEnhanceClass: VisualLauncher
		protocol: 'private actions'
		code: 'openTranscript
	TextCollectorView open: Transcript label: ''System Transcript'''!

refreshWindowsInVisualLauncher
	"VisualLauncherEnhancements refreshWindowsInVisualLauncher."

	self
		installEnhanceClass: VisualLauncher
		protocol: 'private actions'
		code: 'refreshWindows
	ScheduledControllers restore'!

winNewLauncherInVisualLauncher
	"VisualLauncherEnhancements winNewLauncherInVisualLauncher."

	self
		installEnhanceClass: VisualLauncher
		protocol: 'private actions'
		code: 'winNewLauncher
	"Create a new launcher."

	| aController scheduledControllers |
	scheduledControllers := ScheduledControllers scheduledControllers.
	scheduledControllers size <= 1 
		ifTrue: 
			[Dialog warn: ''The Last Window cannot close.''.
			^self].
	aController := scheduledControllers 
			detect: [:each | each model == self]
			ifNone: [nil].
	aController notNil 
		ifTrue: 
			[aController closeAndUnschedule.
			self class open]'! !

!VisualLauncherEnhancements class methodsFor: 'saving'!

save
	"VisualLauncherEnhancements save."

	| encodingName fileName classCollection aStream |
	encodingName := #default.
	fileName := 'LaunchEn.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
	"VisualLauncherEnhancements saveClasses."

	| patternCollection classCollection |
	patternCollection := #('*VisualLauncherEnhancements*').
	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! !

!VisualLauncherEnhancements class methodsFor: 'private'!

installEnhanceClass: aClass protocol: aProtocol code: aCode 
	| aSelector anArray oldCode aCategory |
	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!

postfix
	^(VisualLauncher selectors includes: #setVisualWorksHome)
		ifTrue: [#'30']
		ifFalse: [#'25']!

refreshVisualLauncher
	| scheduledControllers controllers |

	scheduledControllers := ScheduledControllers scheduledControllers.
	controllers := scheduledControllers 
			select: [:each | each model class == VisualLauncher].
	controllers 
		do: 
			[:aController | 
			aController model reInstallInterface.
			aController view refresh]!

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! !

VisualLauncherEnhancements initialize!