Controls.txt 92 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163
  1. MODULE Controls;
  2. (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Controls.odc *)
  3. (* DO NOT EDIT *)
  4. IMPORT
  5. Kernel, Dates, Dialog, Meta, Services, Stores, Views, Properties,
  6. Strings, Fonts, Ports, Controllers, Windows, StdCFrames;
  7. CONST
  8. (** elements of Property.valid **)
  9. opt0* = 0; opt1* = 1; opt2* = 2; opt3* = 3; opt4* = 4;
  10. link* = 5; label* = 6; guard* = 7; notifier* = 8; level* = 9;
  11. default* = opt0; cancel* = opt1;
  12. left* = opt0; right* = opt1; multiLine* = opt2; password* = opt3;
  13. sorted* = opt0;
  14. haslines* = opt1; hasbuttons* = opt2; atroot* = opt3; foldericons* = opt4;
  15. minVersion = 0; maxBaseVersion = 4;
  16. pbVersion = 0; cbVersion = 0; rbVersion = 0; fldVersion = 0;
  17. dfldVersion = 0; tfldVersion = 0; cfldVersion = 0;
  18. lbxVersion = 0; sbxVersion = 0; cbxVersion = 0; capVersion = 1; grpVersion = 0;
  19. tfVersion = 0;
  20. rdel = 07X; ldel = 08X; tab = 09X; ltab = 0AX; lineChar = 0DX; esc = 01BX;
  21. arrowLeft = 1CX; arrowRight = 1DX; arrowUp = 1EX; arrowDown = 1FX;
  22. update = 2; (* notify options *)
  23. listUpdate = 3;
  24. guardCheck = 4;
  25. flushCaches = 5; (* re-map labels for flushed string resources, after a language change *)
  26. maxAdr = 8;
  27. TYPE
  28. Prop* = POINTER TO RECORD (Properties.Property)
  29. opt*: ARRAY 5 OF BOOLEAN;
  30. link*: Dialog.String;
  31. label*: Dialog.String;
  32. guard*: Dialog.String;
  33. notifier*: Dialog.String;
  34. level*: INTEGER
  35. END;
  36. Directory* = POINTER TO ABSTRACT RECORD END;
  37. Control* = POINTER TO ABSTRACT RECORD (Views.View)
  38. item-: Meta.Item;
  39. disabled-, undef-, readOnly-, customFont-: BOOLEAN;
  40. font-: Fonts.Font;
  41. label-: Dialog.String;
  42. prop-: Prop;
  43. adr: ARRAY maxAdr OF INTEGER;
  44. num: INTEGER;
  45. stamp: INTEGER;
  46. shortcut: CHAR;
  47. guardErr, notifyErr: BOOLEAN
  48. END;
  49. DefaultsPref* = RECORD (Properties.Preference)
  50. disabled*: BOOLEAN; (** OUT, preset to ~c.item.Valid() *)
  51. undef*: BOOLEAN; (** OUT, preset to FALSE *)
  52. readOnly*: BOOLEAN (** OUT, preset to c.item.vis = readOnly *)
  53. END;
  54. PropPref* = RECORD (Properties.Preference)
  55. valid*: SET (** OUT, preset to {link, label, guard, notifier, customFont} *)
  56. END;
  57. PushButton = POINTER TO RECORD (Control) END;
  58. CheckBox = POINTER TO RECORD (Control) END;
  59. RadioButton = POINTER TO RECORD (Control) END;
  60. Field = POINTER TO RECORD (Control)
  61. maxLen: INTEGER
  62. END;
  63. UpDownField = POINTER TO RECORD (Control)
  64. min, max, inc: INTEGER
  65. END;
  66. DateField = POINTER TO RECORD (Control)
  67. selection: INTEGER (* 0: no selection, 1..n-1: this part selected, -1: part n selected *)
  68. END;
  69. TimeField = POINTER TO RECORD (Control)
  70. selection: INTEGER
  71. END;
  72. ColorField = POINTER TO RECORD (Control) END;
  73. ListBox = POINTER TO RECORD (Control) END;
  74. SelectionBox = POINTER TO RECORD (Control) END;
  75. ComboBox = POINTER TO RECORD (Control) END;
  76. Caption = POINTER TO RECORD (Control) END;
  77. Group = POINTER TO RECORD (Control) END;
  78. TreeControl = POINTER TO RECORD (Control) END;
  79. StdDirectory = POINTER TO RECORD (Directory) END;
  80. Op = POINTER TO RECORD (Stores.Operation)
  81. ctrl: Control;
  82. prop: Prop
  83. END;
  84. FontOp = POINTER TO RECORD (Stores.Operation)
  85. ctrl: Control;
  86. font: Fonts.Font;
  87. custom: BOOLEAN
  88. END;
  89. NotifyMsg = RECORD (Views.NotifyMsg)
  90. frame: Views.Frame;
  91. op, from, to: INTEGER
  92. END;
  93. UpdateCachesMsg = RECORD (Views.UpdateCachesMsg) END;
  94. SelectPtr = POINTER TO Dialog.Selection;
  95. ProcValue = RECORD (Meta.Value) p*: PROCEDURE END;
  96. SelectValue = RECORD (Meta.Value) p*: SelectPtr END;
  97. GuardProcVal = RECORD (Meta.Value) p*: Dialog.GuardProc END;
  98. NotifyProcValOld = RECORD (Meta.Value) p*: PROCEDURE (op, from, to: INTEGER) END;
  99. GuardProcPVal = RECORD (Meta.Value) p*: PROCEDURE(n: INTEGER; VAR p: Dialog.Par) END;
  100. NotifyProcPVal = RECORD (Meta.Value) p*: PROCEDURE(n, op, f, t: INTEGER) END;
  101. Param = RECORD from, to, i: INTEGER; n: Dialog.String END;
  102. TVParam = RECORD l: INTEGER; e: BOOLEAN; nodeIn, nodeOut: Dialog.TreeNode END;
  103. Action = POINTER TO RECORD (Services.Action)
  104. w: Windows.Window;
  105. resolution, cnt: INTEGER
  106. END;
  107. TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
  108. VAR
  109. dir-, stdDir-: Directory;
  110. par-: Control;
  111. stamp: INTEGER;
  112. action: Action;
  113. cleaner: TrapCleaner;
  114. cleanerInstalled: INTEGER;
  115. (** Cleaner **)
  116. PROCEDURE (c: TrapCleaner) Cleanup;
  117. BEGIN
  118. par := NIL;
  119. cleanerInstalled := 0
  120. END Cleanup;
  121. PROCEDURE (c: Control) Update- (f: Views.Frame; op, from, to: INTEGER), NEW, EMPTY;
  122. PROCEDURE (c: Control) UpdateList- (f: Views.Frame), NEW, EMPTY;
  123. PROCEDURE (c: Control) CheckLink- (VAR ok: BOOLEAN), NEW, EMPTY;
  124. PROCEDURE (c: Control) HandlePropMsg2- (VAR p: Views.PropMessage), NEW, EMPTY;
  125. PROCEDURE (c: Control) HandleViewMsg2- (f: Views.Frame; VAR msg: Views.Message), NEW, EMPTY;
  126. PROCEDURE (c: Control) HandleCtrlMsg2- (f: Views.Frame; VAR msg: Views.CtrlMessage;
  127. VAR focus: Views.View), NEW, EMPTY;
  128. PROCEDURE (c: Control) Externalize2- (VAR wr: Stores.Writer), NEW, EMPTY;
  129. PROCEDURE (c: Control) Internalize2- (VAR rd: Stores.Reader), NEW, EMPTY;
  130. (* auxiliary procedures *)
  131. PROCEDURE IsShortcut (ch: CHAR; c: Control): BOOLEAN;
  132. BEGIN
  133. IF (ch >= "a") & (ch <= "z") OR (ch >= 0E0X) THEN ch := CAP(ch) END;
  134. RETURN ch = c.shortcut
  135. END IsShortcut;
  136. PROCEDURE ExtractShortcut (c: Control);
  137. VAR label: Dialog.String; i: INTEGER; ch, sCh: CHAR;
  138. BEGIN
  139. Dialog.MapString(c.label, label);
  140. i := 0; ch := label[0]; sCh := "&";
  141. WHILE sCh = "&" DO
  142. WHILE (ch # 0X) & (ch # "&") DO INC(i); ch := label[i] END;
  143. IF ch = 0X THEN sCh := 0X
  144. ELSE INC(i); sCh := label[i]; INC(i); ch := label[i]
  145. END
  146. END;
  147. IF (sCh >= "a") & (sCh <= "z") OR (sCh >= 0E0X) THEN sCh := CAP(sCh) END;
  148. c.shortcut := sCh
  149. END ExtractShortcut;
  150. PROCEDURE GetGuardProc (name: ARRAY OF CHAR; VAR i: Meta.Item; VAR err: BOOLEAN;
  151. VAR par: BOOLEAN; VAR n: INTEGER);
  152. VAR j, k, e: INTEGER; num: ARRAY 32 OF CHAR;
  153. BEGIN
  154. j := 0;
  155. WHILE (name[j] # 0X) & (name[j] # "(") DO INC(j) END;
  156. IF name[j] = "(" THEN
  157. INC(j); k := 0;
  158. WHILE (name[j] # 0X) & (name[j] # ")") DO num[k] := name[j]; INC(j); INC(k) END;
  159. IF (name[j] = ")") & (name[j+1] = 0X) THEN
  160. num[k] := 0X; Strings.StringToInt(num, n, e);
  161. IF e = 0 THEN
  162. name[j - k - 1] := 0X;
  163. Meta.LookupPath(name, i); par := TRUE
  164. ELSE
  165. IF ~err THEN
  166. Dialog.ShowParamMsg("#System:SyntaxErrorIn", name, "", "");
  167. err := TRUE
  168. END;
  169. Meta.Lookup("", i);
  170. RETURN
  171. END
  172. ELSE
  173. IF ~err THEN
  174. Dialog.ShowParamMsg("#System:SyntaxErrorIn", name, "", "");
  175. err := TRUE
  176. END;
  177. Meta.Lookup("", i);
  178. RETURN
  179. END
  180. ELSE
  181. Meta.LookupPath(name, i); par := FALSE
  182. END;
  183. IF (i.obj = Meta.procObj) OR (i.obj = Meta.varObj) & (i.typ = Meta.procTyp) THEN (*ok *)
  184. ELSE
  185. IF ~err THEN
  186. IF i.obj = Meta.undef THEN
  187. Dialog.ShowParamMsg("#System:NotFound", name, "", "")
  188. ELSE
  189. Dialog.ShowParamMsg("#System:HasWrongType", name, "", "")
  190. END;
  191. err := TRUE
  192. END;
  193. Meta.Lookup("", i)
  194. END
  195. END GetGuardProc;
  196. PROCEDURE CallGuard (c: Control);
  197. VAR ok, up: BOOLEAN; n: INTEGER; dpar: Dialog.Par; p: Control;
  198. v: GuardProcVal; vp: GuardProcPVal; i: Meta.Item; pref: DefaultsPref;
  199. BEGIN
  200. Controllers.SetCurrentPath(Controllers.targetPath);
  201. pref.disabled := ~c.item.Valid();
  202. pref.undef := FALSE;
  203. pref.readOnly := c.item.vis = Meta.readOnly;
  204. Views.HandlePropMsg(c, pref);
  205. c.disabled := pref.disabled;
  206. c.undef := pref.undef;
  207. c.readOnly := pref.readOnly;
  208. c.label := c.prop.label$;
  209. IF ~c.disabled & (c.prop.guard # "") & ~c.guardErr THEN
  210. IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
  211. INC(cleanerInstalled);
  212. p := par; par := c;
  213. dpar.disabled := FALSE; dpar.undef := FALSE;
  214. dpar.readOnly := c.readOnly;
  215. dpar.checked := FALSE; dpar.label := c.label$;
  216. GetGuardProc(c.prop.guard, i, c.guardErr, up, n);
  217. IF i.obj # Meta.undef THEN
  218. IF up THEN (* call with numeric parameter *)
  219. i.GetVal(vp, ok);
  220. IF ok THEN vp.p(n, dpar) END
  221. ELSE
  222. i.GetVal(v, ok);
  223. IF ok THEN v.p(dpar) END
  224. END;
  225. IF ok THEN
  226. c.disabled := dpar.disabled;
  227. c.undef := dpar.undef;
  228. IF dpar.readOnly THEN c.readOnly := TRUE END;
  229. IF dpar.label # c.label THEN c.label := dpar.label END
  230. ELSIF ~c.guardErr THEN
  231. Dialog.ShowParamMsg("#System:HasWrongType", c.prop.guard, "", "");
  232. c.guardErr := TRUE
  233. END
  234. END;
  235. par := p;
  236. DEC(cleanerInstalled);
  237. IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
  238. END;
  239. ExtractShortcut(c);
  240. Controllers.ResetCurrentPath()
  241. END CallGuard;
  242. PROCEDURE CallNotifier (c: Control; op, from, to: INTEGER);
  243. VAR ok, up: BOOLEAN; n: INTEGER; vold: NotifyProcValOld; vp: NotifyProcPVal;
  244. i: Meta.Item; p: Control;
  245. BEGIN
  246. IF c.prop.notifier # "" THEN
  247. IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
  248. INC(cleanerInstalled);
  249. p := par; par := c;
  250. IF c.prop.notifier[0] = "!" THEN
  251. IF op = Dialog.pressed THEN
  252. c.prop.notifier[0] := " ";
  253. Dialog.ShowStatus(c.prop.notifier);
  254. c.prop.notifier[0] := "!"
  255. ELSIF op = Dialog.released THEN
  256. Dialog.ShowStatus("")
  257. END
  258. ELSE
  259. GetGuardProc(c.prop.notifier, i, c.notifyErr, up, n);
  260. IF i.obj # Meta.undef THEN
  261. IF up THEN (* call with numeric parameter *)
  262. i.GetVal(vp, ok);
  263. IF ok THEN vp.p(n, op, from, to) END
  264. ELSE
  265. i.GetVal(vold, ok);
  266. IF ok THEN vold.p(op, from, to) END
  267. END;
  268. IF ~ok & ~c.notifyErr THEN
  269. Dialog.ShowParamMsg("#System:HasWrongType", c.prop.notifier, "", "");
  270. c.notifyErr := TRUE
  271. END
  272. END
  273. END;
  274. par := p;
  275. DEC(cleanerInstalled);
  276. IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
  277. END
  278. END CallNotifier;
  279. PROCEDURE DCHint (modifiers: SET): INTEGER;
  280. BEGIN
  281. IF Controllers.doubleClick IN modifiers THEN RETURN 1
  282. ELSE RETURN 0
  283. END
  284. END DCHint;
  285. PROCEDURE Notify* (c: Control; f: Views.Frame; op, from, to: INTEGER);
  286. VAR msg: NotifyMsg;
  287. BEGIN
  288. IF ~c.readOnly & ~ c.disabled THEN
  289. CallNotifier(c, op, from, to);
  290. IF op >= Dialog.changed THEN
  291. msg.id0 := c.item.adr; msg.id1 := msg.id0 + c.item.Size(); msg.frame := f;
  292. msg.op := op; msg.from := from; msg.to := to;
  293. msg.opts := {update, guardCheck};
  294. Views.Omnicast(msg)
  295. END
  296. END
  297. END Notify;
  298. PROCEDURE NotifyFlushCaches*;
  299. VAR msg: NotifyMsg;
  300. BEGIN
  301. msg.opts := {flushCaches}; msg.id0 := 0; msg.id1 := 0;
  302. Views.Omnicast(msg)
  303. END NotifyFlushCaches;
  304. PROCEDURE GetName (VAR path, name: ARRAY OF CHAR; VAR i: INTEGER);
  305. VAR j: INTEGER; ch: CHAR;
  306. BEGIN
  307. j := 0; ch := path[i];
  308. WHILE (j < LEN(name) - 1) & ((ch >= "0") & (ch <= "9") OR (CAP(ch) >= "A") & (CAP(ch) <= "Z")
  309. OR (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_")) DO
  310. name[j] := ch; INC(i); INC(j); ch := path[i]
  311. END;
  312. IF (ch = 0X) OR (ch = ".") OR (ch = "[") OR (ch = "^") THEN name[j] := 0X
  313. ELSE name[0] := 0X
  314. END
  315. END GetName;
  316. PROCEDURE LookupPath (path: ARRAY OF CHAR; VAR i: Meta.Item;
  317. VAR adr: ARRAY OF INTEGER; VAR num: INTEGER);
  318. VAR j, n: INTEGER; name: Meta.Name; ch: CHAR;
  319. BEGIN
  320. path[LEN(path) - 1] := 0X; j := 0; num := 0;
  321. GetName(path, name, j); Meta.Lookup(name, i);
  322. IF (i.obj = Meta.modObj) & (path[j] = ".") THEN
  323. INC(j); GetName(path, name, j);
  324. i.Lookup(name, i); ch := path[j]; INC(j);
  325. WHILE i.obj = Meta.varObj DO
  326. adr[num] := i.adr;
  327. IF num < LEN(adr) - 1 THEN INC(num) END;
  328. IF ch = 0X THEN RETURN
  329. ELSIF i.typ = Meta.ptrTyp THEN
  330. IF ch = "^" THEN ch := path[j]; INC(j) END;
  331. i.Deref(i)
  332. ELSIF (i.typ = Meta.recTyp) & (ch = ".") THEN
  333. GetName(path, name, j); i.Lookup(name, i);
  334. ch := path[j]; INC(j)
  335. ELSIF (i.typ = Meta.arrTyp) & (ch = "[") THEN
  336. ch := path[j]; INC(j); n := 0;
  337. WHILE (ch >= "0") & (ch <= "9") DO n := 10 * n + ORD(ch) - ORD("0"); ch := path[j]; INC(j) END;
  338. IF ch = "]" THEN ch := path[j]; INC(j); i.Index(n, i) ELSE Meta.Lookup("", i) END
  339. ELSE Meta.Lookup("", i)
  340. END
  341. END
  342. ELSE
  343. Meta.LookupPath(path, i); num := 0;
  344. IF i.obj = Meta.varObj THEN adr[0] := i.adr; num := 1
  345. ELSIF i.obj # Meta.procObj THEN Meta.Lookup("", i)
  346. END
  347. END
  348. END LookupPath;
  349. PROCEDURE Sort (VAR adr: ARRAY OF INTEGER; num: INTEGER);
  350. VAR i, j, p: INTEGER;
  351. BEGIN
  352. i := 1;
  353. WHILE i < num DO
  354. p := adr[i]; j := i;
  355. WHILE (j >= 1) & (adr[j - 1] > p) DO adr[j] := adr[j - 1]; DEC(j) END;
  356. adr[j] := p; INC(i)
  357. END
  358. END Sort;
  359. PROCEDURE GetTypeName (IN item: Meta.Item; OUT name: Meta.Name);
  360. VAR mod: Meta.Name;
  361. BEGIN
  362. IF (item.typ = Meta.recTyp) THEN
  363. item.GetTypeName(mod, name);
  364. IF (mod = "Dialog") OR (mod = "Dates") THEN (* ok *)
  365. ELSE name := ""
  366. END
  367. ELSE name := ""
  368. END
  369. END GetTypeName;
  370. PROCEDURE OpenLink* (c: Control; p: Prop);
  371. VAR ok: BOOLEAN;
  372. BEGIN
  373. ASSERT(c # NIL, 20); ASSERT(p # NIL, 21);
  374. c.num := 0;
  375. c.prop := Properties.CopyOf(p)(Prop);
  376. IF c.font = NIL THEN
  377. IF c.customFont THEN c.font := StdCFrames.defaultLightFont
  378. ELSE c.font := StdCFrames.defaultFont
  379. END
  380. END;
  381. c.guardErr := FALSE; c.notifyErr := FALSE;
  382. LookupPath(p.link, c.item, c.adr, c.num);
  383. IF c.item.obj = Meta.varObj THEN
  384. Sort(c.adr, c.num);
  385. ok := TRUE; c.CheckLink(ok);
  386. IF ~ok THEN
  387. Meta.Lookup("", c.item);
  388. Dialog.ShowParamMsg("#System:HasWrongType", p.link, "", "")
  389. END
  390. ELSE
  391. Meta.Lookup("", c.item); c.num := 0
  392. END;
  393. CallGuard(c);
  394. c.stamp := stamp
  395. END OpenLink;
  396. (** Prop **)
  397. PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);
  398. VAR valid: SET;
  399. BEGIN
  400. WITH q: Prop DO
  401. valid := p.valid * q.valid; equal := TRUE;
  402. IF p.link # q.link THEN EXCL(valid, link) END;
  403. IF p.label # q.label THEN EXCL(valid, label) END;
  404. IF p.guard # q.guard THEN EXCL(valid, guard) END;
  405. IF p.notifier # q.notifier THEN EXCL(valid, notifier) END;
  406. IF p.level # q.level THEN EXCL(valid, level) END;
  407. IF p.opt[0] # q.opt[0] THEN EXCL(valid, opt0) END;
  408. IF p.opt[1] # q.opt[1] THEN EXCL(valid, opt1) END;
  409. IF p.opt[2] # q.opt[2] THEN EXCL(valid, opt2) END;
  410. IF p.opt[3] # q.opt[3] THEN EXCL(valid, opt3) END;
  411. IF p.opt[4] # q.opt[4] THEN EXCL(valid, opt4) END;
  412. IF p.valid # valid THEN p.valid := valid; equal := FALSE END
  413. END
  414. END IntersectWith;
  415. (* Control *)
  416. PROCEDURE (c: Control) CopyFromSimpleView2- (source: Control), NEW, EMPTY;
  417. PROCEDURE (c: Control) CopyFromSimpleView- (source: Views.View);
  418. BEGIN
  419. WITH source: Control DO
  420. c.item := source.item;
  421. c.adr := source.adr;
  422. c.num := source.num;
  423. c.disabled := source.disabled;
  424. c.undef := source.undef;
  425. c.readOnly := source.readOnly;
  426. c.shortcut := source.shortcut;
  427. c.customFont := source.customFont;
  428. c.font := source.font;
  429. c.label := source.label$;
  430. c.prop := Properties.CopyOf(source.prop)(Prop);
  431. c.CopyFromSimpleView2(source)
  432. END
  433. END CopyFromSimpleView;
  434. PROCEDURE (c: Control) Internalize- (VAR rd: Stores.Reader);
  435. VAR thisVersion: INTEGER; x, def, canc, sort: BOOLEAN;
  436. BEGIN
  437. c.Internalize^(rd);
  438. IF rd.cancelled THEN RETURN END;
  439. rd.ReadVersion(minVersion, maxBaseVersion, thisVersion);
  440. IF rd.cancelled THEN RETURN END;
  441. NEW(c.prop);
  442. IF thisVersion >= 3 THEN
  443. rd.ReadString(c.prop.link);
  444. rd.ReadString(c.prop.label);
  445. rd.ReadString(c.prop.guard);
  446. rd.ReadString(c.prop.notifier);
  447. rd.ReadInt(c.prop.level);
  448. rd.ReadBool(c.customFont);
  449. rd.ReadBool(c.prop.opt[0]);
  450. rd.ReadBool(c.prop.opt[1]);
  451. rd.ReadBool(c.prop.opt[2]);
  452. rd.ReadBool(c.prop.opt[3]);
  453. rd.ReadBool(c.prop.opt[4]);
  454. IF c.customFont & (thisVersion = 4) THEN
  455. Views.ReadFont(rd, c.font)
  456. END
  457. ELSE
  458. rd.ReadXString(c.prop.link);
  459. rd.ReadXString(c.prop.label);
  460. rd.ReadXString(c.prop.guard);
  461. c.prop.notifier := "";
  462. c.prop.opt[2] := FALSE;
  463. c.prop.opt[3] := FALSE;
  464. c.prop.opt[4] := FALSE;
  465. sort := FALSE;
  466. IF thisVersion = 2 THEN
  467. rd.ReadXString(c.prop.notifier);
  468. rd.ReadBool(sort);
  469. rd.ReadBool(c.prop.opt[multiLine])
  470. ELSIF thisVersion = 1 THEN
  471. rd.ReadXString(c.prop.notifier);
  472. rd.ReadBool(sort)
  473. END;
  474. rd.ReadBool(x); (* free, was sed for prop.element *)
  475. rd.ReadBool(def);
  476. rd.ReadBool(canc);
  477. rd.ReadXInt(c.prop.level);
  478. rd.ReadBool(c.customFont);
  479. c.prop.opt[default] := def OR sort OR (c IS Field);
  480. c.prop.opt[cancel] := canc
  481. END;
  482. c.Internalize2(rd);
  483. OpenLink(c, c.prop)
  484. END Internalize;
  485. PROCEDURE (c: Control) Externalize- (VAR wr: Stores.Writer);
  486. BEGIN
  487. c.Externalize^(wr);
  488. wr.WriteVersion(maxBaseVersion);
  489. wr.WriteString(c.prop.link);
  490. wr.WriteString(c.prop.label);
  491. wr.WriteString(c.prop.guard);
  492. wr.WriteString(c.prop.notifier);
  493. wr.WriteInt(c.prop.level);
  494. wr.WriteBool(c.customFont);
  495. wr.WriteBool(c.prop.opt[0]);
  496. wr.WriteBool(c.prop.opt[1]);
  497. wr.WriteBool(c.prop.opt[2]);
  498. wr.WriteBool(c.prop.opt[3]);
  499. wr.WriteBool(c.prop.opt[4]);
  500. IF c.customFont THEN Views.WriteFont(wr, c.font) END;
  501. c.Externalize2(wr)
  502. END Externalize;
  503. PROCEDURE (c: Control) HandleViewMsg- (f: Views.Frame; VAR msg: Views.Message);
  504. VAR disabled, undef, readOnly, done, allDone: BOOLEAN; i: INTEGER; lbl: Dialog.String;
  505. BEGIN
  506. WITH msg: Views.NotifyMsg DO
  507. done := FALSE; allDone := FALSE;
  508. IF guardCheck IN msg.opts THEN
  509. (* should call c.Update for each frame but Views.Update only once *)
  510. WITH f: StdCFrames.Caption DO lbl := f.label$
  511. | f: StdCFrames.PushButton DO lbl := f.label$
  512. | f: StdCFrames.RadioButton DO lbl := f.label$
  513. | f: StdCFrames.CheckBox DO lbl := f.label$
  514. | f: StdCFrames.Group DO lbl := f.label$
  515. ELSE lbl := c.label$
  516. END;
  517. WITH f: StdCFrames.Frame DO
  518. disabled := f.disabled; undef := f.undef; readOnly := f.readOnly
  519. ELSE
  520. disabled := c.disabled; undef := c.undef; readOnly := c.readOnly
  521. END;
  522. CallGuard(c);
  523. IF (c.disabled # disabled) OR (c.undef # undef)
  524. OR (c.readOnly # readOnly) OR (c.label # lbl) THEN
  525. WITH f: StdCFrames.Frame DO
  526. IF f.noRedraw THEN
  527. f.disabled := c.disabled;
  528. f.undef := c.undef;
  529. f.readOnly := c.readOnly;
  530. c.Update(f, 0, 0, 0); done := TRUE
  531. ELSE Views.Update(c, Views.rebuildFrames); allDone := TRUE
  532. END
  533. ELSE Views.Update(c, Views.keepFrames); done := TRUE
  534. END
  535. END
  536. END;
  537. IF flushCaches IN msg.opts THEN
  538. Views.Update(c, Views.rebuildFrames)
  539. END;
  540. i := 0; WHILE (i < c.num) & (c.adr[i] < msg.id0) DO INC(i) END;
  541. IF (i < c.num) & (c.adr[i] < msg.id1) & ~allDone THEN
  542. IF (update IN msg.opts) & ~done THEN
  543. WITH msg: NotifyMsg DO
  544. IF msg.frame # f THEN (* don't update origin frame *)
  545. c.Update(f, msg.op, msg.from, msg.to)
  546. END
  547. ELSE
  548. c.Update(f, 0, 0, 0)
  549. END
  550. END;
  551. IF listUpdate IN msg.opts THEN
  552. c.UpdateList(f)
  553. END
  554. END
  555. | msg: Views.UpdateCachesMsg DO
  556. IF c.stamp # stamp THEN
  557. OpenLink(c, c.prop);
  558. IF msg IS UpdateCachesMsg THEN
  559. Views.Update(c, Views.rebuildFrames)
  560. END
  561. END
  562. ELSE
  563. END;
  564. c.HandleViewMsg2(f, msg)
  565. END HandleViewMsg;
  566. PROCEDURE (c: Control) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message;
  567. VAR focus: Views.View);
  568. VAR sp: Properties.SizeProp; p: Control; dcOk: BOOLEAN;
  569. BEGIN
  570. IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
  571. INC(cleanerInstalled);
  572. p := par; par := c;
  573. WITH msg: Properties.PollPickMsg DO
  574. msg.dest := f
  575. | msg: Properties.PickMsg DO
  576. NEW(sp); sp.known := {Properties.width, Properties.height}; sp.valid := sp.known;
  577. c.context.GetSize(sp.width, sp.height);
  578. Properties.Insert(msg.prop, sp)
  579. | msg: Controllers.TrackMsg DO
  580. IF ~c.disabled THEN
  581. dcOk := TRUE;
  582. IF f IS StdCFrames.Frame THEN dcOk := f(StdCFrames.Frame).DblClickOk(msg.x, msg.y) END;
  583. IF (DCHint(msg.modifiers) = 1) & dcOk THEN
  584. (* double click *)
  585. Notify(c, f, Dialog.pressed, 1, 0)
  586. ELSE
  587. Notify(c, f, Dialog.pressed, 0, 0)
  588. END
  589. END
  590. ELSE
  591. END;
  592. c.HandleCtrlMsg2(f, msg, focus);
  593. WITH msg: Controllers.TrackMsg DO
  594. IF ~c.disabled THEN
  595. Notify(c, f, Dialog.released, 0, 0)
  596. END
  597. ELSE
  598. END;
  599. par := p;
  600. DEC(cleanerInstalled);
  601. IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
  602. END HandleCtrlMsg;
  603. PROCEDURE (c: Control) HandlePropMsg- (VAR msg: Properties.Message);
  604. VAR fpref: Properties.FocusPref; stp: Properties.StdProp;
  605. cp: Prop; ppref: PropPref; op: Op; valid: SET; p: Properties.Property;
  606. fop: FontOp; face: Fonts.Typeface; size, weight: INTEGER; style: SET;
  607. BEGIN
  608. WITH msg: Properties.ControlPref DO
  609. IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
  610. IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN
  611. fpref.hotFocus := FALSE; fpref.setFocus := FALSE; fpref.atLocation := FALSE;
  612. Views.HandlePropMsg(c, fpref);
  613. IF fpref.setFocus THEN msg.getFocus := TRUE END
  614. END
  615. | msg: Properties.PollMsg DO
  616. ppref.valid := {link, label, notifier, guard};
  617. Views.HandlePropMsg(c, ppref);
  618. cp := Properties.CopyOf(c.prop)(Prop);
  619. cp.valid := ppref.valid; cp.known := cp.valid; cp.readOnly := {};
  620. Properties.Insert(msg.prop, cp);
  621. NEW(stp);
  622. stp.valid := {Properties.typeface..Properties.weight};
  623. stp.known := stp.valid;
  624. IF c.customFont THEN stp.typeface := c.font.typeface$
  625. ELSE stp.typeface := Fonts.default
  626. END;
  627. stp.size := c.font.size; stp.style.val := c.font.style; stp.weight := c.font.weight;
  628. stp.style.mask := {Fonts.italic, Fonts.strikeout, Fonts.underline};
  629. Properties.Insert(msg.prop, stp)
  630. | msg: Properties.SetMsg DO
  631. p := msg.prop; op := NIL; fop := NIL;
  632. WHILE (p # NIL) & (op = NIL) DO
  633. WITH p: Prop DO
  634. ppref.valid := {link, label, notifier, guard};
  635. Views.HandlePropMsg(c, ppref);
  636. valid := p.valid * ppref.valid;
  637. IF valid # {} THEN
  638. NEW(op);
  639. op.ctrl := c;
  640. op.prop := Properties.CopyOf(p)(Prop); op.prop.valid := valid
  641. END
  642. | p: Properties.StdProp DO
  643. valid := p.valid * {Properties.typeface..Properties.weight};
  644. IF valid # {} THEN
  645. NEW(fop); fop.ctrl := c;
  646. face := c.font.typeface$; size := c.font.size; style := c.font.style; weight := c.font.weight;
  647. IF Properties.typeface IN p.valid THEN face := p.typeface$;
  648. IF face = Fonts.default THEN face := StdCFrames.defaultFont.typeface END
  649. END;
  650. IF Properties.size IN p.valid THEN size := p.size END;
  651. IF Properties.style IN p.valid THEN
  652. style := (p.style.val * p.style.mask) + (style - p.style.mask)
  653. END;
  654. IF Properties.weight IN p.valid THEN weight := p.weight END;
  655. fop.custom := TRUE;
  656. fop.font := Fonts.dir.This(face, size, style, weight);
  657. IF (fop.font.typeface = StdCFrames.defaultFont.typeface)
  658. & (fop.font.size = StdCFrames.defaultFont.size)
  659. & (fop.font.style = StdCFrames.defaultFont.style)
  660. & (fop.font.weight = StdCFrames.defaultFont.weight) THEN
  661. fop.custom := FALSE;
  662. fop.font := StdCFrames.defaultFont
  663. END
  664. END
  665. ELSE
  666. END;
  667. p := p.next
  668. END;
  669. IF op # NIL THEN Views.Do(c, "#System:SetProp", op) END;
  670. IF fop # NIL THEN Views.Do(c, "#System:SetProp", fop) END
  671. | msg: Properties.TypePref DO
  672. IF Services.Is(c, msg.type) THEN msg.view := c END
  673. ELSE
  674. END;
  675. c.HandlePropMsg2(msg)
  676. END HandlePropMsg;
  677. (* Op *)
  678. PROCEDURE (op: Op) Do;
  679. VAR c: Control; prop: Prop;
  680. BEGIN
  681. c := op.ctrl;
  682. prop := Properties.CopyOf(c.prop)(Prop);
  683. prop.valid := op.prop.valid; (* fields to be restored *)
  684. IF link IN op.prop.valid THEN c.prop.link := op.prop.link END;
  685. IF label IN op.prop.valid THEN c.prop.label := op.prop.label END;
  686. IF guard IN op.prop.valid THEN c.prop.guard := op.prop.guard END;
  687. IF notifier IN op.prop.valid THEN c.prop.notifier := op.prop.notifier END;
  688. IF level IN op.prop.valid THEN c.prop.level := op.prop.level END;
  689. IF opt0 IN op.prop.valid THEN c.prop.opt[0] := op.prop.opt[0] END;
  690. IF opt1 IN op.prop.valid THEN c.prop.opt[1] := op.prop.opt[1] END;
  691. IF opt2 IN op.prop.valid THEN c.prop.opt[2] := op.prop.opt[2] END;
  692. IF opt3 IN op.prop.valid THEN c.prop.opt[3] := op.prop.opt[3] END;
  693. IF opt4 IN op.prop.valid THEN c.prop.opt[4] := op.prop.opt[4] END;
  694. IF c.prop.guard # prop.guard THEN c.guardErr := FALSE END;
  695. IF c.prop.notifier # prop.notifier THEN c.notifyErr := FALSE END;
  696. IF c.prop.link # prop.link THEN OpenLink(c, c.prop) ELSE CallGuard(c) END;
  697. op.prop := prop;
  698. Views.Update(c, Views.rebuildFrames)
  699. END Do;
  700. PROCEDURE (op: FontOp) Do;
  701. VAR c: Control; custom: BOOLEAN; font: Fonts.Font;
  702. BEGIN
  703. c := op.ctrl;
  704. custom := c.customFont; c.customFont := op.custom; op.custom := custom;
  705. font := c.font; c.font := op.font; op.font := font;
  706. Views.Update(c, Views.rebuildFrames)
  707. END Do;
  708. (* ------------------------- standard controls ------------------------- *)
  709. PROCEDURE CatchCtrlMsg (c: Control; f: Views.Frame; VAR msg: Controllers.Message;
  710. VAR focus: Views.View);
  711. BEGIN
  712. IF ~c.disabled THEN
  713. WITH f: StdCFrames.Frame DO
  714. WITH msg: Controllers.PollCursorMsg DO
  715. f.GetCursor(msg.x, msg.y, msg.modifiers, msg.cursor)
  716. | msg: Controllers.PollOpsMsg DO
  717. msg.valid := {Controllers.pasteChar}
  718. | msg: Controllers.TrackMsg DO
  719. f.MouseDown(msg.x, msg.y, msg.modifiers)
  720. | msg: Controllers.MarkMsg DO
  721. f.Mark(msg.show, msg.focus)
  722. |msg: Controllers.WheelMsg DO
  723. f.WheelMove(msg.x, msg.y, msg.op, msg.nofLines, msg.done)
  724. ELSE
  725. END
  726. END
  727. END
  728. END CatchCtrlMsg;
  729. (** Directory **)
  730. PROCEDURE (d: Directory) NewPushButton* (p: Prop): Control, NEW, ABSTRACT;
  731. PROCEDURE (d: Directory) NewCheckBox* (p: Prop): Control, NEW, ABSTRACT;
  732. PROCEDURE (d: Directory) NewRadioButton* (p: Prop): Control, NEW, ABSTRACT;
  733. PROCEDURE (d: Directory) NewField* (p: Prop): Control, NEW, ABSTRACT;
  734. PROCEDURE (d: Directory) NewUpDownField* (p: Prop): Control, NEW, ABSTRACT;
  735. PROCEDURE (d: Directory) NewDateField* (p: Prop): Control, NEW, ABSTRACT;
  736. PROCEDURE (d: Directory) NewTimeField* (p: Prop): Control, NEW, ABSTRACT;
  737. PROCEDURE (d: Directory) NewColorField* (p: Prop): Control, NEW, ABSTRACT;
  738. PROCEDURE (d: Directory) NewListBox* (p: Prop): Control, NEW, ABSTRACT;
  739. PROCEDURE (d: Directory) NewSelectionBox* (p: Prop): Control, NEW, ABSTRACT;
  740. PROCEDURE (d: Directory) NewComboBox* (p: Prop): Control, NEW, ABSTRACT;
  741. PROCEDURE (d: Directory) NewCaption* (p: Prop): Control, NEW, ABSTRACT;
  742. PROCEDURE (d: Directory) NewGroup* (p: Prop): Control, NEW, ABSTRACT;
  743. PROCEDURE (d: Directory) NewTreeControl* (p: Prop): Control, NEW, ABSTRACT;
  744. (* PushButton *)
  745. PROCEDURE Call (c: PushButton);
  746. VAR res: INTEGER; p: Control; ok: BOOLEAN; msg: Views.NotifyMsg;
  747. BEGIN
  748. IF c.item.Valid() & ((c.item.obj = Meta.procObj) OR (c.item.obj = Meta.varObj) & (c.item.typ = Meta.procTyp)) THEN
  749. IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
  750. INC(cleanerInstalled);
  751. p := par; c.item.Call(ok); par := p;
  752. DEC(cleanerInstalled);
  753. IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END;
  754. IF ~ok THEN Dialog.ShowMsg("#System:BehaviorNotAccessible") END
  755. ELSIF c.prop.link # "" THEN
  756. IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
  757. INC(cleanerInstalled);
  758. p := par; par := c; Dialog.Call(c.prop.link, " ", res); par := p;
  759. DEC(cleanerInstalled);
  760. IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
  761. ELSE Dialog.ShowMsg("#System:NoBehaviorBound")
  762. END;
  763. msg.opts := {guardCheck};
  764. Views.Omnicast(msg)
  765. END Call;
  766. PROCEDURE Do (f: StdCFrames.PushButton);
  767. BEGIN
  768. Call(f.view(PushButton))
  769. END Do;
  770. PROCEDURE (c: PushButton) Internalize2 (VAR rd: Stores.Reader);
  771. VAR thisVersion: INTEGER;
  772. BEGIN
  773. rd.ReadVersion(minVersion, pbVersion, thisVersion)
  774. END Internalize2;
  775. PROCEDURE (c: PushButton) Externalize2 (VAR wr: Stores.Writer);
  776. BEGIN
  777. wr.WriteVersion(pbVersion)
  778. END Externalize2;
  779. PROCEDURE (c: PushButton) GetNewFrame (VAR frame: Views.Frame);
  780. VAR f: StdCFrames.PushButton;
  781. BEGIN
  782. f := StdCFrames.dir.NewPushButton();
  783. f.disabled := c.disabled;
  784. f.undef := c.undef;
  785. f.readOnly := c.readOnly;
  786. f.font := c.font;
  787. f.label := c.label$;
  788. f.default := c.prop.opt[default];
  789. f.cancel := c.prop.opt[cancel];
  790. f.Do := Do;
  791. frame := f
  792. END GetNewFrame;
  793. PROCEDURE (c: PushButton) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  794. BEGIN
  795. WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
  796. END Restore;
  797. PROCEDURE (c: PushButton) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
  798. VAR focus: Views.View);
  799. BEGIN
  800. IF ~c.disabled THEN
  801. WITH f: StdCFrames.Frame DO
  802. WITH msg: Controllers.EditMsg DO
  803. IF (msg.op = Controllers.pasteChar)
  804. & ((msg.char = lineChar)
  805. OR (msg.char = " ")
  806. OR (msg.char = esc) & c.prop.opt[cancel]
  807. OR IsShortcut(msg.char, c)) THEN f.KeyDown(msg.char) END
  808. ELSE
  809. CatchCtrlMsg(c, f, msg, focus)
  810. END
  811. END
  812. END
  813. END HandleCtrlMsg2;
  814. PROCEDURE (c: PushButton) HandlePropMsg2 (VAR msg: Properties.Message);
  815. BEGIN
  816. WITH msg: Properties.ControlPref DO
  817. msg.accepts := ~c.disabled & ((msg.char = lineChar) & c.prop.opt[default]
  818. OR (msg.char = esc) & c.prop.opt[cancel]
  819. OR IsShortcut(msg.char, c))
  820. | msg: Properties.FocusPref DO
  821. IF ~c.disabled & ~ c.readOnly THEN
  822. msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
  823. END
  824. | msg: Properties.SizePref DO
  825. StdCFrames.dir.GetPushButtonSize(msg.w, msg.h)
  826. | msg: PropPref DO
  827. msg.valid := {link, label, guard, notifier, default, cancel}
  828. | msg: DefaultsPref DO
  829. IF c.prop.link # "" THEN msg.disabled := FALSE END
  830. ELSE
  831. END
  832. END HandlePropMsg2;
  833. PROCEDURE (c: PushButton) Update (f: Views.Frame; op, from, to: INTEGER);
  834. BEGIN
  835. f(StdCFrames.PushButton).label := c.label$;
  836. f(StdCFrames.Frame).Update
  837. END Update;
  838. PROCEDURE (c: PushButton) CheckLink (VAR ok: BOOLEAN);
  839. BEGIN
  840. ok := c.item.typ = Meta.procTyp
  841. END CheckLink;
  842. (* CheckBox *)
  843. PROCEDURE GetCheckBox (f: StdCFrames.CheckBox; OUT x: BOOLEAN);
  844. VAR c: CheckBox;
  845. BEGIN
  846. x := FALSE;
  847. c := f.view(CheckBox);
  848. IF c.item.Valid() THEN
  849. IF c.item.typ = Meta.boolTyp THEN x := c.item.BoolVal()
  850. ELSIF c.item.typ = Meta.setTyp THEN x := c.prop.level IN c.item.SetVal()
  851. END
  852. END
  853. END GetCheckBox;
  854. PROCEDURE SetCheckBox (f: StdCFrames.CheckBox; x: BOOLEAN);
  855. VAR c: CheckBox; s: SET;
  856. BEGIN
  857. c := f.view(CheckBox);
  858. IF c.item.Valid() & ~c.readOnly THEN
  859. IF c.item.typ = Meta.boolTyp THEN
  860. c.item.PutBoolVal(x); Notify(c, f, Dialog.changed, 0, 0)
  861. ELSIF c.item.typ = Meta.setTyp THEN
  862. s := c.item.SetVal();
  863. IF x THEN INCL(s, c.prop.level) ELSE EXCL(s, c.prop.level) END;
  864. c.item.PutSetVal(s);
  865. IF x THEN Notify(c, f, Dialog.included, c.prop.level, c.prop.level)
  866. ELSE Notify(c, f, Dialog.excluded, c.prop.level, c.prop.level)
  867. END
  868. END
  869. END
  870. END SetCheckBox;
  871. PROCEDURE (c: CheckBox) Internalize2 (VAR rd: Stores.Reader);
  872. VAR thisVersion: INTEGER;
  873. BEGIN
  874. rd.ReadVersion(minVersion, cbVersion, thisVersion)
  875. END Internalize2;
  876. PROCEDURE (c: CheckBox) Externalize2 (VAR wr: Stores.Writer);
  877. BEGIN
  878. wr.WriteVersion(cbVersion)
  879. END Externalize2;
  880. PROCEDURE (c: CheckBox) GetNewFrame (VAR frame: Views.Frame);
  881. VAR f: StdCFrames.CheckBox;
  882. BEGIN
  883. f := StdCFrames.dir.NewCheckBox();
  884. f.disabled := c.disabled;
  885. f.undef := c.undef;
  886. f.readOnly := c.readOnly;
  887. f.font := c.font;
  888. f.label := c.label$;
  889. f.Get := GetCheckBox;
  890. f.Set := SetCheckBox;
  891. frame := f
  892. END GetNewFrame;
  893. PROCEDURE (c: CheckBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  894. BEGIN
  895. WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
  896. END Restore;
  897. PROCEDURE (c: CheckBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
  898. VAR focus: Views.View);
  899. BEGIN
  900. IF ~c.disabled & ~c.readOnly THEN
  901. WITH f: StdCFrames.Frame DO
  902. WITH msg: Controllers.EditMsg DO
  903. IF (msg.op = Controllers.pasteChar)
  904. & ((msg.char = " ") OR IsShortcut(msg.char, c)) THEN f.KeyDown(msg.char) END
  905. ELSE
  906. CatchCtrlMsg(c, f, msg, focus)
  907. END
  908. END
  909. END
  910. END HandleCtrlMsg2;
  911. PROCEDURE (c: CheckBox) HandlePropMsg2 (VAR msg: Properties.Message);
  912. BEGIN
  913. WITH msg: Properties.ControlPref DO
  914. IF ~c.disabled & ~c.readOnly THEN
  915. IF (msg.char = tab) OR (msg.char = ltab) THEN
  916. (* tabs set focus to first checkbox only *)
  917. IF (msg.focus # NIL) & (msg.focus IS CheckBox)
  918. & (msg.focus(CheckBox).item.adr = c.item.adr) THEN
  919. msg.getFocus := FALSE
  920. END
  921. ELSIF (msg.char >= arrowLeft) & (msg.char <= arrowDown) THEN
  922. (* arrows set focus to next checkbox bound to same variable *)
  923. msg.getFocus := StdCFrames.setFocus
  924. & (msg.focus # NIL)
  925. & (msg.focus IS CheckBox)
  926. & (msg.focus(CheckBox).item.adr = c.item.adr);
  927. msg.accepts := msg.getFocus & (msg.focus # c)
  928. ELSIF IsShortcut(msg.char, c) THEN
  929. msg.accepts := TRUE; msg.getFocus := StdCFrames.setFocus
  930. ELSIF msg.char # " " THEN
  931. msg.accepts := FALSE
  932. END
  933. END
  934. | msg: Properties.FocusPref DO
  935. IF ~c.disabled & ~c.readOnly THEN
  936. msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
  937. END
  938. | msg: Properties.SizePref DO
  939. StdCFrames.dir.GetCheckBoxSize(msg.w, msg.h)
  940. | msg: PropPref DO
  941. msg.valid := {link, label, guard, notifier, level}
  942. ELSE
  943. END
  944. END HandlePropMsg2;
  945. PROCEDURE (c: CheckBox) CheckLink (VAR ok: BOOLEAN);
  946. BEGIN
  947. ok := (c.item.typ = Meta.boolTyp) OR (c.item.typ = Meta.setTyp)
  948. END CheckLink;
  949. PROCEDURE (c: CheckBox) Update (f: Views.Frame; op, from, to: INTEGER);
  950. BEGIN
  951. IF (op = 0) OR (c.item.typ = Meta.boolTyp) OR (c.prop.level = to) THEN
  952. f(StdCFrames.CheckBox).label := c.label$;
  953. f(StdCFrames.Frame).Update
  954. END
  955. END Update;
  956. (* RadioButton *)
  957. PROCEDURE GetRadioButton (f: StdCFrames.RadioButton; OUT x: BOOLEAN);
  958. VAR c: RadioButton;
  959. BEGIN
  960. x := FALSE;
  961. c := f.view(RadioButton);
  962. IF c.item.Valid() THEN
  963. IF c.item.typ = Meta.boolTyp THEN x := c.item.BoolVal() = (c.prop.level # 0)
  964. ELSE x := c.item.IntVal() = c.prop.level
  965. END
  966. END
  967. END GetRadioButton;
  968. PROCEDURE SetRadioButton (f: StdCFrames.RadioButton; x: BOOLEAN);
  969. VAR c: RadioButton; old: INTEGER;
  970. BEGIN
  971. IF x THEN
  972. c := f.view(RadioButton);
  973. IF c.item.Valid() & ~c.readOnly THEN
  974. IF c.item.typ = Meta.boolTyp THEN
  975. IF c.item.BoolVal() THEN old := 1 ELSE old := 0 END;
  976. IF c.prop.level # old THEN
  977. c.item.PutBoolVal(c.prop.level # 0);
  978. Notify(c, f, Dialog.changed, old, c.prop.level)
  979. END
  980. ELSE
  981. old := c.item.IntVal();
  982. IF c.prop.level # old THEN
  983. c.item.PutIntVal(c.prop.level);
  984. Notify(c, f, Dialog.changed, old, c.prop.level)
  985. END
  986. END
  987. END
  988. END
  989. END SetRadioButton;
  990. PROCEDURE (c: RadioButton) Internalize2 (VAR rd: Stores.Reader);
  991. VAR thisVersion: INTEGER;
  992. BEGIN
  993. rd.ReadVersion(minVersion, rbVersion, thisVersion)
  994. END Internalize2;
  995. PROCEDURE (c: RadioButton) Externalize2 (VAR wr: Stores.Writer);
  996. BEGIN
  997. wr.WriteVersion(rbVersion)
  998. END Externalize2;
  999. PROCEDURE (c: RadioButton) GetNewFrame (VAR frame: Views.Frame);
  1000. VAR f: StdCFrames.RadioButton;
  1001. BEGIN
  1002. f := StdCFrames.dir.NewRadioButton();
  1003. f.disabled := c.disabled;
  1004. f.undef := c.undef;
  1005. f.readOnly := c.readOnly;
  1006. f.font := c.font;
  1007. f.label := c.label$;
  1008. f.Get := GetRadioButton;
  1009. f.Set := SetRadioButton;
  1010. frame := f
  1011. END GetNewFrame;
  1012. PROCEDURE (c: RadioButton) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  1013. BEGIN
  1014. WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
  1015. END Restore;
  1016. PROCEDURE (c: RadioButton) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
  1017. VAR focus: Views.View);
  1018. BEGIN
  1019. IF ~c.disabled & ~c.readOnly THEN
  1020. WITH f: StdCFrames.Frame DO
  1021. WITH msg: Controllers.EditMsg DO
  1022. IF (msg.op = Controllers.pasteChar)
  1023. & ((msg.char <= " ") OR IsShortcut(msg.char, c)) THEN f.KeyDown(msg.char) END
  1024. ELSE
  1025. CatchCtrlMsg(c, f, msg, focus)
  1026. END
  1027. END
  1028. END
  1029. END HandleCtrlMsg2;
  1030. PROCEDURE (c: RadioButton) HandlePropMsg2 (VAR msg: Properties.Message);
  1031. VAR hot: BOOLEAN;
  1032. BEGIN
  1033. WITH msg: Properties.ControlPref DO
  1034. IF ~c.disabled & ~c.readOnly THEN
  1035. IF (msg.char = tab) OR (msg.char = ltab) THEN
  1036. (* tabs set focus to active radio button only *)
  1037. IF c.item.Valid() THEN
  1038. IF c.item.typ = Meta.boolTyp THEN hot := c.item.BoolVal() = (c.prop.level # 0)
  1039. ELSE hot := c.item.IntVal() = c.prop.level
  1040. END
  1041. ELSE hot := FALSE
  1042. END;
  1043. IF ~hot THEN msg.getFocus := FALSE END
  1044. ELSIF (msg.char >= arrowLeft) & (msg.char <= arrowDown) THEN
  1045. (* arrows set focus to next radio button bound to same variable *)
  1046. msg.getFocus := StdCFrames.setFocus
  1047. & (msg.focus # NIL) & (msg.focus IS RadioButton)
  1048. & (msg.focus(RadioButton).item.adr = c.item.adr);
  1049. msg.accepts := msg.getFocus & (msg.focus # c)
  1050. ELSIF IsShortcut(msg.char, c) THEN
  1051. msg.accepts := TRUE; msg.getFocus := StdCFrames.setFocus
  1052. ELSIF msg.char # " " THEN
  1053. msg.accepts := FALSE
  1054. END
  1055. END
  1056. | msg: Properties.FocusPref DO
  1057. IF ~c.disabled & ~c.readOnly THEN
  1058. msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
  1059. END
  1060. | msg: Properties.SizePref DO
  1061. StdCFrames.dir.GetRadioButtonSize(msg.w, msg.h)
  1062. | msg: PropPref DO
  1063. msg.valid := {link, label, guard, notifier, level}
  1064. ELSE
  1065. END
  1066. END HandlePropMsg2;
  1067. PROCEDURE (c: RadioButton) CheckLink (VAR ok: BOOLEAN);
  1068. VAR name: Meta.Name;
  1069. BEGIN
  1070. GetTypeName(c.item, name);
  1071. IF name = "List" THEN c.item.Lookup("index", c.item) END;
  1072. ok := (c.item.typ >= Meta.byteTyp) & (c.item.typ <= Meta.intTyp) OR (c.item.typ = Meta.boolTyp)
  1073. END CheckLink;
  1074. PROCEDURE (c: RadioButton) Update (f: Views.Frame; op, from, to: INTEGER);
  1075. BEGIN
  1076. IF (op = 0) OR (c.prop.level = to) OR (c.prop.level = from) THEN
  1077. f(StdCFrames.RadioButton).label := c.label$;
  1078. f(StdCFrames.Frame).Update
  1079. END
  1080. END Update;
  1081. (* Field *)
  1082. PROCEDURE LongToString (x: LONGINT; OUT s: ARRAY OF CHAR);
  1083. VAR d: ARRAY 24 OF CHAR; i, j: INTEGER;
  1084. BEGIN
  1085. IF x = MIN(LONGINT) THEN
  1086. s := "-9223372036854775808"
  1087. ELSE
  1088. i := 0; j := 0;
  1089. IF x < 0 THEN s[0] := "-"; i := 1; x := -x END;
  1090. REPEAT d[j] := CHR(x MOD 10 + ORD("0")); INC(j); x := x DIV 10 UNTIL x = 0;
  1091. WHILE j > 0 DO DEC(j); s[i] := d[j]; INC(i) END;
  1092. s[i] := 0X
  1093. END
  1094. END LongToString;
  1095. PROCEDURE StringToLong (IN s: ARRAY OF CHAR; OUT x: LONGINT; OUT res: INTEGER);
  1096. VAR i, sign, d: INTEGER;
  1097. BEGIN
  1098. i := 0; sign := 1; x := 0; res := 0;
  1099. WHILE s[i] = " " DO INC(i) END;
  1100. IF s[i] = "-" THEN sign := -1; INC(i) END;
  1101. WHILE s[i] = " " DO INC(i) END;
  1102. IF s[i] = 0X THEN res := 2 END;
  1103. WHILE (s[i] >= "0") & (s[i] <= "9") DO
  1104. d := ORD(s[i]) - ORD("0"); INC(i);
  1105. IF x <= (MAX(LONGINT) - d) DIV 10 THEN x := 10 * x + d
  1106. ELSE res := 1
  1107. END
  1108. END;
  1109. x := x * sign;
  1110. IF s[i] # 0X THEN res := 2 END
  1111. END StringToLong;
  1112. PROCEDURE FixToInt (fix: ARRAY OF CHAR; OUT int: ARRAY OF CHAR; scale: INTEGER);
  1113. VAR i, j: INTEGER;
  1114. BEGIN
  1115. IF scale > 24 THEN scale := 24 ELSIF scale < 0 THEN scale := 0 END;
  1116. i := 0; j := 0;
  1117. WHILE (fix[i] # ".") & (fix[i] # 0X) DO int[j] := fix[i]; INC(i); INC(j) END;
  1118. IF fix[i] = "." THEN INC(i) END;
  1119. WHILE (scale > 0) & (fix[i] >= "0") & (fix[i] <= "9") DO int[j] := fix[i]; INC(i); INC(j); DEC(scale) END;
  1120. WHILE scale > 0 DO int[j] := "0"; INC(j); DEC(scale) END;
  1121. int[j] := 0X
  1122. END FixToInt;
  1123. PROCEDURE IntToFix (int: ARRAY OF CHAR; OUT fix: ARRAY OF CHAR; scale: INTEGER);
  1124. VAR i, j, n: INTEGER;
  1125. BEGIN
  1126. IF scale > 24 THEN scale := 24 ELSIF scale < 0 THEN scale := 0 END;
  1127. n := LEN(int$); i := 0; j := 0;
  1128. WHILE int[i] < "0" DO fix[j] := int[i]; INC(i); INC(j); DEC(n) END;
  1129. IF n > scale THEN
  1130. WHILE n > scale DO fix[j] := int[i]; INC(i); INC(j); DEC(n) END
  1131. ELSE
  1132. fix[j] := "0"; INC(j)
  1133. END;
  1134. fix[j] := "."; INC(j);
  1135. WHILE n < scale DO fix[j] := "0"; INC(j); DEC(scale) END;
  1136. WHILE n > 0 DO fix[j] := int[i]; INC(i); INC(j); DEC(n) END;
  1137. fix[j] := 0X
  1138. END IntToFix;
  1139. PROCEDURE GetField (f: StdCFrames.Field; OUT x: ARRAY OF CHAR);
  1140. VAR c: Field; ok: BOOLEAN; b, v: Meta.Item; mod, name: Meta.Name;
  1141. BEGIN
  1142. x := "";
  1143. c := f.view(Field);
  1144. IF c.item.Valid() THEN
  1145. IF c.item.typ = Meta.arrTyp THEN
  1146. c.item.GetStringVal(x, ok)
  1147. ELSIF c.item.typ IN {Meta.byteTyp, Meta.sIntTyp, Meta.intTyp} THEN
  1148. Strings.IntToString(c.item.IntVal(), x);
  1149. IF c.prop.level > 0 THEN IntToFix(x, x, c.prop.level) END
  1150. ELSIF c.item.typ = Meta.longTyp THEN
  1151. LongToString(c.item.LongVal(), x);
  1152. IF c.prop.level > 0 THEN IntToFix(x, x, c.prop.level) END
  1153. ELSIF c.item.typ = Meta.sRealTyp THEN
  1154. IF c.prop.level <= 0 THEN
  1155. Strings.RealToStringForm(c.item.RealVal(), 7, 0, c.prop.level, " ", x)
  1156. ELSE
  1157. Strings.RealToStringForm(c.item.RealVal(), c.prop.level, 0, 1, " ", x)
  1158. END
  1159. ELSIF c.item.typ = Meta.realTyp THEN
  1160. IF c.prop.level <= 0 THEN
  1161. Strings.RealToStringForm(c.item.RealVal(), 16, 0, c.prop.level, " ", x)
  1162. ELSE
  1163. Strings.RealToStringForm(c.item.RealVal(), c.prop.level, 0, 1, " ", x)
  1164. END
  1165. ELSIF c.item.typ = Meta.recTyp THEN
  1166. c.item.GetTypeName(mod, name);
  1167. IF mod = "Dialog" THEN
  1168. IF name = "Currency" THEN
  1169. c.item.Lookup("val", v); c.item.Lookup("scale", b);
  1170. LongToString(v.LongVal(), x); IntToFix(x, x, b.IntVal())
  1171. ELSE (* Combo *)
  1172. c.item.Lookup("item", v); (* Combo *)
  1173. IF v.typ = Meta.arrTyp THEN v.GetStringVal(x, ok) END
  1174. END
  1175. END
  1176. END
  1177. ELSE
  1178. x := c.label$
  1179. END
  1180. END GetField;
  1181. PROCEDURE SetField (f: StdCFrames.Field; IN x: ARRAY OF CHAR);
  1182. VAR c: Field; ok: BOOLEAN; i, res, old: INTEGER; r, or: REAL; b, v: Meta.Item;
  1183. mod, name: Meta.Name; long, long0: LONGINT;
  1184. s: ARRAY 1024 OF CHAR;
  1185. BEGIN
  1186. c := f.view(Field);
  1187. IF c.item.Valid() & ~c.readOnly THEN
  1188. CASE c.item.typ OF
  1189. | Meta.arrTyp:
  1190. c.item.GetStringVal(s, ok);
  1191. IF ~ok OR (s$ # x$) THEN
  1192. c.item.PutStringVal(x, ok);
  1193. IF ok THEN Notify(c, f, Dialog.changed, 0, 0) ELSE Dialog.Beep END
  1194. END
  1195. | Meta.byteTyp:
  1196. IF x = "" THEN i := 0; res := 0
  1197. ELSIF c.prop.level > 0 THEN FixToInt(x, s, c.prop.level); Strings.StringToInt(s, i, res)
  1198. ELSE Strings.StringToInt(x, i, res)
  1199. END;
  1200. IF (res = 0) & (i >= MIN(BYTE)) & (i <= MAX(BYTE)) THEN
  1201. old := c.item.IntVal();
  1202. IF i # old THEN c.item.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
  1203. ELSIF x # "-" THEN
  1204. Dialog.Beep
  1205. END
  1206. | Meta.sIntTyp:
  1207. IF x = "" THEN i := 0; res := 0
  1208. ELSIF c.prop.level > 0 THEN FixToInt(x, s, c.prop.level); Strings.StringToInt(s, i, res)
  1209. ELSE Strings.StringToInt(x, i, res)
  1210. END;
  1211. IF (res = 0) & (i >= MIN(SHORTINT)) & (i <= MAX(SHORTINT)) THEN
  1212. old := c.item.IntVal();
  1213. IF i # old THEN c.item.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
  1214. ELSIF x # "-" THEN
  1215. Dialog.Beep
  1216. END
  1217. | Meta.intTyp:
  1218. IF x = "" THEN i := 0; res := 0
  1219. ELSIF c.prop.level > 0 THEN FixToInt(x, s, c.prop.level); Strings.StringToInt(s, i, res)
  1220. ELSE Strings.StringToInt(x, i, res)
  1221. END;
  1222. IF res = 0 THEN
  1223. old := c.item.IntVal();
  1224. IF i # old THEN c.item.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
  1225. ELSIF x # "-" THEN
  1226. Dialog.Beep
  1227. END
  1228. | Meta.longTyp:
  1229. IF x = "" THEN long := 0; res := 0
  1230. ELSE FixToInt(x, s, c.prop.level); StringToLong(s, long, res)
  1231. END;
  1232. IF res = 0 THEN
  1233. long0 := c.item.LongVal();
  1234. IF long # long0 THEN c.item.PutLongVal(long); Notify(c, f, Dialog.changed, 0, 0) END
  1235. ELSIF x # "-" THEN
  1236. Dialog.Beep
  1237. END
  1238. | Meta.sRealTyp:
  1239. IF (x = "") OR (x = "-") THEN r := 0; res := 0 ELSE Strings.StringToReal(x, r, res) END;
  1240. IF (res = 0) & (r >= MIN(SHORTREAL)) & (r <= MAX(SHORTREAL)) THEN
  1241. or := c.item.RealVal();
  1242. IF r # or THEN c.item.PutRealVal(r); Notify(c, f, Dialog.changed, 0, 0) END
  1243. ELSIF x # "-" THEN
  1244. Dialog.Beep
  1245. END
  1246. | Meta.realTyp:
  1247. IF (x = "") OR (x = "-") THEN r := 0; res := 0 ELSE Strings.StringToReal(x, r, res) END;
  1248. IF res = 0 THEN
  1249. or := c.item.RealVal();
  1250. IF r # or THEN c.item.PutRealVal(r); Notify(c, f, Dialog.changed, 0, 0) END
  1251. ELSIF x # "-" THEN
  1252. Dialog.Beep
  1253. END
  1254. | Meta.recTyp:
  1255. c.item.GetTypeName(mod, name);
  1256. IF mod = "Dialog" THEN
  1257. IF name = "Currency" THEN
  1258. c.item.Lookup("val", v); c.item.Lookup("scale", b);
  1259. IF x = "" THEN long := 0; res := 0
  1260. ELSE FixToInt(x, s, b.IntVal()); StringToLong(s, long, res)
  1261. END;
  1262. IF res = 0 THEN
  1263. long0 := v.LongVal();
  1264. IF long # long0 THEN v.PutLongVal(long); Notify(c, f, Dialog.changed, 0, 0) END
  1265. ELSIF x # "-" THEN
  1266. Dialog.Beep
  1267. END
  1268. ELSE (* name = "Combo" *)
  1269. c.item.Lookup("item", v);
  1270. IF v.typ = Meta.arrTyp THEN
  1271. v.GetStringVal(s, ok);
  1272. IF ~ok OR (s$ # x$) THEN
  1273. v.PutStringVal(x, ok);
  1274. IF ok THEN Notify(c, f, Dialog.changed, 0, 0) ELSE Dialog.Beep END
  1275. END
  1276. END
  1277. END
  1278. END
  1279. END
  1280. END
  1281. END SetField;
  1282. PROCEDURE EqualField (f: StdCFrames.Field; IN s1, s2: ARRAY OF CHAR): BOOLEAN;
  1283. VAR c: Field; i1, i2, res1, res2: INTEGER; r1, r2: REAL; l1, l2: LONGINT;
  1284. mod, name: Meta.Name; t1, t2: ARRAY 64 OF CHAR; b: Meta.Item;
  1285. BEGIN
  1286. c := f.view(Field);
  1287. CASE c.item.typ OF
  1288. | Meta.arrTyp:
  1289. RETURN s1 = s2
  1290. | Meta.byteTyp, Meta.sIntTyp, Meta.intTyp:
  1291. IF c.prop.level > 0 THEN
  1292. FixToInt(s1, t1, c.prop.level); Strings.StringToInt(t1, i1, res1);
  1293. FixToInt(s2, t2, c.prop.level); Strings.StringToInt(t2, i2, res2)
  1294. ELSE
  1295. Strings.StringToInt(s1, i1, res1);
  1296. Strings.StringToInt(s2, i2, res2)
  1297. END;
  1298. RETURN (res1 = 0) & (res2 = 0) & (i1 = i2)
  1299. | Meta.longTyp:
  1300. IF c.prop.level > 0 THEN
  1301. FixToInt(s1, t1, c.prop.level); StringToLong(t1, l1, res1);
  1302. FixToInt(s2, t2, c.prop.level); StringToLong(t2, l2, res2)
  1303. ELSE
  1304. StringToLong(s1, l1, res1);
  1305. StringToLong(s2, l2, res2)
  1306. END;
  1307. RETURN (res1 = 0) & (res2 = 0) & (l1 = l2)
  1308. | Meta.sRealTyp, Meta.realTyp:
  1309. Strings.StringToReal(s1, r1, res1);
  1310. Strings.StringToReal(s2, r2, res2);
  1311. RETURN (res1 = 0) & (res2 = 0) & (r1 = r2)
  1312. | Meta.recTyp:
  1313. c.item.GetTypeName(mod, name);
  1314. IF mod = "Dialog" THEN
  1315. IF name = "Currency" THEN
  1316. c.item.Lookup("scale", b); i1 := b.IntVal();
  1317. FixToInt(s1, t1, i1); StringToLong(t1, l1, res1);
  1318. FixToInt(s2, t2, i1); StringToLong(t2, l2, res2);
  1319. RETURN (res1 = 0) & (res2 = 0) & (l1 =l2)
  1320. ELSE (* name = "Combo" *)
  1321. RETURN s1 = s2
  1322. END
  1323. END
  1324. ELSE RETURN s1 = s2
  1325. END
  1326. END EqualField;
  1327. PROCEDURE (c: Field) CopyFromSimpleView2 (source: Control);
  1328. BEGIN
  1329. WITH source: Field DO c.maxLen := source.maxLen END
  1330. END CopyFromSimpleView2;
  1331. PROCEDURE (c: Field) Internalize2 (VAR rd: Stores.Reader);
  1332. VAR thisVersion: INTEGER;
  1333. BEGIN
  1334. rd.ReadVersion(minVersion, fldVersion, thisVersion)
  1335. END Internalize2;
  1336. PROCEDURE (c: Field) Externalize2 (VAR wr: Stores.Writer);
  1337. BEGIN
  1338. wr.WriteVersion(fldVersion)
  1339. END Externalize2;
  1340. PROCEDURE (c: Field) GetNewFrame (VAR frame: Views.Frame);
  1341. VAR f: StdCFrames.Field;
  1342. BEGIN
  1343. f := StdCFrames.dir.NewField();
  1344. f.disabled := c.disabled;
  1345. f.undef := c.undef;
  1346. f.readOnly := c.readOnly;
  1347. f.font := c.font;
  1348. f.maxLen := c.maxLen;
  1349. f.left := c.prop.opt[left];
  1350. f.right := c.prop.opt[right];
  1351. f.multiLine := c.prop.opt[multiLine];
  1352. f.password := c.prop.opt[password];
  1353. f.Get := GetField;
  1354. f.Set := SetField;
  1355. f.Equal := EqualField;
  1356. frame := f
  1357. END GetNewFrame;
  1358. PROCEDURE (c: Field) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  1359. BEGIN
  1360. WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
  1361. END Restore;
  1362. PROCEDURE (c: Field) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
  1363. VAR focus: Views.View);
  1364. VAR ch: CHAR; mod, name: Meta.Name;
  1365. BEGIN
  1366. WITH f: StdCFrames.Field DO
  1367. IF ~c.disabled & ~c.readOnly THEN
  1368. WITH msg: Controllers.PollOpsMsg DO
  1369. msg.selectable := TRUE;
  1370. (* should ask Frame if there is a selection for cut or copy! *)
  1371. msg.valid := {Controllers.pasteChar, Controllers.cut, Controllers.copy, Controllers.paste}
  1372. | msg: Controllers.TickMsg DO
  1373. f.Idle
  1374. | msg: Controllers.EditMsg DO
  1375. IF msg.op = Controllers.pasteChar THEN
  1376. ch := msg.char;
  1377. IF (ch = ldel) OR (ch = rdel) OR (ch >= 10X) & (ch <= 1FX)
  1378. OR ("0" <= ch) & (ch <= "9") OR (ch = "+") OR (ch = "-")
  1379. OR (c.item.typ = Meta.arrTyp)
  1380. OR (c.item.typ IN {Meta.sRealTyp, Meta.realTyp}) & ((ch = ".") OR (ch = "E"))
  1381. OR (c.prop.level > 0) & (ch = ".")
  1382. THEN f.KeyDown(ch)
  1383. ELSIF c.item.typ = Meta.recTyp THEN
  1384. c.item.GetTypeName(mod, name);
  1385. IF (mod = "Dialog") & (name = "Combo") OR (ch = ".") THEN
  1386. f.KeyDown(ch)
  1387. ELSE Dialog.Beep
  1388. END
  1389. ELSE Dialog.Beep
  1390. END
  1391. ELSE
  1392. f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
  1393. END
  1394. | msg: Controllers.SelectMsg DO
  1395. IF msg.set THEN f.Select(0, MAX(INTEGER))
  1396. ELSE f.Select(-1, -1)
  1397. END
  1398. | msg: Controllers.MarkMsg DO
  1399. f.Mark(msg.show, msg.focus);
  1400. IF ~msg.show & msg.focus THEN f.Update END;
  1401. IF msg.show & msg.focus THEN f.Select(0, MAX(INTEGER)) END
  1402. ELSE
  1403. CatchCtrlMsg(c, f, msg, focus)
  1404. END
  1405. ELSIF ~c.disabled THEN
  1406. WITH msg: Controllers.TrackMsg DO
  1407. f.MouseDown(msg.x, msg.y, msg.modifiers)
  1408. ELSE
  1409. END
  1410. END
  1411. END
  1412. END HandleCtrlMsg2;
  1413. PROCEDURE (c: Field) HandlePropMsg2 (VAR msg: Properties.Message);
  1414. BEGIN
  1415. WITH msg: Properties.ControlPref DO
  1416. IF msg.char = lineChar THEN msg.accepts := c.prop.opt[multiLine] & (msg.focus = c)
  1417. ELSIF msg.char = esc THEN msg.accepts := FALSE
  1418. END;
  1419. IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
  1420. | msg: Properties.FocusPref DO
  1421. IF ~c.disabled & ~c.readOnly THEN
  1422. msg.setFocus := TRUE
  1423. ELSIF~c.disabled THEN
  1424. msg.hotFocus := TRUE
  1425. END
  1426. | msg: Properties.SizePref DO
  1427. StdCFrames.dir.GetFieldSize(c.maxLen, msg.w, msg.h)
  1428. | msg: PropPref DO
  1429. msg.valid := {link, label, guard, level, notifier, left, right, multiLine, password}
  1430. ELSE
  1431. END
  1432. END HandlePropMsg2;
  1433. PROCEDURE (c: Field) CheckLink (VAR ok: BOOLEAN);
  1434. VAR t: INTEGER; name: Meta.Name;
  1435. BEGIN
  1436. GetTypeName(c.item, name); t := c.item.typ;
  1437. IF (t = Meta.arrTyp) & (c.item.BaseTyp() = Meta.charTyp) THEN c.maxLen := SHORT(c.item.Len() - 1)
  1438. ELSIF t = Meta.byteTyp THEN c.maxLen := 6
  1439. ELSIF t = Meta.sIntTyp THEN c.maxLen := 9
  1440. ELSIF t = Meta.intTyp THEN c.maxLen := 13
  1441. ELSIF t = Meta.longTyp THEN c.maxLen := 24
  1442. ELSIF t = Meta.sRealTyp THEN c.maxLen := 16
  1443. ELSIF t = Meta.realTyp THEN c.maxLen := 24
  1444. ELSIF name = "Combo" THEN c.maxLen := 64
  1445. ELSIF name = "Currency" THEN c.maxLen := 16
  1446. ELSE ok := FALSE
  1447. END
  1448. END CheckLink;
  1449. PROCEDURE (c: Field) Update (f: Views.Frame; op, from, to: INTEGER);
  1450. BEGIN
  1451. f(StdCFrames.Frame).Update
  1452. END Update;
  1453. (* UpDownField *)
  1454. PROCEDURE GetUpDownField (f: StdCFrames.UpDownField; OUT val: INTEGER);
  1455. VAR c: UpDownField;
  1456. BEGIN
  1457. val := 0;
  1458. c := f.view(UpDownField);
  1459. IF c.item.Valid() THEN val := c.item.IntVal() END
  1460. END GetUpDownField;
  1461. PROCEDURE SetUpDownField (f: StdCFrames.UpDownField; val: INTEGER);
  1462. VAR c: UpDownField; old: INTEGER;
  1463. BEGIN
  1464. c := f.view(UpDownField);
  1465. IF c.item.Valid() & ~c.readOnly THEN
  1466. IF (val >= c.min) & (val <= c.max) THEN
  1467. old := c.item.IntVal();
  1468. IF old # val THEN c.item.PutIntVal(val); Notify(c, f, Dialog.changed, old, val) END
  1469. ELSE Dialog.Beep
  1470. END
  1471. END
  1472. END SetUpDownField;
  1473. PROCEDURE (c: UpDownField) CopyFromSimpleView2 (source: Control);
  1474. BEGIN
  1475. WITH source: UpDownField DO
  1476. c.min := source.min;
  1477. c.max := source.max;
  1478. c.inc := source.inc
  1479. END
  1480. END CopyFromSimpleView2;
  1481. PROCEDURE (c: UpDownField) Internalize2 (VAR rd: Stores.Reader);
  1482. VAR thisVersion: INTEGER;
  1483. BEGIN
  1484. rd.ReadVersion(minVersion, fldVersion, thisVersion)
  1485. END Internalize2;
  1486. PROCEDURE (c: UpDownField) Externalize2 (VAR wr: Stores.Writer);
  1487. BEGIN
  1488. wr.WriteVersion(fldVersion)
  1489. END Externalize2;
  1490. PROCEDURE (c: UpDownField) GetNewFrame (VAR frame: Views.Frame);
  1491. VAR f: StdCFrames.UpDownField;
  1492. BEGIN
  1493. f := StdCFrames.dir.NewUpDownField();
  1494. f.disabled := c.disabled;
  1495. f.undef := c.undef;
  1496. f.readOnly := c.readOnly;
  1497. f.font := c.font;
  1498. f.min := c.min;
  1499. f.max := c.max;
  1500. f.inc := c.inc;
  1501. f.Get := GetUpDownField;
  1502. f.Set := SetUpDownField;
  1503. frame := f
  1504. END GetNewFrame;
  1505. PROCEDURE (c: UpDownField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  1506. BEGIN
  1507. WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
  1508. END Restore;
  1509. PROCEDURE (c: UpDownField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
  1510. VAR focus: Views.View);
  1511. VAR ch: CHAR;
  1512. BEGIN
  1513. IF ~c.disabled & ~c.readOnly THEN
  1514. WITH f: StdCFrames.UpDownField DO
  1515. WITH msg: Controllers.PollOpsMsg DO
  1516. msg.selectable := TRUE;
  1517. (* should ask view if there is a selection for cut or copy! *)
  1518. msg.valid := {Controllers.pasteChar, Controllers.cut, Controllers.copy, Controllers.paste}
  1519. | msg: Controllers.TickMsg DO
  1520. f.Idle
  1521. | msg: Controllers.EditMsg DO
  1522. IF msg.op = Controllers.pasteChar THEN
  1523. ch := msg.char;
  1524. IF (ch = ldel) OR (ch = rdel) OR (ch >= 10X) & (ch <= 1FX)
  1525. OR ("0" <= ch) & (ch <= "9") OR (ch = "+") OR (ch = "-")
  1526. OR (c.item.typ = Meta.arrTyp)
  1527. THEN f.KeyDown(ch)
  1528. ELSE Dialog.Beep
  1529. END
  1530. ELSE
  1531. f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
  1532. END
  1533. | msg: Controllers.SelectMsg DO
  1534. IF msg.set THEN f.Select(0, MAX(INTEGER))
  1535. ELSE f.Select(-1, -1)
  1536. END
  1537. | msg: Controllers.MarkMsg DO
  1538. f.Mark(msg.show, msg.focus);
  1539. IF msg.show & msg.focus THEN f.Select(0, MAX(INTEGER)) END
  1540. ELSE
  1541. CatchCtrlMsg(c, f, msg, focus)
  1542. END
  1543. END
  1544. END
  1545. END HandleCtrlMsg2;
  1546. PROCEDURE (c: UpDownField) HandlePropMsg2 (VAR msg: Properties.Message);
  1547. VAR m: INTEGER; n: INTEGER;
  1548. BEGIN
  1549. WITH msg: Properties.ControlPref DO
  1550. IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
  1551. IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
  1552. | msg: Properties.FocusPref DO
  1553. IF ~c.disabled & ~c.readOnly THEN
  1554. msg.setFocus := TRUE
  1555. END
  1556. | msg: Properties.SizePref DO
  1557. m := -c.min;
  1558. IF c.max > m THEN m := c.max END;
  1559. n := 3;
  1560. WHILE m > 99 DO INC(n); m := m DIV 10 END;
  1561. StdCFrames.dir.GetUpDownFieldSize(n, msg.w, msg.h)
  1562. | msg: PropPref DO
  1563. msg.valid := {link, label, guard, notifier}
  1564. ELSE
  1565. END
  1566. END HandlePropMsg2;
  1567. PROCEDURE (c: UpDownField) CheckLink (VAR ok: BOOLEAN);
  1568. BEGIN
  1569. IF c.item.typ = Meta.byteTyp THEN c.min := MIN(BYTE); c.max := MAX(BYTE)
  1570. ELSIF c.item.typ = Meta.sIntTyp THEN c.min := MIN(SHORTINT); c.max := MAX(SHORTINT)
  1571. ELSIF c.item.typ = Meta.intTyp THEN c.min := MIN(INTEGER); c.max := MAX(INTEGER)
  1572. ELSE ok := FALSE
  1573. END;
  1574. c.inc := 1
  1575. END CheckLink;
  1576. PROCEDURE (c: UpDownField) Update (f: Views.Frame; op, from, to: INTEGER);
  1577. BEGIN
  1578. f(StdCFrames.Frame).Update
  1579. END Update;
  1580. (* DateField *)
  1581. PROCEDURE GetDateField (f: StdCFrames.DateField; OUT date: Dates.Date);
  1582. VAR c: DateField; v: Meta.Item;
  1583. BEGIN
  1584. date.year := 1; date.month := 1; date.day := 1;
  1585. c := f.view(DateField);
  1586. IF c.item.Valid() THEN
  1587. c.item.Lookup("year", v); IF v.typ = Meta.intTyp THEN date.year := SHORT(v.IntVal()) END;
  1588. c.item.Lookup("month", v); IF v.typ = Meta.intTyp THEN date.month := SHORT(v.IntVal()) END;
  1589. c.item.Lookup("day", v); IF v.typ = Meta.intTyp THEN date.day := SHORT(v.IntVal()) END
  1590. END
  1591. END GetDateField;
  1592. PROCEDURE SetDateField(f: StdCFrames.DateField; IN date: Dates.Date);
  1593. VAR c: DateField; v: Meta.Item;
  1594. BEGIN
  1595. c := f.view(DateField);
  1596. IF c.item.Valid() & ~c.readOnly THEN
  1597. c.item.Lookup("year", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.year) END;
  1598. c.item.Lookup("month", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.month) END;
  1599. c.item.Lookup("day", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.day) END;
  1600. Notify(c, f, Dialog.changed, 0, 0)
  1601. END
  1602. END SetDateField;
  1603. PROCEDURE GetDateFieldSelection (f: StdCFrames.DateField; OUT sel: INTEGER);
  1604. BEGIN
  1605. sel := f.view(DateField).selection
  1606. END GetDateFieldSelection;
  1607. PROCEDURE SetDateFieldSelection (f: StdCFrames.DateField; sel: INTEGER);
  1608. BEGIN
  1609. f.view(DateField).selection := sel
  1610. END SetDateFieldSelection;
  1611. PROCEDURE (c: DateField) CopyFromSimpleView2 (source: Control);
  1612. BEGIN
  1613. WITH source: DateField DO c.selection := source.selection END
  1614. END CopyFromSimpleView2;
  1615. PROCEDURE (c: DateField) Internalize2 (VAR rd: Stores.Reader);
  1616. VAR thisVersion: INTEGER;
  1617. BEGIN
  1618. rd.ReadVersion(minVersion, dfldVersion, thisVersion);
  1619. c.selection := 0
  1620. END Internalize2;
  1621. PROCEDURE (c: DateField) Externalize2 (VAR wr: Stores.Writer);
  1622. BEGIN
  1623. wr.WriteVersion(dfldVersion)
  1624. END Externalize2;
  1625. PROCEDURE (c: DateField) GetNewFrame (VAR frame: Views.Frame);
  1626. VAR f: StdCFrames.DateField;
  1627. BEGIN
  1628. f := StdCFrames.dir.NewDateField();
  1629. f.disabled := c.disabled;
  1630. f.undef := c.undef;
  1631. f.readOnly := c.readOnly;
  1632. f.font := c.font;
  1633. f.Get := GetDateField;
  1634. f.Set := SetDateField;
  1635. f.GetSel := GetDateFieldSelection;
  1636. f.SetSel := SetDateFieldSelection;
  1637. frame := f
  1638. END GetNewFrame;
  1639. PROCEDURE (c: DateField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  1640. BEGIN
  1641. WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
  1642. END Restore;
  1643. PROCEDURE (c: DateField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
  1644. VAR focus: Views.View);
  1645. BEGIN
  1646. IF ~c.disabled & ~c.readOnly THEN
  1647. WITH f: StdCFrames.DateField DO
  1648. WITH msg: Controllers.PollOpsMsg DO
  1649. msg.valid := {Controllers.pasteChar, Controllers.copy}
  1650. | msg: Controllers.EditMsg DO
  1651. IF msg.op = Controllers.pasteChar THEN
  1652. f.KeyDown(msg.char)
  1653. ELSE
  1654. f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
  1655. END
  1656. | msg: Controllers.TickMsg DO
  1657. IF f.mark THEN
  1658. IF c.selection = 0 THEN c.selection := 1; Views.Update(c, Views.keepFrames) END
  1659. END
  1660. ELSE
  1661. CatchCtrlMsg(c, f, msg, focus)
  1662. END
  1663. END
  1664. END
  1665. END HandleCtrlMsg2;
  1666. PROCEDURE (c: DateField) HandlePropMsg2 (VAR msg: Properties.Message);
  1667. BEGIN
  1668. WITH msg: Properties.ControlPref DO
  1669. IF (msg.char = lineChar) OR (msg.char = esc) THEN
  1670. msg.accepts := FALSE
  1671. ELSIF (msg.char = tab) OR (msg.char = ltab) THEN
  1672. msg.accepts := ((msg.focus # c) & (~c.disabled & ~c.readOnly)) OR
  1673. (msg.focus = c) & ((msg.char = tab) & (c.selection # -1) OR (msg.char = ltab) & (c.selection # 1));
  1674. msg.getFocus := msg.accepts
  1675. END;
  1676. IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
  1677. | msg: Properties.FocusPref DO
  1678. IF ~c.disabled & ~c.readOnly THEN
  1679. msg.setFocus := TRUE
  1680. END
  1681. | msg: Properties.SizePref DO
  1682. StdCFrames.dir.GetDateFieldSize(msg.w, msg.h)
  1683. | msg: PropPref DO
  1684. msg.valid := {link, label, guard, notifier}
  1685. ELSE
  1686. END
  1687. END HandlePropMsg2;
  1688. PROCEDURE (c: DateField) CheckLink (VAR ok: BOOLEAN);
  1689. VAR name: Meta.Name;
  1690. BEGIN
  1691. GetTypeName(c.item, name);
  1692. ok := name = "Date"
  1693. END CheckLink;
  1694. PROCEDURE (c: DateField) Update (f: Views.Frame; op, from, to: INTEGER);
  1695. BEGIN
  1696. f(StdCFrames.Frame).Update
  1697. END Update;
  1698. (* TimeField *)
  1699. PROCEDURE GetTimeField (f: StdCFrames.TimeField; OUT time: Dates.Time);
  1700. VAR c: TimeField; v: Meta.Item;
  1701. BEGIN
  1702. time.hour := 0; time.minute := 0; time.second := 0;
  1703. c := f.view(TimeField);
  1704. IF c.item.Valid() THEN
  1705. c.item.Lookup("hour", v); IF v.typ = Meta.intTyp THEN time.hour := SHORT(v.IntVal()) END;
  1706. c.item.Lookup("minute", v); IF v.typ = Meta.intTyp THEN time.minute := SHORT(v.IntVal()) END;
  1707. c.item.Lookup("second", v); IF v.typ = Meta.intTyp THEN time.second := SHORT(v.IntVal()) END
  1708. END
  1709. END GetTimeField;
  1710. PROCEDURE SetTimeField(f: StdCFrames.TimeField; IN date: Dates.Time);
  1711. VAR c: TimeField; v: Meta.Item;
  1712. BEGIN
  1713. c := f.view(TimeField);
  1714. IF c.item.Valid() & ~c.readOnly THEN
  1715. c.item.Lookup("hour", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.hour) END;
  1716. c.item.Lookup("minute", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.minute) END;
  1717. c.item.Lookup("second", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.second) END;
  1718. Notify(c, f, Dialog.changed, 0, 0)
  1719. END
  1720. END SetTimeField;
  1721. PROCEDURE GetTimeFieldSelection (f: StdCFrames.TimeField; OUT sel: INTEGER);
  1722. BEGIN
  1723. sel := f.view(TimeField).selection
  1724. END GetTimeFieldSelection;
  1725. PROCEDURE SetTimeFieldSelection (f: StdCFrames.TimeField; sel: INTEGER);
  1726. BEGIN
  1727. f.view(TimeField).selection := sel
  1728. END SetTimeFieldSelection;
  1729. PROCEDURE (c: TimeField) CopyFromSimpleView2 (source: Control);
  1730. BEGIN
  1731. WITH source: TimeField DO c.selection := source.selection END
  1732. END CopyFromSimpleView2;
  1733. PROCEDURE (c: TimeField) Internalize2 (VAR rd: Stores.Reader);
  1734. VAR thisVersion: INTEGER;
  1735. BEGIN
  1736. rd.ReadVersion(minVersion, tfldVersion, thisVersion);
  1737. c.selection := 0
  1738. END Internalize2;
  1739. PROCEDURE (c: TimeField) Externalize2 (VAR wr: Stores.Writer);
  1740. BEGIN
  1741. wr.WriteVersion(tfldVersion)
  1742. END Externalize2;
  1743. PROCEDURE (c: TimeField) GetNewFrame (VAR frame: Views.Frame);
  1744. VAR f: StdCFrames.TimeField;
  1745. BEGIN
  1746. f := StdCFrames.dir.NewTimeField();
  1747. f.disabled := c.disabled;
  1748. f.undef := c.undef;
  1749. f.readOnly := c.readOnly;
  1750. f.font := c.font;
  1751. f.Get := GetTimeField;
  1752. f.Set := SetTimeField;
  1753. f.GetSel := GetTimeFieldSelection;
  1754. f.SetSel := SetTimeFieldSelection;
  1755. frame := f
  1756. END GetNewFrame;
  1757. PROCEDURE (c: TimeField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  1758. BEGIN
  1759. WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
  1760. END Restore;
  1761. PROCEDURE (c: TimeField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
  1762. VAR focus: Views.View);
  1763. BEGIN
  1764. IF ~c.disabled & ~c.readOnly THEN
  1765. WITH f: StdCFrames.TimeField DO
  1766. WITH msg: Controllers.PollOpsMsg DO
  1767. msg.valid := {Controllers.pasteChar, Controllers.copy}
  1768. | msg: Controllers.EditMsg DO
  1769. IF msg.op = Controllers.pasteChar THEN
  1770. f.KeyDown(msg.char)
  1771. ELSE
  1772. f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
  1773. END
  1774. | msg: Controllers.TickMsg DO
  1775. IF f.mark THEN
  1776. IF c.selection = 0 THEN c.selection := 1; Views.Update(c, Views.keepFrames) END
  1777. END
  1778. ELSE
  1779. CatchCtrlMsg(c, f, msg, focus)
  1780. END
  1781. END
  1782. END
  1783. END HandleCtrlMsg2;
  1784. PROCEDURE (c: TimeField) HandlePropMsg2 (VAR msg: Properties.Message);
  1785. BEGIN
  1786. WITH msg: Properties.ControlPref DO
  1787. IF (msg.char = lineChar) OR (msg.char = esc) THEN
  1788. msg.accepts := FALSE
  1789. ELSIF (msg.char = tab) OR (msg.char = ltab) THEN
  1790. msg.accepts := (msg.focus # c) OR
  1791. ((msg.char = tab) & (c.selection # -1)) OR ((msg.char = ltab) & (c.selection # 1))
  1792. END;
  1793. IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
  1794. | msg: Properties.FocusPref DO
  1795. IF ~c.disabled & ~c.readOnly THEN
  1796. msg.setFocus := TRUE
  1797. END
  1798. | msg: Properties.SizePref DO
  1799. StdCFrames.dir.GetTimeFieldSize(msg.w, msg.h)
  1800. | msg: PropPref DO
  1801. msg.valid := {link, label, guard, notifier}
  1802. ELSE
  1803. END
  1804. END HandlePropMsg2;
  1805. PROCEDURE (c: TimeField) CheckLink (VAR ok: BOOLEAN);
  1806. VAR name: Meta.Name;
  1807. BEGIN
  1808. GetTypeName(c.item, name);
  1809. ok := name = "Time"
  1810. END CheckLink;
  1811. PROCEDURE (c: TimeField) Update (f: Views.Frame; op, from, to: INTEGER);
  1812. BEGIN
  1813. f(StdCFrames.Frame).Update
  1814. END Update;
  1815. (* ColorField *)
  1816. PROCEDURE GetColorField (f: StdCFrames.ColorField; OUT col: INTEGER);
  1817. VAR c: ColorField; v: Meta.Item;
  1818. BEGIN
  1819. col := Ports.defaultColor;
  1820. c := f.view(ColorField);
  1821. IF c.item.Valid() THEN
  1822. IF c.item.typ = Meta.intTyp THEN
  1823. col := c.item.IntVal()
  1824. ELSE
  1825. c.item.Lookup("val", v); IF v.typ = Meta.intTyp THEN col := v.IntVal() END
  1826. END
  1827. END
  1828. END GetColorField;
  1829. PROCEDURE SetColorField(f: StdCFrames.ColorField; col: INTEGER);
  1830. VAR c: ColorField; v: Meta.Item; old: INTEGER;
  1831. BEGIN
  1832. c := f.view(ColorField);
  1833. IF c.item.Valid() & ~c.readOnly THEN
  1834. IF c.item.typ = Meta.intTyp THEN
  1835. old := c.item.IntVal();
  1836. IF old # col THEN c.item.PutIntVal(col); Notify(c, f, Dialog.changed, old, col) END
  1837. ELSE
  1838. c.item.Lookup("val", v);
  1839. IF v.typ = Meta.intTyp THEN
  1840. old := v.IntVal();
  1841. IF old # col THEN v.PutIntVal(col); Notify(c, f, Dialog.changed, old, col) END
  1842. END
  1843. END
  1844. END
  1845. END SetColorField;
  1846. PROCEDURE (c: ColorField) Internalize2 (VAR rd: Stores.Reader);
  1847. VAR thisVersion: INTEGER;
  1848. BEGIN
  1849. rd.ReadVersion(minVersion, cfldVersion, thisVersion)
  1850. END Internalize2;
  1851. PROCEDURE (c: ColorField) Externalize2 (VAR wr: Stores.Writer);
  1852. BEGIN
  1853. wr.WriteVersion(cfldVersion)
  1854. END Externalize2;
  1855. PROCEDURE (c: ColorField) GetNewFrame (VAR frame: Views.Frame);
  1856. VAR f: StdCFrames.ColorField;
  1857. BEGIN
  1858. f := StdCFrames.dir.NewColorField();
  1859. f.disabled := c.disabled;
  1860. f.undef := c.undef;
  1861. f.readOnly := c.readOnly;
  1862. f.font := c.font;
  1863. f.Get := GetColorField;
  1864. f.Set := SetColorField;
  1865. frame := f
  1866. END GetNewFrame;
  1867. PROCEDURE (c: ColorField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  1868. BEGIN
  1869. WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
  1870. END Restore;
  1871. PROCEDURE (c: ColorField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
  1872. VAR focus: Views.View);
  1873. BEGIN
  1874. IF ~c.disabled & ~c.readOnly THEN
  1875. WITH f: StdCFrames.ColorField DO
  1876. WITH msg: Controllers.EditMsg DO
  1877. IF msg.op = Controllers.pasteChar THEN
  1878. f.KeyDown(msg.char)
  1879. ELSE
  1880. f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
  1881. END
  1882. ELSE
  1883. CatchCtrlMsg(c, f, msg, focus)
  1884. END
  1885. END
  1886. END
  1887. END HandleCtrlMsg2;
  1888. PROCEDURE (c: ColorField) HandlePropMsg2 (VAR msg: Properties.Message);
  1889. BEGIN
  1890. WITH msg: Properties.ControlPref DO
  1891. msg.accepts := ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c)
  1892. | msg: Properties.FocusPref DO
  1893. IF ~c.disabled & ~c.readOnly THEN
  1894. msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
  1895. END
  1896. | msg: Properties.SizePref DO
  1897. StdCFrames.dir.GetColorFieldSize(msg.w, msg.h)
  1898. ELSE
  1899. END
  1900. END HandlePropMsg2;
  1901. PROCEDURE (c: ColorField) CheckLink (VAR ok: BOOLEAN);
  1902. VAR name: Meta.Name;
  1903. BEGIN
  1904. GetTypeName(c.item, name);
  1905. ok := (name = "Color") OR (c.item.typ = Meta.intTyp)
  1906. END CheckLink;
  1907. PROCEDURE (c: ColorField) Update (f: Views.Frame; op, from, to: INTEGER);
  1908. BEGIN
  1909. f(StdCFrames.Frame).Update
  1910. END Update;
  1911. (* ListBox *)
  1912. PROCEDURE GetListBox (f: StdCFrames.ListBox; OUT i: INTEGER);
  1913. VAR c: ListBox; v: Meta.Item;
  1914. BEGIN
  1915. i := -1;
  1916. c := f.view(ListBox);
  1917. IF c.item.Valid() THEN
  1918. c.item.Lookup("index", v);
  1919. IF v.typ = Meta.intTyp THEN i := v.IntVal() END
  1920. END
  1921. END GetListBox;
  1922. PROCEDURE SetListBox (f: StdCFrames.ListBox; i: INTEGER);
  1923. VAR c: ListBox; v: Meta.Item; old: INTEGER;
  1924. BEGIN
  1925. c := f.view(ListBox);
  1926. IF c.item.Valid() & ~c.readOnly THEN
  1927. c.item.Lookup("index", v);
  1928. IF v.typ = Meta.intTyp THEN
  1929. old := v.IntVal();
  1930. IF i # old THEN v.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
  1931. END
  1932. END
  1933. END SetListBox;
  1934. PROCEDURE GetFName (VAR rec, par: ANYREC);
  1935. BEGIN
  1936. WITH par: Param DO
  1937. WITH rec: Dialog.List DO rec.GetItem(par.i, par.n)
  1938. | rec: Dialog.Selection DO rec.GetItem(par.i, par.n)
  1939. | rec: Dialog.Combo DO rec.GetItem(par.i, par.n)
  1940. ELSE par.n := ""
  1941. END
  1942. END
  1943. END GetFName;
  1944. PROCEDURE GetListName (f: StdCFrames.ListBox; i: INTEGER; VAR name: ARRAY OF CHAR);
  1945. VAR c: ListBox; par: Param;
  1946. BEGIN
  1947. par.n := "";
  1948. c := f.view(ListBox);
  1949. IF c.item.Valid() THEN
  1950. par.i := i;
  1951. c.item.CallWith(GetFName, par)
  1952. END;
  1953. name := par.n$
  1954. END GetListName;
  1955. PROCEDURE (c: ListBox) Internalize2 (VAR rd: Stores.Reader);
  1956. VAR thisVersion: INTEGER;
  1957. BEGIN
  1958. rd.ReadVersion(minVersion, lbxVersion, thisVersion)
  1959. END Internalize2;
  1960. PROCEDURE (c: ListBox) Externalize2 (VAR wr: Stores.Writer);
  1961. BEGIN
  1962. wr.WriteVersion(lbxVersion)
  1963. END Externalize2;
  1964. PROCEDURE (c: ListBox) GetNewFrame (VAR frame: Views.Frame);
  1965. VAR f: StdCFrames.ListBox;
  1966. BEGIN
  1967. f := StdCFrames.dir.NewListBox();
  1968. f.disabled := c.disabled;
  1969. f.undef := c.undef;
  1970. f.readOnly := c.readOnly;
  1971. f.font := c.font;
  1972. f.sorted := c.prop.opt[sorted];
  1973. f.Get := GetListBox;
  1974. f.Set := SetListBox;
  1975. f.GetName := GetListName;
  1976. frame := f
  1977. END GetNewFrame;
  1978. PROCEDURE (c: ListBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  1979. BEGIN
  1980. WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
  1981. END Restore;
  1982. PROCEDURE (c: ListBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
  1983. VAR focus: Views.View);
  1984. BEGIN
  1985. WITH f: StdCFrames.ListBox DO
  1986. IF ~c.disabled & ~c.readOnly THEN
  1987. WITH msg: Controllers.EditMsg DO
  1988. IF msg.op = Controllers.pasteChar THEN f.KeyDown(msg.char) END
  1989. ELSE
  1990. CatchCtrlMsg(c, f, msg, focus)
  1991. END
  1992. ELSIF ~c.disabled THEN
  1993. WITH msg: Controllers.TrackMsg DO
  1994. f.MouseDown(msg.x, msg.y, msg.modifiers)
  1995. ELSE
  1996. END
  1997. END
  1998. END
  1999. END HandleCtrlMsg2;
  2000. PROCEDURE (c: ListBox) HandlePropMsg2 (VAR msg: Properties.Message);
  2001. BEGIN
  2002. WITH msg: Properties.ControlPref DO
  2003. IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
  2004. IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
  2005. | msg: Properties.FocusPref DO
  2006. IF ~c.disabled & ~c.readOnly THEN
  2007. msg.setFocus := TRUE
  2008. ELSIF~c.disabled THEN
  2009. msg.hotFocus := TRUE
  2010. END
  2011. | msg: Properties.SizePref DO
  2012. StdCFrames.dir.GetListBoxSize(msg.w, msg.h)
  2013. | msg: PropPref DO
  2014. msg.valid := {link, label, guard, notifier, sorted}
  2015. ELSE
  2016. END
  2017. END HandlePropMsg2;
  2018. PROCEDURE (c: ListBox) CheckLink (VAR ok: BOOLEAN);
  2019. VAR name: Meta.Name;
  2020. BEGIN
  2021. GetTypeName(c.item, name);
  2022. ok := name = "List"
  2023. END CheckLink;
  2024. PROCEDURE (c: ListBox) Update (f: Views.Frame; op, from, to: INTEGER);
  2025. BEGIN
  2026. f(StdCFrames.Frame).Update
  2027. END Update;
  2028. PROCEDURE (c: ListBox) UpdateList (f: Views.Frame);
  2029. BEGIN
  2030. f(StdCFrames.Frame).UpdateList
  2031. END UpdateList;
  2032. (* SelectionBox *)
  2033. PROCEDURE InLargeSet (VAR rec, par: ANYREC);
  2034. BEGIN
  2035. WITH par: Param DO
  2036. WITH rec: Dialog.Selection DO
  2037. IF rec.In(par.i) THEN par.i := 1 ELSE par.i := 0 END
  2038. ELSE par.i := 0
  2039. END
  2040. END
  2041. END InLargeSet;
  2042. PROCEDURE GetSelectionBox (f: StdCFrames.SelectionBox; i: INTEGER; OUT in: BOOLEAN);
  2043. VAR c: SelectionBox; lv: SelectValue; par: Param;
  2044. BEGIN
  2045. in := FALSE;
  2046. c := f.view(SelectionBox);
  2047. IF c.item.Valid() THEN
  2048. IF c.item.Is(lv) THEN
  2049. par.i := i;
  2050. c.item.CallWith(InLargeSet, par);
  2051. in := par.i # 0
  2052. END
  2053. END
  2054. END GetSelectionBox;
  2055. PROCEDURE InclLargeSet (VAR rec, par: ANYREC);
  2056. BEGIN
  2057. WITH par: Param DO
  2058. WITH rec: Dialog.Selection DO
  2059. IF (par.from # par.to) OR ~rec.In(par.from) THEN
  2060. rec.Incl(par.from, par.to); par.i := 1
  2061. ELSE par.i := 0
  2062. END
  2063. ELSE par.i := 0
  2064. END
  2065. END
  2066. END InclLargeSet;
  2067. PROCEDURE InclSelectionBox (f: StdCFrames.SelectionBox; from, to: INTEGER);
  2068. VAR c: SelectionBox; lv: SelectValue; par: Param;
  2069. BEGIN
  2070. c := f.view(SelectionBox);
  2071. IF c.item.Valid() & ~c.readOnly THEN
  2072. IF c.item.Is(lv) THEN
  2073. par.from := from; par.to := to;
  2074. c.item.CallWith(InclLargeSet, par);
  2075. IF par.i # 0 THEN Notify(c, f, Dialog.included, from, to) END
  2076. END
  2077. END
  2078. END InclSelectionBox;
  2079. PROCEDURE ExclLargeSet (VAR rec, par: ANYREC);
  2080. BEGIN
  2081. WITH par: Param DO
  2082. WITH rec: Dialog.Selection DO
  2083. IF (par.from # par.to) OR rec.In(par.from) THEN
  2084. rec.Excl(par.from, par.to); par.i := 1
  2085. ELSE par.i := 0
  2086. END
  2087. ELSE par.i := 0
  2088. END
  2089. END
  2090. END ExclLargeSet;
  2091. PROCEDURE ExclSelectionBox (f: StdCFrames.SelectionBox; from, to: INTEGER);
  2092. VAR c: SelectionBox; lv: SelectValue; par: Param;
  2093. BEGIN
  2094. c := f.view(SelectionBox);
  2095. IF c.item.Valid() & ~c.readOnly THEN
  2096. IF c.item.Is(lv) THEN
  2097. par.from := from; par.to := to;
  2098. c.item.CallWith(ExclLargeSet, par);
  2099. IF par.i # 0 THEN Notify(c, f, Dialog.excluded, from, to) END
  2100. END
  2101. END
  2102. END ExclSelectionBox;
  2103. PROCEDURE SetSelectionBox (f: StdCFrames.SelectionBox; from, to: INTEGER);
  2104. VAR c: SelectionBox; lv: SelectValue; par: Param;
  2105. BEGIN
  2106. c := f.view(SelectionBox);
  2107. IF c.item.Valid() & ~c.readOnly THEN
  2108. IF c.item.Is(lv) THEN
  2109. par.from := 0; par.to := MAX(INTEGER);
  2110. c.item.CallWith(ExclLargeSet, par);
  2111. par.from := from; par.to := to;
  2112. c.item.CallWith(InclLargeSet, par);
  2113. Notify(c, f, Dialog.set, from, to)
  2114. END
  2115. END
  2116. END SetSelectionBox;
  2117. PROCEDURE GetSelName (f: StdCFrames.SelectionBox; i: INTEGER; VAR name: ARRAY OF CHAR);
  2118. VAR c: SelectionBox; par: Param;
  2119. BEGIN
  2120. par.n := "";
  2121. c := f.view(SelectionBox);
  2122. IF c.item.Valid() THEN
  2123. par.i := i;
  2124. c.item.CallWith(GetFName, par)
  2125. END;
  2126. name := par.n$
  2127. END GetSelName;
  2128. PROCEDURE (c: SelectionBox) Internalize2 (VAR rd: Stores.Reader);
  2129. VAR thisVersion: INTEGER;
  2130. BEGIN
  2131. rd.ReadVersion(minVersion, sbxVersion, thisVersion)
  2132. END Internalize2;
  2133. PROCEDURE (c: SelectionBox) Externalize2 (VAR wr: Stores.Writer);
  2134. BEGIN
  2135. wr.WriteVersion(sbxVersion)
  2136. END Externalize2;
  2137. PROCEDURE (c: SelectionBox) GetNewFrame (VAR frame: Views.Frame);
  2138. VAR f: StdCFrames.SelectionBox;
  2139. BEGIN
  2140. f := StdCFrames.dir.NewSelectionBox();
  2141. f.disabled := c.disabled;
  2142. f.undef := c.undef;
  2143. f.readOnly := c.readOnly;
  2144. f.font := c.font;
  2145. f.sorted := c.prop.opt[sorted];
  2146. f.Get := GetSelectionBox;
  2147. f.Incl := InclSelectionBox;
  2148. f.Excl := ExclSelectionBox;
  2149. f.Set := SetSelectionBox;
  2150. f.GetName := GetSelName;
  2151. frame := f
  2152. END GetNewFrame;
  2153. PROCEDURE (c: SelectionBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  2154. BEGIN
  2155. WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
  2156. END Restore;
  2157. PROCEDURE (c: SelectionBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
  2158. VAR focus: Views.View);
  2159. BEGIN
  2160. WITH f: StdCFrames.SelectionBox DO
  2161. IF ~c.disabled & ~c.readOnly THEN
  2162. WITH msg: Controllers.EditMsg DO
  2163. IF msg.op = Controllers.pasteChar THEN f.KeyDown(msg.char) END
  2164. | msg: Controllers.SelectMsg DO
  2165. IF msg.set THEN f.Select(0, MAX(INTEGER))
  2166. ELSE f.Select(-1, -1)
  2167. END
  2168. ELSE
  2169. CatchCtrlMsg(c, f, msg, focus)
  2170. END
  2171. ELSIF ~c.disabled THEN
  2172. WITH msg: Controllers.TrackMsg DO
  2173. f.MouseDown(msg.x, msg.y, msg.modifiers)
  2174. ELSE
  2175. END
  2176. END
  2177. END
  2178. END HandleCtrlMsg2;
  2179. PROCEDURE (c: SelectionBox) HandlePropMsg2 (VAR msg: Properties.Message);
  2180. BEGIN
  2181. WITH msg: Properties.ControlPref DO
  2182. IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
  2183. IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) OR msg.getFocus THEN
  2184. msg.getFocus := StdCFrames.setFocus
  2185. END
  2186. | msg: Properties.FocusPref DO
  2187. IF ~c.disabled & ~c.readOnly THEN
  2188. msg.setFocus := TRUE
  2189. ELSIF~c.disabled THEN
  2190. msg.hotFocus := TRUE
  2191. END
  2192. | msg: Properties.SizePref DO
  2193. StdCFrames.dir.GetSelectionBoxSize(msg.w, msg.h)
  2194. | msg: PropPref DO
  2195. msg.valid := {link, label, guard, notifier, sorted}
  2196. ELSE
  2197. END
  2198. END HandlePropMsg2;
  2199. PROCEDURE (c: SelectionBox) CheckLink (VAR ok: BOOLEAN);
  2200. VAR name: Meta.Name;
  2201. BEGIN
  2202. GetTypeName(c.item, name);
  2203. ok := name = "Selection"
  2204. END CheckLink;
  2205. PROCEDURE (c: SelectionBox) Update (f: Views.Frame; op, from, to: INTEGER);
  2206. BEGIN
  2207. IF (op >= Dialog.included) & (op <= Dialog.set) THEN
  2208. f(StdCFrames.SelectionBox).UpdateRange(op, from, to)
  2209. ELSE
  2210. f(StdCFrames.Frame).Update
  2211. END
  2212. END Update;
  2213. PROCEDURE (c: SelectionBox) UpdateList (f: Views.Frame);
  2214. BEGIN
  2215. f(StdCFrames.Frame).UpdateList
  2216. END UpdateList;
  2217. (* ComboBox *)
  2218. PROCEDURE GetComboBox (f: StdCFrames.ComboBox; OUT x: ARRAY OF CHAR);
  2219. VAR c: ComboBox; ok: BOOLEAN; v: Meta.Item;
  2220. BEGIN
  2221. x := "";
  2222. c := f.view(ComboBox);
  2223. IF c.item.Valid() THEN
  2224. c.item.Lookup("item", v);
  2225. IF v.typ = Meta.arrTyp THEN v.GetStringVal(x, ok) END
  2226. END
  2227. END GetComboBox;
  2228. PROCEDURE SetComboBox (f: StdCFrames.ComboBox; IN x: ARRAY OF CHAR);
  2229. VAR c: ComboBox; ok: BOOLEAN; v: Meta.Item; s: ARRAY 1024 OF CHAR;
  2230. BEGIN
  2231. c := f.view(ComboBox);
  2232. IF c.item.Valid() & ~c.readOnly THEN
  2233. c.item.Lookup("item", v);
  2234. IF v.typ = Meta.arrTyp THEN
  2235. v.GetStringVal(s, ok);
  2236. IF ~ok OR (s$ # x$) THEN
  2237. v.PutStringVal(x, ok);
  2238. IF ok THEN Notify(c, f, Dialog.changed, 0, 0) END
  2239. END
  2240. END
  2241. END
  2242. END SetComboBox;
  2243. PROCEDURE GetComboName (f: StdCFrames.ComboBox; i: INTEGER; VAR name: ARRAY OF CHAR);
  2244. VAR c: ComboBox; par: Param;
  2245. BEGIN
  2246. par.n := "";
  2247. c := f.view(ComboBox);
  2248. IF c.item.Valid() THEN
  2249. par.i := i;
  2250. c.item.CallWith(GetFName, par)
  2251. END;
  2252. name := par.n$
  2253. END GetComboName;
  2254. PROCEDURE (c: ComboBox) Internalize2 (VAR rd: Stores.Reader);
  2255. VAR thisVersion: INTEGER;
  2256. BEGIN
  2257. rd.ReadVersion(minVersion, cbxVersion, thisVersion)
  2258. END Internalize2;
  2259. PROCEDURE (c: ComboBox) Externalize2 (VAR wr: Stores.Writer);
  2260. BEGIN
  2261. wr.WriteVersion(cbxVersion)
  2262. END Externalize2;
  2263. PROCEDURE (c: ComboBox) GetNewFrame (VAR frame: Views.Frame);
  2264. VAR f: StdCFrames.ComboBox;
  2265. BEGIN
  2266. f := StdCFrames.dir.NewComboBox();
  2267. f.disabled := c.disabled;
  2268. f.undef := c.undef;
  2269. f.readOnly := c.readOnly;
  2270. f.font := c.font;
  2271. f.sorted := c.prop.opt[sorted];
  2272. f.Get := GetComboBox;
  2273. f.Set := SetComboBox;
  2274. f.GetName := GetComboName;
  2275. frame := f
  2276. END GetNewFrame;
  2277. PROCEDURE (c: ComboBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  2278. BEGIN
  2279. WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
  2280. END Restore;
  2281. PROCEDURE (c: ComboBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
  2282. VAR focus: Views.View);
  2283. BEGIN
  2284. WITH f: StdCFrames.ComboBox DO
  2285. IF ~c.disabled & ~c.readOnly THEN
  2286. WITH msg: Controllers.PollOpsMsg DO
  2287. msg.selectable := TRUE;
  2288. (* should ask Frame if there is a selection for cut or copy! *)
  2289. msg.valid := {Controllers.pasteChar, Controllers.cut, Controllers.copy, Controllers.paste}
  2290. | msg: Controllers.TickMsg DO
  2291. f.Idle
  2292. | msg: Controllers.EditMsg DO
  2293. IF msg.op = Controllers.pasteChar THEN
  2294. f.KeyDown(msg.char)
  2295. ELSE
  2296. f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
  2297. END
  2298. | msg: Controllers.SelectMsg DO
  2299. IF msg.set THEN f.Select(0, MAX(INTEGER))
  2300. ELSE f.Select(-1, -1)
  2301. END
  2302. | msg: Controllers.MarkMsg DO
  2303. f.Mark(msg.show, msg.focus);
  2304. IF msg.show & msg.focus THEN f.Select(0, MAX(INTEGER)) END
  2305. | msg: Controllers.TrackMsg DO
  2306. f.MouseDown(msg.x, msg.y, msg.modifiers)
  2307. ELSE
  2308. CatchCtrlMsg(c, f, msg, focus)
  2309. END
  2310. END
  2311. END
  2312. END HandleCtrlMsg2;
  2313. PROCEDURE (c: ComboBox) HandlePropMsg2 (VAR msg: Properties.Message);
  2314. BEGIN
  2315. WITH msg: Properties.ControlPref DO
  2316. IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
  2317. IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
  2318. | msg: Properties.FocusPref DO
  2319. IF ~c.disabled & ~c.readOnly THEN
  2320. msg.setFocus := TRUE
  2321. END
  2322. | msg: Properties.SizePref DO
  2323. StdCFrames.dir.GetComboBoxSize(msg.w, msg.h)
  2324. | msg: PropPref DO
  2325. msg.valid := {link, label, guard, notifier, sorted}
  2326. ELSE
  2327. END
  2328. END HandlePropMsg2;
  2329. PROCEDURE (c: ComboBox) CheckLink (VAR ok: BOOLEAN);
  2330. VAR name: Meta.Name;
  2331. BEGIN
  2332. GetTypeName(c.item, name);
  2333. ok := name = "Combo"
  2334. END CheckLink;
  2335. PROCEDURE (c: ComboBox) Update (f: Views.Frame; op, from, to: INTEGER);
  2336. BEGIN
  2337. f(StdCFrames.Frame).Update
  2338. END Update;
  2339. PROCEDURE (c: ComboBox) UpdateList (f: Views.Frame);
  2340. BEGIN
  2341. f(StdCFrames.Frame).UpdateList
  2342. END UpdateList;
  2343. (* Caption *)
  2344. PROCEDURE (c: Caption) Internalize2 (VAR rd: Stores.Reader);
  2345. VAR thisVersion: INTEGER;
  2346. BEGIN
  2347. rd.ReadVersion(minVersion, capVersion, thisVersion);
  2348. IF thisVersion < 1 THEN c.prop.opt[left] := TRUE END
  2349. END Internalize2;
  2350. PROCEDURE (c: Caption) Externalize2 (VAR wr: Stores.Writer);
  2351. BEGIN
  2352. (* Save old version for captions that are compatible with the old version *)
  2353. IF c.prop.opt[left] THEN wr.WriteVersion(0) ELSE wr.WriteVersion(capVersion) END
  2354. END Externalize2;
  2355. PROCEDURE (c: Caption) GetNewFrame (VAR frame: Views.Frame);
  2356. VAR f: StdCFrames.Caption;
  2357. BEGIN
  2358. f := StdCFrames.dir.NewCaption();
  2359. f.disabled := c.disabled;
  2360. f.undef := c.undef;
  2361. f.readOnly := c.readOnly;
  2362. f.font := c.font;
  2363. f.label := c.label$;
  2364. f.left := c.prop.opt[left];
  2365. f.right := c.prop.opt[right];
  2366. frame := f
  2367. END GetNewFrame;
  2368. PROCEDURE (c: Caption) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  2369. BEGIN
  2370. WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
  2371. END Restore;
  2372. PROCEDURE (c: Caption) HandlePropMsg2 (VAR msg: Properties.Message);
  2373. BEGIN
  2374. WITH msg: Properties.SizePref DO
  2375. StdCFrames.dir.GetCaptionSize(msg.w, msg.h)
  2376. | msg: PropPref DO
  2377. msg.valid := {link, label, guard, left, right}
  2378. | msg: DefaultsPref DO
  2379. IF c.prop.link = "" THEN msg.disabled := FALSE END
  2380. ELSE
  2381. END
  2382. END HandlePropMsg2;
  2383. PROCEDURE (c: Caption) Update (f: Views.Frame; op, from, to: INTEGER);
  2384. BEGIN
  2385. f(StdCFrames.Caption).label := c.label$;
  2386. f(StdCFrames.Frame).Update
  2387. END Update;
  2388. (* Group *)
  2389. PROCEDURE (c: Group) Internalize2 (VAR rd: Stores.Reader);
  2390. VAR thisVersion: INTEGER;
  2391. BEGIN
  2392. rd.ReadVersion(minVersion, grpVersion, thisVersion)
  2393. END Internalize2;
  2394. PROCEDURE (c: Group) Externalize2 (VAR wr: Stores.Writer);
  2395. BEGIN
  2396. wr.WriteVersion(grpVersion)
  2397. END Externalize2;
  2398. PROCEDURE (c: Group) GetNewFrame (VAR frame: Views.Frame);
  2399. VAR f: StdCFrames.Group;
  2400. BEGIN
  2401. f := StdCFrames.dir.NewGroup();
  2402. f.disabled := c.disabled;
  2403. f.undef := c.undef;
  2404. f.readOnly := c.readOnly;
  2405. f.font := c.font;
  2406. f.label := c.label$;
  2407. frame := f
  2408. END GetNewFrame;
  2409. PROCEDURE (c: Group) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  2410. BEGIN
  2411. WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
  2412. END Restore;
  2413. PROCEDURE (c: Group) HandlePropMsg2 (VAR msg: Properties.Message);
  2414. BEGIN
  2415. WITH msg: Properties.SizePref DO
  2416. StdCFrames.dir.GetGroupSize(msg.w, msg.h)
  2417. | msg: PropPref DO
  2418. msg.valid := {link, label, guard}
  2419. | msg: DefaultsPref DO
  2420. IF c.prop.link = "" THEN msg.disabled := FALSE END
  2421. ELSE
  2422. END
  2423. END HandlePropMsg2;
  2424. PROCEDURE (c: Group) Update (f: Views.Frame; op, from, to: INTEGER);
  2425. BEGIN
  2426. f(StdCFrames.Group).label := c.label$;
  2427. f(StdCFrames.Frame).Update
  2428. END Update;
  2429. (* TreeControl *)
  2430. PROCEDURE (c: TreeControl) Internalize2 (VAR rd: Stores.Reader);
  2431. VAR thisVersion: INTEGER;
  2432. BEGIN
  2433. rd.ReadVersion(minVersion, tfVersion, thisVersion)
  2434. END Internalize2;
  2435. PROCEDURE (c: TreeControl) Externalize2 (VAR wr: Stores.Writer);
  2436. BEGIN
  2437. wr.WriteVersion(tfVersion)
  2438. END Externalize2;
  2439. PROCEDURE TVNofNodesF (VAR rec, par: ANYREC);
  2440. BEGIN
  2441. WITH par: TVParam DO
  2442. WITH rec: Dialog.Tree DO par.l := rec.NofNodes()
  2443. ELSE par.l := 0
  2444. END
  2445. END
  2446. END TVNofNodesF;
  2447. PROCEDURE TVNofNodes (f: StdCFrames.TreeFrame): INTEGER;
  2448. VAR c: TreeControl; par: TVParam;
  2449. BEGIN
  2450. c := f.view(TreeControl); par.l := 0;
  2451. IF c.item.Valid() THEN c.item.CallWith(TVNofNodesF, par) END;
  2452. RETURN par.l
  2453. END TVNofNodes;
  2454. PROCEDURE TVChildF (VAR rec, par: ANYREC);
  2455. BEGIN
  2456. WITH par: TVParam DO
  2457. WITH rec: Dialog.Tree DO par.nodeOut := rec.Child(par.nodeIn, Dialog.firstPos)
  2458. ELSE par.nodeOut := NIL
  2459. END
  2460. END
  2461. END TVChildF;
  2462. PROCEDURE TVChild (f: StdCFrames.TreeFrame; node: Dialog.TreeNode): Dialog.TreeNode;
  2463. VAR c: TreeControl; par: TVParam;
  2464. BEGIN
  2465. c := f.view(TreeControl); par.nodeIn := node; par.nodeOut := NIL;
  2466. IF c.item.Valid() THEN c.item.CallWith(TVChildF, par) END;
  2467. RETURN par.nodeOut
  2468. END TVChild;
  2469. PROCEDURE TVParentF (VAR rec, par: ANYREC);
  2470. BEGIN
  2471. WITH par: TVParam DO
  2472. WITH rec: Dialog.Tree DO par.nodeOut := rec.Parent(par.nodeIn)
  2473. ELSE par.nodeOut := NIL
  2474. END
  2475. END
  2476. END TVParentF;
  2477. PROCEDURE TVParent (f: StdCFrames.TreeFrame; node: Dialog.TreeNode): Dialog.TreeNode;
  2478. VAR c: TreeControl; par: TVParam;
  2479. BEGIN
  2480. c := f.view(TreeControl); par.nodeIn := node; par.nodeOut := NIL;
  2481. IF c.item.Valid() THEN c.item.CallWith(TVParentF, par) END;
  2482. RETURN par.nodeOut
  2483. END TVParent;
  2484. PROCEDURE TVNextF (VAR rec, par: ANYREC);
  2485. BEGIN
  2486. WITH par: TVParam DO
  2487. WITH rec: Dialog.Tree DO par.nodeOut := rec.Next(par.nodeIn)
  2488. ELSE par.nodeOut := NIL
  2489. END
  2490. END
  2491. END TVNextF;
  2492. PROCEDURE TVNext (f: StdCFrames.TreeFrame; node: Dialog.TreeNode): Dialog.TreeNode;
  2493. VAR c: TreeControl; par: TVParam;
  2494. BEGIN
  2495. c := f.view(TreeControl); par.nodeIn := node; par.nodeOut := NIL;
  2496. IF c.item.Valid() THEN c.item.CallWith(TVNextF, par) END;
  2497. RETURN par.nodeOut
  2498. END TVNext;
  2499. PROCEDURE TVSelectF (VAR rec, par: ANYREC);
  2500. BEGIN
  2501. WITH par: TVParam DO
  2502. WITH rec: Dialog.Tree DO rec.Select(par.nodeIn) END
  2503. END
  2504. END TVSelectF;
  2505. PROCEDURE TVSelect (f: StdCFrames.TreeFrame; node: Dialog.TreeNode);
  2506. VAR c: TreeControl; par: TVParam;
  2507. BEGIN
  2508. c := f.view(TreeControl); par.nodeIn := node;
  2509. IF c.item.Valid() THEN
  2510. c.item.CallWith(TVSelectF, par);
  2511. Notify(c, f, Dialog.changed, 0, 0)
  2512. END
  2513. END TVSelect;
  2514. PROCEDURE TVSelectedF (VAR rec, par: ANYREC);
  2515. BEGIN
  2516. WITH par: TVParam DO
  2517. WITH rec: Dialog.Tree DO par.nodeOut := rec.Selected()
  2518. ELSE par.nodeOut := NIL
  2519. END
  2520. END
  2521. END TVSelectedF;
  2522. PROCEDURE TVSelected (f: StdCFrames.TreeFrame): Dialog.TreeNode;
  2523. VAR c: TreeControl; par: TVParam;
  2524. BEGIN
  2525. c := f.view(TreeControl); par.nodeOut := NIL;
  2526. IF c.item.Valid() THEN c.item.CallWith(TVSelectedF, par) END;
  2527. RETURN par.nodeOut
  2528. END TVSelected;
  2529. PROCEDURE TVSetExpansionF (VAR rec, par: ANYREC);
  2530. BEGIN
  2531. WITH par: TVParam DO
  2532. par.nodeIn.SetExpansion(par.e)
  2533. END
  2534. END TVSetExpansionF;
  2535. PROCEDURE TVSetExpansion (f: StdCFrames.TreeFrame; tn: Dialog.TreeNode; expanded: BOOLEAN);
  2536. VAR c: TreeControl; par: TVParam;
  2537. BEGIN
  2538. c := f.view(TreeControl); par.e := expanded; par.nodeIn := tn;
  2539. IF c.item.Valid() THEN c.item.CallWith(TVSetExpansionF, par) END
  2540. END TVSetExpansion;
  2541. PROCEDURE (c: TreeControl) GetNewFrame (VAR frame: Views.Frame);
  2542. VAR f: StdCFrames.TreeFrame;
  2543. BEGIN
  2544. f := StdCFrames.dir.NewTreeFrame();
  2545. f.disabled := c.disabled;
  2546. f.undef := c.undef;
  2547. f.readOnly := c.readOnly;
  2548. f.font := c.font;
  2549. f.sorted := c.prop.opt[sorted];
  2550. f.haslines := c.prop.opt[haslines];
  2551. f.hasbuttons := c.prop.opt[hasbuttons];
  2552. f.atroot := c.prop.opt[atroot];
  2553. f.foldericons := c.prop.opt[foldericons];
  2554. f.NofNodes := TVNofNodes;
  2555. f.Child := TVChild;
  2556. f.Parent := TVParent;
  2557. f.Next := TVNext;
  2558. f.Select := TVSelect;
  2559. f.Selected := TVSelected;
  2560. f.SetExpansion := TVSetExpansion;
  2561. frame := f
  2562. END GetNewFrame;
  2563. PROCEDURE (c: TreeControl) UpdateList (f: Views.Frame);
  2564. BEGIN
  2565. f(StdCFrames.Frame).UpdateList()
  2566. END UpdateList;
  2567. PROCEDURE (c: TreeControl) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  2568. BEGIN
  2569. WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
  2570. END Restore;
  2571. PROCEDURE (c: TreeControl) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
  2572. VAR focus: Views.View);
  2573. BEGIN
  2574. WITH f: StdCFrames.TreeFrame DO
  2575. IF ~c.disabled & ~c.readOnly THEN
  2576. WITH msg: Controllers.EditMsg DO
  2577. IF (msg.op = Controllers.pasteChar) THEN
  2578. f.KeyDown(msg.char)
  2579. END
  2580. ELSE
  2581. CatchCtrlMsg(c, f, msg, focus)
  2582. END
  2583. ELSIF ~c.disabled THEN
  2584. WITH msg: Controllers.TrackMsg DO
  2585. f.MouseDown(msg.x, msg.y, msg.modifiers)
  2586. ELSE
  2587. END
  2588. END
  2589. END
  2590. END HandleCtrlMsg2;
  2591. PROCEDURE (c: TreeControl) HandlePropMsg2 (VAR msg: Properties.Message);
  2592. BEGIN
  2593. WITH msg: Properties.ControlPref DO
  2594. IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
  2595. IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) OR msg.getFocus THEN
  2596. msg.getFocus := StdCFrames.setFocus
  2597. END
  2598. | msg: Properties.FocusPref DO
  2599. IF ~c.disabled & ~c.readOnly THEN
  2600. msg.setFocus := TRUE
  2601. ELSIF~c.disabled THEN
  2602. msg.hotFocus := TRUE
  2603. END
  2604. | msg: Properties.SizePref DO
  2605. StdCFrames.dir.GetTreeFrameSize(msg.w, msg.h)
  2606. | msg: PropPref DO
  2607. msg.valid := {link, label, guard, notifier, sorted, haslines, hasbuttons, atroot, foldericons}
  2608. | msg: Properties.ResizePref DO
  2609. msg.horFitToWin := TRUE; msg.verFitToWin := TRUE
  2610. ELSE
  2611. END
  2612. END HandlePropMsg2;
  2613. PROCEDURE (c: TreeControl) CheckLink (VAR ok: BOOLEAN);
  2614. VAR name: Meta.Name;
  2615. BEGIN
  2616. GetTypeName(c.item, name);
  2617. ok := name = "Tree"
  2618. END CheckLink;
  2619. PROCEDURE (c: TreeControl) Update (f: Views.Frame; op, from, to: INTEGER);
  2620. BEGIN
  2621. f(StdCFrames.Frame).Update
  2622. END Update;
  2623. (* StdDirectory *)
  2624. PROCEDURE (d: StdDirectory) NewPushButton (p: Prop): Control;
  2625. VAR c: PushButton;
  2626. BEGIN
  2627. NEW(c); OpenLink(c, p); RETURN c
  2628. END NewPushButton;
  2629. PROCEDURE (d: StdDirectory) NewCheckBox (p: Prop): Control;
  2630. VAR c: CheckBox;
  2631. BEGIN
  2632. NEW(c); OpenLink(c, p); RETURN c
  2633. END NewCheckBox;
  2634. PROCEDURE (d: StdDirectory) NewRadioButton (p: Prop): Control;
  2635. VAR c: RadioButton;
  2636. BEGIN
  2637. NEW(c); OpenLink(c, p); RETURN c
  2638. END NewRadioButton;
  2639. PROCEDURE (d: StdDirectory) NewField (p: Prop): Control;
  2640. VAR c: Field;
  2641. BEGIN
  2642. NEW(c); OpenLink(c, p); RETURN c
  2643. END NewField;
  2644. PROCEDURE (d: StdDirectory) NewUpDownField (p: Prop): Control;
  2645. VAR c: UpDownField;
  2646. BEGIN
  2647. NEW(c); OpenLink(c, p); RETURN c
  2648. END NewUpDownField;
  2649. PROCEDURE (d: StdDirectory) NewDateField (p: Prop): Control;
  2650. VAR c: DateField;
  2651. BEGIN
  2652. NEW(c); OpenLink(c, p); RETURN c
  2653. END NewDateField;
  2654. PROCEDURE (d: StdDirectory) NewTimeField (p: Prop): Control;
  2655. VAR c: TimeField;
  2656. BEGIN
  2657. NEW(c); OpenLink(c, p); RETURN c
  2658. END NewTimeField;
  2659. PROCEDURE (d: StdDirectory) NewColorField (p: Prop): Control;
  2660. VAR c: ColorField;
  2661. BEGIN
  2662. NEW(c); OpenLink(c, p); RETURN c
  2663. END NewColorField;
  2664. PROCEDURE (d: StdDirectory) NewListBox (p: Prop): Control;
  2665. VAR c: ListBox;
  2666. BEGIN
  2667. NEW(c); OpenLink(c, p); RETURN c
  2668. END NewListBox;
  2669. PROCEDURE (d: StdDirectory) NewSelectionBox (p: Prop): Control;
  2670. VAR c: SelectionBox;
  2671. BEGIN
  2672. NEW(c); OpenLink(c, p); RETURN c
  2673. END NewSelectionBox;
  2674. PROCEDURE (d: StdDirectory) NewComboBox (p: Prop): Control;
  2675. VAR c: ComboBox;
  2676. BEGIN
  2677. NEW(c); OpenLink(c, p); RETURN c
  2678. END NewComboBox;
  2679. PROCEDURE (d: StdDirectory) NewCaption (p: Prop): Control;
  2680. VAR c: Caption;
  2681. BEGIN
  2682. NEW(c); OpenLink(c, p); RETURN c
  2683. END NewCaption;
  2684. PROCEDURE (d: StdDirectory) NewGroup (p: Prop): Control;
  2685. VAR c: Group;
  2686. BEGIN
  2687. NEW(c); OpenLink(c, p); RETURN c
  2688. END NewGroup;
  2689. PROCEDURE (d: StdDirectory) NewTreeControl (p: Prop): Control;
  2690. VAR c: TreeControl;
  2691. BEGIN
  2692. NEW(c); OpenLink(c, p); RETURN c
  2693. END NewTreeControl;
  2694. PROCEDURE SetDir* (d: Directory);
  2695. BEGIN
  2696. ASSERT(d # NIL, 20); dir := d
  2697. END SetDir;
  2698. PROCEDURE InitProp (VAR p: Prop);
  2699. BEGIN
  2700. NEW(p);
  2701. p.link := ""; p.label := ""; p.guard := ""; p.notifier := "";
  2702. p.level := 0;
  2703. p.opt[0] := FALSE; p.opt[1] := FALSE;
  2704. p.opt[2] := FALSE; p.opt[3] := FALSE;
  2705. p.opt[4] := FALSE
  2706. END InitProp;
  2707. PROCEDURE DepositPushButton*;
  2708. VAR p: Prop;
  2709. BEGIN
  2710. InitProp(p);
  2711. p.label := "#System:untitled";
  2712. Views.Deposit(dir.NewPushButton(p))
  2713. END DepositPushButton;
  2714. PROCEDURE DepositCheckBox*;
  2715. VAR p: Prop;
  2716. BEGIN
  2717. InitProp(p);
  2718. p.label := "#System:untitled";
  2719. Views.Deposit(dir.NewCheckBox(p))
  2720. END DepositCheckBox;
  2721. PROCEDURE DepositRadioButton*;
  2722. VAR p: Prop;
  2723. BEGIN
  2724. InitProp(p);
  2725. p.label := "#System:untitled";
  2726. Views.Deposit(dir.NewRadioButton(p))
  2727. END DepositRadioButton;
  2728. PROCEDURE DepositField*;
  2729. VAR p: Prop;
  2730. BEGIN
  2731. InitProp(p); p.opt[left] := TRUE;
  2732. Views.Deposit(dir.NewField(p))
  2733. END DepositField;
  2734. PROCEDURE DepositUpDownField*;
  2735. VAR p: Prop;
  2736. BEGIN
  2737. InitProp(p);
  2738. Views.Deposit(dir.NewUpDownField(p))
  2739. END DepositUpDownField;
  2740. PROCEDURE DepositDateField*;
  2741. VAR p: Prop;
  2742. BEGIN
  2743. InitProp(p);
  2744. Views.Deposit(dir.NewDateField(p))
  2745. END DepositDateField;
  2746. PROCEDURE DepositTimeField*;
  2747. VAR p: Prop;
  2748. BEGIN
  2749. InitProp(p);
  2750. Views.Deposit(dir.NewTimeField(p))
  2751. END DepositTimeField;
  2752. PROCEDURE DepositColorField*;
  2753. VAR p: Prop;
  2754. BEGIN
  2755. InitProp(p);
  2756. Views.Deposit(dir.NewColorField(p))
  2757. END DepositColorField;
  2758. PROCEDURE DepositListBox*;
  2759. VAR p: Prop;
  2760. BEGIN
  2761. InitProp(p);
  2762. Views.Deposit(dir.NewListBox(p))
  2763. END DepositListBox;
  2764. PROCEDURE DepositSelectionBox*;
  2765. VAR p: Prop;
  2766. BEGIN
  2767. InitProp(p);
  2768. Views.Deposit(dir.NewSelectionBox(p))
  2769. END DepositSelectionBox;
  2770. PROCEDURE DepositComboBox*;
  2771. VAR p: Prop;
  2772. BEGIN
  2773. InitProp(p);
  2774. Views.Deposit(dir.NewComboBox(p))
  2775. END DepositComboBox;
  2776. PROCEDURE DepositCancelButton*;
  2777. VAR p: Prop;
  2778. BEGIN
  2779. InitProp(p);
  2780. p.link := "StdCmds.CloseDialog"; p.label := "#System:Cancel"; p.opt[cancel] := TRUE;
  2781. Views.Deposit(dir.NewPushButton(p))
  2782. END DepositCancelButton;
  2783. PROCEDURE DepositCaption*;
  2784. VAR p: Prop;
  2785. BEGIN
  2786. InitProp(p); p.opt[left] := TRUE;
  2787. p.label := "#System:Caption";
  2788. Views.Deposit(dir.NewCaption(p))
  2789. END DepositCaption;
  2790. PROCEDURE DepositGroup*;
  2791. VAR p: Prop;
  2792. BEGIN
  2793. InitProp(p);
  2794. p.label := "#System:Caption";
  2795. Views.Deposit(dir.NewGroup(p))
  2796. END DepositGroup;
  2797. PROCEDURE DepositTreeControl*;
  2798. VAR p: Prop;
  2799. BEGIN
  2800. InitProp(p);
  2801. p.opt[haslines] := TRUE; p.opt[hasbuttons] := TRUE; p.opt[atroot] := TRUE; p.opt[foldericons] := TRUE;
  2802. Views.Deposit(dir.NewTreeControl(p))
  2803. END DepositTreeControl;
  2804. PROCEDURE Relink*;
  2805. VAR msg: UpdateCachesMsg;
  2806. BEGIN
  2807. INC(stamp);
  2808. Views.Omnicast(msg)
  2809. END Relink;
  2810. PROCEDURE Init;
  2811. VAR d: StdDirectory;
  2812. BEGIN
  2813. par := NIL; stamp := 0;
  2814. NEW(d); stdDir := d; dir := d;
  2815. NEW(cleaner); cleanerInstalled := 0
  2816. END Init;
  2817. (* check guards action *)
  2818. PROCEDURE (a: Action) Do;
  2819. VAR msg: Views.NotifyMsg;
  2820. BEGIN
  2821. IF Windows.dir # NIL THEN
  2822. IF a.w # NIL THEN
  2823. INC(a.cnt);
  2824. msg.id0 := 0; msg.id1 := 0; msg.opts := {guardCheck};
  2825. IF a.w.seq # NIL THEN a.w.seq.Handle(msg) END;
  2826. a.w := Windows.dir.Next(a.w);
  2827. WHILE (a.w # NIL) & a.w.sub DO a.w := Windows.dir.Next(a.w) END
  2828. ELSE
  2829. IF a.cnt = 0 THEN a.resolution := Services.resolution
  2830. ELSE a.resolution := Services.resolution DIV a.cnt DIV 2
  2831. END;
  2832. a.cnt := 0;
  2833. a.w := Windows.dir.First();
  2834. WHILE (a.w # NIL) & a.w.sub DO a.w := Windows.dir.Next(a.w) END
  2835. END
  2836. END;
  2837. Services.DoLater(a, Services.Ticks() + a.resolution)
  2838. END Do;
  2839. BEGIN
  2840. Init;
  2841. NEW(action); action.w := NIL; action.cnt := 0; Services.DoLater(action, Services.now)
  2842. CLOSE
  2843. Services.RemoveAction(action)
  2844. END Controls.