[squeak-dev] The Inbox: DesktopBackgroundLoader-sbw.20.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Apr 24 01:15:23 UTC 2010


A new version of DesktopBackgroundLoader was added to project The Inbox:
http://source.squeak.org/inbox/DesktopBackgroundLoader-sbw.20.mcz

==================== Summary ====================

Name: DesktopBackgroundLoader-sbw.20
Author: sbw
Time: 23 April 2010, 8:15:17.965 pm
UUID: bd0f5baa-9676-4e16-9e04-893e65f26d25
Ancestors: DesktopBackgroundLoader-sbw.19

Published for general distribution.  See Extras menu from Dock for access.

==================== Snapshot ====================

SystemOrganization addCategory: #DesktopBackgroundLoader!

----- Method: TheWorldMainDockingBar>>extrasMenuOn: (in category '*DesktopBackgroundLoader') -----
extrasMenuOn: aDockingBar 

	aDockingBar addItem: [ :it|
		it 	contents: 'Extras' translated;
			addSubMenu: [:menu|
				menu addItem:[:item|
					item
						contents: 'Recover Changes' translated;
						help: 'Recover changes after a crash' translated;
						icon: MenuIcons smallHelpIcon;
						target: ChangeList;
						selector: #browseRecentLog].
				menu addLine.
				menu addItem:[:item|
					item
						contents: 'Window Colors' translated;
						help: 'Changes the window color scheme' translated;
						addSubMenu:[:submenu| self windowColorsOn: submenu]].
				menu addItem:[:item|
					item
						contents: 'Set Author Initials' translated;
						help: 'Sets the author initials' translated;
						target: Utilities;
						selector: #setAuthorInitials].
				menu addItem:[:item|
					item
						contents: 'Restore Display (r)' translated;
						help: 'Redraws the entire display' translated;
						target: World;
						selector: #restoreMorphicDisplay].
				menu addItem:[:item|
					item
						contents: 'Rebuild Menus' translated;
						help: 'Rebuilds the menu bar' translated;
						target: TheWorldMainDockingBar;
						selector: #updateInstances].
				menu addLine.
				menu addItem:[:item|
					item
						contents: 'Start Profiler' translated;
						help: 'Starts the profiler' translated;
						target: self;
						selector: #startMessageTally].
				menu addItem:[:item|
					item
						contents: 'Collect Garbage' translated;
						help: 'Run the garbage collector and report space usage' translated;
						target: Utilities;
						selector: #garbageCollectAndReport].
				menu addItem:[:item|
					item
						contents: 'Purge Undo Records' translated;
						help: 'Save space by removing all the undo information remembered in all projects' translated;
						target: CommandHistory;
						selector: #resetAllHistory].
				menu addItem:[:item|
					item
						contents: 'VM statistics' translated;
						help: 'Virtual Machine information' translated;
						target: self;
						selector: #vmStatistics].
				menu addLine.
				menu addItem:[:item|
					item
						contents: 'Graphical Imports' translated;
						help: 'View the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList' translated;
						target: (Imports default);
						selector: #viewImages].
				menu addItem:[:item|
					item
						contents: 'Standard Graphics Library' translated;
						help: 'Lets you view and change the system''s standard library of graphics' translated;
						target: ScriptingSystem;
						selector: #inspectFormDictionary].
				menu addItem:[:item|
					item
						contents: 'Annotation Setup' translated;
						help: 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools' translated;
						target: Preferences;
						selector: #editAnnotations].
				menu addItem:[:item|
					item
						contents: 'Desktop Background Loader' translated;
						help: 'Let''s you select a graphic image and place it as your desktop background.' translated;
						target: StandardToolSet;
						selector: #openDesktopBackgroundLoader].
			] ]!

Model subclass: #DesktopBackgroundLoader
	instanceVariableNames: 'directory directoryCache list listIndex fileName volList volListIndex'
	classVariableNames: 'DefaultImagesLocation RecentDirs'
	poolDictionaries: ''
	category: 'DesktopBackgroundLoader'!

----- Method: DesktopBackgroundLoader classSide>>defaultImagesLocation (in category 'accessing') -----
defaultImagesLocation
	DefaultImagesLocation isNil ifTrue: [self initializeDefaultImagesLocation].
	^DefaultImagesLocation!

----- Method: DesktopBackgroundLoader classSide>>defaultImagesLocation: (in category 'accessing') -----
defaultImagesLocation: aFileDirectory
	DefaultImagesLocation := aFileDirectory!

----- Method: DesktopBackgroundLoader classSide>>initialize (in category 'class initialization') -----
initialize
	TheWorldMainDockingBar updateInstances.
	RecentDirs := OrderedCollection new.
!

----- Method: DesktopBackgroundLoader classSide>>initializeDefaultImagesLocation (in category 'initialize-release') -----
initializeDefaultImagesLocation
	self defaultImagesLocation: FileDirectory default!

----- Method: DesktopBackgroundLoader classSide>>myWorkspace (in category 'workspace') -----
myWorkspace
"
DesktopBackgroundLoader defaultImagesLocation: (FileDirectory on: '/Users/steve/Pictures/Wallpaper')
"!

----- Method: DesktopBackgroundLoader classSide>>open (in category 'instance creation') -----
open
	"Open a view of an instance of me on the default directory."
	^ToolBuilder open: self!

----- Method: DesktopBackgroundLoader classSide>>validExtensions (in category 'constants') -----
validExtensions
	^ImageReadWriter allTypicalFileExtensions!

----- Method: DesktopBackgroundLoader>>addPath: (in category 'tree') -----
addPath: aString
	"Add the given string to the list of recently visited directories."

	| full |
	aString ifNil: [^self].
	full := String streamContents: 
		[ :strm | 2 to: volList size do: 
			[ :i | strm nextPutAll: (volList at: i) withBlanksTrimmed.
			strm nextPut: FileDirectory pathNameDelimiter]].
	full := full, aString.
"Remove and super-directories of aString from the collection."
	RecentDirs removeAllSuchThat: [ :aDir | ((aDir, '*') match: full)].

"If a sub-directory is in the list, do nothing."
	(RecentDirs detect: [ :aDir | ((full, '*') match: aDir)] ifNone: [nil])
		ifNotNil: [^self].

	[RecentDirs size >= 10]
		whileTrue: [RecentDirs removeFirst].
	RecentDirs addLast: full!

----- Method: DesktopBackgroundLoader>>attachForm:asMorphToWorld: (in category 'image') -----
attachForm: aForm asMorphToWorld: world
	| sketch previous |
	sketch := SketchMorph withForm: aForm.
	sketch
		setToAdhereToEdge: #center;
		name: self worldImageName;
		lock.
	previous := world submorphNamed: self worldImageName.
	previous isNil ifFalse: [previous delete].
	sketch
		openInWorld;
		goBehind!

----- Method: DesktopBackgroundLoader>>buildButtonPaneWith: (in category 'toolbuilder') -----
buildButtonPaneWith: builder
	| panel |
	panel := builder pluggablePanelSpec new.
	panel
		children: OrderedCollection new;
		layout: #horizontal.
	self optionalButtons do: [:spec |
		| btnSpec |
		btnSpec := builder pluggableActionButtonSpec new.
		btnSpec
			model: self;
			label: spec first;
			action: spec second;
			help: spec third translated.
		panel children add: btnSpec
		].
	^panel!

----- Method: DesktopBackgroundLoader>>buildFileInfoPaneWith: (in category 'toolbuilder') -----
buildFileInfoPaneWith: builder
	| textSpec |
	textSpec := builder pluggableTextSpec new.
	textSpec
		model: self;
		getText: #fileInfoContents;
		menu: nil.
	^textSpec!

----- Method: DesktopBackgroundLoader>>buildListPaneWith: (in category 'toolbuilder') -----
buildListPaneWith: builder
	| listSpec |
	listSpec := builder pluggableListSpec new.
	listSpec
		model: self;
		list: #fileList;
		getIndex: #fileListIndex;
		setIndex: #fileListIndex:;
		menu: #fileListMenu:;
		keyPress: nil.
	^listSpec!

----- Method: DesktopBackgroundLoader>>buildTreePaneWith: (in category 'toolbuilder') -----
buildTreePaneWith: builder
	| treeSpec |
	treeSpec := builder pluggableTreeSpec new.
	treeSpec
		model: self;
		roots: #rootDirectoryList;
		hasChildren: #hasMoreDirectories:;
		getChildren: #subDirectoriesOf:;
		getSelectedPath: #selectedPath; 
		setSelected: #setDirectoryTo:;
		label: #directoryNameOf:;
		menu: #volumeMenu:;
		autoDeselect: false.
	^treeSpec!

----- Method: DesktopBackgroundLoader>>buildViewerPaneWith: (in category 'toolbuilder') -----
buildViewerPaneWith: builder
	| panel |
	panel := builder pluggablePanelSpec new.
	panel
		model: self;
		name: 'imageViewer';
		children: #childrenForViewer.
	^panel
!

----- Method: DesktopBackgroundLoader>>buildWith: (in category 'toolbuilder') -----
buildWith: builder
	| windowSpec window |
	windowSpec := builder pluggableWindowSpec new.
	windowSpec model: self.
	windowSpec label: 'Desktop Background Loader'.
	windowSpec children: OrderedCollection new.
	(self widgetSpecsWith: builder) do: [:array |
		| widgetSpec |
		widgetSpec := array last value.
		widgetSpec frame: (LayoutFrame fractions: array first offsets: array second).
		windowSpec children add: widgetSpec].
	window := builder build: windowSpec.
	self changed: #selectedPath.
	^window!

----- Method: DesktopBackgroundLoader>>centerScreen (in category 'buttons') -----
centerScreen
	self fileName isNil ifFalse: [
		| world |
		world := Project current currentWorld.
		self attachForm: self currentForm asMorphToWorld: world.
		]!

----- Method: DesktopBackgroundLoader>>childrenForViewer (in category 'image') -----
childrenForViewer
	^OrderedCollection with: self scaledImageMorph!

----- Method: DesktopBackgroundLoader>>clearBackground (in category 'buttons') -----
clearBackground
	| world previous |
	world := Project current currentWorld.
	previous := world submorphNamed: self worldImageName.
	previous isNil
		ifTrue: [self inform: 'No background image found.' translated]
		ifFalse: [previous delete].
!

----- Method: DesktopBackgroundLoader>>currentForm (in category 'image') -----
currentForm
	^self fileName isNil
		ifTrue: [self emptyForm]
		ifFalse: [Form fromFileNamed: (self directory fullNameFor: self fileName)]!

----- Method: DesktopBackgroundLoader>>directory (in category 'accessing') -----
directory

	^directory!

----- Method: DesktopBackgroundLoader>>directory: (in category 'accessing') -----
directory: dir

	directory := dir.
	volList := ((Array with: '[]'), self directory pathParts)
		withIndexCollect: [:each :index | (String new: index - 1 withAll: $ ), each].
	volListIndex := volList size.
	self changed: #volumeList.
	self updateFileList!

----- Method: DesktopBackgroundLoader>>directoryNameOf: (in category 'tree') -----
directoryNameOf: aDirectory
	"Attempt to find the name of ServerDirectories when used."
	^(aDirectory isRemoteDirectory and:[aDirectory isKindOf: ServerDirectory])
		ifTrue:[ServerDirectory servers keyAtIdentityValue: aDirectory]
		ifFalse:[aDirectory localName]!

----- Method: DesktopBackgroundLoader>>directoryNamesFor: (in category 'toolbuilder') -----
directoryNamesFor: item
	^item directoryNames!

----- Method: DesktopBackgroundLoader>>emptyForm (in category 'image') -----
emptyForm
	| form |
	form := Form extent: 800 at 800 depth: Display depth.
	form fillWhite.
	^form!

----- Method: DesktopBackgroundLoader>>fileInfoContents (in category 'file info') -----
fileInfoContents
	^self fileName isNil
		ifTrue: ['No file selected' translated]
		ifFalse: [
			| entry sizeStr form stream |
			entry := self directory directoryEntryFor: self fileName.
			sizeStr := entry fileSize asStringWithCommas.
			form := self currentForm.
			stream := WriteStream on: String new.
			stream
				nextPutAll: 'File Size: ';
				nextPutAll: sizeStr;
				nextPutAll: ' Image Size: ';
				nextPutAll: form extent asString.
			^stream contents]!

----- Method: DesktopBackgroundLoader>>fileList (in category 'list') -----
fileList
	^list!

----- Method: DesktopBackgroundLoader>>fileListIndex (in category 'list') -----
fileListIndex
	^listIndex!

----- Method: DesktopBackgroundLoader>>fileListIndex: (in category 'list') -----
fileListIndex: anInteger
	| item name |
	listIndex := anInteger.
	listIndex = 0 
		ifTrue: [fileName := nil]
		ifFalse:
			[
			item := self fileNameFromFormattedItem: (list at: anInteger).
			(item endsWith: self folderString)
				ifTrue:
					[
					name := item copyFrom: 1 to: item size - self folderString size.
					listIndex := 0.
					self addPath: name.
					name first = $^
						ifTrue: [self directory: (ServerDirectory serverNamed: name allButFirst)]
						ifFalse: [volListIndex = 1 ifTrue: [name := name, directory slash].
							self directory: (directory directoryNamed: name)]]
				ifFalse: [fileName := item]].
	self changed: #fileListIndex.
	self changed: #fileInfoContents.
	self changed: #childrenForViewer!

----- Method: DesktopBackgroundLoader>>fileListMenu: (in category 'list') -----
fileListMenu: aMenu
	^aMenu.!

----- Method: DesktopBackgroundLoader>>fileName (in category 'accessing') -----
fileName

	^ fileName!

----- Method: DesktopBackgroundLoader>>fileNameFormattedFrom:sizePad: (in category 'list') -----
fileNameFormattedFrom: entry sizePad: sizePad
	"entry is a 5-element array of the form:
		(name creationTime modificationTime dirFlag fileSize)"
	| nameStr |
	nameStr := entry isDirectory
		ifTrue: [entry name , self folderString]
		ifFalse: [entry name].
	^nameStr!

----- Method: DesktopBackgroundLoader>>fileNameFromFormattedItem: (in category 'list') -----
fileNameFromFormattedItem: item
	| offset |
	offset := item lastIndexOf: $] ifAbsent: [0].
	^(offset = 0
		ifTrue: [item]
		ifFalse: [item copyFrom: offset + 1 to: item size]) withBlanksTrimmed!

----- Method: DesktopBackgroundLoader>>fillScreen (in category 'buttons') -----
fillScreen
	self fileName isNil ifFalse: [
		| world scaledForm |
		world := Project current currentWorld.
		scaledForm := self scaledForm: self currentForm toSizeUsingMaximum: world extent.
		self attachForm: scaledForm asMorphToWorld: world]!

----- Method: DesktopBackgroundLoader>>folderString (in category 'accessing') -----
folderString
	^ ' [...]'!

----- Method: DesktopBackgroundLoader>>fullName (in category 'accessing') -----
fullName
	"Answer the full name for the currently selected file; answer nil if no file is selected."

	^ fileName ifNotNil: [directory
		ifNil:
			[FileDirectory default fullNameFor: fileName]
		ifNotNil:
			[directory fullNameFor: fileName]]
!

----- Method: DesktopBackgroundLoader>>hasMoreDirectories: (in category 'tree') -----
hasMoreDirectories: aDirectory
	(aDirectory isKindOf: FileDirectory) ifFalse:[^true]. "server directory; don't ask"
	^directoryCache at: aDirectory ifAbsentPut:[
		[aDirectory directoryNames notEmpty] on: Error do:[:ex| true].
	].!

----- Method: DesktopBackgroundLoader>>imageViewerMorph (in category 'image') -----
imageViewerMorph
	^self myDependents detect: [:ea | ea knownName = 'imageViewer'] ifNone: []!

----- Method: DesktopBackgroundLoader>>initialize (in category 'initialize-release') -----
initialize
	super initialize.
	directoryCache := WeakIdentityKeyDictionary new.
	self directory: self class defaultImagesLocation!

----- Method: DesktopBackgroundLoader>>optionalButtons (in category 'buttons') -----
optionalButtons
	| list |
	list := OrderedCollection new.
	list
		add: {'Fill'. #fillScreen. 'The currently selected image will be scaled to fill background.  Narrowest dimension is kept intact.'};
		add: {'Stretch'. #stretchScreen. 'Stretches, or shrinks, the selected image to fully fit the current background dimensions.'};
		add: {'Center'. #centerScreen. 'Places the selected image centered in the background.'};
		add: {'Tile'. #tileScreen. 'Repeats the selected image in the background.'};
		add: {'Clear'. #clearBackground. 'Will remove the background morph last installed with this tool.'};
		yourself. 
	^list!

----- Method: DesktopBackgroundLoader>>recentDirs (in category 'accessing') -----
recentDirs
	"Put up a menu and let the user select from the list of recently visited directories."

	| dirName |
	RecentDirs isEmpty ifTrue: [^self].
	dirName := UIManager default chooseFrom: RecentDirs values: RecentDirs.
	dirName == nil ifTrue: [^self].
	self directory: (FileDirectory on: dirName)!

----- Method: DesktopBackgroundLoader>>rootDirectoryList (in category 'tree') -----
rootDirectoryList
	| dir dirList servers |
	dir := FileDirectory on: ''.
	dirList := dir directoryNames collect: [:each | dir directoryNamed: each].
	dirList isEmpty ifTrue: [dirList := Array with: FileDirectory default].
	servers := ServerDirectory serverNames collect: [ :n | ServerDirectory serverNamed: n].
	servers := servers select:[:each| each respondsTo: #localName].
	^dirList, servers!

----- Method: DesktopBackgroundLoader>>scaledForm:toSizeUsingMaximum: (in category 'image') -----
scaledForm: aForm toSizeUsingMaximum: newExtent 
	| scale |
	newExtent = aForm extent ifTrue: [^aForm].
	scale := newExtent x / aForm width max: newExtent y / aForm height.
	^aForm
		magnify: aForm boundingBox
		by: scale
		smoothing: 2!

----- Method: DesktopBackgroundLoader>>scaledImageMorph (in category 'image') -----
scaledImageMorph
	| fullForm scaledForm imageMorph holder |
	holder := self imageViewerMorph.
	fullForm := self currentForm.
	scaledForm := self fileName isNil
		ifTrue: [fullForm]
		ifFalse: [fullForm scaledToSize: holder extent].
	imageMorph := ImageMorph new image: scaledForm.
	imageMorph position: holder position.
	^imageMorph!

----- Method: DesktopBackgroundLoader>>selectedPath (in category 'tree') -----
selectedPath
	| top here result |
	top := FileDirectory root.
	here := self directory.
	result := (Array streamContents:[:s| | next |
		s nextPut: here.
		[next := here containingDirectory.
		top pathName = next pathName] whileFalse:[
			s nextPut: next.
			here := next.
		]]) reversed.
	^result!

----- Method: DesktopBackgroundLoader>>setDirectoryTo: (in category 'tree') -----
setDirectoryTo: dir
	dir ifNil:[^self].
	self directory: dir.
	self changed: #fileList.
!

----- Method: DesktopBackgroundLoader>>stretchScreen (in category 'buttons') -----
stretchScreen
	self fileName isNil ifFalse: [
		| world scaledForm |
		world := Project current currentWorld.
		scaledForm := self currentForm scaledToSize: world extent.
		self attachForm: scaledForm asMorphToWorld: world]!

----- Method: DesktopBackgroundLoader>>subDirectoriesOf: (in category 'toolbuilder') -----
subDirectoriesOf: aDirectory
	^aDirectory directoryNames collect:[:each| aDirectory directoryNamed: each].!

----- Method: DesktopBackgroundLoader>>tileScreen (in category 'buttons') -----
tileScreen
	self fileName isNil ifFalse: [
		| world repeatingForm destForm top left |
		world := Project current currentWorld.
		destForm := Form extent: world extent depth: Display depth.
		repeatingForm := self currentForm.
		top := 0.
		left := 0.
		left to: (destForm extent x - 1) by: repeatingForm extent x do: [:xOffset |
			top to: (destForm extent y - 1) by: repeatingForm extent y do: [:yOffset |
				repeatingForm displayOn: destForm at: xOffset at yOffset
				]
			].
		self attachForm: destForm asMorphToWorld: world.
		]
	
!

----- Method: DesktopBackgroundLoader>>updateFileList (in category 'list') -----
updateFileList
	| entries patterns newList sizePad |
	entries := self directory entries reject:[:e| e isDirectory].
	patterns := self class validExtensions collect: [:ea | '*.', ea].
	newList := entries select: [:entry |
		patterns anySatisfy: [:each |
			each match: entry name]].
	sizePad := (newList inject: 0 into: [:mx :entry | mx max: entry fileSize])
					asStringWithCommas size.
	list := newList collect: [:ea | self fileNameFormattedFrom: ea sizePad: sizePad].
	volList size = 1 ifTrue:
		[
		list := list  ,
			(ServerDirectory serverNames collect: [:n | '^' , n , self folderString])].
	listIndex := 0.
	volListIndex := volList size.
	fileName := nil.
	self changed: #volumeListIndex.
	self changed: #fileList.
	self changed: #fileListIndex.
	self changed: #fileInfoContents.
!

----- Method: DesktopBackgroundLoader>>volumeList (in category 'accessing') -----
volumeList
	"Answer the current list of volumes."

	^ volList
!

----- Method: DesktopBackgroundLoader>>volumeListIndex (in category 'accessing') -----
volumeListIndex
	"Answer the index of the currently selected volume."

	^ volListIndex
!

----- Method: DesktopBackgroundLoader>>volumeListIndex: (in category 'accessing') -----
volumeListIndex: index
	| path |
	volListIndex := index.
	index = 1 
		ifTrue: [self directory: (FileDirectory on: '')]
		ifFalse: [
			| delim |
			delim := directory pathNameDelimiter.
			path := String streamContents: [:strm |
				2 to: index do: [:i |
					strm nextPutAll: (volList at: i) withBlanksTrimmed.
					i < index ifTrue: [strm nextPut: delim]]].
				self directory: (directory on: path)].
	self addPath: path.
	self changed: #fileList.
!

----- Method: DesktopBackgroundLoader>>volumeMenu: (in category 'accessing') -----
volumeMenu: aMenu
	aMenu addList: {
			{'recent...' translated.		#recentDirs}.
			#-.
			{'add server...' translated.		#askServerInfo}.
			{'remove server...' translated.		#removeServer}.
			#-.
			{'delete directory...' translated.	#deleteDirectory}.
			#-}.
	aMenu
		addServices: (self itemsForDirectory: self directory)
		for: self
		extraLines: #().
	^aMenu.!

----- Method: DesktopBackgroundLoader>>widgetSpecsWith: (in category 'toolbuilder') -----
widgetSpecsWith: builder
	| btnPaneHeight listPaneHeight infoPaneHeight |
	btnPaneHeight := 24.
	listPaneHeight := 100.
	infoPaneHeight := 30.
	^OrderedCollection new
		add: {
			(0 at 0 corner: 0.25 at 1). 
			(0 at 0 corner: 0 at 0). 
			[self buildTreePaneWith: builder]};
		add: {
			(0.25 at 0 corner: 1 at 0). 
			(2 at 0 corner: 0 at btnPaneHeight). 
			[self buildButtonPaneWith: builder]};
		add: {
			(0.25 at 0 corner: 1 at 0). 
			(2@(btnPaneHeight + 2) corner: 0@(btnPaneHeight + 2 + listPaneHeight)). 
			[self buildListPaneWith: builder]};
		add: {
			(0.25 at 0 corner: 1 at 0). 
			(2@(btnPaneHeight + 2 + listPaneHeight + 2) corner: 0@(btnPaneHeight + 2 + listPaneHeight + 2 + infoPaneHeight)). 
			[self buildFileInfoPaneWith: builder]};
		add: {
			(0.25 at 0 corner: 1 at 1). 
			(2@(btnPaneHeight + 2 + listPaneHeight + 2 + infoPaneHeight + 2) corner: 0 at 0). 
			[self buildViewerPaneWith: builder]};
		yourself!

----- Method: DesktopBackgroundLoader>>worldImageName (in category 'image') -----
worldImageName
	^'worldBackgroundImage'!

----- Method: StandardToolSet class>>openDesktopBackgroundLoader (in category '*DesktopBackgroundLoader') -----
openDesktopBackgroundLoader
	DesktopBackgroundLoader open!




More information about the Squeak-dev mailing list