GalleyView

Smilie smilie at cc.gatech.edu
Thu Apr 27 18:38:59 UTC 2000


Attached is the code for my GalleyViewer.  I created it as part of my
Sr. project.  It is a flat class viewer, that contains the entire class
within one window.  From inside of this window, you can edit and compile
your code.  Enjoy.

--------------------
Jen a.k.a. Smilie
:-P
smilie at cc.gatech.edu

-------------- next part --------------
'From Squeak2.8alpha of 19 January 2000 [latest update: #2040] on 26 April 2000 at 4:55:09 pm'!
TextMorph subclass: #ClassCategoryTextMorph
	instanceVariableNames: 'currentClass currentCategory '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FlatViewer'!

!ClassCategoryTextMorph commentStamp: '<historical>' prior: 0!
This is a ClassCategoryTextMorph.  It contains a class category.  It knows what class the category is for.!
TextMorph subclass: #ClassCommentTextMorph
	instanceVariableNames: 'currentClass myCustomMenu '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FlatViewer'!

!ClassCommentTextMorph commentStamp: '<historical>' prior: 0!
This is a ClassCommentTextMorph.  It contains a class comment.  It knows what class the comment is for.!
TextMorph subclass: #ClassDefinitionTextMorph
	instanceVariableNames: 'currentClass myCustomMenu myViewer '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FlatViewer'!

!ClassDefinitionTextMorph commentStamp: '<historical>' prior: 0!
This is a ClassDefinitionTextMorph.  It contains the class definition.  It knows what class the definition is for.!
TextMorph subclass: #ClassMethodDefinitionTextMorph
	instanceVariableNames: 'currentClass currentCategory myCustomMenu '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FlatViewer'!

!ClassMethodDefinitionTextMorph commentStamp: '<historical>' prior: 0!
This is a ClassMethodDefinitionTextMorph.  It contains a class method.  It knows the category and what class it is a part of.!
Object subclass: #GalleyView
	instanceVariableNames: 'class galleyWindow myScrollPane myAM '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FlatViewer'!

!GalleyView commentStamp: 'mjg 4/26/2000 16:46' prior: 0!
This class puts all of the parts together to display the whole class.  It creates the window and adds the scrollbar.  To start GalleyView type the following into a Workspace and doit:

|t|
t _ GalleyView new.
t view: GalleyView "Insert Class Name Here".

To add a new method, use the menu over the Class Definition!
TextMorph subclass: #InstanceCategoryTextMorph
	instanceVariableNames: 'currentClass currentCategory '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FlatViewer'!

!InstanceCategoryTextMorph commentStamp: '<historical>' prior: 0!
This is an InstanceCategoryTextMorph.  It contains the instance category.  It knows what class it is a part of.!
TextMorph subclass: #InstanceMethodDefinitionTextMorph
	instanceVariableNames: 'currentClass currentCategory myCustomMenu '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FlatViewer'!

!InstanceMethodDefinitionTextMorph commentStamp: '<historical>' prior: 0!
This is an InstanceMethodDefinitionTextMorph.  It contains an instance method.  It knows the class and category it is a part of.!

!ClassCategoryTextMorph methodsFor: 'accessing'!
currentCategory
	"return the current category"
	^ currentCategory! !

!ClassCategoryTextMorph methodsFor: 'accessing'!
currentCategory: aCategory
"set the current category"

currentCategory _ aCategory.! !

!ClassCategoryTextMorph methodsFor: 'accessing'!
currentClass
	"return the current class"
	^ currentClass! !

!ClassCategoryTextMorph methodsFor: 'accessing'!
currentClass: aClass
	"set the current class"
	currentClass _ aClass! !


!ClassCommentTextMorph methodsFor: 'accessing' stamp: 'jlb 2/27/2000 13:25'!
currentClass
	"return current class to the calling method"
	^ currentClass! !

!ClassCommentTextMorph methodsFor: 'accessing' stamp: 'jlb 2/27/2000 12:48'!
currentClass: aClass
	"set the current class"
	currentClass _ aClass.! !

