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

commits at source.squeak.org commits at source.squeak.org
Sun Apr 25 15:47:31 UTC 2010


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

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

Name: DesktopBackgroundLoader-sbw.26
Author: sbw
Time: 25 April 2010, 10:47:27.765 am
UUID: 12154636-aed7-42bb-8097-258ef7b5a426
Ancestors: DesktopBackgroundLoader-sbw.25

Uses proposed pragma scheme that extends the dock menus.

Removed collisions with other base code.

Note that the recently published world menu registry code can be used to add this to the appearance menu later.


=============== Diff against DesktopBackgroundLoader-sbw.22 ===============

Item was added:
+ ----- Method: DesktopBackgroundLoader>>makeCurrentDirectoryDefault (in category 'tree') -----
+ makeCurrentDirectoryDefault
+ 	| selected |
+ 	selected := self selectedPath.
+ 	selected notEmpty ifTrue: [
+ 		| msg |
+ 		self class defaultImagesLocation: selected last.
+ 		msg := WriteStream on: String new.
+ 		msg
+ 			nextPutAll: 'Default pictures directory set to:' translated;
+ 			cr;
+ 			nextPutAll: self class defaultImagesLocation fullName;
+ 			cr;
+ 			nextPutAll: 'Save your image to keep this value between Squeak launches.' translated.
+ 		self inform: msg contents
+ 		]!

Item was changed:
  ----- 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:;
- 		menu: nil;
  		autoDeselect: false.
  	^treeSpec!

Item was added:
+ ----- Method: DesktopBackgroundLoader classSide>>registerWithTheWorldAppearanceMenu (in category 'class initialization') -----
+ registerWithTheWorldAppearanceMenu
+ 	TheWorldMenu registerAppearanceCommand: {
+ 		'Desktop Background Loader' translated.
+ 		{DesktopBackgroundLoader. #open}.
+ 		'Opens a tool for selecting graphic images as desktop background.'
+ 		}!

Item was added:
+ ----- Method: TheWorldMainDockingBar>>desktopBackgroundLoaderItemOn: (in category '*DesktopBackgroundLoader') -----
+ desktopBackgroundLoaderItemOn: menu
+ 
+ 	<fillDockingBarMenu: #extras priority: 50>
+ 	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: DesktopBackgroundLoader;
+ 			selector: #open].
+ !

Item was changed:
  ----- 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: ' translated;
- 				nextPutAll: 'File Size: ';
  				nextPutAll: sizeStr;
+ 				nextPutAll: ' Image Size: ' translated;
- 				nextPutAll: ' Image Size: ';
  				nextPutAll: form extent asString.
  			^stream contents]!

Item was changed:
+ FileList subclass: #DesktopBackgroundLoader
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'DefaultImagesLocation'
- Model subclass: #DesktopBackgroundLoader
- 	instanceVariableNames: 'directory directoryCache list listIndex fileName volList volListIndex'
- 	classVariableNames: 'DefaultImagesLocation RecentDirs'
  	poolDictionaries: ''
  	category: 'DesktopBackgroundLoader'!

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

Item was added:
+ ----- Method: DesktopBackgroundLoader>>volumeMenu: (in category 'tree') -----
+ volumeMenu: aMenu
+ 	aMenu
+ 		addList: {
+ 			{'make directory default' translated. #makeCurrentDirectoryDefault}
+ 			}.
+ 	^aMenu.!

Item was added:
+ ----- Method: DesktopBackgroundLoader classSide>>new (in category 'instance creation') -----
+ new
+ 	^super newOn: self defaultImagesLocation!

Item was changed:
  ----- Method: DesktopBackgroundLoader>>buildWith: (in category 'toolbuilder') -----
  buildWith: builder
  	| windowSpec window |
  	windowSpec := builder pluggableWindowSpec new.
  	windowSpec model: self.
+ 	windowSpec label: 'Desktop Background Loader' translated.
- 	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!

Item was changed:
  ----- Method: DesktopBackgroundLoader classSide>>initialize (in category 'class initialization') -----
  initialize
+ 	super initialize.
  	TheWorldMainDockingBar updateInstances.
+ 	self registerWithTheWorldOpenMenu
+ 	"Do this one instead when the appearance menu support appears...
+ 	registerWithTheWorldAppearanceMenu"
- 	RecentDirs := OrderedCollection new.
  !

Item was added:
+ ----- Method: DesktopBackgroundLoader classSide>>registerWithTheWorldOpenMenu (in category 'class initialization') -----
+ registerWithTheWorldOpenMenu
+ 	TheWorldMenu registerOpenCommand: {
+ 		'Desktop Background Loader' translated.
+ 		{DesktopBackgroundLoader. #open}.
+ 		'Opens a tool for selecting graphic images as desktop background.'
+ 		}!

Item was removed:
- ----- 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!

Item was removed:
- ----- 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!

Item was removed:
- ----- 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]!

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

Item was removed:
- ----- 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)!

Item was removed:
- ----- Method: DesktopBackgroundLoader>>fileName (in category 'accessing') -----
- fileName
- 
- 	^ fileName!

Item was removed:
- ----- 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].
- 			] ]!

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

Item was removed:
- ----- Method: DesktopBackgroundLoader>>directory (in category 'accessing') -----
- directory
- 
- 	^directory!

Item was removed:
- ----- Method: DesktopBackgroundLoader>>volumeListIndex (in category 'accessing') -----
- volumeListIndex
- 	"Answer the index of the currently selected volume."
- 
- 	^ volListIndex
- !

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

Item was removed:
- ----- 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]]
- !

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

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

Item was removed:
- ----- Method: DesktopBackgroundLoader>>volumeList (in category 'accessing') -----
- volumeList
- 	"Answer the current list of volumes."
- 
- 	^ volList
- !

Item was removed:
- ----- 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!

Item was removed:
- ----- 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].
- 	].!




More information about the Squeak-dev mailing list