DIRECTORY Imager, InputFocus, IO, MessageWindow, Pipal, PipalEdit, PipalInt, PipalMutate, PipalOps, PipalPaint, PipalReal, PipalTextMutant, Rope, TerminalIO;

PipalTextEditorImpl: CEDAR PROGRAM
IMPORTS InputFocus, IO, MessageWindow, Pipal, PipalEdit, PipalMutate, PipalOps, PipalPaint, PipalReal, PipalTextMutant, Rope, TerminalIO =
BEGIN OPEN PipalTextMutant;
textEditorClass: Pipal.Class _ Pipal.RegisterClass[name: "TextEditor", type: CODE [TextEditorRec]];

TextEditor: TYPE = REF TextEditorRec;
TextEditorRec: TYPE = RECORD [
textMutant: TextMutant,
notifyState: NotifyState _ [],
undoRedo: PipalOps.UndoRedo _ []
];

TextEditorSize: PipalReal.SizeProc ~ {
size _ PipalReal.ObjectSize[NARROW [object, TextEditor].textMutant];
};

TextEditorPaint: PipalPaint.PaintProc = {
PipalPaint.Paint[NARROW [object, TextEditor].textMutant, context];
};

NotifyState: TYPE = RECORD [
coords: PipalReal.Vector _ PipalReal.zeroVector, -- mx, my
editState: EditState _ reset,
sel: Selections _ primary,
selState: SelState _ reset,
pdelState: PDelState _ reset,
pDel: BOOL _ FALSE,
prevPSel: Selection _ [],
initialSelect: PipalInt.Interval _ [0, 0],
mouseColor: MouseColor _ red,
editMessage: Pipal.ROPE _ NIL];

EditState: TYPE = {
reset, -- no mutant specified
abort, -- mutant aborted
tolimbo, -- delete primary
toprimary, -- copy/move secondary selection to/onto primary
tosecondary, -- copy/move primary to/onto secondary
toboth -- transpose primary and secondary
};

SelState: TYPE = {
reset,  -- not specified yet
primary,  -- making a primary selection
secondary 
};

PDelState: TYPE = {
reset,  -- not specified yet
pending, -- making a pending delete selection
not 
};

LevelChange: TYPE = {reduce, expand, same};

MouseColor: TYPE = {red, yellow, blue, dead};

BadMouse: SIGNAL = CODE;

MessageArray: TYPE = ARRAY BOOL OF ARRAY BOOL OF Pipal.ROPE;
toPrimaryMessages: REF MessageArray _ NEW [MessageArray];
toSecondaryMessages: REF MessageArray _ NEW [MessageArray];

