[comp.lang.smalltalk] Free Code: a SetInspector

bnfb@uw-beaver.UUCP (Bjorn Freeman-Benson) (06/11/87)

This is a small (subclassed) modification of the Inspector, with
three new menu items for inspecting Sets.
					    Enjoy,
					      Bjorn N Freeman-Benson

--cut here----cut here----cut here----cut here----cut here----cut here--

Inspector subclass: #SetInspector
	instanceVariableNames: 'topView listView '
	classVariableNames: 'NoSelectionMenu YesSelectionMenu '
	poolDictionaries: ''
	category: 'Interface-SetInspector'!


!SetInspector methodsFor: 'initialization'!

listView: aView
	^listView _ aView!

topView: aView
	^topView _ aView! !


!SetInspector methodsFor: 'field list'!

fieldMenu
	field == nil
		ifTrue: [
			NoSelectionMenu == nil
				ifTrue: [
					NoSelectionMenu _ ActionMenu
						labels: 'first non-empty'
						selectors: #(firstNonEmpty)
					].
			^NoSelectionMenu
			]
		ifFalse: [
			YesSelectionMenu == nil
				ifTrue: [
					YesSelectionMenu _ ActionMenu
						labels: 'inspect\prev non-empty\next non-empty' withCRs
						lines: #(1)
						selectors: #(inspectField prevNonEmpty nextNonEmpty)
					].
			^YesSelectionMenu
			]! !


!SetInspector methodsFor: 'menu commands'!

firstNonEmpty

	1 to: (object basicSize) do: [ :i |
		(object basicAt: i) ~= nil
			ifTrue: [
				listView moveSelectionBox: (i + 2).
				listView changeModelSelection: (i + 2).
				^self
				]
		].
	topView flash.!

nextNonEmpty
	| idx | 

	field first isDigit
		ifFalse: [ ^self firstNonEmpty ].
	idx _ Integer readFromString: field.
	(idx+1) to: (object basicSize) do: [ :i |
		(object basicAt: i) ~= nil
			ifTrue: [
				listView moveSelectionBox: (i + 2).
				listView changeModelSelection: (i + 2).
				^self
				]
		].
	topView flash.!

prevNonEmpty
	| idx | 

	field first isDigit
		ifFalse: [ ^self firstNonEmpty ].
	idx _ Integer readFromString: field.
	(idx-1) to: 1 by: -1 do: [ :i |
		(object basicAt: i) ~= nil
			ifTrue: [
				listView moveSelectionBox: (i + 2).
				listView changeModelSelection: (i + 2).
				^self
				]
		].
	topView flash.! !

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

SetInspector class
	instanceVariableNames: ''!


!SetInspector class methodsFor: 'initialization'!

flushMenus
	YesSelectionMenu _ NoSelectionMenu _ nil! !


InspectorView subclass: #SetInspectorView
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Interface-SetInspector'!

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

SetInspectorView class
	instanceVariableNames: ''!


!SetInspectorView class methodsFor: 'instance creation'!

view: anInspector in: area of: superView
	"Create proportioned List and Code views on anInspector in area of superView"

	| mid |
	mid _ area left + (area width * 0.3).
	anInspector topView: superView.
	superView addSubView:
		(anInspector listView: (SelectionInListView
			on: anInspector printItems: anInspector printItems
			oneItem: false aspect: #field change: #field: list: #fieldList
			menu: #fieldMenu initialSelection: #field))
		in: (area copy right: mid) borderWidth: 1.
	superView addSubView: (CodeView on: anInspector aspect: #text
			change: #acceptText:from:
			menu: #textMenu initialSelection: nil)
		in: (area copy left: mid) borderWidth: 1! !

!Set methodsFor: 'user interface'!
inspect
	SetInspectorView open: (SetInspector inspect: self)! !