'From Squeak3.7alpha of ''11 September 2003'' [latest update: #5545] on 14 November 2003 at 6:09:20 pm'! "Change Set: SyntaxFixes-md Date: 14 November 2003 Author: Marcus Denker These are some syntax fixes needed to compile the current 3.7a image with the ClosureCompiler. This should be added to the updatestream soon. (fixed a couple of conflicts with 5546. -dew)"! !CRDictionary class methodsFor: 'exported instances' stamp: 'md 11/14/2003 16:06'! exportedName: aSymbol "Returns the instance with the given exported name. For a fast lookup, the instances with an exported name are stored in a dictionary of the class (ExportedInstanceDictionary)" aSymbol isEmptyOrNil ifTrue: [^ nil]. ^ ExportedInstanceDictionary at: aSymbol ifAbsent: [].! ! !CRFeature methodsFor: 'accessing' stamp: 'md 11/14/2003 16:13'! asMorphSize: sizeNumber border: aNumberOrPoint relative: relativeBoolean properties: aCRDisplayProperties showPoints: pointsBoolean orientation: aSymbol "Return a morph representing this feature" | morph subMorph | morph _ AlignmentMorph newColumn color: Color transparent. pointsBoolean ifTrue: [subMorph _ AlignmentMorph new color: Color transparent. morph addMorphBack: subMorph. subMorph listDirection: aSymbol. subMorph addMorphBack: (self capturedPointsMorphSize: sizeNumber border: aNumberOrPoint relative: relativeBoolean properties: aCRDisplayProperties)] ifFalse: [subMorph _ morph]. subMorph addMorphFront: (self featureMorphSize: sizeNumber border: aNumberOrPoint relative: relativeBoolean properties: aCRDisplayProperties). morph addMorphFront: self textMorph. ^ morph.! ! !CRGesture methodsFor: 'accessing' stamp: 'md 11/14/2003 16:16'! distance "The distance from the captured feature to the result feature at the iterator position" ^ self distanceAt: self lookupIndex! ! !CRGesture methodsFor: 'accessing' stamp: 'md 11/14/2003 16:15'! evaluateCode "Eveluate the code at the iterator position of the result with THIS INSTANCE AS A RECEIVER. (Only if the character at the iterator position is really code)" ^ self evaluateCodeAt: self lookupIndex ! ! !CRStrokeFeature methodsFor: 'private comparing' stamp: 'md 11/14/2003 16:17'! sameClassAcuteAngleDistance: aCRFeature maxNormDist: maxNumber "This mainly heuristic method measures the distance between two features in terms of acute angles and their positions" | myVal otherVal factor diff minCount significantCount result | "The position is only considered if the acute angle count is at least this value (An acute angle count of 100 means that there is one completely acute angle)." minCount _ 50. myVal _ self acuteAngleCount. otherVal _ aCRFeature acuteAngleCount. significantCount _ myVal > otherVal ifTrue: [myVal] ifFalse: [otherVal]. "max" diff _ (myVal - otherVal). diff < 0 ifTrue: [diff _ 0 - diff]. "abs" factor _ 500 * diff * diff // 40000. "500 * diff * diff // (200 * 200)" significantCount > minCount ifTrue: [myVal _ self acuteAnglePosition. otherVal _ aCRFeature acuteAnglePosition. diff _ (myVal - otherVal). diff < 0 ifTrue: [diff _ 0 - diff]. "abs" factor _ factor + (500 * diff * diff // 1600)]. result _ maxNumber * factor // 1000. ^ maxNumber > result ifTrue: [result] ifFalse: [maxNumber]. "min"! ! !CRStrokeFeature class methodsFor: 'primitive test' stamp: 'md 11/14/2003 16:18'! testPrimitiveDictionaryName: aDictSymbol forReference: forReferenceBoolean detailed: detailedBoolean "CRStrokeFeature primitiveTestDictionaryName: #PrimTest1 forReference: true. " "Method to test a primitive for CRStrokeFeature>>sameClassAbsoluteStrokeDistance:forReference:. See comment of method CRStrokeFeature class>>testPrimitive:original:dictionary:relDiffLimit:" | primSelector origSelector dict relDiffLimit | "Selectors for the original and the primitive methods" primSelector _ #primSameClassAbsoluteStrokeDistance:forReference:. origSelector _ #origSameClassAbsoluteStrokeDistance:forReference:. "This boolean value is used as the second argument of the test method. The test should run successfully with both true and false" Transcript cr; show: 'Testing primitive with dictionary: ', aDictSymbol, ', for reference: ', forReferenceBoolean printString, '...'. "Use the CRStrokeFeatures in this dictionary as test cases" "Note: You can use the method #exportedName: instead of #name: to refer to the exported name of a dictionary" dict _ CRDictionary name: aDictSymbol. dict isNil ifTrue: [self error: 'Dictionary ', aDictSymbol, ' is not available!!']. "If the relative difference between primitive and original is bigger than this value, an exception is raised" relDiffLimit _ 0. dict fillFeaturesCacheIfNotFull. self testPrimitive: [:feature1 :feature2 | feature1 perform: primSelector with: feature2 with: forReferenceBoolean] original: [:feature1 :feature2 | feature1 perform: origSelector with: feature2 with: forReferenceBoolean] dictionary: dict relDiffLimit: relDiffLimit detailed: detailedBoolean ! ! !CategoryViewer methodsFor: 'entries' stamp: 'md 11/14/2003 16:21'! addIsOverColorDetailTo: aRow | clrTile readout aTile | aRow addMorphBack: (Morph new color: self color; extent: 2@10). " spacer" aRow addMorphBack: (clrTile _ Color blue newTileMorphRepresentative). aRow addMorphBack: (AlignmentMorph new beTransparent). "flexible spacer" readout _ UpdatingStringMorphWithArgument new target: scriptedPlayer; getSelector: #seesColor:; growable: false; putSelector: nil; argumentTarget: clrTile colorSwatch argumentGetSelector: #color. readout useDefaultFormat. aTile _ StringReadoutTile new typeColor: Color lightGray lighter. aTile addMorphBack: readout. aRow addMorphBack: aTile. aTile setLiteralTo: (scriptedPlayer seesColor: clrTile colorSwatch color) printString width: 30! ! !CategoryViewer methodsFor: 'entries' stamp: 'md 11/14/2003 16:20'! addOverlapsDetailTo: aRow "Disreputable magic: add necessary items to a viewer row abuilding for the overlaps phrase" aRow addMorphBack: (Morph new color: self color; extent: 2@10). "spacer" aRow addMorphBack: self tileForSelf. aRow addMorphBack: (AlignmentMorph new beTransparent). "flexible spacer" ! ! !CategoryViewer methodsFor: 'entries' stamp: 'md 11/14/2003 16:21'! addTouchesADetailTo: aRow | clrTile | aRow addMorphBack: (Morph new color: self color; extent: 2@10). " spacer" aRow addMorphBack: (clrTile _ self tileForSelf). aRow addMorphBack: (AlignmentMorph new beTransparent). "flexible spacer" "readout _ UpdatingStringMorphWithArgument new target: scriptedPlayer; getSelector: #seesColor:; growable: false; putSelector: nil; argumentTarget: clrTile colorSwatch argumentGetSelector: #color. readout useDefaultFormat. aTile _ StringReadoutTile new typeColor: Color lightGray lighter. aTile addMorphBack: readout. aRow addMorphBack: aTile. aTile setLiteralTo: (scriptedPlayer seesColor: clrTile colorSwatch color) printString width: 30"! ! !CategoryViewer methodsFor: 'entries' stamp: 'md 11/14/2003 16:20'! infoButtonFor: aScriptOrSlotSymbol "Answer a fully-formed morph that will serve as the 'info button' alongside an entry corresponding to the given slot or script symbol. If no such button is appropriate, answer a transparent graphic that fills the same space." | aButton | (self wantsRowMenuFor: aScriptOrSlotSymbol) ifFalse: ["Fill the space with sweet nothing, since there is no meaningful menu to offer" aButton _ RectangleMorph new beTransparent extent: (17@20). aButton borderWidth: 0. ^ aButton]. aButton _ IconicButton new labelGraphic: Cursor menu. aButton target: scriptedPlayer; actionSelector: #infoFor:inViewer:; arguments: (Array with:aScriptOrSlotSymbol with: self); color: Color transparent; borderWidth: 0; shedSelvedge; actWhen: #buttonDown. aButton setBalloonText: 'Press here to get a menu' translated. ^ aButton! ! !ChangeSet methodsFor: 'fileIn/Out' stamp: 'md 11/14/2003 16:22'! objectForDataStream: refStrm "I am about to be written on an object file. Write a path to me in the other system instead." refStrm projectChangeSet == self ifTrue: [^ self]. "try to write reference for me" ^ DiskProxy global: #ChangeSorter selector: #existingOrNewChangeSetNamed: args: (Array with: self name) "=== refStrm replace: self with: nil. ^ nil ===" ! ! !Date methodsFor: 'inquiries' stamp: 'md 11/14/2003 16:27'! daylightSavingsInEffect "Return true if DST is observed at or after 2am on this day" self dayMonthYearDo: [:day :month :year | (month < 4 or: [month > 10]) ifTrue: [^ false]. "False November through March" (month > 4 and: [month < 10]) ifTrue: [^ true]. "True May through September" month = 4 ifTrue: ["It's April -- true on first Sunday or later" day >= 7 ifTrue: [^ true]. "Must be after" ^ day > (self weekdayIndex \\ 7)] ifFalse: ["It's October -- false on last Sunday or later" day <= 24 ifTrue: [^ true]. "Must be before" ^ day <= (24 + (self weekdayIndex \\ 7))]]! ! !Decompiler methodsFor: 'instruction decoding' stamp: 'md 11/14/2003 16:28'! case: dist "statements = keyStmts CascadeFlag keyValueBlock ... keyStmts" | nextCase end thenJump stmtStream elements b node cases otherBlock | nextCase _ pc + dist. end _ limit. "Now add CascadeFlag & keyValueBlock to statements" statements addLast: stack removeLast. stack addLast: CaseFlag. "set for next pop" statements addLast: (self blockForCaseTo: nextCase). stack last == CaseFlag ifTrue: "Last case" ["ensure jump is within block (in case thenExpr returns wierdly I guess)" stack removeLast. "get rid of CaseFlag" thenJump _ exit <= end ifTrue: [exit] ifFalse: [nextCase]. stmtStream _ ReadStream on: (self popTo: stack removeLast). elements _ OrderedCollection new. b _ OrderedCollection new. [stmtStream atEnd] whileFalse: [(node _ stmtStream next) == CascadeFlag ifTrue: [elements addLast: (constructor codeMessage: (constructor codeBlock: b returns: false) selector: (constructor codeSelector: #-> code: #macro) arguments: (Array with: stmtStream next)). b _ OrderedCollection new] ifFalse: [b addLast: node]]. b size > 0 ifTrue: [self error: 'Bad cases']. cases _ constructor codeBrace: elements. otherBlock _ self blockTo: thenJump. stack addLast: (constructor codeMessage: stack removeLast selector: (constructor codeSelector: #caseOf:otherwise: code: #macro) arguments: (Array with: cases with: otherBlock))]! ! !FishEyeMorph methodsFor: 'initialization' stamp: 'md 11/14/2003 16:32'! transformX: aFloatArray | focus gridNum2 subArray dMaxX | focus _ srcExtent x asFloat / 2. gridNum2 _ (aFloatArray findFirst: [:x | x > focus]) - 1. dMaxX _ 0.0 - focus. subArray _ self g: (aFloatArray copyFrom: 1 to: gridNum2) max: dMaxX focus: focus. aFloatArray replaceFrom: 1 to: gridNum2 with: subArray startingAt: 1. dMaxX _ focus. " = (size - focus)" subArray _ self g: (aFloatArray copyFrom: gridNum2 + 1 to: gridNum x + 1) max: dMaxX focus: focus. aFloatArray replaceFrom: gridNum2 + 1 to: gridNum x + 1 with: subArray startingAt: 1. ! ! !FormEditor methodsFor: 'editing tools' stamp: 'md 11/14/2003 16:36'! curve "Conic-section specified by three points designated by: first point--press red button second point--release red button third point--click red button. The resultant curve on the display is displayed according to the current form and mode." | firstPoint secondPoint thirdPoint curve | "sensor noButtonPressed ifTrue: [^self]." firstPoint _ self cursorPoint. form displayOn: Display at: firstPoint clippingBox: view insetDisplayBox rule: (Display depth > 1 ifTrue: [Form paint] ifFalse: [mode]) fillColor: color. secondPoint _ self trackFormUntil: [sensor noButtonPressed]. form displayOn: Display at: secondPoint clippingBox: view insetDisplayBox rule: Form reverse fillColor: color. thirdPoint _ self trackFormUntil: [sensor redButtonPressed]. form displayOn: Display at: thirdPoint clippingBox: view insetDisplayBox rule: (Display depth > 1 ifTrue: [Form paint] ifFalse: [mode]) fillColor: color. form displayOn: Display at: secondPoint clippingBox: view insetDisplayBox rule: Form reverse fillColor: color. curve _ CurveFitter new. curve firstPoint: firstPoint. curve secondPoint: secondPoint. curve thirdPoint: thirdPoint. curve form: form. curve displayOn: Display at: 0 @ 0 clippingBox: view insetDisplayBox rule: (Display depth > 1 ifTrue: [Form paint] ifFalse: [mode]) fillColor: color. sensor waitNoButton! ! !HTTPLoader methodsFor: 'private' stamp: 'md 11/14/2003 16:38'! removeProcess: downloadProcess downloads remove: downloadProcess ifAbsent: []! ! !HTTPSocket methodsFor: 'as yet unclassified' stamp: 'md 11/14/2003 16:39'! header: headerText "set the headers. Then getHeader: can be used" "divide into basic lines" | lines foldedLines i statusLine | lines _ headerText findTokens: (String with: Character cr with: Character linefeed). statusLine _ lines first. lines _ lines copyFrom: 2 to: lines size. "parse the status (pretty trivial right now)" responseCode _ (statusLine findTokens: ' ') second. "fold lines that start with spaces into the previous line" foldedLines _ OrderedCollection new. lines do: [ :line | line first isSeparator ifTrue: [ foldedLines at: foldedLines size put: (foldedLines last, line) ] ifFalse: [ foldedLines add: line ] ]. "make a dictionary mapping headers to header contents" headers _ Dictionary new. foldedLines do: [ :line | i _ line indexOf: $:. i > 0 ifTrue: [ headers at: (line copyFrom: 1 to: i-1) asLowercase put: (line copyFrom: i+1 to: line size) withBlanksTrimmed ] ]. ! ! !HTTPSocket class methodsFor: 'utilities' stamp: 'md 11/14/2003 16:40'! httpPostDocument: url args: argsDict accept: mimeType request: requestString "like httpGET, except it does a POST instead of a GET. POST allows data to be uploaded" | s header length page list firstData aStream type newUrl httpUrl argString | Socket initializeNetwork. httpUrl _ Url absoluteFromText: url. page _ httpUrl fullPath. "add arguments" argString _ argsDict ifNotNil: [argString _ self argString: argsDict] ifNil: ['']. page _ page, argString. s _ HTTPSocket new. s _ self initHTTPSocket: httpUrl wait: (self deadlineSecs: 30) ifError: [:errorString | ^errorString]. s sendCommand: 'POST ', page, ' HTTP/1.0', CrLf, (mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']), 'ACCEPT: text/html', CrLf, "Always accept plain text" HTTPBlabEmail, "may be empty" requestString, "extra user request. Authorization" self userAgentString, CrLf, 'Content-type: application/x-www-form-urlencoded', CrLf, 'Content-length: ', argString size printString, CrLf, 'Host: ', httpUrl authority, CrLf. "blank line automatically added" argString first = $? ifTrue: [ argString _ argString copyFrom: 2 to: argString size]. "umur - IE sends argString without a $? and swiki expects so" s sendCommand: argString. "get the header of the reply" list _ s getResponseUpTo: CrLf, CrLf ignoring: (String with: CR). "list = header, CrLf, CrLf, beginningOfData" header _ list at: 1. "Transcript show: page; cr; show: argsStream contents; cr; show: header; cr." firstData _ list at: 3. "dig out some headers" s header: header. length _ s getHeader: 'content-length'. length ifNotNil: [ length _ length asNumber ]. type _ s getHeader: 'content-type'. s responseCode first = $3 ifTrue: [ newUrl _ s getHeader: 'location'. newUrl ifNotNil: [ "umur 6/25/2003 12:58 - If newUrl is relative then we need to make it absolute." newUrl _ (httpUrl newFromRelativeText: newUrl) asString. self flag: #refactor. "get, post, postmultipart are almost doing the same stuff" s destroy. "^self httpPostDocument: newUrl args: argsDict accept: mimeType" ^self httpGetDocument: newUrl accept: mimeType ] ]. aStream _ s getRestOfBuffer: firstData totalLength: length. s responseCode = '401' ifTrue: [^ header, aStream contents]. s destroy. "Always OK to destroy!!" ^ MIMEDocument contentType: type content: aStream contents url: url! ]style[(77 993 150 561 228 369)f1b,f1,f1cmagenta;,f1,f1cmagenta;,f1! ! !IndentingListItemMorph methodsFor: 'layout' stamp: 'md 11/14/2003 16:43'! acceptDroppingMorph: toDrop event: evt complexContents acceptDroppingObject: toDrop complexContents. toDrop delete. self clearDropHighlighting.! ! !Message methodsFor: 'as yet unclassified' stamp: 'md 11/14/2003 17:37'! pushReceiver! ! !MethodFinder methodsFor: 'initialize' stamp: 'md 11/14/2003 16:47'! copy: mthFinder addArg: aConstant | more | "Copy inputs and answers, add an additional data argument to the inputs. The same constant for every example" more _ Array with: aConstant. data _ mthFinder data collect: [:argList | argList, more]. answers _ mthFinder answers. self load: nil. ! ! !MethodFinder methodsFor: 'find a constant' stamp: 'md 11/14/2003 16:47'! constEquiv | const subTest got jj | "See if (data1 = C) or (data1 ~= C) is the answer" "quick test" ((answers at: 1) class superclass == Boolean) ifFalse: [^ false]. 2 to: answers size do: [:ii | ((answers at: ii) class superclass == Boolean) ifFalse: [^ false]]. const _ (thisData at: 1) at: 1. got _ (subTest _ MethodFinder new copy: self addArg: const) searchForOne isEmpty not. got ifFalse: ["try other polarity for ~~ " (jj _ answers indexOf: (answers at: 1) not) > 0 ifTrue: [ const _ (thisData at: jj) at: 1. got _ (subTest _ MethodFinder new copy: self addArg: const) searchForOne isEmpty not]]. got ifFalse: [^ false]. "replace data2 with const in expressions" subTest expressions do: [:exp | expressions add: (exp copyReplaceAll: 'data2' with: const printString)]. selector addAll: subTest selectors. ^ true! ! !PCXReadWriter methodsFor: 'private-decoding' stamp: 'md 11/14/2003 16:51'! readHeader | xMin xMax yMin yMax | self next. "skip over manufacturer field" version _ self next. encoding _ self next. bitsPerPixel _ self next. xMin _ self nextWord. yMin _ self nextWord. xMax _ self nextWord. yMax _ self nextWord. width _ xMax - xMin + 1. height _ yMax - yMin + 1. self next: 4. "skip over device resolution" self next: 49. "skip over EGA color palette" colorPlanes _ self next. rowByteSize _ self nextWord. isGrayScale _ (self next: 2) = 2. self next: 58. "skip over filler" ! ! !PaintBoxMorph methodsFor: 'initialization' stamp: 'md 11/14/2003 16:52'! loadoffImage: fileName "Read in and convert the background image for the paintBox. All buttons off. A .bmp 24-bit image." " Prototype loadoffImage: 'roundedPalette3.bmp' " | pic16Bit blt type getBounds | type _ 'bmp'. " gif or bmp " getBounds _ 'fromPic'. "fromUser = draw out rect of paintbox on image" "fromOB = just read in new bits, keep same size and place as last time." "fromPic = picture is just the PaintBox, use its bounds" type = 'gif' ifTrue: [ pic16Bit "really 8" _ GIFReadWriter formFromFileNamed: fileName. getBounds = 'fromUser' ifTrue: ["Just first time, collect the bounds" pic16Bit display. OriginalBounds _ Rectangle fromUser]. getBounds = 'fromPic' ifTrue: [OriginalBounds _ pic16Bit boundingBox]. ]. "Use OriginalBounds as it was last time" type = 'bmp' ifTrue: [ pic16Bit _ (Form fromBMPFileNamed: fileName) asFormOfDepth: 16. getBounds = 'fromUser' ifTrue: ["Just first time, collect the bounds" pic16Bit display. OriginalBounds _ Rectangle fromUser]. "Use OriginalBounds as it was last time" (getBounds = 'fromPic') ifTrue: [OriginalBounds _ pic16Bit boundingBox]. AllOffImage _ Form extent: OriginalBounds extent depth: 16. ]. type = 'gif' ifTrue: [ AllOffImage _ ColorForm extent: OriginalBounds extent depth: 8. AllOffImage colors: pic16Bit colors]. blt _ BitBlt current toForm: AllOffImage. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. type = 'bmp' ifTrue: [AllOffImage mapColor: Color transparent to: Color black]. self image: AllOffImage. self invalidRect: bounds. ! ! !PenPointRecorder methodsFor: 'line drawing' stamp: 'md 11/14/2003 16:56'! drawFrom: p1 to: p2 "Overridden to skip drawing but track bounds of the region traversed." points ifNil: [points _ OrderedCollection with: p1]. points addLast: p2! ! !PianoRollScoreMorph methodsFor: 'private' stamp: 'md 11/14/2003 16:57'! removedMorph: aMorph | trackSize | trackSize _ score ambientTrack size. score removeAmbientEventWithMorph: aMorph. trackSize = score ambientTrack size ifFalse: ["Update duration if we removed an event" scorePlayer updateDuration]. ^super removedMorph: aMorph! ! !PluggableMessageCategoryListMorph methodsFor: 'as yet unclassified' stamp: 'md 11/14/2003 16:59'! on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel getRawListSelector: getRawSel self model: anObject. getListSelector _ getListSel. getIndexSelector _ getSelectionSel. setIndexSelector _ setSelectionSel. getMenuSelector _ getMenuSel. keystrokeActionSelector _ keyActionSel. autoDeselect _ true. self borderWidth: 1. getRawListSelector _ getRawSel. self list: self getList. self selectionIndex: self getCurrentSelectionIndex. self initForKeystrokes! ! !PluggableMessageCategoryListMorph class methodsFor: 'as yet unclassified' stamp: 'md 11/14/2003 16:59'! on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel getRawListSelector: getRawSel ^ self new on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel getRawListSelector: getRawSel! ! !PostscriptCanvas methodsFor: 'drawing' stamp: 'md 11/14/2003 17:05'! drawRectangle: r color: color borderWidth: borderWidth borderColor: borderColor ^self frameAndFillRectangle: r fillColor: color borderWidth: borderWidth borderColor: borderColor . ! ! !PostscriptCanvas methodsFor: 'morph drawing' stamp: 'md 11/14/2003 17:04'! setupGStateForMorph:aMorph ! ! !Preferences class methodsFor: 'misc' stamp: 'md 11/14/2003 17:05'! browseThemes "Open up a message-category browser on the theme-defining methods" | aBrowser | aBrowser _ Browser new setClass: Preferences class selector: #outOfTheBox. aBrowser messageCategoryListIndex: ((Preferences class organization categories indexOf: 'themes' ifAbsent: [^ self inform: 'no themes found']) + 1). Browser openBrowserView: (aBrowser openMessageCatEditString: nil) label: 'Preference themes' "Preferences browseThemes"! ! !ProjectSorterMorph methodsFor: 'as yet unclassified' stamp: 'md 11/14/2003 17:09'! navigator: aThreadNavigator listOfPages: listOfPages | morphsForPageSorter pixelsAvailable pixelsNeeded scale | "a bit of fudging to try to outguess the layout mechanism and get best possible scale" pixelsAvailable _ Display extent - 130. pixelsAvailable _ pixelsAvailable x * pixelsAvailable y. pixelsNeeded _ 100@75. pixelsNeeded _ pixelsNeeded x * pixelsNeeded y * listOfPages size. scale _ (pixelsAvailable / pixelsNeeded min: 1) sqrt. sizeOfEachMorph _ (100@75 * scale) rounded. morphsForPageSorter _ self morphsForMyContentsFrom: listOfPages sizedTo: sizeOfEachMorph. morphsForPageSorter _ morphsForPageSorter reject: [ :each | each isNil]. self changeExtent: Display extent. self book: aThreadNavigator morphsToSort: morphsForPageSorter. pageHolder cursor: aThreadNavigator currentIndex; fullBounds; hResizing: #rigid. ! ! !Scanner methodsFor: 'multi-character scans' stamp: 'md 11/14/2003 17:14'! xColon "Allow := for assignment by converting to #_ " aheadChar = $= ifTrue: [self step. tokenType _ #leftArrow. self step. ^ token _ #'_']. "Otherwise, just do what normal scan of colon would do" tokenType _ #colon. ^ token _ self step asSymbol! ! !Parser methodsFor: 'primitives' stamp: 'md 11/14/2003 16:53'! externalFunctionDeclaration "Parse the function declaration for a call to an external library." | descriptorClass callType retType externalName args argType module fn | descriptorClass _ Smalltalk at: #ExternalFunction ifAbsent:[nil]. descriptorClass == nil ifTrue:[^0]. callType _ descriptorClass callingConventionFor: here. callType == nil ifTrue:[^0]. "Parse return type" self advance. retType _ self externalType: descriptorClass. retType == nil ifTrue:[^self expected:'return type']. "Parse function name or index" externalName _ here. (self match: #string) ifTrue:[externalName _ externalName asSymbol] ifFalse:[(self match:#number) ifFalse:[^self expected:'function name or index']]. (self matchToken:'(' asSymbol) ifFalse:[^self expected:'argument list']. args _ WriteStream on: Array new. [here == #')'] whileFalse:[ argType _ self externalType: descriptorClass. argType == nil ifTrue:[^self expected:'argument']. argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]. ]. (self matchToken:')' asSymbol) ifFalse:[^self expected:')']. (self matchToken: 'module:') ifTrue:[ module _ here. (self match: #string) ifFalse:[^self expected: 'String']. module _ module asSymbol]. Smalltalk at: #ExternalLibraryFunction ifPresent:[:xfn| fn _ xfn name: externalName module: module callType: callType returnType: retType argumentTypes: args contents. self allocateLiteral: fn. ]. ^120! ! !ScreenController methodsFor: 'menu messages' stamp: 'md 11/14/2003 17:14'! propagateChanges "The changes made in this isolated project will be propagated to projects above." CurrentProjectRefactoring currentPropagateChanges! ! !SecureHashAlgorithm methodsFor: 'public' stamp: 'md 11/14/2003 17:17'! hashInteger: aPositiveInteger seed: seedInteger "Hash the given positive integer. The integer to be hashed should have 512 or fewer bits. This entry point is used in the production of random numbers" | buffer dstIndex | "Initialize totalA through totalE to their seed values." totalA _ ThirtyTwoBitRegister new load: ((seedInteger bitShift: -128) bitAnd: 16rFFFFFFFF). totalB _ ThirtyTwoBitRegister new load: ((seedInteger bitShift: -96) bitAnd: 16rFFFFFFFF). totalC _ ThirtyTwoBitRegister new load: ((seedInteger bitShift: -64) bitAnd: 16rFFFFFFFF). totalD _ ThirtyTwoBitRegister new load: ((seedInteger bitShift: -32) bitAnd: 16rFFFFFFFF). totalE _ ThirtyTwoBitRegister new load: (seedInteger bitAnd: 16rFFFFFFFF). self initializeTotalsArray. "pad integer with zeros" buffer _ ByteArray new: 64. dstIndex _ 0. aPositiveInteger digitLength to: 1 by: -1 do: [:i | buffer at: (dstIndex _ dstIndex + 1) put: (aPositiveInteger digitAt: i)]. "process that one block" self processBuffer: buffer. ^ self finalHash ! ! !SelectionMorph methodsFor: 'halo commands' stamp: 'md 11/14/2003 17:18'! doDup: evt fromHalo: halo handle: dupHandle selectedItems _ self duplicateMorphCollection: selectedItems. selectedItems do: [:m | self owner addMorph: m]. dupDelta isNil ifTrue: ["First duplicate operation -- note starting location" dupLoc _ self position. evt hand grabMorph: self. halo removeAllHandlesBut: dupHandle] ifFalse: ["Subsequent duplicate does not grab, but only moves me and my morphs" dupLoc _ nil. self position: self position + dupDelta] ! ! !SelectorBrowser methodsFor: 'as yet unclassified' stamp: 'md 11/14/2003 17:19'! markMatchingClasses "If an example is used, mark classes matching the example instance with an asterisk." | unmarkedClassList firstPartOfSelector receiverString receiver | self flag: #mref. "allows for old-fashioned style" "Only 'example' queries can be marked." (contents asString includes: $.) ifFalse: [^ self]. unmarkedClassList _ classList copy. "Get the receiver object of the selected statement in the message list." firstPartOfSelector _ (Scanner new scanTokens: (selectorList at: selectorIndex)) second. receiverString _ (ReadStream on: (selectorList at: selectorIndex)) upToAll: firstPartOfSelector. receiver _ Compiler evaluate: receiverString. unmarkedClassList do: [ :classAndMethod | | class | (classAndMethod isKindOf: MethodReference) ifTrue: [ (receiver isKindOf: classAndMethod actualClass) ifTrue: [ classAndMethod stringVersion: '*', classAndMethod stringVersion. ] ] ifFalse: [ class _ Compiler evaluate: ((ReadStream on: classAndMethod) upToAll: firstPartOfSelector). (receiver isKindOf: class) ifTrue: [ classList add: '*', classAndMethod. classList remove: classAndMethod ] ]. ]. ! ! !SelectorBrowser methodsFor: 'as yet unclassified' stamp: 'md 11/14/2003 17:21'! selectedMessageName "Answer the name of the currently selected message." | example tokens | selectorIndex = 0 ifTrue: [^nil]. example _ selectorList at: selectorIndex. tokens _ Scanner new scanTokens: example. tokens size = 1 ifTrue: [^ tokens first]. tokens first == #'^' ifTrue: [^ nil]. (tokens second includes: $:) ifTrue: [^ example findSelector]. Symbol hasInterned: tokens second ifTrue: [:aSymbol | ^ aSymbol]. ^ nil! ! !StarSqueakMorph methodsFor: 'private-primitives' stamp: 'md 11/14/2003 17:24'! primMapFrom: srcBitmap to: dstBitmap width: w height: h patchSize: patchSize rgbFlags: rgbFlags shift: shiftAmount "Map values in the source bitmap (interpreted as unsigned 32-bit integers) to 2x2 patches of color in the destination bitmap. The color brightness level is determined by the source value and the color hue is determined by the bottom three bits of the rgbFlags value. For example, if rgbFlags is 1, you get shades of blue, if it is 6 you get shades of yellow, and if it is 7, you get shades of gray. The shiftAmount is used to scale the source data values by a power of two. If shiftAmount is zero, the data is unscaled. Positive shiftAmount values result in right shifting the source data by the given number of bits (multiplying by 2^N, negative values perform right shifts (dividing by 2^N). The width parameter gives the width of the Form that owns the destination bitmap." | rgbMult srcIndex level pixel offset | rgbMult := 0. (rgbFlags bitAnd: 4) > 0 ifTrue: [rgbMult := rgbMult + 65536]. (rgbFlags bitAnd: 2) > 0 ifTrue: [rgbMult := rgbMult + 256]. (rgbFlags bitAnd: 1) > 0 ifTrue: [rgbMult := rgbMult + 1]. srcIndex := 0. 0 to: h // patchSize - 1 do: [:y | 0 to: w // patchSize - 1 do: [:x | level := (srcBitmap at: (srcIndex := srcIndex + 1)) bitShift: shiftAmount. level _ level min: 255. pixel := level <= 0 ifTrue: ["non-transparent black" 1] ifFalse: [level * rgbMult]. "fill a patchSize x patchSize square with the pixel value" offset := (y * w + x) * patchSize. offset to: offset + ((patchSize - 1) * w) by: w do: [:rowStart | rowStart + 1 to: rowStart + patchSize do: [:dstIndex | dstBitmap at: dstIndex put: pixel]]]]! ! !StrikeFont methodsFor: 'file in/out' stamp: 'md 11/14/2003 17:25'! newFromStrike: fileName "Build an instance from the strike font file name. The '.strike' extension is optional." | strike startName raster16 | name _ fileName copyUpTo: $.. "assumes extension (if any) is '.strike'" strike _ FileStream readOnlyFileNamed: name, '.strike.'. strike binary. "strip off direcory name if any" startName _ name size. [startName > 0 and: [((name at: startName) ~= $>) & ((name at: startName) ~= $])]] whileTrue: [startName _ startName - 1]. name _ name copyFrom: startName+1 to: name size. type _ strike nextWord. "type is ignored now -- simplest assumed. Kept here to make writing and consistency more straightforward." minAscii _ strike nextWord. maxAscii _ strike nextWord. maxWidth _ strike nextWord. strikeLength _ strike nextWord. ascent _ strike nextWord. descent _ strike nextWord. "xOffset _" strike nextWord. raster16 _ strike nextWord. superscript _ ascent - descent // 3. subscript _ descent - ascent // 3. emphasis _ 0. glyphs _ Form extent: (raster16 * 16) @ (self height) offset: 0@0. glyphs bits fromByteStream: strike. xTable _ (Array new: maxAscii + 3) atAllPut: 0. (minAscii + 1 to: maxAscii + 3) do: [:index | xTable at: index put: strike nextWord]. "Set up space character" ((xTable at: (Space asciiValue + 2)) = 0 or: [(xTable at: (Space asciiValue + 2)) = (xTable at: (Space asciiValue + 1))]) ifTrue: [(Space asciiValue + 2) to: xTable size do: [:index | xTable at: index put: ((xTable at: index) + DefaultSpace)]]. strike close. characterToGlyphMap _ nil.! ! !String methodsFor: 'accessing' stamp: 'md 11/14/2003 17:26'! lineCount "Answer the number of lines represented by the receiver, where every cr adds one line. 5/10/96 sw" | cr count | cr _ Character cr. count _ 1 min: self size. 1 to: self size do: [:i | (self at: i) == cr ifTrue: [count _ count + 1]]. ^ count " 'Fred the Bear' lineCount "! ! !SuperSwikiServer methodsFor: 'testing' stamp: 'md 11/14/2003 17:28'! queryProjects: criteria | result | "SuperSwikiServer defaultSuperSwiki queryProjects: #('submittedBy: mir' )" result _ self sendToSwikiProjectServer: { 'action: findproject'. } , criteria. (result beginsWith: 'OK') ifFalse: [^self inform: result printString]. ^self parseQueryResult: (ReadStream on: result). ! ! !SuperSwikiServer methodsFor: 'for real' stamp: 'md 11/14/2003 17:28'! matchingEntries: criteria | result | eToyUserListUrl ifNil:[^self entries]. result _ self sendToSwikiProjectServer: { 'action: listmatchingprojects'. } , criteria. (result beginsWith: 'OK') ifFalse: [^self entries]. "If command not supported" ^self parseListEntries: result! ! !SystemWindow methodsFor: 'menu' stamp: 'md 11/14/2003 17:30'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. "template..." aCustomMenu addLine. aCustomMenu add: 'edit label...' translated action: #relabel. ! ! !TTCFont methodsFor: 'objects from disk' stamp: 'md 11/14/2003 17:31'! convertToCurrentVersion: varDict refStream: smartRefStrm "If we're reading in an old version with a pixelSize instance variable, convert it to a point size" "Deal with the change from pixelSize to pointSize, assuming 96 dpi." varDict at: 'pixelSize' ifPresent: [ :x | pointSize _ x * 72 / 96. ]. ^super convertToCurrentVersion: varDict refStream: smartRefStrm.! ! !TextFieldMorph class methodsFor: 'scripting' stamp: 'md 11/14/2003 17:32'! authoringPrototype "Answer an instance of the receiver that can serve as a prototype for authoring" | proto | proto _ super authoringPrototype. proto setProperty: #shared toValue: true. proto extent: 170 @ 30. proto color: Color veryLightGray lighter. proto contents: 'on a clear day you can...'. ^ proto ! ! !TheWorldMenu methodsFor: 'commands' stamp: 'md 11/14/2003 17:33'! propagateChanges "The changes made in this isolated project will be propagated to projects above." self projectForMyWorld propagateChanges.! ! !Utilities class methodsFor: 'miscellaneous' stamp: 'md 11/14/2003 18:02'! methodDiffFor: aString class: aClass selector: aSelector prettyDiffs: prettyDiffBoolean "Return a string comprising a source-code diff between an existing method and the source-code in aString. DO prettyDiff if prettyDiffBoolean is true." ^ (aClass notNil and: [aClass includesSelector: aSelector]) ifTrue: [TextDiffBuilder buildDisplayPatchFrom: (aClass sourceCodeAt: aSelector) to: aString inClass: aClass prettyDiffs: prettyDiffBoolean] ifFalse: [aString copy]! !