Squeak
  links to this page:    
View this PageEdit this Page (locked)Uploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
Browser Autolabeler
Last updated at 4:04 pm UTC on 14 January 2006
The Browser Autolabeler filein automatically puts a meaningful label in a Browser's title bar. It also make Cmd-H open a HierarchyBrowser on the selected class. Enjoy!

This functionality is in the standard Squeak image at least for 3.7final. So don't load this if you have a newer Squeak.


Until I successfully get the code on the UIUC archives, cut and paste the filein below.
<pre><p>

'From Squeak 2.1 of June 30, 1998 on 25 August 1998 at 5:03:14 pm'!
StringHolder subclass: #Browser
	instanceVariableNames: 'label systemOrganizer classOrganizer metaClassOrganizer systemCategoryListIndex classListIndex messageCategoryListIndex messageListIndex editSelection metaClassIndicated '
	classVariableNames: 'RecentClasses '
	poolDictionaries: ''
	category: 'Interface-Browser'!

!Browser reorganize!
('initialize-release' browserWindowActivated buildClassSwitchView buildCommentSwitchView buildInstanceClassSwitchView buildInstanceSwitchView buildMorphicSwitches defaultBackgroundColor initialize openAsMorphClassEditing: openAsMorphEditing: openAsMorphMessageEditing: openAsMorphMsgCatEditing: openAsMorphSysCatEditing: openEditString: openMessageCatEditString: openMessageEditString: openOnClassWithEditString: openSystemCatEditString: setClass:selector: systemOrganizer:)
('accessing' contents contents:notifying: contentsSelection couldBrowseAnyClass doItReceiver editSelection request:initialAnswer: spawn:)
('system category list' indexIsOne indexIsOne: selectedSystemCategoryName systemCategoryList systemCategoryListIndex systemCategoryListIndex: systemCategorySingleton toggleSystemCategoryListIndex:)
('system category functions' addSystemCategory browseAllClasses buildSystemCategoryBrowser buildSystemCategoryBrowserEditString: changeSystemCategories: classNotFound editSystemCategories fileOutSystemCategory findClass printOutSystemCategory removeSystemCategory renameSystemCategory systemCategoryMenu: updateSystemCategories)
('class list' classList classListIndex classListIndex: classListSingleton recent selectClass: selectedClass selectedClassName toggleClassListIndex:)
('class functions' buildClassBrowser buildClassBrowserEditString: classListMenu: defineClass:notifying: editClass editComment explainSpecial: fileOutClass findMethod hierarchy printOutClass removeClass renameClass spawnHierarchy spawnProtocol)
('message category list' messageCatListSingleton messageCategoryList messageCategoryListIndex messageCategoryListIndex: selectedMessageCategoryName toggleMessageCategoryListIndex:)
('message category functions' addCategory buildMessageCategoryBrowser buildMessageCategoryBrowserEditString: changeMessageCategories: editMessageCategories fileOutMessageCategories messageCategoryMenu: printOutMessageCategories removeMessageCategory renameCategory)
('message list' messageList messageListIndex messageListIndex: messageListSingleton selectedMessage selectedMessageName toggleMessageListIndex:)
('message functions' browseImplementors buildMessageBrowser buildMessageBrowserEditString: defineMessage:notifying: inspectInstances inspectSubInstances messageListMenu:shifted: removeMessage removeMessageFromBrowser)
('code pane' showBytecodes)
('metaclass' classCommentIndicated classMessagesIndicated classOrMetaClassOrganizer indicateClassMessages indicateInstanceMessages instanceMessagesIndicated metaClassIndicated metaClassIndicated: selectedClassOrMetaClass selectedClassOrMetaClassName setClassOrganizer)
('label' buildLabelWith: defaultLabel label label: labelString)
('label printing' printLabelPrefixOn: printNoSelectionOn: printSelectedClassNameOn: printSelectedMessageCategoryNameOn: printSelectedMessageNameOn: printSelectedSystemCategoryNameOn:)
('updating' classSelectionChanged messageCategorySelectionChanged messageSelectionChanged systemCategorySelectionChanged update:)
!