!ClassCommentTextMorph methodsFor: 'event handling' stamp: 'jlb 2/28/2000 13:16'!
handlesMouseDown
"this morph deals with its own mouse down events"
	^ true! !

!ClassCommentTextMorph methodsFor: 'event handling' stamp: 'jlb 2/28/2000 13:16'!
mouseDown: evt
"what to do when the mouse is pressed"
evt yellowButtonPressed
ifTrue: [self createCustomMenu]
ifFalse: [super mouseDown: evt]! !

!ClassCommentTextMorph methodsFor: 'menu' stamp: 'jlb 2/28/2000 13:17'!
compileClassComment
"compile this ClassCommentTextMorph"
currentClass comment: self asText asString! !

!ClassCommentTextMorph methodsFor: 'menu' stamp: 'jlb 3/12/2000 14:12'!
createCustomMenu
	"create the custom menu that will be used for compiling"
	myCustomMenu _ CustomMenu new.
	myCustomMenu title: 'Class Comment Menu'.
	myCustomMenu add: 'Compile Class Comment' action: #compileClassComment.
	myCustomMenu invokeOn: self defaultSelection: nil! !


!ClassDefinitionTextMorph methodsFor: 'accessing' stamp: 'jlb 2/27/2000 13:23'!
currentClass
	"return the current class to the calling method"
	^ currentClass! !

!ClassDefinitionTextMorph methodsFor: 'accessing' stamp: 'jen 12/15/1999 11:30'!
currentClass: aClass
	"set the current class"
	currentClass _ aClass.! !

!ClassDefinitionTextMorph methodsFor: 'accessing' stamp: 'mjg 4/26/2000 16:31'!
myViewer
	^myViewer
! !

!ClassDefinitionTextMorph methodsFor: 'accessing' stamp: 'mjg 4/26/2000 16:31'!
myViewer: aViewer
	myViewer _ aViewer.
! !

!ClassDefinitionTextMorph methodsFor: 'event handling' stamp: 'jlb 2/27/2000 13:02'!
handleMouseDown: evt
"this morph deals with its own mouse down events"

^ true! !

!ClassDefinitionTextMorph methodsFor: 'event handling' stamp: 'jlb 2/27/2000 13:01'!
mouseDown: evt
"what to do when the mouse is pressed"
evt yellowButtonPressed
ifTrue: [self createCustomMenu]
ifFalse: [super mouseDown: evt]! !

!ClassDefinitionTextMorph methodsFor: 'adding' stamp: 'mjg 4/26/2000 16:27'!
addNewClassMethod
| name category |
name _ FillInTheBlank request: 'Class Method Name'.
name ifNil: [^self].
category _ FillInTheBlank request: 'In Class Category:' initialAnswer: 'instance creation'.
category ifNil: [^self].
self addNewClassMethodNamed: name inCategory: category.


! !

!ClassDefinitionTextMorph methodsFor: 'adding' stamp: 'mjg 4/26/2000 16:54'!
addNewClassMethodNamed: aName inCategory: aCategory
"this method will add a new method in the System Browser"
| temp|
temp _ ClassMethodDefinitionTextMorph new.
temp currentClass: currentClass.
temp currentCategory: aCategory.
temp contentsAsIs: aName,'
	"Comment for class method"
	| temporaries |
	statements.'.
currentClass class compile: (temp contents asText asString) classified: aCategory.
myViewer renewContents.



! !

!ClassDefinitionTextMorph methodsFor: 'adding' stamp: 'mjg 4/26/2000 16:28'!
addNewInstanceMethod
| name category |
name _ FillInTheBlank request: 'Instance Method Name'.
name ifNil: [^self].
category _ FillInTheBlank request: 'In Method Category:' initialAnswer: 'accessing'.
category ifNil: [^self].
self addNewInstanceMethodNamed: name inCategory: category.

! !