Notify: PipalEdit.NotifyProc = {
Complain: PROC [atom: ATOM] = {
IO.PutF[TerminalIO.TOS[], "Unimplemented tip table atom %g\n", IO.atom[atom]];
someComplaint _ TRUE;
};
AbortSecondary: PROC = {
MessageWindow.Append["Make a primary selection first.",TRUE];
MessageWindow.Blink[];
d.editState _ abort; d.mouseColor _ dead 
};
EditMessage: PROC = {
msg: Pipal.ROPE _ SELECT d.editState FROM
tolimbo => "Select for delete",
toprimary => toPrimaryMessages [textMutant.selections[primary].pendingDelete] [textMutant.selections[secondary].pendingDelete],
tosecondary => toSecondaryMessages [textMutant.selections[primary].pendingDelete] [textMutant.selections[secondary].pendingDelete],
toboth => "Select for transpose",
ENDCASE => NIL;
IF msg = NIL OR msg = d.editMessage THEN RETURN;
MessageWindow.Append[msg,TRUE];
d.editMessage _ msg 
};
Extend: PROC [saveEnds: BOOL] = {
IF d.editState=abort THEN RETURN;
IF d.mouseColor # blue THEN {
IF d.mouseColor = dead THEN SIGNAL BadMouse;
d.mouseColor _ blue;
d.prevPSel _ textMutant.selections[primary];
saveEnds _ TRUE;
};
{
grain: SelectionGrain _ textMutant.selections[d.sel].granularity;
new: PipalInt.Interval;
closerRight: BOOL;
set: PipalInt.Interval;
IF saveEnds THEN d.initialSelect _ textMutant.selections[d.sel].interval;
[new, closerRight] _ GetSelectionInterval[text, d.coords, grain];
IF d.initialSelect.base<=new.base THEN {
set.base _ d.initialSelect.base;
set.size _ new.base+new.size-d.initialSelect.base;
}
ELSE {
set.base _ new.base;
set.size _ d.initialSelect.base+d.initialSelect.size-new.base;
};
[message, textMutant] _ SetSelection[textMutant, set, d.sel, d.pDel, closerRight, grain];
IF d.sel=secondary THEN EditMessage[];
};
};
textEditor: TextEditor = NARROW [editor];
d: NotifyState _ textEditor.notifyState; -- we copy because we are changing in place that variable
textMutant: TextMutant _ textEditor.textMutant; -- all operations do return a new TextMutant
text: PipalText _ textMutant.text;
message: Pipal.ROPE _ NIL;
someComplaint: BOOL _ FALSE;
FOR input _ input, input.rest UNTIL input=NIL DO WITH input.first SELECT FROM
coords: REF Imager.VEC => d.coords _ coords^;
char: REF CHAR => {
SELECT char^ FROM
IO.BS => [message, textMutant] _ Erase[textMutant ! Pipal.Error => IF reason=$noCharacterToErase THEN {TerminalIO.PutRope["No character to erase\n"]; CONTINUE} ELSE REJECT];
ENDCASE => {
newBase: Location _ textMutant.selections[primary].interval.base;
IF textMutant.selections[primary].caretAfter THEN newBase _ newBase + textMutant.selections[primary].interval.size;
[message, textMutant] _ InsertChar[textMutant, char^];
textMutant _ SetSelection[tm: textMutant, interval: [newBase+1, 0], selection: primary, pendingDelete: FALSE, caretAfter: FALSE, granularity: point].newtm;
};
PipalPaint.Enqueue[queue, [type: clearAndPaint, area: PipalPaint.fullArea, data: textMutant]];
};
atom: ATOM => {
SELECT atom FROM
$BlueMouse => {
IF d.mouseColor = dead THEN SIGNAL BadMouse;
d.mouseColor _ blue;
d.prevPSel _ textMutant.selections[primary];
};
$DoEdit => {
SELECT d.editState FROM
tolimbo => [message, textMutant] _ Delete[textMutant];
reset, abort => NULL;
toprimary => {
[message, textMutant] _ Copy[textMutant]; 
[, textMutant] _ CancelSelection[textMutant, secondary];
};
tosecondary => Complain[$DoEditToSecondary];
toboth => [message, textMutant] _ Transpose[textMutant];
ENDCASE => ERROR;
d.editState _ reset;
d.sel _ primary;
d.selState _ reset;
d.pdelState _ reset;
d.pDel _ FALSE;
d.mouseColor _ red;
IF d.editMessage # NIL THEN MessageWindow.Clear[];
d.editMessage _ NIL;
};
$ForceSelNotPendDel => {
d.pdelState _ reset;
d.pdelState _ not;
d.pDel _ FALSE;
};
$ForceSelPendDel => {
d.pdelState _ reset;
d.pdelState _ pending;
d.pDel _ TRUE;
};
$RedMouse => {
IF d.mouseColor = dead THEN SIGNAL BadMouse;
d.mouseColor _ red;
d.prevPSel _ textMutant.selections[primary];
};
$SelChar => {
IF NOT d.editState=abort THEN {
IF d.sel=secondary AND NOT textMutant.selections[primary].valid THEN AbortSecondary[]
ELSE {
interval: PipalInt.Interval;
closerRight: BOOL;
[interval, closerRight] _ GetSelectionInterval[text, d.coords, char];
[message, textMutant] _ SetSelection[textMutant, interval, d.sel, d.pDel, closerRight, char];
IF d.editState=tolimbo OR d.sel=secondary THEN EditMessage[];
};
};
};
$SelExpand => textMutant.selections[d.sel].granularity _ SELECT textMutant.selections[d.sel].granularity FROM
point => char,
char => word,
ENDCASE => word;
$SelExtend => Extend[FALSE];
$SelNotPendDel => IF d.pdelState=reset THEN {
d.pdelState _ not;
d.pDel _ FALSE;
};
$SelPendDel => IF d.pdelState=reset THEN {
d.pdelState _ pending;
d.pDel _ TRUE;
};
$SelReduce => textMutant.selections[d.sel].granularity _ char;
$SelSecondary => IF d.selState=reset THEN {
d.selState _ secondary;
d.sel _ secondary;
};
$SelStartExtend => Extend[TRUE];
$SelUpdate => {
IF NOT d.editState=abort THEN {
IF d.sel=secondary AND NOT textMutant.selections[primary].valid THEN AbortSecondary[]
ELSE {
grain: SelectionGrain _ textMutant.selections[d.sel].granularity;
interval: PipalInt.Interval;
closerRight: BOOL;
[interval, closerRight] _ GetSelectionInterval[text, d.coords, grain];
[message, textMutant] _ SetSelection[textMutant, interval, d.sel, d.pDel, closerRight, grain];
IF d.sel=secondary THEN EditMessage[];
};
};
};
$SelWord => {
IF NOT d.editState=abort THEN {
IF d.sel=secondary AND NOT textMutant.selections[primary].valid THEN AbortSecondary[]
ELSE {
interval: PipalInt.Interval;
closerRight: BOOL;
[interval, closerRight] _ GetSelectionInterval[text, d.coords, word];
[message, textMutant] _ SetSelection[textMutant, interval, d.sel, d.pDel, closerRight, word];
IF d.editState=tolimbo OR d.sel=secondary THEN EditMessage[];
};
};
};
$ToLimbo => IF d.editState=reset THEN d.editState _ tolimbo;
$ToPrimary => IF d.editState=reset OR d.editState=tolimbo THEN d.editState _ toprimary;
$YellowMouse => {
IF d.mouseColor = dead THEN SIGNAL BadMouse;
d.mouseColor _ yellow;
d.prevPSel _ textMutant.selections[primary];
};
ENDCASE => {
IO.PutF[TerminalIO.TOS[], "Unknown tip table atom %g\n", IO.atom[atom]];
someComplaint _ TRUE;
};
InputFocus.SetInputFocus[viewer];
PipalPaint.Enqueue[queue, [type: clearAndPaint, area: PipalPaint.fullArea, data: textMutant]];
};
ENDCASE; ENDLOOP;
newEditor _ NEW [TextEditorRec _ [
textMutant: textMutant, 
notifyState: d, 
undoRedo: PipalOps.Do[textEditor.undoRedo, message, textEditor]
]];
IF someComplaint THEN TerminalIO.PutRope["\n"];
};

