'From Squeak3.2alpha of 4 October 2001 [latest update: #4609] on 18 December 2001 at 10:55:21 am'! "Change Set: Postscript-tk Date: 12 December 2001 Author: Ted Kaehler Postscript printing knew nothing about installing the card-specific morphs of a StackMorph before printing each page. Also, extended ^m to handle the case when people write (aa max:bb) with no space after the colon. Ensure that changes in a project being loaded do not go into the current changeSet. Ensure that 'file into new changeSet' always goes back to the old changeSet, even if there is an error, or the user aborts a Bumper. This holds for updating from the server also. When getting a Fancy Number Watcher from the Master Parts Bin, and placing it in the background of a stack, don't get an error. (Let it be OK to be unnamed and have no variable.) Name the three kinds of number tiles and their parts appropriately. Recognise those names as 'generic' and not specifically named by the user. By default they will not have card specific values until the user renames them. Method for StackMorph to add tab delimited cards from a file. Repair a bug in Find... in a StackMorph when it is invoked with Cmd-f. Feedback when no match is found, or when then only instance is the one already selected."! !BookMorph methodsFor: 'accessing' stamp: 'tk 12/12/2001 15:36'! cardsOrPages "The turnable and printable entities" ^ pages! ! !ChangeSorter class methodsFor: 'adding' stamp: 'tk 12/14/2001 11:14'! newChangesFromStream: aStream named: aName "File in the code from the stream into a new change set whose name is derived from aName. Leave the 'current change set' unchanged. Return the new change set or nil on failure." | oldChanges newName newSet | oldChanges _ Smalltalk changes. PreviousSet _ oldChanges name. "so a Bumper update can find it" newName _ aName sansPeriodSuffix. newSet _ self basicNewChangeSet: newName. [newSet ifNotNil: [Smalltalk newChanges: newSet. aStream fileInAnnouncing: 'Loading ', newName, '...'. Transcript cr; show: 'File ', aName, ' successfully filed in to change set ', newName]. aStream close] ensure: [ Smalltalk newChanges: oldChanges]. ^ newSet! ! !DSCPostscriptCanvas methodsFor: 'as yet unclassified' stamp: 'tk 12/12/2001 15:51'! fullDrawBookMorph: aBookMorph " draw all the pages in a book morph, but only if it is the top-level morph " | currentPage | morphLevel = 1 ifFalse: [^ super fullDrawBookMorph: aBookMorph]. "Unfortunately, the printable 'pages' of a StackMorph are the cards, but for a BookMorph, they are the pages. Separate the cases here." currentPage _ 0. (aBookMorph isKindOf: StackMorph) ifTrue: [ aBookMorph cards do: [:aCard | aBookMorph goToCard: aCard. "cause card-specific morphs to be installed" currentPage _ currentPage + 1. target print: '%%Page: '; write: currentPage; space; write: currentPage; cr. self drawPage: aBookMorph currentPage]] ifFalse: [ aBookMorph pages do: [:aPage | currentPage _ currentPage + 1. target print: '%%Page: '; write: currentPage; space; write: currentPage; cr. self drawPage: aPage]]. target print: '%%EOF'; cr. ! ! !NumericReadoutTile class methodsFor: 'instance creation' stamp: 'tk 12/14/2001 19:30'! authoringPrototype "Enclose my prototype in a SyntaxMorph." | aWatcher aTile aLine aColor ms slotMsg | aColor _ Color r: 0.387 g: 0.581 b: 1.0. aTile _ self new typeColor: aColor. aWatcher _ UpdatingStringMorph new. aWatcher growable: true; setToAllowTextEdit; getSelector: nil; putSelector: nil. aWatcher target: nil. aTile addMorphBack: aWatcher. aTile addArrows. aTile setLiteralTo: 5 width: 30. "This is the long way around to do this..." ms _ MessageSend receiver: nil selector: #aNumber arguments: #(). slotMsg _ ms asTilesIn: Player globalNames: false. "For CardPlayers, use 'aPlayer'. For others, name it, and use its name." ms _ MessageSend receiver: 3 selector: #= asSymbol arguments: #(5). aLine _ ms asTilesIn: Player globalNames: false. aLine firstSubmorph delete. aLine addMorphFront: (slotMsg submorphs second) firstSubmorph. aLine firstSubmorph setNameTo: 'label'. aLine addMorphFront: (Morph new transparentSpacerOfSize: 3@3). aLine lastSubmorph delete. aLine lastSubmorph delete. aLine color: aColor; setNameTo: 'Number (fancy)'. aLine addMorphBack: (Morph new transparentSpacerOfSize: 3@3). aLine addMorphBack: aTile. aLine readOut setNameTo: 'value'. aLine cellPositioning: #leftCenter. aWatcher step; fitContents. ^ aLine markAsPartsDonor.! ! !NumericReadoutTile class methodsFor: 'instance creation' stamp: 'tk 12/14/2001 19:32'! borderedPrototype "Just number and up/down arrows" | aWatcher aTile | aTile _ self new typeColor: (Color r: 0.387 g: 0.581 b: 1.0). aWatcher _ UpdatingStringMorph new. aWatcher growable: true; setNameTo: 'value'. aTile addMorphBack: aWatcher. aTile addArrows; setNameTo: 'Number (mid)'. aTile setLiteralTo: 5 width: 30. aWatcher step; fitContents; setToAllowTextEdit. ^ aTile extent: 30@24; markAsPartsDonor! ! !NumericReadoutTile class methodsFor: 'instance creation' stamp: 'tk 12/14/2001 19:29'! simplePrototype "Bare number readout. Will keep up to data with a number once it has target, getterSelector, setterSelector." ^ (UpdatingStringMorph new) contents: '5'; growable: true; setToAllowTextEdit; step; fitContents; setNameTo: 'Number (bare)'; markAsPartsDonor! ! !ProjectLoading class methodsFor: 'as yet unclassified' stamp: 'tk 12/14/2001 10:36'! openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView "Reconstitute a Morph from the selected file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world." | morphOrList proj trusted localDir projStream archive mgr projectsToBeDeleted baseChangeSet | (preStream isNil or: [preStream size = 0]) ifTrue: [ ProgressNotification signal: '9999 about to enter project'. "the hard part is over" ^self inform: 'It looks like a problem occurred while getting this project. It may be temporary, so you may want to try again,' ]. ProgressNotification signal: '2:fileSizeDetermined ',preStream size printString. preStream isZipArchive ifTrue:[ archive _ ZipArchive new readFrom: preStream. projStream _ self projectStreamFromArchive: archive] ifFalse:[projStream _ preStream]. trusted _ SecurityManager default positionToSecureContentsOf: projStream. trusted ifFalse:[(SecurityManager default enterRestrictedMode) ifFalse:[ (preStream respondsTo: #close) ifTrue:[preStream close]. ^self]]. localDir _ Project squeakletDirectory. aFileName ifNotNil: [ (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName ~= localDir pathName]) ifTrue: [ localDir deleteFileNamed: aFileName. (localDir fileNamed: aFileName) nextPutAll: preStream contents; close. ]. ]. morphOrList _ projStream asUnZippedStream. preStream sleep. "if ftp, let the connection close" ProgressNotification signal: '3:unzipped'. ResourceCollector current: ResourceCollector new. baseChangeSet _ Smalltalk changes. self useTempChangeSet. "named zzTemp" "The actual reading happens here" [morphOrList _ morphOrList fileInObjectAndCode] ensure: [ Smalltalk newChanges: baseChangeSet]. mgr _ ResourceManager new initializeFrom: ResourceCollector current. mgr registerUnloadedResources. archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName]. (preStream respondsTo: #close) ifTrue:[preStream close]. ResourceCollector current: nil. ProgressNotification signal: '4:filedIn'. ProgressNotification signal: '9999 about to enter project'. "the hard part is over" (morphOrList isKindOf: ImageSegment) ifTrue: [ proj _ morphOrList arrayOfRoots detect: [:mm | mm class == Project] ifNone: [^self inform: 'No project found in this file']. proj resourceManager: mgr. proj versionFrom: preStream. proj lastDirectory: aDirectoryOrNil. CurrentProjectRefactoring currentBeParentTo: proj. projectsToBeDeleted _ OrderedCollection new. existingView ifNil: [ Smalltalk isMorphic ifTrue: [ proj createViewIfAppropriate. ] ifFalse: [ ChangeSorter allChangeSets add: proj changeSet. ProjectView openAndEnter: proj. "Note: in MVC we get no further than the above" ]. ] ifNotNil: [ (existingView project isKindOf: DiskProxy) ifFalse: [ existingView project changeSet name: ChangeSet defaultName. projectsToBeDeleted add: existingView project. ]. (existingView owner isKindOf: SystemWindow) ifTrue: [ existingView owner model: proj ]. existingView project: proj. ]. ChangeSorter allChangeSets add: proj changeSet. Project current projectParameters at: #deleteWhenEnteringNewProject ifPresent: [ :ignored | projectsToBeDeleted add: Project current. Project current removeParameter: #deleteWhenEnteringNewProject. ]. projectsToBeDeleted isEmpty ifFalse: [ proj projectParameters at: #projectsToBeDeleted put: projectsToBeDeleted. ]. ^ ProjectEntryNotification signal: proj ]. (morphOrList isKindOf: SqueakPage) ifTrue: [ morphOrList _ morphOrList contentsMorph ]. (morphOrList isKindOf: PasteUpMorph) ifFalse: [ ^ self inform: 'This is not a PasteUpMorph or exported Project.' ]. (Project newMorphicOn: morphOrList) enter ! ! !ProjectLoading class methodsFor: 'as yet unclassified' stamp: 'tk 12/14/2001 10:35'! useTempChangeSet "While reading the project in, use the temporary change set zzTemp" | zz | zz _ ChangeSorter changeSetNamed: 'zzTemp'. zz ifNil: [zz _ ChangeSorter basicNewChangeSet: 'zzTemp']. Smalltalk newChanges: zz.! ! !StackMorph methodsFor: 'background' stamp: 'tk 12/15/2001 17:46'! addCardsFromFile: fileStream "Using the current background, take tab delimited data from the file to create new records." | slotNames clip count | slotNames _ self currentCard slotNames. (clip _ fileStream contentsOfEntireFile) isEmptyOrNil ifTrue: [^ self beep]. count _ 0. clip asString linesDo: [:aLine | aLine size > 0 ifTrue: [count _ count + 1. self insertCardOfBackground: self currentPage withDataFrom: aLine forInstanceVariables: slotNames]]. self inform: count asString, ' card(s) added' ! ! !StackMorph methodsFor: 'card access' stamp: 'tk 12/12/2001 15:36'! cardsOrPages "The turnable and printable entities" ^ cards! ! !StackMorph class methodsFor: 'misc' stamp: 'tk 12/14/2001 19:23'! discoverSlots: aMorph "Examine the parts of the morph for ones that couldHoldSeparateData. Return a pair of lists: Named morphs, and unnamed morphs (which may be labels, and non-data). Examine all submorphs." | named unnamed got sn generic | named _ OrderedCollection new. unnamed _ OrderedCollection new. aMorph submorphsDo: [:direct | got _ false. direct allMorphsDo: [:sub | sub couldHoldSeparateDataForEachInstance ifTrue: [ (sn _ sub knownName) ifNotNil: [ generic _ (#('Number (fancy)' 'Number (mid)' 'Number (bare)') includes: sn). (sn beginsWith: 'shared' "label") | generic ifFalse: [ named add: sub. got _ true]]]]. got ifFalse: [unnamed add: direct]]. ^ Array with: named with: unnamed ! ! !String methodsFor: 'converting' stamp: 'tk 12/12/2001 15:11'! findSelector "Dan's code for hunting down selectors with keyword parts; while this doesn't give a true parse, in most cases it does what we want, in where it doesn't, we're none the worse for it." | sel possibleParens level n | sel _ self withBlanksTrimmed. (sel includes: $:) ifTrue: [sel _ sel copyReplaceAll: ':' with: ': '. "for the style (aa max:bb) with no space" possibleParens _ sel findTokens: Character separators. sel _ String streamContents: [:s | level _ 0. possibleParens do: [:token | (level = 0 and: [token endsWith: ':']) ifTrue: [s nextPutAll: token] ifFalse: [(n _ token occurrencesOf: $( ) > 0 ifTrue: [level _ level + n]. (n _ token occurrencesOf: $[ ) > 0 ifTrue: [level _ level + n]. (n _ token occurrencesOf: $] ) > 0 ifTrue: [level _ level - n]. (n _ token occurrencesOf: $) ) > 0 ifTrue: [level _ level - n]]]]]. sel isEmpty ifTrue: [^ nil]. Symbol hasInterned: sel ifTrue: [:aSymbol | ^ aSymbol]. ^ nil! ! !SyntaxMorph methodsFor: 'card & stack' stamp: 'tk 12/14/2001 11:58'! putOnBackground "Place the receiver, formerly private to its card, onto the shared background. If the receiver needs data carried on its behalf by the card, such data will be represented on every card." | updStr | (updStr _ self readOut) ifNotNil: ["If has a place to put per-card data, set that up." updStr getSelector ifNotNil: [ self setProperty: #holdsSeparateDataForEachInstance toValue: true]]. super putOnBackground.! ! !TextMorphEditor methodsFor: 'accessing' stamp: 'tk 12/18/2001 10:25'! setSearch: aString | bk | "Set the FindText and ChangeText to seek aString; except if already seeking aString, leave ChangeText alone so again will repeat last replacement." (bk _ morph ownerThatIsA: BookMorph) ifNotNil: [ bk setProperty: #tempSearchKey toValue: (aString findTokens: Character separators)]. FindText string = aString ifFalse: [FindText _ ChangeText _ aString asText]! ! !TextMorphEditor methodsFor: 'mvc compatibility' stamp: 'tk 12/18/2001 10:30'! againOrSame: bool | bk keys | (bk _ morph ownerThatIsA: BookMorph) ifNotNil: [ (keys _ bk valueOfProperty: #tempSearchKey ifAbsent: [nil]) "Cmd-f" ifNil: [keys _ bk valueOfProperty: #searchKey ifAbsent: [nil]] "Cmd-g" ifNotNil: [bk removeProperty: #tempSearchKey]. keys ifNotNil: [ keys size > 0 ifTrue: [ bk findText: keys. ^ (morph respondsTo: #editView) ifTrue: [ morph editView selectionInterval: self selectionInterval]. ]]]. super againOrSame: bool. (morph respondsTo: #editView) ifTrue: [ morph editView selectionInterval: self selectionInterval].! ! BookMorph removeSelector: #cardsOrPagesDo:!