XTkNumberLabelImpl.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, March 31, 1992 12:50 pm PST
Christian Jacobi, April 20, 1992 4:27 pm PDT
DIRECTORY
Ascii,
Convert,
IO,
KeySymsKB,
KeySymsSun,
KeySymsOSF,
KeySymsHP,
Rope,
Xl,
XlAscii,
XlCursor,
XlCutBuffers,
XTk,
XTkCommon,
XTkNumberLabel,
XTkFriends,
XTkLabels,
XTkInputFocus;
XTkNumberLabelImpl:
CEDAR
MONITOR
IMPORTS Convert, IO, Xl, XlAscii, XlCutBuffers, XTk, XTkLabels, XTkNumberLabel, XTkFriends, XTkInputFocus
EXPORTS XTkNumberLabel =
BEGIN
Widget: TYPE = XTk.Widget;
WidgetSpec: TYPE = XTk.WidgetSpec;
StyleSpec: TYPE = XTkCommon.StyleSpec;
NumberFilter: TYPE = XTkNumberLabel.NumberFilter;
valueChangedKey: PUBLIC REF ¬ $XTkNumberLabelChanged;
classImplementsFocus: XTk.ClassFlagKey ~ cf1;
events: Xl.EventFilter ~ Xl.CreateEventFilter[keyPress, buttonPress];
listOfSpecials: LIST OF Xl.KeySym ~ LIST[KeySymsSun.Paste, KeySymsOSF.Paste, KeySymsHP.Paste, KeySymsKB.Stop, KeySymsKB.Next, KeySymsKB.MoveRight];
numberClass: XTk.Class ¬ MakeClass[];
MakeClass:
PROC []
RETURNS [c: XTk.ImplementorClass] = {
c ¬ XTkFriends.CreateClass[basicMethods: [
key: $Number,
super: XTkLabels.labelClass,
initInstPart: NumberInitInstPart,
preferredSizeLR: NumberPreferredSize,
wDataNum: 1,
cursorKey: NEW[XlCursor.StandardFontCursors ¬ centerPtr]
]];
XTk.SetClassFlag[c, classImplementsFocus];
};
NumberData: TYPE = REF NumberDataRec;
NumberDataRec:
TYPE =
RECORD[
val: INT ← -1,
editable: BOOL ← FALSE,
filter: REF FilterRec ¬ NIL
];
FilterRec: TYPE = RECORD [proc: NumberFilter, data: REF];
GetNumberData:
PROC [widget: XTk.Widget]
RETURNS [numberData: NumberData] =
INLINE {
numberData ← NARROW[XTkFriends.InstPart[widget, numberClass]];
};
NumberInitInstPart: XTk.InitInstancePartProc = {
numberData: NumberData ~ NEW[NumberDataRec];
XTkFriends.AssignInstPart[widget, numberClass, numberData];
XTk.AddPermanentMatch[widget, [proc: EventProc, handles: events, tq: Xl.CreateTQ[], data: widget], [keyPress: TRUE, buttonPress: TRUE]];
};
EventProc: Xl.EventProcType = {
ENABLE {
Xl.XError => GOTO oops;
};
Beep:
PROC [] = {
Xl.Bell[event.connection, 100];
};
widget: XTk.Widget ~ NARROW[clientData];
numberData: NumberData ~ GetNumberData[widget];
IF ~numberData.editable
THEN {
Beep[];
RETURN;
};
WITH event
SELECT
FROM
keyPress: Xl.KeyPressEvent => {
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 {
sel: Rope.ROPE ¬ XlCutBuffers.Get[widget.connection];
val: INT ← Convert.IntFromRope[r: sel ! Convert.Error => {Beep[]; GOTO oops}];
IF val<=LAST[NAT] AND val>=0 THEN SetVal[widget, val];
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;
};
IF char
IN ['0..'9]
THEN {
val: INT ¬ GetVal[widget];
digit: INT ~ ORD[char]-ORD['0];
IF val<=LAST[NAT]/10 THEN val ¬ val*10 ELSE {val ¬ LAST[NAT]; Beep[]};
IF val<=LAST[NAT]-digit THEN val ¬ val+digit ELSE {val ¬ LAST[NAT]; Beep[]};
SetVal[widget, val];
RETURN;
};
IF char=Ascii.
BS
THEN {
val: INT ¬ GetVal[widget];
val ¬ val/10;
SetVal[widget, val];
RETURN;
};
Beep[];
};
buttonPress: Xl.ButtonPressEvent => {
XTkInputFocus.SetFocus[widget, buttonPress.timeStamp];
};
ENDCASE => {};
EXITS oops => {};
};
Redisplay: XTk.WidgetNotifyProc = {
ValToText:
PROC [val:
NAT]
RETURNS [r: Rope.
ROPE] = {
r ← IO.PutFR1["%5d", IO.int[val]];
};
val: NAT ¬ GetVal[widget];
XTkLabels.SetText[widget, ValToText[val]];
};
IsNumberLabel:
PUBLIC
PROC [widget: XTk.Widget]
RETURNS [
BOOL] = {
RETURN [widget#NIL AND XTk.HasClass[widget, numberClass]];
};
Create:
PUBLIC
PROC [widgetSpec: XTk.WidgetSpec, init:
NAT, filter: NumberFilter ¬
NIL, filterData:
REF ¬
NIL, style: StyleSpec, editable:
BOOL]
RETURNS [w: XTk.Widget] = {
widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, numberClass];
w ¬ XTkLabels.CreateLabel[widgetSpec: widgetSpec, style: style];
XTk.RegisterNotifier[w, XTkNumberLabel.valueChangedKey, Redisplay];
SetFilter[w, filter, filterData];
SetVal[w, init];
SetEditable[w, editable];
};
GetVal:
PUBLIC
PROC [widget: XTk.Widget]
RETURNS [value:
NAT] = {
numberData: NumberData ~ GetNumberData[widget];
value ← MAX[numberData.val, 0];
};
SetFilter:
PUBLIC
PROC [widget: XTk.Widget, filter: NumberFilter ¬
NIL, filterData:
REF ¬
NIL] = {
numberData: NumberData ~ GetNumberData[widget];
newFilter: REF FilterRec ← NIL;
IF filter#
NIL
THEN {
newFilter ¬ NEW[FilterRec ¬ [filter, filterData]]
};
numberData.filter ¬ newFilter
};
SetVal:
PUBLIC
PROC [widget: XTk.Widget, value:
NAT, event: XTk.Event ¬
NIL] = {
numberData: NumberData ~ GetNumberData[widget];
IF numberData.val#value
THEN {
new: NAT ← value; inhibit: BOOL ¬ FALSE;
filter: REF FilterRec ← numberData.filter;
IF filter#NIL THEN [new, inhibit] ¬ filter.proc[widget, filter.data, value, event];
IF ~inhibit THEN InternalSetVal[widget, new, event];
};
};
InternalSetVal:
PUBLIC
PROC [widget: XTk.Widget, value:
NAT, event: XTk.Event ¬
NIL] = {
numberData: NumberData ~ GetNumberData[widget];
IF numberData.val#value
THEN {
numberData.val ← value;
XTkFriends.CallNotifiers[widget, XTkNumberLabel.valueChangedKey, NIL, event];
};
};
SetEditable:
PUBLIC PROC [widget: XTk.Widget, editable:
BOOL] = {
numberData: NumberData ~ GetNumberData[widget];
numberData.editable ← editable;
};
NumberPreferredSize: 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 widget.s.geometry.borderWidth ¬ preferred.borderWidth ¬ 0;
IF preferred.size.width<=0 THEN widget.s.geometry.size.width ¬ preferred.size.width ¬ 60;
IF preferred.size.height<=0 THEN widget.s.geometry.size.height ¬ preferred.size.height ¬ 20;
};
END.