<> <> <> <> <<>> DIRECTORY Ascii, Customize, KeyMapping, KeySymsHP, KeySymsOSF, KeySymsSun, Rope, Xl, XlCursor, XlCutBuffers, XlDB, XlFontOps, XlPerDepth, XTk, XTkBlinker, XTkCommon, XTkDB, XTkDelegation, XTkFriends, XTkLabels, XTkLabelsExtras, XTkOps, XTkPrivate; XTkLabelsImpl: CEDAR MONITOR IMPORTS Customize, KeyMapping, Rope, Xl, XlCutBuffers, XlDB, XlFontOps, XlPerDepth, XTk, XTkBlinker, XTkDB, XTkDelegation, XTkFriends, XTkOps, XTkPrivate EXPORTS XTkCommon, XTkLabels, XTkLabelsExtras SHARES XTk, XTkFriends = BEGIN OPEN XTkLabels; Widget: TYPE = XTk.Widget; WidgetSpec: TYPE = XTk.WidgetSpec; perDKey: XlPerDepth.Handle ¬ XlPerDepth.InstallHandle[InstallDepth]; queryDBFont: PUBLIC Xl.Font ¬ Xl.OpenFont[NIL, "fake"]; labelClass: PUBLIC XTk.Class ¬ LabClass[]; LabClass: PROC [] RETURNS [labelClass: XTk.ImplementorClass] = { labelClass ¬ XTkFriends.CreateClass[[ key: $Label, classNameHint: $Label, cDataNum: 1, wDataNum: 1, preferredSizeLR: LabPreferredSizeLR, actualCreateWindowLR: LabActualCreateWindowLR, fullStopFastAccessLR: LabFullStopFastAccessLR, initInstPart: LabelInitInstPart, forgetScreenLR: LabelForgetScreenLR, eventMask: [exposure: TRUE, structureNotify: TRUE, keyPress: TRUE, focusChange: TRUE], backgroundKey: $white ]]; labelClass.cClassData[labelClass.cDataIdx] ¬ NEW[LabelClassRec ¬ [ getText: LabelGetText, setText: LabelSetText, getStyleSpec: LabelGetStyleSpec, setStyleSpec: LabelSetStyleSpec, setStyleKey: LabelSetStyleKey ]]; }; NewLabelClassPart: PUBLIC PROC [subClass: XTk.ImplementorClass] RETURNS [newClassPart: REF LabelClassRec] = { oldClassPart: REF LabelClassRec ~ NARROW[subClass.cClassData[labelClass.cDataIdx]]; newClassPart ¬ NEW[LabelClassRec ¬ oldClassPart­]; subClass.cClassData[labelClass.cDataIdx] ¬ newClassPart; }; <<>> PerDepthRec: TYPE = RECORD [ actionTQ: Xl.TQ ¬ NIL, --share expose and paint threadqueues for labels of same connection labelExtraSpace: Xl.Size ¬ [-1, -1], grey1Pixmap, grey2Pixmap, grey3Pixmap, grey4Pixmap: Xl.Pixmap ]; stipple1Space: REF ARRAY [0..15] OF CARD32 = NEW[ARRAY [0..15] OF CARD32 ¬ [ 088888888H, 0, 022222222H, 0, 088888888H, 044444444H, 022222222H, 011111111H, CARD32.LAST, 0, 0, 0, CARD32.LAST, 088888888H, 088888888H, 088888888H ]]; InstallDepth: XlPerDepth.InitProc = { dd: REF PerDepthRec ¬ NEW[PerDepthRec]; IF sd#NIL AND Xl.Alive[sd.screen.connection] THEN { c: Xl.Connection ¬ sd.screen.connection; screen: Xl.Screen ¬ sd.screen; gc: Xl.GContext ¬ Xl.MakeGContext[c, screen.root.drawable]; Xl.SetGCGrounds[gc: gc, foreground: screen.blackPixel, background: screen.whitePixel]; dd.grey1Pixmap ¬ Xl.CreatePixmap[c, screen.root.drawable, [4, 4], sd.depth]; dd.grey2Pixmap ¬ Xl.CreatePixmap[c, screen.root.drawable, [4, 4], sd.depth]; dd.grey3Pixmap ¬ Xl.CreatePixmap[c, screen.root.drawable, [4, 4], sd.depth]; dd.grey4Pixmap ¬ Xl.CreatePixmap[c, screen.root.drawable, [4, 4], sd.depth]; TRUSTED { Xl.PutImage[c: c, drawable: dd.grey1Pixmap.drawable, gc: gc, size: [4, 4], dest: [0, 0], base: LOOPHOLE[@stipple1Space[0]], offx: 0, offy: 0, scanLineBytes: 4, bitsPerPixel: 1]; Xl.PutImage[c: c, drawable: dd.grey2Pixmap.drawable, gc: gc, size: [4, 4], dest: [0, 0], base: LOOPHOLE[@stipple1Space[4]], offx: 0, offy: 0, scanLineBytes: 4, bitsPerPixel: 1]; Xl.PutImage[c: c, drawable: dd.grey3Pixmap.drawable, gc: gc, size: [4, 4], dest: [0, 0], base: LOOPHOLE[@stipple1Space[8]], offx: 0, offy: 0, scanLineBytes: 4, bitsPerPixel: 1]; Xl.PutImage[c: c, drawable: dd.grey4Pixmap.drawable, gc: gc, size: [4, 4], dest: [0, 0], base: LOOPHOLE[@stipple1Space[12]], offx: 0, offy: 0, scanLineBytes: 4, bitsPerPixel: 1] }; XlDB.RegisterDBInvalidator[c, InvalidateDB, NIL, dd]; }; dd.actionTQ ¬ Xl.CreateTQ[$actionTQ]; RETURN [dd] }; InvalidateDB: Xl.EventProcType = { dd: REF PerDepthRec ¬ NARROW[clientData]; dd.labelExtraSpace.width ¬ -1; dd.labelExtraSpace.height ¬ -1; }; GetDepthData: PROC [w: XTk.Widget] RETURNS [REF PerDepthRec] = INLINE { RETURN [NARROW[XlPerDepth.InlineGetData[perDKey, w.screenDepth]]] }; LabData: TYPE = REF LabRec; LabRec: TYPE = RECORD [ text: Rope.ROPE ¬ NIL, insertPoint: INT ¬ LAST[INT], styleSpec: StyleSpec, off: Xl.Point ¬ [0, 0], gc: Xl.GContext ¬ NIL, --could we somehow share gc's? precomputed: BOOL ¬ FALSE ]; repaintDelayed: Xl.LocalEvent ~ NEW[Xl.EventRep.local]; repaintNow: Xl.LocalEvent ~ NEW[Xl.EventRep.local]; setStyle: Xl.LocalEvent ~ NEW[Xl.EventRep.local]; setCaretPosition: Xl.LocalEvent ~ NEW[Xl.EventRep.local]; labEvents: Xl.EventFilter ~ Xl.FullCreateEventFilter[LIST[expose, keyPress, destroyNotify, focusIn, focusOut]]; LabelEventProc: <>Xl.EventProcType = { ENABLE Xl.XError, UNCAUGHT => GOTO oops; widget: XTk.Widget ~ NARROW[clientData]; ld: LabData ~ GetInstData[widget]; IF widget.fastAccessAllowed#ok OR widget.state#realized THEN RETURN; WITH event SELECT FROM local: Xl.LocalEvent => { SELECT local FROM repaintNow => ImmediateRepaint[widget, ld, immediately, event]; repaintDelayed => ImmediateRepaint[widget, ld, delayed, event]; setStyle => { SetGCPartOfStyle[widget, ld, ld.styleSpec.styleKey]; SetWindowPartOfStyle[widget, ld, delayed]; }; setCaretPosition => ComputeCaretPosition[widget, ld]; ENDCASE => {} }; expose: Xl.ExposeEvent => { IF expose.count<=0 THEN ImmediateRepaint[widget, ld, delayed, event]; }; keyPress: Xl.KeyPressEvent => { mapping: Xl.KeyboardMapping ~ Xl.GetKeyboardMapping[event.connection]; keySyms: KeyMapping.KeySyms ~ KeyMapping.GetKeySyms[mapping, keyPress.keyCode]; FOR n: BYTE IN [0..keySyms.n) DO keySym: Xl.KeySym ~ keySyms[n]; IF keySym=KeySymsSun.Copy OR keySym=KeySymsSun.Paste OR keySym=KeySymsHP.Copy OR keySym=KeySymsHP.Paste OR keySym=KeySymsOSF.Copy OR keySym=KeySymsOSF.Paste THEN { CutLabelValue[widget, keyPress.state=[]]; EXIT }; ENDLOOP }; ev: Xl.FocusInEvent => { SELECT ev.detail FROM inferior, ancestor, nonlinear => XTkBlinker.BlinkerOn[widget, $focus]; ENDCASE => {} }; ev: Xl.FocusOutEvent => { SELECT ev.detail FROM <<--separated only for debugging reasons>> inferior => XTkBlinker.BlinkerOff[widget, $focus]; ancestor => XTkBlinker.BlinkerOff[widget, $focus]; nonlinear => XTkBlinker.BlinkerOff[widget, $focus]; ENDCASE => {} }; destroyNotify: Xl.DestroyNotifyEvent => { IF destroyNotify.window=widget.window AND ~Xl.ClientRequested[event] THEN XTkFriends.PreStopFastAccess[widget, errorWindow] }; ENDCASE => {}; EXITS oops => {}; }; ForkSetStyle: PROC [widget: Widget, ld: LabData, repaint: RepaintMode ¬ immediately] = { IF widget.fastAccessAllowed=ok AND widget.state=realized THEN { dd: REF PerDepthRec _ GetDepthData[widget]; Xl.Enqueue[dd.actionTQ, LabelEventProc, widget, setStyle]; SELECT repaint FROM immediately => Xl.Enqueue[dd.actionTQ, LabelEventProc, widget, repaintNow]; delayed => Xl.Enqueue[dd.actionTQ, LabelEventProc, widget, repaintDelayed]; ENDCASE => {}; }; }; ForkRepaint: PROC [widget: Widget, ld: LabData, repaint: RepaintMode ¬ immediately] = { IF widget.fastAccessAllowed=ok AND widget.state=realized THEN { dd: REF PerDepthRec _ GetDepthData[widget]; SELECT repaint FROM immediately => Xl.Enqueue[dd.actionTQ, LabelEventProc, widget, repaintNow]; delayed => Xl.Enqueue[dd.actionTQ, LabelEventProc, widget, repaintDelayed]; ENDCASE => {}; }; }; ForkComputeCaretPosition: PROC [widget: Widget, ld: LabData, repaint: RepaintMode ¬ immediately] = { IF widget.fastAccessAllowed=ok AND widget.state=realized THEN { dd: REF PerDepthRec _ GetDepthData[widget]; Xl.Enqueue[dd.actionTQ, LabelEventProc, widget, setCaretPosition]; }; }; ComputeCaretPosition: PROC [widget: Widget, ld: LabData] = { c: Xl.Connection ¬ widget.connection; off: Xl.Point ¬ ld.off; text: Rope.ROPE ¬ ld.text; charPos: INT ¬ MIN[Rope.Length[text], ld.insertPoint]; font: Xl.Font ¬ ld.styleSpec.font; te: Xl.TextExtentsRec; IF widget.fastAccessAllowed#ok OR widget.state#realized OR ~Xl.Alive[c] THEN RETURN; te ¬ Xl.QueryTextExtents[c, font, Rope.Substr[text, 0, charPos] ! Xl.XError => GOTO Oops]; off.x ¬ MIN[off.x+te.overallRight, widget.actual.size.width-2]; XTkBlinker.BlinkerSetPos[widget, $focus, off]; EXITS Oops => {} }; ImmediateRepaint: PROC [widget: Widget, ld: LabData, repaint: XTkCommon.RepaintMode ¬ immediately, event: Xl.Event ¬ NIL] = { c: Xl.Connection ~ widget.connection; window: Xl.Window ~ widget.window; IF widget.fastAccessAllowed#ok OR widget.state#realized OR ~Xl.Alive[c] THEN RETURN; Xl.ClearArea[c, window, [0, 0], [4000, 4000], FALSE, XTkPrivate.detailsForNoErrors]; Xl.DrawRope[c, window, ld.off, ld.gc, ld.text, 0, XTkPrivate.detailsForNoErrors]; XTkFriends.CallNotifiers[widget, $LabelRepaint, NIL, event]; SELECT repaint FROM immediately => Xl.Flush[c]; delayed => Xl.Flush[c, TRUE]; ENDCASE => {}; }; EnforceConnection: PROC [widget: Widget] RETURNS [c: Xl.Connection] = { IF widget.connection#NIL THEN RETURN [widget.connection]; IF widget.parent#NIL THEN c ¬ widget.connection ¬ EnforceConnection[widget.parent]; }; GetDefaultFont: PUBLIC PROC [c: Xl.Connection] RETURNS [font: Xl.Font] = { RETURN [XlFontOps.GetDefaultFont[c]] }; NiceOpenFont: PROC [c: Xl.Connection, name: Rope.ROPE] RETURNS [Xl.Font ¬ Xl.nullFont] = { font: Xl.Font; IF Rope.IsEmpty[name] OR ~Xl.Alive[c] THEN RETURN; font ¬ Xl.OpenFont[c, name, XTkPrivate.detailsForSynchronous ! Xl.XError => GOTO Oops]; RETURN [font]; EXITS Oops => {}; }; QueryFontName: PROC [widget: Widget] RETURNS [Rope.ROPE ¬ NIL] = { WITH XTkDB.DoQueryFromWidget[w: widget, screenPrefix: TRUE, key1: $FontName] SELECT FROM r: Rope.ROPE => RETURN [r]; ENDCASE => {}; }; LocalSetFont: PROC [widget: Widget, ld: LabData, font: Xl.Font] = { <<--Any thread ok: because the critical change of state happens in single ref assignment.>> IF font=queryDBFont THEN { fontName: Rope.ROPE ¬ QueryFontName[widget]; font ¬ NiceOpenFont[widget.connection, fontName]; }; IF font=Xl.nullFont THEN { val: REF ¬ XTkOps.GetWidgetPropStar[widget, $LabelFont].val; WITH val SELECT FROM r: Rope.ROPE => {font ¬ NiceOpenFont[widget.connection, r]}; ENDCASE => {IF Xl.IsFont[val] THEN font ¬ Xl.NarrowFont[val]}; IF font=queryDBFont THEN font ¬ Xl.nullFont; IF font=Xl.nullFont THEN font ¬ XlFontOps.GetDefaultFont[widget.connection]; }; ld.styleSpec.font ¬ font; }; defaultLabelWExtension: NAT = 3; defaultLabelHExtension: NAT = 3; LabPreComputations: PROC [widget: Widget, ld: LabData] = { connection: Xl.Connection ¬ EnforceConnection[widget]; LocalSetFont[widget, ld, ld.styleSpec.font]; <<--get the size >> BEGIN ext: Xl.TextExtentsRec ¬ Xl.QueryTextExtents[connection, ld.styleSpec.font, ld.text]; space: Xl.Size ¬ ld.styleSpec.space; IF space.width<0 THEN { dd: REF PerDepthRec ¬ GetDepthData[widget]; space.width ¬ dd.labelExtraSpace.width; IF space.width<0 THEN { dbx: Customize.DBreadonly ¬ XlDB.GetStandardDB[connection]; x: REF ¬ Customize.DoQueryString[dbx, "(Cedar)(defaultLabelWExtension)"]; dd.labelExtraSpace.width ¬ space.width ¬ XTkDB.ScanInt[x]; }; IF space.width<0 OR space.width>50 THEN space.width ¬ defaultLabelWExtension; <> }; IF space.height<0 THEN { dd: REF PerDepthRec ¬ GetDepthData[widget]; space.height ¬ dd.labelExtraSpace.height; IF space.height<0 THEN { dbx: Customize.DBreadonly ¬ XlDB.GetStandardDB[connection]; x: REF ¬ Customize.DoQueryString[dbx, "(Cedar)(defaultLabelHExtension)"]; dd.labelExtraSpace.height ¬ space.height ¬ XTkDB.ScanInt[x]; }; IF space.height<0 OR space.height>50 THEN space.height ¬ defaultLabelHExtension; <> }; IF widget.s.geometry.size.width<=0 THEN { widget.s.geometry.size.width ¬ 2*space.width+ext.overallLeft+ext.overallRight; }; IF widget.s.geometry.size.height<=0 THEN { widget.s.geometry.size.height ¬ 2*space.height+ext.fontAscent+ext.fontDescent; }; ld.off.x ¬ space.width+ext.overallLeft; ld.off.y ¬ space.height+ext.fontAscent; END; ld.precomputed ¬ TRUE; }; LabPreferredSizeLR: XTk.PreferredSizeProc = { ld: LabData ~ GetInstData[widget]; IF ~ld.precomputed THEN LabPreComputations[widget, ld]; RETURN [widget.s.geometry]; }; LabFullStopFastAccessLR: XTk.FullStopFastAccessProc = { dd: REF PerDepthRec ~ GetDepthData[widget]; IF dd#NIL AND dd.actionTQ#NIL THEN protectTQLR[dd.actionTQ]; }; LabActualCreateWindowLR: XTk.WidgetProc = { dd: REF PerDepthRec ~ GetDepthData[widget]; ld: LabData ~ GetInstData[widget]; IF ~ld.precomputed THEN LabPreComputations[widget, ld]; XTk.AddTemporaryMatch[widget, [proc: LabelEventProc, handles: labEvents, tq: dd.actionTQ, data: widget], labelClass.eventMask]; IF widget.attributes.bitGravity=illegal THEN widget.attributes.bitGravity ¬ northWest; ld.gc ¬ Xl.MakeGContext[widget.connection, widget.parent.window.drawable]; Xl.SetGCFont[ld.gc, ld.styleSpec.font]; --is available since precomputed! Xl.SetGCGraphicsExposures[ld.gc, FALSE]; SetGCPartOfStyle[widget, ld, ld.styleSpec.styleKey]; XTkFriends.DontMapCreateWindowLR[widget]; IF ld.styleSpec.styleKey#NIL THEN SetWindowPartOfStyle[widget, ld, dont]; IF widget.actualMapping=mapped THEN Xl.MapWindow[widget.connection, widget.window]; ForkComputeCaretPosition[widget, ld]; }; focusBlinkerClass: XTkBlinker.BlinkerClass ¬ XTkBlinker.NewBlinkerClass[createProc: CreateFocusBlinker]; CreateFocusBlinker: XTkBlinker.CreateOverlayProc = { myGeometry: Xl.Geometry ~ [pos: [pos.x, pos.y], size: [4, 6], borderWidth: 0]; sd: Xl.ScreenDepth ~ parent.screenDepth; attributes.backgroundPixel ¬ sd.screen.blackPixel; geometry ¬ [pos: [0, 0], size: [4, 6], borderWidth: 0]; w ¬ Xl.CreateWindow[c: parent.connection, matchList: NIL, parent: parent.window, class: inputOutput, geometry: myGeometry, attributes: attributes]; }; LabelInitInstPart: XTk.InitInstancePartProc = { ld: LabData ~ NEW[LabRec]; XTkFriends.AssignInstPart[widget, labelClass, ld]; XTkBlinker.InstallBlinker[widget, $focus, focusBlinkerClass, FALSE]; }; LabelForgetScreenLR: XTk.TerminateProc = { ld: LabData ~ GetInstData[widget]; ld.precomputed ¬ FALSE; ld.gc ¬ NIL; ld.styleSpec.font ¬ Xl.nullFont; }; CreateLabel: PUBLIC PROC [widgetSpec: WidgetSpec, text: Rope.ROPE ¬ NIL, style: StyleSpec ¬ []] RETURNS [Widget] = { widget: Widget ~ XTk.CreateWidget[widgetSpec, labelClass]; ld: LabData ~ GetInstData[widget]; ld.text ¬ text; ld.styleSpec ¬ style; RETURN [widget] }; GetInstData: PROC [w: Widget] RETURNS [LabData] = INLINE { RETURN [NARROW[XTkFriends.InstPart[w, labelClass]]]; }; GetLabelClassPart: PROC [w: Widget] RETURNS [REF LabelClassRec] = INLINE { RETURN [NARROW[XTkFriends.ClassPart[w, labelClass]]] }; GetText: PUBLIC PROC [widget: Widget] RETURNS [text: Rope.ROPE] = { w: Widget ~ XTkDelegation.InlineSingleDelegant[widget, labelClass.key, $TextDelegation]; RETURN [GetLabelClassPart[w].getText[w]]; }; LabelGetText: PROC [widget: Widget] RETURNS [text: Rope.ROPE] = { RETURN [GetInstData[widget].text]; }; SetText: PUBLIC PROC [widget: Widget, text: Rope.ROPE, repaint: RepaintMode ¬ immediately] = { w: Widget ~ XTkDelegation.InlineSingleDelegant[widget, labelClass.key, $TextDelegation]; GetLabelClassPart[w].setText[w, text, repaint]; }; LabelSetText: PROC [widget: Widget, text: Rope.ROPE, repaint: RepaintMode] = { <> ld: LabData ~ GetInstData[widget]; ld.text ¬ text; IF repaint#dont THEN ForkRepaint[widget, ld, delayed]; ForkComputeCaretPosition[widget, ld]; }; EntrySetStyleSpec: ENTRY PROC [ld: LabData, style: StyleSpec] = { IF ld#NIL THEN ld.styleSpec ¬ style }; EntryGetStyleSpec: ENTRY PROC [ld: LabData] RETURNS [style: StyleSpec] = { IF ld#NIL THEN style ¬ ld.styleSpec }; SetGCPartOfStyle: PROC [widget: XTk.Widget, ld: LabData, style: ATOM] = { screen: Xl.Screen ~ widget.screenDepth.screen; Xl.SetGCFillStyle[ld.gc, solid]; SELECT style FROM NIL => { Xl.SetGCForeground[ld.gc, screen.blackPixel]; Xl.SetGCBackground[ld.gc, screen.whitePixel]; }; $invert, $WhiteOnBlack => { Xl.SetGCForeground[ld.gc, screen.whitePixel]; Xl.SetGCBackground[ld.gc, screen.blackPixel]; }; ENDCASE => { Xl.SetGCForeground[ld.gc, screen.blackPixel]; Xl.SetGCBackground[ld.gc, screen.whitePixel]; }; }; GetStyleSpec: PUBLIC PROC [widget: Widget] RETURNS [style: StyleSpec] = { w: Widget ~ XTkDelegation.InlineSingleDelegant[widget, labelClass.key, $TextDelegation]; ld: LabData ~ GetInstData[w]; RETURN [EntryGetStyleSpec[ld]]; }; SetStyleSpec: PUBLIC PROC [widget: Widget, style: StyleSpec, repaint: RepaintMode ¬ immediately] = { <> <> MultiDelegation: PROC [delegant: Widget] = {SetStyleSpec[delegant, style, dont]}; IF XTkDelegation.InlineDidMultiDelegation[widget, labelClass.key, $TextDelegationSetStyle, MultiDelegation] THEN { SELECT repaint FROM immediately => Xl.Flush[widget.connection]; delayed => Xl.Flush[widget.connection, TRUE]; ENDCASE => {}; } ELSE { GetLabelClassPart[widget].setStyleSpec[widget, style, repaint]; } }; SetStyleKey: PUBLIC PROC [widget: Widget, styleKey: ATOM, repaint: RepaintMode ¬ immediately] = { <> <> MultiDelegation: PROC [delegant: Widget] = {SetStyleKey[delegant, styleKey, dont]}; IF XTkDelegation.InlineDidMultiDelegation[widget, labelClass.key, $TextDelegationSetStyle, MultiDelegation] THEN { SELECT repaint FROM immediately => Xl.Flush[widget.connection]; delayed => Xl.Flush[widget.connection, TRUE]; ENDCASE => {}; } ELSE { GetLabelClassPart[widget].setStyleKey[widget, styleKey, repaint]; } }; LabelSetStyleKey: PROC [widget: Widget, style: ATOM, repaint: RepaintMode ¬ immediately] = { ld: LabData ~ GetInstData[widget]; ld.styleSpec.styleKey ¬ style; IF repaint#dont THEN ForkSetStyle[widget, ld, repaint]; }; LabelGetStyleSpec: PROC [widget: Widget] RETURNS [style: StyleSpec] = { ld: LabData ~ GetInstData[widget]; style ¬ EntryGetStyleSpec[ld]; }; LabelSetStyleSpec: PROC [widget: Widget, style: StyleSpec, repaint: RepaintMode ¬ immediately] = { ld: LabData ~ GetInstData[widget]; EntrySetStyleSpec[ld, style]; IF repaint#dont THEN ForkSetStyle[widget, ld, repaint]; }; SetWindowPartOfStyle: PROC [widget: Widget, ld: LabData, repaint: RepaintMode ¬ immediately] = { dd: REF PerDepthRec ~ GetDepthData[widget]; SELECT ld.styleSpec.styleKey FROM NIL, $BlackOnWhite => { Xl.ChangeWindowAttributes[c: widget.connection, window: widget.window, attributes: [backgroundPixel: widget.screenDepth.screen.whitePixel], details: XTkPrivate.detailsForNoErrors]; }; $invert, $WhiteOnBlack => { Xl.ChangeWindowAttributes[c: widget.connection, window: widget.window, attributes: [backgroundPixel: widget.screenDepth.screen.blackPixel], details: XTkPrivate.detailsForNoErrors]; }; $BlackOnGray, $Gray1 => { Xl.ChangeWindowAttributes[c: widget.connection, window: widget.window, attributes: [backgroundPixmap: dd.grey1Pixmap], details: XTkPrivate.detailsForNoErrors]; }; $Gray2 => { Xl.ChangeWindowAttributes[c: widget.connection, window: widget.window, attributes: [backgroundPixmap: dd.grey2Pixmap], details: XTkPrivate.detailsForNoErrors]; }; $Gray3 => { Xl.ChangeWindowAttributes[c: widget.connection, window: widget.window, attributes: [backgroundPixmap: dd.grey3Pixmap], details: XTkPrivate.detailsForNoErrors]; }; $Gray4 => { Xl.ChangeWindowAttributes[c: widget.connection, window: widget.window, attributes: [backgroundPixmap: dd.grey4Pixmap], details: XTkPrivate.detailsForNoErrors]; }; ENDCASE => {}; }; CutLabelValue: PROC [label: XTk.Widget, hackForXTerm: BOOL ¬ FALSE] = { text: Rope.ROPE ~ GetText[label]; XlCutBuffers.Put[label.connection, text]; }; <<>> SetCharInsertionIndex: PUBLIC PROC [label: XTk.Widget, pos: INT, repaint: RepaintMode ¬ immediately] = { c: Xl.Connection ~ label.connection; ld: LabData ~ GetInstData[label]; ld.insertPoint ¬ pos; IF Xl.Alive[c] THEN { dd: REF PerDepthRec ~ GetDepthData[label]; Xl.Enqueue[dd.actionTQ, LabelEventProc, label, setCaretPosition]; }; }; SetCharInsertionPos: PUBLIC PROC [label: XTk.Widget, pos: Xl.Point, repaint: RepaintMode ¬ immediately] = { i: INT ¬ ToCharPos[label, pos]; SetCharInsertionIndex[label, i, repaint]; }; GetCharInsertionIndex: PUBLIC PROC [label: XTk.Widget] RETURNS [pos: INT] = { ld: LabData ~ GetInstData[label]; RETURN [ld.insertPoint] }; ToCharPos: PUBLIC PROC [label: XTk.Widget, pos: Xl.Point] RETURNS [cpos: INT ¬ 0] = { ENABLE Xl.XError => GOTO Oops; ld: LabData ~ GetInstData[label]; c: Xl.Connection ¬ label.connection; font: Xl.Font ¬ ld.styleSpec.font; IF label.fastAccessAllowed#ok OR label.state#realized OR ~Xl.Alive[c] THEN RETURN; cpos ¬ XlFontOps.QueryPosInfo[c, font, ld.text, pos.x-ld.off.x].gapIndex; EXITS Oops => {} }; END.