DIRECTORY 
Ascii,
KeySymsKB,
KeySymsSun,
KeySymsOSF,
KeySymsHP,
Rope,
Xl,
XlAscii,
XlCursor,
XTk,
XTkButtons,
XTkCommon,
XTkContainers,
XlCutBuffers,
XTkDelegation,
XTkFields,
XTkFriends,
XTkLabels,
XTkLabelsExtras,
XTkInputFocus,
XTkPopUps,
XTkShellWidgets;

XTkFieldsImpl: CEDAR MONITOR 
IMPORTS Rope, Xl, XlAscii, XlCutBuffers, XTkContainers, XTk, XTkButtons, XTkDelegation, XTkLabels, XTkLabelsExtras, XTkFields, XTkFriends, XTkInputFocus, XTkPopUps, XTkShellWidgets
EXPORTS XTkFields =
BEGIN 

debugging: BOOL ¬ FALSE;

Widget: TYPE = XTk.Widget;
WidgetSpec: TYPE = XTk.WidgetSpec;
StyleSpec: TYPE = XTkCommon.StyleSpec;

classImplementsFocus: XTk.ClassFlagKey ~ cf1;

events: Xl.EventFilter ~ Xl.CreateEventFilter[keyPress, buttonPress, buttonRelease, clientMessage];
listOfSpecials: LIST OF Xl.KeySym ~ LIST[KeySymsSun.Paste, KeySymsOSF.Paste, KeySymsHP.Paste, KeySymsKB.Stop, KeySymsKB.Next, KeySymsKB.MoveRight];

fieldClass: PUBLIC XTk.Class ¬ MakeClass[];
MakeClass: PROC [] RETURNS [c: XTk.ImplementorClass] = {
c ¬ XTkFriends.CreateClass[basicMethods: [
key: $Field, 
super: XTkLabels.labelClass, 
initInstPart: FieldInitInstPart, 
preferredSizeLR: FieldPreferredSize, 
wDataNum: 1, 
cursorKey: NEW[XlCursor.StandardFontCursors ¬ centerPtr]
]];
XTk.SetClassFlag[c, classImplementsFocus];
};

