1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163 |
- MODULE Controls;
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Controls.odc *)
- (* DO NOT EDIT *)
- IMPORT
- Kernel, Dates, Dialog, Meta, Services, Stores, Views, Properties,
- Strings, Fonts, Ports, Controllers, Windows, StdCFrames;
- CONST
- (** elements of Property.valid **)
- opt0* = 0; opt1* = 1; opt2* = 2; opt3* = 3; opt4* = 4;
- link* = 5; label* = 6; guard* = 7; notifier* = 8; level* = 9;
- default* = opt0; cancel* = opt1;
- left* = opt0; right* = opt1; multiLine* = opt2; password* = opt3;
- sorted* = opt0;
- haslines* = opt1; hasbuttons* = opt2; atroot* = opt3; foldericons* = opt4;
- minVersion = 0; maxBaseVersion = 4;
- pbVersion = 0; cbVersion = 0; rbVersion = 0; fldVersion = 0;
- dfldVersion = 0; tfldVersion = 0; cfldVersion = 0;
- lbxVersion = 0; sbxVersion = 0; cbxVersion = 0; capVersion = 1; grpVersion = 0;
- tfVersion = 0;
- rdel = 07X; ldel = 08X; tab = 09X; ltab = 0AX; lineChar = 0DX; esc = 01BX;
- arrowLeft = 1CX; arrowRight = 1DX; arrowUp = 1EX; arrowDown = 1FX;
- update = 2; (* notify options *)
- listUpdate = 3;
- guardCheck = 4;
- flushCaches = 5; (* re-map labels for flushed string resources, after a language change *)
-
- maxAdr = 8;
- TYPE
- Prop* = POINTER TO RECORD (Properties.Property)
- opt*: ARRAY 5 OF BOOLEAN;
- link*: Dialog.String;
- label*: Dialog.String;
- guard*: Dialog.String;
- notifier*: Dialog.String;
- level*: INTEGER
- END;
-
- Directory* = POINTER TO ABSTRACT RECORD END;
- Control* = POINTER TO ABSTRACT RECORD (Views.View)
- item-: Meta.Item;
- disabled-, undef-, readOnly-, customFont-: BOOLEAN;
- font-: Fonts.Font;
- label-: Dialog.String;
- prop-: Prop;
- adr: ARRAY maxAdr OF INTEGER;
- num: INTEGER;
- stamp: INTEGER;
- shortcut: CHAR;
- guardErr, notifyErr: BOOLEAN
- END;
- DefaultsPref* = RECORD (Properties.Preference)
- disabled*: BOOLEAN; (** OUT, preset to ~c.item.Valid() *)
- undef*: BOOLEAN; (** OUT, preset to FALSE *)
- readOnly*: BOOLEAN (** OUT, preset to c.item.vis = readOnly *)
- END;
- PropPref* = RECORD (Properties.Preference)
- valid*: SET (** OUT, preset to {link, label, guard, notifier, customFont} *)
- END;
- PushButton = POINTER TO RECORD (Control) END;
- CheckBox = POINTER TO RECORD (Control) END;
- RadioButton = POINTER TO RECORD (Control) END;
- Field = POINTER TO RECORD (Control)
- maxLen: INTEGER
- END;
- UpDownField = POINTER TO RECORD (Control)
- min, max, inc: INTEGER
- END;
- DateField = POINTER TO RECORD (Control)
- selection: INTEGER (* 0: no selection, 1..n-1: this part selected, -1: part n selected *)
- END;
- TimeField = POINTER TO RECORD (Control)
- selection: INTEGER
- END;
- ColorField = POINTER TO RECORD (Control) END;
- ListBox = POINTER TO RECORD (Control) END;
- SelectionBox = POINTER TO RECORD (Control) END;
- ComboBox = POINTER TO RECORD (Control) END;
- Caption = POINTER TO RECORD (Control) END;
- Group = POINTER TO RECORD (Control) END;
- TreeControl = POINTER TO RECORD (Control) END;
- StdDirectory = POINTER TO RECORD (Directory) END;
- Op = POINTER TO RECORD (Stores.Operation)
- ctrl: Control;
- prop: Prop
- END;
- FontOp = POINTER TO RECORD (Stores.Operation)
- ctrl: Control;
- font: Fonts.Font;
- custom: BOOLEAN
- END;
- NotifyMsg = RECORD (Views.NotifyMsg)
- frame: Views.Frame;
- op, from, to: INTEGER
- END;
- UpdateCachesMsg = RECORD (Views.UpdateCachesMsg) END;
- SelectPtr = POINTER TO Dialog.Selection;
-
- ProcValue = RECORD (Meta.Value) p*: PROCEDURE END;
- SelectValue = RECORD (Meta.Value) p*: SelectPtr END;
- GuardProcVal = RECORD (Meta.Value) p*: Dialog.GuardProc END;
- NotifyProcValOld = RECORD (Meta.Value) p*: PROCEDURE (op, from, to: INTEGER) END;
- GuardProcPVal = RECORD (Meta.Value) p*: PROCEDURE(n: INTEGER; VAR p: Dialog.Par) END;
- NotifyProcPVal = RECORD (Meta.Value) p*: PROCEDURE(n, op, f, t: INTEGER) END;
- Param = RECORD from, to, i: INTEGER; n: Dialog.String END;
-
- TVParam = RECORD l: INTEGER; e: BOOLEAN; nodeIn, nodeOut: Dialog.TreeNode END;
- Action = POINTER TO RECORD (Services.Action)
- w: Windows.Window;
- resolution, cnt: INTEGER
- END;
- TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
- VAR
- dir-, stdDir-: Directory;
- par-: Control;
- stamp: INTEGER;
- action: Action;
- cleaner: TrapCleaner;
- cleanerInstalled: INTEGER;
- (** Cleaner **)
- PROCEDURE (c: TrapCleaner) Cleanup;
- BEGIN
- par := NIL;
- cleanerInstalled := 0
- END Cleanup;
- PROCEDURE (c: Control) Update- (f: Views.Frame; op, from, to: INTEGER), NEW, EMPTY;
- PROCEDURE (c: Control) UpdateList- (f: Views.Frame), NEW, EMPTY;
- PROCEDURE (c: Control) CheckLink- (VAR ok: BOOLEAN), NEW, EMPTY;
- PROCEDURE (c: Control) HandlePropMsg2- (VAR p: Views.PropMessage), NEW, EMPTY;
- PROCEDURE (c: Control) HandleViewMsg2- (f: Views.Frame; VAR msg: Views.Message), NEW, EMPTY;
- PROCEDURE (c: Control) HandleCtrlMsg2- (f: Views.Frame; VAR msg: Views.CtrlMessage;
- VAR focus: Views.View), NEW, EMPTY;
- PROCEDURE (c: Control) Externalize2- (VAR wr: Stores.Writer), NEW, EMPTY;
- PROCEDURE (c: Control) Internalize2- (VAR rd: Stores.Reader), NEW, EMPTY;
- (* auxiliary procedures *)
- PROCEDURE IsShortcut (ch: CHAR; c: Control): BOOLEAN;
- BEGIN
- IF (ch >= "a") & (ch <= "z") OR (ch >= 0E0X) THEN ch := CAP(ch) END;
- RETURN ch = c.shortcut
- END IsShortcut;
- PROCEDURE ExtractShortcut (c: Control);
- VAR label: Dialog.String; i: INTEGER; ch, sCh: CHAR;
- BEGIN
- Dialog.MapString(c.label, label);
- i := 0; ch := label[0]; sCh := "&";
- WHILE sCh = "&" DO
- WHILE (ch # 0X) & (ch # "&") DO INC(i); ch := label[i] END;
- IF ch = 0X THEN sCh := 0X
- ELSE INC(i); sCh := label[i]; INC(i); ch := label[i]
- END
- END;
- IF (sCh >= "a") & (sCh <= "z") OR (sCh >= 0E0X) THEN sCh := CAP(sCh) END;
- c.shortcut := sCh
- END ExtractShortcut;
- PROCEDURE GetGuardProc (name: ARRAY OF CHAR; VAR i: Meta.Item; VAR err: BOOLEAN;
- VAR par: BOOLEAN; VAR n: INTEGER);
- VAR j, k, e: INTEGER; num: ARRAY 32 OF CHAR;
- BEGIN
- j := 0;
- WHILE (name[j] # 0X) & (name[j] # "(") DO INC(j) END;
- IF name[j] = "(" THEN
- INC(j); k := 0;
- WHILE (name[j] # 0X) & (name[j] # ")") DO num[k] := name[j]; INC(j); INC(k) END;
- IF (name[j] = ")") & (name[j+1] = 0X) THEN
- num[k] := 0X; Strings.StringToInt(num, n, e);
- IF e = 0 THEN
- name[j - k - 1] := 0X;
- Meta.LookupPath(name, i); par := TRUE
- ELSE
- IF ~err THEN
- Dialog.ShowParamMsg("#System:SyntaxErrorIn", name, "", "");
- err := TRUE
- END;
- Meta.Lookup("", i);
- RETURN
- END
- ELSE
- IF ~err THEN
- Dialog.ShowParamMsg("#System:SyntaxErrorIn", name, "", "");
- err := TRUE
- END;
- Meta.Lookup("", i);
- RETURN
- END
- ELSE
- Meta.LookupPath(name, i); par := FALSE
- END;
- IF (i.obj = Meta.procObj) OR (i.obj = Meta.varObj) & (i.typ = Meta.procTyp) THEN (*ok *)
- ELSE
- IF ~err THEN
- IF i.obj = Meta.undef THEN
- Dialog.ShowParamMsg("#System:NotFound", name, "", "")
- ELSE
- Dialog.ShowParamMsg("#System:HasWrongType", name, "", "")
- END;
- err := TRUE
- END;
- Meta.Lookup("", i)
- END
- END GetGuardProc;
-
- PROCEDURE CallGuard (c: Control);
- VAR ok, up: BOOLEAN; n: INTEGER; dpar: Dialog.Par; p: Control;
- v: GuardProcVal; vp: GuardProcPVal; i: Meta.Item; pref: DefaultsPref;
- BEGIN
- Controllers.SetCurrentPath(Controllers.targetPath);
- pref.disabled := ~c.item.Valid();
- pref.undef := FALSE;
- pref.readOnly := c.item.vis = Meta.readOnly;
- Views.HandlePropMsg(c, pref);
- c.disabled := pref.disabled;
- c.undef := pref.undef;
- c.readOnly := pref.readOnly;
- c.label := c.prop.label$;
- IF ~c.disabled & (c.prop.guard # "") & ~c.guardErr THEN
- IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
- INC(cleanerInstalled);
- p := par; par := c;
- dpar.disabled := FALSE; dpar.undef := FALSE;
- dpar.readOnly := c.readOnly;
- dpar.checked := FALSE; dpar.label := c.label$;
- GetGuardProc(c.prop.guard, i, c.guardErr, up, n);
- IF i.obj # Meta.undef THEN
- IF up THEN (* call with numeric parameter *)
- i.GetVal(vp, ok);
- IF ok THEN vp.p(n, dpar) END
- ELSE
- i.GetVal(v, ok);
- IF ok THEN v.p(dpar) END
- END;
- IF ok THEN
- c.disabled := dpar.disabled;
- c.undef := dpar.undef;
- IF dpar.readOnly THEN c.readOnly := TRUE END;
- IF dpar.label # c.label THEN c.label := dpar.label END
- ELSIF ~c.guardErr THEN
- Dialog.ShowParamMsg("#System:HasWrongType", c.prop.guard, "", "");
- c.guardErr := TRUE
- END
- END;
- par := p;
- DEC(cleanerInstalled);
- IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
- END;
- ExtractShortcut(c);
- Controllers.ResetCurrentPath()
- END CallGuard;
- PROCEDURE CallNotifier (c: Control; op, from, to: INTEGER);
- VAR ok, up: BOOLEAN; n: INTEGER; vold: NotifyProcValOld; vp: NotifyProcPVal;
- i: Meta.Item; p: Control;
- BEGIN
- IF c.prop.notifier # "" THEN
- IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
- INC(cleanerInstalled);
- p := par; par := c;
- IF c.prop.notifier[0] = "!" THEN
- IF op = Dialog.pressed THEN
- c.prop.notifier[0] := " ";
- Dialog.ShowStatus(c.prop.notifier);
- c.prop.notifier[0] := "!"
- ELSIF op = Dialog.released THEN
- Dialog.ShowStatus("")
- END
- ELSE
- GetGuardProc(c.prop.notifier, i, c.notifyErr, up, n);
- IF i.obj # Meta.undef THEN
- IF up THEN (* call with numeric parameter *)
- i.GetVal(vp, ok);
- IF ok THEN vp.p(n, op, from, to) END
- ELSE
- i.GetVal(vold, ok);
- IF ok THEN vold.p(op, from, to) END
- END;
- IF ~ok & ~c.notifyErr THEN
- Dialog.ShowParamMsg("#System:HasWrongType", c.prop.notifier, "", "");
- c.notifyErr := TRUE
- END
- END
- END;
- par := p;
- DEC(cleanerInstalled);
- IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
- END
- END CallNotifier;
- PROCEDURE DCHint (modifiers: SET): INTEGER;
- BEGIN
- IF Controllers.doubleClick IN modifiers THEN RETURN 1
- ELSE RETURN 0
- END
- END DCHint;
- PROCEDURE Notify* (c: Control; f: Views.Frame; op, from, to: INTEGER);
- VAR msg: NotifyMsg;
- BEGIN
- IF ~c.readOnly & ~ c.disabled THEN
- CallNotifier(c, op, from, to);
- IF op >= Dialog.changed THEN
- msg.id0 := c.item.adr; msg.id1 := msg.id0 + c.item.Size(); msg.frame := f;
- msg.op := op; msg.from := from; msg.to := to;
- msg.opts := {update, guardCheck};
- Views.Omnicast(msg)
- END
- END
- END Notify;
- PROCEDURE NotifyFlushCaches*;
- VAR msg: NotifyMsg;
- BEGIN
- msg.opts := {flushCaches}; msg.id0 := 0; msg.id1 := 0;
- Views.Omnicast(msg)
- END NotifyFlushCaches;
-
- PROCEDURE GetName (VAR path, name: ARRAY OF CHAR; VAR i: INTEGER);
- VAR j: INTEGER; ch: CHAR;
- BEGIN
- j := 0; ch := path[i];
- WHILE (j < LEN(name) - 1) & ((ch >= "0") & (ch <= "9") OR (CAP(ch) >= "A") & (CAP(ch) <= "Z")
- OR (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_")) DO
- name[j] := ch; INC(i); INC(j); ch := path[i]
- END;
- IF (ch = 0X) OR (ch = ".") OR (ch = "[") OR (ch = "^") THEN name[j] := 0X
- ELSE name[0] := 0X
- END
- END GetName;
- PROCEDURE LookupPath (path: ARRAY OF CHAR; VAR i: Meta.Item;
- VAR adr: ARRAY OF INTEGER; VAR num: INTEGER);
- VAR j, n: INTEGER; name: Meta.Name; ch: CHAR;
- BEGIN
- path[LEN(path) - 1] := 0X; j := 0; num := 0;
- GetName(path, name, j); Meta.Lookup(name, i);
- IF (i.obj = Meta.modObj) & (path[j] = ".") THEN
- INC(j); GetName(path, name, j);
- i.Lookup(name, i); ch := path[j]; INC(j);
- WHILE i.obj = Meta.varObj DO
- adr[num] := i.adr;
- IF num < LEN(adr) - 1 THEN INC(num) END;
- IF ch = 0X THEN RETURN
- ELSIF i.typ = Meta.ptrTyp THEN
- IF ch = "^" THEN ch := path[j]; INC(j) END;
- i.Deref(i)
- ELSIF (i.typ = Meta.recTyp) & (ch = ".") THEN
- GetName(path, name, j); i.Lookup(name, i);
- ch := path[j]; INC(j)
- ELSIF (i.typ = Meta.arrTyp) & (ch = "[") THEN
- ch := path[j]; INC(j); n := 0;
- WHILE (ch >= "0") & (ch <= "9") DO n := 10 * n + ORD(ch) - ORD("0"); ch := path[j]; INC(j) END;
- IF ch = "]" THEN ch := path[j]; INC(j); i.Index(n, i) ELSE Meta.Lookup("", i) END
- ELSE Meta.Lookup("", i)
- END
- END
- ELSE
- Meta.LookupPath(path, i); num := 0;
- IF i.obj = Meta.varObj THEN adr[0] := i.adr; num := 1
- ELSIF i.obj # Meta.procObj THEN Meta.Lookup("", i)
- END
- END
- END LookupPath;
- PROCEDURE Sort (VAR adr: ARRAY OF INTEGER; num: INTEGER);
- VAR i, j, p: INTEGER;
- BEGIN
- i := 1;
- WHILE i < num DO
- p := adr[i]; j := i;
- WHILE (j >= 1) & (adr[j - 1] > p) DO adr[j] := adr[j - 1]; DEC(j) END;
- adr[j] := p; INC(i)
- END
- END Sort;
- PROCEDURE GetTypeName (IN item: Meta.Item; OUT name: Meta.Name);
- VAR mod: Meta.Name;
- BEGIN
- IF (item.typ = Meta.recTyp) THEN
- item.GetTypeName(mod, name);
- IF (mod = "Dialog") OR (mod = "Dates") THEN (* ok *)
- ELSE name := ""
- END
- ELSE name := ""
- END
- END GetTypeName;
- PROCEDURE OpenLink* (c: Control; p: Prop);
- VAR ok: BOOLEAN;
- BEGIN
- ASSERT(c # NIL, 20); ASSERT(p # NIL, 21);
- c.num := 0;
- c.prop := Properties.CopyOf(p)(Prop);
- IF c.font = NIL THEN
- IF c.customFont THEN c.font := StdCFrames.defaultLightFont
- ELSE c.font := StdCFrames.defaultFont
- END
- END;
- c.guardErr := FALSE; c.notifyErr := FALSE;
- LookupPath(p.link, c.item, c.adr, c.num);
- IF c.item.obj = Meta.varObj THEN
- Sort(c.adr, c.num);
- ok := TRUE; c.CheckLink(ok);
- IF ~ok THEN
- Meta.Lookup("", c.item);
- Dialog.ShowParamMsg("#System:HasWrongType", p.link, "", "")
- END
- ELSE
- Meta.Lookup("", c.item); c.num := 0
- END;
- CallGuard(c);
- c.stamp := stamp
- END OpenLink;
- (** Prop **)
- PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);
- VAR valid: SET;
- BEGIN
- WITH q: Prop DO
- valid := p.valid * q.valid; equal := TRUE;
- IF p.link # q.link THEN EXCL(valid, link) END;
- IF p.label # q.label THEN EXCL(valid, label) END;
- IF p.guard # q.guard THEN EXCL(valid, guard) END;
- IF p.notifier # q.notifier THEN EXCL(valid, notifier) END;
- IF p.level # q.level THEN EXCL(valid, level) END;
- IF p.opt[0] # q.opt[0] THEN EXCL(valid, opt0) END;
- IF p.opt[1] # q.opt[1] THEN EXCL(valid, opt1) END;
- IF p.opt[2] # q.opt[2] THEN EXCL(valid, opt2) END;
- IF p.opt[3] # q.opt[3] THEN EXCL(valid, opt3) END;
- IF p.opt[4] # q.opt[4] THEN EXCL(valid, opt4) END;
- IF p.valid # valid THEN p.valid := valid; equal := FALSE END
- END
- END IntersectWith;
- (* Control *)
- PROCEDURE (c: Control) CopyFromSimpleView2- (source: Control), NEW, EMPTY;
- PROCEDURE (c: Control) CopyFromSimpleView- (source: Views.View);
- BEGIN
- WITH source: Control DO
- c.item := source.item;
- c.adr := source.adr;
- c.num := source.num;
- c.disabled := source.disabled;
- c.undef := source.undef;
- c.readOnly := source.readOnly;
- c.shortcut := source.shortcut;
- c.customFont := source.customFont;
- c.font := source.font;
- c.label := source.label$;
- c.prop := Properties.CopyOf(source.prop)(Prop);
- c.CopyFromSimpleView2(source)
- END
- END CopyFromSimpleView;
- PROCEDURE (c: Control) Internalize- (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER; x, def, canc, sort: BOOLEAN;
- BEGIN
- c.Internalize^(rd);
- IF rd.cancelled THEN RETURN END;
- rd.ReadVersion(minVersion, maxBaseVersion, thisVersion);
- IF rd.cancelled THEN RETURN END;
- NEW(c.prop);
- IF thisVersion >= 3 THEN
- rd.ReadString(c.prop.link);
- rd.ReadString(c.prop.label);
- rd.ReadString(c.prop.guard);
- rd.ReadString(c.prop.notifier);
- rd.ReadInt(c.prop.level);
- rd.ReadBool(c.customFont);
- rd.ReadBool(c.prop.opt[0]);
- rd.ReadBool(c.prop.opt[1]);
- rd.ReadBool(c.prop.opt[2]);
- rd.ReadBool(c.prop.opt[3]);
- rd.ReadBool(c.prop.opt[4]);
- IF c.customFont & (thisVersion = 4) THEN
- Views.ReadFont(rd, c.font)
- END
- ELSE
- rd.ReadXString(c.prop.link);
- rd.ReadXString(c.prop.label);
- rd.ReadXString(c.prop.guard);
- c.prop.notifier := "";
- c.prop.opt[2] := FALSE;
- c.prop.opt[3] := FALSE;
- c.prop.opt[4] := FALSE;
- sort := FALSE;
- IF thisVersion = 2 THEN
- rd.ReadXString(c.prop.notifier);
- rd.ReadBool(sort);
- rd.ReadBool(c.prop.opt[multiLine])
- ELSIF thisVersion = 1 THEN
- rd.ReadXString(c.prop.notifier);
- rd.ReadBool(sort)
- END;
- rd.ReadBool(x); (* free, was sed for prop.element *)
- rd.ReadBool(def);
- rd.ReadBool(canc);
- rd.ReadXInt(c.prop.level);
- rd.ReadBool(c.customFont);
- c.prop.opt[default] := def OR sort OR (c IS Field);
- c.prop.opt[cancel] := canc
- END;
- c.Internalize2(rd);
- OpenLink(c, c.prop)
- END Internalize;
- PROCEDURE (c: Control) Externalize- (VAR wr: Stores.Writer);
- BEGIN
- c.Externalize^(wr);
- wr.WriteVersion(maxBaseVersion);
- wr.WriteString(c.prop.link);
- wr.WriteString(c.prop.label);
- wr.WriteString(c.prop.guard);
- wr.WriteString(c.prop.notifier);
- wr.WriteInt(c.prop.level);
- wr.WriteBool(c.customFont);
- wr.WriteBool(c.prop.opt[0]);
- wr.WriteBool(c.prop.opt[1]);
- wr.WriteBool(c.prop.opt[2]);
- wr.WriteBool(c.prop.opt[3]);
- wr.WriteBool(c.prop.opt[4]);
- IF c.customFont THEN Views.WriteFont(wr, c.font) END;
- c.Externalize2(wr)
- END Externalize;
- PROCEDURE (c: Control) HandleViewMsg- (f: Views.Frame; VAR msg: Views.Message);
- VAR disabled, undef, readOnly, done, allDone: BOOLEAN; i: INTEGER; lbl: Dialog.String;
- BEGIN
- WITH msg: Views.NotifyMsg DO
- done := FALSE; allDone := FALSE;
- IF guardCheck IN msg.opts THEN
- (* should call c.Update for each frame but Views.Update only once *)
- WITH f: StdCFrames.Caption DO lbl := f.label$
- | f: StdCFrames.PushButton DO lbl := f.label$
- | f: StdCFrames.RadioButton DO lbl := f.label$
- | f: StdCFrames.CheckBox DO lbl := f.label$
- | f: StdCFrames.Group DO lbl := f.label$
- ELSE lbl := c.label$
- END;
- WITH f: StdCFrames.Frame DO
- disabled := f.disabled; undef := f.undef; readOnly := f.readOnly
- ELSE
- disabled := c.disabled; undef := c.undef; readOnly := c.readOnly
- END;
- CallGuard(c);
- IF (c.disabled # disabled) OR (c.undef # undef)
- OR (c.readOnly # readOnly) OR (c.label # lbl) THEN
- WITH f: StdCFrames.Frame DO
- IF f.noRedraw THEN
- f.disabled := c.disabled;
- f.undef := c.undef;
- f.readOnly := c.readOnly;
- c.Update(f, 0, 0, 0); done := TRUE
- ELSE Views.Update(c, Views.rebuildFrames); allDone := TRUE
- END
- ELSE Views.Update(c, Views.keepFrames); done := TRUE
- END
- END
- END;
- IF flushCaches IN msg.opts THEN
- Views.Update(c, Views.rebuildFrames)
- END;
- i := 0; WHILE (i < c.num) & (c.adr[i] < msg.id0) DO INC(i) END;
- IF (i < c.num) & (c.adr[i] < msg.id1) & ~allDone THEN
- IF (update IN msg.opts) & ~done THEN
- WITH msg: NotifyMsg DO
- IF msg.frame # f THEN (* don't update origin frame *)
- c.Update(f, msg.op, msg.from, msg.to)
- END
- ELSE
- c.Update(f, 0, 0, 0)
- END
- END;
- IF listUpdate IN msg.opts THEN
- c.UpdateList(f)
- END
- END
- | msg: Views.UpdateCachesMsg DO
- IF c.stamp # stamp THEN
- OpenLink(c, c.prop);
- IF msg IS UpdateCachesMsg THEN
- Views.Update(c, Views.rebuildFrames)
- END
- END
- ELSE
- END;
- c.HandleViewMsg2(f, msg)
- END HandleViewMsg;
- PROCEDURE (c: Control) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- VAR sp: Properties.SizeProp; p: Control; dcOk: BOOLEAN;
- BEGIN
- IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
- INC(cleanerInstalled);
- p := par; par := c;
- WITH msg: Properties.PollPickMsg DO
- msg.dest := f
- | msg: Properties.PickMsg DO
- NEW(sp); sp.known := {Properties.width, Properties.height}; sp.valid := sp.known;
- c.context.GetSize(sp.width, sp.height);
- Properties.Insert(msg.prop, sp)
- | msg: Controllers.TrackMsg DO
- IF ~c.disabled THEN
- dcOk := TRUE;
- IF f IS StdCFrames.Frame THEN dcOk := f(StdCFrames.Frame).DblClickOk(msg.x, msg.y) END;
- IF (DCHint(msg.modifiers) = 1) & dcOk THEN
- (* double click *)
- Notify(c, f, Dialog.pressed, 1, 0)
- ELSE
- Notify(c, f, Dialog.pressed, 0, 0)
- END
- END
- ELSE
- END;
- c.HandleCtrlMsg2(f, msg, focus);
- WITH msg: Controllers.TrackMsg DO
- IF ~c.disabled THEN
- Notify(c, f, Dialog.released, 0, 0)
- END
- ELSE
- END;
- par := p;
- DEC(cleanerInstalled);
- IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
- END HandleCtrlMsg;
- PROCEDURE (c: Control) HandlePropMsg- (VAR msg: Properties.Message);
- VAR fpref: Properties.FocusPref; stp: Properties.StdProp;
- cp: Prop; ppref: PropPref; op: Op; valid: SET; p: Properties.Property;
- fop: FontOp; face: Fonts.Typeface; size, weight: INTEGER; style: SET;
- BEGIN
- WITH msg: Properties.ControlPref DO
- IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
- IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN
- fpref.hotFocus := FALSE; fpref.setFocus := FALSE; fpref.atLocation := FALSE;
- Views.HandlePropMsg(c, fpref);
- IF fpref.setFocus THEN msg.getFocus := TRUE END
- END
- | msg: Properties.PollMsg DO
- ppref.valid := {link, label, notifier, guard};
- Views.HandlePropMsg(c, ppref);
- cp := Properties.CopyOf(c.prop)(Prop);
- cp.valid := ppref.valid; cp.known := cp.valid; cp.readOnly := {};
- Properties.Insert(msg.prop, cp);
- NEW(stp);
- stp.valid := {Properties.typeface..Properties.weight};
- stp.known := stp.valid;
- IF c.customFont THEN stp.typeface := c.font.typeface$
- ELSE stp.typeface := Fonts.default
- END;
- stp.size := c.font.size; stp.style.val := c.font.style; stp.weight := c.font.weight;
- stp.style.mask := {Fonts.italic, Fonts.strikeout, Fonts.underline};
- Properties.Insert(msg.prop, stp)
- | msg: Properties.SetMsg DO
- p := msg.prop; op := NIL; fop := NIL;
- WHILE (p # NIL) & (op = NIL) DO
- WITH p: Prop DO
- ppref.valid := {link, label, notifier, guard};
- Views.HandlePropMsg(c, ppref);
- valid := p.valid * ppref.valid;
- IF valid # {} THEN
- NEW(op);
- op.ctrl := c;
- op.prop := Properties.CopyOf(p)(Prop); op.prop.valid := valid
- END
- | p: Properties.StdProp DO
- valid := p.valid * {Properties.typeface..Properties.weight};
- IF valid # {} THEN
- NEW(fop); fop.ctrl := c;
- face := c.font.typeface$; size := c.font.size; style := c.font.style; weight := c.font.weight;
- IF Properties.typeface IN p.valid THEN face := p.typeface$;
- IF face = Fonts.default THEN face := StdCFrames.defaultFont.typeface END
- END;
- IF Properties.size IN p.valid THEN size := p.size END;
- IF Properties.style IN p.valid THEN
- style := (p.style.val * p.style.mask) + (style - p.style.mask)
- END;
- IF Properties.weight IN p.valid THEN weight := p.weight END;
- fop.custom := TRUE;
- fop.font := Fonts.dir.This(face, size, style, weight);
- IF (fop.font.typeface = StdCFrames.defaultFont.typeface)
- & (fop.font.size = StdCFrames.defaultFont.size)
- & (fop.font.style = StdCFrames.defaultFont.style)
- & (fop.font.weight = StdCFrames.defaultFont.weight) THEN
- fop.custom := FALSE;
- fop.font := StdCFrames.defaultFont
- END
- END
- ELSE
- END;
- p := p.next
- END;
- IF op # NIL THEN Views.Do(c, "#System:SetProp", op) END;
- IF fop # NIL THEN Views.Do(c, "#System:SetProp", fop) END
- | msg: Properties.TypePref DO
- IF Services.Is(c, msg.type) THEN msg.view := c END
- ELSE
- END;
- c.HandlePropMsg2(msg)
- END HandlePropMsg;
- (* Op *)
- PROCEDURE (op: Op) Do;
- VAR c: Control; prop: Prop;
- BEGIN
- c := op.ctrl;
- prop := Properties.CopyOf(c.prop)(Prop);
- prop.valid := op.prop.valid; (* fields to be restored *)
- IF link IN op.prop.valid THEN c.prop.link := op.prop.link END;
- IF label IN op.prop.valid THEN c.prop.label := op.prop.label END;
- IF guard IN op.prop.valid THEN c.prop.guard := op.prop.guard END;
- IF notifier IN op.prop.valid THEN c.prop.notifier := op.prop.notifier END;
- IF level IN op.prop.valid THEN c.prop.level := op.prop.level END;
- IF opt0 IN op.prop.valid THEN c.prop.opt[0] := op.prop.opt[0] END;
- IF opt1 IN op.prop.valid THEN c.prop.opt[1] := op.prop.opt[1] END;
- IF opt2 IN op.prop.valid THEN c.prop.opt[2] := op.prop.opt[2] END;
- IF opt3 IN op.prop.valid THEN c.prop.opt[3] := op.prop.opt[3] END;
- IF opt4 IN op.prop.valid THEN c.prop.opt[4] := op.prop.opt[4] END;
- IF c.prop.guard # prop.guard THEN c.guardErr := FALSE END;
- IF c.prop.notifier # prop.notifier THEN c.notifyErr := FALSE END;
- IF c.prop.link # prop.link THEN OpenLink(c, c.prop) ELSE CallGuard(c) END;
- op.prop := prop;
- Views.Update(c, Views.rebuildFrames)
- END Do;
- PROCEDURE (op: FontOp) Do;
- VAR c: Control; custom: BOOLEAN; font: Fonts.Font;
- BEGIN
- c := op.ctrl;
- custom := c.customFont; c.customFont := op.custom; op.custom := custom;
- font := c.font; c.font := op.font; op.font := font;
- Views.Update(c, Views.rebuildFrames)
- END Do;
- (* ------------------------- standard controls ------------------------- *)
- PROCEDURE CatchCtrlMsg (c: Control; f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- IF ~c.disabled THEN
- WITH f: StdCFrames.Frame DO
- WITH msg: Controllers.PollCursorMsg DO
- f.GetCursor(msg.x, msg.y, msg.modifiers, msg.cursor)
- | msg: Controllers.PollOpsMsg DO
- msg.valid := {Controllers.pasteChar}
- | msg: Controllers.TrackMsg DO
- f.MouseDown(msg.x, msg.y, msg.modifiers)
- | msg: Controllers.MarkMsg DO
- f.Mark(msg.show, msg.focus)
- |msg: Controllers.WheelMsg DO
- f.WheelMove(msg.x, msg.y, msg.op, msg.nofLines, msg.done)
- ELSE
- END
- END
- END
- END CatchCtrlMsg;
-
- (** Directory **)
- PROCEDURE (d: Directory) NewPushButton* (p: Prop): Control, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewCheckBox* (p: Prop): Control, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewRadioButton* (p: Prop): Control, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewField* (p: Prop): Control, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewUpDownField* (p: Prop): Control, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewDateField* (p: Prop): Control, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewTimeField* (p: Prop): Control, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewColorField* (p: Prop): Control, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewListBox* (p: Prop): Control, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewSelectionBox* (p: Prop): Control, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewComboBox* (p: Prop): Control, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewCaption* (p: Prop): Control, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewGroup* (p: Prop): Control, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewTreeControl* (p: Prop): Control, NEW, ABSTRACT;
- (* PushButton *)
- PROCEDURE Call (c: PushButton);
- VAR res: INTEGER; p: Control; ok: BOOLEAN; msg: Views.NotifyMsg;
- BEGIN
- IF c.item.Valid() & ((c.item.obj = Meta.procObj) OR (c.item.obj = Meta.varObj) & (c.item.typ = Meta.procTyp)) THEN
- IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
- INC(cleanerInstalled);
- p := par; c.item.Call(ok); par := p;
- DEC(cleanerInstalled);
- IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END;
- IF ~ok THEN Dialog.ShowMsg("#System:BehaviorNotAccessible") END
- ELSIF c.prop.link # "" THEN
- IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
- INC(cleanerInstalled);
- p := par; par := c; Dialog.Call(c.prop.link, " ", res); par := p;
- DEC(cleanerInstalled);
- IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
- ELSE Dialog.ShowMsg("#System:NoBehaviorBound")
- END;
- msg.opts := {guardCheck};
- Views.Omnicast(msg)
- END Call;
-
- PROCEDURE Do (f: StdCFrames.PushButton);
- BEGIN
- Call(f.view(PushButton))
- END Do;
- PROCEDURE (c: PushButton) Internalize2 (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- rd.ReadVersion(minVersion, pbVersion, thisVersion)
- END Internalize2;
- PROCEDURE (c: PushButton) Externalize2 (VAR wr: Stores.Writer);
- BEGIN
- wr.WriteVersion(pbVersion)
- END Externalize2;
- PROCEDURE (c: PushButton) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.PushButton;
- BEGIN
- f := StdCFrames.dir.NewPushButton();
- f.disabled := c.disabled;
- f.undef := c.undef;
- f.readOnly := c.readOnly;
- f.font := c.font;
- f.label := c.label$;
- f.default := c.prop.opt[default];
- f.cancel := c.prop.opt[cancel];
- f.Do := Do;
- frame := f
- END GetNewFrame;
- PROCEDURE (c: PushButton) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
- PROCEDURE (c: PushButton) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- IF ~c.disabled THEN
- WITH f: StdCFrames.Frame DO
- WITH msg: Controllers.EditMsg DO
- IF (msg.op = Controllers.pasteChar)
- & ((msg.char = lineChar)
- OR (msg.char = " ")
- OR (msg.char = esc) & c.prop.opt[cancel]
- OR IsShortcut(msg.char, c)) THEN f.KeyDown(msg.char) END
- ELSE
- CatchCtrlMsg(c, f, msg, focus)
- END
- END
- END
- END HandleCtrlMsg2;
- PROCEDURE (c: PushButton) HandlePropMsg2 (VAR msg: Properties.Message);
- BEGIN
- WITH msg: Properties.ControlPref DO
- msg.accepts := ~c.disabled & ((msg.char = lineChar) & c.prop.opt[default]
- OR (msg.char = esc) & c.prop.opt[cancel]
- OR IsShortcut(msg.char, c))
- | msg: Properties.FocusPref DO
- IF ~c.disabled & ~ c.readOnly THEN
- msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
- END
- | msg: Properties.SizePref DO
- StdCFrames.dir.GetPushButtonSize(msg.w, msg.h)
- | msg: PropPref DO
- msg.valid := {link, label, guard, notifier, default, cancel}
- | msg: DefaultsPref DO
- IF c.prop.link # "" THEN msg.disabled := FALSE END
- ELSE
- END
- END HandlePropMsg2;
-
- PROCEDURE (c: PushButton) Update (f: Views.Frame; op, from, to: INTEGER);
- BEGIN
- f(StdCFrames.PushButton).label := c.label$;
- f(StdCFrames.Frame).Update
- END Update;
-
- PROCEDURE (c: PushButton) CheckLink (VAR ok: BOOLEAN);
- BEGIN
- ok := c.item.typ = Meta.procTyp
- END CheckLink;
- (* CheckBox *)
- PROCEDURE GetCheckBox (f: StdCFrames.CheckBox; OUT x: BOOLEAN);
- VAR c: CheckBox;
- BEGIN
- x := FALSE;
- c := f.view(CheckBox);
- IF c.item.Valid() THEN
- IF c.item.typ = Meta.boolTyp THEN x := c.item.BoolVal()
- ELSIF c.item.typ = Meta.setTyp THEN x := c.prop.level IN c.item.SetVal()
- END
- END
- END GetCheckBox;
- PROCEDURE SetCheckBox (f: StdCFrames.CheckBox; x: BOOLEAN);
- VAR c: CheckBox; s: SET;
- BEGIN
- c := f.view(CheckBox);
- IF c.item.Valid() & ~c.readOnly THEN
- IF c.item.typ = Meta.boolTyp THEN
- c.item.PutBoolVal(x); Notify(c, f, Dialog.changed, 0, 0)
- ELSIF c.item.typ = Meta.setTyp THEN
- s := c.item.SetVal();
- IF x THEN INCL(s, c.prop.level) ELSE EXCL(s, c.prop.level) END;
- c.item.PutSetVal(s);
- IF x THEN Notify(c, f, Dialog.included, c.prop.level, c.prop.level)
- ELSE Notify(c, f, Dialog.excluded, c.prop.level, c.prop.level)
- END
- END
- END
- END SetCheckBox;
- PROCEDURE (c: CheckBox) Internalize2 (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- rd.ReadVersion(minVersion, cbVersion, thisVersion)
- END Internalize2;
- PROCEDURE (c: CheckBox) Externalize2 (VAR wr: Stores.Writer);
- BEGIN
- wr.WriteVersion(cbVersion)
- END Externalize2;
- PROCEDURE (c: CheckBox) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.CheckBox;
- BEGIN
- f := StdCFrames.dir.NewCheckBox();
- f.disabled := c.disabled;
- f.undef := c.undef;
- f.readOnly := c.readOnly;
- f.font := c.font;
- f.label := c.label$;
- f.Get := GetCheckBox;
- f.Set := SetCheckBox;
- frame := f
- END GetNewFrame;
- PROCEDURE (c: CheckBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
- PROCEDURE (c: CheckBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- IF ~c.disabled & ~c.readOnly THEN
- WITH f: StdCFrames.Frame DO
- WITH msg: Controllers.EditMsg DO
- IF (msg.op = Controllers.pasteChar)
- & ((msg.char = " ") OR IsShortcut(msg.char, c)) THEN f.KeyDown(msg.char) END
- ELSE
- CatchCtrlMsg(c, f, msg, focus)
- END
- END
- END
- END HandleCtrlMsg2;
- PROCEDURE (c: CheckBox) HandlePropMsg2 (VAR msg: Properties.Message);
- BEGIN
- WITH msg: Properties.ControlPref DO
- IF ~c.disabled & ~c.readOnly THEN
- IF (msg.char = tab) OR (msg.char = ltab) THEN
- (* tabs set focus to first checkbox only *)
- IF (msg.focus # NIL) & (msg.focus IS CheckBox)
- & (msg.focus(CheckBox).item.adr = c.item.adr) THEN
- msg.getFocus := FALSE
- END
- ELSIF (msg.char >= arrowLeft) & (msg.char <= arrowDown) THEN
- (* arrows set focus to next checkbox bound to same variable *)
- msg.getFocus := StdCFrames.setFocus
- & (msg.focus # NIL)
- & (msg.focus IS CheckBox)
- & (msg.focus(CheckBox).item.adr = c.item.adr);
- msg.accepts := msg.getFocus & (msg.focus # c)
- ELSIF IsShortcut(msg.char, c) THEN
- msg.accepts := TRUE; msg.getFocus := StdCFrames.setFocus
- ELSIF msg.char # " " THEN
- msg.accepts := FALSE
- END
- END
- | msg: Properties.FocusPref DO
- IF ~c.disabled & ~c.readOnly THEN
- msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
- END
- | msg: Properties.SizePref DO
- StdCFrames.dir.GetCheckBoxSize(msg.w, msg.h)
- | msg: PropPref DO
- msg.valid := {link, label, guard, notifier, level}
- ELSE
- END
- END HandlePropMsg2;
- PROCEDURE (c: CheckBox) CheckLink (VAR ok: BOOLEAN);
- BEGIN
- ok := (c.item.typ = Meta.boolTyp) OR (c.item.typ = Meta.setTyp)
- END CheckLink;
- PROCEDURE (c: CheckBox) Update (f: Views.Frame; op, from, to: INTEGER);
- BEGIN
- IF (op = 0) OR (c.item.typ = Meta.boolTyp) OR (c.prop.level = to) THEN
- f(StdCFrames.CheckBox).label := c.label$;
- f(StdCFrames.Frame).Update
- END
- END Update;
-
- (* RadioButton *)
- PROCEDURE GetRadioButton (f: StdCFrames.RadioButton; OUT x: BOOLEAN);
- VAR c: RadioButton;
- BEGIN
- x := FALSE;
- c := f.view(RadioButton);
- IF c.item.Valid() THEN
- IF c.item.typ = Meta.boolTyp THEN x := c.item.BoolVal() = (c.prop.level # 0)
- ELSE x := c.item.IntVal() = c.prop.level
- END
- END
- END GetRadioButton;
- PROCEDURE SetRadioButton (f: StdCFrames.RadioButton; x: BOOLEAN);
- VAR c: RadioButton; old: INTEGER;
- BEGIN
- IF x THEN
- c := f.view(RadioButton);
- IF c.item.Valid() & ~c.readOnly THEN
- IF c.item.typ = Meta.boolTyp THEN
- IF c.item.BoolVal() THEN old := 1 ELSE old := 0 END;
- IF c.prop.level # old THEN
- c.item.PutBoolVal(c.prop.level # 0);
- Notify(c, f, Dialog.changed, old, c.prop.level)
- END
- ELSE
- old := c.item.IntVal();
- IF c.prop.level # old THEN
- c.item.PutIntVal(c.prop.level);
- Notify(c, f, Dialog.changed, old, c.prop.level)
- END
- END
- END
- END
- END SetRadioButton;
- PROCEDURE (c: RadioButton) Internalize2 (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- rd.ReadVersion(minVersion, rbVersion, thisVersion)
- END Internalize2;
- PROCEDURE (c: RadioButton) Externalize2 (VAR wr: Stores.Writer);
- BEGIN
- wr.WriteVersion(rbVersion)
- END Externalize2;
- PROCEDURE (c: RadioButton) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.RadioButton;
- BEGIN
- f := StdCFrames.dir.NewRadioButton();
- f.disabled := c.disabled;
- f.undef := c.undef;
- f.readOnly := c.readOnly;
- f.font := c.font;
- f.label := c.label$;
- f.Get := GetRadioButton;
- f.Set := SetRadioButton;
- frame := f
- END GetNewFrame;
- PROCEDURE (c: RadioButton) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
- PROCEDURE (c: RadioButton) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- IF ~c.disabled & ~c.readOnly THEN
- WITH f: StdCFrames.Frame DO
- WITH msg: Controllers.EditMsg DO
- IF (msg.op = Controllers.pasteChar)
- & ((msg.char <= " ") OR IsShortcut(msg.char, c)) THEN f.KeyDown(msg.char) END
- ELSE
- CatchCtrlMsg(c, f, msg, focus)
- END
- END
- END
- END HandleCtrlMsg2;
- PROCEDURE (c: RadioButton) HandlePropMsg2 (VAR msg: Properties.Message);
- VAR hot: BOOLEAN;
- BEGIN
- WITH msg: Properties.ControlPref DO
- IF ~c.disabled & ~c.readOnly THEN
- IF (msg.char = tab) OR (msg.char = ltab) THEN
- (* tabs set focus to active radio button only *)
- IF c.item.Valid() THEN
- IF c.item.typ = Meta.boolTyp THEN hot := c.item.BoolVal() = (c.prop.level # 0)
- ELSE hot := c.item.IntVal() = c.prop.level
- END
- ELSE hot := FALSE
- END;
- IF ~hot THEN msg.getFocus := FALSE END
- ELSIF (msg.char >= arrowLeft) & (msg.char <= arrowDown) THEN
- (* arrows set focus to next radio button bound to same variable *)
- msg.getFocus := StdCFrames.setFocus
- & (msg.focus # NIL) & (msg.focus IS RadioButton)
- & (msg.focus(RadioButton).item.adr = c.item.adr);
- msg.accepts := msg.getFocus & (msg.focus # c)
- ELSIF IsShortcut(msg.char, c) THEN
- msg.accepts := TRUE; msg.getFocus := StdCFrames.setFocus
- ELSIF msg.char # " " THEN
- msg.accepts := FALSE
- END
- END
- | msg: Properties.FocusPref DO
- IF ~c.disabled & ~c.readOnly THEN
- msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
- END
- | msg: Properties.SizePref DO
- StdCFrames.dir.GetRadioButtonSize(msg.w, msg.h)
- | msg: PropPref DO
- msg.valid := {link, label, guard, notifier, level}
- ELSE
- END
- END HandlePropMsg2;
- PROCEDURE (c: RadioButton) CheckLink (VAR ok: BOOLEAN);
- VAR name: Meta.Name;
- BEGIN
- GetTypeName(c.item, name);
- IF name = "List" THEN c.item.Lookup("index", c.item) END;
- ok := (c.item.typ >= Meta.byteTyp) & (c.item.typ <= Meta.intTyp) OR (c.item.typ = Meta.boolTyp)
- END CheckLink;
- PROCEDURE (c: RadioButton) Update (f: Views.Frame; op, from, to: INTEGER);
- BEGIN
- IF (op = 0) OR (c.prop.level = to) OR (c.prop.level = from) THEN
- f(StdCFrames.RadioButton).label := c.label$;
- f(StdCFrames.Frame).Update
- END
- END Update;
-
- (* Field *)
- PROCEDURE LongToString (x: LONGINT; OUT s: ARRAY OF CHAR);
- VAR d: ARRAY 24 OF CHAR; i, j: INTEGER;
- BEGIN
- IF x = MIN(LONGINT) THEN
- s := "-9223372036854775808"
- ELSE
- i := 0; j := 0;
- IF x < 0 THEN s[0] := "-"; i := 1; x := -x END;
- REPEAT d[j] := CHR(x MOD 10 + ORD("0")); INC(j); x := x DIV 10 UNTIL x = 0;
- WHILE j > 0 DO DEC(j); s[i] := d[j]; INC(i) END;
- s[i] := 0X
- END
- END LongToString;
- PROCEDURE StringToLong (IN s: ARRAY OF CHAR; OUT x: LONGINT; OUT res: INTEGER);
- VAR i, sign, d: INTEGER;
- BEGIN
- i := 0; sign := 1; x := 0; res := 0;
- WHILE s[i] = " " DO INC(i) END;
- IF s[i] = "-" THEN sign := -1; INC(i) END;
- WHILE s[i] = " " DO INC(i) END;
- IF s[i] = 0X THEN res := 2 END;
- WHILE (s[i] >= "0") & (s[i] <= "9") DO
- d := ORD(s[i]) - ORD("0"); INC(i);
- IF x <= (MAX(LONGINT) - d) DIV 10 THEN x := 10 * x + d
- ELSE res := 1
- END
- END;
- x := x * sign;
- IF s[i] # 0X THEN res := 2 END
- END StringToLong;
- PROCEDURE FixToInt (fix: ARRAY OF CHAR; OUT int: ARRAY OF CHAR; scale: INTEGER);
- VAR i, j: INTEGER;
- BEGIN
- IF scale > 24 THEN scale := 24 ELSIF scale < 0 THEN scale := 0 END;
- i := 0; j := 0;
- WHILE (fix[i] # ".") & (fix[i] # 0X) DO int[j] := fix[i]; INC(i); INC(j) END;
- IF fix[i] = "." THEN INC(i) END;
- WHILE (scale > 0) & (fix[i] >= "0") & (fix[i] <= "9") DO int[j] := fix[i]; INC(i); INC(j); DEC(scale) END;
- WHILE scale > 0 DO int[j] := "0"; INC(j); DEC(scale) END;
- int[j] := 0X
- END FixToInt;
- PROCEDURE IntToFix (int: ARRAY OF CHAR; OUT fix: ARRAY OF CHAR; scale: INTEGER);
- VAR i, j, n: INTEGER;
- BEGIN
- IF scale > 24 THEN scale := 24 ELSIF scale < 0 THEN scale := 0 END;
- n := LEN(int$); i := 0; j := 0;
- WHILE int[i] < "0" DO fix[j] := int[i]; INC(i); INC(j); DEC(n) END;
- IF n > scale THEN
- WHILE n > scale DO fix[j] := int[i]; INC(i); INC(j); DEC(n) END
- ELSE
- fix[j] := "0"; INC(j)
- END;
- fix[j] := "."; INC(j);
- WHILE n < scale DO fix[j] := "0"; INC(j); DEC(scale) END;
- WHILE n > 0 DO fix[j] := int[i]; INC(i); INC(j); DEC(n) END;
- fix[j] := 0X
- END IntToFix;
- PROCEDURE GetField (f: StdCFrames.Field; OUT x: ARRAY OF CHAR);
- VAR c: Field; ok: BOOLEAN; b, v: Meta.Item; mod, name: Meta.Name;
- BEGIN
- x := "";
- c := f.view(Field);
- IF c.item.Valid() THEN
- IF c.item.typ = Meta.arrTyp THEN
- c.item.GetStringVal(x, ok)
- ELSIF c.item.typ IN {Meta.byteTyp, Meta.sIntTyp, Meta.intTyp} THEN
- Strings.IntToString(c.item.IntVal(), x);
- IF c.prop.level > 0 THEN IntToFix(x, x, c.prop.level) END
- ELSIF c.item.typ = Meta.longTyp THEN
- LongToString(c.item.LongVal(), x);
- IF c.prop.level > 0 THEN IntToFix(x, x, c.prop.level) END
- ELSIF c.item.typ = Meta.sRealTyp THEN
- IF c.prop.level <= 0 THEN
- Strings.RealToStringForm(c.item.RealVal(), 7, 0, c.prop.level, " ", x)
- ELSE
- Strings.RealToStringForm(c.item.RealVal(), c.prop.level, 0, 1, " ", x)
- END
- ELSIF c.item.typ = Meta.realTyp THEN
- IF c.prop.level <= 0 THEN
- Strings.RealToStringForm(c.item.RealVal(), 16, 0, c.prop.level, " ", x)
- ELSE
- Strings.RealToStringForm(c.item.RealVal(), c.prop.level, 0, 1, " ", x)
- END
- ELSIF c.item.typ = Meta.recTyp THEN
- c.item.GetTypeName(mod, name);
- IF mod = "Dialog" THEN
- IF name = "Currency" THEN
- c.item.Lookup("val", v); c.item.Lookup("scale", b);
- LongToString(v.LongVal(), x); IntToFix(x, x, b.IntVal())
- ELSE (* Combo *)
- c.item.Lookup("item", v); (* Combo *)
- IF v.typ = Meta.arrTyp THEN v.GetStringVal(x, ok) END
- END
- END
- END
- ELSE
- x := c.label$
- END
- END GetField;
- PROCEDURE SetField (f: StdCFrames.Field; IN x: ARRAY OF CHAR);
- VAR c: Field; ok: BOOLEAN; i, res, old: INTEGER; r, or: REAL; b, v: Meta.Item;
- mod, name: Meta.Name; long, long0: LONGINT;
- s: ARRAY 1024 OF CHAR;
- BEGIN
- c := f.view(Field);
- IF c.item.Valid() & ~c.readOnly THEN
- CASE c.item.typ OF
- | Meta.arrTyp:
- c.item.GetStringVal(s, ok);
- IF ~ok OR (s$ # x$) THEN
- c.item.PutStringVal(x, ok);
- IF ok THEN Notify(c, f, Dialog.changed, 0, 0) ELSE Dialog.Beep END
- END
- | Meta.byteTyp:
- IF x = "" THEN i := 0; res := 0
- ELSIF c.prop.level > 0 THEN FixToInt(x, s, c.prop.level); Strings.StringToInt(s, i, res)
- ELSE Strings.StringToInt(x, i, res)
- END;
- IF (res = 0) & (i >= MIN(BYTE)) & (i <= MAX(BYTE)) THEN
- old := c.item.IntVal();
- IF i # old THEN c.item.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
- ELSIF x # "-" THEN
- Dialog.Beep
- END
- | Meta.sIntTyp:
- IF x = "" THEN i := 0; res := 0
- ELSIF c.prop.level > 0 THEN FixToInt(x, s, c.prop.level); Strings.StringToInt(s, i, res)
- ELSE Strings.StringToInt(x, i, res)
- END;
- IF (res = 0) & (i >= MIN(SHORTINT)) & (i <= MAX(SHORTINT)) THEN
- old := c.item.IntVal();
- IF i # old THEN c.item.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
- ELSIF x # "-" THEN
- Dialog.Beep
- END
- | Meta.intTyp:
- IF x = "" THEN i := 0; res := 0
- ELSIF c.prop.level > 0 THEN FixToInt(x, s, c.prop.level); Strings.StringToInt(s, i, res)
- ELSE Strings.StringToInt(x, i, res)
- END;
- IF res = 0 THEN
- old := c.item.IntVal();
- IF i # old THEN c.item.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
- ELSIF x # "-" THEN
- Dialog.Beep
- END
- | Meta.longTyp:
- IF x = "" THEN long := 0; res := 0
- ELSE FixToInt(x, s, c.prop.level); StringToLong(s, long, res)
- END;
- IF res = 0 THEN
- long0 := c.item.LongVal();
- IF long # long0 THEN c.item.PutLongVal(long); Notify(c, f, Dialog.changed, 0, 0) END
- ELSIF x # "-" THEN
- Dialog.Beep
- END
- | Meta.sRealTyp:
- IF (x = "") OR (x = "-") THEN r := 0; res := 0 ELSE Strings.StringToReal(x, r, res) END;
- IF (res = 0) & (r >= MIN(SHORTREAL)) & (r <= MAX(SHORTREAL)) THEN
- or := c.item.RealVal();
- IF r # or THEN c.item.PutRealVal(r); Notify(c, f, Dialog.changed, 0, 0) END
- ELSIF x # "-" THEN
- Dialog.Beep
- END
- | Meta.realTyp:
- IF (x = "") OR (x = "-") THEN r := 0; res := 0 ELSE Strings.StringToReal(x, r, res) END;
- IF res = 0 THEN
- or := c.item.RealVal();
- IF r # or THEN c.item.PutRealVal(r); Notify(c, f, Dialog.changed, 0, 0) END
- ELSIF x # "-" THEN
- Dialog.Beep
- END
- | Meta.recTyp:
- c.item.GetTypeName(mod, name);
- IF mod = "Dialog" THEN
- IF name = "Currency" THEN
- c.item.Lookup("val", v); c.item.Lookup("scale", b);
- IF x = "" THEN long := 0; res := 0
- ELSE FixToInt(x, s, b.IntVal()); StringToLong(s, long, res)
- END;
- IF res = 0 THEN
- long0 := v.LongVal();
- IF long # long0 THEN v.PutLongVal(long); Notify(c, f, Dialog.changed, 0, 0) END
- ELSIF x # "-" THEN
- Dialog.Beep
- END
- ELSE (* name = "Combo" *)
- c.item.Lookup("item", v);
- IF v.typ = Meta.arrTyp THEN
- v.GetStringVal(s, ok);
- IF ~ok OR (s$ # x$) THEN
- v.PutStringVal(x, ok);
- IF ok THEN Notify(c, f, Dialog.changed, 0, 0) ELSE Dialog.Beep END
- END
- END
- END
- END
- END
- END
- END SetField;
- PROCEDURE EqualField (f: StdCFrames.Field; IN s1, s2: ARRAY OF CHAR): BOOLEAN;
- VAR c: Field; i1, i2, res1, res2: INTEGER; r1, r2: REAL; l1, l2: LONGINT;
- mod, name: Meta.Name; t1, t2: ARRAY 64 OF CHAR; b: Meta.Item;
- BEGIN
- c := f.view(Field);
- CASE c.item.typ OF
- | Meta.arrTyp:
- RETURN s1 = s2
- | Meta.byteTyp, Meta.sIntTyp, Meta.intTyp:
- IF c.prop.level > 0 THEN
- FixToInt(s1, t1, c.prop.level); Strings.StringToInt(t1, i1, res1);
- FixToInt(s2, t2, c.prop.level); Strings.StringToInt(t2, i2, res2)
- ELSE
- Strings.StringToInt(s1, i1, res1);
- Strings.StringToInt(s2, i2, res2)
- END;
- RETURN (res1 = 0) & (res2 = 0) & (i1 = i2)
- | Meta.longTyp:
- IF c.prop.level > 0 THEN
- FixToInt(s1, t1, c.prop.level); StringToLong(t1, l1, res1);
- FixToInt(s2, t2, c.prop.level); StringToLong(t2, l2, res2)
- ELSE
- StringToLong(s1, l1, res1);
- StringToLong(s2, l2, res2)
- END;
- RETURN (res1 = 0) & (res2 = 0) & (l1 = l2)
- | Meta.sRealTyp, Meta.realTyp:
- Strings.StringToReal(s1, r1, res1);
- Strings.StringToReal(s2, r2, res2);
- RETURN (res1 = 0) & (res2 = 0) & (r1 = r2)
- | Meta.recTyp:
- c.item.GetTypeName(mod, name);
- IF mod = "Dialog" THEN
- IF name = "Currency" THEN
- c.item.Lookup("scale", b); i1 := b.IntVal();
- FixToInt(s1, t1, i1); StringToLong(t1, l1, res1);
- FixToInt(s2, t2, i1); StringToLong(t2, l2, res2);
- RETURN (res1 = 0) & (res2 = 0) & (l1 =l2)
- ELSE (* name = "Combo" *)
- RETURN s1 = s2
- END
- END
- ELSE RETURN s1 = s2
- END
- END EqualField;
- PROCEDURE (c: Field) CopyFromSimpleView2 (source: Control);
- BEGIN
- WITH source: Field DO c.maxLen := source.maxLen END
- END CopyFromSimpleView2;
- PROCEDURE (c: Field) Internalize2 (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- rd.ReadVersion(minVersion, fldVersion, thisVersion)
- END Internalize2;
- PROCEDURE (c: Field) Externalize2 (VAR wr: Stores.Writer);
- BEGIN
- wr.WriteVersion(fldVersion)
- END Externalize2;
- PROCEDURE (c: Field) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.Field;
- BEGIN
- f := StdCFrames.dir.NewField();
- f.disabled := c.disabled;
- f.undef := c.undef;
- f.readOnly := c.readOnly;
- f.font := c.font;
- f.maxLen := c.maxLen;
- f.left := c.prop.opt[left];
- f.right := c.prop.opt[right];
- f.multiLine := c.prop.opt[multiLine];
- f.password := c.prop.opt[password];
- f.Get := GetField;
- f.Set := SetField;
- f.Equal := EqualField;
- frame := f
- END GetNewFrame;
- PROCEDURE (c: Field) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
- PROCEDURE (c: Field) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- VAR ch: CHAR; mod, name: Meta.Name;
- BEGIN
- WITH f: StdCFrames.Field DO
- IF ~c.disabled & ~c.readOnly THEN
- WITH msg: Controllers.PollOpsMsg DO
- msg.selectable := TRUE;
- (* should ask Frame if there is a selection for cut or copy! *)
- msg.valid := {Controllers.pasteChar, Controllers.cut, Controllers.copy, Controllers.paste}
- | msg: Controllers.TickMsg DO
- f.Idle
- | msg: Controllers.EditMsg DO
- IF msg.op = Controllers.pasteChar THEN
- ch := msg.char;
- IF (ch = ldel) OR (ch = rdel) OR (ch >= 10X) & (ch <= 1FX)
- OR ("0" <= ch) & (ch <= "9") OR (ch = "+") OR (ch = "-")
- OR (c.item.typ = Meta.arrTyp)
- OR (c.item.typ IN {Meta.sRealTyp, Meta.realTyp}) & ((ch = ".") OR (ch = "E"))
- OR (c.prop.level > 0) & (ch = ".")
- THEN f.KeyDown(ch)
- ELSIF c.item.typ = Meta.recTyp THEN
- c.item.GetTypeName(mod, name);
- IF (mod = "Dialog") & (name = "Combo") OR (ch = ".") THEN
- f.KeyDown(ch)
- ELSE Dialog.Beep
- END
- ELSE Dialog.Beep
- END
- ELSE
- f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
- END
- | msg: Controllers.SelectMsg DO
- IF msg.set THEN f.Select(0, MAX(INTEGER))
- ELSE f.Select(-1, -1)
- END
- | msg: Controllers.MarkMsg DO
- f.Mark(msg.show, msg.focus);
- IF ~msg.show & msg.focus THEN f.Update END;
- IF msg.show & msg.focus THEN f.Select(0, MAX(INTEGER)) END
- ELSE
- CatchCtrlMsg(c, f, msg, focus)
- END
- ELSIF ~c.disabled THEN
- WITH msg: Controllers.TrackMsg DO
- f.MouseDown(msg.x, msg.y, msg.modifiers)
- ELSE
- END
- END
- END
- END HandleCtrlMsg2;
- PROCEDURE (c: Field) HandlePropMsg2 (VAR msg: Properties.Message);
- BEGIN
- WITH msg: Properties.ControlPref DO
- IF msg.char = lineChar THEN msg.accepts := c.prop.opt[multiLine] & (msg.focus = c)
- ELSIF msg.char = esc THEN msg.accepts := FALSE
- END;
- IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
- | msg: Properties.FocusPref DO
- IF ~c.disabled & ~c.readOnly THEN
- msg.setFocus := TRUE
- ELSIF~c.disabled THEN
- msg.hotFocus := TRUE
- END
- | msg: Properties.SizePref DO
- StdCFrames.dir.GetFieldSize(c.maxLen, msg.w, msg.h)
- | msg: PropPref DO
- msg.valid := {link, label, guard, level, notifier, left, right, multiLine, password}
- ELSE
- END
- END HandlePropMsg2;
- PROCEDURE (c: Field) CheckLink (VAR ok: BOOLEAN);
- VAR t: INTEGER; name: Meta.Name;
- BEGIN
- GetTypeName(c.item, name); t := c.item.typ;
- IF (t = Meta.arrTyp) & (c.item.BaseTyp() = Meta.charTyp) THEN c.maxLen := SHORT(c.item.Len() - 1)
- ELSIF t = Meta.byteTyp THEN c.maxLen := 6
- ELSIF t = Meta.sIntTyp THEN c.maxLen := 9
- ELSIF t = Meta.intTyp THEN c.maxLen := 13
- ELSIF t = Meta.longTyp THEN c.maxLen := 24
- ELSIF t = Meta.sRealTyp THEN c.maxLen := 16
- ELSIF t = Meta.realTyp THEN c.maxLen := 24
- ELSIF name = "Combo" THEN c.maxLen := 64
- ELSIF name = "Currency" THEN c.maxLen := 16
- ELSE ok := FALSE
- END
- END CheckLink;
- PROCEDURE (c: Field) Update (f: Views.Frame; op, from, to: INTEGER);
- BEGIN
- f(StdCFrames.Frame).Update
- END Update;
-
- (* UpDownField *)
- PROCEDURE GetUpDownField (f: StdCFrames.UpDownField; OUT val: INTEGER);
- VAR c: UpDownField;
- BEGIN
- val := 0;
- c := f.view(UpDownField);
- IF c.item.Valid() THEN val := c.item.IntVal() END
- END GetUpDownField;
- PROCEDURE SetUpDownField (f: StdCFrames.UpDownField; val: INTEGER);
- VAR c: UpDownField; old: INTEGER;
- BEGIN
- c := f.view(UpDownField);
- IF c.item.Valid() & ~c.readOnly THEN
- IF (val >= c.min) & (val <= c.max) THEN
- old := c.item.IntVal();
- IF old # val THEN c.item.PutIntVal(val); Notify(c, f, Dialog.changed, old, val) END
- ELSE Dialog.Beep
- END
- END
- END SetUpDownField;
-
- PROCEDURE (c: UpDownField) CopyFromSimpleView2 (source: Control);
- BEGIN
- WITH source: UpDownField DO
- c.min := source.min;
- c.max := source.max;
- c.inc := source.inc
- END
- END CopyFromSimpleView2;
- PROCEDURE (c: UpDownField) Internalize2 (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- rd.ReadVersion(minVersion, fldVersion, thisVersion)
- END Internalize2;
- PROCEDURE (c: UpDownField) Externalize2 (VAR wr: Stores.Writer);
- BEGIN
- wr.WriteVersion(fldVersion)
- END Externalize2;
- PROCEDURE (c: UpDownField) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.UpDownField;
- BEGIN
- f := StdCFrames.dir.NewUpDownField();
- f.disabled := c.disabled;
- f.undef := c.undef;
- f.readOnly := c.readOnly;
- f.font := c.font;
- f.min := c.min;
- f.max := c.max;
- f.inc := c.inc;
- f.Get := GetUpDownField;
- f.Set := SetUpDownField;
- frame := f
- END GetNewFrame;
- PROCEDURE (c: UpDownField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
- PROCEDURE (c: UpDownField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- VAR ch: CHAR;
- BEGIN
- IF ~c.disabled & ~c.readOnly THEN
- WITH f: StdCFrames.UpDownField DO
- WITH msg: Controllers.PollOpsMsg DO
- msg.selectable := TRUE;
- (* should ask view if there is a selection for cut or copy! *)
- msg.valid := {Controllers.pasteChar, Controllers.cut, Controllers.copy, Controllers.paste}
- | msg: Controllers.TickMsg DO
- f.Idle
- | msg: Controllers.EditMsg DO
- IF msg.op = Controllers.pasteChar THEN
- ch := msg.char;
- IF (ch = ldel) OR (ch = rdel) OR (ch >= 10X) & (ch <= 1FX)
- OR ("0" <= ch) & (ch <= "9") OR (ch = "+") OR (ch = "-")
- OR (c.item.typ = Meta.arrTyp)
- THEN f.KeyDown(ch)
- ELSE Dialog.Beep
- END
- ELSE
- f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
- END
- | msg: Controllers.SelectMsg DO
- IF msg.set THEN f.Select(0, MAX(INTEGER))
- ELSE f.Select(-1, -1)
- END
- | msg: Controllers.MarkMsg DO
- f.Mark(msg.show, msg.focus);
- IF msg.show & msg.focus THEN f.Select(0, MAX(INTEGER)) END
- ELSE
- CatchCtrlMsg(c, f, msg, focus)
- END
- END
- END
- END HandleCtrlMsg2;
- PROCEDURE (c: UpDownField) HandlePropMsg2 (VAR msg: Properties.Message);
- VAR m: INTEGER; n: INTEGER;
- BEGIN
- WITH msg: Properties.ControlPref DO
- IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
- IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
- | msg: Properties.FocusPref DO
- IF ~c.disabled & ~c.readOnly THEN
- msg.setFocus := TRUE
- END
- | msg: Properties.SizePref DO
- m := -c.min;
- IF c.max > m THEN m := c.max END;
- n := 3;
- WHILE m > 99 DO INC(n); m := m DIV 10 END;
- StdCFrames.dir.GetUpDownFieldSize(n, msg.w, msg.h)
- | msg: PropPref DO
- msg.valid := {link, label, guard, notifier}
- ELSE
- END
- END HandlePropMsg2;
- PROCEDURE (c: UpDownField) CheckLink (VAR ok: BOOLEAN);
- BEGIN
- IF c.item.typ = Meta.byteTyp THEN c.min := MIN(BYTE); c.max := MAX(BYTE)
- ELSIF c.item.typ = Meta.sIntTyp THEN c.min := MIN(SHORTINT); c.max := MAX(SHORTINT)
- ELSIF c.item.typ = Meta.intTyp THEN c.min := MIN(INTEGER); c.max := MAX(INTEGER)
- ELSE ok := FALSE
- END;
- c.inc := 1
- END CheckLink;
- PROCEDURE (c: UpDownField) Update (f: Views.Frame; op, from, to: INTEGER);
- BEGIN
- f(StdCFrames.Frame).Update
- END Update;
-
- (* DateField *)
- PROCEDURE GetDateField (f: StdCFrames.DateField; OUT date: Dates.Date);
- VAR c: DateField; v: Meta.Item;
- BEGIN
- date.year := 1; date.month := 1; date.day := 1;
- c := f.view(DateField);
- IF c.item.Valid() THEN
- c.item.Lookup("year", v); IF v.typ = Meta.intTyp THEN date.year := SHORT(v.IntVal()) END;
- c.item.Lookup("month", v); IF v.typ = Meta.intTyp THEN date.month := SHORT(v.IntVal()) END;
- c.item.Lookup("day", v); IF v.typ = Meta.intTyp THEN date.day := SHORT(v.IntVal()) END
- END
- END GetDateField;
-
- PROCEDURE SetDateField(f: StdCFrames.DateField; IN date: Dates.Date);
- VAR c: DateField; v: Meta.Item;
- BEGIN
- c := f.view(DateField);
- IF c.item.Valid() & ~c.readOnly THEN
- c.item.Lookup("year", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.year) END;
- c.item.Lookup("month", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.month) END;
- c.item.Lookup("day", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.day) END;
- Notify(c, f, Dialog.changed, 0, 0)
- END
- END SetDateField;
-
- PROCEDURE GetDateFieldSelection (f: StdCFrames.DateField; OUT sel: INTEGER);
- BEGIN
- sel := f.view(DateField).selection
- END GetDateFieldSelection;
-
- PROCEDURE SetDateFieldSelection (f: StdCFrames.DateField; sel: INTEGER);
- BEGIN
- f.view(DateField).selection := sel
- END SetDateFieldSelection;
-
- PROCEDURE (c: DateField) CopyFromSimpleView2 (source: Control);
- BEGIN
- WITH source: DateField DO c.selection := source.selection END
- END CopyFromSimpleView2;
- PROCEDURE (c: DateField) Internalize2 (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- rd.ReadVersion(minVersion, dfldVersion, thisVersion);
- c.selection := 0
- END Internalize2;
- PROCEDURE (c: DateField) Externalize2 (VAR wr: Stores.Writer);
- BEGIN
- wr.WriteVersion(dfldVersion)
- END Externalize2;
- PROCEDURE (c: DateField) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.DateField;
- BEGIN
- f := StdCFrames.dir.NewDateField();
- f.disabled := c.disabled;
- f.undef := c.undef;
- f.readOnly := c.readOnly;
- f.font := c.font;
- f.Get := GetDateField;
- f.Set := SetDateField;
- f.GetSel := GetDateFieldSelection;
- f.SetSel := SetDateFieldSelection;
- frame := f
- END GetNewFrame;
- PROCEDURE (c: DateField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
- PROCEDURE (c: DateField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- IF ~c.disabled & ~c.readOnly THEN
- WITH f: StdCFrames.DateField DO
- WITH msg: Controllers.PollOpsMsg DO
- msg.valid := {Controllers.pasteChar, Controllers.copy}
- | msg: Controllers.EditMsg DO
- IF msg.op = Controllers.pasteChar THEN
- f.KeyDown(msg.char)
- ELSE
- f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
- END
- | msg: Controllers.TickMsg DO
- IF f.mark THEN
- IF c.selection = 0 THEN c.selection := 1; Views.Update(c, Views.keepFrames) END
- END
- ELSE
- CatchCtrlMsg(c, f, msg, focus)
- END
- END
- END
- END HandleCtrlMsg2;
- PROCEDURE (c: DateField) HandlePropMsg2 (VAR msg: Properties.Message);
- BEGIN
- WITH msg: Properties.ControlPref DO
- IF (msg.char = lineChar) OR (msg.char = esc) THEN
- msg.accepts := FALSE
- ELSIF (msg.char = tab) OR (msg.char = ltab) THEN
- msg.accepts := ((msg.focus # c) & (~c.disabled & ~c.readOnly)) OR
- (msg.focus = c) & ((msg.char = tab) & (c.selection # -1) OR (msg.char = ltab) & (c.selection # 1));
- msg.getFocus := msg.accepts
- END;
- IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
- | msg: Properties.FocusPref DO
- IF ~c.disabled & ~c.readOnly THEN
- msg.setFocus := TRUE
- END
- | msg: Properties.SizePref DO
- StdCFrames.dir.GetDateFieldSize(msg.w, msg.h)
- | msg: PropPref DO
- msg.valid := {link, label, guard, notifier}
- ELSE
- END
- END HandlePropMsg2;
- PROCEDURE (c: DateField) CheckLink (VAR ok: BOOLEAN);
- VAR name: Meta.Name;
- BEGIN
- GetTypeName(c.item, name);
- ok := name = "Date"
- END CheckLink;
- PROCEDURE (c: DateField) Update (f: Views.Frame; op, from, to: INTEGER);
- BEGIN
- f(StdCFrames.Frame).Update
- END Update;
-
- (* TimeField *)
- PROCEDURE GetTimeField (f: StdCFrames.TimeField; OUT time: Dates.Time);
- VAR c: TimeField; v: Meta.Item;
- BEGIN
- time.hour := 0; time.minute := 0; time.second := 0;
- c := f.view(TimeField);
- IF c.item.Valid() THEN
- c.item.Lookup("hour", v); IF v.typ = Meta.intTyp THEN time.hour := SHORT(v.IntVal()) END;
- c.item.Lookup("minute", v); IF v.typ = Meta.intTyp THEN time.minute := SHORT(v.IntVal()) END;
- c.item.Lookup("second", v); IF v.typ = Meta.intTyp THEN time.second := SHORT(v.IntVal()) END
- END
- END GetTimeField;
-
- PROCEDURE SetTimeField(f: StdCFrames.TimeField; IN date: Dates.Time);
- VAR c: TimeField; v: Meta.Item;
- BEGIN
- c := f.view(TimeField);
- IF c.item.Valid() & ~c.readOnly THEN
- c.item.Lookup("hour", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.hour) END;
- c.item.Lookup("minute", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.minute) END;
- c.item.Lookup("second", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.second) END;
- Notify(c, f, Dialog.changed, 0, 0)
- END
- END SetTimeField;
-
- PROCEDURE GetTimeFieldSelection (f: StdCFrames.TimeField; OUT sel: INTEGER);
- BEGIN
- sel := f.view(TimeField).selection
- END GetTimeFieldSelection;
-
- PROCEDURE SetTimeFieldSelection (f: StdCFrames.TimeField; sel: INTEGER);
- BEGIN
- f.view(TimeField).selection := sel
- END SetTimeFieldSelection;
-
- PROCEDURE (c: TimeField) CopyFromSimpleView2 (source: Control);
- BEGIN
- WITH source: TimeField DO c.selection := source.selection END
- END CopyFromSimpleView2;
- PROCEDURE (c: TimeField) Internalize2 (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- rd.ReadVersion(minVersion, tfldVersion, thisVersion);
- c.selection := 0
- END Internalize2;
- PROCEDURE (c: TimeField) Externalize2 (VAR wr: Stores.Writer);
- BEGIN
- wr.WriteVersion(tfldVersion)
- END Externalize2;
- PROCEDURE (c: TimeField) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.TimeField;
- BEGIN
- f := StdCFrames.dir.NewTimeField();
- f.disabled := c.disabled;
- f.undef := c.undef;
- f.readOnly := c.readOnly;
- f.font := c.font;
- f.Get := GetTimeField;
- f.Set := SetTimeField;
- f.GetSel := GetTimeFieldSelection;
- f.SetSel := SetTimeFieldSelection;
- frame := f
- END GetNewFrame;
- PROCEDURE (c: TimeField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
- PROCEDURE (c: TimeField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- IF ~c.disabled & ~c.readOnly THEN
- WITH f: StdCFrames.TimeField DO
- WITH msg: Controllers.PollOpsMsg DO
- msg.valid := {Controllers.pasteChar, Controllers.copy}
- | msg: Controllers.EditMsg DO
- IF msg.op = Controllers.pasteChar THEN
- f.KeyDown(msg.char)
- ELSE
- f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
- END
- | msg: Controllers.TickMsg DO
- IF f.mark THEN
- IF c.selection = 0 THEN c.selection := 1; Views.Update(c, Views.keepFrames) END
- END
- ELSE
- CatchCtrlMsg(c, f, msg, focus)
- END
- END
- END
- END HandleCtrlMsg2;
- PROCEDURE (c: TimeField) HandlePropMsg2 (VAR msg: Properties.Message);
- BEGIN
- WITH msg: Properties.ControlPref DO
- IF (msg.char = lineChar) OR (msg.char = esc) THEN
- msg.accepts := FALSE
- ELSIF (msg.char = tab) OR (msg.char = ltab) THEN
- msg.accepts := (msg.focus # c) OR
- ((msg.char = tab) & (c.selection # -1)) OR ((msg.char = ltab) & (c.selection # 1))
- END;
- IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
- | msg: Properties.FocusPref DO
- IF ~c.disabled & ~c.readOnly THEN
- msg.setFocus := TRUE
- END
- | msg: Properties.SizePref DO
- StdCFrames.dir.GetTimeFieldSize(msg.w, msg.h)
- | msg: PropPref DO
- msg.valid := {link, label, guard, notifier}
- ELSE
- END
- END HandlePropMsg2;
- PROCEDURE (c: TimeField) CheckLink (VAR ok: BOOLEAN);
- VAR name: Meta.Name;
- BEGIN
- GetTypeName(c.item, name);
- ok := name = "Time"
- END CheckLink;
- PROCEDURE (c: TimeField) Update (f: Views.Frame; op, from, to: INTEGER);
- BEGIN
- f(StdCFrames.Frame).Update
- END Update;
-
- (* ColorField *)
- PROCEDURE GetColorField (f: StdCFrames.ColorField; OUT col: INTEGER);
- VAR c: ColorField; v: Meta.Item;
- BEGIN
- col := Ports.defaultColor;
- c := f.view(ColorField);
- IF c.item.Valid() THEN
- IF c.item.typ = Meta.intTyp THEN
- col := c.item.IntVal()
- ELSE
- c.item.Lookup("val", v); IF v.typ = Meta.intTyp THEN col := v.IntVal() END
- END
- END
- END GetColorField;
-
- PROCEDURE SetColorField(f: StdCFrames.ColorField; col: INTEGER);
- VAR c: ColorField; v: Meta.Item; old: INTEGER;
- BEGIN
- c := f.view(ColorField);
- IF c.item.Valid() & ~c.readOnly THEN
- IF c.item.typ = Meta.intTyp THEN
- old := c.item.IntVal();
- IF old # col THEN c.item.PutIntVal(col); Notify(c, f, Dialog.changed, old, col) END
- ELSE
- c.item.Lookup("val", v);
- IF v.typ = Meta.intTyp THEN
- old := v.IntVal();
- IF old # col THEN v.PutIntVal(col); Notify(c, f, Dialog.changed, old, col) END
- END
- END
- END
- END SetColorField;
-
- PROCEDURE (c: ColorField) Internalize2 (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- rd.ReadVersion(minVersion, cfldVersion, thisVersion)
- END Internalize2;
- PROCEDURE (c: ColorField) Externalize2 (VAR wr: Stores.Writer);
- BEGIN
- wr.WriteVersion(cfldVersion)
- END Externalize2;
- PROCEDURE (c: ColorField) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.ColorField;
- BEGIN
- f := StdCFrames.dir.NewColorField();
- f.disabled := c.disabled;
- f.undef := c.undef;
- f.readOnly := c.readOnly;
- f.font := c.font;
- f.Get := GetColorField;
- f.Set := SetColorField;
- frame := f
- END GetNewFrame;
- PROCEDURE (c: ColorField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
- PROCEDURE (c: ColorField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- IF ~c.disabled & ~c.readOnly THEN
- WITH f: StdCFrames.ColorField DO
- WITH msg: Controllers.EditMsg DO
- IF msg.op = Controllers.pasteChar THEN
- f.KeyDown(msg.char)
- ELSE
- f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
- END
- ELSE
- CatchCtrlMsg(c, f, msg, focus)
- END
- END
- END
- END HandleCtrlMsg2;
- PROCEDURE (c: ColorField) HandlePropMsg2 (VAR msg: Properties.Message);
- BEGIN
- WITH msg: Properties.ControlPref DO
- msg.accepts := ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c)
- | msg: Properties.FocusPref DO
- IF ~c.disabled & ~c.readOnly THEN
- msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
- END
- | msg: Properties.SizePref DO
- StdCFrames.dir.GetColorFieldSize(msg.w, msg.h)
- ELSE
- END
- END HandlePropMsg2;
- PROCEDURE (c: ColorField) CheckLink (VAR ok: BOOLEAN);
- VAR name: Meta.Name;
- BEGIN
- GetTypeName(c.item, name);
- ok := (name = "Color") OR (c.item.typ = Meta.intTyp)
- END CheckLink;
- PROCEDURE (c: ColorField) Update (f: Views.Frame; op, from, to: INTEGER);
- BEGIN
- f(StdCFrames.Frame).Update
- END Update;
-
- (* ListBox *)
- PROCEDURE GetListBox (f: StdCFrames.ListBox; OUT i: INTEGER);
- VAR c: ListBox; v: Meta.Item;
- BEGIN
- i := -1;
- c := f.view(ListBox);
- IF c.item.Valid() THEN
- c.item.Lookup("index", v);
- IF v.typ = Meta.intTyp THEN i := v.IntVal() END
- END
- END GetListBox;
- PROCEDURE SetListBox (f: StdCFrames.ListBox; i: INTEGER);
- VAR c: ListBox; v: Meta.Item; old: INTEGER;
- BEGIN
- c := f.view(ListBox);
- IF c.item.Valid() & ~c.readOnly THEN
- c.item.Lookup("index", v);
- IF v.typ = Meta.intTyp THEN
- old := v.IntVal();
- IF i # old THEN v.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
- END
- END
- END SetListBox;
-
- PROCEDURE GetFName (VAR rec, par: ANYREC);
- BEGIN
- WITH par: Param DO
- WITH rec: Dialog.List DO rec.GetItem(par.i, par.n)
- | rec: Dialog.Selection DO rec.GetItem(par.i, par.n)
- | rec: Dialog.Combo DO rec.GetItem(par.i, par.n)
- ELSE par.n := ""
- END
- END
- END GetFName;
-
- PROCEDURE GetListName (f: StdCFrames.ListBox; i: INTEGER; VAR name: ARRAY OF CHAR);
- VAR c: ListBox; par: Param;
- BEGIN
- par.n := "";
- c := f.view(ListBox);
- IF c.item.Valid() THEN
- par.i := i;
- c.item.CallWith(GetFName, par)
- END;
- name := par.n$
- END GetListName;
- PROCEDURE (c: ListBox) Internalize2 (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- rd.ReadVersion(minVersion, lbxVersion, thisVersion)
- END Internalize2;
- PROCEDURE (c: ListBox) Externalize2 (VAR wr: Stores.Writer);
- BEGIN
- wr.WriteVersion(lbxVersion)
- END Externalize2;
- PROCEDURE (c: ListBox) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.ListBox;
- BEGIN
- f := StdCFrames.dir.NewListBox();
- f.disabled := c.disabled;
- f.undef := c.undef;
- f.readOnly := c.readOnly;
- f.font := c.font;
- f.sorted := c.prop.opt[sorted];
- f.Get := GetListBox;
- f.Set := SetListBox;
- f.GetName := GetListName;
- frame := f
- END GetNewFrame;
- PROCEDURE (c: ListBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
- PROCEDURE (c: ListBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- WITH f: StdCFrames.ListBox DO
- IF ~c.disabled & ~c.readOnly THEN
- WITH msg: Controllers.EditMsg DO
- IF msg.op = Controllers.pasteChar THEN f.KeyDown(msg.char) END
- ELSE
- CatchCtrlMsg(c, f, msg, focus)
- END
- ELSIF ~c.disabled THEN
- WITH msg: Controllers.TrackMsg DO
- f.MouseDown(msg.x, msg.y, msg.modifiers)
- ELSE
- END
- END
- END
- END HandleCtrlMsg2;
- PROCEDURE (c: ListBox) HandlePropMsg2 (VAR msg: Properties.Message);
- BEGIN
- WITH msg: Properties.ControlPref DO
- IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
- IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
- | msg: Properties.FocusPref DO
- IF ~c.disabled & ~c.readOnly THEN
- msg.setFocus := TRUE
- ELSIF~c.disabled THEN
- msg.hotFocus := TRUE
- END
- | msg: Properties.SizePref DO
- StdCFrames.dir.GetListBoxSize(msg.w, msg.h)
- | msg: PropPref DO
- msg.valid := {link, label, guard, notifier, sorted}
- ELSE
- END
- END HandlePropMsg2;
- PROCEDURE (c: ListBox) CheckLink (VAR ok: BOOLEAN);
- VAR name: Meta.Name;
- BEGIN
- GetTypeName(c.item, name);
- ok := name = "List"
- END CheckLink;
- PROCEDURE (c: ListBox) Update (f: Views.Frame; op, from, to: INTEGER);
- BEGIN
- f(StdCFrames.Frame).Update
- END Update;
-
- PROCEDURE (c: ListBox) UpdateList (f: Views.Frame);
- BEGIN
- f(StdCFrames.Frame).UpdateList
- END UpdateList;
-
- (* SelectionBox *)
- PROCEDURE InLargeSet (VAR rec, par: ANYREC);
- BEGIN
- WITH par: Param DO
- WITH rec: Dialog.Selection DO
- IF rec.In(par.i) THEN par.i := 1 ELSE par.i := 0 END
- ELSE par.i := 0
- END
- END
- END InLargeSet;
-
- PROCEDURE GetSelectionBox (f: StdCFrames.SelectionBox; i: INTEGER; OUT in: BOOLEAN);
- VAR c: SelectionBox; lv: SelectValue; par: Param;
- BEGIN
- in := FALSE;
- c := f.view(SelectionBox);
- IF c.item.Valid() THEN
- IF c.item.Is(lv) THEN
- par.i := i;
- c.item.CallWith(InLargeSet, par);
- in := par.i # 0
- END
- END
- END GetSelectionBox;
- PROCEDURE InclLargeSet (VAR rec, par: ANYREC);
- BEGIN
- WITH par: Param DO
- WITH rec: Dialog.Selection DO
- IF (par.from # par.to) OR ~rec.In(par.from) THEN
- rec.Incl(par.from, par.to); par.i := 1
- ELSE par.i := 0
- END
- ELSE par.i := 0
- END
- END
- END InclLargeSet;
-
- PROCEDURE InclSelectionBox (f: StdCFrames.SelectionBox; from, to: INTEGER);
- VAR c: SelectionBox; lv: SelectValue; par: Param;
- BEGIN
- c := f.view(SelectionBox);
- IF c.item.Valid() & ~c.readOnly THEN
- IF c.item.Is(lv) THEN
- par.from := from; par.to := to;
- c.item.CallWith(InclLargeSet, par);
- IF par.i # 0 THEN Notify(c, f, Dialog.included, from, to) END
- END
- END
- END InclSelectionBox;
-
- PROCEDURE ExclLargeSet (VAR rec, par: ANYREC);
- BEGIN
- WITH par: Param DO
- WITH rec: Dialog.Selection DO
- IF (par.from # par.to) OR rec.In(par.from) THEN
- rec.Excl(par.from, par.to); par.i := 1
- ELSE par.i := 0
- END
- ELSE par.i := 0
- END
- END
- END ExclLargeSet;
-
- PROCEDURE ExclSelectionBox (f: StdCFrames.SelectionBox; from, to: INTEGER);
- VAR c: SelectionBox; lv: SelectValue; par: Param;
- BEGIN
- c := f.view(SelectionBox);
- IF c.item.Valid() & ~c.readOnly THEN
- IF c.item.Is(lv) THEN
- par.from := from; par.to := to;
- c.item.CallWith(ExclLargeSet, par);
- IF par.i # 0 THEN Notify(c, f, Dialog.excluded, from, to) END
- END
- END
- END ExclSelectionBox;
-
- PROCEDURE SetSelectionBox (f: StdCFrames.SelectionBox; from, to: INTEGER);
- VAR c: SelectionBox; lv: SelectValue; par: Param;
- BEGIN
- c := f.view(SelectionBox);
- IF c.item.Valid() & ~c.readOnly THEN
- IF c.item.Is(lv) THEN
- par.from := 0; par.to := MAX(INTEGER);
- c.item.CallWith(ExclLargeSet, par);
- par.from := from; par.to := to;
- c.item.CallWith(InclLargeSet, par);
- Notify(c, f, Dialog.set, from, to)
- END
- END
- END SetSelectionBox;
-
- PROCEDURE GetSelName (f: StdCFrames.SelectionBox; i: INTEGER; VAR name: ARRAY OF CHAR);
- VAR c: SelectionBox; par: Param;
- BEGIN
- par.n := "";
- c := f.view(SelectionBox);
- IF c.item.Valid() THEN
- par.i := i;
- c.item.CallWith(GetFName, par)
- END;
- name := par.n$
- END GetSelName;
- PROCEDURE (c: SelectionBox) Internalize2 (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- rd.ReadVersion(minVersion, sbxVersion, thisVersion)
- END Internalize2;
- PROCEDURE (c: SelectionBox) Externalize2 (VAR wr: Stores.Writer);
- BEGIN
- wr.WriteVersion(sbxVersion)
- END Externalize2;
- PROCEDURE (c: SelectionBox) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.SelectionBox;
- BEGIN
- f := StdCFrames.dir.NewSelectionBox();
- f.disabled := c.disabled;
- f.undef := c.undef;
- f.readOnly := c.readOnly;
- f.font := c.font;
- f.sorted := c.prop.opt[sorted];
- f.Get := GetSelectionBox;
- f.Incl := InclSelectionBox;
- f.Excl := ExclSelectionBox;
- f.Set := SetSelectionBox;
- f.GetName := GetSelName;
- frame := f
- END GetNewFrame;
- PROCEDURE (c: SelectionBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
- PROCEDURE (c: SelectionBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- WITH f: StdCFrames.SelectionBox DO
- IF ~c.disabled & ~c.readOnly THEN
- WITH msg: Controllers.EditMsg DO
- IF msg.op = Controllers.pasteChar THEN f.KeyDown(msg.char) END
- | msg: Controllers.SelectMsg DO
- IF msg.set THEN f.Select(0, MAX(INTEGER))
- ELSE f.Select(-1, -1)
- END
- ELSE
- CatchCtrlMsg(c, f, msg, focus)
- END
- ELSIF ~c.disabled THEN
- WITH msg: Controllers.TrackMsg DO
- f.MouseDown(msg.x, msg.y, msg.modifiers)
- ELSE
- END
- END
- END
- END HandleCtrlMsg2;
- PROCEDURE (c: SelectionBox) HandlePropMsg2 (VAR msg: Properties.Message);
- BEGIN
- WITH msg: Properties.ControlPref DO
- IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
- IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) OR msg.getFocus THEN
- msg.getFocus := StdCFrames.setFocus
- END
- | msg: Properties.FocusPref DO
- IF ~c.disabled & ~c.readOnly THEN
- msg.setFocus := TRUE
- ELSIF~c.disabled THEN
- msg.hotFocus := TRUE
- END
- | msg: Properties.SizePref DO
- StdCFrames.dir.GetSelectionBoxSize(msg.w, msg.h)
- | msg: PropPref DO
- msg.valid := {link, label, guard, notifier, sorted}
- ELSE
- END
- END HandlePropMsg2;
- PROCEDURE (c: SelectionBox) CheckLink (VAR ok: BOOLEAN);
- VAR name: Meta.Name;
- BEGIN
- GetTypeName(c.item, name);
- ok := name = "Selection"
- END CheckLink;
- PROCEDURE (c: SelectionBox) Update (f: Views.Frame; op, from, to: INTEGER);
- BEGIN
- IF (op >= Dialog.included) & (op <= Dialog.set) THEN
- f(StdCFrames.SelectionBox).UpdateRange(op, from, to)
- ELSE
- f(StdCFrames.Frame).Update
- END
- END Update;
-
- PROCEDURE (c: SelectionBox) UpdateList (f: Views.Frame);
- BEGIN
- f(StdCFrames.Frame).UpdateList
- END UpdateList;
-
- (* ComboBox *)
- PROCEDURE GetComboBox (f: StdCFrames.ComboBox; OUT x: ARRAY OF CHAR);
- VAR c: ComboBox; ok: BOOLEAN; v: Meta.Item;
- BEGIN
- x := "";
- c := f.view(ComboBox);
- IF c.item.Valid() THEN
- c.item.Lookup("item", v);
- IF v.typ = Meta.arrTyp THEN v.GetStringVal(x, ok) END
- END
- END GetComboBox;
- PROCEDURE SetComboBox (f: StdCFrames.ComboBox; IN x: ARRAY OF CHAR);
- VAR c: ComboBox; ok: BOOLEAN; v: Meta.Item; s: ARRAY 1024 OF CHAR;
- BEGIN
- c := f.view(ComboBox);
- IF c.item.Valid() & ~c.readOnly THEN
- c.item.Lookup("item", v);
- IF v.typ = Meta.arrTyp THEN
- v.GetStringVal(s, ok);
- IF ~ok OR (s$ # x$) THEN
- v.PutStringVal(x, ok);
- IF ok THEN Notify(c, f, Dialog.changed, 0, 0) END
- END
- END
- END
- END SetComboBox;
- PROCEDURE GetComboName (f: StdCFrames.ComboBox; i: INTEGER; VAR name: ARRAY OF CHAR);
- VAR c: ComboBox; par: Param;
- BEGIN
- par.n := "";
- c := f.view(ComboBox);
- IF c.item.Valid() THEN
- par.i := i;
- c.item.CallWith(GetFName, par)
- END;
- name := par.n$
- END GetComboName;
- PROCEDURE (c: ComboBox) Internalize2 (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- rd.ReadVersion(minVersion, cbxVersion, thisVersion)
- END Internalize2;
- PROCEDURE (c: ComboBox) Externalize2 (VAR wr: Stores.Writer);
- BEGIN
- wr.WriteVersion(cbxVersion)
- END Externalize2;
- PROCEDURE (c: ComboBox) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.ComboBox;
- BEGIN
- f := StdCFrames.dir.NewComboBox();
- f.disabled := c.disabled;
- f.undef := c.undef;
- f.readOnly := c.readOnly;
- f.font := c.font;
- f.sorted := c.prop.opt[sorted];
- f.Get := GetComboBox;
- f.Set := SetComboBox;
- f.GetName := GetComboName;
- frame := f
- END GetNewFrame;
- PROCEDURE (c: ComboBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
- PROCEDURE (c: ComboBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- WITH f: StdCFrames.ComboBox DO
- IF ~c.disabled & ~c.readOnly THEN
- WITH msg: Controllers.PollOpsMsg DO
- msg.selectable := TRUE;
- (* should ask Frame if there is a selection for cut or copy! *)
- msg.valid := {Controllers.pasteChar, Controllers.cut, Controllers.copy, Controllers.paste}
- | msg: Controllers.TickMsg DO
- f.Idle
- | msg: Controllers.EditMsg DO
- IF msg.op = Controllers.pasteChar THEN
- f.KeyDown(msg.char)
- ELSE
- f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
- END
- | msg: Controllers.SelectMsg DO
- IF msg.set THEN f.Select(0, MAX(INTEGER))
- ELSE f.Select(-1, -1)
- END
- | msg: Controllers.MarkMsg DO
- f.Mark(msg.show, msg.focus);
- IF msg.show & msg.focus THEN f.Select(0, MAX(INTEGER)) END
- | msg: Controllers.TrackMsg DO
- f.MouseDown(msg.x, msg.y, msg.modifiers)
- ELSE
- CatchCtrlMsg(c, f, msg, focus)
- END
- END
- END
- END HandleCtrlMsg2;
- PROCEDURE (c: ComboBox) HandlePropMsg2 (VAR msg: Properties.Message);
- BEGIN
- WITH msg: Properties.ControlPref DO
- IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
- IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
- | msg: Properties.FocusPref DO
- IF ~c.disabled & ~c.readOnly THEN
- msg.setFocus := TRUE
- END
- | msg: Properties.SizePref DO
- StdCFrames.dir.GetComboBoxSize(msg.w, msg.h)
- | msg: PropPref DO
- msg.valid := {link, label, guard, notifier, sorted}
- ELSE
- END
- END HandlePropMsg2;
- PROCEDURE (c: ComboBox) CheckLink (VAR ok: BOOLEAN);
- VAR name: Meta.Name;
- BEGIN
- GetTypeName(c.item, name);
- ok := name = "Combo"
- END CheckLink;
- PROCEDURE (c: ComboBox) Update (f: Views.Frame; op, from, to: INTEGER);
- BEGIN
- f(StdCFrames.Frame).Update
- END Update;
-
- PROCEDURE (c: ComboBox) UpdateList (f: Views.Frame);
- BEGIN
- f(StdCFrames.Frame).UpdateList
- END UpdateList;
-
- (* Caption *)
- PROCEDURE (c: Caption) Internalize2 (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- rd.ReadVersion(minVersion, capVersion, thisVersion);
- IF thisVersion < 1 THEN c.prop.opt[left] := TRUE END
- END Internalize2;
- PROCEDURE (c: Caption) Externalize2 (VAR wr: Stores.Writer);
- BEGIN
- (* Save old version for captions that are compatible with the old version *)
- IF c.prop.opt[left] THEN wr.WriteVersion(0) ELSE wr.WriteVersion(capVersion) END
- END Externalize2;
- PROCEDURE (c: Caption) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.Caption;
- BEGIN
- f := StdCFrames.dir.NewCaption();
- f.disabled := c.disabled;
- f.undef := c.undef;
- f.readOnly := c.readOnly;
- f.font := c.font;
- f.label := c.label$;
- f.left := c.prop.opt[left];
- f.right := c.prop.opt[right];
- frame := f
- END GetNewFrame;
- PROCEDURE (c: Caption) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
- PROCEDURE (c: Caption) HandlePropMsg2 (VAR msg: Properties.Message);
- BEGIN
- WITH msg: Properties.SizePref DO
- StdCFrames.dir.GetCaptionSize(msg.w, msg.h)
- | msg: PropPref DO
- msg.valid := {link, label, guard, left, right}
- | msg: DefaultsPref DO
- IF c.prop.link = "" THEN msg.disabled := FALSE END
- ELSE
- END
- END HandlePropMsg2;
- PROCEDURE (c: Caption) Update (f: Views.Frame; op, from, to: INTEGER);
- BEGIN
- f(StdCFrames.Caption).label := c.label$;
- f(StdCFrames.Frame).Update
- END Update;
-
- (* Group *)
- PROCEDURE (c: Group) Internalize2 (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- rd.ReadVersion(minVersion, grpVersion, thisVersion)
- END Internalize2;
- PROCEDURE (c: Group) Externalize2 (VAR wr: Stores.Writer);
- BEGIN
- wr.WriteVersion(grpVersion)
- END Externalize2;
- PROCEDURE (c: Group) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.Group;
- BEGIN
- f := StdCFrames.dir.NewGroup();
- f.disabled := c.disabled;
- f.undef := c.undef;
- f.readOnly := c.readOnly;
- f.font := c.font;
- f.label := c.label$;
- frame := f
- END GetNewFrame;
- PROCEDURE (c: Group) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
- PROCEDURE (c: Group) HandlePropMsg2 (VAR msg: Properties.Message);
- BEGIN
- WITH msg: Properties.SizePref DO
- StdCFrames.dir.GetGroupSize(msg.w, msg.h)
- | msg: PropPref DO
- msg.valid := {link, label, guard}
- | msg: DefaultsPref DO
- IF c.prop.link = "" THEN msg.disabled := FALSE END
- ELSE
- END
- END HandlePropMsg2;
- PROCEDURE (c: Group) Update (f: Views.Frame; op, from, to: INTEGER);
- BEGIN
- f(StdCFrames.Group).label := c.label$;
- f(StdCFrames.Frame).Update
- END Update;
-
-
- (* TreeControl *)
-
- PROCEDURE (c: TreeControl) Internalize2 (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- rd.ReadVersion(minVersion, tfVersion, thisVersion)
- END Internalize2;
- PROCEDURE (c: TreeControl) Externalize2 (VAR wr: Stores.Writer);
- BEGIN
- wr.WriteVersion(tfVersion)
- END Externalize2;
- PROCEDURE TVNofNodesF (VAR rec, par: ANYREC);
- BEGIN
- WITH par: TVParam DO
- WITH rec: Dialog.Tree DO par.l := rec.NofNodes()
- ELSE par.l := 0
- END
- END
- END TVNofNodesF;
-
- PROCEDURE TVNofNodes (f: StdCFrames.TreeFrame): INTEGER;
- VAR c: TreeControl; par: TVParam;
- BEGIN
- c := f.view(TreeControl); par.l := 0;
- IF c.item.Valid() THEN c.item.CallWith(TVNofNodesF, par) END;
- RETURN par.l
- END TVNofNodes;
-
- PROCEDURE TVChildF (VAR rec, par: ANYREC);
- BEGIN
- WITH par: TVParam DO
- WITH rec: Dialog.Tree DO par.nodeOut := rec.Child(par.nodeIn, Dialog.firstPos)
- ELSE par.nodeOut := NIL
- END
- END
- END TVChildF;
-
- PROCEDURE TVChild (f: StdCFrames.TreeFrame; node: Dialog.TreeNode): Dialog.TreeNode;
- VAR c: TreeControl; par: TVParam;
- BEGIN
- c := f.view(TreeControl); par.nodeIn := node; par.nodeOut := NIL;
- IF c.item.Valid() THEN c.item.CallWith(TVChildF, par) END;
- RETURN par.nodeOut
- END TVChild;
-
- PROCEDURE TVParentF (VAR rec, par: ANYREC);
- BEGIN
- WITH par: TVParam DO
- WITH rec: Dialog.Tree DO par.nodeOut := rec.Parent(par.nodeIn)
- ELSE par.nodeOut := NIL
- END
- END
- END TVParentF;
-
- PROCEDURE TVParent (f: StdCFrames.TreeFrame; node: Dialog.TreeNode): Dialog.TreeNode;
- VAR c: TreeControl; par: TVParam;
- BEGIN
- c := f.view(TreeControl); par.nodeIn := node; par.nodeOut := NIL;
- IF c.item.Valid() THEN c.item.CallWith(TVParentF, par) END;
- RETURN par.nodeOut
- END TVParent;
-
- PROCEDURE TVNextF (VAR rec, par: ANYREC);
- BEGIN
- WITH par: TVParam DO
- WITH rec: Dialog.Tree DO par.nodeOut := rec.Next(par.nodeIn)
- ELSE par.nodeOut := NIL
- END
- END
- END TVNextF;
-
- PROCEDURE TVNext (f: StdCFrames.TreeFrame; node: Dialog.TreeNode): Dialog.TreeNode;
- VAR c: TreeControl; par: TVParam;
- BEGIN
- c := f.view(TreeControl); par.nodeIn := node; par.nodeOut := NIL;
- IF c.item.Valid() THEN c.item.CallWith(TVNextF, par) END;
- RETURN par.nodeOut
- END TVNext;
-
- PROCEDURE TVSelectF (VAR rec, par: ANYREC);
- BEGIN
- WITH par: TVParam DO
- WITH rec: Dialog.Tree DO rec.Select(par.nodeIn) END
- END
- END TVSelectF;
-
- PROCEDURE TVSelect (f: StdCFrames.TreeFrame; node: Dialog.TreeNode);
- VAR c: TreeControl; par: TVParam;
- BEGIN
- c := f.view(TreeControl); par.nodeIn := node;
- IF c.item.Valid() THEN
- c.item.CallWith(TVSelectF, par);
- Notify(c, f, Dialog.changed, 0, 0)
- END
- END TVSelect;
-
- PROCEDURE TVSelectedF (VAR rec, par: ANYREC);
- BEGIN
- WITH par: TVParam DO
- WITH rec: Dialog.Tree DO par.nodeOut := rec.Selected()
- ELSE par.nodeOut := NIL
- END
- END
- END TVSelectedF;
-
- PROCEDURE TVSelected (f: StdCFrames.TreeFrame): Dialog.TreeNode;
- VAR c: TreeControl; par: TVParam;
- BEGIN
- c := f.view(TreeControl); par.nodeOut := NIL;
- IF c.item.Valid() THEN c.item.CallWith(TVSelectedF, par) END;
- RETURN par.nodeOut
- END TVSelected;
-
- PROCEDURE TVSetExpansionF (VAR rec, par: ANYREC);
- BEGIN
- WITH par: TVParam DO
- par.nodeIn.SetExpansion(par.e)
- END
- END TVSetExpansionF;
-
- PROCEDURE TVSetExpansion (f: StdCFrames.TreeFrame; tn: Dialog.TreeNode; expanded: BOOLEAN);
- VAR c: TreeControl; par: TVParam;
- BEGIN
- c := f.view(TreeControl); par.e := expanded; par.nodeIn := tn;
- IF c.item.Valid() THEN c.item.CallWith(TVSetExpansionF, par) END
- END TVSetExpansion;
- PROCEDURE (c: TreeControl) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.TreeFrame;
- BEGIN
- f := StdCFrames.dir.NewTreeFrame();
- f.disabled := c.disabled;
- f.undef := c.undef;
- f.readOnly := c.readOnly;
- f.font := c.font;
- f.sorted := c.prop.opt[sorted];
- f.haslines := c.prop.opt[haslines];
- f.hasbuttons := c.prop.opt[hasbuttons];
- f.atroot := c.prop.opt[atroot];
- f.foldericons := c.prop.opt[foldericons];
- f.NofNodes := TVNofNodes;
- f.Child := TVChild;
- f.Parent := TVParent;
- f.Next := TVNext;
- f.Select := TVSelect;
- f.Selected := TVSelected;
- f.SetExpansion := TVSetExpansion;
- frame := f
- END GetNewFrame;
- PROCEDURE (c: TreeControl) UpdateList (f: Views.Frame);
- BEGIN
- f(StdCFrames.Frame).UpdateList()
- END UpdateList;
-
- PROCEDURE (c: TreeControl) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
-
- PROCEDURE (c: TreeControl) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- WITH f: StdCFrames.TreeFrame DO
- IF ~c.disabled & ~c.readOnly THEN
- WITH msg: Controllers.EditMsg DO
- IF (msg.op = Controllers.pasteChar) THEN
- f.KeyDown(msg.char)
- END
- ELSE
- CatchCtrlMsg(c, f, msg, focus)
- END
- ELSIF ~c.disabled THEN
- WITH msg: Controllers.TrackMsg DO
- f.MouseDown(msg.x, msg.y, msg.modifiers)
- ELSE
- END
- END
- END
- END HandleCtrlMsg2;
- PROCEDURE (c: TreeControl) HandlePropMsg2 (VAR msg: Properties.Message);
- BEGIN
- WITH msg: Properties.ControlPref DO
- IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
- IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) OR msg.getFocus THEN
- msg.getFocus := StdCFrames.setFocus
- END
- | msg: Properties.FocusPref DO
- IF ~c.disabled & ~c.readOnly THEN
- msg.setFocus := TRUE
- ELSIF~c.disabled THEN
- msg.hotFocus := TRUE
- END
- | msg: Properties.SizePref DO
- StdCFrames.dir.GetTreeFrameSize(msg.w, msg.h)
- | msg: PropPref DO
- msg.valid := {link, label, guard, notifier, sorted, haslines, hasbuttons, atroot, foldericons}
- | msg: Properties.ResizePref DO
- msg.horFitToWin := TRUE; msg.verFitToWin := TRUE
- ELSE
- END
- END HandlePropMsg2;
- PROCEDURE (c: TreeControl) CheckLink (VAR ok: BOOLEAN);
- VAR name: Meta.Name;
- BEGIN
- GetTypeName(c.item, name);
- ok := name = "Tree"
- END CheckLink;
- PROCEDURE (c: TreeControl) Update (f: Views.Frame; op, from, to: INTEGER);
- BEGIN
- f(StdCFrames.Frame).Update
- END Update;
-
- (* StdDirectory *)
- PROCEDURE (d: StdDirectory) NewPushButton (p: Prop): Control;
- VAR c: PushButton;
- BEGIN
- NEW(c); OpenLink(c, p); RETURN c
- END NewPushButton;
- PROCEDURE (d: StdDirectory) NewCheckBox (p: Prop): Control;
- VAR c: CheckBox;
- BEGIN
- NEW(c); OpenLink(c, p); RETURN c
- END NewCheckBox;
- PROCEDURE (d: StdDirectory) NewRadioButton (p: Prop): Control;
- VAR c: RadioButton;
- BEGIN
- NEW(c); OpenLink(c, p); RETURN c
- END NewRadioButton;
- PROCEDURE (d: StdDirectory) NewField (p: Prop): Control;
- VAR c: Field;
- BEGIN
- NEW(c); OpenLink(c, p); RETURN c
- END NewField;
-
- PROCEDURE (d: StdDirectory) NewUpDownField (p: Prop): Control;
- VAR c: UpDownField;
- BEGIN
- NEW(c); OpenLink(c, p); RETURN c
- END NewUpDownField;
-
- PROCEDURE (d: StdDirectory) NewDateField (p: Prop): Control;
- VAR c: DateField;
- BEGIN
- NEW(c); OpenLink(c, p); RETURN c
- END NewDateField;
- PROCEDURE (d: StdDirectory) NewTimeField (p: Prop): Control;
- VAR c: TimeField;
- BEGIN
- NEW(c); OpenLink(c, p); RETURN c
- END NewTimeField;
-
- PROCEDURE (d: StdDirectory) NewColorField (p: Prop): Control;
- VAR c: ColorField;
- BEGIN
- NEW(c); OpenLink(c, p); RETURN c
- END NewColorField;
- PROCEDURE (d: StdDirectory) NewListBox (p: Prop): Control;
- VAR c: ListBox;
- BEGIN
- NEW(c); OpenLink(c, p); RETURN c
- END NewListBox;
- PROCEDURE (d: StdDirectory) NewSelectionBox (p: Prop): Control;
- VAR c: SelectionBox;
- BEGIN
- NEW(c); OpenLink(c, p); RETURN c
- END NewSelectionBox;
- PROCEDURE (d: StdDirectory) NewComboBox (p: Prop): Control;
- VAR c: ComboBox;
- BEGIN
- NEW(c); OpenLink(c, p); RETURN c
- END NewComboBox;
- PROCEDURE (d: StdDirectory) NewCaption (p: Prop): Control;
- VAR c: Caption;
- BEGIN
- NEW(c); OpenLink(c, p); RETURN c
- END NewCaption;
- PROCEDURE (d: StdDirectory) NewGroup (p: Prop): Control;
- VAR c: Group;
- BEGIN
- NEW(c); OpenLink(c, p); RETURN c
- END NewGroup;
- PROCEDURE (d: StdDirectory) NewTreeControl (p: Prop): Control;
- VAR c: TreeControl;
- BEGIN
- NEW(c); OpenLink(c, p); RETURN c
- END NewTreeControl;
- PROCEDURE SetDir* (d: Directory);
- BEGIN
- ASSERT(d # NIL, 20); dir := d
- END SetDir;
- PROCEDURE InitProp (VAR p: Prop);
- BEGIN
- NEW(p);
- p.link := ""; p.label := ""; p.guard := ""; p.notifier := "";
- p.level := 0;
- p.opt[0] := FALSE; p.opt[1] := FALSE;
- p.opt[2] := FALSE; p.opt[3] := FALSE;
- p.opt[4] := FALSE
- END InitProp;
- PROCEDURE DepositPushButton*;
- VAR p: Prop;
- BEGIN
- InitProp(p);
- p.label := "#System:untitled";
- Views.Deposit(dir.NewPushButton(p))
- END DepositPushButton;
- PROCEDURE DepositCheckBox*;
- VAR p: Prop;
- BEGIN
- InitProp(p);
- p.label := "#System:untitled";
- Views.Deposit(dir.NewCheckBox(p))
- END DepositCheckBox;
- PROCEDURE DepositRadioButton*;
- VAR p: Prop;
- BEGIN
- InitProp(p);
- p.label := "#System:untitled";
- Views.Deposit(dir.NewRadioButton(p))
- END DepositRadioButton;
- PROCEDURE DepositField*;
- VAR p: Prop;
- BEGIN
- InitProp(p); p.opt[left] := TRUE;
- Views.Deposit(dir.NewField(p))
- END DepositField;
-
- PROCEDURE DepositUpDownField*;
- VAR p: Prop;
- BEGIN
- InitProp(p);
- Views.Deposit(dir.NewUpDownField(p))
- END DepositUpDownField;
-
- PROCEDURE DepositDateField*;
- VAR p: Prop;
- BEGIN
- InitProp(p);
- Views.Deposit(dir.NewDateField(p))
- END DepositDateField;
- PROCEDURE DepositTimeField*;
- VAR p: Prop;
- BEGIN
- InitProp(p);
- Views.Deposit(dir.NewTimeField(p))
- END DepositTimeField;
- PROCEDURE DepositColorField*;
- VAR p: Prop;
- BEGIN
- InitProp(p);
- Views.Deposit(dir.NewColorField(p))
- END DepositColorField;
- PROCEDURE DepositListBox*;
- VAR p: Prop;
- BEGIN
- InitProp(p);
- Views.Deposit(dir.NewListBox(p))
- END DepositListBox;
- PROCEDURE DepositSelectionBox*;
- VAR p: Prop;
- BEGIN
- InitProp(p);
- Views.Deposit(dir.NewSelectionBox(p))
- END DepositSelectionBox;
- PROCEDURE DepositComboBox*;
- VAR p: Prop;
- BEGIN
- InitProp(p);
- Views.Deposit(dir.NewComboBox(p))
- END DepositComboBox;
- PROCEDURE DepositCancelButton*;
- VAR p: Prop;
- BEGIN
- InitProp(p);
- p.link := "StdCmds.CloseDialog"; p.label := "#System:Cancel"; p.opt[cancel] := TRUE;
- Views.Deposit(dir.NewPushButton(p))
- END DepositCancelButton;
- PROCEDURE DepositCaption*;
- VAR p: Prop;
- BEGIN
- InitProp(p); p.opt[left] := TRUE;
- p.label := "#System:Caption";
- Views.Deposit(dir.NewCaption(p))
- END DepositCaption;
- PROCEDURE DepositGroup*;
- VAR p: Prop;
- BEGIN
- InitProp(p);
- p.label := "#System:Caption";
- Views.Deposit(dir.NewGroup(p))
- END DepositGroup;
-
- PROCEDURE DepositTreeControl*;
- VAR p: Prop;
- BEGIN
- InitProp(p);
- p.opt[haslines] := TRUE; p.opt[hasbuttons] := TRUE; p.opt[atroot] := TRUE; p.opt[foldericons] := TRUE;
- Views.Deposit(dir.NewTreeControl(p))
- END DepositTreeControl;
- PROCEDURE Relink*;
- VAR msg: UpdateCachesMsg;
- BEGIN
- INC(stamp);
- Views.Omnicast(msg)
- END Relink;
- PROCEDURE Init;
- VAR d: StdDirectory;
- BEGIN
- par := NIL; stamp := 0;
- NEW(d); stdDir := d; dir := d;
- NEW(cleaner); cleanerInstalled := 0
- END Init;
- (* check guards action *)
- PROCEDURE (a: Action) Do;
- VAR msg: Views.NotifyMsg;
- BEGIN
- IF Windows.dir # NIL THEN
- IF a.w # NIL THEN
- INC(a.cnt);
- msg.id0 := 0; msg.id1 := 0; msg.opts := {guardCheck};
- IF a.w.seq # NIL THEN a.w.seq.Handle(msg) END;
- a.w := Windows.dir.Next(a.w);
- WHILE (a.w # NIL) & a.w.sub DO a.w := Windows.dir.Next(a.w) END
- ELSE
- IF a.cnt = 0 THEN a.resolution := Services.resolution
- ELSE a.resolution := Services.resolution DIV a.cnt DIV 2
- END;
- a.cnt := 0;
- a.w := Windows.dir.First();
- WHILE (a.w # NIL) & a.w.sub DO a.w := Windows.dir.Next(a.w) END
- END
- END;
- Services.DoLater(a, Services.Ticks() + a.resolution)
- END Do;
- BEGIN
- Init;
- NEW(action); action.w := NIL; action.cnt := 0; Services.DoLater(action, Services.now)
- CLOSE
- Services.RemoveAction(action)
- END Controls.
|