EditPipalText: PipalEdit.EditProc = {
textMutant: TextMutant _ NARROW [mutant];
editor _ NEW [TextEditorRec _ [textMutant: textMutant]];
PipalEdit.CreateBiscroller[editor, Rope.Cat[PipalOps.wDir, "PipalTextEditor.TIP"], Notify, TRUE];
};

Test: PUBLIC PROC [size: PipalReal.Size] RETURNS [editor: TextEditor] = {
text: PipalText = CreatePipalText[NIL, size];
editor _ NARROW [PipalEdit.Edit[PipalMutate.Mutation[text]]];
};

DoUndoRedo: PROC [old: TextEditor, message: Pipal.ROPE, op: PipalOps.UndoRedoOp] RETURNS [new: TextEditor] = {
newUndoRedo: PipalOps.UndoRedo;
newState: REF;
newTE: TextEditor;
[newUndoRedo, newState] _ op[old.undoRedo, old];
newTE _ NARROW [newState];
new _ NEW [TextEditorRec _ [
textMutant: newTE.textMutant, 
notifyState: newTE.notifyState,
undoRedo: newUndoRedo 
]];
};

ResetCommand: PipalMutate.CommandProc ~ {
te: TextEditor = NARROW [mutant];
new _ DoUndoRedo[te, "Reset", PipalOps.Reset];
};

UndoCommand: PipalMutate.CommandProc ~ {
te: TextEditor = NARROW [mutant];
IF te.undoRedo.undo=NIL 
THEN {TerminalIO.PutF["*** Cant Undo!\n"]; RETURN [changedArea, Pipal.void, te]};
new _ DoUndoRedo[te, "Undo", PipalOps.Undo];
};

RedoCommand: PipalMutate.CommandProc ~ {
te: TextEditor = NARROW [mutant];
IF te.undoRedo.redo=NIL 
THEN {TerminalIO.PutF["*** Cant Redo!\n"]; RETURN [changedArea, Pipal.void, te]};
new _ DoUndoRedo[te, "Redo", PipalOps.Redo];
};