FieldData: TYPE = REF FieldDataRec;
FieldDataRec: TYPE = RECORD [
pseudoBase: XTkPopUps.PseudoBase ¬ NIL,
downPos: Xl.Point ¬ [0, 0] --for poor mans gesture recognition 
];
EventProc: Xl.EventProcType = {
ENABLE {
Xl.XError => GOTO oops;
};
widget: XTk.Widget ~ NARROW[clientData];
WITH event SELECT FROM
keyPress: Xl.KeyPressEvent => {
asRope: Rope.ROPE;
char: CHAR; keysym: Xl.KeySym; matched: Xl.KeySym; isModifier: BOOL;
[char: char, keysym: keysym, matched: matched, isModifier: isModifier] ¬ XlAscii.Convert[event.connection, keyPress.keyCode, keyPress.state, listOfSpecials];
IF isModifier THEN RETURN;
IF matched = KeySymsSun.Paste OR matched = KeySymsOSF.Paste OR matched = KeySymsHP.Paste THEN {
insert: Rope.ROPE ¬ XlCutBuffers.Get[event.connection];
InsertRope[widget, insert, FALSE];
RETURN
};
IF matched = KeySymsKB.Next OR matched = KeySymsKB.MoveRight THEN {
XTkInputFocus.SetFocus[XTkInputFocus.NextFocusTarget[widget]];
RETURN;
};
IF matched = KeySymsKB.Stop THEN {
XTkInputFocus.GiveUpFocus[widget, keyPress.timeStamp];
RETURN;
};
asRope ¬ Rope.FromChar[char];
PushChar[widget, char, asRope];
XTkFriends.CallNotifiers[widget, $FieldCharInput, asRope, keyPress];
};
br: Xl.ButtonReleaseEvent => {
pm: Xl.PointerMapping ~ Xl.GetPointerMapping[br.connection];
SELECT pm[br.button] FROM
1 => {
fd: FieldData ¬ GetFieldData[widget];
IF ABS[fd.downPos.y-br.pos.y]>8 AND ABS[fd.downPos.x-br.pos.x]<8 --poor mans gesture recognition-- THEN {
XTkPopUps.PopUpWithRegularShell[createMenu: menuClosure, registerData: widget, header: "Field values", screen: widget.screenDepth.screen]
};  
SELECT TRUE FROM
br.state.control => {};
br.state.shift => XTkLabelsExtras.SetCharInsertionIndex[widget, 10000];
ENDCASE => XTkLabelsExtras.SetCharInsertionPos[widget, br.pos];
};
2 => XTkLabelsExtras.SetCharInsertionIndex[widget, 10000];
ENDCASE => {};
XTkInputFocus.SetFocus[widget, br.timeStamp];
};
bp: Xl.ButtonPressEvent => {
pm: Xl.PointerMapping ~ Xl.GetPointerMapping[bp.connection];
fd: FieldData ¬ GetFieldData[widget];
fd.downPos ¬ bp.pos;
SELECT pm[bp.button] FROM
1 => {
SELECT TRUE FROM
bp.state.control => {
XTkPopUps.PopUpWithRegularShell[createMenu: menuClosure, registerData: widget, header: "Field values", screen: widget.screenDepth.screen]
};
ENDCASE => {};
};
3 => {
XTkPopUps.PopUpWithRegularShell[createMenu: menuClosure, registerData: widget, header: "Field values", screen: widget.screenDepth.screen];
};
ENDCASE => RETURN;
};
cm: Xl.ClientMessageEvent => {
a: Xl.XAtom ¬ Xl.MakeAtom[cm.connection, "PARC_Handwriting"];
IF cm.typeAtom=a AND cm.w[0]=Xl.AtomId[a] THEN {
i: INT32 ~ LOOPHOLE[cm.w[1]];
stuffKey: INT32 ~ -1;
nextKey: INT32 ~ -3;
SELECT i FROM
stuffKey =>  {
text: Rope.ROPE ¬ XlCutBuffers.Get[cm.connection];
InsertRope[widget, text, TRUE];
};
nextKey =>  {
XTkInputFocus.SetFocus[XTkInputFocus.NextFocusTarget[widget]];
};
ENDCASE => {
SELECT TRUE FROM
i<0 => {
XTkFriends.CallNotifiers[widget, $HandwritingClientMessage, NEW[INT¬i], cm] 
};
i<=255 => PushChar[widget, VAL[i]];
ENDCASE => {};
};
};
};
ENDCASE => {};
EXITS oops => {};
};

FieldButtonChoice: XTk.WidgetNotifyProc ~ {
ENABLE {
Xl.XError => GOTO Oops;
UNCAUGHT => IF ~debugging THEN GOTO Oops;
};
field: XTk.Widget ~ NARROW[registerData];
time: Xl.TimeStamp ¬ Xl.LastTime[field.connection];
From: PROC [convention: ATOM] = {
r: Rope.ROPE ¬ XlCutBuffers.Get[field.connection, convention];
ReplaceRope[field, r];
};
To: PROC [convention: ATOM] = {
XlCutBuffers.Put[field.connection, XTkLabels.GetText[field], convention];
};
FromProp: PROC [prop: ATOM] = {
WITH XTk.GetWidgetProp[field, prop] SELECT FROM
r: Rope.ROPE => XTkLabels.SetText[field, r];
ENDCASE => {};
};
SELECT callData FROM
$clear => {
XTkLabels.SetText[field, NIL];
XTkInputFocus.SetFocus[field, time];
};
$PRIMARY => From[$PRIMARY];
$CLIPBOARD => From[$CLIPBOARD];
$CutBuffer0 => From[$CutBuffer0];
$previous => FromProp[$previous];
$default => FromProp[$default];
$putPRIMARY => To[$PRIMARY];
$putCLIPBOARD => To[$CLIPBOARD];
$putCutBuffer0 => To[$CutBuffer0];
$Dismiss => XTkShellWidgets.DestroyShell[XTk.RootWidget[widget]];
ENDCASE => {};
EXITS Oops => {};
};

menuList: XTkPopUps.ChoiceList ~ LIST[["empty", $clear], ["from primary selection", $PRIMARY], ["from clipboard", $CLIPBOARD], ["from cut buffer", $CutBuffer0], ["actually typed text", $previous], ["default text", $default], ["to primary", $putPRIMARY], ["to clipboard", $putCLIPBOARD], ["to cut buffer", $putCutBuffer0], ["Dismiss", $Dismiss]];

