’From Smalltalk 5.5k XM November 24 on 22 November 1980 at 2:57:08 am.’
"CodePane"
Class new title: ’CodePane’
subclassof: Window
fields: ’pared class selector selectorPane scrollBar’
declare: ’editmenu ’;
asFollows
I am a Window for editing a paragraph which may include Smalltalk source code. My selectorPane (not necessarily of class SelectorPane, and possibly even myself) compiles and doits for me.
Initialization
class: class selector: selector para: para
classInit
[editmenu ← Menu new string:
’again
copy
cut
paste
doit
compile
undo
cancel
align’]
from: selectorPane
init
showing: paragraph
[pared ← ParagraphEditor new para: paragraph asParagraph frame: nil.
pared formerly: false; fixframe: frame.
self windowenter.
scrollBar ← ([scrollBar≡nil⇒ [ScrollBar new] scrollBar]) on: frame from: pared]
Window protocol
close
[pared unselect. selectorPane ← pared ← nil. scrollBar close]
doit | s val d [
d ← [user leftShiftKey⇒ [mem◦067] false].
[d⇒ [mem◦067 ← 58]].
scrollBar hide.
"do automatic selection (ESC) on empty selections"
[(s ← pared selectRange) empty⇒ [
pared unselect; fintype; complement.
s ← pared selectRange]].
val ← selectorPane execute: pared selectionAsStream for: self.
[val≡nil or⦂ s ≠ pared selectRange⇒ ["result is nil or error occurred"]
"automatically paste result"
s← s stop+1.
pared Scrap ← [(String new: 100) asStream
space; print: val; contents asParagraph];
selectRange: (s to: s); paste].
scrollBar show.
d⇒ [mem◦067 ← d]
]
eachtime [
user kbck⇒ [⇑self kbd]
frame has: user mp⇒ [
user anybug⇒ [
user redbug⇒ [⇑self redbug]
user yellowbug⇒ [⇑self yellowbug]
user bluebug⇒ [⇑false]]
user anykeys⇒ [⇑self keyset]]
⇑self outside]
enter
[scrollBar show]
frame ← frame
["Change my frame and that of my pared (if any)."
pared≡nil⇒ [] pared frame ← frame.
scrollBar on: frame from: pared]
hardcopy: pf [
"if this is just part of a CodeWindow, then print entire Paragraph with no frame.
unfortunately, the test for this is a kludge. otherwise, print clipped"
selectorPane ≡ self⇒ [(PressPrinter init) press: pf; print: pared contents]
frame hardcopy: pf thickness: 1.
pared hardcopy: pf]
kbd
[pared typing]
keyset
[⇑pared keyset]
leave
[scrollBar hide]
outline
[frame outline: 1]
outside
[⇑scrollBar startup]
picked
[⇑frame has: user mp]
redbug
[⇑pared selecting]
show
[frame outline. pared show]
windowenter
[self outline. pared enter]
windowleave
[pared≡nil⇒[] pared leave]
yellowbug
[editmenu bug
=5⇒[self doit];
=1⇒[scrollBar hidewhile⦂ [pared again]];
=2⇒[pared copy];
=3⇒[pared cut];
=4⇒[pared paste];
=6⇒[pared formerly⇒
[scrollBar hidewhile⦂ [selectorPane compile: pared contents⇒ [pared formerly: false]]]
frame flash];
=7⇒[pared undo];
=8⇒[pared formerly⇒ [
pared Deletion ← pared contents.
scrollBar hidewhile⦂ [self showing: pared formerly]] frame flash];
=9⇒[pared realign]]
Browse/Notify protocol
compile: parag "as my own selectorPane"
[⇑self compile: parag in: class under: ’As yet unclassified’]
compile: parag in: defaultClass under: category
[⇑Generator new
compile: parag
in: [class≡nil⇒ [defaultClass] class]
under: category
notifying: self]
contents
[⇑pared contents]
dirty
[pared formerly⇒ [⇑frame] ⇑false]
execute: parseStream for: codePane "as my own selectorPane"
[⇑self execute: parseStream in: false to: nil]
execute: parseStream in: context to: receiver
[⇑Generator new evaluate: parseStream in: context to: receiver notifying: self]
formerly: oldpara "should not be called before ’showing:’"
[pared formerly: oldpara]
interactive
[⇑true]
notify: errorString at: position in: stream
[pared
fintype;
selectRange: (position to: position);
replace: (’➲’ + errorString + ’➲.’) asParagraph;
selectAndScroll.
⇑false]
oldContents
[⇑pared formerly]
reflects: selection "am I trying to show the code of selectorPaneⓢ selection?"
[⇑class≡nil and⦂ selection>0]
selectRange: r [pared selectRange: r; selectAndScroll]
SystemOrganization classify: ↪CodePane under: ’Panes and Menus’.
CodePane classInit
"FilePane"
Class new title: ’FilePane’
subclassof: CodePane
fields: ’file’
declare: ’editmenu ’;
asFollows
This class has not yet been commented
As yet unclassified
classInit "FilePane classInit."
[editmenu ← Menu new string:
’again
copy
cut
paste
doit
put
undo
get
align’]
file: file
yellowbug
[editmenu bug
=1⇒[pared again];
=2⇒[pared copy];
=3⇒[pared cut];
=4⇒[pared paste];
=5⇒[self doit];
=6⇒[pared formerly⇒ [user displayoffwhile⦂ [
file readwriteshorten; reset; append: pared contents; close.
pared formerly: false]]
frame flash];
=7⇒[pared undo];
=8⇒[user displayoffwhile⦂ [scrollBar hidewhile⦂
[self showing: file contents asParagraph]]];
=9⇒[pared realign]]
SystemOrganization classify: ↪FilePane under: ’Panes and Menus’.
FilePane classInit
"ListPane"
Class new title: ’ListPane’
subclassof: Textframe
fields: ’list firstShown lastShown selection scrollBar’
declare: ’’;
asFollows
A list pane displays a vertical list of one-line items. The list can be scrolled slow or fast, and any item can be selected. When an item is selected (or deselected), a dependent pane can be told to display appropriate material.
Initialization
of: list "Acquire the specified list and show me scrolled to the top"
[firstShown← selection← 0.
self frame← window.
self fill; deselected]
revise: newlist with: sel | changing
["Acquire newlist. Do not change firstShown. Select sel if in list."
[changing ← list≠newlist⇒
[list ← newlist.
firstShown ← firstShown min: (
list length+2 - (window height-4/self lineheight) max: 0).
[nil ≠ para⇒ [para ← para asStream]].
self fill]
selection>0⇒ [changing ← list◦selection≠sel⇒ [self compselection]]
changing ← true].
changing⇒ [selection ← ¬1. self select: (list find: sel)]]
select: lineNum | oldSel
["Select my non-dummy displayed entry whose subscript is lineNum; highlight it; if it is different from selection, tell me to select. If there is no such entry, set selection to 0 and if it wasnt 0 before, tell me to deselect."
oldSel ← selection.
(1 max: firstShown) ≤ lineNum and⦂ lineNum ≤ (list length min: lastShown)⇒
[selection ← lineNum. self compselection. oldSel≠selection⇒ [self selected]]
selection ← 0. oldSel≠selection⇒ [self deselected]]
Pane protocol
close "Zero my selection so it wont be grayed when I close. Break cycles."
[selection←0. scrollBar close]
eachtime
[window has: user mp⇒
[user kbck⇒[⇑self kbd]
user anybug⇒
[user redbug⇒[⇑self redbug]
user yellowbug⇒[⇑self yellowbug]
user bluebug⇒[⇑false]]
user anykeys⇒[⇑self keyset]]
⇑self outside]
enter
[scrollBar show]
firsttime
[window has: user mp⇒[self enter]
⇑false]
frame ← window "(Re)initialize my window"
[para ← nil.
scrollBar ← ([scrollBar≡nil⇒ [ScrollBar new] scrollBar]) on: window from: self]
hardcopy: pf | t cr first last lasty lineNum parag left right lineheight [
window hardcopy: pf thickness: 1.
[para≡nil⇒ [self makeParagraph]].
parag ← para asParagraph.
t ← para asStream.
last ← 0.
cr ← 015.
left ← frame minX.
right ← window maxX.
lasty ← frame minY.
lineheight ← self lineheight.
for⦂ lineNum from: firstShown to: lastShown do⦂ [
first ← last.
[(t skipTo: cr) or⦂ lineNum = lastShown⇒ [last ← t position]
user notify: ’not enough lines’].
[lineNum = selection and⦂ selection > 0⇒ [
"outline selection; complementing doesn’t look good"
(self selectionRect-(0⌾1) inset: 0⌾1) hardcopy: pf thickness: 1]].
(parag copy: first+1 to: last-1) presson: pf in:
(pf transrect: (left ⌾ lasty rect: right ⌾ (lasty+lineheight+4))) style: style.
lasty ← lasty + lineheight.
]]
kbd
[window flash. user kbd.]
keyset | c
["As long as any keyset keys are down, react to keys 2 and 8 down by scrolling up or down a line at a time. If key 4 is down as well, scroll faster."
c ← user currentCursor.
self scrollControl⦂ [user keyset=6⇒[2]; =12⇒[¬2]; =2⇒[1]; =8⇒[¬1] 0].
c show]
lasttime
[self leave]
leave
[scrollBar hide]
outline
[window outline: 1]
outside [⇑scrollBar startup]
picked
[⇑window has: user mp]
redbug | newSel f "Deselect selection and select cursor item, if any"
[[f ← self locked⇒ []
self compselection.
newSel ← (user mp y - window origin y)/self lineheight + firstShown.
XeqCursor showwhile⦂ [self select: [newSel = selection⇒ [0] newSel]]].
while⦂ (user redbug and⦂ (window has: user mp)) do⦂ [
f⇒ [f flash. self compselection; compselection]]]
scrollPos
[firstShown≡nil or⦂ list length=0⇒[⇑0.0]
⇑firstShown asFloat/list length]
scrollTo: f | t
[self scrollControl⦂
[t← (f*list length) asInteger - firstShown.
t<0⇒[firstShown<0⇒[0] t]
lastShown>list length⇒[0] t]]
windowenter "Refresh my image. Reaffirm selection."
[self outline; fill; select: selection.]
windowleave
[self compselection; grayselection]
yellowbug
[window flash]
Subclass defaults
deselected "I just lost my selection. I dont care, but my subclasses might."
dirty "My subclasses may want to prohibit a change of selection"
[⇑false]
locked "My subclasses may want to prohibit a change of selection"
[⇑[selection=0⇒ [false] self dirty]]
selected "A new selection is highlighted. I dont care, but my subclasses might"
Private
compselection "If I have a selection, complement its image."
[selection≠0⇒ [self selectionRect comp]]
dummy
[⇑’▱▱▱▱▱▱▱’]
fill [self makeParagraph; show]
grayselection
[selection≠0⇒ [self selectionRect color: ltgray mode: oring]]
init
[self para: nil frame: nil.]
makeParagraph | i len s lines "Given firstShown, compute lastShown."
[
len ← list length.
lastShown ← firstShown-1 + (lines ← window height-4/self lineheight)
min: 1+len.
[self locked⇒
[i ← (selection-lastShown max: 0) + (selection-firstShown min: 0).
i≠0⇒ [para←nil. firstShown ← firstShown + i. lastShown ← lastShown + i]]].
(frame ← window inset: 2) width ← 999.
para is: String⇒ ["if para is a String, refresh from it directly"]
"otherwise compute para."
s ← [para≡nil⇒ [(String new: 200) asStream] para].
for⦂ i from: firstShown to: lastShown do⦂ [
[0<i and⦂ i≤len⇒ [lines ← lines-1. (list◦i) printon: s]
s append: self dummy].
s cr].
for⦂ i to: (lines+1 min: s limit - s position) do⦂ [s cr].
para ← s asArray]
scrollBy⦂ expr copying: src into: dest showing: item in: frame direction: n
| strm final stop pt delay chars locked t
[strm ← Stream new. chars ← 2*frame width/self lineheight. para ← String new: chars.
pt ← dest origin. final ← [n<0⇒ [0] list length+1].
stop ← [locked←self locked⇒ [0 max: (list length+1 min: (lastShown - firstShown * n sign + selection))] final].
while⦂ item≠stop do⦂
[firstShown ← firstShown + n. lastShown ← lastShown + n. item ← item + n.
strm of: para from: 1 to: chars.
[item≠final⇒ [(list◦item) printon: strm] self dummy copyto: strm].
strm cr. src blt: pt mode: storing. self show.
(t← expr eval) abs ≤1⇒ [for⦂ delay to: chars/4 do⦂ [strm myend]. para ← nil. ⇑self]
t*n<0⇒[⇑self]].
para ← nil. locked and: stop≠final⇒ [locked flash. ⇑false]]
scrollControl⦂ expr
| dY onlyFirst butFirst onlyLast butLast x1 x2 y1 y2 y3 y4 k
["Selection is highlighted. Unhighlight it. Invalidate my saved para if I scroll. Then reselect selection, or deselect if it is no longer displayed."
self compselection. dY ← self lineheight.
x1 ← window origin x. x2 ← window corner x.
y1 ← window origin y+2. y4 ← window height-4 |dY + y1. y2←y1+dY. y3←y4-dY.
onlyFirst ← x1+2⌾y1 rect: 2000⌾y2. butFirst ← x1⌾y2 rect: x2⌾y4.
onlyLast ← x1+2⌾y3 rect: 2000⌾y4. butLast ← x1⌾y1 rect: x2⌾y3.
while⦂ (k←expr eval)≠0 do⦂
[k>0⇒[UpCursor topage1.
self scrollBy⦂ expr eval copying: butFirst into: butLast showing: lastShown
in: onlyLast direction: 1⇒[] ⇑self select: selection]
DownCursor topage1.
self scrollBy⦂ expr eval copying: butLast into: butFirst showing: firstShown
in: onlyFirst direction: ¬1⇒[] ⇑self select: selection].
self select: selection]
scrollUp: n | c
[c ← window origin x-20.
self scrollControl⦂
[user buttons=4⇒
[user mp x > c⇒[2] ¬2]
0]]
selectionRect | h w
["I have a selection. Return its highlighting rectangle."
(w ← window inset: 2) height ← h ← self lineheight.
⇑w + (0⌾(selection-firstShown *h))]
SystemOrganization classify: ↪ListPane under: ’Panes and Menus’.
"ClassPane"
Class new title: ’ClassPane’
subclassof: ListPane
fields: ’systemPane organizationPane’
declare: ’editmenu ’;
asFollows
I am a list pane that displays the names of all the classes of a category
Initialization
classInit
[editmenu ← Menu new string: ’filout
print
forget’]
from: systemPane to: organizationPane
Window protocol
close
[systemPane ← nil. super close]
yellowbug
["If there is a selection, let the user choose a command from the menu."
selection=0⇒ [window flash]
editmenu bug
=1⇒ ["filout" (Smalltalk◦(list◦selection)) filout];
=2⇒ ["print" (Smalltalk◦(list◦selection)) printout];
=3⇒ ["forget" systemPane forget: list◦selection]]
ListPane protocol
deselected
["I just lost my selection. Tell organizationPane to display nothing."
organizationPane class: nil.]
selected
["My selection just changed. Tell organizationPane to display the categories of my newly selected Class."
organizationPane class: Smalltalk◦(list◦selection).]
Browser protocol
compile: parag
[systemPane compile: parag]
dirty
[⇑organizationPane dirty]
noCode
[selection=0⇒ [⇑systemPane noCode] ⇑’’]
SystemOrganization classify: ↪ClassPane under: ’Panes and Menus’.
ClassPane classInit
"Menu"
Class new title: ’Menu’
subclassof: Object
fields: ’str text thisline frame’
declare: ’’;
asFollows
I am a list of text lines one of which can be selected with the pointing device
Initialization
rescan " | each. Menu allInstances notNil transform⦂ each to⦂ each rescan."
[self string: str] "rescan (for new fonts, lineheight)"
string: str | i pt tpara
[[str last≠13⇒[str←str+’
’]]. "make sure str ends with CR"
text ← Textframe new para: (tpara ← str asParagraph)
frame: (Rectangle new origin: (pt ← 0 ⌾ 0)
corner: 1000 ⌾ 1000).
pt ← text maxx: str length+1.
text frame growto: pt + (4 ⌾ 0).
tpara center.
frame ← text frame inset: ¬2 ⌾ ¬2.
thisline ← Rectangle new origin: text frame origin
corner: text frame corner x ⌾ text lineheight]
stringFromVector: v | s
["DW classInit"
s ← Stream default.
for⦂ v from: v do⦂ [s append: v; cr].
self string: s contents]
User interactions
bug | index bits
[bits ← self movingsetup. "set up and save background"
index ← self bugit. "get the index"
frame bitsFromString: bits. "restore background"
⇑ index "return index"
]
clear
[frame clear]
fbug | index
[ "for fixed menus"
index ← self bugit. "get the index"
⇑ index "return index"
]
frame
[⇑ frame]
has: pt
[⇑ text frame has: pt]
moveto: pt
[self clear.
frame moveto: pt.
text frame moveto: pt+2.
thisline moveto: pt+2.
]
rebug
[user waitbug. "wait for button down again"
⇑"bugcursor showwhile⦂" self bug]
show
[frame clear: black. text show.]
wbug | index bits [
"save background, display menu"
bits ← self movingsetup.
"wait until a mouse button is down"
until⦂ user anybug do⦂ [].
"get selection (possibly 0)"
index ← self bugit.
"restore background"
frame bitsFromString: bits.
⇑ index
]
zbug | index bits
[bits ← self movingsetup.
while⦂ (index ← self bugit) = 0 do⦂ [].
frame bitsFromString: bits.
⇑ index
]
Internal
bugit | pt bits
[user nobug ⇒
[⇑0] "accidental bug returns 0"
thisline comp.
while⦂ true do⦂
[text frame has: (pt ← user mp) ⇒
[user anybug⇒
[thisline has: pt⇒[]
pt ← text ptofpt: pt.
thisline comp. "selection follows mouse"
thisline moveto: text frame origin x ⌾ pt y.
thisline comp]
⇑1+ (thisline origin y-text frame origin y
/ text lineheight) "return index"
]
thisline comp. "he left the menu"
until⦂ [text frame has: user mp] do⦂
[user nobug⇒[⇑0]] "return 0 for abort"
thisline comp] "he came back"
]
movingsetup | pt bits
[pt ← user mp - thisline center. "center prev item on mouse"
text frame moveby: pt. thisline moveby: pt.
frame moveby: pt.
bits ← frame bitsIntoString. "save background"
frame clear: black. text show.
⇑ bits
]
SystemOrganization classify: ↪Menu under: ’Panes and Menus’.
"OrganizationPane"
Class new title: ’OrganizationPane’
subclassof: ListPane
fields: ’classPane selectorPane class’
declare: ’editmenu ’;
asFollows
I am a list pane that displays the selector categories of a class.
Initialization
class: class
[self of: (self listFor: class)]
classInit
[editmenu ← Menu new string: ’filout
print’]
from: classPane to: selectorPane
listFor: class
[⇑[class≡nil⇒ [Vector new: 0]
↪(ClassDefinition ClassOrganization) concat: class organization categories]]
Window protocol
close
[classPane ← nil. super close]
yellowbug
["If there is a selection, let the user choose a command from the menu."
selection≤1⇒ [window flash] "Can’t filout or print definition by itself"
editmenu bug
=1⇒ ["filout the selected category"
selection=2⇒ [class filoutOrganization]
class filoutCategory: list◦selection];
=2⇒ ["print the selected category"
selection=2⇒ [window flash] "Can’t print organization"
class printoutCategory: list◦selection]
]
ListPane protocol
deselected
["I just lost my selection. Tell selectorPane to display nothing."
selectorPane of: (Vector new: 0)]
selected
[selectorPane of: [selection≤2⇒ [Vector new: 0] class organization category: list◦selection]]
Browser protocol
code: selector
[⇑class code: selector]
compile: parag
| sel cat
[class≡nil or⦂ selection=1⇒ [classPane compile: parag] "new definition"
selection=2⇒ [class organization fromParagraph: parag. self class: class] "new organization"
cat ← [selection=0⇒ [’As yet unclassified’] list◦selection].
sel ← selectorPane compile: parag in: class under: cat⇒
[self revise: (self listFor: class) with: cat.
selection≠0⇒ [selectorPane revise: (class organization category: cat) with: sel]]
⇑false]
dirty
[⇑selectorPane dirty]
execute: parag
[⇑classⓢ parag]
forget: selector | cat
[class derstands: selector.
cat ← list◦selection.
self revise: (self listFor: class) with: cat.
selection>0⇒
[selectorPane revise: (class organization category: cat) with: selector]]
noCode
[class≡nil⇒ [⇑classPane noCode]
selection=0⇒ [⇑’’]; =1⇒ [⇑class definition]; =2⇒ [⇑class organization]
⇑’Message name and Arguments | Temporary variables "short comment"
["long comment if necessary"
Smalltalk
Statements]’]
spawn: selector with: parag formerly: oldparag
[selectorPane compselection; select: 0.
class edit: selector para: parag formerly: oldparag]
SystemOrganization classify: ↪OrganizationPane under: ’Panes and Menus’.
OrganizationPane classInit
"ScrollBar"
Class new title: ’ScrollBar’
subclassof: Object
fields: ’rect bitstr owner position’
declare: ’DownCursor UpCursor JumpCursor ’;
asFollows
I am a bar to the left of an awake window. With the cursor in me I can make that window scroll.
Initialization
classInit
[UpCursor ← Cursor new fromtext: ’
1000000000000000
1100000000000000
1110000000000000
1111000000000000
1111100000000000
1111110000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000’.
DownCursor ← Cursor new fromtext: ’
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1111110000000000
1111100000000000
1111000000000000
1110000000000000
1100000000000000
1000000000000000’.
JumpCursor ← Cursor new fromtext: ’
0111000000000000
1111100000000000
1111100000000000
0111000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000’ offset: 2⌾1]
on: f from: o
[self on: f from: o at: o scrollPos]
on: frame from: owner at: f
[rect ← Rectangle new
origin: frame origin-(32⌾2)
extent: 32⌾(frame height+4).
position ← Rectangle new
origin: rect origin+(9⌾4)
extent: 16⌾8.
self boxPosition← f]
Scheduling
close
[owner←nil]
eachtime | p cx r "This needs to be restructured"
[rect has: (p← user mp)⇒
[cx ← rect center x - 2.
p x < cx⇒
[r ← Rectangle new origin: rect origin corner: cx⌾rect maxY.
DownCursor showwhile⦂
[while⦂ (r has: (p←user mp)) do⦂
[self slide: p⇒[owner scrollTo: (position minY-rect minY-4) asFloat/(rect height-12)]
user redbug⇒[self reposition⦂[owner scrollUp: rect origin y - p y]]]]]
r ← Rectangle new origin: cx⌾rect minY corner: rect corner.
UpCursor showwhile⦂
[while⦂ (r has: (p←user mp)) do⦂
[self slide: p⇒[owner scrollTo: (position minY-rect minY-4) asFloat/(rect height-12)]
user redbug⇒[self reposition⦂[owner scrollUp: p y - rect origin y]]]]]
⇑false]
firsttime
[⇑rect has: user mp]
lasttime
slide: p | bug
[position has: p⇒
[JumpCursor showwhile⦂
[bug ← false.
while⦂ ((position has: user mp) and⦂ bug≡false) do⦂
[user redbug⇒
[bug ← true.
while⦂ user redbug do⦂
[self reshow⦂
[position moveto: position origin x⌾
((user mp y max: rect origin y+4) min: rect corner y-12)]]]]].
⇑bug]
⇑false]
Image
boxPosition← f
[position moveto: rect origin+
(9⌾(4+(([f<0.0⇒[0.0]; >1.0⇒[1.0] f])*(rect height-16))))]
hide "restore background"
[bitstr≡nil⇒ [user notify: ’Attempt to hide unshown scrollbar’]
rect bitsFromString: bitstr.
bitstr ← nil]
hidewhile⦂ expr | v
[self hide. v ← expr eval. self show. ⇑v]
reposition⦂ expr
[self reshow⦂
[expr eval. self boxPosition← owner scrollPos]]
reshow⦂ expr | r
[r ← position inset: ¬2. expr eval.
r clear: white. position outline]
show "Save background and turn gray"
[bitstr ← rect bitsIntoString.
rect clear: black.
(rect inset: 2⌾2 and: 1⌾2) clear: white.
position outline]
SystemOrganization classify: ↪ScrollBar under: ’Panes and Menus’.
ScrollBar classInit
"SelectorPane"
Class new title: ’SelectorPane’
subclassof: ListPane
fields: ’organizationPane codePane’
declare: ’editmenu ’;
asFollows
I am a ListPane whose entries are the message selectors of a category within a class. Only organizationPane knows what the class and category are. I make codePane display the code of my selected selector, if any.
Initialization
classInit
[editmenu ← Menu new string:
’spawn
forget’]
from: organizationPane to: codePane
Window protocol
close
[organizationPane ← nil. super close]
yellowbug
[selection=0⇒ [window flash]
scrollBar hidewhile⦂
[editmenu bug
=1⇒ [organizationPane spawn: list◦selection with: codePane contents
formerly: codePane oldContents];
=2⇒ [organizationPane forget: list◦selection]]]
ListPane protocol
deselected
[codePane showing: organizationPane noCode]
selected
[codePane showing: (organizationPane code: list◦selection)]
Browser protocol
compile: parag
[⇑organizationPane compile: parag]
compile: parag in: class under: heading
[⇑codePane compile: parag in: class under: heading]
dirty
[⇑codePane dirty]
execute: parseStream for: codePane
[⇑codePane execute: parseStream in: false to: nil]
SystemOrganization classify: ↪SelectorPane under: ’Panes and Menus’.
SelectorPane classInit
"StackPane"
Class new title: ’StackPane’
subclassof: ListPane
fields: ’contextVarPane instanceVarPane codePane variables proceed’
declare: ’stackmenu ’;
asFollows
I am a list pane that displays one or all of the stack below a context in a notify window.
Initialization
classInit
[stackmenu ← Menu new string:
’stack
spawn
proceed
restart’]
context: contextVarPane at: level instance: instanceVarPane code: codePane
[variables ← (Vector new: 16) asStream.
proceed≡nil⇒[proceed ← (false, nil, level)]]
context: contextVarPane instance: instanceVarPane code: codePane
[variables ← (Vector new: 16) asStream.
proceed≡nil⇒[proceed ← (false, nil, Top currentPriority)]]
interrupt: flag
[proceed◦1 ← flag]
Window protocol
close
[Top enable: proceed◦3. super close. list⇒ [(list◦1) releaseFully]]
yellowbug
[scrollBar hidewhile⦂
[stackmenu bug
=1⇒ ["show a full backtrace"
self revise: (list◦1) stack with: [selection=0⇒ [nil] list◦selection]];
=2⇒ ["spawn a code editor" self spawn];
=3⇒ ["return to selected context" self continue: false];
=4⇒ ["restart selected context" self continue: true]]]
ListPane protocol
deselected
[contextVarPane ≡ false⇒ []
codePane showing: ’’.
contextVarPane names: (Vector new: 0) values: ↪(nil) wrt: false.
instanceVarPane names: (Vector new: 0) values: ↪(nil) wrt: false]
locked
[⇑contextVarPane and⦂ (selection>0 and⦂ self dirty)]
selected | context instance code safeVec
[contextVarPane ≡ false⇒ []
context ← list◦selection. instance ← context receiver.
Decompiler new findPC: context pc.
code ← self code.
codePane showing: [code⇒ [code] ’’].
codePane selectRange: Decompiler new highlight.
variables reset. context variableNamesInto: self with: nil.
[code⇒
[contextVarPane names: (↪(thisContext) concat: variables contents)
values: (context, context tempframe) wrt: context.
context tempframe≡nil⇒ [user notify: ’NIL TEMPFRAME’]]
contextVarPane names: ↪(thisContext) values: context inVector wrt: context].
variables reset. instance class fieldNamesInto: self.
safeVec ← Vector new: 2. safeVec all ← instance.
instanceVarPane names: (↪(self) concat: variables contents) values: safeVec wrt: context.
contextVarPane select: 1]
NotifyWindow protocol
compile: parseStream | ctxt selector method mcl
[ctxt ← list◦(selection max: 1). mcl ← ctxt mclass.
proceed◦2 ← selector ←
codePane compile: parseStream in: mcl under: ’As yet unclassified’⇒
[codePane reflects: selection⇒
[method ← mcl md methodorfalse: selector⇒
[self releaseAboveSelection.
ctxt restartWith: method. proceed◦1 ← true.
self of: list◦(selection to: list length) copy; select: 1]]]]
dirty
[⇑codePane and⦂ codePane dirty]
execute: parseStream for: codePane
[⇑proceed◦2 ←
codePane execute: parseStream in: [selection=0⇒ [false] list◦selection] to: nil]
Private
code | mclass selector "code of my selected context"
[mclass ← (list ◦ selection) mclass.
selector ← self selector.
⇑(mclass canunderstand: selector) and⦂ (mclass code: selector)]
comment: s "called by selected via Class fieldNamesInto"
contents "called by selected via Class fieldNamesInto"
continue: restarting | ctxt
["Close my window and resume my selected context, if any, else my first context. If interrupted (proceed◦1) or restarting or a recompiled method, don’t return a value; otherwise, return proceed◦2."
[user leftShiftKey ⇒[mem◦067 ← 58 "turn display off"]].
[selection=0⇒ [selection←1]].
ctxt ← list◦selection.
self releaseAboveSelection. "release abandoned contexts"
[restarting⇒ [ctxt restart]
proceed◦1 and: selection=1⇒ ["resume after interrupt"]
ctxt push: proceed◦2].
list ← false. "Inhibit me closing." user topWindow vanish.
list ← nil.
[proceed◦3=1⇒[thisContext sender release]].
Top run: ctxt at: proceed◦3.
Top enable: proceed◦3.
Top wakeup: proceed◦3.
Top resetCurrent]
declaration: dummy1 name: string asArg: dummy2
[variables next ← string]
identifier: s "called by selected via Class fieldNamesInto"
[variables next ← s]
notify: msg "selected context doesnt know its variables"
releaseAboveSelection
[[selection>1⇒ [(list◦(selection-1)) sender ← nil. (list◦1) release"Fully"]].
(list◦(selection max: 1)) verifyFrames]
selector | context
[context ← list◦(selection max: 1).
⇑[context sender≡nil⇒ [false] context selector]]
separator: c "called by selected via Class fieldNamesInto"
spawn | mclass selector parag oldparag
[mclass ← (list◦(selection max: 1)) mclass.
selector ← self selector.
parag ← [codePane⇒ [codePane contents] mclass canunderstand: selector⇒ [mclass code: selector] ’’].
oldparag ← [codePane⇒ [codePane oldContents] false].
self compselection; select: 0.
mclass edit: selector para: parag formerly: oldparag]
terminate "called by parser close during initialization"
trailer: s "called by selected via Class fieldNamesInto"
SystemOrganization classify: ↪StackPane under: ’Panes and Menus’.
StackPane classInit
"SystemPane"
Class new title: ’SystemPane’
subclassof: ListPane
fields: ’mySysOrgVersion classPane’
declare: ’sysmenu ’;
asFollows
I am a list pane in which all the system categories are displayed.
Initialization
classInit
[sysmenu ← Menu new string: ’filout
print’]
to: classPane
update
[self of: (↪(AllClasses SystemOrganization) concat: SystemOrganization categories). mySysOrgVersion←user classNames]
Window protocol
enter "be sure I am up to date"
[mySysOrgVersion≡user classNames⇒ [super enter]
window outline. self update. super enter]
leave "I am up to date"
[mySysOrgVersion ← user classNames. super leave]
yellowbug
[selection<3⇒[window flash]
scrollBar hidewhile⦂
[sysmenu bug
=1⇒
[SystemOrganization filoutCategory: list◦selection];
=2⇒
[SystemOrganization printCategory: list◦selection]
]
]
ListPane protocol
deselected
[classPane of: (Vector new: 0)]
selected
[classPane of: self classes]
Browser protocol
classes "return a Vector of the classes in my selected category"
[selection =1⇒ [⇑user classNames];
≤2⇒ [⇑Vector new: 0]
⇑SystemOrganization category: list◦selection]
compile: parag
| class cat className
[selection=2⇒ [SystemOrganization fromParagraph: parag. self update] "new organization"
cat ← [selection≤1⇒ [false] list◦selection].
class ← nilⓢparag.
class Is: Class⇒
[className ← class title unique.
[cat⇒ [SystemOrganization classify: className under: cat]].
mySysOrgVersion≡user classNames⇒
[selection>0⇒
[classPane of: [cat⇒ [SystemOrganization category: cat] user classNames]]]
self update]]
dirty
[⇑classPane dirty]
forget: className
[user notify: ’Class ’+className+’ will disappear if you proceed...’.
(Smalltalk◦className) noChanges; obsolete. Smalltalk delete: className.
SystemOrganization delete: className.
AllClassNames ← AllClassNames delete: className.
classPane revise: self classes with: className]
noCode
[selection=0⇒ [⇑’’]; =2⇒ [⇑SystemOrganization]
⇑’Class new title: ’’NameOfClass’’
subclassof: Object
fields: ’’names of fields’’
declare: ’’names of class variables’’’ copy]
SystemOrganization classify: ↪SystemPane under: ’Panes and Menus’.
SystemPane classInit
"VariablePane"
Class new title: ’VariablePane’
subclassof: ListPane
fields: ’valuePane values context’
declare: ’varmenu ’;
asFollows
I am a list pane that displays the names of variables in a context or instance.
Initialization
classInit
[varmenu ← Menu new string: ’inspect’]
names: vars values: values wrt: context
[self of: vars]
to: valuePane
[]
Window protocol
yellowbug
[selection=0⇒ [window flash]
scrollBar hidewhile⦂ [varmenu bug =1⇒ [self value inspect]]]
ListPane protocol
deselected
[valuePane showing: ’’]
selected
[valuePane showing: self value asString]
Notify/Inspect protocol
compile: parag
[window flash. ⇑false]
execute: parseStream for: valuePane
[⇑valuePane execute: parseStream in: context to: values◦1]
Private
value
[selection=1⇒ [⇑values◦1] ⇑(values◦2) inspectfield: selection-1]
SystemOrganization classify: ↪VariablePane under: ’Panes and Menus’.
VariablePane classInit