WMComponents.Mod 123 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725
  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. Initialize;
  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, property : ANY);
  604. BEGIN
  605. IF ~initialized THEN RETURN END;
  606. IF ~IsCallFromSequencer() THEN
  607. sequencer.ScheduleEvent(SELF.InternalLinkChanged, sender, property);
  608. IF CanYield THEN Objects.Yield END;
  609. ELSE
  610. IF ~inLinkUpdate THEN
  611. inLinkUpdate := TRUE;
  612. LinkChanged(sender, property);
  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()); Invalidate;
  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 InvalidateCommand*(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. IF ~IsCallFromSequencer() OR ~visible.Get() THEN
  1332. r := GetClientRect();
  1333. client := SELF;
  1334. parent := GetParent();
  1335. WHILE (parent # NIL) & (parent IS VisualComponent) DO
  1336. IF ~parent(VisualComponent).visible.Get() THEN RETURN END;
  1337. b := client.bounds.Get();
  1338. Rectangles.MoveRel(r, b.l, b.t);
  1339. client := parent(VisualComponent);
  1340. parent := client.GetParent();
  1341. END;
  1342. m.msgType := Messages.MsgInvalidate;
  1343. m.msgSubType := Messages.MsgSubRectangle;
  1344. m.x := r.l; m.y := r.t; m.dx := r.r; m.dy := r.b;
  1345. m.sender := client;
  1346. IF sequencer.Add(m) THEN IF CanYield THEN Objects.Yield END END;
  1347. ELSE
  1348. InvalidateRect(GetClientRect());
  1349. END;
  1350. END InvalidateCommand;
  1351. PROCEDURE Invalidate*; (* For convenience in component internal use *)
  1352. BEGIN
  1353. InvalidateCommand(SELF, NIL)
  1354. END Invalidate;
  1355. (** recursively disable the redrawing of any components in the hierarchy *)
  1356. (** dont forget to re-enable it ;-). Use with care to optimize sub-component operations *)
  1357. PROCEDURE DisableUpdate*;
  1358. VAR vc: VisualComponent;
  1359. BEGIN
  1360. ASSERT(IsCallFromSequencer());
  1361. vc := GetVisualComponentRoot();
  1362. IF (vc # NIL) & (vc IS Form) THEN vc(Form).DisableUpdate() END
  1363. END DisableUpdate;
  1364. (** recursively enable the redrawing of any components in the hierarchy *)
  1365. (** Only enable drawing if it was disabled before, but dont forget it, then ! *)
  1366. PROCEDURE EnableUpdate*;
  1367. VAR vc: VisualComponent;
  1368. BEGIN
  1369. ASSERT(IsCallFromSequencer());
  1370. vc := GetVisualComponentRoot();
  1371. IF (vc # NIL) & (vc IS Form) THEN vc(Form).EnableUpdate() END
  1372. END EnableUpdate;
  1373. PROCEDURE GetInternalPointerInfo*() : WM.PointerInfo;
  1374. VAR vc: VisualComponent;
  1375. BEGIN
  1376. ASSERT(IsCallFromSequencer());
  1377. vc := GetVisualComponentRoot();
  1378. IF (vc # NIL) & (vc IS Form) THEN
  1379. RETURN vc(Form).GetPointerInfo()
  1380. ELSE
  1381. RETURN NIL
  1382. END
  1383. END GetInternalPointerInfo;
  1384. PROCEDURE SetInternalPointerInfo*(pi : WM.PointerInfo);
  1385. VAR vc: VisualComponent;
  1386. BEGIN
  1387. AssertLock;
  1388. vc := GetVisualComponentRoot();
  1389. IF (vc # NIL) & (vc IS Form) THEN vc(Form).SetPointerInfo(pi) END
  1390. END SetInternalPointerInfo;
  1391. PROCEDURE SetPointerInfo*(pi : WM.PointerInfo);
  1392. BEGIN
  1393. Acquire;
  1394. SetInternalPointerInfo(pi);
  1395. pointerInfo := pi;
  1396. Release
  1397. END SetPointerInfo;
  1398. PROCEDURE GetPointerInfo*() : WM.PointerInfo;
  1399. BEGIN
  1400. RETURN pointerInfo
  1401. END GetPointerInfo;
  1402. (** User interaction messages *)
  1403. PROCEDURE SetExtPointerLeaveHandler*(handler : PointerLeaveHandler);
  1404. BEGIN
  1405. Acquire; extPointerLeave := handler; Release
  1406. END SetExtPointerLeaveHandler;
  1407. PROCEDURE SetExtPointerDownHandler*(handler : PointerHandler);
  1408. BEGIN
  1409. Acquire; extPointerDown := handler; Release
  1410. END SetExtPointerDownHandler;
  1411. PROCEDURE SetExtPointerMoveHandler*(handler : PointerHandler);
  1412. BEGIN
  1413. Acquire; extPointerMove := handler; Release
  1414. END SetExtPointerMoveHandler;
  1415. PROCEDURE SetExtPointerUpHandler*(handler : PointerHandler);
  1416. BEGIN
  1417. Acquire; extPointerUp := handler; Release
  1418. END SetExtPointerUpHandler;
  1419. PROCEDURE SetExtDragOverHandler*(handler : DragDropHandler);
  1420. BEGIN
  1421. Acquire; extDragOver := handler; Release
  1422. END SetExtDragOverHandler;
  1423. PROCEDURE SetExtDragDroppedHandler*(handler : DragDropHandler);
  1424. BEGIN
  1425. Acquire; extDragDropped := handler; Release
  1426. END SetExtDragDroppedHandler;
  1427. PROCEDURE SetExtDragResultHandler*(handler : DragResultHandler);
  1428. BEGIN
  1429. Acquire; extDragResult := handler; Release
  1430. END SetExtDragResultHandler;
  1431. PROCEDURE SetExtKeyEventHandler*(handler : KeyEventHandler);
  1432. BEGIN
  1433. Acquire; extKeyEvent := handler; Release
  1434. END SetExtKeyEventHandler;
  1435. PROCEDURE SetExtDrawHandler*(handler : DrawHandler);
  1436. BEGIN
  1437. Acquire; extDraw := handler; Release
  1438. END SetExtDrawHandler;
  1439. PROCEDURE SetExtFocusHandler*(handler : FocusHandler);
  1440. BEGIN
  1441. Acquire; extFocus := handler; Release
  1442. END SetExtFocusHandler;
  1443. PROCEDURE SetExtContextMenuHandler*(handler : ContextMenuHandler);
  1444. BEGIN
  1445. Acquire; extContextMenu := handler; Release
  1446. END SetExtContextMenuHandler;
  1447. PROCEDURE SetExtGetPositionOwnerHandler*(handler : GetPositionOwnerHandler);
  1448. BEGIN
  1449. Acquire; extGetPositionOwner := handler; Release;
  1450. END SetExtGetPositionOwnerHandler;
  1451. (** Indicates the pointing device has left the component without a key pressed down.
  1452. May only be called from the sequencer thread.
  1453. Components interested in this message can override this method instead of searching for the message in HandleInternal. *)
  1454. PROCEDURE PointerLeave*; (** PROTECTED *)
  1455. BEGIN ASSERT(IsCallFromSequencer());
  1456. END PointerLeave;
  1457. (** Indicates one of the pointer keys went down. keys is the set of buttons currently pressed. x, y is the position in component
  1458. coordinates.
  1459. May only be called from the sequencer thread.
  1460. Components interested in this message can override this method instead of searching for the message in HandleInternal. *)
  1461. PROCEDURE PointerDown*(x, y: LONGINT; keys: SET); (** PROTECTED *)
  1462. BEGIN ASSERT(IsCallFromSequencer());
  1463. IF keys = {2} THEN ShowContextMenu(x, y)
  1464. END;
  1465. END PointerDown;
  1466. (** Indicates the pointer was moved. keys is the set of buttons currently pressed. x, y is the position in component
  1467. coordinates.
  1468. May only be called from the sequencer thread.
  1469. Components interested in this message can override this method instead of searching for the message in HandleInternal. *)
  1470. PROCEDURE PointerMove*(x, y: LONGINT; keys: SET); (** PROTECTED *)
  1471. BEGIN ASSERT(IsCallFromSequencer());
  1472. END PointerMove;
  1473. PROCEDURE WheelMove*(dz: LONGINT); (** PROTECTED *)
  1474. BEGIN ASSERT(IsCallFromSequencer());
  1475. END WheelMove;
  1476. (** Indicates one of the pointer keys went up. keys is the set of buttons currently pressed. x, y is the position in component
  1477. coordinates.
  1478. May only be called from the sequencer thread.
  1479. Components interested in this message can override this method instead of searching for the message in HandleInternal. *)
  1480. PROCEDURE PointerUp*(x, y: LONGINT; keys: SET); (** PROTECTED *)
  1481. BEGIN ASSERT(IsCallFromSequencer());
  1482. END PointerUp;
  1483. (** The component can determine wheter the key was pressed or released by examining the
  1484. Inputs.Release flag in flags. ucs contains the unicode equivalent of the key. Special input editors
  1485. send the generated unicode characters via KeyEvent.
  1486. May only be called from the sequencer thread.
  1487. Components interested in this message can override this method instead of searching for the message in HandleInternal. *)
  1488. PROCEDURE KeyEvent*(ucs : LONGINT; flags: SET; VAR keySym: LONGINT); (** PROTECTED *)
  1489. BEGIN ASSERT(IsCallFromSequencer());
  1490. END KeyEvent;
  1491. PROCEDURE EditKeyEvents(ucs : LONGINT; flags: SET; VAR keySym: LONGINT): BOOLEAN; (** FINAL *)
  1492. VAR event : KeyPressedEvent; command : Strings.String; scale: LONGINT;
  1493. clone: Repositories.Component; parent: XML.Content; parentEditMode: BOOLEAN;
  1494. enum: XMLObjects.Enumerator; obj: ANY;
  1495. BEGIN
  1496. ASSERT(IsCallFromSequencer());
  1497. event.ucs := ucs; event.flags := flags; event.keysym := keySym;
  1498. parent := GetParent();
  1499. IF (parent # NIL) & (parent IS VisualComponent) & parent(VisualComponent).editMode.Get() THEN
  1500. parentEditMode := TRUE
  1501. ELSE
  1502. parentEditMode := FALSE
  1503. END;
  1504. IF ({Inputs.Release} * flags = {}) THEN
  1505. IF (keySym = Inputs.KsF1) & (Inputs.Shift * flags # {}) THEN
  1506. SetEditMode(~editMode.Get(), FALSE);
  1507. RETURN TRUE
  1508. ELSIF (keySym = Inputs.KsEscape) THEN
  1509. selection.Reset(NIL);
  1510. RETURN FALSE
  1511. ELSIF parentEditMode OR editMode.Get() THEN
  1512. IF Inputs.Shift * flags # {} THEN scale := 1 ELSE scale := 4 END;
  1513. IF keySym = Inputs.KsLeft THEN selection.Shift(-scale,0); RETURN TRUE
  1514. ELSIF keySym = Inputs.KsRight THEN selection.Shift(scale,0); RETURN TRUE
  1515. ELSIF keySym = Inputs.KsDown THEN selection.Shift(0,scale); RETURN TRUE
  1516. ELSIF keySym = Inputs.KsUp THEN selection.Shift(0,-scale); RETURN TRUE
  1517. ELSIF keySym=4 (* CTRL-D *) THEN
  1518. clone := Clone(selection.first.component);
  1519. parent := selection.first.component.GetParent(); parent(Component).AddContent(clone);
  1520. RETURN TRUE
  1521. ELSIF keySym=1 THEN (* CTRL-A *)
  1522. enum := GetContents();
  1523. WHILE enum.HasMoreElements() DO
  1524. obj := enum.GetNext();
  1525. IF obj IS VisualComponent THEN
  1526. selection.Add(obj(VisualComponent))
  1527. END;
  1528. END;
  1529. ELSIF keySym = Inputs.KsDelete THEN
  1530. RemoveSelection();
  1531. RETURN TRUE
  1532. END;
  1533. END
  1534. END;
  1535. RETURN FALSE;
  1536. END EditKeyEvents;
  1537. PROCEDURE CheckKeyEvents(ucs : LONGINT; flags: SET; VAR keySym: LONGINT); (** FINAL *)
  1538. VAR event : KeyPressedEvent; command : Strings.String; scale: LONGINT; clone: Repositories.Component; parent: XML.Content;
  1539. BEGIN
  1540. ASSERT(IsCallFromSequencer());
  1541. event.ucs := ucs; event.flags := flags; event.keysym := keySym;
  1542. IF ({Inputs.Release} * flags = {}) THEN
  1543. IF (keySym = Inputs.KsReturn) THEN
  1544. command := GetAttributeValue("onReturn");
  1545. ELSIF (keySym = Inputs.KsEscape) THEN
  1546. command := GetAttributeValue("onEscape");
  1547. selection.Reset(NIL);
  1548. (*ELSIF (keySym = Inputs.KsF1) & (Inputs.Shift * flags # {}) THEN
  1549. SetEditMode(~editMode.Get(), TRUE);
  1550. ELSIF editMode.Get() THEN
  1551. IF Inputs.Shift * flags # {} THEN scale := 1 ELSE scale := 4 END;
  1552. IF keySym = Inputs.KsLeft THEN selection.Shift(-scale,0)
  1553. ELSIF keySym = Inputs.KsRight THEN selection.Shift(scale,0)
  1554. ELSIF keySym = Inputs.KsDown THEN selection.Shift(0,scale)
  1555. ELSIF keySym = Inputs.KsUp THEN selection.Shift(0,-scale)
  1556. ELSIF keySym=4 (* CTRL-D *) THEN
  1557. clone := Clone(selection.first.component);
  1558. parent := selection.first.component.GetParent(); parent(Component).AddContent(clone);
  1559. ELSIF keySym = Inputs.KsDelete THEN
  1560. RemoveSelection();
  1561. END;
  1562. *)
  1563. END;
  1564. IF (command # NIL) THEN HandleEvent(event, SELF, command); END;
  1565. command := GetAttributeValue("onKeyPressed");
  1566. IF (command # NIL) THEN HandleEvent(event, SELF, command); END;
  1567. ELSE
  1568. command := GetAttributeValue("onKeyReleased");
  1569. IF (command # NIL) THEN HandleEvent(event, SELF, command); END;
  1570. END;
  1571. END CheckKeyEvents;
  1572. PROCEDURE CheckPointerEvent(x, y, z : LONGINT; keys : SET);
  1573. VAR event : PointerEvent; command : Strings.String;
  1574. BEGIN
  1575. ASSERT(IsCallFromSequencer());
  1576. event.x := x; event.y := y; event.z := z; event.keys := keys;
  1577. IF ({0} * keys = {0}) THEN
  1578. command := GetAttributeValue("onLeftClick");
  1579. ELSIF ({2} * keys = {2}) THEN
  1580. command := GetAttributeValue("onRightClick");
  1581. ELSIF ({1} * keys = {1}) THEN
  1582. command := GetAttributeValue("onMiddleClick");
  1583. END;
  1584. IF (command # NIL) THEN HandleEvent(event, SELF, command); END;
  1585. command := GetAttributeValue("onClick");
  1586. IF (command # NIL) THEN HandleEvent(event, SELF, command); END;
  1587. END CheckPointerEvent;
  1588. PROCEDURE CheckPointerUpEvent(x, y, z : LONGINT; keys : SET);
  1589. VAR event : PointerEvent; command : Strings.String;
  1590. BEGIN
  1591. ASSERT(IsCallFromSequencer());
  1592. event.x := x; event.y := y; event.z := z; event.keys := keys;
  1593. command := GetAttributeValue("onRelease");
  1594. IF (command # NIL) THEN HandleEvent(event, SELF, command); END;
  1595. END CheckPointerUpEvent;
  1596. PROCEDURE InEditBounds(x,y: LONGINT): LONGINT;
  1597. CONST Border = 8;
  1598. VAR left, right, top, bottom: LONGINT;
  1599. BEGIN
  1600. left := bounds.GetLeft();
  1601. right := bounds.GetRight();
  1602. top := bounds.GetTop();
  1603. bottom := bounds.GetBottom();
  1604. INC(x,left); INC(y,top); (* relative -> absolute *)
  1605. IF (ABS(left-x) <= Border) THEN
  1606. IF (ABS(top-y) <= Border) THEN
  1607. RETURN UpperLeft
  1608. ELSIF (ABS(bottom-y) <= Border) THEN
  1609. RETURN LowerLeft
  1610. ELSE
  1611. RETURN Left
  1612. END
  1613. ELSIF (ABS(right-x) <= Border) THEN
  1614. IF (ABS(top-y) <= Border) THEN
  1615. RETURN UpperRight
  1616. ELSIF (ABS(bottom-y) <= Border) THEN
  1617. RETURN LowerRight
  1618. ELSE
  1619. RETURN Right
  1620. END
  1621. ELSIF (ABS(y-top) <= Border) THEN
  1622. RETURN Upper
  1623. ELSIF (ABS(bottom-y) <= Border) THEN
  1624. RETURN Lower
  1625. ELSIF (x > left+Border) & (x < right-Border) & (y > top+Border) & (y< bottom-Border) THEN
  1626. RETURN Inside
  1627. ELSE
  1628. RETURN None
  1629. END;
  1630. END InEditBounds;
  1631. PROCEDURE Edit(VAR msg: Messages.Message);
  1632. VAR region: LONGINT; dx,dy: LONGINT; b: Rectangles.Rectangle; manager: WM.WindowManager;
  1633. w,h: LONGINT; img: WMGraphics.Image; canvas: WMGraphics.BufferCanvas; e: ComponentListEntry;
  1634. alignRelative : BOOLEAN;
  1635. BEGIN
  1636. IF msg.msgSubType = Messages.MsgSubPointerUp THEN
  1637. editRegion := None;
  1638. SetPointerInfo(oldPointerInfo);
  1639. RETURN
  1640. END;
  1641. dx := msg.x-editX; dy := msg.y-editY;
  1642. b := bounds.Get();
  1643. IF editRegion = Right THEN
  1644. b.r := b.r + dx
  1645. ELSIF editRegion = Left THEN
  1646. b.l := b.l + dx; dx := 0;
  1647. ELSIF editRegion = Lower THEN
  1648. b.b := b.b + dy
  1649. ELSIF editRegion = Upper THEN
  1650. b.t := b.t + dy; dy := 0;
  1651. ELSIF editRegion = LowerLeft THEN
  1652. b.b := b.b + dy;
  1653. b.l := b.l + dx; dx := 0;
  1654. ELSIF editRegion = LowerRight THEN
  1655. b.b := b.b + dy;
  1656. b.r := b.r + dx
  1657. ELSIF editRegion = UpperLeft THEN
  1658. b.t := b.t + dy; dy := 0;
  1659. b.l := b.l + dx; dx := 0;
  1660. ELSIF editRegion = UpperRight THEN
  1661. b.t := b.t + dy; dy := 0;
  1662. b.r := b.r + dx
  1663. ELSIF (editRegion = Inside) & ((dx # 0) OR (dy # 0)) THEN
  1664. img := selection.ToImg(SELF,e);
  1665. IF e # NIL THEN
  1666. IF StartDrag(selection,img,-msg.x-e.dx,-msg.y-e.dy, EditMoved,NIL) THEN END;
  1667. END;
  1668. RETURN
  1669. END;
  1670. AdaptRelativeBounds(b, GetParent());
  1671. bounds.Set(b);
  1672. editX := editX + dx; editY := editY + dy;
  1673. END Edit;
  1674. PROCEDURE SetEditMode*(mode: BOOLEAN; recurse: BOOLEAN);
  1675. VAR vc: VisualComponent; c: XML.Content;
  1676. BEGIN
  1677. Acquire;
  1678. editMode.Set(mode);
  1679. IF recurse THEN
  1680. c := GetFirst();
  1681. WHILE (c # NIL) DO
  1682. IF c IS VisualComponent THEN
  1683. vc := c(VisualComponent);
  1684. vc.SetEditMode(mode, TRUE);
  1685. END;
  1686. c := GetNext(c);
  1687. END;
  1688. END;
  1689. Release;
  1690. END SetEditMode;
  1691. PROCEDURE EditMoved(sender, data: ANY);
  1692. VAR parent: XML.Element; ldata: ANY; e: ComponentListEntry;
  1693. BEGIN
  1694. IF (sender # SELF) THEN
  1695. IF (data # NIL) & (data IS WM.DragInfo) THEN
  1696. ldata := data(WM.DragInfo).data;
  1697. IF (ldata # NIL) & (ldata IS XML.Element) THEN
  1698. parent := ldata(XML.Element).GetParent();
  1699. parent.RemoveContent(ldata(XML.Element));
  1700. parent(VisualComponent).Invalidate;
  1701. ELSIF (ldata # NIL) & (ldata IS SelectionList) THEN
  1702. e := ldata(SelectionList).first;
  1703. WHILE e # NIL DO
  1704. parent := e.component.GetParent();
  1705. ldata := e.component;
  1706. parent.RemoveContent(ldata(XML.Element));
  1707. parent(VisualComponent).Invalidate;
  1708. e := e.next;
  1709. END;
  1710. END;
  1711. END;
  1712. END;
  1713. END EditMoved;
  1714. PROCEDURE HandleInternal*(VAR msg : Messages.Message); (** PROTECTED *)
  1715. VAR
  1716. po : VisualComponent; nm : Messages.Message; handled : BOOLEAN; b : Rectangles.Rectangle;
  1717. r, v : VisualComponent;
  1718. p : XML.Element;
  1719. keyFlags: SET; manager : WM.WindowManager;
  1720. currentEditRegion: LONGINT;
  1721. parent: XML.Element;
  1722. parentEditMode: BOOLEAN;
  1723. BEGIN
  1724. ASSERT(IsCallFromSequencer());
  1725. handled := FALSE;
  1726. IF msg.msgType = Messages.MsgPointer THEN
  1727. parent := GetParent();
  1728. IF (parent # NIL) & (parent IS VisualComponent) & parent(VisualComponent).editMode.Get() THEN
  1729. parentEditMode := TRUE
  1730. ELSE
  1731. parentEditMode := FALSE
  1732. END;
  1733. IF msg.msgSubType = Messages.MsgSubPointerMove THEN
  1734. IF (msg.flags * {0, 1, 2} = {}) OR (fPointerOwner = NIL) THEN
  1735. IF parentEditMode & ~editMode.Get() THEN fPointerOwner := SELF; handled := TRUE
  1736. ELSIF ~parentEditMode & (extGetPositionOwner # NIL) THEN extGetPositionOwner(msg.x, msg.y, fPointerOwner, handled);
  1737. END;
  1738. IF ~handled THEN
  1739. po := GetPositionOwner(msg.x, msg.y);
  1740. IF po # fPointerOwner THEN
  1741. nm.msgType := Messages.MsgPointer;
  1742. nm.msgSubType := Messages.MsgSubPointerLeave;
  1743. HandleInternal(nm)
  1744. END;
  1745. fPointerOwner := po
  1746. ELSE
  1747. handled := FALSE;
  1748. END;
  1749. END
  1750. END;
  1751. IF (fPointerOwner = SELF) THEN
  1752. IF (msg.originator # NIL) & (msg.originator IS WM.ViewPort) THEN
  1753. manager := msg.originator(WM.ViewPort).manager;
  1754. msg.originator(WM.ViewPort).GetKeyState(keyFlags);
  1755. END;
  1756. IF parentEditMode & (editRegion # None) THEN
  1757. Edit(msg)
  1758. ELSE
  1759. IF msg.msgSubType = Messages.MsgSubPointerMove THEN
  1760. IF (parentEditMode) & (msg.originator # NIL) & (msg.originator IS WM.ViewPort) THEN
  1761. currentEditRegion := InEditBounds(msg.x, msg.y);
  1762. CASE currentEditRegion OF
  1763. | Lower, Upper: SetPointerInfo(manager.pointerUpDown)
  1764. | Left, Right:SetPointerInfo(manager.pointerLeftRight)
  1765. | LowerLeft, UpperRight:SetPointerInfo(manager.pointerURDL)
  1766. | UpperLeft, LowerRight: SetPointerInfo(manager.pointerULDR)
  1767. | Inside: SetPointerInfo(manager.pointerMove)
  1768. ELSE
  1769. IF oldPointerInfo # NIL THEN
  1770. SetPointerInfo(oldPointerInfo); oldPointerInfo := NIL;
  1771. ELSE oldPointerInfo := GetPointerInfo();
  1772. END;
  1773. END;
  1774. END;
  1775. IF extPointerMove # NIL THEN extPointerMove(msg.x, msg.y, msg.flags, handled) END;
  1776. SetInternalPointerInfo(pointerInfo);
  1777. IF ~handled THEN PointerMove(msg.x, msg.y, msg.flags) END;
  1778. IF msg.dz # 0 THEN WheelMove(msg.dz) END
  1779. ELSIF msg.msgSubType = Messages.MsgSubPointerDown THEN
  1780. IF parentEditMode THEN
  1781. editRegion := InEditBounds(msg.x, msg.y);
  1782. END;
  1783. (*
  1784. IF (msg.originator # NIL) & (msg.originator IS WM.ViewPort) THEN
  1785. msg.originator(WM.ViewPort).GetKeyState(keyFlags);
  1786. IF (keyFlags # {}) & (keyFlags <= Inputs.Ctrl) THEN editRegion := InEditBounds(msg.x, msg.y) ELSE editRegion := None END;
  1787. ELSE
  1788. editRegion := None
  1789. END;
  1790. *)
  1791. IF editRegion # None THEN
  1792. IF (keyFlags # {}) & (keyFlags <= Inputs.Shift) THEN
  1793. selection.Toggle(SELF)
  1794. ELSIF ~selection.Has(SELF) THEN selection.Reset(SELF)
  1795. END;
  1796. manager := msg.originator(WM.ViewPort).manager;
  1797. editX := msg.x; editY := msg.y;
  1798. ELSE
  1799. IF extPointerDown # NIL THEN extPointerDown(msg.x, msg.y, msg.flags, handled) END;
  1800. IF ~handled THEN PointerDown(msg.x, msg.y, msg.flags) END;
  1801. END;
  1802. SetFocus
  1803. ELSIF msg.msgSubType = Messages.MsgSubPointerUp THEN
  1804. IF extPointerUp # NIL THEN extPointerUp(msg.x, msg.y, msg.flags, handled) END;
  1805. IF ~handled THEN PointerUp(msg.x, msg.y, msg.flags) END
  1806. ELSIF msg.msgSubType = Messages.MsgSubPointerLeave THEN
  1807. IF extPointerLeave # NIL THEN extPointerLeave(handled) END;
  1808. IF ~handled THEN PointerLeave END
  1809. END;
  1810. IF ~parentEditMode & (msg.flags * {0, 1, 2} # {}) THEN
  1811. IF (msg.msgSubType = Messages.MsgSubPointerDown) THEN
  1812. CheckPointerEvent(msg.x, msg.y, msg.z, msg.flags);
  1813. ELSIF msg.msgSubType = Messages.MsgSubPointerUp THEN
  1814. CheckPointerUpEvent(msg.x, msg.y, msg.z, msg.flags);
  1815. END;
  1816. END;
  1817. END;
  1818. ELSE
  1819. b := fPointerOwner.bounds.Get();
  1820. msg.x := msg.x - b.l; msg.y := msg.y - b.t;
  1821. fPointerOwner.Handle(msg)
  1822. END
  1823. ELSIF msg.msgType = Messages.MsgKey THEN
  1824. IF focusComponent # SELF THEN focusComponent.Handle(msg)
  1825. ELSIF EditKeyEvents(msg.x, msg.flags, msg.y) THEN
  1826. handled := TRUE;
  1827. ELSIF (visible.Get()) THEN
  1828. IF ~needsTab.Get() & (msg.y = 0FF09H) THEN
  1829. IF (Inputs.Shift * msg.flags # {}) THEN FocusPrev ELSE FocusNext END
  1830. ELSIF msg.y = 0FF67H THEN ShowContextMenu(0, 0)
  1831. ELSE
  1832. IF extKeyEvent # NIL THEN extKeyEvent(msg.x, msg.flags, msg.y, handled) END;
  1833. IF ~handled THEN KeyEvent(msg.x, msg.flags, msg.y) END;
  1834. CheckKeyEvents(msg.x, msg.flags, msg.y);
  1835. END
  1836. END;
  1837. ELSIF msg.msgType = Messages.MsgDrag THEN
  1838. IF extGetPositionOwner # NIL THEN extGetPositionOwner(msg.x, msg.y, po, handled); END;
  1839. IF ~handled THEN
  1840. po := GetPositionOwner(msg.x, msg.y);
  1841. ELSE
  1842. handled := FALSE;
  1843. END;
  1844. IF (po # SELF) & editMode.Get() & (~po.editMode.Get() OR (msg.ext # NIL) & (msg.ext(WM.DragInfo).data=po)) THEN
  1845. po := SELF
  1846. 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
  1847. po := SELF
  1848. END;
  1849. IF (po # SELF) THEN (* Let child handle the drag and drop message *)
  1850. b := po.bounds.Get();
  1851. msg.x := msg.x - b.l; msg.y := msg.y - b.t;
  1852. po.Handle(msg)
  1853. ELSE (* handle the drag and drop message *)
  1854. IF msg.msgSubType = Messages.MsgDragOver THEN
  1855. IF (msg.ext # NIL) THEN
  1856. IF extDragOver # NIL THEN extDragOver(msg.x, msg.y, msg.ext(WM.DragInfo), handled) END;
  1857. IF ~handled THEN po.DragOver(msg.x, msg.y, msg.ext(WM.DragInfo)) END
  1858. END
  1859. ELSIF msg.msgSubType = Messages.MsgDragDropped THEN
  1860. IF (msg.ext # NIL) THEN
  1861. IF (msg.ext(WM.DragInfo).data # NIL) & (msg.ext(WM.DragInfo).data IS ToggleEditMode) THEN
  1862. SetEditMode(~editMode.Get(), msg.ext(WM.DragInfo).data(ToggleEditMode).recursion # Recursion.None);
  1863. Invalidate;
  1864. ELSIF editMode.Get() THEN
  1865. handled := EditDragDropped(msg.x,msg.y,msg.ext(WM.DragInfo));
  1866. ELSIF extDragDropped # NIL THEN
  1867. extDragDropped(msg.x, msg.y, msg.ext(WM.DragInfo), handled)
  1868. END;
  1869. IF ~handled THEN
  1870. po.DragDropped(msg.x, msg.y, msg.ext(WM.DragInfo))
  1871. END
  1872. END
  1873. END
  1874. END
  1875. ELSIF (msg.msgType = Messages.MsgFocus) & (msg.msgSubType = Messages.MsgSubFocusLost) THEN
  1876. (* unset the old focus chain *)
  1877. r := GetVisualComponentRoot(); (* find the leaf component that has the focus *)
  1878. WHILE (r # NIL) & (r.focusComponent # NIL) & (r.focusComponent # r) DO r := r.focusComponent END;
  1879. p := r; (* clear the focus chain until the root or this component *)
  1880. WHILE (p # SELF) & (p # NIL) & (p IS VisualComponent) DO
  1881. v := p(VisualComponent);
  1882. v.focusComponent := v;
  1883. v.FocusLost; IF v.extFocus # NIL THEN v.extFocus(FALSE) END; p := p.GetParent()
  1884. END;
  1885. ELSIF msg.msgType = Messages.MsgInvalidate THEN
  1886. IF msg.msgSubType = Messages.MsgSubAll THEN
  1887. msg.sender(VisualComponent).InvalidateRect(GetClientRect());
  1888. ELSIF msg.msgSubType = Messages.MsgSubRectangle THEN
  1889. msg.sender(VisualComponent).InvalidateRect(Rectangles.MakeRect(msg.x, msg.y, msg.dx, msg.dy));
  1890. ELSE (* nothing to do *)
  1891. END;
  1892. ELSIF msg.msgType = Messages.MsgExt THEN
  1893. IF msg.ext = invalidateRectMsg THEN
  1894. TRACE("WARNING: OLD MESSAGE FORM");
  1895. msg.sender(VisualComponent).InvalidateRect(Rectangles.MakeRect(msg.x, msg.y, msg.dx, msg.dy))
  1896. ELSE
  1897. BroadcastSubcomponents(msg);
  1898. END
  1899. ELSE HandleInternal^(msg)
  1900. END;
  1901. END HandleInternal;
  1902. END VisualComponent;
  1903. GetPositionOwnerHandler* = PROCEDURE {DELEGATE} (x, y : LONGINT; VAR positionOwner : VisualComponent; VAR handled : BOOLEAN);
  1904. TYPE
  1905. (* Layout Manager *)
  1906. LayoutManager* = PROCEDURE {DELEGATE} (vc : VisualComponent);
  1907. FormWindow* = OBJECT(WM.DoubleBufferWindow)
  1908. VAR
  1909. form- : Form;
  1910. cs : WMGraphics.CanvasState;
  1911. disableUpdate : LONGINT;
  1912. content : VisualComponent;
  1913. scaling* : BOOLEAN;
  1914. PROCEDURE ToXML*():XML.Content;
  1915. VAR winx: XML.Element; a: XML.Attribute; string: ARRAY 128 OF CHAR; title:Strings.String;
  1916. BEGIN {EXCLUSIVE}
  1917. NEW(winx); winx.SetName("FormWindow");
  1918. NEW(a); a.SetName("name");
  1919. title:=GetTitle(); IF title=NIL THEN a.SetValue("componentWindow") ELSE a.SetValue(title^) END;
  1920. winx.AddAttribute(a);
  1921. NEW(a); a.SetName("loader"); a.SetValue("WMComponents.FormWindowGen"); winx.AddAttribute(a);
  1922. NEW(a); a.SetName("l"); Strings.IntToStr(bounds.l, string); a.SetValue(string); winx.AddAttribute(a);
  1923. NEW(a); a.SetName("t"); Strings.IntToStr(bounds.t, string); a.SetValue(string); winx.AddAttribute(a);
  1924. NEW(a); a.SetName("r"); Strings.IntToStr(bounds.r, string); a.SetValue(string); winx.AddAttribute(a);
  1925. NEW(a); a.SetName("b"); Strings.IntToStr(bounds.b, string); a.SetValue(string); winx.AddAttribute(a);
  1926. NEW(a); a.SetName("flags"); Strings.SetToStr(flags, string); a.SetValue(string); winx.AddAttribute(a);
  1927. NEW(a); a.SetName("canvasGenerator"); a.SetValue(canvas.generator^); winx.AddAttribute(a);
  1928. winx.AddContent(form);
  1929. RETURN winx
  1930. END ToXML;
  1931. PROCEDURE LoadComponents*(xml: XML.Element);
  1932. VAR component: Repositories.Component;
  1933. BEGIN
  1934. IF xml # NIL THEN
  1935. component := Repositories.ComponentFromXML(xml);
  1936. IF (component # NIL) & (component IS VisualComponent) THEN
  1937. SetContent(component);
  1938. ELSE
  1939. KernelLog.String("formwindow could not load content"); KernelLog.Ln;
  1940. END;
  1941. END;
  1942. END LoadComponents;
  1943. PROCEDURE StoreComponents*(): XML.Element;
  1944. BEGIN RETURN content (* do not store form separately *)
  1945. END StoreComponents;
  1946. PROCEDURE SetContent*(x : XML.Content);
  1947. VAR c: XML.Content;
  1948. m:Messages.Message;
  1949. BEGIN
  1950. IF sequencer # NIL THEN sequencer.WaitFree() END;
  1951. BEGIN{EXCLUSIVE}
  1952. INC(disableUpdate);
  1953. INCL(flags, 13); (* render windows background non-displayed*)
  1954. IF form # NIL THEN form.Finalize; form.sequencer.Stop; content:=NIL END;
  1955. IF x IS Form THEN
  1956. form := x(Form);
  1957. form.initialized:=FALSE;
  1958. form.SetWindow(SELF); (* includes new sequencer *)
  1959. c:=form.GetFirst(); (* get first VisualComponent content of form*)
  1960. WHILE (c#NIL) & (c IS XML.Container) & ~(c IS VisualComponent) DO
  1961. c:=c(XML.Container).GetNext(c);
  1962. END;
  1963. IF c#NIL THEN form.RemoveContent(c) END; (* avoid duplicates. will be added in a systematic way below in AddContent *)
  1964. ELSE
  1965. NEW(form, SELF); (* includes new sequencer; initialized=FALSE *)
  1966. form.uid.Set(NewString("form"));
  1967. c:=x;
  1968. END;
  1969. IF (c#NIL) & (c IS VisualComponent) THEN
  1970. content := c(VisualComponent);
  1971. form.initialized:=TRUE;
  1972. form.AddContent(content);
  1973. form.focusComponent := content;
  1974. form.fPointerOwner := content;
  1975. END;
  1976. DEC(disableUpdate);
  1977. END;
  1978. (*form.Initialize;*)(*implied above*)
  1979. (*form.Invalidate;*)(*implied above*)
  1980. END SetContent;
  1981. PROCEDURE DisableUpdate*;
  1982. BEGIN {EXCLUSIVE}
  1983. INC(disableUpdate);
  1984. ASSERT(disableUpdate # -1); (* overflow *)
  1985. END DisableUpdate;
  1986. PROCEDURE EnableUpdate*;
  1987. BEGIN {EXCLUSIVE}
  1988. DEC(disableUpdate);
  1989. ASSERT(disableUpdate # -1); (* underflow *)
  1990. END EnableUpdate;
  1991. PROCEDURE Resized( width, height: LONGINT);
  1992. BEGIN
  1993. IF ~scaling THEN
  1994. DisableUpdate;
  1995. form.Acquire;
  1996. ReInit(width, height);
  1997. form.Release;
  1998. form.bounds.Set(Rectangles.MakeRect(0, 0, GetWidth(), GetHeight()));
  1999. content.bounds.Set(Rectangles.MakeRect(0, 0, GetWidth(), GetHeight()));
  2000. EnableUpdate;
  2001. form.Invalidate()
  2002. END
  2003. END Resized;
  2004. PROCEDURE Trap():BOOLEAN;
  2005. BEGIN
  2006. KernelLog.String("WMComponents.FormWindow.Trap !!! --> Resetting Locks "); KernelLog.Ln;
  2007. form.sequencer.lock.Reset;
  2008. RETURN TRUE
  2009. END Trap;
  2010. PROCEDURE Update(rect : Rectangles.Rectangle);
  2011. BEGIN
  2012. (*KernelLog.String("Update "); KernelLog.Int(disableUpdate,0); KernelLog.Ln;*)
  2013. IF disableUpdate > 0 THEN RETURN END;
  2014. form.Acquire;
  2015. canvas.SaveState(cs);
  2016. canvas.SetClipRect(rect);
  2017. canvas.ClipRectAsNewLimits(0, 0);
  2018. IF Raster.alpha IN img.fmt.components THEN
  2019. canvas.Fill(rect, 0H, WMGraphics.ModeCopy)
  2020. ELSE
  2021. canvas.Fill(rect, 0H (*0FFH*), Raster.clear(*WMGraphics.ModeCopy*))
  2022. END;
  2023. form.Draw(canvas);
  2024. canvas.RestoreState(cs);
  2025. form.Release;
  2026. CopyRect(rect);
  2027. Invalidate(rect)
  2028. END Update;
  2029. PROCEDURE Handle*(VAR m : Messages.Message);
  2030. VAR pendingM: Messages.Message;
  2031. BEGIN
  2032. Handle^(m);
  2033. IF (m.msgType = Messages.MsgExt) & (m.ext # NIL) THEN
  2034. IF (m.ext = componentStyleMsg) THEN CSChanged
  2035. END;
  2036. ELSIF (m.msgType = Messages.MsgFocus) & (m.msgSubType = Messages.MsgSubFocusGot) THEN
  2037. IF (form # NIL) & (form.lastFocusComponent # NIL) THEN
  2038. form.lastFocusComponent.SetFocus;
  2039. END;
  2040. ELSIF (m.msgType = Messages.MsgSetLanguage) & (m.ext # NIL) & (m.ext IS LanguageExtension) THEN
  2041. LanguageChanged(m.ext(LanguageExtension).languages);
  2042. ELSIF (m.msgType=Messages.MsgInvalidate) THEN (* sent by WindowManager when a window is added to display space to assure it is up-to-date*)
  2043. IF form=NIL THEN RETURN
  2044. ELSE m.sender:=form; (* will be passed to form below, which will call sender.InvalidateRect *)
  2045. END;
  2046. END;
  2047. IF (TraceFocus IN Trace) THEN
  2048. IF (m.msgType = Messages.MsgFocus) THEN
  2049. IF (m.msgSubType = Messages.MsgSubFocusGot) THEN
  2050. KernelLog.String("Got Focus: "); form.TraceFocusChain;
  2051. ELSIF (m.msgSubType = Messages.MsgSubMasterFocusGot) THEN
  2052. KernelLog.String("Got Master Focus: "); form.TraceFocusChain;
  2053. END;
  2054. ELSIF (m.msgType = Messages.MsgKey) & (m.x = ORD("f")) THEN
  2055. KernelLog.String("Focus chain: "); form.TraceFocusChain;
  2056. END;
  2057. END;
  2058. IF (form # NIL) THEN form.Handle(m); END;
  2059. END Handle;
  2060. PROCEDURE LanguageChanged*(languages : Localization.Languages);
  2061. BEGIN
  2062. ASSERT(languages # NIL);
  2063. END LanguageChanged;
  2064. PROCEDURE CSChanged*;
  2065. BEGIN
  2066. DisableUpdate; (* the components are going to redraw like crazy *)
  2067. form.Acquire;
  2068. form.Reset(SELF, NIL);
  2069. form.Release;
  2070. EnableUpdate;
  2071. END CSChanged;
  2072. PROCEDURE Close*;
  2073. BEGIN
  2074. Close^; (* remove the form to avoid further messages *)
  2075. IF form # NIL THEN
  2076. form.Acquire;
  2077. form.Finalize; form.sequencer.Stop;
  2078. form.Release
  2079. END;
  2080. END Close;
  2081. END FormWindow;
  2082. Form* = OBJECT(VisualComponent)
  2083. VAR
  2084. window- : FormWindow;
  2085. lastFocusComponent : VisualComponent;
  2086. PROCEDURE &New*(window : FormWindow);
  2087. BEGIN
  2088. Init;
  2089. SetGenerator("WMComponents.NewForm");
  2090. lastFocusComponent := NIL;
  2091. SetNameAsString(StrForm);
  2092. SetWindow(window);
  2093. END New;
  2094. PROCEDURE SetWindow*(window: FormWindow);
  2095. VAR seq: Messages.MsgSequencer;
  2096. BEGIN {EXCLUSIVE}
  2097. IF window # NIL THEN
  2098. SELF.window := window;
  2099. window.form := SELF;
  2100. bounds.Set(Rectangles.MakeRect(0, 0, window.GetWidth(), window.GetHeight()));
  2101. NEW(seq, Handle); seq.SetTrapHandler(window.Trap); SetSequencer(seq);
  2102. END;
  2103. END SetWindow;
  2104. PROCEDURE GetPointerInfo*() : WM.PointerInfo;
  2105. BEGIN
  2106. ASSERT(IsCallFromSequencer());
  2107. IF window # NIL THEN RETURN window.pointerInfo ELSE RETURN NIL END
  2108. END GetPointerInfo;
  2109. PROCEDURE SetPointerInfo*(pi : WM.PointerInfo);
  2110. BEGIN
  2111. ASSERT(IsCallFromSequencer());
  2112. IF window # NIL THEN window.SetPointerInfo(pi) END;
  2113. END SetPointerInfo;
  2114. PROCEDURE DisableUpdate*;
  2115. BEGIN
  2116. ASSERT(IsCallFromSequencer());
  2117. IF window # NIL THEN window.DisableUpdate END
  2118. END DisableUpdate;
  2119. PROCEDURE EnableUpdate*;
  2120. BEGIN
  2121. ASSERT(IsCallFromSequencer());
  2122. IF window # NIL THEN window.EnableUpdate END
  2123. END EnableUpdate;
  2124. PROCEDURE InvalidateRect*(rect : Rectangles.Rectangle);
  2125. BEGIN
  2126. IF window # NIL THEN
  2127. BEGIN{EXCLUSIVE} AWAIT(initialized) END;
  2128. window.Update(rect)
  2129. END;
  2130. END InvalidateRect;
  2131. PROCEDURE PropertyChanged*(sender, property : ANY);
  2132. VAR w,h: LONGINT;
  2133. BEGIN
  2134. IF property = bounds THEN
  2135. IF ~ Rectangles.IsEqual(window.bounds, bounds.Get()) THEN
  2136. bounds.GetExtents(w,h);
  2137. IF window # NIL THEN
  2138. window.manager.SetWindowSize(window,w,h);
  2139. END;
  2140. ELSE
  2141. (*ScaleFont(bounds.GetHeight(), scaleFont.Get());*)
  2142. Resized
  2143. END;
  2144. END
  2145. END PropertyChanged;
  2146. END Form;
  2147. TYPE
  2148. (** PropertyLists for style support *)
  2149. PropertyListEntry = POINTER TO RECORD
  2150. next : PropertyListEntry;
  2151. name : Strings.String;
  2152. list : WMProperties.PropertyList;
  2153. END;
  2154. ListArray* = POINTER TO ARRAY OF WMProperties.PropertyList;
  2155. PropertyListList* = OBJECT
  2156. VAR
  2157. first : PropertyListEntry;
  2158. PROCEDURE Find*(CONST name : ARRAY OF CHAR) : WMProperties.PropertyList;
  2159. VAR cur : PropertyListEntry;
  2160. BEGIN {EXCLUSIVE}
  2161. cur := first;
  2162. WHILE (cur # NIL) & (cur.name^ # name) DO cur := cur.next END;
  2163. IF cur # NIL THEN RETURN cur.list
  2164. ELSE RETURN NIL
  2165. END
  2166. END Find;
  2167. PROCEDURE RemoveInternal(CONST name : ARRAY OF CHAR);
  2168. VAR cur : PropertyListEntry;
  2169. BEGIN
  2170. IF first = NIL THEN RETURN END;
  2171. IF (first # NIL) & (first.name^ = name) THEN first := first.next
  2172. ELSE
  2173. cur := first;
  2174. WHILE (cur.next # NIL) DO
  2175. IF (cur.next.name^ = name) THEN cur.next := cur.next.next END;
  2176. cur := cur.next
  2177. END
  2178. END
  2179. END RemoveInternal;
  2180. PROCEDURE Remove*(CONST name : ARRAY OF CHAR);
  2181. BEGIN {EXCLUSIVE}
  2182. RemoveInternal(name)
  2183. END Remove;
  2184. PROCEDURE Add*(CONST name : ARRAY OF CHAR; pl : WMProperties.PropertyList);
  2185. VAR new : PropertyListEntry;
  2186. BEGIN {EXCLUSIVE}
  2187. RemoveInternal(name);
  2188. NEW(new); new.name := NewString(name); new.list := pl; new.next := first; first := new
  2189. END Add;
  2190. PROCEDURE Enumerate*() : ListArray;
  2191. VAR array : ListArray; current : PropertyListEntry; i : LONGINT;
  2192. BEGIN {EXCLUSIVE}
  2193. i := 0;
  2194. current := first;
  2195. WHILE current # NIL DO INC(i); current := current.next END;
  2196. NEW(array, i );
  2197. current := first;
  2198. i := 0;
  2199. WHILE current # NIL DO
  2200. array[i] := current.list;
  2201. INC(i);
  2202. current := current.next
  2203. END;
  2204. RETURN array
  2205. END Enumerate;
  2206. PROCEDURE UpdateStyle*;
  2207. VAR
  2208. en : XMLObjects.Enumerator;
  2209. p : ANY; s : Strings.String;
  2210. pl : WMProperties.PropertyList;
  2211. BEGIN
  2212. IF currentStyle = NIL THEN RETURN END;
  2213. en := currentStyle.GetContents();
  2214. WHILE en.HasMoreElements() DO
  2215. p := en.GetNext();
  2216. IF p IS XML.Element THEN
  2217. s := p(XML.Element).GetName();
  2218. pl := propertyListList.Find(s^);
  2219. IF pl # NIL THEN pl.SetXML(p(XML.Element)) END
  2220. END
  2221. END
  2222. END UpdateStyle;
  2223. END PropertyListList;
  2224. ComponentListEntry= POINTER TO RECORD
  2225. component: VisualComponent;
  2226. dx,dy: LONGINT;
  2227. next: ComponentListEntry
  2228. END;
  2229. SelectionArray* = POINTER TO ARRAY OF VisualComponent;
  2230. SelectionList*= OBJECT
  2231. VAR first, last: ComponentListEntry; number: LONGINT; state: LONGINT; timer: Kernel.Timer;
  2232. onChanged-: WMEvents.EventSource;
  2233. lock: Locks.RecursiveLock;
  2234. PROCEDURE &Init;
  2235. BEGIN
  2236. NEW(lock);
  2237. first := NIL; last := NIL; number := 0; state := 0; NEW(onChanged, NIL, NIL, NIL, NIL);
  2238. END Init;
  2239. PROCEDURE Reset(this: VisualComponent);
  2240. VAR entry: ComponentListEntry;
  2241. BEGIN
  2242. lock.Acquire;
  2243. entry := first;
  2244. first := NIL; last := NIL; number := 0;
  2245. WHILE entry # NIL DO entry.component.Invalidate; entry := entry.next END;
  2246. lock.Release;
  2247. Add(this);
  2248. onChanged.Call(SELF);
  2249. END Reset;
  2250. PROCEDURE Has*(this: ANY): BOOLEAN;
  2251. VAR entry: ComponentListEntry;
  2252. BEGIN
  2253. IF first = NIL THEN RETURN FALSE END; (* no lock for usual case *)
  2254. lock.Acquire;
  2255. entry := first;
  2256. WHILE (entry # NIL) & (entry.component # this) DO entry := entry.next END;
  2257. lock.Release;
  2258. RETURN entry # NIL
  2259. END Has;
  2260. PROCEDURE Add*(this: VisualComponent);
  2261. VAR entry: ComponentListEntry;
  2262. BEGIN
  2263. IF (this = NIL) OR Has(this) THEN RETURN END;
  2264. lock.Acquire;
  2265. NEW(entry); entry.component := this; entry.next := NIL;
  2266. IF last = NIL THEN
  2267. ASSERT(first = NIL);
  2268. first := entry; last := entry;
  2269. ELSE
  2270. last.next := entry; last := entry
  2271. END;
  2272. INC(number);
  2273. lock.Release;
  2274. this.Invalidate;
  2275. onChanged.Call(SELF);
  2276. END Add;
  2277. PROCEDURE Remove*(this: VisualComponent);
  2278. VAR entry, prev: ComponentListEntry;
  2279. BEGIN
  2280. lock.Acquire;
  2281. entry := first; prev := NIL;
  2282. WHILE (entry # NIL) & (entry.component # this) DO
  2283. prev := entry;
  2284. entry := entry.next;
  2285. END;
  2286. IF entry = NIL THEN lock.Release; RETURN END;
  2287. IF prev # NIL THEN prev.next := entry.next END;
  2288. IF entry = first THEN first := first.next END;
  2289. IF entry = last THEN last := prev END;
  2290. DEC(number);
  2291. lock.Release;
  2292. this.Invalidate;
  2293. onChanged.Call(SELF);
  2294. END Remove;
  2295. PROCEDURE GetSelection*(): SelectionArray;
  2296. VAR array: SelectionArray; i: LONGINT; e: ComponentListEntry;
  2297. BEGIN
  2298. lock.Acquire;
  2299. NEW(array, number);
  2300. e := first; i := 0;
  2301. WHILE e # NIL DO
  2302. array[i] := e.component;
  2303. INC(i);
  2304. e := e.next;
  2305. END;
  2306. lock.Release;
  2307. RETURN array;
  2308. END GetSelection;
  2309. PROCEDURE Toggle*(this: VisualComponent);
  2310. BEGIN
  2311. IF Has(this) THEN Remove(this) ELSE Add(this) END;
  2312. END Toggle;
  2313. PROCEDURE Update;
  2314. VAR e: ComponentListEntry;
  2315. BEGIN
  2316. e := first;
  2317. WHILE e # NIL DO
  2318. e.component.Invalidate;
  2319. e := e.next;
  2320. END;
  2321. END Update;
  2322. PROCEDURE Shift(dx, dy: LONGINT);
  2323. VAR e: ComponentListEntry; rect: Rectangles.Rectangle;
  2324. BEGIN
  2325. e := first;
  2326. WHILE e # NIL DO
  2327. rect := e.component.bounds.Get();
  2328. INC(rect.l,dx); INC(rect.r,dx);
  2329. INC(rect.t,dy); INC(rect.b,dy);
  2330. e.component.AdaptRelativeBounds(rect,e.component.GetParent());
  2331. e.component.bounds.Set(rect);
  2332. e := e.next
  2333. END;
  2334. END Shift;
  2335. PROCEDURE ToImg(start: VisualComponent; VAR this: ComponentListEntry): WMGraphics.Image;
  2336. VAR l,t,r,b: LONGINT; e: ComponentListEntry; rect: Rectangles.Rectangle; img, image: WMGraphics.Image; w,h: LONGINT;
  2337. canvas: WMGraphics.BufferCanvas; srcCopy: Raster.Mode;
  2338. BEGIN
  2339. l := MAX(LONGINT); r := MIN(LONGINT);
  2340. t := MAX(LONGINT); b := MIN(LONGINT);
  2341. e := first;
  2342. WHILE e # NIL DO
  2343. rect := e.component(VisualComponent).bounds.Get();
  2344. IF rect.l < l THEN l := rect.l END;
  2345. IF rect.r > r THEN r := rect.r END;
  2346. IF rect.t < t THEN t := rect.t END;
  2347. IF rect.b > b THEN b := rect.b END;
  2348. e := e.next;
  2349. END;
  2350. Raster.InitMode(srcCopy, Raster.srcCopy);
  2351. NEW(image);
  2352. w := r-l+1; h := b-t+1;
  2353. Raster.Create(image, w,h, Raster.BGRA8888);
  2354. e := first;
  2355. WHILE e # NIL DO
  2356. rect := e.component.bounds.Get();
  2357. NEW(img);
  2358. Raster.Create(img,rect.r-rect.l+1, rect.b-rect.t+1, Raster.BGRA8888);
  2359. NEW(canvas,img);
  2360. e.component.Draw(canvas);
  2361. Raster.Copy(img,image,0,0,img.width-1, img.height-1,rect.l-l, rect.t-t, srcCopy);
  2362. e.dx := rect.l-l; e.dy := rect.t-t;
  2363. IF e.component = start THEN this := e END;
  2364. e := e.next
  2365. END;
  2366. RETURN image
  2367. END ToImg;
  2368. BEGIN {ACTIVE}
  2369. NEW(timer);
  2370. LOOP
  2371. timer.Sleep(400);
  2372. state := (state + 1) MOD 2;
  2373. Update;
  2374. END
  2375. END SelectionList;
  2376. WindowGenerator*= PROCEDURE(xml: XML.Content): WM.Window;
  2377. VAR
  2378. hasErrors : BOOLEAN; (* accessed only from (EXCLUSIVE) *)
  2379. invalidateRectMsg- : Messages.MessageExtension; (* used as unique ID *)
  2380. PrototypeID, PrototypeUID : WMProperties.StringProperty;
  2381. PrototypeBounds-, PrototypeBoundsRelative-, PrototypeBearing : WMProperties.RectangleProperty;
  2382. PrototypeEnabled : WMProperties.BooleanProperty;
  2383. PrototypeFillColor : WMProperties.ColorProperty;
  2384. PrototypeAlignment : WMProperties.Int32Property;
  2385. PrototypeVisible, PrototypeTakesFocus, PrototypeNeedsTab, PrototypeEditMode: WMProperties.BooleanProperty;
  2386. PrototypeScaleFont: WMProperties.Int32Property;
  2387. PrototypeFocusPrevious, PrototypeFocusNext : WMProperties.StringProperty;
  2388. PrototypeFont- : WMProperties.FontProperty;
  2389. StrComponent, StrVisualComponent, StrForm, StrFormWindow, StrModel, StrModelInfo : Strings.String;
  2390. GSonStartDrag, GSonStartDragInfo : Strings.String;
  2391. ModelPrototype-: WMProperties.ReferenceProperty;
  2392. propertyListList- : PropertyListList;
  2393. currentStyle- : XML.Element;
  2394. componentStyleMsg- : ComponentStyleChanged;
  2395. timestamp : LONGINT;
  2396. macroHandlers : MacroHandler; (* the head of the list is always the DefaultMacroHandler *)
  2397. selection-: SelectionList;
  2398. (*
  2399. PROCEDURE ResetInternal(parent:Component);
  2400. VAR c: XML.Content;
  2401. BEGIN
  2402. IF ~parent.initialized THEN parent.Initialize END;
  2403. (*parent.RecacheProperties;*)
  2404. c := parent.GetFirst();
  2405. WHILE (c # NIL) DO
  2406. IF c IS Component THEN
  2407. ResetInternal(c(Component))
  2408. END;
  2409. c := parent.GetNext(c);
  2410. END;
  2411. END ResetInternal;
  2412. *)
  2413. PROCEDURE IsWhiteSpace(ch : CHAR) : BOOLEAN;
  2414. BEGIN
  2415. RETURN ch <= " ";
  2416. END IsWhiteSpace;
  2417. PROCEDURE SkipWhiteSpace(CONST string : ARRAY OF CHAR; VAR index : LONGINT);
  2418. VAR length : LONGINT;
  2419. BEGIN
  2420. length := LEN(string);
  2421. WHILE (index < length) & (string[index] # 0X) & IsWhiteSpace(string[index]) DO INC(index); END;
  2422. ASSERT(index < LEN(string));
  2423. END SkipWhiteSpace;
  2424. PROCEDURE ReadWord*(CONST string : ARRAY OF CHAR; VAR word : ARRAY OF CHAR; VAR index : LONGINT) : BOOLEAN;
  2425. VAR length, wordLength, i : LONGINT;
  2426. BEGIN
  2427. SkipWhiteSpace(string, index);
  2428. length := LEN(string);
  2429. wordLength := LEN(word);
  2430. i := 0;
  2431. WHILE (index < length) & (string[index] # 0X) & ~IsWhiteSpace(string[index]) & (i < wordLength) DO
  2432. word[i] := string[index];
  2433. INC(i);
  2434. INC(index);
  2435. END;
  2436. IF (i < wordLength) THEN word[i] := 0X; END;
  2437. ASSERT(index < LEN(string));
  2438. RETURN (i > 0) & (index < length) & (i < wordLength);
  2439. END ReadWord;
  2440. (* Split <string> into two strings separated by <separator> *)
  2441. PROCEDURE SplitMacroString(CONST string : ARRAY OF CHAR; VAR namespace, name : ARRAY OF CHAR; separator : CHAR);
  2442. VAR i, j : LONGINT;
  2443. BEGIN
  2444. ASSERT((LEN(namespace) >= LEN(string)) & (LEN(name) >= LEN(string)));
  2445. i := 0;
  2446. WHILE (i < LEN(string)) & (string[i] # 0X) & (string[i] # separator) DO
  2447. namespace[i] := string[i];
  2448. INC(i);
  2449. END;
  2450. namespace[i] := 0X;
  2451. INC(i); (* skip separator *)
  2452. j := 0;
  2453. WHILE (i < LEN(string)) & (string[i] # 0X) DO
  2454. name[j] := string[i];
  2455. INC(i); INC(j);
  2456. END;
  2457. name[j] := 0X;
  2458. IF (name = "") THEN COPY(namespace, name); COPY(NoNamespace, namespace); END; (* no namespace *)
  2459. END SplitMacroString;
  2460. PROCEDURE ReportError(CONST text, argument1, argument2 : ARRAY OF CHAR);
  2461. VAR
  2462. message : Events.Message;
  2463. textIdx, messageIdx : LONGINT;
  2464. secondArgument : BOOLEAN;
  2465. PROCEDURE Append(VAR message : ARRAY OF CHAR; CONST argument : ARRAY OF CHAR; VAR index : LONGINT);
  2466. VAR i : LONGINT;
  2467. BEGIN
  2468. i := 0;
  2469. WHILE (i < LEN(argument)) & (argument[i] # 0X) & (index < LEN(message) - 1) DO
  2470. message[index] := argument[i];
  2471. INC(i);
  2472. INC(index);
  2473. END;
  2474. END Append;
  2475. BEGIN
  2476. secondArgument := FALSE;
  2477. textIdx := 0;
  2478. messageIdx := 0;
  2479. WHILE (textIdx < LEN(text)) & (text[textIdx] # 0X) & (messageIdx < LEN(message) - 1) DO
  2480. IF (text[textIdx] # "%") THEN
  2481. message[messageIdx] := text[textIdx];
  2482. INC(messageIdx);
  2483. ELSE
  2484. IF ~secondArgument THEN
  2485. secondArgument := TRUE;
  2486. Append(message, argument1, messageIdx);
  2487. ELSE
  2488. Append(message, argument2, messageIdx);
  2489. END;
  2490. END;
  2491. INC(textIdx);
  2492. END;
  2493. message[messageIdx] := 0X;
  2494. Events.AddEvent("Components", Events.Error, 0, 0, 0, message, FALSE);
  2495. END ReportError;
  2496. PROCEDURE GetArgumentStream*(command: Strings.String; offset: LONGINT; VAR arguments: Streams.StringReader);
  2497. VAR i: LONGINT;
  2498. BEGIN
  2499. IF command = NIL THEN arguments := NIL; RETURN END;
  2500. i := offset;
  2501. WHILE (i < LEN(command)) & (command[i] # 0X) DO INC(i); END;
  2502. IF (i # offset) THEN
  2503. NEW(arguments, i - offset + 1);
  2504. arguments.SetRaw(command^, offset, i - offset + 1);
  2505. ELSE
  2506. arguments := NIL;
  2507. END;
  2508. END GetArgumentStream;
  2509. PROCEDURE GenerateContext*(oldCommand, command : Strings.String; index : LONGINT; originator : Component; CONST event : Event) : EventContext;
  2510. VAR
  2511. context : EventContext; pointerContext : PointerContext; keyContext : KeyContext;
  2512. arguments : Streams.StringReader;
  2513. i : LONGINT;
  2514. BEGIN
  2515. ASSERT((command # NIL) & (0 <= index) & (index < LEN(command)));
  2516. ASSERT(originator # NIL);
  2517. GetArgumentStream(command,index,arguments);
  2518. IF (event IS PointerEvent) THEN
  2519. NEW(pointerContext, originator, oldCommand, NIL, arguments, NIL, NIL, NIL); pointerContext.pointer := event(PointerEvent);
  2520. context := pointerContext;
  2521. ELSIF (event IS KeyPressedEvent) THEN
  2522. NEW(keyContext, originator, oldCommand, NIL, arguments, NIL, NIL, NIL); keyContext.key := event(KeyPressedEvent);
  2523. context := keyContext;
  2524. ELSE
  2525. NEW(context, originator, oldCommand, NIL, arguments, NIL, NIL, NIL);
  2526. END;
  2527. BEGIN {EXCLUSIVE}
  2528. context.timestamp := timestamp;
  2529. INC(timestamp);
  2530. END;
  2531. ASSERT(context # NIL);
  2532. RETURN context;
  2533. END GenerateContext;
  2534. PROCEDURE HandleEvent*(CONST event : Event; originator : Component; command : Strings.String);
  2535. VAR
  2536. commandString : ARRAY 128 OF CHAR;
  2537. newCommand : Strings.String;
  2538. context : EventContext;
  2539. msg : Events.Message;
  2540. index : LONGINT;
  2541. BEGIN
  2542. ASSERT((originator # NIL) & (command # NIL));
  2543. index := 0;
  2544. IF Logging THEN
  2545. COPY(command^, msg);
  2546. Events.AddEvent("Components", Events.Information, 0, 0, 0, msg, FALSE);
  2547. END;
  2548. SubstituteMacros(command, newCommand, originator);
  2549. IF ReadWord(newCommand^, commandString, index) THEN
  2550. context := GenerateContext(command, newCommand, index, originator, event);
  2551. Commands.Activate(commandString, context, {}, context.result, msg); (* asynchronous call since holding the originators lock! *)
  2552. IF (context.result # Commands.Ok) THEN
  2553. Events.AddEvent("Components", Events.Error, 0, 0, 0, msg, FALSE);
  2554. END;
  2555. ELSE
  2556. Events.AddEvent("Components", Events.Error, 0, 0, 0, "Expected command", FALSE);
  2557. END;
  2558. END HandleEvent;
  2559. PROCEDURE ContainsMacros(CONST string : ARRAY OF CHAR) : BOOLEAN;
  2560. VAR result : BOOLEAN; length, i : LONGINT;
  2561. BEGIN
  2562. result := FALSE;
  2563. i := 0; length := LEN(string);
  2564. WHILE (i < length) & (string[i] # 0X) & ~result DO
  2565. IF (string[i] = MacroCharacter) THEN
  2566. result := (i + 1 < length) & (string[i+1] # MacroCharacter);
  2567. IF ~result THEN (* two consequent MacroCharacter's are used to escape *)
  2568. INC(i); (*skip string[i+1] *)
  2569. END;
  2570. END;
  2571. INC(i);
  2572. END;
  2573. RETURN result;
  2574. END ContainsMacros;
  2575. PROCEDURE WriteSelectionToStream(w : Streams.Writer);
  2576. VAR text : Texts.Text; from, to : Texts.TextPosition; a, b : LONGINT;
  2577. BEGIN
  2578. ASSERT(w # NIL);
  2579. IF Texts.GetLastSelection(text, from, to) THEN
  2580. text.AcquireRead;
  2581. a := Strings.Min(from.GetPosition(), to.GetPosition());
  2582. b := Strings.Max(from.GetPosition(), to.GetPosition());
  2583. IF (text.GetLength() > 0) THEN
  2584. TextUtilities.SubTextToStream(text, a, b - a + 1, w);
  2585. END;
  2586. text.ReleaseRead;
  2587. END;
  2588. END WriteSelectionToStream;
  2589. PROCEDURE SubstituteMacro(CONST command : Strings.String; VAR index : LONGINT; originator : Component; w : Streams.Writer);
  2590. VAR oldIndex : LONGINT; macro, namespace, name : Macro; handler : MacroHandlerProcedure; handled : BOOLEAN;
  2591. BEGIN
  2592. ASSERT((command # NIL) & (0 <= index) & (index < LEN(command)) & (command[index] = MacroCharacter));
  2593. ASSERT(originator # NIL);
  2594. ASSERT(w # NIL);
  2595. oldIndex := index;
  2596. INC(index); (* skip MacroCharacter *)
  2597. IF ReadWord(command^, macro, index) THEN (*? TBD error handling *)
  2598. SplitMacroString(macro, namespace, name, NamespaceCharacter);
  2599. IF (namespace = NoNamespace) OR (namespace = DefaultNamespace) THEN
  2600. handler := DefaultMacroHandler;
  2601. ELSE
  2602. BEGIN {EXCLUSIVE}
  2603. handler := FindMacroHandler(namespace);
  2604. END;
  2605. END;
  2606. handled := FALSE;
  2607. IF (handler # NIL) THEN handler(name, originator, w, handled); END;
  2608. IF ~handled THEN
  2609. w.Char(MacroCharacter); w.String(macro); (* don't substitute *)
  2610. END;
  2611. END;
  2612. ASSERT(index > oldIndex);
  2613. END SubstituteMacro;
  2614. PROCEDURE SubstituteMacros*(CONST command : Strings.String; VAR newCommand : Strings.String; originator : Component);
  2615. VAR index, oldIndex, length : LONGINT; w : Streams.Writer; buffer : Strings.Buffer;
  2616. BEGIN
  2617. ASSERT((command # NIL) & (originator # NIL));
  2618. IF ContainsMacros(command^) THEN
  2619. NEW(buffer, 256);
  2620. w := buffer.GetWriter();
  2621. index := 0; length := LEN(command^);
  2622. WHILE (index < length) & (command[index] # 0X) DO
  2623. oldIndex := index;
  2624. IF (command[index] = MacroCharacter) THEN
  2625. IF (index + 1 < length) & (command[index + 1] = MacroCharacter) THEN (* escape *)
  2626. w.Char(MacroCharacter);
  2627. index := index + 2; (* skip both MacroCharacter's *)
  2628. ELSE
  2629. (* substitute macro *)
  2630. SubstituteMacro(command, index, originator, w);
  2631. END;
  2632. ELSE
  2633. w.Char(command[index]);
  2634. INC(index);
  2635. END;
  2636. ASSERT(index > oldIndex);
  2637. END;
  2638. newCommand := buffer.GetString();
  2639. ELSE
  2640. newCommand := command;
  2641. END;
  2642. ASSERT(newCommand # NIL);
  2643. END SubstituteMacros;
  2644. PROCEDURE GetAttributeValue(originator : Component; CONST fullname : ARRAY OF CHAR) : Strings.String;
  2645. VAR value : Strings.String; c : Component; component, attribute : ARRAY 64 OF CHAR;
  2646. BEGIN
  2647. ASSERT(originator # NIL);
  2648. value := NIL;
  2649. Strings.GetExtension(fullname, component, attribute);
  2650. IF (attribute = "") THEN
  2651. COPY(component, attribute);
  2652. COPY("", component);
  2653. END;
  2654. IF (component[0] = "@") THEN component[0] := "&"; END; (*? TBD: Hack to avoid ampersand in XML *)
  2655. IF (component = "") THEN
  2656. c := originator;
  2657. ELSE
  2658. c := originator.Find(component);
  2659. END;
  2660. IF (c # NIL) THEN
  2661. IF c.HasAttribute(attribute) THEN
  2662. RETURN c.GetAttributeValue(attribute);
  2663. ELSE
  2664. ReportError("Attribute % of component % not found", attribute, component);
  2665. END;
  2666. ELSE
  2667. ReportError("Component % not found", component, "");
  2668. END;
  2669. RETURN value;
  2670. END GetAttributeValue;
  2671. PROCEDURE GetPropertyValue(originator : Component; CONST fullname : ARRAY OF CHAR) : Strings.String;
  2672. VAR value : ARRAY 256 OF CHAR; string:Strings.String; c : Component; component, property : ARRAY 64 OF CHAR;
  2673. BEGIN
  2674. ASSERT(originator # NIL);
  2675. Strings.GetExtension(fullname, component, property);
  2676. IF (property = "") THEN COPY(component, property); COPY("", component);
  2677. END;
  2678. IF (component[0] = "@") THEN component[0] := "&"; END; (*? TBD: Hack to avoid ampersand in XML *)
  2679. IF (component = "") THEN c := originator;
  2680. ELSE c := originator.Find(component);
  2681. END;
  2682. IF (c # NIL) THEN
  2683. IF c.properties.GetPropertyValue(property,value) THEN RETURN Strings.NewString(value)
  2684. ELSE ReportError("Property % of component % not found", property, component);
  2685. END;
  2686. ELSE ReportError("Component % not found", component, "");
  2687. END;
  2688. RETURN NIL;
  2689. END GetPropertyValue;
  2690. PROCEDURE DefaultMacroHandler(CONST macro : Macro; originator : Component; w : Streams.Writer; VAR handled : BOOLEAN);
  2691. VAR string, value : Strings.String;
  2692. BEGIN
  2693. ASSERT((originator # NIL) & (w # NIL));
  2694. handled := TRUE;
  2695. IF (macro = MacroSelection) THEN
  2696. WriteSelectionToStream(w);
  2697. ELSIF (macro = MacroClipboard) THEN
  2698. TextUtilities.TextToStream(Texts.clipboard, w);
  2699. ELSIF Strings.StartsWith(MacroAttributePrefix, 0, macro) THEN
  2700. string := Strings.Substring(Strings.Length(MacroAttributePrefix), Strings.Length(macro), macro);
  2701. value := GetAttributeValue(originator, string^);
  2702. IF (value # NIL) THEN
  2703. w.String(value^);
  2704. ELSE
  2705. handled := FALSE;
  2706. END;
  2707. ELSIF Strings.StartsWith(MacroPropertyPrefix, 0, macro) THEN
  2708. string := Strings.Substring(Strings.Length(MacroPropertyPrefix), Strings.Length(macro), macro);
  2709. value := GetPropertyValue(originator,string^);
  2710. IF (value # NIL) THEN
  2711. w.String(value^);
  2712. ELSE
  2713. handled := FALSE;
  2714. END;
  2715. ELSE
  2716. handled := FALSE;
  2717. END;
  2718. END DefaultMacroHandler;
  2719. PROCEDURE FindMacroHandler(CONST namespace : ARRAY OF CHAR) : MacroHandlerProcedure;
  2720. VAR node : MacroHandler; handler : MacroHandlerProcedure;
  2721. BEGIN (* caller must hold module lock! *)
  2722. node := macroHandlers;
  2723. WHILE (node # NIL) & (node.namespace # namespace) DO node := node.next; END;
  2724. IF (node # NIL) THEN
  2725. handler := node.handler;
  2726. ELSE
  2727. handler := NIL;
  2728. END;
  2729. RETURN handler;
  2730. END FindMacroHandler;
  2731. PROCEDURE AddMacroHandler*(CONST namespace : Namespace; handler : MacroHandlerProcedure; VAR res : LONGINT);
  2732. VAR new, node : MacroHandler; h : MacroHandlerProcedure;
  2733. BEGIN {EXCLUSIVE}
  2734. ASSERT((namespace # NoNamespace) & (handler # NIL));
  2735. ASSERT(macroHandlers # NIL);
  2736. h := FindMacroHandler(namespace);
  2737. IF (h = NIL) THEN (* append new handler to list *)
  2738. NEW(new);
  2739. new.handler := handler;
  2740. new.namespace := namespace;
  2741. new.next := NIL;
  2742. node := macroHandlers;
  2743. WHILE (node.next # NIL) DO node := node.next; END;
  2744. node.next := new;
  2745. res := Ok;
  2746. ELSE
  2747. res := DuplicateNamespace;
  2748. END;
  2749. END AddMacroHandler;
  2750. PROCEDURE RemoveMacroHandler*(handler : MacroHandlerProcedure);
  2751. VAR node : MacroHandler;
  2752. BEGIN {EXCLUSIVE}
  2753. ASSERT((handler # NIL) & (handler # DefaultMacroHandler));
  2754. ASSERT(macroHandlers # NIL);
  2755. node := macroHandlers;
  2756. WHILE (node.next # NIL) & (node.next.handler # handler) DO node := node.next; END;
  2757. ASSERT((node.next # NIL) & (node.next.handler = handler));
  2758. node.next := node.next.next;
  2759. END RemoveMacroHandler;
  2760. PROCEDURE SetAttribute*(context : Commands.Context); (** component attribute value ~ *)
  2761. VAR originator, target : Component; name, attribute, value : ARRAY 128 OF CHAR; (*? TBD array size *)
  2762. BEGIN
  2763. IF (context IS EventContext) THEN
  2764. originator := context(EventContext).originator;
  2765. IF context.arg.GetString(name) & context.arg.GetString(attribute) & context.arg.GetString(value) THEN
  2766. target := originator.Find(name);
  2767. IF (target # NIL) THEN
  2768. IF target.HasAttribute(attribute) THEN
  2769. target.SetAttributeValue(attribute, value);
  2770. ELSE
  2771. context.result := Commands.CommandError;
  2772. END;
  2773. ELSE
  2774. context.result := Commands.CommandError;
  2775. END;
  2776. ELSE
  2777. context.error.String("Expected component name, attribute and value parameters"); context.error.Ln;
  2778. context.result := Commands.CommandParseError;
  2779. END;
  2780. ELSE
  2781. context.error.String("Command requires EventContext."); context.error.Ln;
  2782. context.result := Commands.CommandParseError;
  2783. END;
  2784. END SetAttribute;
  2785. (** Activate a string of commands, including their parameters.
  2786. The string is parsed from left to right and Activate is called for every command.
  2787. Parsing stops at the end of the string, or when Activate returns an error.
  2788. The flags are applied to every command, i.e., for sequential execution,
  2789. use the Wait flag (the caller waits until all commands return).
  2790. Syntax:
  2791. cmds = [mode " " ] cmd {";" cmd} .
  2792. mode = "PAR" | "SEQ" .
  2793. cmd = mod ["." proc] [" " params] .
  2794. params = {<any character except ";">} .
  2795. REMARK: For now, this is almost the same as Commands.Call. This procedure will either be enhanced to
  2796. support some component-related macro substitution or be replaced by Commands.Call
  2797. *)
  2798. PROCEDURE Call*(cmds : ARRAY OF CHAR; caller : Component; flags : SET; VAR res : LONGINT; VAR msg : ARRAY OF CHAR);
  2799. VAR
  2800. context : Commands.Context; arg : Streams.StringReader;
  2801. buffer : Strings.Buffer; w : Streams.Writer; par : Strings.String;
  2802. length, i, k : LONGINT;
  2803. PROCEDURE Expand(CONST string : ARRAY OF CHAR; w : Streams.Writer; start : LONGINT; VAR end : LONGINT);
  2804. VAR
  2805. component : Component;
  2806. componentStr, attributeStr : ARRAY 256 OF CHAR;
  2807. property : WMProperties.Property; attribute : XML.Attribute;
  2808. value : Strings.String;
  2809. lastDotIdx, i, j : LONGINT; error : BOOLEAN;
  2810. BEGIN
  2811. ASSERT((string[start] = "&") & (start + 1 < LEN(string)) & (w # NIL));
  2812. end := start; WHILE (end < LEN(string)) & (string[end] # 0X) & (string[end] # ";") & (string[end] > " ") DO INC(end); END;
  2813. DEC(end);
  2814. lastDotIdx := end;
  2815. WHILE (lastDotIdx > start) & (string[lastDotIdx] # ".") DO DEC(lastDotIdx); END;
  2816. error := (lastDotIdx <= start); (* missing dot *)
  2817. IF ~error THEN
  2818. i := start + 1; (* skip ampersand *)
  2819. IF (string[i] = "&") OR (string[i] = "/") THEN
  2820. j := 0;
  2821. WHILE (i < lastDotIdx) & (j < LEN(componentStr) - 1) DO
  2822. componentStr[j] := string[i];
  2823. INC(i); INC(j);
  2824. END;
  2825. componentStr[j] := 0X;
  2826. component := caller.Find(componentStr);
  2827. ELSE
  2828. componentStr := "";
  2829. component := caller;
  2830. END;
  2831. ASSERT(string[i] = ".");
  2832. INC(i); (* skip dot *)
  2833. attributeStr := "";
  2834. j := 0;
  2835. WHILE (j < LEN(attributeStr)) & (i <= end) DO
  2836. attributeStr[j] := string[i];
  2837. INC(i); INC(j);
  2838. END;
  2839. error := (attributeStr = "");
  2840. IF ~error THEN
  2841. IF (component # NIL) THEN
  2842. property := component.properties.Get(attributeStr);
  2843. IF (property # NIL) THEN
  2844. property.ToStream(w);
  2845. ELSE
  2846. attribute := component.GetAttribute(attributeStr);
  2847. IF (attribute # NIL) THEN
  2848. value := attribute.GetValue();
  2849. IF (value # NIL) THEN w.String(value^); ELSE w.String("NIL"); END;
  2850. ELSE
  2851. error := TRUE;
  2852. END;
  2853. END;
  2854. ELSE
  2855. error := TRUE;
  2856. END;
  2857. END;
  2858. END;
  2859. IF error THEN (* don't expand macro *)
  2860. FOR i := start TO end DO w.Char(string[i]); END;
  2861. END;
  2862. ASSERT(end >= start);
  2863. END Expand;
  2864. BEGIN
  2865. ASSERT(caller # NIL);
  2866. NEW(buffer, LEN(cmds)); w := buffer.GetWriter();
  2867. IF Strings.StartsWith2(Repositories.CommandPrefix, cmds) THEN i := Strings.Length(Repositories.CommandPrefix); ELSE i := 0; END;
  2868. LOOP
  2869. buffer.Clear;
  2870. w.Reset;
  2871. k := 0;
  2872. 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;
  2873. IF k = 0 THEN EXIT; END; (* end of string *)
  2874. IF (i < LEN(cmds)) & (cmds[i] # ";") & (cmds[i] # 0X) THEN (* parameters *)
  2875. INC(i); (* skip delimiter *)
  2876. WHILE (i < LEN(cmds)) & (cmds[i] # 0X) & (cmds[i] # ";") DO
  2877. IF (cmds[i] = "&") & (i + 1 < LEN(cmds)) & ((cmds[i+1] = "&") OR (cmds[i+1] = ".") OR (cmds[i+1] = "/")) THEN
  2878. Expand(cmds, w, i, i);
  2879. ELSE
  2880. w.Char(cmds[i]);
  2881. END;
  2882. INC(i);
  2883. END;
  2884. END;
  2885. IF (i < LEN(cmds)) & (cmds[i] = ";") THEN (* skip command delimiter *) INC(i); END;
  2886. cmds[k] := 0X;
  2887. length := buffer.GetLength();
  2888. IF (length > 0) THEN
  2889. par := buffer.GetString();
  2890. NEW(arg, length + 1); arg.SetRaw(par^, 0, length + 1);
  2891. ELSE
  2892. arg := NIL;
  2893. END;
  2894. NEW(context, NIL, arg, NIL, NIL, caller);
  2895. Commands.Activate(cmds, context, flags, res, msg);
  2896. IF (res # Commands.Ok) THEN KernelLog.String("WMComponents.Call error, res = "); KernelLog.Int(res, 0); KernelLog.Ln; EXIT; END;
  2897. END;
  2898. END Call;
  2899. PROCEDURE GetComponent*(CONST name : ARRAY OF CHAR) : Component;
  2900. VAR component : Component; c : Repositories.Component; res : LONGINT;
  2901. BEGIN
  2902. component := NIL;
  2903. Repositories.GetComponentByString(name, c, res);
  2904. IF (res = Repositories.Ok) THEN
  2905. IF (c # NIL) & (c IS Component) THEN
  2906. component := c (Component);
  2907. ELSE
  2908. KernelLog.String("WMComponents.GetComponent: Could not generate component ");
  2909. KernelLog.String(name); KernelLog.String(": Wrong type"); KernelLog.Ln;
  2910. END;
  2911. ELSE
  2912. KernelLog.String("WMComponents.GetComponent: Could not generate component ");
  2913. KernelLog.String(name); KernelLog.String(", res: "); KernelLog.Int(res, 0); KernelLog.Ln;
  2914. END;
  2915. RETURN component;
  2916. END GetComponent;
  2917. PROCEDURE GetVisualComponent*(CONST name : ARRAY OF CHAR) : VisualComponent;
  2918. VAR component : VisualComponent; c : Repositories.Component; res : LONGINT;
  2919. BEGIN
  2920. component := NIL;
  2921. Repositories.GetComponentByString(name, c, res);
  2922. IF (res = Repositories.Ok) THEN
  2923. IF (c # NIL) & (c IS VisualComponent) THEN
  2924. component := c (VisualComponent);
  2925. ELSE
  2926. KernelLog.String("WMComponents.GetVisualComponent: Could not generate component ");
  2927. KernelLog.String(name); KernelLog.String(": Wrong type"); KernelLog.Ln;
  2928. END;
  2929. ELSE
  2930. KernelLog.String("WMComponents.GetVisualComponent: Could not generate component ");
  2931. KernelLog.String(name); KernelLog.String(", res: "); KernelLog.Int(res, 0); KernelLog.Ln;
  2932. END;
  2933. RETURN component;
  2934. END GetVisualComponent;
  2935. PROCEDURE SetStyle*(style : XML.Element);
  2936. BEGIN
  2937. SetStyleInternal(style)
  2938. END SetStyle;
  2939. PROCEDURE SetStyleInternal(style : XML.Element);
  2940. VAR msg : Messages.Message; m : WM.WindowManager;
  2941. BEGIN
  2942. currentStyle := style;
  2943. IF propertyListList # NIL THEN propertyListList.UpdateStyle END;
  2944. msg.msgType := Messages.MsgExt; msg.ext := componentStyleMsg;
  2945. m := WM.GetDefaultManager();
  2946. m.Broadcast(msg)
  2947. END SetStyleInternal;
  2948. PROCEDURE FindRelativePath(x : Component; CONST path : ARRAY OF CHAR; pos : LONGINT) : Component;
  2949. VAR c : XML.Content;
  2950. sn : ARRAY MaxComponentNameSize OF CHAR;
  2951. i : LONGINT; id : Strings.String;
  2952. BEGIN
  2953. IF x = NIL THEN RETURN NIL
  2954. ELSIF path[pos] = 0X THEN RETURN x
  2955. ELSIF (pos = 0) & (path[0] = "/") THEN RETURN FindRelativePath(x.GetComponentRoot(), path, pos + 1)
  2956. ELSIF (path[pos] = ".") & (path[pos + 1] = ".") THEN
  2957. INC(pos, 2); IF path[pos]="/" THEN INC(pos) END;
  2958. c := x.GetParent();
  2959. IF (c # NIL) & (c IS Component) THEN
  2960. RETURN FindRelativePath(c(Component), path, pos)
  2961. ELSE
  2962. RETURN NIL
  2963. END
  2964. ELSE
  2965. i := 0; WHILE (i < MaxComponentNameSize - 1) & (path[pos] # 0X) & (path[pos] # "/") DO
  2966. sn[i] := path[pos]; INC(i); INC(pos)
  2967. END;
  2968. IF (path[pos] = "/") THEN INC(pos) END;
  2969. sn[i] := 0X;
  2970. c := x.GetFirst();
  2971. WHILE (c # NIL) DO
  2972. IF (c IS Component) THEN
  2973. id := c(Component).id.Get();
  2974. IF (id # NIL) & (id^ = sn) THEN
  2975. RETURN FindRelativePath(c(Component), path, pos);
  2976. END;
  2977. END;
  2978. c := x.GetNext(c);
  2979. END;
  2980. RETURN NIL
  2981. END
  2982. END FindRelativePath;
  2983. (* Report errors while parsing *)
  2984. PROCEDURE Error(pos, line, row: LONGINT; CONST msg: ARRAY OF CHAR);
  2985. BEGIN
  2986. KernelLog.String("Parse error at pos "); KernelLog.Int(pos, 5); KernelLog.String(" in line "); KernelLog.Int(line, 5);
  2987. KernelLog.String(" row "); KernelLog.Int(row, 5); KernelLog.String(" - "); KernelLog.String(msg); KernelLog.Ln;
  2988. hasErrors := TRUE
  2989. END Error;
  2990. (** Load an XML file. Return NIL if errors occured *)
  2991. PROCEDURE Load*(CONST filename : ARRAY OF CHAR) : XML.Content;
  2992. VAR scanner : XMLScanner.Scanner;
  2993. parser : XMLParser.Parser;
  2994. doc : XML.Document;
  2995. in : Streams.Reader;
  2996. BEGIN {EXCLUSIVE}
  2997. hasErrors := FALSE;
  2998. in := Codecs.OpenInputStream(filename);
  2999. IF in # NIL THEN
  3000. NEW(scanner, in); scanner.reportError := Error;
  3001. NEW(parser, scanner); parser.reportError := Error;
  3002. parser.elemReg := Repositories.registry; doc := parser.Parse();
  3003. IF hasErrors THEN RETURN NIL END;
  3004. RETURN doc.GetRoot()
  3005. END;
  3006. RETURN NIL
  3007. END Load;
  3008. PROCEDURE FormWindowGen*(xml:XML.Content): WM.Window;
  3009. VAR winx: XML.Element; formx: XML.Content; window: FormWindow; name, string:Strings.String; canvas:WMGraphics.BufferCanvas;
  3010. canvasGenerator: WMGraphics.CanvasGenerator;
  3011. moduleName, procedureName : Modules.Name;
  3012. msg : ARRAY 128 OF CHAR;
  3013. res: LONGINT;
  3014. l,t,r,b: LONGINT;
  3015. BEGIN
  3016. IF xml IS XML.Element THEN
  3017. winx:=xml(XML.Element);
  3018. string:=winx.GetName();
  3019. IF string^="FormWindow" THEN
  3020. string:=winx.GetAttributeValue("l"); Strings.StrToInt(string^,l);
  3021. string:=winx.GetAttributeValue("t"); Strings.StrToInt(string^,t);
  3022. string:=winx.GetAttributeValue("r"); Strings.StrToInt(string^,r);
  3023. string:=winx.GetAttributeValue("b"); Strings.StrToInt(string^,b);
  3024. NEW(window, r-l, b-t, TRUE);
  3025. name:=winx.GetAttributeValue("name"); window.SetTitle(name);
  3026. window.bounds.r:=r; window.bounds.l:=l; window.bounds.t:=t; window.bounds.b:=b;
  3027. string:=winx.GetAttributeValue("flags"); Strings.StrToSet(string^,window.flags);
  3028. string:=winx.GetAttributeValue("canvasGenerator"); (* allow to plug in alternative canvas versions,e.g. WMGraphicsGfx.Canvas *)
  3029. IF (string#NIL) THEN
  3030. Commands.Split(string^, moduleName, procedureName, res, msg);
  3031. IF (res = Commands.Ok) THEN
  3032. GETPROCEDURE(moduleName, procedureName, canvasGenerator);
  3033. IF (canvasGenerator # NIL) THEN
  3034. window.SetCanvasGenerator(canvasGenerator);
  3035. END;
  3036. END;
  3037. END;
  3038. formx:=winx.GetFirst(); (* this typically has name="Form" *)
  3039. IF (formx#NIL)&(formx IS XML.Element) THEN
  3040. window.LoadComponents(formx(XML.Element)); (* at the price of duplication of component tree construction ...*)
  3041. window.form.Reset(NIL,NIL);
  3042. ELSE window:=NIL;
  3043. END;
  3044. END;
  3045. END;
  3046. RETURN window
  3047. END FormWindowGen;
  3048. (* generic loading of any form window using the generator procedure supplied in the XML as 'loader' attribute *)
  3049. PROCEDURE LoadFormWindow*(xml:XML.Content): WM.Window;
  3050. VAR winx: XML.Element; window: WM.Window; formWindow:FormWindow;
  3051. formx, c:Component;
  3052. name, string, load:Strings.String;
  3053. moduleName, procedureName : Modules.Name;
  3054. msg : ARRAY 128 OF CHAR;
  3055. res: LONGINT;
  3056. gen:WindowGenerator;
  3057. bounds:Rectangles.Rectangle;
  3058. BEGIN
  3059. IF xml IS XML.Element THEN
  3060. winx:=xml(XML.Element);
  3061. name:=winx.GetName();
  3062. IF name^="FormWindow" THEN
  3063. string:=winx.GetAttributeValue("loader");
  3064. Commands.Split(string^, moduleName, procedureName, res, msg);
  3065. IF (res = Commands.Ok) THEN
  3066. GETPROCEDURE(moduleName, procedureName, gen);
  3067. IF (gen # NIL) THEN
  3068. window:=gen(xml);
  3069. END;
  3070. END;
  3071. ELSE (*generate FormWindow from generic Visual Component*)
  3072. c:=ComponentFromXML(xml(XML.Element));
  3073. IF (c#NIL) & (c IS VisualComponent) THEN
  3074. bounds:=c(VisualComponent).bounds.Get();
  3075. NEW(formWindow, bounds.r-bounds.l, bounds.b-bounds.t, TRUE);
  3076. formWindow.SetContent(c);
  3077. (*formWindow.SetTitle(c.GetName());*)
  3078. window:=formWindow;
  3079. END;
  3080. END;
  3081. END;
  3082. RETURN window
  3083. END LoadFormWindow;
  3084. (** Open form window and build its component tree *)
  3085. PROCEDURE Open*(context : Commands.Context);
  3086. VAR filename: Files.FileName; window: WM.Window; xml:XML.Content;
  3087. BEGIN
  3088. IF context.arg.GetString(filename) & (Strings.Length(filename)>0) THEN
  3089. xml:=Load(filename); (* here, the xml tree is already constructed, however not in the right sequence for component contruction ( [Init()..loadProperties()..Initialize()] )*)
  3090. window:=LoadFormWindow(xml);
  3091. IF window#NIL THEN
  3092. WM.AddWindow(window,window.bounds.l,window.bounds.t);
  3093. END;
  3094. END;
  3095. END Open;
  3096. PROCEDURE LoadStyleInternal(CONST filename : ARRAY OF CHAR);
  3097. VAR f : Files.File;
  3098. scanner : XMLScanner.Scanner;
  3099. parser : XMLParser.Parser;
  3100. reader : Files.Reader;
  3101. doc : XML.Document;
  3102. BEGIN
  3103. hasErrors := FALSE;
  3104. f := Files.Old(filename);
  3105. IF f # NIL THEN
  3106. NEW(reader, f, 0);
  3107. NEW(scanner, reader); scanner.reportError := Error;
  3108. NEW(parser, scanner); parser.reportError := Error;
  3109. parser.elemReg := Repositories.registry; doc := parser.Parse();
  3110. IF hasErrors THEN KernelLog.String("Stylefile not ok"); KernelLog.Ln
  3111. ELSE
  3112. SetStyleInternal(doc.GetRoot())
  3113. END
  3114. END
  3115. END LoadStyleInternal;
  3116. (** Load Component registry file. Return NIL if errors occured *)
  3117. PROCEDURE LoadStyle*(context : Commands.Context);
  3118. VAR filename : ARRAY 64 OF CHAR;
  3119. BEGIN {EXCLUSIVE}
  3120. IF context.arg.GetString(filename) THEN
  3121. LoadStyleInternal(filename);
  3122. ELSE
  3123. context.result := Commands.CommandParseError;
  3124. END;
  3125. END LoadStyle;
  3126. PROCEDURE NewString*(CONST x : ARRAY OF CHAR) : Strings.String;
  3127. VAR t : Strings.String;
  3128. BEGIN
  3129. NEW(t, LEN(x)); COPY(x, t^); RETURN t
  3130. END NewString;
  3131. PROCEDURE InitStrings;
  3132. BEGIN
  3133. StrComponent := NewString("Component");
  3134. StrVisualComponent := NewString("VisualComponent");
  3135. StrForm := NewString("Form");
  3136. StrFormWindow := NewString("FormWindow");
  3137. GSonStartDrag := NewString("onStartDrag");
  3138. GSonStartDragInfo := NewString("Event generated whenever a drag is started");
  3139. StrModel := NewString("Model");
  3140. StrModelInfo := NewString("Model used by component");
  3141. END InitStrings;
  3142. PROCEDURE InitPrototypes;
  3143. BEGIN
  3144. (* General component properties *)
  3145. NEW(PrototypeID, NIL, NewString("ID"),
  3146. NewString("identifier of the component"));
  3147. NEW(PrototypeUID, NIL, NewString("UID"),
  3148. NewString("unique identifier of the component"));
  3149. NEW(PrototypeEnabled, NIL, NewString("Enabled"),
  3150. NewString("defines if the component is enabled"));
  3151. PrototypeEnabled.Set(TRUE);
  3152. (* Visual component properties *)
  3153. NEW(PrototypeBounds, NIL, NewString("Bounds"),
  3154. NewString("the bounding box of the component in parent coordinates"));
  3155. NEW(PrototypeBoundsRelative, NIL, NewString("RelBounds"),
  3156. NewString("the bounding box of the component in relative parent coordinates"));
  3157. NEW(PrototypeBearing, NIL, NewString("Bearing"),
  3158. NewString("the bearing (empty space) aroung the component if auto aligned"));
  3159. NEW(PrototypeFillColor, NIL, NewString("FillColor"),
  3160. NewString("the main fill color of the component. i.e. background"));
  3161. NEW(PrototypeAlignment, NIL, NewString("Alignment"),
  3162. NewString("defines the alignment none, left, right, top, bottom or client"));
  3163. PrototypeAlignment.Set(0);
  3164. NEW(PrototypeVisible, NIL, NewString("Visible"),
  3165. NewString("defines if the component is visible"));
  3166. PrototypeVisible.Set(TRUE);
  3167. NEW(PrototypeTakesFocus, NIL, NewString("TakesFocus"),
  3168. NewString("defines if the component takes the keyboard focus"));
  3169. NEW(PrototypeNeedsTab, NIL, NewString("NeedsTab"),
  3170. NewString("defines if the component handles the tabulator key"));
  3171. NEW(PrototypeFocusPrevious, NIL, NewString("FocusPrevious"), NewString("Previous focus component ID"));
  3172. PrototypeFocusPrevious.Set(NIL);
  3173. NEW(PrototypeFocusNext, NIL, NewString("FocusNext"), NewString("Next focus component ID"));
  3174. PrototypeFocusNext.Set(NIL);
  3175. NEW(PrototypeEditMode, NIL, NewString("EditMode"), NewString("defines if the contents of the component can be edited"));
  3176. PrototypeEditMode.Set(FALSE);
  3177. NEW(PrototypeFont, NIL, NewString("Font"), NewString("Font"));
  3178. PrototypeFont.Set(WMGraphics.GetDefaultFont());
  3179. NEW(PrototypeScaleFont, NIL, Strings.NewString("ScaleFont"), Strings.NewString("percentage that fonts scales with height (0=none)"));
  3180. NEW(ModelPrototype, NIL, StrModel, StrModelInfo);
  3181. END InitPrototypes;
  3182. PROCEDURE ShowComponent(component : Component);
  3183. VAR string : Strings.String;
  3184. BEGIN
  3185. IF (component # NIL) THEN
  3186. string := component.GetName();
  3187. IF (string # NIL) THEN KernelLog.String(string^); ELSE KernelLog.String("NoName"); END;
  3188. KernelLog.String(" [");
  3189. string := component.uid.Get();
  3190. IF (string # NIL) THEN KernelLog.String(string^); ELSE KernelLog.String("NIL"); END;
  3191. IF (component IS VisualComponent) THEN
  3192. KernelLog.String(", "); KernelLog.Boolean(component(VisualComponent).takesFocus.Get());
  3193. END;
  3194. KernelLog.String("]");
  3195. ELSE
  3196. KernelLog.String("NIL?");
  3197. END;
  3198. END ShowComponent;
  3199. PROCEDURE NewLine(w : Streams.Writer; level : LONGINT);
  3200. BEGIN
  3201. w.Ln; WHILE level > 0 DO w.Char(09X); DEC(level) END
  3202. END NewLine;
  3203. PROCEDURE InstallDefaultMacroHandler;
  3204. BEGIN
  3205. NEW(macroHandlers);
  3206. macroHandlers.handler := DefaultMacroHandler;
  3207. macroHandlers.namespace := DefaultNamespace;
  3208. macroHandlers.next := NIL;
  3209. END InstallDefaultMacroHandler;
  3210. (*! ---- xml tool --- move to where appropriate *)
  3211. PROCEDURE GetElementByName(parent : XML.Element; CONST name : ARRAY OF CHAR) : XML.Element;
  3212. VAR elem : XML.Element; enum : XMLObjects.Enumerator; ptr : ANY; string : Strings.String;
  3213. BEGIN
  3214. IF parent # NIL THEN
  3215. enum := parent.GetContents(); enum.Reset();
  3216. WHILE enum.HasMoreElements() DO
  3217. ptr := enum.GetNext();
  3218. IF ptr IS XML.Element THEN
  3219. elem := ptr (XML.Element);
  3220. string := elem.GetName();
  3221. IF (string # NIL) & (string^ = name) THEN
  3222. RETURN elem;
  3223. END;
  3224. END;
  3225. END;
  3226. END;
  3227. RETURN NIL;
  3228. END GetElementByName;
  3229. PROCEDURE NewComponent*(): XML.Element;
  3230. VAR component: Component;
  3231. BEGIN NEW(component); RETURN component;
  3232. END NewComponent;
  3233. PROCEDURE NewVisualComponent*(): XML.Element;
  3234. VAR component: VisualComponent;
  3235. BEGIN NEW(component); RETURN component;
  3236. END NewVisualComponent;
  3237. (* does not work like this its own because a form is statically bound to a window, but for completeness.. *)
  3238. PROCEDURE NewForm*(): XML.Element;
  3239. VAR component: Form;
  3240. BEGIN NEW(component, NIL); RETURN component
  3241. END NewForm;
  3242. PROCEDURE Align*(context: Commands.Context);
  3243. VAR width,height,bwidth,bheight: LONGINT; entry: ComponentListEntry; b,rect: Rectangles.Rectangle; string: ARRAY 32 OF CHAR; l,t: LONGINT; done: BOOLEAN;
  3244. BEGIN
  3245. entry := selection.first;
  3246. rect.l := MAX(LONGINT); rect.r := MIN(LONGINT);
  3247. rect.t := MAX(LONGINT); rect.b := MIN(LONGINT);
  3248. width := 0; height := 0;
  3249. WHILE entry # NIL DO
  3250. b := entry.component.bounds.Get();
  3251. bwidth := b.r-b.l; bheight := b.b-b.t;
  3252. IF b.l < rect.l THEN rect.l := b.l END;
  3253. IF b.r > rect.r THEN rect.r := b.r END;
  3254. IF b.t < rect.t THEN rect.t := b.t END;
  3255. IF b.b > rect.b THEN rect.b := b.b END;
  3256. IF width < bwidth THEN width := bwidth END;
  3257. IF height < bheight THEN height := bheight END;
  3258. entry := entry.next
  3259. END;
  3260. done := FALSE;
  3261. WHILE ~done & context.arg.GetString(string) DO
  3262. l := rect.l; t := rect.t;
  3263. entry := selection.first;
  3264. WHILE ~done & (entry # NIL) DO
  3265. b := entry.component.bounds.Get(); bwidth := b.r-b.l; bheight := b.b-b.t;
  3266. entry.component.AdaptRelativeBounds(b,entry.component.GetParent());
  3267. IF string = "left" THEN b.l := rect.l; b.r := rect.l + bwidth;
  3268. ELSIF string = "right" THEN b.r := rect.r; b.l := rect.r-bwidth
  3269. ELSIF string = "top" THEN b.t := rect.t; b.b := rect.t + bheight;
  3270. ELSIF string = "bottom" THEN b.b := rect.b; b.t := rect.b-bheight
  3271. ELSIF string = "width" THEN b.r := b.l + width;
  3272. ELSIF string = "height" THEN b.b := b.t + height;
  3273. ELSIF string = "size" THEN b.r := b.l + width; b.b := b.t + height;
  3274. ELSIF string = "hcenter" THEN b.l := (rect.l+rect.r) DIV 2 - bwidth DIV 2; b.r := b.l + bwidth;
  3275. ELSIF string = "vcenter" THEN b.t := (rect.t + rect.b) DIV 2 - bheight DIV 2; b.b := b.t + bheight;
  3276. ELSIF string = "horizontal" THEN b.l := l; b.r := b.l + bwidth; l := b.r+1
  3277. ELSIF string = "vertical" THEN b.t := t; b.b := b.t + bheight; t := b.b + 1;
  3278. ELSIF string = "none" THEN entry.component.alignment.Set(AlignNone)
  3279. ELSIF string = "relative" THEN entry.component.alignment.Set(AlignRelative)
  3280. ELSE done := TRUE
  3281. END;
  3282. entry.component.AdaptRelativeBounds(b,entry.component.GetParent());
  3283. entry.component.bounds.Set(b);
  3284. entry := entry.next
  3285. END;
  3286. END;
  3287. END Align;
  3288. PROCEDURE SetProperty*(context: Commands.Context);
  3289. VAR name, value: ARRAY 256 OF CHAR; entry: ComponentListEntry;
  3290. BEGIN
  3291. IF context.arg.GetString(name) & context.arg.GetString(value) THEN
  3292. entry := selection.first;
  3293. WHILE entry # NIL DO
  3294. IF entry.component.properties.SetPropertyValue(name, value) THEN END;
  3295. entry := entry.next;
  3296. END;
  3297. END;
  3298. END SetProperty;
  3299. PROCEDURE RemoveSelection*;
  3300. VAR entry: ComponentListEntry; parent: XML.Element;
  3301. BEGIN
  3302. entry := selection.first;
  3303. WHILE entry # NIL DO
  3304. parent := entry.component.GetParent();
  3305. IF parent # NIL THEN parent(VisualComponent).RemoveContent(entry.component); parent(VisualComponent).Invalidate END;
  3306. entry := entry.next
  3307. END;
  3308. END RemoveSelection;
  3309. PROCEDURE ComponentFromXML*(xml: XML.Element): Component;
  3310. VAR generator: PROCEDURE(): XML.Element;
  3311. VAR
  3312. l,name: Strings.String;
  3313. moduleName, procedureName: Modules.Name;
  3314. res: LONGINT; msg: ARRAY 32 OF CHAR;
  3315. component: Component;
  3316. element: XML.Element;
  3317. BEGIN
  3318. component := NIL;
  3319. IF xml # NIL THEN
  3320. name := xml.GetName();
  3321. l := xml.GetAttributeValue("generator");
  3322. IF l # NIL THEN
  3323. Commands.Split(l^, moduleName, procedureName, res, msg);
  3324. IF (res = Commands.Ok) THEN
  3325. GETPROCEDURE(moduleName, procedureName, generator);
  3326. IF (generator # NIL) THEN
  3327. element := generator();
  3328. IF (element # NIL) & (element IS Component) THEN
  3329. component := element(Component);
  3330. component.SetName(name^);
  3331. component.FromXML(xml);
  3332. END;
  3333. ELSE KernelLog.String("WMComponents error: invalid generator "); KernelLog.String(l^); KernelLog.Ln;
  3334. END;
  3335. ELSE KernelLog.String("WMComponents error: could not generate component "); KernelLog.String(l^); KernelLog.Ln;
  3336. END;
  3337. END;
  3338. END;
  3339. RETURN component
  3340. END ComponentFromXML;
  3341. PROCEDURE Clone*(x: Component): Repositories.Component;
  3342. BEGIN
  3343. RETURN ComponentFromXML(x)
  3344. END Clone;
  3345. BEGIN
  3346. timestamp := 0;
  3347. NEW(componentStyleMsg);
  3348. NEW(propertyListList);
  3349. InitStrings;
  3350. InitPrototypes;
  3351. NEW(invalidateRectMsg);
  3352. InstallDefaultMacroHandler;
  3353. NEW(selection);
  3354. END WMComponents.
  3355. WMComponents.Open Test.Cwd ~
  3356. WMComponents.Open DictEntry.wm ~
  3357. The message sequencer contains a reader writer lock that can be used to block the hierarchy.
  3358. Each message-call from the sequencer posesses the writer lock.
  3359. WMComponents.LoadStyle ComponentStyle.XML ~
  3360. If a focusComponent is set in an non-focus container-component, the focus can not escape the "isolated" component group