menuClosure: XTkPopUps.WidgetCreateClosure ~ XTkPopUps.WidgetCreateClosureFromChoiceList[list: menuList, defaultNotify: FieldButtonChoice];

CreateField: PUBLIC PROC [widgetSpec: XTk.WidgetSpec ¬ [], text: Rope.ROPE ¬ NIL, style: StyleSpec ¬ []] RETURNS [w: XTk.Widget] = {
widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, fieldClass];
w ¬ XTkLabels.CreateLabel[widgetSpec: widgetSpec, text: text, style: style];
XTk.PutWidgetProp[w, $default, text];
};

GetFieldData: PROC [widget: XTk.Widget] RETURNS [fieldData: FieldData] = INLINE {
fieldData _ NARROW[XTkFriends.InstPart[widget, fieldClass]];
};

FieldInitInstPart: XTk.InitInstancePartProc = {
fieldData: FieldData ~ NEW[FieldDataRec];
XTkFriends.AssignInstPart[widget, fieldClass, fieldData];
XTk.AddPermanentMatch[widget, [proc: EventProc, handles: events, tq: Xl.CreateTQ[], data: widget], [keyPress: TRUE, buttonPress: TRUE, buttonRelease: TRUE]];
};

PushChar: PROC [widget: XTk.Widget, ch: CHAR, asRope: Rope.ROPE ¬ NIL] = {
SELECT ch FROM
0c, Ascii.LF, Ascii.CR => {};
4c, Ascii.DEL => {
ReplaceRope[widget, NIL];
};
Ascii.BS => {
InsertBS[widget, TRUE];
}
ENDCASE => {
IF asRope=NIL THEN asRope ¬ Rope.FromChar[ch];
InsertRope[widget, asRope, TRUE];
};
};

InsertBS: PROC [widget: XTk.Widget, remember: BOOL] = {
text: Rope.ROPE ¬ XTkLabels.GetText[widget];
ip: INT ¬ MIN[XTkLabelsExtras.GetCharInsertionIndex[widget], Rope.Length[text]];
IF ip>0 THEN {
left: Rope.ROPE ¬ Rope.Substr[text, 0, ip-1];
right: Rope.ROPE ¬ Rope.Substr[text, ip, LAST[INT]];
text ¬ Rope.Concat[left, right];
ip ¬ ip-1;
XTkLabels.SetText[widget, text];
XTkLabelsExtras.SetCharInsertionIndex[widget, ip];
IF remember THEN XTk.PutWidgetProp[widget, $previous, text];
};
};


InsertRope: PROC [widget: XTk.Widget, r: Rope.ROPE, remember: BOOL] = {
text: Rope.ROPE ¬ XTkLabels.GetText[widget];
ip: INT ¬ MIN[XTkLabelsExtras.GetCharInsertionIndex[widget], Rope.Length[text]];
left: Rope.ROPE ¬ Rope.Substr[text, 0, ip];
right: Rope.ROPE ¬ Rope.Substr[text, ip, LAST[INT]];
text ¬ Rope.Cat[left, r, right];
ip ¬ Rope.Length[left]+Rope.Length[r];
XTkLabels.SetText[widget, text];
XTkLabelsExtras.SetCharInsertionIndex[widget, ip];
IF remember THEN XTk.PutWidgetProp[widget, $previous, text];
};

ReplaceRope: PROC [widget: XTk.Widget, r: Rope.ROPE] = {
XTkLabels.SetText[widget, r];
XTkLabelsExtras.SetCharInsertionIndex[widget, LAST[INT]];
};

FieldPreferredSize: XTk.PreferredSizeProc = {
preferred ¬ [
size: [widget.s.geometry.size.width, widget.s.geometry.size.height], 
pos: widget.s.geometry.pos, 
borderWidth: widget.s.geometry.borderWidth
]; 
IF preferred.borderWidth<0 THEN preferred.borderWidth ¬ 0;
IF preferred.size.width<=0 THEN preferred.size.width ¬ 200;
IF preferred.size.height<=0 THEN preferred.size.height ¬ 20;
};

