[Pkg] The Trunk: ST80-pre.236.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Dec 13 13:04:41 UTC 2018
Patrick Rein uploaded a new version of ST80 to project The Trunk:
http://source.squeak.org/trunk/ST80-pre.236.mcz
==================== Summary ====================
Name: ST80-pre.236
Author: pre
Time: 13 December 2018, 2:04:37.757468 pm
UUID: b4f1dbb4-b2bf-4a03-9929-60c0521e5ef1
Ancestors: ST80-mt.217, ST80-dtl.235
Categorized uncategorized messages in ST80 and moved test methods to tests.
=============== Diff against ST80-mt.217 ===============
Item was changed:
----- Method: BitEditor>>fileOut (in category 'menu messages') -----
fileOut
| fileName |
fileName := UIManager default
+ saveFilenameRequest: 'Save this Form to' translated
- request: 'File name?' translated
initialAnswer: 'Filename.form'.
+ fileName ifNil: [^ self].
- fileName isEmpty ifTrue: [^ self].
Cursor normal
showWhile: [model writeOnFileNamed: fileName].
!
Item was changed:
----- 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: [
- characterIndex > text size ifTrue: [Transcript cr; show:'here'.
lastIndex := characterIndex.
characterPoint := (nextLeftMargin ifNil: [leftMargin]) @ (destY + line lineHeight).
^true]].
^super crossedX!
Item was changed:
+ ----- Method: ColorSystemView>>displayDeEmphasized (in category 'displaying') -----
- ----- Method: ColorSystemView>>displayDeEmphasized (in category 'as yet unclassified') -----
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 changed:
----- 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 controllers listToUse 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]].
- listToUse := sortAlphabetically
- ifTrue: [controllers asSortedCollection: [:a :b | a view label < b view label]]
- ifFalse: [controllers].
labels := String streamContents:
[:strm |
+ controllers do: [:controller | strm nextPutAll: (controller view label contractTo: 40); cr].
- listToUse 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)].
- [self activateController: (listToUse at: index)].
!
Item was added:
+ ----- Method: Debugger class>>context: (in category '*ST80-instance creation') -----
+ context: aContext
+ "Answer an instance of me for debugging the active process starting with the given context."
+ ^ self new
+ process: Processor activeProcess
+ controller: (ScheduledControllers
+ ifNotNil: [:sc |
+ "this means we are in an MVC project"
+ sc inActiveControllerProcess
+ ifTrue: [ScheduledControllers activeController]])
+ context: aContext!
Item was removed:
- ----- Method: Debugger class>>mvcContext: (in category '*ST80-instance creation') -----
- mvcContext: aContext
- "Answer an instance of me for debugging the active process starting with the given context."
-
- ^ self new
- process: Processor activeProcess
- controller: (ScheduledControllers inActiveControllerProcess
- ifTrue: [ScheduledControllers activeController]
- ifFalse: [nil])
- context: aContext!
Item was removed:
- ----- Method: Debugger class>>mvcOpenContext:label:contents: (in category '*ST80-opening') -----
- mvcOpenContext: aContext label: aString contents: contentsStringOrNil
- "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."
- <primitive: 19> "Simulation guard"
- ErrorRecursion not & Preferences logDebuggerStackToFile ifTrue:
- [Smalltalk logSqueakError: aString inContext: aContext].
- ErrorRecursion ifTrue:[
- ErrorRecursion := false.
- self primitiveError: aString].
- ErrorRecursion := true.
- self informExistingDebugger: aContext label: aString.
- (Debugger mvcContext: aContext)
- openNotifierContents: contentsStringOrNil
- label: aString.
- ErrorRecursion := false.
- Processor activeProcess suspend.!
Item was removed:
- ----- Method: Debugger class>>mvcOpenInterrupt:onProcess: (in category '*ST80-opening') -----
- mvcOpenInterrupt: aString onProcess: interruptedProcess
- "Open a notifier in response to an interrupt. An interrupt occurs when the user types the interrupt key (cmd-. on Macs, ctrl-c or alt-. on other systems) or when the low-space watcher detects that memory is low."
- | debugger |
- <primitive: 19> "Simulation guard"
- debugger := self new.
- debugger
- process: interruptedProcess
- controller: (ScheduledControllers activeControllerProcess == interruptedProcess
- ifTrue: [ScheduledControllers activeController]
- ifFalse: [nil])
- context: interruptedProcess suspendedContext.
- debugger externalInterrupt: true.
-
- Preferences logDebuggerStackToFile ifTrue:
- [(aString includesSubstring: 'Space') & (aString includesSubstring: 'low')
- ifTrue: [Smalltalk logError: aString inContext: debugger interruptedContext to: 'LowSpaceDebug.log']
- "logging disabled for 4.3 release, see
- http://lists.squeak.org/pipermail/squeak-dev/2011-December/162503.html"
- "ifFalse: [Smalltalk logSqueakError: aString inContext: debugger interruptedContext]"].
-
- ^debugger
- openNotifierContents: nil label: aString;
- yourself
- !
Item was changed:
----- 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].
- request: 'File name?' translated
- initialAnswer: 'Filename.form'.
- fileName isEmpty ifTrue: [^ self].
form := Form fromFileNamed: fileName.
tool := previousTool.
!
Item was changed:
----- Method: FormEditor>>fileOut (in category 'menu messages') -----
fileOut
| fileName |
fileName := UIManager default
+ saveFilenameRequest: 'File name?' translated
- request: 'File name?' translated
initialAnswer: 'Filename.form'.
+ fileName ifNil: [^ self].
- fileName isEmpty ifTrue: [^ self].
Cursor normal
showWhile: [model writeOnFileNamed: fileName].
!
Item was changed:
----- 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
- request: 'File name?' translated
initialAnswer: 'Filename.form'.
+ fileName ifNil: [^ self].
- fileName isEmpty ifTrue: [^ self].
Cursor normal
showWhile: [form writeOnFileNamed: fileName].
tool := previousTool.
!
Item was changed:
+ ----- Method: FormInspectView>>defaultControllerClass (in category 'controller access') -----
- ----- Method: FormInspectView>>defaultControllerClass (in category 'as yet unclassified') -----
defaultControllerClass
"Refer to the comment in View|defaultControllerClass."
^ NoController!
Item was changed:
+ ----- Method: FormInspectView>>displayView (in category 'displaying') -----
- ----- Method: FormInspectView>>displayView (in category 'as yet unclassified') -----
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 changed:
+ ----- Method: MVCProject>>addProject: (in category 'sub-projects & hierarchy') -----
- ----- Method: MVCProject>>addProject: (in category 'as yet unclassified') -----
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 changed:
----- 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"
- "Present a list of potential projects and enter the one selected."
"Project current jumpToProject"
+ self jumpToSelection: (self buildJumpToMenu: CustomMenu new) mvcStartUpLeftFlush!
- self jumpToSelection: (self buildJumpToMenu: CustomMenu new) startUpLeftFlush!
Item was removed:
- ----- Method: MVCProject>>selectorPrefixForDispatch (in category 'dispatching') -----
- selectorPrefixForDispatch
- "A string to be prepended to selectors for project specific methods"
-
- ^ 'mvc'!
Item was changed:
----- 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].
- (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 changed:
----- 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 == 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: MailComposition>>mvcOpen (in category '*ST80-Support') -----
- mvcOpen
- | textView sendButton |
-
- mvcWindow := StandardSystemView new
- label: 'Mister Postman';
- minimumSize: 400 at 250;
- model: self.
-
- textView := PluggableTextView
- on: self
- text: #messageText
- accept: #messageText:.
- textEditor := textView controller.
-
- sendButton := PluggableButtonView
- on: self
- getState: nil
- action: #submit.
- sendButton label: 'Send'.
- sendButton borderWidth: 1.
-
- sendButton window: (1 at 1 extent: 398 at 38).
- mvcWindow addSubView: sendButton.
-
- textView window: (0 at 40 corner: 400 at 250).
- mvcWindow addSubView: textView below: sendButton.
-
- mvcWindow controller open.
-
-
- !
Item was changed:
+ ----- Method: ModalController>>close (in category 'scheduling') -----
- ----- Method: ModalController>>close (in category 'as yet unclassified') -----
close
"This is how we leave the mode."
modeActive := false.
!
Item was changed:
+ ----- Method: ModalController>>closeAndUnscheduleNoTerminate (in category 'scheduling') -----
- ----- Method: ModalController>>closeAndUnscheduleNoTerminate (in category 'as yet unclassified') -----
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 changed:
+ ----- Method: ModalController>>controlInitialize (in category 'basic control sequence') -----
- ----- Method: ModalController>>controlInitialize (in category 'as yet unclassified') -----
controlInitialize
modeActive := true.
^ super controlInitialize
!
Item was changed:
+ ----- Method: ModalController>>isControlActive (in category 'control defaults') -----
- ----- Method: ModalController>>isControlActive (in category 'as yet unclassified') -----
isControlActive
^ modeActive
!
Item was changed:
+ ----- Method: ModalController>>isControlWanted (in category 'control defaults') -----
- ----- Method: ModalController>>isControlWanted (in category 'as yet unclassified') -----
isControlWanted
^ modeActive
!
Item was changed:
----- Method: Paragraph>>hiliteRect: (in category 'selecting') -----
hiliteRect: rect
- | highlightColor |
- highlightColor := Color quickHighLight: destinationForm depth.
rect ifNotNil: [
+ | highlightColor |
+ highlightColor := Color quickHighLight: destinationForm depth.
destinationForm
fill: rect
rule: Form reverse
+ fillColor: highlightColor].
- fillColor: highlightColor.
- "destinationForm
- fill: (rect translateBy: 1 at 1)
- rule: Form reverse
- fillColor: highlightColor" ].
!
Item was changed:
----- 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]]
- 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.
+ finalRectangle :=
+ (characterBlock2 topLeft
+ corner: visibleRectangle right @ characterBlock2 bottom)
+ 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]]].
self hiliteRect: initialRectangle.
self hiliteRect: interiorRectangle.
self hiliteRect: finalRectangle.!
Item was changed:
----- 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].
- 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].!
- aClass
- ifNil: [^ view flash].
- self
- terminateAndInitializeAround:
- [| aBrow |
- aBrow := SystemBrowser default new.
- aBrow setClass: aClass selector: nil.
- aBrow class
- openBrowserView: (aBrow openEditString: nil) label: 'System Browser'].!
Item was changed:
----- Method: ParagraphEditor>>browseIt (in category 'menu messages') -----
browseIt
"Launch a browser for the current selection, if appropriate"
| aSymbol |
self flag: #yoCharCases.
Preferences alternativeBrowseIt ifTrue: [^ self browseClassFromIt].
self lineSelectAndEmptyCheck: [^ self].
(aSymbol := self selectedSymbol) isNil ifTrue: [^ view flash].
self terminateAndInitializeAround:
[aSymbol first isUppercase
+ ifTrue: [| anEntry |
+ anEntry := (Smalltalk at: aSymbol
+ ifAbsent: [ self systemNavigation browseAllImplementorsOf: aSymbol.
- ifTrue:
- [| anEntry |
- anEntry := (Smalltalk
- at: aSymbol
- ifAbsent:
- [ self systemNavigation browseAllImplementorsOf: aSymbol.
^ nil]).
anEntry isNil ifTrue: [^ view flash].
(anEntry isBehavior or: [ anEntry isTrait ])
ifFalse: [ anEntry := anEntry class ].
+ self systemNavigation browseClass: anEntry.
+ ] ifFalse:[ self systemNavigation browseAllImplementorsOf: aSymbol]]!
- ToolSet browse: anEntry selector: nil.
- ] ifFalse:[ self systemNavigation browseAllImplementorsOf: aSymbol]]!
Item was changed:
----- 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)) first]
ifFalse:[
(string
lastIndexOfAnyOf: CharacterSet crlf
+ startingAt: position - 1) + 1]]
- startingAt: position - 1
- ifAbsent:[0]) + 1]]
forward: false
specialBlock: [:dummy | 1].
^true!
Item was changed:
----- 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.
- left := (string lastIndexOfAnyOf: CharacterSet crlf startingAt: anInterval first - 1 ifAbsent:[0]) + 1.
right := (string indexOfAnyOf: CharacterSet crlf startingAt: anInterval last + 1 ifAbsent: [string size + 1]) - 1.
^left to: right!
Item was changed:
----- 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: [^'"The code inside square brackets is an unevaluated block of code. It becomes an instance of BlockContext 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 changed:
----- 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."'].
- symbol = #thisContext ifTrue: [reply := '"is a context variable. Its value is always the MethodContext 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 changed:
----- 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 |
- | realStart realStop lines startLine stopLine start stop adjustStart indentation numLines oldString newString 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:
- indentation := (startLine to: stopLine) inject: 1000 into:
[:m :l |
m min: (paragraph indentationOfLineIndex: l ifBlank: [:tabs | 1000])].
+ indentation + delta <= 0 ifTrue: [^false]."
- 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).
+
- oldString := paragraph string copyFrom: start to: stop.
- newString := oldString species new: oldString 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]]
- tabs := oldString species new: delta withAll: Character tab.
- oldString lineIndicesDo: [:startL :endWithoutDelimiters :endL |
- startL < endWithoutDelimiters ifTrue: [newString replaceFrom: 1 + newSize to: (newSize := newSize + delta) with: tabs startingAt: 1].
- newString replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - startL) with: oldString startingAt: startL]]
ifFalse: [| tab |
tab := Character tab.
+ oldText string lineIndicesDo: [:startL :endWithoutDelimiters :endL |
- oldString 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].
- [i + delta < 0 and: [ i + startL <= endWithoutDelimiters and: [(oldString at: i + startL) == tab]]] whileTrue: [i := i + 1].
- newString replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - (i + startL)) with: oldString startingAt: i + startL]].
- newSize < newString size ifTrue: [newString := newString copyFrom: 1 to: newSize].
"Adjust the range that will be highlighted later"
adjustStart ifTrue: [realStart := (realStart + delta) max: start].
+ realStop := realStop + newSize - oldText size.
- realStop := realStop + newSize - oldString size.
"Replace selection"
self selectInvisiblyFrom: start to: stop.
+ self replaceSelectionWith: newText.
- self replaceSelectionWith: newString asText.
self selectFrom: realStart to: realStop. "highlight only the original range"
^ true!
Item was changed:
+ ----- Method: ParagraphEditor>>offerMenuFromEsc: (in category 'menu messages') -----
- ----- Method: ParagraphEditor>>offerMenuFromEsc: (in category 'as yet unclassified') -----
offerMenuFromEsc: aStream
sensor keyboard. " consume the character "
self yellowButtonActivity.
^true "tell the caller that the character was processed "!
Item was changed:
----- Method: ParagraphEditor>>saveContentsInFile (in category 'menu messages') -----
saveContentsInFile
"Save the receiver's contents string to a file, prompting the user for a file-name. Suggest a reasonable file-name."
| fileName stringToSave parentWindow labelToUse suggestedName |
stringToSave := paragraph text string.
stringToSave size = 0 ifTrue: [^ self inform: 'nothing to save.'].
parentWindow := self model dependents
detect: [:dep | dep isKindOf: SystemWindow orOf: StandardSystemView]
ifNone: [nil].
labelToUse := parentWindow
ifNil: ['Untitled']
ifNotNil: [parentWindow label].
suggestedName := nil.
#(('Decompressed contents of: ' '.gz')) do: "can add more here..."
[:leaderTrailer | | lastIndex |
(labelToUse beginsWith: leaderTrailer first) ifTrue:
[suggestedName := labelToUse copyFrom: leaderTrailer first size + 1 to: labelToUse size.
(labelToUse endsWith: leaderTrailer last)
ifTrue:
[suggestedName := suggestedName copyFrom: 1 to: suggestedName size - leaderTrailer last size]
ifFalse:
+ [lastIndex := suggestedName lastIndexOf: $..
+ (lastIndex > 1) ifTrue:
- [lastIndex := suggestedName lastIndexOf: $. ifAbsent: [0].
- (lastIndex = 0 or: [lastIndex = 1]) ifFalse:
[suggestedName := suggestedName copyFrom: 1 to: lastIndex - 1]]]].
suggestedName ifNil:
[suggestedName := labelToUse, '.text'].
+ fileName := UIManager default saveFilenameRequest: 'File name?' translated
- fileName := UIManager default request: 'File name?' translated
initialAnswer: suggestedName.
fileName isEmptyOrNil ifFalse:
[(FileStream newFileNamed: fileName) nextPutAll: stringToSave; close]!
Item was changed:
----- Method: ParagraphEditor>>sendContentsToPrinter (in category 'menu messages') -----
sendContentsToPrinter
| textToPrint printer parentWindow |
textToPrint := paragraph text.
+ textToPrint size == 0 ifTrue: [^self inform: 'nothing to print.' translated].
- textToPrint size = 0 ifTrue: [^self inform: 'nothing to print.'].
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 changed:
+ ----- Method: ParagraphEditor>>totalTextHeight (in category 'accessing') -----
- ----- Method: ParagraphEditor>>totalTextHeight (in category 'as yet unclassified') -----
totalTextHeight
^paragraph boundingBox height!
Item was changed:
+ ----- Method: ParagraphEditor>>visibleHeight (in category 'accessing') -----
- ----- Method: ParagraphEditor>>visibleHeight (in category 'as yet unclassified') -----
visibleHeight
^paragraph clippingRectangle height!
Item was changed:
----- 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)))].
- ifFalse: [label := aStringOrDisplayObject asParagraph].
self centerLabel.
!
Item was changed:
+ ----- Method: PluggableFileListView>>acceptButtonView: (in category 'accessing') -----
- ----- Method: PluggableFileListView>>acceptButtonView: (in category 'as yet unclassified') -----
acceptButtonView: aView
^acceptButtonView := aView!
Item was changed:
+ ----- Method: PluggableFileListView>>label: (in category 'label access') -----
- ----- Method: PluggableFileListView>>label: (in category 'as yet unclassified') -----
label: aString
super label: aString.
self noLabel!
Item was changed:
+ ----- Method: PluggableFileListView>>update: (in category 'model access') -----
- ----- Method: PluggableFileListView>>update: (in category 'as yet unclassified') -----
update: aSymbol
(aSymbol = #volumeListIndex or: [aSymbol = #fileListIndex])
ifTrue: [self updateAcceptButton].
^super update: aSymbol!
Item was changed:
+ ----- Method: PluggableFileListView>>updateAcceptButton (in category 'private') -----
- ----- Method: PluggableFileListView>>updateAcceptButton (in category 'as yet unclassified') -----
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 changed:
+ ----- Method: PluggableListViewByItem>>changeModelSelection: (in category 'model access') -----
- ----- Method: PluggableListViewByItem>>changeModelSelection: (in category 'as yet unclassified') -----
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 changed:
+ ----- Method: PluggableListViewByItem>>getCurrentSelectionIndex (in category 'model access') -----
- ----- Method: PluggableListViewByItem>>getCurrentSelectionIndex (in category 'as yet unclassified') -----
getCurrentSelectionIndex
"Answer the index of the current selection."
| item |
getSelectionSelector == nil ifTrue: [^ 0].
item := model perform: getSelectionSelector.
^ itemList findFirst: [ :x | x = item]
!
Item was changed:
+ ----- Method: PluggableListViewByItem>>getList (in category 'model access') -----
- ----- Method: PluggableListViewByItem>>getList (in category 'as yet unclassified') -----
getList
"Ensure that there are only strings in that list."
^ super getList collect: [:ea | ea asString]!
Item was changed:
+ ----- Method: PluggableListViewByItem>>list: (in category 'initialization') -----
- ----- Method: PluggableListViewByItem>>list: (in category 'as yet unclassified') -----
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 changed:
+ ----- Method: PluggableTextController>>accept (in category 'menu messages') -----
- ----- Method: PluggableTextController>>accept (in category 'as yet unclassified') -----
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 changed:
+ ----- Method: PluggableTextController>>userHasEdited (in category 'edit flag') -----
- ----- Method: PluggableTextController>>userHasEdited (in category 'as yet unclassified') -----
userHasEdited
"Note that the user has edited my text."
view hasUnacceptedEdits: true!
Item was changed:
+ ----- Method: PluggableTextController>>userHasNotEdited (in category 'edit flag') -----
- ----- Method: PluggableTextController>>userHasNotEdited (in category 'as yet unclassified') -----
userHasNotEdited
"Note that my text is free of user edits."
view hasUnacceptedEdits: false!
Item was changed:
+ ----- Method: ProjectView class>>open: (in category 'opening') -----
- ----- Method: ProjectView class>>open: (in category 'as yet unclassified') -----
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 changed:
+ ----- Method: ProjectView class>>openAndEnter: (in category 'opening') -----
- ----- Method: ProjectView class>>openAndEnter: (in category 'as yet unclassified') -----
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 changed:
+ ----- Method: ReadOnlyTextController>>accept (in category 'menu messages') -----
- ----- Method: ReadOnlyTextController>>accept (in category 'as yet unclassified') -----
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 changed:
+ ----- Method: ReadOnlyTextController>>userHasEdited (in category 'edit flag') -----
- ----- Method: ReadOnlyTextController>>userHasEdited (in category 'as yet unclassified') -----
userHasEdited
"Ignore this -- I stay clean"!
Item was changed:
+ ----- Method: ReadOnlyTextController>>zapSelectionWith: (in category 'private') -----
- ----- Method: ReadOnlyTextController>>zapSelectionWith: (in category 'as yet unclassified') -----
zapSelectionWith: aText
view flash "no edits allowed"!
Item was changed:
TestCase subclass: #ST80MenusTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'ST80-Menus-Tests'!
+ !ST80MenusTest commentStamp: 'eem 3/30/2017 17:33' prior: 0!
- !ST80MenusTest commentStamp: 'tlk 5/2/2006 22:41' 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,
- 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 BlockContext 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 changed:
+ ----- Method: ST80MenusTest>>testSupplyAnswerOfFillInTheBlank (in category 'tests') -----
- ----- Method: ST80MenusTest>>testSupplyAnswerOfFillInTheBlank (in category 'testing') -----
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 changed:
----- 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:
- (result := (SelectionMenu selections: Display supportedDisplayDepths) startUpWithCaption: 'Choose a display depth
- (it is currently ' , Display depth printString , ')') == nil ifFalse:
[Display newDepth: result]!
Item was changed:
----- Method: StandardSystemView class>>doCacheBits (in category 'class initialization') -----
doCacheBits
"StandardSystemView doCacheBits - Enable fast window repaint feature"
CacheBits := true.
+ ScheduledControllers ifNotNil: [:sc | sc unCacheWindows; restore]!
- ScheduledControllers ifNotNilDo: [:sc | sc unCacheWindows; restore]!
Item was added:
+ ----- Method: StandardSystemView>>defaultBackgroundColor (in category 'initialize-release') -----
+ defaultBackgroundColor
+
+ ^ model
+ ifNil: [Color white]
+ ifNotNil: [:m | m windowColorToUse]!
Item was added:
+ ----- 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>>model: (in category 'initialize-release') -----
- model: aModel
- "Set the receiver's model. For a Standard System View, we also at this time get the default background color set up. 7/30/96 sw"
- super model: aModel.
- self setDefaultBackgroundColor!
Item was changed:
+ ----- Method: TestIndenting>>testBreakAtSpaceLeavesSpaceOnOriginalLine (in category 'tests') -----
- ----- Method: TestIndenting>>testBreakAtSpaceLeavesSpaceOnOriginalLine (in category 'testing') -----
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 changed:
+ ----- Method: TestIndenting>>testCR (in category 'tests') -----
- ----- Method: TestIndenting>>testCR (in category 'testing') -----
testCR
"Checks whether the beginning of a new line starts at the indented position"
| 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: cb top > 0.
self assert: cb left = 24!
Item was changed:
+ ----- Method: TestIndenting>>testCR2 (in category 'tests') -----
- ----- Method: TestIndenting>>testCR2 (in category 'testing') -----
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 changed:
+ ----- Method: TestIndenting>>testCR3 (in category 'tests') -----
- ----- Method: TestIndenting>>testCR3 (in category 'testing') -----
testCR3
"Checks whether the beginning of a new line starts at the indented position"
| cb |
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.
self assert: cb top > 0.
self assert: cb left = 24!
Item was changed:
+ ----- Method: TestIndenting>>testNewLineAndTabProvidesDoubleIndent (in category 'tests') -----
- ----- Method: TestIndenting>>testNewLineAndTabProvidesDoubleIndent (in category 'testing') -----
testNewLineAndTabProvidesDoubleIndent
"Checks whether the beginning of a new line starts at the indented position"
| cb |
para replaceFrom: 11 to: 11 with: (Text string: (String with: Character cr) attribute: (TextIndent tabs: 1)) displaying: false.
cb := para characterBlockForIndex: 12.
self assert: cb top > 0.
self assert: cb left = 24!
Item was changed:
+ ----- Method: TestIndenting>>testNewLineLeaveSpacesOnOldLine (in category 'tests') -----
- ----- Method: TestIndenting>>testNewLineLeaveSpacesOnOldLine (in category 'testing') -----
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 changed:
+ ----- Method: TestIndenting>>testNewLineStartsIndented (in category 'tests') -----
- ----- Method: TestIndenting>>testNewLineStartsIndented (in category 'testing') -----
testNewLineStartsIndented
"Checks whether the beginning of a new line starts at the indented position"
| cb |
para replaceFrom: 7 to: 7 with: (String with: Character cr) displaying: false.
cb := para characterBlockForIndex: 8.
self assert: cb top > 0.
self assert: cb left = 24!
Item was changed:
+ ----- Method: TestIndenting>>testNewLineStartsIndentedWhenWrapped (in category 'tests') -----
- ----- Method: TestIndenting>>testNewLineStartsIndentedWhenWrapped (in category 'testing') -----
testNewLineStartsIndentedWhenWrapped
"Checks whether the beginning of a new line starts at the indented position"
| cb |
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.
self assert: cb top > 0.
self assert: cb left = 24!
Item was changed:
+ ----- Method: TestIndenting>>testSetUp (in category 'tests') -----
- ----- Method: TestIndenting>>testSetUp (in category 'testing') -----
testSetUp
"just reminding us all what the paragraph looks like to begin with. assuming Accuny12 font "
| cb |
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 = 24.
cb := para characterBlockForIndex: 3. "w"
self assert: cb top = 0.
self assert: cb left = 24.
self assert: cb right = 34.
cb := para characterBlockForIndex: 7. " " "between word and word"
self assert: cb top = 0.
self assert: cb left = 52.
self assert: cb right = 57.
cb := para characterBlockForIndex: 11. "d" "last char"
self assert: cb top = 0.
self assert: cb left = 79.
self assert: cb right = 85.
!
Item was added:
+ ----- Method: View>>defaultBackgroundColor (in category 'initialize-release') -----
+ defaultBackgroundColor
+
+ ^ self userInterfaceTheme color!
Item was added:
+ ----- Method: View>>defaultForegroundColor (in category 'initialize-release') -----
+ defaultForegroundColor
+
+ ^ self userInterfaceTheme borderColor!
Item was changed:
----- 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.!
- controller := aController!
Item was changed:
----- 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!
- self backgroundColor: model windowColorToUse!
Item was added:
+ ----- Method: View>>setDefaultForegroundColor (in category 'initialize-release') -----
+ setDefaultForegroundColor
+
+ self foregroundColor: self defaultForegroundColor!
More information about the Packages
mailing list