!ClassDefinitionTextMorph methodsFor: 'adding' stamp: 'mjg 4/26/2000 16:54'!
addNewInstanceMethodNamed: aName inCategory: aCategory
"this will add a method to the System Browser"
| temp  |
temp _ InstanceMethodDefinitionTextMorph new.
temp currentClass: currentClass.
temp currentCategory: aCategory.
temp contentsAsIs: aName,'
	"Comment for instance method"
	| temporaries |
	statements.'.
currentClass compile: (temp contents asText asString) classified: aCategory.
myViewer renewContents.
! !

!ClassDefinitionTextMorph methodsFor: 'menu' stamp: 'jlb 2/27/2000 13:09'!
compileClassDefinition
"compile this ClassDefinitionTextMorph"
Compiler evaluate: (self contents asText asString).! !

!ClassDefinitionTextMorph methodsFor: 'menu' stamp: 'mjg 4/26/2000 16:24'!
createCustomMenu
	"create the custom menu that will be used for compiling"
	myCustomMenu _ CustomMenu new.
	myCustomMenu title: 'Class Definition Menu'.
	myCustomMenu add: 'Compile Class Definition' action: #compileClassDefinition.
	myCustomMenu add: 'New class method' action: #addNewClassMethod.
	myCustomMenu add: 'New instance method' action: #addNewInstanceMethod.
	myCustomMenu invokeOn: self defaultSelection: nil.
	! !


!ClassMethodDefinitionTextMorph methodsFor: 'accessing' stamp: 'jlb 2/27/2000 13:28'!
currentCategory
	"return the current category to the calling method"
	^ currentCategory! !

!ClassMethodDefinitionTextMorph methodsFor: 'accessing' stamp: 'jlb 2/26/2000 14:19'!
currentCategory: aCategory
	"set the current category"
	currentCategory _ aCategory! !

!ClassMethodDefinitionTextMorph methodsFor: 'accessing' stamp: 'jlb 2/27/2000 13:28'!
currentClass
	"return the current class to the calling method"
	^ currentClass! !

!ClassMethodDefinitionTextMorph methodsFor: 'accessing' stamp: 'jlb 2/27/2000 13:28'!
currentClass: aClass 
	"set the current class"
	currentClass _ aClass! !

!ClassMethodDefinitionTextMorph methodsFor: 'event handling' stamp: 'jlb 2/26/2000 14:17'!
handleMouseDown: evt
"this morph deals with its own mouse down events"
 ^ true! !

!ClassMethodDefinitionTextMorph methodsFor: 'event handling' stamp: 'jlb 2/26/2000 14:30'!
mouseDown: evt 
	"what to do when the mouse is pressed"
	evt yellowButtonPressed
		ifTrue: [self createCustomMenu]
		ifFalse: [super mouseDown: evt]! !

!ClassMethodDefinitionTextMorph methodsFor: 'menu'!
compileClassMethod
"compile this ClassMethodDefinitionTextMorph"
currentClass class compile: (self contents asText asString) classified: currentCategory.! !

!ClassMethodDefinitionTextMorph methodsFor: 'menu' stamp: 'jlb 3/12/2000 14:11'!
createCustomMenu
	"create the custom menu that will be used for compiling"
	myCustomMenu _ CustomMenu new.
	myCustomMenu title: 'Class Method Menu'.
	myCustomMenu add: 'Compile Class Method' action: #compileClassMethod.
	myCustomMenu invokeOn: self defaultSelection: nil.
	! !


!GalleyView methodsFor: 'accessing' stamp: 'jlb 2/27/2000 13:22'!
class
	"return the class to the calling method"
	^ class! !

!GalleyView methodsFor: 'accessing' stamp: 'jen 12/15/1999 11:12'!
class: aClass
"set the class we are working with"

  class _ aClass.! !

!GalleyView methodsFor: 'accessing' stamp: 'jlb 2/27/2000 13:22'!
galleyWindow
	"return the window to the calling method"
	^ galleyWindow! !

!GalleyView methodsFor: 'accessing' stamp: 'jen 12/15/1999 12:12'!
galleyWindow: aWin
	"set the window"
	galleyWindow _ aWin! !

