[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
|