[Seaside] WebDVS Package

Adrian Lienhard seaside@lists.squeakfoundation.org
Sat, 11 Jan 2003 15:05:27 +0100


This is a multi-part message in MIME format.

------=_NextPart_000_001F_01C2B982.DFD5E820
Content-Type: text/plain;
	charset="iso-8859-1"
Content-Transfer-Encoding: 7bit

Hi Derek an all Seasiders

I've added the functionality "Load new Package" which - like the original
DVS - shows a file dialog where a file (on the server!) can be selected,
which then is filed in and added to DVS. I'll use this on the app-server to
first upload packages with ftp and then load/fileIn them with WebDVS.

The File Dialog uses the WATree component to present/navigate the directory
structure on the left side. On the right side, all files of the current
directory are shown. If the file type matches one of the given suffixes, the
file can be "opened".

Derek, one question: why do you send #fixTemps to every block in
WebDVS>>packageListView?
I always use #renderListViewOn: html instead of using a block like you are.
I like your solution (if there was not these fixTemps) because you can alway
say "html render: self XY..." and not "self renderXYOn: html".

Cheers,
Adrian
_____________________
Adrian Lienhard
www.adrian-lienhard.ch
www.netstyle.ch

----- Original Message -----
From: "Derek Brans" <brans@nerdonawire.com>
Sent: Friday, November 29, 2002 9:17 PM
Subject: [Seaside] WebDVS Package


> Here's an implementation of DVS on Seaside (idea by Avi)
> It's useful for managing code on a remote server.
>
> It is limited to filing in and filing out changesets from the default
> directory.
>
> Minimally tested (I used it to file itself out).
>
> Derek
>
> Nerd on a Wire: Web and Information Solutions
> Website Design - Database Systems - Site Hosting
> 604.874.6463
> mailto:info@nerdonawire.com
> For more information, visit http://nerdonawire.com
>

------=_NextPart_000_001F_01C2B982.DFD5E820
Content-Type: application/octet-stream;
	name="WebDVS.st"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
	filename="WebDVS.st"

Smalltalk organization addCategory: 'WebDVS'!

WATreeVisitor subclass: #WADirectoryNameVisitor
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'WebDVS'!

WADirectoryNameVisitor class
	instanceVariableNames: ''!

WAComponent subclass: #WAFileDialog
	instanceVariableNames: 'tree rootDirectory suffixes selectedFile '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'WebDVS'!

WAFileDialog class
	instanceVariableNames: ''!

WATreeVisitor subclass: #WAFileListVisitor
	instanceVariableNames: 'tree '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'WebDVS'!

WAFileListVisitor class
	instanceVariableNames: ''!

WAComponent subclass: #WebDVS
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'WebDVS'!

WebDVS class
	instanceVariableNames: ''!

