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
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.PopUp[fd.pseudoBase, bp];
XTkPopUps.PopUpWithRegularShell[createMenu: menuClosure, registerData: widget, header: "Field values", screen: widget.screenDepth.screen]
};
ENDCASE => {};
};
3 => {
XTkPopUps.PopUp[fd.pseudoBase, bp];
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];
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;
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.