FlushCommand: PipalMutate.CommandProc ~ {
te: TextEditor = NARROW [mutant];
new _ NEW [TextEditorRec _ [
textMutant: te.textMutant, 
notifyState: te.notifyState,
undoRedo: []
]];
RETURN [changedArea, Pipal.void, new];
};
PipalMutate.RegisterCommand[textEditorClass, $Reset, ResetCommand];
PipalMutate.RegisterCommand[textEditorClass, $Undo, UndoCommand];
PipalMutate.RegisterCommand[textEditorClass, $Redo, RedoCommand];
PipalMutate.RegisterCommand[textEditorClass, $Flush, FlushCommand];

Pipal.PutClassMethod[textEditorClass, PipalReal.sizeMethod, NEW [PipalReal.SizeProc _ TextEditorSize]];
Pipal.PutClassMethod[textEditorClass, PipalPaint.paintMethod, NEW [PipalPaint.PaintProc _ TextEditorPaint]];

Pipal.PutClassMethod[textMutantClass, PipalEdit.editMethod, NEW [PipalEdit.EditProc _ EditPipalText]];

toPrimaryMessages[FALSE][FALSE] _ "Select for copy to caret";
toPrimaryMessages[FALSE][TRUE] _ "Select for move to caret";
toPrimaryMessages[TRUE][FALSE] _ "Select replacement";
toPrimaryMessages[TRUE][TRUE] _ "Select for move onto";
toSecondaryMessages[FALSE][FALSE] _ "Select destination for copy";
toSecondaryMessages[FALSE][TRUE] _ "Select for replacement";
toSecondaryMessages[TRUE][FALSE] _ "Select destination for move";
toSecondaryMessages[TRUE][TRUE] _ "Select destination for move onto";

END.

PipalTextEditorImpl.mesa
Copyright Σ 1988 by Xerox Corporation.  All rights reserved.
Louis Monier February 3, 1988 11:33:05 am PST
Bertrand Serlet February 24, 1988 5:19:35 pm PST

Interactive Mutant
Little Quick and Dirty Test

Undo/Redo Commands
Initialization
ΚC–

