WMComponents.Mod 122 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717
  1. MODULE WMComponents; (** AUTHOR "TF"; PURPOSE "Component Framework based on XML"; *)
  2. (**
  3. -- Events: --
  4. Each VisualComponent can produce keyboard and mouse events which can trigger A2 commands.
  5. The command string for a given event can by specified by the usage of XML attributes and component properties.
  6. The following attributes are defined:
  7. Keyboard: onReturn, onEscape, onKeyPressed, onKeyReleased
  8. Mouse: onLeftClick, onRightClick, onMiddleClick, onClick
  9. The command strings are processed (macro substitution) before the actual command is called.
  10. -- Macro substitution: --
  11. General form: "^" [namespace ":"] macrostring
  12. A macro always start with MacroCharacter ("^"). The next occurence of a whitespace character determines the end of the macro.
  13. Two consequent MacroCharacter's ("^^") will be replaced by the MacroCharacter ("^") not triggering macro substitution at all.
  14. The user can install MacroHandlerProcedures for a given namespace. At most one handler per namespace can be installed.
  15. If the namespace is omitted, the default macro handler is triggered.
  16. The DefaultMacroHandler currently supports the following macro substitutions:
  17. ^selection is replaced by the last selection of the user
  18. ^clipboard is replaced by the content of the clipboard
  19. ^attribute=[component "."] attribute
  20. ^property=[component "."] property
  21. is replaced by the value of <attribute> or <property>.
  22. If the component qualifier is omitted, <attribute> or <property> is supposed to be an attribute or property of the originator of the event.
  23. If no MacroHandlerProcedure is found for a given macro, no substitution takes place.
  24. Example:
  25. onLeftClick = SystemTools.Show ^attribute=generator
  26. onMiddleClick = SystemTools.Show ^property=FillColor
  27. *)
  28. (*PH 08/14:
  29. - avoid parallel call of FormWindow.SetContent, Component.AddContent, Form.InvalidateRect by different processes, through use of EXCLUSIVE sections.
  30. - send an "invalidate content" message to a window after it appears on the display, which is handled after "form" field is ready
  31. - restructure FormWindow.SetContent() to assure coherent displays and to assure FormWindow.content is consistent
  32. *)
  33. IMPORT
  34. KernelLog, Inputs, Streams, Events, Files, Texts, TextUtilities,
  35. XML, XMLScanner, XMLParser, XMLObjects, Codecs, Localization, Repositories,
  36. Messages := WMMessages, Rectangles := WMRectangles,
  37. WMEvents, WMProperties, WMGraphics, Strings, WM := WMWindowManager, Raster,
  38. Commands, Modules, Kernel, Locks, Objects, WMDropTarget;
  39. CONST
  40. Ok* = 0;
  41. DuplicateNamespace* = 1;
  42. AlignNone* = 0; AlignLeft* = 1; AlignTop* = 2; AlignRight* = 3; AlignBottom* = 4; AlignClient* = 5; AlignRelative*=6;
  43. None=0; Left=1; Right=2; Lower=3; Upper=4; LowerRight=5; UpperRight=6; LowerLeft=7; UpperLeft=8; Inside = 9;
  44. MaxRel = 16*1024;
  45. MaxComponentNameSize* = 64; (* including 0X *)
  46. TraceFocus = 0;
  47. TraceFinalize = 1;
  48. Trace = {};
  49. (* Enable event logging? *)
  50. Logging = TRUE;
  51. (* Macro handling *)
  52. (* General form of macro: MacroCharacter [Namespace + NamespaceCharacter] MacroName *)
  53. MacroCharacter = "^";
  54. NamespaceCharacter = ":";
  55. NoNamespace = "";
  56. (* Namespace used if no namespace is specified *)
  57. DefaultNamespace = "system";
  58. (* Macros names of default macro handler *)
  59. MacroSelection = "selection";
  60. MacroClipboard = "clipboard";
  61. MacroAttributePrefix = "attribute=";
  62. MacroPropertyPrefix = "property=";
  63. CanYield = TRUE;
  64. (*temporary - to be removed*)
  65. FlagDirty=13;
  66. TYPE
  67. (** Installable event preview handlers. Are called by the components sequencer thread *)
  68. PointerHandler* = PROCEDURE {DELEGATE} (x, y : LONGINT; keys : SET; VAR handled : BOOLEAN);
  69. PointerLeaveHandler* = PROCEDURE {DELEGATE} (VAR handled : BOOLEAN);
  70. DragDropHandler* = PROCEDURE {DELEGATE} (x, y : LONGINT; dragInfo : WM.DragInfo; VAR handled : BOOLEAN);
  71. DragResultHandler* = PROCEDURE {DELEGATE} (accepted : BOOLEAN; recipient : ANY; dragInfo : WM.DragInfo; VAR handled : BOOLEAN);
  72. DragAutoStartHandler* = PROCEDURE {DELEGATE} (VAR handled : BOOLEAN);
  73. FocusHandler* = PROCEDURE {DELEGATE} (hasFocus : BOOLEAN);
  74. ContextMenuHandler* = PROCEDURE {DELEGATE} (sender : ANY; x, y: LONGINT);
  75. KeyEventHandler* = PROCEDURE {DELEGATE} (ucs : LONGINT; flags : SET; VAR keySym : LONGINT; VAR handled : BOOLEAN);
  76. DrawHandler* = PROCEDURE {DELEGATE} (canvas : WMGraphics.Canvas);
  77. Recursion*= ENUM None*, FromComponent*, FromBottom* END;
  78. TYPE
  79. SetStringProcedure = PROCEDURE {DELEGATE} (CONST string : ARRAY OF CHAR; x,y : LONGINT; VAR res : LONGINT);
  80. DropTarget = OBJECT(WMDropTarget.DropTarget)
  81. VAR
  82. originator : ANY;
  83. setString : SetStringProcedure;
  84. x,y : LONGINT;
  85. PROCEDURE &Init(originator : ANY; setString : SetStringProcedure; x,y : LONGINT);
  86. BEGIN
  87. ASSERT(setString # NIL);
  88. SELF.originator := originator;
  89. SELF.setString := setString;
  90. SELF.x := x;
  91. SELF.y := y;
  92. END Init;
  93. PROCEDURE GetInterface(type : LONGINT) : WMDropTarget.DropInterface;
  94. VAR sdi : DropString;
  95. BEGIN
  96. IF (type = WMDropTarget.TypeString) THEN
  97. NEW(sdi, originator, setString, x,y); RETURN sdi;
  98. ELSE
  99. RETURN NIL;
  100. END;
  101. END GetInterface;
  102. END DropTarget;
  103. DropString = OBJECT(WMDropTarget.DropString)
  104. VAR
  105. originator : ANY;
  106. setString : SetStringProcedure;
  107. x,y : LONGINT;
  108. PROCEDURE &Init(originator : ANY; setString : SetStringProcedure; x,y : LONGINT);
  109. BEGIN
  110. ASSERT(setString # NIL);
  111. SELF.originator := originator;
  112. SELF.setString := setString;
  113. SELF.x := x; SELF.y := y;
  114. END Init;
  115. PROCEDURE Set(CONST string : ARRAY OF CHAR; VAR res : LONGINT);
  116. BEGIN
  117. setString(string, x,y, res);
  118. END Set;
  119. END DropString;
  120. LanguageExtension* = POINTER TO RECORD(Messages.MessageExtension)
  121. languages* : Localization.Languages;
  122. END;
  123. ToggleEditMode* = POINTER TO RECORD
  124. recursion*: Recursion;
  125. END;
  126. Event* = RECORD
  127. END;
  128. KeyPressedEvent* = RECORD(Event)
  129. ucs- : LONGINT;
  130. flags- : SET;
  131. keysym- : LONGINT;
  132. END;
  133. PointerEvent* = RECORD(Event)
  134. x-, y-, z- : LONGINT;
  135. keys- : SET;
  136. END;
  137. EventContext* = OBJECT(Repositories.Context)
  138. VAR
  139. originator- : Component; (** {originator # NIL} *)
  140. command- : Strings.String; (** {command # NIL}, immutable *)
  141. timestamp- : LONGINT;
  142. PROCEDURE &New*(originator : Component; command : Strings.String; in, arg : Streams.Reader; out, error : Streams.Writer; caller : OBJECT);
  143. BEGIN
  144. ASSERT((originator # NIL) & (command # NIL));
  145. SELF.originator := originator;
  146. SELF.command := command;
  147. Init(in, arg, out, error, caller);
  148. END New;
  149. END EventContext;
  150. PointerContext* = OBJECT(EventContext)
  151. VAR
  152. pointer- : PointerEvent;
  153. END PointerContext;
  154. KeyContext* = OBJECT(EventContext)
  155. VAR
  156. key- : KeyPressedEvent;
  157. END KeyContext;
  158. TYPE
  159. (** Basic component *)
  160. ComponentStyleChanged = OBJECT
  161. END ComponentStyleChanged;
  162. Component* = OBJECT(Repositories.Component)
  163. VAR
  164. sequencer- : Messages.MsgSequencer;
  165. initialized- : BOOLEAN;
  166. properties- : WMProperties.PropertyList;
  167. events- : WMEvents.EventSourceList;
  168. eventListeners- : WMEvents.EventListenerList;
  169. id-, uid- : WMProperties.StringProperty;
  170. enabled- : WMProperties.BooleanProperty;
  171. (* discard property changes that come from a property change within the same component*)
  172. inPropertyUpdate, inLinkUpdate : BOOLEAN;
  173. (* If TRUE, this component is supposed to be created and managed by its parent. It is not externalized. *)
  174. internal- : BOOLEAN;
  175. (* after Init() , calling Reset() implicitely by insertion into FormWindow or explicitely, thereby triggering Initialize() is required to render component responsive to messages *)
  176. PROCEDURE &Init*;
  177. BEGIN
  178. Init^;
  179. SetNameAsString(StrComponent);
  180. sequencer := NIL;
  181. initialized := FALSE;
  182. NEW(properties); properties.onPropertyChanged.Add(SELF.InternalPropertyChanged); properties.onLinkChanged.Add(SELF.InternalLinkChanged);
  183. NEW(events);
  184. NEW(eventListeners);
  185. NEW(id, PrototypeID, NIL, NIL); properties.Add(id);
  186. NEW(uid, PrototypeUID, NIL, NIL); properties.Add(uid);
  187. NEW(enabled, PrototypeEnabled, NIL, NIL); properties.Add(enabled);
  188. inPropertyUpdate := FALSE;
  189. inLinkUpdate := FALSE;
  190. internal := FALSE;
  191. SetGenerator("WMComponents.NewComponent");
  192. END Init;
  193. PROCEDURE Write*(w : Streams.Writer;context: ANY; level : LONGINT);
  194. VAR enum: XMLObjects.Enumerator; c: ANY; name : Strings.String; nextLevel : LONGINT;
  195. BEGIN
  196. IF IsLocked() THEN (* D.String("Component.Write: islocked"); D.Ln; *) RETURN; END;
  197. IF ~internal THEN
  198. name := GetName();
  199. w.Char('<'); IF name = NIL THEN w.String("_NILNAME_") ELSE w.String(name^) END;
  200. WriteAttributes(w, context, level);
  201. w.Char('>');
  202. properties.WriteXML(w, context, level);
  203. nextLevel := level + 1;
  204. ELSE
  205. (* D.String("Component.Write: isInternal"); D.Ln; *)
  206. nextLevel := level;
  207. END;
  208. enum := GetContents();
  209. WHILE enum.HasMoreElements() DO
  210. c := enum.GetNext();
  211. IF ~(c IS WMProperties.Properties) THEN
  212. IF ~((c IS Component) & ((c(Component).internal) OR c(Component).IsLocked())) THEN NewLine(w, 0); NewLine(w, nextLevel); END;
  213. c(XML.Content).Write(w, context, nextLevel);
  214. (*c(Component).Write(w, context, nextLevel)*)
  215. END;
  216. END;
  217. IF ~internal THEN
  218. NewLine(w, level);
  219. w.String("</"); IF name = NIL THEN w.String("_NILNAME_") ELSE w.String(name^); END; w.Char('>')
  220. END;
  221. END Write;
  222. (*
  223. PROCEDURE ToRepository*(CONST repository: ARRAY OF CHAR; w: Streams.Writer; level: LONGINT);
  224. VAR enum: XMLObjects.Enumerator; c: ANY; name : Strings.String; nextLevel : LONGINT;
  225. BEGIN
  226. IF IsLocked() THEN RETURN; END;
  227. IF ~internal THEN
  228. name := GetName();
  229. w.Char('<'); IF name = NIL THEN w.String("_NILNAME_") ELSE w.String(name^) END;
  230. WriteAttributes(w, NIL, level);
  231. w.Char('>');
  232. properties.ToRepository(repository,w, level);
  233. nextLevel := level + 1;
  234. ELSE
  235. nextLevel := level;
  236. END;
  237. enum := GetContents();
  238. WHILE enum.HasMoreElements() DO
  239. c := enum.GetNext();
  240. IF ~(c IS WMProperties.Properties) THEN
  241. IF ~((c IS Component) & ((c(Component).internal) OR c(Component).IsLocked())) THEN NewLine(w, 0); NewLine(w, nextLevel); END;
  242. IF (c IS Repositories.Component) THEN
  243. c(Repositories.Component).ToRepository(repository, w, level);
  244. ELSE
  245. c(XML.Content).Write(w, NIL, nextLevel);
  246. END;
  247. END;
  248. END;
  249. IF ~internal THEN
  250. NewLine(w, level);
  251. w.String("</"); IF name = NIL THEN w.String("_NILNAME_") ELSE w.String(name^); END; w.Char('>')
  252. END;
  253. END ToRepository;
  254. *)
  255. PROCEDURE FromXML*(xml: XML.Element);
  256. VAR component: Component; enum: XMLObjects.Enumerator; c: ANY; element: XML.Element;
  257. BEGIN
  258. element := GetElementByName(xml,"Properties");
  259. IF (element = NIL) & (xml IS Component) THEN (* trick to get XML description of properties if not already there (new components) *)
  260. xml(Component).properties.ToXML(element)
  261. END;
  262. properties.FromXML(element);
  263. (* was: supercall to Repositories *)
  264. enum := xml.GetContents();
  265. WHILE enum.HasMoreElements() DO
  266. c := enum.GetNext();
  267. IF c IS XML.Element THEN
  268. IF ~(c IS Component) OR ~c(Component).internal THEN
  269. component := ComponentFromXML(c(XML.Element));
  270. IF component # NIL THEN
  271. AddContent(component)
  272. END;
  273. END;
  274. END;
  275. END;
  276. enum :=xml.GetAttributes();
  277. WHILE enum.HasMoreElements() DO
  278. c := enum.GetNext();
  279. IF c(XML.Attribute).GetName()^ # "generator" THEN
  280. SetAttributeValue(c(XML.Attribute).GetName()^, c(XML.Attribute).GetValue()^);
  281. END;
  282. END;
  283. (*Initialize;*) (* redundant *)
  284. END FromXML;
  285. PROCEDURE IsCallFromSequencer*():BOOLEAN;
  286. BEGIN
  287. ASSERT (sequencer # NIL);
  288. RETURN sequencer.IsCallFromSequencer()
  289. END IsCallFromSequencer;
  290. PROCEDURE AssertLock*;
  291. BEGIN
  292. ASSERT((sequencer = NIL) OR sequencer.IsCallFromSequencer() OR sequencer.lock.HasReadLock())
  293. END AssertLock;
  294. (** Atomically set the components sequencer *)
  295. PROCEDURE SetSequencer*(s : Messages.MsgSequencer);
  296. VAR old : Messages.MsgSequencer; c : XML.Content;
  297. BEGIN
  298. old := sequencer;
  299. IF old # NIL THEN old.lock.AcquireWrite() END;
  300. sequencer := s;
  301. c := GetFirst();
  302. WHILE (c # NIL) DO
  303. IF c IS Component THEN c(Component).SetSequencer(s); END; (*? what happens to old sequencers/active objects ?*)
  304. c := GetNext(c);
  305. END;
  306. IF old # NIL THEN old.lock.ReleaseWrite() END
  307. END SetSequencer;
  308. PROCEDURE Acquire*;
  309. BEGIN
  310. IF sequencer # NIL THEN sequencer.lock.AcquireWrite END
  311. END Acquire;
  312. PROCEDURE Release*;
  313. BEGIN
  314. IF sequencer # NIL THEN sequencer.lock.ReleaseWrite END
  315. END Release;
  316. PROCEDURE CheckReadLock*;
  317. BEGIN
  318. IF (sequencer # NIL) & (~sequencer.lock.HasReadLock()) THEN
  319. KernelLog.String("WMComponents.Component.CheckReadLock: FAILED!"); KernelLog.Ln;
  320. sequencer.lock.WriteLock
  321. END;
  322. IF sequencer # NIL THEN ASSERT(sequencer.lock.HasReadLock()) END
  323. END CheckReadLock;
  324. (** AddContent adds a content (element or subtree) to the element. Called mainly by the XMLParser.
  325. *)
  326. PROCEDURE AddContent*(c : XML.Content);
  327. VAR m:Messages.Message; rect:Rectangles.Rectangle;
  328. BEGIN
  329. ASSERT(c # NIL);
  330. Acquire;
  331. BEGIN {EXCLUSIVE}
  332. IF c IS WMProperties.Properties THEN
  333. properties.SetXML(c(WMProperties.Properties));
  334. ELSIF c IS Component THEN
  335. IF (sequencer # c(Component).sequencer) THEN
  336. IF sequencer#NIL THEN
  337. c(Component).SetSequencer(sequencer);
  338. c(Component).Reset(SELF,NIL); (* will be scheduled by sequencer. implied RecacheProperties*)
  339. IF (SELF IS VisualComponent) & ( c IS VisualComponent) THEN (* todo: move to VisualComponent*)
  340. sequencer.ScheduleEvent(SELF(VisualComponent).InvalidateCommand, SELF, NIL);
  341. END;
  342. ELSE (* no tree traversal - is less costly *)
  343. c(Component).sequencer:=NIL;
  344. c(Component).initialized:=FALSE; (*? is this necessary/correct ?*)
  345. END;
  346. END;
  347. ELSIF ~(c IS XML.Comment) THEN
  348. Release; RETURN
  349. END;
  350. END;
  351. (*Acquire;*)
  352. AddContent^(c);
  353. Release;
  354. END AddContent;
  355. PROCEDURE RemoveContent*(c : XML.Content);
  356. BEGIN
  357. (*ASSERT(c # NIL);*)
  358. IF c = NIL THEN RETURN END;
  359. Acquire;
  360. RemoveContent^(c);
  361. Release;
  362. END RemoveContent;
  363. (** Add internal component. Internal components are supposed to be created and managed by its parent component.
  364. Internal components and their subcomponents are not externalized *)
  365. PROCEDURE AddInternalComponent*(component : Component);
  366. BEGIN
  367. IF (component # NIL) THEN
  368. component.internal := TRUE;
  369. AddContent(component);
  370. END;
  371. END AddInternalComponent;
  372. (** Return the root element of the component hierarchy. This is not necessarily the same as the
  373. root element of XML since it is possible to have multiple component hierarchies in an XML file *)
  374. PROCEDURE GetComponentRoot*(): Component;
  375. VAR p, c : XML.Element;
  376. BEGIN
  377. c := SELF;
  378. LOOP
  379. p := c.GetParent();
  380. IF (p # NIL) & (p IS Component) THEN c := p ELSE RETURN c(Component) END
  381. END
  382. END GetComponentRoot;
  383. PROCEDURE Find*(id : ARRAY OF CHAR) : Component;
  384. VAR
  385. root, component : Component;
  386. PROCEDURE IsUID(CONST id : ARRAY OF CHAR) : BOOLEAN;
  387. BEGIN
  388. RETURN id[0] = "&";
  389. END IsUID;
  390. PROCEDURE RemoveAmpersand(VAR id : ARRAY OF CHAR);
  391. VAR i : LONGINT;
  392. BEGIN
  393. ASSERT(id[0] = "&");
  394. FOR i := 0 TO LEN(id)-2 DO
  395. id[i] := id[i + 1];
  396. END;
  397. END RemoveAmpersand;
  398. BEGIN
  399. component := NIL;
  400. IF IsUID(id) THEN
  401. RemoveAmpersand(id);
  402. root := GetComponentRoot();
  403. component := root.FindByUID(id);
  404. ELSE
  405. component := FindByPath(id, 0);
  406. END;
  407. RETURN component;
  408. END Find;
  409. (** Find a sub component by its uid *)
  410. PROCEDURE FindByUID*(CONST uid : ARRAY OF CHAR) : Component;
  411. VAR c : XML.Content; result : Component; s : Strings.String;
  412. BEGIN
  413. IF (uid = "") THEN RETURN NIL END;
  414. s := SELF.uid.Get();
  415. IF (s # NIL) & (s^ = uid) THEN
  416. RETURN SELF
  417. ELSE
  418. result := NIL;
  419. Acquire;
  420. c := GetFirst();
  421. WHILE (result = NIL) & (c # NIL) DO
  422. IF (c IS Component) THEN result := c(Component).FindByUID(uid) END;
  423. c := GetNext(c);
  424. END;
  425. Release;
  426. RETURN result
  427. END
  428. END FindByUID;
  429. (** find a component by relative path *)
  430. PROCEDURE FindByPath*(CONST path : ARRAY OF CHAR; pos : LONGINT) : Component;
  431. VAR component : Component;
  432. BEGIN
  433. Acquire;
  434. component := FindRelativePath(SELF, path, pos);
  435. Release;
  436. RETURN component;
  437. END FindByPath;
  438. PROCEDURE StringToComponent*(str : Strings.String) : Component;
  439. VAR
  440. id : ARRAY 100 OF CHAR;
  441. isUID : BOOLEAN;
  442. ch : CHAR;
  443. sr : Streams.StringReader;
  444. r, target : Component;
  445. BEGIN
  446. NEW(sr, LEN(str)); sr.Set(str^);
  447. isUID := FALSE; IF sr.Peek() = "%" THEN isUID := TRUE; ch := sr.Get() END;
  448. sr.Token(id);
  449. IF isUID THEN r := GetComponentRoot(); target := r.FindByUID(id);
  450. IF target = NIL THEN KernelLog.String("StringToComponent : UID target not found: "); KernelLog.String(id); KernelLog.Ln; END
  451. ELSE target := FindByPath(id, 0);
  452. IF target = NIL THEN KernelLog.String("StringToComponent : Path target not found: "); KernelLog.String(id); KernelLog.Ln; END
  453. END;
  454. RETURN target
  455. END StringToComponent;
  456. (** Search a CompCommand by string *)
  457. PROCEDURE StringToCompCommand*(eventstr : Strings.String) : WMEvents.EventListener;
  458. VAR
  459. id, name : ARRAY 100 OF CHAR;
  460. isUID : BOOLEAN;
  461. ch : CHAR;
  462. sr : Streams.StringReader;
  463. r, target : Component;
  464. BEGIN
  465. NEW(sr, LEN(eventstr)); sr.Set(eventstr^);
  466. isUID := FALSE; IF sr.Peek() = "%" THEN isUID := TRUE; ch := sr.Get() END;
  467. sr.Token(id); sr.SkipWhitespace; sr.Token(name);
  468. IF isUID THEN r := GetComponentRoot(); target := r.FindByUID(id);
  469. IF target = NIL THEN KernelLog.String("StringToEvent : UID target not found: "); KernelLog.String(id); KernelLog.Ln; END
  470. ELSE target := FindByPath(id, 0);
  471. IF target = NIL THEN KernelLog.String("StringToEvent : Path target not found: "); KernelLog.String(id); KernelLog.Ln; END
  472. END;
  473. IF target # NIL THEN RETURN target.eventListeners.GetHandlerByName(NewString(name))
  474. ELSE RETURN NIL
  475. END
  476. END StringToCompCommand;
  477. (** The Finalize Method is asynchronous since queuing could result in modules being freed before finalize ispropagated..
  478. Active components should terminate, external resources should be released *)
  479. PROCEDURE Finalize*; (** PROTECTED *)
  480. VAR c : XML.Content;
  481. BEGIN
  482. IF TraceFinalize IN Trace THEN IF uid # NIL THEN (* KernelLog.String(uid.string) *) KernelLog.String(".Finalize") END END;
  483. Acquire;
  484. c := GetFirst();
  485. WHILE (c # NIL) DO
  486. IF (c IS Component) THEN c(Component).Finalize END;
  487. c := GetNext(c);
  488. END;
  489. properties.Finalize;
  490. Release;
  491. END Finalize;
  492. (* reset/initialize a hierarchy of components *)
  493. PROCEDURE Reset*(sender, data : ANY); (** PROTECTED *)
  494. VAR c : XML.Content;
  495. BEGIN
  496. IF ~IsCallFromSequencer() THEN
  497. sequencer.ScheduleEvent(SELF.Reset, sender, data);
  498. IF CanYield THEN Objects.Yield END;
  499. ELSE
  500. BEGIN
  501. RecacheProperties;
  502. c := GetFirst();
  503. WHILE (c # NIL) DO
  504. IF c IS Component THEN
  505. c(Component).Reset(sender, data)
  506. END;
  507. c := GetNext(c);
  508. END;
  509. IF ~initialized THEN Initialize END; (*component is ready when children are ready *)
  510. END;
  511. END
  512. END Reset;
  513. (* Initialize is called by Reset() and is required to render components responsive *)
  514. PROCEDURE Initialize*; (** PROTECTED *)
  515. BEGIN
  516. BEGIN{EXCLUSIVE}
  517. initialized := TRUE
  518. END;
  519. END Initialize;
  520. (** Internal interface of the message handler. This method may only be called via the Handle method.
  521. Components that need to handle messages should implement HandleInternal. *)
  522. PROCEDURE HandleInternal*(VAR msg : Messages.Message); (** PROTECTED *)
  523. VAR pa : WMProperties.PropertyArray; i : LONGINT;
  524. BEGIN
  525. ASSERT(IsCallFromSequencer());
  526. IF (msg.msgType = Messages.MsgSetLanguage) & (msg.ext # NIL) & (msg.ext IS LanguageExtension) THEN
  527. pa := properties.Enumerate();
  528. IF (pa # NIL) THEN
  529. FOR i := 0 TO LEN(pa) - 1 DO
  530. IF (pa[i] # NIL) & (pa[i] IS WMProperties.StringProperty) THEN
  531. pa[i](WMProperties.StringProperty).SetLanguage(msg.ext(LanguageExtension).languages);
  532. END;
  533. END;
  534. END;
  535. LanguageChanged(msg.ext(LanguageExtension).languages);
  536. BroadcastSubcomponents(msg);
  537. END;
  538. END HandleInternal;
  539. (** External interface to the message handler. Asynchronous messages are synchronized by
  540. the sequencer of the Container *)
  541. PROCEDURE Handle*(VAR msg : Messages.Message); (** FINAL *)
  542. VAR s : Strings.String;
  543. BEGIN
  544. (* if asynchronous call --> synchronize *)
  545. IF sequencer=NIL THEN RETURN
  546. ELSIF ~IsCallFromSequencer() THEN
  547. IF ~sequencer.Add(msg) THEN
  548. s := uid.Get();
  549. KernelLog.String("A message sent to ");
  550. IF s # NIL THEN KernelLog.String(s^) ELSE KernelLog.String(" <uid = NIL>") END;
  551. KernelLog.String(" was discarded")
  552. END;
  553. IF CanYield THEN Objects.Yield END (* give the sequencer an immediate chance to react -- important on single-processor machines *)
  554. ELSE HandleInternal(msg) END
  555. END Handle;
  556. (** Broadcast a message to all direct subcomponents. The subcomponent can then decide
  557. whether to further propagate the message to its children or not *)
  558. PROCEDURE BroadcastSubcomponents*(VAR msg : Messages.Message); (** FINAL *)
  559. VAR c : XML.Content;
  560. BEGIN
  561. Acquire;
  562. c := GetFirst();
  563. WHILE (c # NIL) DO
  564. IF c IS Component THEN c(Component).Handle(msg) END;
  565. c := GetNext(c);
  566. END;
  567. Release
  568. END BroadcastSubcomponents;
  569. (* not to be called from user *)
  570. PROCEDURE LanguageChanged*(languages : Localization.Languages);
  571. BEGIN
  572. ASSERT(languages # NIL);
  573. ASSERT(IsCallFromSequencer());
  574. END LanguageChanged;
  575. (* LinkChanged can be called to inform about changes of the state of links (i.e. objects in reference properties)
  576. Unlike PropertyChanged which informs about an actual replacement of the link *)
  577. PROCEDURE LinkChanged*(sender, link: ANY);
  578. BEGIN ASSERT(IsCallFromSequencer());
  579. END LinkChanged;
  580. (* will be called synchronously if a property of the component changes. May not be called directly.
  581. Call Invalidate in this procedure whenever a property changed that impacts the visualization.
  582. No such messages are sent until the component is initialized *)
  583. PROCEDURE PropertyChanged*(sender, property : ANY);(** PROTECTED *)
  584. BEGIN ASSERT(IsCallFromSequencer());
  585. END PropertyChanged;
  586. (** called by the internal property changed handler via the sequencer, either if multiple properties have
  587. changed or a Reset occured. The PropertyChanged method is called, too in case of multi-property changes
  588. The component should call the inherited RecacheProperties method.
  589. Do not call Invalidate in RecacheProperties, but rather in PropertyChanged(). *)
  590. PROCEDURE RecacheProperties*;
  591. BEGIN
  592. END RecacheProperties;
  593. PROCEDURE InternalPropertyChanged(sender, property : ANY);
  594. BEGIN
  595. IF ~initialized THEN RETURN END;
  596. IF ~IsCallFromSequencer() THEN
  597. sequencer.ScheduleEvent(SELF.InternalPropertyChanged, sender, property);
  598. IF CanYield THEN Objects.Yield END;
  599. ELSE
  600. IF ~inPropertyUpdate THEN
  601. inPropertyUpdate := TRUE;
  602. IF property = properties THEN RecacheProperties END;
  603. PropertyChanged(sender, property);
  604. inPropertyUpdate := FALSE
  605. END;
  606. END
  607. END InternalPropertyChanged;
  608. PROCEDURE InternalLinkChanged(sender, property : ANY);
  609. BEGIN
  610. IF ~initialized THEN RETURN END;
  611. IF ~IsCallFromSequencer() THEN
  612. sequencer.ScheduleEvent(SELF.InternalLinkChanged, sender, property);
  613. IF CanYield THEN Objects.Yield END;
  614. ELSE
  615. IF ~inLinkUpdate THEN
  616. inLinkUpdate := TRUE;
  617. LinkChanged(sender, property);
  618. inLinkUpdate := FALSE
  619. END;
  620. END
  621. END InternalLinkChanged;
  622. END Component;
  623. TYPE
  624. Macro* = ARRAY 128 OF CHAR;
  625. (** Installable macro handler procedure. {(originator # NIL) & (w # NIL)} *)
  626. MacroHandlerProcedure* = PROCEDURE {DELEGATE} (CONST macro : Macro; originator : Component; w : Streams.Writer; VAR handled : BOOLEAN);
  627. Namespace = ARRAY 16 OF CHAR;
  628. MacroHandler = POINTER TO RECORD
  629. handler : MacroHandlerProcedure;
  630. namespace : Namespace;
  631. next : MacroHandler;
  632. END;
  633. TYPE
  634. (** Basic visual component *)
  635. VisualComponent* = OBJECT(Component)
  636. VAR
  637. bounds-, bearing-, relativeBounds-: WMProperties.RectangleProperty;
  638. alignment- : WMProperties.Int32Property;
  639. fillColor- : WMProperties.ColorProperty;
  640. font- : WMProperties.FontProperty;
  641. scaleFont-: WMProperties.Int32Property;
  642. visible-, takesFocus-, needsTab-, editMode- : WMProperties.BooleanProperty;
  643. focusPrevious-, focusNext- : WMProperties.StringProperty;
  644. model- : WMProperties.ReferenceProperty;
  645. onStartDrag- : WMEvents.EventSource;
  646. canvasState- : WMGraphics.CanvasState; (** PROTECTED *)
  647. fPointerOwner : VisualComponent;
  648. hasFocus- : BOOLEAN;
  649. focusComponent : VisualComponent; (** Subcomponent that has the keyboard focus, if any *)
  650. extPointerDown, extPointerUp, extPointerMove : PointerHandler;
  651. extPointerLeave : PointerLeaveHandler;
  652. extDragOver, extDragDropped : DragDropHandler;
  653. extDragResult : DragResultHandler;
  654. extKeyEvent : KeyEventHandler;
  655. extDraw : DrawHandler;
  656. extFocus : FocusHandler;
  657. extContextMenu : ContextMenuHandler;
  658. extGetPositionOwner : GetPositionOwnerHandler;
  659. layoutManager : LayoutManager;
  660. aligning* : BOOLEAN;
  661. pointerInfo : WM.PointerInfo;
  662. editRegion: LONGINT;
  663. editX, editY: LONGINT;
  664. keyFlags: SET; (*! remove *)
  665. oldPointerInfo : WM.PointerInfo;
  666. PROCEDURE &Init*;
  667. BEGIN
  668. Init^;
  669. SetGenerator("WMComponents.NewVisualComponent");
  670. SetNameAsString(StrVisualComponent);
  671. NEW(bounds, PrototypeBounds, NIL, NIL); properties.Add(bounds);
  672. NEW(relativeBounds, PrototypeBoundsRelative, NIL, NIL); properties.Add(relativeBounds);
  673. NEW(bearing, PrototypeBearing, NIL, NIL); properties.Add(bearing);
  674. NEW(alignment, PrototypeAlignment, NIL, NIL); properties.Add(alignment);
  675. NEW(fillColor, PrototypeFillColor, NIL, NIL); properties.Add(fillColor);
  676. NEW(visible, PrototypeVisible, NIL, NIL); properties.Add(visible);
  677. NEW(takesFocus, PrototypeTakesFocus, NIL, NIL); properties.Add(takesFocus);
  678. NEW(needsTab, PrototypeNeedsTab, NIL, NIL); properties.Add(needsTab);
  679. NEW(focusPrevious, PrototypeFocusPrevious, NIL, NIL); properties.Add(focusPrevious);
  680. NEW(focusNext, PrototypeFocusNext, NIL, NIL); properties.Add(focusNext);
  681. NEW(editMode, PrototypeEditMode, NIL,NIL); properties.Add(editMode); editMode.Set(FALSE);
  682. NEW(model, ModelPrototype, NIL, NIL); properties.Add(model);
  683. NEW(font, PrototypeFont, NIL, NIL); properties.Add(font);
  684. NEW(scaleFont, PrototypeScaleFont, NIL,NIL); properties.Add(scaleFont);
  685. NEW(onStartDrag, SELF, GSonStartDrag,GSonStartDragInfo, SELF.StringToCompCommand);
  686. events.Add(onStartDrag);
  687. extGetPositionOwner := NIL;
  688. aligning := FALSE; fPointerOwner := SELF; focusComponent := SELF;
  689. END Init;
  690. (** Focus handling *)
  691. PROCEDURE TraceFocusChain*;
  692. BEGIN
  693. KernelLog.String(" -> ");
  694. ShowComponent(SELF);
  695. IF focusComponent = SELF THEN
  696. KernelLog.String(" <END>"); KernelLog.Ln;
  697. ELSIF focusComponent = NIL THEN
  698. KernelLog.String("ERROR focusComponent is NIL"); KernelLog.Ln;
  699. ELSE
  700. focusComponent.TraceFocusChain;
  701. END;
  702. END TraceFocusChain;
  703. (** Set the keyboard focus chain to this component its takesFocus field is set and unset the old chain *)
  704. PROCEDURE SetFocus*;
  705. VAR root, vc : VisualComponent; p : XML.Element;
  706. BEGIN
  707. Acquire;
  708. IF (takesFocus.Get() OR editMode.Get()) & visible.Get() THEN
  709. IF TraceFocus IN Trace THEN KernelLog.String("Set focus to: "); ShowComponent(SELF); KernelLog.Ln; END;
  710. root := GetVisualComponentRoot();
  711. IF (root IS Form) THEN root(Form).lastFocusComponent := SELF; END;
  712. (* unset the old focus chain *)
  713. (* find the leaf component that has the focus *)
  714. vc := root;
  715. WHILE (vc # NIL) & (vc.focusComponent # NIL) & (vc.focusComponent # vc) DO vc := vc.focusComponent; END;
  716. (* clear the focus chain until the root or this component *)
  717. p := vc;
  718. WHILE (p # SELF) & (p # NIL) & (p IS VisualComponent) DO
  719. vc := p(VisualComponent);
  720. vc.focusComponent := vc;
  721. vc.FocusLost;
  722. IF (vc.extFocus # NIL) THEN vc.extFocus(FALSE); END;
  723. p := p.GetParent();
  724. END;
  725. (* set the new chain *)
  726. vc := SELF; vc.focusComponent := SELF;
  727. WHILE (vc # NIL) DO
  728. IF ~vc.hasFocus THEN
  729. vc.FocusReceived;
  730. IF vc.extFocus # NIL THEN vc.extFocus(TRUE) END;
  731. END;
  732. p := vc.GetParent();
  733. IF (p # NIL) & (p IS VisualComponent) THEN
  734. p(VisualComponent).focusComponent := vc; vc := p(VisualComponent);
  735. ELSE
  736. vc := NIL;
  737. END;
  738. END;
  739. ELSE (* component does not take focus or is not visible *)
  740. IF TraceFocus IN Trace THEN ShowComponent(SELF); KernelLog.String("does not take focus."); KernelLog.Ln END;
  741. END;
  742. Release;
  743. END SetFocus;
  744. PROCEDURE FocusReceived*;
  745. BEGIN
  746. hasFocus := TRUE
  747. END FocusReceived;
  748. PROCEDURE FocusLost*;
  749. BEGIN
  750. hasFocus := FALSE
  751. END FocusLost;
  752. PROCEDURE SetFocusTo(CONST id : ARRAY OF CHAR);
  753. VAR vc : Component;
  754. BEGIN
  755. vc := Find(id);
  756. IF (vc # NIL) & (vc IS VisualComponent) THEN
  757. vc(VisualComponent).SetFocus;
  758. ELSE
  759. KernelLog.String("Warning: WMComponents.VisualComponent.SetFocusTo: Component ");
  760. KernelLog.String(id); KernelLog.String(" not found."); KernelLog.Ln;
  761. END;
  762. END SetFocusTo;
  763. PROCEDURE FocusNext*;
  764. VAR string : Strings.String;
  765. BEGIN
  766. string := focusNext.Get();
  767. IF (string # NIL) THEN
  768. SetFocusTo(string^);
  769. END;
  770. END FocusNext;
  771. PROCEDURE FocusPrev*;
  772. VAR string : Strings.String;
  773. BEGIN
  774. string := focusPrevious.Get();
  775. IF (string # NIL) THEN
  776. SetFocusTo(string^);
  777. END;
  778. END FocusPrev;
  779. (* LinkChanged can be called to inform about changes of the state of links (i.e. objects in reference properties)
  780. Unlike PropertyChanged which informs about an actual replacement of the link *)
  781. PROCEDURE LinkChanged*(sender, link: ANY);
  782. BEGIN
  783. IF sender = model THEN
  784. Invalidate
  785. END;
  786. END LinkChanged;
  787. PROCEDURE PropertyChanged*(sender, property : ANY);
  788. BEGIN
  789. IF property = bounds THEN
  790. (*ScaleFont(bounds.GetHeight(), scaleFont.Get());*)
  791. Resized (*implicit Invalidate*)
  792. ELSIF property = bearing THEN Resized;
  793. (* ELSIF bounds=relativeBounds THEN ? *)
  794. ELSIF property = alignment THEN AlignmentChanged; Invalidate (*moved here from implicit Invalidate*)
  795. ELSIF property = fillColor THEN Invalidate;
  796. ELSIF property = font THEN
  797. IF scaleFont.Get() # 0 THEN
  798. ScaleFont(bounds.GetHeight(), scaleFont.Get()); (* implicit Invalidate*)
  799. END;
  800. Invalidate;
  801. ELSIF (property = scaleFont) THEN ScaleFont(bounds.GetHeight(),scaleFont.Get()); (*implicit Invalidate*)
  802. ELSIF property = visible THEN Resized (*Implicit Invalidate*)
  803. (* ELSIF takesFocus, needsTab...*)
  804. ELSIF property = editMode THEN Invalidate;
  805. ELSIF property = model THEN LinkChanged(model, model.Get()); Invalidate;
  806. ELSE PropertyChanged^(sender, property)
  807. END;
  808. END PropertyChanged;
  809. PROCEDURE RecacheProperties;
  810. BEGIN
  811. RecacheProperties^;
  812. IF scaleFont.Get() # 0 THEN ScaleFont(bounds.GetHeight(), scaleFont.Get()) END;
  813. IF (model # NIL) & (model.Get() # NIL) THEN LinkChanged(model,model.Get()) END;
  814. END RecacheProperties;
  815. (** Get the root of visible components. Not neccessarily the same as GetComponentRoot() OR GetRoot() *)
  816. PROCEDURE GetVisualComponentRoot*(): VisualComponent;
  817. VAR p, c : XML.Element;
  818. BEGIN
  819. c := SELF;
  820. LOOP
  821. p := c.GetParent();
  822. IF (p # NIL) & (p IS VisualComponent) THEN c := p
  823. ELSE RETURN c(VisualComponent)
  824. END
  825. END
  826. END GetVisualComponentRoot;
  827. PROCEDURE AdaptRelativeBounds(inner: Rectangles.Rectangle; parent: XML.Element);
  828. VAR outer: Rectangles.Rectangle;
  829. BEGIN
  830. Acquire;
  831. IF (parent # NIL) & (parent IS VisualComponent) THEN
  832. (* inner := bounds.Get();*)
  833. outer := parent(VisualComponent).bounds.Get();
  834. IF (outer.b - outer.t > 0) & (outer.r - outer.l > 0) THEN
  835. relativeBounds.Set(Rectangles.MakeRect( (inner.l * MaxRel) DIV (outer.r-outer.l), (inner.t * MaxRel) DIV (outer.b-outer.t),
  836. (inner.r * MaxRel) DIV (outer.r - outer.l), (inner.b * MaxRel) DIV (outer.b - outer.t)));
  837. END;
  838. END;
  839. Release
  840. END AdaptRelativeBounds;
  841. (** Position handling *)
  842. PROCEDURE AlignmentChanged;
  843. VAR p : XML.Element; inner, outer: Rectangles.Rectangle;
  844. BEGIN
  845. Acquire;
  846. IF alignment.Get()= AlignRelative THEN
  847. AdaptRelativeBounds(bounds.Get(), GetParent());
  848. END;
  849. p := SELF.GetParent();
  850. IF (p # NIL) & (p IS VisualComponent) THEN
  851. p(VisualComponent).AlignSubComponents
  852. END;
  853. (*Invalidate;*)
  854. Release
  855. END AlignmentChanged;
  856. (** Get the bounds of the component *)
  857. PROCEDURE GetClientRect*() : Rectangles.Rectangle;
  858. VAR r, t : Rectangles.Rectangle;
  859. BEGIN
  860. r := bounds.Get();
  861. t := Rectangles.MakeRect(0, 0, r.r - r.l, r.b - r.t);
  862. RETURN t
  863. END GetClientRect;
  864. PROCEDURE SetLayoutManager*(layoutManager : LayoutManager);
  865. BEGIN
  866. Acquire;
  867. SELF.layoutManager := layoutManager;
  868. Release
  869. END SetLayoutManager;
  870. PROCEDURE AlignEvent(sender, data: ANY);
  871. BEGIN
  872. AlignSubComponents;
  873. END AlignEvent;
  874. PROCEDURE AlignSubComponents*;
  875. VAR c : XML.Content; vc : VisualComponent;
  876. r, b, rel : Rectangles.Rectangle;
  877. BEGIN
  878. Acquire;
  879. IF (sequencer # NIL) & ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.AlignEvent, NIL,NIL); Release; RETURN
  880. ELSIF sequencer = NIL THEN Release; RETURN
  881. END;
  882. IF aligning THEN Release; RETURN END;
  883. DisableUpdate;
  884. aligning := TRUE;
  885. IF layoutManager # NIL THEN layoutManager(SELF)
  886. ELSE
  887. r := GetClientRect();
  888. c := GetFirst();
  889. WHILE (c # NIL) DO
  890. IF c IS VisualComponent THEN
  891. vc := c(VisualComponent);
  892. IF vc.visible.Get() THEN
  893. b := vc.bearing.Get();
  894. CASE vc.alignment.Get() OF
  895. | AlignTop : vc.bounds.Set(Rectangles.MakeRect(r.l + b.l , r.t + b.t, r.r - b.r, r.t + b.t + vc.bounds.GetHeight())); INC(r.t, vc.bounds.GetHeight() + b.t + b.b)
  896. | AlignLeft : vc.bounds.Set(Rectangles.MakeRect(r.l + b.l, r.t + b.t, r.l + b.l + vc.bounds.GetWidth(), r.b - b.b)); INC(r.l, vc.bounds.GetWidth() + b.l + b.r)
  897. | AlignBottom : vc.bounds.Set(Rectangles.MakeRect(r.l + b.l, r.b - vc.bounds.GetHeight() - b.b, r.r - b.r, r.b - b.b)); DEC(r.b, vc.bounds.GetHeight() + b.t + b.b)
  898. | AlignRight : vc.bounds.Set(Rectangles.MakeRect(r.r - vc.bounds.GetWidth() - b.r , r.t + b.t, r.r - b.r, r.b - b.b)); DEC(r.r, vc.bounds.GetWidth() + b.l + b.r);
  899. | AlignClient : IF ~Rectangles.RectEmpty(r) THEN vc.bounds.Set(Rectangles.MakeRect(r.l + b.l , r.t + b.t, r.r - b.r, r.b - b.b)) END
  900. | AlignRelative:
  901. IF ~editMode.Get() THEN
  902. rel := vc.relativeBounds.Get();
  903. vc.bounds.Set(Rectangles.MakeRect(r.l + ((r.r-r.l)*rel.l+MaxRel DIV 2) DIV MaxRel, r.t + ((r.b-r.t)*rel.t+MaxRel DIV 2) DIV MaxRel,
  904. r.l + ((r.r-r.l)*rel.r +MaxRel DIV 2) DIV MaxRel, r.t+((r.b-r.t)*rel.b + MaxRel DIV 2) DIV MaxRel));
  905. ELSE
  906. vc.AdaptRelativeBounds(vc.bounds.Get(),SELF);
  907. END;
  908. ELSE (* nothing *)
  909. END;
  910. END;
  911. END;
  912. c := GetNext(c);
  913. END;
  914. END;
  915. EnableUpdate;
  916. aligning := FALSE;
  917. Release;
  918. END AlignSubComponents;
  919. PROCEDURE Initialize*;
  920. BEGIN
  921. Initialize^;
  922. AlignSubComponents;
  923. END Initialize;
  924. (** Locating *)
  925. (** transform the local component coordinates into global window manager coordinates *)
  926. PROCEDURE ToWMCoordinates*(x, y : LONGINT; VAR gx, gy : LONGINT);
  927. VAR cr : Component; tc : XML.Element; r : Rectangles.Rectangle;
  928. BEGIN
  929. gx := x; gy := y; tc := SELF;
  930. REPEAT
  931. IF (tc # NIL) & (tc IS VisualComponent) THEN
  932. r := tc(VisualComponent).bounds.Get();
  933. INC(gx, r.l); INC(gy, r.t)
  934. END;
  935. tc := tc.GetParent()
  936. UNTIL (tc = NIL) OR ~(tc IS VisualComponent);
  937. cr := GetComponentRoot();
  938. IF (cr # NIL) & (cr IS Form) THEN
  939. INC(gx, cr(Form).window.bounds.l);
  940. INC(gy, cr(Form).window.bounds.t)
  941. END
  942. END ToWMCoordinates;
  943. (** Return if the component is hit at (x, y) in component coordinates *)
  944. PROCEDURE IsHit*(x, y: LONGINT): BOOLEAN;
  945. BEGIN
  946. RETURN visible.Get() & enabled.Get() & Rectangles.PointInRect(x, y, GetClientRect())
  947. END IsHit;
  948. (** Return the topmost first child component at (x, y) *)
  949. PROCEDURE GetPositionOwner*(x, y: LONGINT): VisualComponent;
  950. VAR c: XML.Content; result, vc : VisualComponent; r : Rectangles.Rectangle;
  951. BEGIN
  952. Acquire;
  953. result := SELF;
  954. c := GetFirst();
  955. WHILE (c # NIL) DO
  956. IF c IS VisualComponent THEN
  957. vc := c(VisualComponent);
  958. r := vc.bounds.Get();
  959. IF Rectangles.PointInRect(x, y, r) & vc.IsHit(x - r.l, y - r.t) THEN
  960. result := vc
  961. END;
  962. END;
  963. c := GetNext(c);
  964. END;
  965. Release;
  966. RETURN result
  967. END GetPositionOwner;
  968. (** DragOver is called via the message handler. The should call manager.SetDragAccept(SELF, .... *)
  969. PROCEDURE DragOver*(x, y: LONGINT; dragInfo : WM.DragInfo);
  970. END DragOver;
  971. (** Dropped is called via the message handler to indicate an item has been dropped. *)
  972. PROCEDURE DragDropped*(x, y: LONGINT; dragInfo : WM.DragInfo);
  973. BEGIN
  974. IF dragInfo.onReject # NIL THEN dragInfo.onReject(SELF,dragInfo) END;
  975. END DragDropped;
  976. (*
  977. PROCEDURE EditDragOver(x,y: LONGINT; dragInfo: WMWindowManager.DragInfo);
  978. BEGIN
  979. END EditDragOver;
  980. *)
  981. PROCEDURE FromXML(xml: XML.Element);
  982. BEGIN
  983. FromXML^(xml);
  984. END FromXML;
  985. (*
  986. PROCEDURE AddContent*(c : XML.Content);
  987. VAR m:Messages.Message;
  988. BEGIN
  989. AddContent^(c);
  990. IF c IS VisualComponent THEN
  991. m.sender:=SELF (*c*); (*move to VisualComponent ?*)
  992. m.msgType := Messages.MsgInvalidate;
  993. m.msgSubType := Messages.MsgSubAll;
  994. (* SELF(VisualComponent).Invalidate ...*)
  995. IF sequencer.Add(m) THEN END;
  996. END;
  997. END AddContent;
  998. *)
  999. PROCEDURE AddVisualComponent(c :VisualComponent; x, y : LONGINT);
  1000. VAR bounds : Rectangles.Rectangle;canvas: WMGraphics.BufferCanvas; relativeAlignment: BOOLEAN;
  1001. BEGIN
  1002. ASSERT(c # NIL);
  1003. IF (c.bounds.GetWidth() < 10) OR (c.bounds.GetHeight() < 10) THEN
  1004. c.bounds.SetExtents(40, 20);
  1005. END;
  1006. bounds := c.bounds.Get();
  1007. Rectangles.MoveRel(bounds, x, y);
  1008. c.bounds.Set(bounds);
  1009. c.AdaptRelativeBounds(c.bounds.Get(), SELF);
  1010. (*
  1011. IF c.sequencer # sequencer THEN c.SetSequencer(sequencer) END; (* redundant - implicit in AddContent *)
  1012. c.Reset(NIL, NIL); (*currently redundant - already in happens Component.AddContent() *)
  1013. c.RecacheProperties; (*currently redundant - already in happens Reset() *)
  1014. *)
  1015. Acquire;
  1016. AddContent(c);
  1017. Release;
  1018. END AddVisualComponent;
  1019. PROCEDURE EditDragDropped(x,y: LONGINT; dragInfo: WM.DragInfo): BOOLEAN;
  1020. VAR data: ANY; e: ComponentListEntry; parent: XML.Element; dt: DropTarget; pos: LONGINT;
  1021. BEGIN
  1022. data := dragInfo.data;
  1023. IF (data # NIL) & (data IS VisualComponent) THEN
  1024. IF dragInfo.sender # SELF THEN
  1025. IF dragInfo.onAccept # NIL THEN dragInfo.onAccept(SELF,dragInfo) END;
  1026. data(VisualComponent).bounds.Set(Rectangles.MakeRect(0, 0, data(VisualComponent).bounds.GetWidth(), data(VisualComponent).bounds.GetHeight()));
  1027. AddVisualComponent(data(VisualComponent),x+dragInfo.offsetX,y+dragInfo.offsetY);
  1028. Invalidate;
  1029. ELSE
  1030. parent := GetParent();
  1031. IF parent = NIL THEN RETURN FALSE END;
  1032. x := x + bounds.GetLeft();
  1033. y := y + bounds.GetTop();
  1034. RETURN parent(VisualComponent).EditDragDropped(x,y,dragInfo);
  1035. END;
  1036. RETURN TRUE
  1037. ELSIF (data # NIL) & (data IS Repositories.Component) THEN
  1038. IF dragInfo.onAccept # NIL THEN dragInfo.onAccept(SELF,dragInfo) END;
  1039. model.Set(data(Repositories.Component));
  1040. RETURN TRUE
  1041. ELSIF (data # NIL) & (data IS SelectionList) THEN
  1042. IF (dragInfo.sender # SELF) & ~data(SelectionList).Has(SELF) THEN
  1043. IF dragInfo.onAccept # NIL THEN dragInfo.onAccept(SELF,dragInfo) END;
  1044. e := data(SelectionList).first;
  1045. WHILE e # NIL DO
  1046. e.component.bounds.Set(Rectangles.MakeRect(0, 0, e.component.bounds.GetWidth(), e.component.bounds.GetHeight()));
  1047. ASSERT(e.component IS VisualComponent);
  1048. AddVisualComponent(e.component,x+e.dx+dragInfo.offsetX, y+e.dy + dragInfo.offsetY);
  1049. e := e.next;
  1050. END;
  1051. Invalidate;
  1052. ELSE
  1053. parent := GetParent();
  1054. IF parent = NIL THEN RETURN FALSE END;
  1055. x := x + bounds.GetLeft();
  1056. y := y + bounds.GetTop();
  1057. RETURN parent(VisualComponent).EditDragDropped(x,y,dragInfo);
  1058. END;
  1059. RETURN TRUE
  1060. ELSE
  1061. NEW(dt, SELF, SetDroppedString, x,y);
  1062. dragInfo.data := dt;
  1063. ConfirmDrag(TRUE, dragInfo);
  1064. RETURN FALSE
  1065. END;
  1066. END EditDragDropped;
  1067. PROCEDURE SetDroppedString( CONST string : ARRAY OF CHAR; x,y : LONGINT; VAR res : LONGINT);
  1068. VAR gen: XML.GeneratorProcedure; moduleName, procedureName ,msg: Modules.Name; element: XML.Element;
  1069. context: Repositories.Context; repositoryName, componentName: ARRAY 265 OF CHAR; componentID: LONGINT; object: Repositories.Component;
  1070. BEGIN
  1071. Commands.Split(string, moduleName, procedureName, res, msg);
  1072. IF (res = Commands.Ok) THEN
  1073. GETPROCEDURE(moduleName, procedureName, gen);
  1074. END;
  1075. IF gen # NIL THEN
  1076. element := gen();
  1077. ELSIF Repositories.IsCommandString(string) THEN
  1078. Repositories.CallCommand(string, context, res);
  1079. IF (res = Repositories.Ok) & (context.object # NIL) & (context.object IS Repositories.Component) THEN
  1080. element := context.object(Repositories.Component);
  1081. END;
  1082. ELSIF Repositories.SplitName(string, repositoryName, componentName, componentID) THEN
  1083. Repositories.GetComponent(repositoryName, componentName, componentID, object, res);
  1084. element := object;
  1085. END;
  1086. IF (element # NIL) & (element IS VisualComponent) THEN
  1087. AddVisualComponent(element(VisualComponent),x,y);
  1088. Invalidate;
  1089. ELSIF (element # NIL) & (element IS Repositories.Component) THEN
  1090. model.Set(element(Repositories.Component))
  1091. END;
  1092. res := 1; (* to avoid removal of source *)
  1093. END SetDroppedString;
  1094. (** Is called via the message handler to inform about the result of a recent drag operation *)
  1095. PROCEDURE DragResult*(accepted : BOOLEAN; recipient : ANY; dragInfo : WM.DragInfo);
  1096. END DragResult;
  1097. (** Start a drag operation. *)
  1098. PROCEDURE StartDrag*(data : ANY; img : WMGraphics.Image; offsetX, offsetY: LONGINT; onAccept, onReject : Messages.CompCommand) : BOOLEAN;
  1099. VAR rc : Component;
  1100. BEGIN
  1101. rc := GetVisualComponentRoot();
  1102. IF (rc # NIL) & (rc IS Form) THEN
  1103. RETURN rc(Form).window.StartDrag(SELF, data, img, offsetX, offsetY, onAccept, onReject)
  1104. ELSE
  1105. RETURN FALSE
  1106. END
  1107. END StartDrag;
  1108. (** confirm a drag operation. *)
  1109. PROCEDURE ConfirmDrag*(accept : BOOLEAN; dragInfo : WM.DragInfo);
  1110. VAR rc : Component;
  1111. BEGIN
  1112. rc := GetVisualComponentRoot();
  1113. IF (rc # NIL) & (rc IS Form) THEN rc(Form).window.ConfirmDrag(accept, dragInfo)
  1114. END
  1115. END ConfirmDrag;
  1116. (** Is called by the component if it detects a default drag action. The subclass should then call StartDrag with
  1117. the respective coordinates. If it wants to start the drag operation *)
  1118. PROCEDURE AutoStartDrag*;
  1119. BEGIN
  1120. onStartDrag.Call(NIL)
  1121. END AutoStartDrag;
  1122. (** Is called by the component if it detects a request for a context menu. The subclass should open the
  1123. context menu if applicable *)
  1124. PROCEDURE ShowContextMenu*(x, y : LONGINT);
  1125. BEGIN
  1126. IF extContextMenu # NIL THEN extContextMenu(SELF, x, y) END;
  1127. END ShowContextMenu;
  1128. (** Special methods *)
  1129. PROCEDURE Resized*;
  1130. VAR p : XML.Element;
  1131. BEGIN
  1132. (*
  1133. AdaptRelativeBounds(GetParent());
  1134. *)
  1135. IF sequencer # NIL THEN ASSERT(sequencer.lock.HasWriteLock()) END;
  1136. DisableUpdate;
  1137. p := SELF.GetParent();
  1138. IF (p # NIL) & (p IS VisualComponent) & (alignment.Get() # AlignNone) THEN p(VisualComponent).AlignSubComponents END;
  1139. IF visible.Get() THEN
  1140. AlignSubComponents;
  1141. IF scaleFont.Get() # 0 THEN ScaleFont(bounds.GetHeight(), scaleFont.Get()) END;
  1142. END;
  1143. EnableUpdate;
  1144. IF (p # NIL) & (p IS VisualComponent) THEN p(VisualComponent).Invalidate
  1145. ELSE Invalidate()
  1146. END
  1147. END Resized;
  1148. (** Is called before any sub-components are drawn *)
  1149. PROCEDURE DrawBackground*(canvas : WMGraphics.Canvas);
  1150. VAR color : LONGINT; name:Strings.String;
  1151. BEGIN
  1152. (* message tracing
  1153. IF sequencer = Messages.debug THEN
  1154. D.Enter;
  1155. D.Ln;
  1156. D.String("##############"); D.Ln;
  1157. name := GetName();
  1158. IF name # NIL THEN D.String(name^); D.Ln; END;
  1159. name := id.Get();
  1160. IF name # NIL THEN D.String(name^); D.Ln; END;
  1161. D.Int(Kernel.GetTicks(),1); D.Ln;
  1162. (*D.TraceBack;*)
  1163. D.Exit;
  1164. END;
  1165. *)
  1166. CheckReadLock;
  1167. color := fillColor.Get();
  1168. IF color # 0 THEN canvas.Fill(GetClientRect(), color, WMGraphics.ModeSrcOverDst) END;
  1169. END DrawBackground;
  1170. (** Is called after all sub-components are drawn *)
  1171. PROCEDURE DrawForeground*(canvas : WMGraphics.Canvas);
  1172. END DrawForeground;
  1173. PROCEDURE DrawSelection(canvas : WMGraphics.Canvas);
  1174. VAR r,r0: Rectangles.Rectangle; x,y,x0,y0: LONGINT; color: LONGINT;
  1175. PROCEDURE MarkSelected(r: Rectangles.Rectangle; w, color: LONGINT);
  1176. VAR r0: Rectangles.Rectangle;
  1177. BEGIN
  1178. r0 :=r; r0.r := r.l+w; r0.b := r.t+w;
  1179. canvas.Fill(r0, color, WMGraphics.ModeSrcOverDst);
  1180. r0 :=r; r0.r := r.l+w; r0.t := r.b-w;
  1181. canvas.Fill(r0, color, WMGraphics.ModeSrcOverDst);
  1182. r0 :=r; r0.l := r.r-w; r0.b := r.t+w;
  1183. canvas.Fill(r0, color, WMGraphics.ModeSrcOverDst);
  1184. r0 :=r; r0.l := r.r-w; r0.t := r.b-w;
  1185. canvas.Fill(r0, color, WMGraphics.ModeSrcOverDst);
  1186. r0 := r; r0.l := r.r-1; canvas.Fill(r0,color, WMGraphics.ModeSrcOverDst);
  1187. r0 := r; r0.r := r.l+1; canvas.Fill(r0,color, WMGraphics.ModeSrcOverDst);
  1188. r0 := r; r0.b := r.t+1; canvas.Fill(r0,color, WMGraphics.ModeSrcOverDst);
  1189. r0 := r; r0.t := r.b-1; canvas.Fill(r0,color, WMGraphics.ModeSrcOverDst);
  1190. END MarkSelected;
  1191. BEGIN
  1192. CheckReadLock;
  1193. r := GetClientRect();
  1194. IF editMode.Get() THEN
  1195. y := r.t + (-r.t) MOD 8;
  1196. y0 := 0;
  1197. WHILE y < r.b DO
  1198. r0.t := y; r0.b := y+2;
  1199. x := r.l + (-r.l) MOD 8; x0 := 0;
  1200. WHILE x < r.r DO
  1201. r0.l := x; r0.r := x+2;
  1202. IF ODD(x DIV 8+y DIV 8) THEN color := 060H;
  1203. ELSE color := LONGINT(0FFFFFF60H);
  1204. END;
  1205. canvas.Fill(r0,color, WMGraphics.ModeSrcOverDst);
  1206. INC(x,8); INC(x0);
  1207. END;
  1208. INC(y,8);INC(y0);
  1209. END;
  1210. END;
  1211. IF selection.Has(SELF) THEN
  1212. IF selection.state = 0 THEN
  1213. MarkSelected(r,8,LONGINT(080H));
  1214. ELSE
  1215. MarkSelected(r,8,LONGINT(0FFFFFFFF80H));
  1216. END;
  1217. END;
  1218. END DrawSelection;
  1219. PROCEDURE DrawSubComponents*(canvas : WMGraphics.Canvas);
  1220. VAR c : XML.Content; vc : VisualComponent; cr, r : Rectangles.Rectangle;
  1221. BEGIN
  1222. CheckReadLock;
  1223. canvas.GetClipRect(cr);
  1224. canvas.SaveState(canvasState);
  1225. (* draw all sub-components *)
  1226. c := GetFirst();
  1227. WHILE (c # NIL) DO
  1228. IF c IS VisualComponent THEN
  1229. vc := c(VisualComponent); r := vc.bounds.Get();
  1230. IF Rectangles.Intersect(r, cr) THEN (* only draw if the component has a chance to be visible *)
  1231. canvas.SetClipRect(r); canvas.SetClipMode({WMGraphics.ClipRect});
  1232. canvas.ClipRectAsNewLimits(r.l, r.t);
  1233. vc.Draw(canvas);
  1234. canvas.RestoreState(canvasState);
  1235. END;
  1236. END;
  1237. c := GetNext(c);
  1238. END;
  1239. END DrawSubComponents;
  1240. PROCEDURE GetFont*() : WMGraphics.Font;
  1241. BEGIN
  1242. IF font.Get() = NIL THEN RETURN WMGraphics.GetDefaultFont()
  1243. ELSE RETURN font.Get()
  1244. END
  1245. END GetFont;
  1246. PROCEDURE SetFont*(font : WMGraphics.Font);
  1247. BEGIN
  1248. Acquire;
  1249. IF SELF.font.Get() # font THEN
  1250. SELF.font.Set(font);
  1251. (*?Invalidate()*) (* Invalidate already in PropertyChanged() *)
  1252. END;
  1253. Release
  1254. END SetFont;
  1255. PROCEDURE ScaleFont*(height: LONGINT; percent: LONGINT);
  1256. VAR fh,newSize: LONGINT; f: WMGraphics.Font;
  1257. BEGIN
  1258. IF height < 4 THEN height := 4 END;
  1259. IF percent <= 0 THEN RETURN END;
  1260. Acquire;
  1261. f := GetFont();
  1262. f := WMGraphics.GetFont(f.name, 100, f.style); (* expensive ? *)
  1263. fh := f.GetAscent() + f.GetDescent();
  1264. fh := height * percent DIV fh;
  1265. IF fh > 100 THEN fh := fh - fh MOD 8
  1266. ELSIF fh > 32 THEN fh := fh - fh MOD 4
  1267. ELSIF fh > 12 THEN fh := fh - fh MOD 2
  1268. END;
  1269. IF font.GetSize() # fh THEN
  1270. font.SetSize(fh);
  1271. Invalidate;
  1272. END;
  1273. Release;
  1274. END ScaleFont;
  1275. (** Called by the component owner whenever a redraw to a canvas is needed. Caller must hold hierarchy lock *)
  1276. PROCEDURE Draw*(canvas : WMGraphics.Canvas);
  1277. VAR command: Strings.String; event: Event;
  1278. BEGIN
  1279. (*
  1280. can lead to deadlock:
  1281. we hold the lock "lock"
  1282. onDraw tries to get the Objects lock, but this may be held by other component (should better not, but did, dead: WMPartitionsComponents.OperationEventHandler
  1283. command := GetAttributeValue("onDraw");
  1284. IF (command # NIL) THEN HandleEvent(event, SELF, command); END;
  1285. *)
  1286. CheckReadLock;
  1287. IF ~visible.Get() THEN RETURN END;
  1288. canvas.SaveState(canvasState);
  1289. IF font # NIL THEN canvas.SetFont(font.Get()) END;
  1290. DrawBackground(canvas);
  1291. IF extDraw # NIL THEN extDraw(canvas) END;
  1292. DrawSelection(canvas);
  1293. DrawSubComponents(canvas);
  1294. DrawForeground(canvas);
  1295. canvas.RestoreState(canvasState)
  1296. END Draw;
  1297. (** declare a rectangle area as dirty *)
  1298. PROCEDURE InvalidateRect*(r: Rectangles.Rectangle);
  1299. VAR parent : XML.Element;
  1300. m : Messages.Message; b : Rectangles.Rectangle;
  1301. BEGIN
  1302. IF ~initialized THEN RETURN END;
  1303. IF ~visible.Get() THEN RETURN END;
  1304. IF ~IsCallFromSequencer() THEN
  1305. m.msgType := Messages.MsgInvalidate;
  1306. m.msgSubType := Messages.MsgSubRectangle;
  1307. (*
  1308. m.msgType := Messages.MsgExt;
  1309. m.ext := invalidateRectMsg;
  1310. *)
  1311. m.x := r.l; m.y := r.t; m.dx := r.r; m.dy := r.b; m.sender := SELF;
  1312. IF sequencer.Add(m) THEN IF CanYield THEN Objects.Yield END END;
  1313. ELSE
  1314. parent := GetParent();
  1315. IF (parent # NIL) & (parent IS VisualComponent) THEN
  1316. b := bounds.Get();
  1317. Rectangles.MoveRel(r, b.l, b.t);
  1318. parent(VisualComponent).InvalidateRect(r)
  1319. END
  1320. END
  1321. END InvalidateRect;
  1322. PROCEDURE InvalidateCommand*(sender, par : ANY);
  1323. VAR m: Messages.Message; r, b: Rectangles.Rectangle; client: VisualComponent; parent: XML.Element;
  1324. BEGIN
  1325. IF ~initialized OR ~visible.Get() THEN RETURN END; (*? double call to visible.Get here and below. Which one is better ?*)
  1326. IF ~IsCallFromSequencer() OR ~visible.Get() THEN
  1327. r := GetClientRect();
  1328. client := SELF;
  1329. parent := GetParent();
  1330. WHILE (parent # NIL) & (parent IS VisualComponent) DO
  1331. IF ~parent(VisualComponent).visible.Get() THEN RETURN END;
  1332. b := client.bounds.Get();
  1333. Rectangles.MoveRel(r, b.l, b.t);
  1334. client := parent(VisualComponent);
  1335. parent := client.GetParent();
  1336. END;
  1337. m.msgType := Messages.MsgInvalidate;
  1338. m.msgSubType := Messages.MsgSubRectangle;
  1339. m.x := r.l; m.y := r.t; m.dx := r.r; m.dy := r.b;
  1340. m.sender := client;
  1341. IF sequencer.Add(m) THEN IF CanYield THEN Objects.Yield END END;
  1342. ELSE
  1343. InvalidateRect(GetClientRect());
  1344. END;
  1345. END InvalidateCommand;
  1346. PROCEDURE Invalidate*; (* For convenience in component internal use *)
  1347. BEGIN
  1348. InvalidateCommand(SELF, NIL)
  1349. END Invalidate;
  1350. (** recursively disable the redrawing of any components in the hierarchy *)
  1351. (** dont forget to re-enable it ;-). Use with care to optimize sub-component operations *)
  1352. PROCEDURE DisableUpdate*;
  1353. VAR vc: VisualComponent;
  1354. BEGIN
  1355. ASSERT(IsCallFromSequencer());
  1356. vc := GetVisualComponentRoot();
  1357. IF (vc # NIL) & (vc IS Form) THEN vc(Form).DisableUpdate() END
  1358. END DisableUpdate;
  1359. (** recursively enable the redrawing of any components in the hierarchy *)
  1360. (** Only enable drawing if it was disabled before, but dont forget it, then ! *)
  1361. PROCEDURE EnableUpdate*;
  1362. VAR vc: VisualComponent;
  1363. BEGIN
  1364. ASSERT(IsCallFromSequencer());
  1365. vc := GetVisualComponentRoot();
  1366. IF (vc # NIL) & (vc IS Form) THEN vc(Form).EnableUpdate() END
  1367. END EnableUpdate;
  1368. PROCEDURE GetInternalPointerInfo*() : WM.PointerInfo;
  1369. VAR vc: VisualComponent;
  1370. BEGIN
  1371. ASSERT(IsCallFromSequencer());
  1372. vc := GetVisualComponentRoot();
  1373. IF (vc # NIL) & (vc IS Form) THEN
  1374. RETURN vc(Form).GetPointerInfo()
  1375. ELSE
  1376. RETURN NIL
  1377. END
  1378. END GetInternalPointerInfo;
  1379. PROCEDURE SetInternalPointerInfo*(pi : WM.PointerInfo);
  1380. VAR vc: VisualComponent;
  1381. BEGIN
  1382. AssertLock;
  1383. vc := GetVisualComponentRoot();
  1384. IF (vc # NIL) & (vc IS Form) THEN vc(Form).SetPointerInfo(pi) END
  1385. END SetInternalPointerInfo;
  1386. PROCEDURE SetPointerInfo*(pi : WM.PointerInfo);
  1387. BEGIN
  1388. Acquire;
  1389. SetInternalPointerInfo(pi);
  1390. pointerInfo := pi;
  1391. Release
  1392. END SetPointerInfo;
  1393. PROCEDURE GetPointerInfo*() : WM.PointerInfo;
  1394. BEGIN
  1395. RETURN pointerInfo
  1396. END GetPointerInfo;
  1397. (** User interaction messages *)
  1398. PROCEDURE SetExtPointerLeaveHandler*(handler : PointerLeaveHandler);
  1399. BEGIN
  1400. Acquire; extPointerLeave := handler; Release
  1401. END SetExtPointerLeaveHandler;
  1402. PROCEDURE SetExtPointerDownHandler*(handler : PointerHandler);
  1403. BEGIN
  1404. Acquire; extPointerDown := handler; Release
  1405. END SetExtPointerDownHandler;
  1406. PROCEDURE SetExtPointerMoveHandler*(handler : PointerHandler);
  1407. BEGIN
  1408. Acquire; extPointerMove := handler; Release
  1409. END SetExtPointerMoveHandler;
  1410. PROCEDURE SetExtPointerUpHandler*(handler : PointerHandler);
  1411. BEGIN
  1412. Acquire; extPointerUp := handler; Release
  1413. END SetExtPointerUpHandler;
  1414. PROCEDURE SetExtDragOverHandler*(handler : DragDropHandler);
  1415. BEGIN
  1416. Acquire; extDragOver := handler; Release
  1417. END SetExtDragOverHandler;
  1418. PROCEDURE SetExtDragDroppedHandler*(handler : DragDropHandler);
  1419. BEGIN
  1420. Acquire; extDragDropped := handler; Release
  1421. END SetExtDragDroppedHandler;
  1422. PROCEDURE SetExtDragResultHandler*(handler : DragResultHandler);
  1423. BEGIN
  1424. Acquire; extDragResult := handler; Release
  1425. END SetExtDragResultHandler;
  1426. PROCEDURE SetExtKeyEventHandler*(handler : KeyEventHandler);
  1427. BEGIN
  1428. Acquire; extKeyEvent := handler; Release
  1429. END SetExtKeyEventHandler;
  1430. PROCEDURE SetExtDrawHandler*(handler : DrawHandler);
  1431. BEGIN
  1432. Acquire; extDraw := handler; Release
  1433. END SetExtDrawHandler;
  1434. PROCEDURE SetExtFocusHandler*(handler : FocusHandler);
  1435. BEGIN
  1436. Acquire; extFocus := handler; Release
  1437. END SetExtFocusHandler;
  1438. PROCEDURE SetExtContextMenuHandler*(handler : ContextMenuHandler);
  1439. BEGIN
  1440. Acquire; extContextMenu := handler; Release
  1441. END SetExtContextMenuHandler;
  1442. PROCEDURE SetExtGetPositionOwnerHandler*(handler : GetPositionOwnerHandler);
  1443. BEGIN
  1444. Acquire; extGetPositionOwner := handler; Release;
  1445. END SetExtGetPositionOwnerHandler;
  1446. (** Indicates the pointing device has left the component without a key pressed down.
  1447. May only be called from the sequencer thread.
  1448. Components interested in this message can override this method instead of searching for the message in HandleInternal. *)
  1449. PROCEDURE PointerLeave*; (** PROTECTED *)
  1450. BEGIN ASSERT(IsCallFromSequencer());
  1451. END PointerLeave;
  1452. (** Indicates one of the pointer keys went down. keys is the set of buttons currently pressed. x, y is the position in component
  1453. coordinates.
  1454. May only be called from the sequencer thread.
  1455. Components interested in this message can override this method instead of searching for the message in HandleInternal. *)
  1456. PROCEDURE PointerDown*(x, y: LONGINT; keys: SET); (** PROTECTED *)
  1457. BEGIN ASSERT(IsCallFromSequencer());
  1458. IF keys = {2} THEN ShowContextMenu(x, y)
  1459. END;
  1460. END PointerDown;
  1461. (** Indicates the pointer was moved. keys is the set of buttons currently pressed. x, y is the position in component
  1462. coordinates.
  1463. May only be called from the sequencer thread.
  1464. Components interested in this message can override this method instead of searching for the message in HandleInternal. *)
  1465. PROCEDURE PointerMove*(x, y: LONGINT; keys: SET); (** PROTECTED *)
  1466. BEGIN ASSERT(IsCallFromSequencer());
  1467. END PointerMove;
  1468. PROCEDURE WheelMove*(dz: LONGINT); (** PROTECTED *)
  1469. BEGIN ASSERT(IsCallFromSequencer());
  1470. END WheelMove;
  1471. (** Indicates one of the pointer keys went up. keys is the set of buttons currently pressed. x, y is the position in component
  1472. coordinates.
  1473. May only be called from the sequencer thread.
  1474. Components interested in this message can override this method instead of searching for the message in HandleInternal. *)
  1475. PROCEDURE PointerUp*(x, y: LONGINT; keys: SET); (** PROTECTED *)
  1476. BEGIN ASSERT(IsCallFromSequencer());
  1477. END PointerUp;
  1478. (** The component can determine wheter the key was pressed or released by examining the
  1479. Inputs.Release flag in flags. ucs contains the unicode equivalent of the key. Special input editors
  1480. send the generated unicode characters via KeyEvent.
  1481. May only be called from the sequencer thread.
  1482. Components interested in this message can override this method instead of searching for the message in HandleInternal. *)
  1483. PROCEDURE KeyEvent*(ucs : LONGINT; flags: SET; VAR keySym: LONGINT); (** PROTECTED *)
  1484. BEGIN ASSERT(IsCallFromSequencer());
  1485. END KeyEvent;
  1486. PROCEDURE EditKeyEvents(ucs : LONGINT; flags: SET; VAR keySym: LONGINT): BOOLEAN; (** FINAL *)
  1487. VAR event : KeyPressedEvent; command : Strings.String; scale: LONGINT;
  1488. clone: Repositories.Component; parent: XML.Content; parentEditMode: BOOLEAN;
  1489. enum: XMLObjects.Enumerator; obj: ANY;
  1490. BEGIN
  1491. ASSERT(IsCallFromSequencer());
  1492. event.ucs := ucs; event.flags := flags; event.keysym := keySym;
  1493. parent := GetParent();
  1494. IF (parent # NIL) & (parent IS VisualComponent) & parent(VisualComponent).editMode.Get() THEN
  1495. parentEditMode := TRUE
  1496. ELSE
  1497. parentEditMode := FALSE
  1498. END;
  1499. IF ({Inputs.Release} * flags = {}) THEN
  1500. IF (keySym = Inputs.KsF1) & (Inputs.Shift * flags # {}) THEN
  1501. SetEditMode(~editMode.Get(), FALSE);
  1502. RETURN TRUE
  1503. ELSIF (keySym = Inputs.KsEscape) THEN
  1504. selection.Reset(NIL);
  1505. RETURN FALSE
  1506. ELSIF parentEditMode OR editMode.Get() THEN
  1507. IF Inputs.Shift * flags # {} THEN scale := 1 ELSE scale := 4 END;
  1508. IF keySym = Inputs.KsLeft THEN selection.Shift(-scale,0); RETURN TRUE
  1509. ELSIF keySym = Inputs.KsRight THEN selection.Shift(scale,0); RETURN TRUE
  1510. ELSIF keySym = Inputs.KsDown THEN selection.Shift(0,scale); RETURN TRUE
  1511. ELSIF keySym = Inputs.KsUp THEN selection.Shift(0,-scale); RETURN TRUE
  1512. ELSIF keySym=4 (* CTRL-D *) THEN
  1513. clone := Clone(selection.first.component);
  1514. parent := selection.first.component.GetParent(); parent(Component).AddContent(clone);
  1515. RETURN TRUE
  1516. ELSIF keySym=1 THEN (* CTRL-A *)
  1517. enum := GetContents();
  1518. WHILE enum.HasMoreElements() DO
  1519. obj := enum.GetNext();
  1520. IF obj IS VisualComponent THEN
  1521. selection.Add(obj(VisualComponent))
  1522. END;
  1523. END;
  1524. ELSIF keySym = Inputs.KsDelete THEN
  1525. RemoveSelection();
  1526. RETURN TRUE
  1527. END;
  1528. END
  1529. END;
  1530. RETURN FALSE;
  1531. END EditKeyEvents;
  1532. PROCEDURE CheckKeyEvents(ucs : LONGINT; flags: SET; VAR keySym: LONGINT); (** FINAL *)
  1533. VAR event : KeyPressedEvent; command : Strings.String; scale: LONGINT; clone: Repositories.Component; parent: XML.Content;
  1534. BEGIN
  1535. ASSERT(IsCallFromSequencer());
  1536. event.ucs := ucs; event.flags := flags; event.keysym := keySym;
  1537. IF ({Inputs.Release} * flags = {}) THEN
  1538. IF (keySym = Inputs.KsReturn) THEN
  1539. command := GetAttributeValue("onReturn");
  1540. ELSIF (keySym = Inputs.KsEscape) THEN
  1541. command := GetAttributeValue("onEscape");
  1542. selection.Reset(NIL);
  1543. (*ELSIF (keySym = Inputs.KsF1) & (Inputs.Shift * flags # {}) THEN
  1544. SetEditMode(~editMode.Get(), TRUE);
  1545. ELSIF editMode.Get() THEN
  1546. IF Inputs.Shift * flags # {} THEN scale := 1 ELSE scale := 4 END;
  1547. IF keySym = Inputs.KsLeft THEN selection.Shift(-scale,0)
  1548. ELSIF keySym = Inputs.KsRight THEN selection.Shift(scale,0)
  1549. ELSIF keySym = Inputs.KsDown THEN selection.Shift(0,scale)
  1550. ELSIF keySym = Inputs.KsUp THEN selection.Shift(0,-scale)
  1551. ELSIF keySym=4 (* CTRL-D *) THEN
  1552. clone := Clone(selection.first.component);
  1553. parent := selection.first.component.GetParent(); parent(Component).AddContent(clone);
  1554. ELSIF keySym = Inputs.KsDelete THEN
  1555. RemoveSelection();
  1556. END;
  1557. *)
  1558. END;
  1559. IF (command # NIL) THEN HandleEvent(event, SELF, command); END;
  1560. command := GetAttributeValue("onKeyPressed");
  1561. IF (command # NIL) THEN HandleEvent(event, SELF, command); END;
  1562. ELSE
  1563. command := GetAttributeValue("onKeyReleased");
  1564. IF (command # NIL) THEN HandleEvent(event, SELF, command); END;
  1565. END;
  1566. END CheckKeyEvents;
  1567. PROCEDURE CheckPointerEvent(x, y, z : LONGINT; keys : SET);
  1568. VAR event : PointerEvent; command : Strings.String;
  1569. BEGIN
  1570. ASSERT(IsCallFromSequencer());
  1571. event.x := x; event.y := y; event.z := z; event.keys := keys;
  1572. IF ({0} * keys = {0}) THEN
  1573. command := GetAttributeValue("onLeftClick");
  1574. ELSIF ({2} * keys = {2}) THEN
  1575. command := GetAttributeValue("onRightClick");
  1576. ELSIF ({1} * keys = {1}) THEN
  1577. command := GetAttributeValue("onMiddleClick");
  1578. END;
  1579. IF (command # NIL) THEN HandleEvent(event, SELF, command); END;
  1580. command := GetAttributeValue("onClick");
  1581. IF (command # NIL) THEN HandleEvent(event, SELF, command); END;
  1582. END CheckPointerEvent;
  1583. PROCEDURE CheckPointerUpEvent(x, y, z : LONGINT; keys : SET);
  1584. VAR event : PointerEvent; command : Strings.String;
  1585. BEGIN
  1586. ASSERT(IsCallFromSequencer());
  1587. event.x := x; event.y := y; event.z := z; event.keys := keys;
  1588. command := GetAttributeValue("onRelease");
  1589. IF (command # NIL) THEN HandleEvent(event, SELF, command); END;
  1590. END CheckPointerUpEvent;
  1591. PROCEDURE InEditBounds(x,y: LONGINT): LONGINT;
  1592. CONST Border = 8;
  1593. VAR left, right, top, bottom: LONGINT;
  1594. BEGIN
  1595. left := bounds.GetLeft();
  1596. right := bounds.GetRight();
  1597. top := bounds.GetTop();
  1598. bottom := bounds.GetBottom();
  1599. INC(x,left); INC(y,top); (* relative -> absolute *)
  1600. IF (ABS(left-x) <= Border) THEN
  1601. IF (ABS(top-y) <= Border) THEN
  1602. RETURN UpperLeft
  1603. ELSIF (ABS(bottom-y) <= Border) THEN
  1604. RETURN LowerLeft
  1605. ELSE
  1606. RETURN Left
  1607. END
  1608. ELSIF (ABS(right-x) <= Border) THEN
  1609. IF (ABS(top-y) <= Border) THEN
  1610. RETURN UpperRight
  1611. ELSIF (ABS(bottom-y) <= Border) THEN
  1612. RETURN LowerRight
  1613. ELSE
  1614. RETURN Right
  1615. END
  1616. ELSIF (ABS(y-top) <= Border) THEN
  1617. RETURN Upper
  1618. ELSIF (ABS(bottom-y) <= Border) THEN
  1619. RETURN Lower
  1620. ELSIF (x > left+Border) & (x < right-Border) & (y > top+Border) & (y< bottom-Border) THEN
  1621. RETURN Inside
  1622. ELSE
  1623. RETURN None
  1624. END;
  1625. END InEditBounds;
  1626. PROCEDURE Edit(VAR msg: Messages.Message);
  1627. VAR region: LONGINT; dx,dy: LONGINT; b: Rectangles.Rectangle; manager: WM.WindowManager;
  1628. w,h: LONGINT; img: WMGraphics.Image; canvas: WMGraphics.BufferCanvas; e: ComponentListEntry;
  1629. alignRelative : BOOLEAN;
  1630. BEGIN
  1631. IF msg.msgSubType = Messages.MsgSubPointerUp THEN
  1632. editRegion := None;
  1633. SetPointerInfo(oldPointerInfo);
  1634. RETURN
  1635. END;
  1636. dx := msg.x-editX; dy := msg.y-editY;
  1637. b := bounds.Get();
  1638. IF editRegion = Right THEN
  1639. b.r := b.r + dx
  1640. ELSIF editRegion = Left THEN
  1641. b.l := b.l + dx; dx := 0;
  1642. ELSIF editRegion = Lower THEN
  1643. b.b := b.b + dy
  1644. ELSIF editRegion = Upper THEN
  1645. b.t := b.t + dy; dy := 0;
  1646. ELSIF editRegion = LowerLeft THEN
  1647. b.b := b.b + dy;
  1648. b.l := b.l + dx; dx := 0;
  1649. ELSIF editRegion = LowerRight THEN
  1650. b.b := b.b + dy;
  1651. b.r := b.r + dx
  1652. ELSIF editRegion = UpperLeft THEN
  1653. b.t := b.t + dy; dy := 0;
  1654. b.l := b.l + dx; dx := 0;
  1655. ELSIF editRegion = UpperRight THEN
  1656. b.t := b.t + dy; dy := 0;
  1657. b.r := b.r + dx
  1658. ELSIF (editRegion = Inside) & ((dx # 0) OR (dy # 0)) THEN
  1659. img := selection.ToImg(SELF,e);
  1660. IF e # NIL THEN
  1661. IF StartDrag(selection,img,-msg.x-e.dx,-msg.y-e.dy, EditMoved,NIL) THEN END;
  1662. END;
  1663. RETURN
  1664. END;
  1665. AdaptRelativeBounds(b, GetParent());
  1666. bounds.Set(b);
  1667. editX := editX + dx; editY := editY + dy;
  1668. END Edit;
  1669. PROCEDURE SetEditMode*(mode: BOOLEAN; recurse: BOOLEAN);
  1670. VAR vc: VisualComponent; c: XML.Content;
  1671. BEGIN
  1672. Acquire;
  1673. editMode.Set(mode);
  1674. IF recurse THEN
  1675. c := GetFirst();
  1676. WHILE (c # NIL) DO
  1677. IF c IS VisualComponent THEN
  1678. vc := c(VisualComponent);
  1679. vc.SetEditMode(mode, TRUE);
  1680. END;
  1681. c := GetNext(c);
  1682. END;
  1683. END;
  1684. Release;
  1685. END SetEditMode;
  1686. PROCEDURE EditMoved(sender, data: ANY);
  1687. VAR parent: XML.Element; ldata: ANY; e: ComponentListEntry;
  1688. BEGIN
  1689. IF (sender # SELF) THEN
  1690. IF (data # NIL) & (data IS WM.DragInfo) THEN
  1691. ldata := data(WM.DragInfo).data;
  1692. IF (ldata # NIL) & (ldata IS XML.Element) THEN
  1693. parent := ldata(XML.Element).GetParent();
  1694. parent.RemoveContent(ldata(XML.Element));
  1695. parent(VisualComponent).Invalidate;
  1696. ELSIF (ldata # NIL) & (ldata IS SelectionList) THEN
  1697. e := ldata(SelectionList).first;
  1698. WHILE e # NIL DO
  1699. parent := e.component.GetParent();
  1700. ldata := e.component;
  1701. parent.RemoveContent(ldata(XML.Element));
  1702. parent(VisualComponent).Invalidate;
  1703. e := e.next;
  1704. END;
  1705. END;
  1706. END;
  1707. END;
  1708. END EditMoved;
  1709. PROCEDURE HandleInternal*(VAR msg : Messages.Message); (** PROTECTED *)
  1710. VAR
  1711. po : VisualComponent; nm : Messages.Message; handled : BOOLEAN; b : Rectangles.Rectangle;
  1712. r, v : VisualComponent;
  1713. p : XML.Element;
  1714. keyFlags: SET; manager : WM.WindowManager;
  1715. currentEditRegion: LONGINT;
  1716. parent: XML.Element;
  1717. parentEditMode: BOOLEAN;
  1718. BEGIN
  1719. ASSERT(IsCallFromSequencer());
  1720. handled := FALSE;
  1721. IF msg.msgType = Messages.MsgPointer THEN
  1722. parent := GetParent();
  1723. IF (parent # NIL) & (parent IS VisualComponent) & parent(VisualComponent).editMode.Get() THEN
  1724. parentEditMode := TRUE
  1725. ELSE
  1726. parentEditMode := FALSE
  1727. END;
  1728. IF msg.msgSubType = Messages.MsgSubPointerMove THEN
  1729. IF (msg.flags * {0, 1, 2} = {}) OR (fPointerOwner = NIL) THEN
  1730. IF parentEditMode & ~editMode.Get() THEN fPointerOwner := SELF; handled := TRUE
  1731. ELSIF ~parentEditMode & (extGetPositionOwner # NIL) THEN extGetPositionOwner(msg.x, msg.y, fPointerOwner, handled);
  1732. END;
  1733. IF ~handled THEN
  1734. po := GetPositionOwner(msg.x, msg.y);
  1735. IF po # fPointerOwner THEN
  1736. nm.msgType := Messages.MsgPointer;
  1737. nm.msgSubType := Messages.MsgSubPointerLeave;
  1738. HandleInternal(nm)
  1739. END;
  1740. fPointerOwner := po
  1741. ELSE
  1742. handled := FALSE;
  1743. END;
  1744. END
  1745. END;
  1746. IF (fPointerOwner = SELF) THEN
  1747. IF (msg.originator # NIL) & (msg.originator IS WM.ViewPort) THEN
  1748. manager := msg.originator(WM.ViewPort).manager;
  1749. msg.originator(WM.ViewPort).GetKeyState(keyFlags);
  1750. END;
  1751. IF parentEditMode & (editRegion # None) THEN
  1752. Edit(msg)
  1753. ELSE
  1754. IF msg.msgSubType = Messages.MsgSubPointerMove THEN
  1755. IF (parentEditMode) & (msg.originator # NIL) & (msg.originator IS WM.ViewPort) THEN
  1756. currentEditRegion := InEditBounds(msg.x, msg.y);
  1757. CASE currentEditRegion OF
  1758. | Lower, Upper: SetPointerInfo(manager.pointerUpDown)
  1759. | Left, Right:SetPointerInfo(manager.pointerLeftRight)
  1760. | LowerLeft, UpperRight:SetPointerInfo(manager.pointerURDL)
  1761. | UpperLeft, LowerRight: SetPointerInfo(manager.pointerULDR)
  1762. | Inside: SetPointerInfo(manager.pointerMove)
  1763. ELSE
  1764. IF oldPointerInfo # NIL THEN
  1765. SetPointerInfo(oldPointerInfo); oldPointerInfo := NIL;
  1766. ELSE oldPointerInfo := GetPointerInfo();
  1767. END;
  1768. END;
  1769. END;
  1770. IF extPointerMove # NIL THEN extPointerMove(msg.x, msg.y, msg.flags, handled) END;
  1771. SetInternalPointerInfo(pointerInfo);
  1772. IF ~handled THEN PointerMove(msg.x, msg.y, msg.flags) END;
  1773. IF msg.dz # 0 THEN WheelMove(msg.dz) END
  1774. ELSIF msg.msgSubType = Messages.MsgSubPointerDown THEN
  1775. IF parentEditMode THEN
  1776. editRegion := InEditBounds(msg.x, msg.y);
  1777. END;
  1778. (*
  1779. IF (msg.originator # NIL) & (msg.originator IS WM.ViewPort) THEN
  1780. msg.originator(WM.ViewPort).GetKeyState(keyFlags);
  1781. IF (keyFlags # {}) & (keyFlags <= Inputs.Ctrl) THEN editRegion := InEditBounds(msg.x, msg.y) ELSE editRegion := None END;
  1782. ELSE
  1783. editRegion := None
  1784. END;
  1785. *)
  1786. IF editRegion # None THEN
  1787. IF (keyFlags # {}) & (keyFlags <= Inputs.Shift) THEN
  1788. selection.Toggle(SELF)
  1789. ELSIF ~selection.Has(SELF) THEN selection.Reset(SELF)
  1790. END;
  1791. manager := msg.originator(WM.ViewPort).manager;
  1792. editX := msg.x; editY := msg.y;
  1793. ELSE
  1794. IF extPointerDown # NIL THEN extPointerDown(msg.x, msg.y, msg.flags, handled) END;
  1795. IF ~handled THEN PointerDown(msg.x, msg.y, msg.flags) END;
  1796. END;
  1797. SetFocus
  1798. ELSIF msg.msgSubType = Messages.MsgSubPointerUp THEN
  1799. IF extPointerUp # NIL THEN extPointerUp(msg.x, msg.y, msg.flags, handled) END;
  1800. IF ~handled THEN PointerUp(msg.x, msg.y, msg.flags) END
  1801. ELSIF msg.msgSubType = Messages.MsgSubPointerLeave THEN
  1802. IF extPointerLeave # NIL THEN extPointerLeave(handled) END;
  1803. IF ~handled THEN PointerLeave END
  1804. END;
  1805. IF ~parentEditMode & (msg.flags * {0, 1, 2} # {}) THEN
  1806. IF (msg.msgSubType = Messages.MsgSubPointerDown) THEN
  1807. CheckPointerEvent(msg.x, msg.y, msg.z, msg.flags);
  1808. ELSIF msg.msgSubType = Messages.MsgSubPointerUp THEN
  1809. CheckPointerUpEvent(msg.x, msg.y, msg.z, msg.flags);
  1810. END;
  1811. END;
  1812. END;
  1813. ELSE
  1814. b := fPointerOwner.bounds.Get();
  1815. msg.x := msg.x - b.l; msg.y := msg.y - b.t;
  1816. fPointerOwner.Handle(msg)
  1817. END
  1818. ELSIF msg.msgType = Messages.MsgKey THEN
  1819. IF focusComponent # SELF THEN focusComponent.Handle(msg)
  1820. ELSIF EditKeyEvents(msg.x, msg.flags, msg.y) THEN
  1821. handled := TRUE;
  1822. ELSIF (visible.Get()) THEN
  1823. IF ~needsTab.Get() & (msg.y = 0FF09H) THEN
  1824. IF (Inputs.Shift * msg.flags # {}) THEN FocusPrev ELSE FocusNext END
  1825. ELSIF msg.y = 0FF67H THEN ShowContextMenu(0, 0)
  1826. ELSE
  1827. IF extKeyEvent # NIL THEN extKeyEvent(msg.x, msg.flags, msg.y, handled) END;
  1828. IF ~handled THEN KeyEvent(msg.x, msg.flags, msg.y) END;
  1829. CheckKeyEvents(msg.x, msg.flags, msg.y);
  1830. END
  1831. END;
  1832. ELSIF msg.msgType = Messages.MsgDrag THEN
  1833. IF extGetPositionOwner # NIL THEN extGetPositionOwner(msg.x, msg.y, po, handled); END;
  1834. IF ~handled THEN
  1835. po := GetPositionOwner(msg.x, msg.y);
  1836. ELSE
  1837. handled := FALSE;
  1838. END;
  1839. IF (po # SELF) & editMode.Get() & (~po.editMode.Get() OR (msg.ext # NIL) & (msg.ext(WM.DragInfo).data=po)) THEN
  1840. po := SELF
  1841. ELSIF (msg.ext # NIL) & (msg.ext(WM.DragInfo).data # NIL) & (msg.ext(WM.DragInfo).data IS ToggleEditMode) & (msg.ext(WM.DragInfo).data(ToggleEditMode).recursion = Recursion.FromBottom) THEN
  1842. po := SELF
  1843. END;
  1844. IF (po # SELF) THEN (* Let child handle the drag and drop message *)
  1845. b := po.bounds.Get();
  1846. msg.x := msg.x - b.l; msg.y := msg.y - b.t;
  1847. po.Handle(msg)
  1848. ELSE (* handle the drag and drop message *)
  1849. IF msg.msgSubType = Messages.MsgDragOver THEN
  1850. IF (msg.ext # NIL) THEN
  1851. IF extDragOver # NIL THEN extDragOver(msg.x, msg.y, msg.ext(WM.DragInfo), handled) END;
  1852. IF ~handled THEN po.DragOver(msg.x, msg.y, msg.ext(WM.DragInfo)) END
  1853. END
  1854. ELSIF msg.msgSubType = Messages.MsgDragDropped THEN
  1855. IF (msg.ext # NIL) THEN
  1856. IF (msg.ext(WM.DragInfo).data # NIL) & (msg.ext(WM.DragInfo).data IS ToggleEditMode) THEN
  1857. SetEditMode(~editMode.Get(), msg.ext(WM.DragInfo).data(ToggleEditMode).recursion # Recursion.None);
  1858. Invalidate;
  1859. ELSIF editMode.Get() THEN
  1860. handled := EditDragDropped(msg.x,msg.y,msg.ext(WM.DragInfo));
  1861. ELSIF extDragDropped # NIL THEN
  1862. extDragDropped(msg.x, msg.y, msg.ext(WM.DragInfo), handled)
  1863. END;
  1864. IF ~handled THEN
  1865. po.DragDropped(msg.x, msg.y, msg.ext(WM.DragInfo))
  1866. END
  1867. END
  1868. END
  1869. END
  1870. ELSIF (msg.msgType = Messages.MsgFocus) & (msg.msgSubType = Messages.MsgSubFocusLost) THEN
  1871. (* unset the old focus chain *)
  1872. r := GetVisualComponentRoot(); (* find the leaf component that has the focus *)
  1873. WHILE (r # NIL) & (r.focusComponent # NIL) & (r.focusComponent # r) DO r := r.focusComponent END;
  1874. p := r; (* clear the focus chain until the root or this component *)
  1875. WHILE (p # SELF) & (p # NIL) & (p IS VisualComponent) DO
  1876. v := p(VisualComponent);
  1877. v.focusComponent := v;
  1878. v.FocusLost; IF v.extFocus # NIL THEN v.extFocus(FALSE) END; p := p.GetParent()
  1879. END;
  1880. ELSIF msg.msgType = Messages.MsgInvalidate THEN
  1881. IF msg.msgSubType = Messages.MsgSubAll THEN
  1882. msg.sender(VisualComponent).InvalidateRect(GetClientRect());
  1883. ELSIF msg.msgSubType = Messages.MsgSubRectangle THEN
  1884. msg.sender(VisualComponent).InvalidateRect(Rectangles.MakeRect(msg.x, msg.y, msg.dx, msg.dy));
  1885. ELSE (* nothing to do *)
  1886. END;
  1887. ELSIF msg.msgType = Messages.MsgExt THEN
  1888. IF msg.ext = invalidateRectMsg THEN
  1889. TRACE("WARNING: OLD MESSAGE FORM");
  1890. msg.sender(VisualComponent).InvalidateRect(Rectangles.MakeRect(msg.x, msg.y, msg.dx, msg.dy))
  1891. ELSE
  1892. BroadcastSubcomponents(msg);
  1893. END
  1894. ELSE HandleInternal^(msg)
  1895. END;
  1896. END HandleInternal;
  1897. END VisualComponent;
  1898. GetPositionOwnerHandler* = PROCEDURE {DELEGATE} (x, y : LONGINT; VAR positionOwner : VisualComponent; VAR handled : BOOLEAN);
  1899. TYPE
  1900. (* Layout Manager *)
  1901. LayoutManager* = PROCEDURE {DELEGATE} (vc : VisualComponent);
  1902. FormWindow* = OBJECT(WM.DoubleBufferWindow)
  1903. VAR
  1904. form- : Form;
  1905. cs : WMGraphics.CanvasState;
  1906. disableUpdate : LONGINT;
  1907. content : VisualComponent;
  1908. scaling* : BOOLEAN;
  1909. PROCEDURE ToXML*():XML.Content;
  1910. VAR winx: XML.Element; a: XML.Attribute; string: ARRAY 128 OF CHAR; title:Strings.String;
  1911. BEGIN {EXCLUSIVE}
  1912. NEW(winx); winx.SetName("FormWindow");
  1913. NEW(a); a.SetName("name");
  1914. title:=GetTitle(); IF title=NIL THEN a.SetValue("componentWindow") ELSE a.SetValue(title^) END;
  1915. winx.AddAttribute(a);
  1916. NEW(a); a.SetName("loader"); a.SetValue("WMComponents.FormWindowGen"); winx.AddAttribute(a);
  1917. NEW(a); a.SetName("l"); Strings.IntToStr(bounds.l, string); a.SetValue(string); winx.AddAttribute(a);
  1918. NEW(a); a.SetName("t"); Strings.IntToStr(bounds.t, string); a.SetValue(string); winx.AddAttribute(a);
  1919. NEW(a); a.SetName("r"); Strings.IntToStr(bounds.r, string); a.SetValue(string); winx.AddAttribute(a);
  1920. NEW(a); a.SetName("b"); Strings.IntToStr(bounds.b, string); a.SetValue(string); winx.AddAttribute(a);
  1921. NEW(a); a.SetName("flags"); Strings.SetToStr(flags, string); a.SetValue(string); winx.AddAttribute(a);
  1922. NEW(a); a.SetName("canvasGenerator"); a.SetValue(canvas.generator^); winx.AddAttribute(a);
  1923. winx.AddContent(form);
  1924. RETURN winx
  1925. END ToXML;
  1926. PROCEDURE LoadComponents*(xml: XML.Element);
  1927. VAR component: Repositories.Component;
  1928. BEGIN
  1929. IF xml # NIL THEN
  1930. component := Repositories.ComponentFromXML(xml);
  1931. IF (component # NIL) & (component IS VisualComponent) THEN
  1932. SetContent(component);
  1933. ELSE
  1934. KernelLog.String("formwindow could not load content"); KernelLog.Ln;
  1935. END;
  1936. END;
  1937. END LoadComponents;
  1938. PROCEDURE StoreComponents*(): XML.Element;
  1939. BEGIN RETURN content (* do not store form separately *)
  1940. END StoreComponents;
  1941. PROCEDURE SetContent*(x : XML.Content);
  1942. VAR c: XML.Content;
  1943. m:Messages.Message;
  1944. BEGIN
  1945. IF sequencer # NIL THEN sequencer.WaitFree() END;
  1946. BEGIN{EXCLUSIVE}
  1947. INC(disableUpdate);
  1948. INCL(flags, 13); (* render windows background non-displayed*)
  1949. IF form # NIL THEN form.Finalize; form.sequencer.Stop; content:=NIL END;
  1950. IF x IS Form THEN
  1951. form := x(Form);
  1952. form.initialized:=FALSE;
  1953. form.SetWindow(SELF); (* includes new sequencer *)
  1954. c:=form.GetFirst(); (* get first VisualComponent content of form*)
  1955. WHILE (c#NIL) & (c IS XML.Container) & ~(c IS VisualComponent) DO
  1956. c:=c(XML.Container).GetNext(c);
  1957. END;
  1958. IF c#NIL THEN form.RemoveContent(c) END; (* avoid duplicates. will be added in a systematic way below in AddContent *)
  1959. ELSE
  1960. NEW(form, SELF); (* includes new sequencer; initialized=FALSE *)
  1961. form.uid.Set(NewString("form"));
  1962. c:=x;
  1963. END;
  1964. IF (c#NIL) & (c IS VisualComponent) THEN
  1965. content := c(VisualComponent);
  1966. form.initialized:=TRUE;
  1967. form.AddContent(content);
  1968. form.focusComponent := content;
  1969. form.fPointerOwner := content;
  1970. END;
  1971. DEC(disableUpdate);
  1972. END;
  1973. form.Initialize;
  1974. form.Invalidate;
  1975. END SetContent;
  1976. PROCEDURE DisableUpdate*;
  1977. BEGIN {EXCLUSIVE}
  1978. INC(disableUpdate);
  1979. ASSERT(disableUpdate # -1); (* overflow *)
  1980. END DisableUpdate;
  1981. PROCEDURE EnableUpdate*;
  1982. BEGIN {EXCLUSIVE}
  1983. DEC(disableUpdate);
  1984. ASSERT(disableUpdate # -1); (* underflow *)
  1985. END EnableUpdate;
  1986. PROCEDURE Resized( width, height: LONGINT);
  1987. BEGIN
  1988. IF ~scaling THEN
  1989. DisableUpdate;
  1990. form.Acquire;
  1991. ReInit(width, height);
  1992. form.Release;
  1993. form.bounds.Set(Rectangles.MakeRect(0, 0, GetWidth(), GetHeight()));
  1994. content.bounds.Set(Rectangles.MakeRect(0, 0, GetWidth(), GetHeight()));
  1995. EnableUpdate;
  1996. form.Invalidate()
  1997. END
  1998. END Resized;
  1999. PROCEDURE Trap():BOOLEAN;
  2000. BEGIN
  2001. KernelLog.String("WMComponents.FormWindow.Trap !!! --> Resetting Locks "); KernelLog.Ln;
  2002. form.sequencer.lock.Reset;
  2003. RETURN TRUE
  2004. END Trap;
  2005. PROCEDURE Update(rect : Rectangles.Rectangle);
  2006. BEGIN
  2007. (*KernelLog.String("Update "); KernelLog.Int(disableUpdate,0); KernelLog.Ln;*)
  2008. IF disableUpdate > 0 THEN RETURN END;
  2009. form.Acquire;
  2010. canvas.SaveState(cs);
  2011. canvas.SetClipRect(rect);
  2012. canvas.ClipRectAsNewLimits(0, 0);
  2013. IF Raster.alpha IN img.fmt.components THEN
  2014. canvas.Fill(rect, 0H, WMGraphics.ModeCopy)
  2015. ELSE
  2016. canvas.Fill(rect, 0H (*0FFH*), Raster.clear(*WMGraphics.ModeCopy*))
  2017. END;
  2018. form.Draw(canvas);
  2019. canvas.RestoreState(cs);
  2020. form.Release;
  2021. CopyRect(rect);
  2022. Invalidate(rect)
  2023. END Update;
  2024. PROCEDURE Handle*(VAR m : Messages.Message);
  2025. VAR pendingM: Messages.Message;
  2026. BEGIN
  2027. Handle^(m);
  2028. IF (m.msgType = Messages.MsgExt) & (m.ext # NIL) THEN
  2029. IF (m.ext = componentStyleMsg) THEN CSChanged
  2030. END;
  2031. ELSIF (m.msgType = Messages.MsgFocus) & (m.msgSubType = Messages.MsgSubFocusGot) THEN
  2032. IF (form # NIL) & (form.lastFocusComponent # NIL) THEN
  2033. form.lastFocusComponent.SetFocus;
  2034. END;
  2035. ELSIF (m.msgType = Messages.MsgSetLanguage) & (m.ext # NIL) & (m.ext IS LanguageExtension) THEN
  2036. LanguageChanged(m.ext(LanguageExtension).languages);
  2037. ELSIF (m.msgType=Messages.MsgInvalidate) THEN (* sent by WindowManager when a window is added to display space to assure it is up-to-date*)
  2038. IF form=NIL THEN RETURN
  2039. ELSE m.sender:=form; (* will be passed to form below, which will call sender.InvalidateRect *)
  2040. END;
  2041. END;
  2042. IF (TraceFocus IN Trace) THEN
  2043. IF (m.msgType = Messages.MsgFocus) THEN
  2044. IF (m.msgSubType = Messages.MsgSubFocusGot) THEN
  2045. KernelLog.String("Got Focus: "); form.TraceFocusChain;
  2046. ELSIF (m.msgSubType = Messages.MsgSubMasterFocusGot) THEN
  2047. KernelLog.String("Got Master Focus: "); form.TraceFocusChain;
  2048. END;
  2049. ELSIF (m.msgType = Messages.MsgKey) & (m.x = ORD("f")) THEN
  2050. KernelLog.String("Focus chain: "); form.TraceFocusChain;
  2051. END;
  2052. END;
  2053. IF (form # NIL) THEN form.Handle(m); END;
  2054. END Handle;
  2055. PROCEDURE LanguageChanged*(languages : Localization.Languages);
  2056. BEGIN
  2057. ASSERT(languages # NIL);
  2058. END LanguageChanged;
  2059. PROCEDURE CSChanged*;
  2060. BEGIN
  2061. DisableUpdate; (* the components are going to redraw like crazy *)
  2062. form.Acquire;
  2063. form.Reset(SELF, NIL);
  2064. form.Release;
  2065. EnableUpdate;
  2066. END CSChanged;
  2067. PROCEDURE Close*;
  2068. BEGIN
  2069. Close^; (* remove the form to avoid further messages *)
  2070. IF form # NIL THEN
  2071. form.Acquire;
  2072. form.Finalize; form.sequencer.Stop;
  2073. form.Release
  2074. END;
  2075. END Close;
  2076. END FormWindow;
  2077. Form* = OBJECT(VisualComponent)
  2078. VAR
  2079. window- : FormWindow;
  2080. lastFocusComponent : VisualComponent;
  2081. PROCEDURE &New*(window : FormWindow);
  2082. BEGIN
  2083. Init;
  2084. SetGenerator("WMComponents.NewForm");
  2085. lastFocusComponent := NIL;
  2086. SetNameAsString(StrForm);
  2087. SetWindow(window);
  2088. END New;
  2089. PROCEDURE SetWindow*(window: FormWindow);
  2090. VAR seq: Messages.MsgSequencer;
  2091. BEGIN {EXCLUSIVE}
  2092. IF window # NIL THEN
  2093. SELF.window := window;
  2094. window.form := SELF;
  2095. bounds.Set(Rectangles.MakeRect(0, 0, window.GetWidth(), window.GetHeight()));
  2096. NEW(seq, Handle); seq.SetTrapHandler(window.Trap); SetSequencer(seq);
  2097. END;
  2098. END SetWindow;
  2099. PROCEDURE GetPointerInfo*() : WM.PointerInfo;
  2100. BEGIN
  2101. ASSERT(IsCallFromSequencer());
  2102. IF window # NIL THEN RETURN window.pointerInfo ELSE RETURN NIL END
  2103. END GetPointerInfo;
  2104. PROCEDURE SetPointerInfo*(pi : WM.PointerInfo);
  2105. BEGIN
  2106. ASSERT(IsCallFromSequencer());
  2107. IF window # NIL THEN window.SetPointerInfo(pi) END;
  2108. END SetPointerInfo;
  2109. PROCEDURE DisableUpdate*;
  2110. BEGIN
  2111. ASSERT(IsCallFromSequencer());
  2112. IF window # NIL THEN window.DisableUpdate END
  2113. END DisableUpdate;
  2114. PROCEDURE EnableUpdate*;
  2115. BEGIN
  2116. ASSERT(IsCallFromSequencer());
  2117. IF window # NIL THEN window.EnableUpdate END
  2118. END EnableUpdate;
  2119. PROCEDURE InvalidateRect*(rect : Rectangles.Rectangle);
  2120. BEGIN
  2121. IF window # NIL THEN
  2122. BEGIN{EXCLUSIVE} AWAIT(initialized) END;
  2123. window.Update(rect)
  2124. END;
  2125. END InvalidateRect;
  2126. PROCEDURE PropertyChanged*(sender, property : ANY);
  2127. VAR w,h: LONGINT;
  2128. BEGIN
  2129. IF property = bounds THEN
  2130. IF ~ Rectangles.IsEqual(window.bounds, bounds.Get()) THEN
  2131. bounds.GetExtents(w,h);
  2132. IF window # NIL THEN
  2133. window.manager.SetWindowSize(window,w,h);
  2134. END;
  2135. ELSE
  2136. (*ScaleFont(bounds.GetHeight(), scaleFont.Get());*)
  2137. Resized
  2138. END;
  2139. END
  2140. END PropertyChanged;
  2141. END Form;
  2142. TYPE
  2143. (** PropertyLists for style support *)
  2144. PropertyListEntry = POINTER TO RECORD
  2145. next : PropertyListEntry;
  2146. name : Strings.String;
  2147. list : WMProperties.PropertyList;
  2148. END;
  2149. ListArray* = POINTER TO ARRAY OF WMProperties.PropertyList;
  2150. PropertyListList* = OBJECT
  2151. VAR
  2152. first : PropertyListEntry;
  2153. PROCEDURE Find*(CONST name : ARRAY OF CHAR) : WMProperties.PropertyList;
  2154. VAR cur : PropertyListEntry;
  2155. BEGIN {EXCLUSIVE}
  2156. cur := first;
  2157. WHILE (cur # NIL) & (cur.name^ # name) DO cur := cur.next END;
  2158. IF cur # NIL THEN RETURN cur.list
  2159. ELSE RETURN NIL
  2160. END
  2161. END Find;
  2162. PROCEDURE RemoveInternal(CONST name : ARRAY OF CHAR);
  2163. VAR cur : PropertyListEntry;
  2164. BEGIN
  2165. IF first = NIL THEN RETURN END;
  2166. IF (first # NIL) & (first.name^ = name) THEN first := first.next
  2167. ELSE
  2168. cur := first;
  2169. WHILE (cur.next # NIL) DO
  2170. IF (cur.next.name^ = name) THEN cur.next := cur.next.next END;
  2171. cur := cur.next
  2172. END
  2173. END
  2174. END RemoveInternal;
  2175. PROCEDURE Remove*(CONST name : ARRAY OF CHAR);
  2176. BEGIN {EXCLUSIVE}
  2177. RemoveInternal(name)
  2178. END Remove;
  2179. PROCEDURE Add*(CONST name : ARRAY OF CHAR; pl : WMProperties.PropertyList);
  2180. VAR new : PropertyListEntry;
  2181. BEGIN {EXCLUSIVE}
  2182. RemoveInternal(name);
  2183. NEW(new); new.name := NewString(name); new.list := pl; new.next := first; first := new
  2184. END Add;
  2185. PROCEDURE Enumerate*() : ListArray;
  2186. VAR array : ListArray; current : PropertyListEntry; i : LONGINT;
  2187. BEGIN {EXCLUSIVE}
  2188. i := 0;
  2189. current := first;
  2190. WHILE current # NIL DO INC(i); current := current.next END;
  2191. NEW(array, i );
  2192. current := first;
  2193. i := 0;
  2194. WHILE current # NIL DO
  2195. array[i] := current.list;
  2196. INC(i);
  2197. current := current.next
  2198. END;
  2199. RETURN array
  2200. END Enumerate;
  2201. PROCEDURE UpdateStyle*;
  2202. VAR
  2203. en : XMLObjects.Enumerator;
  2204. p : ANY; s : Strings.String;
  2205. pl : WMProperties.PropertyList;
  2206. BEGIN
  2207. IF currentStyle = NIL THEN RETURN END;
  2208. en := currentStyle.GetContents();
  2209. WHILE en.HasMoreElements() DO
  2210. p := en.GetNext();
  2211. IF p IS XML.Element THEN
  2212. s := p(XML.Element).GetName();
  2213. pl := propertyListList.Find(s^);
  2214. IF pl # NIL THEN pl.SetXML(p(XML.Element)) END
  2215. END
  2216. END
  2217. END UpdateStyle;
  2218. END PropertyListList;
  2219. ComponentListEntry= POINTER TO RECORD
  2220. component: VisualComponent;
  2221. dx,dy: LONGINT;
  2222. next: ComponentListEntry
  2223. END;
  2224. SelectionArray* = POINTER TO ARRAY OF VisualComponent;
  2225. SelectionList*= OBJECT
  2226. VAR first, last: ComponentListEntry; number: LONGINT; state: LONGINT; timer: Kernel.Timer;
  2227. onChanged-: WMEvents.EventSource;
  2228. lock: Locks.RecursiveLock;
  2229. PROCEDURE &Init;
  2230. BEGIN
  2231. NEW(lock);
  2232. first := NIL; last := NIL; number := 0; state := 0; NEW(onChanged, NIL, NIL, NIL, NIL);
  2233. END Init;
  2234. PROCEDURE Reset(this: VisualComponent);
  2235. VAR entry: ComponentListEntry;
  2236. BEGIN
  2237. lock.Acquire;
  2238. entry := first;
  2239. first := NIL; last := NIL; number := 0;
  2240. WHILE entry # NIL DO entry.component.Invalidate; entry := entry.next END;
  2241. lock.Release;
  2242. Add(this);
  2243. onChanged.Call(SELF);
  2244. END Reset;
  2245. PROCEDURE Has*(this: ANY): BOOLEAN;
  2246. VAR entry: ComponentListEntry;
  2247. BEGIN
  2248. IF first = NIL THEN RETURN FALSE END; (* no lock for usual case *)
  2249. lock.Acquire;
  2250. entry := first;
  2251. WHILE (entry # NIL) & (entry.component # this) DO entry := entry.next END;
  2252. lock.Release;
  2253. RETURN entry # NIL
  2254. END Has;
  2255. PROCEDURE Add*(this: VisualComponent);
  2256. VAR entry: ComponentListEntry;
  2257. BEGIN
  2258. IF (this = NIL) OR Has(this) THEN RETURN END;
  2259. lock.Acquire;
  2260. NEW(entry); entry.component := this; entry.next := NIL;
  2261. IF last = NIL THEN
  2262. ASSERT(first = NIL);
  2263. first := entry; last := entry;
  2264. ELSE
  2265. last.next := entry; last := entry
  2266. END;
  2267. INC(number);
  2268. lock.Release;
  2269. this.Invalidate;
  2270. onChanged.Call(SELF);
  2271. END Add;
  2272. PROCEDURE Remove*(this: VisualComponent);
  2273. VAR entry, prev: ComponentListEntry;
  2274. BEGIN
  2275. lock.Acquire;
  2276. entry := first; prev := NIL;
  2277. WHILE (entry # NIL) & (entry.component # this) DO
  2278. prev := entry;
  2279. entry := entry.next;
  2280. END;
  2281. IF entry = NIL THEN lock.Release; RETURN END;
  2282. IF prev # NIL THEN prev.next := entry.next END;
  2283. IF entry = first THEN first := first.next END;
  2284. IF entry = last THEN last := prev END;
  2285. DEC(number);
  2286. lock.Release;
  2287. this.Invalidate;
  2288. onChanged.Call(SELF);
  2289. END Remove;
  2290. PROCEDURE GetSelection*(): SelectionArray;
  2291. VAR array: SelectionArray; i: LONGINT; e: ComponentListEntry;
  2292. BEGIN
  2293. lock.Acquire;
  2294. NEW(array, number);
  2295. e := first; i := 0;
  2296. WHILE e # NIL DO
  2297. array[i] := e.component;
  2298. INC(i);
  2299. e := e.next;
  2300. END;
  2301. lock.Release;
  2302. RETURN array;
  2303. END GetSelection;
  2304. PROCEDURE Toggle*(this: VisualComponent);
  2305. BEGIN
  2306. IF Has(this) THEN Remove(this) ELSE Add(this) END;
  2307. END Toggle;
  2308. PROCEDURE Update;
  2309. VAR e: ComponentListEntry;
  2310. BEGIN
  2311. e := first;
  2312. WHILE e # NIL DO
  2313. e.component.Invalidate;
  2314. e := e.next;
  2315. END;
  2316. END Update;
  2317. PROCEDURE Shift(dx, dy: LONGINT);
  2318. VAR e: ComponentListEntry; rect: Rectangles.Rectangle;
  2319. BEGIN
  2320. e := first;
  2321. WHILE e # NIL DO
  2322. rect := e.component.bounds.Get();
  2323. INC(rect.l,dx); INC(rect.r,dx);
  2324. INC(rect.t,dy); INC(rect.b,dy);
  2325. e.component.AdaptRelativeBounds(rect,e.component.GetParent());
  2326. e.component.bounds.Set(rect);
  2327. e := e.next
  2328. END;
  2329. END Shift;
  2330. PROCEDURE ToImg(start: VisualComponent; VAR this: ComponentListEntry): WMGraphics.Image;
  2331. VAR l,t,r,b: LONGINT; e: ComponentListEntry; rect: Rectangles.Rectangle; img, image: WMGraphics.Image; w,h: LONGINT;
  2332. canvas: WMGraphics.BufferCanvas; srcCopy: Raster.Mode;
  2333. BEGIN
  2334. l := MAX(LONGINT); r := MIN(LONGINT);
  2335. t := MAX(LONGINT); b := MIN(LONGINT);
  2336. e := first;
  2337. WHILE e # NIL DO
  2338. rect := e.component(VisualComponent).bounds.Get();
  2339. IF rect.l < l THEN l := rect.l END;
  2340. IF rect.r > r THEN r := rect.r END;
  2341. IF rect.t < t THEN t := rect.t END;
  2342. IF rect.b > b THEN b := rect.b END;
  2343. e := e.next;
  2344. END;
  2345. Raster.InitMode(srcCopy, Raster.srcCopy);
  2346. NEW(image);
  2347. w := r-l+1; h := b-t+1;
  2348. Raster.Create(image, w,h, Raster.BGRA8888);
  2349. e := first;
  2350. WHILE e # NIL DO
  2351. rect := e.component.bounds.Get();
  2352. NEW(img);
  2353. Raster.Create(img,rect.r-rect.l+1, rect.b-rect.t+1, Raster.BGRA8888);
  2354. NEW(canvas,img);
  2355. e.component.Draw(canvas);
  2356. Raster.Copy(img,image,0,0,img.width-1, img.height-1,rect.l-l, rect.t-t, srcCopy);
  2357. e.dx := rect.l-l; e.dy := rect.t-t;
  2358. IF e.component = start THEN this := e END;
  2359. e := e.next
  2360. END;
  2361. RETURN image
  2362. END ToImg;
  2363. BEGIN {ACTIVE}
  2364. NEW(timer);
  2365. LOOP
  2366. timer.Sleep(400);
  2367. state := (state + 1) MOD 2;
  2368. Update;
  2369. END
  2370. END SelectionList;
  2371. WindowGenerator*= PROCEDURE(xml: XML.Content): WM.Window;
  2372. VAR
  2373. hasErrors : BOOLEAN; (* accessed only from (EXCLUSIVE) *)
  2374. invalidateRectMsg- : Messages.MessageExtension; (* used as unique ID *)
  2375. PrototypeID, PrototypeUID : WMProperties.StringProperty;
  2376. PrototypeBounds-, PrototypeBoundsRelative-, PrototypeBearing : WMProperties.RectangleProperty;
  2377. PrototypeEnabled : WMProperties.BooleanProperty;
  2378. PrototypeFillColor : WMProperties.ColorProperty;
  2379. PrototypeAlignment : WMProperties.Int32Property;
  2380. PrototypeVisible, PrototypeTakesFocus, PrototypeNeedsTab, PrototypeEditMode: WMProperties.BooleanProperty;
  2381. PrototypeScaleFont: WMProperties.Int32Property;
  2382. PrototypeFocusPrevious, PrototypeFocusNext : WMProperties.StringProperty;
  2383. PrototypeFont- : WMProperties.FontProperty;
  2384. StrComponent, StrVisualComponent, StrForm, StrFormWindow, StrModel, StrModelInfo : Strings.String;
  2385. GSonStartDrag, GSonStartDragInfo : Strings.String;
  2386. ModelPrototype-: WMProperties.ReferenceProperty;
  2387. propertyListList- : PropertyListList;
  2388. currentStyle- : XML.Element;
  2389. componentStyleMsg- : ComponentStyleChanged;
  2390. timestamp : LONGINT;
  2391. macroHandlers : MacroHandler; (* the head of the list is always the DefaultMacroHandler *)
  2392. selection-: SelectionList;
  2393. (*
  2394. PROCEDURE ResetInternal(parent:Component);
  2395. VAR c: XML.Content;
  2396. BEGIN
  2397. IF ~parent.initialized THEN parent.Initialize END;
  2398. (*parent.RecacheProperties;*)
  2399. c := parent.GetFirst();
  2400. WHILE (c # NIL) DO
  2401. IF c IS Component THEN
  2402. ResetInternal(c(Component))
  2403. END;
  2404. c := parent.GetNext(c);
  2405. END;
  2406. END ResetInternal;
  2407. *)
  2408. PROCEDURE IsWhiteSpace(ch : CHAR) : BOOLEAN;
  2409. BEGIN
  2410. RETURN ch <= " ";
  2411. END IsWhiteSpace;
  2412. PROCEDURE SkipWhiteSpace(CONST string : ARRAY OF CHAR; VAR index : LONGINT);
  2413. VAR length : LONGINT;
  2414. BEGIN
  2415. length := LEN(string);
  2416. WHILE (index < length) & (string[index] # 0X) & IsWhiteSpace(string[index]) DO INC(index); END;
  2417. ASSERT(index < LEN(string));
  2418. END SkipWhiteSpace;
  2419. PROCEDURE ReadWord*(CONST string : ARRAY OF CHAR; VAR word : ARRAY OF CHAR; VAR index : LONGINT) : BOOLEAN;
  2420. VAR length, wordLength, i : LONGINT;
  2421. BEGIN
  2422. SkipWhiteSpace(string, index);
  2423. length := LEN(string);
  2424. wordLength := LEN(word);
  2425. i := 0;
  2426. WHILE (index < length) & (string[index] # 0X) & ~IsWhiteSpace(string[index]) & (i < wordLength) DO
  2427. word[i] := string[index];
  2428. INC(i);
  2429. INC(index);
  2430. END;
  2431. IF (i < wordLength) THEN word[i] := 0X; END;
  2432. ASSERT(index < LEN(string));
  2433. RETURN (i > 0) & (index < length) & (i < wordLength);
  2434. END ReadWord;
  2435. (* Split <string> into two strings separated by <separator> *)
  2436. PROCEDURE SplitMacroString(CONST string : ARRAY OF CHAR; VAR namespace, name : ARRAY OF CHAR; separator : CHAR);
  2437. VAR i, j : LONGINT;
  2438. BEGIN
  2439. ASSERT((LEN(namespace) >= LEN(string)) & (LEN(name) >= LEN(string)));
  2440. i := 0;
  2441. WHILE (i < LEN(string)) & (string[i] # 0X) & (string[i] # separator) DO
  2442. namespace[i] := string[i];
  2443. INC(i);
  2444. END;
  2445. namespace[i] := 0X;
  2446. INC(i); (* skip separator *)
  2447. j := 0;
  2448. WHILE (i < LEN(string)) & (string[i] # 0X) DO
  2449. name[j] := string[i];
  2450. INC(i); INC(j);
  2451. END;
  2452. name[j] := 0X;
  2453. IF (name = "") THEN COPY(namespace, name); COPY(NoNamespace, namespace); END; (* no namespace *)
  2454. END SplitMacroString;
  2455. PROCEDURE ReportError(CONST text, argument1, argument2 : ARRAY OF CHAR);
  2456. VAR
  2457. message : Events.Message;
  2458. textIdx, messageIdx : LONGINT;
  2459. secondArgument : BOOLEAN;
  2460. PROCEDURE Append(VAR message : ARRAY OF CHAR; CONST argument : ARRAY OF CHAR; VAR index : LONGINT);
  2461. VAR i : LONGINT;
  2462. BEGIN
  2463. i := 0;
  2464. WHILE (i < LEN(argument)) & (argument[i] # 0X) & (index < LEN(message) - 1) DO
  2465. message[index] := argument[i];
  2466. INC(i);
  2467. INC(index);
  2468. END;
  2469. END Append;
  2470. BEGIN
  2471. secondArgument := FALSE;
  2472. textIdx := 0;
  2473. messageIdx := 0;
  2474. WHILE (textIdx < LEN(text)) & (text[textIdx] # 0X) & (messageIdx < LEN(message) - 1) DO
  2475. IF (text[textIdx] # "%") THEN
  2476. message[messageIdx] := text[textIdx];
  2477. INC(messageIdx);
  2478. ELSE
  2479. IF ~secondArgument THEN
  2480. secondArgument := TRUE;
  2481. Append(message, argument1, messageIdx);
  2482. ELSE
  2483. Append(message, argument2, messageIdx);
  2484. END;
  2485. END;
  2486. INC(textIdx);
  2487. END;
  2488. message[messageIdx] := 0X;
  2489. Events.AddEvent("Components", Events.Error, 0, 0, 0, message, FALSE);
  2490. END ReportError;
  2491. PROCEDURE GetArgumentStream*(command: Strings.String; offset: LONGINT; VAR arguments: Streams.StringReader);
  2492. VAR i: LONGINT;
  2493. BEGIN
  2494. IF command = NIL THEN arguments := NIL; RETURN END;
  2495. i := offset;
  2496. WHILE (i < LEN(command)) & (command[i] # 0X) DO INC(i); END;
  2497. IF (i # offset) THEN
  2498. NEW(arguments, i - offset + 1);
  2499. arguments.SetRaw(command^, offset, i - offset + 1);
  2500. ELSE
  2501. arguments := NIL;
  2502. END;
  2503. END GetArgumentStream;
  2504. PROCEDURE GenerateContext*(oldCommand, command : Strings.String; index : LONGINT; originator : Component; CONST event : Event) : EventContext;
  2505. VAR
  2506. context : EventContext; pointerContext : PointerContext; keyContext : KeyContext;
  2507. arguments : Streams.StringReader;
  2508. i : LONGINT;
  2509. BEGIN
  2510. ASSERT((command # NIL) & (0 <= index) & (index < LEN(command)));
  2511. ASSERT(originator # NIL);
  2512. GetArgumentStream(command,index,arguments);
  2513. IF (event IS PointerEvent) THEN
  2514. NEW(pointerContext, originator, oldCommand, NIL, arguments, NIL, NIL, NIL); pointerContext.pointer := event(PointerEvent);
  2515. context := pointerContext;
  2516. ELSIF (event IS KeyPressedEvent) THEN
  2517. NEW(keyContext, originator, oldCommand, NIL, arguments, NIL, NIL, NIL); keyContext.key := event(KeyPressedEvent);
  2518. context := keyContext;
  2519. ELSE
  2520. NEW(context, originator, oldCommand, NIL, arguments, NIL, NIL, NIL);
  2521. END;
  2522. BEGIN {EXCLUSIVE}
  2523. context.timestamp := timestamp;
  2524. INC(timestamp);
  2525. END;
  2526. ASSERT(context # NIL);
  2527. RETURN context;
  2528. END GenerateContext;
  2529. PROCEDURE HandleEvent*(CONST event : Event; originator : Component; command : Strings.String);
  2530. VAR
  2531. commandString : ARRAY 128 OF CHAR;
  2532. newCommand : Strings.String;
  2533. context : EventContext;
  2534. msg : Events.Message;
  2535. index : LONGINT;
  2536. BEGIN
  2537. ASSERT((originator # NIL) & (command # NIL));
  2538. index := 0;
  2539. IF Logging THEN
  2540. COPY(command^, msg);
  2541. Events.AddEvent("Components", Events.Information, 0, 0, 0, msg, FALSE);
  2542. END;
  2543. SubstituteMacros(command, newCommand, originator);
  2544. IF ReadWord(newCommand^, commandString, index) THEN
  2545. context := GenerateContext(command, newCommand, index, originator, event);
  2546. Commands.Activate(commandString, context, {}, context.result, msg); (* asynchronous call since holding the originators lock! *)
  2547. IF (context.result # Commands.Ok) THEN
  2548. Events.AddEvent("Components", Events.Error, 0, 0, 0, msg, FALSE);
  2549. END;
  2550. ELSE
  2551. Events.AddEvent("Components", Events.Error, 0, 0, 0, "Expected command", FALSE);
  2552. END;
  2553. END HandleEvent;
  2554. PROCEDURE ContainsMacros(CONST string : ARRAY OF CHAR) : BOOLEAN;
  2555. VAR result : BOOLEAN; length, i : LONGINT;
  2556. BEGIN
  2557. result := FALSE;
  2558. i := 0; length := LEN(string);
  2559. WHILE (i < length) & (string[i] # 0X) & ~result DO
  2560. IF (string[i] = MacroCharacter) THEN
  2561. result := (i + 1 < length) & (string[i+1] # MacroCharacter);
  2562. IF ~result THEN (* two consequent MacroCharacter's are used to escape *)
  2563. INC(i); (*skip string[i+1] *)
  2564. END;
  2565. END;
  2566. INC(i);
  2567. END;
  2568. RETURN result;
  2569. END ContainsMacros;
  2570. PROCEDURE WriteSelectionToStream(w : Streams.Writer);
  2571. VAR text : Texts.Text; from, to : Texts.TextPosition; a, b : LONGINT;
  2572. BEGIN
  2573. ASSERT(w # NIL);
  2574. IF Texts.GetLastSelection(text, from, to) THEN
  2575. text.AcquireRead;
  2576. a := Strings.Min(from.GetPosition(), to.GetPosition());
  2577. b := Strings.Max(from.GetPosition(), to.GetPosition());
  2578. IF (text.GetLength() > 0) THEN
  2579. TextUtilities.SubTextToStream(text, a, b - a + 1, w);
  2580. END;
  2581. text.ReleaseRead;
  2582. END;
  2583. END WriteSelectionToStream;
  2584. PROCEDURE SubstituteMacro(CONST command : Strings.String; VAR index : LONGINT; originator : Component; w : Streams.Writer);
  2585. VAR oldIndex : LONGINT; macro, namespace, name : Macro; handler : MacroHandlerProcedure; handled : BOOLEAN;
  2586. BEGIN
  2587. ASSERT((command # NIL) & (0 <= index) & (index < LEN(command)) & (command[index] = MacroCharacter));
  2588. ASSERT(originator # NIL);
  2589. ASSERT(w # NIL);
  2590. oldIndex := index;
  2591. INC(index); (* skip MacroCharacter *)
  2592. IF ReadWord(command^, macro, index) THEN (*? TBD error handling *)
  2593. SplitMacroString(macro, namespace, name, NamespaceCharacter);
  2594. IF (namespace = NoNamespace) OR (namespace = DefaultNamespace) THEN
  2595. handler := DefaultMacroHandler;
  2596. ELSE
  2597. BEGIN {EXCLUSIVE}
  2598. handler := FindMacroHandler(namespace);
  2599. END;
  2600. END;
  2601. handled := FALSE;
  2602. IF (handler # NIL) THEN handler(name, originator, w, handled); END;
  2603. IF ~handled THEN
  2604. w.Char(MacroCharacter); w.String(macro); (* don't substitute *)
  2605. END;
  2606. END;
  2607. ASSERT(index > oldIndex);
  2608. END SubstituteMacro;
  2609. PROCEDURE SubstituteMacros*(CONST command : Strings.String; VAR newCommand : Strings.String; originator : Component);
  2610. VAR index, oldIndex, length : LONGINT; w : Streams.Writer; buffer : Strings.Buffer;
  2611. BEGIN
  2612. ASSERT((command # NIL) & (originator # NIL));
  2613. IF ContainsMacros(command^) THEN
  2614. NEW(buffer, 256);
  2615. w := buffer.GetWriter();
  2616. index := 0; length := LEN(command^);
  2617. WHILE (index < length) & (command[index] # 0X) DO
  2618. oldIndex := index;
  2619. IF (command[index] = MacroCharacter) THEN
  2620. IF (index + 1 < length) & (command[index + 1] = MacroCharacter) THEN (* escape *)
  2621. w.Char(MacroCharacter);
  2622. index := index + 2; (* skip both MacroCharacter's *)
  2623. ELSE
  2624. (* substitute macro *)
  2625. SubstituteMacro(command, index, originator, w);
  2626. END;
  2627. ELSE
  2628. w.Char(command[index]);
  2629. INC(index);
  2630. END;
  2631. ASSERT(index > oldIndex);
  2632. END;
  2633. newCommand := buffer.GetString();
  2634. ELSE
  2635. newCommand := command;
  2636. END;
  2637. ASSERT(newCommand # NIL);
  2638. END SubstituteMacros;
  2639. PROCEDURE GetAttributeValue(originator : Component; CONST fullname : ARRAY OF CHAR) : Strings.String;
  2640. VAR value : Strings.String; c : Component; component, attribute : ARRAY 64 OF CHAR;
  2641. BEGIN
  2642. ASSERT(originator # NIL);
  2643. value := NIL;
  2644. Strings.GetExtension(fullname, component, attribute);
  2645. IF (attribute = "") THEN
  2646. COPY(component, attribute);
  2647. COPY("", component);
  2648. END;
  2649. IF (component[0] = "@") THEN component[0] := "&"; END; (*? TBD: Hack to avoid ampersand in XML *)
  2650. IF (component = "") THEN
  2651. c := originator;
  2652. ELSE
  2653. c := originator.Find(component);
  2654. END;
  2655. IF (c # NIL) THEN
  2656. IF c.HasAttribute(attribute) THEN
  2657. RETURN c.GetAttributeValue(attribute);
  2658. ELSE
  2659. ReportError("Attribute % of component % not found", attribute, component);
  2660. END;
  2661. ELSE
  2662. ReportError("Component % not found", component, "");
  2663. END;
  2664. RETURN value;
  2665. END GetAttributeValue;
  2666. PROCEDURE GetPropertyValue(originator : Component; CONST fullname : ARRAY OF CHAR) : Strings.String;
  2667. VAR value : ARRAY 256 OF CHAR; string:Strings.String; c : Component; component, property : ARRAY 64 OF CHAR;
  2668. BEGIN
  2669. ASSERT(originator # NIL);
  2670. Strings.GetExtension(fullname, component, property);
  2671. IF (property = "") THEN COPY(component, property); COPY("", component);
  2672. END;
  2673. IF (component[0] = "@") THEN component[0] := "&"; END; (*? TBD: Hack to avoid ampersand in XML *)
  2674. IF (component = "") THEN c := originator;
  2675. ELSE c := originator.Find(component);
  2676. END;
  2677. IF (c # NIL) THEN
  2678. IF c.properties.GetPropertyValue(property,value) THEN RETURN Strings.NewString(value)
  2679. ELSE ReportError("Property % of component % not found", property, component);
  2680. END;
  2681. ELSE ReportError("Component % not found", component, "");
  2682. END;
  2683. RETURN NIL;
  2684. END GetPropertyValue;
  2685. PROCEDURE DefaultMacroHandler(CONST macro : Macro; originator : Component; w : Streams.Writer; VAR handled : BOOLEAN);
  2686. VAR string, value : Strings.String;
  2687. BEGIN
  2688. ASSERT((originator # NIL) & (w # NIL));
  2689. handled := TRUE;
  2690. IF (macro = MacroSelection) THEN
  2691. WriteSelectionToStream(w);
  2692. ELSIF (macro = MacroClipboard) THEN
  2693. TextUtilities.TextToStream(Texts.clipboard, w);
  2694. ELSIF Strings.StartsWith(MacroAttributePrefix, 0, macro) THEN
  2695. string := Strings.Substring(Strings.Length(MacroAttributePrefix), Strings.Length(macro), macro);
  2696. value := GetAttributeValue(originator, string^);
  2697. IF (value # NIL) THEN
  2698. w.String(value^);
  2699. ELSE
  2700. handled := FALSE;
  2701. END;
  2702. ELSIF Strings.StartsWith(MacroPropertyPrefix, 0, macro) THEN
  2703. string := Strings.Substring(Strings.Length(MacroPropertyPrefix), Strings.Length(macro), macro);
  2704. value := GetPropertyValue(originator,string^);
  2705. IF (value # NIL) THEN
  2706. w.String(value^);
  2707. ELSE
  2708. handled := FALSE;
  2709. END;
  2710. ELSE
  2711. handled := FALSE;
  2712. END;
  2713. END DefaultMacroHandler;
  2714. PROCEDURE FindMacroHandler(CONST namespace : ARRAY OF CHAR) : MacroHandlerProcedure;
  2715. VAR node : MacroHandler; handler : MacroHandlerProcedure;
  2716. BEGIN (* caller must hold module lock! *)
  2717. node := macroHandlers;
  2718. WHILE (node # NIL) & (node.namespace # namespace) DO node := node.next; END;
  2719. IF (node # NIL) THEN
  2720. handler := node.handler;
  2721. ELSE
  2722. handler := NIL;
  2723. END;
  2724. RETURN handler;
  2725. END FindMacroHandler;
  2726. PROCEDURE AddMacroHandler*(CONST namespace : Namespace; handler : MacroHandlerProcedure; VAR res : LONGINT);
  2727. VAR new, node : MacroHandler; h : MacroHandlerProcedure;
  2728. BEGIN {EXCLUSIVE}
  2729. ASSERT((namespace # NoNamespace) & (handler # NIL));
  2730. ASSERT(macroHandlers # NIL);
  2731. h := FindMacroHandler(namespace);
  2732. IF (h = NIL) THEN (* append new handler to list *)
  2733. NEW(new);
  2734. new.handler := handler;
  2735. new.namespace := namespace;
  2736. new.next := NIL;
  2737. node := macroHandlers;
  2738. WHILE (node.next # NIL) DO node := node.next; END;
  2739. node.next := new;
  2740. res := Ok;
  2741. ELSE
  2742. res := DuplicateNamespace;
  2743. END;
  2744. END AddMacroHandler;
  2745. PROCEDURE RemoveMacroHandler*(handler : MacroHandlerProcedure);
  2746. VAR node : MacroHandler;
  2747. BEGIN {EXCLUSIVE}
  2748. ASSERT((handler # NIL) & (handler # DefaultMacroHandler));
  2749. ASSERT(macroHandlers # NIL);
  2750. node := macroHandlers;
  2751. WHILE (node.next # NIL) & (node.next.handler # handler) DO node := node.next; END;
  2752. ASSERT((node.next # NIL) & (node.next.handler = handler));
  2753. node.next := node.next.next;
  2754. END RemoveMacroHandler;
  2755. PROCEDURE SetAttribute*(context : Commands.Context); (** component attribute value ~ *)
  2756. VAR originator, target : Component; name, attribute, value : ARRAY 128 OF CHAR; (*? TBD array size *)
  2757. BEGIN
  2758. IF (context IS EventContext) THEN
  2759. originator := context(EventContext).originator;
  2760. IF context.arg.GetString(name) & context.arg.GetString(attribute) & context.arg.GetString(value) THEN
  2761. target := originator.Find(name);
  2762. IF (target # NIL) THEN
  2763. IF target.HasAttribute(attribute) THEN
  2764. target.SetAttributeValue(attribute, value);
  2765. ELSE
  2766. context.result := Commands.CommandError;
  2767. END;
  2768. ELSE
  2769. context.result := Commands.CommandError;
  2770. END;
  2771. ELSE
  2772. context.error.String("Expected component name, attribute and value parameters"); context.error.Ln;
  2773. context.result := Commands.CommandParseError;
  2774. END;
  2775. ELSE
  2776. context.error.String("Command requires EventContext."); context.error.Ln;
  2777. context.result := Commands.CommandParseError;
  2778. END;
  2779. END SetAttribute;
  2780. (** Activate a string of commands, including their parameters.
  2781. The string is parsed from left to right and Activate is called for every command.
  2782. Parsing stops at the end of the string, or when Activate returns an error.
  2783. The flags are applied to every command, i.e., for sequential execution,
  2784. use the Wait flag (the caller waits until all commands return).
  2785. Syntax:
  2786. cmds = [mode " " ] cmd {";" cmd} .
  2787. mode = "PAR" | "SEQ" .
  2788. cmd = mod ["." proc] [" " params] .
  2789. params = {<any character except ";">} .
  2790. REMARK: For now, this is almost the same as Commands.Call. This procedure will either be enhanced to
  2791. support some component-related macro substitution or be replaced by Commands.Call
  2792. *)
  2793. PROCEDURE Call*(cmds : ARRAY OF CHAR; caller : Component; flags : SET; VAR res : LONGINT; VAR msg : ARRAY OF CHAR);
  2794. VAR
  2795. context : Commands.Context; arg : Streams.StringReader;
  2796. buffer : Strings.Buffer; w : Streams.Writer; par : Strings.String;
  2797. length, i, k : LONGINT;
  2798. PROCEDURE Expand(CONST string : ARRAY OF CHAR; w : Streams.Writer; start : LONGINT; VAR end : LONGINT);
  2799. VAR
  2800. component : Component;
  2801. componentStr, attributeStr : ARRAY 256 OF CHAR;
  2802. property : WMProperties.Property; attribute : XML.Attribute;
  2803. value : Strings.String;
  2804. lastDotIdx, i, j : LONGINT; error : BOOLEAN;
  2805. BEGIN
  2806. ASSERT((string[start] = "&") & (start + 1 < LEN(string)) & (w # NIL));
  2807. end := start; WHILE (end < LEN(string)) & (string[end] # 0X) & (string[end] # ";") & (string[end] > " ") DO INC(end); END;
  2808. DEC(end);
  2809. lastDotIdx := end;
  2810. WHILE (lastDotIdx > start) & (string[lastDotIdx] # ".") DO DEC(lastDotIdx); END;
  2811. error := (lastDotIdx <= start); (* missing dot *)
  2812. IF ~error THEN
  2813. i := start + 1; (* skip ampersand *)
  2814. IF (string[i] = "&") OR (string[i] = "/") THEN
  2815. j := 0;
  2816. WHILE (i < lastDotIdx) & (j < LEN(componentStr) - 1) DO
  2817. componentStr[j] := string[i];
  2818. INC(i); INC(j);
  2819. END;
  2820. componentStr[j] := 0X;
  2821. component := caller.Find(componentStr);
  2822. ELSE
  2823. componentStr := "";
  2824. component := caller;
  2825. END;
  2826. ASSERT(string[i] = ".");
  2827. INC(i); (* skip dot *)
  2828. attributeStr := "";
  2829. j := 0;
  2830. WHILE (j < LEN(attributeStr)) & (i <= end) DO
  2831. attributeStr[j] := string[i];
  2832. INC(i); INC(j);
  2833. END;
  2834. error := (attributeStr = "");
  2835. IF ~error THEN
  2836. IF (component # NIL) THEN
  2837. property := component.properties.Get(attributeStr);
  2838. IF (property # NIL) THEN
  2839. property.ToStream(w);
  2840. ELSE
  2841. attribute := component.GetAttribute(attributeStr);
  2842. IF (attribute # NIL) THEN
  2843. value := attribute.GetValue();
  2844. IF (value # NIL) THEN w.String(value^); ELSE w.String("NIL"); END;
  2845. ELSE
  2846. error := TRUE;
  2847. END;
  2848. END;
  2849. ELSE
  2850. error := TRUE;
  2851. END;
  2852. END;
  2853. END;
  2854. IF error THEN (* don't expand macro *)
  2855. FOR i := start TO end DO w.Char(string[i]); END;
  2856. END;
  2857. ASSERT(end >= start);
  2858. END Expand;
  2859. BEGIN
  2860. ASSERT(caller # NIL);
  2861. NEW(buffer, LEN(cmds)); w := buffer.GetWriter();
  2862. IF Strings.StartsWith2(Repositories.CommandPrefix, cmds) THEN i := Strings.Length(Repositories.CommandPrefix); ELSE i := 0; END;
  2863. LOOP
  2864. buffer.Clear;
  2865. w.Reset;
  2866. k := 0;
  2867. WHILE (i < LEN(cmds)) & (cmds[i] # " ") & (cmds[i] # 09X) & (cmds[i] # 0DX) & (cmds[i] # 0AX) & (cmds[i] # 0X) & (cmds[i] # ";") DO cmds[k] := cmds[i]; INC(k); INC(i); END;
  2868. IF k = 0 THEN EXIT; END; (* end of string *)
  2869. IF (i < LEN(cmds)) & (cmds[i] # ";") & (cmds[i] # 0X) THEN (* parameters *)
  2870. INC(i); (* skip delimiter *)
  2871. WHILE (i < LEN(cmds)) & (cmds[i] # 0X) & (cmds[i] # ";") DO
  2872. IF (cmds[i] = "&") & (i + 1 < LEN(cmds)) & ((cmds[i+1] = "&") OR (cmds[i+1] = ".") OR (cmds[i+1] = "/")) THEN
  2873. Expand(cmds, w, i, i);
  2874. ELSE
  2875. w.Char(cmds[i]);
  2876. END;
  2877. INC(i);
  2878. END;
  2879. END;
  2880. IF (i < LEN(cmds)) & (cmds[i] = ";") THEN (* skip command delimiter *) INC(i); END;
  2881. cmds[k] := 0X;
  2882. length := buffer.GetLength();
  2883. IF (length > 0) THEN
  2884. par := buffer.GetString();
  2885. NEW(arg, length + 1); arg.SetRaw(par^, 0, length + 1);
  2886. ELSE
  2887. arg := NIL;
  2888. END;
  2889. NEW(context, NIL, arg, NIL, NIL, caller);
  2890. Commands.Activate(cmds, context, flags, res, msg);
  2891. IF (res # Commands.Ok) THEN KernelLog.String("WMComponents.Call error, res = "); KernelLog.Int(res, 0); KernelLog.Ln; EXIT; END;
  2892. END;
  2893. END Call;
  2894. PROCEDURE GetComponent*(CONST name : ARRAY OF CHAR) : Component;
  2895. VAR component : Component; c : Repositories.Component; res : LONGINT;
  2896. BEGIN
  2897. component := NIL;
  2898. Repositories.GetComponentByString(name, c, res);
  2899. IF (res = Repositories.Ok) THEN
  2900. IF (c # NIL) & (c IS Component) THEN
  2901. component := c (Component);
  2902. ELSE
  2903. KernelLog.String("WMComponents.GetComponent: Could not generate component ");
  2904. KernelLog.String(name); KernelLog.String(": Wrong type"); KernelLog.Ln;
  2905. END;
  2906. ELSE
  2907. KernelLog.String("WMComponents.GetComponent: Could not generate component ");
  2908. KernelLog.String(name); KernelLog.String(", res: "); KernelLog.Int(res, 0); KernelLog.Ln;
  2909. END;
  2910. RETURN component;
  2911. END GetComponent;
  2912. PROCEDURE GetVisualComponent*(CONST name : ARRAY OF CHAR) : VisualComponent;
  2913. VAR component : VisualComponent; c : Repositories.Component; res : LONGINT;
  2914. BEGIN
  2915. component := NIL;
  2916. Repositories.GetComponentByString(name, c, res);
  2917. IF (res = Repositories.Ok) THEN
  2918. IF (c # NIL) & (c IS VisualComponent) THEN
  2919. component := c (VisualComponent);
  2920. ELSE
  2921. KernelLog.String("WMComponents.GetVisualComponent: Could not generate component ");
  2922. KernelLog.String(name); KernelLog.String(": Wrong type"); KernelLog.Ln;
  2923. END;
  2924. ELSE
  2925. KernelLog.String("WMComponents.GetVisualComponent: Could not generate component ");
  2926. KernelLog.String(name); KernelLog.String(", res: "); KernelLog.Int(res, 0); KernelLog.Ln;
  2927. END;
  2928. RETURN component;
  2929. END GetVisualComponent;
  2930. PROCEDURE SetStyle*(style : XML.Element);
  2931. BEGIN
  2932. SetStyleInternal(style)
  2933. END SetStyle;
  2934. PROCEDURE SetStyleInternal(style : XML.Element);
  2935. VAR msg : Messages.Message; m : WM.WindowManager;
  2936. BEGIN
  2937. currentStyle := style;
  2938. IF propertyListList # NIL THEN propertyListList.UpdateStyle END;
  2939. msg.msgType := Messages.MsgExt; msg.ext := componentStyleMsg;
  2940. m := WM.GetDefaultManager();
  2941. m.Broadcast(msg)
  2942. END SetStyleInternal;
  2943. PROCEDURE FindRelativePath(x : Component; CONST path : ARRAY OF CHAR; pos : LONGINT) : Component;
  2944. VAR c : XML.Content;
  2945. sn : ARRAY MaxComponentNameSize OF CHAR;
  2946. i : LONGINT; id : Strings.String;
  2947. BEGIN
  2948. IF x = NIL THEN RETURN NIL
  2949. ELSIF path[pos] = 0X THEN RETURN x
  2950. ELSIF (pos = 0) & (path[0] = "/") THEN RETURN FindRelativePath(x.GetComponentRoot(), path, pos + 1)
  2951. ELSIF (path[pos] = ".") & (path[pos + 1] = ".") THEN
  2952. INC(pos, 2); IF path[pos]="/" THEN INC(pos) END;
  2953. c := x.GetParent();
  2954. IF (c # NIL) & (c IS Component) THEN
  2955. RETURN FindRelativePath(c(Component), path, pos)
  2956. ELSE
  2957. RETURN NIL
  2958. END
  2959. ELSE
  2960. i := 0; WHILE (i < MaxComponentNameSize - 1) & (path[pos] # 0X) & (path[pos] # "/") DO
  2961. sn[i] := path[pos]; INC(i); INC(pos)
  2962. END;
  2963. IF (path[pos] = "/") THEN INC(pos) END;
  2964. sn[i] := 0X;
  2965. c := x.GetFirst();
  2966. WHILE (c # NIL) DO
  2967. IF (c IS Component) THEN
  2968. id := c(Component).id.Get();
  2969. IF (id # NIL) & (id^ = sn) THEN
  2970. RETURN FindRelativePath(c(Component), path, pos);
  2971. END;
  2972. END;
  2973. c := x.GetNext(c);
  2974. END;
  2975. RETURN NIL
  2976. END
  2977. END FindRelativePath;
  2978. (* Report errors while parsing *)
  2979. PROCEDURE Error(pos, line, row: LONGINT; CONST msg: ARRAY OF CHAR);
  2980. BEGIN
  2981. KernelLog.String("Parse error at pos "); KernelLog.Int(pos, 5); KernelLog.String(" in line "); KernelLog.Int(line, 5);
  2982. KernelLog.String(" row "); KernelLog.Int(row, 5); KernelLog.String(" - "); KernelLog.String(msg); KernelLog.Ln;
  2983. hasErrors := TRUE
  2984. END Error;
  2985. (** Load an XML file. Return NIL if errors occured *)
  2986. PROCEDURE Load*(CONST filename : ARRAY OF CHAR) : XML.Content;
  2987. VAR scanner : XMLScanner.Scanner;
  2988. parser : XMLParser.Parser;
  2989. doc : XML.Document;
  2990. in : Streams.Reader;
  2991. BEGIN {EXCLUSIVE}
  2992. hasErrors := FALSE;
  2993. in := Codecs.OpenInputStream(filename);
  2994. IF in # NIL THEN
  2995. NEW(scanner, in); scanner.reportError := Error;
  2996. NEW(parser, scanner); parser.reportError := Error;
  2997. parser.elemReg := Repositories.registry; doc := parser.Parse();
  2998. IF hasErrors THEN RETURN NIL END;
  2999. RETURN doc.GetRoot()
  3000. END;
  3001. RETURN NIL
  3002. END Load;
  3003. PROCEDURE FormWindowGen*(xml:XML.Content): WM.Window;
  3004. VAR winx: XML.Element; formx: XML.Content; window: FormWindow; name, string:Strings.String; canvas:WMGraphics.BufferCanvas;
  3005. canvasGenerator: WMGraphics.CanvasGenerator;
  3006. moduleName, procedureName : Modules.Name;
  3007. msg : ARRAY 128 OF CHAR;
  3008. res: LONGINT;
  3009. l,t,r,b: LONGINT;
  3010. BEGIN
  3011. IF xml IS XML.Element THEN
  3012. winx:=xml(XML.Element);
  3013. string:=winx.GetName();
  3014. IF string^="FormWindow" THEN
  3015. string:=winx.GetAttributeValue("l"); Strings.StrToInt(string^,l);
  3016. string:=winx.GetAttributeValue("t"); Strings.StrToInt(string^,t);
  3017. string:=winx.GetAttributeValue("r"); Strings.StrToInt(string^,r);
  3018. string:=winx.GetAttributeValue("b"); Strings.StrToInt(string^,b);
  3019. NEW(window, r-l, b-t, TRUE);
  3020. name:=winx.GetAttributeValue("name"); window.SetTitle(name);
  3021. window.bounds.r:=r; window.bounds.l:=l; window.bounds.t:=t; window.bounds.b:=b;
  3022. string:=winx.GetAttributeValue("flags"); Strings.StrToSet(string^,window.flags);
  3023. string:=winx.GetAttributeValue("canvasGenerator"); (* allow to plug in alternative canvas versions,e.g. WMGraphicsGfx.Canvas *)
  3024. IF (string#NIL) THEN
  3025. Commands.Split(string^, moduleName, procedureName, res, msg);
  3026. IF (res = Commands.Ok) THEN
  3027. GETPROCEDURE(moduleName, procedureName, canvasGenerator);
  3028. IF (canvasGenerator # NIL) THEN
  3029. window.SetCanvasGenerator(canvasGenerator);
  3030. END;
  3031. END;
  3032. END;
  3033. formx:=winx.GetFirst(); (* this typically has name="Form" *)
  3034. IF (formx#NIL)&(formx IS XML.Element) THEN
  3035. window.LoadComponents(formx(XML.Element)); (* at the price of duplication of component tree construction ...*)
  3036. window.form.Reset(NIL,NIL);
  3037. ELSE window:=NIL;
  3038. END;
  3039. END;
  3040. END;
  3041. RETURN window
  3042. END FormWindowGen;
  3043. (* generic loading of any form window using the generator procedure supplied in the XML as 'loader' attribute *)
  3044. PROCEDURE LoadFormWindow*(xml:XML.Content): WM.Window;
  3045. VAR winx: XML.Element; window: WM.Window; formWindow:FormWindow;
  3046. formx, c:Component;
  3047. name, string, load:Strings.String;
  3048. moduleName, procedureName : Modules.Name;
  3049. msg : ARRAY 128 OF CHAR;
  3050. res: LONGINT;
  3051. gen:WindowGenerator;
  3052. bounds:Rectangles.Rectangle;
  3053. BEGIN
  3054. IF xml IS XML.Element THEN
  3055. winx:=xml(XML.Element);
  3056. name:=winx.GetName();
  3057. IF name^="FormWindow" THEN
  3058. string:=winx.GetAttributeValue("loader");
  3059. Commands.Split(string^, moduleName, procedureName, res, msg);
  3060. IF (res = Commands.Ok) THEN
  3061. GETPROCEDURE(moduleName, procedureName, gen);
  3062. IF (gen # NIL) THEN
  3063. window:=gen(xml);
  3064. END;
  3065. END;
  3066. ELSE (*generate FormWindow from generic Visual Component*)
  3067. c:=ComponentFromXML(xml(XML.Element));
  3068. IF (c#NIL) & (c IS VisualComponent) THEN
  3069. bounds:=c(VisualComponent).bounds.Get();
  3070. NEW(formWindow, bounds.r-bounds.l, bounds.b-bounds.t, TRUE);
  3071. formWindow.SetContent(c);
  3072. (*formWindow.SetTitle(c.GetName());*)
  3073. window:=formWindow;
  3074. END;
  3075. END;
  3076. END;
  3077. RETURN window
  3078. END LoadFormWindow;
  3079. (** Open form window and build its component tree *)
  3080. PROCEDURE Open*(context : Commands.Context);
  3081. VAR filename: Files.FileName; window: WM.Window; xml:XML.Content;
  3082. BEGIN
  3083. IF context.arg.GetString(filename) & (Strings.Length(filename)>0) THEN
  3084. xml:=Load(filename); (* here, the xml tree is already constructed, however not in the right sequence for component contruction ( [Init()..loadProperties()..Initialize()] )*)
  3085. window:=LoadFormWindow(xml);
  3086. IF window#NIL THEN
  3087. WM.AddWindow(window,window.bounds.l,window.bounds.t);
  3088. END;
  3089. END;
  3090. END Open;
  3091. PROCEDURE LoadStyleInternal(CONST filename : ARRAY OF CHAR);
  3092. VAR f : Files.File;
  3093. scanner : XMLScanner.Scanner;
  3094. parser : XMLParser.Parser;
  3095. reader : Files.Reader;
  3096. doc : XML.Document;
  3097. BEGIN
  3098. hasErrors := FALSE;
  3099. f := Files.Old(filename);
  3100. IF f # NIL THEN
  3101. NEW(reader, f, 0);
  3102. NEW(scanner, reader); scanner.reportError := Error;
  3103. NEW(parser, scanner); parser.reportError := Error;
  3104. parser.elemReg := Repositories.registry; doc := parser.Parse();
  3105. IF hasErrors THEN KernelLog.String("Stylefile not ok"); KernelLog.Ln
  3106. ELSE
  3107. SetStyleInternal(doc.GetRoot())
  3108. END
  3109. END
  3110. END LoadStyleInternal;
  3111. (** Load Component registry file. Return NIL if errors occured *)
  3112. PROCEDURE LoadStyle*(context : Commands.Context);
  3113. VAR filename : ARRAY 64 OF CHAR;
  3114. BEGIN {EXCLUSIVE}
  3115. IF context.arg.GetString(filename) THEN
  3116. LoadStyleInternal(filename);
  3117. ELSE
  3118. context.result := Commands.CommandParseError;
  3119. END;
  3120. END LoadStyle;
  3121. PROCEDURE NewString*(CONST x : ARRAY OF CHAR) : Strings.String;
  3122. VAR t : Strings.String;
  3123. BEGIN
  3124. NEW(t, LEN(x)); COPY(x, t^); RETURN t
  3125. END NewString;
  3126. PROCEDURE InitStrings;
  3127. BEGIN
  3128. StrComponent := NewString("Component");
  3129. StrVisualComponent := NewString("VisualComponent");
  3130. StrForm := NewString("Form");
  3131. StrFormWindow := NewString("FormWindow");
  3132. GSonStartDrag := NewString("onStartDrag");
  3133. GSonStartDragInfo := NewString("Event generated whenever a drag is started");
  3134. StrModel := NewString("Model");
  3135. StrModelInfo := NewString("Model used by component");
  3136. END InitStrings;
  3137. PROCEDURE InitPrototypes;
  3138. BEGIN
  3139. (* General component properties *)
  3140. NEW(PrototypeID, NIL, NewString("ID"),
  3141. NewString("identifier of the component"));
  3142. NEW(PrototypeUID, NIL, NewString("UID"),
  3143. NewString("unique identifier of the component"));
  3144. NEW(PrototypeEnabled, NIL, NewString("Enabled"),
  3145. NewString("defines if the component is enabled"));
  3146. PrototypeEnabled.Set(TRUE);
  3147. (* Visual component properties *)
  3148. NEW(PrototypeBounds, NIL, NewString("Bounds"),
  3149. NewString("the bounding box of the component in parent coordinates"));
  3150. NEW(PrototypeBoundsRelative, NIL, NewString("RelBounds"),
  3151. NewString("the bounding box of the component in relative parent coordinates"));
  3152. NEW(PrototypeBearing, NIL, NewString("Bearing"),
  3153. NewString("the bearing (empty space) aroung the component if auto aligned"));
  3154. NEW(PrototypeFillColor, NIL, NewString("FillColor"),
  3155. NewString("the main fill color of the component. i.e. background"));
  3156. NEW(PrototypeAlignment, NIL, NewString("Alignment"),
  3157. NewString("defines the alignment none, left, right, top, bottom or client"));
  3158. PrototypeAlignment.Set(0);
  3159. NEW(PrototypeVisible, NIL, NewString("Visible"),
  3160. NewString("defines if the component is visible"));
  3161. PrototypeVisible.Set(TRUE);
  3162. NEW(PrototypeTakesFocus, NIL, NewString("TakesFocus"),
  3163. NewString("defines if the component takes the keyboard focus"));
  3164. NEW(PrototypeNeedsTab, NIL, NewString("NeedsTab"),
  3165. NewString("defines if the component handles the tabulator key"));
  3166. NEW(PrototypeFocusPrevious, NIL, NewString("FocusPrevious"), NewString("Previous focus component ID"));
  3167. PrototypeFocusPrevious.Set(NIL);
  3168. NEW(PrototypeFocusNext, NIL, NewString("FocusNext"), NewString("Next focus component ID"));
  3169. PrototypeFocusNext.Set(NIL);
  3170. NEW(PrototypeEditMode, NIL, NewString("EditMode"), NewString("defines if the contents of the component can be edited"));
  3171. PrototypeEditMode.Set(FALSE);
  3172. NEW(PrototypeFont, NIL, NewString("Font"), NewString("Font"));
  3173. PrototypeFont.Set(WMGraphics.GetDefaultFont());
  3174. NEW(PrototypeScaleFont, NIL, Strings.NewString("ScaleFont"), Strings.NewString("percentage that fonts scales with height (0=none)"));
  3175. NEW(ModelPrototype, NIL, StrModel, StrModelInfo);
  3176. END InitPrototypes;
  3177. PROCEDURE ShowComponent(component : Component);
  3178. VAR string : Strings.String;
  3179. BEGIN
  3180. IF (component # NIL) THEN
  3181. string := component.GetName();
  3182. IF (string # NIL) THEN KernelLog.String(string^); ELSE KernelLog.String("NoName"); END;
  3183. KernelLog.String(" [");
  3184. string := component.uid.Get();
  3185. IF (string # NIL) THEN KernelLog.String(string^); ELSE KernelLog.String("NIL"); END;
  3186. IF (component IS VisualComponent) THEN
  3187. KernelLog.String(", "); KernelLog.Boolean(component(VisualComponent).takesFocus.Get());
  3188. END;
  3189. KernelLog.String("]");
  3190. ELSE
  3191. KernelLog.String("NIL?");
  3192. END;
  3193. END ShowComponent;
  3194. PROCEDURE NewLine(w : Streams.Writer; level : LONGINT);
  3195. BEGIN
  3196. w.Ln; WHILE level > 0 DO w.Char(09X); DEC(level) END
  3197. END NewLine;
  3198. PROCEDURE InstallDefaultMacroHandler;
  3199. BEGIN
  3200. NEW(macroHandlers);
  3201. macroHandlers.handler := DefaultMacroHandler;
  3202. macroHandlers.namespace := DefaultNamespace;
  3203. macroHandlers.next := NIL;
  3204. END InstallDefaultMacroHandler;
  3205. (*! ---- xml tool --- move to where appropriate *)
  3206. PROCEDURE GetElementByName(parent : XML.Element; CONST name : ARRAY OF CHAR) : XML.Element;
  3207. VAR elem : XML.Element; enum : XMLObjects.Enumerator; ptr : ANY; string : Strings.String;
  3208. BEGIN
  3209. IF parent # NIL THEN
  3210. enum := parent.GetContents(); enum.Reset();
  3211. WHILE enum.HasMoreElements() DO
  3212. ptr := enum.GetNext();
  3213. IF ptr IS XML.Element THEN
  3214. elem := ptr (XML.Element);
  3215. string := elem.GetName();
  3216. IF (string # NIL) & (string^ = name) THEN
  3217. RETURN elem;
  3218. END;
  3219. END;
  3220. END;
  3221. END;
  3222. RETURN NIL;
  3223. END GetElementByName;
  3224. PROCEDURE NewComponent*(): XML.Element;
  3225. VAR component: Component;
  3226. BEGIN NEW(component); RETURN component;
  3227. END NewComponent;
  3228. PROCEDURE NewVisualComponent*(): XML.Element;
  3229. VAR component: VisualComponent;
  3230. BEGIN NEW(component); RETURN component;
  3231. END NewVisualComponent;
  3232. (* does not work like this its own because a form is statically bound to a window, but for completeness.. *)
  3233. PROCEDURE NewForm*(): XML.Element;
  3234. VAR component: Form;
  3235. BEGIN NEW(component, NIL); RETURN component
  3236. END NewForm;
  3237. PROCEDURE Align*(context: Commands.Context);
  3238. VAR width,height,bwidth,bheight: LONGINT; entry: ComponentListEntry; b,rect: Rectangles.Rectangle; string: ARRAY 32 OF CHAR; l,t: LONGINT; done: BOOLEAN;
  3239. BEGIN
  3240. entry := selection.first;
  3241. rect.l := MAX(LONGINT); rect.r := MIN(LONGINT);
  3242. rect.t := MAX(LONGINT); rect.b := MIN(LONGINT);
  3243. width := 0; height := 0;
  3244. WHILE entry # NIL DO
  3245. b := entry.component.bounds.Get();
  3246. bwidth := b.r-b.l; bheight := b.b-b.t;
  3247. IF b.l < rect.l THEN rect.l := b.l END;
  3248. IF b.r > rect.r THEN rect.r := b.r END;
  3249. IF b.t < rect.t THEN rect.t := b.t END;
  3250. IF b.b > rect.b THEN rect.b := b.b END;
  3251. IF width < bwidth THEN width := bwidth END;
  3252. IF height < bheight THEN height := bheight END;
  3253. entry := entry.next
  3254. END;
  3255. done := FALSE;
  3256. WHILE ~done & context.arg.GetString(string) DO
  3257. l := rect.l; t := rect.t;
  3258. entry := selection.first;
  3259. WHILE ~done & (entry # NIL) DO
  3260. b := entry.component.bounds.Get(); bwidth := b.r-b.l; bheight := b.b-b.t;
  3261. entry.component.AdaptRelativeBounds(b,entry.component.GetParent());
  3262. IF string = "left" THEN b.l := rect.l; b.r := rect.l + bwidth;
  3263. ELSIF string = "right" THEN b.r := rect.r; b.l := rect.r-bwidth
  3264. ELSIF string = "top" THEN b.t := rect.t; b.b := rect.t + bheight;
  3265. ELSIF string = "bottom" THEN b.b := rect.b; b.t := rect.b-bheight
  3266. ELSIF string = "width" THEN b.r := b.l + width;
  3267. ELSIF string = "height" THEN b.b := b.t + height;
  3268. ELSIF string = "size" THEN b.r := b.l + width; b.b := b.t + height;
  3269. ELSIF string = "hcenter" THEN b.l := (rect.l+rect.r) DIV 2 - bwidth DIV 2; b.r := b.l + bwidth;
  3270. ELSIF string = "vcenter" THEN b.t := (rect.t + rect.b) DIV 2 - bheight DIV 2; b.b := b.t + bheight;
  3271. ELSIF string = "horizontal" THEN b.l := l; b.r := b.l + bwidth; l := b.r+1
  3272. ELSIF string = "vertical" THEN b.t := t; b.b := b.t + bheight; t := b.b + 1;
  3273. ELSIF string = "none" THEN entry.component.alignment.Set(AlignNone)
  3274. ELSIF string = "relative" THEN entry.component.alignment.Set(AlignRelative)
  3275. ELSE done := TRUE
  3276. END;
  3277. entry.component.AdaptRelativeBounds(b,entry.component.GetParent());
  3278. entry.component.bounds.Set(b);
  3279. entry := entry.next
  3280. END;
  3281. END;
  3282. END Align;
  3283. PROCEDURE SetProperty*(context: Commands.Context);
  3284. VAR name, value: ARRAY 256 OF CHAR; entry: ComponentListEntry;
  3285. BEGIN
  3286. IF context.arg.GetString(name) & context.arg.GetString(value) THEN
  3287. entry := selection.first;
  3288. WHILE entry # NIL DO
  3289. IF entry.component.properties.SetPropertyValue(name, value) THEN END;
  3290. entry := entry.next;
  3291. END;
  3292. END;
  3293. END SetProperty;
  3294. PROCEDURE RemoveSelection*;
  3295. VAR entry: ComponentListEntry; parent: XML.Element;
  3296. BEGIN
  3297. entry := selection.first;
  3298. WHILE entry # NIL DO
  3299. parent := entry.component.GetParent();
  3300. IF parent # NIL THEN parent(VisualComponent).RemoveContent(entry.component); parent(VisualComponent).Invalidate END;
  3301. entry := entry.next
  3302. END;
  3303. END RemoveSelection;
  3304. PROCEDURE ComponentFromXML*(xml: XML.Element): Component;
  3305. VAR generator: PROCEDURE(): XML.Element;
  3306. VAR
  3307. l,name: Strings.String;
  3308. moduleName, procedureName: Modules.Name;
  3309. res: LONGINT; msg: ARRAY 32 OF CHAR;
  3310. component: Component;
  3311. element: XML.Element;
  3312. BEGIN
  3313. component := NIL;
  3314. IF xml # NIL THEN
  3315. name := xml.GetName();
  3316. l := xml.GetAttributeValue("generator");
  3317. IF l # NIL THEN
  3318. Commands.Split(l^, moduleName, procedureName, res, msg);
  3319. IF (res = Commands.Ok) THEN
  3320. GETPROCEDURE(moduleName, procedureName, generator);
  3321. IF (generator # NIL) THEN
  3322. element := generator();
  3323. IF (element # NIL) & (element IS Component) THEN
  3324. component := element(Component);
  3325. component.SetName(name^);
  3326. component.FromXML(xml);
  3327. END;
  3328. ELSE KernelLog.String("WMComponents error: invalid generator "); KernelLog.String(l^); KernelLog.Ln;
  3329. END;
  3330. ELSE KernelLog.String("WMComponents error: could not generate component "); KernelLog.String(l^); KernelLog.Ln;
  3331. END;
  3332. END;
  3333. END;
  3334. RETURN component
  3335. END ComponentFromXML;
  3336. PROCEDURE Clone*(x: Component): Repositories.Component;
  3337. BEGIN
  3338. RETURN ComponentFromXML(x)
  3339. END Clone;
  3340. BEGIN
  3341. timestamp := 0;
  3342. NEW(componentStyleMsg);
  3343. NEW(propertyListList);
  3344. InitStrings;
  3345. InitPrototypes;
  3346. NEW(invalidateRectMsg);
  3347. InstallDefaultMacroHandler;
  3348. NEW(selection);
  3349. END WMComponents.
  3350. WMComponents.Open Test.Cwd ~
  3351. WMComponents.Open DictEntry.wm ~
  3352. The message sequencer contains a reader writer lock that can be used to block the hierarchy.
  3353. Each message-call from the sequencer posesses the writer lock.
  3354. WMComponents.LoadStyle ComponentStyle.XML ~
  3355. If a focusComponent is set in an non-focus container-component, the focus can not escape the "isolated" component group