[squeak-dev] The Inbox: ST80-mt.286.mczcommits at source.squeak.org commits at source.squeak.orgThu Jul 14 14:11:40 UTC 2022
A new version of ST80 was added to project The Inbox: http://source.squeak.org/inbox/ST80-mt.286.mcz ==================== Summary ==================== Name: ST80-mt.286 Author: mt Time: 16 June 2022, 3:48:33.456458 pm UUID: c94219e0-1984-3e44-9047-c0489059f14b Ancestors: ST80-ct.285 Makes some tests more robust against scale factors > 100% =============== Diff against ST80-ct.285 =============== Item was removed: - SystemOrganization addCategory: #'ST80-Controllers'! - SystemOrganization addCategory: #'ST80-Editors'! - SystemOrganization addCategory: #'ST80-Framework'! - SystemOrganization addCategory: #'ST80-Menus'! - SystemOrganization addCategory: #'ST80-Menus-Tests'! - SystemOrganization addCategory: #'ST80-Paths'! - SystemOrganization addCategory: #'ST80-Pluggable Views'! - SystemOrganization addCategory: #'ST80-Support'! - SystemOrganization addCategory: #'ST80-Support-Tests'! - SystemOrganization addCategory: #'ST80-Symbols'! - SystemOrganization addCategory: #'ST80-Views'! Item was removed: - Path subclass: #Arc - instanceVariableNames: 'quadrant radius center numberOfVertices' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Paths'! - - !Arc commentStamp: '<historical>' prior: 0! - Arcs are an unusual implementation of splines due to Ted Kaehler. Imagine two lines that meet at a corner. Now imagine two moving points; one moves from the corner to the end on one line, the other moves from the end of the other line in to the corner. Now imagine a series of lines drawn between those moving points at each step along the way (they form a sort of spider web pattern). By connecting segments of the intersecting lines, a smooth curve is achieved that is tangent to both of the original lines. Voila.! Item was removed: - ----- Method: Arc class>>center:radius:quadrant: (in category 'instance creation') ----- - center: aPoint radius: anInteger quadrant: section - - ^ self new - center: aPoint radius: anInteger quadrant: section; - yourself! Item was removed: - ----- Method: Arc class>>example (in category 'examples') ----- - example - "Click the button somewhere on the screen. The designated point will - be the center of an Arc with radius 50 in the 4th quadrant." - - | anArc aForm | - aForm := Form extent: 1 @ 30. "make a long thin Form for display" - aForm fillBlack. "turn it black" - anArc := Arc new. - anArc form: aForm. "set the form for display" - anArc radius: 50.0. - anArc center: Sensor waitButton. - anArc quadrant: 4. - anArc displayOn: Display. - Sensor waitButton - - "Arc example"! Item was removed: - ----- Method: Arc>>center (in category 'accessing') ----- - center - "Answer the point at the center of the receiver." - - ^center! Item was removed: - ----- Method: Arc>>center: (in category 'accessing') ----- - center: aPoint - "Set aPoint to be the receiver's center." - - center := aPoint! Item was removed: - ----- Method: Arc>>center:radius: (in category 'accessing') ----- - center: aPoint radius: anInteger - "The receiver is defined by a point at the center and a radius. The - quadrant is not reset." - - center := aPoint. - radius := anInteger! Item was removed: - ----- Method: Arc>>center:radius:quadrant: (in category 'accessing') ----- - center: aPoint radius: anInteger quadrant: section - "Set the receiver's quadrant to be the argument, section. The size of the - receiver is defined by the center and its radius." - - center := aPoint. - radius := anInteger. - quadrant := section! Item was removed: - ----- Method: Arc>>computeBoundingBox (in category 'display box access') ----- - computeBoundingBox - | aRectangle aPoint | - aRectangle := center - radius + form offset extent: form extent + (radius * 2) asPoint. - aPoint := center + form extent. - quadrant = 1 ifTrue: [^ aRectangle encompass: center x @ aPoint y]. - quadrant = 2 ifTrue: [^ aRectangle encompass: aPoint x @ aPoint y]. - quadrant = 3 ifTrue: [^ aRectangle encompass: aPoint x @ center y]. - quadrant = 4 ifTrue: [^ aRectangle encompass: center x @ center y]! Item was removed: - ----- Method: Arc>>computeVertices: (in category 'displaying') ----- - computeVertices: size - - | dAngle dSin dCos point | - dAngle := (90 / (size - 1)) degreesToRadians. - dSin := dAngle sin. - dCos := dAngle cos. - point := (1 to: quadrant) - inject: 0 @ radius - into: [:p :i | p leftRotated]. - ^ (OrderedCollection new: size) - add: (center + point) rounded; - addAll: ((2 to: size) collect: [:i | - point := point * dCos + (point * dSin) leftRotated. - (center + point) rounded]); - yourself! Item was removed: - ----- Method: Arc>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger fillColor: aForm - - | line | - line := Line new. - line form: self form. - (self computeVertices: self numberOfVertices) overlappingPairsDo: [:start :dest | - line - beginPoint: start; - endPoint: dest; - displayOn: aDisplayMedium - at: aPoint - clippingBox: clipRect - rule: anInteger - fillColor: aForm]! Item was removed: - ----- Method: Arc>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm - - | newArc tempCenter | - newArc := Arc new. - tempCenter := aTransformation applyTo: self center. - newArc center: tempCenter x asInteger @ tempCenter y asInteger. - newArc quadrant: self quadrant. - newArc radius: (self radius * aTransformation scale x) asInteger. - newArc form: self form. - newArc - displayOn: aDisplayMedium - at: 0 @ 0 - clippingBox: clipRect - rule: anInteger - fillColor: aForm! Item was removed: - ----- Method: Arc>>numberOfVertices (in category 'accessing') ----- - numberOfVertices - - ^ numberOfVertices ifNil: [12]! Item was removed: - ----- Method: Arc>>numberOfVertices: (in category 'accessing') ----- - numberOfVertices: anInteger - - numberOfVertices := anInteger.! Item was removed: - ----- Method: Arc>>quadrant (in category 'accessing') ----- - quadrant - "Answer the part of the circle represented by the receiver." - ^quadrant! Item was removed: - ----- Method: Arc>>quadrant: (in category 'accessing') ----- - quadrant: section - "Set the part of the circle represented by the receiver to be the argument, - section." - - quadrant := section! Item was removed: - ----- Method: Arc>>radius (in category 'accessing') ----- - radius - "Answer the receiver's radius." - - ^radius! Item was removed: - ----- Method: Arc>>radius: (in category 'accessing') ----- - radius: anInteger - "Set the receiver's radius to be the argument, anInteger." - - radius := anInteger! Item was removed: - ----- Method: BitBltDisplayScanner>>displayLines:in:clippedBy: (in category '*ST80-Support') ----- - displayLines: linesInterval in: aParagraph clippedBy: visibleRectangle - "The central display routine. The call on the primitive - (scanCharactersFrom:to:in:rightX:) will be interrupted according to an - array of stop conditions passed to the scanner at which time the code to - handle the stop condition is run and the call on the primitive continued - until a stop condition returns true (which means the line has - terminated)." - | leftInRun | - "leftInRun is the # of characters left to scan in the current run; - when 0, it is time to call 'self setStopConditions'" - morphicOffset := 0 at 0. - leftInRun := 0. - self initializeFromParagraph: aParagraph clippedBy: visibleRectangle. - ignoreColorChanges := false. - foregroundColor := defaultTextColor := aParagraph foregroundColor. - backgroundColor := aParagraph backgroundColor. - aParagraph backgroundColor isTransparent - ifTrue: [fillBlt := nil] - ifFalse: [fillBlt := bitBlt copy. "Blt to fill spaces, tabs, margins" - fillBlt sourceForm: nil; sourceOrigin: 0 at 0. - fillBlt fillColor: aParagraph backgroundColor]. - rightMargin := aParagraph rightMarginForDisplay. - lineY := aParagraph topAtLineIndex: linesInterval first. - bitBlt destForm deferUpdatesIn: visibleRectangle while: [ - linesInterval do: - [:lineIndex | - | string startIndex lastPos runLength stopCondition baselineY lineHeight stop | - line := aParagraph lines at: lineIndex. - lastDisplayableIndex := lastIndex := line first. - leftInRun <= 0 - ifTrue: [self setStopConditions. "also sets the font, alignment and emphasisCode" - leftInRun := text runLengthFor: line first]. - leftMargin := aParagraph leftMarginForDisplayForLine: lineIndex alignment: alignment. - destX := leftMargin. - lineHeight := line lineHeight. - fillBlt == nil ifFalse: - [fillBlt destX: visibleRectangle left destY: lineY - width: visibleRectangle width height: lineHeight; copyBits]. - baselineY := lineY + line baseline. - destY := baselineY - font ascent. "Should have happened in setFont" - runLength := leftInRun. - runStopIndex := lastIndex + (runLength - 1) min: line last. - leftInRun := leftInRun - (runStopIndex - lastIndex + 1). - spaceCount := 0. - string := text string. - self handleIndentation. - [ - "Reset the stopping conditions of this displaying loop, and also the font." - stopConditionsMustBeReset - ifTrue:[self setStopConditions]. - startIndex := lastIndex. - lastPos := destX at destY. - stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex - in: string rightX: rightMargin. - stop := self perform: stopCondition. - lastDisplayableIndex >= startIndex ifTrue:[ - font displayString: string on: bitBlt - from: startIndex to: lastDisplayableIndex at: lastPos kern: kern]. - stop - ] whileFalse. - fillBlt == nil ifFalse: - [fillBlt destX: destX destY: lineY width: visibleRectangle right-destX height: lineHeight; copyBits]. - lineY := lineY + lineHeight]]! Item was removed: - ----- Method: BitBltDisplayScanner>>initializeFromParagraph:clippedBy: (in category '*ST80-Support') ----- - initializeFromParagraph: aParagraph clippedBy: clippingRectangle - - super initializeFromParagraph: aParagraph clippedBy: clippingRectangle. - bitBlt := BitBlt asGrafPort toForm: aParagraph destinationForm. - bitBlt sourceX: 0; width: 0. "Init BitBlt so that the first call to a primitive will not fail" - bitBlt combinationRule: - ((Display depth = 1) - ifTrue: - [aParagraph rule] - ifFalse: - [Form paint]). - bitBlt colorMap: - (Bitmap with: 0 "Assumes 1-bit deep fonts" - with: (bitBlt destForm pixelValueFor: aParagraph foregroundColor)). - bitBlt clipRect: clippingRectangle! Item was removed: - MouseMenuController subclass: #BitEditor - instanceVariableNames: 'scale squareForm color transparent' - classVariableNames: 'YellowButtonMenu' - poolDictionaries: '' - category: 'ST80-Editors'! - - !BitEditor commentStamp: '<historical>' prior: 0! - I am a bit-magnifying tool for editing small Forms directly on the display screen. I continue to be active until the user points outside of my viewing area.! Item was removed: - ----- Method: BitEditor class>>bitEdit:at:scale:remoteView: (in category 'private') ----- - bitEdit: aForm at: magnifiedFormLocation scale: scaleFactor remoteView: remoteView - "Create a BitEditor on aForm. That is, aForm is a small image that will - change as a result of the BitEditor changing a second and magnified - view of me. magnifiedFormLocation is where the magnified form is to be - located on the screen. scaleFactor is the amount of magnification. This - method implements a scheduled view containing both a small and - magnified view of aForm. Upon accept, aForm is updated." - - | aFormView scaledFormView bitEditor topView extent menuView lowerRightExtent | - scaledFormView := FormHolderView new model: aForm. - scaledFormView scaleBy: scaleFactor. - bitEditor := self new. - scaledFormView controller: bitEditor. - bitEditor setColor: Color black. - topView := ColorSystemView new. - remoteView == nil ifTrue: [topView label: 'Bit Editor']. - topView borderWidth: 2. - - topView addSubView: scaledFormView. - remoteView == nil - ifTrue: "If no remote view, then provide a local view of the form" - [aFormView := FormView new model: scaledFormView workingForm. - aFormView controller: NoController new. - aForm height < 50 - ifTrue: [aFormView borderWidthLeft: 0 right: 2 top: 2 bottom: 2] - ifFalse: [aFormView borderWidthLeft: 0 right: 2 top: 2 bottom: 0]. - topView addSubView: aFormView below: scaledFormView] - ifFalse: "Otherwise, the remote one should view the same form" - [remoteView model: scaledFormView workingForm]. - lowerRightExtent := remoteView == nil - ifTrue: - [(scaledFormView viewport width - aFormView viewport width) @ - (aFormView viewport height max: 50)] - ifFalse: - [scaledFormView viewport width @ 50]. - menuView := self buildColorMenu: lowerRightExtent colorCount: 1. - menuView model: bitEditor. - menuView borderWidthLeft: 0 right: 0 top: 2 bottom: 0. - topView - addSubView: menuView - align: menuView viewport topRight - with: scaledFormView viewport bottomRight. - extent := scaledFormView viewport extent + (0 @ lowerRightExtent y) - + (4 @ 4). "+4 for borders" - topView minimumSize: extent. - topView maximumSize: extent. - topView translateBy: magnifiedFormLocation. - topView insideColor: Color white. - ^topView! Item was removed: - ----- Method: BitEditor class>>buildColorMenu:colorCount: (in category 'private') ----- - buildColorMenu: extent colorCount: nColors - "See BitEditor magnifyWithSmall." - - | menuView form aSwitchView - button formExtent highlightForm color leftOffset | - menuView := FormMenuView new. - menuView window: (0 at 0 corner: extent). - formExtent := 30 at 30 min: extent//(nColors*2+1 at 2). "compute this better" - leftOffset := extent x-(nColors*2-1*formExtent x)//2. - highlightForm := Form extent: formExtent. - highlightForm borderWidth: 4. - 1 to: nColors do: [:index | - color := (nColors = 1 - ifTrue: [#(black)] - ifFalse: [#(black gray)]) at: index. - form := Form extent: formExtent. - form fill: form boundingBox fillColor: (Color perform: color). - form borderWidth: 5. - form border: form boundingBox width: 4 fillColor: Color white. - button := Button new. - aSwitchView := PluggableButtonView - on: button - getState: #isOn - action: #turnOn - label: #getCurrentColor. - - index = 1 - ifTrue: [button onAction: [menuView model setColor: Color fromUser. - aSwitchView label: menuView model getCurrentColor; - displayView - ] - ] - ifFalse: [button onAction: [menuView model setTransparentColor]]. - - aSwitchView - shortcutCharacter: ((nColors=3 ifTrue: ['xvn'] ifFalse: ['xn']) at: index); - label: form; - window: (0 at 0 extent: form extent); - translateBy: (((index - 1) * 2 * form width) + leftOffset)@(form height // 2); - borderWidth: 1. - menuView addSubView: aSwitchView]. - ^ menuView - ! Item was removed: - ----- Method: BitEditor class>>initialize (in category 'class initialization') ----- - initialize - "The Bit Editor is the only controller to override the use of the blue - button with a different pop-up menu. Initialize this menu." - - YellowButtonMenu := SelectionMenu - labels: - 'cancel - accept - file out - test' - lines: #(2 3) - selections: #(cancel accept fileOut test) - - "BitEditor initialize"! Item was removed: - ----- Method: BitEditor class>>magnifyOnScreen (in category 'examples') ----- - magnifyOnScreen - "Bit editing of an area of the display screen. User designates a - rectangular area that is magnified by 8 to allow individual screens dots to - be modified. red button is used to set a bit to black and yellow button is - used to set a bit to white. Editor is not scheduled in a view. Original - screen location is updated immediately. This is the same as FormEditor - magnify." - | smallRect smallForm scaleFactor tempRect | - scaleFactor := 8 @ 8. - smallRect := Rectangle fromUser. - smallRect isNil ifTrue: [^self]. - smallForm := Form fromDisplay: smallRect. - tempRect := Rectangle locateMagnifiedView: smallForm scale: scaleFactor. - "show magnified form size until mouse is depressed" - self - openScreenViewOnForm: smallForm - at: smallRect topLeft - magnifiedAt: tempRect topLeft - scale: scaleFactor - - "BitEditor magnifyOnScreen."! Item was removed: - ----- Method: BitEditor class>>magnifyWithSmall (in category 'examples') ----- - magnifyWithSmall - " Also try: - BitEditor openOnForm: - (Form extent: 32 at 32 depth: Display depth) - BitEditor openOnForm: - ((MaskedForm extent: 32 at 32 depth: Display depth) - withTransparentPixelValue: -1) - " - "Open a BitEditor viewing an area on the screen which the user chooses" - | area form | - area := Rectangle fromUser. - area isNil ifTrue: [^ self]. - form := Form fromDisplay: area. - self openOnForm: form - - "BitEditor magnifyWithSmall."! Item was removed: - ----- Method: BitEditor class>>openOnForm: (in category 'instance creation') ----- - openOnForm: aForm - "Create and schedule a BitEditor on the form aForm at its top left corner. - Show the small and magnified view of aForm." - - | scaleFactor | - scaleFactor := 8 @ 8. - ^self openOnForm: aForm - at: (Rectangle locateMagnifiedView: aForm scale: scaleFactor) topLeft - scale: scaleFactor! Item was removed: - ----- Method: BitEditor class>>openOnForm:at: (in category 'instance creation') ----- - openOnForm: aForm at: magnifiedLocation - "Create and schedule a BitEditor on the form aForm at magnifiedLocation. - Show the small and magnified view of aForm." - - ^self openOnForm: aForm - at: magnifiedLocation - scale: 8 @ 8! Item was removed: - ----- Method: BitEditor class>>openOnForm:at:scale: (in category 'instance creation') ----- - openOnForm: aForm at: magnifiedLocation scale: scaleFactor - "Create and schedule a BitEditor on the form aForm. Show the small and - magnified view of aForm." - - | aScheduledView | - aScheduledView := self - bitEdit: aForm - at: magnifiedLocation - scale: scaleFactor - remoteView: nil. - aScheduledView controller openDisplayAt: - aScheduledView displayBox topLeft + (aScheduledView displayBox extent / 2)! Item was removed: - ----- Method: BitEditor class>>openScreenViewOnForm:at:magnifiedAt:scale: (in category 'instance creation') ----- - openScreenViewOnForm: aForm at: formLocation magnifiedAt: magnifiedLocation scale: scaleFactor - "Create and schedule a BitEditor on the form aForm. Show the magnified - view of aForm in a scheduled window." - | smallFormView bitEditor savedForm r | - smallFormView := FormView new model: aForm. - smallFormView align: smallFormView viewport topLeft with: formLocation. - bitEditor := self bitEdit: aForm at: magnifiedLocation scale: scaleFactor remoteView: smallFormView. - savedForm := Form fromDisplay: (r := bitEditor displayBox expandBy: (0 at 23 corner: 0 at 0)). - bitEditor controller startUp. - savedForm displayOn: Display at: r topLeft. - bitEditor release. - smallFormView release. - - "BitEditor magnifyOnScreen."! Item was removed: - ----- Method: BitEditor>>accept (in category 'menu messages') ----- - accept - "The edited information should now be accepted by the view." - - view accept! Item was removed: - ----- Method: BitEditor>>cancel (in category 'menu messages') ----- - cancel - "The edited informatin should be forgotten by the view." - - view cancel! Item was removed: - ----- Method: BitEditor>>controlInitialize (in category 'basic control sequence') ----- - controlInitialize - - super controlInitialize. - Cursor crossHair show! Item was removed: - ----- Method: BitEditor>>controlTerminate (in category 'basic control sequence') ----- - controlTerminate - - Cursor normal show! Item was removed: - ----- Method: BitEditor>>fileOut (in category 'menu messages') ----- - fileOut - - | fileName | - fileName := UIManager default - saveFilenameRequest: 'Save this Form to' translated - initialAnswer: 'Filename.form'. - fileName ifNil: [^ self]. - Cursor normal - showWhile: [model writeOnFileNamed: fileName]. - ! Item was removed: - ----- Method: BitEditor>>getCurrentColor (in category 'menu messages') ----- - getCurrentColor - | formExtent form c | - c := Color colorFromPixelValue: color depth: Display depth. - formExtent := 30 at 30" min: 10@ 10//(2+1 at 2)". "compute this better" - form := Form extent: formExtent depth: Display depth. - form borderWidth: 5. - form border: form boundingBox width: 4 fillColor: Color white. - form fill: form boundingBox fillColor: c. - - ^form! Item was removed: - ----- Method: BitEditor>>getPluggableYellowButtonMenu: (in category 'pluggable menus') ----- - getPluggableYellowButtonMenu: shiftKeyState - ^ YellowButtonMenu! Item was removed: - ----- Method: BitEditor>>isControlActive (in category 'control defaults') ----- - isControlActive - ^ super isControlActive and: [sensor keyboardPressed not]! Item was removed: - ----- Method: BitEditor>>redButtonActivity (in category 'control defaults') ----- - redButtonActivity - | formPoint displayPoint | - model depth = 1 ifTrue: - ["If this is just a black&white form, then set the color to be - the opposite of what it was where the mouse was clicked" - formPoint := (view inverseDisplayTransform: sensor cursorPoint - (scale//2)) rounded. - color := 1-(view workingForm pixelValueAt: formPoint). - squareForm fillColor: (color=1 ifTrue: [Color black] ifFalse: [Color white])]. - [sensor redButtonPressed] - whileTrue: - [formPoint := (view inverseDisplayTransform: sensor cursorPoint - (scale//2)) rounded. - displayPoint := view displayTransform: formPoint. - squareForm - displayOn: Display - at: displayPoint - clippingBox: view insetDisplayBox - rule: Form over - fillColor: nil. - view changeValueAt: formPoint put: color]! Item was removed: - ----- Method: BitEditor>>release (in category 'initialize-release') ----- - release - - super release. - squareForm release. - squareForm := nil! Item was removed: - ----- Method: BitEditor>>setColor: (in category 'menu messages') ----- - setColor: aColor - "Set the color that the next edited dots of the model to be the argument, - aSymbol. aSymbol can be any color changing message understood by a - Form, such as white or black." - - color := aColor pixelValueForDepth: Display depth. - squareForm fillColor: aColor. - self changed: #getCurrentColor! Item was removed: - ----- Method: BitEditor>>setTransparentColor (in category 'menu messages') ----- - setTransparentColor - squareForm fillColor: Color gray. - color := Color transparent! Item was removed: - ----- Method: BitEditor>>test (in category 'menu messages') ----- - test - view workingForm follow: [Sensor cursorPoint] while: [Sensor noButtonPressed]. - Sensor waitNoButton! Item was removed: - ----- Method: BitEditor>>view: (in category 'view access') ----- - view: aView - - super view: aView. - scale := aView transformation scale. - scale := scale x rounded @ scale y rounded. - squareForm := Form extent: scale depth: aView model depth. - squareForm fillBlack! Item was removed: - Switch subclass: #Button - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Menus'! - - !Button commentStamp: '<historical>' prior: 0! - I am a Switch that turns off automatically after being turned on, that is, I act like a push-button switch.! Item was removed: - ----- Method: Button class>>newOn (in category 'instance creation') ----- - newOn - "Refer to the comment in Switch|newOn." - - self error: 'Buttons cannot be created in the on state'. - ^nil! Item was removed: - ----- Method: Button>>turnOff (in category 'state') ----- - turnOff - "Sets the state of the receiver to 'off'. The off action of the receiver is not - executed." - - on := false! Item was removed: - ----- Method: Button>>turnOn (in category 'state') ----- - turnOn - "The receiver remains in the 'off' state'." - - self doAction: onAction. - self doAction: offAction! Item was removed: - CharacterBlockScanner subclass: #CharacterBlockScannerForMVC - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Support'! - - !CharacterBlockScannerForMVC commentStamp: 'nice 10/6/2013 22:09' prior: 0! - A CharacterBlockScannerForMVC is specialization of a CharacterBlockScanner used for compatibility with Smalltalk-80 Model View Controller framework. - ! Item was removed: - ----- Method: CharacterBlockScannerForMVC>>buildCharacterBlockIn: (in category 'private') ----- - buildCharacterBlockIn: para - "This method is used by the MVC version only." - - | lineIndex runLength lineStop stopCondition | - "handle nullText" - (para numberOfLines = 0 or: [text size = 0]) - ifTrue: [^ CharacterBlock new stringIndex: 1 "like being off end of string" - text: para text - topLeft: (para leftMarginForDisplayForLine: 1 alignment: (alignment ifNil:[textStyle alignment])) - @ para compositionRectangle top - extent: 0 @ textStyle lineGrid]. - "find the line" - lineIndex := para lineIndexOfTop: characterPoint y. - destY := para topAtLineIndex: lineIndex. - line := para lines at: lineIndex. - lastIndex := line first. - rightMargin := para rightMarginForDisplay. - self setStopConditions. " also loads the font, alignment and all emphasis attributes " - - (lineIndex = para numberOfLines and: - [(destY + line lineHeight) < characterPoint y]) - ifTrue: ["if beyond lastLine, force search to last character" - self characterPointSetX: rightMargin] - ifFalse: [characterPoint y < (para compositionRectangle) top - ifTrue: ["force search to first line" - characterPoint := (para compositionRectangle) topLeft]. - characterPoint x > rightMargin - ifTrue: [self characterPointSetX: rightMargin]]. - destX := leftMargin := para leftMarginForDisplayForLine: lineIndex alignment: alignment. - nextLeftMargin:= para leftMarginForDisplayForLine: lineIndex+1 alignment: alignment. - runLength := text runLengthFor: line first. - lineStop := characterIndex "scanning for index" - ifNil: [ line last ]. "scanning for point" - runStopIndex := lastIndex + (runLength - 1) min: lineStop. - lastCharacterWidth := 0. - spaceCount := 0. - self handleIndentation. - - [stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex - in: text string rightX: characterPoint x. - "see setStopConditions for stopping conditions for character block operations." - self perform: stopCondition] whileFalse. - - ^characterIndex == nil - ifTrue: ["characterBlockAtPoint" - ^ CharacterBlock new stringIndex: lastIndex text: text - topLeft: characterPoint + (font descentKern @ 0) - extent: lastCharacterWidth @ line lineHeight] - ifFalse: ["characterBlockForIndex" - ^ CharacterBlock new stringIndex: lastIndex text: text - topLeft: characterPoint + ((font descentKern) - kern @ 0) - extent: lastCharacterWidth @ line lineHeight]! Item was removed: - ----- Method: CharacterBlockScannerForMVC>>characterBlockAtPoint:in: (in category 'scanning') ----- - characterBlockAtPoint: aPoint in: aParagraph - "Answer a CharacterBlock for character in aParagraph at point aPoint. It - is assumed that aPoint has been transformed into coordinates appropriate - to the text's destination form rectangle and the composition rectangle." - - self initializeFromParagraph: aParagraph clippedBy: aParagraph clippingRectangle. - characterPoint := aPoint. - ^self buildCharacterBlockIn: aParagraph! Item was removed: - ----- Method: CharacterBlockScannerForMVC>>characterBlockForIndex:in: (in category 'scanning') ----- - characterBlockForIndex: targetIndex in: aParagraph - "Answer a CharacterBlock for character in aParagraph at targetIndex. The - coordinates in the CharacterBlock will be appropriate to the intersection - of the destination form rectangle and the composition rectangle." - - self - initializeFromParagraph: aParagraph - clippedBy: aParagraph clippingRectangle. - characterIndex := targetIndex. - characterPoint := - aParagraph rightMarginForDisplay @ - (aParagraph topAtLineIndex: - (aParagraph lineIndexOfCharacterIndex: characterIndex)). - ^self buildCharacterBlockIn: aParagraph! Item was removed: - ----- Method: CharacterBlockScannerForMVC>>characterPointSetX: (in category 'private') ----- - characterPointSetX: xVal - characterPoint := xVal @ characterPoint y! Item was removed: - ----- Method: CharacterBlockScannerForMVC>>crossedX (in category 'stop conditions') ----- - crossedX - characterIndex == nil ifFalse: [ - "If the last character of the last line is a space, - and it crosses the right margin, then locating - the character block after it is impossible without this hack." - characterIndex > text size ifTrue: [ - lastIndex := characterIndex. - characterPoint := (nextLeftMargin ifNil: [leftMargin]) @ (destY + line lineHeight). - ^true]]. - ^super crossedX! Item was removed: - ----- Method: CharacterScanner>>initializeFromParagraph:clippedBy: (in category '*ST80-Support') ----- - initializeFromParagraph: aParagraph clippedBy: clippingRectangle - - text := aParagraph text. - textStyle := aParagraph textStyle. - ! Item was removed: - Arc subclass: #Circle - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Paths'! - - !Circle commentStamp: '<historical>' prior: 0! - I represent a full circle. I am made from four Arcs.! Item was removed: - ----- Method: Circle class>>exampleOne (in category 'examples') ----- - exampleOne - "Click any button somewhere on the screen. The point will be the center - of the circcle of radius 150." - - | aCircle aForm | - aForm := Form extent: 1 at 30. - aForm fillBlack. - aCircle := Circle new. - aCircle form: aForm. - aCircle radius: 150. - aCircle center: Sensor waitButton. - aCircle displayOn: Display - - "Circle exampleOne"! Item was removed: - ----- Method: Circle class>>exampleTwo (in category 'examples') ----- - exampleTwo - "Designate a rectangular area that should be used as the brush for - displaying the circle. Click any button at a point on the screen which - will be the center location for the circle. The curve will be displayed - with a long black form." - - | aCircle aForm | - aForm := Form fromUser. - aCircle := Circle new. - aCircle form: aForm. - aCircle radius: 150. - aCircle center: Sensor waitButton. - aCircle displayOn: Display at: 0 @ 0 rule: Form reverse - - "Circle exampleTwo"! Item was removed: - ----- Method: Circle>>computeBoundingBox (in category 'display box access') ----- - computeBoundingBox - - ^center - radius + form offset extent: form extent + (radius * 2) asPoint! Item was removed: - ----- Method: Circle>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger fillColor: aForm - - 1 to: 4 do: - [:i | - super quadrant: i. - super displayOn: aDisplayMedium - at: aPoint - clippingBox: clipRect - rule: anInteger - fillColor: aForm]! Item was removed: - ----- Method: Circle>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm - - 1 to: 4 do: - [:i | - super quadrant: i. - super displayOn: aDisplayMedium - transformation: aTransformation - clippingBox: clipRect - rule: anInteger - fillColor: aForm]! Item was removed: - StandardSystemView subclass: #ColorSystemView - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Support'! Item was removed: - ----- Method: ColorSystemView>>displayDeEmphasized (in category 'displaying') ----- - displayDeEmphasized - "Display this view with emphasis off. - If windowBits is not nil, then simply BLT if possible." - bitsValid - ifTrue: [self lock. - windowBits displayAt: self windowOrigin] - ifFalse: [super displayDeEmphasized] - ! Item was removed: - ----- Method: CompositionScanner>>composeLine:fromCharacterIndex:inParagraph: (in category '*ST80-Support') ----- - composeLine: lineIndex fromCharacterIndex: startIndex inParagraph: aParagraph - "Answer an instance of TextLineInterval that represents the next line in the paragraph." - | runLength stopCondition | - destX := spaceX := leftMargin := aParagraph leftMarginForCompositionForLine: lineIndex. - destY := 0. - rightMargin := aParagraph rightMarginForComposition. - leftMargin >= rightMargin ifTrue: [self error: 'No room between margins to compose']. - lastIndex := startIndex. "scanning sets last index" - lineHeight := baseline := 0. "Will be increased by setFont" - lineGap := lineGapSlice := -9999. "Will be increased by setFont; allow negative to show all effects of a custom #extraGap value. See TTFontDescription." - topMargin := bottomMargin := 0. - self setStopConditions. "also sets font" - self handleIndentation. - runLength := text runLengthFor: startIndex. - runStopIndex := (lastIndex := startIndex) + (runLength - 1). - line := TextLineInterval - start: lastIndex - stop: 0 - internalSpaces: 0 - paddingWidth: 0. - nextIndexAfterLineBreak := spaceCount := 0. - lastBreakIsNotASpace := false. - - [stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex - in: text string rightX: rightMargin. - "See setStopConditions for stopping conditions for composing." - self perform: stopCondition] whileFalse. - - self flag: #margins. "mt: Note that this path does not support #lineSpacing because ST80's text views do not use TextComposer but TextLineInterval and their own legacy Paragraph class." - - ^ line - lineHeight: lineHeight + lineGap - baseline: baseline + lineGapSlice! Item was removed: - ----- Method: CompositionScanner>>forParagraph: (in category '*ST80-Support') ----- - forParagraph: aParagraph - "Initialize the receiver for scanning the given paragraph." - - self - initializeFromParagraph: aParagraph - clippedBy: aParagraph clippingRectangle. - ! Item was removed: - Object subclass: #ControlManager - instanceVariableNames: 'scheduledControllers activeController activeControllerProcess screenController newTopClicked' - classVariableNames: 'DeferredActionQueue' - poolDictionaries: '' - category: 'ST80-Controllers'! - - !ControlManager commentStamp: '<historical>' prior: 0! - I represent the top level control over scheduling which controller of a view on the screen the user is actively using. ScheduledControllers is the global reference to an instance of me, the one attached to the Project currently being used.! Item was removed: - ----- Method: ControlManager class>>addDeferredUIMessage: (in category 'class initialization') ----- - addDeferredUIMessage: valuableObject - "Arrange for valuableObject to be evaluated the next time the controlActivity in any controller becomes active." - - self deferredActionQueue nextPut: valuableObject.! Item was removed: - ----- Method: ControlManager class>>deferredActionQueue (in category 'class initialization') ----- - deferredActionQueue - - ^DeferredActionQueue ifNil: [DeferredActionQueue := SharedQueue new]! Item was removed: - ----- Method: ControlManager class>>lastDeferredUIMessage (in category 'class initialization') ----- - lastDeferredUIMessage - "Answer the most recently scheduled deferredUIMessage." - - ^self deferredActionQueue peekLast! Item was removed: - ----- Method: ControlManager class>>newScheduler: (in category 'exchange') ----- - newScheduler: controlManager - "When switching projects, the control scheduler has to be exchanged. The - active one is the one associated with the current project." - - Smalltalk at: #ScheduledControllers put: controlManager. - ScheduledControllers restore. - controlManager searchForActiveController! Item was removed: - ----- Method: ControlManager>>activateController: (in category 'scheduling') ----- - activateController: aController - "Make aController, which must already be a scheduled controller, the active window. 5/8/96 sw" - - self activeController: aController. - (activeController view labelDisplayBox - intersect: Display boundingBox) area < 200 - ifTrue: [activeController move]. - Processor terminateActive! Item was removed: - ----- Method: ControlManager>>activateTranscript (in category 'scheduling') ----- - activateTranscript - "There is known to be a Transcript open in the current project; activate it. 2/5/96 sw" - - | itsController | - itsController := scheduledControllers detect: - [:controller | controller model == Transcript] - ifNone: - [^ self]. - - self activeController: itsController. - (activeController view labelDisplayBox - intersect: Display boundingBox) area < 200 - ifTrue: [activeController move]. - Processor terminateActive! Item was removed: - ----- Method: ControlManager>>activeController (in category 'accessing') ----- - activeController - "Answer the currently active controller." - - ^activeController! Item was removed: - ----- Method: ControlManager>>activeController: (in category 'accessing') ----- - activeController: aController - "Set aController to be the currently active controller. Give the user - control in it." - <primitive: 19> "Simulation guard" - activeController := aController. - (activeController == screenController) - ifFalse: [self promote: activeController]. - activeControllerProcess := - [activeController startUp. - self searchForActiveController] newProcess. - activeControllerProcess priority: Processor userSchedulingPriority. - activeControllerProcess resume! Item was removed: - ----- Method: ControlManager>>activeController:andProcess: (in category 'accessing') ----- - activeController: aController andProcess: aProcess - "Set aController to be the currently active controller and aProcess to be the the process that handles controller scheduling activities in the system. ndProcess: in that it - does not send controlTerminate to the currently active controller." - - self inActiveControllerProcess - ifTrue: [ - aController ifNotNil: [:c | - (scheduledControllers includes: c) - ifTrue: [self promote: c] - ifFalse: [self error: 'Old controller not scheduled']]. - activeController ifNotNil: [:c | c controlTerminate]. - activeController := aController. - activeController ifNotNil: [:c | c controlInitialize]. - - aProcess resume. - - activeController - ifNil: [self searchForActiveController] - ifNotNil: [ - "Assume that given controller matches the process." - activeControllerProcess := aProcess. - Processor terminateActive]] - ifFalse: - [self error: 'New active controller process must be set from old one'] ! Item was removed: - ----- Method: ControlManager>>activeControllerNoTerminate:andProcess: (in category 'accessing') ----- - activeControllerNoTerminate: aController andProcess: aProcess - "Set aController to be the currently active controller and aProcess to be - the the process that handles controller scheduling activities in the - system. This message differs from activeController:andProcess: in that it - does not send controlTerminate to the currently active controller." - - self inActiveControllerProcess - ifTrue: - [aController~~nil - ifTrue: [(scheduledControllers includes: aController) - ifTrue: [self promote: aController] - ifFalse: [self error: 'Old controller not scheduled']]. - activeController := aController. - activeController == nil - ifFalse: [activeController controlInitialize]. - activeControllerProcess := aProcess. - activeControllerProcess resume] - ifFalse: - [self error: 'New active controller process must be set from old one'] ! Item was removed: - ----- Method: ControlManager>>activeControllerProcess (in category 'accessing') ----- - activeControllerProcess - "Answer the process that is currently handling controller scheduling - activities in the system." - - ^activeControllerProcess! Item was removed: - ----- Method: ControlManager>>backgroundForm: (in category 'displaying') ----- - backgroundForm: aForm - screenController view model: aForm. - ScheduledControllers restore - " - QDPen new mandala: 30 diameter: 640. - ScheduledControllers backgroundForm: - (Form fromDisplay: Display boundingBox). - - ScheduledControllers backgroundForm: - (InfiniteForm with: Form gray). - "! Item was removed: - ----- Method: ControlManager>>controllerSatisfying: (in category 'accessing') ----- - controllerSatisfying: aBlock - "Return the first scheduled controller which satisfies the 1-argument boolean-valued block, or nil if none. 7/25/96 sw" - - scheduledControllers do: - [:aController | (aBlock value: aController) == true ifTrue: [^ aController]]. - ^ nil! Item was removed: - ----- Method: ControlManager>>controllerWhoseModelSatisfies: (in category 'accessing') ----- - controllerWhoseModelSatisfies: aBlock - "Return the first scheduled controller whose model satisfies the 1-argument boolean-valued block, or nil if none. 5/6/96 sw" - - scheduledControllers do: - [:aController | (aBlock value: aController model) == true ifTrue: [^ aController]]. - ^ nil! Item was removed: - ----- Method: ControlManager>>controllersSatisfying: (in category 'accessing') ----- - controllersSatisfying: aBlock - "Return a list of scheduled controllers satisfying aBlock" - - ^ (scheduledControllers ifNil: [^ #()]) select: - [:aController | (aBlock value: aController) == true]! Item was removed: - ----- Method: ControlManager>>displayWorld (in category 'displaying') ----- - displayWorld - - screenController view window: Display boundingBox; displayDeEmphasized. - self scheduledWindowControllers reverseDo: - [:aController | aController view displayDeEmphasized]. - ! Item was removed: - ----- Method: ControlManager>>emergencyCollapse (in category 'private') ----- - emergencyCollapse - - self screenController emergencyCollapse.! Item was removed: - ----- Method: ControlManager>>findWindow (in category 'scheduling') ----- - findWindow - "Present a menu of window titles, and activate the one that gets chosen." - - ^ self findWindowSatisfying: [:c | true]! Item was removed: - ----- Method: ControlManager>>findWindowSatisfying: (in category 'scheduling') ----- - findWindowSatisfying: aBlock - "Present a menu of window titles, and activate the one that gets chosen" - - | sortAlphabetically controllers labels index | - sortAlphabetically := Sensor shiftPressed. - controllers := OrderedCollection new. - scheduledControllers do: [:controller | - controller == screenController ifFalse: - [(aBlock value: controller) ifTrue: [controllers addLast: controller]]]. - controllers size = 0 ifTrue: [^ self]. - sortAlphabetically ifTrue: [controllers sort: [:a :b | a view label < b view label]]. - labels := String streamContents: - [:strm | - controllers do: [:controller | strm nextPutAll: (controller view label contractTo: 40); cr]. - strm skip: -1 "drop last cr"]. - index := (UIManager default chooseFrom: labels lines). - index > 0 ifTrue: - [self activateController: (controllers at: index)]. - ! Item was removed: - ----- Method: ControlManager>>inActiveControllerProcess (in category 'scheduling') ----- - inActiveControllerProcess - "Answer whether the active scheduling process is the actual active - process in the system." - - ^activeControllerProcess == Processor activeProcess! Item was removed: - ----- Method: ControlManager>>includes: (in category 'accessing') ----- - includes: aController - ^ scheduledControllers includes: aController! Item was removed: - ----- Method: ControlManager>>initialize (in category 'initialize-release') ----- - initialize - "Initialize the receiver to refer to only the background controller." - | screenView | - screenController := ScreenController new. - screenView := FormView new. - screenView model: (InfiniteForm with: Color gray) controller: screenController. - screenView window: Display boundingBox. - scheduledControllers := OrderedCollection with: screenController! Item was removed: - ----- Method: ControlManager>>nextActiveController (in category 'private') ----- - nextActiveController - "Answer the controller that would like control. - If there was a click outside the active window, it's the top window - that now has the mouse, otherwise it's just the top window." - - (newTopClicked notNil and: [newTopClicked]) - ifTrue: [newTopClicked := false. - ^ scheduledControllers - detect: [:aController | aController isControlWanted] - ifNone: [scheduledControllers first]] - ifFalse: [^ scheduledControllers first]! Item was removed: - ----- Method: ControlManager>>noteNewTop (in category 'accessing') ----- - noteNewTop - newTopClicked := true! Item was removed: - ----- Method: ControlManager>>processDeferredActions (in category 'scheduling') ----- - processDeferredActions - - [self class deferredActionQueue isEmpty] - whileFalse: [self class deferredActionQueue next value].! Item was removed: - ----- Method: ControlManager>>promote: (in category 'scheduling') ----- - promote: aController - "Make aController be the first scheduled controller in the ordered - collection." - - scheduledControllers remove: aController. - scheduledControllers addFirst: aController! Item was removed: - ----- Method: ControlManager>>release (in category 'initialize-release') ----- - release - "Refer to the comment in Object|release." - - scheduledControllers == nil - ifFalse: - [scheduledControllers - do: [:controller | (controller isKindOf: Controller) - ifTrue: [controller view release] - ifFalse: [controller release]]. - scheduledControllers := nil]! Item was removed: - ----- Method: ControlManager>>resetActiveController (in category 'scheduling') ----- - resetActiveController - "When saving a morphic project whose parent is mvc, we need to set this up first" - - activeController := nil. - activeControllerProcess := Processor activeProcess. - ! Item was removed: - ----- Method: ControlManager>>restore (in category 'displaying') ----- - restore - "Clear the screen to gray and then redisplay all the scheduled views. Try to be a bit intelligent about the view that wants control and not display it twice if possible." - - self unCacheWindows. "assure refresh" - self unschedule: screenController; scheduleOnBottom: screenController. - self displayWorld.! Item was removed: - ----- Method: ControlManager>>restore: (in category 'displaying') ----- - restore: aRectangle - "Restore all windows visible in aRectangle" - ^ self restore: aRectangle without: nil! Item was removed: - ----- Method: ControlManager>>restore:below:without: (in category 'displaying') ----- - restore: aRectangle below: index without: aView - "Restore all windows visible in aRectangle, but without aView" - | view | - view := (scheduledControllers at: index) view. - view == aView ifTrue: - [index >= scheduledControllers size ifTrue: [^ self]. - ^ self restore: aRectangle below: index+1 without: aView]. - view displayOn: ((BitBlt toForm: Display) clipRect: aRectangle). - index >= scheduledControllers size ifTrue: [^ self]. - (aRectangle areasOutside: view windowBox) do: - [:rect | self restore: rect below: index + 1 without: aView]! Item was removed: - ----- Method: ControlManager>>restore:without: (in category 'displaying') ----- - restore: aRectangle without: aView - "Restore all windows visible in aRectangle" - Display deferUpdates: true. - self restore: aRectangle below: 1 without: aView. - Display deferUpdates: false; forceToScreen: aRectangle! Item was removed: - ----- Method: ControlManager>>scheduleActive: (in category 'scheduling') ----- - scheduleActive: aController - "Make aController be scheduled as the active controller. Presumably the - active scheduling process asked to schedule this controller and that a - new process associated this controller takes control. So this is the last act - of the active scheduling process." - <primitive: 19> "Simulation guard" - self scheduleActiveNoTerminate: aController. - Processor terminateActive! Item was removed: - ----- Method: ControlManager>>scheduleActiveNoTerminate: (in category 'scheduling') ----- - scheduleActiveNoTerminate: aController - "Make aController be the active controller. Presumably the process that - requested the new active controller wants to keep control to do more - activites before the new controller can take control. Therefore, do not - terminate the currently active process." - - self schedulePassive: aController. - self scheduled: aController - from: Processor activeProcess! Item was removed: - ----- Method: ControlManager>>scheduleOnBottom: (in category 'scheduling') ----- - scheduleOnBottom: aController - "Make aController be scheduled as a scheduled controller, but not the - active one. Put it at the end of the ordered collection of controllers." - - scheduledControllers addLast: aController! Item was removed: - ----- Method: ControlManager>>schedulePassive: (in category 'scheduling') ----- - schedulePassive: aController - "Make aController be scheduled as a scheduled controller, but not the - active one. Put it at the beginning of the ordered collection of - controllers." - - scheduledControllers addFirst: aController! Item was removed: - ----- Method: ControlManager>>scheduled:from: (in category 'private') ----- - scheduled: aController from: aProcess - - activeControllerProcess==aProcess - ifTrue: - [activeController ~~ nil - ifTrue: [activeController controlTerminate]. - aController centerCursorInView. - self activeController: aController]! Item was removed: - ----- Method: ControlManager>>scheduledControllers (in category 'accessing') ----- - scheduledControllers - "Answer a copy of the ordered collection of scheduled controllers." - - ^scheduledControllers copy! Item was removed: - ----- Method: ControlManager>>scheduledWindowControllers (in category 'accessing') ----- - scheduledWindowControllers - "Same as scheduled controllers, but without ScreenController. - Avoids null views just after closing, eg, a debugger." - - ^ scheduledControllers select: - [:c | c ~~ screenController and: [c view ~~ nil]]! Item was removed: - ----- Method: ControlManager>>screenController (in category 'accessing') ----- - screenController - ^ screenController! Item was removed: - ----- Method: ControlManager>>searchForActiveController (in category 'scheduling') ----- - searchForActiveController - "Find a scheduled controller that wants control and give control to it. If - none wants control, then see if the System Menu has been requested." - activeController := nil. - activeControllerProcess := Processor activeProcess. - self activeController: self nextActiveController. - Processor terminateActive! Item was removed: - ----- Method: ControlManager>>spawnNewProcess (in category 'scheduling') ----- - spawnNewProcess - - self activeController: self screenController! Item was removed: - ----- Method: ControlManager>>unCacheWindows (in category 'private') ----- - unCacheWindows - scheduledControllers ifNotNil: [scheduledControllers do: - [:aController | aController view uncacheBits]]! Item was removed: - ----- Method: ControlManager>>unschedule: (in category 'scheduling') ----- - unschedule: aController - "Remove the view, aController, from the collection of scheduled - controllers." - - scheduledControllers remove: aController ifAbsent: []! Item was removed: - ----- Method: ControlManager>>updateGray (in category 'displaying') ----- - updateGray - "From Georg Gollmann - 11/96. tell the Screen Controller's model to use the currently-preferred desktop color." - - "ScheduledControllers updateGray" - (screenController view model isMemberOf: InfiniteForm) - ifTrue: [screenController view model: (InfiniteForm with: - Preferences desktopColor)]! Item was removed: - ----- Method: ControlManager>>windowFromUser (in category 'scheduling') ----- - windowFromUser - "Present a menu of window titles, and returns the StandardSystemController belonging to the one that gets chosen, or nil if none" - | controllers labels index | - controllers := OrderedCollection new. - labels := String streamContents: - [:strm | - scheduledControllers do: - [:controller | controller == screenController ifFalse: - [controllers addLast: controller. - strm nextPutAll: (controller view label contractTo: 40); cr]]. - strm skip: -1 "drop last cr"]. - index := (UIManager default chooseFrom: labels lines). - ^ index > 0 - ifTrue: - [controllers at: index] - ifFalse: - [nil]! Item was removed: - ----- Method: ControlManager>>windowOriginsInUse (in category 'accessing') ----- - windowOriginsInUse - "Answer a collection of the origins of windows currently on the screen in the current project. 5/21/96 sw" - - ^ self scheduledWindowControllers collect: [:aController | aController view displayBox origin].! Item was removed: - Object subclass: #Controller - instanceVariableNames: 'model view sensor deferredActionQueue lastActivityTime' - classVariableNames: 'MinActivityLapse' - poolDictionaries: '' - category: 'ST80-Controllers'! - - !Controller commentStamp: '<historical>' prior: 0! - A Controller coordinates a View, its model, and user actions. It provides scheduling (control) behavior to determine when the user wants to communicate with the model or view.! Item was removed: - ----- Method: Controller class>>initialize (in category 'initialization') ----- - initialize - "Controller initialize" - self minActivityLapse: 10.! Item was removed: - ----- Method: Controller class>>minActivityLapse: (in category 'initialization') ----- - minActivityLapse: milliseconds - "minimum time to delay between calls to controlActivity" - MinActivityLapse := milliseconds ifNotNil: [ milliseconds rounded ].! Item was removed: - ----- Method: Controller>>centerCursorInView (in category 'cursor') ----- - centerCursorInView - "Position sensor's mousePoint (which is assumed to be connected to the - cursor) to the center of its view's inset display box (see - Sensor|mousePoint: and View|insetDisplayBox)." - - ^sensor cursorPoint: view insetDisplayBox center! Item was removed: - ----- Method: Controller>>closeAndUnscheduleNoTerminate (in category 'as yet unclassified') ----- - closeAndUnscheduleNoTerminate - ! Item was removed: - ----- Method: Controller>>controlActivity (in category 'control defaults') ----- - controlActivity - "Pass control to the next control level (that is, to the Controller of a - subView of the receiver's view) if possible. It is sent by - Controller|controlLoop each time through the main control loop. It should - be redefined in a subclass if some other action is needed." - - self processDeferredActions. - self controlToNextLevel! Item was removed: - ----- Method: Controller>>controlInitialize (in category 'basic control sequence') ----- - controlInitialize - "Sent by Controller|startUp as part of the standard control sequence, it - provides a place in the standard control sequence for initializing the - receiver (taking into account the current state of its model and view). It - should be redefined in subclasses to perform some specific action." - - ^self! Item was removed: - ----- Method: Controller>>controlLoop (in category 'basic control sequence') ----- - controlLoop - "Sent by Controller|startUp as part of the standard control sequence. - Controller|controlLoop sends the message Controller|isControlActive to test - for loop termination. As long as true is returned, the loop continues. - When false is returned, the loop ends. Each time through the loop, the - message Controller|controlActivity is sent." - - [self interActivityPause. self isControlActive] whileTrue: [ - self controlActivity. Processor yield]! Item was removed: - ----- Method: Controller>>controlTerminate (in category 'basic control sequence') ----- - controlTerminate - "Provide a place in the standard control sequence for terminating the - receiver (taking into account the current state of its model and view). It - should be redefined in subclasses to perform some specific action." - - ^self! Item was removed: - ----- Method: Controller>>controlToNextLevel (in category 'control defaults') ----- - controlToNextLevel - "Pass control to the next control level (that is, to the Controller of a - subView of the receiver's view) if possible. The receiver finds the - subView (if any) of its view whose inset display box (see - View|insetDisplayBox) contains the sensor's cursor point. The Controller - of this subView is then given control if it answers true in response to - the message Controller|isControlWanted." - - | aView | - aView := view subViewWantingControl. - aView ~~ nil ifTrue: [aView controller startUp]! Item was removed: - ----- Method: Controller>>deferredActionQueue (in category 'basic control sequence') ----- - deferredActionQueue - - ^deferredActionQueue ifNil: [deferredActionQueue := SharedQueue new]! Item was removed: - ----- Method: Controller>>initialize (in category 'initialize-release') ----- - initialize - "Initialize the state of the receiver. Subclasses should include 'super - initialize' when redefining this message to insure proper initialization." - - sensor := EventSensor default! Item was removed: - ----- Method: Controller>>inspectView (in category 'view access') ----- - inspectView - view notNil ifTrue: [^ view inspect; yourself]! Item was removed: - ----- Method: Controller>>interActivityPause (in category 'basic control sequence') ----- - interActivityPause - "if we are looping quickly, insert a short delay. Thus if we are just doing UI stuff, we won't take up much CPU" - | currentTime wait | - MinActivityLapse ifNotNil: [ - lastActivityTime ifNotNil: [ - currentTime := Time millisecondClockValue. - wait := lastActivityTime + MinActivityLapse - currentTime. - wait > 0 ifTrue: [ - wait <= MinActivityLapse "big waits happen after a snapshot" - ifTrue: [DisplayScreen checkForNewScreenScaleFactor; checkForNewScreenSize. - (Delay forMilliseconds: wait) wait ]. ]. ]. ]. - - lastActivityTime := Time millisecondClockValue.! Item was removed: - ----- Method: Controller>>isControlActive (in category 'control defaults') ----- - isControlActive - "Answer whether receiver wishes to continue evaluating its controlLoop - method. It is sent by Controller|controlLoop in order to determine when - the receiver's control loop should terminate, and should be redefined in - a subclass if some special condition for terminating the main control loop - is needed." - - ^ self viewHasCursor - and: [sensor blueButtonPressed not - and: [sensor yellowButtonPressed not]]! Item was removed: - ----- Method: Controller>>isControlWanted (in category 'control defaults') ----- - isControlWanted - "Answer whether the cursor is inside the inset display box (see - View|insetDisplayBox) of the receiver's view. It is sent by - Controller|controlNextLevel in order to determine whether or not control - should be passed to this receiver from the Controller of the superView of - this receiver's view." - - ^self viewHasCursor! Item was removed: - ----- Method: Controller>>model (in category 'model access') ----- - model - "Answer the receiver's model which is the same as the model of the - receiver's view." - - ^model! Item was removed: - ----- Method: Controller>>model: (in category 'model access') ----- - model: aModel - "Controller|model: and Controller|view: are sent by View|controller: in - order to coordinate the links between the model, view, and controller. In - ordinary usage, the receiver is created and passed as the parameter to - View|controller: so that the receiver's model and view links can be set - up by the view." - - model := aModel! Item was removed: - ----- Method: Controller>>processDeferredActions (in category 'control defaults') ----- - processDeferredActions - - Project current isMVC ifFalse: [^ self]. - Project current world processDeferredActions.! Item was removed: - ----- Method: Controller>>release (in category 'initialize-release') ----- - release - "Breaks the cycle between the receiver and its view. It is usually not - necessary to send release provided the receiver's view has been properly - released independently." - - model := nil. - view ~~ nil - ifTrue: - [view controller: nil. - view := nil]! Item was removed: - ----- Method: Controller>>sensor (in category 'sensor access') ----- - sensor - "Answer the receiver's sensor. Subclasses may use other objects that are - not instances of Sensor or its subclasses if more general kinds of - input/output functions are required." - - ^sensor! Item was removed: - ----- Method: Controller>>sensor: (in category 'sensor access') ----- - sensor: aSensor - "Set the receiver's sensor to aSensor." - - sensor := aSensor! Item was removed: - ----- Method: Controller>>startUp (in category 'basic control sequence') ----- - startUp - "Give control to the receiver. The default control sequence is to initialize - (see Controller|controlInitialize), to loop (see Controller|controlLoop), and - then to terminate (see Controller|controlTerminate). After this sequence, - control is returned to the sender of Control|startUp. The receiver's control - sequence is used to coordinate the interaction of its view and model. In - general, this consists of polling the sensor for user input, testing the - input with respect to the current display of the view, and updating the - model to reflect intended changes." - - self controlInitialize. - self controlLoop. - self controlTerminate! Item was removed: - ----- Method: Controller>>terminateAndInitializeAround: (in category 'basic control sequence') ----- - terminateAndInitializeAround: aBlock - "1/12/96 sw" - self controlTerminate. - aBlock value. - self controlInitialize! Item was removed: - ----- Method: Controller>>view (in category 'view access') ----- - view - "Answer the receiver's view." - - ^view! Item was removed: - ----- Method: Controller>>view: (in category 'view access') ----- - view: aView - "Controller|view: and Controller|model: are sent by View|controller: in - order to coordinate the links between the model, view, and controller. In - ordinary usage, the receiver is created and passed as the parameter to - View|controller: and the receiver's model and view links are set up - automatically by the view." - - view := aView! Item was removed: - ----- Method: Controller>>viewHasCursor (in category 'cursor') ----- - viewHasCursor - "Answer whether the cursor point of the receiver's sensor lies within the - inset display box of the receiver's view (see View|insetDisplayBox). - Controller|viewHasCursor is normally used in internal methods." - - ^ view ifNotNil: [view containsPoint: sensor cursorPoint] ifNil: [false]! Item was removed: - Path subclass: #CurveFitter - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Paths'! - - !CurveFitter commentStamp: '<historical>' prior: 0! - I represent a conic section determined by three points p1, p2 and p3. I interpolate p1 and p3 and am tangent to line p1, p2 at p1 and line p3, p2 at p3.! Item was removed: - ----- Method: CurveFitter class>>example (in category 'examples') ----- - example - "Designate three locations on the screen by clicking any button. The - curve determined by the points will be displayed with a long black form." - - | aCurveFitter aForm | - aForm := Form extent: 1 at 30. "make a long thin Form for display " - aForm fillBlack. "turn it black" - aCurveFitter := CurveFitter new. - aCurveFitter form: aForm. "set the form for display" - "collect three Points and show them on the dispaly" - aCurveFitter firstPoint: Sensor waitButton. Sensor waitNoButton. - aForm displayOn: Display at: aCurveFitter firstPoint. - aCurveFitter secondPoint: Sensor waitButton. Sensor waitNoButton. - aForm displayOn: Display at: aCurveFitter secondPoint. - aCurveFitter thirdPoint: Sensor waitButton. Sensor waitNoButton. - aForm displayOn: Display at: aCurveFitter thirdPoint. - - aCurveFitter displayOn: Display "display the CurveFitter" - - "CurveFitter example"! Item was removed: - ----- Method: CurveFitter class>>new (in category 'instance creation') ----- - new - - | newSelf | - newSelf := super new: 3. - newSelf add: 0 at 0. - newSelf add: 0 at 0. - newSelf add: 0 at 0. - ^newSelf! Item was removed: - ----- Method: CurveFitter>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger fillColor: aForm - - | pa pb k s p1 p2 p3 line | - line := Line new. - line form: self form. - collectionOfPoints size < 3 ifTrue: [self error: 'Curve must have three points']. - p1 := self firstPoint. - p2 := self secondPoint. - p3 := self thirdPoint. - s := Path new. - s add: p1. - pa := p2 - p1. - pb := p3 - p2. - k := 5 max: pa x abs + pa y abs + pb x abs + pb y abs // 20. - "k is a guess as to how many line segments to use to approximate - the curve." - 1 to: k do: - [:i | - s add: pa * i // k + p1 * (k - i) + (pb * (i - 1) // k + p2 * (i - 1)) // (k - 1)]. - s add: p3. - 1 to: s size - 1 do: - [:i | - line beginPoint: (s at: i). - line endPoint: (s at: i + 1). - line displayOn: aDisplayMedium - at: aPoint - clippingBox: clipRect - rule: anInteger - fillColor: aForm]! Item was removed: - ----- Method: CurveFitter>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm - - | transformedPath newCurveFitter | - transformedPath := aTransformation applyTo: self. - newCurveFitter := CurveFitter new. - newCurveFitter firstPoint: transformedPath firstPoint. - newCurveFitter secondPoint: transformedPath secondPoint. - newCurveFitter thirdPoint: transformedPath thirdPoint. - newCurveFitter form: self form. - newCurveFitter - displayOn: aDisplayMedium - at: 0 @ 0 - clippingBox: clipRect - rule: anInteger - fillColor: aForm! Item was removed: - ----- Method: DisplayText>>asParagraph (in category '*ST80-Support') ----- - asParagraph - "Answer a Paragraph whose text and style are identical to that of the - receiver." - | para | - para := Paragraph withText: text style: textStyle. - para foregroundColor: foreColor backgroundColor: backColor. - backColor isTransparent ifTrue: [para rule: Form paint]. - ^ para! Item was removed: - View subclass: #DisplayTextView - instanceVariableNames: 'rule mask editParagraph centered' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Views'! - - !DisplayTextView commentStamp: '<historical>' prior: 0! - I represent a view of an instance of DisplayText.! Item was removed: - ----- Method: DisplayTextView class>>example2 (in category 'examples') ----- - example2 - "Create a standarad system view with two parts, one editable, the other not." - | topView aDisplayTextView | - topView := StandardSystemView new. - topView label: 'Text Editor'. - aDisplayTextView := self new model: 'test string label' asDisplayText. - aDisplayTextView controller: NoController new. - aDisplayTextView window: (0 @ 0 extent: 100 @ 100). - aDisplayTextView borderWidthLeft: 2 right: 0 top: 2 bottom: 2. - topView addSubView: aDisplayTextView. - - aDisplayTextView := self new model: 'test string' asDisplayText. - aDisplayTextView window: (0 @ 0 extent: 100 @ 100). - aDisplayTextView borderWidth: 2. - topView - addSubView: aDisplayTextView - align: aDisplayTextView viewport topLeft - with: topView lastSubView viewport topRight. - topView controller open - - "DisplayTextView example2"! Item was removed: - ----- Method: DisplayTextView class>>example3 (in category 'examples') ----- - example3 - "Create a passive view of some text on the screen." - | view | - view:= self new model: 'this is a test of one line - and the second line' asDisplayText. - view translateBy: 100 at 100. - view borderWidth: 2. - view display. - view release - - "DisplayTextView example3"! Item was removed: - ----- Method: DisplayTextView class>>example4 (in category 'examples') ----- - example4 - "Create four passive views of some text on the screen with fat borders." - | view | - view:= self new model: 'this is a test of one line - and the second line' asDisplayText. - view translateBy: 100 at 100. - view borderWidth: 5. - view display. - 3 timesRepeat: [view translateBy: 100 at 100. view display]. - view release - - "DisplayTextView example4"! Item was removed: - ----- Method: DisplayTextView>>centerText (in category 'private') ----- - centerText - - self isCentered - ifTrue: - [editParagraph - align: editParagraph boundingBox center - with: self getWindow center]! Item was removed: - ----- Method: DisplayTextView>>centered (in category 'accessing') ----- - centered - - centered := true. - self centerText! Item was removed: - ----- Method: DisplayTextView>>deEmphasizeView (in category 'deEmphasizing') ----- - deEmphasizeView - "Refer to the comment in View|deEmphasizeView." - - (self controller isKindOf: ParagraphEditor) - ifTrue: [controller deselect]! Item was removed: - ----- Method: DisplayTextView>>defaultController (in category 'controller access') ----- - defaultController - "Refer to the comment in View|defaultController." - - ^self defaultControllerClass newParagraph: editParagraph! Item was removed: - ----- Method: DisplayTextView>>defaultControllerClass (in category 'controller access') ----- - defaultControllerClass - "Refer to the comment in View|defaultControllerClass." - - ^ParagraphEditor! Item was removed: - ----- Method: DisplayTextView>>defaultRule (in category 'private') ----- - defaultRule - - ^Form over! Item was removed: - ----- Method: DisplayTextView>>defaultWindow (in category 'window access') ----- - defaultWindow - "Refer to the comment in View|defaultWindow." - - ^self inverseDisplayTransform: (editParagraph boundingBox expandBy: 6 @ 6)! Item was removed: - ----- Method: DisplayTextView>>display (in category 'displaying') ----- - display - "Refer to the comment in View|display." - - self isUnlocked ifTrue: [self positionText]. - super display! Item was removed: - ----- Method: DisplayTextView>>displayView (in category 'displaying') ----- - displayView - "Refer to the comment in View|displayView." - - self clearInside. - (self controller isKindOf: ParagraphEditor ) - ifTrue: [controller changeParagraph: editParagraph]. - editParagraph foregroundColor: self foregroundColor - backgroundColor: self backgroundColor. - self isCentered - ifTrue: - [editParagraph displayOn: Display - transformation: self displayTransformation - clippingBox: self insetDisplayBox - fixedPoint: editParagraph boundingBox center] - ifFalse: - [editParagraph displayOn: Display]! Item was removed: - ----- Method: DisplayTextView>>fillColor (in category 'accessing') ----- - fillColor - "Answer an instance of class Form that is to be used as the mask when - displaying the receiver's model (a DisplayText)." - - ^ mask! Item was removed: - ----- Method: DisplayTextView>>fillColor: (in category 'accessing') ----- - fillColor: aForm - "Set aForm to be the mask used when displaying the receiver's model." - - mask := aForm! Item was removed: - ----- Method: DisplayTextView>>initialize (in category 'initialize-release') ----- - initialize - "Refer to the comment in View|initialize." - - super initialize. - centered := false! Item was removed: - ----- Method: DisplayTextView>>isCentered (in category 'accessing') ----- - isCentered - - ^centered! Item was removed: - ----- Method: DisplayTextView>>lock (in category 'lock access') ----- - lock - "Refer to the comment in View|lock. Must do what would be done by displaying..." - - self isUnlocked ifTrue: [self positionText]. - super lock! Item was removed: - ----- Method: DisplayTextView>>mask (in category 'accessing') ----- - mask - "Answer an instance of class Form that is to be used as the mask when - displaying the receiver's model (a DisplayText)." - - ^ mask! Item was removed: - ----- Method: DisplayTextView>>model: (in category 'model access') ----- - model: aDisplayText - "Refer to the comment in View|model:." - - super model: aDisplayText. - editParagraph := model asParagraph. - self centerText! Item was removed: - ----- Method: DisplayTextView>>positionText (in category 'private') ----- - positionText - - | box | - box := (self displayBox insetBy: 6 at 6) origin extent: editParagraph boundingBox extent. - editParagraph wrappingBox: box clippingBox: box. - self centerText! Item was removed: - ----- Method: DisplayTextView>>rule (in category 'accessing') ----- - rule - "Answer a number from 0 to 15 that indicates which of the sixteen - display rules is to be used when copying the receiver's model (a - DisplayText) onto the display screen." - - rule == nil - ifTrue: [^self defaultRule] - ifFalse: [^rule]! Item was removed: - ----- Method: DisplayTextView>>rule: (in category 'accessing') ----- - rule: anInteger - "Set anInteger to be the rule used when displaying the receiver's model." - - rule := anInteger! Item was removed: - ----- Method: DisplayTextView>>uncacheBits (in category 'displaying') ----- - uncacheBits - "Normally only sent to a StandardSystemView, but for casees where a DisplayTextView is used alone, without a superview, in which we make this a no-op, put in so that the Character Recognizer doesn't fail. 8/9/96 sw"! Item was removed: - ----- Method: DisplayTextView>>window: (in category 'window access') ----- - window: aWindow - "Refer to the comment in View|window:." - - super window: aWindow. - self centerText! Item was removed: - ----- Method: EventSensor>>characterForKeycode: (in category '*ST80-Support-keyboard') ----- - characterForKeycode: keycode - "Map the given keycode to a Smalltalk character object. Encoding: - A keycode is 12 bits: <4 modifer bits><8 bit ISO character> - Modifier bits are: <command><option><control><shift>" - - "NOTE: the command and option keys are specific to the Macintosh and may not have equivalents on other platforms." - - keycode = nil ifTrue: [ ^nil ]. - keycode class = Character ifTrue: [ ^keycode ]. "to smooth the transition!!" - ^ Character value: (keycode bitAnd: 16rFF)! Item was removed: - ----- Method: EventSensor>>keyboard (in category '*ST80-Support-keyboard') ----- - keyboard - "Answer the next (single-byte or multi-byte) character from the keyboard." - - | firstCharacter secondCharactor stream multiCharacter converter | - "1) Consume next character from buffer." - (firstCharacter := self characterForKeycode: keyboardBuffer next) ifNil: [^ nil]. - - "2) Peek additional character and try to read multi-byte character." - (secondCharactor := self characterForKeycode: keyboardBuffer peek) ifNil: [^ firstCharacter]. - (converter := Locale currentPlatform systemConverter) ifNil: [^ firstCharacter]. - stream := ReadStream on: (String with: firstCharacter with: secondCharactor). - multiCharacter := [converter nextFromStream: stream] ifError: [firstCharacter]. - - "3) Only consume that additional character if we got a multi-byte character." - multiCharacter isOctetCharacter ifFalse: [keyboardBuffer next]. - - "4) Answer either single-byte or multi-byte character." - ^ multiCharacter - ! Item was removed: - ----- Method: EventSensor>>keyboardPressed (in category '*ST80-Support-keyboard') ----- - keyboardPressed - "Answer true if keystrokes are available." - - ^self peekKeyboard notNil! Item was removed: - ----- Method: EventSensor>>mouseWheelDelta (in category '*ST80-Support-mouse') ----- - mouseWheelDelta - - | delta | - delta := self peekMouseWheelDelta. - mouseWheelDelta := 0 at 0. - ^ delta! Item was removed: - ----- Method: EventSensor>>mouseWheelDirection (in category '*ST80-Support-mouse') ----- - mouseWheelDirection - - | direction | - direction := self peekMouseWheelDirection. - mouseWheelDelta := 0 at 0. - ^ direction! Item was removed: - ----- Method: EventSensor>>peekButtons (in category '*ST80-Support-mouse') ----- - peekButtons - - self fetchMoreEvents. - self eventQueue ifNotNil: [:queue | queue flush]. - ^ mouseButtons! Item was removed: - ----- Method: EventSensor>>peekKeyboard (in category '*ST80-Support-keyboard') ----- - peekKeyboard - "Answer the next character in the keyboard buffer without removing it, or nil if it is empty." - - self fetchMoreEvents. - self eventQueue ifNotNil: [:queue | queue flush]. - ^ self characterForKeycode: keyboardBuffer peek! Item was removed: - ----- Method: EventSensor>>peekMouseWheelDelta (in category '*ST80-Support-mouse') ----- - peekMouseWheelDelta - - self fetchMoreEvents. - self eventQueue ifNotNil: [:queue | queue flush]. - ^ mouseWheelDelta! Item was removed: - ----- Method: EventSensor>>peekMouseWheelDirection (in category '*ST80-Support-mouse') ----- - peekMouseWheelDirection - - | delta | - delta := self peekMouseWheelDelta. - - delta x > 0 ifTrue: [^ #right]. - delta x < 0 ifTrue: [^ #left]. - - delta y > 0 ifTrue: [^ #up]. - delta y < 0 ifTrue: [^ #down]. - - ^ nil! Item was removed: - ----- Method: EventSensor>>peekPosition (in category '*ST80-Support-mouse') ----- - peekPosition - - self fetchMoreEvents. - self eventQueue ifNotNil: [:queue | queue flush]. - ^ mousePosition! Item was removed: - StringHolder subclass: #FillInTheBlank - instanceVariableNames: 'acceptOnCR done responseUponCancel' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Menus'! - - !FillInTheBlank commentStamp: '<historical>' prior: 0! - I represent a prompt for string input from the user. The user is asked to type in and edit a string. The resulting string is supplied as the argument to a client-supplied action block. - ! Item was removed: - ----- Method: FillInTheBlank class>>fillInTheBlankMorphClass (in category 'private') ----- - fillInTheBlankMorphClass - "By factoring out this class references, it becomes possible to discard - morphic by simply removing this class. All calls to this method needs - to be protected by 'Smalltalk isMorphic' tests." - - ^ Smalltalk - at: #FillInTheBlankMorph - ifAbsent: [self notify: 'Morphic class FillInTheBlankMorph not present']! Item was removed: - ----- Method: FillInTheBlank class>>fillInTheBlankViewClass (in category 'private') ----- - fillInTheBlankViewClass - "By factoring out this class references, it becomes possible to discard - MVC by simply removing this class. All calls to this method needs - to be protected by 'Smalltalk isMorphic' tests." - - ^ FillInTheBlankView! Item was removed: - ----- Method: FillInTheBlank class>>multiLineRequest:centerAt:initialAnswer:answerHeight: (in category 'instance creation') ----- - multiLineRequest: queryString centerAt: aPoint initialAnswer: defaultAnswer answerHeight: answerHeight - "Create a multi-line instance of me whose question is queryString with - the given initial answer. Invoke it centered at the given point, and - answer the string the user accepts. Answer nil if the user cancels. An - empty string returned means that the ussr cleared the editing area and - then hit 'accept'. Because multiple lines are invited, we ask that the user - use the ENTER key, or (in morphic anyway) hit the 'accept' button, to - submit; that way, the return key can be typed to move to the next line. - NOTE: The ENTER key does not work on Windows platforms." - - "UIManager default - multiLineRequest: - 'Enter several lines; end input by accepting - or canceling via menu or press Alt+s/Alt+l' - centerAt: Display center - initialAnswer: 'Once upon a time...' - answerHeight: 200" - - | model fillInView | - Smalltalk isMorphic - ifTrue: - [^self fillInTheBlankMorphClass - request: queryString - initialAnswer: defaultAnswer - centerAt: aPoint - inWorld: self currentWorld - onCancelReturn: nil - acceptOnCR: false]. - model := self new. - model contents: defaultAnswer. - model responseUponCancel: nil. - model acceptOnCR: false. - fillInView := self fillInTheBlankViewClass - multiLineOn: model - message: queryString - centerAt: aPoint - answerHeight: answerHeight. - ^model show: fillInView! Item was removed: - ----- Method: FillInTheBlank class>>request: (in category 'instance creation') ----- - request: queryString - "Create an instance of me whose question is queryString. Invoke it - centered at the cursor, and answer the string the user accepts. Answer - the empty string if the user cancels." - - "UIManager default request: 'Your name?'" - - ^ self - request: queryString - initialAnswer: '' - centerAt: (self currentHand ifNil: [Sensor]) cursorPoint! Item was removed: - ----- Method: FillInTheBlank class>>request:initialAnswer: (in category 'instance creation') ----- - request: queryString initialAnswer: defaultAnswer - "Create an instance of me whose question is queryString with the given - initial answer. Invoke it centered at the given point, and answer the - string the user accepts. Answer the empty string if the user cancels." - - "UIManager default - request: 'What is your favorite color?' - initialAnswer: 'red, no blue. Ahhh!!'" - - ^ self - request: queryString - initialAnswer: defaultAnswer - centerAt: (self currentHand ifNil: [Sensor]) cursorPoint! Item was removed: - ----- Method: FillInTheBlank class>>request:initialAnswer:centerAt: (in category 'instance creation') ----- - request: queryString initialAnswer: defaultAnswer centerAt: aPoint - - ^ self - request: queryString - initialAnswer: defaultAnswer - centerAt: aPoint - onCancelReturn: ''! Item was removed: - ----- Method: FillInTheBlank class>>request:initialAnswer:centerAt:onCancelReturn: (in category 'instance creation') ----- - request: queryString initialAnswer: defaultAnswer centerAt: aPoint onCancelReturn: cancelResponse - "Create an instance of me whose question is queryString with the given - initial answer. Invoke it centered at the given point, and answer the - string the user accepts. Answer the empty string if the user cancels." - - "UIManager default - request: 'Type something, then type CR.' - initialAnswer: 'yo ho ho!!' - centerAt: Display center" - - | model fillInView | - Smalltalk isMorphic - ifTrue: - [^self fillInTheBlankMorphClass - request: queryString - initialAnswer: defaultAnswer - centerAt: aPoint]. - model := self new. - model contents: defaultAnswer. - model responseUponCancel: cancelResponse. - fillInView := self fillInTheBlankViewClass - on: model - message: queryString - centerAt: aPoint. - ^model show: fillInView! Item was removed: - ----- Method: FillInTheBlank class>>request:initialAnswer:onCancelReturn: (in category 'instance creation') ----- - request: queryString initialAnswer: defaultAnswer onCancelReturn: cancelResponse - - ^ self - request: queryString - initialAnswer: defaultAnswer - centerAt: (self currentHand ifNil: [Sensor]) cursorPoint - onCancelReturn: cancelResponse! Item was removed: - ----- Method: FillInTheBlank class>>requestPassword: (in category 'instance creation') ----- - requestPassword: queryString - "Create an instance of me whose question is queryString. Invoke it centered - at the cursor, and answer the string the user accepts. Answer the empty - string if the user cancels." - - "UIManager default requestPassword: 'POP password'" - - | model fillInView | - Smalltalk isMorphic - ifTrue: [^self fillInTheBlankMorphClass requestPassword: queryString]. - model := self new. - model contents: ''. - fillInView := self fillInTheBlankViewClass - requestPassword: model - message: queryString - centerAt: Sensor cursorPoint - answerHeight: 40. - ^model show: fillInView! Item was removed: - ----- Method: FillInTheBlank>>acceptOnCR (in category 'accessing') ----- - acceptOnCR - "Answer whether a carriage return should cause input to be accepted." - - ^ acceptOnCR - ! Item was removed: - ----- Method: FillInTheBlank>>acceptOnCR: (in category 'accessing') ----- - acceptOnCR: aBoolean - - acceptOnCR := aBoolean. - ! Item was removed: - ----- Method: FillInTheBlank>>convertToCurrentVersion:refStream: (in category 'object fileIn') ----- - convertToCurrentVersion: varDict refStream: smartRefStrm - - varDict at: 'responseUponCancel' ifAbsent: [responseUponCancel := '']. - ^super convertToCurrentVersion: varDict refStream: smartRefStrm. - - ! Item was removed: - ----- Method: FillInTheBlank>>done (in category 'accessing') ----- - done - "Answer whether the user has ended the interaction." - - ^ done - ! Item was removed: - ----- Method: FillInTheBlank>>done: (in category 'accessing') ----- - done: aBoolean - - done := aBoolean. - ! Item was removed: - ----- Method: FillInTheBlank>>initialize (in category 'initialize-release') ----- - initialize - - super initialize. - acceptOnCR := false. - done := false. - responseUponCancel := '' - ! Item was removed: - ----- Method: FillInTheBlank>>responseUponCancel: (in category 'accessing') ----- - responseUponCancel: resp - responseUponCancel := resp! Item was removed: - ----- Method: FillInTheBlank>>setResponseForCancel (in category 'accessing') ----- - setResponseForCancel - self contents: responseUponCancel! Item was removed: - ----- Method: FillInTheBlank>>show: (in category 'private') ----- - show: fillInView - | savedArea | - savedArea := Form fromDisplay: fillInView displayBox. - fillInView display. - contents isEmpty - ifFalse: [fillInView lastSubView controller selectFrom: 1 to: contents size]. - (fillInView lastSubView containsPoint: Sensor cursorPoint) - ifFalse: [fillInView lastSubView controller centerCursorInView]. - fillInView controller startUp. - fillInView release. - savedArea displayOn: Display at: fillInView viewport topLeft. - ^ contents! Item was removed: - StringHolderController subclass: #FillInTheBlankController - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Support'! - - !FillInTheBlankController commentStamp: '<historical>' prior: 0! - I am the controller for a FillInTheBlankView. Based on a flag in the view, I can either accept the input string when a carriage return is typed, or I can allow multiple lines of input that is accepted by either typing enter or by invoking the 'accept' command. - ! Item was removed: - ----- Method: FillInTheBlankController>>accept (in category 'other') ----- - accept - - super accept. - model done: true. - ! Item was removed: - ----- Method: FillInTheBlankController>>cancel (in category 'other') ----- - cancel - - model setResponseForCancel. - super cancel. - model done: true. - ! Item was removed: - ----- Method: FillInTheBlankController>>controlInitialize (in category 'basic control sequence') ----- - controlInitialize - - model acceptOnCR ifFalse: [^ super controlInitialize]. - self setMark: self markBlock stringIndex. - self setPoint: self pointBlock stringIndex. - self initializeSelection. - beginTypeInBlock := nil. - ! Item was removed: - ----- Method: FillInTheBlankController>>controlTerminate (in category 'basic control sequence') ----- - controlTerminate - - | topController | - super controlTerminate. - topController := view topView controller. - topController ifNotNil: [topController close]. - ! Item was removed: - ----- Method: FillInTheBlankController>>dispatchOnCharacter:with: (in category 'other') ----- - dispatchOnCharacter: char with: typeAheadStream - "Accept the current input if the user hits the carriage return or the enter key." - - (model acceptOnCR and: - [(char = Character cr) | (char = Character enter)]) - ifTrue: [ - sensor keyboard. "absorb the character" - self accept. - ^ true] - ifFalse: [ - ^ super dispatchOnCharacter: char with: typeAheadStream]. - ! Item was removed: - ----- Method: FillInTheBlankController>>isControlActive (in category 'control defaults') ----- - isControlActive - ^ self isControlWanted! Item was removed: - ----- Method: FillInTheBlankController>>isControlWanted (in category 'control defaults') ----- - isControlWanted - ^ model done not! Item was removed: - ----- Method: FillInTheBlankController>>processYellowButton (in category 'other') ----- - processYellowButton - "Suppress yellow-button menu if acceptOnCR is true." - - model acceptOnCR ifFalse: [^ super processYellowButton]. - ! Item was removed: - StringHolderView subclass: #FillInTheBlankView - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Support'! - - !FillInTheBlankView commentStamp: '<historical>' prior: 0! - I am a view of a FillInTheBlank. I display a query and an editable view of the user's reply string. - ! Item was removed: - ----- Method: FillInTheBlankView class>>multiLineOn:message:centerAt:answerHeight: (in category 'instance creation') ----- - multiLineOn: aFillInTheBlank message: queryString centerAt: aPoint answerHeight: answerHeight - "Answer an instance of me on aFillInTheBlank asking the question queryString. Allow the reply to be multiple lines, and make the user input view the given height." - - | messageView answerView topView | - messageView := DisplayTextView new - model: queryString asDisplayText; - borderWidthLeft: 2 right: 2 top: 2 bottom: 0; - controller: NoController new. - messageView - window: (0 at 0 extent: (messageView window extent max: 200 at 30)); - centered. - answerView := self new - model: aFillInTheBlank; - window: (0 at 0 extent: (messageView window width at answerHeight)); - borderWidth: 2. - topView := View new model: aFillInTheBlank. - topView controller: ModalController new. - topView addSubView: messageView. - topView addSubView: answerView below: messageView. - topView align: topView viewport center with: aPoint. - topView window: - (0 @ 0 extent: - (messageView window width) @ - (messageView window height + answerView window height)). - topView translateBy: - (topView displayBox amountToTranslateWithin: Display boundingBox). - ^ topView - ! Item was removed: - ----- Method: FillInTheBlankView class>>on:message:centerAt: (in category 'instance creation') ----- - on: aFillInTheBlank message: queryString centerAt: aPoint - "Answer an instance of me on aFillInTheBlank for a single line of input in response to the question queryString." - - aFillInTheBlank acceptOnCR: true. - ^ self - multiLineOn: aFillInTheBlank - message: queryString - centerAt: aPoint - answerHeight: 40 - ! Item was removed: - ----- Method: FillInTheBlankView class>>requestPassword:message:centerAt:answerHeight: (in category 'instance creation') ----- - requestPassword: aFillInTheBlank message: queryString centerAt: aPoint answerHeight: answerHeight - "Answer an instance of me on aFillInTheBlank asking the question queryString. Allow the reply to be multiple lines, and make the user input view the given height." - - | messageView answerView topView myPar pwdFont myArray myStyle | - aFillInTheBlank acceptOnCR: true. - messageView := DisplayTextView new - model: queryString asDisplayText; - borderWidthLeft: 2 right: 2 top: 2 bottom: 0; - controller: NoController new. - messageView - window: (0 at 0 extent: (messageView window extent max: 200 at 30)); - centered. - answerView := self new - model: aFillInTheBlank; - window: (0 at 0 extent: (messageView window width at answerHeight)); - borderWidth: 2. - " now answerView to use the password font" - myPar := answerView displayContents. - pwdFont := StrikeFont passwordFont. - myArray := Array new: 1. - myArray at: 1 put: pwdFont. - myStyle := TextStyle fontArray: myArray. - myPar setWithText: (myPar text) style: myStyle. - - topView := View new model: aFillInTheBlank. - topView controller: ModalController new. - topView addSubView: messageView. - topView addSubView: answerView below: messageView. - topView align: topView viewport center with: aPoint. - topView window: - (0 @ 0 extent: - (messageView window width) @ - (messageView window height + answerView window height)). - topView translateBy: - (topView displayBox amountToTranslateWithin: Display boundingBox). - ^ topView - ! Item was removed: - ----- Method: FillInTheBlankView>>defaultControllerClass (in category 'controller access') ----- - defaultControllerClass - - ^ FillInTheBlankController - ! Item was removed: - Object subclass: #FormButtonCache - instanceVariableNames: 'offset form value initialState' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Editors'! - - !FormButtonCache commentStamp: '<historical>' prior: 0! - My instances are used to save information needed to construct the switch in a menu for a FormEditor. A collection of my instances is stored as a class variable of FormMenuView.! Item was removed: - ----- Method: FormButtonCache>>form (in category 'accessing') ----- - form - "Answer the receiver's form, the image of the button on the screen." - - ^form! Item was removed: - ----- Method: FormButtonCache>>form: (in category 'accessing') ----- - form: aForm - "Set the receiver's form to be the argument." - - form := aForm! Item was removed: - ----- Method: FormButtonCache>>initialState (in category 'accessing') ----- - initialState - "Answer the receiver's initial state, on or off." - - ^initialState! Item was removed: - ----- Method: FormButtonCache>>initialState: (in category 'accessing') ----- - initialState: aBoolean - "Set the receiver's initial state, on or off, to be the argument." - - initialState := aBoolean! Item was removed: - ----- Method: FormButtonCache>>offset (in category 'accessing') ----- - offset - "Answer the receiver's offset, its relative position for displaying the - button." - - ^offset! Item was removed: - ----- Method: FormButtonCache>>offset: (in category 'accessing') ----- - offset: anInteger - "Set the receiver's offset." - - offset := anInteger! Item was removed: - ----- Method: FormButtonCache>>value (in category 'accessing') ----- - value - "Answer the receiver's value, the keyboard key that selects the button." - - ^value! Item was removed: - ----- Method: FormButtonCache>>value: (in category 'accessing') ----- - value: aCharacter - "Set the receiver's key character." - - value := aCharacter! Item was removed: - MouseMenuController subclass: #FormEditor - instanceVariableNames: 'form tool grid togglegrid mode previousTool color unNormalizedColor xgridOn ygridOn hasUnsavedChanges' - classVariableNames: 'BitEditKey BlackKey BlockKey ChangeGridsKey CurveKey DarkGrayKey EraseKey FlashCursor GrayKey InKey LightGrayKey LineKey OutKey OverKey RepeatCopyKey ReverseKey SelectKey SingleCopyKey TogglexGridKey ToggleyGridKey UnderKey WhiteKey YellowButtonMenu YellowButtonMessages YgridKey' - poolDictionaries: '' - category: 'ST80-Editors'! - - !FormEditor commentStamp: 'BG 12/5/2003 22:40' prior: 0! - I represent the basic editor for creating and modifying Forms. This is intended to be an easy to use general-purpose picture (bitMap) editor. I am a kind of MouseMenuController that creates a yellow button menu for accepting and canceling edits. My instances give up control if the cursor is outside the FormView or if a key on the keyboard is pressed. - - The form to be edited is stored in instance variable model. - The instance variable form references the paint brush.! Item was removed: - ----- Method: FormEditor class>>createFullScreenForm (in category 'private') ----- - createFullScreenForm - "Create a StandardSystemView for a FormEditor on the form whole screen." - | formView formEditor menuView topView extent aForm | - aForm := Form extent: (Display extent x @ (Display extent y - 112)) depth: Display depth. - formView := FormHolderView new model: aForm. - formView borderWidthLeft: 0 right: 0 top: 0 bottom: 1. - formEditor := formView controller. - menuView := FormMenuView new makeFormEditorMenu model: formEditor. - formEditor model: menuView controller. - topView := StandardSystemView new. - topView backgroundColor: #veryLightGray. - topView model: aForm. - topView addSubView: formView. - topView - addSubView: menuView - align: menuView viewport topCenter - with: formView viewport bottomCenter + (0 at 16). - topView window: - (formView viewport - merge: (menuView viewport expandBy: (16 @ 0 corner: 16 at 16))). - topView label: 'Form Editor'. - extent := topView viewport extent. - topView minimumSize: extent. - topView maximumSize: extent. - ^topView - - ! Item was removed: - ----- Method: FormEditor class>>createOnForm: (in category 'private') ----- - createOnForm: aForm - "Create a StandardSystemView for a FormEditor on the form aForm." - | formView formEditor menuView aView topView extent topViewBorder | - topViewBorder := 2. - formView := FormHolderView new model: aForm. - formEditor := formView controller. - menuView := FormMenuView new makeFormEditorMenu model: formEditor. - formEditor model: aForm. - aView := View new. - aView model: aForm. - aView addSubView: formView. - aView - addSubView: menuView - align: menuView viewport topCenter - with: formView viewport bottomCenter + (0 at 16). - aView window: - ((formView viewport - merge: (menuView viewport expandBy: (16 @ 0 corner: 16 at 16))) - expandBy: (0 at topViewBorder corner: 0 at 0)). - topView := "ColorSystemView" FormEditorView new. - topView model: formEditor. - topView backgroundColor: #veryLightGray. - topView addSubView: aView. - topView label: 'Form Editor'. - topView borderWidth: topViewBorder. - extent := topView viewport extent. - topView minimumSize: extent. - topView maximumSize: extent. - ^topView! Item was removed: - ----- Method: FormEditor class>>flashCursor: (in category 'class initialization') ----- - flashCursor: aBoolean - - FlashCursor := aBoolean - - "FormEditor flashCursor: true"! Item was removed: - ----- Method: FormEditor class>>formFromDisplay (in category 'examples') ----- - formFromDisplay - "Create an instance of me on a new form designated by the user at a - location designated by the user." - - Form fromUser edit - - "FormEditor formFromDisplay"! Item was removed: - ----- Method: FormEditor class>>fullScreen (in category 'examples') ----- - fullScreen - "Create an instance of me on a new form that fills the full size of the - display screen." - - FormEditor openFullScreenForm - - "FormEditor fullScreen"! Item was removed: - ----- Method: FormEditor class>>initialize (in category 'class initialization') ----- - initialize - - FlashCursor := false. - self setKeyboardMap. - YellowButtonMenu := SelectionMenu - labels: - 'accept - cancel - edit - file out' - lines: #(2) - selections: #(accept cancel edit fileOut). - - "FormEditor initialize"! Item was removed: - ----- Method: FormEditor class>>newForm (in category 'examples') ----- - newForm - "Create an instance of me on a new form at a location designated by the user. " - - (Form extent: 400 @ 200 depth: Display depth) - fillWhite; - edit - - "FormEditor newForm"! Item was removed: - ----- Method: FormEditor class>>openFullScreenForm (in category 'instance creation') ----- - openFullScreenForm - "Create and schedule an instance of me on the form whose extent is the - extent of the display screen." - - | topView | - topView := self createFullScreenForm. - topView controller - openDisplayAt: (topView viewport extent//2) - - "FormEditor openFullScreenForm."! Item was removed: - ----- Method: FormEditor class>>openOnForm: (in category 'instance creation') ----- - openOnForm: aForm - "Create and schedule an instance of me on the form aForm." - - | topView | - topView := self createOnForm: aForm. - topView controller open - - ! Item was removed: - ----- Method: FormEditor class>>setKeyboardMap (in category 'private') ----- - setKeyboardMap - "Keyboard Mapping." - - SelectKey:=$a. - SingleCopyKey:=$s. "tools" - RepeatCopyKey:=$d. - LineKey:=$f. - CurveKey:=$g. - BlockKey:=$h. - OverKey:=$j. "modes" - UnderKey:=$k. - ReverseKey:=$l. - EraseKey:=$;. - InKey:=$'. "file In" - BitEditKey:=$z. - WhiteKey:=$x. "colors" - LightGrayKey:=$c. - GrayKey:=$v. - DarkGrayKey:=$b. - BlackKey:=$n. - TogglexGridKey:=$m. "gridding" - ToggleyGridKey:=$,. - ChangeGridsKey:=$.. - OutKey:=$/ "file Out"! Item was removed: - ----- Method: FormEditor>>accept (in category 'menu messages') ----- - accept - "The edited information should now be accepted by the view." - - view updateDisplay. - view accept. - hasUnsavedChanges contents: false.! Item was removed: - ----- Method: FormEditor>>block (in category 'editing tools') ----- - block - "Allow the user to fill a rectangle with the gray tone and mode currently - selected." - - | rectangle originRect | - originRect := (Sensor cursorPoint grid: grid) extent: 2 @ 2. - rectangle := Cursor corner showWhile: - [originRect newRectFrom: - [:f | f origin corner: (Sensor cursorPoint grid: grid)]]. - rectangle isNil - ifFalse: - [sensor waitNoButton. - Display - fill: (rectangle intersect: view insetDisplayBox) - rule: mode - fillColor: color. - hasUnsavedChanges contents: true.]! Item was removed: - ----- Method: FormEditor>>cancel (in category 'menu messages') ----- - cancel - "The edited information should be forgotten by the view." - - view cancel. - hasUnsavedChanges contents: false.! Item was removed: - ----- Method: FormEditor>>changeGridding (in category 'editing tools') ----- - changeGridding - "Allow the user to change the values of the horizontal and/or vertical - grid modules. Does not change the primary tool." - - | response gridInteger gridX gridY | - gridX := togglegrid x. - gridY := togglegrid y. - response := UIManager default - request: - 'Current horizontal gridding is: ', gridX printString, '. - Type new horizontal gridding.'. - response isEmpty - ifFalse: - [gridInteger := Integer readFromString: response. - gridX := ((gridInteger max: 1) min: Display extent x)]. - response := UIManager default - request: - 'Current vertical gridding is: ', gridY printString, '. - Type new vertical gridding.'. - response isEmpty - ifFalse: - [gridInteger := Integer readFromString: response. - gridY := ((gridInteger max: 1) min: Display extent y)]. - xgridOn ifTrue: [grid := gridX @ grid y]. - ygridOn ifTrue: [grid := grid x @ gridY]. - togglegrid := gridX @ gridY. - tool := previousTool! Item was removed: - ----- Method: FormEditor>>changeTool: (in category 'editing tools') ----- - changeTool: aCharacter - "Change the value of the instance variable tool to be the tool - corresponding to aCharacter. Typically sent from a Switch in a - FormMenuView." - - previousTool := tool. - tool := self selectTool: aCharacter. - (#(singleCopy repeatCopy line curve block) includes: tool) - ifFalse: - [self perform: tool]! Item was removed: - ----- Method: FormEditor>>colorBlack (in category 'editing tools') ----- - colorBlack - "Set the mask (color) to black. Leaves the tool set in its previous state." - - self setColor: Color black! Item was removed: - ----- Method: FormEditor>>colorDarkGray (in category 'editing tools') ----- - colorDarkGray - "Set the mask (color) to dark gray. Leaves the tool set in its previous - state." - - self setColor: Color darkGray! Item was removed: - ----- Method: FormEditor>>colorGray (in category 'editing tools') ----- - colorGray - "Set the color to gray. Leaves the tool set in its previous state." - - self setColor: Color gray. - ! Item was removed: - ----- Method: FormEditor>>colorLightGray (in category 'editing tools') ----- - colorLightGray - "Set the mask (color) to light gray. Leaves the tool set in its previous - state." - - self setColor: Color lightGray! Item was removed: - ----- Method: FormEditor>>colorWhite (in category 'editing tools') ----- - colorWhite - "Set the color to white. Leaves the tool set in its previous state." - - self setColor: Color white! Item was removed: - ----- Method: FormEditor>>controlActivity (in category 'control defaults') ----- - controlActivity - - super controlActivity. - self dragForm! Item was removed: - ----- Method: FormEditor>>controlInitialize (in category 'basic control sequence') ----- - controlInitialize - - Cursor crossHair show. - self normalizeColor: unNormalizedColor. - sensor waitNoButton! Item was removed: - ----- Method: FormEditor>>controlTerminate (in category 'basic control sequence') ----- - controlTerminate - "Resets the cursor to be the normal Smalltalk cursor." - - Cursor normal show. - view updateDisplay! Item was removed: - ----- Method: FormEditor>>cursorPoint (in category 'cursor') ----- - cursorPoint - "Answer the mouse coordinate data gridded according to the receiver's - grid." - - ^sensor cursorPoint grid: grid! Item was removed: - ----- Method: FormEditor>>curve (in category 'editing tools') ----- - 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 drawForm | - "sensor noButtonPressed ifTrue: [^self]." - firstPoint := self cursorPoint. - secondPoint := self rubberBandFrom: firstPoint until: [sensor noButtonPressed]. - thirdPoint := self rubberBandFrom: secondPoint until: [sensor redButtonPressed]. - Display depth > 1 - ifTrue: - [self deleteRubberBandFrom: secondPoint to: thirdPoint. - self deleteRubberBandFrom: firstPoint to: secondPoint]. - curve := CurveFitter new. - curve firstPoint: firstPoint. - curve secondPoint: secondPoint. - curve thirdPoint: thirdPoint. - drawForm := form asFormOfDepth: Display depth. - Display depth > 1 ifTrue: - [drawForm mapColor: Color white to: Color transparent; - mapColor: Color black to: color]. - - curve form: drawForm. - curve - displayOn: Display - at: 0 @ 0 - clippingBox: view insetDisplayBox - rule: (Display depth > 1 ifTrue: [mode ~= Form erase ifTrue: [Form paint] ifFalse: [mode]] - ifFalse: [mode]) - fillColor: (Display depth = 1 ifTrue: [color] ifFalse: [nil]). - sensor waitNoButton. - hasUnsavedChanges contents: true.! Item was removed: - ----- Method: FormEditor>>deleteRubberBandFrom:to: (in category 'private') ----- - deleteRubberBandFrom: startPoint to: endPoint - - (Line from: startPoint to: endPoint withForm: form) - displayOn: Display - at: 0 @ 0 - clippingBox: view insetDisplayBox - rule: Form reverse - fillColor: (Display depth = 1 ifTrue: [Color black] ifFalse: [Color gray]).! Item was removed: - ----- Method: FormEditor>>dragForm (in category 'private') ----- - dragForm - - tool = #block - ifTrue: - [Cursor origin show. - [sensor anyButtonPressed - or: [sensor keyboardPressed - or: [self viewHasCursor not]]] - whileFalse: []. - ^self cursorPoint] - ifFalse: - [^self trackFormUntil: - [sensor anyButtonPressed - or: [sensor keyboardPressed - or: [self viewHasCursor not]]]]! Item was removed: - ----- Method: FormEditor>>edit (in category 'menu messages') ----- - edit - model edit! Item was removed: - ----- Method: FormEditor>>eraseMode (in category 'editing tools') ----- - eraseMode - "Set the mode for the tools that copy the form onto the display to erase. - Leaves the tool set in its previous state." - - mode := 4. - tool := previousTool! Item was removed: - ----- Method: FormEditor>>fileInForm (in category 'editing tools') ----- - fileInForm - "Ask the user for a file name and then recalls the Form in that file as the current source Form (form). Does not change the tool." - - | fileName | - fileName := UIManager default - chooseFileMatchingSuffixes: #('form') - label: 'File name?' translated. - fileName ifNil: [^ self]. - form := Form fromFileNamed: fileName. - tool := previousTool. - ! Item was removed: - ----- Method: FormEditor>>fileOut (in category 'menu messages') ----- - fileOut - - | fileName | - fileName := UIManager default - saveFilenameRequest: 'File name?' translated - initialAnswer: 'Filename.form'. - fileName ifNil: [^ self]. - Cursor normal - showWhile: [model writeOnFileNamed: fileName]. - ! Item was removed: - ----- Method: FormEditor>>fileOutForm (in category 'editing tools') ----- - fileOutForm - "Ask the user for a file name and save the current source form under that name. Does not change the tool." - - | fileName | - fileName := UIManager default - saveFilenameRequest: 'File name?' translated - initialAnswer: 'Filename.form'. - fileName ifNil: [^ self]. - Cursor normal - showWhile: [form writeOnFileNamed: fileName]. - tool := previousTool. - ! Item was removed: - ----- Method: FormEditor>>getPluggableYellowButtonMenu: (in category 'pluggable menus') ----- - getPluggableYellowButtonMenu: shiftKeyState - ^ YellowButtonMenu! Item was removed: - ----- Method: FormEditor>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - self setVariables! Item was removed: - ----- Method: FormEditor>>isControlActive (in category 'control defaults') ----- - isControlActive - ^ super isControlActive and: [sensor keyboardPressed not]! Item was removed: - ----- Method: FormEditor>>line (in category 'editing tools') ----- - line - "Line is specified by two points from the mouse: first point--press red - button; second point--release red button. The resultant line is displayed - according to the current form and mode." - - | firstPoint endPoint drawForm | - drawForm := form asFormOfDepth: Display depth. - - Display depth > 1 - ifTrue: - [drawForm mapColor: Color white to: Color transparent; - mapColor: Color black to: color]. - - firstPoint := self cursorPoint. - endPoint := self rubberBandFrom: firstPoint until: [sensor noButtonPressed]. - endPoint isNil ifTrue: [^self]. - Display depth > 1 ifTrue: [self deleteRubberBandFrom: firstPoint to: endPoint.]. - (Line from: firstPoint to: endPoint withForm: drawForm) - displayOn: Display - at: 0 @ 0 - clippingBox: view insetDisplayBox - rule: (Display depth > 1 ifTrue: [mode ~= Form erase ifTrue: [Form paint] ifFalse: [mode]] - ifFalse: [mode]) - fillColor: (Display depth = 1 ifTrue: [color] ifFalse: [nil]). - hasUnsavedChanges contents: true.! Item was removed: - ----- Method: FormEditor>>magnify (in category 'editing tools') ----- - magnify - "Allow for bit editing of an area of the Form. The user designates a - rectangular area that is scaled by 5 to allow individual screens dots to be - modified. Red button is used to set a bit to black, and yellow button is - used to set a bit to white. Editing continues until the user depresses any - key on the keyboard." - - | smallRect smallForm scaleFactor tempRect | - scaleFactor := 8 at 8. - smallRect := (Rectangle fromUser: grid) intersect: view insetDisplayBox. - smallRect isNil ifTrue: [^self]. - smallForm := Form fromDisplay: smallRect. - - "Do this computation here in order to be able to save the existing display screen." - tempRect := Rectangle locateMagnifiedView: smallForm scale: scaleFactor. - BitEditor - openScreenViewOnForm: smallForm - at: smallRect topLeft - magnifiedAt: tempRect topLeft - scale: scaleFactor. - tool := previousTool! Item was removed: - ----- Method: FormEditor>>newSourceForm (in category 'editing tools') ----- - newSourceForm - "Allow the user to define a new source form for the FormEditor. Copying - the source form onto the display is the primary graphical operation. - Resets the tool to be repeatCopy." - | dForm interiorPoint interiorColor | - - dForm := Form fromUser: grid. - "sourceForm must be only 1 bit deep" - interiorPoint := dForm extent // 2. - interiorColor := dForm colorAt: interiorPoint. - form := (dForm makeBWForm: interiorColor) reverse - findShapeAroundSeedBlock: - [:f | f pixelValueAt: interiorPoint put: 1]. - form := form trimBordersOfColor: Color white. - tool := previousTool! Item was removed: - ----- Method: FormEditor>>normalizeColor: (in category 'private') ----- - normalizeColor: aColor - - color := aColor. - ! Item was removed: - ----- Method: FormEditor>>okToChange (in category 'window support') ----- - okToChange - - ^hasUnsavedChanges contents not - ifFalse: - [self confirm: - 'This drawing was not saved.\Is it OK to close this window?' withCRs - ] - ifTrue: - [true] - ! Item was removed: - ----- Method: FormEditor>>overMode (in category 'editing tools') ----- - overMode - "Set the mode for the tools that copy the form onto the display to over. - Leaves the tool set in its previous state." - - mode := Form over. - tool := previousTool! Item was removed: - ----- Method: FormEditor>>redButtonActivity (in category 'menu messages') ----- - redButtonActivity - "Refer to the comment in MouseMenuController|redButtonActivity." - - self perform: tool! Item was removed: - ----- Method: FormEditor>>release (in category 'initialize-release') ----- - release - "Break the cycle between the Controller and its view. It is usually not - necessary to send release provided the Controller's view has been properly - released independently." - - super release. - form := nil! Item was removed: - ----- Method: FormEditor>>repeatCopy (in category 'editing tools') ----- - repeatCopy - "As long as the red button is pressed, copy the source form onto the - display screen." - | drawingWasChanged | - drawingWasChanged := false. - [sensor redButtonPressed] - whileTrue: - [(BitBlt destForm: Display sourceForm: form halftoneForm: color - combinationRule: (Display depth > 1 ifTrue: [mode ~= Form erase ifTrue: [Form paint] ifFalse: [mode]] - ifFalse: [mode]) - destOrigin: self cursorPoint sourceOrigin: 0 at 0 extent: form extent - clipRect: view insetDisplayBox) - colorMap: (Bitmap with: 0 with: 16rFFFFFFFF); - copyBits. - drawingWasChanged := true. - ]. - drawingWasChanged - ifTrue: [hasUnsavedChanges contents: true.]! Item was removed: - ----- Method: FormEditor>>reverseMode (in category 'editing tools') ----- - reverseMode - "Set the mode for the tools that copy the form onto the display to reverse. - Leaves the tool set in its previous state." - - mode := Form reverse. - tool := previousTool! Item was removed: - ----- Method: FormEditor>>rubberBandFrom:until: (in category 'private') ----- - rubberBandFrom: startPoint until: aBlock - - | endPoint previousEndPoint | - previousEndPoint := startPoint. - [aBlock value] whileFalse: - [(endPoint := self cursorPoint) = previousEndPoint - ifFalse: - [(Line from: startPoint to: previousEndPoint withForm: form) - displayOn: Display - at: 0 @ 0 - clippingBox: view insetDisplayBox - rule: Form reverse - fillColor: Color gray. - (Line from: startPoint to: endPoint withForm: form) - displayOn: Display - at: 0 @ 0 - clippingBox: view insetDisplayBox - rule: Form reverse - fillColor: Color gray. - previousEndPoint := endPoint]]. - (Line from: startPoint to: previousEndPoint withForm: form) - displayOn: Display - at: 0 @ 0 - clippingBox: view insetDisplayBox - rule: Form reverse - fillColor: (Display depth = 1 ifTrue: [Color gray] ifFalse: [Color black]). - ^endPoint! Item was removed: - ----- Method: FormEditor>>selectTool: (in category 'private') ----- - selectTool: aCharacter - "A new tool has been selected. It is denoted by aCharacter. Set the tool. - This code is written out in long hand (i.e., rather than dispatching on a - table of options) so that it is obvious what is happening." - - aCharacter = SingleCopyKey ifTrue: [^#singleCopy]. - aCharacter = RepeatCopyKey ifTrue: [^#repeatCopy]. - aCharacter = LineKey ifTrue: [^#line]. - aCharacter = CurveKey ifTrue: [^#curve]. - aCharacter = BlockKey ifTrue: [^#block]. - aCharacter = SelectKey ifTrue: [^#newSourceForm]. - aCharacter = OverKey ifTrue: [^#overMode]. - aCharacter = UnderKey ifTrue: [^#underMode]. - aCharacter = ReverseKey ifTrue: [^#reverseMode]. - aCharacter = EraseKey ifTrue: [^#eraseMode]. - aCharacter = ChangeGridsKey ifTrue: [^#changeGridding]. - aCharacter = TogglexGridKey ifTrue: [^#togglexGridding]. - aCharacter = ToggleyGridKey ifTrue: [^#toggleyGridding]. - aCharacter = BitEditKey ifTrue: [^#magnify]. - aCharacter = WhiteKey ifTrue: [^#colorWhite]. - aCharacter = LightGrayKey ifTrue: [^#colorLightGray]. - aCharacter = GrayKey ifTrue: [^#colorGray]. - aCharacter = DarkGrayKey ifTrue: [^#colorDarkGray]. - aCharacter = BlackKey ifTrue: [^#colorBlack]. - aCharacter = OutKey ifTrue: [^#fileOutForm]. - aCharacter = InKey ifTrue: [^#fileInForm]! Item was removed: - ----- Method: FormEditor>>setColor: (in category 'editing tools') ----- - setColor: aColor - "Set the mask (color) to aColor. - Hacked to invoke color chooser if not B/W screen. - Leaves the tool set in its previous state." - - self normalizeColor: (unNormalizedColor := Display depth > 1 - ifTrue: [Color fromUser] - ifFalse: [aColor]). - tool := previousTool! Item was removed: - ----- Method: FormEditor>>setVariables (in category 'private') ----- - setVariables - tool := #repeatCopy. - previousTool := tool. - grid := 1 @ 1. - togglegrid := 8 @ 8. - xgridOn := false. - ygridOn := false. - mode := Form over. - form := Form extent: 8 @ 8. - form fillBlack. - unNormalizedColor := color := Color black. - hasUnsavedChanges := ValueHolder new contents: false. - ! Item was removed: - ----- Method: FormEditor>>singleCopy (in category 'editing tools') ----- - singleCopy - "If the red button is clicked, copy the source form onto the display - screen." - - (BitBlt destForm: Display - sourceForm: form halftoneForm: color - combinationRule: (Display depth > 1 ifTrue: [mode ~= Form erase ifTrue: [Form paint] ifFalse: [mode]] - ifFalse: [mode]) - destOrigin: self cursorPoint sourceOrigin: 0 at 0 extent: form extent - clipRect: view insetDisplayBox) - colorMap: (Bitmap with: 0 with: 16rFFFFFFFF); - copyBits. - sensor waitNoButton. - hasUnsavedChanges contents: true.! Item was removed: - ----- Method: FormEditor>>togglexGridding (in category 'editing tools') ----- - togglexGridding - "Turn x (horizontal) gridding off, if it is on, and turns it on, if it is off. - Does not change the primary tool." - - xgridOn - ifTrue: - [grid := 1 @ grid y. - xgridOn := false] - ifFalse: - [grid := togglegrid x @ grid y. - xgridOn := true]. - tool := previousTool! Item was removed: - ----- Method: FormEditor>>toggleyGridding (in category 'editing tools') ----- - toggleyGridding - "Turn y (vertical) gridding off, if it is on, and turns it on, if it is off. - Does not change the primary tool." - - ygridOn - ifTrue: - [grid := grid x @ 1. - ygridOn := false] - ifFalse: - [grid := grid x @ togglegrid y. - ygridOn := true]. - tool := previousTool! Item was removed: - ----- Method: FormEditor>>trackFormUntil: (in category 'private') ----- - trackFormUntil: aBlock - - | previousPoint cursorPoint displayForm | - previousPoint := self cursorPoint. - displayForm := Form extent: form extent depth: form depth. - displayForm copy: (0 @ 0 extent: form extent) - from: form - to: 0 @ 0 - rule: Form over. - Display depth > 1 ifTrue: [displayForm reverse]. - displayForm displayOn: Display at: previousPoint rule: Form reverse. - [aBlock value] whileFalse: - [cursorPoint := self cursorPoint. - (FlashCursor or: [cursorPoint ~= previousPoint]) - ifTrue: - [displayForm displayOn: Display at: previousPoint rule: Form reverse. - displayForm displayOn: Display at: cursorPoint rule: Form reverse. - previousPoint := cursorPoint]]. - displayForm displayOn: Display at: previousPoint rule: Form reverse. - ^previousPoint! Item was removed: - ----- Method: FormEditor>>underMode (in category 'editing tools') ----- - underMode - "Set the mode for the tools that copy the form onto the display to under. - Leaves the tool set in its previous state." - - mode := Form under. - tool := previousTool! Item was removed: - StandardSystemView subclass: #FormEditorView - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Editors'! Item was removed: - FormView subclass: #FormHolderView - instanceVariableNames: 'displayedForm' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Views'! - - !FormHolderView commentStamp: '<historical>' prior: 0! - I represent a view of a Form. Editing takes place by modifying a working version of the Form. The message accept is used to copy the working version into the Form; the message cancel copies the Form into the working version.! Item was removed: - ----- Method: FormHolderView>>accept (in category 'menu messages') ----- - accept - "Refer to the comment in FormView|accept." - model - copyBits: displayedForm boundingBox - from: displayedForm - at: 0 @ 0 - clippingBox: model boundingBox - rule: Form over - fillColor: nil. - model changed: self! Item was removed: - ----- Method: FormHolderView>>cancel (in category 'menu messages') ----- - cancel - "Refer to the comment in FormView|cancel." - - displayedForm becomeForward: model deepCopy. - displayedForm changed: self. - self display! Item was removed: - ----- Method: FormHolderView>>changeValueAt:put: (in category 'model access') ----- - changeValueAt: location put: anInteger - "Refer to the comment in FormView|changeValueAt:put:." - - displayedForm pixelValueAt: location put: anInteger. - displayedForm changed: self! Item was removed: - ----- Method: FormHolderView>>displayView (in category 'displaying') ----- - displayView - "Display the Form associated with this View according to the rule and - fillColor specifed by this class." - - | oldOffset | - oldOffset := displayedForm offset. - displayedForm offset: 0 at 0. - displayedForm - displayOn: Display - transformation: self displayTransformation - clippingBox: self insetDisplayBox - rule: self rule - fillColor: self fillColor. - displayedForm offset: oldOffset! Item was removed: - ----- Method: FormHolderView>>model: (in category 'model access') ----- - model: aForm - - super model: aForm. - displayedForm := aForm deepCopy! Item was removed: - ----- Method: FormHolderView>>release (in category 'initialize-release') ----- - release - - super release. - displayedForm release. - displayedForm := nil! Item was removed: - ----- Method: FormHolderView>>updateDisplay (in category 'displaying') ----- - updateDisplay - "The working version is redefined by copying the bits displayed in the - receiver's display area." - - displayedForm fromDisplay: self displayBox. - displayedForm changed: self! Item was removed: - ----- Method: FormHolderView>>workingForm (in category 'model access') ----- - workingForm - "Answer the form that is currently being displayed--the working version - in which edits are carried out." - - ^displayedForm! Item was removed: - FormView subclass: #FormInspectView - instanceVariableNames: 'offset' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Views'! Item was removed: - ----- Method: FormInspectView class>>openOn:withLabel: (in category 'instance creation') ----- - openOn: aFormDictionary withLabel: aLabel - "open a graphical dictionary in a window having the label aLabel. - aFormDictionary should be a dictionary containing as value a form." - - ^ aFormDictionary inspectWithLabel: aLabel - ! Item was removed: - ----- Method: FormInspectView>>defaultControllerClass (in category 'controller access') ----- - defaultControllerClass - "Refer to the comment in View|defaultControllerClass." - - ^ NoController! Item was removed: - ----- Method: FormInspectView>>displayView (in category 'displaying') ----- - displayView - "Display the form as a value in an inspector. 8/11/96 sw" - "Defeated form scaling for HS FormInspector. 8/20/96 di" - | scale | - Display fill: self insetDisplayBox fillColor: Color white. - model selectionIndex = 0 ifTrue: [^ self]. - scale := self insetDisplayBox extent / model selection extent. - scale := (scale x min: scale y) min: 1. - model selection - displayOn: Display - transformation: (WindowingTransformation - scale: scale asPoint - translation: self insetDisplayBox topLeft - model selection offset) - clippingBox: self insetDisplayBox - rule: self rule - fillColor: self fillColor! Item was removed: - Controller subclass: #FormMenuController - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Editors'! - - !FormMenuController commentStamp: '<historical>' prior: 0! - I represent a Controller that takes control if a key on the keyboard is depressed or if the cursor is within my rectangular area.! Item was removed: - ----- Method: FormMenuController>>controlActivity (in category 'control defaults') ----- - controlActivity - "Pass control to a subView corresponding to a pressed keyboard key or to - a mouse button pressed, if any." - - sensor keyboardPressed - ifTrue: [self processMenuKey] - ifFalse: [self controlToNextLevel]! Item was removed: - ----- Method: FormMenuController>>isControlActive (in category 'control defaults') ----- - isControlActive - "Answer false if the blue mouse button is pressed and the cursor is - outside of the inset display box of the Controller's view; answer true, - otherwise." - - ^sensor keyboardPressed | - (view containsPoint: sensor cursorPoint) & sensor blueButtonPressed not! Item was removed: - ----- Method: FormMenuController>>isControlWanted (in category 'control defaults') ----- - isControlWanted - "Answer true if the cursor is inside the inset display box (see - View|insetDisplayBox) of the receiver's view, and answer false, - otherwise. It is sent by Controller|controlNextLevel in order to determine - whether or not control should be passed to this receiver from the - Controller of the superView of this receiver's view." - - ^sensor keyboardPressed | self viewHasCursor! Item was removed: - ----- Method: FormMenuController>>processMenuKey (in category 'control defaults') ----- - processMenuKey - "The user typed a key on the keyboard. Perform the action of the button whose shortcut is that key, if any." - - | aView | - aView := view subViewContainingCharacter: sensor keyboard. - aView ~~ nil ifTrue: [aView performAction]. - ! Item was removed: - View subclass: #FormMenuView - instanceVariableNames: '' - classVariableNames: 'BorderForm FormButtons SpecialBorderForm' - poolDictionaries: '' - category: 'ST80-Editors'! - - !FormMenuView commentStamp: '<historical>' prior: 0! - I represent a View whose subViews are Switches (and Buttons and OneOnSwitches) whose actions set the mode, color, and tool for editing a Form on the screen. The default controller of my instances is FormMenuController.! Item was removed: - ----- Method: FormMenuView class>>fileOut (in category 'class initialization') ----- - fileOut - "Save the FormEditor button icons." - "FormMenuView fileOut" - - | names | - names := - #('select.form' 'singlecopy.form' 'repeatcopy.form' 'line.form' 'curve.form' - 'block.form' 'over.form' 'under.form' 'reverse.form' 'erase.form' 'in.form' - 'magnify.form' 'white.form' 'lightgray.form' 'gray.form' 'darkgray.form' 'black.form' - 'xgrid.form' 'ygrid.form' 'togglegrids.form' 'out.form'). - 1 to: FormButtons size do: [:i | - (FormButtons at: i) form writeOnFileNamed: (names at: i)]. - SpecialBorderForm writeOnFileNamed: 'specialborderform.form'. - BorderForm writeOnFileNamed: 'borderform.form'. - ! Item was removed: - ----- Method: FormMenuView class>>formButtons (in category 'accessing') ----- - formButtons - - ^FormButtons! Item was removed: - ----- Method: FormMenuView class>>initialize2 (in category 'class initialization') ----- - initialize2 - "The icons for the menu are typically stored on files. In order to avoid reading them every time, they are stored in a collection in a class variable, along with their offset, tool value, and initial visual state (on or off)." - "FormMenuView initialize" - - | offsets keys states names button | - offsets := OrderedCollection new: 21. - #(0 64 96 128 160 192 256 288 320 352 420) do: [:i | offsets addLast: i at 0]. "First row" - #(0 64 96 128 160 192 256 304 352 420) do: [:i | offsets addLast: i at 48]. "Second row" - offsets := offsets asArray. - keys := #($a $s $d $f $g $h $j $k $l $; $' $z $x $c $v $b $n $m $, $. $/ ). "Keyboard" - states := #( - #false #false #true #false #false #false #true #false #false #false #false - #false #false #false #false #false #true #false #false #false #false). "Initial button states" - names := - #('select.form' 'singlecopy.form' 'repeatcopy.form' 'line.form' 'curve.form' - 'block.form' 'over.form' 'under.form' 'reverse.form' 'erase.form' 'in.form' - 'magnify.form' 'white.form' 'lightgray.form' 'gray.form' 'darkgray.form' 'black.form' - 'xgrid.form' 'ygrid.form' 'togglegrids.form' 'out.form'). "Files of button images" - FormButtons := OrderedCollection new. - 1 to: 21 do: [:index | - button := FormButtonCache new. - button form: (Form fromFileNamed: (names at: index)). - button offset: (offsets at: index). - button value: (keys at: index). - button initialState: (states at: index). - FormButtons addLast: button]. - SpecialBorderForm := Form fromFileNamed: 'specialborderform.form'. - BorderForm := Form fromFileNamed: 'borderform.form'. - ! Item was removed: - ----- Method: FormMenuView>>defaultControllerClass (in category 'controller access') ----- - defaultControllerClass - "Refer to the comment in View|defaultControllerClass." - - ^FormMenuController! Item was removed: - ----- Method: FormMenuView>>makeButton: (in category 'private') ----- - makeButton: index - - | buttonCache button | - buttonCache := (FormButtons at: index) shallowCopy. - buttonCache form: (FormButtons at: index) form copy. - button := Button newOff. - button onAction: [model changeTool: buttonCache value]. - self makeViews: buttonCache for: button. - ! Item was removed: - ----- Method: FormMenuView>>makeColorConnections: (in category 'private') ----- - makeColorConnections: indexInterval - - | connector aSwitchView | - connector := Object new. "a dummy model for connecting dependents" - indexInterval do: [:index | | button buttonCache | - buttonCache := (FormButtons at: index) shallowCopy. - buttonCache form: (FormButtons at: index) form copy. - buttonCache initialState = #true - ifTrue: [button := OneOnSwitch newOn] - ifFalse: [button := OneOnSwitch newOff]. - button onAction: [model changeTool: buttonCache value]. - button connection: connector. - aSwitchView := self makeViews: buttonCache for: button. - aSwitchView - borderWidthLeft: 1 right: 0 top: 1 bottom: 1; - action: #turnOn]. - aSwitchView borderWidth: 1. - ! Item was removed: - ----- Method: FormMenuView>>makeConnections: (in category 'private') ----- - makeConnections: indexInterval - - | connector aSwitchView | - connector := Object new. "a dummy model for connecting dependents." - indexInterval do: [:index | | button buttonCache | - buttonCache := (FormButtons at: index) shallowCopy. - buttonCache form: (FormButtons at: index) form copy. - buttonCache initialState = #true - ifTrue: [button := OneOnSwitch newOn] - ifFalse: [button := OneOnSwitch newOff]. - button onAction: [model changeTool: buttonCache value]. - button connection: connector. - aSwitchView := self makeViews: buttonCache for: button. - aSwitchView - borderWidthLeft: 1 right: 0 top: 1 bottom: 1; - action: #turnOn]. - aSwitchView borderWidth: 1. - ! Item was removed: - ----- Method: FormMenuView>>makeFormEditorMenu (in category 'initialize-release') ----- - makeFormEditorMenu - - | button buttonCache form aSwitchView aSwitchController| - "Now get those forms into the subviews" - self makeButton: 1. "form source" - self makeConnections: (2 to: 6). "tools" - self makeConnections: (7 to: 10). "modes" - self makeButton: 11. "filing in" - self makeButton: 12. "bit editing" - self makeColorConnections: (13 to: 17). "colors" - self makeGridSwitch: 18. "toggle x" - self makeGridSwitch: 19. "toggle y" - self makeButton: 20. "setting grid" - self makeButton: 21 "filing out"! Item was removed: - ----- Method: FormMenuView>>makeGridSwitch: (in category 'private') ----- - makeGridSwitch: index - - | buttonCache button | - buttonCache := FormButtons at: index. - buttonCache form: (FormButtons at: index) form copy. - buttonCache initialState = #true - ifTrue: [button := Switch newOn] - ifFalse: [button := Switch newOff]. - button onAction: [model changeTool: buttonCache value]. - button offAction: [model changeTool: buttonCache value]. - self makeViews: buttonCache for: button. - ! Item was removed: - ----- Method: FormMenuView>>makeSwitch: (in category 'private') ----- - makeSwitch: index - - | buttonCache button | - buttonCache := (FormButtons at: index) shallowCopy. - buttonCache form: (FormButtons at: index) form copy. - buttonCache initialState = #true - ifTrue: [button := Switch newOn] - ifFalse: [button := Switch newOff]. - button onAction: [model changeTool: buttonCache value]. - self makeViews: buttonCache for: button. - ! Item was removed: - ----- Method: FormMenuView>>makeViews:for: (in category 'private') ----- - makeViews: cache for: aSwitch - - | form aSwitchView | - form := cache form. - aSwitchView := PluggableButtonView - on: aSwitch - getState: #isOn - action: #switch. - aSwitchView - label: form; - shortcutCharacter: cache value; - window: (0 at 0 extent: form extent); - translateBy: cache offset; - borderWidth: 1. - self addSubView: aSwitchView. - ^ aSwitchView - ! Item was removed: - ----- Method: FormMenuView>>subViewContainingCharacter: (in category 'subView access') ----- - subViewContainingCharacter: aCharacter - "Answer the receiver's subView that corresponds to the key, aCharacter. - Answer nil if no subView is selected by aCharacter." - - self subViews reverseDo: - [:aSubView | - (aSubView shortcutCharacter = aCharacter) ifTrue: [^aSubView]]. - ^nil - ! Item was removed: - View subclass: #FormView - instanceVariableNames: 'rule mask' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Views'! - - !FormView commentStamp: '<historical>' prior: 0! - I represent a view of a Form.! Item was removed: - ----- Method: FormView class>>exampleOne (in category 'examples') ----- - exampleOne - "Frame a Form (specified by the user) with a border of 2 bits in width and display it offset 60 x 40 from the cornor of the display screen. " - | f view | - f := Form fromUser. - view := self new model: f. - view translateBy: 60 @ 40. - view borderWidth: 2. - view display. - view release - - "FormView exampleOne"! Item was removed: - ----- Method: FormView class>>exampleTwo (in category 'examples') ----- - exampleTwo - "Frame a Form (specified by the user) that is scaled by 2. The border is 2 bits in width. Displays at location 60, 40." - | f view | - f := Form fromUser. - view := self new model: f. - view scaleBy: 2.0. - view translateBy: 60 @ 40. - view borderWidth: 2. - view display. - view release - - "FormView exampleTwo"! Item was removed: - ----- Method: FormView class>>open:named: (in category 'examples') ----- - open: aForm named: aString - "FormView open: ((Form extent: 100 at 100) borderWidth: 1) named: 'Squeak' " - "Open a window whose model is aForm and whose label is aString." - | topView aView | - topView := StandardSystemView new. - topView model: aForm. - topView label: aString. - topView minimumSize: aForm extent; - maximumSize: aForm extent. - aView := FormView new. - aView model: aForm. - aView window: (aForm boundingBox expandBy: 2). - aView borderWidthLeft: 2 right: 2 top: 2 bottom: 2. - topView addSubView: aView. - topView controller open! Item was removed: - ----- Method: FormView>>accept (in category 'menu messages') ----- - accept - "The receiver's model is set to the working version, the one in which - edits are carried out." - - ^self! Item was removed: - ----- Method: FormView>>cancel (in category 'menu messages') ----- - cancel - "Set the working form to be a copy of the model." - - ^self! Item was removed: - ----- Method: FormView>>changeValueAt:put: (in category 'model access') ----- - changeValueAt: location put: anInteger - "The receiver's model is a form which has an array of bits. Change the - bit at index, location, to be anInteger (either 1 or 0). Inform all objects - that depend on the model that it has changed." - - model pixelValueAt: location put: anInteger. - model changed: self! Item was removed: - ----- Method: FormView>>defaultControllerClass (in category 'controller access') ----- - defaultControllerClass - "Refer to the comment in View|defaultControllerClass." - - ^ FormEditor! Item was removed: - ----- Method: FormView>>defaultRule (in category 'private') ----- - defaultRule - "The default display rule is 3=over or storing." - - ^Form over! Item was removed: - ----- Method: FormView>>defaultWindow (in category 'window access') ----- - defaultWindow - "Refer to the comment in View|defaultWindow." - - ^(Rectangle origin: 0 @ 0 extent: model extent) - expandBy: borderWidth! Item was removed: - ----- Method: FormView>>displayOn: (in category 'displaying') ----- - displayOn: aPort - model displayOnPort: aPort at: self displayBox origin! Item was removed: - ----- Method: FormView>>displayView (in category 'displaying') ----- - displayView - "Refer to the comment in View|displayView." - - | oldOffset | - super displayView. - insideColor == nil ifFalse: [Display fill: self insetDisplayBox fillColor: insideColor]. - oldOffset := model offset. - model offset: "borderWidth origin" 0 at 0. - model - displayOn: Display - transformation: self displayTransformation - clippingBox: self insetDisplayBox - rule: self rule - fillColor: self fillColor. - model offset: oldOffset! Item was removed: - ----- Method: FormView>>fillColor (in category 'accessing') ----- - fillColor - "Answer an instance of class Form that is the mask used when displaying - the receiver's model (a Form) on the display screen (see BitBlt for the - meaning of this mask)." - - ^ mask! Item was removed: - ----- Method: FormView>>fillColor: (in category 'accessing') ----- - fillColor: aForm - "Set the display mask for displaying the receiver's model to be the - argument, aForm." - - mask := aForm! Item was removed: - ----- Method: FormView>>mask (in category 'accessing') ----- - mask - "Answer an instance of class Form that is the mask used when displaying - the receiver's model (a Form) on the display screen (see BitBlt for the - meaning of this mask)." - - ^ mask! Item was removed: - ----- Method: FormView>>rule (in category 'accessing') ----- - rule - "Answer a number from 0 to 15 that indicates which of the sixteen - display rules (logical function of two boolean values) is to be used when - copying the receiver's model (a Form) onto the display screen." - - rule == nil - ifTrue: [^self defaultRule] - ifFalse: [^rule]! Item was removed: - ----- Method: FormView>>rule: (in category 'accessing') ----- - rule: anInteger - "Set the display rule for the receiver to be the argument, anInteger." - - rule := anInteger! Item was removed: - ----- Method: FormView>>uncacheBits (in category 'displaying') ----- - uncacheBits - "Placed vacuously here so that when ControlManager>>restore calls uncacheBits for a project with no windows, we don't hang. 1/24/96 sw"! Item was removed: - ----- Method: FormView>>update: (in category 'updating') ----- - update: aFormView - "Refer to the comment in View|update:." - - self == aFormView ifFalse: [self display]! Item was removed: - ----- Method: FormView>>updateDisplay (in category 'displaying') ----- - updateDisplay - "overridden by subclass"! Item was removed: - ----- Method: FormView>>windowBox (in category 'window access') ----- - windowBox - "For comaptibility with Control manager (see senders)" - ^ self insetDisplayBox! Item was removed: - OrderedCollection variableSubclass: #GraphicSymbol - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Symbols'! - - !GraphicSymbol commentStamp: '<historical>' prior: 0! - I represent a structured picture built from primitive display objects and other instances of me.! Item was removed: - ----- Method: GraphicSymbol>>computeBoundingBox (in category 'accessing') ----- - computeBoundingBox - "Compute a boundingBox that encloses all of the Paths in this symbol" - - ^Rectangle merging: (self collect: [:each | each computeBoundingBox]) - ! Item was removed: - ----- Method: GraphicSymbol>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm - "Display the receiver on the Display where aTransformation is provided - as an argument, rule is anInteger and mask is aForm. No translation. - Information to be displayed must be confined to the area that intersects - with clipRect." - - self do: - [:element | - element - displayOn: aDisplayMedium - transformation: aTransformation - clippingBox: clipRect - rule: anInteger - fillColor: aForm]! Item was removed: - ----- Method: GraphicSymbol>>displayTransformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayTransformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm - "Display the receiver where aTransformation is provided as an argument, - rule is anInteger and mask is aForm. No translation. Information to be - displayed must be confined to the area that intersects with clipRect." - - self displayOn: Display transformation: aTransformation clippingBox: clipRect - rule: anInteger fillColor: aForm! Item was removed: - Object subclass: #GraphicSymbolInstance - instanceVariableNames: 'transformation graphicSymbol' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Symbols'! - - !GraphicSymbolInstance commentStamp: '<historical>' prior: 0! - I represent a display transformation of a GraphicSymbol. Multiple copies of a GraphicSymbol can be displayed at different positions and scales on the screen by making appropriate, multiple, instances of me.! Item was removed: - ----- Method: GraphicSymbolInstance class>>example (in category 'examples') ----- - example - "Simply evaluate the method and two GraphicSymbolInstances, each - displaying a transformation of the same graphic symbol, will be - presented on the screen. Clears the screen to white." - - | gate instance1 instance2 trans1 trans2 line arc f| - Display fillWhite. "clear the Screen." - f := Form extent: 2 @ 2. - f fillBlack. - gate:= GraphicSymbol new. "make a logic gate out of lines and arcs." - line:=Line new. line beginPoint: -20 @ -20. line endPoint: 0 @ -20. line form: f. - gate add: line. - - line:=Line new. line beginPoint: -20 @ 20. line endPoint: 0 @ 20. line form: f. - gate add: line. - - line:=Line new. line beginPoint: 0 @ -40. line endPoint: 0 @ 40. line form: f. - gate add: line. - - arc := Arc new. arc center: 0 @ 0 radius: 40 quadrant: 1. - arc form: f. - gate add: arc. - - arc := Arc new. arc center: 0 @ 0 radius: 40 quadrant: 4. - arc form: f. - gate add: arc. - - "one instance at 1/2 scale." - trans1:=WindowingTransformation identity. - trans1:= trans1 scaleBy: 0.5 @ 0.5. - trans1:= trans1 translateBy: 100 @ 100. - - "the other instance at 2 times scale" - trans2:=WindowingTransformation identity. - trans2:= trans2 scaleBy: 2.0 @ 2.0. - trans2:= trans2 translateBy: 200 @ 200. - - instance1 := GraphicSymbolInstance new. - instance1 transformation: trans1. - instance1 graphicSymbol: gate. - - instance2 := GraphicSymbolInstance new. - instance2 transformation: trans2. - instance2 graphicSymbol: gate. - - "display both instances of the logic gate" - instance1 displayOn: Display - transformation: WindowingTransformation identity - clippingBox: Display boundingBox - rule: Form under - fillColor: nil. - instance2 displayOn: Display - transformation: WindowingTransformation identity - clippingBox: Display boundingBox - rule: Form under - fillColor: nil - - "GraphicSymbolInstance example"! Item was removed: - ----- Method: GraphicSymbolInstance>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: aTransformation clippingBox: - clipRect rule: anInteger fillColor: aForm - "Display the graphic symbol on the Display according to the arguments - of this message." - - graphicSymbol - displayOn: aDisplayMedium - transformation: aTransformation - clippingBox: clipRect - rule: anInteger - fillColor: aForm! Item was removed: - ----- Method: GraphicSymbolInstance>>displayTransformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayTransformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm - "Display the graphic symbol according to the arguments of this message." - - self displayOn: Display transformation: aTransformation clippingBox: clipRect - rule: anInteger fillColor: aForm! Item was removed: - ----- Method: GraphicSymbolInstance>>graphicSymbol (in category 'accessing') ----- - graphicSymbol - "Answer the graphic symbol that the receiver displays." - - ^graphicSymbol! Item was removed: - ----- Method: GraphicSymbolInstance>>graphicSymbol: (in category 'accessing') ----- - graphicSymbol: aGraphicSymbol - "Set the argument, aGraphicSymbol, to be the graphic symbol that the - receiver displays." - - graphicSymbol := aGraphicSymbol! Item was removed: - ----- Method: GraphicSymbolInstance>>transformation (in category 'transforming') ----- - transformation - "Answer the receiver's display transformation." - - ^transformation! Item was removed: - ----- Method: GraphicSymbolInstance>>transformation: (in category 'transforming') ----- - transformation: aWindowingTransformation - "Set the argument, aWindowingTransformation, to be the receiver's - display transformation." - - transformation := aWindowingTransformation! Item was removed: - Path subclass: #Line - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Paths'! - - !Line commentStamp: '<historical>' prior: 0! - I represent the line segment specified by two points.! Item was removed: - ----- Method: Line class>>example (in category 'examples') ----- - example - "Designate two places on the screen by clicking any mouse button. A - straight path with a square black form will be displayed connecting the - two selected points." - - | aLine aForm | - aForm := Form extent: 20 at 20. "make a form one quarter of inch square" - aForm fillBlack. "turn it black" - aLine := Line new. - aLine form: aForm. "use the black form for display" - aLine beginPoint: Sensor waitButton. Sensor waitNoButton. - aForm displayOn: Display at: aLine beginPoint. - aLine endPoint: Sensor waitButton. - aLine displayOn: Display. "display the line" - - "Line example"! Item was removed: - ----- Method: Line class>>from:to:withForm: (in category 'instance creation') ----- - from: beginPoint to: endPoint withForm: aForm - "Answer an instance of me with end points begingPoint and endPoint; - the source form for displaying the line is aForm." - - | newSelf | - newSelf := super new: 2. - newSelf add: beginPoint. - newSelf add: endPoint. - newSelf form: aForm. - ^newSelf! Item was removed: - ----- Method: Line class>>new (in category 'instance creation') ----- - new - - | newSelf | - newSelf := super new: 2. - newSelf add: 0 at 0. - newSelf add: 0 at 0. - ^newSelf! Item was removed: - ----- Method: Line>>beginPoint (in category 'accessing') ----- - beginPoint - "Answer the first end point of the receiver." - - ^self first! Item was removed: - ----- Method: Line>>beginPoint: (in category 'accessing') ----- - beginPoint: aPoint - "Set the first end point of the receiver to be the argument, aPoint. - Answer aPoint." - - self at: 1 put: aPoint. - ^aPoint! Item was removed: - ----- Method: Line>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger fillColor: aForm - "The form associated with this Path will be displayed, according - to one of the sixteen functions of two logical variables (rule), at - each point on the Line. Also the source form will be first anded - with aForm as a mask. Does not effect the state of the Path." - - collectionOfPoints size < 2 ifTrue: [self error: 'a line must have two points']. - aDisplayMedium - drawLine: self form - from: self beginPoint + aPoint - to: self endPoint + aPoint - clippingBox: clipRect - rule: anInteger - fillColor: aForm! Item was removed: - ----- Method: Line>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm - - | newPath newLine | - newPath := aTransformation applyTo: self. - newLine := Line new. - newLine beginPoint: newPath firstPoint. - newLine endPoint: newPath secondPoint. - newLine form: self form. - newLine - displayOn: aDisplayMedium - at: 0 @ 0 - clippingBox: clipRect - rule: anInteger - fillColor: aForm! Item was removed: - ----- Method: Line>>displayOnPort:at: (in category 'displaying') ----- - displayOnPort: aPort at: aPoint - aPort sourceForm: self form; combinationRule: Form under; fillColor: nil. - aPort drawFrom: collectionOfPoints first + aPoint - to: collectionOfPoints last + aPoint! Item was removed: - ----- Method: Line>>endPoint (in category 'accessing') ----- - endPoint - "Answer the last end point of the receiver." - - ^self last! Item was removed: - ----- Method: Line>>endPoint: (in category 'accessing') ----- - endPoint: aPoint - "Set the first end point of the receiver to be the argument, aPoint. - Answer aPoint." - - self at: 2 put: aPoint. - ^aPoint! Item was removed: - Path subclass: #LinearFit - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Paths'! - - !LinearFit commentStamp: '<historical>' prior: 0! - I represent a piece-wise linear approximation to a set of points in the plane.! Item was removed: - ----- Method: LinearFit class>>example (in category 'examples') ----- - example - "Select points on a Path using the red button. Terminate by selecting - any other button. Creates a Path from the points and displays it as a - piece-wise linear approximation." - - | aLinearFit aForm flag | - aLinearFit := LinearFit new. - aForm := Form extent: 1 @ 40. - aForm fillBlack. - aLinearFit form: aForm. - flag := true. - [flag] whileTrue: - [Sensor waitButton. - Sensor redButtonPressed - ifTrue: [aLinearFit add: Sensor waitButton. Sensor waitNoButton. - aForm displayOn: Display at: aLinearFit last] - ifFalse: [flag:=false]]. - aLinearFit displayOn: Display - - "LinearFit example"! Item was removed: - ----- Method: LinearFit>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger - fillColor: aForm - - | line | - line := Line new. - line form: self form. - 1 to: self size - 1 do: - [:i | - line beginPoint: (self at: i). - line endPoint: (self at: i + 1). - line displayOn: aDisplayMedium - at: aPoint - clippingBox: clipRect - rule: anInteger - fillColor: aForm]! Item was removed: - ----- Method: LinearFit>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: aTransformation clippingBox: - clipRect rule: anInteger fillColor: aForm - - | transformedPath | - "get the scaled and translated Path." - transformedPath := aTransformation applyTo: self. - transformedPath - displayOn: aDisplayMedium - at: 0 @ 0 - clippingBox: clipRect - rule: anInteger - fillColor: aForm! Item was removed: - ScrollController subclass: #ListController - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Support'! - - !ListController commentStamp: '<historical>' prior: 0! - I am a kind of ScrollController that assumes that the view is a kind of ListView. Therefore, scrolling means moving the items in a textual list (menu) up or down. In addition, I provide the red button activity of determining when the red button is selecting an item in the list.! Item was removed: - ----- Method: ListController>>changeModelSelection: (in category 'private') ----- - changeModelSelection: anInteger - model toggleListIndex: anInteger! Item was removed: - ----- Method: ListController>>computeMarkerRegion (in category 'marker adjustment') ----- - computeMarkerRegion - "Refer to the comment in ScrollController|computeMarkerRegion." - - | viewList | - viewList := view list. - viewList compositionRectangle height = 0 - ifTrue: [^ 0 at 0 extent: Preferences scrollBarWidth at scrollBar inside height]. - ^ 0 at 0 extent: Preferences scrollBarWidth@ - ((viewList clippingRectangle height asFloat / - viewList compositionRectangle height * - scrollBar inside height) - rounded min: scrollBar inside height)! Item was removed: - ----- Method: ListController>>controlActivity (in category 'control defaults') ----- - controlActivity - self scrollByMouseWheel ifTrue: [^self]. - self scrollByKeyboard ifTrue: [^self]. - self processKeyboard. - super controlActivity. - ! Item was removed: - ----- Method: ListController>>markerDelta (in category 'marker adjustment') ----- - markerDelta - - | viewList | - viewList := view list. - viewList compositionRectangle height = 0 ifTrue: [ - ^ (marker top - scrollBar inside top) - scrollBar inside height - ]. - ^ (marker top - scrollBar inside top) - - ((viewList clippingRectangle top - - viewList compositionRectangle top) asFloat / - viewList compositionRectangle height asFloat * - scrollBar inside height asFloat) rounded - ! Item was removed: - ----- Method: ListController>>processKeyboard (in category 'menu messages') ----- - processKeyboard - "Derived from a Martin Pammer submission, 02/98" - - | keyEvent oldSelection nextSelection max min howMany | - sensor keyboardPressed ifFalse: [^ self]. - - keyEvent := sensor keyboard asciiValue. - oldSelection := view selection. - nextSelection := oldSelection. - max := view maximumSelection. - min := view minimumSelection. - howMany := view clippingBox height // view list lineGrid. - - keyEvent = 31 ifTrue: - ["down-arrow; move down one, wrapping to top if needed" - nextSelection := oldSelection + 1. - nextSelection > max ifTrue: [nextSelection := 1]]. - - keyEvent = 30 ifTrue: - ["up arrow; move up one, wrapping to bottom if needed" - nextSelection := oldSelection - 1. - nextSelection < 1 ifTrue: [nextSelection := max]]. - - keyEvent = 1 ifTrue: [nextSelection := 1]. "home" - keyEvent = 4 ifTrue: [nextSelection := max]. "end" - keyEvent = 11 ifTrue: [nextSelection := min max: (oldSelection - - howMany)]. "page up" - keyEvent = 12 ifTrue: [nextSelection := (oldSelection + howMany) - min: max]. "page down" - nextSelection = oldSelection ifFalse: - [model okToChange - ifTrue: - [self changeModelSelection: nextSelection. - self moveMarker]] - ! Item was removed: - ----- Method: ListController>>redButtonActivity (in category 'selecting') ----- - redButtonActivity - | noSelectionMovement oldSelection selection nextSelection pt scrollFlag firstTime | - noSelectionMovement := true. - scrollFlag := false. - oldSelection := view selection. - firstTime := true. - [sensor redButtonPressed | firstTime] - whileTrue: - [selection := view findSelection: (pt := sensor cursorPoint). - firstTime := false. - selection == nil ifTrue: "Maybe out of box - check for auto-scroll" - [pt y < view insetDisplayBox top ifTrue: - [self scrollView: view list lineGrid. - scrollFlag := true. - selection := view firstShown]. - pt y > view insetDisplayBox bottom ifTrue: - [self scrollView: view list lineGrid negated. - scrollFlag := true. - selection := view lastShown]]. - selection == nil ifFalse: - [view moveSelectionBox: (nextSelection := selection). - nextSelection ~= oldSelection - ifTrue: [noSelectionMovement := false]]]. - nextSelection ~~ nil & (nextSelection = oldSelection - ifTrue: [noSelectionMovement] - ifFalse: [true]) ifTrue: [self changeModelSelection: nextSelection]. - scrollFlag ifTrue: [self moveMarker]! Item was removed: - ----- Method: ListController>>scrollAmount (in category 'scrolling') ----- - scrollAmount - "Refer to the comment in ScrollController|scrollAmount." - - ^sensor cursorPoint y - scrollBar inside top! Item was removed: - ----- Method: ListController>>scrollView: (in category 'scrolling') ----- - scrollView: anInteger - "Scroll the view and highlight the selection if it just came into view" - | wasClipped | - wasClipped := view isSelectionBoxClipped. - (view scrollBy: anInteger) - ifTrue: [view isSelectionBoxClipped ifFalse: - [wasClipped ifTrue: "Selection came into view" - [view displaySelectionBox]]. - ^ true] - ifFalse: [^ false]! Item was removed: - ----- Method: ListController>>viewDelta (in category 'scrolling') ----- - viewDelta - "Refer to the comment in ScrollController|viewDelta." - - | viewList | - viewList := view list. - ^(viewList clippingRectangle top - - viewList compositionRectangle top - - ((marker top - scrollBar inside top) asFloat / - scrollBar inside height asFloat * - viewList compositionRectangle height asFloat)) - roundTo: viewList lineGrid! Item was removed: - Paragraph subclass: #ListParagraph - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Support'! - - !ListParagraph commentStamp: '<historical>' prior: 0! - I represent a special type of Paragraph that is used in the list panes of a browser. I avoid all the composition done by more general Paragraphs, because I know the structure of my Text.! Item was removed: - ----- Method: ListParagraph class>>cleanUp (in category 'initialization') ----- - cleanUp - "Re-initialize" - - self initialize.! Item was removed: - ----- Method: ListParagraph class>>standardListStyle (in category 'style') ----- - standardListStyle - - ^ (TextStyle fontArray: { Preferences standardListFont }) - gridForFont: 1 withLead: 1; - yourself! Item was removed: - ----- Method: ListParagraph class>>withArray:style: (in category 'instance creation') ----- - withArray: anArray style: aTextStyleOrNil - "Convert an array of strings into a ListParagraph using the given TextStyle." - - aTextStyleOrNil - ifNil: [^ (super withText: Text new style: self standardListStyle) withArray: anArray] - ifNotNil: [^ (super withText: Text new style: aTextStyleOrNil) withArray: anArray]. - ! Item was removed: - ----- Method: ListParagraph>>composeAll (in category 'composition') ----- - composeAll - "No composition is necessary once the ListParagraph is created." - - lastLine isNil ifTrue: [lastLine := 0]. - "Because composeAll is called once in the process of creating the ListParagraph." - ^compositionRectangle width! Item was removed: - ----- Method: ListParagraph>>trimLinesTo: (in category 'private') ----- - trimLinesTo: lastLineInteger - "Since ListParagraphs are not designed to be changed, we can cut back the - lines field to lastLineInteger." - lastLine := lastLineInteger. - lines := lines copyFrom: 1 to: lastLine! Item was removed: - ----- Method: ListParagraph>>withArray: (in category 'private') ----- - withArray: anArray - "Modifies self to contain the list of strings in anArray" - | startOfLine endOfLine lineIndex aString | - lines := Array new: 20. - lastLine := 0. - startOfLine := 1. - endOfLine := 1. - lineIndex := 0. - anArray do: - [:item | - endOfLine := startOfLine + item size. "this computation allows for a cr after each line..." - "...but later we will adjust for no cr after last line" - lineIndex := lineIndex + 1. - self lineAt: lineIndex put: - ((TextLineInterval start: startOfLine stop: endOfLine - internalSpaces: 0 paddingWidth: 0) - lineHeight: textStyle lineGrid baseline: textStyle baseline). - startOfLine := endOfLine + 1]. - endOfLine := endOfLine - 1. "endOfLine is now the total size of the text" - self trimLinesTo: lineIndex. - aString := String new: endOfLine. - anArray with: lines do: - [:item :interval | - aString - replaceFrom: interval first - to: interval last - 1 - with: item asString - startingAt: 1. - interval last <= endOfLine ifTrue: [aString at: interval last put: Character cr]]. - lineIndex > 0 ifTrue: [(lines at: lineIndex) stop: endOfLine]. "adjust for no cr after last line" - self text: aString asText. - anArray with: lines do: - [:item :interval | item isText ifTrue: - [text replaceFrom: interval first to: interval last - 1 with: item]]. - self updateCompositionHeight! Item was removed: - View subclass: #ListView - instanceVariableNames: 'list selection topDelimiter bottomDelimiter isEmpty textStyle' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Support'! - - !ListView commentStamp: '<historical>' prior: 0! - I am an abstract View of a list of items. I provide support for storing a selection of one item, as well as formatting the list for presentation on the screen. My instances' default controller is ListController.! Item was removed: - ----- Method: ListView>>assuredTextStyle (in category 'list access') ----- - assuredTextStyle - ^ textStyle ifNil: - [textStyle := ListParagraph standardListStyle] - ! Item was removed: - ----- Method: ListView>>bottomDelimiter (in category 'delimiters') ----- - bottomDelimiter - "Answer the string used to indicate the bottom of the list." - - ^bottomDelimiter! Item was removed: - ----- Method: ListView>>bottomDelimiter: (in category 'delimiters') ----- - bottomDelimiter: aString - "Set the string used to indicate the bottom of the list." - - bottomDelimiter := aString! Item was removed: - ----- Method: ListView>>boundingBox (in category 'display box access') ----- - boundingBox - "Refer to the comment in View|boundingBox." - - ^list boundingBox! Item was removed: - ----- Method: ListView>>clippingBox (in category 'clipping box access') ----- - clippingBox - "Answer the rectangle in which the model can be displayed--this is the - insetDisplayBox inset by the height of a line for an item." - - ^self insetDisplayBox insetBy: - (Rectangle - left: 0 - right: 0 - top: 0 - bottom: self insetDisplayBox height \\ list lineGrid)! Item was removed: - ----- Method: ListView>>deEmphasizeSelectionBox (in category 'displaying') ----- - deEmphasizeSelectionBox - self displaySelectionBox! Item was removed: - ----- Method: ListView>>deEmphasizeView (in category 'deEmphasizing') ----- - deEmphasizeView - "Refer to the comment in View|deEmphasizeView." - ^ self deEmphasizeSelectionBox! Item was removed: - ----- Method: ListView>>defaultControllerClass (in category 'controller access') ----- - defaultControllerClass - "Refer to the comment in View|defaultControllerClass." - - ^ListController! Item was removed: - ----- Method: ListView>>deselect (in category 'selecting') ----- - deselect - "If the receiver has a selection, then it is highlighted. Remove the - highlighting." - - selection ~= 0 ifTrue: [Display reverse: (self selectionBox intersect: self clippingBox)]! Item was removed: - ----- Method: ListView>>display (in category 'displaying') ----- - display - "Refer to the comment in View.display." - (self isUnlocked and: [self clippingBox ~= list clippingRectangle]) - ifTrue: "Recompose the list if the window changed" - [selection isNil ifTrue: [selection := 0]. - self positionList]. - super display! Item was removed: - ----- Method: ListView>>displaySelectionBox (in category 'displaying') ----- - displaySelectionBox - "If the receiver has a selection and that selection is visible on the display - screen, then highlight it." - selection ~= 0 ifTrue: - [Display reverse: (self selectionBox intersect: self clippingBox)]! Item was removed: - ----- Method: ListView>>displayView (in category 'displaying') ----- - displayView - "Refer to the comment in View|displayView." - - self clearInside. - list foregroundColor: self foregroundColor - backgroundColor: self backgroundColor. - list displayOn: Display! Item was removed: - ----- Method: ListView>>emphasizeView (in category 'deEmphasizing') ----- - emphasizeView - "List emphasis is its own inverse." - ^ self deEmphasizeView! Item was removed: - ----- Method: ListView>>findSelection: (in category 'selecting') ----- - findSelection: aPoint - "Determine which selection is displayed in an area containing the point, - aPoint. Answer the selection if one contains the point, answer nil - otherwise." - - | trialSelection | - (self clippingBox containsPoint: aPoint) ifFalse: [^nil]. - trialSelection := aPoint y - list compositionRectangle top // list lineGrid + 1. - topDelimiter == nil ifFalse: [trialSelection := trialSelection - 1]. - (trialSelection < 1) | (trialSelection > self maximumSelection) - ifTrue: [^ nil] - ifFalse: [^ trialSelection]! Item was removed: - ----- Method: ListView>>firstShown (in category 'private') ----- - firstShown - "Return the index of the top item currently visible" - | trial | - trial := self findSelection: self insetDisplayBox topLeft. - ^ trial == nil - ifTrue: [1] - ifFalse: [trial]! Item was removed: - ----- Method: ListView>>font (in category 'font access') ----- - font - ^ self assuredTextStyle fontNamed: textStyle fontNames first - ! Item was removed: - ----- Method: ListView>>font: (in category 'font access') ----- - font: aFontOrNil - - aFontOrNil - ifNil: [textStyle := nil] - ifNotNil: [ - textStyle := TextStyle fontArray: (Array with: aFontOrNil). - textStyle gridForFont: 1 withLead: 1]. - self changed: #list. "update display" - ! Item was removed: - ----- Method: ListView>>initialize (in category 'initialize-release') ----- - initialize - "Refer to the comment in View|initialize." - - super initialize. - topDelimiter := '------------'. - bottomDelimiter := '------------'. - isEmpty := true. - self list: Array new! Item was removed: - ----- Method: ListView>>isSelectionBoxClipped (in category 'display box access') ----- - isSelectionBoxClipped - "Answer whether there is a selection and whether the selection is visible - on the screen." - - ^ selection ~= 0 and: - [(self selectionBox intersects: - (self clippingBox insetBy: (Rectangle left: 0 right: 0 top: 1 bottom: 0))) not]! Item was removed: - ----- Method: ListView>>lastShown (in category 'private') ----- - lastShown - "Return the index of the bottom item currently visible" - | trial bottomMargin | - bottomMargin := self insetDisplayBox height \\ list lineGrid. - trial := self findSelection: self insetDisplayBox bottomLeft - (0 at bottomMargin). - trial == nil - ifTrue: [trial := self findSelection: self insetDisplayBox bottomLeft - - (0@(list lineGrid+bottomMargin))]. - ^ trial == nil - ifTrue: [list numberOfLines - 2] - ifFalse: [trial]! Item was removed: - ----- Method: ListView>>list (in category 'list access') ----- - list - "Answer the list of items the receiver displays." - - ^list! Item was removed: - ----- Method: ListView>>list: (in category 'list access') ----- - list: anArray - "Set the list of items the receiver displays to be anArray." - | arrayCopy i | - isEmpty := anArray isEmpty. - arrayCopy := Array new: (anArray size + 2). - arrayCopy at: 1 put: topDelimiter. - arrayCopy at: arrayCopy size put: bottomDelimiter. - i := 2. - anArray do: [:el | arrayCopy at: i put: el. i := i+1]. - arrayCopy := arrayCopy copyWithout: nil. - list := ListParagraph withArray: arrayCopy style: self assuredTextStyle. - selection := 0. - self positionList. - ! Item was removed: - ----- Method: ListView>>lock (in category 'lock access') ----- - lock - "Refer to the comment in view|lock. Must do at least what display would do to lock the view." - - (self isUnlocked and: [self clippingBox ~= list clippingRectangle]) - ifTrue: "Recompose the list if the window changed" - [self positionList]. - super lock! Item was removed: - ----- Method: ListView>>maximumSelection (in category 'selecting') ----- - maximumSelection - "Answer which selection is the last possible one." - ^ list numberOfLines - - (topDelimiter == nil ifTrue: [0] ifFalse: [1]) - - (bottomDelimiter == nil ifTrue: [0] ifFalse: [1])! Item was removed: - ----- Method: ListView>>minimumSelection (in category 'selecting') ----- - minimumSelection - "Answer which selection is the first possible one." - ^ 1! Item was removed: - ----- Method: ListView>>moveSelectionBox: (in category 'selecting') ----- - moveSelectionBox: anInteger - "Presumably the selection has changed to be anInteger. Deselect the - previous selection and display the new one, highlighted." - - selection ~= anInteger - ifTrue: - [self deselect. - selection := anInteger. - self displaySelectionBox]. - self isSelectionBoxClipped - ifTrue: [self scrollSelectionIntoView]! Item was removed: - ----- Method: ListView>>noBottomDelimiter (in category 'delimiters') ----- - noBottomDelimiter - "Set the string used to indicate the bottom of the list to be nothing." - - bottomDelimiter := nil! Item was removed: - ----- Method: ListView>>noTopDelimiter (in category 'delimiters') ----- - noTopDelimiter - "Set the string used to indicate the top of the list to be nothing." - - topDelimiter := nil! Item was removed: - ----- Method: ListView>>numSelectionsInView (in category 'selecting') ----- - numSelectionsInView - ^ self clippingBox height // self list lineGrid! Item was removed: - ----- Method: ListView>>positionList (in category 'private') ----- - positionList - - list wrappingBox: self wrappingBox clippingBox: self clippingBox ! Item was removed: - ----- Method: ListView>>reset (in category 'list access') ----- - reset - "Set the list of items displayed to be empty." - - isEmpty := true. - self list: Array new! Item was removed: - ----- Method: ListView>>resetAndDisplayView (in category 'list access') ----- - resetAndDisplayView - "Set the list of items displayed to be empty and redisplay the receiver." - - isEmpty - ifFalse: - [self reset. - self displayView]! Item was removed: - ----- Method: ListView>>scrollBy: (in category 'displaying') ----- - scrollBy: anInteger - "Scroll up by this amount adjusted by lineSpacing and list limits" - | maximumAmount minimumAmount amount wasClipped | - maximumAmount := 0 max: - list clippingRectangle top - list compositionRectangle top. - minimumAmount := 0 min: - list clippingRectangle bottom - list compositionRectangle bottom. - amount := (anInteger min: maximumAmount) max: minimumAmount. - amount ~= 0 - ifTrue: [list scrollBy: amount negated. ^ true] - ifFalse: [^ false] "Return false if no scrolling took place"! Item was removed: - ----- Method: ListView>>scrollSelectionIntoView (in category 'displaying') ----- - scrollSelectionIntoView - "Selection is assumed to be on and clipped out of view. - Uses controller scrollView to keep selection right" - | delta | - (delta := self insetDisplayBox bottom - self selectionBox bottom) < 0 - ifTrue: [^ self controller scrollView: delta - (list lineGrid-1)]. "up" - (delta := self insetDisplayBox top - self selectionBox top) > 0 - ifTrue: [^ self controller scrollView: delta + 1] "down"! Item was removed: - ----- Method: ListView>>selection (in category 'selecting') ----- - selection - "Answer the receiver's current selection." - - ^selection! Item was removed: - ----- Method: ListView>>selection: (in category 'list access') ----- - selection: selIndex - selection := selIndex! Item was removed: - ----- Method: ListView>>selectionBox (in category 'selecting') ----- - selectionBox - "Answer the rectangle in which the current selection is displayed." - - ^(self insetDisplayBox left @ (list compositionRectangle top + self selectionBoxOffset) - extent: self insetDisplayBox width @ list lineGrid) - insetBy: (Rectangle left: 1 right: 1 top: 1 bottom: 0)! Item was removed: - ----- Method: ListView>>selectionBoxOffset (in category 'selecting') ----- - selectionBoxOffset - "Answer an integer that determines the y position for the display box of - the current selection." - - ^ (selection - 1 + (topDelimiter == nil ifTrue: [0] ifFalse: [1])) - * list lineGrid! Item was removed: - ----- Method: ListView>>topDelimiter (in category 'delimiters') ----- - topDelimiter - "Answer the string used to indicate the top of the list." - - ^topDelimiter! Item was removed: - ----- Method: ListView>>topDelimiter: (in category 'delimiters') ----- - topDelimiter: aString - "Set the string used to indicate the top of the list." - - topDelimiter := aString! Item was removed: - ----- Method: ListView>>update: (in category 'updating') ----- - update: aSymbol - "Refer to the comment in View|update:." - - aSymbol == #list - ifTrue: - [self list: model list. - self displayView. - ^self]. - aSymbol == #listIndex - ifTrue: - [self moveSelectionBox: model listIndex. - ^self]! Item was removed: - ----- Method: ListView>>wrappingBox (in category 'private') ----- - wrappingBox - - | aRectangle | - aRectangle := self insetDisplayBox. - selection = 0 - ifTrue: [^aRectangle topLeft + (4 @ 0) extent: list compositionRectangle extent] - ifFalse: [^aRectangle left + 4 @ - (aRectangle top - - (self selectionBoxOffset - min: ((list height - aRectangle height - + list lineGrid truncateTo: list lineGrid) - max: 0))) - extent: list compositionRectangle extent]! Item was removed: - Debugger subclass: #MVCDebugger - instanceVariableNames: 'interruptedController' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Support'! Item was removed: - ----- Method: MVCDebugger class>>openOn:context:label:contents:fullView: (in category 'opening') ----- - openOn: processToDebug context: context label: title contents: contentsStringOrNil fullView: full - "Open a notifier in response to an error, halt, or notify. A notifier view just shows a short view of the sender stack and provides a menu that lets the user open a full debugger." - - | debugger cm ac acp wasActive | - cm := Project current world. "controller manager" - ac := cm activeController. - acp := cm activeControllerProcess. "the ui process" - wasActive := cm inActiveControllerProcess. - - debugger := self new - process: processToDebug - "Keep track of the controller if it matches." - controller: (acp == processToDebug ifTrue: [ac]) - context: context. - - full - ifTrue: [debugger openFullNoSuspendLabel: title] - ifFalse: [debugger openNotifierNoSuspendContents: contentsStringOrNil label: title]. - - "Try drawing the debugger tool at least once to avoid freeze." - Project current restoreDisplay. - - "If we are in a helper process, #openNoTerminate WILL NOT activate the debugger's controller. Example: user-interrupt request (cmd+dot)." - (acp == processToDebug and: [wasActive not]) - ifTrue: [ [cm searchForActiveController] fork ]. - - "Be sure to suspend the process we want to debug now." - processToDebug suspend. - - "If we are NOT in a helper process, #openNoTerminate WILL NOT terminate the active controller's process." - (acp ~~ processToDebug and: [wasActive]) - ifTrue: [ Processor terminateActive ]. - - "Get here only if active process is not the process-to-debug. Use helper process if you want to access this return value." - ^ debugger! Item was removed: - ----- Method: MVCDebugger>>context: (in category 'initialize') ----- - context: aContext - - self - process: Processor activeProcess - controller: (ScheduledControllers inActiveControllerProcess - ifTrue: [ScheduledControllers activeController]) - context: aContext.! Item was removed: - ----- Method: MVCDebugger>>openFullFromNotifier: (in category 'initialize') ----- - openFullFromNotifier: notifierView - "Create, schedule and answer a full debugger with the given label. Do not terminate the current active process." - - | fullView | - super openFullFromNotifier: notifierView. - - fullView := ToolBuilder default build: self. - fullView label: notifierView label. "Keep the label." - fullView controller openNoTerminate. - - notifierView controller closeAndUnscheduleNoTerminate. - Processor terminateActive.! Item was removed: - ----- Method: MVCDebugger>>openFullNoSuspendLabel: (in category 'initialize') ----- - openFullNoSuspendLabel: aString - "Create, schedule and answer a full debugger with the given label. Do not terminate the current active process." - - | fullView | - super openFullNoSuspendLabel: aString. - - fullView := ToolBuilder default build: self. - fullView label: aString. - fullView controller openNoTerminate. - - ^ fullView! Item was removed: - ----- Method: MVCDebugger>>openNotifierNoSuspendContents:label: (in category 'initialize') ----- - openNotifierNoSuspendContents: msgString label: label - - | builder spec view | - EventSensor default flushEvents. - super openNotifierNoSuspendContents: msgString label: label. - - builder := ToolBuilder default. - spec := self buildNotifierWith: builder label: label message: msgString. - - view := builder build: spec. - view controller openNoTerminate. - - ^ view! Item was removed: - ----- Method: MVCDebugger>>process:controller:context: (in category 'initialize') ----- - process: aProcess controller: aController context: aContext - - self process: aProcess context: aContext. - - interruptedController := aController.! Item was removed: - ----- Method: MVCDebugger>>resumeProcess: (in category 'private') ----- - resumeProcess: processToResume - "Finally free the reference to the controller if any. We cannot do this in #windowIsClosing." - - | controllerToReschedule | - controllerToReschedule := interruptedController. - interruptedController := nil. - - ScheduledControllers - activeController: controllerToReschedule - andProcess: processToResume.! Item was removed: - Project subclass: #MVCProject - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Support'! - - !MVCProject commentStamp: 'dtl 7/13/2013 15:36' prior: 0! - An MVCProject is a project with an MVC user interface. It stores its control manager in the world instance variable, and its UI manager is an MVCUIManager. It uses an MVCToolBuilder to create the views for various tools. - ! Item was removed: - ----- Method: MVCProject class>>convertOldProjects (in category 'class initialization') ----- - convertOldProjects - "Convert old MVC projects to be MVCProjects" - Project allInstancesDo:[:p| - (p world isKindOf: ControlManager) - ifTrue:[p primitiveChangeClassTo: self basicNew]].! Item was removed: - ----- Method: MVCProject class>>initialize (in category 'class initialization') ----- - initialize - super initialize. - CurrentProject ifNil: - ["This is the Top Project." - CurrentProject := super new initialProject]. - ! Item was removed: - ----- Method: MVCProject class>>releaseProjectReferences: (in category 'utilities') ----- - releaseProjectReferences: outgoingProject - - ProjectController allInstancesDo: [:pvc | - [pvc model == outgoingProject ifTrue: [pvc closeAndUnscheduleNoTerminate]] - on: Error do: [:ex | - "Unschedule the bad controller from all managers." - ControlManager allInstancesDo: [:m | m unschedule: pvc]]].! Item was removed: - ----- Method: MVCProject class>>unloadMVC (in category 'shrinking') ----- - unloadMVC - "Completely remove MVC from the system. All MVC projects will be destroyed. - To reinstall MVC, load all of the ST80 and MVCToolbuilder packages." - - "MVCProject unloadMVC" - - Project current isMVC ifTrue: [ - ^ Error signal: 'You can only unload MVC from within another kind of project.']. - - MVCProject removeProjectsFromSystem. - - Smalltalk globals removeKey: #ScheduledControllers. - { 'ToolBuilder-MVC' . 'ST80Tests' . 'ST80Tools' . 'ST80' } - do: [ :package | (MCPackage named: package) unload ]. - - ! Item was removed: - ----- Method: MVCProject>>acceptProjectDetails: (in category 'file in/out') ----- - acceptProjectDetails: details - "Ignored; here for MorphicProject compatibility."! Item was removed: - ----- Method: MVCProject>>addDeferredUIMessage: (in category 'scheduling & debugging') ----- - addDeferredUIMessage: valuableObject - "Arrange for valuableObject to be evaluated at a time when the user interface - is in a coherent state." - - self flag: #discuss. "mt: Why are deferred UI messages shared among all MVC projects?" - ControlManager addDeferredUIMessage: valuableObject.! Item was removed: - ----- Method: MVCProject>>addItem:toMenu:selection:color:thumbnail: (in category 'utilities') ----- - addItem: item toMenu: menu selection: action color: aColor thumbnail: aForm - "Add menu item representing the sender to a menu. Morphic projects use - aColor and aForm for menu items." - - menu add: item action: action! Item was removed: - ----- Method: MVCProject>>addProject: (in category 'sub-projects & hierarchy') ----- - addProject: project - - | view | - super addProject: project. - - view := ProjectView new - model: project; - minimumSize: 50 at 30; - borderWidth: 2; - resizeInitially; - yourself. - view controller status: #open.! Item was removed: - ----- Method: MVCProject>>armsLengthCommand:withDescription: (in category 'file in/out') ----- - armsLengthCommand: aCommand withDescription: aString - | pvm | - "Set things up so that this aCommand is sent to self as a message - after jumping to the parentProject. For things that can't be executed - while in this project, such as saveAs, loadFromServer, storeOnServer. See - ProjectViewMorph step." - - parentProject ifNil: [^ self inform: 'The top project can''t do that']. - pvm := parentProject findProjectView: self. - pvm armsLengthCommand: {self. aCommand}. - self exit - ! Item was removed: - ----- Method: MVCProject>>bitEdit: (in category 'editors') ----- - bitEdit: aForm - "Create and schedule a view located in an area designated by the user - that contains a view of aForm magnified by 8 at 8 that can be modified using - a bit editor. It also contains a view of the original form." - - BitEditor openOnForm: aForm - - "Note that using direct messages to BitEditor, fixed locations and scales can be created. - That is, also try: - BitEditor openOnForm: self at: <some point> - BitEditor openOnForm: self at: <some point> scale: <some point>"! Item was removed: - ----- Method: MVCProject>>bitEdit:at:scale: (in category 'editors') ----- - bitEdit: aForm at: magnifiedFormLocation scale: scaleFactor - "Create and schedule a view whose top left corner is magnifiedLocation - and that contains a view of aForm magnified by scaleFactor that can be - modified using the Bit Editor. It also contains a view of the original form." - - BitEditor openOnForm: aForm at: magnifiedFormLocation scale: scaleFactor ! Item was removed: - ----- Method: MVCProject>>color (in category 'accessing') ----- - color - - ^ self world isInMemory - ifTrue: [Color veryVeryDarkGray] - ifFalse: [Color blue]! Item was removed: - ----- Method: MVCProject>>composeDisplayTextIntoForm: (in category 'utilities') ----- - composeDisplayTextIntoForm: displayText - - ^ displayText asParagraph asForm! Item was removed: - ----- Method: MVCProject>>currentVocabulary (in category 'protocols') ----- - currentVocabulary - "Answer the currently-prevailing default vocabulary." - - Smalltalk at: #Vocabulary ifPresent: [:v | ^ v fullVocabulary]. - self error: 'package Protocols not present in this image' - ! Item was removed: - ----- Method: MVCProject>>debuggerClass (in category 'scheduling & debugging') ----- - debuggerClass - - ^ Smalltalk classNamed: #MVCDebugger! Item was removed: - ----- Method: MVCProject>>deletingProject: (in category 'release') ----- - deletingProject: outgoingProject - - "Clean-up my project views." - (self world controllersSatisfying: [:m | m model = outgoingProject]) - do: [:projectController | - self world unschedule: projectController. - projectController view - model: nil; - release]. - - super deletingProject: outgoingProject.! Item was removed: - ----- Method: MVCProject>>displayTranscripter: (in category 'transcripter') ----- - displayTranscripter: transcripter - "A transcripter is a minimal user interface to support an emergency evaluator. - An MVC project uses class Paragraph." - transcripter mvcDisplayText! Item was removed: - ----- Method: MVCProject>>do:withProgressInfoOn:label: (in category 'utilities') ----- - do: aBlock withProgressInfoOn: aMorphOrNil label: aString - "Evaluate aBlock with a labeled progress bar. Use a simple progress - bar set to 50% progress. In Morphic, progress is displayed with a - ComplexProgressIndicator." - - aString - displayProgressFrom: 0 to: 2 - during: [:bar | bar value: 1. - aBlock value] - - ! Item was removed: - ----- Method: MVCProject>>editCharacter:ofFont: (in category 'editors') ----- - editCharacter: character ofFont: strikeFont - "Open a bit editor on a character in the given strike font. Note that you must - do an accept (in the option menu of the bit editor) if you want this work. - Accepted edits will not take effect in the font until you leave or close the bit editor. - Also note that unaccepted edits will be lost when you leave or close." - "Note that BitEditor only works in MVC currently." - - "(TextStyle default fontAt: 1) edit: $=" - - | charForm editRect scaleFactor bitEditor savedForm r | - charForm := strikeFont characterFormAt: character. - editRect := Rectangle locateMagnifiedView: charForm scale: (scaleFactor := 8 @ 8). - bitEditor := BitEditor - bitEdit: charForm - at: editRect topLeft - scale: scaleFactor - remoteView: nil. - savedForm := Form fromDisplay: (r := bitEditor displayBox - expandBy: (0 @ 23 corner: 0 @ 0)). - bitEditor controller startUp. - bitEditor release. - savedForm displayOn: Display at: r topLeft. - strikeFont characterFormAt: character put: charForm! Item was removed: - ----- Method: MVCProject>>exportSegmentWithCatagories:classes:fileName:directory: (in category 'file in/out') ----- - exportSegmentWithCatagories: catList classes: classList fileName: aFileName directory: aDirectory - "Store my project out on the disk as an *exported* ImageSegment. All outPointers will be in a form that can be resolved in the target image. Name it <project name>.extSeg. What do we do about subProjects, especially if they are out as local image segments? Force them to come in? - Player classes are included automatically." - - self flag: #toRemove. - self halt. "unused" - "world == World ifTrue: [^ false]." - "self inform: 'Can''t send the current world out'." - self projectParameters at: #isMVC put: true. - ^ false "Only Morphic projects for now" - ! Item was removed: - ----- Method: MVCProject>>exportSegmentWithChangeSet:fileName:directory: (in category 'file in/out') ----- - exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName - directory: aDirectory - "Store my project out on the disk as an *exported* - ImageSegment. All outPointers will be in a form that can be resolved - in the target image. Name it <project name>.extSeg. Whatdo we do - about subProjects, especially if they are out as local image - segments? Force them to come in? - Player classes are included automatically." - - "Files out a changeSet first, so that a project can contain - its own classes" - self projectParameters at: #isMVC put: true. - ^ false "Only Morphic projects for now" - ! Item was removed: - ----- Method: MVCProject>>finalEnterActions: (in category 'enter') ----- - finalEnterActions: leavingProject - - ScheduledControllers := world.! Item was removed: - ----- Method: MVCProject>>finalExitActions: (in category 'enter') ----- - finalExitActions: enteringProject - - super finalExitActions: enteringProject. - - self world unCacheWindows. - EventSensor default flushEvents. - - ScheduledControllers := nil.! Item was removed: - ----- Method: MVCProject>>findAFolderForProject:label: (in category 'utilities') ----- - findAFolderForProject: aProject label: dialogLabel - "Find a folder for saving or loading a project" - - ^PluggableFileList getFolderDialog openLabel: dialogLabel - ! Item was removed: - ----- Method: MVCProject>>findProjectView: (in category 'utilities') ----- - findProjectView: projectDescription - "In this world, find the ProjectController for the project described by projectDescription." - - | pName | - pName := (projectDescription isString) - ifTrue: [projectDescription] - ifFalse: [projectDescription name]. - world scheduledControllers do: [:cont | | proj dpName | - (cont isKindOf: ProjectController) ifTrue: [ - ((proj := cont model) class == Project and: - [proj name = pName]) ifTrue: [^ cont view]. - proj class == DiskProxy ifTrue: [ - dpName := proj constructorArgs first. - dpName := (dpName findTokens: '/') last. - dpName := (Project parseProjectFileName: dpName unescapePercents) first. - dpName = pName ifTrue: [^ cont view]]]]. - ^ nil! Item was removed: - ----- Method: MVCProject>>formEdit: (in category 'editors') ----- - formEdit: aForm - "Start up an instance of the FormEditor on a form. Typically the form - is not visible on the screen. The editor menu is located at the bottom of - the form editing frame. The form is displayed centered in the frame. - YellowButtonMenu accept is used to modify the form to reflect the - changes made on the screen version; cancel restores the original form to - the screen. Note that the changes are clipped to the original size of the - form." - - FormEditor openOnForm: aForm! Item was removed: - ----- Method: MVCProject>>formViewClass (in category 'editors') ----- - formViewClass - "Answer a class suitable for a view on a form or collection of forms" - - ^ FormInspectView! Item was removed: - ----- Method: MVCProject>>initialize (in category 'initialize') ----- - initialize - super initialize. - world := ControlManager new. - uiManager := (Smalltalk classNamed: #MVCUIManager) ifNotNil: [:mgrClass | mgrClass new]. - CurrentProject ifNil: - [CurrentProject := super new initialProject]. - ! Item was removed: - ----- Method: MVCProject>>initializeParagraphForTranscripter: (in category 'transcripter') ----- - initializeParagraphForTranscripter: transcripter - "A transcripter is a minimal user interface to support an emergency evaluator. - An MVC project uses class Paragraph." - transcripter mvcInitializeParagraph: Paragraph! Item was removed: - ----- Method: MVCProject>>initializeProjectPreferences (in category 'project parameters') ----- - initializeProjectPreferences - "Initialize the project's preferences from currently-prevailing preferences that are currently being held in projects in this system" - - self flapsSuppressed: true. - super initializeProjectPreferences - ! Item was removed: - ----- Method: MVCProject>>interruptCleanUpFor: (in category 'scheduling & debugging') ----- - interruptCleanUpFor: interruptedProcess - - super interruptCleanUpFor: interruptedProcess. - - (world activeController ~~ nil and: [world activeController ~~ world screenController]) ifTrue: [ - interruptedProcess == self uiProcess - ifTrue: [ - world activeController view topView deEmphasizeForDebugger] - ifFalse: [ - world activeController controlTerminate]].! Item was removed: - ----- Method: MVCProject>>invalidate (in category 'display') ----- - invalidate - "Invalidate the entire project so that a redraw will be forced later." - - world - unCacheWindows; - unschedule: world screenController; - scheduleOnBottom: world screenController.! Item was removed: - ----- Method: MVCProject>>isMVC (in category 'testing') ----- - isMVC - - ^ true! Item was removed: - ----- Method: MVCProject>>jumpToProject (in category 'utilities') ----- - jumpToProject - "Present a list of potential projects and enter the one selected. - We use mvcStartUpLeftFlush for possibly no longer valid historical reasons" - - "Project current jumpToProject" - - self jumpToSelection: (self buildJumpToMenu: CustomMenu new) startUp! Item was removed: - ----- Method: MVCProject>>lastDeferredUIMessage (in category 'scheduling & debugging') ----- - lastDeferredUIMessage - "Answer the most recently scheduled deferredUIMessage." - - ^ControlManager lastDeferredUIMessage! Item was removed: - ----- Method: MVCProject>>offerMenu:from:shifted: (in category 'utilities') ----- - offerMenu: menuSelector from: aModel shifted: aBoolean - "Pop up a menu whose target is aModel and whose contents are provided - by sending the menuSelector to the model. The menuSelector takes two - arguments: a menu, and a boolean representing the shift state." - - | aMenu | - aMenu := CustomMenu new. - aModel perform: menuSelector with: aMenu with: aBoolean. - aMenu invokeOn: aModel! Item was removed: - ----- Method: MVCProject>>okToChange (in category 'release') ----- - okToChange - "If there is no open window, we are fine to close." - - ^ (self parent ~~ Project current - or: [self world scheduledControllers size <= 1]) - or: [super okToChange]! Item was removed: - ----- Method: MVCProject>>openImage:name:saveResource: (in category 'editors') ----- - openImage: aForm name: fullName saveResource: aBoolean - "Open a view on an image. Do not save project resource in an MVC project." - - FormView open: aForm named: fullName! Item was removed: - ----- Method: MVCProject>>openProject: (in category 'initialize') ----- - openProject: aProject - "Create a new for a new project in the context of the receiver" - ProjectView openAndEnter: aProject.! Item was removed: - ----- Method: MVCProject>>restore (in category 'display') ----- - restore - "Redraw the entire Project. Ignore errors to keep system responsive." - - [world displayWorld] on: Error do: [:ex | "Ignore."].! Item was removed: - ----- Method: MVCProject>>scheduleProcessForEnter (in category 'enter') ----- - scheduleProcessForEnter - "Complete the enter: by launching a new process. Note that we have to use a helper process because MVC will terminate the current process immediately when searching for an active controller. There might, however, be other code to be executed when returning from this call." - - [world searchForActiveController] newProcess - priority: Processor userSchedulingPriority; - resume.! Item was removed: - ----- Method: MVCProject>>setAsBackground: (in category 'utilities') ----- - setAsBackground: aForm - "Set aForm as a background image." - - world screenController model form: aForm. - Display restore.! Item was removed: - ----- Method: MVCProject>>showImage:named: (in category 'utilities') ----- - showImage: aForm named: imageName - "Show an image, possibly attached to the pointer for positioning" - - FormView open: aForm named: imageName - ! Item was removed: - ----- Method: MVCProject>>spawnNewProcessIfThisIsUI: (in category 'active process') ----- - spawnNewProcessIfThisIsUI: suspendedProcess - "In MVC the debugger does not require special handling to start a new UI process - when the active controller process is interrupted in the debugger." - ^true! Item was removed: - ----- Method: MVCProject>>storeSegment (in category 'file in/out') ----- - storeSegment - "Store my project out on the disk as an ImageSegment. Keep the outPointers in memory. Name it <project name>.seg. *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***" - - (Project current world == world) ifTrue: [^ false]. - "self inform: 'Can''t send the current world out'." - world isInMemory ifFalse: [^ false]. "already done" - self projectParameters at: #isMVC put: true. - ^ false "Only Morphic projects for now" - ! Item was removed: - ----- Method: MVCProject>>storeSegmentNoFile (in category 'file in/out') ----- - storeSegmentNoFile - "For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)" - - (Project current world == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'." - world isInMemory ifFalse: [^ self]. "already done" - self projectParameters at: #isMVC put: true. - ^ self "Only Morphic projects for now" - ! Item was removed: - ----- Method: MVCProject>>subProjects (in category 'utilities') ----- - subProjects - "Answer a list of all the subprojects of the receiver. " - - ^ (super subProjects, ((self world controllersSatisfying: [:m | m model isKindOf: Project]) - collect: [:controller | controller model])) asSet asArray! Item was removed: - ----- Method: MVCProject>>syntaxError: (in category 'scheduling & debugging') ----- - syntaxError: aSyntaxErrorNotification - - super syntaxError: aSyntaxErrorNotification. - Cursor normal show. - Processor activeProcess suspend.! Item was removed: - ----- Method: MVCProject>>terminateProcessForLeave (in category 'enter') ----- - terminateProcessForLeave - "There is only one active controller at a time. Kill it's process." - - self assert: Processor activeProcess == world activeControllerProcess. - Processor terminateActive.! Item was removed: - ----- Method: MVCProject>>textWindows (in category 'utilities') ----- - textWindows - "Answer a dictionary of all system windows for text display keyed by window title. - Generate new window titles as required to ensure unique keys in the dictionary." - - | aDict windows title | - aDict := Dictionary new. - windows := world controllersSatisfying: - [:c | (c model isKindOf: StringHolder)]. - windows do: - [:aController | | textToUse aTextView | - aTextView := aController view subViews detect: [:m | m isKindOf: PluggableTextView] ifNone: [nil]. - textToUse := aTextView - ifNil: [aController model contents] - ifNotNil: [aTextView controller text]. "The latest edits, whether accepted or not" - title := aController view label. - (aDict includesKey: title) ifTrue: [ | newKey | "Ensure unique keys in aDict" - (1 to: 100) detect: [:e | - newKey := title, '-', e asString. - (aDict includesKey: newKey) not]. - title := newKey]. - aDict at: title put: textToUse]. - ^ aDict! Item was removed: - ----- Method: MVCProject>>uiProcess (in category 'active process') ----- - uiProcess - - ^ world activeControllerProcess! Item was removed: - ----- Method: MVCProject>>viewLocFor: (in category 'display') ----- - viewLocFor: exitedProject - "Look for a view of the exitedProject, and return its center" - - ^ (world controllerWhoseModelSatisfies: [:p | p == exitedProject]) - ifNil: [super viewLocFor: exitedProject] - ifNotNil: [:ctlr | ^ctlr view windowBox center]! Item was removed: - Controller subclass: #ModalController - instanceVariableNames: 'modeActive' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Framework'! - - !ModalController commentStamp: '<historical>' prior: 0! - I am a controller that puts the poor user into a mode by not relinquishing control. However, I do pass control onto my underlings. Some underling is expected to end the mode by sending me 'close'. Watch out Larry Tesler, the mode lives on... - ! Item was removed: - ----- Method: ModalController>>close (in category 'scheduling') ----- - close - "This is how we leave the mode." - - modeActive := false. - ! Item was removed: - ----- Method: ModalController>>closeAndUnscheduleNoTerminate (in category 'scheduling') ----- - closeAndUnscheduleNoTerminate - "Erase the receiver's view and remove it from the collection of scheduled views, but do not terminate the current process." - - ScheduledControllers unschedule: self. - view erase. - view release.! Item was removed: - ----- Method: ModalController>>controlInitialize (in category 'basic control sequence') ----- - controlInitialize - - modeActive := true. - ^ super controlInitialize - ! Item was removed: - ----- Method: ModalController>>isControlActive (in category 'control defaults') ----- - isControlActive - - ^ modeActive - ! Item was removed: - ----- Method: ModalController>>isControlWanted (in category 'control defaults') ----- - isControlWanted - - ^ modeActive - ! Item was removed: - StandardSystemView subclass: #ModalSystemWindowView - instanceVariableNames: 'modalBorder' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Views'! - - !ModalSystemWindowView commentStamp: '<historical>' prior: 0! - I am a view for a Modal System Window. I vary from StandardSystemView, of which I am a subclass in a few ways: - - (1) I use ModalController as my default controller; - (2) When asked to update with the symbol #close, I direct the controller to close; - (3) I display a slightly different title bar with no control boxes.! Item was removed: - ----- Method: ModalSystemWindowView>>backgroundColor (in category 'label access') ----- - backgroundColor - ^Color lightYellow! Item was removed: - ----- Method: ModalSystemWindowView>>borderWidth: (in category 'initialize-release') ----- - borderWidth: anObject - - modalBorder := false. - ^super borderWidth: anObject! Item was removed: - ----- Method: ModalSystemWindowView>>defaultControllerClass (in category 'controller access') ----- - defaultControllerClass - - ^Smalltalk at: #ModalController! Item was removed: - ----- Method: ModalSystemWindowView>>display (in category 'displaying') ----- - display - - super display. - self displayLabelBackground: false. - self displayLabelText. - ! Item was removed: - ----- Method: ModalSystemWindowView>>displayBorder (in category 'displaying') ----- - displayBorder - "Display the receiver's border (using the receiver's borderColor)." - - modalBorder ifFalse: [^super displayBorder]. - - Display - border: self displayBox - widthRectangle: (1 at 1 corner: 2 at 2) - rule: Form over - fillColor: Color black. - Display - border: (self displayBox insetBy: (1 at 1 corner: 2 at 2)) - widthRectangle: (4 at 4 corner: 3 at 3) - rule: Form over - fillColor: (Color r: 16rEA g: 16rEA b: 16rEA). - ! Item was removed: - ----- Method: ModalSystemWindowView>>displayLabelBoxes (in category 'displaying') ----- - displayLabelBoxes - "Modal dialogs don't have closeBox or growBox." - ! Item was removed: - ----- Method: ModalSystemWindowView>>doModalDialog (in category 'modal dialog') ----- - doModalDialog - - | savedArea | - self resizeInitially. - self resizeTo: - ((self windowBox) - align: self windowBox center - with: Display boundingBox aboveCenter). - savedArea := Form fromDisplay: self windowBox. - self displayEmphasized. - self controller startUp. - self release. - savedArea displayOn: Display at: self windowOrigin. - ! Item was removed: - ----- Method: ModalSystemWindowView>>initialize (in category 'initialize-release') ----- - initialize - "Refer to the comment in View|initialize." - super initialize. - self borderWidth: 5. - self noLabel. - modalBorder := true.! Item was removed: - ----- Method: ModalSystemWindowView>>update: (in category 'model access') ----- - update: aSymbol - aSymbol = #close - ifTrue: [^self controller close]. - ^super update: aSymbol! Item was removed: - Controller subclass: #MouseMenuController - instanceVariableNames: 'redButtonMenu redButtonMessages' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Controllers'! - - !MouseMenuController commentStamp: '<historical>' prior: 0! - I am a Controller that modifies the scheduling of user activities so that the three mouse buttons can be used to make selections or display menus. The menu items are unary messages to the value of sending my instance the message menuMessageReceiver.! Item was removed: - ----- Method: MouseMenuController>>blueButtonActivity (in category 'menu messages') ----- - blueButtonActivity - "This normally opens the window menu. It is a no-op here - as only the StandardSystemController deals with that kind - of menus."! Item was removed: - ----- Method: MouseMenuController>>controlActivity (in category 'control defaults') ----- - controlActivity - "Refer to the comment in Controller|controlActivity." - | cursorPoint | - cursorPoint := sensor cursorPoint. - super controlActivity. - (cursorPoint = sensor cursorPoint and: [self viewHasCursor]) - ifTrue: - [sensor redButtonPressed ifTrue: [^ self redButtonActivity]. - sensor yellowButtonPressed ifTrue: [^ self yellowButtonActivity]. - sensor blueButtonPressed ifTrue: [^ self blueButtonActivity]]! Item was removed: - ----- Method: MouseMenuController>>getPluggableYellowButtonMenu: (in category 'pluggable menus') ----- - getPluggableYellowButtonMenu: shiftKeyState - ^ view getMenu: shiftKeyState! Item was removed: - ----- Method: MouseMenuController>>isControlActive (in category 'control defaults') ----- - isControlActive - "In contrast to class Controller, only blue button but not yellow button - events will end the receiver's control loop." - - ^ self viewHasCursor and: [sensor blueButtonPressed not]! Item was removed: - ----- Method: MouseMenuController>>performMenuMessage: (in category 'menu messages') ----- - performMenuMessage: aSelector - "Perform a menu command by sending self the message aSelector. - Default does nothing special." - - ^self perform: aSelector! Item was removed: - ----- Method: MouseMenuController>>pluggableYellowButtonActivity: (in category 'pluggable menus') ----- - pluggableYellowButtonActivity: shiftKeyState - "Invoke the model's popup menu." - - | menu | - (menu := self getPluggableYellowButtonMenu: shiftKeyState) - ifNil: - [sensor waitNoButton] - ifNotNil: - [self terminateAndInitializeAround: - [menu invokeOn: model orSendTo: self]]! Item was removed: - ----- Method: MouseMenuController>>redButtonActivity (in category 'menu messages') ----- - redButtonActivity - "Determine which item in the red button pop-up menu is selected. If one - is selected, then send the corresponding message to the object designated - as the menu message receiver." - - | index | - redButtonMenu ~~ nil - ifTrue: - [index := redButtonMenu startUp. - index ~= 0 - ifTrue: [self perform: (redButtonMessages at: index)]] - ifFalse: [super controlActivity]! Item was removed: - ----- Method: MouseMenuController>>redButtonMenu:redButtonMessages: (in category 'menu setup') ----- - redButtonMenu: aSystemMenu redButtonMessages: anArray - "Initialize the pop-up menu that should appear when the user presses the - red mouse button to be aSystemMenu. The corresponding messages that - should be sent are listed in the array, anArray." - - redButtonMenu release. - redButtonMenu := aSystemMenu. - redButtonMessages := anArray! Item was removed: - ----- Method: MouseMenuController>>release (in category 'initialize-release') ----- - release - super release. - redButtonMenu release! Item was removed: - ----- Method: MouseMenuController>>reset (in category 'initialize-release') ----- - reset - "Eliminate references to all mouse button menus." - - redButtonMenu := nil. - redButtonMessages := nil! Item was removed: - ----- Method: MouseMenuController>>shiftedTextPaneMenuRequest (in category 'pluggable menus') ----- - shiftedTextPaneMenuRequest - "The user chose the more... branch from the text-pane menu." - - ^ self pluggableYellowButtonActivity: true! Item was removed: - ----- Method: MouseMenuController>>shiftedYellowButtonActivity (in category 'pluggable menus') ----- - shiftedYellowButtonActivity - "Invoke the model's special popup menu." - - ^ self pluggableYellowButtonActivity: true! Item was removed: - ----- Method: MouseMenuController>>unshiftedYellowButtonActivity (in category 'pluggable menus') ----- - unshiftedYellowButtonActivity - "Invoke the model's normal popup menu." - - ^ self pluggableYellowButtonActivity: false! Item was removed: - ----- Method: MouseMenuController>>yellowButtonActivity (in category 'menu messages') ----- - yellowButtonActivity - "This normally opens a popup menu. Determine the selected - item and, if one is selected, then send the corresponding message - to either the model or the receiver." - - ^ self pluggableYellowButtonActivity: sensor leftShiftDown! Item was removed: - Controller subclass: #NoController - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Framework'! - - !NoController commentStamp: '<historical>' prior: 0! - I represent a controller that never wants control. I am the controller for views that are non-interactive.! Item was removed: - ----- Method: NoController>>isControlActive (in category 'control defaults') ----- - isControlActive - "Refer to the comment in Controller|isControlActive." - - ^false! Item was removed: - ----- Method: NoController>>isControlWanted (in category 'control defaults') ----- - isControlWanted - "Refer to the comment in Controller|isControlWanted." - - ^false! Item was removed: - ----- Method: NoController>>startUp (in category 'basic control sequence') ----- - startUp - "I do nothing." - - ^self! Item was removed: - Switch subclass: #OneOnSwitch - instanceVariableNames: 'connection' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Menus'! - - !OneOnSwitch commentStamp: '<historical>' prior: 0! - I am a kind of Switch that can be connected to some related object, typically to a collection of my instances. When my instance is created, its connection is set to a particular object. When the object changes because an Switch it refers to is turned on, an update message is broadcasted. All the connected OneOnSwitches, except the changed one, turn off. This allows OneOnSwitches to maintain the constraint that at most one of them will be on at any time. OneOnSwitches can thus be made to act like "car radio" switches.! Item was removed: - ----- Method: OneOnSwitch>>connection (in category 'connection') ----- - connection - "Answer the object that connects the receiver to other Switches." - - ^connection! Item was removed: - ----- Method: OneOnSwitch>>connection: (in category 'connection') ----- - connection: anObject - "Set anObject to be the connection among two or more Switches. Make the - receiver a dependent of the argument, anObject." - - connection := anObject. - connection addDependent: self! Item was removed: - ----- Method: OneOnSwitch>>isConnectionSet (in category 'connection') ----- - isConnectionSet - "Answer whether the receiver is connected to an object that coordinates - updates among switches." - - connection == nil - ifTrue: [^false] - ifFalse: [^true]! Item was removed: - ----- Method: OneOnSwitch>>notifyConnection (in category 'connection') ----- - notifyConnection - "Send the receiver's connection (if it exists) the message 'changed: self' in - order for the connection to broadcast the change to other objects - connected by the connection." - - self isConnectionSet ifTrue: [self connection changed: self]! Item was removed: - ----- Method: OneOnSwitch>>release (in category 'initialize-release') ----- - release - - super release. - self isConnectionSet ifTrue: [connection removeDependent: self]! Item was removed: - ----- Method: OneOnSwitch>>turnOn (in category 'state') ----- - turnOn - "Does nothing if it is already on. If it is not, it is set to 'on', its - dependents are notified of the change, its connection is notified, and - its action is executed." - - self isOff - ifTrue: - [on := true. - self changed. - self notifyConnection. - self doAction: onAction]! Item was removed: - ----- Method: OneOnSwitch>>update: (in category 'updating') ----- - update: aOneOnSwitch - "Does nothing if aOneOnSwitch is identical to this object. If it is not, this - object is turned off. This message is sent by the connection (an Object) - when some related OneOnSwitch (possibly this one) has changed. This - allows a group of related OneOnSwitches to maintain the constraint that - at most one will be on at any time." - - self ~~ aOneOnSwitch ifTrue: [self turnOff]! Item was removed: - DisplayText subclass: #Paragraph - instanceVariableNames: 'clippingRectangle compositionRectangle destinationForm rule mask marginTabsLevel lines lastLine' - classVariableNames: '' - poolDictionaries: 'TextConstants' - category: 'ST80-Support'! - - !Paragraph commentStamp: '<historical>' prior: 0! - I represent displayable text that has been decoraged with margin alignment, line leading, and tab settings.! Item was removed: - ----- Method: Paragraph class>>example (in category 'examples') ----- - example - "This simple example illustrates how to display a few lines of text on the screen at the current cursor point. - Fixed. " - - | para point | - point := Sensor waitButton. - para := 'This is the first line of characters - and this is the second line.' asParagraph. - para displayOn: Display at: point. - - "Paragraph example"! Item was removed: - ----- Method: Paragraph class>>new (in category 'instance creation') ----- - new - "Do not allow an uninitialized view. Create with text that has no - characters." - - ^self withText: '' asText! Item was removed: - ----- Method: Paragraph class>>withText: (in category 'instance creation') ----- - withText: aText - "Answer an instance of me with text set to aText and style set to the - system's default text style." - - ^self withText: aText style: DefaultTextStyle copy! Item was removed: - ----- Method: Paragraph class>>withText:style: (in category 'instance creation') ----- - withText: aText style: aTextStyle - "Answer an instance of me with text set to aText and style set to - aTextStyle." - - ^super new setWithText: aText style: aTextStyle! Item was removed: - ----- Method: Paragraph class>>withText:style:compositionRectangle:clippingRectangle:foreColor:backColor: (in category 'instance creation') ----- - withText: aText style: aTextStyle compositionRectangle: compRect clippingRectangle: clipRect foreColor: c1 backColor: c2 - "Answer an instance of me with text set to aText and style set to - aTextStyle, composition rectangle is compRect and the clipping rectangle - is clipRect." - | para | - para := super new. - para setWithText: aText - style: aTextStyle - compositionRectangle: compRect - clippingRectangle: clipRect - foreColor: c1 backColor: c2. - ^para! Item was removed: - ----- Method: Paragraph>>asForm (in category 'converting') ----- - asForm - "Answer a Form made up of the bits that represent the receiver's displayable text." - - | theForm | - theForm := textStyle maxDepth = 1 - ifTrue: [ - (ColorForm extent: compositionRectangle extent) - offset: offset; - colors: { - backColor ifNil: [Color transparent]. - foreColor ifNil: [Color black]}] - ifFalse: [ - (Form extent: compositionRectangle extent depth: Display depth) - offset: offset]. - - self displayOn: theForm - at: 0 at 0 - clippingBox: theForm boundingBox - rule: Form over - fillColor: nil. - - ^ theForm - - "Example: - | p | - p := 'Abc' asParagraph. - p foregroundColor: Color red backgroundColor: Color black. - p asForm displayOn: Display at: 30 at 30 rule: Form over" - ! Item was removed: - ----- Method: Paragraph>>asString (in category 'converting') ----- - asString - "Answer the string of characters of the receiver's text." - - ^text string! Item was removed: - ----- Method: Paragraph>>asText (in category 'converting') ----- - asText - "Answer the receiver's text." - - ^text! Item was removed: - ----- Method: Paragraph>>backgroundColor (in category 'accessing') ----- - backgroundColor - backColor == nil ifTrue: [^ Color white]. - ^ backColor! Item was removed: - ----- Method: Paragraph>>bottomAtLineIndex: (in category 'private') ----- - bottomAtLineIndex: lineIndex - "Answer the bottom y of given line." - | y | - y := compositionRectangle top. - lastLine = 0 ifTrue: [^ y + textStyle lineGrid]. - 1 to: (lineIndex min: lastLine) do: - [:i | y := y + (lines at: i) lineHeight]. - ^ y - ! Item was removed: - ----- Method: Paragraph>>boundingBox (in category 'display box access') ----- - boundingBox - - ^offset extent: compositionRectangle extent! Item was removed: - ----- Method: Paragraph>>caretFormForDepth: (in category 'selecting') ----- - caretFormForDepth: depth - "Return a caret form for the given depth." - "(Paragraph new caretFormForDepth: Display depth) displayOn: Display at: 0 at 0 rule: Form reverse" - - | box f bb map | - box := CaretForm boundingBox. - f := Form extent: box extent depth: depth. - map := (Color cachedColormapFrom: CaretForm depth to: depth) copy. - map at: 1 put: (Color transparent pixelValueForDepth: depth). - map at: 2 put: (Color quickHighLight: depth) first. "pixel value for reversing" - bb := BitBlt toForm: f. - bb - sourceForm: CaretForm; - sourceRect: box; - destOrigin: 0 at 0; - colorMap: map; - combinationRule: Form over; - copyBits. - ^ f! Item was removed: - ----- Method: Paragraph>>centered (in category 'alignment') ----- - centered - "Set the alignment for the style with which the receiver displays its text - so that text is centered in the composition rectangle." - - textStyle alignment: Centered! Item was removed: - ----- Method: Paragraph>>characterBlockAtPoint: (in category 'character location') ----- - characterBlockAtPoint: aPoint - "Answer a CharacterBlock for characters in the text at point aPoint. It is - assumed that aPoint has been transformed into coordinates appropriate to - the receiver's destinationForm rectangle and the compositionRectangle." - - ^CharacterBlockScannerForMVC new characterBlockAtPoint: aPoint in: self! Item was removed: - ----- Method: Paragraph>>characterBlockForIndex: (in category 'character location') ----- - characterBlockForIndex: targetIndex - "Answer a CharacterBlock for character in the text at targetIndex. The - coordinates in the CharacterBlock will be appropriate to the intersection - of the destinationForm rectangle and the compositionRectangle." - - ^CharacterBlockScannerForMVC new characterBlockForIndex: targetIndex in: self! Item was removed: - ----- Method: Paragraph>>clearVisibleRectangle (in category 'utilities') ----- - clearVisibleRectangle - "Display the area in which the receiver presents its text so that the area - is all one tone--in this case, all white." - - destinationForm - fill: clippingRectangle - rule: rule - fillColor: self backgroundColor! Item was removed: - ----- Method: Paragraph>>clickAt:for:controller: (in category 'selecting') ----- - clickAt: clickPoint for: model controller: aController - "Give sensitive text a chance to fire. Display flash: (100 at 100 extent: 100 at 100)." - | startBlock action | - action := false. - startBlock := self characterBlockAtPoint: clickPoint. - (text attributesAt: startBlock stringIndex forStyle: textStyle) - do: [:att | att mayActOnClick ifTrue: - [| range boxes box | - range := text rangeOf: att startingAt: startBlock stringIndex. - boxes := self selectionRectsFrom: (self characterBlockForIndex: range first) - to: (self characterBlockForIndex: range last+1). - box := boxes detect: [:each | each containsPoint: clickPoint] - ifNone: [^ action]. - Utilities awaitMouseUpIn: box repeating: [] - ifSucceed: [aController terminateAndInitializeAround: - [(att actOnClickFor: model in: self at: clickPoint editor: aController) ifTrue: [action := true]]]]]. - ^ action! Item was removed: - ----- Method: Paragraph>>clippingRectangle (in category 'accessing') ----- - clippingRectangle - "Answer the rectangle, defined in absolute coordinates, whose - intersection with the destinationForm is the area in which the characters - are constrained to display." - - ^clippingRectangle! Item was removed: - ----- Method: Paragraph>>clippingRectangle: (in category 'accessing') ----- - clippingRectangle: clipRect - clippingRectangle := clipRect! Item was removed: - ----- Method: Paragraph>>composeAll (in category 'composition') ----- - composeAll - "Compose a collection of characters into a collection of lines." - - | startIndex stopIndex lineIndex maximumRightX compositionScanner | - lines := Array new: 32. - lastLine := 0. - maximumRightX := 0. - text size = 0 - ifTrue: - [compositionRectangle := compositionRectangle withHeight: 0. - ^maximumRightX]. - startIndex := lineIndex := 1. - stopIndex := text size. - compositionScanner := CompositionScanner new forParagraph: self. - [startIndex > stopIndex] whileFalse: - [self lineAt: lineIndex - put: (compositionScanner composeLine: lineIndex - fromCharacterIndex: startIndex - inParagraph: self). - maximumRightX := compositionScanner rightX max: maximumRightX. - startIndex := (lines at: lineIndex) last + 1. - lineIndex := lineIndex + 1]. - self updateCompositionHeight. - self trimLinesTo: lineIndex - 1. - ^ maximumRightX! Item was removed: - ----- Method: Paragraph>>compositionRectangle (in category 'accessing') ----- - compositionRectangle - "Answer the rectangle whose width is the dimension, modified by - indents and tabsLevels, against which line wraparound is measured. The - height of the compositionRectangle is reset each time recomposition is - required." - - ^compositionRectangle! Item was removed: - ----- Method: Paragraph>>compositionRectangle: (in category 'accessing') ----- - compositionRectangle: compRectangle - "Set the rectangle whose width is the dimension, modified by indents and - tabsLevels, against which line wraparound is measured." - - compositionRectangle := compRectangle. - self composeAll! Item was removed: - ----- Method: Paragraph>>compositionRectangle:text:style:offset: (in category 'private') ----- - compositionRectangle: compositionRect text: aText style: aTextStyle offset: aPoint - - compositionRectangle := compositionRect copy. - text := aText. - textStyle := aTextStyle. - rule := DefaultRule. - mask := nil. "was DefaultMask " - marginTabsLevel := 0. - destinationForm := Display. - offset := aPoint. - ^self composeAll! Item was removed: - ----- Method: Paragraph>>compositionRectangleDelta (in category 'private') ----- - compositionRectangleDelta - "A handy number -- mostly for scrolling." - - ^compositionRectangle top - clippingRectangle top! Item was removed: - ----- Method: Paragraph>>computeBoundingBox (in category 'display box access') ----- - computeBoundingBox - - ^offset extent: compositionRectangle extent! Item was removed: - ----- Method: Paragraph>>deepCopy (in category 'utilities') ----- - deepCopy - "Don't want to copy the destForm (Display) or fonts in the TextStyle. 9/13/96 tk" - - | new | - new := self copy. - new textStyle: textStyle copy. - new destinationForm: destinationForm. - new lines: lines copy. - new text: text deepCopy. - ^ new! Item was removed: - ----- Method: Paragraph>>defaultCharacterBlock (in category 'character location') ----- - defaultCharacterBlock - ^ CharacterBlock new stringIndex: 1 text: text - topLeft: compositionRectangle topLeft extent: 0 @ 0! Item was removed: - ----- Method: Paragraph>>destinationForm (in category 'accessing') ----- - destinationForm - "Answer the Form into which the characters are scanned." - - ^destinationForm! Item was removed: - ----- Method: Paragraph>>destinationForm: (in category 'utilities') ----- - destinationForm: destForm - destinationForm := destForm! Item was removed: - ----- Method: Paragraph>>displayLines: (in category 'private') ----- - displayLines: linesInterval - ^ self displayLines: linesInterval - affectedRectangle: self visibleRectangle! Item was removed: - ----- Method: Paragraph>>displayLines:affectedRectangle: (in category 'private') ----- - displayLines: linesInterval affectedRectangle: affectedRectangle - "This is the first level workhorse in the display portion of the TextForm routines. - It checks to see which lines in the interval are actually visible, has the - CharacterScanner display only those, clears out the areas in which display will - occur, and clears any space remaining in the visibleRectangle following the space - occupied by lastLine." - - | topY firstLineIndex lastLineIndex lastLineIndexBottom | - - "Save some time by only displaying visible lines" - firstLineIndex := self lineIndexOfTop: affectedRectangle top. - firstLineIndex < linesInterval first ifTrue: [firstLineIndex := linesInterval first]. - lastLineIndex := self lineIndexOfTop: affectedRectangle bottom - 1. - lastLineIndex > linesInterval last ifTrue: - [linesInterval last > lastLine - ifTrue: [lastLineIndex := lastLine] - ifFalse: [lastLineIndex := linesInterval last]]. - lastLineIndexBottom := (self bottomAtLineIndex: lastLineIndex). - ((Rectangle - origin: affectedRectangle left @ (topY := self topAtLineIndex: firstLineIndex) - corner: affectedRectangle right @ lastLineIndexBottom) - intersects: affectedRectangle) - ifTrue: [ " . . . (skip to clear-below if no lines displayed)" - BitBltDisplayScanner new - displayLines: (firstLineIndex to: lastLineIndex) - in: self clippedBy: affectedRectangle]. - lastLineIndex = lastLine ifTrue: - [destinationForm "Clear out white space below last line" - fill: (affectedRectangle left @ (lastLineIndexBottom max: affectedRectangle top) - corner: affectedRectangle bottomRight) - rule: rule fillColor: self backgroundColor]! Item was removed: - ----- Method: Paragraph>>displayOn: (in category 'displaying') ----- - displayOn: aDisplayMedium - "Because Paragraphs cache so much information, computation is avoided - and displayAt: 0 at 0 is not appropriate here." - - self displayOn: aDisplayMedium - at: compositionRectangle topLeft - clippingBox: clippingRectangle - rule: rule - fillColor: mask! Item was removed: - ----- Method: Paragraph>>displayOn:at: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aPoint - "Use internal clippingRect; destination cliping is done during actual display." - - self displayOn: aDisplayMedium at: aPoint - clippingBox: (clippingRectangle translateBy: aPoint - compositionRectangle topLeft) - rule: rule fillColor: mask! Item was removed: - ----- Method: Paragraph>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger fillColor: aForm - "Default display message when aDisplayPoint is in absolute screen - coordinates." - - rule := ruleInteger. - mask := aForm. - clippingRectangle := clipRectangle. - compositionRectangle := aDisplayPoint extent: compositionRectangle extent. - (lastLine == nil or: [lastLine < 1]) ifTrue: [self composeAll]. - self displayOn: aDisplayMedium lines: (1 to: lastLine)! Item was removed: - ----- Method: Paragraph>>displayOn:lines: (in category 'private') ----- - displayOn: aDisplayMedium lines: lineInterval - - | saveDestinationForm | - saveDestinationForm := destinationForm. - destinationForm := aDisplayMedium. - self displayLines: lineInterval. - destinationForm := saveDestinationForm! Item was removed: - ----- Method: Paragraph>>displayOn:transformation:clippingBox:align:with:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle align: alignmentPoint with: relativePoint rule: ruleInteger fillColor: aForm - - self "Assumes offset has been set!!!!!!!!!!" - displayOn: aDisplayMedium - at: (offset - + (displayTransformation applyTo: relativePoint) - - alignmentPoint) rounded - clippingBox: clipRectangle - rule: ruleInteger - fillColor: aForm. - ! Item was removed: - ----- Method: Paragraph>>extendSelectionAt:endBlock: (in category 'selecting') ----- - extendSelectionAt: beginBlock endBlock: endBlock - "Answer with an Array of two CharacterBlocks that represent the text - selection that the user makes." - - (self characterBlockAtPoint: Sensor cursorPoint) <= beginBlock - ifTrue: [^self mouseMovedFrom: beginBlock - pivotBlock: endBlock - showingCaret: (beginBlock = endBlock)] - ifFalse: [^self mouseMovedFrom: endBlock - pivotBlock: beginBlock - showingCaret: (beginBlock = endBlock)] - ! Item was removed: - ----- Method: Paragraph>>extendSelectionMark:pointBlock: (in category 'selecting') ----- - extendSelectionMark: markBlock pointBlock: pointBlock - "Answer with an Array of two CharacterBlocks that represent the text - selection that the user makes." - true - ifTrue:[^self mouseMovedFrom: pointBlock - pivotBlock: markBlock - showingCaret:(pointBlock = markBlock)] - ifFalse: - [ | beginBlock endBlock | - beginBlock := markBlock min: pointBlock. - endBlock := markBlock max: endBlock. - - (self characterBlockAtPoint: Sensor cursorPoint) <= beginBlock - ifTrue: [^self mouseMovedFrom: beginBlock - pivotBlock: endBlock - showingCaret: (beginBlock = endBlock)] - ifFalse: [^self mouseMovedFrom: endBlock - pivotBlock: beginBlock - showingCaret: (beginBlock = endBlock)] - ] - ! Item was removed: - ----- Method: Paragraph>>fillColor (in category 'accessing') ----- - fillColor - "Answer the Form with which each character is combined by the scanner - before applying the rule for display." - - ^mask! Item was removed: - ----- Method: Paragraph>>fillColor: (in category 'accessing') ----- - fillColor: maskForm - "Set the argument, maskForm, to be the form with which each character - is combined by the scanner before applying the rule for display." - - mask := maskForm! Item was removed: - ----- Method: Paragraph>>fit (in category 'utilities') ----- - fit - "Make the bounding rectangle of the receiver contain all the text without - changing the width of the receiver's composition rectangle." - - [(self lineIndexOfTop: clippingRectangle top) = 1] - whileFalse: [self scrollBy: (0-1)*textStyle lineGrid]. - self updateCompositionHeight. - clippingRectangle := clippingRectangle withBottom: compositionRectangle bottom! Item was removed: - ----- Method: Paragraph>>flash (in category 'indicating') ----- - flash - "Complement twice the visible area in which the receiver displays." - - Display flash: clippingRectangle! Item was removed: - ----- Method: Paragraph>>height (in category 'accessing') ----- - height - "Answer the height of the composition rectangle." - - ^compositionRectangle height! Item was removed: - ----- Method: Paragraph>>hiliteRect: (in category 'selecting') ----- - hiliteRect: rect - - rect ifNotNil: [ - | highlightColor | - highlightColor := Color quickHighLight: destinationForm depth. - destinationForm - fill: rect - rule: Form reverse - fillColor: highlightColor]. - ! Item was removed: - ----- Method: Paragraph>>indentationOfLineIndex:ifBlank: (in category 'accessing') ----- - indentationOfLineIndex: lineIndex ifBlank: aBlock - "Answer the number of leading tabs in the line at lineIndex. If there are - no visible characters, pass the number of tabs to aBlock and return its value. - If the line is word-wrap overflow, back up a line and recur." - - | arrayIndex first last reader leadingTabs lastSeparator lf tab ch | - lf := Character lf. - tab := Character tab. - arrayIndex := lineIndex. - [first := (lines at: arrayIndex) first. - first > 1 and: [(text string at: first - 1) ~~ CR and: [(text string at: first - 1) ~~ lf]]] whileTrue: "word wrap" - [arrayIndex := arrayIndex - 1]. - last := (lines at: lastLine) last. - reader := ReadStream on: text string from: first to: last. - leadingTabs := 0. - [reader atEnd not and: [(ch := reader next) == tab]] - whileTrue: [leadingTabs := leadingTabs + 1]. - lastSeparator := first - 1 + leadingTabs. - [reader atEnd not and: [ch isSeparator and: [ch ~~ CR and: [ch ~~ lf]]]] - whileTrue: [lastSeparator := lastSeparator + 1. ch := reader next]. - (lastSeparator = last or: [ch == CR or: [ch == lf]]) - ifTrue: [^aBlock value: leadingTabs]. - ^leadingTabs! Item was removed: - ----- Method: Paragraph>>justified (in category 'alignment') ----- - justified - "Set the alignment for the style with which the receiver displays its text - so that the characters in each of text end on an even border in the - composition rectangle." - - textStyle alignment: Justified! Item was removed: - ----- Method: Paragraph>>leftFlush (in category 'alignment') ----- - leftFlush - "Set the alignment for the style with which the receiver displays its text - so that the characters in each of text begin on an even border in the - composition rectangle. This is also known as ragged-right." - - textStyle alignment: LeftFlush! Item was removed: - ----- Method: Paragraph>>leftMarginForCompositionForLine: (in category 'private') ----- - leftMarginForCompositionForLine: lineIndex - "Build the left margin for composition of a line. Depends upon - marginTabsLevel and the indent." - - | indent | - lineIndex = 1 - ifTrue: [indent := textStyle firstIndent] - ifFalse: [indent := textStyle restIndent]. - ^indent + (textStyle leftMarginTabAt: marginTabsLevel)! Item was removed: - ----- Method: Paragraph>>leftMarginForDisplayForLine:alignment: (in category 'private') ----- - leftMarginForDisplayForLine: lineIndex alignment: alignment - "Build the left margin for display of a line. Depends upon - leftMarginForComposition, compositionRectangle left and the alignment." - - | pad | - (alignment = LeftFlush or: [alignment = Justified]) - ifTrue: - [^compositionRectangle left - + (self leftMarginForCompositionForLine: lineIndex)]. - "When called from character location code and entire string has been cut, - there are no valid lines, hence following nil check." - (lineIndex <= lines size and: [(lines at: lineIndex) notNil]) - ifTrue: - [pad := (lines at: lineIndex) paddingWidth] - ifFalse: - [pad := - compositionRectangle width - textStyle firstIndent - textStyle rightIndent]. - alignment = Centered - ifTrue: - [^compositionRectangle left - + (self leftMarginForCompositionForLine: lineIndex) + (pad // 2)]. - alignment = RightFlush - ifTrue: - [^compositionRectangle left - + (self leftMarginForCompositionForLine: lineIndex) + pad]. - self error: ['no such alignment']! Item was removed: - ----- Method: Paragraph>>lineAt:put: (in category 'private') ----- - lineAt: indexInteger put: aTextLineInterval - "Store a line, track last, and grow lines if necessary." - indexInteger > lastLine ifTrue: [lastLine := indexInteger]. - lastLine > lines size ifTrue: [lines := lines , (Array new: lines size)]. - ^lines at: indexInteger put: aTextLineInterval! Item was removed: - ----- Method: Paragraph>>lineIndexOfCharacterIndex: (in category 'private') ----- - lineIndexOfCharacterIndex: characterIndex - "Answer the line index for a given characterIndex." - - 1 to: lastLine do: - [:lineIndex | - (lines at: lineIndex) last >= characterIndex ifTrue: [^lineIndex]]. - ^lastLine! Item was removed: - ----- Method: Paragraph>>lineIndexOfTop: (in category 'private') ----- - lineIndexOfTop: top - "Answer the line index at a given top y." - | y line | - lastLine = 0 ifTrue: [^ 1]. - y := compositionRectangle top. - 1 to: lastLine do: - [:i | line := lines at: i. - (y := y + line lineHeight) > top ifTrue: [^ i]]. - ^ lastLine - ! Item was removed: - ----- Method: Paragraph>>lines (in category 'private') ----- - lines - - ^lines! Item was removed: - ----- Method: Paragraph>>lines: (in category 'utilities') ----- - lines: lineArray - lines := lineArray! Item was removed: - ----- Method: Paragraph>>mask (in category 'accessing') ----- - mask - "Answer the Form with which each character is combined by the scanner - before applying the rule for display." - - ^mask! Item was removed: - ----- Method: Paragraph>>mouseMovedFrom:pivotBlock:showingCaret: (in category 'selecting') ----- - mouseMovedFrom: beginBlock pivotBlock: pivotBlock showingCaret: caretOn - | startBlock stopBlock showingCaret | - stopBlock := startBlock := beginBlock. - showingCaret := caretOn. - [Sensor redButtonPressed] - whileTrue: - [stopBlock := self characterBlockAtPoint: Sensor cursorPoint. - stopBlock = startBlock - ifFalse: - [showingCaret - ifTrue: - [showingCaret := false. - self reverseFrom: pivotBlock to: pivotBlock]. - ((startBlock >= pivotBlock and: [stopBlock >= pivotBlock]) - or: [startBlock <= pivotBlock and: [stopBlock <= pivotBlock]]) - ifTrue: - [self reverseFrom: startBlock to: stopBlock. - startBlock := stopBlock] - ifFalse: - [self reverseFrom: startBlock to: pivotBlock. - self reverseFrom: pivotBlock to: stopBlock. - startBlock := stopBlock]. - (clippingRectangle containsRect: stopBlock) ifFalse: - [stopBlock top < clippingRectangle top - ifTrue: [self scrollBy: stopBlock top - clippingRectangle top - withSelectionFrom: pivotBlock to: stopBlock] - ifFalse: [self scrollBy: stopBlock bottom + textStyle lineGrid - clippingRectangle bottom - withSelectionFrom: pivotBlock to: stopBlock]]]]. - pivotBlock = stopBlock ifTrue: - [showingCaret ifFalse: "restore caret" - [self reverseFrom: pivotBlock to: pivotBlock]]. - ^ Array with: pivotBlock with: stopBlock! Item was removed: - ----- Method: Paragraph>>mouseSelect (in category 'selecting') ----- - mouseSelect - "Answer with an Array of two CharacterBlocks that represent the text - selection that the user makes. Return quickly if the button is noticed up - to make double-click more responsive." - - | pivotBlock startBlock stopBlock origPoint stillDown | - stillDown := Sensor redButtonPressed. - pivotBlock := startBlock := stopBlock := - self characterBlockAtPoint: (origPoint := Sensor cursorPoint). - stillDown := stillDown and: [Sensor redButtonPressed]. - self reverseFrom: startBlock to: startBlock. - [stillDown and: [Sensor cursorPoint = origPoint]] whileTrue: - [stillDown := Sensor redButtonPressed]. - (stillDown and: [clippingRectangle containsPoint: Sensor cursorPoint]) - ifFalse: [^Array with: pivotBlock with: stopBlock]. - ^ self mouseMovedFrom: startBlock - pivotBlock: pivotBlock - showingCaret: true! Item was removed: - ----- Method: Paragraph>>mouseSelect: (in category 'selecting') ----- - mouseSelect: clickPoint - "Track text selection and answer with an Array of two CharacterBlocks." - | startBlock | - startBlock := self characterBlockAtPoint: clickPoint. - self reverseFrom: startBlock to: startBlock. - ^ self mouseMovedFrom: startBlock - pivotBlock: startBlock - showingCaret: true! Item was removed: - ----- Method: Paragraph>>moveBy: (in category 'private') ----- - moveBy: delta - compositionRectangle := compositionRectangle translateBy: delta. - clippingRectangle := clippingRectangle translateBy: delta. - ! Item was removed: - ----- Method: Paragraph>>numberOfLines (in category 'accessing') ----- - numberOfLines - "Answer the number of lines of text in the receiver." - - ^lastLine! Item was removed: - ----- Method: Paragraph>>outline (in category 'indicating') ----- - outline - "Display a border around the visible area in which the receiver presents - its text." - - clippingRectangle bottom <= compositionRectangle bottom - ifTrue: [Display - border: (clippingRectangle intersect: compositionRectangle) - width: 2] - ifFalse: [Display - border: (clippingRectangle intersect: destinationForm boundingBox) - width: 2]. - ! Item was removed: - ----- Method: Paragraph>>replaceFrom:to:with:displaying: (in category 'accessing') ----- - replaceFrom: start to: stop with: aText displaying: displayBoolean - "Replace the receiver's text starting at position start, stopping at stop, by - the characters in aText. It is expected that most requirements for - modifications to the receiver will call this code. Certainly all cut's or - paste's." - - | compositionScanner obsoleteLines obsoleteLastLine firstLineIndex lastLineIndex - startLine stopLine replacementRange visibleRectangle startIndex newLine done - newStop obsoleteY newY moveRectangle | - - text replaceFrom: start to: stop with: aText. "Update the text." - lastLine = 0 ifTrue: - ["if lines have never been set up, measure them and display - all the lines falling in the visibleRectangle" - self composeAll. - displayBoolean ifTrue: [^ self displayLines: (1 to: lastLine)]]. - - "save -- things get pretty mashed as we go along" - obsoleteLines := lines copy. - obsoleteLastLine := lastLine. - - "find the starting and stopping lines" - firstLineIndex := startLine := self lineIndexOfCharacterIndex: start. - stopLine := self lineIndexOfCharacterIndex: stop. - - "how many characters being inserted or deleted - -- negative if aText size is < characterInterval size." - replacementRange := aText size - (stop - start + 1). - "Give ourselves plenty of elbow room." - compositionRectangle := compositionRectangle withHeight: (textStyle lineGrid * 9999). - "build a boundingBox of the actual screen space in question -- we'll need it later" - visibleRectangle := (clippingRectangle intersect: compositionRectangle) - intersect: destinationForm boundingBox. - compositionScanner := CompositionScanner new forParagraph: self. "Initialize a scanner." - - "If the starting line is not also the first line, then measuring must commence from line preceding the one in which characterInterval start appears. For example, deleting a line with only a carriage return may move characters following the deleted portion of text into the line preceding the deleted line." - startIndex := (lines at: firstLineIndex) first. - startLine > 1 - ifTrue: [newLine := compositionScanner composeLine: startLine - 1 - fromCharacterIndex: (lines at: startLine - 1) first - inParagraph: self. - (lines at: startLine - 1) = newLine - ifFalse: ["start in line preceding the one with the starting character" - startLine := startLine - 1. - self lineAt: startLine put: newLine. - startIndex := newLine last + 1]]. - startIndex > text size ifTrue: - ["nil lines after a deletion -- remeasure last line below" - self trimLinesTo: (firstLineIndex - 1 max: 0). - text size = 0 ifTrue: - ["entire text deleted -- clear visibleRectangle and return." - displayBoolean ifTrue: [destinationForm fill: visibleRectangle rule: rule fillColor: self backgroundColor]. - self updateCompositionHeight. - ^self]]. - - "Now we really get to it." - done := false. - lastLineIndex := stopLine. - [done or: [startIndex > text size]] - whileFalse: - [self lineAt: firstLineIndex put: - (newLine := compositionScanner composeLine: firstLineIndex - fromCharacterIndex: startIndex inParagraph: self). - [(lastLineIndex > obsoleteLastLine - or: ["no more old lines to compare with?" - newLine last < - (newStop := (obsoleteLines at: lastLineIndex) last + replacementRange)]) - or: [done]] - whileFalse: - [newStop = newLine last - ifTrue: ["got the match" - "get source and dest y's for moving the unchanged lines" - obsoleteY := self topAtLineIndex: lastLineIndex + 1 - using: obsoleteLines and: obsoleteLastLine. - newY := self topAtLineIndex: firstLineIndex + 1. - stopLine := firstLineIndex. - done := true. - "Fill in the new line vector with the old unchanged lines. - Update their starting and stopping indices on the way." - ((lastLineIndex := lastLineIndex + 1) to: obsoleteLastLine) do: - [:upDatedIndex | - self lineAt: (firstLineIndex := firstLineIndex + 1) - put: ((obsoleteLines at: upDatedIndex) - slide: replacementRange)]. - "trim off obsolete lines, if any" - self trimLinesTo: firstLineIndex] - ifFalse: [lastLineIndex := lastLineIndex + 1]]. - startIndex := newLine last + 1. - firstLineIndex := firstLineIndex + 1]. - - "Now the lines are up to date -- Whew!!. What remains is to move - the 'unchanged' lines and display those which have changed." - displayBoolean "Not much to do if not displaying" - ifFalse: [^ self updateCompositionHeight]. - startIndex > text size ifTrue: - ["If at the end of previous lines simply display lines from the line in - which the first character of the replacement occured through the - end of the paragraph." - self updateCompositionHeight. - self displayLines: - (startLine to: (stopLine := firstLineIndex min: lastLine)). - destinationForm "Clear out area at the bottom" - fill: ((visibleRectangle left @ (self topAtLineIndex: lastLine + 1) - extent: visibleRectangle extent) - intersect: visibleRectangle) - rule: rule fillColor: self backgroundColor] - ifFalse: - [newY ~= obsoleteY ifTrue: - ["Otherwise first move the unchanged lines within - the visibleRectangle with a good old bitblt." - moveRectangle := - visibleRectangle left @ (obsoleteY max: visibleRectangle top) - corner: visibleRectangle corner. - destinationForm copyBits: moveRectangle from: destinationForm - at: moveRectangle origin + (0 @ (newY-obsoleteY)) - clippingBox: visibleRectangle - rule: Form over fillColor: nil]. - - "Then display the altered lines." - self displayLines: (startLine to: stopLine). - - newY < obsoleteY - ifTrue: - [(self topAtLineIndex: obsoleteLastLine+1 using: obsoleteLines and: obsoleteLastLine) > visibleRectangle bottom - ifTrue: - ["A deletion may have 'pulled' previously undisplayed lines - into the visibleRectangle. If so, display them." - self displayLines: - ((self lineIndexOfTop: visibleRectangle bottom - (obsoleteY - newY)) - to: (self lineIndexOfTop: visibleRectangle bottom))]. - "Clear out obsolete material at the bottom of the visibleRectangle." - destinationForm - fill: ((visibleRectangle left @ ((self bottomAtLineIndex: lastLine) + 1) - extent: visibleRectangle extent) - intersect: visibleRectangle) "How about just corner: ??" - rule: rule fillColor: self backgroundColor]. - - (newY > obsoleteY and: [obsoleteY < visibleRectangle top]) - ifTrue: - ["An insertion may have 'pushed' previously undisplayed lines - into the visibleRectangle. If so, display them." - self displayLines: - ((self lineIndexOfTop: visibleRectangle top) - to: (self lineIndexOfTop: visibleRectangle top + (newY-obsoleteY)))]. - - self updateCompositionHeight]! Item was removed: - ----- Method: Paragraph>>reverseFrom:to: (in category 'selecting') ----- - reverseFrom: characterBlock1 to: characterBlock2 - "Reverse area between the two character blocks given as arguments." - | visibleRectangle initialRectangle interiorRectangle finalRectangle lineNo baseline caret | - characterBlock1 = characterBlock2 ifTrue: - [lineNo := self lineIndexOfCharacterIndex: characterBlock1 stringIndex. - baseline := lineNo = 0 ifTrue: [textStyle baseline] - ifFalse: [(lines at: lineNo) baseline]. - caret := self caretFormForDepth: Display depth. - ^ caret "Use a caret to indicate null selection" - displayOn: destinationForm - at: characterBlock1 topLeft + (-3 @ baseline) - clippingBox: clippingRectangle - rule: (false "Display depth>8" ifTrue: [9 "not-reverse"] - ifFalse: [Form reverse]) - fillColor: nil]. - visibleRectangle := - (clippingRectangle intersect: compositionRectangle) - "intersect: destinationForm boundingBox" "not necessary". - characterBlock1 top = characterBlock2 top - ifTrue: [characterBlock1 left < characterBlock2 left - ifTrue: - [initialRectangle := - (characterBlock1 topLeft corner: characterBlock2 bottomLeft) - intersect: visibleRectangle] - ifFalse: - [initialRectangle := - (characterBlock2 topLeft corner: characterBlock1 bottomLeft) - intersect: visibleRectangle]] - ifFalse: [characterBlock1 top < characterBlock2 top - ifTrue: - [initialRectangle := - (characterBlock1 topLeft - corner: visibleRectangle right @ characterBlock1 bottom) - intersect: visibleRectangle. - finalRectangle := - (visibleRectangle left @ characterBlock2 top - corner: characterBlock2 bottomLeft) - intersect: visibleRectangle. - characterBlock1 bottom = characterBlock2 top - ifFalse: - [interiorRectangle := - (visibleRectangle left @ characterBlock1 bottom - corner: visibleRectangle right @ characterBlock2 top) - intersect: visibleRectangle]] - ifFalse: - [initialRectangle := - (visibleRectangle left @ characterBlock1 top - corner: characterBlock1 bottomLeft) - intersect: visibleRectangle. - finalRectangle := - (characterBlock2 topLeft - corner: visibleRectangle right @ characterBlock2 bottom) - intersect: visibleRectangle. - characterBlock1 top = characterBlock2 bottom - ifFalse: - [interiorRectangle := - (visibleRectangle left @ characterBlock2 bottom - corner: visibleRectangle right @ characterBlock1 top) - intersect: visibleRectangle]]]. - self hiliteRect: initialRectangle. - self hiliteRect: interiorRectangle. - self hiliteRect: finalRectangle.! Item was removed: - ----- Method: Paragraph>>rightFlush (in category 'alignment') ----- - rightFlush - "Set the alignment for the style with which the receiver displays its text - so that the characters in each of text end on an even border in the - composition rectangle but the beginning of each line does not. This is - also known as ragged-left." - - textStyle alignment: RightFlush! Item was removed: - ----- Method: Paragraph>>rightMarginForComposition (in category 'private') ----- - rightMarginForComposition - "Build the right margin for a line. Depends upon compositionRectangle - width, marginTabsLevel, and right indent." - - ^compositionRectangle width - - (textStyle rightMarginTabAt: marginTabsLevel) - - textStyle rightIndent! Item was removed: - ----- Method: Paragraph>>rightMarginForDisplay (in category 'private') ----- - rightMarginForDisplay - "Build the right margin for a line. Depends upon compositionRectangle - rightSide, marginTabsLevel, and right indent." - - ^compositionRectangle right - - textStyle rightIndent - (textStyle rightMarginTabAt: marginTabsLevel)! Item was removed: - ----- Method: Paragraph>>rule (in category 'accessing') ----- - rule - "Answer the rule according to which character display behaves. For - example, rule may equal over, under, reverse." - - ^rule! Item was removed: - ----- Method: Paragraph>>rule: (in category 'accessing') ----- - rule: ruleInteger - "Set the rule according to which character display behaves." - - rule := ruleInteger! Item was removed: - ----- Method: Paragraph>>scrollBy: (in category 'scrolling') ----- - scrollBy: heightToMove - ^ self scrollBy: heightToMove withSelectionFrom: nil to: nil! Item was removed: - ----- Method: Paragraph>>scrollBy:withSelectionFrom:to: (in category 'scrolling') ----- - scrollBy: heightToMove withSelectionFrom: startBlock to: stopBlock - "Translate the composition rectangle up (dy<0) by heightToMove. - Repainting text as necessary, and selection if blocks not nil. - Return true unless scrolling limits have been reached." - | max min amount | - max := 0 max: "cant scroll up more than dist to (top of) bottom line" - compositionRectangle bottom - textStyle lineGrid - clippingRectangle top. - min := 0 min: "cant scroll down more than top is above clipRect" - compositionRectangle top - clippingRectangle top. - amount := ((heightToMove truncateTo: textStyle lineGrid) min: max) max: min. - amount ~= 0 - ifTrue: [destinationForm deferUpdatesIn: clippingRectangle while: [ - self scrollUncheckedBy: amount - withSelectionFrom: startBlock to: stopBlock]. - ^ true] - ifFalse: [^ false]! Item was removed: - ----- Method: Paragraph>>scrollDelta (in category 'scrolling') ----- - scrollDelta - "By comparing this before and after, you know if scrolling happened" - ^ clippingRectangle top - compositionRectangle top! Item was removed: - ----- Method: Paragraph>>scrollUncheckedBy:withSelectionFrom:to: (in category 'scrolling') ----- - scrollUncheckedBy: heightToMove withSelectionFrom: startBlock to: stopBlock - "Scroll by the given amount. Copy bits where possible, display the rest. - If selection blocks are not nil, then select the newly visible text as well." - | savedClippingRectangle delta | - delta := 0 @ (0 - heightToMove). - compositionRectangle := compositionRectangle translateBy: delta. - startBlock == nil ifFalse: - [startBlock moveBy: delta. - stopBlock moveBy: delta]. - savedClippingRectangle := clippingRectangle. - clippingRectangle := clippingRectangle intersect: Display boundingBox. - heightToMove abs >= clippingRectangle height - ifTrue: - ["Entire visible region must be repainted" - self displayLines: (1 to: lastLine) affectedRectangle: clippingRectangle] - ifFalse: - ["Copy bits where possible / display the rest" - destinationForm - copyBits: clippingRectangle from: destinationForm - at: clippingRectangle topLeft + delta - clippingBox: clippingRectangle - rule: Form over fillColor: nil. - "Set clippingRectangle to 'vacated' area for lines 'pulled' into view." - clippingRectangle := heightToMove < 0 - ifTrue: "On the top" - [clippingRectangle topLeft corner: clippingRectangle topRight + delta] - ifFalse: "At the bottom" - [clippingRectangle bottomLeft + delta corner: clippingRectangle bottomRight]. - self displayLines: (1 to: lastLine) "Refresh vacated region" - affectedRectangle: clippingRectangle]. - startBlock == nil ifFalse: - [self reverseFrom: startBlock to: stopBlock]. - "And restore the clippingRectangle to its original value. " - clippingRectangle := savedClippingRectangle! Item was removed: - ----- Method: Paragraph>>selectionRectsFrom:to: (in category 'selecting') ----- - selectionRectsFrom: characterBlock1 to: characterBlock2 - "Return an array of rectangles representing the area between the two character blocks given as arguments." - | visibleRectangle initialRectangle interiorRectangle finalRectangle lineNo baseline | - characterBlock1 = characterBlock2 ifTrue: - [lineNo := self lineIndexOfCharacterIndex: characterBlock1 stringIndex. - baseline := lineNo = 0 ifTrue: [textStyle baseline] - ifFalse: [(lines at: lineNo) baseline]. - ^ Array with: (characterBlock1 topLeft extent: 1 @ baseline)]. - visibleRectangle := clippingRectangle intersect: compositionRectangle. - characterBlock1 top = characterBlock2 top - ifTrue: [characterBlock1 left < characterBlock2 left - ifTrue: - [initialRectangle := - (characterBlock1 topLeft corner: characterBlock2 bottomLeft) - intersect: visibleRectangle] - ifFalse: - [initialRectangle := - (characterBlock2 topLeft corner: characterBlock1 bottomLeft) - intersect: visibleRectangle]] - ifFalse: [characterBlock1 top < characterBlock2 top - ifTrue: - [initialRectangle := - (characterBlock1 topLeft - corner: visibleRectangle right @ characterBlock1 bottom) - intersect: visibleRectangle. - characterBlock1 bottom = characterBlock2 top - ifTrue: - [finalRectangle := - (visibleRectangle left @ characterBlock2 top - corner: characterBlock2 bottomLeft) - intersect: visibleRectangle] - ifFalse: - [interiorRectangle := - (visibleRectangle left @ characterBlock1 bottom - corner: visibleRectangle right - @ characterBlock2 top) - intersect: visibleRectangle. - finalRectangle := - (visibleRectangle left @ characterBlock2 top - corner: characterBlock2 bottomLeft) - intersect: visibleRectangle]] - ifFalse: - [initialRectangle := - (visibleRectangle left @ characterBlock1 top - corner: characterBlock1 bottomLeft) - intersect: visibleRectangle. - characterBlock1 top = characterBlock2 bottom - ifTrue: - [finalRectangle := - (characterBlock2 topLeft - corner: visibleRectangle right - @ characterBlock2 bottom) - intersect: visibleRectangle] - ifFalse: - [interiorRectangle := - (visibleRectangle left @ characterBlock2 bottom - corner: visibleRectangle right @ characterBlock1 top) - intersect: visibleRectangle. - finalRectangle := - (characterBlock2 topLeft - corner: visibleRectangle right - @ characterBlock2 bottom) - intersect: visibleRectangle]]]. - ^ (Array with: initialRectangle with: interiorRectangle with: finalRectangle) - select: [:rect | rect notNil]! Item was removed: - ----- Method: Paragraph>>setWithText:style: (in category 'private') ----- - setWithText: aText style: aTextStyle - "Set text and adjust bounding rectangles to fit." - - | shrink compositionWidth unbounded | - unbounded := Rectangle origin: 0 @ 0 extent: 9999 at 9999. - compositionWidth := self - setWithText: aText style: aTextStyle compositionRectangle: unbounded clippingRectangle: unbounded. - compositionRectangle := compositionRectangle withWidth: compositionWidth. - clippingRectangle := compositionRectangle copy. - shrink := unbounded width - compositionWidth. - "Shrink padding widths accordingly" - 1 to: lastLine do: - [:i | (lines at: i) paddingWidth: (lines at: i) paddingWidth - shrink]! Item was removed: - ----- Method: Paragraph>>setWithText:style:compositionRectangle:clippingRectangle: (in category 'private') ----- - setWithText: aText style: aTextStyle compositionRectangle: compRect clippingRectangle: clipRect - "Set text and using supplied parameters. Answer max composition width." - - clippingRectangle := clipRect copy. - ^self - compositionRectangle: compRect - text: aText - style: aTextStyle - offset: 0 @ 0! Item was removed: - ----- Method: Paragraph>>setWithText:style:compositionRectangle:clippingRectangle:foreColor:backColor: (in category 'private') ----- - setWithText: aText style: aTextStyle compositionRectangle: compRect clippingRectangle: clipRect foreColor: cf backColor: cb - "Set text and using supplied parameters. Answer max composition width." - - clippingRectangle := clipRect copy. - self foregroundColor: cf backgroundColor: cb. - ^ self - compositionRectangle: compRect - text: aText - style: aTextStyle - offset: 0 @ 0! Item was removed: - ----- Method: Paragraph>>string (in category 'accessing') ----- - string - ^text string! Item was removed: - ----- Method: Paragraph>>stringAtLineNumber: (in category 'accessing') ----- - stringAtLineNumber: aNumber - (aNumber > lastLine or: [aNumber < 1]) ifTrue: [^ nil]. - ^ (text string copyFrom: (lines at: aNumber) first to: (lines at: aNumber) last) copyWithoutAll: CharacterSet crlf! Item was removed: - ----- Method: Paragraph>>text: (in category 'accessing') ----- - text: aText - "Set the argument, aText, to be the text for the receiver." - - text := aText. - self composeAll! Item was removed: - ----- Method: Paragraph>>toggleAlignment (in category 'alignment') ----- - toggleAlignment - "Set the alignment for the style with which the receiver displays its text - so that it moves from centered to justified to leftFlush to rightFlush and - back to centered again." - - textStyle alignment: textStyle alignment + 1! Item was removed: - ----- Method: Paragraph>>topAtLineIndex: (in category 'private') ----- - topAtLineIndex: lineIndex - "Answer the top y of given line." - | y | - y := compositionRectangle top. - lastLine = 0 ifTrue: [lineIndex > 0 ifTrue: [^ y + textStyle lineGrid]. ^ y]. - 1 to: (lineIndex-1 min: lastLine) do: - [:i | y := y + (lines at: i) lineHeight]. - ^ y - ! Item was removed: - ----- Method: Paragraph>>topAtLineIndex:using:and: (in category 'private') ----- - topAtLineIndex: lineIndex using: otherLines and: otherLastLine - "Answer the top y of given line." - | y | - y := compositionRectangle top. - otherLastLine = 0 ifTrue: [^ y]. - 1 to: (lineIndex-1 min: otherLastLine) do: - [:i | y := y + (otherLines at: i) lineHeight]. - ^ y - ! Item was removed: - ----- Method: Paragraph>>trimLinesTo: (in category 'private') ----- - trimLinesTo: lastLineInteger - - (lastLineInteger + 1 to: lastLine) do: [:i | lines at: i put: nil]. - (lastLine := lastLineInteger) < (lines size // 2) - ifTrue: [lines := lines copyFrom: 1 to: lines size - (lines size // 2)]! Item was removed: - ----- Method: Paragraph>>updateCompositionHeight (in category 'private') ----- - updateCompositionHeight - "Mainly used to insure that intersections with compositionRectangle work." - - compositionRectangle := compositionRectangle withHeight: - (self bottomAtLineIndex: lastLine) - compositionRectangle top. - (text size ~= 0 and: [(text at: text size) = CR or: [(text at: text size) = Character lf]]) - ifTrue: [compositionRectangle := compositionRectangle withHeight: - compositionRectangle height + (lines at: lastLine) lineHeight]! Item was removed: - ----- Method: Paragraph>>visibleRectangle (in category 'utilities') ----- - visibleRectangle - "May be less than the clippingRectangle if text ends part way down. - Also some fearful history includes Display intersection; - it shouldn't be necessary" - - ^ (clippingRectangle intersect: compositionRectangle) - intersect: destinationForm boundingBox! Item was removed: - ----- Method: Paragraph>>withClippingRectangle:do: (in category 'private') ----- - withClippingRectangle: clipRect do: aBlock - | saveClip | - saveClip := clippingRectangle. - clippingRectangle := clipRect. - aBlock value. - clippingRectangle := saveClip! Item was removed: - ----- Method: Paragraph>>wrappingBox:clippingBox: (in category 'composition') ----- - wrappingBox: compositionRect clippingBox: clippingRect - "Set the composition rectangle for the receiver so that the lines wrap - within the rectangle, compositionRect, and the display of the text is - clipped by the rectangle, clippingRect." - - self compositionRectangle: compositionRect copy - text: text - style: textStyle - offset: offset. - clippingRectangle := clippingRect copy! Item was removed: - ScrollController subclass: #ParagraphEditor - instanceVariableNames: 'paragraph startBlock stopBlock beginTypeInBlock emphasisHere initialText selectionShowing otherInterval lastParentLocation wasComposition' - classVariableNames: 'ChangeText CmdActions FindText Keyboard ShiftCmdActions UndoInterval UndoMessage UndoParagraph UndoSelection Undone' - poolDictionaries: 'TextConstants' - category: 'ST80-Controllers'! - - !ParagraphEditor commentStamp: '<historical>' prior: 0! - I am a Controller for editing a Paragraph. I am a kind of ScrollController, so that more text can be created for the Paragraph than can be viewed on the screen. Editing messages are sent by issuing commands from a yellow button menu or from keys on the keyboard. My instances keep control as long as the cursor is within the view when the red or yellow mouse button is pressed; they give up control if the blue button is pressed.! Item was removed: - ----- Method: ParagraphEditor class>>abandonChangeText (in category 'class initialization') ----- - abandonChangeText - "Call this to get out of the maddening situation in which the system keeps aggressively trying to do a replacement that you no longer wish to make, every time you make choose a new method in a list." - ChangeText := FindText - - "ParagraphEditor abandonChangeText" - ! Item was removed: - ----- Method: ParagraphEditor class>>initialize (in category 'class initialization') ----- - initialize - "Initialize the keyboard shortcut maps and the shared buffers - for copying text across views and managing again and undo. - Marked this method changed to trigger reinit" - "ParagraphEditor initialize" - UndoSelection := FindText := ChangeText := Text new. - UndoMessage := Message selector: #halt. - self initializeCmdKeyShortcuts. - self initializeShiftCmdKeyShortcuts.! Item was removed: - ----- Method: ParagraphEditor class>>initializeCmdKeyShortcuts (in category 'keyboard shortcut tables') ----- - initializeCmdKeyShortcuts - "Initialize the (unshifted) command-key (or alt-key) shortcut table." - - "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" - - "ParagraphEditor initialize" - - | cmdMap | - - cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash" - - cmdMap at: 1 + 1 put: #cursorHome:. "home key" - cmdMap at: 4 + 1 put: #cursorEnd:. "end key" - cmdMap at: 8 + 1 put: #backspace:. "ctrl-H or delete key" - cmdMap at: 11 + 1 put: #cursorPageUp:. "page up key" - cmdMap at: 12 + 1 put: #cursorPageDown:. "page down key" - cmdMap at: 13 + 1 put: #crWithIndent:. "cmd-Return" - cmdMap at: 27 + 1 put: #offerMenuFromEsc:. "escape key" - cmdMap at: 28 + 1 put: #cursorLeft:. "left arrow key" - cmdMap at: 29 + 1 put: #cursorRight:. "right arrow key" - cmdMap at: 30 + 1 put: #cursorUp:. "up arrow key" - cmdMap at: 31 + 1 put: #cursorDown:. "down arrow key" - cmdMap at: 32 + 1 put: #selectWord:. "space bar key" - cmdMap at: 127 + 1 put: #forwardDelete:. "del key" - - '0123456789' - do: [:char | cmdMap at: char asciiValue + 1 put: #changeEmphasis:]. - - "triplet = {character. comment selector. novice appropiated}" - #( - ($a #selectAll: true) - ($b #browseIt: false) - ($c #copySelection: true) - ($d #doIt: false) - ($e #exchange: true) - ($f #find: true) - ($g #findAgain: true) - ($h #setSearchString: true) - ($i #inspectIt: false) - ($j #doAgainOnce: true) - ($k #offerFontMenu: true) - ($l #cancel: true) - ($m #implementorsOfIt: false) - ($n #sendersOfIt: false) - ($o #spawnIt: false) - ($p #printIt: false) - ($q #querySymbol: false) - ($s #save: true) - ($t #tempCommand: false) - ($u #align: true) - ($v #paste: true) - ($w #backWord: true) - ($x #cut: true) - ($y #swapChars: true) - ($z #undo: true) - ) - select:[:triplet | Preferences noviceMode not or:[triplet third]] - thenDo:[:triplet | cmdMap at: triplet first asciiValue + 1 put: triplet second]. - - CmdActions := cmdMap. - ! Item was removed: - ----- Method: ParagraphEditor class>>initializeShiftCmdKeyShortcuts (in category 'keyboard shortcut tables') ----- - initializeShiftCmdKeyShortcuts - "Initialize the shift-command-key (or control-key) shortcut table." - "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" - "wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the - capitalized versions of the letters. - TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values." - - | cmdMap | - - "shift-command and control shortcuts" - cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash" - - cmdMap at: ( 1 + 1) put: #cursorHome:. "home key" - cmdMap at: ( 4 + 1) put: #cursorEnd:. "end key" - cmdMap at: ( 8 + 1) put: #forwardDelete:. "ctrl-H or delete key" - cmdMap at: (11 + 1) put: #cursorPageUp:. "page up key" - cmdMap at: (12 + 1) put: #cursorPageDown:. "page down key" - cmdMap at: (13 + 1) put: #crWithIndent:. "ctrl-Return" - cmdMap at: (27 + 1) put: #offerMenuFromEsc:. "escape key" - cmdMap at: (28 + 1) put: #cursorLeft:. "left arrow key" - cmdMap at: (29 + 1) put: #cursorRight:. "right arrow key" - cmdMap at: (30 + 1) put: #cursorUp:. "up arrow key" - cmdMap at: (31 + 1) put: #cursorDown:. "down arrow key" - cmdMap at: (32 + 1) put: #selectWord:. "space bar key" - cmdMap at: (45 + 1) put: #changeEmphasis:. "cmd-sh-minus" - cmdMap at: (61 + 1) put: #changeEmphasis:. "cmd-sh-plus" - cmdMap at: (127 + 1) put: #forwardDelete:. "del key" - - "triplet = {character. comment selector. novice appropiated}" - #( - ($a argAdvance: false) - ($b browseItHere: false) - ($c compareToClipboard: false) - ($e methodStringsContainingIt: false) - ($f displayIfFalse: false) - ($g fileItIn: false) - ($h cursorTopHome: true) - ($i exploreIt: false) - ($j doAgainMany: true) - ($k changeStyle: true) - ($m selectCurrentTypeIn: true) - ($n referencesToIt: false) - ($p makeProjectLink: true) - ($s search: true) - ($t displayIfTrue: false) - ($u changeLfToCr: false) - ($v pasteInitials: false) - ($w methodNamesContainingIt: false) - ($x makeLowercase: true) - ($y makeUppercase: true) - ($z makeCapitalized: true) - ) - select:[:triplet | Preferences noviceMode not or:[triplet third]] - thenDo:[:triplet | - cmdMap at: (triplet first asciiValue + 1) put: triplet second. "plain keys" - cmdMap at: (triplet first asciiValue - 32 + 1) put: triplet second. "shifted keys" - cmdMap at: (triplet first asciiValue - 96 + 1) put: triplet second. "ctrl keys" - ]. - - ShiftCmdActions := cmdMap! Item was removed: - ----- Method: ParagraphEditor class>>multiRedoOverride (in category 'keyboard shortcut tables') ----- - multiRedoOverride - "Call this to set meta-r to perform the multilevel redo (or tweak the code below to have it bound to some other key sequence)." - - " - ParagraphEditor multiRedoOverride. - " - CmdActions at: $r asciiValue + 1 put: #multiRedo: - ! Item was removed: - ----- Method: ParagraphEditor class>>new (in category 'instance creation') ----- - new - "Answer a new instance of me with a null Paragraph to be edited." - - | aParagraphEditor | - aParagraphEditor := super new. - aParagraphEditor changeParagraph: '' asParagraph. - ^aParagraphEditor! Item was removed: - ----- Method: ParagraphEditor class>>newParagraph: (in category 'instance creation') ----- - newParagraph: aParagraph - "Answer an instance of me with aParagraph as the text to be edited." - - | aParagraphEditor | - aParagraphEditor := super new. - aParagraphEditor initialize. - aParagraphEditor changeParagraph: aParagraph. - ^aParagraphEditor! Item was removed: - ----- Method: ParagraphEditor class>>shiftedYellowButtonMenu (in category 'class initialization') ----- - shiftedYellowButtonMenu - "Answer the menu to be presented when the yellow button is pressed while the shift key is down" - - ^ SelectionMenu fromArray: StringHolder shiftedYellowButtonMenuItems - ! Item was removed: - ----- Method: ParagraphEditor class>>specialShiftCmdKeys (in category 'keyboard shortcut tables') ----- - specialShiftCmdKeys - - "Private - return array of key codes that represent single keys acting - as if shift-command were also being pressed" - - ^#( - 1 "home" - 3 "enter" - 4 "end" - 8 "backspace" - 11 "page up" - 12 "page down" - 27 "escape" - 28 "left arrow" - 29 "right arrow" - 30 "up arrow" - 31 "down arrow" - 127 "delete" - )! Item was removed: - ----- Method: ParagraphEditor class>>yellowButtonExpertMenu (in category 'class initialization') ----- - yellowButtonExpertMenu - - ^ SelectionMenu fromArray: StringHolder yellowButtonMenuItems. - ! Item was removed: - ----- Method: ParagraphEditor class>>yellowButtonMenu (in category 'class initialization') ----- - yellowButtonMenu - - ^ Preferences noviceMode - ifTrue: [self yellowButtonNoviceMenu] - ifFalse: [self yellowButtonExpertMenu] - ! Item was removed: - ----- Method: ParagraphEditor class>>yellowButtonNoviceMenu (in category 'class initialization') ----- - yellowButtonNoviceMenu - - ^ MenuMorph fromArray: { - {'set font... (k)' translated. #offerFontMenu}. - {'set style... (K)' translated. #changeStyle}. - {'set alignment... (u)' translated. #chooseAlignment}. - #-. - {'make project link (P)' translated. #makeProjectLink}. - #-. - {'find...(f)' translated. #find}. - {'find again (g)' translated. #findAgain}. - {'set search string (h)' translated. #setSearchString}. - #-. - {'do again (j)' translated. #again}. - {'undo (z)' translated. #undo}. - #-. - {'copy (c)' translated. #copySelection}. - {'cut (x)' translated. #cut}. - {'paste (v)' translated. #paste}. - {'paste...' translated. #pasteRecent}. - #-. - {'accept (s)' translated. #accept}. - {'cancel (l)' translated. #cancel}. - }. - ! Item was removed: - ----- Method: ParagraphEditor>>abandonChangeText (in category 'editing keys') ----- - abandonChangeText - ^self class abandonChangeText! Item was removed: - ----- Method: ParagraphEditor>>accept (in category 'menu messages') ----- - accept - "Save the current text of the text being edited as the current acceptable version for purposes of canceling." - - initialText := paragraph text copy. - ! Item was removed: - ----- Method: ParagraphEditor>>activateTextActions (in category 'as yet unclassified') ----- - activateTextActions - (paragraph text attributesAt: startBlock stringIndex) - do: [:att | att actOnClickFor: model in: paragraph]! Item was removed: - ----- Method: ParagraphEditor>>adjustSelection: (in category 'new selection') ----- - adjustSelection: directionBlock - "Helper function for Cursor movement. Always moves point thus allowing selections to shrink. " - "See also expandSelection:" - "Accepts a one argument Block that computes the new postion given an old one." - | newPosition | - newPosition := directionBlock value: self pointIndex. - self selectMark: self markIndex point: newPosition. - ^true.! Item was removed: - ----- Method: ParagraphEditor>>afterSelectionInsertAndSelect: (in category 'new selection') ----- - afterSelectionInsertAndSelect: aString - - self insertAndSelect: aString at: self stopIndex ! Item was removed: - ----- Method: ParagraphEditor>>again (in category 'menu messages') ----- - again - "Text substitution. If the left shift key is down, the substitution is made - throughout the entire Paragraph. Otherwise, only the next possible - substitution is made. - Undoer & Redoer: #undoAgain:andReselect:typedKey:." - - "If last command was also 'again', use same keys as before" - self againOrSame: (UndoMessage sends: #undoAgain:andReselect:typedKey:)! Item was removed: - ----- Method: ParagraphEditor>>againOnce: (in category 'private') ----- - againOnce: indices - "Find the next occurrence of FindText. If none, answer false. - Append the start index of the occurrence to the stream indices, and, if - ChangeText is not the same object as FindText, replace the occurrence by it. - Note that the search is case-sensitive for replacements, otherwise not." - - | where | - where := paragraph text findString: FindText startingAt: self stopIndex - caseSensitive: ((ChangeText ~~ FindText) or: [Preferences caseSensitiveFinds]). - where = 0 ifTrue: [^ false]. - self deselect; selectInvisiblyFrom: where to: where + FindText size - 1. - ChangeText ~~ FindText ifTrue: [self zapSelectionWith: ChangeText]. - indices nextPut: where. - self selectAndScroll. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>againOrSame: (in category 'private') ----- - againOrSame: useOldKeys - "Subroutine of search: and again. If useOldKeys, use same FindText and ChangeText as before. - 1/26/96 sw: real worked moved to againOrSame:many:" - - ^ self againOrSame: useOldKeys many: sensor leftShiftDown! Item was removed: - ----- Method: ParagraphEditor>>againOrSame:many: (in category 'private') ----- - againOrSame: useOldKeys many: many - "Subroutine of search: and again. If useOldKeys, use same FindText and ChangeText as before. If many is true, do it repeatedly. Created 1/26/96 sw by adding the many argument to #againOrSame." - - | home indices wasTypedKey | - - home := self selectionInterval. "what was selected when 'again' was invoked" - - "If new keys are to be picked..." - useOldKeys ifFalse: "Choose as FindText..." - [FindText := UndoSelection. "... the last thing replaced." - "If the last command was in another paragraph, ChangeText is set..." - paragraph == UndoParagraph ifTrue: "... else set it now as follows." - [UndoInterval ~= home ifTrue: [self selectInterval: UndoInterval]. "blink" - ChangeText := ((UndoMessage sends: #undoCutCopy:) and: [self hasSelection]) - ifTrue: [FindText] "== objects signal no model-locking by 'undo copy'" - ifFalse: [self selection]]]. "otherwise, change text is last-replaced text" - - (wasTypedKey := FindText size = 0) - ifTrue: "just inserted at a caret" - [home := self selectionInterval. - self replaceSelectionWith: self nullText. "delete search key..." - FindText := ChangeText] "... and search for it, without replacing" - ifFalse: "Show where the search will start" - [home last = self selectionInterval last ifFalse: - [self selectInterval: home]]. - - "Find and Change, recording start indices in the array" - indices := WriteStream on: (Array new: 20). "an array to store change locs" - [(self againOnce: indices) & many] whileTrue. "<-- this does the work" - indices isEmpty ifTrue: "none found" - [self flash. - wasTypedKey ifFalse: [^self]]. - - (many | wasTypedKey) ifFalse: "after undo, select this replacement" - [home := self startIndex to: - self startIndex + UndoSelection size - 1]. - - self undoer: #undoAgain:andReselect:typedKey: with: indices contents with: home with: wasTypedKey! Item was removed: - ----- Method: ParagraphEditor>>align (in category 'menu messages') ----- - align - "Align text according to the next greater alignment value--cycling among - left flush, right flush, center, justified. No effect on the undoability of the pre - preceding command." - - paragraph toggleAlignment. - paragraph displayOn: Display. - self recomputeInterval! Item was removed: - ----- Method: ParagraphEditor>>align: (in category 'editing keys') ----- - align: characterStream - "Triggered by Cmd-u; cycle through alignment alternatives. 8/11/96 sw" - - sensor keyboard. "flush character" - self align. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>argAdvance: (in category 'typing/selecting keys') ----- - argAdvance: characterStream - "Invoked by Ctrl-a. Useful after Ctrl-q or pasting a selector. - Search forward from the end of the selection for a colon and place - the caret after it. If no colon is found, do nothing.." - | start | - "flush character" - sensor keyboard. - self closeTypeIn: characterStream. - start := paragraph text findString: ':' startingAt: self stopIndex. - start = 0 - ifFalse: [self selectAt: start + 1]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>backTo: (in category 'typing support') ----- - backTo: startIndex - "During typing, backspace to startIndex. Deleted characters fall into three - clusters, from left to right in the text: (1) preexisting characters that were - backed over; (2) newly typed characters that were backed over (excluding - typeahead, which never even appears); (3) preexisting characters that - were highlighted before typing began. If typing has not yet been opened, - open it and watch for the first and third cluster. If typing has been opened, - watch for the first and second cluster. Save characters from the first and third - cluster in UndoSelection. Tally characters from the first cluster in UndoMessage's parameter. - Delete all the clusters. Do not alter Undoer or UndoInterval (except via - openTypeIn). The code is shorter than the comment." - - | saveLimit newBackovers | - saveLimit := beginTypeInBlock == nil - ifTrue: [self openTypeIn. UndoSelection := self nullText. self stopIndex] - ifFalse: [self startOfTyping]. - self setMark: startIndex. - startIndex < saveLimit ifTrue: - [newBackovers := self startOfTyping - startIndex. - beginTypeInBlock := self startIndex. - UndoSelection replaceFrom: 1 to: 0 with: - (paragraph text copyFrom: startIndex to: saveLimit - 1). - UndoMessage argument: (UndoMessage argument ifNil: [1]) + newBackovers]. - self zapSelectionWith: self nullText. - self unselect! Item was removed: - ----- Method: ParagraphEditor>>backWord: (in category 'typing/selecting keys') ----- - backWord: characterStream - "If the selection is not a caret, delete it and leave it in the backspace buffer. - Else if there is typeahead, delete it. - Else, delete the word before the caret." - - | startIndex | - sensor keyboard. - characterStream isEmpty - ifTrue: - [self hasCaret - ifTrue: "a caret, delete at least one character" - [startIndex := 1 max: self markIndex - 1. - [startIndex > 1 and: - [(paragraph text at: startIndex - 1) asCharacter tokenish]] - whileTrue: - [startIndex := startIndex - 1]] - ifFalse: "a non-caret, just delete it" - [startIndex := self markIndex]. - self backTo: startIndex] - ifFalse: - [characterStream reset]. - ^false! Item was removed: - ----- Method: ParagraphEditor>>backspace: (in category 'typing/selecting keys') ----- - backspace: characterStream - "Backspace over the last character." - - | startIndex | - sensor leftShiftDown ifTrue: [^ self backWord: characterStream]. - - startIndex := self markIndex + (self hasCaret ifTrue: [0] ifFalse: [1]). - [sensor keyboardPressed and: - [sensor peekKeyboard asciiValue = 8]] whileTrue: [ - "process multiple backspaces" - sensor keyboard. - startIndex := 1 max: startIndex - 1. - ]. - self backTo: startIndex. - - ^false! Item was removed: - ----- Method: ParagraphEditor>>blinkParen (in category 'parenblinking') ----- - blinkParen - "Highlight the last parenthesis in the text" - lastParentLocation ifNotNil: - [self text string size >= lastParentLocation ifTrue: [ - self text - addAttribute: TextEmphasis bold - from: lastParentLocation - to: lastParentLocation]] - ! Item was removed: - ----- Method: ParagraphEditor>>blinkParenAt: (in category 'parenblinking') ----- - blinkParenAt: parenLocation - self text - addAttribute: TextEmphasis bold - from: parenLocation - to: parenLocation. - lastParentLocation := parenLocation.! Item was removed: - ----- Method: ParagraphEditor>>blinkPrevParen (in category 'parenblinking') ----- - blinkPrevParen - - self deprecated: 'Use #blinkPrevParen:'. - self blinkPrevParen: sensor peekKeyboard! Item was removed: - ----- Method: ParagraphEditor>>blinkPrevParen: (in category 'parenblinking') ----- - blinkPrevParen: aCharacter - | openDelimiter closeDelimiter level string here hereChar | - string := paragraph text string. - here := startBlock stringIndex. - openDelimiter := aCharacter. - closeDelimiter := '([{' at: (')]}' indexOf: openDelimiter). - level := 1. - [level > 0 and: [here > 1]] - whileTrue: - [hereChar := string at: (here := here - 1). - hereChar = closeDelimiter - ifTrue: - [level := level - 1. - level = 0 - ifTrue: [^ self blinkParenAt: here]] - ifFalse: - [hereChar = openDelimiter - ifTrue: [level := level + 1]]].! Item was removed: - ----- Method: ParagraphEditor>>browseClassFromIt (in category 'menu messages') ----- - browseClassFromIt - "Launch a browser for the class indicated by the current selection. - If multiple classes matching the selection exist, let the user choose among them." - | aClass | - - self lineSelectAndEmptyCheck: [^ self]. - aClass := UIManager default - classFromPattern: self selection string - withCaption: 'choose a class to browse...'. - aClass ifNil: [^ view flash]. - self terminateAndInitializeAround: - [self systemNavigation browseClass: aClass].! Item was removed: - ----- Method: ParagraphEditor>>browseIt (in category 'menu messages') ----- - browseIt - "Launch a browser for the current selection, if appropriate." - - Preferences alternativeBrowseIt ifTrue: [^ self browseClassFromIt]. - - self lineSelectAndEmptyCheck: [^ view flash]. - - self terminateAndInitializeAround: [ - - self flag: #todo. "mt: Active controller process will terminate if any new tool is opened. Find a way to open two tools in this method." - - "First, try to show all accesses to instance or class variables." - self selectedInstanceVariable ifNotNil: - [:nameToClass | self systemNavigation - browseAllAccessesTo: nameToClass key - from: nameToClass value]. - self selectedClassVariable ifNotNil: - [:binding | self systemNavigation browseAllCallsOn: binding]. - - "Then, either browse the class (from a binding) or all implementors of a selector." - self selectedBinding ifNotNil: - [:binding | self systemNavigation browseClass: binding]. - self selectedSelector ifNotNil: - [:selector | self systemNavigation browseAllImplementorsOf: selector]. - - ]! Item was removed: - ----- Method: ParagraphEditor>>browseIt: (in category 'editing keys') ----- - browseIt: characterStream - "Triggered by Cmd-B; browse the thing represented by the current selection, if plausible. 1/18/96 sw" - - sensor keyboard. "flush character" - self browseIt. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>browseItHere: (in category 'editing keys') ----- - browseItHere: characterStream - "Triggered by Cmd-shift-B; browse the thing represented by the current selection, if plausible, in the receiver's own window. 3/1/96 sw" - - sensor keyboard. "flush character" - self browseItHere. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>cancel (in category 'menu messages') ----- - cancel - "Restore the text of the paragraph to be the text saved since initialization - or the last accept. Undoer & Redoer: undoAndReselect:redoAndReselect:. - This used to call controlTerminate and controlInitialize but this seemed illogical. - Sure enough, nobody overrode them who had cancel in the menu, and if - anybody really cared they could override cancel." - - UndoSelection := paragraph text. - self undoer: #undoAndReselect:redoAndReselect: with: self selectionInterval with: (1 to: 0). - view ifNotNil: [view clearInside]. - self changeParagraph: (paragraph text: initialText). - UndoParagraph := paragraph. - otherInterval := UndoInterval := 1 to: initialText size. "so undo will replace all" - paragraph displayOn: Display. - self selectAt: 1. - self scrollToTop - ! Item was removed: - ----- Method: ParagraphEditor>>cancel: (in category 'editing keys') ----- - cancel: characterStream - "Cancel unsubmitted changes. Flushes typeahead. 1/12/96 sw - 1/22/96 sw: put in control terminate/init" - - sensor keyboard. - self terminateAndInitializeAround: [self cancel]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>changeAlignment (in category 'menu messages') ----- - changeAlignment - | aList reply | - aList := #(leftFlush centered justified rightFlush). - reply := (SelectionMenu labelList: (aList collect: [:t | t translated]) selections: aList) startUp. - reply ifNil:[^self]. - self setAlignment: reply. - paragraph composeAll. - self recomputeSelection. - self mvcRedisplay. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>changeEmphasis (in category 'menu messages') ----- - changeEmphasis - | aList reply | - aList := #(normal bold italic narrow underlined struckOut). - reply := (SelectionMenu labelList: (aList collect: [:t | t translated]) selections: aList) startUp. - reply ~~ nil ifTrue: - [self setEmphasis: reply. - paragraph composeAll. - self recomputeSelection. - self mvcRedisplay]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>changeEmphasis: (in category 'editing keys') ----- - changeEmphasis: characterStream - "Change the emphasis of the current selection or prepare to - accept characters with the change in emphasis. Emphasis - change amounts to a font change. Keeps typeahead." - - | keyCode attribute oldAttributes index thisSel colors extras | - - "control 0..9 -> 0..9" - keyCode := ('0123456789' indexOf: sensor keyboard ifAbsent: [1]) - 1. - - oldAttributes := paragraph text attributesAt: self pointIndex forStyle: paragraph textStyle. - thisSel := self selection. - - "Decipher keyCodes for Command 0-9..." - "(keyCode between: 1 and: 5) ifTrue: [ - attribute := TextFontChange fontNumber: keyCode - ]." - - keyCode = 5 ifTrue: [ - | labels lines | - colors := #(#black #magenta #red #yellow #green #blue #cyan #white ). - extras := #('Link to comment of class' 'Link to definition of class' 'Link to hierarchy of class' 'Link to method' ). - - Preferences noviceMode ifTrue: [ - labels := colors , #('choose color...' ). - lines := #() - ] - ifFalse: [ - labels := colors , #('choose color...' 'Do it' 'Print it' ) , extras , #('be a web URL link' 'Edit hidden info' 'Copy hidden info' ). - lines := Array with: colors size + 1 - ]. - - "index := (PopUpMenu labelArray: labels lines: lines) startUp. " - index := UIManager default chooseFrom: labels lines: lines. - index = 0 - ifTrue: [ ^ true]. - - index <= colors size ifTrue: [ - attribute := TextColor color: (Color perform: (colors at: index)) - ] - ifFalse: [ - index := index - colors size - 1. "Re-number!!!!!!" - - index = 0 ifTrue: [ - attribute := self chooseColor - ]. - - index = 1 ifTrue: [ - attribute := TextDoIt new. - thisSel := attribute analyze: self selection asString - ]. - - index = 2 ifTrue: [ - attribute := TextPrintIt new. - thisSel := attribute analyze: self selection asString - ]. - - extras size = 0 & (index > 2) ifTrue: [ - index := index + 4 "skip those" - ]. - - index = 3 ifTrue: [ - attribute := TextLink new. - thisSel := attribute analyze: self selection asString with: 'Comment' - ]. - - index = 4 ifTrue: [ - attribute := TextLink new. - thisSel := attribute analyze: self selection asString with: 'Definition' - ]. - - index = 5 ifTrue: [ - attribute := TextLink new. - thisSel := attribute analyze: self selection asString with: 'Hierarchy' - ]. - - index = 6 ifTrue: [ - attribute := TextLink new. - thisSel := attribute analyze: self selection asString - ]. - - index = 7 ifTrue: [ - attribute := TextURL new. - thisSel := attribute analyze: self selection asString - ]. - - index = 8 ifTrue: [ - "Edit hidden info" - thisSel := self hiddenInfo. "includes selection" - attribute := TextEmphasis normal - ]. - - index = 9 ifTrue: [ - "Copy hidden info" - self copyHiddenInfo. - ^ true - ]. - - "no other action" - thisSel - ifNil: [ ^ true ] - ] - ]. - - (keyCode between: 6 and: 9) ifTrue: [ - sensor leftShiftDown ifTrue: [ - keyCode = 6 ifTrue: [ - attribute := TextKern kern: -1 - ]. - keyCode = 7 ifTrue: [ - attribute := TextKern kern: 1 - ] - ] - ifFalse: [ - "And remember this: nine is fine for underline, obliter-eight it as you see fit, seven has been bold for ever'n, which leaves six as the obivous fix to emphasize your poetics." - attribute := TextEmphasis perform: (#(italic bold struckOut underlined) at: keyCode - 5). - oldAttributes - do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]] - ] - ]. - - keyCode = 0 - ifTrue: [attribute := TextEmphasis normal]. - - attribute ifNil: [^ true]. - - beginTypeInBlock ~~ nil ifTrue: [ - "only change emphasisHere while typing" - self insertTypeAhead: characterStream. - emphasisHere := Text addAttribute: attribute toArray: oldAttributes. - ^ true - ]. - - self - replaceSelectionWith: (thisSel asText addAttribute: attribute). - - ^ true - ! Item was removed: - ----- Method: ParagraphEditor>>changeEmphasisOrAlignment (in category 'menu messages') ----- - changeEmphasisOrAlignment - | aList reply | - aList := #(normal bold italic narrow underlined struckOut leftFlush centered rightFlush justified). - reply := (SelectionMenu labelList: aList lines: #(6) selections: aList) startUp. - reply ~~ nil ifTrue: - [(#(leftFlush centered rightFlush justified) includes: reply) - ifTrue: - [paragraph perform: reply. - self recomputeInterval] - ifFalse: - [self setEmphasis: reply. - paragraph composeAll. - self recomputeSelection. - self mvcRedisplay]]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>changeLfToCr: (in category 'editing keys') ----- - changeLfToCr: characterStream - "Replace all LFs by CRs, and CR-LF pairs by single CRs. - Triggered by Cmd-U -- useful when getting code from FTP sites" - - sensor keyboard. "flush the triggering cmd-key character" - self replaceSelectionWith: (Text fromString: - (self selection string withSqueakLineEndings)). - ^ true! Item was removed: - ----- Method: ParagraphEditor>>changeParagraph: (in category 'initialize-release') ----- - changeParagraph: aParagraph - "Install aParagraph as the one to be edited by the receiver." - - UndoParagraph == paragraph ifTrue: [UndoParagraph := nil]. - paragraph := aParagraph. - self resetState! Item was removed: - ----- Method: ParagraphEditor>>changeStyle (in category 'menu messages') ----- - changeStyle - "Let user change styles for the current text pane - Moved from experimentalCommand to its own method " - - | aList reply style | - aList := StrikeFont actualFamilyNames. - aList addFirst: 'DefaultTextStyle'. - reply := (SelectionMenu labelList: aList lines: #(1) selections: aList) startUp. - reply ifNotNil: - [(style := TextStyle named: reply) ifNil: [Beeper beep. ^ true]. - paragraph textStyle: style copy. - paragraph composeAll. - self recomputeSelection. - self mvcRedisplay]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>changeStyle: (in category 'typing/selecting keys') ----- - changeStyle: characterStream - "Put up the style-change menu" - - sensor keyboard. "flush character" - self closeTypeIn: characterStream. - self changeStyle. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>changeStyleTo: (in category 'menu messages') ----- - changeStyleTo: aNewStyle - - paragraph textStyle: aNewStyle. - paragraph composeAll. - self recomputeSelection. - ! Item was removed: - ----- Method: ParagraphEditor>>charBefore (in category 'accessing-selection') ----- - charBefore - - | start | - (start := self startIndex) > 1 ifTrue: [^ paragraph text at: start - 1]. - ^ nil. - ! Item was removed: - ----- Method: ParagraphEditor>>chooseAlignment (in category 'menu messages') ----- - chooseAlignment - self changeAlignment! Item was removed: - ----- Method: ParagraphEditor>>chooseColor (in category 'editing keys') ----- - chooseColor - "Make a new Text Color Attribute, let the user pick a color, and return the attribute. This is the non-Morphic version." - - ^ TextColor color: (Color fromUser)! Item was removed: - ----- Method: ParagraphEditor>>classCommentsContainingIt (in category 'menu messages') ----- - classCommentsContainingIt - "Open a browser class comments which contain the current selection somewhere in them." - - self lineSelectAndEmptyCheck: [^ self]. - self terminateAndInitializeAround: [ - self systemNavigation browseClassCommentsWithString: self selection string]! Item was removed: - ----- Method: ParagraphEditor>>classNamesContainingIt (in category 'menu messages') ----- - classNamesContainingIt - "Open a browser on classes whose names contain the selected string" - - self lineSelectAndEmptyCheck: [^self]. - self systemNavigation - browseClassesWithNamesContaining: self selection string - caseSensitive: Sensor leftShiftDown! Item was removed: - ----- Method: ParagraphEditor>>clearParens (in category 'parenblinking') ----- - clearParens - lastParentLocation ifNotNil: - [self text string size >= lastParentLocation ifTrue: [ - self text - removeAttribute: TextEmphasis bold - from: lastParentLocation - to: lastParentLocation]]. - lastParentLocation := nil.! Item was removed: - ----- Method: ParagraphEditor>>clipboardText (in category 'menu messages') ----- - clipboardText - - ^ Clipboard clipboardText! Item was removed: - ----- Method: ParagraphEditor>>clipboardText: (in category 'menu messages') ----- - clipboardText: text - - ^ Clipboard clipboardText: text! Item was removed: - ----- Method: ParagraphEditor>>clipboardTextPut: (in category 'menu messages') ----- - clipboardTextPut: text - - ^ Clipboard clipboardText: text! Item was removed: - ----- Method: ParagraphEditor>>closeTypeIn (in category 'typing support') ----- - closeTypeIn - "See comment in openTypeIn. It is important to call closeTypeIn before executing - any non-typing key, making a new selection, etc. It is called automatically for - menu commands. - Typing commands can call 'closeTypeIn: aCharacterStream' instead of this to - save typeahead. Undoer & Redoer: undoAndReselect:redoAndReselect:." - - | begin stop | - beginTypeInBlock == nil ifFalse: - [(UndoMessage sends: #noUndoer) ifTrue: "should always be true, but just in case..." - [begin := self startOfTyping. - stop := self stopIndex. - self undoer: #undoAndReselect:redoAndReselect: - with: (begin + UndoMessage argument to: begin + UndoSelection size - 1) - with: (stop to: stop - 1). - UndoInterval := begin to: stop - 1]. - beginTypeInBlock := nil]! Item was removed: - ----- Method: ParagraphEditor>>closeTypeIn: (in category 'typing support') ----- - closeTypeIn: characterStream - "Call instead of closeTypeIn when you want typeahead to be inserted before the - control character is executed, e.g., from Ctrl-V." - - self insertTypeAhead: characterStream. - self closeTypeIn! Item was removed: - ----- Method: ParagraphEditor>>comment (in category 'nonediting/nontyping keys') ----- - comment - "All key actions that are neither editing nor typing actions have to - send closeTypeIn at first. See comment in openTypeIn closeTypeIn"! Item was removed: - ----- Method: ParagraphEditor>>compareToClipboard (in category 'menu messages') ----- - compareToClipboard - "If any text is selected, present the modifications that would be made to it if the clipboard contents were pasted over it. If no text is selected, present the differences betwen the entire pane's contents and the clipboard text." - | subjectText proposedText | - subjectText := self selection string ifEmpty: [ paragraph text string ]. - proposedText := self clipboardText string. - subjectText = proposedText ifTrue: [^ self inform: 'Exact match']. - (StringHolder new - textContents: - (TextDiffBuilder - buildDisplayPatchFrom: subjectText - to: proposedText)) openLabel: 'Differences with Clipboard Text'! Item was removed: - ----- Method: ParagraphEditor>>compareToClipboard: (in category 'editing keys') ----- - compareToClipboard: characterStream - "Compare the receiver to the text on the clipboard. Flushes typeahead. 5/1/96 sw" - - sensor keyboard. - self terminateAndInitializeAround: [self compareToClipboard]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>compileSelectionFor:in: (in category 'do-its') ----- - compileSelectionFor: anObject in: evalContext - - | methodNode | - methodNode := [Compiler new - compileNoPattern: self selectionAsStream - in: anObject class - context: evalContext - notifying: self - ifFail: [^nil]] - on: OutOfScopeNotification - do: [:ex | ex resume: true]. - - ^ methodNode generateWithTempNames. - ! Item was removed: - ----- Method: ParagraphEditor>>completeSymbol:lastOffering: (in category 'private') ----- - completeSymbol: hintText lastOffering: selectorOrNil - "Invoked by Ctrl-q when there is only a caret. - Do selector-completion, i.e., try to replace the preceding identifier by a - selector that begins with those characters & has as many keywords as possible. - Leave two spaces after each colon (only one after the last) as space for - arguments. Put the caret after the space after the first keyword. If the - user types Ctrl-q again immediately, choose a different selector. - Undoer: #undoQuery:lastOffering:; Redoer: itself. - If redoing, just redisplay the last offering, selector[OrNil]." - - | firstTime input prior caret newStart sym kwds outStream | - firstTime := self isRedoing - ifTrue: [prior := sym := selectorOrNil. true] - ifFalse: [hintText isNil]. - firstTime - ifTrue: "Initial Ctrl-q (or redo)" - [caret := self startIndex. - self selectPrecedingIdentifier. - input := self selection] - ifFalse: "Repeated Ctrl-q" - [caret := UndoInterval first + hintText size. - self selectInvisiblyFrom: UndoInterval first to: UndoInterval last. - input := hintText. - prior := selectorOrNil]. - (input size ~= 0 and: [sym ~~ nil or: - [(sym := Symbol thatStarts: input string skipping: prior) ~~ nil]]) - ifTrue: "found something to offer" - [newStart := self startIndex. - outStream := WriteStream on: (String new: 2 * sym size). - 1 to: (kwds := sym keywords) size do: - [:i | - outStream nextPutAll: (kwds at: i). - i = 1 ifTrue: [caret := newStart + outStream contents size + 1]. - outStream nextPutAll: - (i < kwds size ifTrue: [' '] ifFalse: [' '])]. - UndoSelection := input. - self deselect; zapSelectionWith: outStream contents asText. - self undoer: #undoQuery:lastOffering: with: input with: sym] - ifFalse: "no more matches" - [firstTime ifFalse: "restore original text & set up for a redo" - [UndoSelection := self selection. - self deselect; zapSelectionWith: input. - self undoer: #completeSymbol:lastOffering: with: input with: prior. - Undone := true]. - view flash]. - self selectAt: caret! Item was removed: - ----- Method: ParagraphEditor>>computeIntervalFrom:to: (in category 'new selection') ----- - computeIntervalFrom: start to: stop - "Select the designated characters, inclusive. Make no visual changes." - - self setMark: start. - self setPoint: stop + 1.! Item was removed: - ----- Method: ParagraphEditor>>computeMarkerRegion (in category 'scrolling') ----- - computeMarkerRegion - "Refer to the comment in ScrollController|computeMarkerRegion." - - paragraph compositionRectangle height = 0 - ifTrue: [^0 at 0 extent: Preferences scrollBarWidth @ scrollBar inside height] - ifFalse: [^0 at 0 extent: - Preferences scrollBarWidth - @ ((paragraph clippingRectangle height asFloat / - self scrollRectangleHeight * scrollBar inside height) rounded - min: scrollBar inside height)]! Item was removed: - ----- Method: ParagraphEditor>>controlInitialize (in category 'controlling') ----- - controlInitialize - - super controlInitialize. - self recomputeInterval. - self initializeSelection. - beginTypeInBlock := nil! Item was removed: - ----- Method: ParagraphEditor>>controlTerminate (in category 'controlling') ----- - controlTerminate - - self closeTypeIn. "Must call to establish UndoInterval" - super controlTerminate. - self deselect! Item was removed: - ----- Method: ParagraphEditor>>copyHiddenInfo (in category 'editing keys') ----- - copyHiddenInfo - "In TextLinks, TextDoits, TextColor, and TextURLs, there is hidden - info. Copy that to the clipboard. You can paste it and see what it is. - Usually enclosed in <>." - - ^ self clipboardTextPut: self hiddenInfo asText! Item was removed: - ----- Method: ParagraphEditor>>copySelection (in category 'menu messages') ----- - copySelection - "Copy the current selection and store it in the paste buffer, unless a caret. Undoer & Redoer: undoCutCopy" - - self lineSelectAndEmptyCheck: [^ self]. - - "Simulate 'substitute: self selection' without locking the controller" - UndoSelection := self selection. - self undoer: #undoCutCopy: with: self clipboardText. - UndoInterval := self selectionInterval. - self clipboardTextPut: UndoSelection! Item was removed: - ----- Method: ParagraphEditor>>copySelection: (in category 'editing keys') ----- - copySelection: characterStream - "Copy the current text selection. Flushes typeahead." - - sensor keyboard. "flush character" - self copySelection. - ^true! Item was removed: - ----- Method: ParagraphEditor>>correctFrom:to:with: (in category 'new selection') ----- - correctFrom: start to: stop with: aString - "Make a correction in the model that the user has authorised from somewhere else in the system (such as from the compilier). The user's selection is not changed, only corrected." - | wasShowing userSelection delta loc | - aString = '#insert period' ifTrue: - [loc := start. - [(loc := loc-1)>0 and: [(paragraph text string at: loc) isSeparator]] - whileTrue: [loc := loc-1]. - ^ self correctFrom: loc+1 to: loc with: '.']. - (wasShowing := selectionShowing) ifTrue: [ self reverseSelection ]. - userSelection := self selectionInterval. - - self selectInvisiblyFrom: start to: stop. - self replaceSelectionWith: aString asText. - - delta := aString size - (stop - start + 1). - self selectInvisiblyFrom: - userSelection first + (userSelection first > start ifFalse: [ 0 ] ifTrue: [ delta ]) - to: userSelection last + (userSelection last > start ifFalse: [ 0 ] ifTrue: [ delta ]). - wasShowing ifTrue: [ self reverseSelection ]. - ! Item was removed: - ----- Method: ParagraphEditor>>crWithIndent: (in category 'typing/selecting keys') ----- - crWithIndent: characterStream - "Replace the current text selection with CR followed by as many tabs - as on the current line (+/- bracket count) -- initiated by Shift-Return." - | char s i tabCount | - sensor keyboard. "flush character" - s := paragraph string. - i := self stopIndex. - tabCount := 0. - [(i := i-1) > 0 and: [(char := s at: i) ~= Character cr and: [char ~= Character lf]]] - whileTrue: "Count tabs and brackets (but not a leading bracket)" - [(char = Character tab and: [i < s size and: [(s at: i+1) ~= $[ ]]) ifTrue: [tabCount := tabCount + 1]. - char = $[ ifTrue: [tabCount := tabCount + 1]. - char = $] ifTrue: [tabCount := tabCount - 1]]. - characterStream crtab: tabCount. "Now inject CR with tabCount tabs" - ^ false! Item was removed: - ----- Method: ParagraphEditor>>cursorDown: (in category 'nonediting/nontyping keys') ----- - cursorDown: characterStream - - "Private - Move cursor from position in current line to same position in - next line. If next line too short, put at end. If shift key down, - select." - self closeTypeIn: characterStream. - self - moveCursor:[:position | self - sameColumn: position - newLine:[:line | line + 1] - forward: true] - forward: true - specialBlock:[:dummy | dummy]. - ^true! Item was removed: - ----- Method: ParagraphEditor>>cursorEnd: (in category 'nonediting/nontyping keys') ----- - cursorEnd: characterStream - - "Private - Move cursor end of current line." - | string | - self closeTypeIn: characterStream. - string := paragraph text string. - self - moveCursor: - [:position | Preferences wordStyleCursorMovement - ifTrue: [ - paragraph lines - at: (paragraph lineIndexOfCharacterIndex: position) - ifPresent: [:targetLine | targetLine last + (targetLine last = string size) asBit] - ifAbsent: [position]] - ifFalse: [ - string - indexOfAnyOf: CharacterSet crlf - startingAt: position - ifAbsent:[string size + 1]]] - forward: true - specialBlock:[:dummy | string size + 1]. - ^true! Item was removed: - ----- Method: ParagraphEditor>>cursorHome: (in category 'nonediting/nontyping keys') ----- - cursorHome: characterStream - - "Private - Move cursor from position in current line to beginning of - current line. If control key is pressed put cursor at beginning of text" - - | string | - - string := paragraph text string. - self - moveCursor: [:position | Preferences wordStyleCursorMovement - ifTrue: [ - paragraph lines - at: (paragraph lineIndexOfCharacterIndex: position) - ifPresent: [:targetLine | targetLine first] ifAbsent: [position]] - ifFalse:[ - (string - lastIndexOfAnyOf: CharacterSet crlf - startingAt: position - 1) + 1]] - forward: false - specialBlock: [:dummy | 1]. - ^true! Item was removed: - ----- Method: ParagraphEditor>>cursorLeft: (in category 'nonediting/nontyping keys') ----- - cursorLeft: characterStream - "Private - Move cursor left one character if nothing selected, otherwise - move cursor to beginning of selection. If the shift key is down, start - selecting or extending current selection. Don't allow cursor past - beginning of text" - - self closeTypeIn: characterStream. - self - moveCursor:[:position | position - 1 max: 1] - forward: false - specialBlock:[:position | self previousWord: position]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>cursorPageDown: (in category 'nonediting/nontyping keys') ----- - cursorPageDown: characterStream - - self closeTypeIn: characterStream. - self - moveCursor: [:position | - self - sameColumn: position - newLine:[:lineNo | lineNo + self pageHeight] - forward: true] - forward: true - specialBlock:[:dummy | dummy]. - ^true! Item was removed: - ----- Method: ParagraphEditor>>cursorPageUp: (in category 'nonediting/nontyping keys') ----- - cursorPageUp: characterStream - - self closeTypeIn: characterStream. - self - moveCursor: [:position | - self - sameColumn: position - newLine:[:lineNo | lineNo - self pageHeight] - forward: false] - forward: false - specialBlock:[:dummy | dummy]. - ^true! Item was removed: - ----- Method: ParagraphEditor>>cursorRight: (in category 'nonediting/nontyping keys') ----- - cursorRight: characterStream - "Private - Move cursor right one character if nothing selected, - otherwise move cursor to end of selection. If the shift key is down, - start selecting characters or extending already selected characters. - Don't allow cursor past end of text" - - self closeTypeIn: characterStream. - self - moveCursor: [:position | position + 1] - forward: true - specialBlock:[:position | self nextWord: position]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>cursorTopHome: (in category 'typing/selecting keys') ----- - cursorTopHome: characterStream - "Put cursor at beginning of text -- invoked from cmd-H shortcut, useful for keyboards that have no home key." - - sensor keyboard. - self selectAt: 1. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>cursorUp: (in category 'nonediting/nontyping keys') ----- - cursorUp: characterStream - - "Private - Move cursor from position in current line to same position in - prior line. If prior line too short, put at end" - - self closeTypeIn: characterStream. - self - moveCursor: [:position | self - sameColumn: position - newLine:[:line | line - 1] - forward: false] - forward: false - specialBlock:[:dummy | dummy]. - ^true! Item was removed: - ----- Method: ParagraphEditor>>cut (in category 'menu messages') ----- - cut - "Cut out the current selection and redisplay the paragraph if necessary. Undoer & Redoer: undoCutCopy:" - - self lineSelectAndEmptyCheck: [^ self]. - - self replaceSelectionWith: self nullText. - self undoer: #undoCutCopy: with: self clipboardText. - self clipboardTextPut: UndoSelection! Item was removed: - ----- Method: ParagraphEditor>>cut: (in category 'editing keys') ----- - cut: characterStream - "Cut out the current text selection. Flushes typeahead." - - sensor keyboard. "flush character" - self cut. - ^true! Item was removed: - ----- Method: ParagraphEditor>>debugIt: (in category 'editing keys') ----- - debugIt: characterStream - sensor keyboard. - self terminateAndInitializeAround: [self debugIt]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>deselect (in category 'current selection') ----- - deselect - "If the text selection is visible on the screen, reverse its highlight." - - selectionShowing ifTrue: [self reverseSelection]! Item was removed: - ----- Method: ParagraphEditor>>dispatchOnCharacter:with: (in category 'parenblinking') ----- - dispatchOnCharacter: char with: typeAheadStream - "Carry out the action associated with this character, if any. - Type-ahead is passed so some routines can flush or use it." - - | honorCommandKeys result | - self clearParens. - - "mikki 1/3/2005 21:31 Preference for auto-indent on return added." - char asciiValue = 13 ifTrue: [ - ^Preferences autoIndent - ifTrue: [ - sensor controlKeyPressed - ifTrue: [self normalCharacter: typeAheadStream] - ifFalse: [self crWithIndent: typeAheadStream]] - ifFalse: [ - sensor controlKeyPressed - ifTrue: [self crWithIndent: typeAheadStream] - ifFalse: [self normalCharacter: typeAheadStream]]]. - - ((honorCommandKeys := Preferences cmdKeysInText) and: [char = Character enter]) - ifTrue: [^ self dispatchOnEnterWith: typeAheadStream]. - - (char = Character tab and: [ self selection notEmpty ]) ifTrue: [ self tabOrIndent: typeAheadStream ]. - - "Special keys overwrite crtl+key combinations - at least on Windows. To resolve this - conflict, assume that keys other than cursor keys aren't used together with Crtl." - ((self class specialShiftCmdKeys includes: char asciiValue) and: [char asciiValue < 27]) - ifTrue: [^ sensor controlKeyPressed - ifTrue: [self perform: (ShiftCmdActions at: char asciiValue + 1) with: typeAheadStream] - ifFalse: [self perform: (CmdActions at: char asciiValue + 1) with: typeAheadStream]]. - - "backspace, and escape keys (ascii 8 and 27) are command keys" - ((honorCommandKeys and: [sensor commandKeyPressed]) or: [self class specialShiftCmdKeys includes: char asciiValue]) ifTrue: - [^ sensor leftShiftDown - ifTrue: - [self perform: (ShiftCmdActions at: char asciiValue + 1 ifAbsent: [#noop:]) with: typeAheadStream] - ifFalse: - [self perform: (CmdActions at: char asciiValue + 1 ifAbsent: [#noop:]) with: typeAheadStream]]. - - "the control key can be used to invoke shift-cmd shortcuts" - (honorCommandKeys and: [sensor controlKeyPressed]) - ifTrue: - [^ self perform: (ShiftCmdActions at: char asciiValue + 1 ifAbsent: [#noop:]) with: typeAheadStream]. - - result := self normalCharacter: typeAheadStream. - - (')]}' includes: char) - ifTrue: [self blinkPrevParen: char ]. - ^result! Item was removed: - ----- Method: ParagraphEditor>>dispatchOnEnterWith: (in category 'typing support') ----- - dispatchOnEnterWith: typeAheadStream - "Enter key hit. Treat is as an 'accept', viz a synonym for cmd-s. If cmd key is down, treat is as a synonym for print-it. " - - sensor keyboard. "consume enter key" - self terminateAndInitializeAround: [ - sensor commandKeyPressed - ifTrue: - [self printIt.] - ifFalse: - [self closeTypeIn: typeAheadStream. - self accept]. - ]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>display (in category 'displaying') ----- - display - "Redisplay the paragraph." - - | selectionState | - selectionState := selectionShowing. - self deselect. - paragraph foregroundColor: view foregroundColor - backgroundColor: view backgroundColor; - displayOn: Display. - selectionState ifTrue: [self select]! Item was removed: - ----- Method: ParagraphEditor>>displayIfFalse: (in category 'typing/selecting keys') ----- - displayIfFalse: characterStream - "Replace the current text selection with the text 'ifFalse:'--initiated by - ctrl-f." - - sensor keyboard. "flush character" - characterStream nextPutAll: 'ifFalse:'. - ^false! Item was removed: - ----- Method: ParagraphEditor>>displayIfTrue: (in category 'typing/selecting keys') ----- - displayIfTrue: characterStream - "Replace the current text selection with the text 'ifTrue:'--initiated by - ctrl-t." - - sensor keyboard. "flush character" - characterStream nextPutAll: 'ifTrue:'. - ^false! Item was removed: - ----- Method: ParagraphEditor>>doAgainMany: (in category 'typing/selecting keys') ----- - doAgainMany: characterStream - "Do the previous thing again repeatedly. 1/26/96 sw" - - sensor keyboard. "flush character" - self closeTypeIn: characterStream. - self againOrSame: (UndoMessage sends: #undoAgain:andReselect:typedKey:) many: true. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>doAgainOnce: (in category 'typing/selecting keys') ----- - doAgainOnce: characterStream - "Do the previous thing again once. 1/26/96 sw" - - sensor keyboard. "flush character" - self closeTypeIn: characterStream. - self again. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>doIt (in category 'do-its') ----- - doIt - "Set the context to include pool vars of the model. Then evaluate." - ^ self evaluateSelection. - ! Item was removed: - ----- Method: ParagraphEditor>>doIt: (in category 'editing keys') ----- - doIt: characterStream - "Called when user hits cmd-d. Select the current line, if relevant, then evaluate and execute. 2/1/96 sw. - 2/29/96 sw: don't call selectLine; it's done by doIt now" - - sensor keyboard. - self terminateAndInitializeAround: [self doIt]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>doneTyping (in category 'typing support') ----- - doneTyping - beginTypeInBlock := nil! Item was removed: - ----- Method: ParagraphEditor>>enclose: (in category 'editing keys') ----- - enclose: characterStream - "Insert or remove bracket characters around the current selection. - Flushes typeahead." - - | char left right startIndex stopIndex oldSelection which text | - char := sensor keyboard. - self closeTypeIn. - startIndex := self startIndex. - stopIndex := self stopIndex. - oldSelection := self selection. - which := '([<{|"''' indexOf: char ifAbsent: [ ^true ]. - left := '([<{|"''' at: which. - right := ')]>}|"''' at: which. - text := paragraph text. - ((startIndex > 1 and: [stopIndex <= text size]) - and: - [(text at: startIndex-1) = left and: [(text at: stopIndex) = right]]) - ifTrue: - ["already enclosed; strip off brackets" - self selectFrom: startIndex-1 to: stopIndex. - self replaceSelectionWith: oldSelection] - ifFalse: - ["not enclosed; enclose by matching brackets" - self replaceSelectionWith: - (Text string: (String with: left), oldSelection string ,(String with: right) - emphasis: emphasisHere). - self selectFrom: startIndex+1 to: stopIndex]. - ^true! Item was removed: - ----- Method: ParagraphEditor>>encompassLine: (in category 'new selection') ----- - encompassLine: anInterval - "Return an interval that encompasses the entire line" - | string left right | - string := paragraph text string. - left := (string lastIndexOfAnyOf: CharacterSet crlf startingAt: anInterval first - 1) + 1. - right := (string indexOfAnyOf: CharacterSet crlf startingAt: anInterval last + 1 ifAbsent: [string size + 1]) - 1. - ^left to: right! Item was removed: - ----- Method: ParagraphEditor>>escapeToDesktop: (in category 'nonediting/nontyping keys') ----- - escapeToDesktop: characterStream - "Pop up a morph to field keyboard input in the context of the desktop" - - Smalltalk isMorphic ifTrue: [ - Project current world putUpWorldMenuFromEscapeKey]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>evaluateSelection (in category 'do-its') ----- - evaluateSelection - "Treat the current selection as an expression; evaluate it and return the result" - - ^self evaluateSelectionAndDo: [:result | result]! Item was removed: - ----- Method: ParagraphEditor>>evaluateSelectionAndDo: (in category 'do-its') ----- - evaluateSelectionAndDo: aBlock - "Treat the current selection as an expression; evaluate it and invoke aBlock with the result." - | result rcvr ctxt | - self lineSelectAndEmptyCheck: [^ nil]. - - (model respondsTo: #evaluateExpression:requestor:) ifTrue: [ - ^ aBlock value: (model perform: #evaluateExpression:requestor: with: self selection with: self)]. - (model respondsTo: #evaluateExpression:) ifTrue: [ - ^ aBlock value: (model perform: #evaluateExpression: with: self selection)]. - - (model respondsTo: #doItReceiver) - ifTrue: [ rcvr := model doItReceiver. - ctxt := model doItContext] - ifFalse: [rcvr := ctxt := nil]. - result := [ - rcvr class evaluatorClass new - evaluate: self selectionAsStream - in: ctxt - to: rcvr - environment: (model environment ifNil: [Smalltalk globals]) - notifying: self - ifFail: [self flash. ^ nil] - logged: true. - ] - on: OutOfScopeNotification - do: [ :ex | ex resume: true]. - - (model respondsTo: #expressionEvaluated:result:) ifTrue: [ - model perform: #expressionEvaluated:result: with: self selection with: result]. - - ^aBlock value: result! Item was removed: - ----- Method: ParagraphEditor>>exchange (in category 'menu messages') ----- - exchange - "See comment in exchangeWith:" - - self exchangeWith: otherInterval! Item was removed: - ----- Method: ParagraphEditor>>exchange: (in category 'editing keys') ----- - exchange: characterStream - "Exchange the current and prior selections. Keeps typeahead." - - sensor keyboard. "Flush character" - self closeTypeIn: characterStream. - self exchange. - ^true! Item was removed: - ----- Method: ParagraphEditor>>exchangeWith: (in category 'private') ----- - exchangeWith: prior - "If the prior selection is non-overlapping and legal, exchange the text of - it with the current selection and leave the currently selected text selected - in the location of the prior selection (or leave a caret after a non-caret if it was - exchanged with a caret). If both selections are carets, flash & do nothing. - Don't affect the paste buffer. Undoer: itself; Redoer: Undoer." - - | start stop before selection priorSelection delta altInterval | - start := self startIndex. - stop := self stopIndex - 1. - ((prior first <= prior last) | (start <= stop) "Something to exchange" and: - [self isDisjointFrom: prior]) - ifTrue: - [before := prior last < start. - selection := self selection. - priorSelection := paragraph text copyFrom: prior first to: prior last. - - delta := before ifTrue: [0] ifFalse: [priorSelection size - selection size]. - self zapSelectionWith: priorSelection. - self selectFrom: prior first + delta to: prior last + delta. - - delta := before ifTrue: [stop - prior last] ifFalse: [start - prior first]. - self zapSelectionWith: selection. - altInterval := prior first + delta to: prior last + delta. - self undoer: #exchangeWith: with: altInterval. - "If one was a caret, make it otherInterval & leave the caret after the other" - prior first > prior last ifTrue: [self selectAt: UndoInterval last + 1]. - otherInterval := start > stop - ifTrue: [self selectAt: altInterval last + 1. UndoInterval] - ifFalse: [altInterval]] - ifFalse: - [view flash]! Item was removed: - ----- Method: ParagraphEditor>>experimentalCommand (in category 'menu messages') ----- - experimentalCommand - "Use for experimental command-key implementation. Using this, - you can try things out without forever needing to reinitialize the - ParagraphEditor." - - self prettyPrint. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>explain (in category 'menu messages') ----- - explain - "Try to shed some light on what kind of entity the current selection - is. - The selection must be a single token or construct. Insert the answer - after - the selection. Send private messages whose names begin with 'explain' - that return a string if they recognize the selection, else nil." - - - Cursor execute showWhile: - [ | string delimitors reply numbers tiVars selectors sorry cgVars | - sorry := '"Sorry, I can''t explain that. Please select a single - token, construct, or special character.'. - sorry := sorry , (view canDiscardEdits - ifFalse: [' Also, please cancel or accept."'] - ifTrue: ['"']). - (string := self selection asString) isEmpty - ifTrue: [reply := ''] - ifFalse: [string := self explainScan: string. - "Remove space, tab, cr" - "Temps and Instance vars need only test strings that are all - letters" - (string detect: [:char | (char isLetter or: [char isDigit]) not] - ifNone: []) ifNil: - [tiVars := self explainTemp: string. - tiVars == nil ifTrue: [tiVars := self explainInst: string]]. - (tiVars == nil and: [model respondsTo: #explainSpecial:]) - ifTrue: [tiVars := model explainSpecial: string]. - tiVars == nil - ifTrue: [tiVars := ''] - ifFalse: [tiVars := tiVars , '\' withCRs]. - "Context, Class, Pool, and Global vars, and Selectors need - only test symbols" - (Symbol lookup: string) - ifNotNil: [ :symbol | - cgVars := self explainCtxt: symbol. - cgVars == nil - ifTrue: [cgVars := self explainClass: symbol. - cgVars == nil ifTrue: [cgVars := self explainGlobal: symbol]]. - "See if it is a Selector (sent here or not)" - selectors := self explainMySel: symbol. - selectors == nil - ifTrue: - [selectors := self explainPartSel: string. - selectors == nil ifTrue: [ - selectors := self explainAnySel: symbol]]] - ifNil: [selectors := self explainPartSel: string]. - cgVars == nil - ifTrue: [cgVars := ''] - ifFalse: [cgVars := cgVars , '\' withCRs]. - selectors == nil - ifTrue: [selectors := ''] - ifFalse: [selectors := selectors , '\' withCRs]. - string size = 1 - ifTrue: ["single special characters" - delimitors := self explainChar: string] - ifFalse: ["matched delimitors" - delimitors := self explainDelimitor: string]. - numbers := self explainNumber: string. - numbers == nil ifTrue: [numbers := '']. - delimitors == nil ifTrue: [delimitors := '']. - reply := tiVars , cgVars , selectors , delimitors , numbers]. - reply size = 0 ifTrue: [reply := sorry]. - self afterSelectionInsertAndSelect: reply]! Item was removed: - ----- Method: ParagraphEditor>>explainAnySel: (in category 'explain') ----- - explainAnySel: symbol - "Is this any message selector?" - - | list reply | - list := self systemNavigation allClassesImplementing: symbol. - list size = 0 ifTrue: [^nil]. - list size < 12 - ifTrue: [reply := ' is a message selector which is defined in these classes: ' , list asArray printString] - ifFalse: [reply := ' is a message selector which is defined in many classes']. - ^'"' , symbol , reply , '."' , '\' withCRs, 'SystemNavigation new browseAllImplementorsOf: #' , symbol! Item was removed: - ----- Method: ParagraphEditor>>explainChar: (in category 'explain') ----- - explainChar: string - "Does string start with a special character?" - - | char | - char := string at: 1. - char = $. ifTrue: [^'"Period marks the end of a Smalltalk statement. A period in the middle of a number means a decimal point. (The number is an instance of class Float)."']. - char = $' ifTrue: [^'"The characters between two single quotes are made into an instance of class String"']. - char = $" ifTrue: [^'"Double quotes enclose a comment. Smalltalk ignores everything between double quotes."']. - char = $# ifTrue: [^'"The characters following a hash mark are made into an instance of class Symbol. If parenthesis follow a hash mark, an instance of class Array is made. It contains literal constants."']. - (char = $( or: [char = $)]) ifTrue: [^'"Expressions enclosed in parenthesis are evaluated first"']. - (char = $[ or: [char = $]]) ifTrue: [^'"The code inside square brackets is an unevaluated block of code. It becomes an instance of BlockClosure and is usually passed as an argument."']. - (char = ${ or: [char = $}]) ifTrue: [^ '"A sequence of expressions separated by periods, when enclosed in curly braces, are evaluated to yield the elements of a new Array"']. - (char = $< or: [char = $>]) ifTrue: [^'"<primitive: xx> means that this method is usually preformed directly by the virtual machine. If this method is primitive, its Smalltalk code is executed only when the primitive fails."']. - char = $^ ifTrue: [^'"Uparrow means return from this method. The value returned is the expression following the ^"']. - char = $| ifTrue: [^'"Vertical bars enclose the names of the temporary variables used in this method. In a block, the vertical bar separates the argument names from the rest of the code."']. - char = $_ ifTrue: [^'"Left arrow means assignment. The value of the expression after the left arrow is stored into the variable before it."']. - char = $; ifTrue: [^'"Semicolon means cascading. The message after the semicolon is sent to the same object which received the message before the semicolon."']. - char = $: ifTrue: [^'"A colon at the end of a keyword means that an argument is expected to follow. Methods which take more than one argument have selectors with more than one keyword. (One keyword, ending with a colon, appears before each argument).', '\\' withCRs, 'A colon before a variable name just inside a block means that the block takes an agrument. (When the block is evaluated, the argument will be assigned to the variable whose name appears after the colon)."']. - char = $$ ifTrue: [^'"The single character following a dollar sign is made into an instance of class Character"']. - char = $- ifTrue: [^'"A minus sign in front of a number means a negative number."']. - char = $e ifTrue: [^'"An e in the middle of a number means that the exponent follows."']. - char = $r ifTrue: [^'"An r in the middle of a bunch of digits is an instance of Integer expressed in a certain radix. The digits before the r denote the base and the digits after it express a number in that base."']. - char = Character space ifTrue: [^'"the space Character"']. - char = Character tab ifTrue: [^'"the tab Character"']. - char = Character cr ifTrue: [^'"the carriage return Character"']. - char = Character lf ifTrue: [^'"the line feed Character"']. - ^nil! Item was removed: - ----- Method: ParagraphEditor>>explainClass: (in category 'explain') ----- - explainClass: symbol - "Is symbol a class variable or a pool variable?" - | class reply classes | - self flag: #environments. - (model respondsTo: #selectedClassOrMetaClass) - ifFalse: [^ nil]. - (class := model selectedClassOrMetaClass) ifNil: [^ nil]. - "no class is selected" - (class isKindOf: Metaclass) - ifTrue: [class := class soleInstance]. - classes := (Array with: class) - , class allSuperclasses. - "class variables" - reply := classes detect: [:each | (each classVarNames detect: [:name | symbol = name] - ifNone: []) - ~~ nil] - ifNone: []. - reply == nil ifFalse: [^ '"is a class variable, defined in class ' , reply printString , '"\' withCRs , 'SystemNavigation new browseAllCallsOn: (' , reply printString , ' classPool associationAt: #' , symbol , ').']. - "pool variables" - classes do: [:each | (each sharedPools - detect: [:pool | (pool includesKey: symbol) - and: - [reply := pool. - true]] - ifNone: []) - ~~ nil]. - reply - ifNil: [(class environment isUndeclared: symbol) - ifTrue: [^ '"is an undeclared variable.' , '"\' withCRs , 'SystemNavigation new browseAllCallsOn: (Undeclared associationAt: #' , symbol , ').']] - ifNotNil: - [classes := WriteStream on: Array new. - self systemNavigation - allBehaviorsDo: [:each | (each sharedPools - detect: - [:pool | - pool == reply] - ifNone: []) - ~~ nil ifTrue: [classes nextPut: each]]. - "Perhaps not print whole list of classes if too long. (unlikely)" - ^ '"is a pool variable from the pool ' , (Smalltalk globals keyAtIdentityValue: reply) asString , ', which is used by the following classes ' , classes contents printString , '"\' withCRs , 'SystemNavigation new browseAllCallsOn: (' , (Smalltalk globals keyAtIdentityValue: reply) asString , ' bindingOf: #' , symbol , ').']. - ^ nil! Item was removed: - ----- Method: ParagraphEditor>>explainCtxt: (in category 'explain') ----- - explainCtxt: symbol - "Is symbol a context variable?" - - | reply classes text cls | - symbol = #nil ifTrue: [reply := '"is a constant. It is the only instance of class UndefinedObject. nil is the initial value of all variables."']. - symbol = #true ifTrue: [reply := '"is a constant. It is the only instance of class True and is the receiver of many control messages."']. - symbol = #false ifTrue: [reply := '"is a constant. It is the only instance of class False and is the receiver of many control messages."']. - symbol = #thisContext ifTrue: [reply := '"is a context variable. Its value is always the Context which is executing this method."']. - (model respondsTo: #selectedClassOrMetaClass) ifTrue: [ - cls := model selectedClassOrMetaClass]. - cls ifNil: [^ reply]. "no class known" - symbol = #self ifTrue: - [classes := cls withAllSubclasses. - classes size > 12 - ifTrue: [text := cls printString , ' or a subclass'] - ifFalse: - [classes := classes printString. - text := 'one of these classes' , (classes copyFrom: 4 to: classes size)]. - reply := '"is the receiver of this message; an instance of ' , text , '"']. - symbol = #super ifTrue: [reply := '"is just like self. Messages to super are looked up in the superclass (' , cls superclass printString , ')"']. - ^reply! Item was removed: - ----- Method: ParagraphEditor>>explainDelimitor: (in category 'private') ----- - explainDelimitor: string - "Is string enclosed in delimitors?" - - | str | - (string at: 1) isLetter ifTrue: [^nil]. "only special chars" - (string first = string last) ifTrue: - [^ self explainChar: (String with: string first)] - ifFalse: - [(string first = $( and: [string last = $)]) ifTrue: - [^ self explainChar: (String with: string first)]. - (string first = $[ and: [string last = $]]) ifTrue: - [^ self explainChar: (String with: string first)]. - (string first = ${ and: [string last = $}]) ifTrue: - [^ self explainChar: (String with: string first)]. - (string first = $< and: [string last = $>]) ifTrue: - [^ self explainChar: (String with: string first)]. - (string first = $# and: [string last = $)]) ifTrue: - [^'"An instance of class Array. The Numbers, Characters, Symbols or Arrays between the parenthesis are the elements of the Array."']. - string first = $# ifTrue: - [^'"An instance of class Symbol."']. - (string first = $$ and: [string size = 2]) ifTrue: - [^'"An instance of class Character. This one is the character ', (String with: string last), '."']. - (string first = $:) ifTrue: - [string = ':=' ifTrue: - [^'"Colon equals means assignment. The value of the expression after the := is stored into the variable before it."']. - str := string allButFirst. - (self explainTemp: str) ifNotNil: - [^'"An argument to this block will be bound to the temporary variable ', str, '."']]]. - ^ nil! Item was removed: - ----- Method: ParagraphEditor>>explainGlobal: (in category 'explain') ----- - explainGlobal: symbol - "Is symbol a global variable?" - | reply classes | - reply := Smalltalk at: symbol ifAbsent: [^nil]. - (reply class == Dictionary or:[reply isKindOf: SharedPool class]) - ifTrue: - [classes := Set new. - self systemNavigation allBehaviorsDo: [:each | (each sharedPools anySatisfy: [:pool | pool == reply]) - ifTrue: [classes add: each]]. - classes := classes printString. - ^'"is a global variable. It is a pool which is used by the following classes ' , (classes allButFirst: 5) , '"']. - (reply isKindOf: Behavior) - ifTrue: [^'"is a global variable. ' , symbol , ' is a class in category ', reply category, - '."', '\' withCRs, 'Browser newOnClass: ' , symbol , '.']. - symbol == #Smalltalk ifTrue: [^'"is a global. Smalltalk is the only instance of SystemDictionary and holds all global variables."']. - ^'"is a global variable. ' , symbol , ' is ' , reply printString , '"'! Item was removed: - ----- Method: ParagraphEditor>>explainInst: (in category 'explain') ----- - explainInst: string - "Is string an instance variable of this class?" - | classes cls | - - (model respondsTo: #selectedClassOrMetaClass) ifTrue: [ - cls := model selectedClassOrMetaClass]. - cls ifNil: [^ nil]. "no class known" - classes := (Array with: cls) - , cls allSuperclasses. - classes := classes detect: [:each | each instVarNames - anySatisfy: [:name | name = string] ] ifNone: [^nil]. - classes := classes printString. - ^ '"is an instance variable of the receiver; defined in class ' , classes , - '"\' withCRs , classes , ' systemNavigation browseAllAccessesTo: ''' , string , ''' from: ', classes, '.'! Item was removed: - ----- Method: ParagraphEditor>>explainMySel: (in category 'explain') ----- - explainMySel: symbol - "Is symbol the selector of this method? Is it sent by this method? If - not, then expalin will call (explainPartSel:) to see if it is a fragment of a - selector sent here. If not, explain will call (explainAnySel:) to catch any - selector. " - - | lits classes msg | - (model respondsTo: #selectedMessageName) ifFalse: [^ nil]. - (msg := model selectedMessageName) ifNil: [^nil]. "not in a message" - classes := self systemNavigation allClassesImplementing: symbol. - classes size > 12 - ifTrue: [classes := 'many classes'] - ifFalse: [classes := 'these classes ' , classes printString]. - msg = symbol - ifTrue: [^ '"' , symbol , ' is the selector of this very method!! It is defined in ', - classes , '. To see the other definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."'] - ifFalse: - [lits := (model selectedClassOrMetaClass compiledMethodAt: - msg) messages. - (lits anySatisfy: [:each | each == symbol]) - ifFalse: [^nil]. - ^ '"' , symbol , ' is a message selector which is defined in ', classes , '. To see the definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."'].! Item was removed: - ----- Method: ParagraphEditor>>explainNumber: (in category 'explain') ----- - explainNumber: string - "Is string a Number?" - - | strm c | - (c := string at: 1) isDigit ifFalse: [(c = $- and: [string size > 1 and: [(string at: 2) isDigit]]) - ifFalse: [^nil]]. - strm := ReadStream on: string. - c := Number readFrom: strm. - strm atEnd ifFalse: [^nil]. - c printString = string - ifTrue: [^'"' , string , ' is a ' , c class name , '"'] - ifFalse: [^'"' , string , ' (= ' , c printString , ') is a ' , c class name , '"']! Item was removed: - ----- Method: ParagraphEditor>>explainPartSel: (in category 'explain') ----- - explainPartSel: string - "Is this a fragment of a multiple-argument selector sent in this method?" - | lits whole reply classes s msg | - - (model respondsTo: #selectedMessageName) ifFalse: [^ nil]. - (msg := model selectedMessageName) ifNil: [^ nil]. "not in a message" - string last == $: ifFalse: [^ nil]. - "Name of this method" - lits := Array with: msg. - (whole := lits detect: [:each | each keywords anySatisfy: [:frag | frag = string] ] - ifNone: []) ~~ nil - ifTrue: [reply := ', which is the selector of this very method!!'. - s := '. To see the other definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."'] - ifFalse: - ["Selectors called from this method" - lits := (model selectedClassOrMetaClass compiledMethodAt: - msg) messages. - (whole := lits detect: [:each | each keywords anySatisfy: [:frag | frag = string] ] - ifNone: []) ~~ nil - ifFalse: [string = 'primitive:' - ifTrue: [^self explainChar: '<'] - ifFalse: [^nil]]. - reply := '.'. - s := '. To see the definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."']. - classes := self systemNavigation allClassesImplementing: whole. - classes size > 12 - ifTrue: [classes := 'many classes'] - ifFalse: [classes := 'these classes ' , classes printString]. - ^ '"' , string , ' is one part of the message selector ' , whole, reply , ' It is defined in ' , classes , s! Item was removed: - ----- Method: ParagraphEditor>>explainScan: (in category 'explain') ----- - explainScan: string - "Remove beginning and trailing separators (space, tab, cr,...)" - - ^string withBlanksTrimmed! Item was removed: - ----- Method: ParagraphEditor>>explainTemp: (in category 'explain') ----- - explainTemp: string - "Is string the name of a temporary variable (method or block argument or temporary)?" - - | selectedClass methodNode tempNode | - (model respondsTo: #selectedMessageName) ifFalse: [^ nil]. - model selectedMessageName ifNil: [^nil]. "not in a method" - selectedClass := model selectedClassOrMetaClass. - methodNode := selectedClass newParser parse: model selectedMessage class: selectedClass. - tempNode := methodNode encoder tempNodes detect: [:n| n name = string] ifNone: [^nil]. - ^(tempNode isArg - ifTrue: ['"is an argument to this '] - ifFalse: ['"is a temporary variable in this ']), - (tempNode isDeclaredAtMethodLevel - ifTrue: ['method"'] - ifFalse: ['block"'])! Item was removed: - ----- Method: ParagraphEditor>>exploreIt (in category 'do-its') ----- - exploreIt - self evaluateSelectionAndDo: [:result | result explore] - ! Item was removed: - ----- Method: ParagraphEditor>>exploreIt: (in category 'editing keys') ----- - exploreIt: characterStream - "Explore the selection -- invoked via cmd-shift-I. If there is no current selection, use the current line." - - sensor keyboard. "flush character" - self terminateAndInitializeAround: [self exploreIt]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>fileItIn (in category 'menu messages') ----- - fileItIn - "Make a Stream on the text selection and fileIn it. - 1/24/96 sw: moved here from FileController; this function can be useful from any text window that shows stuff in chunk format" - - | selection | - selection := self selection. - self terminateAndInitializeAround: - [(ReadStream on: selection string from: 1 to: selection size) fileIn]. - ! Item was removed: - ----- Method: ParagraphEditor>>fileItIn: (in category 'editing keys') ----- - fileItIn: characterStream - "File in the selection; invoked via a keyboard shortcut, -- for now, cmd-shift-G." - - sensor keyboard. "flush character" - self terminateAndInitializeAround: [self fileItIn]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>find (in category 'menu messages') ----- - find - "Prompt the user for a string to search for, and search the receiver from the current selection onward for it. 1/26/96 sw" - - | reply | - reply := UIManager default request: 'Find what? ' translated initialAnswer: ''. - reply size = 0 ifTrue: [^ self]. - self setSearch: reply. - ChangeText := FindText. "Implies no replacement to againOnce: method" - self againOrSame: true - - ! Item was removed: - ----- Method: ParagraphEditor>>find: (in category 'typing/selecting keys') ----- - find: characterStream - "Prompt the user for what to find, then find it, searching from the current selection onward. 1/24/96 sw" - - sensor keyboard. "flush character" - self closeTypeIn: characterStream. - self find. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>findAgain (in category 'menu messages') ----- - findAgain - "Find the text-to-find again. 1/24/96 sw" - - self againOrSame: true! Item was removed: - ----- Method: ParagraphEditor>>findAgain: (in category 'typing/selecting keys') ----- - findAgain: characterStream - "Find the desired text again. 1/24/96 sw" - - sensor keyboard. "flush character" - self closeTypeIn: characterStream. - self findAgain. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>findReplace (in category 'menu messages') ----- - findReplace - - (Project uiManager - request: 'Find what to replace?' - initialAnswer: FindText) - ifNotEmpty: [:find | - - (Project uiManager - request: ('Replace ''{1}'' with?' format: {find}) - initialAnswer: (ChangeText ifEmpty: [find]) - onCancelReturn: nil) - ifNotNil: [:replace | - - FindText := find. - ChangeText := replace. - self againOrSame: true ]]! Item was removed: - ----- Method: ParagraphEditor>>fit (in category 'menu messages') ----- - fit - "Make the bounding rectangle of the paragraph contain all the text while - not changing the width of the view of the paragraph. No effect on undoability - of the preceding command." - - paragraph clearVisibleRectangle. - paragraph fit. - paragraph displayOn: Display; outline. - self recomputeInterval! Item was removed: - ----- Method: ParagraphEditor>>flash (in category 'displaying') ----- - flash - "Causes the view of the paragraph to complement twice in succession." - - paragraph flash! Item was removed: - ----- Method: ParagraphEditor>>forwardDelete: (in category 'typing/selecting keys') ----- - forwardDelete: characterStream - "Delete forward over the next character. - Make Undo work on the whole type-in, not just the one char. - wod 11/3/1998: If there was a selection use #zapSelectionWith: rather than #backspace: which was 'one off' in deleting the selection. Handling of things like undo or typeIn area were not fully considered." - | startIndex usel upara uinterval ind stopIndex | - startIndex := self mark. - startIndex > paragraph text size ifTrue: - [sensor keyboard. - ^ false]. - self hasSelection ifTrue: - ["there was a selection" - sensor keyboard. - self zapSelectionWith: self nullText. - ^ false]. - "Null selection - do the delete forward" - beginTypeInBlock == nil "no previous typing. openTypeIn" - ifTrue: [self openTypeIn. UndoSelection := self nullText]. - uinterval := UndoInterval deepCopy. - upara := UndoParagraph deepCopy. - stopIndex := startIndex. - (sensor keyboard asciiValue = 127 and: [sensor leftShiftDown]) - ifTrue: [stopIndex := (self firstWordBoundaryAfter: stopIndex) - 1]. - self selectFrom: startIndex to: stopIndex. - self replaceSelectionWith: self nullText. - self selectFrom: startIndex to: startIndex-1. - UndoParagraph := upara. UndoInterval := uinterval. - UndoMessage selector == #noUndoer ifTrue: [ - (UndoSelection isText) ifTrue: [ - usel := UndoSelection. - ind := startIndex. "UndoInterval startIndex" - usel replaceFrom: usel size + 1 to: usel size with: - (UndoParagraph text copyFrom: ind to: ind). - UndoParagraph text replaceFrom: ind to: ind with: - self nullText]]. - ^false! Item was removed: - ----- Method: ParagraphEditor>>getPluggableYellowButtonMenu: (in category 'private') ----- - getPluggableYellowButtonMenu: shiftKeyState - | customMenu | - ^ ((view ~~ nil) and: [(customMenu := view getMenu: shiftKeyState) notNil]) - ifTrue: [customMenu] - ifFalse: - [shiftKeyState - ifTrue: [self class shiftedYellowButtonMenu] - ifFalse: [self class yellowButtonMenu]]! Item was removed: - ----- Method: ParagraphEditor>>hasCaret (in category 'accessing-selection') ----- - hasCaret - ^self markBlock = self pointBlock! Item was removed: - ----- Method: ParagraphEditor>>hasSelection (in category 'accessing-selection') ----- - hasSelection - ^self hasCaret not! Item was removed: - ----- Method: ParagraphEditor>>hiddenInfo (in category 'editing keys') ----- - hiddenInfo - "In TextLinks, TextDoits, TextColor, and TextURLs, there is hidden info. Return the entire string that was used by Cmd-6 to create this text attribute. Usually enclosed in < >." - - | attrList | - attrList := paragraph text attributesAt: (self pointIndex + - self markIndex)//2 forStyle: paragraph textStyle. - attrList do: [:attr | - (attr isKindOf: TextAction) ifTrue: - [^ self selection asString, '<', attr info, '>']]. - "If none of the above" - attrList do: [:attr | - attr class == TextColor ifTrue: - [^ self selection asString, '<', attr color printString, '>']]. - ^ self selection asString, '[No hidden info]'! Item was removed: - ----- Method: ParagraphEditor>>implementorsOfIt (in category 'menu messages') ----- - implementorsOfIt - "Open an implementors browser on the selected selector" - - | aSelector | - self lineSelectAndEmptyCheck: [^ self]. - (aSelector := self selectedSelector) == nil ifTrue: [^ view flash]. - self terminateAndInitializeAround: [ self systemNavigation browseAllImplementorsOf: aSelector]! Item was removed: - ----- Method: ParagraphEditor>>implementorsOfIt: (in category 'editing keys') ----- - implementorsOfIt: characterStream - "Triggered by Cmd-m; browse implementors of the selector represented by the current selection, if plausible. 2/1/96 sw" - - sensor keyboard. "flush character" - self implementorsOfIt. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>inOutdent:delta: (in category 'editing keys') ----- - inOutdent: characterStream delta: delta - "Add/remove a tab at the front of every line occupied by the selection. Flushes typeahead. Derived from work by Larry Tesler back in December 1985. Now triggered by Cmd-L and Cmd-R. 2/29/96 sw" - - | realStart realStop lines startLine stopLine start stop adjustStart "indentation" numLines oldText newText newSize | - sensor keyboard. "Flush typeahead" - - "Operate on entire lines, but remember the real selection for re-highlighting later" - realStart := self startIndex. - realStop := self stopIndex - 1. - - "Special case a caret on a line of its own, including weird case at end of paragraph" - (realStart > realStop and: - [realStart < 2 or: [(paragraph string at: realStart - 1) == Character cr or: [(paragraph string at: realStart - 1) == Character lf]]]) - ifTrue: - [delta < 0 - ifTrue: - [view flash] - ifFalse: - [self replaceSelectionWith: Character tab asSymbol asText. - self selectAt: realStart + 1]. - ^true]. - - lines := paragraph lines. - startLine := paragraph lineIndexOfCharacterIndex: realStart. - "start on a real line, not a wrapped line" - [startLine = 1 or: [CharacterSet crlf includes: (paragraph string at: (lines at: startLine-1) last)]] whileFalse: [startLine := startLine - 1]. - stopLine := paragraph lineIndexOfCharacterIndex: (realStart max: realStop). - start := (lines at: startLine) first. - stop := (lines at: stopLine) last. - - "Pin the start of highlighting unless the selection starts a line" - adjustStart := realStart > start. - - "Find the indentation of the least-indented non-blank line; never outdent more" - "indentation := (startLine to: stopLine) inject: 1000 into: - [:m :l | - m min: (paragraph indentationOfLineIndex: l ifBlank: [:tabs | 1000])]. - indentation + delta <= 0 ifTrue: [^false]." - - numLines := stopLine + 1 - startLine. - oldText := paragraph text copyFrom: start to: stop. - newText := oldText species new: oldText size + ((numLines * delta) max: 0). - - "Do the actual work" - newSize := 0. - delta > 0 - ifTrue: [| tabs | - tabs := oldText species new: delta withAll: Character tab. - oldText string lineIndicesDo: [:startL :endWithoutDelimiters :endL | - startL < endWithoutDelimiters ifTrue: [newText replaceFrom: 1 + newSize to: (newSize := newSize + delta) with: tabs startingAt: 1]. - newText replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - startL) with: oldText startingAt: startL]] - ifFalse: [| tab | - tab := Character tab. - oldText string lineIndicesDo: [:startL :endWithoutDelimiters :endL | - | i | - i := 0. - [i + delta < 0 and: [ i + startL <= endWithoutDelimiters and: [(oldText at: i + startL) == tab]]] whileTrue: [i := i + 1]. - newText replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - (i + startL)) with: oldText startingAt: i + startL]]. - newSize < newText size ifTrue: [newText := newText copyFrom: 1 to: newSize]. - - "Adjust the range that will be highlighted later" - adjustStart ifTrue: [realStart := (realStart + delta) max: start]. - realStop := realStop + newSize - oldText size. - - "Replace selection" - self selectInvisiblyFrom: start to: stop. - self replaceSelectionWith: newText. - self selectFrom: realStart to: realStop. "highlight only the original range" - ^ true! Item was removed: - ----- Method: ParagraphEditor>>indent: (in category 'editing keys') ----- - indent: characterStream - "Add a tab at the front of every line occupied by the selection. Flushes typeahead. Invoked from keyboard via cmd-shift-R. 2/29/96 sw" - - ^ self inOutdent: characterStream delta: 1! Item was removed: - ----- Method: ParagraphEditor>>initialText (in category 'accessing') ----- - initialText - ^ initialText! Item was removed: - ----- Method: ParagraphEditor>>initializeSelection (in category 'current selection') ----- - initializeSelection - "Do the initial activity when starting up the receiver. For example, in the - ParagraphEditor highlight the current selection." - - self select! Item was removed: - ----- Method: ParagraphEditor>>insertAndSelect:at: (in category 'new selection') ----- - insertAndSelect: aString at: anInteger - - self replace: (anInteger to: anInteger - 1) - with: (Text string: (' ' , aString) - attributes: emphasisHere) - and: [self selectAndScroll]! Item was removed: - ----- Method: ParagraphEditor>>insertTypeAhead: (in category 'typing support') ----- - insertTypeAhead: typeAhead - typeAhead position = 0 ifFalse: - [self zapSelectionWith: (Text string: typeAhead contents emphasis: emphasisHere). - typeAhead reset. - self unselect]! Item was removed: - ----- Method: ParagraphEditor>>inspectIt (in category 'do-its') ----- - inspectIt - self evaluateSelectionAndDo: [:result | ToolSet inspect: result]. - ! Item was removed: - ----- Method: ParagraphEditor>>inspectIt: (in category 'editing keys') ----- - inspectIt: characterStream - "Inspect the selection -- invoked via cmd-i. If there is no current selection, use the current line. 1/17/96 sw - 2/29/96 sw: don't call selectLine; it's done by inspectIt now" - - sensor keyboard. "flush character" - self terminateAndInitializeAround: [self inspectIt]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>isDisjointFrom: (in category 'private') ----- - isDisjointFrom: anInterval - "Answer true if anInterval is a caret not touching or within the current - interval, or if anInterval is a non-caret that does not overlap the current - selection." - - | fudge | - fudge := anInterval size = 0 ifTrue: [1] ifFalse: [0]. - ^(anInterval last + fudge < self startIndex or: - [anInterval first - fudge >= self stopIndex]) - ! Item was removed: - ----- Method: ParagraphEditor>>isDoing (in category 'undo support') ----- - isDoing - "Call from a doer/undoer/redoer any time to see which it is." - - ^(self isUndoing | self isRedoing) not! Item was removed: - ----- Method: ParagraphEditor>>isRedoing (in category 'undo support') ----- - isRedoing - "Call from a doer/undoer/redoer any time to see which it is." - - ^UndoParagraph == #redoing! Item was removed: - ----- Method: ParagraphEditor>>isUndoing (in category 'undo support') ----- - isUndoing - "Call from a doer/undoer/redoer any time to see which it is." - - ^UndoParagraph == #undoing! Item was removed: - ----- Method: ParagraphEditor>>lineSelectAndEmptyCheck: (in category 'menu messages') ----- - lineSelectAndEmptyCheck: returnBlock - "If the current selection is an insertion point, expand it to be the entire current line; if after that's done the selection is still empty, then evaluate the returnBlock, which will typically consist of '[^ self]' in the caller -- check senders of this method to understand this." - - self hasSelection ifFalse: [ - self selectLine. - self hasSelection ifFalse: [ - self flash. - ^ returnBlock value]].! Item was removed: - ----- Method: ParagraphEditor>>lines (in category 'private') ----- - lines - "Other than my member paragraph i compute lines based on logical - line breaks, not optical (which may change due to line wrapping of the editor)" - | lines string lineIndex | - string := paragraph text string. - "Empty strings have no lines at all. Think of something." - string isEmpty ifTrue:[^{#(1 0 0)}]. - lines := OrderedCollection new: (string size // 15). - lineIndex := 0. - string lineIndicesDo: [:start :endWithoutDelimiters :end | - lines addLast: {start. (lineIndex := lineIndex + 1). end}]. - "Special workaround for last line empty." - (string last == Character cr or: [string last == Character lf]) - ifTrue: [lines addLast: {string size + 1. lineIndex + 1. string size}]. - ^lines! Item was removed: - ----- Method: ParagraphEditor>>makeCapitalized: (in category 'editing keys') ----- - makeCapitalized: characterStream - "Force the current selection to be capitalized. Triggered by Cmd-Z." - | prev | - sensor keyboard. "Flush the triggering cmd-key character" - prev := $-. "not a letter" - self replaceSelectionWith: (Text fromString: - (self selection string collect: - [:c | prev := prev isLetter ifTrue: [c asLowercase] ifFalse: [c asUppercase]])). - ^ true! Item was removed: - ----- Method: ParagraphEditor>>makeLowercase: (in category 'editing keys') ----- - makeLowercase: characterStream - "Force the current selection to lowercase. Triggered by Cmd-X." - - sensor keyboard. "flush the triggering cmd-key character" - self replaceSelectionWith: (Text fromString: (self selection string asLowercase)). - ^ true! Item was removed: - ----- Method: ParagraphEditor>>makeProjectLink (in category 'menu messages') ----- - makeProjectLink - - | attribute thisSel | - - thisSel := self selection. - - attribute := TextSqkProjectLink new. - thisSel := attribute analyze: self selection asString. - - thisSel ifNil: [^ true]. - self replaceSelectionWith: (thisSel asText addAttribute: attribute). - ^ true! Item was removed: - ----- Method: ParagraphEditor>>makeProjectLink: (in category 'editing keys') ----- - makeProjectLink: characterStream - "" - - | attribute oldAttributes thisSel | - - sensor keyboard. - oldAttributes := paragraph text attributesAt: self pointIndex forStyle: paragraph textStyle. - thisSel := self selection. - - attribute := TextSqkProjectLink new. - thisSel := attribute analyze: self selection asString. - - thisSel ifNil: [^ true]. - beginTypeInBlock ~~ nil - ifTrue: "only change emphasisHere while typing" - [self insertTypeAhead: characterStream. - emphasisHere := Text addAttribute: attribute toArray: oldAttributes. - ^ true]. - self replaceSelectionWith: (thisSel asText addAttribute: attribute). - ^ true! Item was removed: - ----- Method: ParagraphEditor>>makeUppercase: (in category 'editing keys') ----- - makeUppercase: characterStream - "Force the current selection to uppercase. Triggered by Cmd-Y." - - sensor keyboard. "flush the triggering cmd-key character" - self replaceSelectionWith: (Text fromString: (self selection string asUppercase)). - ^ true! Item was removed: - ----- Method: ParagraphEditor>>mark (in category 'accessing-selection') ----- - mark - ^ self markBlock stringIndex! Item was removed: - ----- Method: ParagraphEditor>>markBlock (in category 'accessing-selection') ----- - markBlock - ^ stopBlock! Item was removed: - ----- Method: ParagraphEditor>>markBlock: (in category 'accessing-selection') ----- - markBlock: aCharacterBlock - stopBlock := aCharacterBlock. - ! Item was removed: - ----- Method: ParagraphEditor>>markIndex (in category 'accessing-selection') ----- - markIndex - ^ self markBlock stringIndex! Item was removed: - ----- Method: ParagraphEditor>>markerDelta (in category 'scrolling') ----- - markerDelta - - ^marker top - scrollBar top - ((paragraph clippingRectangle top - - paragraph compositionRectangle top) asFloat / - (self scrollRectangleHeight max: 1) asFloat * - scrollBar height asFloat) rounded! Item was removed: - ----- Method: ParagraphEditor>>methodNamesContainingIt (in category 'menu messages') ----- - methodNamesContainingIt - "Open a browser on methods names containing the selected string" - - self lineSelectAndEmptyCheck: [^ self]. - Cursor wait showWhile: - [self terminateAndInitializeAround: [self systemNavigation browseMethodsWhoseNamesContain: self selection string withBlanksTrimmed]]. - Cursor normal show! Item was removed: - ----- Method: ParagraphEditor>>methodNamesContainingIt: (in category 'editing keys') ----- - methodNamesContainingIt: characterStream - "Browse methods whose selectors containing the selection in their names" - - sensor keyboard. "flush character" - self methodNamesContainingIt. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>methodSourceContainingIt (in category 'menu messages') ----- - methodSourceContainingIt - "Open a browser on methods which contain the current selection in their source (case-sensitive full-text search of source). Slow!!" - - self lineSelectAndEmptyCheck: [^ self]. - self systemNavigation browseMethodsWithSourceString: self selection string! Item was removed: - ----- Method: ParagraphEditor>>methodStringsContainingIt: (in category 'editing keys') ----- - methodStringsContainingIt: characterStream - "Invoked from cmd-E -- open a browser on all methods holding string constants containing it. Flushes typeahead. " - - sensor keyboard. - self methodStringsContainingit. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>methodStringsContainingit (in category 'menu messages') ----- - methodStringsContainingit - "Open a browser on methods which contain the current selection as part of a string constant." - - self lineSelectAndEmptyCheck: [^ self]. - self terminateAndInitializeAround: [self systemNavigation browseMethodsWithString: self selection string]! Item was removed: - ----- Method: ParagraphEditor>>moveCursor:forward:specialBlock: (in category 'private') ----- - moveCursor: directionBlock forward: forward specialBlock: specialBlock - "Private - Move cursor. - directionBlock is a one argument Block that computes the new Position from a given one. - specialBlock is a one argumentBlock that computes the new position from a given one under the alternate semantics. - Note that directionBlock always is evaluated first." - | shift indices newPosition | - shift := sensor leftShiftDown. - indices := self setIndices: shift forward: forward. - newPosition := directionBlock value: (indices at: #moving). - (sensor commandKeyPressed or:[sensor controlKeyPressed]) - ifTrue: [newPosition := specialBlock value: newPosition]. - sensor keyboard. - shift - ifTrue: [self selectMark: (indices at: #fixed) point: newPosition - 1] - ifFalse: [self selectAt: newPosition]! Item was removed: - ----- Method: ParagraphEditor>>mvcRedisplay (in category 'menu messages') ----- - mvcRedisplay - "Overridable by subclasses that do their own display" - Display fill: paragraph clippingRectangle - fillColor: view backgroundColor. "very brute force" - self display! Item was removed: - ----- Method: ParagraphEditor>>nextTokenFrom:direction: (in category 'new selection') ----- - nextTokenFrom: start direction: dir - "simple token-finder for compiler automated corrections" - | loc str | - loc := start + dir. - str := paragraph text string. - [(loc between: 1 and: str size) and: [(str at: loc) isSeparator]] - whileTrue: [loc := loc + dir]. - ^ loc! Item was removed: - ----- Method: ParagraphEditor>>nextWord: (in category 'private') ----- - nextWord: position - | string index | - string := paragraph text string. - index := position. - [(index between: 1 and: string size) and: [(string at: index) isAlphaNumeric]] - whileTrue: [index := index + 1]. - [(index between: 1 and: string size) and: [(string at: index) isAlphaNumeric not]] - whileTrue: [index := index + 1]. - ^ index! Item was removed: - ----- Method: ParagraphEditor>>noUndoer (in category 'undo support') ----- - noUndoer - "The Undoer to use when the command can not be undone. Checked for - specially by readKeyboard." - - UndoMessage := Message selector: #noUndoer! Item was removed: - ----- Method: ParagraphEditor>>noop: (in category 'editing keys') ----- - noop: characterStream - "Unimplemented keyboard command; just ignore it." - - sensor keyboard. "flush character" - ^ true - ! Item was removed: - ----- Method: ParagraphEditor>>normalActivity (in category 'controlling') ----- - normalActivity - self processKeyboard. - self processMouseButtons. - super normalActivity. - ! Item was removed: - ----- Method: ParagraphEditor>>normalCharacter: (in category 'typing/selecting keys') ----- - normalCharacter: characterStream - "A nonspecial character is to be added to the stream of characters." - - characterStream nextPut: sensor keyboard. - ^false! Item was removed: - ----- Method: ParagraphEditor>>notify:at:in: (in category 'new selection') ----- - notify: aString at: anInteger in: aStream - "The compilation of text failed. The syntax error is noted as the argument, - aString. Insert it in the text at starting character position anInteger." - - self insertAndSelect: aString at: (anInteger max: 1)! Item was removed: - ----- Method: ParagraphEditor>>nullText (in category 'private') ----- - nullText - - ^Text string: '' emphasis: emphasisHere! Item was removed: - ----- Method: ParagraphEditor>>objectsReferencingIt (in category 'do-its') ----- - objectsReferencingIt - "Open a list inspector on all objects that reference the object that results when the current selection is evaluated. " - - self terminateAndInitializeAround: - [self evaluateSelectionAndDo: [:result | - self systemNavigation - browseAllObjectReferencesTo: result - except: #() - ifNone: [:obj | view topView flash]]]! Item was removed: - ----- Method: ParagraphEditor>>offerFontMenu (in category 'editing keys') ----- - offerFontMenu - "Present a menu of available fonts, and if one is chosen, apply it to the current selection. - Use only names of Fonts of this paragraph " - - | aList reply | - aList := paragraph textStyle fontNamesWithPointSizes. - reply := (SelectionMenu labelList: aList selections: aList) startUp. - reply ~~ nil ifTrue: - [self replaceSelectionWith: - (Text string: self selection asString - attribute: (TextFontChange fontNumber: (aList indexOf: reply)))] ! Item was removed: - ----- Method: ParagraphEditor>>offerFontMenu: (in category 'editing keys') ----- - offerFontMenu: characterStream - "The user typed the command key that requests a font change; Offer the font menu. 5/27/96 sw - Keeps typeahead. (?? should flush?)" - - sensor keyboard. "flush character" - self closeTypeIn: characterStream. - self offerFontMenu. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>offerMenuFromEsc: (in category 'menu messages') ----- - offerMenuFromEsc: aStream - sensor keyboard. " consume the character " - self yellowButtonActivity. - ^true "tell the caller that the character was processed "! Item was removed: - ----- Method: ParagraphEditor>>openTypeIn (in category 'typing support') ----- - openTypeIn - "Set up UndoSelection to null text (to be added to by readKeyboard and backTo:), - beginTypeInBlock to keep track of the leftmost backspace, and UndoParameter to tally - how many deleted characters were backspaced over rather than 'cut'. - You can't undo typing until after closeTypeIn." - - beginTypeInBlock == nil ifTrue: - [UndoSelection := self nullText. - self undoer: #noUndoer with: 0. - beginTypeInBlock := self startIndex]! Item was removed: - ----- Method: ParagraphEditor>>outdent: (in category 'editing keys') ----- - outdent: characterStream - "Remove a tab from the front of every line occupied by the selection. Flushes typeahead. Invoked from keyboard via cmd-shift-L. 2/29/96 sw" - - ^ self inOutdent: characterStream delta: -1! Item was removed: - ----- Method: ParagraphEditor>>pageHeight (in category 'private') ----- - pageHeight - | howManyLines visibleHeight totalHeight ratio | - howManyLines := paragraph numberOfLines. - visibleHeight := self visibleHeight. - totalHeight := self totalTextHeight. - ratio := visibleHeight / totalHeight. - ^(ratio * howManyLines) rounded - 2! Item was removed: - ----- Method: ParagraphEditor>>paste (in category 'menu messages') ----- - paste - "Paste the text from the shared buffer over the current selection and - redisplay if necessary. Undoer & Redoer: undoAndReselect." - - self replace: self selectionInterval with: self clipboardText and: - [self selectAt: self pointIndex]! Item was removed: - ----- Method: ParagraphEditor>>paste: (in category 'editing keys') ----- - paste: characterStream - "Replace the current text selection by the text in the shared buffer. - Keeps typeahead." - - sensor keyboard. "flush character" - self closeTypeIn: characterStream. - self paste. - ^true! Item was removed: - ----- Method: ParagraphEditor>>pasteInitials: (in category 'editing keys') ----- - pasteInitials: characterStream - "Replace the current text selection by an authorship name/date stamp; invoked by cmd-shift-v, easy way to put an authorship stamp in the comments of an editor. - Keeps typeahead." - - sensor keyboard. "flush character" - self closeTypeIn: characterStream. - self replace: self selectionInterval with: (Text fromString: Utilities changeStamp) and: [self selectAt: self stopIndex]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>pasteRecent (in category 'menu messages') ----- - pasteRecent - "Paste an item chose from RecentClippings." - - | clipping | - (clipping := Clipboard chooseRecentClipping) ifNil: [^ self]. - Clipboard clipboardText: clipping. - ^ self paste! Item was removed: - ----- Method: ParagraphEditor>>performMenuMessage: (in category 'menu messages') ----- - performMenuMessage: aSelector - "If a menu command is invoked, typeIn must be closed first, the selection - must be unhighlighted before and rehighlighted after, and the marker - must be updated." - - self closeTypeIn. - self deselect. - super performMenuMessage: aSelector. - self selectAndScroll. - self updateMarker! Item was removed: - ----- Method: ParagraphEditor>>pointBlock (in category 'accessing-selection') ----- - pointBlock - ^ startBlock! Item was removed: - ----- Method: ParagraphEditor>>pointBlock: (in category 'accessing-selection') ----- - pointBlock: aCharacterBlock - startBlock := aCharacterBlock. - ! Item was removed: - ----- Method: ParagraphEditor>>pointIndex (in category 'accessing-selection') ----- - pointIndex - ^ self pointBlock stringIndex! Item was removed: - ----- Method: ParagraphEditor>>presentSpecialMenu (in category 'menu messages') ----- - presentSpecialMenu - "Present a list of expressions, and if the user chooses one, evaluate it in the context of the receiver, a ParagraphEditor. Primarily for debugging, this provides a convenient way to talk to the various views, controllers, and models associated with any text pane" - - self terminateAndInitializeAround: - [| reply items | - reply := (UIManager default chooseFrom: (items := self specialMenuItems) lines: #()). - reply = 0 ifTrue: [^ self]. - Compiler new evaluate: (items at: reply) in: [] to: self] - ! Item was removed: - ----- Method: ParagraphEditor>>prettyPrint (in category 'menu messages') ----- - prettyPrint - self prettyPrint: false! Item was removed: - ----- Method: ParagraphEditor>>prettyPrint: (in category 'menu messages') ----- - prettyPrint: decorated - "Reformat the contents of the receiver's view (a Browser)." - - | selectedClass newText | - model selectedMessageCategoryName ifNil: [^ view flash]. - selectedClass := model selectedClassOrMetaClass. - newText := selectedClass prettyPrinterClass - format: self text - in: selectedClass - notifying: self - decorated: decorated. - newText ifNotNil: - [self deselect; selectInvisiblyFrom: 1 to: paragraph text size. - self replaceSelectionWith: (newText asText makeSelectorBoldIn: selectedClass). - self selectAt: 1]! Item was removed: - ----- Method: ParagraphEditor>>prettyPrintWithColor (in category 'menu messages') ----- - prettyPrintWithColor - self prettyPrint: true! Item was removed: - ----- Method: ParagraphEditor>>previousWord: (in category 'private') ----- - previousWord: position - | string index | - string := paragraph text string. - index := position. - [(index between: 1 and: string size) and: [(string at: index) isAlphaNumeric not]] - whileTrue: [index := index - 1]. - [(index between: 1 and: string size) and: [(string at: index) isAlphaNumeric]] - whileTrue: [index := index - 1]. - ^ index + 1! Item was removed: - ----- Method: ParagraphEditor>>printIt (in category 'do-its') ----- - printIt - "Treat the current text selection as an expression; evaluate it. Insert the - description of the result of evaluation after the selection and then make - this description the new text selection." - self evaluateSelectionAndDo: [:result | - self afterSelectionInsertAndSelect: result printString]! Item was removed: - ----- Method: ParagraphEditor>>printIt: (in category 'editing keys') ----- - printIt: characterStream - "Print the results of evaluting the selection -- invoked via cmd-p. If there is no current selection, use the current line. 1/17/96 sw - 2/29/96 sw: don't call selectLine now, since it's called by doIt" - - sensor keyboard. "flush character" - self terminateAndInitializeAround: [self printIt]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>printerSetup (in category 'menu messages') ----- - printerSetup - - TextPrinter defaultTextPrinter inspect - ! Item was removed: - ----- Method: ParagraphEditor>>processBlueButton (in category 'sensor access') ----- - processBlueButton - "The user pressed the blue button on the mouse. Determine what action - to take." - - ^self! Item was removed: - ----- Method: ParagraphEditor>>processKeyboard (in category 'sensor access') ----- - processKeyboard - "Determine whether the user pressed the keyboard. If so, read the keys." - - sensor keyboardPressed ifTrue: [self readKeyboard]! Item was removed: - ----- Method: ParagraphEditor>>processMouseButtons (in category 'sensor access') ----- - processMouseButtons - "Determine whether the user pressed any mouse button. For each possible - button, determine what actions to take." - - sensor redButtonPressed ifTrue: [self processRedButton]. - sensor yellowButtonPressed ifTrue: [self processYellowButton]. - sensor blueButtonPressed ifTrue: [self processBlueButton]! Item was removed: - ----- Method: ParagraphEditor>>processRedButton (in category 'sensor access') ----- - processRedButton - "The user pressed a red mouse button, meaning create a new text - selection. Highlighting the selection is carried out by the paragraph - itself. Double clicking causes a selection of the area between the nearest - enclosing delimitors." - - | selectionBlocks clickPoint oldDelta oldInterval previousMarkBlock previousPointBlock | - - clickPoint := sensor cursorPoint. - (view containsPoint: clickPoint) ifFalse: [^ self]. - (paragraph clickAt: clickPoint for: model controller: self) ifTrue: [^ self]. - oldInterval := self selectionInterval. - previousMarkBlock := self markBlock. - previousPointBlock := self pointBlock. - oldDelta := paragraph scrollDelta. - sensor leftShiftDown - ifFalse: - [self deselect. - self closeTypeIn. - selectionBlocks := paragraph mouseSelect: clickPoint] - ifTrue: - [selectionBlocks := paragraph extendSelectionMark: self markBlock pointBlock: self pointBlock. - self closeTypeIn]. - selectionShowing := true. - self markBlock: (selectionBlocks at: 1). - self pointBlock: (selectionBlocks at: 2). - (self hasCaret - and: [previousMarkBlock = self markBlock and: [previousPointBlock = self pointBlock]]) - ifTrue: [self selectWord]. - oldDelta ~= paragraph scrollDelta "case of autoscroll" - ifTrue: [self updateMarker]. - self setEmphasisHere. - (self isDisjointFrom: oldInterval) ifTrue: - [otherInterval := oldInterval]! Item was removed: - ----- Method: ParagraphEditor>>processYellowButton (in category 'sensor access') ----- - processYellowButton - "User pressed the yellow button on the mouse. Determine what actions to - take." - - self yellowButtonActivity! Item was removed: - ----- Method: ParagraphEditor>>querySymbol: (in category 'typing/selecting keys') ----- - querySymbol: characterStream - "Invoked by Ctrl-q to query the Symbol table and display alternate symbols. - See comment in completeSymbol:lastOffering: for details." - - sensor keyboard. "flush character" - self closeTypeIn: characterStream. "keep typeahead" - self hasCaret - ifTrue: "Ctrl-q typed when a caret" - [self perform: #completeSymbol:lastOffering: withArguments: - ((UndoParagraph == paragraph and: [UndoMessage sends: #undoQuery:lastOffering:]) - ifTrue: [UndoMessage arguments] "repeated Ctrl-q" - ifFalse: [Array with: nil with: nil])] "initial Ctrl-q" - ifFalse: "Ctrl-q typed when statements were highlighted" - [view flash]. - ^true! Item was removed: - ----- Method: ParagraphEditor>>raiseContextMenu: (in category 'nonediting/nontyping keys') ----- - raiseContextMenu: characterStream - "AFAIK, this is never called in morphic, because a subclass overrides it. Which is good, because a ParagraphEditor doesn't know about Morphic and thus duplicates the text-editing actions that really belong in the specific application, not the controller. So the context menu this would raise is likely to be out of date." - self yellowButtonActivity. - ^true! Item was removed: - ----- Method: ParagraphEditor>>readKeyboard (in category 'typing support') ----- - readKeyboard - "Key struck on the keyboard. Find out which one and, if special, carry - out the associated special action. Otherwise, add the character to the - stream of characters. Undoer & Redoer: see closeTypeIn." - - | typeAhead char | - typeAhead := WriteStream on: (String new: 128). - [sensor keyboardPressed] whileTrue: - [self deselect. - sensor keyboardPressed ifTrue: - [char := sensor peekKeyboard. - (self dispatchOnCharacter: char with: typeAhead) ifTrue: - [self doneTyping. - self setEmphasisHere. - ^self selectAndScroll; updateMarker]. - self openTypeIn]. - self hasSelection ifTrue: "save highlighted characters" - [UndoSelection := self selection]. - self zapSelectionWithCompositionWith: typeAhead contents. - typeAhead reset. - self unselect. - sensor keyboardPressed ifFalse: - [self selectAndScroll. - sensor keyboardPressed - ifFalse: [self updateMarker]]]! Item was removed: - ----- Method: ParagraphEditor>>recomputeInterval (in category 'current selection') ----- - recomputeInterval - "The same characters are selected but their coordinates may have changed." - - self computeIntervalFrom: self mark to: self pointIndex - 1! Item was removed: - ----- Method: ParagraphEditor>>recomputeSelection (in category 'current selection') ----- - recomputeSelection - "Redetermine the selection according to the start and stop block indices; - do not highlight." - - self deselect; recomputeInterval! Item was removed: - ----- Method: ParagraphEditor>>referencesToIt (in category 'menu messages') ----- - referencesToIt - "Open a MessageSet with the references to the selected global or variable name." - - self wordSelectAndEmptyCheck: [^ self]. - self selectedInstanceVariable ifNotNil: - [:nameToClass | ^ self terminateAndInitializeAround: - [self systemNavigation - browseAllAccessesTo: nameToClass key - from: nameToClass value]]. - self selectedBinding ifNotNil: - [:binding | ^ self terminateAndInitializeAround: - [self systemNavigation browseAllCallsOnClass: binding]]. - view flash.! Item was removed: - ----- Method: ParagraphEditor>>referencesToIt: (in category 'editing keys') ----- - referencesToIt: characterStream - "Triggered by Cmd-N; browse references to the current selection" - - sensor keyboard. "flush character" - self referencesToIt. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>replace:with:and: (in category 'accessing') ----- - replace: oldInterval with: newText and: selectingBlock - "Replace the text in oldInterval with newText and execute selectingBlock to establish the new selection. Create an undoAndReselect:redoAndReselect: undoer to allow perfect undoing." - - | undoInterval | - undoInterval := self selectionInterval. - undoInterval = oldInterval ifFalse: [self selectInterval: oldInterval]. - UndoSelection := self selection. - self zapSelectionWith: newText. - selectingBlock value. - otherInterval := self selectionInterval. - self undoer: #undoAndReselect:redoAndReselect: with: undoInterval with: otherInterval! Item was removed: - ----- Method: ParagraphEditor>>replaceSelectionWith: (in category 'accessing') ----- - replaceSelectionWith: aText - "Remember the selection text in UndoSelection. - Deselect, and replace the selection text by aText. - Remember the resulting selectionInterval in UndoInterval and PriorInterval. - Set up undo to use UndoReplace." - - beginTypeInBlock ~~ nil ifTrue: [^self zapSelectionWith: aText]. "called from old code" - UndoSelection := self selection. - self zapSelectionWith: aText. - self undoer: #undoReplace! Item was removed: - ----- Method: ParagraphEditor>>resetState (in category 'initialize-release') ----- - resetState - "Establish the initial conditions for editing the paragraph: place caret - before first character, set the emphasis to that of the first character, - and save the paragraph for purposes of canceling." - - stopBlock := paragraph defaultCharacterBlock. - self pointBlock: stopBlock copy. - beginTypeInBlock := nil. - UndoInterval := otherInterval := 1 to: 0. - self setEmphasisHere. - selectionShowing := false. - initialText := paragraph text copy! Item was removed: - ----- Method: ParagraphEditor>>reverseSelection (in category 'current selection') ----- - reverseSelection - "Reverse the valence of the current selection highlighting." - selectionShowing := selectionShowing not. - paragraph reverseFrom: self pointBlock to: self markBlock! Item was removed: - ----- Method: ParagraphEditor>>sameColumn:newLine:forward: (in category 'private') ----- - sameColumn: start newLine: lineBlock forward: isForward - "Private - Compute the index in my text - with the line number derived from lineBlock," - " a one argument block accepting the old line number. - The position inside the line will be preserved as good as possible" - "The boolean isForward is used in the border case to determine if - we should move to the beginning or the end of the line." - | wordStyle column currentLine offsetAtTargetLine targetEOL lines numberOfLines currentLineNumber targetLineNumber | - wordStyle := Preferences wordStyleCursorMovement. - wordStyle - ifTrue: [ - lines := paragraph lines. - numberOfLines := paragraph numberOfLines. - currentLineNumber := paragraph lineIndexOfCharacterIndex: start. - currentLine := lines at: currentLineNumber] - ifFalse: [ - lines := self lines. - numberOfLines := lines size. - currentLine := lines - detect:[:lineInterval | lineInterval last >= start] - ifNone:[lines last]. - currentLineNumber := currentLine second]. - column := start - currentLine first. - targetLineNumber := ((lineBlock value: currentLineNumber) max: 1) min: numberOfLines. - offsetAtTargetLine := (lines at: targetLineNumber) first. - targetEOL := (lines at: targetLineNumber) last + (targetLineNumber = numberOfLines ifTrue:[1]ifFalse:[0]). - targetLineNumber = currentLineNumber - "No movement or movement failed. Move to beginning or end of line." - ifTrue:[^isForward - ifTrue:[targetEOL] - ifFalse:[offsetAtTargetLine]]. - ^offsetAtTargetLine + column min: targetEOL.! Item was removed: - ----- Method: ParagraphEditor>>save: (in category 'editing keys') ----- - save: characterStream - "Submit the current text. Equivalent to 'accept' 1/18/96 sw - Keeps typeahead." - - sensor keyboard. "flush character" - self closeTypeIn: characterStream. - self terminateAndInitializeAround: [self accept]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>scrollAmount (in category 'scrolling') ----- - scrollAmount - "Refer to the comment in ScrollController|scrollAmount." - - ^sensor cursorPoint y - scrollBar top! Item was removed: - ----- Method: ParagraphEditor>>scrollBar (in category 'scrolling') ----- - scrollBar - ^ scrollBar! Item was removed: - ----- Method: ParagraphEditor>>scrollBy: (in category 'scrolling') ----- - scrollBy: heightToMove - "Move the paragraph by heightToMove, and reset the text selection." - ^ paragraph scrollBy: heightToMove withSelectionFrom: self pointBlock to: self markBlock! Item was removed: - ----- Method: ParagraphEditor>>scrollRectangleHeight (in category 'scrolling') ----- - scrollRectangleHeight - - ^paragraph compositionRectangle height - + paragraph lineGrid! Item was removed: - ----- Method: ParagraphEditor>>scrollToBottom (in category 'scrolling') ----- - scrollToBottom - "Scroll so that the tail end of the text is visible in the view. 5/6/96 sw" - - self scrollView: (paragraph clippingRectangle bottom - - paragraph compositionRectangle bottom)! Item was removed: - ----- Method: ParagraphEditor>>scrollToTop (in category 'scrolling') ----- - scrollToTop - "Scroll so that the paragraph is at the top of the view." - - self scrollView: (paragraph clippingRectangle top - - paragraph compositionRectangle top)! Item was removed: - ----- Method: ParagraphEditor>>scrollView: (in category 'scrolling') ----- - scrollView: anInteger - "Paragraph scrolling uses opposite polarity" - ^ self scrollBy: anInteger negated! Item was removed: - ----- Method: ParagraphEditor>>search: (in category 'typing/selecting keys') ----- - search: characterStream - "Invoked by Ctrl-S. Same as 'again', but always uses the existing FindText - and ChangeText regardless of the last edit." - - sensor keyboard. "flush character" - self closeTypeIn: characterStream. - self againOrSame: true. "true means use same keys" - ^true! Item was removed: - ----- Method: ParagraphEditor>>select (in category 'current selection') ----- - select - "If the text selection is visible on the screen, highlight it." - - selectionShowing ifFalse: [self reverseSelection]! Item was removed: - ----- Method: ParagraphEditor>>selectAll (in category 'typing/selecting keys') ----- - selectAll - "Make the selection be all the characters of the receiver" - - self selectFrom: 1 to: paragraph text string size! Item was removed: - ----- Method: ParagraphEditor>>selectAll: (in category 'typing/selecting keys') ----- - selectAll: characterStream - "select everything, invoked by cmd-a. 1/17/96 sw" - - sensor keyboard. "flush character" - self closeTypeIn: characterStream. - self selectFrom: 1 to: paragraph text string size. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>selectAndScroll (in category 'current selection') ----- - selectAndScroll - "Scroll until the selection is in the view and then highlight it." - | lineHeight deltaY clippingRectangle endBlock | - self select. - endBlock := self stopBlock. - lineHeight := paragraph textStyle lineGrid. - clippingRectangle := paragraph clippingRectangle. - deltaY := endBlock top - clippingRectangle top. - deltaY >= 0 - ifTrue: [deltaY := endBlock bottom - clippingRectangle bottom max: 0]. - "check if stopIndex below bottom of clippingRectangle" - deltaY ~= 0 - ifTrue: [self scrollBy: (deltaY abs + lineHeight - 1 truncateTo: lineHeight) - * deltaY sign]! Item was removed: - ----- Method: ParagraphEditor>>selectAndScrollToTop (in category 'current selection') ----- - selectAndScrollToTop - "Scroll until the selection is in the view and then highlight it." - | lineHeight deltaY clippingRectangle | - self select. - lineHeight := paragraph textStyle lineGrid. - clippingRectangle := paragraph clippingRectangle. - deltaY := self stopBlock top - clippingRectangle top. - deltaY ~= 0 - ifTrue: [self scrollBy: (deltaY abs + lineHeight - 1 truncateTo: lineHeight) - * deltaY sign]! Item was removed: - ----- Method: ParagraphEditor>>selectAt: (in category 'new selection') ----- - selectAt: characterIndex - "Deselect, then place the caret before the character at characterIndex. - Be sure it is in view." - - self selectFrom: characterIndex to: characterIndex - 1! Item was removed: - ----- Method: ParagraphEditor>>selectCurrentTypeIn: (in category 'nonediting/nontyping keys') ----- - selectCurrentTypeIn: characterStream - "Select what would be replaced by an undo (e.g., the last typeIn)." - - | prior | - - self closeTypeIn: characterStream. - prior := otherInterval. - sensor keyboard. "flush character" - self closeTypeIn: characterStream. - self selectInterval: UndoInterval. - otherInterval := prior. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>selectFrom:to: (in category 'new selection') ----- - selectFrom: start to: stop - "Deselect, then select the specified characters inclusive. - Be sure the selection is in view." - - (start = self startIndex and: [stop + 1 = self stopIndex]) ifFalse: - [self deselect. - self selectInvisiblyFrom: start to: stop]. - self selectAndScroll! Item was removed: - ----- Method: ParagraphEditor>>selectInterval: (in category 'new selection') ----- - selectInterval: anInterval - "Deselect, then select the specified characters inclusive. - Be sure the selection is in view." - - self selectFrom: anInterval first to: anInterval last! Item was removed: - ----- Method: ParagraphEditor>>selectIntervalInvisibly: (in category 'new selection') ----- - selectIntervalInvisibly: anInterval - "Deselect, then select the specified characters inclusive. - Do not yet make the new selection visible." - - self deselect. - self selectInvisiblyFrom: anInterval first to: anInterval last! Item was removed: - ----- Method: ParagraphEditor>>selectInvisiblyFrom:to: (in category 'new selection') ----- - selectInvisiblyFrom: start to: stop - "Select the designated characters, inclusive. Make no visual changes." - - ^ self computeIntervalFrom: start to: stop! Item was removed: - ----- Method: ParagraphEditor>>selectInvisiblyMark:point: (in category 'new selection') ----- - selectInvisiblyMark: mark point: point - "Select the designated characters, inclusive. Make no visual changes." - - ^ self computeIntervalFrom: mark to: point! Item was removed: - ----- Method: ParagraphEditor>>selectLine (in category 'new selection') ----- - selectLine - "Make the receiver's selection, if it currently consists of an insertion point only, encompass the current line." - - self selectInterval: (self encompassLine: self selectionInterval)! Item was removed: - ----- Method: ParagraphEditor>>selectMark:point: (in category 'new selection') ----- - selectMark: mark point: point - "Deselect, then select the specified characters inclusive. - Be sure the selection is in view." - - (mark = self markIndex and: [point + 1 = self pointIndex]) ifFalse: - [self deselect. - self selectInvisiblyMark: mark point: point]. - self selectAndScroll! Item was removed: - ----- Method: ParagraphEditor>>selectPrecedingIdentifier (in category 'new selection') ----- - selectPrecedingIdentifier - "Invisibly select the identifier that ends at the end of the selection, if any." - - | string sep stop tok | - tok := false. - string := paragraph text string. - stop := self stopIndex - 1. - [stop > 0 and: [(string at: stop) isSeparator]] whileTrue: [stop := stop - 1]. - sep := stop. - [sep > 0 and: [(string at: sep) tokenish]] whileTrue: [tok := true. sep := sep - 1]. - tok ifTrue: [self selectInvisiblyFrom: sep + 1 to: stop]! Item was removed: - ----- Method: ParagraphEditor>>selectWord (in category 'new selection') ----- - selectWord - "Select delimited text or word--the result of double-clicking." - - | openDelimiter closeDelimiter direction match level leftDelimiters rightDelimiters - string here hereChar start stop | - string := paragraph text string. - here := self pointIndex. - (here between: 2 and: string size) - ifFalse: ["if at beginning or end, select entire string" - ^self selectFrom: 1 to: string size]. - leftDelimiters := '([{<|''" - '. - rightDelimiters := ')]}>|''" - '. - openDelimiter := string at: here - 1. - match := leftDelimiters indexOf: openDelimiter. - match > 0 - ifTrue: - ["delimiter is on left -- match to the right" - start := here. - direction := 1. - here := here - 1. - closeDelimiter := rightDelimiters at: match] - ifFalse: - [openDelimiter := string at: here. - match := rightDelimiters indexOf: openDelimiter. - match > 0 - ifTrue: - ["delimiter is on right -- match to the left" - stop := here - 1. - direction := -1. - closeDelimiter := leftDelimiters at: match] - ifFalse: ["no delimiters -- select a token" - direction := -1]]. - level := 1. - [level > 0 and: [direction > 0 - ifTrue: [here < string size] - ifFalse: [here > 1]]] - whileTrue: - [hereChar := string at: (here := here + direction). - match = 0 - ifTrue: ["token scan goes left, then right" - hereChar tokenish - ifTrue: [here = 1 - ifTrue: - [start := 1. - "go right if hit string start" - direction := 1]] - ifFalse: [direction < 0 - ifTrue: - [start := here + 1. - "go right if hit non-token" - direction := 1] - ifFalse: [level := 0]]] - ifFalse: ["bracket match just counts nesting level" - hereChar = closeDelimiter - ifTrue: [level := level - 1"leaving nest"] - ifFalse: [hereChar = openDelimiter - ifTrue: [level := level + 1"entering deeper nest"]]]]. - - level > 0 ifTrue: ["in case ran off string end" here := here + direction]. - direction > 0 - ifTrue: [self selectFrom: start to: here - 1] - ifFalse: [self selectFrom: here + 1 to: stop]! Item was removed: - ----- Method: ParagraphEditor>>selectWord: (in category 'nonediting/nontyping keys') ----- - selectWord: characterStream - sensor keyboard. - self closeTypeIn: characterStream. - self selectWord. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>selectedBinding (in category 'menu messages') ----- - selectedBinding - "Try to make a binding out of the current text selection. That binding can be a global or class." - - ^ self selectedSymbol ifNotNil: - [ :symbol | - ((model respondsTo: #selectedClassOrMetaClass) - ifTrue: [ model selectedClassOrMetaClass ifNil: [ model environment ] ] - ifFalse: [ model environment ]) ifNotNil: - [ :environment | environment bindingOf: symbol ] ]! Item was removed: - ----- Method: ParagraphEditor>>selectedClassVariable (in category 'menu messages') ----- - selectedClassVariable - "Try to make a class-variable binding out of the current text selection." - - (model respondsTo: #selectedClassOrMetaClass) ifFalse: [ ^ nil ]. - - ^ self selectedSymbol ifNotNil: - [ :symbol | model selectedClassOrMetaClass ifNotNil: - [ :classOrMetaClass | (classOrMetaClass theNonMetaClass allClassVarNames includes: symbol) - ifTrue: [ classOrMetaClass bindingOf: symbol ] - ifFalse: [ nil ] ] ]! Item was removed: - ----- Method: ParagraphEditor>>selectedInstanceVariable (in category 'menu messages') ----- - selectedInstanceVariable - "Try to make an association from an instance-variable name to the class where this variable is defined. Make the implementation robust for models that do not know about classes. - - Note that inst-var names might not have symbol a representation, only via their accessors." - - (model respondsTo: #selectedClassOrMetaClass) ifFalse: [ ^ nil ]. - - ^ self selection string ifNotNil: - [ :token | model selectedClassOrMetaClass ifNotNil: - [ :behavior | - (behavior instVarIndexFor: token ifAbsent: [ 0 ]) ~= 0 - ifTrue: [ token -> behavior ] - ifFalse: [ nil ] ] ]! Item was removed: - ----- Method: ParagraphEditor>>selectedLiteral (in category 'menu messages') ----- - selectedLiteral - "Try to make a Smalltalk literal out of the current text selection." - - ^ self selection string findLiteral! Item was removed: - ----- Method: ParagraphEditor>>selectedSelector (in category 'menu messages') ----- - selectedSelector - "Try to make a selector out of the current text selection" - ^self selection string findSelector! Item was removed: - ----- Method: ParagraphEditor>>selectedSymbol (in category 'menu messages') ----- - selectedSymbol - "Try to make a symbol out of the current text selection." - - ^ self selection string findSymbol! Item was removed: - ----- Method: ParagraphEditor>>selection (in category 'accessing-selection') ----- - selection - "Answer the text in the paragraph that is currently selected." - - | t | - t := paragraph text copyFrom: self startIndex to: self stopIndex - 1. - t string isOctetString ifTrue: [t asOctetStringText]. - ^ t. - ! Item was removed: - ----- Method: ParagraphEditor>>selectionAsStream (in category 'accessing-selection') ----- - selectionAsStream - "Answer a ReadStream on the text in the paragraph that is currently - selected." - - ^ReadStream - on: paragraph string - from: self startIndex - to: self stopIndex - 1! Item was removed: - ----- Method: ParagraphEditor>>selectionInterval (in category 'accessing-selection') ----- - selectionInterval - "Answer the interval that is currently selected." - - ^self startIndex to: self stopIndex - 1 ! Item was removed: - ----- Method: ParagraphEditor>>sendContentsToPrinter (in category 'menu messages') ----- - sendContentsToPrinter - | textToPrint printer parentWindow | - textToPrint := paragraph text. - textToPrint size == 0 ifTrue: [^self inform: 'nothing to print.' translated]. - printer := TextPrinter defaultTextPrinter. - parentWindow := self model dependents - detect: [:dep | dep isSystemWindow] - ifNone: [nil]. - parentWindow isNil - ifTrue: [printer documentTitle: 'Untitled'] - ifFalse: [printer documentTitle: parentWindow label]. - printer printText: textToPrint! Item was removed: - ----- Method: ParagraphEditor>>sendersOfIt (in category 'menu messages') ----- - sendersOfIt - "Open a senders browser on the selected selector" - - self lineSelectAndEmptyCheck: [^ self]. - self selectedSelector ifNotNil: - [:aSelector| ^ self terminateAndInitializeAround: - [self systemNavigation browseAllCallsOn: aSelector]]. - self selectedLiteral ifNotNil: - [:aLiteral| ^ self terminateAndInitializeAround: - [self systemNavigation browseAllCallsOn: aLiteral]]. - view flash! Item was removed: - ----- Method: ParagraphEditor>>sendersOfIt: (in category 'editing keys') ----- - sendersOfIt: characterStream - "Triggered by Cmd-n; browse implementors of the selector represented by the current selection, if plausible. 2/1/96 sw" - - sensor keyboard. "flush character" - self sendersOfIt. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>setAlignment: (in category 'menu messages') ----- - setAlignment: aSymbol - | attr interval | - attr := TextAlignment perform: aSymbol. - interval := self encompassLine: self selectionInterval. - paragraph replaceFrom: interval first to: interval last with: - ((paragraph text copyFrom: interval first to: interval last) addAttribute: attr) displaying: true. - ! Item was removed: - ----- Method: ParagraphEditor>>setEmphasis: (in category 'editing keys') ----- - setEmphasis: emphasisSymbol - "Change the emphasis of the current selection." - - | oldAttributes attribute | - oldAttributes := paragraph text attributesAt: self selectionInterval first forStyle: paragraph textStyle. - - attribute := TextEmphasis perform: emphasisSymbol. - (emphasisSymbol == #normal) - ifFalse: [oldAttributes do: - [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]]. - self replaceSelectionWith: (self selection addAttribute: attribute)! Item was removed: - ----- Method: ParagraphEditor>>setEmphasisHere (in category 'typing support') ----- - setEmphasisHere - - emphasisHere := (paragraph text attributesAt: (self pointIndex - 1 max: 1) forStyle: paragraph textStyle) - select: [:att | att mayBeExtended]! Item was removed: - ----- Method: ParagraphEditor>>setIndices:forward: (in category 'private') ----- - setIndices: shiftPressed forward: forward - "Little helper method that sets the moving and fixed indices according to some flags." - | indices | - indices := Dictionary new. - shiftPressed ifTrue: [ - indices at: #moving put: self pointIndex. - indices at: #fixed put: self markIndex - ] ifFalse: [ - forward - ifTrue:[ - indices at: #moving put: self stopIndex. - indices at: #fixed put: self startIndex. - ] ifFalse: [ - indices at: #moving put: self startIndex. - indices at: #fixed put: self stopIndex. - ] - ]. - ^indices! Item was removed: - ----- Method: ParagraphEditor>>setMark: (in category 'accessing-selection') ----- - setMark: anIndex - self markBlock: (paragraph characterBlockForIndex: anIndex) - ! Item was removed: - ----- Method: ParagraphEditor>>setPoint: (in category 'accessing-selection') ----- - setPoint: anIndex - self pointBlock: (paragraph characterBlockForIndex: anIndex) - ! Item was removed: - ----- Method: ParagraphEditor>>setSearch: (in category 'accessing') ----- - setSearch: aString - "Set the FindText and ChangeText to seek aString; except if already seeking aString, leave ChangeText alone so again will repeat last replacement." - - FindText string = aString - ifFalse: [FindText := ChangeText := aString asText]! Item was removed: - ----- Method: ParagraphEditor>>setSearchString (in category 'menu messages') ----- - setSearchString - "Make the current selection, if any, be the current search string." - self hasCaret ifTrue: [view flash. ^ self]. - self setSearch: self selection string! Item was removed: - ----- Method: ParagraphEditor>>setSearchString: (in category 'nonediting/nontyping keys') ----- - setSearchString: characterStream - "Establish the current selection as the current search string." - - | aString | - self closeTypeIn: characterStream. - sensor keyboard. - self lineSelectAndEmptyCheck: [^ true]. - aString := self selection string. - aString size = 0 - ifTrue: - [self flash] - ifFalse: - [self setSearch: aString]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>simulatedBackspace (in category 'typing/selecting keys') ----- - simulatedBackspace - "Backspace over the last character, derived from hand-char recognition. 2/5/96 sw" - - | startIndex | - startIndex := self markIndex + (self hasSelection ifTrue: [1] ifFalse: [0]). - - startIndex := 1 max: startIndex - 1. - self backTo: startIndex. - ^ false! Item was removed: - ----- Method: ParagraphEditor>>simulatedKeystroke: (in category 'typing support') ----- - simulatedKeystroke: char - "Accept char as if it were struck on the keyboard. This version does not yet deal with command keys, and achieves update in the receiver's typically inactive window via the sledge-hammer of uncache-bits." - - self deselect. - self openTypeIn. - self markBlock = self pointBlock ifFalse: [UndoSelection := self selection]. - self zapSelectionWith: - (Text string: char asString emphasis: emphasisHere). - self userHasEdited. - self unselect. - self selectAndScroll. - self updateMarker. - view ifNotNil: - [view topView uncacheBits - "in mvc, this makes sure the recognized character shows up in the pane right now; in morphic, a different mechanism is used for the same effect -- see TextMorphEditor method #recognizeCharactersWhileMouseIn:"] - ! Item was removed: - ----- Method: ParagraphEditor>>spawn (in category 'menu messages') ----- - spawn - "Create and schedule a message browser for the code of the model's - selected message. Retain any edits that have not yet been accepted." - | code | - code := paragraph text string. - self cancel. - model notNil ifTrue:[model spawn: code]. - ! Item was removed: - ----- Method: ParagraphEditor>>spawnIt: (in category 'editing keys') ----- - spawnIt: characterStream - "Triggered by Cmd-o; spawn a new code window, if it makes sense." - - sensor keyboard. - self terminateAndInitializeAround: [self spawn]. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>spawnWorkspace (in category 'menu messages') ----- - spawnWorkspace - | toUse | - self selectLine. - toUse := self selection asString. - toUse size > 0 ifFalse: - [toUse := paragraph text string. - toUse size > 0 ifFalse: [^ self flash]]. - "NB: BrowserCodeController's version does a cancel here" - self terminateAndInitializeAround: - [Utilities openScratchWorkspaceLabeled: 'Untitled' contents: toUse]! Item was removed: - ----- Method: ParagraphEditor>>specialMenuItems (in category 'menu messages') ----- - specialMenuItems - "Refer to comment under #presentSpecialMenu. . - : added objectsReferencingIt," - - ^ #( 'Transcript cr; show: ''testing''' - 'view superView model inspect' - 'view superView model browseObjClass' - 'view display' - 'self inspect' - 'view backgroundColor: Color fromUser' - 'view topView inspect' - 'self compareToClipboard' - 'view insideColor: Form white' - 'self objectsReferencingIt' - ) ! Item was removed: - ----- Method: ParagraphEditor>>startBlock (in category 'accessing-selection') ----- - startBlock - ^ self pointBlock min: self markBlock! Item was removed: - ----- Method: ParagraphEditor>>startBlock: (in category 'accessing-selection') ----- - startBlock: aCharacterBlock - self markBlock: aCharacterBlock! Item was removed: - ----- Method: ParagraphEditor>>startIndex (in category 'accessing-selection') ----- - startIndex - ^ self startBlock stringIndex! Item was removed: - ----- Method: ParagraphEditor>>startOfTyping (in category 'typing support') ----- - startOfTyping - "Compatibility during change from characterBlock to integer" - beginTypeInBlock == nil ifTrue: [^ nil]. - beginTypeInBlock isNumber ifTrue: [^ beginTypeInBlock]. - "Last line for compatibility during change from CharacterBlock to Integer." - ^ beginTypeInBlock stringIndex - ! Item was removed: - ----- Method: ParagraphEditor>>stateArray (in category 'initialize-release') ----- - stateArray - ^ {ChangeText. - FindText. - UndoInterval. - UndoMessage. - UndoParagraph. - UndoSelection. - Undone. - self selectionInterval. - self startOfTyping. - emphasisHere}! Item was removed: - ----- Method: ParagraphEditor>>stateArrayPut: (in category 'initialize-release') ----- - stateArrayPut: stateArray - | sel | - ChangeText := stateArray at: 1. - FindText := stateArray at: 2. - UndoInterval := stateArray at: 3. - UndoMessage := stateArray at: 4. - UndoParagraph := stateArray at: 5. - UndoSelection := stateArray at: 6. - Undone := stateArray at: 7. - sel := stateArray at: 8. - self selectFrom: sel first to: sel last. - beginTypeInBlock := stateArray at: 9. - emphasisHere := stateArray at: 10.! Item was removed: - ----- Method: ParagraphEditor>>stopBlock (in category 'accessing-selection') ----- - stopBlock - ^ self pointBlock max: self markBlock! Item was removed: - ----- Method: ParagraphEditor>>stopBlock: (in category 'accessing-selection') ----- - stopBlock: aCharacterBlock - self pointBlock: aCharacterBlock! Item was removed: - ----- Method: ParagraphEditor>>stopIndex (in category 'accessing-selection') ----- - stopIndex - ^ self stopBlock stringIndex! Item was removed: - ----- Method: ParagraphEditor>>swapChars: (in category 'editing keys') ----- - swapChars: characterStream - "Triggered byCmd-Y;. Swap two characters, either those straddling the insertion point, or the two that comprise the selection. Suggested by Ted Kaehler. " - - | currentSelection aString chars | - sensor keyboard. "flush the triggering cmd-key character" - (chars := self selection) size = 0 - ifTrue: - [currentSelection := self pointIndex. - self selectMark: currentSelection - 1 point: currentSelection] - ifFalse: - [chars size = 2 - ifFalse: - [view flash. ^ true] - ifTrue: - [currentSelection := self pointIndex - 1]]. - aString := self selection string. - self replaceSelectionWith: (Text string: aString reversed emphasis: emphasisHere). - self selectAt: currentSelection + 1. - ^ true! Item was removed: - ----- Method: ParagraphEditor>>tabOrIndent: (in category 'typing/selecting keys') ----- - tabOrIndent: characterStream - self selection - ifEmpty: [ self normalCharacter: characterStream ] - ifNotEmpty: - [ Sensor shiftPressed - ifTrue: [ self outdent: characterStream ] - ifFalse: [ self indent: characterStream ] ]. - ^ false! Item was removed: - ----- Method: ParagraphEditor>>tallyIt (in category 'do-its') ----- - tallyIt - - ^ self tallySelection! Item was removed: - ----- Method: ParagraphEditor>>tallySelection (in category 'do-its') ----- - tallySelection - "Treat the current selection as an expression; evaluate it and return the time took for this evaluation" - | result rcvr ctxt valueAsString v | - self lineSelectAndEmptyCheck: [^self]. - - (model respondsTo: #doItReceiver) - ifTrue: [ rcvr := model doItReceiver. - ctxt := model doItContext] - ifFalse: [rcvr := ctxt := nil]. - result := [ | cm | - cm := rcvr class evaluatorClass new - compiledMethodFor: self selectionAsStream - in: ctxt - to: rcvr - notifying: self - ifFail: [self flash. ^self]. - Time millisecondsToRun: - [v := cm valueWithReceiver: rcvr arguments: (ctxt ifNil: [#()] ifNotNil: [{ctxt}]) ]. - ] - on: OutOfScopeNotification - do: [ :ex | ex resume: true]. - - "We do not want to have large result displayed" - valueAsString := v printString. - (valueAsString size > 30) ifTrue: [valueAsString := (valueAsString copyFrom: 1 to: 30), '...']. - PopUpMenu - inform: 'Time to compile and execute: ', result printString, 'ms res: ', valueAsString. - ! Item was removed: - ----- Method: ParagraphEditor>>tempCommand: (in category 'editing keys') ----- - tempCommand: characterStream - "Experimental. Triggered by Cmd-t; put trial cmd-key commands here to see how they work, before hanging them on their own cmd accelerators." - Sensor keyboard. - self experimentalCommand. - ^ true - - "sensor keyboard. - self spawnWorkspace. - ^ true"! Item was removed: - ----- Method: ParagraphEditor>>text (in category 'accessing') ----- - text - "Answer the text of the paragraph being edited." - - ^paragraph text! Item was removed: - ----- Method: ParagraphEditor>>totalTextHeight (in category 'accessing') ----- - totalTextHeight - - ^paragraph boundingBox height! Item was removed: - ----- Method: ParagraphEditor>>undo (in category 'menu messages') ----- - undo - "Reset the state of the paragraph prior to the previous edit. - If another ParagraphEditor instance did that edit, UndoInterval is invalid; - just recover the contents of the undo-buffer at the start of the paragraph." - - sensor flushEvents. "a way to flush stuck keys" - self closeTypeIn. - - UndoParagraph == paragraph ifFalse: "Can't undo another paragraph's edit" - [UndoMessage := Message selector: #undoReplace. - UndoInterval := 1 to: 0. - Undone := true]. - UndoInterval ~= self selectionInterval ifTrue: "blink the actual target" - [self selectInterval: UndoInterval; deselect]. - - "Leave a signal of which phase is in progress" - UndoParagraph := Undone ifTrue: [#redoing] ifFalse: [#undoing]. - UndoMessage sentTo: self. - UndoParagraph := paragraph! Item was removed: - ----- Method: ParagraphEditor>>undo: (in category 'editing keys') ----- - undo: characterStream - "Undo the last edit. Keeps typeahead, so undo twice is a full redo." - - sensor keyboard. "flush character" - self closeTypeIn: characterStream. - self undo. - ^true! Item was removed: - ----- Method: ParagraphEditor>>undoAgain:andReselect:typedKey: (in category 'undoers') ----- - undoAgain: indices andReselect: home typedKey: wasTypedKey - "The last command was again. Undo it. Redoer: itself." - - | findSize substText | - (self isRedoing & wasTypedKey) ifTrue: "redelete search key" - [self selectInterval: home. - self zapSelectionWith: self nullText]. - - findSize := (self isRedoing ifTrue: [FindText] ifFalse: [ChangeText]) size. - substText := self isUndoing ifTrue: [FindText] ifFalse: [ChangeText]. - (self isUndoing ifTrue: [indices size to: 1 by: -1] ifFalse: [1 to: indices size]) do: - [:i | | index subject | - index := indices at: i. - (subject := index to: index + findSize - 1) = self selectionInterval ifFalse: - [self selectInterval: subject]. - FindText == ChangeText ifFalse: [self zapSelectionWith: substText]]. - - self isUndoing - ifTrue: "restore selection to where it was when 'again' was invoked" - [wasTypedKey - ifTrue: "search started by typing key at a caret; restore it" - [self selectAt: home first. - self zapSelectionWith: FindText. - self selectAt: home last + 1] - ifFalse: [self selectInterval: home]]. - - self undoMessage: UndoMessage forRedo: self isUndoing! Item was removed: - ----- Method: ParagraphEditor>>undoAndReselect:redoAndReselect: (in category 'undoers') ----- - undoAndReselect: undoHighlight redoAndReselect: redoHighlight - "Undo typing, cancel, paste, and other operations that are like replaces - but the selection is not the whole restored text after undo, redo, or both. - undoHighlight is selected after this phase and redoHighlight after the next phase. - Redoer: itself." - - self replace: self selectionInterval with: UndoSelection and: - [self selectInterval: undoHighlight]. - self undoMessage: (UndoMessage argument: redoHighlight) forRedo: self isUndoing - ! Item was removed: - ----- Method: ParagraphEditor>>undoCutCopy: (in category 'undoers') ----- - undoCutCopy: oldPasteBuffer - "Undo of a cut, copy, or any edit that changed CurrentSelection. Be sure - undo-copy does not lock the model. Redoer: itself, so never isRedoing." - - | recentCut | - recentCut := self clipboardText. - UndoSelection size = UndoInterval size - ifFalse: [self replaceSelectionWith: UndoSelection]. - self clipboardTextPut: oldPasteBuffer. - self undoer: #undoCutCopy: with: recentCut! Item was removed: - ----- Method: ParagraphEditor>>undoMessage:forRedo: (in category 'undo support') ----- - undoMessage: aMessage forRedo: aBoolean - "Call this from an undoer/redoer to set up UndoMessage as the - corresponding redoer/undoer. Also set up UndoParagraph, as well - as the state variable Undone. It is assumed that UndoInterval has been - established (generally by zapSelectionWith:) and that UndoSelection has been - saved (generally by replaceSelectionWith: or replace:With:and:)." - - self isDoing ifTrue: [UndoParagraph := paragraph]. - UndoMessage := aMessage. - Undone := aBoolean! Item was removed: - ----- Method: ParagraphEditor>>undoQuery:lastOffering: (in category 'undoers') ----- - undoQuery: hintText lastOffering: selectorOrNil - "Undo ctrl-q. selectorOrNil (if not nil) is the previously offered selector. - hintText is the original hint. Redoer: completeSymbol." - - self zapSelectionWith: UndoSelection. - self undoMessage: (Message selector: #completeSymbol:lastOffering: arguments: UndoMessage arguments) forRedo: true. - self selectAt: self stopIndex! Item was removed: - ----- Method: ParagraphEditor>>undoReplace (in category 'undoers') ----- - undoReplace - "Undo of any command that replaced a selection by other text that it left - highlighted, and that is undone and redone by simple reversal of the - operation. This is the most common Undoer; call replaceSelectionWith: - to get this setup. Redoer: itself, so never isRedoing." - - self replaceSelectionWith: UndoSelection! Item was removed: - ----- Method: ParagraphEditor>>undoer: (in category 'undo support') ----- - undoer: aSelector - "See comment in undoMessage:. Use this version when aSelector has no arguments, and you are doing or redoing and want to prepare for undoing." - - self undoMessage: (Message selector: aSelector) forRedo: false! Item was removed: - ----- Method: ParagraphEditor>>undoer:with: (in category 'undo support') ----- - undoer: aSelector with: arg1 - "See comment in undoMessage:. Use this version when aSelector has one argument, and you are doing or redoing and want to prepare for undoing." - - self undoMessage: (Message selector: aSelector argument: arg1) forRedo: false! Item was removed: - ----- Method: ParagraphEditor>>undoer:with:with: (in category 'undo support') ----- - undoer: aSelector with: arg1 with: arg2 - "See comment in undoMessage:. Use this version when aSelector has two arguments, and you are doing or redoing and want to prepare for undoing." - - self undoMessage: (Message selector: aSelector arguments: (Array with: arg1 with: arg2)) forRedo: false! Item was removed: - ----- Method: ParagraphEditor>>undoer:with:with:with: (in category 'undo support') ----- - undoer: aSelector with: arg1 with: arg2 with: arg3 - "See comment in undoMessage:. Use this version when aSelector has three arguments, and you are doing or redoing and want to prepare for undoing." - - self undoMessage: (Message selector: aSelector arguments: (Array with: arg1 with: arg2 with: arg3)) forRedo: false! Item was removed: - ----- Method: ParagraphEditor>>unselect (in category 'accessing-selection') ----- - unselect - self markBlock: self pointBlock copy.! Item was removed: - ----- Method: ParagraphEditor>>updateMarker (in category 'scrolling') ----- - updateMarker - "A variation of computeMarkerRegion--only redisplay the marker in the scrollbar if an actual change has occurred in the positioning of the paragraph." - self moveMarkerTo: self computeMarkerRegion! Item was removed: - ----- Method: ParagraphEditor>>userHasEdited (in category 'accessing') ----- - userHasEdited - "Note that the user has edited my text. Here it is just a noop so that the Character Recognizer won't fail when used with a vanilla ParagrahEditor." - ! Item was removed: - ----- Method: ParagraphEditor>>viewDelta (in category 'scrolling') ----- - viewDelta - "Refer to the comment in ScrollController|viewDelta." - - ^paragraph clippingRectangle top - - paragraph compositionRectangle top - - ((marker top - scrollBar inside top) asFloat - / scrollBar inside height asFloat * self scrollRectangleHeight asFloat) - roundTo: paragraph lineGrid! Item was removed: - ----- Method: ParagraphEditor>>visibleHeight (in category 'accessing') ----- - visibleHeight - - ^paragraph clippingRectangle height! Item was removed: - ----- Method: ParagraphEditor>>wasComposition (in category 'accessing-selection') ----- - wasComposition - - ^ wasComposition ifNil: [^ false]. - ! Item was removed: - ----- Method: ParagraphEditor>>wordSelectAndEmptyCheck: (in category 'menu messages') ----- - wordSelectAndEmptyCheck: returnBlock - "If the current selection is an insertion point, expand it to be the entire current word; if after that's done the selection is still empty, then evaluate the returnBlock, which will typically consist of '[^ self]' in the caller -- check senders of this method to understand this." - - self hasSelection ifFalse: [ - self selectWord. - self hasSelection ifFalse: [ - self flash. - ^ returnBlock value]].! Item was removed: - ----- Method: ParagraphEditor>>zapSelectionWith: (in category 'accessing-selection') ----- - zapSelectionWith: aText - "Deselect, and replace the selection text by aText. - Remember the resulting selectionInterval in UndoInterval and otherInterval. - Do not set up for undo." - - | start stop | - self deselect. - start := self startIndex. - stop := self stopIndex. - (aText isEmpty and: [stop > start]) ifTrue: - ["If deleting, then set emphasisHere from 1st character of the deletion" - emphasisHere := (paragraph text attributesAt: start forStyle: paragraph textStyle) - select: [:att | att mayBeExtended]]. - (start = stop and: [aText size = 0]) ifFalse: - [paragraph - replaceFrom: start - to: stop - 1 - with: aText - displaying: true. - self computeIntervalFrom: start to: start + aText size - 1. - self wasComposition ifTrue: [wasComposition := false. self setPoint: start + 1]. - UndoInterval := otherInterval := self selectionInterval]! Item was removed: - ----- Method: ParagraphEditor>>zapSelectionWithCompositionWith: (in category 'accessing-selection') ----- - zapSelectionWithCompositionWith: aString - "Deselect, and replace the selection text by aString. - Remember the resulting selectionInterval in UndoInterval and otherInterval. - Do not set up for undo." - - | stream newString aText beforeChar | - wasComposition := false. - ((aString isEmpty or: [(beforeChar := self charBefore) isNil]) or: [ - aString size >= 1 and: [(Unicode isComposition: aString first) not]]) ifTrue: [ - ^ self zapSelectionWith: (Text string: aString emphasis: emphasisHere)]. - - stream := UnicodeCompositionStream on: (String new: 16). - stream nextPut: beforeChar. - stream nextPutAll: aString. - newString := stream contents. - aText := Text string: newString emphasis: emphasisHere. - self markBlock < self pointBlock - ifTrue: [self setMark: self markBlock stringIndex - 1] - ifFalse: [self setPoint: self pointBlock stringIndex - 1]. - - wasComposition := true. - self zapSelectionWith: aText. - ! Item was removed: - ----- Method: PasteUpMorph>>standardSystemController (in category '*ST80-Support') ----- - standardSystemController - ^ScheduledControllers controllerSatisfying: - [:c | - c view subViews notEmpty and: [c view firstSubView model == self]]! Item was removed: - DisplayObject subclass: #Path - instanceVariableNames: 'form collectionOfPoints' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Paths'! - - !Path commentStamp: '<historical>' prior: 0! - I am the abstract superclass of the Graphic spatial primitives. I represent an ordered sequence of Points. Spatial primitives are used to generate "trajectories" such as lines and circles.! Item was removed: - ----- Method: Path class>>example (in category 'examples') ----- - example - "Creates a Path from mousePoints and displays it several ways on the display screen. Messes up the display. For learning about class Path, just select the code below and execute it to create a path and see it redisplayed in another place on the screen. Each path displays using a different form. A path is indicated by pressing the red mouse button in a sequence; press any other mouse button to terminate. " - - | aPath aForm pl fl flag | - aForm := Form extent: 2 @ 40. "creates a form one inch long" - aForm fillBlack. "turns it black" - aPath := Path new. - aPath form: aForm. "use the long black form for displaying" - flag := true. - [flag] - whileTrue: - [Sensor waitButton. - Sensor redButtonPressed - ifTrue: - [aPath add: Sensor waitButton. - Sensor waitNoButton. - aForm displayOn: Display at: aPath last] - ifFalse: [flag := false]]. - Display fillWhite. - aPath displayOn: Display. "the original path" - pl := aPath translateBy: 0 @ 100. - fl := Form extent: 40 @ 40. - fl fillGray. - pl form: fl. - pl displayOn: Display. "the translated path" - Sensor waitNoButton - - "Path example"! Item was removed: - ----- Method: Path class>>new (in category 'instance creation') ----- - new - - ^self basicNew initializeCollectionOfPoints! Item was removed: - ----- Method: Path class>>new: (in category 'instance creation') ----- - new: anInteger - - ^self basicNew initializeCollectionOfPoints: anInteger! Item was removed: - ----- Method: Path>>add: (in category 'adding') ----- - add: aPoint - "Include aPoint as one of the receiver's elements." - - ^collectionOfPoints add: aPoint! Item was removed: - ----- Method: Path>>at: (in category 'accessing') ----- - at: index - "Answer the point on the receiver's path at position index." - - ^collectionOfPoints at: index! Item was removed: - ----- Method: Path>>at:put: (in category 'accessing') ----- - at: index put: aPoint - "Store the argument, aPoint, as the point on the receiver's path at position - index." - - ^collectionOfPoints at: index put: aPoint! Item was removed: - ----- Method: Path>>collect: (in category 'enumerating') ----- - collect: aBlock - "Evaluate aBlock with each of the receiver's elements as the argument. - Collect the resulting values into a path that is like the receiver. Answer - the new path." - - | newCollection | - newCollection := collectionOfPoints collect: aBlock. - newCollection form: self form. - ^newCollection! Item was removed: - ----- Method: Path>>computeBoundingBox (in category 'display box access') ----- - computeBoundingBox - "Refer to the comment in DisplayObject|computeBoundingBox." - - | box | - box := Rectangle origin: (self at: 1) extent: 0 @ 0. - collectionOfPoints do: - [:aPoint | box swallow: (Rectangle origin: aPoint extent: 0 @ 0)]. - ^box! Item was removed: - ----- Method: Path>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger fillColor: aForm - "Display this Path--offset by aPoint, clipped by clipRect and the form - associated with this Path will be displayedr according to one of the sixteen - functions of two logical variables (rule). Also the source form will be first - anded with aForm as a mask. Does not effect the state of the Path" - - collectionOfPoints do: - [:element | - self form - displayOn: aDisplayMedium - at: element + aDisplayPoint - clippingBox: clipRectangle - rule: ruleInteger - fillColor: aForm]! Item was removed: - ----- Method: Path>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle rule: ruleInteger fillColor: aForm - "Displays this path, translated and scaled by aTransformation. Get the - scaled and translated Path." - - | newPath transformedPath | - transformedPath := displayTransformation applyTo: self. - newPath := Path new. - transformedPath do: [:point | newPath add: point]. - newPath form: self form. - newPath - displayOn: aDisplayMedium - at: 0 @ 0 - clippingBox: clipRectangle - rule: ruleInteger - fillColor: aForm! Item was removed: - ----- Method: Path>>first (in category 'accessing') ----- - first - "Answer the first point on the receiver's path; included to correspond to - OrderedCollection protocol." - - ^collectionOfPoints first! Item was removed: - ----- Method: Path>>firstPoint (in category 'accessing') ----- - firstPoint - "Answer the first point on the receiver's path." - - ^collectionOfPoints first! Item was removed: - ----- Method: Path>>firstPoint: (in category 'accessing') ----- - firstPoint: aPoint - "Replace the first element of the receiver with the new value aPoint. - Answer the argument aPoint." - - collectionOfPoints at: 1 put: aPoint. - ^aPoint! Item was removed: - ----- Method: Path>>form (in category 'accessing') ----- - form - "Answer the receiver's form, or, if form is nil, then answer a 1 x 1 black - form (a black dot)." - - | aForm | - form == nil - ifTrue: - [aForm := Form extent: 1 @ 1. - aForm fillBlack. - ^aForm] - ifFalse: - [^form]! Item was removed: - ----- Method: Path>>form: (in category 'accessing') ----- - form: aForm - "Make the argument, aForm, be the receiver's form." - - form := aForm! Item was removed: - ----- Method: Path>>initializeCollectionOfPoints (in category 'private') ----- - initializeCollectionOfPoints - - collectionOfPoints := OrderedCollection new! Item was removed: - ----- Method: Path>>initializeCollectionOfPoints: (in category 'private') ----- - initializeCollectionOfPoints: anInteger - - collectionOfPoints := OrderedCollection new: anInteger! Item was removed: - ----- Method: Path>>isEmpty (in category 'testing') ----- - isEmpty - - ^collectionOfPoints isEmpty! Item was removed: - ----- Method: Path>>last (in category 'accessing') ----- - last - "Answer the last point on the receiver's path; included to correspond to - OrderedCollection protocol." - - ^collectionOfPoints last! Item was removed: - ----- Method: Path>>offset (in category 'accessing') ----- - offset - "There are basically two kinds of display objects in the system: those - that, when asked to transform themselves, create a new object; and those - that side effect themselves by maintaining a record of the transformation - request (typically an offset). Path, like Rectangle and Point, is a display - object of the first kind." - - self shouldNotImplement! Item was removed: - ----- Method: Path>>removeAllSuchThat: (in category 'removing') ----- - removeAllSuchThat: aBlock - "Evaluate aBlock for each element of the receiver. - Remove each element for which aBlock evaluates to true." - - collectionOfPoints removeAllSuchThat: aBlock. - ! Item was removed: - ----- Method: Path>>scaleBy: (in category 'transforming') ----- - scaleBy: aPoint - "Answers a new Path scaled by aPoint. Does not affect the current data in - this Path." - - | newPath | - newPath := self species new: self size. - newPath form: self form. - collectionOfPoints do: [:element | newPath add: (element scaleBy: aPoint)]. - ^newPath! Item was removed: - ----- Method: Path>>secondPoint (in category 'accessing') ----- - secondPoint - "Answer the second element of the receiver." - - ^collectionOfPoints at: 2! Item was removed: - ----- Method: Path>>secondPoint: (in category 'accessing') ----- - secondPoint: aPoint - "Replace the second element of the receiver with the new value aPoint. - Answer the argument aPoint." - - collectionOfPoints at: 2 put: aPoint. - ^aPoint! Item was removed: - ----- Method: Path>>select: (in category 'enumerating') ----- - select: aBlock - "Evaluate aBlock with each of the receiver's elements as the argument. - Collect into a new path like the receiver only those elements for which - aBlock evaluates to true. Answer the new path." - - | newCollection | - newCollection := collectionOfPoints select: aBlock. - newCollection form: self form. - ^newCollection! Item was removed: - ----- Method: Path>>size (in category 'accessing') ----- - size - "Answer the length of the receiver." - - ^collectionOfPoints size! Item was removed: - ----- Method: Path>>thirdPoint (in category 'accessing') ----- - thirdPoint - "Answer the third element of the receiver." - - ^collectionOfPoints at: 3! Item was removed: - ----- Method: Path>>thirdPoint: (in category 'accessing') ----- - thirdPoint: aPoint - "Replace the third element of the receiver with the new value aPoint. - Answer the argument aPoint." - - collectionOfPoints at: 3 put: aPoint. - ^aPoint! Item was removed: - ----- Method: Path>>translateBy: (in category 'transforming') ----- - translateBy: aPoint - "Answers a new Path whose elements are translated by aPoint. Does not - affect the elements of this Path." - - | newPath | - newPath := self species new: self size. - newPath form: self form. - collectionOfPoints do: [:element | newPath add: (element translateBy: aPoint)]. - ^newPath! Item was removed: - Controller subclass: #PluggableButtonController - instanceVariableNames: 'selector arguments shownAsComplemented' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Pluggable Views'! - - !PluggableButtonController commentStamp: '<historical>' prior: 0! - The controller for Buttons. Not meant to be used with buttons that have mouseOver feeback when the button is not pressed. Use mouseEnter/mouseLeave for that. ! Item was removed: - ----- Method: PluggableButtonController>>controlActivity (in category 'control defaults') ----- - controlActivity - - shownAsComplemented ifNil: [^ self]. - shownAsComplemented = self viewHasCursor - ifFalse: - [view ifNotNil: [view toggleMouseOverFeedback]. - shownAsComplemented := shownAsComplemented not]! Item was removed: - ----- Method: PluggableButtonController>>controlInitialize (in category 'basic control sequence') ----- - controlInitialize - "Provide feedback indicating that button has been entered with the mouse down. If triggerOnMouseDown is true, then do the button action on mouse down--and don't bother with the feedback since the action happens immediately." - - sensor anyButtonPressed ifFalse: [^ self]. - view triggerOnMouseDown - ifTrue: [sensor yellowButtonPressed - ifTrue: [self yellowButtonActivity] - ifFalse: [view performAction]] - ifFalse: [view toggleMouseOverFeedback. - shownAsComplemented := true]! Item was removed: - ----- Method: PluggableButtonController>>controlTerminate (in category 'basic control sequence') ----- - controlTerminate - "Reverse the feedback displayed by controlInitialize, if any. Perform the button action if necessary." - - view ifNotNil: - [view triggerOnMouseDown - ifFalse: - [shownAsComplemented ifTrue: [view toggleMouseOverFeedback]. - self viewHasCursor ifTrue: [view performAction]]]! Item was removed: - ----- Method: PluggableButtonController>>isControlActive (in category 'control defaults') ----- - isControlActive - - ^ sensor anyButtonPressed! Item was removed: - ----- Method: PluggableButtonController>>isControlWanted (in category 'control defaults') ----- - isControlWanted - - "sensor flushKeyboard." - self viewHasCursor & sensor anyButtonPressed ifFalse: [^ false]. - view askBeforeChanging - ifTrue: [^ model okToChange] "ask before changing" - ifFalse: [^ true]. - ! Item was removed: - ----- Method: PluggableButtonController>>yellowButtonActivity (in category 'button activity') ----- - yellowButtonActivity - "Invoke the model's menu. This is option-click, NOT the normal button press." - | menu | - menu := view getMenu: false. - menu == nil - ifTrue: [sensor waitNoButton] - ifFalse: [self terminateAndInitializeAround: [menu invokeOn: model]]. - ! Item was removed: - View subclass: #PluggableButtonView - instanceVariableNames: 'label getStateSelector actionSelector getLabelSelector getMenuSelector shortcutCharacter askBeforeChanging triggerOnMouseDown complemented argumentsProvider argumentsSelector' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Pluggable Views'! - - !PluggableButtonView commentStamp: '<historical>' prior: 0! - A PluggableButtonView is a combination of an indicator for a boolean value stored in its model and an action button. The action of a button is often, but not always, to toggle the boolean value that it shows. Its pluggable selectors are: - - getStateSelector fetch a boolean value from the model - actionSelector invoke this button's action on the model - - Either of the above selectors can be nil, meaning that the model does not supply behavior for the given action, and the default behavior should be used. For example, if getStateSelector is nil, then this button shows the state of a read-only boolean that is always false. - - The model informs a pluggable view of changes by sending #changed: to itself with getStateSelector as a parameter. The view tells the model when the button is pressed by sending actionSelector. - - Options: - askBeforeChanging have model ask user before allowing change that could lose edits - triggerOnMouseDown do button action on mouse down (vs. up) transition - shortcutCharacter a place to record an optional shortcut key - - ! Item was removed: - ----- Method: PluggableButtonView class>>example (in category 'example') ----- - example - "PluggableButtonView example" - - | s1 s2 s3 b1 b2 b3 topView | - s1 := Switch new. - s2 := Switch new turnOn. - s3 := Switch new. - s2 onAction: [s3 turnOff]. - s3 onAction: [s2 turnOff]. - b1 := (PluggableButtonView on: s1 getState: #isOn action: #switch) label: 'S1'. - b2 := (PluggableButtonView on: s2 getState: #isOn action: #turnOn) label: 'S2'. - b3 := (PluggableButtonView on: s3 getState: #isOn action: #turnOn) label: 'S3'. - b1 borderWidth: 1. - b2 borderWidth: 1. - b3 borderWidth: 1. - topView := StandardSystemView new - label: 'Switch Test'; - addSubView: b1; - addSubView: b2 toRightOf: b1; - addSubView: b3 toRightOf: b2. - topView controller open. - ! Item was removed: - ----- Method: PluggableButtonView class>>on: (in category 'instance creation') ----- - on: anObject - - ^ self on: anObject getState: #isOn action: #switch - ! Item was removed: - ----- Method: PluggableButtonView class>>on:getState:action: (in category 'instance creation') ----- - on: anObject getState: getStateSel action: actionSel - - ^ self new - on: anObject - getState: getStateSel - action: actionSel - label: nil - menu: nil! Item was removed: - ----- Method: PluggableButtonView class>>on:getState:action:getArguments:from: (in category 'instance creation') ----- - on: anObject getState: getStateSel action: actionSel getArguments: getArgumentsSel from: argsProvidor - - ^ self new - on: anObject - getState: getStateSel - action: actionSel - getArguments: getArgumentsSel - from: argsProvidor - label: nil - menu: nil! Item was removed: - ----- Method: PluggableButtonView class>>on:getState:action:label: (in category 'instance creation') ----- - on: anObject getState: getStateSel action: actionSel label: labelSel - - ^ self new - on: anObject - getState: getStateSel - action: actionSel - label: labelSel - menu: nil! Item was removed: - ----- Method: PluggableButtonView class>>on:getState:action:label:menu: (in category 'instance creation') ----- - on: anObject getState: getStateSel action: actionSel label: labelSel menu: menuSel - - ^ self new - on: anObject - getState: getStateSel - action: actionSel - label: labelSel - menu: menuSel! Item was removed: - ----- Method: PluggableButtonView>>action: (in category 'accessing') ----- - action: aSymbol - "Set actionSelector to be the action defined by aSymbol." - - actionSelector := aSymbol - ! Item was removed: - ----- Method: PluggableButtonView>>askBeforeChanging (in category 'accessing') ----- - askBeforeChanging - - ^ askBeforeChanging - ! Item was removed: - ----- Method: PluggableButtonView>>askBeforeChanging: (in category 'accessing') ----- - askBeforeChanging: aBoolean - "If this preference is turned on, then give the model an opportunity to ask the user before accepting a change that might cause unaccepted edits to be lost." - - askBeforeChanging := aBoolean. - ! Item was removed: - ----- Method: PluggableButtonView>>centerAlignLabelWith: (in category 'private') ----- - centerAlignLabelWith: aPoint - "Align the center of the label with aPoint." - - | alignPt | - alignPt := label boundingBox center. - (label isKindOf: Paragraph) ifTrue: - [alignPt := alignPt + (0@(label textStyle defaultFont lineGapSlice))]. - (label isForm) - ifTrue: [label offset: 0 @ 0]. - label align: alignPt with: aPoint - ! Item was removed: - ----- Method: PluggableButtonView>>centerLabel (in category 'private') ----- - centerLabel - "If there is a label, align its center with the center of the insetDisplayBox" - - label ifNotNil: - [self centerAlignLabelWith: self insetDisplayBox center]. - ! Item was removed: - ----- Method: PluggableButtonView>>deEmphasizeView (in category 'displaying') ----- - deEmphasizeView - - self getModelState ifTrue: [self displayNormal]. - ! Item was removed: - ----- Method: PluggableButtonView>>defaultControllerClass (in category 'controller access') ----- - defaultControllerClass - - ^ PluggableButtonController - ! Item was removed: - ----- Method: PluggableButtonView>>defaultWindow (in category 'other') ----- - defaultWindow - "Return a rectangle large enough to contain this button's label. If this button is label-less, just return the standard View default window." - - label == nil - ifTrue: [^ super defaultWindow] - ifFalse: [^ label boundingBox expandBy: 6]. - ! Item was removed: - ----- Method: PluggableButtonView>>display (in category 'displaying') ----- - display - "Sets the PluggableButtonView mode to 'normal', displays the border, displays the inside and, if its model is 'on', complements the inside." - - self displayBorder. - self displayView. - ! Item was removed: - ----- Method: PluggableButtonView>>displayComplemented (in category 'displaying') ----- - displayComplemented - "Complement the receiver if it isn't already." - - complemented ifFalse: [ - complemented := true. - Display reverse: self insetDisplayBox]. - ! Item was removed: - ----- Method: PluggableButtonView>>displayNormal (in category 'displaying') ----- - displayNormal - "Complement the receiver if its mode is 'complemented'." - - complemented ifTrue: [ - complemented := false. - Display reverse: self insetDisplayBox]. - ! Item was removed: - ----- Method: PluggableButtonView>>displayView (in category 'displaying') ----- - displayView - - "Displays this switch and its label, if any." - - self clearInside. - label ifNotNil: [ - (label isKindOf: Paragraph) ifTrue: [ - label foregroundColor: self foregroundColor - backgroundColor: self backgroundColor]. - label displayOn: Display - at: label boundingBox topLeft - clippingBox: self insetDisplayBox]. - complemented := false.! Item was removed: - ----- Method: PluggableButtonView>>emphasizeView (in category 'displaying') ----- - emphasizeView - - self getModelState ifTrue: [self displayComplemented]. - ! Item was removed: - ----- Method: PluggableButtonView>>getMenu: (in category 'private') ----- - getMenu: shiftKeyDown - "Answer the menu for this view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key." - - | menu | - getMenuSelector == nil ifTrue: [^ nil]. - menu := CustomMenu new. - getMenuSelector numArgs = 1 - ifTrue: [^ model perform: getMenuSelector with: menu]. - getMenuSelector numArgs = 2 - ifTrue: [^ model perform: getMenuSelector with: menu with: shiftKeyDown]. - ^ self error: 'The getMenuSelector must be a 1- or 2-keyword symbol' - ! Item was removed: - ----- Method: PluggableButtonView>>getModelState (in category 'private') ----- - getModelState - "Answer the result of sending the receiver's model the getStateSelector message." - - (model isNil or: [getStateSelector isNil]) - ifTrue: [^ false] - ifFalse: [^ model perform: getStateSelector]. - ! Item was removed: - ----- Method: PluggableButtonView>>initialize (in category 'initialize-release') ----- - initialize - - super initialize. - label := nil. - getStateSelector := nil. - actionSelector := nil. - getLabelSelector := nil. - getMenuSelector := nil. - shortcutCharacter := nil. - askBeforeChanging := false. - triggerOnMouseDown := false. - complemented := false. - ! Item was removed: - ----- Method: PluggableButtonView>>insetDisplayBox (in category 'private') ----- - insetDisplayBox - "Answer the receiver's inset display box. The inset display box is the - intersection of the receiver's window, tranformed to display coordinates, - and the inset display box of the superView, inset by the border width. - The inset display box represents the region of the display screen in - which the inside of the receiver (all except the border) is displayed. If - the receiver is totally clipped by the display screen and its superView, - the resulting Rectangle will be invalid." - - insetDisplayBox ifNil: - [insetDisplayBox := self computeInsetDisplayBox. - self centerLabel]. - ^insetDisplayBox! Item was removed: - ----- Method: PluggableButtonView>>label (in category 'accessing') ----- - label - "Answer the DisplayObject used as this button's label." - - ^ label - ! Item was removed: - ----- Method: PluggableButtonView>>label: (in category 'accessing') ----- - label: aStringOrDisplayObject - "Label this button with the given String or DisplayObject." - - | fontToUse | - fontToUse := self userInterfaceTheme font ifNil: [TextStyle defaultFont]. - ((aStringOrDisplayObject isKindOf: Paragraph) - or: [aStringOrDisplayObject isForm]) - ifTrue: [label := aStringOrDisplayObject] - ifFalse: [label := (Paragraph withText: (aStringOrDisplayObject asText - addAttribute: (TextFontReference toFont: fontToUse)))]. - self centerLabel. - ! Item was removed: - ----- Method: PluggableButtonView>>on:getState:action:getArguments:from:label:menu: (in category 'initialize-release') ----- - on: anObject getState: getStateSel action: actionSel getArguments: getArgumentsSel from: argsProvidor label: labelSel menu: menuSel - - self initialize. - self model: anObject. - getStateSelector := getStateSel. - actionSelector := actionSel. - argumentsSelector := getArgumentsSel. - argumentsProvider := argsProvidor. - getLabelSelector := labelSel. - getMenuSelector := menuSel! Item was removed: - ----- Method: PluggableButtonView>>on:getState:action:label:menu: (in category 'initialize-release') ----- - on: anObject getState: getStateSel action: actionSel label: labelSel menu: menuSel - - self initialize. - self model: anObject. - getStateSelector := getStateSel. - actionSelector := actionSel. - getLabelSelector := labelSel. - getMenuSelector := menuSel.! Item was removed: - ----- Method: PluggableButtonView>>performAction (in category 'other') ----- - performAction - "Inform the model that this button has been pressed. Sent by the controller when this button is pressed." - - argumentsSelector - ifNil: - [actionSelector ifNotNil: - [model perform: actionSelector]] - ifNotNil: - [model perform: actionSelector - withArguments: - (Array with: (argumentsProvider perform: argumentsSelector))]! Item was removed: - ----- Method: PluggableButtonView>>shortcutCharacter (in category 'accessing') ----- - shortcutCharacter - "Return the Character to be used as a shortcut to turn on this switch, or nil if this switch doesn't have a keyboard shortcut." - - ^ shortcutCharacter - ! Item was removed: - ----- Method: PluggableButtonView>>shortcutCharacter: (in category 'accessing') ----- - shortcutCharacter: aCharacter - "Set the character to be used as a keyboard shortcut for turning on this switch." - - shortcutCharacter := aCharacter. - ! Item was removed: - ----- Method: PluggableButtonView>>toggleMouseOverFeedback (in category 'displaying') ----- - toggleMouseOverFeedback - "Complement the label (or a portion of the displayBox if no label is defined) to show that the mouse is over this button. This feedback can be removed by a second call to this method." - - Display reverse: self insetDisplayBox fillColor: Color gray. - Display reverse: (self insetDisplayBox insetBy: 2) fillColor: Color gray. - ! Item was removed: - ----- Method: PluggableButtonView>>triggerOnMouseDown (in category 'accessing') ----- - triggerOnMouseDown - - ^ triggerOnMouseDown - ! Item was removed: - ----- Method: PluggableButtonView>>triggerOnMouseDown: (in category 'accessing') ----- - triggerOnMouseDown: aBoolean - "If this preference is turned on, then trigger my action immediately when the mouse goes down." - - triggerOnMouseDown := aBoolean. - ! Item was removed: - ----- Method: PluggableButtonView>>update: (in category 'other') ----- - update: aParameter - - aParameter == getLabelSelector ifTrue: [ - getLabelSelector ifNotNil: [ - self label: (model perform: getLabelSelector). - self displayView]]. - self getModelState - ifTrue: [self displayComplemented] - ifFalse: [self displayNormal]. - ! Item was removed: - ----- Method: PluggableButtonView>>window: (in category 'other') ----- - window: aWindow - "Center my label when my window changes." - - super window: aWindow. - self centerLabel. - ! Item was removed: - ----- Method: PluggableFileList>>mvcOpenLabel:in: (in category '*ST80-Pluggable Views') ----- - mvcOpenLabel: ignored in: aWorld - "Open a view of an instance of me." - "PluggableFileList new open" - | topView volListView templateView fileListView fileStringView leftButtonView middleButtonView rightButtonView | - - self directory: directory. - topView := (PluggableFileListView new) - model: self. - - volListView := PluggableListView on: self - list: #volumeList - selected: #volumeListIndex - changeSelected: #volumeListIndex: - menu: #volumeMenu:. - volListView autoDeselect: false. - volListView window: (0 at 0 extent: 80 at 45). - topView addSubView: volListView. - - templateView := PluggableTextView on: self - text: #pattern - accept: #pattern:. - templateView askBeforeDiscardingEdits: false. - templateView window: (0 at 0 extent: 80 at 15). - topView addSubView: templateView below: volListView. - - fileListView := PluggableListView on: self - list: #fileList - selected: #fileListIndex - changeSelected: #fileListIndex: - menu: #fileListMenu:. - fileListView window: (0 at 0 extent: 120 at 60). - - topView addSubView: fileListView toRightOf: volListView. - - fileListView controller terminateDuringSelect: true. "Pane to left may change under scrollbar" - - "fileStringView := PluggableTextView on: self - text: #fileString - accept: #fileString:. - fileStringView askBeforeDiscardingEdits: false. - fileStringView window: (0 at 0 extent: 200 at 15). - topView addSubView: fileStringView below: templateView." - fileStringView := templateView. - - - leftButtonView := PluggableButtonView - on: self - getState: nil - action: #leftButtonPressed. - leftButtonView - label: 'Cancel'; - backgroundColor: Color red; - borderWidth: 3; - window: (0 at 0 extent: 50 at 15). - - middleButtonView := PluggableButtonView - on: self - getState: nil - action: nil. - middleButtonView - label: prompt; - window: (0 at 0 extent: 100 at 15); - borderWidth: 1; - controller: NoController new. - - rightButtonView := PluggableButtonView - on: self - getState: nil - action: #rightButtonPressed. - rightButtonView - label: 'Accept'; - backgroundColor: (self canAccept ifTrue: [Color green] ifFalse: [Color lightYellow]); - borderWidth: (self canAccept ifTrue: [3] ifFalse: [1]); - window: (0 at 0 extent: 50 at 15). - self canAccept ifFalse: [rightButtonView controller: NoController new]. - - topView acceptButtonView: rightButtonView. - - topView - addSubView: leftButtonView below: fileStringView; - addSubView: middleButtonView toRightOf: leftButtonView; - addSubView: rightButtonView toRightOf: middleButtonView. - - self changed: #getSelectionSel. - topView doModalDialog. - - ^self result - ! Item was removed: - ModalSystemWindowView subclass: #PluggableFileListView - instanceVariableNames: 'acceptButtonView' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Views'! - - !PluggableFileListView commentStamp: '<historical>' prior: 0! - I provide aview for PluggableFileList! Item was removed: - ----- Method: PluggableFileListView>>acceptButtonView: (in category 'accessing') ----- - acceptButtonView: aView - - ^acceptButtonView := aView! Item was removed: - ----- Method: PluggableFileListView>>label: (in category 'label access') ----- - label: aString - - super label: aString. - self noLabel! Item was removed: - ----- Method: PluggableFileListView>>update: (in category 'model access') ----- - update: aSymbol - (aSymbol = #volumeListIndex or: [aSymbol = #fileListIndex]) - ifTrue: [self updateAcceptButton]. - ^super update: aSymbol! Item was removed: - ----- Method: PluggableFileListView>>updateAcceptButton (in category 'private') ----- - updateAcceptButton - - self model canAccept - ifTrue: - [acceptButtonView - backgroundColor: Color green; - borderWidth: 3; - controller: acceptButtonView defaultController] - ifFalse: - [acceptButtonView - backgroundColor: Color lightYellow; - borderWidth: 1; - controller: NoController new]. - acceptButtonView display.! Item was removed: - ListController subclass: #PluggableListController - instanceVariableNames: 'terminateDuringSelect' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Pluggable Views'! Item was removed: - ----- Method: PluggableListController>>changeModelSelection: (in category 'private') ----- - changeModelSelection: anInteger - "Let the view handle this." - - terminateDuringSelect ifTrue: [self controlTerminate]. - view changeModelSelection: anInteger. - terminateDuringSelect ifTrue: [self controlInitialize].! Item was removed: - ----- Method: PluggableListController>>initialize (in category 'initialization') ----- - initialize - super initialize. - self terminateDuringSelect: false! Item was removed: - ----- Method: PluggableListController>>processKeyboard (in category 'private') ----- - processKeyboard - sensor keyboardPressed - ifTrue: [view handleKeystroke: sensor keyboard] - ifFalse: [super processKeyboard]! Item was removed: - ----- Method: PluggableListController>>redButtonActivity (in category 'control defaults') ----- - redButtonActivity - model okToChange "Don't change selection if model refuses to unlock" - ifTrue: [^ super redButtonActivity]! Item was removed: - ----- Method: PluggableListController>>terminateDuringSelect: (in category 'private') ----- - terminateDuringSelect: trueOrFalse - terminateDuringSelect := trueOrFalse! Item was removed: - PluggableListController subclass: #PluggableListControllerOfMany - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Pluggable Views'! Item was removed: - ----- Method: PluggableListControllerOfMany>>redButtonActivity (in category 'control defaults') ----- - redButtonActivity - | selection firstHit turningOn lastSelection pt scrollFlag | - model okToChange ifFalse: [^ self]. - "Don't change selection if model refuses to unlock" - firstHit := true. - scrollFlag := false. - lastSelection := 0. - [sensor redButtonPressed] whileTrue: - [selection := view findSelection: (pt := sensor cursorPoint). - selection == nil ifTrue: "Maybe out of box - check for auto-scroll" - [pt y < view insetDisplayBox top ifTrue: - [self scrollView: view list lineGrid. - scrollFlag := true. - selection := view firstShown]. - pt y > view insetDisplayBox bottom ifTrue: - [self scrollView: view list lineGrid negated. - scrollFlag := true. - selection := view lastShown]]. - (selection == nil or: [selection = lastSelection]) ifFalse: - [firstHit ifTrue: - [firstHit := false. - turningOn := (view listSelectionAt: selection) not]. - view selection: selection. - (view listSelectionAt: selection) == turningOn ifFalse: - [view displaySelectionBox. - view listSelectionAt: selection put: turningOn]. - lastSelection := selection]]. - selection notNil ifTrue: - ["Normal protocol delivers change, so unchange first (ugh)" - view listSelectionAt: selection put: (view listSelectionAt: selection) not. - self changeModelSelection: selection]. - scrollFlag ifTrue: [self moveMarker]! Item was removed: - ----- Method: PluggableListControllerOfMany>>scrollView: (in category 'scrolling') ----- - scrollView: anInteger - "Need to minimize the selections which get recomputed" - | oldLimit | - oldLimit := anInteger > 0 - ifTrue: [view firstShown] - ifFalse: [view lastShown]. - (view scrollBy: anInteger) - ifTrue: [anInteger > 0 "Highlight selections brought into view" - ifTrue: [view highlightFrom: view firstShown - to: (oldLimit-1 min: view lastShown)] - ifFalse: [view highlightFrom: (oldLimit+1 max: view firstShown) - to: view lastShown]. - ^ true] - ifFalse: [^ false]! Item was removed: - ListView subclass: #PluggableListView - instanceVariableNames: 'getListSelector getSelectionSelector setSelectionSelector getMenuSelector getMenuTitleSelector keystrokeActionSelector autoDeselect items' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Pluggable Views'! - - !PluggableListView commentStamp: '<historical>' prior: 0! - A pluggable list view gets its content from the model. This allows the same kind of view to be used in different situations, thus avoiding a proliferation of gratuitous view and controller classes. Selector usage is: - - getListSel fetch the list of items (strings) to be displayed - getSelectionSel get the currently selected item - setSelectionSel set the currently selected item (takes an argument) - getMenuSel get the pane-specific, 'yellow-button' menu - keyActionSel process a keystroke typed in this pane (takes an argument) - - Any of the above selectors can be nil, meaning that the model does not supply behavior for the given action, and the default behavior should be used. However, if getListSel is nil, the default behavior just provides an empty list, which makes for a rather dull list view!! - - The model informs a pluggable view of changes by sending #changed: to itself with getListSel or getSelectionSel as a parameter. The view informs the model of selection changes by sending setSelectionSel to it with the newly selected item as a parameter, and invokes menu and keyboard actions on the model via getMenuSel and keyActionSel. - - Pluggability allows a single model object to have pluggable list views on multiple aspects of itself. For example, an object representing one personal music library might be organized as a three-level hierarchy: the types of music, the titles within a given type, and the songs on a given title. Pluggability allows one to easily build a multipane browser for this object with separate list views for the music type, title, and song. - - AutoDeselect is a feature, normally set to true, that will tell the model that there is no selection if you click on an item that is currently selected. If autoDeselect is false, then the model will simply be told to select the same item again.! Item was removed: - ----- Method: PluggableListView class>>on:list:selected:changeSelected: (in category 'instance creation') ----- - on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel - "Create a 'pluggable' list view on the given model parameterized by the given message selectors." - - ^ self new - on: anObject - list: getListSel - selected: getSelectionSel - changeSelected: setSelectionSel - menu: nil - keystroke: #arrowKey:from: "default" - ! Item was removed: - ----- Method: PluggableListView class>>on:list:selected:changeSelected:menu: (in category 'instance creation') ----- - on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel - "Create a 'pluggable' list view on the given model parameterized by the given message selectors." - - ^ self new - on: anObject - list: getListSel - selected: getSelectionSel - changeSelected: setSelectionSel - menu: getMenuSel - keystroke: #arrowKey:from: "default" - - ! Item was removed: - ----- Method: PluggableListView class>>on:list:selected:changeSelected:menu:keystroke: (in category 'instance creation') ----- - on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel - "Create a 'pluggable' list view on the given model parameterized by the given message selectors." - - ^ self new - on: anObject - list: getListSel - selected: getSelectionSel - changeSelected: setSelectionSel - menu: getMenuSel - keystroke: keyActionSel - ! Item was removed: - ----- Method: PluggableListView>>autoDeselect: (in category 'initialization') ----- - autoDeselect: trueOrFalse - "Enable/disable autoDeselect (see class comment)" - autoDeselect := trueOrFalse.! Item was removed: - ----- Method: PluggableListView>>changeModelSelection: (in category 'model access') ----- - changeModelSelection: anInteger - "Change the model's selected item index to be anInteger." - | newIndex | - newIndex := anInteger. - (autoDeselect == nil or: [autoDeselect]) ifTrue: - [getSelectionSelector ifNotNil: - [(model perform: getSelectionSelector) = anInteger ifTrue: - ["Click on existing selection deselects" - newIndex := 0]]]. - - setSelectionSelector ifNotNil: - [model perform: setSelectionSelector with: newIndex].! Item was removed: - ----- Method: PluggableListView>>defaultControllerClass (in category 'controller access') ----- - defaultControllerClass - - ^ PluggableListController - ! Item was removed: - ----- Method: PluggableListView>>font: (in category 'initialization') ----- - font: aFontOrNil - - super font: aFontOrNil. - self list: self getList. "update display" - ! Item was removed: - ----- Method: PluggableListView>>getCurrentSelectionIndex (in category 'model access') ----- - getCurrentSelectionIndex - "Answer the index of the current selection." - - getSelectionSelector == nil ifTrue: [^ 0]. - ^ model perform: getSelectionSelector! Item was removed: - ----- Method: PluggableListView>>getList (in category 'model access') ----- - getList - "Answer the list to be displayed." - - | lst | - getListSelector == nil ifTrue: [^ #()]. - lst := model perform: getListSelector. - lst == nil ifTrue: [^ #()]. - ^ lst! Item was removed: - ----- Method: PluggableListView>>getListSelector (in category 'model access') ----- - getListSelector - ^ getListSelector! Item was removed: - ----- Method: PluggableListView>>getMenu: (in category 'model access') ----- - getMenu: shiftKeyDown - "Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key." - | menu aMenu | - getMenuSelector == nil ifTrue: [^ nil]. - menu := CustomMenu new. - getMenuSelector numArgs = 1 - ifTrue: - [aMenu := model perform: getMenuSelector with: menu. - getMenuTitleSelector ifNotNil: [aMenu title: (model perform: getMenuTitleSelector)]. - ^ aMenu]. - getMenuSelector numArgs = 2 - ifTrue: [aMenu := model perform: getMenuSelector with: menu with: shiftKeyDown. - getMenuTitleSelector ifNotNil: [aMenu title: (model perform: getMenuTitleSelector)]. - ^ aMenu]. - ^ self error: 'The getMenuSelector must be a 1- or 2-keyword symbol'! Item was removed: - ----- Method: PluggableListView>>handleKeystroke: (in category 'model access') ----- - handleKeystroke: aChar - "Answer the menu for this list view." - - | args aSpecialKey | - - aSpecialKey := aChar asciiValue. - aSpecialKey < 32 ifTrue: [ self specialKeyPressed: aSpecialKey. ^nil ]. - keystrokeActionSelector ifNil: [^ nil]. - - controller controlTerminate. - (args := keystrokeActionSelector numArgs) = 1 - ifTrue: [model perform: keystrokeActionSelector with: aChar. - ^ controller controlInitialize]. - args = 2 - ifTrue: [model perform: keystrokeActionSelector with: aChar with: self. - ^ controller controlInitialize]. - ^ self error: 'The keystrokeActionSelector must be a 1- or 2-keyword symbol'! Item was removed: - ----- Method: PluggableListView>>list: (in category 'initialization') ----- - list: arrayOfStrings - "Set the receivers items to be the given list of strings - The instance variable 'items' holds the original list. The instance variable 'list' is a paragraph constructed from this list." - - ((items == arrayOfStrings) "fastest" or: [items = arrayOfStrings]) ifTrue: [^ self]. - items := arrayOfStrings. - isEmpty := arrayOfStrings isEmpty. - - "add top and bottom delimiters" - list := ListParagraph - withArray: - (Array streamContents: [:s | - s nextPut: topDelimiter. - arrayOfStrings do: - [:item | item == nil ifFalse: - [(item isMemberOf: MethodReference) "A very specific fix for MVC" - ifTrue: [s nextPut: item asStringOrText] - ifFalse: [s nextPut: item]]]. - s nextPut: bottomDelimiter]) - style: self assuredTextStyle. - - selection := self getCurrentSelectionIndex. - self positionList.! Item was removed: - ----- Method: PluggableListView>>menu: (in category 'initialization') ----- - menu: getMenuSel - - getMenuSelector := getMenuSel! Item was removed: - ----- Method: PluggableListView>>menuTitleSelector: (in category 'initialization') ----- - menuTitleSelector: getMenuTitleSel - getMenuTitleSelector := getMenuTitleSel! Item was removed: - ----- Method: PluggableListView>>on:list:selected:changeSelected:menu:keystroke: (in category 'initialization') ----- - on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel - - self model: anObject. - getListSelector := getListSel. - getSelectionSelector := getSelectionSel. - setSelectionSelector := setSelectionSel. - getMenuSelector := getMenuSel. - keystrokeActionSelector := keyActionSel. - autoDeselect := true. - self borderWidth: 1. - self list: self getList.! Item was removed: - ----- Method: PluggableListView>>setSelectionSelectorIs: (in category 'model access') ----- - setSelectionSelectorIs: aSelector - ^ aSelector == setSelectionSelector! Item was removed: - ----- Method: PluggableListView>>specialKeyPressed: (in category 'model access') ----- - specialKeyPressed: keyEvent - "Process the up and down arrows in a list pane." - | oldSelection nextSelection max min howMany | - - (#(1 4 11 12 30 31) includes: keyEvent) ifFalse: [ ^ false ]. - - oldSelection := self getCurrentSelectionIndex. - nextSelection := oldSelection. - max := self maximumSelection. - min := self minimumSelection. - howMany := self numSelectionsInView. "get this exactly??" - - keyEvent = 31 ifTrue: - ["down-arrow; move down one, wrapping to top if needed" - nextSelection := oldSelection + 1. - nextSelection > max ifTrue: [nextSelection := 1]]. - - keyEvent = 30 ifTrue: - ["up arrow; move up one, wrapping to bottom if needed" - nextSelection := oldSelection - 1. - nextSelection < 1 ifTrue: [nextSelection := max]]. - - keyEvent = 1 ifTrue: [nextSelection := 1]. "home" - keyEvent = 4 ifTrue: [nextSelection := max]. "end" - keyEvent = 11 ifTrue: [nextSelection := min max: (oldSelection - howMany)]. "page up" - keyEvent = 12 ifTrue: [nextSelection := (oldSelection + howMany) min: max]. "page down" - nextSelection = oldSelection ifFalse: - [model okToChange - ifTrue: - [self changeModelSelection: nextSelection. - "self controller moveMarker"]]. - - ^true - ! Item was removed: - ----- Method: PluggableListView>>update: (in category 'updating') ----- - update: aSymbol - "Refer to the comment in View|update:." - aSymbol == getListSelector ifTrue: - [self list: self getList. - self displayView. - self displaySelectionBox. - ^self]. - aSymbol == getSelectionSelector ifTrue: - [^ self moveSelectionBox: self getCurrentSelectionIndex]. - aSymbol == #startNewBrowser ifTrue: - [(self setSelectionSelectorIs: #classListIndex:) ifTrue: [ - "A SelectorBrowser is about to open a new Browser on a class" - self controller controlTerminate]] - ! Item was removed: - ----- Method: PluggableListView>>verifyContents (in category 'updating') ----- - verifyContents - | newItems existingSelection anIndex | - "Called on window reactivation to react to possible structural changes. Update contents if necessary." - - newItems := self getList. - ((items == newItems) "fastest" or: [items = newItems]) ifTrue: [^ self]. - self flash. "list has changed beneath us; could get annoying, but hell" - existingSelection := list stringAtLineNumber: (selection + (topDelimiter ifNil: [0] ifNotNil: [1])). "account for cursed ------ row" - self list: newItems. - - (newItems size > 0 and: [newItems first isSymbol]) ifTrue: - [existingSelection := existingSelection asSymbol]. - (anIndex := newItems indexOf: existingSelection ifAbsent: [nil]) - ifNotNil: - [model noteSelectionIndex: anIndex for: getListSelector.] - ifNil: - [self changeModelSelection: 0]. - selection := 0. " to display the list without selection " - self displayView. - self update: getSelectionSelector. - ! Item was removed: - PluggableListView subclass: #PluggableListViewByItem - instanceVariableNames: 'itemList' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Pluggable Views'! Item was removed: - ----- Method: PluggableListViewByItem>>changeModelSelection: (in category 'model access') ----- - changeModelSelection: anInteger - "Change the model's selected item to be the one at the given index." - | item | - setSelectionSelector ifNotNil: [ - item := (anInteger = 0 ifTrue: [nil] ifFalse: [itemList at: anInteger]). - model perform: setSelectionSelector with: item]. - ! Item was removed: - ----- Method: PluggableListViewByItem>>getCurrentSelectionIndex (in category 'model access') ----- - getCurrentSelectionIndex - "Answer the index of the current selection." - | item | - getSelectionSelector == nil ifTrue: [^ 0]. - item := model perform: getSelectionSelector. - ^ itemList findFirst: [ :x | x = item] - ! Item was removed: - ----- Method: PluggableListViewByItem>>getList (in category 'model access') ----- - getList - "Ensure that there are only strings in that list." - - ^ super getList collect: [:ea | ea asString]! Item was removed: - ----- Method: PluggableListViewByItem>>list: (in category 'initialization') ----- - list: arrayOfStrings - "Set the receivers items to be the given list of strings." - "Note: the instance variable 'items' holds the original list. - The instance variable 'list' is a paragraph constructed from - this list." - - itemList := arrayOfStrings. - isEmpty := arrayOfStrings isEmpty. - - "add top and bottom delimiters" - list := ListParagraph - withArray: - (Array streamContents: [:s | - s nextPut: topDelimiter. - arrayOfStrings do: [:item | item == nil ifFalse: [s nextPut: item]]. - s nextPut: bottomDelimiter]) - style: self assuredTextStyle. - - selection := self getCurrentSelectionIndex. - self positionList.! Item was removed: - PluggableListView subclass: #PluggableListViewOfMany - instanceVariableNames: 'getSelectionListSelector setSelectionListSelector' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Pluggable Views'! Item was removed: - ----- Method: PluggableListViewOfMany class>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu: (in category 'instance creation') ----- - on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel - ^ self new - on: anObject - list: listSel - primarySelection: getSelectionSel - changePrimarySelection: setSelectionSel - listSelection: getListSel - changeListSelection: setListSel - menu: getMenuSel - keystroke: #arrowKey:from: "default"! Item was removed: - ----- Method: PluggableListViewOfMany class>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu:keystroke: (in category 'instance creation') ----- - on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel keystroke: keyActionSel - ^ self new - on: anObject - list: listSel - primarySelection: getSelectionSel - changePrimarySelection: setSelectionSel - listSelection: getListSel - changeListSelection: setListSel - menu: getMenuSel - keystroke: keyActionSel! Item was removed: - ----- Method: PluggableListViewOfMany>>deEmphasizeView (in category 'displaying') ----- - deEmphasizeView - "Refer to the comment in View|deEmphasizeView." - selection := 0. - 1 to: self maximumSelection do: - [:i | selection := i. - (self listSelectionAt: i) ifTrue: [self deEmphasizeSelectionBox]]. - selection := 0! Item was removed: - ----- Method: PluggableListViewOfMany>>defaultControllerClass (in category 'controller access') ----- - defaultControllerClass - - ^ PluggableListControllerOfMany - ! Item was removed: - ----- Method: PluggableListViewOfMany>>highlightFrom:to: (in category 'displaying') ----- - highlightFrom: start to: stop - (start == nil or: [stop == nil]) ifTrue: [^ self displayView]. - start to: stop do: - [:i | selection := i. - (self listSelectionAt: selection) ifTrue: [self displaySelectionBox]]. - selection := 0! Item was removed: - ----- Method: PluggableListViewOfMany>>listSelectionAt: (in category 'selecting') ----- - listSelectionAt: index - getSelectionListSelector ifNil:[^false]. - ^model perform: getSelectionListSelector with: index! Item was removed: - ----- Method: PluggableListViewOfMany>>listSelectionAt:put: (in category 'selecting') ----- - listSelectionAt: index put: value - setSelectionListSelector ifNil:[^false]. - ^model perform: setSelectionListSelector with: index with: value! Item was removed: - ----- Method: PluggableListViewOfMany>>moveSelectionBox: (in category 'selecting') ----- - moveSelectionBox: anInteger - "Presumably the selection has changed to be anInteger. Deselect the - previous selection and display the new one, highlighted." - selection ~= anInteger - ifTrue: - [selection := anInteger. - self displaySelectionBox]! Item was removed: - ----- Method: PluggableListViewOfMany>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu:keystroke: (in category 'initialization') ----- - on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel keystroke: keyActionSel - "setup a whole load of pluggability options" - getSelectionListSelector := getListSel. - setSelectionListSelector := setListSel. - super on: anObject list: listSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel - ! Item was removed: - ----- Method: PluggableListViewOfMany>>scrollBy: (in category 'displaying') ----- - scrollBy: anInteger - "This is a possible way to intercept what ListOfManyController did to get multiple selections to show. Feel to replace this." - - | ans | - ans := super scrollBy: anInteger. - " self displaySelectionBox." - ^ ans! Item was removed: - ----- Method: PluggableListViewOfMany>>selection (in category 'selecting') ----- - selection - "Have to override normal controller smarts about deselection" - ^ 0! Item was removed: - ----- Method: PluggableListViewOfMany>>update: (in category 'updating') ----- - update: aSymbol - aSymbol == getListSelector - ifTrue: [self list: self getList. - ^ self displayView; emphasizeView]. - aSymbol == getSelectionSelector - ifTrue: [^ self displayView; emphasizeView]. - aSymbol == #allSelections - ifTrue: [^ self displayView; emphasizeView]. - ^ super update: aSymbol! Item was removed: - Object subclass: #PluggableTest - instanceVariableNames: 'musicTypeList musicTypeIndex artistList artistIndex' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Pluggable Views'! - - !PluggableTest commentStamp: '<historical>' prior: 0! - This class demonstrates how to use PluggableListViews. - ! Item was removed: - ----- Method: PluggableTest class>>open (in category 'example') ----- - open - "PluggableTest open" - - | model listView1 topView listView2 | - model := self new. - listView1 := PluggableListView - on: model - list: #musicTypeList - selected: #musicType - changeSelected: #musicType: - menu: #musicTypeMenu: - keystroke: #musicTypeKeystroke:. - listView1 menuTitleSelector: #musicTypeListTitle. - listView2 := PluggableListView - on: model - list: #artistList - selected: #artist - changeSelected: #artist: - menu: nil - keystroke: #artistKeystroke:. - topView := (StandardSystemView new) - label: 'Pluggable Test'; - minimumSize: 300 @ 200; - borderWidth: 1; - addSubView: listView1; - addSubView: listView2 toRightOf: listView1. - topView borderWidth: 1. - topView controller open! Item was removed: - ----- Method: PluggableTest>>artist (in category 'artist pane') ----- - artist - - ^ artistIndex - ! Item was removed: - ----- Method: PluggableTest>>artist: (in category 'artist pane') ----- - artist: anInteger - - artistIndex := anInteger. - self changed: #artist. - ! Item was removed: - ----- Method: PluggableTest>>artistKeystroke: (in category 'artist pane') ----- - artistKeystroke: aCharacter - - self artistList withIndexDo: [:artist :i | - (artist first asLowercase = aCharacter asLowercase) ifTrue: [ - self artist: i]]. - ! Item was removed: - ----- Method: PluggableTest>>artistList (in category 'artist pane') ----- - artistList - - ((musicTypeIndex ~= nil) and: - [musicTypeIndex between: 1 and: artistList size]) - ifTrue: [^ artistList at: musicTypeIndex] - ifFalse: [^ #()]. - ! Item was removed: - ----- Method: PluggableTest>>artistName (in category 'artist pane') ----- - artistName - "Answer the name of the currently selected artist, or nil if no artist is selected." - - | artistsForCurrentType | - artistsForCurrentType := self artistList. - (artistIndex between: 1 and: artistsForCurrentType size) - ifTrue: [^ artistsForCurrentType at: artistIndex] - ifFalse: [^ nil]. - ! Item was removed: - ----- Method: PluggableTest>>earlyCmd (in category 'menu commands') ----- - earlyCmd - - self musicType: (musicTypeList indexOf: 'early'). - ! Item was removed: - ----- Method: PluggableTest>>flashCmd (in category 'menu commands') ----- - flashCmd - - Display reverse; reverse.! Item was removed: - ----- Method: PluggableTest>>grungeCmd (in category 'menu commands') ----- - grungeCmd - - SelectionMenu confirm: - 'You mean, like those strange bands from Seattle?'! Item was removed: - ----- Method: PluggableTest>>initialize (in category 'initialization') ----- - initialize - - musicTypeList := #('reggae' 'classical' 'early'). - artistList := #( - ('alpha blondy' 'black uhuru' 'bob marley' 'burning spear') - ('bach' 'beethoven' 'josquin' 'morley' 'mozart' 'telemann') - ('josquin' 'morley' 'telemann')). - musicTypeIndex := 0. - artistIndex := 0. - ! Item was removed: - ----- Method: PluggableTest>>musicType (in category 'music type pane') ----- - musicType - - ^ musicTypeIndex - ! Item was removed: - ----- Method: PluggableTest>>musicType: (in category 'music type pane') ----- - musicType: anInteger - - | oldArtist | - oldArtist := self artistName. - musicTypeIndex := anInteger. "this changes artists list" - artistIndex := self artistList indexOf: oldArtist. - self changed: #musicType. - self changed: #artistList. - ! Item was removed: - ----- Method: PluggableTest>>musicTypeKeystroke: (in category 'music type pane') ----- - musicTypeKeystroke: aCharacter - - musicTypeList withIndexDo: [:type :i | - (type first asLowercase = aCharacter asLowercase) - ifTrue: [self musicType: i]]. - ! Item was removed: - ----- Method: PluggableTest>>musicTypeList (in category 'music type pane') ----- - musicTypeList - - ^ musicTypeList - ! Item was removed: - ----- Method: PluggableTest>>musicTypeListTitle (in category 'music type pane') ----- - musicTypeListTitle - ^ 'Choose a command'! Item was removed: - ----- Method: PluggableTest>>musicTypeMenu: (in category 'music type pane') ----- - musicTypeMenu: aMenu - - ^ aMenu addList: #( - (reggae reggaeCmd) - (early earlyCmd) - (grunge grungeCmd) - - - (flash flashCmd)) - ! Item was removed: - ----- Method: PluggableTest>>musicTypeName (in category 'music type pane') ----- - musicTypeName - "Answer the name of the currently selected music type, or nil if no music type is selected." - - (musicTypeIndex between: 1 and: musicTypeList size) - ifTrue: [^ musicTypeList at: musicTypeIndex] - ifFalse: [^ nil]. - ! Item was removed: - ----- Method: PluggableTest>>reggaeCmd (in category 'menu commands') ----- - reggaeCmd - - self musicType: (musicTypeList indexOf: 'reggae'). - ! Item was removed: - StringHolderController subclass: #PluggableTextController - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Pluggable Views'! Item was removed: - ----- Method: PluggableTextController>>accept (in category 'menu messages') ----- - accept - view hasUnacceptedEdits ifFalse: [^ view flash]. - view hasEditingConflicts ifTrue: - [(self confirm: - 'Caution!! This method may have been - changed elsewhere since you started - editing it here. Accept anyway?' translated) ifFalse: [^ self flash]]. - - (view setText: paragraph text from: self) == true ifTrue: - [initialText := paragraph text copy. - view ifNotNil: [view hasUnacceptedEdits: false]] . - ! Item was removed: - ----- Method: PluggableTextController>>appendEntry (in category 'transcript') ----- - appendEntry - "Append the text in the model's writeStream to the editable text. " - self deselect. - paragraph text size > model characterLimit ifTrue: - ["Knock off first half of text" - self selectInvisiblyFrom: 1 to: paragraph text size // 2. - self replaceSelectionWith: Text new]. - self selectInvisiblyFrom: paragraph text size + 1 to: paragraph text size. - self replaceSelectionWith: model contents asText. - self selectInvisiblyFrom: paragraph text size + 1 to: paragraph text size! Item was removed: - ----- Method: PluggableTextController>>bsText (in category 'transcript') ----- - bsText - self changeText: (self text copyFrom: 1 to: (self text size - 1 max: 0))! Item was removed: - ----- Method: PluggableTextController>>changeText: (in category 'transcript') ----- - changeText: aText - "The paragraph to be edited is changed to aText." - paragraph text: aText. - self resetState. - self selectInvisiblyFrom: paragraph text size + 1 to: paragraph text size. - self selectAndScroll. - self deselect! Item was removed: - ----- Method: PluggableTextController>>doOccluded: (in category 'transcript') ----- - doOccluded: actionBlock - | paneRect rectSet bottomStrip | - paneRect := paragraph clippingRectangle. - paragraph withClippingRectangle: (paneRect withHeight: 0) - do: [actionBlock value. - self scrollIn: paneRect]. - view topView isCollapsed ifTrue: [^ self]. - rectSet := self visibleAreas. - bottomStrip := paneRect withTop: paragraph compositionRectangle bottom + 1. - rectSet do: - [:rect | - (bottomStrip intersects: rect) ifTrue: - ["The subsequent displayOn should clear this strip but it doesnt" - Display fill: (bottomStrip intersect: rect) - fillColor: paragraph backgroundColor]. - paragraph withClippingRectangle: rect - do: [paragraph displayOn: Display]]! Item was removed: - ----- Method: PluggableTextController>>scrollIn: (in category 'transcript') ----- - scrollIn: scrollRect - "Altered from selectAndScroll so can use with null clipRect" - "Scroll until the selection is in the view and then highlight it." - | deltaY | - deltaY := self stopBlock top - scrollRect top. - deltaY >= 0 - ifTrue: [deltaY := self stopBlock bottom - scrollRect bottom max: 0]. - "check if stopIndex below bottom of scrollRect" - deltaY ~= 0 - ifTrue: [self scrollBy: (deltaY abs + paragraph lineGrid - 1) * deltaY sign]! Item was removed: - ----- Method: PluggableTextController>>selectForTopFrom:to: (in category 'accessing-selection') ----- - selectForTopFrom: start to: stop - "Deselect, then select the specified characters inclusive. - Be sure the selection is in view." - - self selectFrom: start to: stop scroll: #selectAndScrollToTop! Item was removed: - ----- Method: PluggableTextController>>selectFrom:to: (in category 'accessing-selection') ----- - selectFrom: start to: stop - "Deselect, then select the specified characters inclusive. - Be sure the selection is in view." - - self selectFrom: start to: stop scroll: #selectAndScroll! Item was removed: - ----- Method: PluggableTextController>>selectFrom:to:scroll: (in category 'accessing-selection') ----- - selectFrom: start to: stop scroll: scrollCommand - "Deselect, then select the specified characters inclusive. - Be sure the selection is in view." - - (start = self startIndex and: [stop + 1 = self stopIndex]) ifFalse: - [view superView ifNotNil: [self deselect]. - self selectInvisiblyFrom: start to: stop]. - view superView ifNotNil: [self perform: scrollCommand]! Item was removed: - ----- Method: PluggableTextController>>userHasEdited (in category 'edit flag') ----- - userHasEdited - "Note that the user has edited my text." - - view hasUnacceptedEdits: true! Item was removed: - ----- Method: PluggableTextController>>userHasNotEdited (in category 'edit flag') ----- - userHasNotEdited - "Note that my text is free of user edits." - - view hasUnacceptedEdits: false! Item was removed: - ----- Method: PluggableTextController>>visibleAreas (in category 'transcript') ----- - visibleAreas - "Transcript dependents last controller visibleAreas" - | myTopController visibleAreas | - myTopController := self view topView controller. - visibleAreas := Array with: view insetDisplayBox. - myTopController view uncacheBits. - ScheduledControllers scheduledWindowControllers do: - [:c | | remnants rect | - c == myTopController ifTrue: [^ visibleAreas]. - rect := c view windowBox. - remnants := OrderedCollection new. - visibleAreas do: [:a | remnants addAll: (a areasOutside: rect)]. - visibleAreas := remnants]. - ^ visibleAreas! Item was removed: - StringHolderView subclass: #PluggableTextView - instanceVariableNames: 'getTextSelector setTextSelector getSelectionSelector getMenuSelector hasEditingConflicts' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Pluggable Views'! - - !PluggableTextView commentStamp: '<historical>' prior: 0! - A PluggableTextView gets its content from the model. This allows the same kind of view to be used in different situations, thus avoiding a proliferation of gratuitous view and controller classes. See the class comment for PluggableListView. - - Selectors are: - - getTextSel fetch the original text from the model - setTextSel submit new text to the model when user "accepts" - getSelectionSel get the current text selection range - getMenuSel get the pane-specific, 'yellow-button' menu - - Any of the above selectors can be nil, meaning that the model does not supply behavior for the given action, and the default behavior should be used. For example, if setTextSel is nil then this view is consider read-only. - - The model informs a pluggable view of changes by sending #changed: to itself with getTextSel as a parameter. The view informs the model of selection changes by sending setTextSel to it with the newly selected item as a parameter, and invokes menu actions on the model via getMenuSel. - ! Item was removed: - ----- Method: PluggableTextView class>>on:text:accept: (in category 'instance creation') ----- - on: anObject text: getTextSel accept: setTextSel - - ^ self on: anObject - text: getTextSel - accept: setTextSel - readSelection: nil - menu: nil - ! Item was removed: - ----- Method: PluggableTextView class>>on:text:accept:readSelection:menu: (in category 'instance creation') ----- - on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel - - ^ self new on: anObject - text: getTextSel - accept: setTextSel - readSelection: getSelectionSel - menu: getMenuSel - ! Item was removed: - ----- Method: PluggableTextView>>convertToCurrentVersion:refStream: (in category 'object fileIn') ----- - convertToCurrentVersion: varDict refStream: smartRefStrm - - hasEditingConflicts ifNil: [hasEditingConflicts := false]. - ^super convertToCurrentVersion: varDict refStream: smartRefStrm. - - ! Item was removed: - ----- Method: PluggableTextView>>defaultControllerClass (in category 'initialization') ----- - defaultControllerClass - - ^ PluggableTextController - ! Item was removed: - ----- Method: PluggableTextView>>getMenu: (in category 'model access') ----- - getMenu: shiftKeyDown - "Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key." - - | menu | - getMenuSelector == nil ifTrue: [^ nil]. - menu := CustomMenu new. - getMenuSelector numArgs = 1 - ifTrue: [^ model perform: getMenuSelector with: menu]. - getMenuSelector numArgs = 2 - ifTrue: [^ model perform: getMenuSelector with: menu with: shiftKeyDown]. - ^ self error: 'The getMenuSelector must be a 1- or 2-keyword symbol'! Item was removed: - ----- Method: PluggableTextView>>getSelection (in category 'model access') ----- - getSelection - "Answer the model's selection interval." - - getSelectionSelector == nil ifTrue: [^ 1 to: 0]. "null selection" - ^ getSelectionSelector ifNotNil: [model perform: getSelectionSelector] - ! Item was removed: - ----- Method: PluggableTextView>>getText (in category 'model access') ----- - getText - "Answer the list to be displayed." - | txt | - getTextSelector == nil ifTrue: [^ Text new]. - txt := model perform: getTextSelector. - txt == nil ifTrue: [^ Text new]. - self hasUnacceptedEdits: false. "clean now" - ^ txt! Item was removed: - ----- Method: PluggableTextView>>getTextSelector (in category 'model access') ----- - getTextSelector - "This is sent to the model to find out what text to display" - - ^ getTextSelector! Item was removed: - ----- Method: PluggableTextView>>hasEditingConflicts (in category 'updating') ----- - hasEditingConflicts - "Return true if a conflicting edit to the same code (typically) is known to have occurred after the current contents started getting edited" - - ^ hasEditingConflicts == true! Item was removed: - ----- Method: PluggableTextView>>hasEditingConflicts: (in category 'updating') ----- - hasEditingConflicts: aBoolean - hasEditingConflicts := aBoolean! Item was removed: - ----- Method: PluggableTextView>>hasUnacceptedEdits: (in category 'updating') ----- - hasUnacceptedEdits: aBoolean - super hasUnacceptedEdits: aBoolean. - aBoolean ifFalse: [hasEditingConflicts := false]! Item was removed: - ----- Method: PluggableTextView>>initialize (in category 'initialization') ----- - initialize - super initialize. - hasEditingConflicts := false! Item was removed: - ----- Method: PluggableTextView>>isReadOnlyView (in category 'model access') ----- - isReadOnlyView - - ^ setTextSelector == nil - ! Item was removed: - ----- Method: PluggableTextView>>isTextView (in category 'testing') ----- - isTextView - "True if the reciever is a view on a text model, such as a view on a TranscriptStream" - ^true! Item was removed: - ----- Method: PluggableTextView>>model: (in category 'model access') ----- - model: aLockedModel - "Refer to the comment in View|model:." - - self model: aLockedModel controller: controller. - self editString: self getText. - ! Item was removed: - ----- Method: PluggableTextView>>on:text:accept:readSelection:menu: (in category 'initialization') ----- - on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel - - self model: anObject. - getTextSelector := getTextSel. - setTextSelector := setTextSel. - getSelectionSelector := getSelectionSel. - getMenuSelector := getMenuSel. - self borderWidth: 1. - self editString: self getText. - self setSelection: self getSelection. - - ! Item was removed: - ----- Method: PluggableTextView>>selectionInterval (in category 'controller access') ----- - selectionInterval - - ^self controller selectionInterval! Item was removed: - ----- Method: PluggableTextView>>setSelection: (in category 'initialization') ----- - setSelection: sel - - controller selectFrom: sel first to: sel last. - ! Item was removed: - ----- Method: PluggableTextView>>setText:from: (in category 'model access') ----- - setText: textToAccept from: ctlr - "Inform the model of text to be accepted, and return true if OK. - Any errors should be reported to the controller, ctlr." - setTextSelector == nil ifTrue: [^ true]. - setTextSelector numArgs = 2 - ifTrue: [^ model perform: setTextSelector with: textToAccept with: ctlr] - ifFalse: [^ model perform: setTextSelector with: textToAccept]! Item was removed: - ----- Method: PluggableTextView>>tallyIt (in category 'controller access') ----- - tallyIt - - ^ self controller tallyIt! Item was removed: - ----- Method: PluggableTextView>>update: (in category 'updating') ----- - update: aSymbol - "Refer to the comment in View|update:. Do nothing if the given symbol does not match any action. " - - aSymbol == #wantToChange ifTrue: - [self canDiscardEdits ifFalse: [self promptForCancel]. ^ self]. - aSymbol == #flash ifTrue: [^ controller flash]. - aSymbol == getTextSelector ifTrue: [^ self updateDisplayContents]. - aSymbol == getSelectionSelector ifTrue: [^ self setSelection: self getSelection]. - aSymbol == #clearUserEdits ifTrue: [^ self hasUnacceptedEdits: false]. - (aSymbol == #autoSelect and: [getSelectionSelector ~~ nil]) ifTrue: - [ParagraphEditor abandonChangeText. "no replacement!!" - ^ controller setSearch: model autoSelectString; - againOrSame: true]. - (#(#appendEntry appendEntryLater) includes: aSymbol) ifTrue: - [^ controller doOccluded: [controller appendEntry]]. - aSymbol == #clearText ifTrue: - [^ controller doOccluded: - [controller changeText: Text new]]. - aSymbol == #bs ifTrue: - [^ controller doOccluded: - [controller bsText]]. - aSymbol == #codeChangedElsewhere ifTrue: - [^ self hasEditingConflicts: true]. - aSymbol == #saveContents ifTrue: - [^self controller saveContentsInFile]. - aSymbol == #close ifTrue: - [^self topView controller closeAndUnscheduleNoTerminate]. - aSymbol == #acceptChanges ifTrue: - [^ self controller accept]. - aSymbol == #revertChanges ifTrue: - [^ self controller cancel].! Item was removed: - ----- Method: PluggableTextView>>update:with: (in category 'updating') ----- - update: aSymbol with: arg1 - aSymbol == #editString ifTrue:[ - self editString: arg1. - ^self hasUnacceptedEdits: true. - ]. - ^super update: aSymbol with: arg1! Item was removed: - ----- Method: PluggableTextView>>updateDisplayContents (in category 'model access') ----- - updateDisplayContents - - self editString: self getText. - self displayView. - self setSelection: self getSelection. - ! Item was removed: - ----- Method: PopUpMenu>>computeLabelParagraph (in category '*ST80-Support') ----- - computeLabelParagraph - "Answer a Paragraph containing this menu's labels, one per line and centered." - - ^ Paragraph withText: labelString asText style: self class standardMenuStyle! Item was removed: - ----- Method: PopUpMenu>>mvcStartUpWithCaption:icon:at:allowKeyboard: (in category '*ST80-Menus') ----- - mvcStartUpWithCaption: captionOrNil icon: aForm at: location allowKeyboard: aBoolean - "Display the menu, with caption if supplied. Wait for the mouse button to go down, then track the selection as long as the button is pressed. When the button is released, - Answer the index of the current selection, or zero if the mouse is not released over any menu item. Location specifies the desired topLeft of the menu body rectangle. The final argument indicates whether the menu should seize the keyboard focus in order to allow the user to navigate it via the keyboard." - - frame ifNil: [self computeForm]. - Cursor normal showWhile: - [self - displayAt: location - withCaption: (captionOrNil ifNotNil: [ - "This is a compromise. See commentary in DialogWindow >> #message:." - captionOrNil withNoLineLongerThan: (captionOrNil size > 900 ifTrue: [65] ifFalse: [45])]) - during: [self controlActivity]]. - ^ selection! Item was removed: - ----- Method: Project class>>allMVCProjects (in category '*ST80-Support') ----- - allMVCProjects - - ^ self allProjects select: [:p | p isMVC]! Item was removed: - ----- Method: Project>>isMVC (in category '*ST80-Testing') ----- - isMVC - - ^ false! Item was removed: - StandardSystemController subclass: #ProjectController - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Support'! Item was removed: - ----- Method: ProjectController>>redButtonActivity (in category 'control activity') ----- - redButtonActivity - | index | - view isCollapsed ifTrue: [^ super redButtonActivity]. - (view insetDisplayBox containsPoint: Sensor cursorPoint) - ifFalse: [^ super redButtonActivity]. - index := (UIManager default chooseFrom: #('enter' 'jump to project...') lines: #()). - index = 0 ifTrue: [^ self]. - - "save size on enter for thumbnail on exit" - model viewSize: view insetDisplayBox extent. - index = 1 ifTrue: [^ model enter: false revert: false saveForRevert: false]. - index = 2 ifTrue: [Project current jumpToProject. ^ self]. - ! Item was removed: - StandardSystemView subclass: #ProjectView - instanceVariableNames: '' - classVariableNames: 'ArmsLengthCmd' - poolDictionaries: '' - category: 'ST80-Support'! - - !ProjectView commentStamp: 'dtl 4/30/2016 18:32' prior: 0! - I am a view of a project. I display a scaled version of the project's thumbnail, which itself is a scaled-down snapshot of the screen taken when the project was last exited. - ! Item was removed: - ----- Method: ProjectView class>>open: (in category 'opening') ----- - open: aProject - "Answer an instance of me for the argument, aProject. It is created on the - display screen." - | topView | - topView := self new model: aProject. - topView minimumSize: 50 @ 30. - topView borderWidth: 2. - topView controller open! Item was removed: - ----- Method: ProjectView class>>openAndEnter: (in category 'opening') ----- - openAndEnter: aProject - "Answer an instance of me for the argument, aProject. It is created on - the display screen." - | topView | - topView := self new model: aProject. - topView minimumSize: 50 @ 30. - topView borderWidth: 2. - topView window: (RealEstateAgent initialFrameFor: topView world: nil). - ScheduledControllers schedulePassive: topView controller. - aProject - enter: false - revert: false - saveForRevert: false! Item was removed: - ----- Method: ProjectView>>armsLengthCommand: (in category 'displaying') ----- - armsLengthCommand: aCommand - "Set up a save to be done after the subproject exits to here. displayOn: checks it." - - ArmsLengthCmd := aCommand.! Item was removed: - ----- Method: ProjectView>>defaultControllerClass (in category 'initialization') ----- - defaultControllerClass - ^ ProjectController! Item was removed: - ----- Method: ProjectView>>displayDeEmphasized (in category 'displaying') ----- - displayDeEmphasized - | cmd | - "Display this view with emphasis off. Check for a command that - could not be executed in my subproject. Once it is done, remove the - trigger." - - super displayDeEmphasized. - ArmsLengthCmd ifNil: [^ self]. - ArmsLengthCmd first == model ifFalse: [^ self]. "not ours" - cmd := ArmsLengthCmd second. - ArmsLengthCmd := nil. - model "project" perform: cmd. - model "project" enter. - ! Item was removed: - ----- Method: ProjectView>>displayView (in category 'displaying') ----- - displayView - super displayView. - self label = model name - ifFalse: [self setLabelTo: model name]. - self isCollapsed ifTrue: [^ self]. - model thumbnail ifNil: [^ self]. - self insetDisplayBox extent = model thumbnail extent - ifTrue: [model thumbnail displayAt: self insetDisplayBox topLeft] - ifFalse: [(model thumbnail - magnify: model thumbnail boundingBox - by: self insetDisplayBox extent asFloatPoint / model thumbnail extent) displayAt: self insetDisplayBox topLeft] - ! Item was removed: - ----- Method: ProjectView>>maybeRelabel: (in category 'initialization') ----- - maybeRelabel: newLabel - "If the change set name given by newLabel is already in use, do nothing; else relabel the view" - - (newLabel isEmpty or: [newLabel = self label]) - ifTrue: [^ self]. - (ChangeSet named: newLabel) == nil - ifFalse: [^ self]. - self relabel: newLabel! Item was removed: - ----- Method: ProjectView>>relabel: (in category 'initialization') ----- - relabel: newLabel - (newLabel isEmpty or: [newLabel = self label]) - ifTrue: [^ self]. - (ChangeSet named: newLabel) == nil - ifFalse: [self inform: 'Sorry that name is already used'. - ^ self]. - model projectChangeSet name: newLabel. - super relabel: newLabel! Item was removed: - ----- Method: ProjectView>>release (in category 'displaying') ----- - release - super release. - Smalltalk garbageCollect! Item was removed: - ----- Method: ProjectView>>uncacheBits (in category 'initialization') ----- - uncacheBits - super uncacheBits. - self label ~= model name ifTrue: [self setLabelTo: model name]! Item was removed: - PluggableTextController subclass: #ReadOnlyTextController - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Pluggable Views'! Item was removed: - ----- Method: ReadOnlyTextController>>accept (in category 'menu messages') ----- - accept - "Overridden to allow accept of clean text" - (view setText: paragraph text from: self) ifTrue: - [initialText := paragraph text copy. - view ifNotNil: [view hasUnacceptedEdits: false]]. - ! Item was removed: - ----- Method: ReadOnlyTextController>>userHasEdited (in category 'edit flag') ----- - userHasEdited - "Ignore this -- I stay clean"! Item was removed: - ----- Method: ReadOnlyTextController>>zapSelectionWith: (in category 'private') ----- - zapSelectionWith: aText - view flash "no edits allowed"! Item was removed: - TestCase subclass: #ST80MenusTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Menus-Tests'! - - !ST80MenusTest commentStamp: 'eem 3/30/2017 17:33' prior: 0! - I am an SUnit Test of PopUpMenu and FillInTheBlank. The original motivation for my creation was the regression of functionality associated with allowing the non-interactive testing of these menus. - - My fixtures are: None - - NOTES ABOUT AUTOMATING USER INPUTS (See MethodContextTest also for a discussion of this functionality.) - - When executing non-interactive programs you will inevitably run into programs that require user input during their execution and these sort of problems shoot the whole non-interactiveness of your enclosing program. This is particularly true in doing Sunit tests. - - PopUpMenu and FillInTheBlankMorph were modified to first signal a ProvideAnswerNotification and if someone handles that (e.g. the enclosing block) then the user interaction will be avoided and a answer provided by an array will be used instead. PopUpMenu and FillInTheBlankMorph take advantage of BlockClosure helper methods have been made available and tests of these helpers are provided in this class to demonstrate that it can intercept requests for user interaction. Of course, - - The basic syntax looks like: - - [self confirm: 'Install spyware?'] valueSupplyingAnswer: #('Install spyware?' false) - - There a few variants on this theme making it easy to provide a literal list of answers for the block so that you can handle a bunch of questions in a block with appropriate answers. - - Additionally, it is possible to suppress Object>>inform: modal dialog boxes as these get in the way of automating anything. After applying this changeset you should be able to tryout the following code snippets to see the variants on this theme that are available. - - Examples: - - So you don't need any introduction here -- this one works like usual. - [self inform: 'hello'. #done] value. - - Now let's suppress all inform: messages. - [self inform: 'hello'; inform: 'there'. #done] valueSuppressingAllMessages. - - Here we can just suppress a single inform: message. - [self inform: 'hi'; inform: 'there'. #done] valueSuppressingMessages: #('there') - - Here you see how you can suppress a list of messages. - [self inform: 'hi'; inform: 'there'; inform: 'bill'. #done] valueSuppressingMessages: #('hi' 'there') - - Enough about inform:, let's look at confirm:. As you see this one works as expected. - [self confirm: 'You like Squeak?'] value - - Let's supply answers to one of the questions -- check out the return value. - [{self confirm: 'You like Smalltalk?'. self confirm: 'You like Squeak?'}] - valueSupplyingAnswer: #('You like Smalltalk?' true) - - Here we supply answers using only substrings of the questions (for simplicity). - [{self confirm: 'You like Squeak?'. self confirm: 'You like MVC?'}] - valueSupplyingAnswers: #( ('Squeak' true) ('MVC' false) ) - - This time let's answer all questions exactly the same way. - [{self confirm: 'You like Squeak?'. self confirm: 'You like Morphic?'}] - valueSupplyingAnswer: true - - And, of course, we can answer FillInTheBlank questions in the same manner. - [FillInTheBlank request: 'What day is it?'] - valueSupplyingAnswer: 'the first day of the rest of your life' - - We can also return whatever the initialAnswer of the FillInTheBlank was by using the #default answer. - [FillInTheBlank request: 'What day is it?' initialAnswer: DateAndTime now dayOfWeekName] - valueSupplyingAnswer: #default - - Finally, you can also do regex matches on any of the question text (or inform text) (should you have VB-Regex enhancements in your image). - [FillInTheBlank request: 'What day is it?'] - valueSupplyingAnswers: { {'What day.*\?'. DateAndTime now dayOfWeekName} }! Item was removed: - ----- Method: ST80MenusTest>>testSupplyAnswerOfFillInTheBlank (in category 'tests') ----- - testSupplyAnswerOfFillInTheBlank - - self should: ['blue' = ([UIManager default request: 'Should not see this message or this test failed?'] - valueSupplyingAnswer: #('Should not see this message or this test failed?' 'blue'))]! Item was removed: - ----- Method: ST80MenusTest>>testSupplySpecificAnswerToQuestion (in category 'tests') ----- - testSupplySpecificAnswerToQuestion - - self should: [false = ([self confirm: 'Should not see this message or this test failed?'] - valueSupplyingAnswer: #('Should not see this message or this test failed?' false))]! Item was removed: - ----- Method: ST80MenusTest>>testSuppressInform (in category 'tests') ----- - testSuppressInform - - self should: [[nil inform: 'Should not see this message or this test failed!!'] valueSuppressingAllMessages isNil]! Item was removed: - Controller subclass: #ScreenController - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Controllers'! - - !ScreenController commentStamp: '<historical>' prior: 0! - I am the controller for the parts of the display screen that have no view on them. I only provide a standard yellow button menu. I view (a FormView of) an infinite gray form. (ScheduledControllers screenController) is the way to find me.! Item was removed: - ----- Method: ScreenController>>aboutThisSystem (in category 'menu messages') ----- - aboutThisSystem - SmalltalkImage current aboutThisSystem! Item was removed: - ----- Method: ScreenController>>absorbUpdatesFromServer (in category 'menu messages') ----- - absorbUpdatesFromServer - Utilities updateFromServer! Item was removed: - ----- Method: ScreenController>>appearanceMenu (in category 'nested menus') ----- - appearanceMenu - "Answer the appearance menu to be put up as a screen submenu" - - ^ SelectionMenu labelList: - #( - 'system fonts...' - 'full screen on' - 'full screen off' - 'set display depth...' - 'set desktop color...' ) - - lines: #(2 4) - selections: #(configureFonts - fullScreenOn fullScreenOff setDisplayDepth setDesktopColor) - " - ScreenController new appearanceMenu startUp - "! Item was removed: - ----- Method: ScreenController>>bitCachingString (in category 'menu messages') ----- - bitCachingString - ^ StandardSystemView cachingBits - ifTrue: ['don''t save bits (compact)'] - ifFalse: ['save bits (fast)']! Item was removed: - ----- Method: ScreenController>>browseChangedMessages (in category 'menu messages') ----- - browseChangedMessages - ChangeSet browseChangedMessages! Item was removed: - ----- Method: ScreenController>>browseRecentSubmissions (in category 'menu messages') ----- - browseRecentSubmissions - "Open a method-list browser on recently-submitted methods. 5/16/96 sw" - - Utilities browseRecentSubmissions! Item was removed: - ----- Method: ScreenController>>centerCursorInView (in category 'cursor') ----- - centerCursorInView - "Override so this doesn't happen when taking control"! Item was removed: - ----- Method: ScreenController>>changeWindowPolicy (in category 'menu messages') ----- - changeWindowPolicy - - Preferences toggle: #reverseWindowStagger.! Item was removed: - ----- Method: ScreenController>>changesMenu (in category 'nested menus') ----- - changesMenu - "Answer a menu for changes-related items" - ^ SelectionMenu labelList: - #( - 'simple change sorter' - 'dual change sorter' - - 'file out current change set' - 'create new change set...' - 'browse changed methods' - 'check change set for slips' - - 'browse recent submissions' - 'recently logged changes...' - 'recent log file...' - ) - lines: #(1 3 7) - selections: #( - openSimpleChangeSorter openChangeManager - fileOutChanges newChangeSet browseChangedMessages lookForSlips - browseRecentSubmissions browseRecentLog fileForRecentLog) - " - ScreenController new changesMenu startUp - "! Item was removed: - ----- Method: ScreenController>>chooseDirtyWindow (in category 'menu messages') ----- - chooseDirtyWindow - "Put up a list of windows with unaccepted edits and let the user chose one to activate." - "ScheduledControllers screenController chooseDirtyWindow" - - ScheduledControllers findWindowSatisfying: - [:c | c model canDiscardEdits not]. - ! Item was removed: - ----- Method: ScreenController>>closeUnchangedWindows (in category 'menu messages') ----- - closeUnchangedWindows - "Close any window that doesn't have unaccepted input." - - | clean | - (SelectionMenu confirm: - 'Do you really want to close all windows - except those with unaccepted edits?') - ifFalse: [^ self]. - - clean := ScheduledControllers scheduledControllers select: - [:c | c model canDiscardEdits and: [(c isKindOf: ScreenController) not]]. - clean do: [:c | c closeAndUnscheduleNoTerminate]. - - Project current restoreDisplay. - ! Item was removed: - ----- Method: ScreenController>>collapseAll (in category 'menu messages') ----- - collapseAll - "Collapses all open windows" - ScheduledControllers scheduledControllers do: - [:controller | controller == self ifFalse: - [controller view isCollapsed ifFalse: - [controller collapse. - controller view deEmphasize]]]! Item was removed: - ----- Method: ScreenController>>commonRequests (in category 'menu messages') ----- - commonRequests - "Put up a popup of common requests, and perform whatever the user request. 2/1/96 sw" - Utilities offerCommonRequests! Item was removed: - ----- Method: ScreenController>>configureFonts (in category 'menu messages') ----- - configureFonts - | aMenu result | - aMenu := CustomMenu fromArray: #( - ('default text font...' chooseSystemFont) - ('list font' chooseListFont) - ('flaps font' chooseFlapsFont) - ('menu font' chooseMenuFont) - ('window-title font' chooseWindowTitleFont) - ('code font' chooseCodeFont) - - - ('restore default font choices' restoreDefaultFonts)). - aMenu title: 'Standard System Fonts'. - - (result := aMenu startUp) ifNotNil: - [Preferences perform: result].! Item was removed: - ----- Method: ScreenController>>controlActivity (in category 'control defaults') ----- - controlActivity - "Any button opens the screen's menu. - If the shift key is down, do find window." - - sensor leftShiftDown ifTrue: [^ self findWindow]. - (self projectScreenMenu invokeOn: self) ifNil: [super controlActivity]! Item was removed: - ----- Method: ScreenController>>editPreferences (in category 'menu messages') ----- - editPreferences - "Open up a Preferences inspector. 2/7/96 sw" - self inform: 'The preference browser is currently not available in MVC'! Item was removed: - ----- Method: ScreenController>>emergencyCollapse (in category 'menu messages') ----- - emergencyCollapse - "Emergency collapse of a selected window" - | controller | - (controller := ScheduledControllers windowFromUser) notNil - ifTrue: - [controller collapse. - controller view deEmphasize]! Item was removed: - ----- Method: ScreenController>>ensureProjectAccessors (in category 'menu messages') ----- - ensureProjectAccessors - - Project allSubclassesDo: [:cls | - (self respondsTo: (#open, cls name) asSymbol) - ifFalse: [self class - compile: ('open{1}\ Smalltalk at: #{1} ifPresent: [:p | ProjectView open: p new]' withCRs format: {cls name}) classified: '*autogenerated-project accessors']].! Item was removed: - ----- Method: ScreenController>>exitProject (in category 'menu messages') ----- - exitProject - "Leave the current Project and enter the Project in which the receiver's - view is scheduled." - - Project current exit! Item was removed: - ----- Method: ScreenController>>expandAll (in category 'menu messages') ----- - expandAll - "Reopens all collapsed windows" - ScheduledControllers scheduledControllers reverseDo: - [:controller | controller == self ifFalse: - [controller view isCollapsed - ifTrue: [controller view expand] - ifFalse: [controller view displayDeEmphasized]]]! Item was removed: - ----- Method: ScreenController>>fastWindows (in category 'menu messages') ----- - fastWindows - StandardSystemView cachingBits - ifTrue: [StandardSystemView dontCacheBits] - ifFalse: [StandardSystemView doCacheBits]! Item was removed: - ----- Method: ScreenController>>fileForRecentLog (in category 'menu messages') ----- - fileForRecentLog - Smalltalk writeRecentToFile! Item was removed: - ----- Method: ScreenController>>fileOutChanges (in category 'menu messages') ----- - fileOutChanges - ChangeSet current verboseFileOut.! Item was removed: - ----- Method: ScreenController>>findWindow (in category 'menu messages') ----- - findWindow - "Put up a menu of all windows on the screen, and let the user select one. - 1/18/96 sw: the real work devolved to ControlManager>>findWindowSatisfying:" - - ScheduledControllers findWindowSatisfying: [:c | true]! Item was removed: - ----- Method: ScreenController>>fontSizeSummary (in category 'menu messages') ----- - fontSizeSummary - TextStyle fontSizeSummary! Item was removed: - ----- Method: ScreenController>>fullScreenOff (in category 'menu messages') ----- - fullScreenOff - - DisplayScreen fullScreenOff.! Item was removed: - ----- Method: ScreenController>>fullScreenOn (in category 'menu messages') ----- - fullScreenOn - - DisplayScreen fullScreenOn.! Item was removed: - ----- Method: ScreenController>>garbageCollect (in category 'menu messages') ----- - garbageCollect - "Do a garbage collection, and report results to the user." - - Utilities garbageCollectAndReport! Item was removed: - ----- Method: ScreenController>>helpMenu (in category 'nested menus') ----- - helpMenu - "Answer the help menu to be put up as a screen submenu" - - ^ SelectionMenu labelList: - #( - 'about this system...' - 'update code from server' - 'preferences...' - - 'command-key help' - 'font size summary' - 'useful expressions' - 'view graphical imports' - 'standard graphics library'), - - (Array with: (SoundService soundEnablingString)) , - - #( 'set author initials...' - 'vm statistics' - 'space left') - lines: #(1 4 6 11) - selections: #( aboutThisSystem absorbUpdatesFromServer - editPreferences openCommandKeyHelp fontSizeSummary openStandardWorkspace viewImageImports - standardGraphicsLibrary soundOnOrOff setAuthorInitials vmStatistics garbageCollect) - " - ScreenController new helpMenu startUp - "! Item was removed: - ----- Method: ScreenController>>isControlActive (in category 'control defaults') ----- - isControlActive - ^ self isControlWanted! Item was removed: - ----- Method: ScreenController>>isControlWanted (in category 'control defaults') ----- - isControlWanted - ^ self viewHasCursor and: [sensor anyButtonPressed]! Item was removed: - ----- Method: ScreenController>>jumpToProject (in category 'menu messages') ----- - jumpToProject - - Project current jumpToProject. - ! Item was removed: - ----- Method: ScreenController>>lookForSlips (in category 'menu messages') ----- - lookForSlips - ChangeSet current lookForSlips! Item was removed: - ----- Method: ScreenController>>newChangeSet (in category 'menu messages') ----- - newChangeSet - ChangeSet newChangeSet! Item was removed: - ----- Method: ScreenController>>objectForDataStream: (in category 'file in/out') ----- - objectForDataStream: refStrm - | dp | - "I am about to be written on an object file. Write a path to me in the other system instead." - - dp := DiskProxy global: #ScheduledControllers selector: #screenController args: #(). - refStrm replace: self with: dp. - ^ dp! Item was removed: - ----- Method: ScreenController>>openBrowser (in category 'menu messages') ----- - openBrowser - "Create and schedule a Browser view for browsing code." - ToolSet browse: nil selector: nil! Item was removed: - ----- Method: ScreenController>>openCommandKeyHelp (in category 'menu messages') ----- - openCommandKeyHelp - "1/18/96 sw Open a window that explains command-keys" - - (Smalltalk classNamed: 'SqueakTutorialsCommandKey') ifNotNil: [:cls | - StringHolder new - contents: cls commandKeyMappings contents; - openLabel: 'Command Key Mappings' translated].! Item was removed: - ----- Method: ScreenController>>openMenu (in category 'nested menus') ----- - openMenu - - | projectLabels projectAccessors | - self ensureProjectAccessors. - projectLabels := Project allSubclasses collect: [:cls | 'new ', cls name]. - projectAccessors := Project allSubclasses collect: [:cls | (#open, cls name) asSymbol]. - - ^ SelectionMenu labelList: - #( - 'browser' - 'workspace' - 'transcript' - - 'package browser' - 'method finder' - 'file list' - 'file...' - - 'simple change sorter' - 'dual change sorter'), - - projectLabels, - - #( - 'process browser' - ) - lines: {3. 7. 9. 9+projectLabels size} - selections: #(openBrowser openWorkspace openTranscript openPackageBrowser openSelectorBrowser openFileList openFile - openSimpleChangeSorter openChangeManager), - projectAccessors, - #(openProcessBrowser ) - " - ScreenController new openMenu startUp - "! Item was removed: - ----- Method: ScreenController>>openProcessBrowser (in category 'menu messages') ----- - openProcessBrowser - - ToolBuilder open: ProcessBrowser new.! Item was removed: - ----- Method: ScreenController>>openStandardWorkspace (in category 'menu messages') ----- - openStandardWorkspace - "Open a standard, throwaway window chock full of useful expressions. 1/17/96 sw" - - Utilities openStandardWorkspace! Item was removed: - ----- Method: ScreenController>>openTranscript (in category 'menu messages') ----- - openTranscript - "Create and schedule the System Transcript." - Transcript open! Item was removed: - ----- Method: ScreenController>>openWorkspace (in category 'menu messages') ----- - openWorkspace - "Create and schedule workspace." - - UIManager default edit:'' label: 'Workspace'! Item was removed: - ----- Method: ScreenController>>popUpMenuFor: (in category 'nested menus') ----- - popUpMenuFor: aSymbol - (self perform: aSymbol) invokeOn: self! Item was removed: - ----- Method: ScreenController>>presentAppearanceMenu (in category 'nested menus') ----- - presentAppearanceMenu - self popUpMenuFor: #appearanceMenu! Item was removed: - ----- Method: ScreenController>>presentChangesMenu (in category 'nested menus') ----- - presentChangesMenu - self popUpMenuFor: #changesMenu! Item was removed: - ----- Method: ScreenController>>presentHelpMenu (in category 'nested menus') ----- - presentHelpMenu - self popUpMenuFor: #helpMenu! Item was removed: - ----- Method: ScreenController>>presentOpenMenu (in category 'nested menus') ----- - presentOpenMenu - self popUpMenuFor: #openMenu! Item was removed: - ----- Method: ScreenController>>presentWindowMenu (in category 'nested menus') ----- - presentWindowMenu - self popUpMenuFor: #windowMenu! Item was removed: - ----- Method: ScreenController>>projectScreenMenu (in category 'nested menus') ----- - projectScreenMenu - "Answer the project screen menu." - - ^ SelectionMenu labelList: - #( - 'browser' - 'workspace' - - 'previous project' - 'jump to project...' - - 'restore display' - - 'open...' - 'windows...' - 'changes...' - 'help...' - 'appearance...' - 'do...' - - 'save' - 'save as...' - 'save and quit' - 'quit') - lines: #(2 4 5 11) - selections: #( - openBrowser openWorkspace - returnToPreviousProject jumpToProject restoreDisplay - presentOpenMenu presentWindowMenu presentChangesMenu presentHelpMenu presentAppearanceMenu commonRequests - snapshot saveAs snapshotAndQuit quit ) - " - ScreenController new projectScreenMenu startUp - "! Item was removed: - ----- Method: ScreenController>>quit (in category 'menu messages') ----- - quit - SmalltalkImage current - snapshot: - (self confirm: 'Save changes before quitting?' translated - orCancel: [^ self]) - andQuit: true! Item was removed: - ----- Method: ScreenController>>restoreDisplay (in category 'menu messages') ----- - restoreDisplay - "Clear the screen to gray and then redisplay all the scheduled views." - - Project current restoreDisplay.! Item was removed: - ----- Method: ScreenController>>returnToPreviousProject (in category 'menu messages') ----- - returnToPreviousProject - - Project returnToPreviousProject. - ! Item was removed: - ----- Method: ScreenController>>saveAs (in category 'menu messages') ----- - saveAs - ^ SmalltalkImage current saveAs! Item was removed: - ----- Method: ScreenController>>setAuthorInitials (in category 'menu messages') ----- - setAuthorInitials - "Put up a dialog allowing the user to specify the author's initials. " - Utilities setAuthorInitials! Item was removed: - ----- Method: ScreenController>>setDesktopColor (in category 'menu messages') ----- - setDesktopColor - "Let the user choose a new color for the desktop. Based on an idea by Georg Gollmann. " - - Preferences desktopColor: Color fromUser. - ScheduledControllers updateGray; restore! Item was removed: - ----- Method: ScreenController>>setDisplayDepth (in category 'menu messages') ----- - setDisplayDepth - "Let the user choose a new depth for the display. " - | result | - (result := (SelectionMenu selections: Display supportedDisplayDepths) startUpWithCaption: ('Choose a display depth - (it is currently {1})' translated format: {Display depth printString})) == nil ifFalse: - [Display newDepth: result]! Item was removed: - ----- Method: ScreenController>>snapshot (in category 'menu messages') ----- - snapshot - SmalltalkImage current snapshot: true andQuit: false! Item was removed: - ----- Method: ScreenController>>snapshotAndQuit (in category 'menu messages') ----- - snapshotAndQuit - "Snapshot and quit without bother the user further. 2/4/96 sw" - - SmalltalkImage current - snapshot: true - andQuit: true! Item was removed: - ----- Method: ScreenController>>soundEnablingString (in category 'menu messages') ----- - soundEnablingString - ^ SoundService soundEnablingString! Item was removed: - ----- Method: ScreenController>>soundOnOrOff (in category 'menu messages') ----- - soundOnOrOff - SoundService toggleSoundEnabled! Item was removed: - ----- Method: ScreenController>>staggerPolicyString (in category 'menu messages') ----- - staggerPolicyString - ^ Preferences staggerPolicyString! Item was removed: - ----- Method: ScreenController>>standardGraphicsLibrary (in category 'menu messages') ----- - standardGraphicsLibrary - "Open a standard, throwaway window chock full of useful expressions. 1/17/96 sw" - - ScriptingSystem inspectFormDictionary! Item was removed: - ----- Method: ScreenController>>viewImageImports (in category 'menu messages') ----- - viewImageImports - "Open an inspector on forms imported from Image files." - - Imports default viewImages! Item was removed: - ----- Method: ScreenController>>vmStatistics (in category 'menu messages') ----- - vmStatistics - "Open a string view on a report of vm statistics" - - (StringHolder new contents: SmalltalkImage current vmStatisticsReportString) - openLabel: 'VM Statistics'! Item was removed: - ----- Method: ScreenController>>windowMenu (in category 'nested menus') ----- - windowMenu - "Answer a menu for windows-related items. " - - ^ SelectionMenu labelList: - #( - 'find window...' - 'find changed browsers...' - 'find changed windows...' - - 'collapse all windows' - 'expand all windows' - 'close unchanged windows' ) , - (Array - with: self bitCachingString - with: self staggerPolicyString) - lines: #(1 4 7) - selections: #( - findWindow chooseDirtyBrowser chooseDirtyWindow - collapseAll expandAll closeUnchangedWindows - fastWindows changeWindowPolicy) - " - ScreenController new windowMenu startUp - "! Item was removed: - MouseMenuController subclass: #ScrollController - instanceVariableNames: 'scrollBar marker savedArea menuBar savedMenuBarArea' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Controllers'! - - !ScrollController commentStamp: '<historical>' prior: 0! - I represent control for scrolling using a scrollBar. I am a MouseMenuController that creates a scrollBar, rather than menus. My subclasses add the button menus. I keep control as long as the cursor is inside the view or the scrollBar area. - - A scrollBar is a rectangular area representing the length of the information being viewed. It contains an inner rectangle whose top y-coordinate represents the relative position of the information visible on the screen with respect to all of the information, and whose size represents the relative amount of that information visible on the screen. The user controls which part of the information is visible by pressing the red button. If the cursor is to the right of the inner rectangle, the window onto the visible information moves upward, if the cursor is to the left, the window moves downward, and if the cursor is inside, the inner rectangle is grabbed and moved to a desired position.! Item was removed: - ----- Method: ScrollController>>anyButtonActivity (in category 'scrolling') ----- - anyButtonActivity - "deal with red button down in scrollBar beyond yellowLine" - - self yellowButtonActivity! Item was removed: - ----- Method: ScrollController>>changeCursor: (in category 'cursor') ----- - changeCursor: aCursor - "The current cursor should be set to be aCursor." - - Cursor currentCursor ~~ aCursor ifTrue: [aCursor show]! Item was removed: - ----- Method: ScrollController>>computeMarkerRegion (in category 'marker adjustment') ----- - computeMarkerRegion - "Answer the rectangular area in which the gray area of the scroll bar - should be displayed." - - ^0 at 0 extent: Preferences scrollBarWidth @ - ((view window height asFloat / - view boundingBox height * - scrollBar inside height) - rounded min: scrollBar inside height)! Item was removed: - ----- Method: ScrollController>>controlActivity (in category 'control defaults') ----- - controlActivity - self scrollByMouseWheel ifTrue: [^ self]. - self scrollByKeyboard ifTrue: [^ self]. - self scrollBarContainsCursor - ifTrue: [self scroll] - ifFalse: [self normalActivity]! Item was removed: - ----- Method: ScrollController>>controlInitialize (in category 'basic control sequence') ----- - controlInitialize - "Recompute scroll bars. Save underlying image unless it is already saved." - | | - super controlInitialize. - scrollBar region: (0 @ 0 extent: 24 @ view apparentDisplayBox height). - scrollBar insideColor: view backgroundColor. - marker region: self computeMarkerRegion. - scrollBar := scrollBar align: scrollBar topRight with: view apparentDisplayBox topLeft. - marker := marker align: marker topCenter with: self upDownLine @ (scrollBar top + 2). - savedArea isNil ifTrue: [savedArea := Form fromDisplay: scrollBar]. - scrollBar displayOn: Display. - - "Show a border around yellow-button (menu) region" - " - yellowBar := Rectangle left: self yellowLine right: scrollBar right + 1 - top: scrollBar top bottom: scrollBar bottom. - Display border: yellowBar width: 1 mask: Form veryLightGray. - " - self moveMarker - ! Item was removed: - ----- Method: ScrollController>>controlTerminate (in category 'basic control sequence') ----- - controlTerminate - - super controlTerminate. - savedArea notNil - ifTrue: - [savedArea displayOn: Display at: scrollBar topLeft. - savedArea := nil].! Item was removed: - ----- Method: ScrollController>>downLine (in category 'scrolling') ----- - downLine - "if cursor before downLine, display down cursor and scroll down on button down" - - ^scrollBar left + 6 ! Item was removed: - ----- Method: ScrollController>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - scrollBar := Quadrangle new. - scrollBar borderWidthLeft: 2 right: 0 top: 2 bottom: 2. - marker := Quadrangle new. - marker insideColor: Preferences scrollBarColor. - menuBar := Quadrangle new. - menuBar borderWidthLeft: 2 right: 0 top: 2 bottom: 2.! Item was removed: - ----- Method: ScrollController>>isControlActive (in category 'control defaults') ----- - isControlActive - super isControlActive ifTrue: [^ true]. - sensor blueButtonPressed ifTrue: [^ false]. - ^ (scrollBar inside merge: view insetDisplayBox) containsPoint: sensor cursorPoint! Item was removed: - ----- Method: ScrollController>>isControlWanted (in category 'control defaults') ----- - isControlWanted - ^ self viewHasCursor! Item was removed: - ----- Method: ScrollController>>markerContainsCursor (in category 'cursor') ----- - markerContainsCursor - "Answer whether the gray area inside the scroll bar area contains the - cursor." - - ^marker inside containsPoint: sensor cursorPoint! Item was removed: - ----- Method: ScrollController>>markerDelta (in category 'marker adjustment') ----- - markerDelta - ^ marker top - - scrollBar inside top - - ((view window top - view boundingBox top) asFloat - / view boundingBox height asFloat * - scrollBar inside height asFloat) rounded! Item was removed: - ----- Method: ScrollController>>markerRegion: (in category 'marker adjustment') ----- - markerRegion: aRectangle - "Set the area defined by aRectangle as the marker. Fill it with gray tone." - - Display fill: marker fillColor: scrollBar insideColor. - marker region: aRectangle. - marker := marker align: marker topCenter - with: self upDownLine @ (scrollBar top + 2) ! Item was removed: - ----- Method: ScrollController>>menuBarContainsCursor (in category 'cursor') ----- - menuBarContainsCursor - "Answer whether the cursor is anywhere within the menu bar area." - - ^ menuBar notNil and: - [menuBar containsPoint: sensor cursorPoint]! Item was removed: - ----- Method: ScrollController>>moveMarker (in category 'marker adjustment') ----- - moveMarker - "The view window has changed. Update the marker." - - self moveMarker: self markerDelta negated anchorMarker: nil! Item was removed: - ----- Method: ScrollController>>moveMarker:anchorMarker: (in category 'marker adjustment') ----- - moveMarker: anInteger anchorMarker: anchorMarker - "Update the marker so that is is translated by an amount corresponding to - a distance of anInteger, constrained within the boundaries of the scroll - bar. If anchorMarker ~= nil, display the border around the area where the - marker first went down." - - Display fill: marker fillColor: scrollBar insideColor. - anchorMarker = nil - ifFalse: [Display border: anchorMarker width: 1 fillColor: Color gray]. - marker := marker translateBy: 0 @ - ((anInteger min: scrollBar inside bottom - marker bottom) max: - scrollBar inside top - marker top). - marker displayOn: Display! Item was removed: - ----- Method: ScrollController>>moveMarkerTo: (in category 'marker adjustment') ----- - moveMarkerTo: aRectangle - "Same as markerRegion: aRectangle; moveMarker, except a no-op if the marker - would not move." - - (aRectangle height = marker height and: [self viewDelta = 0]) ifFalse: - [self markerRegion: aRectangle. - self moveMarker]! Item was removed: - ----- Method: ScrollController>>normalActivity (in category 'control defaults') ----- - normalActivity - super controlActivity! Item was removed: - ----- Method: ScrollController>>scroll (in category 'scrolling') ----- - scroll - "Check to see whether the user wishes to jump, scroll up, or scroll down." - | savedCursor | - savedCursor := Cursor currentCursor. - [self scrollBarContainsCursor] - whileTrue: - [self interActivityPause. - sensor cursorPoint x <= self downLine - ifTrue: [self scrollDown] - ifFalse: [sensor cursorPoint x <= self upLine - ifTrue: [self scrollAbsolute] - ifFalse: [sensor cursorPoint x <= self yellowLine - ifTrue: [self scrollUp] - ifFalse: [sensor cursorPoint x <= scrollBar right - ifTrue: "Might not be, with touch pen" - [self changeCursor: Cursor menu. - sensor anyButtonPressed - ifTrue: [self changeCursor: savedCursor. - self anyButtonActivity]]]]]]. - savedCursor show! Item was removed: - ----- Method: ScrollController>>scrollAbsolute (in category 'private') ----- - scrollAbsolute - | markerOutline oldY markerForm | - self changeCursor: Cursor rightArrow. - - oldY := -1. - sensor anyButtonPressed ifTrue: - [markerOutline := marker deepCopy. - markerForm := Form fromDisplay: marker. - Display fill: marker fillColor: scrollBar insideColor. - Display border: markerOutline width: 1 fillColor: Color gray. - markerForm - follow: - [oldY ~= sensor cursorPoint y - ifTrue: - [oldY := sensor cursorPoint y. - marker := marker translateBy: - 0 @ ((oldY - marker center y - min: scrollBar inside bottom - marker bottom) - max: scrollBar inside top - marker top). - self scrollView]. - marker origin] - while: [ - self interActivityPause. - sensor anyButtonPressed]. - - Display fill: markerOutline fillColor: scrollBar insideColor. - self moveMarker]! Item was removed: - ----- Method: ScrollController>>scrollAmount (in category 'scrolling') ----- - scrollAmount - "Answer the number of bits of y-coordinate should be scrolled. This is a - default determination based on the view's preset display transformation." - - ^((view inverseDisplayTransform: sensor cursorPoint) - - (view inverseDisplayTransform: scrollBar inside topCenter)) y! Item was removed: - ----- Method: ScrollController>>scrollBarContainsCursor (in category 'cursor') ----- - scrollBarContainsCursor - "Answer whether the cursor is anywhere within the scroll bar area." - - ^scrollBar containsPoint: sensor cursorPoint! Item was removed: - ----- Method: ScrollController>>scrollByKeyboard (in category 'scrolling') ----- - scrollByKeyboard - | keyEvent | - keyEvent := sensor peekKeyboard. - keyEvent ifNil: [^ false]. - (sensor controlKeyPressed or:[sensor commandKeyPressed]) ifFalse: [^ false]. - keyEvent asciiValue = 30 - ifTrue: - [sensor keyboard. - self scrollViewUp ifTrue: [self moveMarker]. - ^ true]. - keyEvent asciiValue = 31 - ifTrue: - [sensor keyboard. - self scrollViewDown ifTrue: [self moveMarker]. - ^ true]. - ^ false! Item was removed: - ----- Method: ScrollController>>scrollByMouseWheel (in category 'scrolling') ----- - scrollByMouseWheel - | wheelDirection | - wheelDirection := sensor peekMouseWheelDirection. - wheelDirection = #up - ifTrue: - [sensor mouseWheelDirection. - self scrollViewUp ifTrue: [self moveMarker]. - ^ true]. - wheelDirection = #down - ifTrue: - [sensor mouseWheelDirection. - self scrollViewDown ifTrue: [self moveMarker]. - ^ true]. - ^ false! Item was removed: - ----- Method: ScrollController>>scrollDown (in category 'private') ----- - scrollDown - | markerForm firstTime | - self changeCursor: Cursor down. - sensor anyButtonPressed ifTrue: - [markerForm := Form fromDisplay: marker. - Display fill: marker fillColor: scrollBar insideColor. - firstTime := true. - markerForm - follow: - [self scrollViewDown ifTrue: - [marker := marker translateBy: 0 @ - ((self markerDelta negated - min: scrollBar inside bottom - marker bottom) - max: scrollBar inside top - marker top). - firstTime - ifTrue: [ - "pause before scrolling repeatedly" - (Delay forMilliseconds: 250) wait. - firstTime := false. - ] ifFalse: [ - (Delay forMilliseconds: 50) wait. - ]. - ]. - marker origin] - while: [sensor anyButtonPressed]. - self moveMarker.]! Item was removed: - ----- Method: ScrollController>>scrollUp (in category 'private') ----- - scrollUp - | markerForm firstTime | - self changeCursor: Cursor up. - sensor anyButtonPressed ifTrue: - [markerForm := Form fromDisplay: marker. - Display fill: marker fillColor: scrollBar insideColor. - firstTime := true. - markerForm - follow: - [self scrollViewUp ifTrue: - [marker := marker translateBy: 0 @ - ((self markerDelta negated - min: scrollBar inside bottom - marker bottom) - max: scrollBar inside top - marker top). - firstTime - ifTrue: [ - "pause before scrolling repeatedly" - (Delay forMilliseconds: 250) wait. - firstTime := false. - ] ifFalse: [ - (Delay forMilliseconds: 50) wait. - ]. - ]. - marker origin] - while: [sensor anyButtonPressed]. - self moveMarker.]! Item was removed: - ----- Method: ScrollController>>scrollView (in category 'scrolling') ----- - scrollView - "The scroll bar jump method was used so that the view should be - updated to correspond to the location of the scroll bar gray area. - Return true only if scrolling took place." - ^ self scrollView: self viewDelta! Item was removed: - ----- Method: ScrollController>>scrollView: (in category 'scrolling') ----- - scrollView: anInteger - "Tell the reciever's view to scroll by anInteger amount. - Return true only if scrolling actually resulted." - (view scrollBy: 0 @ - ((anInteger min: view window top - view boundingBox top) - max: view window top - view boundingBox bottom)) - ifTrue: [view clearInside; display. ^ true] - ifFalse: [^ false]! Item was removed: - ----- Method: ScrollController>>scrollViewDown (in category 'scrolling') ----- - scrollViewDown - "Scroll the receiver's view down the default amount. - Return true only if scrolling actually took place." - ^ self scrollView: self scrollAmount negated! Item was removed: - ----- Method: ScrollController>>scrollViewUp (in category 'scrolling') ----- - scrollViewUp - "Scroll the receiver's view up the default amount. - Return true only if scrolling actually took place." - ^ self scrollView: self scrollAmount! Item was removed: - ----- Method: ScrollController>>upDownLine (in category 'scrolling') ----- - upDownLine - "Check to see whether the user wishes to jump, scroll up, or scroll down." - - ^scrollBar left + 12! Item was removed: - ----- Method: ScrollController>>upLine (in category 'scrolling') ----- - upLine - "if cursor beyond upLine, display up cursor and scroll up on button down" - - ^scrollBar left + 12! Item was removed: - ----- Method: ScrollController>>viewDelta (in category 'scrolling') ----- - viewDelta - "Answer an integer that indicates how much the view should be scrolled. - The scroll bar has been moved and now the view must be so the amount - to scroll is computed as a ratio of the current scroll bar position." - - ^view window top - view boundingBox top - - ((marker top - scrollBar inside top) asFloat / - scrollBar inside height asFloat * - view boundingBox height asFloat) rounded! Item was removed: - ----- Method: ScrollController>>yellowLine (in category 'scrolling') ----- - yellowLine - "Check to see whether the user wishes to jump, scroll up, or scroll down." - - ^scrollBar left + 16! Item was removed: - ----- Method: SmartRefStream>>scrollControllermvslrrsmsms0 (in category '*ST80-conversion') ----- - scrollControllermvslrrsmsms0 - - ^ Smalltalk at: #MouseMenuController! Item was removed: - Path subclass: #Spline - instanceVariableNames: 'coefficients' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Paths'! - - !Spline commentStamp: '<historical>' prior: 0! - I represent a collection of Points through which a cubic spline curve is fitted.! Item was removed: - ----- Method: Spline class>>example (in category 'examples') ----- - example - "Designate points on the Path by clicking the red button. Terminate by - pressing any other button. A curve will be displayed, through the - selected points, using a long black form." - - | splineCurve aForm flag| - aForm := Form extent: 2 at 2. - aForm fillBlack. - splineCurve := Spline new. - splineCurve form: aForm. - flag := true. - [flag] whileTrue: - [Sensor waitButton. - Sensor redButtonPressed - ifTrue: - [splineCurve add: Sensor waitButton. - Sensor waitNoButton. - aForm displayOn: Display at: splineCurve last] - ifFalse: [flag:=false]]. - splineCurve computeCurve. - splineCurve isEmpty - ifFalse: [splineCurve displayOn: Display. - Sensor waitNoButton]. - - "Spline example"! Item was removed: - ----- Method: Spline>>coefficients (in category 'accessing') ----- - coefficients - "Answer an eight-element Array of Arrays each of which is the length - of the receiver. The first four arrays are the values, first, second and - third derivatives, respectively, for the parametric spline in x. The last - four elements are for y." - - ^coefficients! Item was removed: - ----- Method: Spline>>computeCurve (in category 'displaying') ----- - computeCurve - "Compute an array for the coefficients." - - | length extras | - length := self size. - extras := 0. - coefficients := Array new: 8. - 1 to: 8 do: [:i | coefficients at: i put: (Array new: length + extras)]. - 1 to: 5 by: 4 do: - [:k | - 1 to: length do: - [:i | (coefficients at: k) - at: i put: (k = 1 - ifTrue: [(self at: i) x asFloat] - ifFalse: [(self at: i) y asFloat])]. - 1 to: extras do: [:i | (coefficients at: k) - at: length + i put: ((coefficients at: k) - at: i + 1)]. - self derivs: (coefficients at: k) - first: (coefficients at: k + 1) - second: (coefficients at: k + 2) - third: (coefficients at: k + 3)]. - extras > 0 - ifTrue: [1 to: 8 do: - [:i | - coefficients at: i put: ((coefficients at: i) - copyFrom: 2 to: length + 1)]]! Item was removed: - ----- Method: Spline>>derivs:first:second:third: (in category 'private') ----- - derivs: a first: point1 second: point2 third: point3 - "Compute the first, second and third derivitives (in coefficients) from - the Points in this Path (coefficients at: 1 and coefficients at: 5)." - - | l v anArray | - l := a size. - l < 2 ifTrue: [^self]. - l > 2 - ifTrue: - [v := Array new: l. - v at: 1 put: 4.0. - anArray := Array new: l. - anArray at: 1 put: (6.0 * ((a at: 1) - ((a at: 2) * 2.0) + (a at: 3))). - 2 to: l - 2 do: - [:i | - v at: i put: (4.0 - (1.0 / (v at: (i - 1)))). - anArray - at: i - put: (6.0 * ((a at: i) - ((a at: (i + 1)) * 2.0) + (a at: (i + 2))) - - ((anArray at: (i - 1)) / (v at: (i - 1))))]. - point2 at: (l - 1) put: ((anArray at: (l - 2)) / (v at: (l - 2))). - l - 2 to: 2 by: 0-1 do: - [:i | - point2 - at: i - put: ((anArray at: (i - 1)) - (point2 at: (i + 1)) / (v at: (i - 1)))]]. - point2 at: 1 put: (point2 at: l put: 0.0). - 1 to: l - 1 do: - [:i | point1 - at: i - put: ((a at: (i + 1)) - (a at: i) - - ((point2 at: i) * 2.0 + (point2 at: (i + 1)) / 6.0)). - point3 at: i put: ((point2 at: (i + 1)) - (point2 at: i))]! Item was removed: - ----- Method: Spline>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger fillColor: aForm - "Display the receiver, a spline curve, approximated by straight line - segments." - - | n line t x y x1 x2 x3 y1 y2 y3 | - collectionOfPoints size < 1 ifTrue: [self error: 'a spline must have at least one point']. - line := Line new. - line form: self form. - line beginPoint: - (x := (coefficients at: 1) at: 1) rounded @ (y := (coefficients at: 5) at: 1) rounded. - 1 to: (coefficients at: 1) size - 1 do: - [:i | - "taylor series coefficients" - x1 := (coefficients at: 2) at: i. - y1 := (coefficients at: 6) at: i. - x2 := ((coefficients at: 3) at: i) / 2.0. - y2 := ((coefficients at: 7) at: i) / 2.0. - x3 := ((coefficients at: 4) at: i) / 6.0. - y3 := ((coefficients at: 8) at: i) / 6.0. - "guess n" - n := 5 max: (x2 abs + y2 abs * 2.0 + ((coefficients at: 3) - at: i + 1) abs + ((coefficients at: 7) - at: i + 1) abs / 100.0) rounded. - 1 to: n - 1 do: - [:j | - t := j asFloat / n. - line endPoint: - (x3 * t + x2 * t + x1 * t + x) rounded - @ (y3 * t + y2 * t + y1 * t + y) rounded. - line - displayOn: aDisplayMedium - at: aPoint - clippingBox: clipRect - rule: anInteger - fillColor: aForm. - line beginPoint: line endPoint]. - line beginPoint: - (x := (coefficients at: 1) at: i + 1) rounded - @ (y := (coefficients at: 5) at: i + 1) rounded. - line - displayOn: aDisplayMedium - at: aPoint - clippingBox: clipRect - rule: anInteger - fillColor: aForm]! Item was removed: - ----- Method: Spline>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm - "Get the scaled and translated path of newKnots." - - | newKnots newSpline | - newKnots := aTransformation applyTo: self. - newSpline := Spline new. - newKnots do: [:knot | newSpline add: knot]. - newSpline form: self form. - newSpline - displayOn: aDisplayMedium - at: 0 @ 0 - clippingBox: clipRect - rule: anInteger - fillColor: aForm! Item was removed: - MouseMenuController subclass: #StandardSystemController - instanceVariableNames: 'status' - classVariableNames: 'HBorderCursor VBorderCursor' - poolDictionaries: '' - category: 'ST80-Support'! - - !StandardSystemController commentStamp: '<historical>' prior: 0! - I am a controller for StandardSystemViews, that is, those views that are at the top level of a project in the system user interface. I am a kind of MouseMenuController that creates a blue button menu for moving, framing, collapsing, and closing ScheduledViews, and for selecting views under the view of my instance.! Item was removed: - ----- Method: StandardSystemController class>>initialize (in category 'class initialization') ----- - initialize - "StandardSystemController initialize" - - VBorderCursor := Cursor extent: 16 at 16 fromArray: #( - 2r1010000000000000 - 2r1010000000000000 - 2r1010000000000000 - 2r1010000000000000 - 2r1010000000000000 - 2r1010010000100000 - 2r1010110000110000 - 2r1011111111111000 - 2r1010110000110000 - 2r1010010000100000 - 2r1010000000000000 - 2r1010000000000000 - 2r1010000000000000 - 2r1010000000000000 - 2r1010000000000000 - 2r1010000000000000) - offset: 0 at 0. - HBorderCursor := Cursor extent: 16 at 16 fromArray: #( - 2r1111111111111111 - 2r0000000000000000 - 2r1111111111111111 - 2r0000000100000000 - 2r0000001110000000 - 2r0000011111000000 - 2r0000000100000000 - 2r0000000100000000 - 2r0000000100000000 - 2r0000000100000000 - 2r0000011111000000 - 2r0000001110000000 - 2r0000000100000000 - 2r0000000000000000 - 2r0000000000000000 - 2r0000000000000000) - offset: 0 at 0.! Item was removed: - ----- Method: StandardSystemController>>adjustPaneBorders (in category 'borders') ----- - adjustPaneBorders - | side sub newRect outerFrame | - outerFrame := view displayBox. - side := #none. - VBorderCursor showWhile: - [ [sub := view subviewWithLongestSide: [:s | side := s] - near: sensor cursorPoint. - self cursorOnBorder and: [(side = #left) | (side = #right)]] - whileTrue: [ - self interActivityPause. - sensor redButtonPressed ifTrue: - [side = #left ifTrue: - [newRect := sub stretchFrame: - [:f | (f withLeft: sensor cursorPoint x) - intersect: outerFrame] - startingWith: sub displayBox]. - side = #right ifTrue: - [newRect := sub stretchFrame: - [:f | (f withRight: sensor cursorPoint x) - intersect: outerFrame] - startingWith: sub displayBox]. - view reframePanesAdjoining: sub along: side to: newRect]]]. - HBorderCursor showWhile: - [ [sub := view subviewWithLongestSide: [:s | side := s] - near: sensor cursorPoint. - self cursorOnBorder and: [(side = #top) | (side = #bottom)]] - whileTrue: [ - self interActivityPause. - sensor redButtonPressed ifTrue: - [side = #top ifTrue: - [newRect := sub stretchFrame: - [:f | (f withTop: sensor cursorPoint y) - intersect: outerFrame] - startingWith: sub displayBox]. - side = #bottom ifTrue: - [newRect := sub stretchFrame: - [:f | (f withBottom: sensor cursorPoint y) - intersect: outerFrame] - startingWith: sub displayBox]. - view reframePanesAdjoining: sub along: side to: newRect]]]! Item was removed: - ----- Method: StandardSystemController>>adjustWindowBorders (in category 'borders') ----- - adjustWindowBorders - | side noClickYet | - noClickYet := true. - VBorderCursor showWhile: - [ [side := view displayBox sideNearestTo: sensor cursorPoint. - self cursorOnBorder - and: [(side = #left) | (side = #right) - and: [noClickYet or: [sensor redButtonPressed]]]] - whileTrue: - [sensor redButtonPressed ifTrue: - [noClickYet := false. - side = #left ifTrue: - [view newFrame: [:f | f withLeft: sensor cursorPoint x]]. - side = #right ifTrue: - [view newFrame: [:f | f withRight: sensor cursorPoint x]]]. - self interActivityPause]]. - HBorderCursor showWhile: - [ [side := view displayBox sideNearestTo: sensor cursorPoint. - self cursorOnBorder - and: [(side = #top) | (side = #bottom) - and: [noClickYet or: [sensor redButtonPressed]]]] - whileTrue: - [sensor redButtonPressed ifTrue: - [noClickYet := false. - side = #top ifTrue: - [view newFrame: [:f | f withTop: sensor cursorPoint y]]. - side = #bottom ifTrue: - [view newFrame: [:f | f withBottom: sensor cursorPoint y]]]. - self interActivityPause]]! Item was removed: - ----- Method: StandardSystemController>>adjustWindowCorners (in category 'borders') ----- - adjustWindowCorners - | box clicked | - box := view windowBox. - clicked := false. - #(topLeft topRight bottomRight bottomLeft) - do: [:readCorner | - | cornerBox | - cornerBox := ((box insetBy: 2) perform: readCorner) - (10 at 10) extent: 20 at 20. - (cornerBox containsPoint: sensor cursorPoint) - ifTrue: - ["Display reverse: cornerBox." - (Cursor perform: readCorner) showWhile: - [[(cornerBox containsPoint: (sensor cursorPoint)) - and: [(clicked := sensor anyButtonPressed) not]] - whileTrue: [ self interActivityPause ]. - "Display reverse: cornerBox." - clicked ifTrue: - [view newFrame: - [:f | | p f2 | - p := sensor cursorPoint. - readCorner = #topLeft ifTrue: - [f2 := p corner: f bottomRight]. - readCorner = #bottomLeft ifTrue: - [f2 := (f withBottom: p y) withLeft: p x]. - readCorner = #bottomRight ifTrue: - [f2 := f topLeft corner: p]. - readCorner = #topRight ifTrue: - [f2 := (f withTop: p y) withRight: p x]. - f2]]]]]. - ^ clicked! Item was removed: - ----- Method: StandardSystemController>>blueButtonActivity (in category 'control defaults') ----- - blueButtonActivity - - | menu | - menu := SelectionMenu - labels: - 'edit label - choose color... - two-tone/full color - inspect - move - frame - full screen - collapse - close' - lines: #(4 8) - selections: #(label chooseColor toggleTwoTone inspect move reframe fullScreen collapse close). - - menu invokeOn: self.! Item was removed: - ----- Method: StandardSystemController>>checkForReframe (in category 'borders') ----- - checkForReframe - | cp | - view isCollapsed ifTrue: [^ self]. - cp := sensor cursorPoint. - ((view closeBoxFrame expandBy: 2) containsPoint: cp) - | ((view growBoxFrame expandBy: 2) containsPoint: cp) - ifTrue: [^ self]. "Dont let reframe interfere with close/grow" - self adjustWindowCorners. - self cursorOnBorder ifFalse: [^ self]. - ((view insetDisplayBox insetBy: 2 at 2) containsPoint: cp) - ifFalse: [^ self adjustWindowBorders]. - view subViews size <= 1 ifTrue: [^ self]. - (view subviewWithLongestSide: [:s | ] near: cp) == nil - ifFalse: [^ self adjustPaneBorders].! Item was removed: - ----- Method: StandardSystemController>>chooseColor (in category 'menu messages') ----- - chooseColor - "Allow the user to specify a new background color for the receiver's window. 5/6/96 sw. - 7/31/96 sw: use Color fromUser" - - view backgroundColor: Color fromUser; uncacheBits; display! Item was removed: - ----- Method: StandardSystemController>>close (in category 'menu messages') ----- - close - "The receiver's view should be removed from the screen and from the - collection of scheduled views." - - model okToChange ifFalse: [^self]. - status := #closed. - view erase! Item was removed: - ----- Method: StandardSystemController>>closeAndUnschedule (in category 'scheduling') ----- - closeAndUnschedule - "Erase the receiver's view and remove it from the collection of scheduled - views." - - status := #closed. - ScheduledControllers unschedule: self. - view erase. - view release. - ScheduledControllers searchForActiveController.! Item was removed: - ----- Method: StandardSystemController>>closeAndUnscheduleNoErase (in category 'scheduling') ----- - closeAndUnscheduleNoErase - "Remove the scheduled view from the collection of scheduled views. Set - its status to closed but do not erase and do not terminate. For debuggers." - - status := #closed. - ScheduledControllers unschedule: self. - view release.! Item was removed: - ----- Method: StandardSystemController>>closeAndUnscheduleNoTerminate (in category 'scheduling') ----- - closeAndUnscheduleNoTerminate - "Erase the receiver's view and remove it from the collection of scheduled views, but do not terminate the current process. Useful for clean-up scripts." - - status := #closed. - ScheduledControllers unschedule: self. - view erase. - view release. - ! Item was removed: - ----- Method: StandardSystemController>>collapse (in category 'menu messages') ----- - collapse - "Get the receiver's view to change to a collapsed view on the screen." - view collapseToPoint: view chooseCollapsePoint! Item was removed: - ----- Method: StandardSystemController>>controlActivity (in category 'control defaults') ----- - controlActivity - self checkForReframe. - ^ super controlActivity! Item was removed: - ----- Method: StandardSystemController>>controlInitialize (in category 'basic control sequence') ----- - controlInitialize - view displayEmphasized. - view uncacheBits. "Release cached bitmap while active" - model windowActiveOnFirstClick ifFalse: [sensor waitNoButton]. - status := #active. - view isCollapsed ifFalse: [model modelWakeUpIn: view]! Item was removed: - ----- Method: StandardSystemController>>controlTerminate (in category 'basic control sequence') ----- - controlTerminate - status == #closed - ifTrue: [ - ScheduledControllers unschedule: self. - view ~~ nil ifTrue: [view release]. - ^self]. - view deEmphasize; cacheBits. - view isCollapsed ifFalse: [model modelSleep].! Item was removed: - ----- Method: StandardSystemController>>cursorOnBorder (in category 'borders') ----- - cursorOnBorder - | cp i box | - view isCollapsed ifTrue: [^ false]. - cp := sensor cursorPoint. - ((view labelDisplayBox insetBy: (0 @ 2 corner: 0 @ -2)) containsPoint: cp) - ifTrue: [^ false]. - (i := view subViews findFirst: [:v | v displayBox containsPoint: cp]) = 0 - ifTrue: [box := view windowBox] - ifFalse: [box := (view subViews at: i) insetDisplayBox]. - ^ ((box insetBy: 3) containsPoint: cp) not - and: [(box expandBy: 4) containsPoint: cp]! Item was removed: - ----- Method: StandardSystemController>>expand (in category 'menu messages') ----- - expand - "The receiver's view was collapsed; open it again and ask the user to - designate its rectangular area." - view expand; emphasize! Item was removed: - ----- Method: StandardSystemController>>fullScreen (in category 'borders') ----- - fullScreen - "Make the receiver's window occupy jes' about the full screen. 6/10/96 sw" - - view fullScreen! Item was removed: - ----- Method: StandardSystemController>>getPluggableYellowButtonMenu: (in category 'pluggable menus') ----- - getPluggableYellowButtonMenu: shiftKeyState - ^ nil! Item was removed: - ----- Method: StandardSystemController>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - status := #inactive! Item was removed: - ----- Method: StandardSystemController>>isControlActive (in category 'control defaults') ----- - isControlActive - status == #active ifFalse: [^ false]. - sensor anyButtonPressed ifFalse: [^ true]. - self viewHasCursor - ifTrue: [^ true] - ifFalse: [ScheduledControllers noteNewTop. - ^ false]! Item was removed: - ----- Method: StandardSystemController>>label (in category 'menu messages') ----- - label - - | newLabel | - newLabel := UIManager default - request: 'Edit the label, then type RETURN' - initialAnswer: view label. - newLabel isEmpty ifFalse: [view relabel: newLabel]. - ! Item was removed: - ----- Method: StandardSystemController>>labelHasCursor (in category 'cursor') ----- - labelHasCursor - "Answer true if the cursor is within the window's label" - ^view labelContainsPoint: sensor cursorPoint! Item was removed: - ----- Method: StandardSystemController>>move (in category 'menu messages') ----- - move - "Ask the user to designate a new origin position for the receiver's view. - 6/10/96 sw: tell the view that it has moved" - - | oldBox | - oldBox := view windowBox. - view uncacheBits. - view align: view windowBox topLeft - with: view chooseMoveRectangle topLeft. - view displayEmphasized. - view moved. "In case its model wishes to take note." - (oldBox areasOutside: view windowBox) do: - [:rect | ScheduledControllers restore: rect]! Item was removed: - ----- Method: StandardSystemController>>open (in category 'scheduling') ----- - open - "Create an area on the screen in which the receiver's scheduled view can - be displayed. Make it the active view." - - view resizeInitially. - status := #open. - ScheduledControllers scheduleActive: self! Item was removed: - ----- Method: StandardSystemController>>openDisplayAt: (in category 'scheduling') ----- - openDisplayAt: aPoint - "Create an area with origin aPoint in which the receiver's scheduled - view can be displayed. Make it the active view." - - view align: view viewport center with: aPoint. - view translateBy: - (view displayBox amountToTranslateWithin: Display boundingBox). - status := #open. - ScheduledControllers scheduleActive: self! Item was removed: - ----- Method: StandardSystemController>>openNoTerminate (in category 'scheduling') ----- - openNoTerminate - "Create an area in which the receiver's scheduled view can be displayed. - Make it the active view. Do not terminate the currently active process." - - view resizeInitially. - status := #open. - ScheduledControllers scheduleActiveNoTerminate: self! Item was removed: - ----- Method: StandardSystemController>>openNoTerminateDisplayAt: (in category 'scheduling') ----- - openNoTerminateDisplayAt: aPoint - "Create an area with origin aPoint in which the receiver's scheduled - view can be displayed. Make it the active view. Do not terminate the - currently active process." - - view resizeMinimumCenteredAt: aPoint. - status := #open. - ScheduledControllers scheduleActiveNoTerminate: self! Item was removed: - ----- Method: StandardSystemController>>redButtonActivity (in category 'control defaults') ----- - redButtonActivity - "If cursor is in label of a window when red button is pushed, - check for closeBox or growBox, else drag the window frame - or edit the label." - - | box p | - p := sensor cursorPoint. - self labelHasCursor ifFalse: [super redButtonActivity. ^ self]. - ((box := view closeBoxFrame) containsPoint: p) - ifTrue: - [Utilities - awaitMouseUpIn: box - repeating: [] - ifSucceed: [self close. ^ self]. - ^ self]. - ((box := view growBoxFrame) containsPoint: p) - ifTrue: - [Utilities - awaitMouseUpIn: box - repeating: [] - ifSucceed: - [Sensor controlKeyPressed ifTrue: [^ self expand; fullScreen]. - ^ view isCollapsed - ifTrue: [self expand] - ifFalse: [self collapse]]. - ^ self]. - (((box := view labelTextRegion expandBy: 1) containsPoint: p) - and: [Preferences clickOnLabelToEdit or: [sensor leftShiftDown]]) - ifTrue: - [Utilities - awaitMouseUpIn: box - repeating: [] - ifSucceed: [^ self label]. - ^ self]. - self move! Item was removed: - ----- Method: StandardSystemController>>reframe (in category 'menu messages') ----- - reframe - ^ view reframeTo: view getFrame! Item was removed: - ----- Method: StandardSystemController>>status: (in category 'scheduling') ----- - status: aSymbol - status := aSymbol! Item was removed: - ----- Method: StandardSystemController>>toggleTwoTone (in category 'menu messages') ----- - toggleTwoTone - (view isMemberOf: StandardSystemView) ifTrue: - [^ view becomeForward: (view as: ColorSystemView)]. - (view isMemberOf: ColorSystemView) ifTrue: - [^ view becomeForward: (view as: StandardSystemView)]. - ! Item was removed: - ----- Method: StandardSystemController>>under (in category 'menu messages') ----- - under - "Deactive the receiver's scheduled view and pass control to any view that - might be positioned directly underneath it and the cursor." - - status := #inactive! Item was removed: - View subclass: #StandardSystemView - instanceVariableNames: 'labelFrame labelText isLabelComplemented savedSubViews minimumSize maximumSize collapsedViewport expandedViewport labelBits windowBits bitsValid updatablePanes' - classVariableNames: 'CacheBits' - poolDictionaries: '' - category: 'ST80-Support'! - - !StandardSystemView commentStamp: '<historical>' prior: 0! - I represent a view that has a label above its top left corner. The text in the label identifies the kind of view. In addition to a label, I add control over the maximum and minimum size of the display box of my instance. My default controller is StandardSystemController. The elements of ScheduledControllers, the sole instance of ControlManager, are usually controllers for instances of me.! Item was removed: - ----- Method: StandardSystemView class>>cachingBits (in category 'class initialization') ----- - cachingBits - ^ CacheBits! Item was removed: - ----- Method: StandardSystemView class>>doCacheBits (in category 'class initialization') ----- - doCacheBits - "StandardSystemView doCacheBits - Enable fast window repaint feature" - CacheBits := true. - ScheduledControllers ifNotNil: [:sc | sc unCacheWindows; restore]! Item was removed: - ----- Method: StandardSystemView class>>dontCacheBits (in category 'class initialization') ----- - dontCacheBits - "StandardSystemView dontCacheBits - Disable fast window repaint feature. - Return true iff bits were cached, ie if space was been recovered" - CacheBits ifFalse: [^ false]. - CacheBits := false. - ScheduledControllers unCacheWindows. - ^ true! Item was removed: - ----- Method: StandardSystemView class>>initialize (in category 'class initialization') ----- - initialize "StandardSystemView initialize" - self doCacheBits.! Item was removed: - ----- Method: StandardSystemView class>>standardLabelStyle (in category 'class initialization') ----- - standardLabelStyle - - ^ (TextStyle fontArray: { Preferences windowTitleFont }) - gridForFont: 1 withLead: 0; - yourself! Item was removed: - ----- Method: StandardSystemView>>cacheBits (in category 'displaying') ----- - cacheBits - | oldLabelState | - CacheBits ifFalse: [^ self uncacheBits]. - (oldLabelState := isLabelComplemented) ifTrue: [ self deEmphasize ]. - self cacheBitsAsIs. - (isLabelComplemented := oldLabelState) ifTrue: [ self emphasize ]. - ! Item was removed: - ----- Method: StandardSystemView>>cacheBitsAsIs (in category 'displaying') ----- - cacheBitsAsIs - - CacheBits ifFalse: [^ self uncacheBits]. - windowBits := Form fromDisplay: self windowBox using: windowBits. - bitsValid := true. - ! Item was removed: - ----- Method: StandardSystemView>>chooseCollapsePoint (in category 'framing') ----- - chooseCollapsePoint - "Answer the point at which to place the collapsed window." - | pt labelForm beenDown offset | - labelForm := Form fromDisplay: self labelDisplayBox. - self uncacheBits. - self erase. - beenDown := Sensor anyButtonPressed. - self isCollapsed ifTrue: - [offset := self labelDisplayBox topLeft - self growBoxFrame topLeft. - labelForm follow: [pt := (Sensor cursorPoint + offset max: 0 at 0) truncateTo: 8] - while: [Sensor anyButtonPressed - ifTrue: [beenDown := true] - ifFalse: [beenDown not]]. - ^ pt]. - ^ (RealEstateAgent assignCollapseFrameFor: self) origin. - ! Item was removed: - ----- Method: StandardSystemView>>chooseFrame (in category 'framing') ----- - chooseFrame - "Answer a new frame, depending on whether the view is currently - collapsed or not." - | labelForm f | - self isCollapsed & expandedViewport notNil - ifTrue: - [labelForm := bitsValid - ifTrue: [windowBits] - ifFalse: [Form fromDisplay: self labelDisplayBox]. - bitsValid := false. - self erase. - labelForm slideFrom: self labelDisplayBox origin - to: expandedViewport origin-self labelOffset - nSteps: 10. - ^ expandedViewport] - ifFalse: - [f := self getFrame. - bitsValid := false. - self erase. - ^ f topLeft + self labelOffset extent: f extent]! Item was removed: - ----- Method: StandardSystemView>>chooseMoveRectangle (in category 'framing') ----- - chooseMoveRectangle - "Ask the user to designate a new window rectangle." - | offset | - offset := Sensor anyButtonPressed "Offset if draggin, eg, label" - ifTrue: [self windowBox topLeft - Sensor cursorPoint] - ifFalse: [0 at 0]. - self isCollapsed - ifTrue: [^ self labelDisplayBox newRectFrom: - [:f | | p | - p := Sensor cursorPoint + offset. - p := (p max: 0 at 0) truncateTo: 8. - p extent: f extent]] - ifFalse: [^ self windowBox newRectFrom: - [:f | | p | - p := Sensor cursorPoint + offset. - self constrainFrame: (p extent: f extent)]]! Item was removed: - ----- Method: StandardSystemView>>clippingBox (in category 'clipping box access') ----- - clippingBox - "Answer the rectangular area in which the receiver can show its label." - - ^self isTopView - ifTrue: [self labelDisplayBox] - ifFalse: [super insetDisplayBox]! Item was removed: - ----- Method: StandardSystemView>>closeBoxFrame (in category 'label access') ----- - closeBoxFrame - ^ Rectangle origin: (self labelDisplayBox leftCenter + (10 @ -5)) extent: (11 @ 11)! Item was removed: - ----- Method: StandardSystemView>>collapse (in category 'framing') ----- - collapse - "If the receiver is not already collapsed, change its view to be that of its - label only." - - self isCollapsed ifFalse: - [model modelSleep. - expandedViewport := self viewport. - savedSubViews := subViews. - self resetSubViews. - labelText isNil ifTrue: [self label: nil. bitsValid := false.]. - self window: (self inverseDisplayTransform: - ((self labelDisplayBox topLeft extent: (labelText extent x + 70) @ self labelHeight) - intersect: self labelDisplayBox))]! Item was removed: - ----- Method: StandardSystemView>>collapseToPoint: (in category 'framing') ----- - collapseToPoint: collapsePoint - self collapse. - self align: self displayBox topLeft with: collapsePoint. - collapsedViewport := self viewport. - self displayEmphasized! Item was removed: - ----- Method: StandardSystemView>>collapsedFrame (in category 'framing') ----- - collapsedFrame - "Answer the rectangle occupied by this window when collapsed." - ^ collapsedViewport "NOTE may be nil"! Item was removed: - ----- Method: StandardSystemView>>constrainFrame: (in category 'clipping box access') ----- - constrainFrame: aRectangle - "Constrain aRectangle, to the minimum and maximum size - for this window" - - | adjustmentForLabel | - adjustmentForLabel := 0 @ (labelFrame height - labelFrame borderWidth). - ^ aRectangle origin extent: - ((aRectangle extent max: minimumSize + adjustmentForLabel) - min: maximumSize + adjustmentForLabel).! Item was removed: - ----- Method: StandardSystemView>>containsPoint: (in category 'testing') ----- - containsPoint: aPoint - "Refer to the comment in View|containsPoint:." - - ^(super containsPoint: aPoint) | (self labelContainsPoint: aPoint)! Item was removed: - ----- Method: StandardSystemView>>convertToCurrentVersion:refStream: (in category 'object fileIn') ----- - convertToCurrentVersion: varDict refStream: smartRefStrm - - updatablePanes ifNil: [updatablePanes := #()]. - ^super convertToCurrentVersion: varDict refStream: smartRefStrm. - - ! Item was removed: - ----- Method: StandardSystemView>>deEmphasizeForDebugger (in category 'displaying') ----- - deEmphasizeForDebugger - "Carefully de-emphasis this window because a debugger is being opened. Care must be taken to avoid invoking potentially buggy window display code that could cause a recursive chain of errors eventually resulting in a virtual machine crash. In particular, do not de-emphasize the subviews." - - self deEmphasizeView. "de-emphasize this top-level view" - self uncacheBits. - Smalltalk garbageCollectMost > 1000000 ifTrue: [ - "if there is enough space, cache current window screen bits" - self cacheBitsAsIs]. - ! Item was removed: - ----- Method: StandardSystemView>>deEmphasizeLabel (in category 'displaying') ----- - deEmphasizeLabel - "Un-Highlight the label." - labelFrame height = 0 ifTrue: [^ self]. "no label" - self displayLabelBackground: false. - self displayLabelText.! Item was removed: - ----- Method: StandardSystemView>>deEmphasizeView (in category 'deEmphasizing') ----- - deEmphasizeView - "Refer to the comment in View|deEmphasizeView." - - isLabelComplemented ifTrue: - [self deEmphasizeLabel. - isLabelComplemented := false]! Item was removed: - ----- Method: StandardSystemView>>defaultBackgroundColor (in category 'initialize-release') ----- - defaultBackgroundColor - - ^ model - ifNil: [Color white] - ifNotNil: [:m | m windowColorToUse]! Item was removed: - ----- Method: StandardSystemView>>defaultControllerClass (in category 'controller access') ----- - defaultControllerClass - "Refer to the comment in View|defaultControllerClass." - - ^StandardSystemController! Item was removed: - ----- Method: StandardSystemView>>defaultForegroundColor (in category 'initialize-release') ----- - defaultForegroundColor - - ^ (self userInterfaceTheme borderColorModifier ifNil: [ [:c | c adjustBrightness: -0.5] ]) value: self defaultBackgroundColor! Item was removed: - ----- Method: StandardSystemView>>display (in category 'displaying') ----- - display - isLabelComplemented - ifTrue: [self displayEmphasized] - ifFalse: [self displayDeEmphasized]! Item was removed: - ----- Method: StandardSystemView>>displayDeEmphasized (in category 'displaying') ----- - displayDeEmphasized - "Display this view with emphasis off. - If windowBits is not nil, then simply BLT if possible, - but force full display for top window so color is preserved." - (bitsValid and: [controller ~~ ScheduledControllers activeController]) - ifTrue: [self lock. - windowBits displayAt: self windowOrigin] - ifFalse: [Display deferUpdates: true. - super display. - Display deferUpdates: false; forceToScreen: self windowBox. - CacheBits ifTrue: [self cacheBitsAsIs]] - ! Item was removed: - ----- Method: StandardSystemView>>displayEmphasized (in category 'displaying') ----- - displayEmphasized - "Display with label highlighted to indicate that it is active." - - self displayDeEmphasized; emphasize. - isLabelComplemented := true! Item was removed: - ----- Method: StandardSystemView>>displayLabelBackground: (in category 'displaying') ----- - displayLabelBackground: emphasized - "Clear or emphasize the inner region of the label" - | r1 r2 r3 c3 c2 c1 | - emphasized ifFalse: - ["Just clear the label if not emphasized" - ^ Display fill: (self labelDisplayBox insetBy: 2) fillColor: self labelColor]. - r1 := self labelDisplayBox insetBy: 2. - r2 := r1 insetBy: 0 at 2. - r3 := r2 insetBy: 0 at 3. - c3 := self labelColor. - c2 := c3 dansDarker. - c1 := c2 dansDarker. - Display fill: r1 fillColor: c1. - Display fill: r2 fillColor: c2. - Display fill: r3 fillColor: c3. - - " Here is the Mac racing stripe code - stripes := Bitmap with: (self labelColor pixelWordForDepth: Display depth) - with: (Form black pixelWordForDepth: Display depth). - self windowOrigin y even ifTrue: [stripes swap: 1 with: 2]. - Display fill: (self labelDisplayBox insetBy: 3) fillColor: stripes. - "! Item was removed: - ----- Method: StandardSystemView>>displayLabelBoxes (in category 'displaying') ----- - displayLabelBoxes - "closeBox, growBox." - | aRect smallRect backColor | - aRect := self closeBoxFrame. - backColor := self labelColor. - Display fill: (aRect insetBy: -2) fillColor: backColor. - Display fillBlack: aRect. - Display fill: (aRect insetBy: 1) fillColor: backColor. - - aRect := self growBoxFrame. - smallRect := aRect origin extent: 7 at 7. - Display fill: (aRect insetBy: -2) fillColor: backColor. - aRect := aRect insetOriginBy: 2 at 2 cornerBy: 0 at 0. - Display fillBlack: aRect. - Display fill: (aRect insetBy: 1) fillColor: backColor. - Display fillBlack: smallRect. - Display fill: (smallRect insetBy: 1) fillColor: backColor! Item was removed: - ----- Method: StandardSystemView>>displayLabelText (in category 'displaying') ----- - displayLabelText - "The label goes in the center of the window" - | labelRect | - labelText foregroundColor: self foregroundColor - backgroundColor: self labelColor. - labelRect := self labelTextRegion. - Display fill: (labelRect expandBy: 3 at 0) fillColor: self labelColor. - labelText displayOn: Display at: labelRect topLeft clippingBox: labelRect - rule: labelText rule fillColor: labelText fillColor. - labelText destinationForm: nil! Item was removed: - ----- Method: StandardSystemView>>displayOn: (in category 'displaying') ----- - displayOn: aPort - bitsValid ifFalse: - [^ Display clippingTo: aPort clipRect do: [super display]]. - windowBits displayOnPort: aPort at: self windowOrigin! Item was removed: - ----- Method: StandardSystemView>>displayRacingStripes (in category 'displaying') ----- - displayRacingStripes - "Display Racing Stripes in the label" - | labelDisplayBox stripes top bottom left box right | - labelDisplayBox := self labelDisplayBox. - top := labelDisplayBox top + 3. - bottom := labelDisplayBox bottom - 3. - stripes := Bitmap with: (Display pixelWordFor: self labelColor) - with: (Display pixelWordFor: Color black). - top even ifFalse: [stripes swap: 1 with: 2]. - - left := labelDisplayBox left + 3. - - box := self closeBoxFrame. - right := box left - 2. - Display fill: (Rectangle left: left right: right top: top bottom: bottom) - fillColor: stripes. - left := box right + 2. - - box := self labelTextRegion. - right := box left - 3. - Display fill: (Rectangle left: left right: right top: top bottom: bottom) - fillColor: stripes. - left := box right + 2. - - box := self growBoxFrame. - right := box left - 2. - Display fill: (Rectangle left: left right: right top: top bottom: bottom) - fillColor: stripes. - left := box right + 2. - - right := labelDisplayBox right - 3. - Display fill: (Rectangle left: left right: right top: top bottom: bottom) - fillColor: stripes. - ! Item was removed: - ----- Method: StandardSystemView>>displayView (in category 'displaying') ----- - displayView - "Refer to the comment in View|displayView. " - labelFrame height = 0 ifTrue: [^ self]. "no label" - self displayBox width = labelFrame width ifFalse: - ["recompute label width when window changes size" - self setLabelRegion]. - (labelFrame align: labelFrame topLeft with: self windowOrigin) - insideColor: self labelColor; - displayOn: Display. - self displayLabelText! Item was removed: - ----- Method: StandardSystemView>>emphasizeLabel (in category 'displaying') ----- - emphasizeLabel - "Highlight the label." - labelFrame height = 0 ifTrue: [^ self]. "no label" - self displayLabelBackground: true. - self displayLabelBoxes. - self displayLabelText.! Item was removed: - ----- Method: StandardSystemView>>emphasizeView (in category 'deEmphasizing') ----- - emphasizeView - "Refer to the comment in View|emphasizeView." - - self emphasizeLabel! Item was removed: - ----- Method: StandardSystemView>>erase (in category 'displaying') ----- - erase - "Clear the display box of the receiver to be gray, as the screen background." - | oldValid | - CacheBits - ifTrue: - [oldValid := bitsValid. - bitsValid := false. - ScheduledControllers restore: self windowBox without: self. - bitsValid := oldValid] - ifFalse: - [ScheduledControllers restore: self windowBox without: self]! Item was removed: - ----- Method: StandardSystemView>>expand (in category 'framing') ----- - expand - "If the receiver is collapsed, change its view to be that of all of its subviews, not its label alone." - | newFrame | - self isCollapsed - ifTrue: - [newFrame := self chooseFrame expandBy: borderWidth. - collapsedViewport := self viewport. - subViews := savedSubViews. - labelFrame borderWidthLeft: 2 right: 2 top: 2 bottom: 2. - savedSubViews := nil. - self setWindow: nil. - self resizeTo: newFrame. - self displayDeEmphasized. - model modelWakeUpIn: self]! Item was removed: - ----- Method: StandardSystemView>>expandedFrame (in category 'framing') ----- - expandedFrame - "Answer the rectangle occupied by this window when expanded." - ^ expandedViewport "NOTE may be nil"! Item was removed: - ----- Method: StandardSystemView>>fullScreen (in category 'framing') ----- - fullScreen - "Expand the receiver to fill the screen. Let the model decide how big is full -- allows for flop-out scrollbar on left if desired" - - self isCollapsed ifFalse: - [self reframeTo: model fullScreenSize]! Item was removed: - ----- Method: StandardSystemView>>getFrame (in category 'framing') ----- - getFrame - "Ask the user to designate a rectangular area in which - the receiver should be displayed." - | minFrame | - minFrame := Cursor origin showWhile: - [(Sensor cursorPoint extent: self minimumSize) newRectFrom: - [:f | Sensor cursorPoint extent: self minimumSize]]. - self maximumSize <= self minimumSize ifTrue: [^ minFrame]. - ^ Cursor corner showWhile: - [minFrame newRectFrom: - [:f | self constrainFrame: (f origin corner: Sensor cursorPoint)]]! Item was removed: - ----- Method: StandardSystemView>>growBoxFrame (in category 'label access') ----- - growBoxFrame - ^ Rectangle origin: (self labelDisplayBox rightCenter + (-22 @ -5)) extent: (11 @ 11)! Item was removed: - ----- Method: StandardSystemView>>initialExtent (in category 'framing') ----- - initialExtent - "Answer the desired extent for the receiver when it is first opened on the screen. " - - ^ model initialExtent min: maximumSize max: minimumSize! Item was removed: - ----- Method: StandardSystemView>>initialFrame (in category 'framing') ----- - initialFrame - "Find a plausible initial screen area for the receiver, taking into account user preference, the size needed, and other windows currently on the screen. 5/22/96 sw: let RealEstateAgent do it for us" - - ^ RealEstateAgent initialFrameFor: self world: nil! Item was removed: - ----- Method: StandardSystemView>>initialize (in category 'initialize-release') ----- - initialize - "Refer to the comment in View|initialize." - super initialize. - labelFrame := Quadrangle new. - labelFrame region: (Rectangle origin: 0 @ 0 extent: 50 @ self labelHeight). - labelFrame borderWidthLeft: 2 right: 2 top: 2 bottom: 2. - self label: nil. - isLabelComplemented := false. - minimumSize := 50 @ 50. - maximumSize := Display extent. - collapsedViewport := nil. - expandedViewport := nil. - bitsValid := false. - updatablePanes := #()! Item was removed: - ----- Method: StandardSystemView>>isCollapsed (in category 'testing') ----- - isCollapsed - "Answer whether the receiver is collapsed (true) or expanded (false)." - - ^savedSubViews ~~ nil! Item was removed: - ----- Method: StandardSystemView>>isWindowForModel: (in category 'testing') ----- - isWindowForModel: aModel - "Return true if the receiver acts as the window for the given model" - ^aModel == self model! Item was removed: - ----- Method: StandardSystemView>>label (in category 'label access') ----- - label - "Answer the string that appears in the receiver's label." - labelText isNil - ifTrue: [^ 'Untitled' copy] - ifFalse: [^ labelText asString]! Item was removed: - ----- Method: StandardSystemView>>label: (in category 'label access') ----- - label: aString - "Set aString to be the receiver's label." - labelText := Paragraph - withText: (Text fromString: ((aString == nil or: [aString isEmpty]) - ifTrue: ['Untitled' copy] - ifFalse: [aString])) - style: self class standardLabelStyle. - insetDisplayBox == nil ifTrue: [^ self]. "wait for further initialization" - self setLabelRegion! Item was removed: - ----- Method: StandardSystemView>>labelColor (in category 'label access') ----- - labelColor - "Answer the color to use as the background for the receiver's label. By default, this is the same as the background color of the window, but need not be. 7/16/96 sw" - - ^ self backgroundColor! Item was removed: - ----- Method: StandardSystemView>>labelContainsPoint: (in category 'testing') ----- - labelContainsPoint: aPoint - "Answer TRUE if aPoint is in the label box." - - ^self labelDisplayBox containsPoint: aPoint! Item was removed: - ----- Method: StandardSystemView>>labelDisplayBox (in category 'label access') ----- - labelDisplayBox - "Answer the rectangle that borders the visible parts of the receiver's label - on the display screen." - - ^ labelFrame region - align: labelFrame topLeft - with: self windowOrigin! Item was removed: - ----- Method: StandardSystemView>>labelFrame (in category 'label access') ----- - labelFrame - ^labelFrame! Item was removed: - ----- Method: StandardSystemView>>labelHeight (in category 'label access') ----- - labelHeight - ^ ((self class standardLabelStyle fontAt: 1) height + 4) max: 20! Item was removed: - ----- Method: StandardSystemView>>labelOffset (in category 'label access') ----- - labelOffset - ^ 0 @ (self labelHeight-2)! Item was removed: - ----- Method: StandardSystemView>>labelText (in category 'label access') ----- - labelText - ^labelText! Item was removed: - ----- Method: StandardSystemView>>labelTextRegion (in category 'label access') ----- - labelTextRegion - labelText == nil ifTrue: [^ self labelDisplayBox center extent: 0 at 0]. - ^ (labelText boundingBox - align: labelText boundingBox center - with: self labelDisplayBox center) - intersect: (self labelDisplayBox insetBy: 35 at 0)! Item was removed: - ----- Method: StandardSystemView>>makeMeVisible (in category 'displaying') ----- - makeMeVisible - - | newLoc portRect | - ((Display boundingBox insetBy: (0 at 0 corner: self labelHeight asPoint)) - containsPoint: self displayBox topLeft) ifTrue: [^ self "OK -- my top left is visible"]. - - "window not on screen (probably due to reframe) -- move it now" - newLoc := self isCollapsed - ifTrue: [RealEstateAgent assignCollapsePointFor: self] - ifFalse: [(RealEstateAgent initialFrameFor: self world: nil) topLeft]. - portRect := newLoc + self labelOffset - extent: self windowBox extent - self labelOffset. - self resizeTo: portRect. - self setLabelRegion. - ! Item was removed: - ----- Method: StandardSystemView>>maximumSize (in category 'size') ----- - maximumSize - "Answer a point representing the maximum width and height of the - receiver." - - ^maximumSize! Item was removed: - ----- Method: StandardSystemView>>maximumSize: (in category 'size') ----- - maximumSize: aPoint - "Set the argument, aPoint, to be the maximum width and height of the - receiver." - - maximumSize := aPoint! Item was removed: - ----- Method: StandardSystemView>>minimumSize (in category 'size') ----- - minimumSize - "Answer a point representing the minimum width and height of the - receiver." - - ^minimumSize! Item was removed: - ----- Method: StandardSystemView>>minimumSize: (in category 'size') ----- - minimumSize: aPoint - "Set the argument, aPoint, to be the minimum width and height of the - receiver." - - minimumSize := aPoint! Item was removed: - ----- Method: StandardSystemView>>moved (in category 'framing') ----- - moved - "The user has moved the receiver; after a new view rectangle is chosen, this method is called to allow certain views to take note of the change. 6/10/96 sw" ! Item was removed: - ----- Method: StandardSystemView>>newFrame: (in category 'framing') ----- - newFrame: frameChangeBlock - self reframeTo: (self windowBox newRectFrom: - [:f | self constrainFrame: (frameChangeBlock value: f)])! Item was removed: - ----- Method: StandardSystemView>>noLabel (in category 'label access') ----- - noLabel - "A label of zero height indicates no label" - labelFrame height > 0 - ifTrue: [labelFrame region: (labelFrame bottomLeft + (0 at 1) extent: labelFrame width at 0). - labelFrame borderWidth: 0. - self uncacheBits]! Item was removed: - ----- Method: StandardSystemView>>reframePanesAdjoining:along:to: (in category 'framing') ----- - reframePanesAdjoining: subView along: side to: aDisplayBox - | delta newRect minDim theMin | - newRect := aDisplayBox. - theMin := 16. - "First check that this won't make any pane smaller than theMin screen dots" - minDim := ((subViews select: [:sub | sub displayBox bordersOn: subView displayBox along: side]) - collect: [:sub | sub displayBox adjustTo: newRect along: side]) - inject: 999 into: [:was :rect | (was min: rect width) min: rect height]. - "If so, amend newRect as required" - minDim < theMin ifTrue: - [delta := minDim - theMin. - newRect := newRect withSide: side setTo: - ((newRect perform: side) > (subView displayBox perform: side) - ifTrue: [(newRect perform: side) + delta] - ifFalse: [(newRect perform: side) - delta])]. - "Now adjust all adjoining panes for real" - subViews do: - [:sub | (sub displayBox bordersOn: subView displayBox along: side) ifTrue: - [| newBox | - newBox := sub displayBox adjustTo: newRect along: side. - sub window: sub window viewport: - (sub transform: (sub inverseDisplayTransform: newBox)) rounded]]. - "And adjust the growing pane itself" - subView window: subView window viewport: - (subView transform: (subView inverseDisplayTransform: newRect)) rounded. - - "Finally force a recomposition of the whole window" - viewport := nil. - self resizeTo: self viewport. - self uncacheBits; displayEmphasized! Item was removed: - ----- Method: StandardSystemView>>reframeTo: (in category 'framing') ----- - reframeTo: newFrame - "Reframe the receiver to the given screen rectangle. - Repaint difference after the change. " - | oldBox newBox portRect | - self uncacheBits. - oldBox := self windowBox. - portRect := newFrame topLeft + self labelOffset - corner: newFrame corner. - self setWindow: nil. - self resizeTo: portRect. - self setLabelRegion. - newBox := self windowBox. - (oldBox areasOutside: newBox) do: - [:rect | ScheduledControllers restore: rect]. - self displayEmphasized! Item was removed: - ----- Method: StandardSystemView>>relabel: (in category 'label access') ----- - relabel: aString - "A new string for the label. Window is assumed to be active. - Window will redisplay only if label bar has to grow." - | oldRegion oldWidth | - (model windowReqNewLabel: aString) ifFalse: [^ self]. - oldRegion := self labelTextRegion. - oldWidth := self insetDisplayBox width. - self label: aString. - Display fill: ((oldRegion merge: self labelTextRegion) expandBy: 3 at 0) - fillColor: self labelColor. - self insetDisplayBox width = oldWidth - ifTrue: [self displayLabelText; emphasizeLabel] - ifFalse: [self uncacheBits; displayEmphasized]. - ! Item was removed: - ----- Method: StandardSystemView>>release (in category 'initialize-release') ----- - release - - model windowIsClosing; release. - self isCollapsed ifTrue: [savedSubViews do: [:v | v release]]. - super release. - ! Item was removed: - ----- Method: StandardSystemView>>resize (in category 'framing') ----- - resize - "Determine the rectangular area for the receiver, adjusted to the - minimum and maximum sizes." - | f | - f := self getFrame. - self resizeTo: (f topLeft + self labelOffset extent: f extent) - ! Item was removed: - ----- Method: StandardSystemView>>resizeInitially (in category 'framing') ----- - resizeInitially - "Determine the rectangular area for the receiver, adjusted to the - minimum and maximum sizes." - self resizeTo: self initialFrame - ! Item was removed: - ----- Method: StandardSystemView>>resizeMinimumCenteredAt: (in category 'framing') ----- - resizeMinimumCenteredAt: aPoint - "Determine the rectangular area for the receiver, adjusted so that it is - centered a position, aPoint." - | aRectangle | - aRectangle := 0 @ 0 extent: self minimumSize. - aRectangle := aRectangle align: aRectangle center with: aPoint. - self resizeTo: aRectangle! Item was removed: - ----- Method: StandardSystemView>>resizeTo: (in category 'framing') ----- - resizeTo: aRectangle - "Resize this view to aRectangle" - - "First get scaling right inside borders" - self window: (self window insetBy: borderWidth) - viewport: (aRectangle insetBy: borderWidth). - - "Then ensure window maps to aRectangle" - window := transformation applyInverseTo: aRectangle! Item was removed: - ----- Method: StandardSystemView>>setLabel: (in category 'label access') ----- - setLabel: aLabel - "For compatibility with morphic" - - self relabel: aLabel! Item was removed: - ----- Method: StandardSystemView>>setLabelRegion (in category 'label access') ----- - setLabelRegion - "Always follows view width" - - labelFrame region: (0 @ 0 extent: self displayBox width @ self labelHeight). - labelFrame borderWidth: 2! Item was removed: - ----- Method: StandardSystemView>>setLabelTo: (in category 'label access') ----- - setLabelTo: aString - "Force aString to be the new label of the receiver, bypassing any logic about whether it is acceptable and about propagating information about the change." - - | oldRegion oldWidth | - self label: aString. - self controller isControlActive ifFalse: [^ self]. - oldRegion := self labelTextRegion. - oldWidth := self insetDisplayBox width. - Display fill: ((oldRegion merge: self labelTextRegion) expandBy: 3 at 0) - fillColor: self labelColor. - self insetDisplayBox width = oldWidth - ifTrue: [self displayLabelText; emphasizeLabel] - ifFalse: [self uncacheBits; displayEmphasized]! Item was removed: - ----- Method: StandardSystemView>>setTransformation: (in category 'private') ----- - setTransformation: aTransformation - "Override to support label size changes " - super setTransformation: aTransformation. - self label: self label! Item was removed: - ----- Method: StandardSystemView>>setUpdatablePanesFrom: (in category 'updating') ----- - setUpdatablePanesFrom: getSelectors - "Set my updatablePanes inst var to the list of panes which are list panes with the given get-list selectors. Order is important here!! Note that the method is robust in the face of panes not found, but a warning is printed in the transcript in each such case" - | aList | - aList := OrderedCollection new. - getSelectors do: - [:sel | - | aPane | - aPane := self subViewSatisfying: - [:pane | (pane isKindOf: PluggableListView) and: [pane getListSelector == sel]]. - aPane - ifNotNil: - [aList add: aPane] - ifNil: - [Transcript cr; show: 'Warning: view ', sel, ' not found.']]. - updatablePanes := aList asArray! Item was removed: - ----- Method: StandardSystemView>>standardWindowOffset (in category 'framing') ----- - standardWindowOffset - ^ Preferences standardWindowOffset! Item was removed: - ----- Method: StandardSystemView>>subviewWithLongestSide:near: (in category 'private') ----- - subviewWithLongestSide: sideBlock near: aPoint - | theSub theSide theLen | - theLen := 0. - subViews do: - [:sub | - | box | - box := sub insetDisplayBox. - box forPoint: aPoint closestSideDistLen: - [:side :dist :len | - (dist <= 5 and: [len > theLen]) ifTrue: - [theSub := sub. - theSide := side. - theLen := len]]]. - sideBlock value: theSide. - ^ theSub! Item was removed: - ----- Method: StandardSystemView>>uncacheBits (in category 'displaying') ----- - uncacheBits - windowBits := nil. - bitsValid := false.! Item was removed: - ----- Method: StandardSystemView>>updatablePanes (in category 'updating') ----- - updatablePanes - "Answer the list of panes, in order, which might be sent the #verifyContents message upon window activation or expansion." - ^ updatablePanes ifNil: [updatablePanes := #()]! Item was removed: - ----- Method: StandardSystemView>>update: (in category 'updating') ----- - update: aSymbol - aSymbol = #relabel - ifTrue: [^ self setLabelTo: model labelString]. - aSymbol = #close - ifTrue: [^ self controller closeAndUnscheduleNoTerminate]. - - ^ super update: aSymbol! Item was removed: - ----- Method: StandardSystemView>>windowBits (in category 'displaying') ----- - windowBits - ^ windowBits! Item was removed: - ----- Method: StandardSystemView>>windowBox (in category 'framing') ----- - windowBox - ^ self displayBox merge: self labelDisplayBox! Item was removed: - ----- Method: StandardSystemView>>windowOrigin (in category 'framing') ----- - windowOrigin - ^ (self isCollapsed or: [labelFrame height = 0 "no label"]) - ifTrue: [self displayBox topLeft] - ifFalse: [self displayBox topLeft - self labelOffset]! Item was removed: - ----- Method: String>>asParagraph (in category '*ST80-Support') ----- - asParagraph - "Answer a Paragraph whose text string is the receiver." - - ^Paragraph withText: self asText! Item was removed: - ParagraphEditor subclass: #StringHolderController - instanceVariableNames: '' - classVariableNames: 'CodeYellowButtonMenu CodeYellowButtonMessages' - poolDictionaries: '' - category: 'ST80-Support'! - - !StringHolderController commentStamp: '<historical>' prior: 0! - I represent a ParagraphEditor for a single paragraph of text, omitting alignment commands. I provide items in the yellow button menu so that the text selection can be evaluated and so that the contents of the model can be stored or restored. - doIt evaluate the text selection as an expression - printIt same as doIt but insert a description of the result after the selection - accept store the contents of the StringHolder into the model - cancel store the contents of the model into the StringHolder! Item was removed: - ----- Method: StringHolderController>>accept (in category 'menu messages') ----- - accept - "Refer to the comment in ParagraphEditor|accept." - - super accept. - model contents: paragraph string. - self userHasNotEdited. - ! Item was removed: - ----- Method: StringHolderController>>bindingOf: (in category 'compiler access') ----- - bindingOf: aString - ^model bindingOf: aString! Item was removed: - ----- Method: StringHolderController>>cancel (in category 'menu messages') ----- - cancel - "Refer to the comment in ParagraphEditor|cancel." - - super cancel. - self userHasNotEdited. - ! Item was removed: - ----- Method: StringHolderController>>changeText: (in category 'accessing') ----- - changeText: aText - "The paragraph to be edited is changed to aText." - paragraph text: aText. - self resetState. - self selectInvisiblyFrom: paragraph text size + 1 to: paragraph text size. - self selectAndScroll. - self deselect! Item was removed: - ----- Method: StringHolderController>>closeTypeIn (in category 'private') ----- - closeTypeIn - "Note edit if something actually was typed." - - beginTypeInBlock ~~ nil ifTrue: [self userHasEdited]. - super closeTypeIn. - ! Item was removed: - ----- Method: StringHolderController>>hasUnacceptedEdits: (in category 'edit flag') ----- - hasUnacceptedEdits: aBoolean - ^ view hasUnacceptedEdits: aBoolean! Item was removed: - ----- Method: StringHolderController>>model: (in category 'accessing') ----- - model: aModel - - super model: aModel. - view displayContents == nil - ifFalse: [self changeParagraph: view displayContents]! Item was removed: - ----- Method: StringHolderController>>performMenuMessage: (in category 'menu messages') ----- - performMenuMessage: aSelector - "Intercept #again so the model does not get locked by keying the search text." - - | hadEdits | - hadEdits := view canDiscardEdits not. - super performMenuMessage: aSelector. - (hadEdits not and: - [aSelector == #again and: - [(UndoMessage sends: #undoAgain:andReselect:typedKey:) and: - [UndoMessage arguments at: 3]]]) - ifTrue: [self userHasNotEdited]. - ! Item was removed: - ----- Method: StringHolderController>>userHasEdited (in category 'edit flag') ----- - userHasEdited - "Note that the user has edited my text." - - view hasUnacceptedEdits: true - ! Item was removed: - ----- Method: StringHolderController>>userHasNotEdited (in category 'edit flag') ----- - userHasNotEdited - "Note that my text is free of user edits." - - model changed: #clearUserEdits.! Item was removed: - ----- Method: StringHolderController>>zapSelectionWith: (in category 'private') ----- - zapSelectionWith: aText - "Note edit except during typeIn, which notes edits at close." - - super zapSelectionWith: aText. - beginTypeInBlock == nil ifTrue: [self userHasEdited]. - ! Item was removed: - View subclass: #StringHolderView - instanceVariableNames: 'displayContents hasUnacceptedEdits askBeforeDiscardingEdits' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Support'! - - !StringHolderView commentStamp: '<historical>' prior: 0! - I am a View of a String that is an aspect of a more structured object. This String should not be changed by any editing unless the user issues the accept command. Thus my instances provide a working copy of the String. This copy is edited. When the user issues the accept command, the String is copied from the working version; or if the user issues the cancel command, the working version is restored from the String. StringHolderController is my default controller. It is initialized specially by passing the string viewed which is then converted to a Paragraph for editing.! Item was removed: - ----- Method: StringHolderView class>>container (in category 'instance creation') ----- - container - "Answer an instance of me with a new instance of StringHolder as the - model." - - ^self container: StringHolder new! Item was removed: - ----- Method: StringHolderView class>>container: (in category 'instance creation') ----- - container: aContainer - "Answer an instance of me whose model is aContainer. Give it a 2-dot - border." - - | aCodeView | - aCodeView := self new model: aContainer. - aCodeView borderWidthLeft: 2 right: 2 top: 2 bottom: 2. - ^aCodeView! Item was removed: - ----- Method: StringHolderView class>>open (in category 'instance creation') ----- - open - "Create a standard system view of a workspace on the screen." - - self open: StringHolder new label: 'Workspace'! Item was removed: - ----- Method: StringHolderView class>>open: (in category 'instance creation') ----- - open: aStringHolder - "Create a standard system view of the argument, aStringHolder, as viewed - by an instance of me. The view has label 'StringHolder'." - - self open: aStringHolder label: 'StringHolder'! Item was removed: - ----- Method: StringHolderView class>>open:label: (in category 'instance creation') ----- - open: aStringHolder label: labelString - "NOTE this should be in the model class, and all senders so redirected, - in order that the view class can be discarded in a morphic world." - - "Create a standard system view of the model, aStringHolder, as viewed by - an instance of me. The label of the view is aString." - | aStringHolderView topView | - - aStringHolderView := self container: aStringHolder. - topView := StandardSystemView new. - topView model: aStringHolderView model. - topView addSubView: aStringHolderView. - topView label: labelString. - topView minimumSize: 100 @ 50. - topView controller open! Item was removed: - ----- Method: StringHolderView>>accept (in category 'controller access') ----- - accept - - ^ self controller accept! Item was removed: - ----- Method: StringHolderView>>askBeforeDiscardingEdits: (in category 'updating') ----- - askBeforeDiscardingEdits: aBoolean - "Set the flag that determines whether the user should be asked before discarding unaccepted edits." - - askBeforeDiscardingEdits := aBoolean. - ! Item was removed: - ----- Method: StringHolderView>>canDiscardEdits (in category 'updating') ----- - canDiscardEdits - "Return true if this view either has no text changes or does not care." - - ^ (hasUnacceptedEdits & askBeforeDiscardingEdits) not - ! Item was removed: - ----- Method: StringHolderView>>deEmphasizeView (in category 'deEmphasizing') ----- - deEmphasizeView - "Refer to the comment in View|deEmphasizeView." - - (self controller isKindOf: ParagraphEditor) - ifTrue: [controller deselect]! Item was removed: - ----- Method: StringHolderView>>defaultController (in category 'controller access') ----- - defaultController - "Refer to the comment in View|defaultController." - - ^self defaultControllerClass newParagraph: displayContents! Item was removed: - ----- Method: StringHolderView>>defaultControllerClass (in category 'controller access') ----- - defaultControllerClass - "Refer to the comment in View|defaultControllerClass." - - ^StringHolderController! Item was removed: - ----- Method: StringHolderView>>display (in category 'displaying') ----- - display - "Refer to the comment in View.display." - (self isUnlocked and: [self insetDisplayBox ~= displayContents clippingRectangle]) - ifTrue: "Recompose the text if the window changed" - [self positionDisplayContents. - (self controller isKindOf: ParagraphEditor) - ifTrue: [controller recomputeSelection]]. - super display! Item was removed: - ----- Method: StringHolderView>>displayContents (in category 'controller access') ----- - displayContents - - ^displayContents! Item was removed: - ----- Method: StringHolderView>>displayView (in category 'displaying') ----- - displayView - "Refer to the comment in View|displayView." - - Display deferUpdatesIn: self displayBox while: [ - self clearInside. - (self controller isKindOf: ParagraphEditor) - ifTrue: [controller display] - ifFalse: [displayContents display]]! Item was removed: - ----- Method: StringHolderView>>editString: (in category 'model access') ----- - editString: aString - "The paragraph to be displayed is created from the characters in aString." - - displayContents := Paragraph withText: aString asText - style: TextStyle default copy - compositionRectangle: (self insetDisplayBox insetBy: 6 @ 0) - clippingRectangle: self insetDisplayBox - foreColor: self foregroundColor backColor: self backgroundColor. - (self controller isKindOf: ParagraphEditor) - ifTrue: [controller changeParagraph: displayContents]! Item was removed: - ----- Method: StringHolderView>>getMenu: (in category 'model access') ----- - getMenu: shiftKeyState - ^ nil! Item was removed: - ----- Method: StringHolderView>>hasUnacceptedEdits (in category 'updating') ----- - hasUnacceptedEdits - "Return true if this view has unaccepted edits." - - ^ hasUnacceptedEdits - ! Item was removed: - ----- Method: StringHolderView>>hasUnacceptedEdits: (in category 'updating') ----- - hasUnacceptedEdits: aBoolean - "Set the hasUnacceptedEdits flag to the given value." - - hasUnacceptedEdits := aBoolean. - ! Item was removed: - ----- Method: StringHolderView>>initialize (in category 'initialize-release') ----- - initialize - "Refer to the comment in View|initialize." - - super initialize. - displayContents := '' asParagraph. - hasUnacceptedEdits := false. - askBeforeDiscardingEdits := true. - ! Item was removed: - ----- Method: StringHolderView>>isWrapped (in category 'wrapping') ----- - isWrapped - ^true! Item was removed: - ----- Method: StringHolderView>>lock (in category 'displaying') ----- - lock - "Refer to the comment in view|lock. Must do at least what display would do to lock the view." - (self isUnlocked and: [self insetDisplayBox ~= displayContents clippingRectangle]) - ifTrue: "Recompose the text if the window changed" - [self positionDisplayContents. - (self controller isKindOf: ParagraphEditor) - ifTrue: [controller recomputeSelection]]. - super lock! Item was removed: - ----- Method: StringHolderView>>model: (in category 'model access') ----- - model: aLockedModel - "Refer to the comment in View|model:." - - super model: aLockedModel. - self editString: model contents! Item was removed: - ----- Method: StringHolderView>>positionDisplayContents (in category 'displaying') ----- - positionDisplayContents - "Presumably the text being displayed changed so that the wrapping box - and clipping box should be reset." - - displayContents - wrappingBox: (self insetDisplayBox insetBy: 6 @ 0) - clippingBox: self insetDisplayBox! Item was removed: - ----- Method: StringHolderView>>promptForCancel (in category 'updating') ----- - promptForCancel - "Ask if it is OK to cancel changes to text" - | okToCancel stripes | - self topView isCollapsed ifTrue: - [(self confirm: 'Changes have not been saved. - Is it OK to cancel those changes?' translated) ifTrue: [model changed: #clearUserEdits]. - ^ self]. - stripes := (Form extent: 16 at 16 fromStipple: 16r36C9) bits. - Display border: self insetDisplayBox width: 4 - rule: Form reverse fillColor: stripes. - okToCancel := self confirm: 'Changes have not been saved. - Is it OK to cancel those changes?' translated. - Display border: self insetDisplayBox width: 4 - rule: Form reverse fillColor: stripes. - okToCancel ifTrue: - [self updateDisplayContents. - model changed: #clearUserEdits]. - ! Item was removed: - ----- Method: StringHolderView>>text (in category 'controller access') ----- - text - - ^ self displayContents text! Item was removed: - ----- Method: StringHolderView>>update: (in category 'updating') ----- - update: aSymbol - "Refer to the comment in View|update:." - aSymbol == #wantToChange ifTrue: [^ self promptForCancel]. - aSymbol == #clearUserEdits ifTrue: [^ self hasUnacceptedEdits: false]. - aSymbol == #flash ifTrue: [^ controller flash]. - self updateDisplayContents! Item was removed: - ----- Method: StringHolderView>>updateDisplayContents (in category 'updating') ----- - updateDisplayContents - "Make the text that is displayed be the contents of the receiver's model." - - self editString: model contents. - self displayView! Item was removed: - ----- Method: StringHolderView>>wrapFlag: (in category 'wrapping') ----- - wrapFlag: aBoolean - "Control whether contained text will adjust its bounds as I change shape. - This is a no-op in MVC,. See TextMorph>>wrapFlag: for reference." - ! Item was removed: - Model subclass: #Switch - instanceVariableNames: 'on onAction offAction' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Menus'! - - !Switch commentStamp: '<historical>' prior: 0! - I represent a selection setting and actions to take depending on a change in the setting. An instance has three attributes: state, which is either on or off; on action; and off action. The on and off actions are blocks of code that execute whenever the instance changes state. I am typically used as a menu item in conjunction with a SwitchView and a SwitchController. - 1/24/96 sw: made this a subclass of Model, for faster dependents handling! Item was removed: - ----- Method: Switch class>>new (in category 'instance creation') ----- - new - "Answer an instance of me such that the on and off actions are set to nil - ('no action'), and the state is set to 'off'." - - ^self newOff! Item was removed: - ----- Method: Switch class>>newOff (in category 'instance creation') ----- - newOff - "Answer an instance of me such that the on and off actions are set to nil - ('no action'), and the state is set to 'off'." - - ^super new initializeOff! Item was removed: - ----- Method: Switch class>>newOn (in category 'instance creation') ----- - newOn - "Answer an instance of me such that the on and off actions are set to nil - ('no action'), and the state is set to 'on'." - - ^super new initializeOn! Item was removed: - ----- Method: Switch>>clear (in category 'state') ----- - clear - "Set the state of the receiver to 'off'. If the state of the receiver was - previously 'on', then 'self change' is sent. The receiver's off action is - NOT executed." - - self isOn - ifTrue: - [on := false. - self changed]! Item was removed: - ----- Method: Switch>>doAction: (in category 'action') ----- - doAction: anAction - "Execute anAction if it is non-nil." - - anAction == nil ifFalse: [anAction value]! Item was removed: - ----- Method: Switch>>initializeOff (in category 'private') ----- - initializeOff - - on := false. - onAction := nil. - offAction := nil! Item was removed: - ----- Method: Switch>>initializeOn (in category 'private') ----- - initializeOn - - on := true. - onAction := nil. - offAction := nil! Item was removed: - ----- Method: Switch>>isOff (in category 'state') ----- - isOff - "Answer whether the receiver is set off or not." - - ^on not! Item was removed: - ----- Method: Switch>>isOn (in category 'state') ----- - isOn - "Answer whether the receiver is set on or not." - - ^on! Item was removed: - ----- Method: Switch>>offAction: (in category 'action') ----- - offAction: anAction - "Set the off action of the receiver to anAction." - - offAction := anAction! Item was removed: - ----- Method: Switch>>onAction: (in category 'action') ----- - onAction: anAction - "Set the on action of the receiver to anAction." - - onAction := anAction! Item was removed: - ----- Method: Switch>>printOn: (in category 'converting') ----- - printOn: aStream - self isOn - ifTrue: [aStream nextPutAll: 'ON-Switch'] - ifFalse: [aStream nextPutAll: 'OFF-Switch']! Item was removed: - ----- Method: Switch>>set (in category 'state') ----- - set - "Set the state of the receiver to 'on'. If the state of the receiver was - previously 'off', then 'self change' is sent. The receiver's on action is - NOT executed." - - self isOff - ifTrue: - [on := true. - self changed]! Item was removed: - ----- Method: Switch>>switch (in category 'state') ----- - switch - "Change the state of the receiver from 'on' to 'off' or from 'off' to 'on' (see - Switch|turnOn, Switch|turnOff)." - - self isOn - ifTrue: [self turnOff] - ifFalse: [self turnOn]! Item was removed: - ----- Method: Switch>>turnOff (in category 'state') ----- - turnOff - "Set the state of the receiver to 'off'. If the state of the receiver was - previously 'on', then 'self change' is sent and the receiver's off action is - executed." - - self isOn - ifTrue: - [on := false. - self changed. - self doAction: offAction]! Item was removed: - ----- Method: Switch>>turnOn (in category 'state') ----- - turnOn - "Set the state of the receiver to 'on'. If the state of the receiver was - previously 'off', then 'self change' is sent and the receiver's on action is - executed." - - self isOff - ifTrue: - [on := true. - self changed. - self doAction: onAction]! Item was removed: - TestCase subclass: #TestIndenting - instanceVariableNames: 'para' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Support-Tests'! Item was removed: - ----- Method: TestIndenting>>setUp (in category 'running') ----- - setUp - | text style | - text := 'p ' asText, (Text string: 'word word' attribute: (TextIndent tabs: 1)). - style := (TextStyle named: #Accuny) copy. - style defaultFontIndex: 2. "Default to Accuny12 as expected by tests." - para := text asParagraph textStyle: style! Item was removed: - ----- Method: TestIndenting>>testBreakAtSpaceLeavesSpaceOnOriginalLine (in category 'tests') ----- - testBreakAtSpaceLeavesSpaceOnOriginalLine - "When an indented line is broken at a space, the character block must still lie in the line crossing the right margin." - | cb | - para compositionRectangle: (0 at 0 extent: para width - 24 @100); updateCompositionHeight. - para clippingRectangle: (0 at 0 extent: 200 at 200). - cb := para characterBlockForIndex: 7. - self assert: cb top = 0. - self assert: cb left >= 24! Item was removed: - ----- Method: TestIndenting>>testCR (in category 'tests') ----- - testCR - "Checks whether the beginning of a new line starts at the indented position" - | cb leftMargin | - para replaceFrom: 7 to: 7 with: (String with: Character cr) displaying: false. - para clippingRectangle: (0 at 0 extent: 200 at 200). - cb := para characterBlockForIndex: 8. - leftMargin := para textStyle leftMarginTabAt: 1. - self assert: cb top > 0. - self assert: cb left = leftMargin! Item was removed: - ----- Method: TestIndenting>>testCR2 (in category 'tests') ----- - testCR2 - "Checks whether the drawing of indented text is really indented..." - | cb | - para replaceFrom: 7 to: 7 with: (String with: Character cr) displaying: false. - para clippingRectangle: (0 at 0 extent: 200 at 200). - cb := para characterBlockForIndex: 8. - self assert: (para asForm copy: (0 at cb top extent: 24 at cb height)) isAllWhite! Item was removed: - ----- Method: TestIndenting>>testCR3 (in category 'tests') ----- - testCR3 - "Checks whether the beginning of a new line starts at the indented position" - | cb leftMargin | - para replaceFrom: 11 to: 11 with: (Text string: (String with: Character cr) attribute: (TextIndent tabs: 1)) displaying: false. - para clippingRectangle: (0 at 0 extent: 200 at 200). - cb := para characterBlockForIndex: 12. - leftMargin := para textStyle leftMarginTabAt: 1. - self assert: cb top > 0. - self assert: cb left = leftMargin! Item was removed: - ----- Method: TestIndenting>>testNewLineAndTabProvidesDoubleIndent (in category 'tests') ----- - testNewLineAndTabProvidesDoubleIndent - "Checks whether the beginning of a new line starts at the indented position" - | cb leftMargin | - para replaceFrom: 11 to: 11 with: (Text string: (String with: Character cr) attribute: (TextIndent tabs: 1)) displaying: false. - cb := para characterBlockForIndex: 12. - leftMargin := para textStyle leftMarginTabAt: 1. - self assert: cb top > 0. - self assert: cb left = leftMargin! Item was removed: - ----- Method: TestIndenting>>testNewLineLeaveSpacesOnOldLine (in category 'tests') ----- - testNewLineLeaveSpacesOnOldLine - "Checks whether the drawing of indented text is really indented..." - | cb | - para replaceFrom: 7 to: 7 with: (String with: Character cr) displaying: false. - - cb := para characterBlockForIndex: 8. - self assert: (para asForm copy: (0 at cb top extent: 24 at cb height)) isAllWhite! Item was removed: - ----- Method: TestIndenting>>testNewLineStartsIndented (in category 'tests') ----- - testNewLineStartsIndented - "Checks whether the beginning of a new line starts at the indented position" - | cb leftMargin | - para replaceFrom: 7 to: 7 with: (String with: Character cr) displaying: false. - leftMargin := para textStyle leftMarginTabAt: 1. - cb := para characterBlockForIndex: 8. - self assert: cb top > 0. - self assert: cb left = leftMargin! Item was removed: - ----- Method: TestIndenting>>testNewLineStartsIndentedWhenWrapped (in category 'tests') ----- - testNewLineStartsIndentedWhenWrapped - "Checks whether the beginning of a new line starts at the indented position" - | cb leftMargin | - para compositionRectangle: (0 at 0 extent: para width - 24 at 100); updateCompositionHeight. - para clippingRectangle: (0 at 0 extent: 200 at 200). - cb := para characterBlockForIndex: 8. - leftMargin := para textStyle leftMarginTabAt: 1. - self assert: cb top > 0. - self assert: cb left = leftMargin! Item was removed: - ----- Method: TestIndenting>>testSetUp (in category 'tests') ----- - testSetUp - "just reminding us all what the paragraph looks like to begin with. assuming Accuny12 font " - | cb firstTabStop | - firstTabStop := para textStyle nextTabXFrom: 1 leftMargin: 0 rightMargin: 200. - - cb := para characterBlockForIndex: 1. "p" - self assert: cb top = 0. - self assert: cb left = 0. - self assert: cb right = 7. - - cb := para characterBlockForIndex: 2. "the tab" - self assert: cb top = 0. - self assert: cb left = 7. - self assert: cb right = firstTabStop. - - cb := para characterBlockForIndex: 3. "w" - self assert: cb top = 0. - self assert: cb left = firstTabStop. - self assert: cb right = (firstTabStop + 10). - - cb := para characterBlockForIndex: 7. " " "between word and word" - self assert: cb top = 0. - self assert: cb left = (firstTabStop + 28). - self assert: cb right = (firstTabStop + 33). - - cb := para characterBlockForIndex: 11. "d" "last char" - self assert: cb top = 0. - self assert: cb left = (firstTabStop + 55). - self assert: cb right = (firstTabStop + 61). - - - ! Item was removed: - TestParagraphFix subclass: #TestNewParagraphFix - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Support-Tests'! - - !TestNewParagraphFix commentStamp: '<historical>' prior: 0! - This class tests the same things as its superclass, but for NewParagraph which is used in the Morphic environment.! Item was removed: - ----- Method: TestNewParagraphFix>>setUp (in category 'running') ----- - setUp - | morph | - morph := TextMorph new contents: 'i i'. - morph fit. - para := morph paragraph! Item was removed: - ----- Method: TestNewParagraphFix>>testCharacterBlockAfterReplacingAll (in category 'tests') ----- - testCharacterBlockAfterReplacingAll - ^super testCharacterBlockAfterReplacingAll! Item was removed: - ----- Method: TestNewParagraphFix>>testCharacterBlockAfterReplacingOther (in category 'tests') ----- - testCharacterBlockAfterReplacingOther - ^super testCharacterBlockAfterReplacingOther! Item was removed: - ----- Method: TestNewParagraphFix>>testCharacterBlockAfterReplacingSpace (in category 'tests') ----- - testCharacterBlockAfterReplacingSpace - ^super testCharacterBlockAfterReplacingSpace! Item was removed: - ----- Method: TestNewParagraphFix>>testCharacterBlockNormal (in category 'tests') ----- - testCharacterBlockNormal - ^super testCharacterBlockNormal! Item was removed: - TestCase subclass: #TestParagraphFix - instanceVariableNames: 'para' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Support-Tests'! - - !TestParagraphFix commentStamp: '<historical>' prior: 0! - This class tests whether locating characters past the end of a text is possible in all cases.! Item was removed: - ----- Method: TestParagraphFix>>setUp (in category 'running') ----- - setUp - para := 'i i' asParagraph! Item was removed: - ----- Method: TestParagraphFix>>testCharacterBlockAfterReplacingAll (in category 'tests') ----- - testCharacterBlockAfterReplacingAll - para replaceFrom: 1 to: 3 with: 'mmm' displaying: false. - self assert: (para characterBlockForIndex: 4) stringIndex = 4! Item was removed: - ----- Method: TestParagraphFix>>testCharacterBlockAfterReplacingOther (in category 'tests') ----- - testCharacterBlockAfterReplacingOther - para replaceFrom: 3 to: 3 with: 'm' displaying: false. - self assert: (para characterBlockForIndex: 4) stringIndex = 4! Item was removed: - ----- Method: TestParagraphFix>>testCharacterBlockAfterReplacingSpace (in category 'tests') ----- - testCharacterBlockAfterReplacingSpace - para replaceFrom: 3 to: 3 with: ' ' displaying: false. - self assert: (para characterBlockForIndex: 4) stringIndex = 4! Item was removed: - ----- Method: TestParagraphFix>>testCharacterBlockNormal (in category 'tests') ----- - testCharacterBlockNormal - self assert: (para characterBlockForIndex: 4) stringIndex = 4! Item was removed: - ----- Method: Text>>asParagraph (in category '*ST80-Support') ----- - asParagraph - "Answer a Paragraph whose text is the receiver." - - ^Paragraph withText: self! Item was removed: - Interval subclass: #TextLineInterval - instanceVariableNames: 'internalSpaces paddingWidth lineHeight baseline' - classVariableNames: '' - poolDictionaries: 'TextConstants' - category: 'ST80-Support'! - - !TextLineInterval commentStamp: '<historical>' prior: 0! - My instances specify the starting and stopping points in a String of a composed line. The step is always 1.! Item was removed: - ----- Method: TextLineInterval class>>from:to:by: (in category 'instance creation') ----- - from: startInteger to: stopInteger by: stepInteger - "Answer an instance of me, starting at startNumber, ending at - stopNumber, and with an interval increment of stepNumber." - - ^ self basicNew - setFrom: startInteger - to: stopInteger - by: stepInteger! Item was removed: - ----- Method: TextLineInterval class>>start:stop:internalSpaces:paddingWidth: (in category 'instance creation') ----- - start: startInteger stop: stopInteger internalSpaces: spacesInteger paddingWidth: padWidthInteger - "Answer an instance of me with the arguments as the start, stop points, - number of spaces in the line, and width of the padding." - | newSelf | - newSelf := self from: startInteger to: stopInteger by: 1. - ^newSelf internalSpaces: spacesInteger paddingWidth: padWidthInteger! Item was removed: - ----- Method: TextLineInterval>>= (in category 'comparing') ----- - = line - - self species = line species - ifTrue: [^((start = line first and: [stop = line last]) - and: [internalSpaces = line internalSpaces]) - and: [paddingWidth = line paddingWidth]] - ifFalse: [^false]! Item was removed: - ----- Method: TextLineInterval>>baseline (in category 'accessing') ----- - baseline - ^ baseline! Item was removed: - ----- Method: TextLineInterval>>internalSpaces (in category 'accessing') ----- - internalSpaces - "Answer the number of spaces in the line." - - ^internalSpaces! Item was removed: - ----- Method: TextLineInterval>>internalSpaces: (in category 'accessing') ----- - internalSpaces: spacesInteger - "Set the number of spaces in the line to be spacesInteger." - - internalSpaces := spacesInteger! Item was removed: - ----- Method: TextLineInterval>>internalSpaces:paddingWidth: (in category 'private') ----- - internalSpaces: spacesInteger paddingWidth: padWidthInteger - - internalSpaces := spacesInteger. - paddingWidth := padWidthInteger! Item was removed: - ----- Method: TextLineInterval>>justifiedPadFor:font: (in category 'scanning') ----- - justifiedPadFor: spaceIndex font: aFont - "Compute the width of pad for a given space in a line of justified text." - - | pad | - internalSpaces = 0 ifTrue: [^0]. - ^(aFont notNil and:[aFont isSubPixelPositioned]) - ifTrue:[paddingWidth * 1.0 / internalSpaces] - ifFalse:[ - pad := paddingWidth // internalSpaces. - spaceIndex <= (paddingWidth \\ internalSpaces) - ifTrue: [pad + 1] - ifFalse: [pad]]! Item was removed: - ----- Method: TextLineInterval>>justifiedTabDeltaFor: (in category 'scanning') ----- - justifiedTabDeltaFor: spaceIndex - "Compute the delta for a tab in a line of justified text, so tab falls - somewhere plausible when line is justified." - - | pad extraPad | - internalSpaces = 0 ifTrue: [^0]. - pad := paddingWidth // internalSpaces. - extraPad := paddingWidth \\ internalSpaces. - spaceIndex <= extraPad - ifTrue: [^spaceIndex * (pad + 1)] - ifFalse: [^extraPad * (pad + 1) + (spaceIndex - extraPad * pad)]! Item was removed: - ----- Method: TextLineInterval>>lineHeight (in category 'accessing') ----- - lineHeight - ^ lineHeight! Item was removed: - ----- Method: TextLineInterval>>lineHeight:baseline: (in category 'private') ----- - lineHeight: height baseline: ascent - - lineHeight := height. - baseline := ascent! Item was removed: - ----- Method: TextLineInterval>>paddingWidth (in category 'accessing') ----- - paddingWidth - "Answer the amount of space to be added to the font." - - ^paddingWidth! Item was removed: - ----- Method: TextLineInterval>>paddingWidth: (in category 'accessing') ----- - paddingWidth: padWidthInteger - "Set the amount of space to be added to the font to be padWidthInteger." - - paddingWidth := padWidthInteger! Item was removed: - ----- Method: TextLineInterval>>slide: (in category 'updating') ----- - slide: delta - "Change the starting and stopping points of the line by delta." - - start := start + delta. - stop := stop + delta! Item was removed: - ----- Method: TextLineInterval>>stop: (in category 'accessing') ----- - stop: stopInteger - "Set the stopping point in the string of the line to be stopInteger." - - stop := stopInteger! Item was removed: - ----- Method: Transcripter>>mvcDisplayText (in category '*ST80') ----- - mvcDisplayText - para setWithText: self contents asText - style: TextStyle default - compositionRectangle: ((frame insetBy: 4) withHeight: 9999) - clippingRectangle: frame - foreColor: self black backColor: self white. - para display! Item was removed: - ----- Method: Transcripter>>mvcInitializeParagraph: (in category '*ST80') ----- - mvcInitializeParagraph: classParagraph - para := classParagraph withText: self contents asText - style: TextStyle default - compositionRectangle: ((frame insetBy: 4) withHeight: 9999) - clippingRectangle: frame - foreColor: self black backColor: self white! Item was removed: - ----- Method: Utilities class>>emergencyCollapse (in category '*ST80-Support') ----- - emergencyCollapse - - Project current world emergencyCollapse.! Item was removed: - ----- Method: Utilities class>>openScratchWorkspaceLabeled:contents: (in category '*ST80-Support') ----- - openScratchWorkspaceLabeled: labelString contents: initialContents - "Open a scratch text view with the given label on the given string. A scratch text view won't warn you about unsaved changes when you close it." - "Utilities openScratchWorkspaceLabeled: 'Scratch' contents: 'Hello. world!!'" - - | model topView stringView | - model := StringHolder new contents: initialContents. - topView := StandardSystemView new. - topView - model: model; - label: labelString; - minimumSize: 180 at 120. - topView borderWidth: 1. - stringView := PluggableTextView on: model - text: #contents - accept: nil - readSelection: #contentsSelection - menu: #codePaneMenu:shifted:. - stringView - askBeforeDiscardingEdits: false; - window: (0 at 0 extent: 180 at 120). - topView addSubView: stringView. - topView controller open. - ! Item was removed: - Object subclass: #View - instanceVariableNames: 'model controller superView subViews transformation viewport window displayTransformation insetDisplayBox borderWidth borderColor insideColor boundingBox' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Framework'! - - !View commentStamp: '<historical>' prior: 0! - My instances are intended to be components in a structured picture. Each View in the structured picture can contain other Views as sub-components. These sub-components are called subViews. A View can be a subView of only one View. This View is called its superView. The set of Views in a structured picture forms a hierarchy. The one View in the hierarchy that has no superView is called the topView of the structured picture. A View in a structured picture with no subViews is called a bottom View. A View and all of its subViews, and all of their subViews and so on, are treated as a unit in many operations on the View. For example, if a View is displayed, all of its subViews are displayed as well. There are several categories of operations that can be performed on a View. Among these are the following: - - 1. Adding subViews to a View. - 2. Positioning subViews within a View. - 3. Deleting subViews from a View. - 4. Transforming a View. - 5. Displaying a View. - - Each View has its own coordinate system. In order to change from one coordinate system to another, each View has two transformations associated with it. The local transformation is a WindowingTransformation that maps objects in the coordinate system of the View to objects in the coordinate system of the superView of the View. The displayTransformation is a WindowingTransformation that maps objects in the coordinate system of the View to objects in the display screen coordinate system. - - The part of the space that is to be made visible is represented by the window of the View. The window of a View is a Rectangle expressed in the coordinate system of the View. The area occupied by a View in the coordinate system of its superView is called its viewport. The viewport of a View is its window transformed by its local transformation. The region of the display screen occupied by a View is called its displayBox. The display box of a View can include a border. The width of the border expressed in display screen coordinates is called the border width of the View. The color of the border is called the border color. The region of the display box of a View excluding the border is called the inset display box. The color of the inset display box is called the inside color of the View.! Item was removed: - ----- Method: View>>addSubView: (in category 'subView inserting') ----- - addSubView: aView - "Remove aView from the tree of Views it is in (if any) and adds it to the - rear of the list of subViews of the receiver. Set the superView of aView - to be the receiver. It is typically used to build up a hierarchy of Views - (a structured picture). An error notification is generated if aView is the - same as the receiver or its superView, and so on." - - self addSubView: aView ifCyclic: [self error: 'cycle in subView structure.']! Item was removed: - ----- Method: View>>addSubView:above: (in category 'subView inserting') ----- - addSubView: aSubView above: lowerView - "Adds aView (see View|addSubView:) so that it lies above topView." - - self addSubView: aSubView - align: aSubView viewport bottomLeft - with: lowerView viewport topLeft! Item was removed: - ----- Method: View>>addSubView:align:with: (in category 'subView inserting') ----- - addSubView: aSubView align: aPoint1 with: aPoint2 - "Add aView to the receiver's list of subViews (see View|addSubView:) - and translate aView so that aPoint1 coincides with aPoint2. It is typically - used to build up a hierarchy of Views (a structured picture). Normally, - aPoint1 is a point on aView's viewport (e.g. aView viewport topLeft), - and aPoint2 is either an arbitrary point in the receiver's coordinate - system or a point on the receiver's window (e.g., self window topRight)." - - self addSubView: aSubView. - aSubView align: aPoint1 with: aPoint2! Item was removed: - ----- Method: View>>addSubView:below: (in category 'subView inserting') ----- - addSubView: aSubView below: lowerView - "Add the argument, aSubView, (see View|addSubView:) so that it lies - below the view, topView." - - self addSubView: aSubView - align: aSubView viewport topLeft - with: lowerView viewport bottomLeft! Item was removed: - ----- Method: View>>addSubView:ifCyclic: (in category 'subView inserting') ----- - addSubView: aView ifCyclic: exceptionBlock - "Remove aView from the tree of Views it is in (if any) and add it to the - rear of the list of subViews of the receiver. Set the superView of aView - to be the receiver. It is typically used to build up a hierarchy of Views - (a structured picture). An error notification is generated if aView is the - same as the receiver or its superView, and so on." - - (self isCyclic: aView) - ifTrue: [exceptionBlock value] - ifFalse: - [aView removeFromSuperView. - subViews addLast: aView. - aView superView: self]! Item was removed: - ----- Method: View>>addSubView:toLeftOf: (in category 'subView inserting') ----- - addSubView: aSubView toLeftOf: rightView - "Adds aView (see addSubView:) so that it lies to the right of rightView." - - self addSubView: aSubView - align: aSubView viewport topRight - with: rightView viewport topLeft! Item was removed: - ----- Method: View>>addSubView:toRightOf: (in category 'subView inserting') ----- - addSubView: aSubView toRightOf: leftView - "Add the argument, aSubView, (see View|addSubView:) so that it lies to - the right of the view, leftView." - - self addSubView: aSubView - align: aSubView viewport topLeft - with: leftView viewport topRight! Item was removed: - ----- Method: View>>addSubView:viewport: (in category 'subView inserting') ----- - addSubView: aView viewport: aViewport - "Add aView to the receiver's list of subViews (see View|addSubView:) and - applies to aView a scale and translation computed from its window and - aViewport (such that its window fills aViewport)." - - self addSubView: aView. - aView window: aView window viewport: aViewport! Item was removed: - ----- Method: View>>addSubView:window:viewport: (in category 'subView inserting') ----- - addSubView: aView window: aWindow viewport: aViewport - "Add aView to the receiver's list of subViews (see View|addSubView:) - and applies to aView a scale and translation computed from aWindow - and aViewport (such that aWindow fills aViewport)." - - self addSubView: aView. - aView window: aWindow viewport: aViewport! Item was removed: - ----- Method: View>>align:with: (in category 'transforming') ----- - align: aPoint1 with: aPoint2 - "Add a translation of (aPoint2 - aPoint1) to the receiver's local - transformation. The point in the receiver's coordinate system that - previously was transformed to aPoint1 in the superView's coordinate - system will now be transformed to aPoint2 in the superView's coordinate - system. Other points will be translated by the same amount. It is - normally used when adding subViews to their superView in order to - line up the Viewport of one subView with that of another subView (see - View|addSubView:align:with:). aPoint1 and aPoint2 are usually points on - the viewports that are to be aligned. For example, 'subView2 align: - subView2 viewport topLeft with: subView1 viewport topRight' would be - used to place the viewport of subView2 next to the viewport of - subView1 with the topLeft and topRight corners, respectively, - coinciding. It is also possible to align the viewport of a subView with - the window of the superView, e.g., 'subView align: subView viewport - center with: superView window center'. View|align:with: assumes that - the view has been properly scaled, if necessary, to match its superView - (see View|scaleBy:). Typically, the coordinate systems of the receiver - and its superView will differ only by a translation offset so that no - scaling is necessary." - - self setTransformation: (transformation align: aPoint1 with: aPoint2)! Item was removed: - ----- Method: View>>apparentDisplayBox (in category 'display box access') ----- - apparentDisplayBox - ^self insetDisplayBox expandBy: 2 @ 2! Item was removed: - ----- Method: View>>backgroundColor (in category 'bordering') ----- - backgroundColor - Display depth <= 2 ifTrue: [^ Color white]. - insideColor ifNotNil: [^ Color colorFrom: insideColor]. - ^ superView == nil - ifFalse: [superView backgroundColor] - ifTrue: [Color white]! Item was removed: - ----- Method: View>>backgroundColor: (in category 'bordering') ----- - backgroundColor: aColor - Display depth = 1 ifTrue: - [(aColor ~= nil and: [aColor isTransparent not]) ifTrue: - ["Avoid stipple due to attempts to match non-whites" - ^ insideColor := Color white]]. - insideColor := aColor! Item was removed: - ----- Method: View>>balloonText: (in category 'morphic compatibility') ----- - balloonText: aString - "Unfortunately we just ignore this help text because we are not morphic" - ! Item was removed: - ----- Method: View>>borderWidth (in category 'bordering') ----- - borderWidth - "Answer either 0, indicating no border, or a Rectangle whose left value is - the width in display coordinates of the receiver's left border. Right, top, - and bottom widths are analogous. The border width is initially 0. A - View with a border width of 0 will not have any border displayed." - - ^borderWidth! Item was removed: - ----- Method: View>>borderWidth: (in category 'bordering') ----- - borderWidth: anInteger - "Set the four border widths of the receiver to anInteger." - - self - borderWidthLeft: anInteger - right: anInteger - top: anInteger - bottom: anInteger! Item was removed: - ----- Method: View>>borderWidthLeft:right:top:bottom: (in category 'bordering') ----- - borderWidthLeft: anInteger1 right: anInteger2 top: anInteger3 bottom: anInteger4 - "Set the border widths of the receiver. These arguments represent the left, - right, top, and bottom border widths." - - borderWidth := - Rectangle - left: anInteger1 - right: anInteger2 - top: anInteger3 - bottom: anInteger4. - self unlock! Item was removed: - ----- Method: View>>boundingBox (in category 'display box access') ----- - boundingBox - "Answer the bounding box which for the default case is the rectangular - area surrounding the bounding boxes of all the subViews." - - boundingBox ~~ nil - ifTrue: [^boundingBox] - ifFalse: [^self computeBoundingBox]! Item was removed: - ----- Method: View>>canDiscardEdits (in category 'testing') ----- - canDiscardEdits - "Return true if this pane is not dirty." - - ^ true - ! Item was removed: - ----- Method: View>>clear (in category 'clearing') ----- - clear - "Use the border color to paint the display box (including the border, see - View|displayBox) of the receiver." - - borderColor ~= nil ifTrue: [self clear: Color black]! Item was removed: - ----- Method: View>>clear: (in category 'clearing') ----- - clear: aColor - "Use aColor to paint the display box (including the border, see - View|displayBox) of the receiver." - - aColor ~= nil ifTrue: [Display fill: self displayBox fillColor: aColor]! Item was removed: - ----- Method: View>>clearInside (in category 'clearing') ----- - clearInside - "Use the inside color to paint the inset display box (excluding the border, - see View|insetDisplayBox) of the receiver." - - self clearInside: self backgroundColor! Item was removed: - ----- Method: View>>clearInside: (in category 'clearing') ----- - clearInside: aColor - "Use aColor to paint the inset display box (excluding the border, see - View|insetDisplayBox) of the receiver." - - aColor ~~ nil ifTrue: [Display fill: self insetDisplayBox fillColor: aColor]! Item was removed: - ----- Method: View>>clipRect (in category 'miscellaneous') ----- - clipRect - ^ superView clipRect! Item was removed: - ----- Method: View>>clipRect: (in category 'miscellaneous') ----- - clipRect: r - superView clipRect: r! Item was removed: - ----- Method: View>>clippingTo:do: (in category 'displaying') ----- - clippingTo: rect do: aBlock - - superView clippingTo: rect do: aBlock! Item was removed: - ----- Method: View>>computeBoundingBox (in category 'display box access') ----- - computeBoundingBox - "Answer the minimum Rectangle that encloses the bounding boxes of the - receiver's subViews. If the receiver has no subViews, then the bounding - box is the receiver's window. Subclasses should redefine - View|boundingBox if a more suitable default for the case of no subViews - is available." - - | aRectangle | - subViews isEmpty ifTrue: [^self getWindow]. - aRectangle := (self firstSubView transform: self firstSubView boundingBox) copy. - subViews do: - [:aView | - aRectangle swallow: (aView transform: aView boundingBox).]. - ^aRectangle expandBy: borderWidth! Item was removed: - ----- Method: View>>computeDisplayTransformation (in category 'private') ----- - computeDisplayTransformation - "Answer a WindowingTransformation that transforms the coordinate - system of the View into that of the display screen. The transformation is - computed by composing the View's transformation with all transformations - along its superView chain. It is sent by View|displayTransformation when - the View is unlocked (see View|unlock)." - - self isTopView - ifTrue: [^transformation] - ifFalse: [^superView displayTransformation compose: transformation]! Item was removed: - ----- Method: View>>computeInsetDisplayBox (in category 'private') ----- - computeInsetDisplayBox - "Compute the View's inset display box by intersecting the superView's - inset display box with the View's window transformed to display - coordinates and then inseting the result by the border width. It is sent by - View|insetDisplayBox if the inset display box is nil. - - The insetDisplayBox points are truncated to prevent sending floating point numbers to QuickDraw which will die." - - self isTopView - ifTrue: - [^((self displayTransform: self getWindow) insetBy: borderWidth) truncated] - ifFalse: - [^(superView insetDisplayBox - intersect: (self displayTransform: self getWindow)) truncated - insetBy: borderWidth]! Item was removed: - ----- Method: View>>containsPoint: (in category 'testing') ----- - containsPoint: aPoint - "Answer whether aPoint is within the receiver's display box. It is sent to - a View's subViews by View|subViewAt: in order to determine which - subView contains the cursor point (so that, for example, control can be - pass down to that subView's controller)." - - ^ self insetDisplayBox containsPoint: aPoint! Item was removed: - ----- Method: View>>controller (in category 'controller access') ----- - controller - "If the receiver's controller is nil (the default case), answer an initialized - instance of the receiver's default controller. If the receiver does not - allow a controller, answer the symbol #NoControllerAllowed." - - controller == nil ifTrue: [self controller: self defaultController]. - ^controller! Item was removed: - ----- Method: View>>controller: (in category 'controller access') ----- - controller: aController - "Set the receiver's controller to aController. #NoControllerAllowed can be - specified to indicate that the receiver will not have a controller. The - model of aController is set to the receiver's model." - - self model: model controller: aController! Item was removed: - ----- Method: View>>deEmphasize (in category 'deEmphasizing') ----- - deEmphasize - "Modify the emphasis (highlighting, special tabs) of the receiver. This - includes objects such as labels, lines, and boxes. Typically used so that - the receiver is not presented as active. Do this for the receiver and then - for each of the receiver's subViews." - - self deEmphasizeView. - self deEmphasizeSubViews! Item was removed: - ----- Method: View>>deEmphasizeForDebugger (in category 'deEmphasizing') ----- - deEmphasizeForDebugger - "Overridden by StandardSystemView. This default behavior does nothing." - ! Item was removed: - ----- Method: View>>deEmphasizeSubViews (in category 'deEmphasizing') ----- - deEmphasizeSubViews - "Send the deEmphasize message to each of the receiver's subviews." - - subViews do: [:aSubView | aSubView deEmphasize]! Item was removed: - ----- Method: View>>deEmphasizeView (in category 'deEmphasizing') ----- - deEmphasizeView - "Subclasses should redefine View|deEmphasizeView in order to modify - the emphasis (highlighting, special tabs) of particular objects associated - with the View such as labels, lines, and boxes." - - ^self! Item was removed: - ----- Method: View>>defaultBackgroundColor (in category 'initialize-release') ----- - defaultBackgroundColor - - ^ self userInterfaceTheme color! Item was removed: - ----- Method: View>>defaultController (in category 'controller access') ----- - defaultController - "Answer an initialized instance of the receiver's default controller. - Subclasses should redefine this message only if the default controller - instances need to be initialized in a nonstandard way." - - ^self defaultControllerClass new! Item was removed: - ----- Method: View>>defaultControllerClass (in category 'controller access') ----- - defaultControllerClass - "Answer the class of the default controller for the receiver. Subclasses - should redefine View|defaultControllerClass if the class of the default - controller is not Controller." - - ^Controller! Item was removed: - ----- Method: View>>defaultForegroundColor (in category 'initialize-release') ----- - defaultForegroundColor - - ^ self userInterfaceTheme borderColor! Item was removed: - ----- Method: View>>defaultWindow (in category 'window access') ----- - defaultWindow - "Build the minimum Rectangle that encloses all the windows of the - receiver's subViews. The answer is a Rectangle obtained by expanding - this minimal Rectangle by the borderWidth of the receiver. If the - receiver has no subViews, then a Rectangle enclosing the entire display - screen is answered. It is used internally by View methods if no window - has been specified for the View. Specialized subclasses of View should - redefine View|defaultWindow to handle the default case for instances - that have no subViews." - - | aRectangle | - subViews isEmpty ifTrue: [^DisplayScreen boundingBox]. - aRectangle := self firstSubView viewport copy. - subViews do: [:aView | aRectangle swallow: aView viewport]. - ^aRectangle expandBy: borderWidth! Item was removed: - ----- Method: View>>display (in category 'displaying') ----- - display - "Display the receiver's border, display the receiver, then display the - subViews of the receiver. Can be sent to the top View of a structured - picture in order to display the entire structure, or to any particular View - in the structure in order to display that View and its subViews. It is - typically sent in response to an update request to a View." - - Display deferUpdatesIn: self displayBox while: [ - self displayBorder. - self displayView. - self displaySubViews]! Item was removed: - ----- Method: View>>displayBorder (in category 'displaying') ----- - displayBorder - "Display the receiver's border (using the receiver's borderColor)." - - borderWidth = 0 - ifTrue: - [insideColor == nil - ifFalse: - [Display fill: self displayBox fillColor: self backgroundColor]] - ifFalse: - [Display - border: self displayBox - widthRectangle: borderWidth - rule: Form over - fillColor: self foregroundColor. - insideColor == nil ifFalse: - [Display fill: self insetDisplayBox fillColor: self backgroundColor]]! Item was removed: - ----- Method: View>>displayBox (in category 'display box access') ----- - displayBox - "Answer the receiver's inset display box (see View|insetDisplayBox) - expanded by the borderWidth. The display box represents the region of - the display screen in which the receiver (including the border) is - displayed. If the receiver is totally clipped by the display screen and its - superView, the resulting Rectangle will be invalid." - - ^self insetDisplayBox expandBy: borderWidth! Item was removed: - ----- Method: View>>displayClippingTo: (in category 'displaying') ----- - displayClippingTo: rect - - | bigRect | - bigRect := rect insetBy: -1. - self clippingTo: bigRect do: [Display clippingTo: bigRect do: [self display]] - ! Item was removed: - ----- Method: View>>displayDeEmphasized (in category 'displaying') ----- - displayDeEmphasized - self display; deEmphasize! Item was removed: - ----- Method: View>>displaySubViews (in category 'displaying') ----- - displaySubViews - "Display all the subViews of the receiver." - - subViews do: [:aSubView | aSubView display]! Item was removed: - ----- Method: View>>displayTransform: (in category 'display transformation') ----- - displayTransform: anObject - "Apply the display transformation of the receiver to anObject (see - View|displayTransformation) and answer the resulting scaled, translated - object. It is normally applied to Rectangles, Points, and other objects with - coordinates defined in the View's local coordinate system in order to get - a corresponding object in display coordinates." - - ^(self displayTransformation applyTo: anObject) rounded! Item was removed: - ----- Method: View>>displayTransformation (in category 'display transformation') ----- - displayTransformation - "Answer a WindowingTransformation that is the result of composing all - local transformations in the receiver's superView chain with the - receiver's own local transformation. The resulting transformation - transforms objects in the receiver's coordinate system into objects in the - display screen coordinate system." - - displayTransformation == nil - ifTrue: [displayTransformation := self computeDisplayTransformation]. - ^displayTransformation! Item was removed: - ----- Method: View>>displayView (in category 'displaying') ----- - displayView - "Subclasses should redefine View|displayView in order to display - particular objects associated with the View such as labels, lines, and - boxes." - - ^self! Item was removed: - ----- Method: View>>displayViewDeEmphasized (in category 'displaying') ----- - displayViewDeEmphasized - self displayView; deEmphasizeView! Item was removed: - ----- Method: View>>emphasize (in category 'deEmphasizing') ----- - emphasize - "Modify the emphasis (highlighting, special tabs) of the receiver. This - includes objects such as labels, lines, and boxes. Typically used so that - the receiver is presented as active. Do this for the receiver and then - for each of the receiver's subViews." - - self emphasizeView. - self emphasizeSubViews! Item was removed: - ----- Method: View>>emphasizeSubViews (in category 'deEmphasizing') ----- - emphasizeSubViews - "Send the emphasize message to each of the receiver's subviews." - - subViews do: [:aSubView | aSubView emphasize]! Item was removed: - ----- Method: View>>emphasizeView (in category 'deEmphasizing') ----- - emphasizeView - "Subclasses should redefine View|emphasizeView in order to modify - the emphasis (highlighting, special tabs) of particular objects associated - with the View such as labels, lines, and boxes." - - ^self! Item was removed: - ----- Method: View>>firstSubView (in category 'subView access') ----- - firstSubView - "Answer the first subView in the receiver's list of subViews if it is not - empty, else nil." - - subViews isEmpty - ifTrue: [^nil] - ifFalse: [^subViews first]! Item was removed: - ----- Method: View>>flash (in category 'indicating') ----- - flash - "Cause the inset display box (the display box excluding the border, see - View|insetDisplayBox) of the receiver to complement twice in succession." - - Display flash: self insetDisplayBox! Item was removed: - ----- Method: View>>foregroundColor (in category 'bordering') ----- - foregroundColor - borderColor ifNotNil: [^ Color colorFrom: borderColor]. - ^ superView == nil - ifFalse: [superView foregroundColor] - ifTrue: [Color black]! Item was removed: - ----- Method: View>>foregroundColor: (in category 'bordering') ----- - foregroundColor: aColor - borderColor := aColor! Item was removed: - ----- Method: View>>getController (in category 'private') ----- - getController - "Answer the View's controller if one exists. nil indicates that the default - controller is to be used." - - ^controller! Item was removed: - ----- Method: View>>getViewport (in category 'private') ----- - getViewport - "Answer the Rectangle representing the View's viewport (in the - coordinate system of the superclass). If no viewport has been specified, - the View's window transformed into the superView's coordinate system is - saved and returned. It should be used by methods of View and subclasses - (instead of directly referring to the viewport) unless it is known that a - viewport actually exists. It should not be used outside of View or - subclasses because the viewport is not sharable." - - viewport == nil ifTrue: [viewport := (self transform: self getWindow) truncated]. - ^viewport! Item was removed: - ----- Method: View>>getWindow (in category 'private') ----- - getWindow - "Answer the Rectangle that represents the window of this View. If no - window has been specified, a default window (see View|defaultWindow) - is created, saved, and returned. Should be used by methods of View and - subclasses to access the View window instead of directly accessing the - field unless it is known that a window actually exists. It is not to be used - outside of View (or subclasses) because the window is not sharable. - View|window should be used for outside access to the window." - - window == nil ifTrue: [self setWindow: self defaultWindow]. - ^window! Item was removed: - ----- Method: View>>gridSpacing (in category 'miscellaneous') ----- - gridSpacing - ^ superView gridSpacing! Item was removed: - ----- Method: View>>hasUnacceptedEdits (in category 'testing') ----- - hasUnacceptedEdits - "Return true if this view has unaccepted edits." - - ^ false - ! Item was removed: - ----- Method: View>>highlight (in category 'indicating') ----- - highlight - "Cause the inset display box (the display box excluding the border, see - View|insetDisplayBox) of the receiver to complement." - - Display reverse: self insetDisplayBox! Item was removed: - ----- Method: View>>initialize (in category 'initialize-release') ----- - initialize - "Initialize the state of the receiver. Subclasses should include 'super - initialize' when redefining this message to insure proper initialization." - - self resetSubViews. - transformation := WindowingTransformation identity. - self borderWidth: 0! Item was removed: - ----- Method: View>>insetDisplayBox (in category 'display box access') ----- - insetDisplayBox - "Answer the receiver's inset display box. The inset display box is the - intersection of the receiver's window, tranformed to display coordinates, - and the inset display box of the superView, inset by the border width. - The inset display box represents the region of the display screen in - which the inside of the receiver (all except the border) is displayed. If - the receiver is totally clipped by the display screen and its superView, - the resulting Rectangle will be invalid." - - insetDisplayBox ifNil: [insetDisplayBox := self computeInsetDisplayBox]. - ^insetDisplayBox! Item was removed: - ----- Method: View>>insetWindow (in category 'window access') ----- - insetWindow - "Answer a Rectangle that is obtained by insetting the receiver's window - rectangle by the border width." - - ^self getWindow insetBy: borderWidth! Item was removed: - ----- Method: View>>insideColor: (in category 'bordering') ----- - insideColor: aColor - ^ self backgroundColor: aColor! Item was removed: - ----- Method: View>>inspectFirstSubView (in category 'displaying') ----- - inspectFirstSubView - subViews notNil ifTrue: - [subViews size > 0 ifTrue: - [(subViews at: 1) inspect]]! Item was removed: - ----- Method: View>>inspectModel (in category 'displaying') ----- - inspectModel - model notNil - ifTrue: [^ model inspect] - ifFalse: [self flash]! Item was removed: - ----- Method: View>>inspectView (in category 'displaying') ----- - inspectView - ^self inspect! Item was removed: - ----- Method: View>>inverseDisplayTransform: (in category 'display transformation') ----- - inverseDisplayTransform: aPoint - "Answer a Point that is obtained from the argument, aPoint, by applying - to it the inverse of the receiver's display transformation. It is typically - used by the Controller of the receiver in order to convert a point in - display coordinates, such as the cursor point, to the local coordinate - system of the receiver." - - ^self displayTransformation applyInverseTo: aPoint! Item was removed: - ----- Method: View>>isCyclic: (in category 'private') ----- - isCyclic: aView - "Answer true if aView is the same as this View or its superView, false - otherwise." - - self == aView ifTrue: [^true]. - self isTopView ifTrue: [^false]. - ^superView isCyclic: aView! Item was removed: - ----- Method: View>>isLocked (in category 'lock access') ----- - isLocked - "Answer whether the receiver is locked. A View is 'locked' if its display - transformation and inset display box are defined. If these are undefined, - the View is 'unlocked'. The display transformation and inset display box - become undefined when the transformation of the View (or the - transformation of a View in its superView chain) is changed, or when - the superView of the View is changed, or any other change to the View - that affects the display screen coordinates of the View. The locking and - unlocking of a View is handled automatically by the internal methods of - the View, but can also be done explicitly if desired (see View|lock, and - View|unlock)." - - displayTransformation == nil | (insetDisplayBox == nil) - ifTrue: [^false] - ifFalse: [^true]! Item was removed: - ----- Method: View>>isObscured (in category 'testing') ----- - isObscured - - | topController displayRect | - (topController := self topView controller) - == ScheduledControllers activeController - ifTrue: [^false]. - displayRect := self insetDisplayBox. - ScheduledControllers scheduledControllers do: [:ctrlr | - ctrlr == topController ifTrue: [^false]. - (displayRect intersects: ctrlr view insetDisplayBox) - ifTrue: [^true]]. - self error: 'not in ScheduledControllers'. - ^false! Item was removed: - ----- Method: View>>isTopView (in category 'superView access') ----- - isTopView - "Answer whether the receiver is a top view, that is, if it has no - superView." - - ^superView == nil! Item was removed: - ----- Method: View>>isUnlocked (in category 'lock access') ----- - isUnlocked - "Answer whether the receiver is unlocked. See comment in - View|isLocked." - - ^displayTransformation == nil & (insetDisplayBox == nil)! Item was removed: - ----- Method: View>>lastSubView (in category 'subView access') ----- - lastSubView - "Answer the last subView in the receiver's list of subViews if it is not - empty, else nil." - - subViews isEmpty - ifTrue: [^nil] - ifFalse: [^subViews last]! Item was removed: - ----- Method: View>>lock (in category 'lock access') ----- - lock - "'Lock' the receiver and all of its subViews (see View|isLocked). This has - the effect of computing and storing the display transformation (see - View|displayTransformation) and inset display box (see - View|insetDisplayBox) of the receiver and all its subViews. The locking - and unlocking of a View is handled automatically by the internal - methods of the View, but can also be done explicitly if desired." - - self isLocked ifTrue: [^self]. - displayTransformation := self computeDisplayTransformation. - insetDisplayBox := self computeInsetDisplayBox. - subViews do: [:aSubView | aSubView lock]! Item was removed: - ----- Method: View>>maximumSize (in category 'displaying') ----- - maximumSize - "Answer the maximum size of the receiver." - - ^ 10000 @ 10000 - ! Item was removed: - ----- Method: View>>minimumSize (in category 'displaying') ----- - minimumSize - "Answer the minimum size of the receiver." - ^ 10 @ 10 - ! Item was removed: - ----- Method: View>>model (in category 'model access') ----- - model - "Answer the receiver's model." - - ^model! Item was removed: - ----- Method: View>>model: (in category 'model access') ----- - model: aModel - "Set the receiver's model to aModel. The model of the receiver's controller - is also set to aModel." - - self model: aModel controller: controller! Item was removed: - ----- Method: View>>model:controller: (in category 'controller access') ----- - model: aModel controller: aController - "Set the receiver's model to aModel, add the receiver to aModel's list of - dependents, and set the receiver's controller to aController. Subsequent - changes to aModel (see Model|change) will result in View|update: - messages being sent to the receiver. #NoControllerAllowed for the value - of aController indicates that no default controller is available; nil for the - value of aController indicates that the default controller is to be used - when needed. If aController is neither #NoControllerAllowed nor nil, its - view is set to the receiver and its model is set to aModel." - - model ~~ nil & (model ~~ aModel) - ifTrue: [model removeDependent: self]. - aModel ~~ nil & (aModel ~~ model) - ifTrue: [aModel addDependent: self]. - model := aModel. - aController ~~ nil - ifTrue: - [aController view: self. - aController model: aModel]. - controller := aController. - - self setDefaultForegroundColor. - self setDefaultBackgroundColor.! Item was removed: - ----- Method: View>>nestedViewport (in category 'miscellaneous') ----- - nestedViewport - - "The viewport size used to control scaling of nested user views." - - ^ (0 at 0 extent: self viewport extent) - insetBy: 16 @ 16! Item was removed: - ----- Method: View>>printViewSpecOn:nested: (in category 'miscellaneous') ----- - printViewSpecOn: strm nested: level - "Print window and viewport specs - of this and all nested views." - strm crtab: level; nextPutAll: self class name. - strm crtab: level; nextPutAll: 'window: '; print: self window. - strm crtab: level; nextPutAll: 'viewport: '; print: self viewport. - strm crtab: level; nextPutAll: 'displayBox: '; print: self displayBox. - strm crtab: level; nextPutAll: 'border: '; print: self borderWidth. - subViews do: [:v | v printViewSpecOn: strm nested: level+1]! Item was removed: - ----- Method: View>>release (in category 'initialize-release') ----- - release - "Remove the receiver from its model's list of dependents (if the model - exists), and release all of its subViews. It is used to break possible cycles - in the receiver and should be sent when the receiver is no longer needed. - Subclasses should include 'super release.' when redefining release." - - model removeDependent: self. - model := nil. - controller release. - controller := nil. - subViews ~~ nil ifTrue: [subViews do: [:aView | aView release]]. - subViews := nil. - superView := nil! Item was removed: - ----- Method: View>>releaseSubView: (in category 'subView removing') ----- - releaseSubView: aView - "Delete aView from the receiver's list of subViews and send it the - message 'release' (so that it can break up cycles with subViews, etc.)." - - self removeSubView: aView. - aView release! Item was removed: - ----- Method: View>>releaseSubViews (in category 'subView removing') ----- - releaseSubViews - "Release (see View|releaseSubView:) all subViews in the receiver's list of - subViews." - - subViews do: [:aView | aView release]. - self resetSubViews! Item was removed: - ----- Method: View>>removeFromSuperView (in category 'subView removing') ----- - removeFromSuperView - "Delete the receiver from its superView's collection of subViews." - - superView ~= nil ifTrue: [superView removeSubView: self]! Item was removed: - ----- Method: View>>removeSubView: (in category 'subView removing') ----- - removeSubView: aView - "Delete aView from the receiver's list of subViews. If the list of subViews - does not contain aView, create an error notification." - - subViews remove: aView. - aView superView: nil. - aView unlock! Item was removed: - ----- Method: View>>removeSubViews (in category 'subView removing') ----- - removeSubViews - "Delete all the receiver's subViews." - - subViews do: - [:aView | - aView superView: nil. - aView unlock]. - self resetSubViews! Item was removed: - ----- Method: View>>resetSubViews (in category 'subView access') ----- - resetSubViews - "Set the list of subviews to an empty collection." - - subViews := OrderedCollection new! Item was removed: - ----- Method: View>>scale:translation: (in category 'transforming') ----- - scale: aScale translation: aTranslation - "The x component of aScale (a Point) specifies the scale (translation) in - the x direction; the y component specifies the scale (translation) in the y - direction. aScale can optionally be an instance of Integer or Float in - order to specify uniform scaling in both directions. Create a new local - transformation for the receiver with a scale factor of aScale and a - translation offset of aTranslation. When the transformation is applied (see - View|transform:), the scale is applied first, followed by the translation. It - is typically used when building a superView from its subViews in order - to line up the viewports of the subViews in the desired way. If no - scaling is required between subView and superView, then - View|align:with: is often more convenient to use." - - self setTransformation: - (WindowingTransformation scale: aScale translation: aTranslation)! Item was removed: - ----- Method: View>>scaleBy: (in category 'transforming') ----- - scaleBy: aScale - "The x component of aScale (a Point) specifies the scale in the x - direction; the y component specifies the scale in the y direction. aScale - can, optionally, be an instance of Integer or Float in order to specify - uniform scaling in both directions. Scales the View by aScale. The scale - is concatenated with the current transformation of the receiver and is - applied when View|transform is sent. This happens automatically in the - process of displaying the receiver, for example." - - self setTransformation: (transformation scaleBy: aScale)! Item was removed: - ----- Method: View>>scrollBy: (in category 'scrolling') ----- - scrollBy: aPoint - "The x component of aPoint specifies the amount of scrolling in the x - direction; the y component specifies the amount of scrolling in the y - direction. The amounts are specified in the receiver's local coordinate - system. Scroll the receiver up or down, left or right. The window of the - receiver is kept stationary and the subViews and other objects in the - receiver are translated relative to it. Scrolling doesn't change the - insetDisplayBox or the viewport since the change in the transformation - is canceled by the change in the window. In other words, all display - objects in the view, except the window, are translated by the scrolling - operation. - Note: subclasses may override to return false if no scrolling takes place." - - | aRectangle | - aRectangle := insetDisplayBox. - transformation := transformation scrollBy: aPoint. - window := self getWindow translateBy: aPoint x negated @ aPoint y negated. - self unlock. - insetDisplayBox := aRectangle. - ^ true! Item was removed: - ----- Method: View>>setBalloonText: (in category 'morphic compatibility') ----- - setBalloonText: aString - - self flag: #deprecated. "mt: Use #balloonText: or just remove."! Item was removed: - ----- Method: View>>setDefaultBackgroundColor (in category 'initialize-release') ----- - setDefaultBackgroundColor - "Obtain the background color from the receiver's model. - The preferences make sure whether this is a colorful or uniform - look." - - self backgroundColor: self defaultBackgroundColor! Item was removed: - ----- Method: View>>setDefaultForegroundColor (in category 'initialize-release') ----- - setDefaultForegroundColor - - self foregroundColor: self defaultForegroundColor! Item was removed: - ----- Method: View>>setTransformation: (in category 'private') ----- - setTransformation: aTransformation - "Set the View's local transformation to aTransformation, unlock the View - (see View|unlock), and set the viewport to undefined (this forces it to be - recomputed when needed). Should be used instead of setting the - transformation directly." - - transformation := aTransformation. - self unlock. - viewport := nil! Item was removed: - ----- Method: View>>setWindow: (in category 'private') ----- - setWindow: aWindow - "Set the View's window to aWindow and unlock the View (see - View|unlock). View|setWindow should be used by methods of View and - subclasses to set the View window (rather than directly setting the - instance variable) to insure that the View is unlocked." - - window := aWindow. - viewport := nil. - self unlock! Item was removed: - ----- Method: View>>stretchFrame:startingWith: (in category 'miscellaneous') ----- - stretchFrame: newFrameBlock startingWith: startFrame - "Track the outline of a newFrame as long as mouse drags it. - Maintain max and min constraints throughout the drag" - | frame newFrame click delay | - delay := Delay forMilliseconds: 10. - frame := startFrame origin extent: ((startFrame extent min: self maximumSize) - max: self minimumSize). - Display border: frame width: 2 rule: Form reverse fillColor: Color gray. - click := false. - [click and: [Sensor noButtonPressed]] whileFalse: - [delay wait. - click := click | Sensor anyButtonPressed. - newFrame := newFrameBlock value: frame. - newFrame := newFrame topLeft extent: ((newFrame extent min: self maximumSize) - max: self minimumSize). - newFrame = frame ifFalse: - [Display border: frame width: 2 rule: Form reverse fillColor: Color gray. - Display border: newFrame width: 2 rule: Form reverse fillColor: Color gray. - frame := newFrame]]. - Display border: frame width: 2 rule: Form reverse fillColor: Color gray. - ^ frame! Item was removed: - ----- Method: View>>subViewContaining: (in category 'subView access') ----- - subViewContaining: aPoint - "Answer the first subView that contains aPoint within its window and - answer nil, otherwise. It is typically sent from a Controller in order to - determine where to pass control (usually to the Controller of the View - returned by View|subViewContaining:)." - - subViews reverseDo: - [:aSubView | - (aSubView displayBox containsPoint: aPoint) ifTrue: [^aSubView]]. - ^nil! Item was removed: - ----- Method: View>>subViewSatisfying: (in category 'subView access') ----- - subViewSatisfying: aBlock - "Return the first subview that satisfies aBlock, or nil if none does. 1/31/96 sw" - - ^subViews detect: aBlock ifNone: [ nil ]! Item was removed: - ----- Method: View>>subViewWantingControl (in category 'basic control sequence') ----- - subViewWantingControl - "Answer the first subView that has a controller that now wants control." - - subViews reverseDo: - [:aSubView | aSubView controller isControlWanted ifTrue: [^aSubView]]. - ^nil! Item was removed: - ----- Method: View>>subViews (in category 'subView access') ----- - subViews - "Answer the receiver's collection of subViews." - - ^subViews! Item was removed: - ----- Method: View>>superView (in category 'superView access') ----- - superView - "Answer the superView of the receiver." - - ^superView! Item was removed: - ----- Method: View>>superView: (in category 'private') ----- - superView: aView - "Set the View's superView to aView and unlock the View (see - View|unlock). It is sent by View|addSubView: in order to properly set all - the links." - - superView := aView. - self unlock! Item was removed: - ----- Method: View>>textEditorView (in category 'subView access') ----- - textEditorView - "Return the first view in the receiver whose controller is a ParagraphEdior, or nil if none. 1/31/96 sw" - - (controller isKindOf: ParagraphEditor) ifTrue: [^ self]. - ^ self subViewSatisfying: - [:v | v textEditorView ~~ nil]! Item was removed: - ----- Method: View>>topView (in category 'superView access') ----- - topView - "Answer the root of the tree of Views in which the receiver is a node. - The root of the tree is found by going up the superView path until - reaching a View whose superView is nil." - - superView == nil - ifTrue: [^self] - ifFalse: [^superView topView]! Item was removed: - ----- Method: View>>transform: (in category 'transforming') ----- - transform: anObject - "Apply the local transformation of the receiver to anObject and answer - the resulting transformation. It is used to get the superView coordinates - of an object. For example, the viewport is equal to the window - transformed." - - ^transformation applyTo: anObject! Item was removed: - ----- Method: View>>transformation (in category 'transforming') ----- - transformation - "Answer a copy of the receiver's local transformation." - - ^transformation copy! Item was removed: - ----- Method: View>>transformation: (in category 'transforming') ----- - transformation: aTransformation - "Set the receiver's local transformation to a copy of aTransformation, - unlock the receiver (see View|unlock) and set the viewport to undefined - (this forces it to be recomputed when needed)." - - self setTransformation: aTransformation copy! Item was removed: - ----- Method: View>>translateBy: (in category 'transforming') ----- - translateBy: aPoint - "Translate the receiver by aPoint. The translation is concatenated with - the current transformation of the receiver and is applied when - View|transform is sent. This happens automatically in the process of - displaying the receiver." - - self setTransformation: (transformation translateBy: aPoint)! Item was removed: - ----- Method: View>>unlock (in category 'lock access') ----- - unlock - "Unlock the receiver and all of its subViews (see View|isUnlocked). This - has the effect of forcing the display transformation (see - View|displayTransformation) and inset display box (see - View|insetDisplayBox) of the receiver and all its subViews to be - recomputed the next time they are referenced. The locking and - unlocking of a View is handled automatically by the internal methods of - the View, but can also be done explicitly if desired." - - self isUnlocked ifTrue: [^self]. - displayTransformation := nil. - insetDisplayBox := nil. - subViews do: [:aSubView | aSubView unlock]! Item was removed: - ----- Method: View>>update (in category 'updating') ----- - update - "Normally sent by the receiver's model in order to notify the receiver of - a change in the model's state. Subclasses implement this message to do - particular update actions. A typical action that might be required is to - redisplay the receiver." - - self update: self! Item was removed: - ----- Method: View>>update: (in category 'updating') ----- - update: aParameter - "Normally sent by the receiver's model in order to notify the receiver of - a change in the model's state. Subclasses implement this message to do - particular update actions. A typical action that might be required is to - redisplay the receiver." - - ^self! Item was removed: - ----- Method: View>>viewport (in category 'viewport access') ----- - viewport - "Answer a copy of the receiver's viewport." - - ^self getViewport copy! Item was removed: - ----- Method: View>>window (in category 'window access') ----- - window - "Answer a copy of the receiver's window." - - ^self getWindow copy! Item was removed: - ----- Method: View>>window: (in category 'window access') ----- - window: aWindow - "Set the receiver's window to a copy of aWindow." - - self setWindow: aWindow copy! Item was removed: - ----- Method: View>>window:viewport: (in category 'transforming') ----- - window: aWindow viewport: aViewport - "Set the receiver's window to aWindow, set its viewport to aViewport, and - create a new local transformation for the receiver based on aWindow and - aViewport. The receiver is scaled and translated so that aWindow, when - transformed, coincides with aViewport. It is used to position a subView's - window within some specific region of its superView's area. For example, - 'subView window: aRectangle1 viewport: aRectangle2' sets subView's - window to aRectangle1, its viewport to aRectangle2, and its local - transformation to one that transforms aRectangle1 to aRectange2." - - self window: aWindow. - self setTransformation: - (WindowingTransformation window: aWindow viewport: aViewport). - self getViewport! Item was removed: - Object subclass: #WindowingTransformation - instanceVariableNames: 'scale translation' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Framework'! - - !WindowingTransformation commentStamp: '<historical>' prior: 0! - My instances are used to transform objects from a source coordinate system to a destination coordinate system. Each instance contains a scale and a translation which can be applied to objects that respond to scaleBy: and translateBy:. It can be created with a default identity scale and translation, or with a specified scale and translation, or with a scale and translation computed from a window (a Rectangle in the source coordinate system) and a viewport (a Rectangle in the destination coordinate system). In applying a WindowingTransformation to an object, the object is first scaled (around the origin of the source coordinate system) and then translated. WindowingTransformations can be composed to form a single compound transformation.! Item was removed: - ----- Method: WindowingTransformation class>>identity (in category 'instance creation') ----- - identity - "Answer an instance of me with no scaling (nil) and no translation - (0 at 0)." - - ^self new setScale: nil translation: 0 @ 0! Item was removed: - ----- Method: WindowingTransformation class>>scale:translation: (in category 'instance creation') ----- - scale: aScale translation: aTranslation - "Answer an instance of me with a scale factor of aScale and a translation - offset of aTranslation. When the transformation is applied (see - WindowingTransformation|apply:), the scale is applied first, followed by - the translation." - - ^self new setScale: aScale translation: aTranslation! Item was removed: - ----- Method: WindowingTransformation class>>window:viewport: (in category 'instance creation') ----- - window: aWindow viewport: aViewport - "Answer an instance of me with a scale and translation based on - aWindow and aViewport. The scale and translation are computed such - that aWindow, when transformed, coincides with aViewport." - - | scale translation | - aViewport width = aWindow width & (aViewport height = aWindow height) - ifTrue: - [scale := nil] - ifFalse: - [scale := aViewport width asFloat / aWindow width asFloat - @ (aViewport height asFloat / aWindow height asFloat)]. - scale == nil - ifTrue: [translation := aViewport left - aWindow left - @ (aViewport top - aWindow top)] - ifFalse: [translation := aViewport left - (scale x * aWindow left) - @ (aViewport top - (scale y * aWindow top))]. - ^self new setScale: scale translation: translation! Item was removed: - ----- Method: WindowingTransformation>>align:with: (in category 'transforming') ----- - align: point1 with: point2 - "Answer a WindowingTransformation with the same scale as the receiver - and with a translation of (aPoint2 - aPoint1). It is normally used when - the source and destination coordinate systems are scaled the same (that - is, there is no scaling between them), and is then a convenient way of - specifying a translation, given two points that are intended to coincide." - - ^self translateBy: point2 - point1! Item was removed: - ----- Method: WindowingTransformation>>applyInverseTo: (in category 'applying transform') ----- - applyInverseTo: anObject - "Apply the inverse of the receiver to anObject and answer the result. - Used to map some object in destination coordinates to one in source - coordinates." - - | transformedObject | - transformedObject := anObject translateBy: translation x negated @ translation y negated. - scale == nil - ifFalse: [transformedObject := transformedObject scaleBy: 1.0 / scale x @ (1.0 / scale y)]. - ^transformedObject! Item was removed: - ----- Method: WindowingTransformation>>applyTo: (in category 'applying transform') ----- - applyTo: anObject - "Apply the receiver to anObject and answer the result. Used to map some - object in source coordinates to one in destination coordinates." - - | transformedObject | - scale == nil - ifTrue: [transformedObject := anObject] - ifFalse: [transformedObject := anObject scaleBy: scale]. - transformedObject := transformedObject translateBy: translation. - ^transformedObject! Item was removed: - ----- Method: WindowingTransformation>>checkScale: (in category 'private') ----- - checkScale: aScale - "Convert aScale to the internal format of a floating-point Point." - - | checkedScale | - checkedScale := aScale asPoint. - ^checkedScale x asFloat @ checkedScale y asFloat! Item was removed: - ----- Method: WindowingTransformation>>compose: (in category 'applying transform') ----- - compose: aTransformation - "Answer a WindowingTransformation that is the composition of the - receiver and aTransformation. The effect of applying the resulting - WindowingTransformation to an object is the same as that of first - applying aTransformation to the object and then applying the receiver to - its result." - - | aTransformationScale newScale newTranslation | - aTransformationScale := aTransformation scale. - scale == nil - ifTrue: - [aTransformation noScale - ifTrue: [newScale := nil] - ifFalse: [newScale := aTransformationScale]. - newTranslation := translation + aTransformation translation] - ifFalse: - [aTransformation noScale - ifTrue: [newScale := scale] - ifFalse: [newScale := scale * aTransformationScale]. - newTranslation := translation + (scale * aTransformation translation)]. - ^WindowingTransformation scale: newScale translation: newTranslation! Item was removed: - ----- Method: WindowingTransformation>>noScale (in category 'transforming') ----- - noScale - "Answer true if the identity scale is in effect; answer false, otherwise." - - ^scale == nil! Item was removed: - ----- Method: WindowingTransformation>>printOn: (in category 'printing') ----- - printOn: aStream - "Refer to the comment in Object|printOn:." - - aStream nextPutAll: self class name, ' scale: '; - print: scale; nextPutAll: ' translation: '; - print: translation! Item was removed: - ----- Method: WindowingTransformation>>scale (in category 'transforming') ----- - scale - "Answer a copy of the point that represents the current scale of the - receiver." - - scale == nil - ifTrue: [^1.0 @ 1.0] - ifFalse: [^scale copy]! Item was removed: - ----- Method: WindowingTransformation>>scaleBy: (in category 'transforming') ----- - scaleBy: aScale - "Answer a WindowingTransformation with the scale and translation of - the receiver both scaled by aScale." - - | checkedScale newScale newTranslation | - aScale == nil - ifTrue: - [newScale := scale. - newTranslation := translation] - ifFalse: - [checkedScale := self checkScale: aScale. - scale == nil - ifTrue: [newScale := checkedScale] - ifFalse: [newScale := scale * checkedScale]. - newTranslation := checkedScale * translation]. - ^WindowingTransformation scale: newScale translation: newTranslation! Item was removed: - ----- Method: WindowingTransformation>>scrollBy: (in category 'scrolling') ----- - scrollBy: aPoint - "Answer a WindowingTransformation with the same scale as the receiver - and with a translation of the current translation plus aPoint scaled by - the current scale. It is used when the translation is known in source - coordinates, rather than scaled source coordinates (see - WindowingTransformation|translateBy:). An example is that of scrolling - objects with respect to a stationary window in the source coordinate - system. If no scaling is in effect (scale = nil), then - WindowingTransformation|translateBy: and - WindowingTransformation|scrollBy: are equivalent." - - | newTranslation | - scale == nil - ifTrue: [newTranslation := aPoint] - ifFalse: [newTranslation := scale * aPoint]. - ^self translateBy: newTranslation! Item was removed: - ----- Method: WindowingTransformation>>setScale:translation: (in category 'private') ----- - setScale: aScale translation: aTranslation - "Sets the scale to aScale and the translation to aTranslation." - - scale := aScale. - translation := aTranslation! Item was removed: - ----- Method: WindowingTransformation>>translateBy: (in category 'transforming') ----- - translateBy: aPoint - "Answer a WindowingTransformation with the same scale as the receiver - and with a translation of the current translation plus aPoint. It is used - when the translation is known in scaled source coordinates, rather than - source coordinates (see WindowingTransformation|scrollBy:). If no scaling - is in effect (scale = nil), then WindowingTransformation|translateBy: and - WindowingTransformation|scrollBy: are equivalent." - - ^WindowingTransformation scale: scale translation: translation + aPoint! Item was removed: - ----- Method: WindowingTransformation>>translation (in category 'transforming') ----- - translation - "Answer a copy of the receiver's translation." - - ^translation copy! Item was removed: - (PackageInfo named: 'ST80') postscript: 'Smalltalk removeFromStartUpList: ControlManager. - Smalltalk removeFromShutDownList: ControlManager.'!
More information about the Squeak-dev mailing list |