From VisualWorks® NonCommercial, 7.6 of March 3, 2008 on January 2, 2009 at 4:57:17 am
DebugReport
Smalltalk
false
private Smalltalk.*
DebugReport
DRReportPart
DebugReport
Core.Object
false
none
index ctxtTitle allInstVars allTempVars tempVars instVars receiver sourceText pcRange
DebugReport
DRReporter
DebugReport
Core.Object
false
none
accessor reportParts label
outputterClass
DebugReport
DROutputter
DebugReport
Core.Object
false
none
timestamp label reportParts
DebugReport
DRFileOutputter
DebugReport
DebugReport.DROutputter
false
none
baseDir
DebugReport
DRZipOutputter
DebugReport
DebugReport.DROutputter
false
none
zip
DebugReport
DRSettings
DebugReport
Core.Object
false
none
settingDict
DebugReport
DRDebuggerServiceAccessor
DebugReport
Core.Object
false
none
service index
DebugReport
DebugReport.DRReporter class accessing
outputterClass: aDROutputterClass
outputterClass := aDROutputterClass
outputterClass
"
DRReporter outputterClass: DRZipOutputter
DRReporter outputterClass: DRFileOutputter
"
outputterClass ifNil: [outputterClass := DRZipOutputter].
^outputterClass
DebugReport.DRReporter class instance creation
on: aDebuggerService
^(self new)
on: aDebuggerService;
yourself
DebugReport.DRReporter accessing
accessor
^ accessor
label
label ifNil: [label := self accessor label].
^ label
reportParts
reportParts ifNil: [reportParts := self accessor buildReportParts].
^ reportParts
DebugReport.DRReporter outputting
outputHtmlReport
| outputter |
outputter := self class outputterClass on: self.
outputter output
outputHtmlReportSilently
| outputter |
outputter := self class outputterClass on: self.
outputter outputSilently
DebugReport.DRReporter initialize-release
on: aDebuggerService
aDebuggerService prepareTopContext.
accessor := DRDebuggerServiceAccessor on: aDebuggerService
DebugReport.DROutputter class template
stackListTemplate
^ '
<html>
<head>
<link rel="stylesheet" type="text/css" href="../DebugReport.css">
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body>
<div class="indexLink">
<a href="../index.html" target="_top"> ^ index</a>
</div>
<ol>
{1}
<ol>
</body>
</html>'
instValFrameTemplate
^'
<html>
<head>
<link rel="stylesheet" type="text/css" href="./DebugReport.css">
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body>
</body>
</html>'
indexTemplate
^ '
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN">
<html>
<head>
<title>DebugReport - {1}</title>
<link rel="stylesheet" type="text/css" href="./DebugReport.css">
<meta name="generator" content="DebugReport">
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body>
<h1>{1}</h1>
<span class="timeStamp">{2}</span>
<br><br>
<div class="state">
<ul>
{3}
</ul>
</div>
<br>
<div class="debuggerLink">
<a href="./1/report.html"> >> Debugger view</a>
</div>
<div class="stack">
<ol>
{4}
</ol>
<div>
<!-- This Document was generated by DebugReport. -->
</body>
</html>
'
tempValFrameTemplate
^'
<html>
<head>
<link rel="stylesheet" type="text/css" href="./DebugReport.css">
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body>
</body>
</html>'
instVarListTemplate
^ '
<html>
<head>
<link rel="stylesheet" type="text/css" href="../DebugReport.css">
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body>
<ol>
{1}
</ol>
</body>
</html>'
cssTemplate
^ '
body {
font-size: 80%;
background-color: #DCDCDC;
}
a {
text-decoration: none;
}
a:hover {
color: red;
font-style: italic;
}
li.current {
font-weight: bold;
background-color: #A9A9A9;
}
div.debuggerLink {
font-size: 125%;
font-weight: bold;
background-color: #F5F5F5;
}
div.indexLink {
background-color: #F5F5F5;
}
div.state {
border: 2px solid;
border-color: #A9A9A9;
}
div.stack {
border: 2px solid;
border-color: #A9A9A9;
}
.timeStamp {
font-size: 120%;
font-weight: bold;
}
.selector {
font-weight: bold;
}
.selected {
background-color: #99FF66;
}
.varName {
font-size: 120%;
font-weight: bold;
}
'
tempVarListTemplate
^ '
<html>
<head>
<link rel="stylesheet" type="text/css" href="../DebugReport.css">
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body>
<ol>
{1}
</ol>
</body>
</html>'
reportTemplate
^ '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN">
<html>
<head>
<title>DebugReport - {1}</title>
<meta name="generator" content="DebugReport">
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<frameset rows="25%,50%,25%">
<frame src="./stackList.html#current" name="stackListFrame">
<frame src="./stackCode.html" name="stackCodeFrame">
<frameset cols="20%,30%,20%,30%">
<frame src="./instVarList.html" name="instVarListFrame">
<frame src="../instValFrame.html" name="instValFrame">
<frame src="./tempVarList.html" name="tempVarListFrame">
<frame src="../tempValFrame.html" name="tempValFrame">
</frameset>
</frameset>
<noframes>
<h2>Sorry for inconvenience</h2>
<p>This document is designed to be viewed using the frames feature.</p>
</noframes>
<!-- This Document was generated by DebugReport. -->
</html>
'
valTemplate
^ '
<html>
<head>
<link rel="stylesheet" type="text/css" href="../../DebugReport.css">
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body>
<span class="varName">{1}</span>
<br><br>
<div class="varVal">
{2}
</div>
</body>
</html>
'
stackCodeTemplate
^ '
<html>
<head>
<link rel="stylesheet" type="text/css" href="../DebugReport.css">
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body>
<ol>
{1}
<ol>
</body>
</html>'
DebugReport.DROutputter class instance creation
on: reporter
^(self new)
on: reporter;
yourself
DebugReport.DROutputter accessing
reportParts: parts
reportParts := parts
timestamp: anObject
timestamp := anObject
label: anObject
label := anObject
label
^label
timestamp
^timestamp
reportParts
^ reportParts
DebugReport.DROutputter outputting to stream
outputTempVarListOn: aStream index: anInteger
| list part |
part := self reportParts at: anInteger.
list := String streamContents: [:str |
part tempVars do: [:association |
| varName |
varName := association key.
str nextPutAll: '<li><a href="tempVal/'.
str nextPutAll: varName.
str nextPutAll: '.html" target="tempValFrame">'.
str nextPutAll: varName.
str nextPutAll: '</li>'.
str nextPut: Character cr.
].
].
^ aStream nextPutAll: (self class tempVarListTemplate format: (Array with: list))
outputStackListOn: aStream index: anInteger
| list |
list := String streamContents: [:str |
self reportParts do: [:rp |
(rp index = anInteger) ifTrue: [
str nextPutAll: '<li class="current"><a name="current">'.
str nextPutAll: rp ctxtTitle.
str nextPutAll: '</li>'.
] ifFalse: [
str nextPutAll: '<li><a href="../'.
str nextPutAll: rp index printString.
str nextPutAll: '/report.html" target="_top">'.
str nextPutAll: rp ctxtTitle.
str nextPutAll: '</a></li>'.
].
str nextPut: Character cr.
].
].
^ aStream nextPutAll: (self class stackListTemplate format: (Array with: list))
outputTempValFrameOn: aStream
^ aStream nextPutAll: self class tempValFrameTemplate
outputStackCodeOn: aStream index: anInteger
| part |
part := self reportParts at: anInteger.
^ aStream nextPutAll: (self class stackCodeTemplate format: (Array with: part sourceTextHtml))
outputReportOn: aStream
^ aStream nextPutAll: (self class reportTemplate format: (Array with: self label))
outputInstValFrameOn: aStream
^ aStream nextPutAll: self class instValFrameTemplate
outputIndexOn: aStream
| basicState list values |
basicState := String streamContents: [:stream |
stream nextPutAll: (self makeListKey: 'Smalltalk Version' value: Smalltalk version).
stream nextPutAll: (self makeListKey: 'Object Memory versionId' value: ObjectMemory versionId printString).
stream nextPutAll: (self makeListKey: 'Platform' value: ObjectMemory platformMoniker).
stream nextPutAll: (self makeListKey: 'Image' value: ObjectMemory imageName).
stream nextPutAll: (self makeListKey: 'VM' value: CEnvironment commandLine first).
stream nextPutAll: (self makeListKey: 'Command Line' value: self commandLine).
].
list := String streamContents: [:str |
self reportParts do: [:rp |
str nextPutAll: '<li><a href="'.
str nextPutAll: rp index printString.
str nextPutAll: '/report.html">'.
str nextPutAll: rp ctxtTitle.
str nextPutAll: '</a></li>'.
str nextPut: Character cr.
].
].
values := OrderedCollection new.
values add: self label.
values add: self timestamp.
values add: basicState.
values add: list.
^ aStream nextPutAll: (self class indexTemplate format: values)
outputCssOn: aStream
^ aStream nextPutAll: self class cssTemplate
outputInstVarListOn: aStream index: anInteger
| list part |
part := self reportParts at: anInteger.
list := String streamContents: [:str |
part instVars do: [:association |
| varName |
varName := association key.
str nextPutAll: '<li><a href="instVal/'.
str nextPutAll: varName.
str nextPutAll: '.html" target="instValFrame">'.
str nextPutAll: varName.
str nextPutAll: '</li>'.
str nextPut: Character cr.
].
].
^ aStream nextPutAll: (self class instVarListTemplate format: (Array with: list))
outputValueOn: aStream key: keyStr value: valueObj
^ aStream nextPutAll: (self class valTemplate format: (Array with: keyStr with: valueObj))
DebugReport.DROutputter defaults
encoding
^ #UTF8
DebugReport.DROutputter private
formattedTimeStampString
| date time |
date := self timestamp asDate.
time := self timestamp asTime.
^String
streamContents:
[:stream |
stream nextPutAll: date yyyymmddString.
stream nextPutAll: time hhmmssString]
makeListKey: key value: value
^ ('<li>{1}: {2}</li>' format: (Array with: key asString with: value asString)) , (String with: Character cr)
commandLine
| ws |
ws := WriteStream on: String new.
CEnvironment commandLine
do: [:each | ws nextPutAll: each]
separatedBy: [ws space].
^ ws contents
DebugReport.DROutputter initialize-release
on: reporter
label := reporter label.
reportParts := reporter reportParts.
timestamp := Timestamp now
DebugReport.DROutputter outputting
outputInstVals
| instValDirName |
self reportParts do: [:part |
instValDirName := part index printString , '/instVal/'.
self
output: [:aStream | self outputValueOn: aStream key: 'self' value: part receiver]
as: instValDirName , 'self.html'.
part instVars do: [:assoc |
self
output: [:aStream | self outputValueOn: aStream key: assoc key value: assoc value]
as: instValDirName , assoc key , '.html'.
].
].
output
WindowingSystem isHeadless
ifTrue: [self outputSilently]
ifFalse: [self outputWithProgress]
outputStackCodes
self reportParts do: [:part |
self
output: [:aStream | self outputStackCodeOn: aStream index: part index.]
as: part index printString , '/stackCode.html'
].
outputIndex
self
output: [:aStream | self outputIndexOn: aStream]
as: 'index.html'
output: aBlock as: pathString
| aStream |
aStream := WriteStream on: String new.
[aBlock value: aStream.
self
write: aStream contents
to: pathString] ensure: [aStream close]
outputReports
self reportParts do: [:part |
self
output: [:aStream | self outputReportOn: aStream]
as: part index printString , '/report.html'
].
outputTempValFrame
self
output: [:aStream | self outputTempValFrameOn: aStream]
as: 'tempValFrame.html'
write: aString to: pathString
self subclassResponsibility
outputInstValFrame
self
output: [:aStream | self outputInstValFrameOn: aStream]
as: 'instValFrame.html'
outputCss
self
output: [:aStream | self outputCssOn: aStream]
as: 'DebugReport.css'
outputMethods
^ #(
outputCss
outputIndex
outputInstValFrame
outputTempValFrame
outputReports
outputStackLists
outputStackCodes
outputInstVarLists
outputInstVals
outputTempVarLists
outputTempVals
)
outputSilently
self outputMethods do: [:selector | self perform: selector]
outputTempVarLists
self reportParts do: [:part |
self
output: [:aStream | self outputTempVarListOn: aStream index: part index.]
as: part index printString , '/tempVarList.html'
].
outputWithProgress
| aModel windowController sz |
aModel := 0.0 asValue.
windowController := ProgressWidgetView
progressOpenOn: aModel
label: 'Outputting debug report' asText allBold.
sz := self outputMethods size.
self outputMethods
doWithIndex:
[:selector :idx |
self perform: selector.
aModel value: (idx / sz) asFloat].
windowController closeAndUnschedule
outputTempVals
| tempValDirName |
self reportParts do: [:part |
tempValDirName := part index printString , '/tempVal/'.
self
output: [:aStream | self outputValueOn: aStream key: 'thisContext' value: part receiver]
as: tempValDirName , 'thisContext.html'.
part tempVars do: [:assoc |
self
output: [:aStream | self outputValueOn: aStream key: assoc key value: assoc value]
as: tempValDirName , assoc key , '.html'.
].
].
outputInstVarLists
self reportParts do: [:part |
self
output: [:aStream | self outputInstVarListOn: aStream index: part index.]
as: part index printString , '/instVarList.html'
].
outputStackLists
self reportParts do: [:part |
self
output: [:aStream | self outputStackListOn: aStream index: part index.]
as: part index printString , '/stackList.html'
].
DebugReport.DRFileOutputter accessing
baseDir
baseDir ifNil: [baseDir := self createBaseDir].
^ baseDir
DebugReport.DRFileOutputter file io
createBaseDir
^self newBaseDirName asFilename ensureDirectory
newBaseDirName
| dirName base count |
base := 'DebugReport-' , self formattedTimeStampString.
count := 2.
dirName := base.
[dirName asFilename exists] whileTrue: [
dirName := base , '-' , count printString.
count := count + 1.
].
^ dirName
DebugReport.DRFileOutputter outputting
write: aString to: pathString
| path fs dirs currentDir |
path := pathString subStrings: '/\:'.
dirs := path allButLast: 1.
currentDir := self baseDir.
dirs do: [:eachDirName | currentDir := currentDir / eachDirName].
currentDir ensureDirectory.
fs := ((currentDir / path last) withEncoding: self encoding) writeStream.
[
fs nextPutAll: aString.
] ensure: [fs close].
DebugReport.DRDebuggerServiceAccessor class instance creation
on: aDebuggerService
^(self new)
on: aDebuggerService;
yourself
DebugReport.DRDebuggerServiceAccessor initialize-release
on: aDebuggerService
service := aDebuggerService.
index := 0.
DebugReport.DRDebuggerServiceAccessor accessing
title
^self context printString
tempAndValues
| ctxt |
ctxt := self context.
^ctxt slotAccessors
collect: [:each | each key -> (ctxt localAt: each value) ]
label
^self service label
pcRange
| pc i size end sourceMap |
self context == nil
ifTrue: [^1 to: 0].
sourceMap := self sourceMap.
(sourceMap == nil or: [sourceMap size = 0])
ifTrue: [^1 to: 0].
pc:= self context pc.
(self context == self processHandle topContext and: [self processHandle interrupted])
ifFalse: "When selecting a context in middle of the stack or the context 'halt',
the pc points to the byte code after the send."
[i := 1.
size := sourceMap size.
[i <= size and: [(sourceMap at: i) key < pc]]
whileTrue: [i := i + 1].
i > 1 ifTrue: [pc := (sourceMap at: i - 1) key]].
pc := pc - 1.
i := sourceMap indexForInserting: (Association key: pc value: nil).
i < 1 ifTrue: [^1 to: 0].
i > sourceMap size
ifTrue:
[end := sourceMap inject: 0 into:
[:prev :this | prev max: this value last].
^ end+1 to: end].
^(sourceMap at: i) value
sourceText
| ctxt txt |
ctxt := self context.
ctxt ifNil: [^Text new].
^[txt := self sourceCode asText.
ctxt method homeMethod usuallyHasSelector
ifTrue: [txt makeSelectorBoldIn: ctxt mclass].
txt]
on: MethodDictionary keyNotFoundSignal
do:
[:ex |
((#noSourceCodeFor1s << #pdp >> 'no source code for <1s>'
expandMacrosWith: ctxt printString) asText)
emphasizeAllWith: #italic;
yourself]
instAndValueStrings
| col |
col := OrderedCollection new.
col add: ('self' -> self receiver printString).
self instNames
do:
[:varName | col add: varName -> (self receiver instVarNamed: varName) printString].
^col
sourceCode
^ self sourceCodeAt: self index
instNames
^ self receiver class allInstVarNames
receiver
^ self context receiver
context
^self contextAt: self index
receiverString
^ self receiver printString
tempAndValueStrings
^self tempAndValues collect: [:each | each key -> each value printString]
DebugReport.DRDebuggerServiceAccessor actions
buildReportPartAt: idx
self index: idx.
^(DRReportPart new)
index: self index;
ctxtTitle: self title;
sourceText: self sourceText;
receiver: self receiverString;
instVars: self instAndValueStrings;
tempVars: self tempAndValueStrings;
pcRange: self pcRange;
yourself
DebugReport.DRDebuggerServiceAccessor private-accessing
sourceMap
^ self context visibleSourceMap
contextAt: idx
^self service contextList at: index
sourceCodeAt: idx
^ (self contextAt: idx) sourceCode
processHandle
^ self service processHandle
service
^ service
buildReportParts
| col |
col := OrderedCollection new.
1
to: self service contextList size
do: [:idx | col add: (self buildReportPartAt: idx)].
^col
DebugReport.DRDebuggerServiceAccessor private
index
^ index
index: anInteger
index := anInteger
DebugReport.DRReportPart accessing
receiver: anObject
receiver := anObject
hilighteRange
^ self pcRange
ctxtTitle: anObject
ctxtTitle := anObject
pcRange: anInterval
pcRange := anInterval
index: anInteger
index := anInteger
sourceText
^sourceText
instVars: aDictionary
instVars := aDictionary
receiver
^receiver
ctxtTitle
^ctxtTitle
instVars
^instVars
index
^index
sourceText: aStringOrText
sourceText := aStringOrText
tempVars: aDictionary
tempVars := aDictionary
tempVars
^tempVars
pcRange
^pcRange
DebugReport.DRReportPart printing
printOn: aStream
super printOn: aStream.
aStream nextPut: $(.
aStream nextPutAll: self ctxtTitle.
aStream nextPut: $).
DebugReport.DRReportPart html
sourceTextHtml
| cr srcStr srcText inSelector inSelected ws |
cr := String with: Character cr.
srcText := self insertTemporarySelectedTag: self sourceText.
srcStr := self insertTemporarySelectorTag: srcText.
inSelected := false.
inSelector := false.
ws := WriteStream on: String new.
srcStr linesDo: [:line |
| replaced |
replaced := line.
('*%selector_start%*' match: line) ifTrue: [inSelector := true].
('*%selected_start%*' match: line) ifTrue: [inSelected := true].
replaced := self replaceWhiteSpaces: replaced.
inSelector ifTrue: [replaced := self insertSelectorTag: replaced].
inSelected ifTrue: [replaced := self insertSelectedTag: replaced].
ws nextPutAll: '<li>' , replaced , '</li>' , cr.
('*%selector_end%*' match: line) ifTrue: [inSelector := false].
('*%selected_end%*' match: line) ifTrue: [inSelected := false].
].
^ ws contents
DebugReport.DRReportPart private
insertSelectedTag: aString
| replaced |
replaced := ('*%selected_start%*' match: aString)
ifTrue: [aString copyReplaceAll: '%selected_start%' with: '<span class="selected">']
ifFalse: ['<span class="selected">' , aString].
replaced := ('*%selected_end%*' match: aString)
ifTrue: [replaced copyReplaceAll: '%selected_end%' with: '</span>']
ifFalse: [replaced , '</span>'].
^ replaced
insertSelectorTag: aString
| replaced |
replaced := ('*%selector_start%*' match: aString)
ifTrue: [aString copyReplaceAll: '%selector_start%' with: '<span class="selector">']
ifFalse: ['<span class="selector">' , aString ].
replaced := ('*%selector_end%*' match: aString)
ifTrue: [replaced copyReplaceAll: '%selector_end%' with: '</span>']
ifFalse: [replaced , '</span>'].
^ replaced
insertTemporarySelectorTag: aText
| runLength ws |
aText hasChangeOfEmphasis ifFalse: [^ aText asString].
runLength := aText runLengthFor: 1.
ws := WriteStream on: String new.
ws nextPutAll: '%selector_start%'.
ws nextPutAll: (aText first: runLength).
ws nextPutAll: '%selector_end%'.
ws nextPutAll: (aText allButFirst: runLength).
^ ws contents
insertTemporarySelectedTag: aText
| ts range |
range := self pcRange.
range size > 0 ifFalse: [^ aText].
ts := TextStream on: String new.
ts nextPutAllText: (aText first: range first - 1).
ts nextPutAllText: '%selected_start%' asText.
ts nextPutAllText: (aText copyFrom: range first to: range last).
ts nextPutAllText: '%selected_end%' asText.
ts nextPutAllText: (aText allButFirst: range last).
^ ts contents.
replaceWhiteSpaces: aString
| result |
result := aString.
result := result copyReplaceAll: (String with: Character space) with: ' '.
result := result copyReplaceAll: (String with: Character tab) with: ' '.
^ result
DebugReport.DRZipOutputter accessing
zip
zip ifNil: [zip := ZipArchive new].
^ zip
DebugReport.DRZipOutputter outputting
outputMethods
^super outputMethods , #(#outputZipArchive)
outputZipArchive
self zip writeToFileNamed: self newFileName
write: aString to: pathString
self zip
addString: (aString withEncoding: self encoding) readStream contents asString
as: pathString
DebugReport.DRZipOutputter private
newFileName
| base extension count fileName |
base := 'DebugReport-' , self formattedTimeStampString.
extension := '.zip'.
fileName := base.
count := 2.
[(fileName , extension) asFilename exists] whileTrue: [
fileName := base , '-' , count printString.
count := count + 1.
].
^ fileName , extension
DebugReport.DRSettings class class initialization
initialize
settingDict := nil
DebugReport.DRSettings class accessing
settingDict
settingDict ifNil: [settingDict := Dictionary new].
^ settingDict
DebugReport.DRSettings class testing
shouldLogAutomaticaly: aException
self logContextAutomatically ifFalse: [^false].
(self ignoreHalt and: [aException class = HaltInterrupt]) ifTrue: [^false].
^true
DebugReport.DRSettings class setting access
logContextAutomatically
"
DebugReport.DRSettings logContextAutomatically.
DebugReport.DRSettings logContextAutomatically: true.
DebugReport.DRSettings logContextAutomatically: false.
"
^self settingDict
at: #logContextAutomatically
ifAbsentPut: [false]
ignoreHalt: aBoolean
^self settingDict at: #ignoreHalt put: aBoolean
ignoreHalt
"
DebugReport.DRSettings ignoreHalt.
DebugReport.DRSettings ignoreHalt: true.
DebugReport.DRSettings ignoreHalt: false.
"
^self settingDict
at: #ignoreHalt
ifAbsentPut: [true]
logContextAutomatically: aBoolean
^self settingDict at: #logContextAutomatically put: aBoolean
Core.Object system primitives
instVarNamed: varName
| index |
index := self class allInstVarNames indexOf: varName.
index = 0 ifTrue: [^ self].
^ self instVarAt: index
Core.Object converting
asFormatString
^ self printString
Core.CharacterArray converting
asFormatString
^self asString
Core.String formatting
evaluateExpression: aString parameters: aCollection
"private - evaluate the expression aString with
aCollection as the parameters and answer the
evaluation result as an string"
| index |
index := ('0' , aString) asNumber.
index isZero
ifTrue: [^ '[invalid subscript: {1}]' format: (Array with: aString)].
index > aCollection size
ifTrue: [^ '[subscript is out of bounds: {1}]' format: (Array with: aString)].
^ (aCollection at: index) asFormatString
getEnclosedExpressionFrom: aStream
"private - get the expression enclosed between '{' and
'}' and remove all the characters from the stream"
| result currentChar |
result := String new writeStream.
[aStream atEnd
or: [(currentChar := aStream next) == $}]]
whileFalse: [result nextPut: currentChar].
^ result contents withBlanksTrimmed
withBlanksTrimmed
"Return a copy of the receiver from which leading and trailing blanks have been trimmed."
| first result |
first := self findFirst: [:c | c isSeparator not].
first = 0 ifTrue: [^ '']. "no non-separator character"
result := self
copyFrom: first
to: (self findLast: [:c | c isSeparator not]).
^ result
" ' abc d ' withBlanksTrimmed"
format: aCollection
"format the receiver with aCollection
simplest example:
'foo {1} bar' format: (Array with: Date today).
complete example:
'\{ \} \\ foo {1} bar {2}' format: (Array with: 12 with: 'string').
"
| result stream |
result := String new writeStream.
stream := self readStream.
[stream atEnd]
whileFalse: [| currentChar |
currentChar := stream next.
currentChar == ${
ifTrue: [| expression |
expression := self getEnclosedExpressionFrom: stream.
result
nextPutAll: (self evaluateExpression: expression parameters: aCollection)]
ifFalse: [
currentChar == $\
ifTrue: [stream atEnd
ifFalse: [result nextPut: stream next]]
ifFalse: [result nextPut: currentChar]]].
^ result contents
Core.String converting
subStrings: separators
"Answer an array containing the substrings in the receiver separated
by the elements of separators."
| char result sourceStream subString |
"Changed 2000/04/08 For ANSI <readableString> protocol."
(separators isString or:[separators allSatisfy: [:element | element isKindOf: Character]])
ifFalse: [^ self error: 'separators must be Characters.'].
sourceStream := ReadStream on: self.
result := OrderedCollection new.
subString := String new.
[sourceStream atEnd]
whileFalse:
[char := sourceStream next.
(separators includes: char)
ifTrue: [subString notEmpty
ifTrue:
[result add: subString copy.
subString := String new]]
ifFalse: [subString := subString , (String with: char)]].
subString notEmpty ifTrue: [result add: subString copy].
^ result asArray
Core.String enumerating
linesDo: aBlock
"execute aBlock with each line in this string. The terminating CR's are not included in what is passed to aBlock"
| start end |
start := 1.
[ start <= self size ] whileTrue: [
end := self nextIndexOf: Character cr from: start to: self size.
end ifNil: [end := self size + 1].
end := end - 1.
aBlock value: (self copyFrom: start to: end).
start := end + 2. ].
Core.SequenceableCollection class stream creation
streamContents: oneArgBlock
| ws |
ws := WriteStream on: (self new: 100).
oneArgBlock value: ws.
^ ws contents
ZipArchiveMember private-writing
refreshLocalFileHeaderTo: aStream
"Re-writes my local header to the given stream.
To be called after writing the data stream.
Assumes that fileName and localExtraField sizes didn't change since last written."
| here |
here:=aStream position.
aStream position: writeLocalHeaderRelativeOffset.
aStream nextPutAll: LocalFileHeaderSignature asByteArray.
aStream nextLittleEndianNumber: 2 put: versionNeededToExtract.
aStream nextLittleEndianNumber: 2 put: bitFlag.
aStream nextLittleEndianNumber: 2 put: desiredCompressionMethod.
aStream nextLittleEndianNumber: 4 put: lastModFileDateTime.
aStream nextLittleEndianNumber: 4 put: crc32.
aStream nextLittleEndianNumber: 4 put: (desiredCompressionMethod = CompressionStored
ifTrue: [ uncompressedSize ] ifFalse: [ compressedSize ]).
aStream nextLittleEndianNumber: 4 put: uncompressedSize.
aStream nextLittleEndianNumber: 2 put: fileName size.
aStream nextLittleEndianNumber: 2 put: localExtraField size.
aStream position: here.
writeCentralDirectoryFileHeaderTo: aStream
"C2 v3 V4 v5 V2"
aStream nextPutAll: CentralDirectoryFileHeaderSignature asByteArray.
aStream nextLittleEndianNumber: 1 put: versionMadeBy.
aStream nextLittleEndianNumber: 1 put: fileAttributeFormat.
aStream nextLittleEndianNumber: 2 put: versionNeededToExtract.
aStream nextLittleEndianNumber: 2 put: bitFlag.
aStream nextLittleEndianNumber: 2 put: desiredCompressionMethod.
aStream nextLittleEndianNumber: 4 put: lastModFileDateTime.
"These next 3 should have been updated during the write of the data"
aStream nextLittleEndianNumber: 4 put: crc32.
aStream nextLittleEndianNumber: 4 put: (desiredCompressionMethod = CompressionStored
ifTrue: [ uncompressedSize ] ifFalse: [ compressedSize ]).
aStream nextLittleEndianNumber: 4 put: uncompressedSize.
aStream nextLittleEndianNumber: 2 put: fileName size.
aStream nextLittleEndianNumber: 2 put: cdExtraField size.
aStream nextLittleEndianNumber: 2 put: fileComment size.
aStream nextLittleEndianNumber: 2 put: 0. "diskNumberStart"
aStream nextLittleEndianNumber: 2 put: internalFileAttributes.
aStream nextLittleEndianNumber: 4 put: externalFileAttributes.
aStream nextLittleEndianNumber: 4 put: writeLocalHeaderRelativeOffset.
aStream nextPutAll: fileName asByteArray.
aStream nextPutAll: cdExtraField asByteArray.
aStream nextPutAll: fileComment asByteArray.
ZipArchiveMember accessing
setLastModFileDateTimeFrom: aSmalltalkTime
| unixTime |
unixTime := aSmalltalkTime - 2177424000. "PST?"
lastModFileDateTime := self unixToDosTime: unixTime
CraftedSmalltalk.DebuggerClient class resources
reportMenu
"Tools.MenuEditor new openOnClass: self andSelector: #reportMenu"
<resource: #menu>
^#(#{UI.Menu} #(
#(#{UI.MenuItem}
#rawLabel: '&Output Debug Report'
#nameKey: #reportStack
#value: #reportStack ) ) #(1 ) nil ) decodeAsLiteralArray
CraftedSmalltalk.DebuggerClient actions
reportStack
(DebugReport.DRReporter on: service) outputHtmlReport
CraftedSmalltalk.DebuggerClient menus
addReportMenuOn: aMenu
| item |
item := MenuItem labeled: '&Report'.
item nameKey: #reportMenu.
aMenu addItem: item.
(aMenu atNameKey: #reportMenu) submenu: [self reportMenu]
setupMenuBarMenu: aMenu
(aMenu atNameKey: #stackMenu) submenu: [self stackMenu].
(aMenu atNameKey: #editMenu) submenu: self editMenu.
(aMenu atNameKey: #executeMenu) submenu: [self executeMenu].
self setQuerySubmenuBlocksIn: aMenu.
self setVisibilityForStoreCommandsIn: aMenu.
self addReportMenuOn: aMenu.
reportMenu
^self class reportMenu
CraftedSmalltalk.DebuggerService class instance creation - compatibility
openContext: haltContext label: aString proceedable: aBoolean interrupted: interrupted
"Create and schedule an instance of me viewing a Debugger on haltContext.
The view will be labeled with aString, and will show a short sender stack."
| displayPoint contentsString dbr |
self prepareForDebugging.
contentsString := self shortStackFor: haltContext ofSize: 5.
displayPoint := self getDisplayPoint.
thisContext unwindUpTo: haltContext.
dbr := self context: haltContext proceedable: aBoolean interrupted: interrupted.
Processor activeProcess
suspendResumable: false
do: [:proc |
DebugReport.DRSettings logContextAutomatically
ifTrue: [(DebugReport.DRReporter on: dbr) outputHtmlReportSilently].
self openDebugger: dbr
contents: contentsString
label: aString
proceed: aBoolean
displayAt: displayPoint.
self enableWindowsIfNotEventFaithfulFor: proc].
openDebugger: aDebugger contents: aString1 label: aString2 proceed: mayProceed displayAt: aPoint
| box text y builder label actions specs width height copyStack correctIt baseFraction defineIt report |
self prepareForDebugging.
Processor activeProcess priority: Processor userSchedulingPriority.
self logErrorFor: aDebugger label: aString2.
aDebugger prepareForErrorCondition.
builder := UIBuilder new.
builder windowOn: aDebugger label: (#Exception << #pdp >> 'Exception').
aDebugger label: aString2.
text := (self limitString: aString2 lengthTo: 200 andLinesTo: 5) asText.
text emphasizeFrom: 1 to: text size with:
(Screen default colorDepth < 4
ifTrue: [#bold]
ifFalse: [Array with: #bold with: #color->(ColorValue red: 0.8 green: 0 blue: 0)]).
text := ComposedText withText: text style: nil compositionWidth: 250.
y := text bounds height // 2 max: 16.
label := LabelSpec new hasCharacterOrientedLabel: false.
label setLabel: builder policy alertIcon.
label layout: (AlignmentOrigin new
leftOffset: 48; topOffset: y+16;
leftAlignmentFraction: 1;
topAlignmentFraction: 0.5).
builder add: label.
label := LabelSpec new hasCharacterOrientedLabel: false.
label setLabel: text.
label layout: (AlignmentOrigin new
leftOffset: 56; topOffset: y+16;
leftAlignmentFraction: 0;
topAlignmentFraction: 0.5).
y := y * 2 + 32.
builder add: label.
actions := OrderedCollection
with: (#Debug << #pdp >> 'Debug') ->
[self clientClass
openFullViewOn: aDebugger
label: aString2.
builder window model: nil.
builder window controller close]
with: (#Proceed << #pdp >> 'Proceed') -> [aDebugger basicProceed.
builder window controller close.
self resyncEvents]
with: (#Terminate << #pdp >> 'Terminate') -> [aDebugger terminate.
builder window controller close.
self resyncEvents].
specs := OrderedCollection new.
1 to: actions size do:
[:i | | action |
action := actions at: i.
specs add: (ActionButtonSpec
model: action value
label: action key
layout: (LayoutFrame new
leftFraction: i-1/actions size;
rightFraction: i / actions size;
topOffset: y;
bottomOffset: y)).
specs last defaultable: true.
action key = (#Debug << #pdp >> 'Debug')
ifTrue:
[specs last isDefault: true.
builder add: specs last.
builder keyboardProcessor setActive: builder wrapper widget controller]
ifFalse: [builder add: specs last].
(action key = (#Proceed << #pdp >> 'Proceed') and: [mayProceed not])
ifTrue: [builder wrapper disable]].
y := y + builder wrapper preferredBounds height.
specs do:
[:spec |
spec layout bottomOffset: y].
baseFraction := actions size - 1 / 2 / actions size.
copyStack := (ActionButtonSpec
model: [ParagraphEditor currentSelection: aDebugger stackForCopy asText]
label: (#CopyStack << #pdp >> 'Copy Stack')
layout: (LayoutFrame new
leftFraction: baseFraction;
rightFraction: baseFraction + (1/actions size);
topOffset: y;
bottomOffset: y + builder wrapper preferredBounds height)).
copyStack defaultable: true.
builder add: copyStack.
(aDebugger interruptedContext ~~ nil
and: [aDebugger canDefineMethod]) ifTrue:
[aDebugger interruptedContext selector == #doesNotUnderstand: ifTrue:
[correctIt := (ActionButtonSpec
model: [aDebugger correctSpelling.
builder window controller close.
self resyncEvents]
label: (#CorrectItDots << #pdp >> 'Correct it...')
layout: (LayoutFrame new
leftFraction: baseFraction + (1/actions size);
rightFraction: baseFraction + (2/actions size);
topOffset: y;
bottomOffset: y + builder wrapper preferredBounds height)).
correctIt defaultable: true.
builder add: correctIt].
defineIt := (ActionButtonSpec
model:
[aDebugger defineMethodStubAndAdvance.
builder window model: nil.
builder window controller close.
self resyncEvents]
label: (#DefineItDot << #dialogs >> 'Define it...')
layout: (LayoutFrame new
leftFraction: baseFraction - (1/actions size);
rightFraction: baseFraction;
topOffset: y;
bottomOffset: y + builder wrapper preferredBounds height)).
defineIt defaultable: true.
builder add: defineIt].
y := y + builder wrapper preferredBounds height.
report := (ActionButtonSpec
model:
[(DebugReport.DRReporter on: aDebugger) outputHtmlReport]
label: ('Report')
layout: (LayoutFrame new
leftFraction: baseFraction - (1/actions size);
rightFraction: baseFraction;
topOffset: y ;
bottomOffset: y + builder wrapper preferredBounds height)).
report defaultable: true.
builder add: report.
y := y + builder wrapper preferredBounds height.
label := LabelSpec new hasCharacterOrientedLabel: false.
label setLabel: aString1 asComposedText.
label layout: (AlignmentOrigin new
leftFraction: 0.5 offset: 0;
topFraction: 0.5 offset: y // 2;
leftAlignmentFraction: 0.5;
topAlignmentFraction: 0.5).
builder add: label.
width := 320 max: label getLabel bounds width+12.
height := y + label getLabel bounds height + 6.
box := 0@0 corner: width@height.
box := box align: box center with: aPoint.
builder openIn: box.
CraftedSmalltalk.DebuggerService class private - instance creation
openOn: aContext exception: anException interrupted: aBoolean
| service |
self prepareForDebugging.
thisContext unwindUpTo: aContext.
service := self context: aContext proceedable: true interrupted: aBoolean.
service prepareForErrorCondition.
service label: anException description.
Processor activeProcess
suspendResumable: false
do: [:proc |
(DebugReport.DRSettings shouldLogAutomaticaly: anException)
ifTrue: [(DebugReport.DRReporter on: service) outputHtmlReportSilently].
self clientClass openFullViewOn: service label: anException description.
self enableWindowsIfNotEventFaithfulFor: proc]
CraftedSmalltalk.DebuggerService accessing
processHandle
^ processHandle
Core.EncodedStream accessing
nextLittleEndianNumber: n put: value
self stream nextLittleEndianNumber: n put: value
ZipArchive private
writeEndOfCentralDirectoryTo: aStream
aStream nextPutAll: EndOfCentralDirectorySignature asByteArray.
aStream nextLittleEndianNumber: 2 put: 0. "diskNumber"
aStream nextLittleEndianNumber: 2 put: 0. "diskNumberWithStartOfCentralDirectory"
aStream nextLittleEndianNumber: 2 put: members size. "numberOfCentralDirectoriesOnThisDisk"
aStream nextLittleEndianNumber: 2 put: members size. "numberOfCentralDirectories"
aStream nextLittleEndianNumber: 4 put: writeEOCDOffset - writeCentralDirectoryOffset. "size of central dir"
aStream nextLittleEndianNumber: 4 put: writeCentralDirectoryOffset. "offset of central dir"
aStream nextLittleEndianNumber: 2 put: zipFileComment size. "zip file comment"
zipFileComment isEmpty ifFalse: [ aStream nextPutAll: zipFileComment ].
Core.Date printing
yyyymmddString
| aStream |
aStream := WriteStream on: String new.
self year printOn: aStream paddedWith: $0 to: 4 base: 10.
self monthIndex printOn: aStream paddedWith: $0 to: 2 base: 10.
self dayOfMonth printOn: aStream paddedWith: $0 to: 2 base: 10.
^aStream contents
Core.Time printing
hhmmssString
| aStream |
aStream := WriteStream on: String new.
self hours printOn: aStream paddedWith: $0 to: 2 base: 10.
self minutes printOn: aStream paddedWith: $0 to: 2 base: 10.
self seconds printOn: aStream paddedWith: $0 to: 2 base: 10.
^aStream contents
DebugReport.DRSettings