CreateLabeledField: PUBLIC PROC [widgetSpec: XTk.WidgetSpec ¬ [], label, init: Rope.ROPE ¬ NIL, style: StyleSpec ¬ [], labelWidth, fieldWidth: INT ¬ 0] RETURNS [w: XTk.Widget] = {
lab, field: XTk.Widget;
field ¬ XTkFields.CreateField[
widgetSpec: [geometry: [size: [width: (IF fieldWidth>0 THEN fieldWidth ELSE Xl.dontUse), height: widgetSpec.geometry.size.height]]], 
text: init, style: style
];
lab ¬ XTkButtons.CreateButton[
widgetSpec: [geometry: [size: [width: (IF labelWidth>0 THEN labelWidth ELSE Xl.dontUse), height: widgetSpec.geometry.size.height]]], 
text: Rope.Concat[label, " "], style: style, 
hitProc: LabeledFieldLabelHit, registerData: field
];
w ¬ XTkContainers.CreateXStack[widgetSpec, LIST[lab, field]];
XTkDelegation.Delegate[from: w, alternateKey: $TextDelegation, to: field];
XTkInputFocus.Delegate[w, field];
};

LabeledFieldLabelHit: XTk.WidgetNotifyProc ~ {
field: XTk.Widget ~ NARROW[registerData];
time: Xl.TimeStamp ¬ Xl.LastTime[field.connection];
WITH event SELECT FROM
br: Xl.ButtonReleaseEvent => {
pm: Xl.PointerMapping ~ Xl.GetPointerMapping[field.connection];
SELECT pm[br.button] FROM
2 => XTkLabelsExtras.SetCharInsertionIndex[field, 10000];
3 => XTkLabels.SetText[field, ""];
ENDCASE => {};
time ¬ br.timeStamp;
};
ENDCASE => {};
XTkInputFocus.SetFocus[field, time];
};

END.


H
XTkFieldsImpl.mesa
Copyright Σ 1991, 1992 by Xerox Corporation.  All rights reserved.
Created by Christian Jacobi, March 30, 1991 11:59:26 pm PST
Christian Jacobi, October 21, 1992 9:22 am PDT


XTkPopUps.PopUp[fd.pseudoBase, bp];
XTkPopUps.PopUp[fd.pseudoBase, bp];
BEGIN
Commented out because using this would need ownwerGrabButtons TRUE and using the poor mans gesture recognition needs ownwerGrabButtons FALSE
pseudoBase: XTkPopUps.PseudoBase ¬ XTkPopUps.CreatePseudoBase[widget];
XTkPopUps.SetMenuCreator[pseudoBase, menuClosure];
fieldData.pseudoBase ¬ pseudoBase;
END;
Κ
•NewlineDelimiter