!Browser methodsFor: 'initialize-release' stamp: 'm3r 8/13/1998 02:09'!
initialize
	super initialize.
	self addDependent: self! !

!Browser methodsFor: 'system category functions' stamp: 'm3r 8/12/1998 23:57'!
buildSystemCategoryBrowserEditString: aString 
	"Create and schedule a new system category browser with initial textual 
	contents set to aString."

	| newBrowser |
	systemCategoryListIndex > 0
		ifTrue: 
			[newBrowser _ Browser new.
			newBrowser systemCategoryListIndex: systemCategoryListIndex.
			newBrowser setClass: self selectedClassOrMetaClass selector: self selectedMessageName.
			Browser openBrowserView: (newBrowser openSystemCatEditString: aString)
				label: 'Category Browser: ', newBrowser selectedSystemCategoryName]! !

!Browser methodsFor: 'class list' stamp: 'm3r 8/12/1998 14:26'!
classListIndex: anInteger 
	"Set anInteger to be the index of the current class selection."

	| className |
	classListIndex _ anInteger.
	self setClassOrganizer.
	messageCategoryListIndex _ 0.
	messageListIndex _ 0.
	self classCommentIndicated
		ifTrue: []
		ifFalse: [editSelection _ anInteger = 0
					ifTrue: [metaClassIndicated
						ifTrue: [#none]
						ifFalse: [#newClass]]
					ifFalse: [#editClass]].
	contents _ nil.
	self selectedClass isNil
		ifFalse: [className _ self selectedClass name.
					(RecentClasses includes: className)
				ifTrue: [RecentClasses remove: className].
			RecentClasses addFirst: className.
			RecentClasses size > 16
				ifTrue: [RecentClasses removeLast]].
	self changed: #classSelectionChanged.
	self changed: #classListIndex.	"update my selection"
	self changed: #messageCategoryList.
	self changed: #messageList.
	self changed: #contents.
! !

!Browser methodsFor: 'class functions' stamp: 'm3r 8/13/1998 00:00'!
spawnHierarchy
	"Create and schedule a new class hierarchy browser on the currently selected class or meta."
	| newBrowser aSymbol aBehavior messageCatIndex |
	classListIndex = 0 ifTrue: [^ self].
	newBrowser _ HierarchyBrowser new initHierarchyForClass: self selectedClass 
			meta: self metaClassIndicated.
	(aSymbol _ self selectedMessageName) ifNotNil: [
		aBehavior _ self selectedClassOrMetaClass.
		messageCatIndex _ aBehavior organization numberOfCategoryOfElement: aSymbol.
		newBrowser messageCategoryListIndex: messageCatIndex.
		newBrowser messageListIndex:
			((aBehavior organization listAtCategoryNumber: messageCatIndex)
						indexOf: aSymbol)].
	Browser openBrowserView: (newBrowser openSystemCatEditString: nil)
		label: self selectedClassName , ' hierarchy:'! !

!Browser methodsFor: 'message list' stamp: 'm3r 8/12/1998 15:40'!
messageListIndex: anInteger 
	"Set the selected message selector to be the one indexed by anInteger."

	messageListIndex _ anInteger.
	editSelection _ 
		anInteger = 0
			ifTrue: [#newMessage]
			ifFalse: [#editMessage].
	contents _ nil.
	self changed: #messageSelectionChanged.
	self changed: #messageListIndex.	"update my selection"
	self changed: #contents.
! !

!Browser methodsFor: 'label' stamp: 'm3r 8/13/1998 02:46'!
buildLabelWith: streamBlock
	self label: 
		(String streamContents: 
			[:stream |
			self printLabelPrefixOn: stream.
			streamBlock value: stream]).! !

!Browser methodsFor: 'label' stamp: 'm3r 8/13/1998 02:00'!
defaultLabel
	^self class defaultLabel! !

!Browser methodsFor: 'label' stamp: 'm3r 8/13/1998 02:07'!
label
	^label ifNil: ''
! !

!Browser methodsFor: 'label' stamp: 'm3r 8/13/1998 00:14'!
label: aString
	label = aString ifTrue: [^self].
	label _ aString.
	self changed: #relabel.! !

!Browser methodsFor: 'label' stamp: 'm3r 8/12/1998 23:32'!
labelString
	^self label! !

!Browser methodsFor: 'label printing' stamp: 'm3r 8/13/1998 03:19'!
printLabelPrefixOn: aStream
	| colonIndex prefix |
	colonIndex _ self label indexOf: $: ifAbsent: [^self].
	prefix _ self label copyFrom: 1 to: colonIndex.
	(prefix includes: $#) ifTrue: [^self].
	aStream 
		nextPutAll: prefix;
		space.
	! !

!Browser methodsFor: 'label printing' stamp: 'm3r 8/25/1998 16:56'!
printNoSelectionOn: aStream
	aStream isEmpty 
		ifTrue: [aStream nextPutAll: self defaultLabel]
		ifFalse: [aStream skip: -1] "Ignores trailing space created by printLabelPrefixOn:"! !

!Browser methodsFor: 'label printing' stamp: 'm3r 8/13/1998 01:44'!
printSelectedClassNameOn: aStream
	| className |
	(className _ self selectedClassName) ifNil: 
		[^self printSelectedSystemCategoryNameOn: aStream].
	aStream nextPutAll: className! !

!Browser methodsFor: 'label printing' stamp: 'm3r 8/13/1998 01:45'!
printSelectedMessageCategoryNameOn: aStream
	| categoryName |
	self printSelectedClassNameOn: aStream.
	(categoryName _ self selectedMessageCategoryName) ifNil: [^self].
	self metaClassIndicated ifTrue: [aStream nextPutAll: ' class'].
	aStream 
		nextPutAll: ' ''';
		nextPutAll: categoryName;
		nextPut: $'.! !

!Browser methodsFor: 'label printing' stamp: 'm3r 8/13/1998 02:52'!
printSelectedMessageNameOn: aStream
	| messageName |
	(messageName _ self selectedMessageName) ifNil: 
		[^self printSelectedMessageCategoryNameOn: aStream].
	self printSelectedClassNameOn: aStream.
	self metaClassIndicated ifTrue: [aStream nextPutAll: ' class'].
	aStream 
		nextPutAll: '>>#';
		nextPutAll: messageName! !

!Browser methodsFor: 'label printing' stamp: 'm3r 8/13/1998 01:45'!
printSelectedSystemCategoryNameOn: aStream
	| categoryName |
	(categoryName _ self selectedSystemCategoryName) ifNil: 
		[^self printNoSelectionOn: aStream].
	aStream 
		nextPut: $';
		nextPutAll: categoryName;
		nextPut: $'! !

!Browser methodsFor: 'updating' stamp: 'm3r 8/12/1998 23:08'!
classSelectionChanged
	self buildLabelWith:
		[:stream | self printSelectedClassNameOn: stream]! !

!Browser methodsFor: 'updating' stamp: 'm3r 8/12/1998 23:10'!
messageCategorySelectionChanged
	self buildLabelWith:
		[:stream | self printSelectedMessageCategoryNameOn: stream]! !

!Browser methodsFor: 'updating' stamp: 'm3r 8/12/1998 23:11'!
messageSelectionChanged
	self buildLabelWith:
		[:stream | self printSelectedMessageNameOn: stream]! !

!Browser methodsFor: 'updating' stamp: 'm3r 8/13/1998 01:23'!
systemCategorySelectionChanged
	self buildLabelWith:
		[:stream | self printSelectedSystemCategoryNameOn: stream]! !

!Browser methodsFor: 'updating' stamp: 'm3r 8/13/1998 02:55'!
update: aChangedAspect
	| pertinentChanges |
	pertinentChanges _ #(classSelectionChanged messageSelectionChanged systemCategorySelectionChanged messageCategorySelectionChanged).
	
	(pertinentChanges includes: aChangedAspect)
			ifTrue: [^self perform: aChangedAspect].
	^super update: aChangedAspect! !


!Browser class methodsFor: 'instance creation' stamp: 'm3r 8/13/1998 00:03'!
fullOnClass: aClass 
	"Open a new full browser set to class."
	| brow |
	brow _ Browser new.
	brow setClass: aClass selector: nil.
	Browser openBrowserView: (brow openEditString: nil)! !

!Browser class methodsFor: 'instance creation' stamp: 'm3r 8/13/1998 00:03'!
fullOnClass: aClass selector: aSelector
	"Open a new full browser set to class."

	| brow |
	brow _ Browser new.
	brow setClass: aClass selector: aSelector.
	Browser openBrowserView: (brow openEditString: nil)! !

!Browser class methodsFor: 'instance creation' stamp: 'm3r 8/12/1998 23:58'!
newOnCategory: aCategory
	"Browse the system category of the given name.  7/13/96 sw"

	"Browser newOnCategory: 'Interface-Browser'"

	| newBrowser catList |
	newBrowser _ Browser new.
	catList _ newBrowser systemCategoryList.
	newBrowser systemCategoryListIndex: 
		(catList indexOf: aCategory asSymbol ifAbsent: [^ self inform: 'No such category']).
	Browser openBrowserView: (newBrowser openSystemCatEditString: nil)
				label: 'Category Browser: ', aCategory
! !

!Browser class methodsFor: 'instance creation' stamp: 'm3r 8/13/1998 00:03'!
openBrowser
	"Create and schedule a BrowserView with label 'System Browser'. The 
	view consists of five subviews, starting with the list view of system 
	categories of SystemOrganization. The initial text view part is empty."

	Browser openBrowserView: (Browser new openEditString: nil)
! !

!Browser class methodsFor: 'instance creation' stamp: 'm3r 8/13/1998 01:59'!
openBrowserView: aBrowserView
	self openBrowserView: aBrowserView label: self defaultLabel.! !

!Browser class methodsFor: 'instance creation' stamp: 'm3r 8/13/1998 02:02'!
openBrowserView: aBrowserView label: aString 
	"Schedule aBrowserView, labelling the view aString."
	aBrowserView model label: aString.			
	aBrowserView isMorph
		ifTrue:  [(aBrowserView setLabel: aString) openInWorld]
		ifFalse: [aBrowserView minimumSize: 300 @ 200.
				"aBrowserView subViews do: [:each | each controller]."
				aBrowserView controller open]! !

!Browser class methodsFor: 'defaults' stamp: 'm3r 8/13/1998 02:01'!
defaultLabel
	^'System Browser'! !


!HandMorph methodsFor: 'meta menu' stamp: 'm3r 8/13/1998 00:00'!
browseMorphClass

	| mClass newBrowser |
	mClass _ argument class.
	newBrowser _ HierarchyBrowser new
		initHierarchyForClass: mClass
		meta: false.
	Browser openBrowserView: (newBrowser openSystemCatEditString: nil)
		label: mClass name, ' hierarchy:'! !


!ParagraphEditor methodsFor: 'menu messages' stamp: 'm3r 8/25/1998 15:07'!
browseIt
	"Launch a browser for the current selection, if appropriate"

	| aSymbol anEntry brow |
	self lineSelectAndEmptyCheck:
		[brow _ Browser new.
		^Browser openBrowserView: (brow openEditString: nil)].
	(aSymbol _ self selectedSymbol) isNil ifTrue: [^ view flash].

	self terminateAndInitializeAround:
		[aSymbol first isUppercase
			ifTrue:
				[anEntry _ (Smalltalk at: aSymbol ifAbsent: [nil]).
				anEntry isNil ifTrue: [^ view flash].
				(anEntry isKindOf: Class)
					ifTrue:
						[brow _ Browser new.
						brow setClass: anEntry selector: nil.
						Browser openBrowserView: (brow openEditString: nil)]
					ifFalse:
						[anEntry inspect]]
			ifFalse:
				[Smalltalk browseAllImplementorsOf: aSymbol]]! !

!ParagraphEditor methodsFor: 'menu messages' stamp: 'm3r 8/25/1998 16:44'!
browseItByHierarchy
	"Launch a browser for the current selection, if appropriate"

	| aSymbol anEntry brow |
	self lineSelectAndEmptyCheck:
		[(brow _ HierarchyBrowser new)
			initHierarchyForClass: Object meta: false.
		^Browser
			openBrowserView: (brow openEditString: nil)
			label: 'Object hierarchy:'].
	(aSymbol _ self selectedSymbol) isNil ifTrue: [^ view flash].

	self terminateAndInitializeAround:
		[aSymbol first isUppercase
			ifTrue:
				[anEntry _ (Smalltalk at: aSymbol ifAbsent: [nil]).
				anEntry isNil ifTrue: [^ view flash].
				(anEntry isKindOf: Class)
					ifTrue:
						[(brow _ HierarchyBrowser new)
							initHierarchyForClass: anEntry meta: false.
						Browser 
							openBrowserView: (brow openEditString: nil)
							label: aSymbol , ' hierarchy:']
					ifFalse:
						[anEntry inspect]]
			ifFalse:
				[Smalltalk browseAllImplementorsOf: aSymbol]]! !

!ParagraphEditor methodsFor: 'menu messages' stamp: 'm3r 8/25/1998 16:59'!
lineSelectAndEmptyCheck: returnBlock
	"If the current selection is an insertion point, expand it to be the entire current line; if after that's done the selection is still empty, then evaluate the returnBlock, which will typically consist of '[^ self]' in the caller -- check senders of this method to understand this."

	self selectLine.  "if current selection is an insertion point, then first select the entire line in which occurs before proceeding"
	startBlock = stopBlock ifTrue: returnBlock 
	"Previous version incorrectly used [view flash.  ^ self] instead of returnBlock after ifTrue:.   m3r 8/25/1998 16:59"! !

!ParagraphEditor methodsFor: 'editing keys' stamp: 'm3r 8/25/1998 16:30'!
browseItByHierarchy: characterStream 
	"Triggered by Cmd-Shift-B"

	sensor keyboard.		"flush character"
	self browseItByHierarchy.
	^ true! !


!ParagraphEditor class methodsFor: 'keyboard shortcut tables' stamp: 'm3r 8/25/1998 16:28'!
initializeShiftCmdKeyShortcuts
	"Initialize the shift-command-key (or control-key) shortcut table."
	"NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"

	| cmdMap cmds |
	"shift-command and control shortcuts"
	cmdMap _ Array new: 256.  "use temp in case of a crash"
	cmdMap atAllPut: #noop:.
	cmdMap at: ( 1 + 1) put: #cursorHome:.			"home key"
	cmdMap at: ( 4 + 1) put: #cursorEnd:.			"end key"
	cmdMap at: ( 8 + 1) put: #forwardDelete:.			"ctrl-H or delete key"
	cmdMap at: (13 + 1) put: #crWithIndent:.			"ctrl-Return"
	cmdMap at: (27 + 1) put: #selectCurrentTypeIn:.	"escape key"
	cmdMap at: (28 + 1) put: #cursorLeft:.			"left arrow key"
	cmdMap at: (29 + 1) put: #cursorRight:.			"right arrow key"
	cmdMap at: (30 + 1) put: #cursorUp:.				"up arrow key"
	cmdMap at: (31 + 1) put: #cursorDown:.			"down arrow key"
	cmdMap at: (45 + 1) put: #changeEmphasis:.		"cmd-sh-minus"
	cmdMap at: (61 + 1) put: #changeEmphasis:.		"cmd-sh-plus"
	cmdMap at: (127 + 1) put: #forwardDelete:.		"del key"

	"Note: Command key overrides shift key, so, for example, cmd-shift-9 produces $9 not $("
	'9[,''' do: [ :char | cmdMap at: (char asciiValue + 1) put: #shiftEnclose: ].	"({< and double-quote"
	"Note: Must use cmd-9 or ctrl-9 to get '()' since cmd-shift-9 is a Mac FKey command."
	cmdMap at: (27 + 1) put: #shiftEnclose:.	"ctrl-["

	cmds _ #(
		$a	argAdvance:
		$b	browseItHere:
		$c	compareToClipboard:
		$d	duplicate:
		$e	methodStringsContainingIt:
		$f	displayIfFalse:
		$h	browseItByHierarchy:
		$j	doAgainMany:
		$k	changeStyle:
		$n	referencesToIt:
		$r	indent:
		$l	outdent:
		$s	search:
		$t	displayIfTrue:
		$u	changeLfToCr:
		$v	pasteInitials:
		$w	methodNamesContainingIt:
		$x	makeLowercase:
		$y	makeUppercase:
		$z	makeCapitalized:
	).
	1 to: cmds size by: 2 do: [ :i |
		cmdMap at: ((cmds at: i) asciiValue + 1)			put: (cmds at: i + 1).
		cmdMap at: (((cmds at: i) asciiValue - 96) + 1)	put: (cmds at: i + 1).
	].
	ShiftCmdActions _ cmdMap.! !


!Utilities class methodsFor: 'support windows' stamp: 'm3r 8/25/1998 16:38'!
commandKeyMappings
	^ self class firstCommentAt: #commandKeyMappings

"Lower-case command keys
a	Select all
b	Browse it
c	Copy
d	Do it
e	Exchange
f	Find
g	Find again
h	Set Search String
i	Inspect it
j	Again once
k	Set font
l	Cancel
m	Implementors of it
n	Senders of it
o	Spawn
p	Print it
q	Query symbol
r	Recognizer
s	Save (i.e. accept)
u	Align
v	Paste
w	Delete preceding word
x	Cut
y	Swap characters
z	Undo

Upper-case command keys (Hold down Cmd & Shift, or Ctrl key)
A	Advance argument
B	Browse it in this same browser (in System browsers only)
C	Compare argument to clipboard
D	Duplicate
E	Method strings containing it
F	Insert 'ifFalse:'
H	Browse it using a HierarchyBrowser
J	Again many
K	Set style
L	Outdent (move selection one tab-stop left)
N	References to it
R	Indent (move selection one tab-stap right)
S	Search
T	Insert 'ifTrue:'
U	Convert linefeeds to carriage returns in selection
V	Paste author's initials
W	Selectors containing it
X	Force selection to lowercase
Y	Force selection to uppercase
Z	Capitalize all words in selection
<return>		Insert return followed by as many tabs as the previous line
			(with a further adjustment for additional brackets in that line)

esc			Select current type-in
shift-delete	Forward delete character

Enclose the selection in a kind of bracket.  Each is a toggle.
Control-(	Enclose within ( and ), or remove enclosing ( and )
[	Enclose within [ and ], or remove enclosing [ and ]
{	Enclose within { and }, or remove enclosing { and }
<	Enclose within < and >, or remove enclosing < and >
'	Enclose within ' and ', or remove enclosing ' and '
""	Enclose within "" and "", or remove enclosing "" and ""
(Double click just inside any of the above delimiters to select the text inside it.)

Text Emphasis...
1	10 point font
2	12 point font
3	18 point font  (not in base image)
4	24 point font  (not in base image)
5	36 point font  (not in base image)

6	color, action-on-click, link to class comment, link to method, url
	Brings up a menu.  To remove these properties, select
	more than the active part and then use command-0.

7	bold
8	italic
9	narrow (same as negative kern)
0	plain text (resets all emphasis)
-	underlined (toggles it)
=	struck out (toggles it)

Cmd-shift
_ (aka shift -)	negative kern (letters 1 pixel closer)
dj[ptrigj;xdokjgpiuhdpig8irtgiouoktihue[oj[oi9toehrd90wi4j5-07jioeurtgoiusojhehsdkifgj

i
+
"
! !


"Postscript:
<Comments here, if any>
Executable statements after this comment quote..."

ParagraphEditor initialize.!

</pre>