CSegDebugInterface:
CEDAR PROGRAM
IMPORTS
Buttons, Containers, Convert, CSegDebugDefs, Labels, RESOut, Rope, Rules, SafeStorage, TypeScript, VFonts, ViewerIO, ViewerOps, ViewerTools
EXPORTS CSegDebugDefs =
BEGIN
OPEN CSegDebugDefs;
entryHeight: CARDINAL = 15; -- how tall to make each line of items
entryVSpace: CARDINAL = 2; -- vertical leading space between lines
entryHSpace: CARDINAL = 5; -- min horizontal space between items in a line
ROPE: TYPE = Rope.ROPE;
PromptRec: TYPE = RECORD [handle: CSegDebugDefs.Handle, cell: ViewerClasses.Viewer, radix: INT ← 8];
PromptHandle: TYPE = REF PromptRec;
CmdRec: TYPE = RECORD [handle: CSegDebugDefs.Handle, cmd: CSegDebugDefs.CmdIndex];
CmdHandle: TYPE = REF CmdRec;
MakeTool: Commander.CommandProc =
BEGIN
rule: Rules.Rule;
my: Handle ← NEW[DataRec];
my.en ← VFonts.CharWidth['n];
my.outer ← Containers.Create[[
-- construct the outer container
name: "CSegDebug", -- name displayed in the caption
iconic: TRUE, -- so tool will be iconic (small) when first created
column: left, -- initially in the left column
scrollable: FALSE ]]; -- inhibit user from scrolling contents
my.msg ← Labels.Create[ [
name: NIL,
wx: 0, wy: my.height,
wh: 2*entryHeight,
parent: my.outer,
border: FALSE]];
my.height ← my.height + 2*entryHeight + 2; -- interline spacing
Containers.ChildXBound[my.outer, my.msg];
rule ← Rules.Create [[parent: my.outer, wy: my.height, ww: my.outer.cw, wh: 2]];
Containers.ChildXBound[my.outer, rule];
MakeCommands[my];
rule ← Rules.Create [[parent: my.outer, wy: my.height, ww: my.outer.cw, wh: 2]];
Containers.ChildXBound[my.outer, rule];
my.height ← my.height + 2; -- interline spacing
MakeTypescript[my];
my.charsOnLine ← 0;
ViewerOps.PaintViewer[my.outer, all]; -- reflect above change
END;
MakeCommands:
PROC [handle: Handle] =
BEGIN
cmdy: INT ← handle.height + entryVSpace;
cmdx: INT ← 0;
col1: INT = 1;
col2: INT = col1 + 18;
col3: INT = col2 + 15;
col4: INT = col3 + 12;
col5: INT = col4 + 11;
NewLine:
PROC = {cmdy ← cmdy + entryHeight + entryVSpace; cmdx ← 0};
NextPlace:
PROC [at:
CARDINAL]
RETURNS [
CARDINAL] = {
pat: INT = at * handle.en;
cmdx ← MAX[cmdx, pat];
RETURN [cmdx]};
MakeCmd:
PROC [at:
CARDINAL, name:
ROPE, cmd: CSegDebugDefs.CmdIndex] = {
b: Cmd ← Buttons.Create[
info: [
name: Rope.Concat[name, "!"],
wx: NextPlace[at],
wy: cmdy,
-- default the width so that it will be computed for us
wh: entryHeight, -- specify rather than defaulting so line is uniform
parent: handle.outer,
border: FALSE],
proc: OtherCmd,
clientData: NEW [CmdRec ← [handle: handle, cmd: cmd]]];
cmdx ← cmdx + b.ww + entryHSpace};
MakeBool:
PROC [at:
CARDINAL, name:
ROPE, initial:
BOOL]
RETURNS [flag:
REF
BOOL] = {
b: Cmd;
flag ← NEW[BOOL ← initial];
b ← Buttons.Create[
info: [
name: name,
wx: NextPlace[at],
wy: cmdy,
-- default the width so that it will be computed for us
wh: entryHeight, -- specify rather than defaulting so line is uniform
parent: handle.outer,
border: FALSE],
proc: ToggleBool,
clientData: flag];
Buttons.SetDisplayStyle[
button: b,
style: IF initial THEN $WhiteOnBlack ELSE $BlackOnWhite];
cmdx ← cmdx + b.ww + entryHSpace};
NamedCell:
PROC [at:
CARDINAL, name:
ROPE, width:
CARDINAL, initial:
ROPE ←
NIL, radix:
INT ← 8]
RETURNS [v: ViewerClasses.Viewer] = {
ph: PromptHandle ← NEW[PromptRec ← [handle: handle, radix: radix, cell: NIL]];
b: Buttons.Button ← Buttons.Create[
info: [
name: Rope.Concat[name, ": "],
wx: NextPlace[at],
wy: cmdy,
wh: entryHeight,
parent: handle.outer,
border: FALSE],
proc: SimplePrompt,
clientData: ph];
cmdx ← cmdx + b.ww + entryHSpace;
v ← ViewerTools.MakeNewTextViewer[
info: [
wx: cmdx,
wy: cmdy,
ww: width*handle.en,
wh: entryHeight,
parent: handle.outer,
data: initial,
scrollable: FALSE,
border: FALSE]];
ph.cell ← v;
cmdx ← cmdx + v.ww + entryHSpace};
MakeCmd[col1, "gfi", gfi];
handle.cmd.gfVal ← NamedCell[col1+4, "gf", 8];
handle.cmd.bpcVal ← NamedCell[col2, "bpc", 7];
handle.cmd.nVal ← NamedCell[col3, "n", 4, "10", 10];
MakeCmd[col4, "code", code];
MakeCmd[col4+6, "oct", octal];
MakeCmd[col5, "prefix", prefix];
NewLine[];
MakeCmd[col1, "dspLf", dspLf];
MakeCmd[col1+6, "goLf", goLf];
MakeCmd[col2, "wpc", wpc];
MakeCmd[col2, "ep?", findEp];
MakeCmd[col2, "bkup", back];
handle.autoNext ← MakeBool[col3, "auto", TRUE];
MakeCmd[col3+5, "next", next];
MakeCmd[col4, "bytes", bytes];
MakeCmd[col4, "ascii", ascii];
MakeCmd[col5, "evi", evi];
MakeCmd[col5+4, "link", link];
MakeCmd[col5+9, "pd", pd];
NewLine[];
MakeCmd[col1, "stop", stop];
MakeCmd[col1+5, "find", find];
handle.cmd.keyString ← NamedCell[col1+10, "key", col3-col1-11, NIL, 0];
handle.cmd.rangeVal ← NamedCell[col3, "rng", 5, "100", 10];
MakeCmd[col4, "num->mop", numMop];
MakeCmd[col5, "mop->num", mopNum];
handle.height ← cmdy + entryHeight + entryVSpace; -- interline spacing
END;
CellInt:
PUBLIC PROC [handle: Handle, n: NumberCell]
RETURNS [
INT] = {
contents: Rope.ROPE ← ViewerTools.GetContents[n];
RETURN [GetNumber[handle, contents]]};
CellCard:
PUBLIC PROC [handle: Handle, n: NumberCell]
RETURNS [
CARDINAL] = {
contents: Rope.ROPE ← ViewerTools.GetContents[n];
i: INT ← GetNumber[handle, contents];
IF ~ (i
IN [0..
CARDINAL.
LAST])
THEN
RESOut.Complain[h: handle, msg: "number out of range"];
RETURN [CARDINAL[i]]};
GetNumber:
PUBLIC PROC [handle: Handle, contents: Rope.
ROPE]
RETURNS [v:
INT ← 0] = {
ENABLE SafeStorage.NarrowFault => GO TO bad;
neg: BOOL ← FALSE;
first: CARDINAL ← 0;
IF Rope.Length[contents] = 0 THEN RETURN;
FOR i:
CARDINAL
IN [0..
CARDINAL[Rope.Length[contents]])
DO
c: CHAR = Rope.Fetch[contents, i];
SELECT c
FROM
IN [IO.NUL..IO.SP] => NULL;
'- => {neg ← TRUE; first ← i+1; EXIT};
ENDCASE => {first ← i; EXIT};
ENDLOOP;
v ← Convert.CardFromWholeNumberLiteral[contents, first !
Convert.Error => {
SELECT reason
FROM
$empty => RESOut.Complain[h: handle, msg: "number is blank."];
$syntax => RESOut.Complain[h: handle, msg: "number syntax error."];
$overflow => RESOut.Complain[h: handle, msg: "number overflowed."];
ENDCASE; -- above cases won't return (they raise cancelAction)
GO TO bad}];
IF neg THEN v ← -v;
};
MakeTypescript:
PROC [handle: Handle] =
BEGIN
handle.height ← handle.height + entryVSpace; -- space down from the top of the viewer
handle.ts ← TypeScript.Create[
info: [name: "ListTool.ts", wy: handle.height, parent: handle.outer, border: FALSE ]];
[handle.in, handle.out] ← ViewerIO.CreateViewerStreams [
name: "ListTool.ts", viewer: handle.ts, backingFile: "ListTool.ts", editedStream: FALSE];
Containers.ChildXBound[handle.outer, handle.ts];
Containers.ChildYBound[handle.outer, handle.ts];
END;
SetCell:
PRIVATE
PROC [handle: Handle, button: Menus.MouseButton, cell: ViewerClasses.Viewer, radix:
CARDINAL] = {
ENABLE RESOut.cancelAction => GO TO dont;
SELECT button
FROM
blue => ViewerTools.SetSelection[cell];
red, yellow => {
r: ROPE = ViewerTools.GetSelectionContents[];
i: INT = GetNumber[handle, r];
IF button = yellow THEN radix ← 8;
ViewerTools.SetContents[cell, Convert.RopeFromInt[from: i, base: radix, showRadix: TRUE]]};
ENDCASE;
};
SetTextCell:
PRIVATE
PROC [handle: Handle, button: Menus.MouseButton, cell: ViewerClasses.Viewer] = {
ENABLE RESOut.cancelAction => GO TO dont;
SELECT button
FROM
blue => ViewerTools.SetSelection[cell];
red => {
r: ROPE = ViewerTools.GetSelectionContents[];
ViewerTools.SetContents[cell, r]};
ENDCASE;
};
SimplePrompt: Buttons.ButtonProc
= {
ph: PromptHandle ← NARROW[clientData];
IF ph.radix = 0 THEN SetTextCell[ph.handle, mouseButton, ph.cell]
ELSE SetCell[ph.handle, mouseButton, ph.cell, ph.radix];
};
GetSelectionValue:
PUBLIC PROC [handle: Handle]
RETURNS [
UNSPECIFIED] = {
r: ROPE = ViewerTools.GetSelectionContents[];
i: INT = GetNumber[handle, r];
IF ~(i
IN [0..
CARDINAL.
LAST])
THEN
RESOut.Complain[h: handle, msg: "Selected number too large"];
RETURN [CARDINAL[i]]};
GetLongSelectionValue:
PUBLIC PROC [handle: Handle]
RETURNS [
INT] = {
r: ROPE = ViewerTools.GetSelectionContents[];
RETURN [GetNumber[handle, r]]};
OtherCmd: Buttons.ButtonProc
-- [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] -- = {
ENABLE RESOut.cancelAction, ABORTED => GO TO dont;
ch: CmdHandle = NARROW[clientData];
RESOut.Complain[h: ch.handle, msg: NIL, abort: FALSE];
IF ch.cmd = stop THEN ch.handle.stopFlag ← TRUE
ELSE {
ch.handle.stopFlag ← FALSE;
CSegDebugDefs.DoCommand[ch.handle, ch.cmd, mouseButton]};
};
ToggleBool: Buttons.ButtonProc
= {
switch: REF BOOL ← NARROW [clientData];
switch^ ← ~switch^;
Buttons.SetDisplayStyle[
button: NARROW[parent],
style: IF switch^ THEN $WhiteOnBlack ELSE $BlackOnWhite];
};
[] ← MakeTool[NIL];
END.