"cedar" style˜
codeš
œ™Kš
œ<™<Kšœ*Οk™-Kš
œ0™0K™—Kš	œœ}˜
K˜•StartOfExpansion[]šΟnœœ
˜"Kšœœt˜Š
Kšœ
œ˜—
head™šœMœ˜cK˜—Kšœœœ˜%šœœœ˜K˜KšœΟc
˜Kš
œ ˜ K˜K˜—šžœ˜&Kšœœ"˜DKš
œ˜K˜—šžœ˜)Kšœœ+˜BKš
œ˜K˜—šœ
œœ˜Kšœ1Ÿ	˜:Kš
œ˜K˜Kš
œ˜Kš
œ˜Kšœœœ
˜Kš
œ˜Kš
œ*˜*Kš
œ˜Kšœœœ˜K˜—šœœ˜KšœŸ˜KšœŸ˜Kšœ	Ÿ˜KšœŸ0˜;Kšœ
Ÿ&˜3KšœŸ"˜)K˜K˜—šœ
œ˜KšœŸ˜Kšœ
Ÿ˜'K˜
K˜K˜—šœœ˜KšœŸ˜Kšœ	Ÿ$˜-K˜K˜K˜—šœ
œ˜+K˜—šœœ˜-K˜—šžœœœ
˜K˜—Kšœœœ
œ
œ
œ
œ
œœ
˜<Kšœœœ˜9šœœœ˜;K˜—šžœ˜ šžœœœ˜Kšœœ)œ
˜NKšœœ
˜K˜—šžœœ˜Kšœ7œ˜=K˜K˜)K˜—šžœœ˜šœœœ
˜)Kš
œ˜Kš
œ˜Kš
œƒ
˜ƒ
Kš
œ!˜!Kšœœ
˜—Kš
œœ
œœ
œ
˜0Kšœœ˜K˜K˜—šžœœœ˜!Kšœœ
œ
˜!šœœ˜Kšœœ
œ
˜,K˜Kš
œ,˜,Kšœœ
˜Kš
œ˜—š
œ
˜
Kš
œA˜AKš
œ˜Kšœ
œ
˜Kš
œ˜Kšœ
œ9˜IKš
œA˜Ašœ œ˜(Kš
œ ˜ Kš
œ2˜2Kš
œ
˜
—šœ˜Kš
œ˜Kš
œ>˜>K˜—Kš
œY˜YKšœœ˜&K˜—K˜—Kšœœ
˜)Kšœ)Ÿ9˜bKšœ0Ÿ,˜\Kš
œ"˜"Kšœœœ
˜Kšœœœ
˜š
œœœ
œ
œ
œ
˜MKšœœœ˜-šœœ
œ˜šœ˜Kšœ
œ>œœ1œœ
œ˜­
šœ˜Kš
œA˜AKšœ+œB˜sKš
œ6˜6Kšœgœœ˜›
K˜——Jš
œ^˜^Kš
œ˜—šœœ˜šœ˜š
œ˜Kšœœ
œ
˜,K˜Kš
œ,˜,Kš
œ˜—š
œ˜šœ
˜Kš
œ6˜6Kšœœ
˜š
œ˜Kš
œ*˜*Kš
œ8˜8Kš
œ˜—Kš
œ,˜,Kš
œ8˜8Kšœœ
˜—Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœ	œ
˜Kš
œ˜Kšœœ
œ˜2Kšœœ
˜Kš
œ˜—š
œ˜Kš
œ˜Kš
œ˜Kšœ	œ
˜Kš
œ˜—š
œ˜Kš
œ˜Kš
œ˜Kšœ	œ
˜Kš
œ˜—š
œ˜Kšœœ
œ
˜,K˜Kš
œ,˜,K˜—š
œ
˜
šœ
œœ˜Kšœœ
œ&œ˜Ušœ˜Kš
œ˜Kšœ
œ
˜Kš
œE˜EKš
œ]˜]Kšœœœ˜=K˜—Kš
œ˜—K˜—šœ9œ*˜mK˜K˜
Kšœ	˜—Kšœœ˜šœœœ˜-Kš
œ˜Kšœ	œ
˜K˜—šœœœ˜*Kš
œ˜Kšœ	œ
˜K˜—Kš
œ>˜>šœœœ˜+Kš
œ˜Kš
œ˜Kš
œ˜—Kšœœ˜ š
œ˜šœ
œœ˜Kšœœ
œ&œ˜Ušœ˜Kš
œA˜AKš
œ˜Kšœ
œ
˜Kš
œF˜FKš
œ^˜^Kšœœ˜&K˜—Kš
œ˜—Kš
œ˜—š
œ
˜
šœ
œœ˜Kšœœ
œ&œ˜Ušœ˜Kš
œ˜Kšœ
œ
˜Kš
œE˜EKš
œ]˜]Kšœœœ˜=Kš
œ˜—Kš
œ˜—Kš
œ˜—Kšœœœ˜<Kšœœœœ˜Wš
œ˜Kšœœ
œ
˜,K˜Kš
œ,˜,Kš
œ˜—šœ˜Kšœœ#œ
˜HKšœœ
˜K˜——Kš
œ!˜!Jš
œ^˜^K˜—Kšœœ
˜—šœœ˜"Kš
œ˜Kš
œ˜Kš
œ?˜?Kš
œ˜—Kšœœ˜/K˜K˜——™šž
œ˜%Kšœœ
˜)Kšœ	œ,˜8Kšœ[œ˜aK˜K™—K˜šžœœ
œœ˜IKšœ"œ˜-Kšœ	œ.˜=Kš
œ˜K˜——™šž
œœ"œœ˜nKš
œ˜Kšœ
œ
˜Kš
œ˜Kš
œ0˜0Kšœœ˜šœœ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜—K˜K˜—šžœ˜)Kšœœ
˜!Kš
œ.˜.K˜K˜—šžœ˜(Kšœœ
˜!šœœ
˜Kšœ'œ ˜Q—Kš
œ,˜,K˜K˜—šžœ˜(Kšœœ
˜!šœœ
˜Kšœ'œ ˜Q—Kš
œ,˜,K˜K˜—šžœ˜)Kšœœ
˜!šœœ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜—Kšœ ˜&K˜——™Kš
œC˜CKš
œA˜AKš
œA˜AKš
œC˜CK˜Kšœ<œ(˜gKšœ>œ+˜lK˜šœ<œ'˜fK˜—Kšœœœ˜=Kšœœœ˜<Kšœœœ˜6Kšœœœ˜7Kšœœœ"˜BKšœœœ˜<Kšœœœ"˜AKšœœœ'˜EK˜—Kšœ
˜—…—+x8Ι