WMComponents.Mod 123 KB

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