[net.lang.st80] Graphical FileList - a "Grapher" application

pieter@prls.UUCP (08/07/86)

The graphical FileList is an application of the "grapher" posted
earlier by Steve Messick. This application gives you a really nice
graphical overview of directories and sub-directories. You can
quickly select any file or directory and open a normal FileList.
This was built within a day and is really very simple.
It runs on a Tektronix 4406 with the Un*Flex O.S.
If you run Smalltalk version T2.2.0, you will be able to select
the font and size of your labels.
Bug-fixes for continuous horizontal scrolling are also included.

I haven't tried it on other machines/different environments, but
it is possible you will have to make minor changes to this code,
to suit your environment.

				Have fun, Pieter.

-----------------------------------------------------------------
|                          |>                                   |
| philabs!\                ||\       P.S. van der Meulen, MS 02 | 
| amdimage!\              /|| \   Philips Research Laboratories |
| --------- prls!pieter  / ||* \          Signetics Corporation |
| pyramid! /            /  ||   \           811 E.Arques Avenue |
| sigvme! /            /   ||    \     Sunnyvale, CA 94088-3409 |
|                     /____||_____\                             |
|                     \prls!pieter/                             |
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

-------------------------cut here--------------------------------
'If you file this in, the File List will have two new menu items
for selected directories in the selectionInList.
If you select -graphic spawn-, the grapher will be applied to
all files and directories under the selected directory.
In the Graphical File List you can select a File or Directory.
You can open a FileList again (the only yellowButtonMenu item).
If you select -overview-, only directories will appear in the now
labeled Graphical Directory List.
Some textStyle and delta-spacing facilities have been added.
The continuous horizontal scroll-bug has been fixed.

This program is placed in the public domain.
Neither I nor my department will recognize any responsibility for
damages arising from use of this program.

Philips Research Laboratories Sunnyvale, Pieter van der Meulen.'!



DisplayText subclass: #GraphNode
	instanceVariableNames: 'object from to fromPt toPt boxed '
	classVariableNames: 'LabelTextStyle'
	poolDictionaries: ''
	category: 'Grapher'!


!GraphNode class methodsFor: 'class initialization'!

initialize

	LabelTextStyle _ DefaultTextStyle copy

	"GraphNode initialize"! !



!GraphNode class methodsFor: 'accessing'!

setStyle

	| aSM aStyle | 
	aSM _ Smalltalk at: #StyleManager ifAbsent: [nil].
	aSM notNil
		ifTrue:
			[(aStyle _ aSM fromUser) notNil
				ifTrue:
					[self textStyle: aStyle asListStyle]].!

textStyle

	^LabelTextStyle!

textStyle: aStyle

	LabelTextStyle _ aStyle! !


!GraphNode methodsFor: 'private'!

from: fromNodes to: toNodes object: myObject label: label

	from _ fromNodes.
	to _ toNodes.
	object _ myObject.
	(label isKindOf: DisplayObject)
		ifTrue: [form _ label.
				offset _ 0@0]
		ifFalse: [self setText: label asText
				textStyle: LabelTextStyle copy
				offset: 0@0]! !




!GraphHolder methodsFor: 'accessing'!

delta
	^delta!



delta: aPoint

	delta _ aPoint max: 2@2! !




!GraphHolderView class methodsFor: 'private'!

createModel: roots children: childrenMsg label: labelMsg format: formatSymbols delta: aPoint

	| aGraph |
	aGraph _ GraphHolder createForestWithRoots: roots
					children: childrenMsg
					label: labelMsg.
	aGraph delta: aPoint.
	aGraph layout: formatSymbols.
	^aGraph! !




!GraphHolderView class methodsFor: 'instance creation'!

openOn: roots label: labelString format: formatSymbols menu: actionMenu childrenMsg: childrenMsg labelMsg: labelMsg delta: aPoint

	self open: (self createModel: roots
					children: childrenMsg
					label: labelMsg
					format: formatSymbols
					delta: aPoint)
		label: labelString
		menu: actionMenu! !





!FileStream methodsFor: 'grapher accessing'!

allChildren
	"If I am a directory, I have children."

	| files aDir | 
	files _ SortedCollection sortBlock: [:x :y | x name <= y name]. 
	self status isDirectory
		ifTrue:
			[aDir _ FileDirectory directoryNamed: self fullName.
			aDir namesDo: [:aName |
				files add: (FileStream fileNamed: aDir fullName,aName)]].
	^files!

children
	"My children are files and directories."

	^self allChildren!

