diff --git a/1-base/lace/applet/demo/event/distributed/builder.sh b/1-base/lace/applet/demo/event/distributed/builder.sh index 3a8cb8d..7e6f42e 100755 --- a/1-base/lace/applet/demo/event/distributed/builder.sh +++ b/1-base/lace/applet/demo/event/distributed/builder.sh @@ -7,6 +7,12 @@ export OS=Linux mkdir -p build rm -fr dsa + +mkdir --parents dsa/x86_64-unknown-linux-gnu/obj + +cp /usr/lib/gcc/x86_64-pc-linux-gnu/15.1.1/adalib/a-sttebu.ali \ + dsa/x86_64-unknown-linux-gnu/obj + export Build_Mode=debug po_gnatdist -P simple_chat.gpr simple_chat.dsa -cargs -g -largs -g diff --git a/1-base/lace/applet/demo/event/distributed/source/a-sttebu.ads b/1-base/lace/applet/demo/event/distributed/source/a-sttebu.ads new file mode 100644 index 0000000..a97477d --- /dev/null +++ b/1-base/lace/applet/demo/event/distributed/source/a-sttebu.ads @@ -0,0 +1,152 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- ADA.STRINGS.TEXT_BUFFERS -- +-- -- +-- S p e c -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. In accordance with the copyright of that document, you can freely -- +-- copy and modify this specification, provided that if you redistribute a -- +-- modified version, any changes that you have made are clearly indicated. -- +-- -- +------------------------------------------------------------------------------ + +with Ada.Strings.UTF_Encoding; +package Ada.Strings.Text_Buffers with + Pure +is + + type Text_Buffer_Count is range 0 .. Integer'Last; + + New_Line_Count : constant Text_Buffer_Count := 1; + -- There is no support for two-character CR/LF line endings. + + type Root_Buffer_Type is abstract tagged limited private with + Default_Initial_Condition => Current_Indent (Root_Buffer_Type) = 0; + + procedure Put (Buffer : in out Root_Buffer_Type; Item : String) is abstract; + + procedure Wide_Put + (Buffer : in out Root_Buffer_Type; Item : Wide_String) is abstract; + + procedure Wide_Wide_Put + (Buffer : in out Root_Buffer_Type; Item : Wide_Wide_String) is abstract; + + procedure Put_UTF_8 + (Buffer : in out Root_Buffer_Type; + Item : UTF_Encoding.UTF_8_String) is abstract; + + procedure Wide_Put_UTF_16 + (Buffer : in out Root_Buffer_Type; + Item : UTF_Encoding.UTF_16_Wide_String) is abstract; + + procedure New_Line (Buffer : in out Root_Buffer_Type) is abstract; + + Standard_Indent : constant Text_Buffer_Count := 3; + + function Current_Indent + (Buffer : Root_Buffer_Type) return Text_Buffer_Count; + + procedure Increase_Indent + (Buffer : in out Root_Buffer_Type; + Amount : Text_Buffer_Count := Standard_Indent) with + Post'Class => Current_Indent (Buffer) = + Current_Indent (Buffer)'Old + Amount; + + procedure Decrease_Indent + (Buffer : in out Root_Buffer_Type; + Amount : Text_Buffer_Count := Standard_Indent) with + Pre'Class => Current_Indent (Buffer) >= Amount + -- or else raise Constraint_Error, + or else Boolean'Val (Current_Indent (Buffer) - Amount), + Post'Class => Current_Indent (Buffer) = + Current_Indent (Buffer)'Old - Amount; + + procedure Set_Trim_Leading_Spaces + (Buffer : in out Root_Buffer_Type; + Trim : Boolean := True) with + Post => Trim_Leading_Spaces (Buffer) = Trim, + Inline => True; + + function Trim_Leading_Spaces + (Buffer : Root_Buffer_Type) return Boolean + with Inline; + +private + + type Root_Buffer_Type is abstract tagged limited record + Indentation : Natural := 0; + -- Current indentation + + Indent_Pending : Boolean := True; + -- Set by calls to New_Line, cleared when indentation emitted. + + UTF_8_Length : Natural := 0; + -- Count of UTF_8 characters in the buffer + + UTF_8_Column : Positive := 1; + -- Column in which next character will be written. + -- Calling New_Line resets to 1. + + All_7_Bits : Boolean := True; + -- True if all characters seen so far fit in 7 bits + All_8_Bits : Boolean := True; + -- True if all characters seen so far fit in 8 bits + + Trim_Leading_White_Spaces : Boolean := False; + -- Flag set prior to calling any of the Put operations, which will + -- cause white space characters to be discarded by any Put operation + -- until a non-white-space character is encountered, at which point + -- the flag will be reset. + + end record; + + generic + -- This generic allows a client to extend Root_Buffer_Type without + -- having to implement any of the abstract subprograms other than + -- Put_UTF_8 (i.e., Put, Wide_Put, Wide_Wide_Put, Wide_Put_UTF_16, + -- and New_Line). Without this generic, each client would have to + -- duplicate the implementations of those 5 subprograms. + -- This generic also takes care of handling indentation, thereby + -- avoiding further code duplication. The name "Output_Mapping" isn't + -- wonderful, but it refers to the idea that this package knows how + -- to implement all the other output operations in terms of + -- just Put_UTF_8. + -- + -- The classwide parameter type here is somewhat tricky; + -- there are no dispatching calls associated with this parameter. + -- It would be more accurate to say that the parameter is of type + -- Output_Mapping.Buffer_Type'Class, but that type hasn't been declared + -- yet. Instantiators will typically declare a non-abstract extension, + -- B2, of the buffer type, B1, declared in their instantiation. The + -- actual Put_UTF_8_Implementation parameter may then have a + -- precondition "Buffer in B2'Class" and that subprogram can safely + -- access components declared as part of the declaration of B2. + + with procedure Put_UTF_8_Implementation + (Buffer : in out Root_Buffer_Type'Class; + Item : UTF_Encoding.UTF_8_String); + package Output_Mapping is + type Buffer_Type is abstract new Root_Buffer_Type with null record; + + overriding procedure Put (Buffer : in out Buffer_Type; Item : String); + + overriding procedure Wide_Put + (Buffer : in out Buffer_Type; Item : Wide_String); + + overriding procedure Wide_Wide_Put + (Buffer : in out Buffer_Type; Item : Wide_Wide_String); + + overriding procedure Put_UTF_8 + (Buffer : in out Buffer_Type; + Item : UTF_Encoding.UTF_8_String); + + overriding procedure Wide_Put_UTF_16 + (Buffer : in out Buffer_Type; Item : UTF_Encoding.UTF_16_Wide_String); + + overriding procedure New_Line (Buffer : in out Buffer_Type); + end Output_Mapping; + +end Ada.Strings.Text_Buffers; diff --git a/1-base/lace/applet/demo/event/distributed/source/chat-client-local.ads b/1-base/lace/applet/demo/event/distributed/source/chat-client-local.ads index 8759220..b73ce3f 100644 --- a/1-base/lace/applet/demo/event/distributed/source/chat-client-local.ads +++ b/1-base/lace/applet/demo/event/distributed/source/chat-client-local.ads @@ -3,8 +3,8 @@ with private with - lace.make_Subject, - lace.make_Observer, + lace.Event.make_Subject, + lace.Event.make_Observer, ada.Strings.unbounded; package chat.Client.local @@ -52,8 +52,8 @@ is private - package Observer is new lace.make_Observer (lace.Any.limited_item); - package Subject is new lace.make_Subject (Observer .item); + package Observer is new lace.Event.make_Observer (lace.Any.limited_item); + package Subject is new lace.Event.make_Subject (Observer .item); use ada.Strings.unbounded;