1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300 | -----------------------------------------------------------------------
-- asf-components-widgets-inputs -- Input widget components
-- Copyright (C) 2013, 2015, 2017, 2019 Stephane Carrez
-- Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Characters.Conversions;
with ASF.Models.Selects;
with ASF.Components.Utils;
with ASF.Components.Html.Messages;
with ASF.Events.Faces.Actions;
with ASF.Views.Nodes;
with ASF.Applications.Messages.Vectors;
with Util.Beans.Basic;
with Util.Strings.Transforms;
package body ASF.Components.Widgets.Inputs is
-- ------------------------------
-- Render the input field title.
-- ------------------------------
procedure Render_Title (UI : in UIInput;
Name : in String;
Writer : in Response_Writer_Access;
Context : in out Faces_Context'Class) is
Title : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, "title");
begin
Writer.Start_Element ("dt");
Writer.Start_Element ("label");
Writer.Write_Attribute ("for", Name);
Writer.Write_Text (Title);
Writer.End_Element ("label");
Writer.End_Element ("dt");
end Render_Title;
-- ------------------------------
-- Render the input component. Starts the DL/DD list and write the input
-- component with the possible associated error message.
-- ------------------------------
overriding
procedure Encode_Begin (UI : in UIInput;
Context : in out Faces_Context'Class) is
begin
if not UI.Is_Rendered (Context) then
return;
end if;
declare
Id : constant String := To_String (UI.Get_Client_Id);
Writer : constant Response_Writer_Access := Context.Get_Response_Writer;
Messages : constant ASF.Applications.Messages.Vectors.Cursor := Context.Get_Messages (Id);
Style : constant String := UI.Get_Attribute ("styleClass", Context);
begin
Writer.Start_Element ("dl");
Writer.Write_Attribute ("id", Id);
if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
Writer.Write_Attribute ("class", Style & " asf-error");
elsif Style'Length > 0 then
Writer.Write_Attribute ("class", Style);
end if;
UI.Render_Title (Id, Writer, Context);
Writer.Start_Element ("dd");
UI.Render_Input (Context, Write_Id => False);
end;
end Encode_Begin;
-- ------------------------------
-- Render the end of the input component. Closes the DL/DD list.
-- ------------------------------
overriding
procedure Encode_End (UI : in UIInput;
Context : in out Faces_Context'Class) is
use ASF.Components.Html.Messages;
begin
if not UI.Is_Rendered (Context) then
return;
end if;
-- Render the error message associated with the input field.
declare
Id : constant String := To_String (UI.Get_Client_Id);
Writer : constant Response_Writer_Access := Context.Get_Response_Writer;
Messages : constant ASF.Applications.Messages.Vectors.Cursor := Context.Get_Messages (Id);
begin
if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
Write_Message (UI, ASF.Applications.Messages.Vectors.Element (Messages),
SPAN_NO_STYLE, False, True, Context);
end if;
Writer.End_Element ("dd");
Writer.End_Element ("dl");
end;
end Encode_End;
-- ------------------------------
-- Render the end of the input component. Closes the DL/DD list.
-- ------------------------------
overriding
procedure Encode_End (UI : in UIComplete;
Context : in out Faces_Context'Class) is
begin
if not UI.Is_Rendered (Context) then
return;
end if;
-- Render the autocomplete script and finish the input component.
declare
Id : constant String := To_String (UI.Get_Client_Id);
Writer : constant Response_Writer_Access := Context.Get_Response_Writer;
begin
Writer.Queue_Script ("$('#");
Writer.Queue_Script (Id);
Writer.Queue_Script (" input').complete({");
Writer.Queue_Script ("});");
UIInput (UI).Encode_End (Context);
end;
end Encode_End;
overriding
procedure Process_Decodes (UI : in out UIComplete;
Context : in out Faces_Context'Class) is
begin
if not UI.Is_Rendered (Context) then
return;
end if;
declare
Id : constant String := To_String (UI.Get_Client_Id);
Val : constant String := Context.Get_Parameter (Id & ".match");
begin
if Val'Length > 0 then
UI.Match_Value := Util.Beans.Objects.To_Object (Val);
else
ASF.Components.Html.Forms.UIInput (UI).Process_Decodes (Context);
end if;
end;
end Process_Decodes;
procedure Render_List (UI : in UIComplete;
Match : in String;
Context : in out Faces_Context'Class) is
use type Util.Beans.Basic.List_Bean_Access;
procedure Render_Item (Label : in String);
List : constant Util.Beans.Basic.List_Bean_Access
:= ASF.Components.Utils.Get_List_Bean (UI, "autocompleteList", Context);
Writer : constant Response_Writer_Access := Context.Get_Response_Writer;
Need_Comma : Boolean := False;
Count : Natural;
procedure Render_Item (Label : in String) is
Result : Ada.Strings.Unbounded.Unbounded_String;
begin
if Match'Length = 0 or else
(Match'Length <= Label'Length
and then Match = Label (Label'First .. Label'First + Match'Length - 1))
then
if Need_Comma then
Writer.Write (",");
end if;
Writer.Write ('"');
Util.Strings.Transforms.Escape_Java (Content => Label,
Into => Result);
Writer.Write (Result);
Writer.Write ('"');
Need_Comma := True;
end if;
end Render_Item;
begin
Writer.Write ('[');
if List /= null then
Count := List.Get_Count;
if List.all in ASF.Models.Selects.Select_Item_List'Class then
declare
S : constant access ASF.Models.Selects.Select_Item_List'Class
:= ASF.Models.Selects.Select_Item_List'Class (List.all)'Access;
begin
for I in 1 .. Count loop
declare
Value : constant ASF.Models.Selects.Select_Item := S.Get_Select_Item (I);
begin
Render_Item (Ada.Characters.Conversions.To_String (Value.Get_Label));
end;
end loop;
end;
else
for I in 1 .. Count loop
List.Set_Row_Index (I);
declare
Value : constant Util.Beans.Objects.Object := List.Get_Row;
Label : constant String := Util.Beans.Objects.To_String (Value);
begin
Render_Item (Label);
end;
end loop;
end if;
end if;
Writer.Write (']');
end Render_List;
overriding
procedure Process_Updates (UI : in out UIComplete;
Context : in out Faces_Context'Class) is
begin
if not Util.Beans.Objects.Is_Empty (UI.Match_Value) then
declare
Value : constant access ASF.Views.Nodes.Tag_Attribute := UI.Get_Attribute ("match");
ME : EL.Expressions.Method_Expression;
begin
if Value /= null then
declare
VE : constant EL.Expressions.Value_Expression
:= ASF.Views.Nodes.Get_Value_Expression (Value.all);
begin
VE.Set_Value (Value => UI.Match_Value, Context => Context.Get_ELContext.all);
end;
end if;
-- Post an event on this component to trigger the rendering of the completion
-- list as part of an application/json output. The rendering is made by Broadcast.
ASF.Events.Faces.Actions.Post_Event (UI => UI,
Method => ME);
end;
else
ASF.Components.Html.Forms.UIInput (UI).Process_Updates (Context);
end if;
-- exception
-- when E : others =>
-- UI.Is_Valid := False;
-- UI.Add_Message (CONVERTER_MESSAGE_NAME, "convert", Context);
-- Log.Info (Utils.Get_Line_Info (UI)
-- & ": Exception raised when updating value {0} for component {1}: {2}",
-- EL.Objects.To_String (UI.Submitted_Value),
-- To_String (UI.Get_Client_Id), Ada.Exceptions.Exception_Name (E));
end Process_Updates;
-- ------------------------------
-- Broadcast the event to the event listeners installed on this component.
-- Listeners are called in the order in which they were added.
-- ------------------------------
overriding
procedure Broadcast (UI : in out UIComplete;
Event : not null access ASF.Events.Faces.Faces_Event'Class;
Context : in out Faces_Context'Class) is
pragma Unreferenced (Event);
Match : constant String := Util.Beans.Objects.To_String (UI.Match_Value);
begin
Context.Get_Response.Set_Content_Type ("application/json; charset=UTF-8");
UI.Render_List (Match, Context);
Context.Response_Completed;
end Broadcast;
-- ------------------------------
-- Render the end of the input date component.
-- Generate the javascript code to activate the input date selector
-- and closes the DL/DD list.
-- ------------------------------
overriding
procedure Encode_End (UI : in UIInputDate;
Context : in out Faces_Context'Class) is
begin
if not UI.Is_Rendered (Context) then
return;
end if;
-- Render the input date script and finish the input component.
declare
Id : constant String := To_String (UI.Get_Client_Id);
Writer : constant Response_Writer_Access := Context.Get_Response_Writer;
Format : constant String := UI.Get_Attribute ("dateFormat", Context);
begin
Writer.Queue_Script ("$('#");
Writer.Queue_Script (Id);
Writer.Queue_Script (" input').datepicker({");
if Format'Length > 0 then
Writer.Queue_Script ("dateFormat: """);
Writer.Queue_Script (Format);
Writer.Queue_Script ("""");
end if;
Writer.Queue_Script ("});");
UIInput (UI).Encode_End (Context);
end;
end Encode_End;
end ASF.Components.Widgets.Inputs;
|