!WebDVS methodsFor: 'as yet unclassified' stamp: 'AL 1/11/2003 11:46'!
addPackage
	| packageName |
	packageName _ self call: (WAInputDialog new message: 'Name of =
package').
	FilePackageManager named: packageName.
	! !

!WAFileDialog methodsFor: 'as yet unclassified' stamp: 'AL 1/11/2003 =
14:34'!
initialize
	tree _ WATree new
				select: self rootDirectory;
				childVisitor: WAFileListVisitor new;
				labelVisitor: WADirectoryNameVisitor new;
				yourself! !

!WebDVS class methodsFor: 'as yet unclassified' stamp: 'djb 11/29/2002 =
11:52'!
initialize
	self registerAsApplication: 'WebDVS' sessionClass: WASession ! !

!WebDVS methodsFor: 'as yet unclassified' stamp: 'AL 1/11/2003 14:12'!
loadPackage
	| fileName file oldManagers diff |
	fileName _ self call: (WAFileDialog new suffixes: #(st)).
	fileName notNil ifTrue: [
		file _ FileStream fileNamed: fileName.
		"following code duplicated from PackagePanel"
		oldManagers _ self managers copy.
		ChangeSorter
			newChangesFromStream: file
			named: (ChangeSet uniqueNameLike: (file localName copyUpTo: $.)).
		diff _ self managers difference: oldManagers.
		diff isEmpty ifFalse: [diff first directory: file directory]]
	! !

!WebDVS methodsFor: 'as yet unclassified' stamp: 'AL 1/11/2003 11:39'!
managers
	^PackageManager allManagers! !

!WebDVS methodsFor: 'as yet unclassified' stamp: 'AL 1/11/2003 14:56'!
packageListView
	^ [:html | html table: [self managers do: [:pkg | html
				tableRow: [
					html
						tableData: [html text: pkg asString] fixTemps;
						tableData: [html render: pkg fileName] fixTemps;=09
						tableData: [html anchorWithAction: [pkg unregister] fixTemps
											text: 'delete'];
						tableData: [html anchorWithAction: [pkg fileIn] fixTemps
											text: 'fileIn'];
						tableData: [html anchorWithAction: [pkg fileOut] fixTemps
											text: 'fileOut']
						]] fixTemps] fixTemps]! !

!WAFileDialog methodsFor: 'as yet unclassified' stamp: 'AL 1/11/2003 =
14:09'!
renderFilesOn: html
	(tree selection entries select: [:entry | entry isDirectory not]) do:
		[:fileEntry | html bold: [ (fileEntry name endsWithAnyOf: self =
suffixes)
			ifTrue: [
				html
					anchorWithAction: [
						selectedFile _ tree selection fullNameFor: fileEntry name]
					text: fileEntry name]
			ifFalse: [html render: fileEntry name].
			].
			html render: ' (', fileEntry fileSize asStringWithCommas, ' '.
			html render: (TimeStamp fromSeconds: fileEntry modificationTime) =
asString, ')'.
			html break].
	html space.! !

!WAFileDialog methodsFor: 'as yet unclassified' stamp: 'AL 1/11/2003 =
14:28'!
renderOn: html=20
	html
		form: [html render: '<table border=3D"2" cellspacing=3D"0" =
width=3D"600">'.
			html render: '<tr><td colspan=3D2><h2>Select File</h2></td></tr>'.
			html render: '<tr><td colspan=3D2>';
				 render: self rootDirectory containingDirectory pathName , self =
rootDirectory pathNameDelimiter asString.
			html render: '</td></tr>'.
			html render: '<tr><td width=3D"30%" valign=3D"top">'.
			html render: tree.
			html render: '</td><td width=3D"70%" valign=3D"top">'.
			self renderFilesOn: html.
			html render: '</td></tr>'.
			html render: '<tr><td colspan=3D2 align=3D"right">'.
			selectedFile notNil
				ifTrue: [html
						bold: [html render: selectedFile;
								 space].
					html
						submitButtonWithAction: [self answer: selectedFile]
						text: 'Open'].
			html
				submitButtonWithAction: [self answer: nil]
				text: 'Cancel'.
			html render: '</td></tr></table>']! !

!WebDVS methodsFor: 'as yet unclassified' stamp: 'AL 1/11/2003 11:40'!
renderOn: html=20
	html heading: 'WebDVS'.
	html
		anchorWithAction: [self loadPackage]
		text: 'Load new Package'.
	html space.
	html
		anchorWithAction: [self addPackage]
		text: 'Add new Package'.
	html render: self packageListView! !

!WAFileDialog methodsFor: 'as yet unclassified' stamp: 'AL 1/11/2003 =
11:50'!
rootDirectory
	rootDirectory isNil ifTrue: [rootDirectory _ FileDirectory default].
	^rootDirectory! !

!WAFileDialog methodsFor: 'as yet unclassified' stamp: 'AL 1/11/2003 =
11:48'!
rootDirectory: aFileDirectory
	rootDirectory _ aFileDirectory! !

!WAFileDialog methodsFor: 'as yet unclassified' stamp: 'AL 1/11/2003 =
11:58'!
suffixes
	suffixes isNil ifTrue: [suffixes _ #()].
	^suffixes! !

!WAFileDialog methodsFor: 'as yet unclassified' stamp: 'AL 1/11/2003 =
11:57'!
suffixes: anArray
	suffixes _ anArray! !

!WADirectoryNameVisitor methodsFor: 'as yet unclassified' stamp: 'AL =
1/11/2003 00:48'!
visit: aDirectory=20
	^ aDirectory directoryEntry name! !

!WAFileListVisitor methodsFor: 'as yet unclassified' stamp: 'AL =
1/11/2003 00:31'!
visit: anObject=20
	| directoryNames |
	directoryNames _ anObject directoryNames.
	directoryNames isEmpty
		ifFalse: [^directoryNames collect: [:dir | anObject directoryNamed: =
dir]]
		ifTrue: [^#()]! !

WebDVS initialize!

Smalltalk at: #FilePackageManager ifPresent: [:p | p registerPackage: =
'WebDVS'].!


------=_NextPart_000_001F_01C2B982.DFD5E820--