!GalleyView methodsFor: 'parts of class' stamp: 'jlb 2/26/2000 13:01'!
getClassCategoryMethods
	"get the class categories and methods and put them into an       
	         ClassMethodDefinitonTextMorph"
	| classMeth classCategory |
	class class organization categories
		withIndexDo: 
			[:category :i | 
			((class class organization listAtCategoryNumber: i)
				ifNil: [#()])
				do: 
					[:message | 
					classMeth _ ClassMethodDefinitionTextMorph new.
					classMeth currentClass: class.
					classMeth currentCategory: category.
					
					classMeth contentsAsIs: ((class class sourceCodeAt: message)
							makeSelectorBoldIn: class class).
					myAM addMorph: classMeth].
			classCategory _ ClassCategoryTextMorph new.
			classCategory currentCategory: category.
			classCategory currentClass: class.
			classCategory contentsAsIs: category asText allBold.
			myAM addMorph: classCategory]! !

!GalleyView methodsFor: 'parts of class'!
getClassComment
	"get the class comment and put it into a                            
	 ClassCommentTextMorph"
	| cComment |
	cComment _ ClassCommentTextMorph new.
	cComment currentClass: class.
	cComment contentsAsIs: class comment asText allBold allItalic.
	myAM addMorph: cComment
	! !

!GalleyView methodsFor: 'parts of class' stamp: 'mjg 4/26/2000 16:32'!
getClassDefinition
	"get the class definition and put it into a       
	ClassDefinitionTextMorph"
	| def |
	def _ ClassDefinitionTextMorph new.
	def currentClass: class.
	def myViewer: self.
	def contentsAsIs: class definition asText allBold.
	myAM addMorph: def
	! !

!GalleyView methodsFor: 'parts of class' stamp: 'jlb 2/26/2000 14:08'!
getInstanceCategoryMethods
	"get the instance categories and methods and put them into an   
	              InstanceMethodDefinitonTextMorph"
	| inst instCategory  |
	class organization categories
		withIndexDo: 
			[:category :i | 
			((class organization listAtCategoryNumber: i)
				ifNil: [#()])
				do: 
					[:message | 
					inst _ InstanceMethodDefinitionTextMorph new.
					inst currentClass: class.
					inst currentCategory: category.
				
					inst contentsAsIs: ((class sourceCodeAt: message)
							makeSelectorBoldIn: class).
					myAM addMorph: inst].
			instCategory _ InstanceCategoryTextMorph new.
			instCategory currentClass: class.
			instCategory currentCategory: category.
			instCategory contentsAsIs: category asText allBold.
			myAM addMorph: instCategory]! !

!GalleyView methodsFor: 'start up' stamp: 'mjg 4/26/2000 16:43'!
addScrollBars
	"add scroll bars to the window"
	myScrollPane _ ScrollPane new.
	galleyWindow addMorph: myScrollPane frame: (0.0 @ 0.0 extent: 1.0 @ 1.0).
		
	myScrollPane scroller addMorph: myAM.
	myScrollPane resizeScrollBar.! !

!GalleyView methodsFor: 'start up' stamp: 'mjg 4/26/2000 16:35'!
contents
	"get the contents of the class and add scroll bars"
	myAM _ AlignmentMorph newColumn.

	self getClassCategoryMethods.
	self getInstanceCategoryMethods.
	self getClassComment.
	self getClassDefinition.
	self addScrollBars.
	galleyWindow openInWorld.
	^ galleyWindow! !

!GalleyView methodsFor: 'start up' stamp: 'mjg 4/26/2000 16:38'!
renewContents
	myAM removeAllMorphs.
	self contents.
! !

!GalleyView methodsFor: 'start up' stamp: 'mjg 4/26/2000 16:33'!
view: aClass 
	"set the class to view, open the window, and display all of the class"
	self class: aClass.
	self galleyWindow: (SystemWindow labelled: 'Galley View of ',(class printString)).
	self galleyWindow model: self.
	self contents! !


!GalleyView class methodsFor: 'examples' stamp: 'mjg 4/26/2000 16:45'!
example
	self new view: GalleyView! !


!InstanceCategoryTextMorph methodsFor: 'accessing'!
currentCategory
	"return the current category"
	^ currentCategory! !

!InstanceCategoryTextMorph methodsFor: 'accessing'!
currentCategory: aCategory
	"set the current category"
	currentCategory _ aCategory! !

!InstanceCategoryTextMorph methodsFor: 'accessing'!
currentClass
"return the current class"
^ currentClass! !

!InstanceCategoryTextMorph methodsFor: 'accessing'!
currentClass: aClass
	"set the current class"
	currentClass _ aClass! !


!InstanceMethodDefinitionTextMorph methodsFor: 'accessing' stamp: 'jlb 2/26/2000 14:20'!
currentCategory
	"return the category to the calling method"
	^ currentCategory! !

!InstanceMethodDefinitionTextMorph methodsFor: 'accessing' stamp: 'jen 12/15/1999 11:36'!
currentCategory: aCategory
	"set the current category"
	currentCategory _ aCategory! !

!InstanceMethodDefinitionTextMorph methodsFor: 'accessing' stamp: 'jlb 2/26/2000 14:21'!
currentClass
"return the class to the calling method"

^ currentClass! !

!InstanceMethodDefinitionTextMorph methodsFor: 'accessing' stamp: 'jen 12/15/1999 11:35'!
currentClass: aClass
	"set the current class"
	currentClass _ aClass! !

!InstanceMethodDefinitionTextMorph methodsFor: 'event handling' stamp: 'jlb 2/26/2000 13:18'!
handleMouseDown: evt
"this morph deals with its own mouse down events"

^ true! !

!InstanceMethodDefinitionTextMorph methodsFor: 'event handling' stamp: 'jlb 2/28/2000 13:15'!
mouseDown: evt 
	"what to do when the mouse is pressed"
	evt yellowButtonPressed
		ifTrue: [self createCustomMenu]
		ifFalse: [super mouseDown: evt]! !

!InstanceMethodDefinitionTextMorph methodsFor: 'menu' stamp: 'jlb 2/27/2000 13:20'!
compileInstanceMethod
	"compile this InstanceMethodDefinitionTextMorph"
	currentClass compile: (self contents asText asString) classified: currentCategory! !

!InstanceMethodDefinitionTextMorph methodsFor: 'menu' stamp: 'jlb 3/12/2000 14:11'!
createCustomMenu
	"create the custom menu that will be used for compiling"
	myCustomMenu _ CustomMenu new.
	myCustomMenu title: 'Instance Method Menu'.
	myCustomMenu add: 'Compile Instance Method' action: #compileInstanceMethod.
	myCustomMenu invokeOn: self defaultSelection: nil.
	! !


!Metaclass methodsFor: 'bar' stamp: 'mjg 4/26/2000 16:29'!
foo! !


!Text methodsFor: 'emphasis' stamp: 'jen 9/28/1999 16:19'!
allItalic
	"Force this whole text to be italic."
	string size = 0 ifTrue: [^self].
	self makeItalicFrom: 1 to: string size! !

!Text methodsFor: 'emphasis' stamp: 'jen 12/14/1999 22:01'!
makeItalicFrom: start to: stop 
	^ self
		addAttribute: TextEmphasis italic
		from: start
		to: stop! !

GalleyView class removeSelector: #foo!
GalleyView class removeSelector: #myClass!
GalleyView class removeSelector: #myClassMethod!
GalleyView removeSelector: #addNewClassMethodNamed!
GalleyView removeSelector: #addNewClassMethodNamed:inCategory:!
GalleyView removeSelector: #addNewInstanceMethodNamed!
GalleyView removeSelector: #addNewInstanceMethodNamed:inCategory:!
GalleyView removeSelector: #test1!
ClassDefinitionTextMorph removeSelector: #addNewClassMethodNamed!
ClassDefinitionTextMorph removeSelector: #initialExtent!


More information about the Squeak-dev mailing list