–
(cedarcode) style™
code™Kšœ
Οe
œ7™BKš
œ;™;K™.K™—šΟk	œ
˜
Kš
œ˜Kš
œ
˜
Kš
œ˜Kš
œ˜Kš
œ
˜
Kš
œ˜K˜Kš
œ˜Kš
œ	˜	Kš
œ˜K˜Kš
œ
˜
Kš
œ˜K˜
Kš
œ˜Kš
œ
˜
Kš
œ˜Kš
œ
˜
K˜Kš
œ˜K˜
K˜K˜—šΟn
œžœ
žœ
˜Kšžœ­
˜΄
Kšžœ˜—Kšžœ
˜K˜Kšœžœžœ
˜K˜Kšœžœ˜Kšœžœ˜"Kšœžœ˜&K˜Kš
œ-˜-K˜K˜cKšœžœ
žœ
žœk˜“
K˜šœžœ˜+šŸ	œžœžœ˜8˜*Kš
œ
˜
Kš
œ˜Kš
œ!˜!Kš
œ%˜%Kš
œ
˜
Kšœžœ*˜8Kš
œ˜—Kš
œ*˜*K˜—K˜—Kšœžœžœ˜#šœžœžœ˜Kšœ#žœ
˜'KšœΟc$˜?K˜K™—šŸ	œ˜šžœ˜Kšœ
žœ˜K˜—Kšœžœ
˜(šžœžœ
ž˜š
œ˜Kšœ
žœ
˜Kšœžœ5žœ
˜DK˜
Kšžœžœ
žœ
˜šžœžœžœžœ˜_Kšœ
žœ&˜7Kšœžœ˜"Kš
ž˜K˜—šžœžœžœ˜CKš
œ>˜>Kšžœ
˜K˜—šžœžœ˜"Kš
œ6˜6Kšžœ
˜K˜—K˜K˜K˜DKš
œ˜—š
œ˜K˜<šžœž˜˜K˜%šžœ
žœžœ
žœ !œ
žœ˜iK˜‰
K˜—šžœ
žœ
ž˜K˜K˜GKšžœ8˜?—K˜—K˜:Kšžœ˜—K˜-Kš
œ˜—˜K˜<K˜%K˜šžœž˜˜šžœ
žœ
ž˜˜K™#K˜‰
K˜—Kšžœ˜—K˜—˜K™#K˜Š
K˜—Kšžœžœ
˜—Kš
œ˜—˜K˜=šžœžœžœ˜0Kšœžœžœ
˜Kšœ
žœ˜Kšœ	žœ˜šžœž˜
˜Kšœžœ#˜2Kšœžœ˜K˜—˜
Kš
œ>˜>K˜—šžœ˜šžœ
žœ
ž˜˜Kšœ<žœ
žœ	˜LK˜—Kšœžœ˜#Kšžœ˜—K˜——K˜—K˜—Kšžœ˜—Kšžœ˜K˜K˜—šŸœ˜+šžœ˜Kšœ
žœ˜Kšžœžœžœ
žœ˜)K˜—Kšœžœ˜)K˜3šŸœžœžœ˜!Kšœžœ2˜>K˜Kš
œ˜—šŸœžœžœ˜Kš
œI˜IKš
œ˜—šŸœžœžœ˜šžœ žœ
ž˜/Kšœžœ ˜,Kšžœ˜—Kš
œ˜—šžœ
ž˜˜Kšœžœ˜Kš
œ$˜$K˜—Kš
œ˜Kš
œ˜Kš
œ!˜!Kš
œ!˜!Kš
œ˜Kš
œ˜Kš
œ ˜ Kš
œ"˜"K˜AKšžœ˜—Kšžœ˜Kš
œ˜—K˜Kšœ!žœ΄˜ΩK˜K˜‹
K˜šŸœžœ
žœ.žœžœžœ˜„
K˜KK˜LKš
œ%˜%K˜—K˜šŸœžœžœžœ˜QKšœžœ*˜<K˜K˜—šŸœ˜/Kšœžœ˜)K˜9™KšœQ œ™Œ
K™FK™2K™"K™—Kšœnžœžœžœ˜
K˜—K˜š
Ÿœžœžœžœžœ˜Jšžœž˜Kšœ
žœžœ˜šœ
žœ˜Kšœžœ˜K˜—šœžœ˜
Kšœžœ˜Kš
œ
˜
—šžœ˜Kšžœžœ
žœ˜.Kšœžœ˜!K˜——K˜K˜—šŸœžœ žœ˜7Kšœžœ˜,KšœžœžœC˜Pšžœžœ˜Kšœžœ˜-Kšœžœžœ
žœ˜4K˜ K˜
K˜ K˜2Kšžœ
žœ,˜<K˜—K˜—K˜K˜šŸ
œžœžœžœ˜GKšœžœ˜,KšœžœžœC˜PKšœžœ˜+Kšœžœžœ
žœ˜4K˜ K˜&K˜ K˜2Kšžœ
žœ,˜<Kš
œ˜K˜—šŸœžœžœ˜8K˜Kšœ.žœ
žœ˜9Kš
œ˜K˜—šŸœ˜-˜
K˜EK˜K˜*K˜—Kšžœžœ˜:Kšžœžœ˜;Kšžœžœ˜<K˜K˜—šŸœžœ
žœ5žœžœ1žœžœ˜³
Kš
œ˜˜Kšœ'žœžœžœ:˜…
Kš
œ˜Kš
œ˜—˜Kšœ'žœžœžœ:˜…
Kš
œ-˜-Kš
œ2˜2Kš
œ˜—Kšœ+žœ˜=Kš
œJ˜JKš
œ!˜!Kš
œ˜—K˜šŸœ˜.Kšœžœ˜)K˜3šžœžœ
ž˜š
œ˜Kš
œ?˜?šžœž˜K˜9Kš
œ"˜"Kšžœ˜—K˜Kš
œ˜—Kšžœ˜—Kš
œ$˜$K˜—Kšžœ
˜K˜K˜—…—&œ2δ