How to improve SqueakLic. Edgar J. De Cleene edgardec2001 at yahoo.com.arMon Jul 12 12:38:35 UTC 2004
On 11/07/04 14:56, "Karl Ramberg" <karl.ramberg at chello.se> wrote: > Hi, here is a quick and dirty trick to avoid the bogus save menu options. > I just commented out the old menu options and offer Morph>>saveOnFile as > the only option for book saving. Works nice. > Karl So, I send an slow and dirty subclass what could improve to a help system into Squeak. I call Anotador (kind of NotePad in Spanish) and is a subclass of BookMorph intended for fit in poor people 800x600 machines (so many in poor countries like Argentina). My own solution: Have a directory in image path named SqueakBooks !ServerDirectory class methodsFor: 'server groups' stamp: 'edc 6/30/2004 09:52'! localSqueakBooksDirectory | fd | LocalSqueakBooksDirectory ifNil: [fd _ FileDirectory default. (fd directoryExists: 'SqueakBooks') ifFalse:[fd createDirectory: 'SqueakBooks']. LocalSqueakBooksDirectory _ FileDirectory default pathName , FileDirectory slash , 'SqueakBooks' ]. ^LocalSqueakBooksDirectory! ! Changing defaultStemUrl to: !ServerDirectory class methodsFor: 'misc' stamp: 'edc 6/30/2004 09:58'! defaultStemUrl "For writing on an FTP directory. Users should insert their own server url here." "ftp://jumbo.rd.wdi.disney.com/raid1/people/dani/Books/Grp/Grp" " ServerDirectory defaultStemUrl " | rand dir | rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. dir := self serverNamed: 'DaniOnJumbo' ifAbsent: [^ 'file://', ServerDirectory localSqueakBooksDirectory,FileDirectory slash]. Having in mind Mac weirdness about paths: !FileUrl methodsFor: 'printing' stamp: 'edc 7/2/2004 07:43'! toText "Return the FileUrl according to RFC1738 plus supporting fragments: 'file://<host>/<path>#<fragment>' Note that <host> being '' is equivalent to 'localhost'. Note: The pathString can not start with a leading $/ to indicate an 'absolute' file path. This is not according to RFC1738 where the path should have no leading or trailing slashes, and always be considered absolute relative to the filesystem." ^String streamContents: [:s | s nextPutAll: self schemeName, '://'. host ifNotNil: [s nextPutAll: host]. (Smalltalk platformName = 'Mac OS') ifFalse: [s nextPut: $/]. s nextPutAll: self pathString. fragment ifNotNil: [ s nextPut: $#; nextPutAll: fragment encodeForHTTP ]]! ! !FileUrl methodsFor: 'private-initialization' stamp: 'edc 7/1/2004 09:33'! privateInitializeFromText: aString "Calculate host and path from a file URL in String format. Some malformed formats are allowed and interpreted by guessing." | schemeName pathString bare hasDriveLetter stream char i | bare _ aString withBlanksTrimmed. schemeName _ Url schemeNameForString: bare. (schemeName isNil or: [schemeName ~= self schemeName]) ifTrue: [ host _ ''. pathString _ bare] ifFalse: [ "First remove schemeName and colon" bare _ bare copyFrom: (schemeName size + 2) to: bare size. "A proper file URL then has two slashes before host, A malformed URL is interpreted as using syntax file:<path>." (bare beginsWith: '//') ifTrue: [i _ bare indexOf: $/ startingAt: 3. i=0 ifTrue: [ host _ bare copyFrom: 3 to: bare size. pathString _ ''] ifFalse: [ host _ bare copyFrom: 3 to: i-1. pathString _ bare copyFrom: host size + 3 to: bare size]] ifFalse: [host _ ''. pathString _ bare]]. ( Smalltalk platformName = 'Mac OS') ifFalse: [ self initializeFromPathString: pathString] ! ! !ServerDirectory methodsFor: 'accessing' stamp: 'edc 7/2/2004 07:52'! printOn: aStrm aStrm nextPutAll: self class name; nextPut: $<. aStrm nextPutAll: self moniker. (Smalltalk platformName = 'Mac OS') ifFalse: [aStrm nextPut: $>]. ! ! !ServerDirectory methodsFor: 'file directory' stamp: 'edc 7/2/2004 08:08'! fileNamed: fullName "Create a RemoteFileStream for writing. If the file exists, do not complain. fullName is directory path, and does include name of the server. Or it can just be a fileName. Only write the data upon close." | file remoteStrm path | file _ self asServerFileNamed: fullName. file readWrite. file isTypeFile ifTrue: [(Smalltalk platformName = 'Mac OS') ifFalse: [ ^ FileStream fileNamed: (file fileNameRelativeTo: self)] ifTrue:[ path _ fullName copyFrom: 8to: fullName size. ^ FileStream fileNamed: path ] ]. remoteStrm _ RemoteFileStream on: (String new: 2000). remoteStrm remoteFile: file. ^ remoteStrm "no actual writing till close" ! ! So doing Anotador new reloadMeFromDisk brings all .sp pages . I have a example full of Spanish and English recipes for Squeak stuff (with authors or senders to list) what could sent to who is interested in this and a morph saved with Karl solution which one click brings the "Anotador" Also I try to have this help systen works with sblog. Edgar ^ 'ftp://', dir server, dir slashDirectory, '/BK', rand! ! -------------- next part -------------- 'From Squeak3.7beta of ''1 April 2004'' [latest update: #5923] on 9 July 2004 at 8:41:34 am'! "Change Set: Anotador Date: 9 July 2004 Author: Edgar J. De Cleene I cook this slow and dirty partial solution for saving BookMorphs in Mac. Is only for having NotePad (Anotador in Spanish) like pages and a index on disk"! BookMorph subclass: #Anotador instanceVariableNames: 'font' classVariableNames: '' poolDictionaries: '' category: 'SqueakRos'! Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl eToyUserListUrl eToyUserList keepAlive ' classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers LocalSqueakBooksDirectory ' poolDictionaries: '' category: 'Network-RemoteDirectory'! !Anotador methodsFor: 'page controls' stamp: 'edc 7/6/2004 15:02'! getBookNamefromUser ^FillInTheBlank request: 'Give a name for this book '. ! ! !Anotador methodsFor: 'page controls' stamp: 'edc 6/18/2004 09:57'! getPageNamefromUser | pn s | pn _ FillInTheBlank request: 'Ingresar nombre pagina '. s _ StringMorph contents: pn font: self font. s center: (self center x) @ (self top + 50). s color: Color blue. self currentPage addMorph: s. s beSticky ! ! !Anotador methodsFor: 'page controls' stamp: 'edc 3/4/2004 17:20'! insertPage | texto r | pages isEmpty ifTrue: [^ self insertPageColored: self color]. self insertPageColored: self color. self getPageNamefromUser. texto := pages first submorphs first copy. texto setMyText: ''. r := Rectangle left: currentPage left + 5 right: currentPage right - 5 top: currentPage top + 20 bottom: currentPage bottom - 5. texto bounds: r. self currentPage addMorph: texto! ! !Anotador methodsFor: 'page controls' stamp: 'edc 5/19/2003 15:15'! showPageNumber | font pn s | font _ StrikeFont familyName: #ComicBold size: 18. pn _ self pageNumber asString. s _ StringMorph contents: pn font: font. s center: (self center x) @ (self bottom - s height). self currentPage addMorph: s. s beSticky ! ! !Anotador methodsFor: 'page controls' stamp: 'edc 7/7/2004 07:36'! sortPagesByTitle | sortedTitles sortedPages | sortedTitles := (pages collect: [:pg | self pageTitle: pg ]) asSortedCollection . sortedPages := OrderedCollection new. sortedTitles do: [ :thispage | sortedPages add: (pages detect:[ :pg| thispage = (self pageTitle: pg) ]) ]. pages := pages species new. pages addAll: sortedPages ! ! !Anotador methodsFor: 'as yet unclassified' stamp: 'edc 7/9/2004 08:31'! exporting | nombre texto blog story | self pages do: [:aPage| nombre _ self pageTitle: aPage . texto _ ( aPage findA: ScrollableField ) getMyText string. blog _ SLBlog name: nombre. story _ SLStory parent: nombre. story title: nombre. story text: texto. story post. story _ SLStory parent: blog]. blog save! ! !Anotador methodsFor: 'as yet unclassified' stamp: 'edc 7/9/2004 08:12'! nombres | nombre indice menu sel res | menu := CustomMenu new. menu title: 'Seleccione la pagina '. indice := Dictionary new. self pages doWithIndex: [:each :ind | nombre := self pageTitle: each . indice at: nombre put: ind. menu add: nombre action: #goToPage:. menu addLine]. sel := menu startUp. res := menu selection. self goToPage: res! ! !Anotador methodsFor: 'as yet unclassified' stamp: 'edc 7/7/2004 08:44'! title: aString aString emphasis: 1. aString center: self center x @ (self top + 55). aString color: Color blue. self currentPage addMorph: aString. aString beSticky.! ! !Anotador methodsFor: 'accessing' stamp: 'edc 6/18/2004 09:55'! font "Answer the value of font" ^ StrikeFont familyName: #Accuny15 size: 12.! ! !Anotador methodsFor: 'accessing' stamp: 'edc 6/18/2004 09:53'! font: anObject "Set the value of font" font _ anObject! ! !Anotador methodsFor: 'accessing' stamp: 'edc 7/9/2004 08:22'! pageTitle: aPage . ^ ( aPage findA: StringMorph ) contents ! ! !Anotador methodsFor: 'accessing' stamp: 'edc 7/6/2004 10:01'! title ^(self currentPage findA: StringMorph ) contents! ! !Anotador methodsFor: 'initialization' stamp: 'edc 7/9/2004 08:09'! initialize | text r boton lev lev2 lev3 | super initialize. self borderWidth: 2. self color: (Color r: 0.939 g: 0.939 b: 0.258). self resizePagesTo: 350 @ 500. self pages first color: self color. self showMoreControls. self openInWorld. boton := SimpleButtonMorph new label: 'How to ...'; target: self; color: Color lightBlue; actionSelector: #nombres. lev := (submorphs at: 1). lev2 := lev submorphs at: 1. lev3 := lev2 submorphs at: 1. lev3 submorphs last delete. lev3 addMorph: boton . lev3 color: self color. self title: (StringMorph contents: 'My Help System' font: self font). text := ScrollableField new. text color: (Color r: 0.972 g: 0.972 b: 0.662). self currentPage addMorph: text. r := Rectangle left: text owner left + 5 right: text owner right - 5 top: text owner top + 25 bottom: text owner bottom - 5. text bounds: r! ! !Anotador methodsFor: 'fileIn/out' stamp: 'edc 7/9/2004 08:24'! localDiskSave | nombre | self forgetURLs. self pages do: [ :aPage | nombre := ServerDirectory defaultStemUrl , self pageTitle: aPage ,'.sp'. aPage saveOnURL: nombre]. ! ! !Anotador methodsFor: 'fileIn/out' stamp: 'edc 7/8/2004 09:26'! reloadMeFromDisk | index urlList fileStream dir newpage | dir := ServerDirectory defaultStemUrl. dir := dir copyFrom: 8 to: dir size. index := dir , self getBookNamefromUser , '.ind'. fileStream := FileStream oldFileNamed: index. urlList := fileStream fileInObjectAndCode. fileStream close. urlList do: [:pgName | fileStream := FileStream oldFileNamed: dir,pgName. newpage := fileStream fileInObjectAndCode. (newpage isKindOf: SqueakPage) ifTrue:[newpage := newpage asMorph]. fileStream close.pages add: newpage ].! ! !Anotador methodsFor: 'fileIn/out' stamp: 'edc 7/7/2004 09:08'! saveIndexOnDisk "Make up an index to the pages of this book, with thumbnails, and store it on the server. (aDictionary, aMorphObjectOut, aMorphObjectOut, aMorphObjectOut). The last part corresponds exactly to what pages looks like when they are all out. Each holds onto a SqueakPage, which holds a url and a thumbnail." | index sf remoteFile urlList | index := ServerDirectory defaultStemUrl , self getBookNamefromUser , '.ind'. urlList := pages collect: [:ppg | self pageTitle:ppg ]. sf := ServerDirectory new fullPath: index. Cursor wait showWhile: [remoteFile := sf fileNamed: index. remoteFile dataIsValid. remoteFile fileOutClass: nil andObject: urlList "remoteFile close"]! ! !FileUrl methodsFor: 'printing' stamp: 'edc 7/2/2004 07:43'! toText "Return the FileUrl according to RFC1738 plus supporting fragments: 'file://<host>/<path>#<fragment>' Note that <host> being '' is equivalent to 'localhost'. Note: The pathString can not start with a leading $/ to indicate an 'absolute' file path. This is not according to RFC1738 where the path should have no leading or trailing slashes, and always be considered absolute relative to the filesystem." ^String streamContents: [:s | s nextPutAll: self schemeName, '://'. host ifNotNil: [s nextPutAll: host]. (Smalltalk platformName = 'Mac OS') ifFalse: [s nextPut: $/]. s nextPutAll: self pathString. fragment ifNotNil: [ s nextPut: $#; nextPutAll: fragment encodeForHTTP ]]! ! !FileUrl methodsFor: 'private-initialization' stamp: 'edc 7/1/2004 09:33'! privateInitializeFromText: aString "Calculate host and path from a file URL in String format. Some malformed formats are allowed and interpreted by guessing." | schemeName pathString bare hasDriveLetter stream char i | bare _ aString withBlanksTrimmed. schemeName _ Url schemeNameForString: bare. (schemeName isNil or: [schemeName ~= self schemeName]) ifTrue: [ host _ ''. pathString _ bare] ifFalse: [ "First remove schemeName and colon" bare _ bare copyFrom: (schemeName size + 2) to: bare size. "A proper file URL then has two slashes before host, A malformed URL is interpreted as using syntax file:<path>." (bare beginsWith: '//') ifTrue: [i _ bare indexOf: $/ startingAt: 3. i=0 ifTrue: [ host _ bare copyFrom: 3 to: bare size. pathString _ ''] ifFalse: [ host _ bare copyFrom: 3 to: i-1. pathString _ bare copyFrom: host size + 3 to: bare size]] ifFalse: [host _ ''. pathString _ bare]]. ( Smalltalk platformName = 'Mac OS') ifFalse: [ self initializeFromPathString: pathString] ! ! !ServerDirectory methodsFor: 'accessing' stamp: 'edc 7/2/2004 07:52'! printOn: aStrm aStrm nextPutAll: self class name; nextPut: $<. aStrm nextPutAll: self moniker. (Smalltalk platformName = 'Mac OS') ifFalse: [aStrm nextPut: $>]. ! ! !ServerDirectory methodsFor: 'file directory' stamp: 'edc 7/2/2004 08:08'! fileNamed: fullName "Create a RemoteFileStream for writing. If the file exists, do not complain. fullName is directory path, and does include name of the server. Or it can just be a fileName. Only write the data upon close." | file remoteStrm path | file _ self asServerFileNamed: fullName. file readWrite. file isTypeFile ifTrue: [(Smalltalk platformName = 'Mac OS') ifFalse: [ ^ FileStream fileNamed: (file fileNameRelativeTo: self)] ifTrue:[ path _ fullName copyFrom: 8to: fullName size. ^ FileStream fileNamed: path ] ]. remoteStrm _ RemoteFileStream on: (String new: 2000). remoteStrm remoteFile: file. ^ remoteStrm "no actual writing till close" ! ! !ServerDirectory class methodsFor: 'misc' stamp: 'edc 6/30/2004 09:58'! defaultStemUrl "For writing on an FTP directory. Users should insert their own server url here." "ftp://jumbo.rd.wdi.disney.com/raid1/people/dani/Books/Grp/Grp" " ServerDirectory defaultStemUrl " | rand dir | rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. dir := self serverNamed: 'DaniOnJumbo' ifAbsent: [^ 'file://', ServerDirectory localSqueakBooksDirectory,FileDirectory slash]. ^ 'ftp://', dir server, dir slashDirectory, '/BK', rand! ! !ServerDirectory class methodsFor: 'server groups' stamp: 'edc 6/30/2004 09:52'! localSqueakBooksDirectory | fd | LocalSqueakBooksDirectory ifNil: [fd _ FileDirectory default. (fd directoryExists: 'SqueakBooks') ifFalse:[fd createDirectory: 'SqueakBooks']. LocalSqueakBooksDirectory _ FileDirectory default pathName , FileDirectory slash , 'SqueakBooks' ]. ^LocalSqueakBooksDirectory! ! Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl eToyUserListUrl eToyUserList keepAlive' classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories LocalSqueakBooksDirectory Servers' poolDictionaries: '' category: 'Network-RemoteDirectory'!
More information about the Squeak-dev mailing list |