dirChildren
	"My children are directories."

	| directories aDir subDir | 
	directories _ SortedCollection sortBlock: [:x :y | x name <= y name]. 
	self status isDirectory
		ifTrue:
			[aDir _ FileDirectory directoryNamed: self fullName.
			aDir namesDo: [:aName |
					(subDir _ FileStream fileNamed: aDir fullName,aName) isDirectory
						ifTrue:
							[directories add: subDir]]].
	^directories!

fileList
	"Open a file list on me."

	self status isDirectory
		ifTrue:
			[FileList openOnDirectory:
				(FileDirectory directoryNamed: self fullName)]
		ifFalse:
			[FileList openOnFileNames: (SortedCollection with: self fullName) label: 'File List']!

graphLabel

	^name asText!


graphicalFileList
	"Open a file list on me, if I am a directory."

	self status isDirectory
		ifTrue:
			[GraphNode setStyle.
			GraphHolderView
				openOn: (Array with: (Disk directoryNamed: self fullName))
				label: 'Graphical Directory List'
 				format: #( #horizontal )
				menu: (ActionMenu
					labels: 'File List' withCRs
					lines: #()
					selectors: #(fileList))
				childrenMsg: #children
				labelMsg: #graphLabel
				delta: 50@10]! !



!FileList methodsFor: 'directory list'!

graphicalBrowseDirectoriesOnly
	"Open a graphical FileList on the selected item if it is a directory."

	isReading _ false.
	GraphNode setStyle.
	GraphHolderView
		openOn: (Array with: (Disk directoryNamed: self fileName))
		label: 'Graphical Directory List'
 		format: #( #horizontal )
		menu: (ActionMenu
			labels: 'Spawn File List\Graphical Spawn' withCRs
			lines: #(1)
			selectors: #(fileList graphicalFileList))
		childrenMsg: #dirChildren
		labelMsg: #graphLabel
		delta: 50@10!



graphicalBrowseDirectory
	"Open a graphical FileList on the selected item if it is a directory."

	isReading _ false.
	GraphNode setStyle.
	GraphHolderView
		openOn: (Array with: (Disk directoryNamed: self fileName))
		label: 'Graphical File List'
 		format: #( #horizontal )
		menu: (ActionMenu
			labels: 'File List' withCRs
			lines: #()
			selectors: #(fileList))
		childrenMsg: #children
		labelMsg: #graphLabel
		delta: 30@10! !




!FileList class methodsFor: 'class initialization'!

initialize
	"FileList initialize"

	DirectoryMenu _ ActionMenu
				labels: 'list contents\spawn\graphic spawn\overview\copy name\rename\remove' withCRs
				lines: #(2 4 6)
				selectors: #(listDirectoryContents browseDirectory graphicalBrowseDirectory graphicalBrowseDirectoriesOnly  copyName renameFile deleteFile).
	NewFileMenu _ ActionMenu
				labels: 'copy name\rename\new file\new directory' withCRs
				lines: #(2 4 5)
				selectors: #(copyName renameFile createFile createDirectory).
	FileMenu _ ActionMenu
				labels: 'get contents\file in\copy name\rename\remove' withCRs
				lines: #(2 4)
				selectors: #(getFile fileInFile copyName renameFile deleteFile).! !



!XAxisScrollController methodsFor: 'private'!

scrollLeft
	"This is modified from the original to provide continuous scrolling"
	self changeCursor: Cursor left.
	[sensor anyButtonPressed]
		whileTrue:
			[self canXScroll
					ifTrue: 
						[self scrollViewLeft.
						self moveXMarker]].
	sensor waitNoButton!



scrollRight
	"This is modified from the original to provide continuous scrolling"
	self changeCursor: Cursor right.
	[sensor anyButtonPressed]
		whileTrue:
			[self canXScroll
					ifTrue: 
						[self scrollViewRight.
						self moveXMarker]].
	sensor waitNoButton!



xScrollAbsolute
	| oldMarker |
	self changeCursor: Cursor xMarker.
	self canXScroll & sensor anyButtonPressed ifTrue:
		[[sensor anyButtonPressed] whileTrue:
			[oldMarker _ xMarker.
			xMarker _ xMarker translateBy:
				((sensor cursorPoint x - xMarker center x min:
					xScrollBar inside right - xMarker right) max: xScrollBar inside left - xMarker left) @ 0.
			(oldMarker areasOutside: xMarker), (xMarker areasOutside: oldMarker) do:
				[:region | Display fill: region rule: Form reverse mask: Form gray].
			self xScrollView].
		xScrollBar display.
		self moveXMarker]! !


GraphNode initialize.
FileList initialize.
FileList flushMenus