Add a button in a callback - gtk

I can't make my callback function work. I have created a button which when clicked removes the first button and displays the second button. When I click the button, it removes the first button but does not show the second button. here is the complete code:
File.ads
With Gtk.Widget; Use Gtk.Widget;
With Gtk.Main; Use Gtk.Main;
With Gtk.Window; Use Gtk.Window;
With Gtk.Button; Use Gtk.Button;
With Gtk.Table; Use Gtk.Table;
With Gtk.Handlers; Use Gtk.Handlers;
Package File is
Type T_Test_Record is record
Table : Gtk_Table;
Button_2 : Gtk_Button;
end record;
Type T_Test is access T_Test_Record;
Procedure Init_Button ( Self : access Gtk_Widget_Record'Class; Button : T_Test);
-- Callback for create the second button
Procedure Init_Table ( Table : access T_Test_Record );
-- Initialize the table.
Procedure Exit_Window (Self : access Gtk_Widget_Record'Class);
-- Stop Gtk.Main.Main loop when wen close the window.
Package P is new Gtk.handlers.User_Callback (Gtk_Widget_Record,T_Test);
Use P;
Package P2 is new Gtk.Handlers.Callback (Gtk_Window_Record);
Use P2;
end File;
File.adb
With Gtk.Widget; Use Gtk.Widget;
With Gtk.Table; Use Gtk.Table;
With Gtk.Button; Use Gtk.Button;
Package body File is
Procedure Init_Table (Table : access T_Test_Record ) is
begin
Gtk_New (Table.Table,0,0,False);
end Init_Table;
Procedure Init_Button (Self : access Gtk_Widget_Record'Class;
Button : T_Test) is
begin
Self.Destroy;
Init_Table (Button);
Gtk_New (Button.Button_2);
Button.Button_2.Set_Label ("Bouton 2");
Button.Table.Add (Button.Button_2);
end Init_Button;
Procedure Exit_Window (Self : access Gtk_Widget_Record'Class) is
begin
Gtk.Main.Main_Quit;
end Exit_Window;
end File;
Main.adb
With Gtk.Main; Use Gtk.Main;
With Gtk.Enums; Use Gtk.Enums;
With Gtk.Button; Use Gtk.Button;
With Gtk.Window; Use Gtk.Window;
With Gtk.Grid; Use Gtk.Grid;
With test2; Use Test2;
Procedure Main is
Win : Gtk_Window;
Button : Gtk_Button;
Test : T_Test;
begin
Init;
Test := New T_Test_Record;
Init_Table (Test);
-- Initialize the window
Gtk_New (Win);
Win.Set_Default_Size (600,400);
Win.On_Destroy (test2.Exit_Window'Access);
-- Initialize the Button
Gtk_New (Button,"Bouton 1");
-- Add the Table in the window
Win.Add (Test.Table);
-- Add button in the table
Test.Table.Add (Button);
-- Connect the calllback in the button
Test2.P.Connect (Widget => Button,
Name => Signal_Clicked,
Marsh => Test2.P.To_Marshaller (Init_Button'Access),
User_Data => Test,
After => False);
-- Show the window
Win.Show_All;
Gtk.Main.Main;
end Main;
How can I make my callback function show the second button?

To toggle the visibility of a widget, you can use the Show and Hide procedures (or Set_Visibility procedure as used in an earlier example). Here's an annotated example:
app.ads
package App is
end App;
app-main_window.ads
with Gtk.Window; use Gtk.Window;
with Gtk.Grid; use Gtk.Grid;
with Gtk.Button; use Gtk.Button;
with Gtk.Frame; use Gtk.Frame;
package App.Main_Window is
type App_Main_Window_Record is new Gtk_Window_Record with private;
type App_Main_Window is access all App_Main_Window_Record'Class;
------------------
-- Constructors --
------------------
procedure Gtk_New
(Main_Window : out App_Main_Window);
procedure Initialize
(Main_Window : not null access App_Main_Window_Record'Class);
private
Window_Width : constant := 300;
Window_Height : constant := 100;
type App_Main_Window_Record is
new Gtk.Window.Gtk_Window_Record with
record
Grid : Gtk_Grid;
Frame_1 : Gtk_Frame;
Frame_2 : Gtk_Frame;
Button_1 : Gtk_Button;
Button_2 : Gtk_Button;
end record;
end App.Main_Window;
app-main_window.adb
with Gtk.Main;
with Gtk.Widget;
with Gtk.Window;
with Gdk.Event;
package body App.Main_Window is
procedure Destroy_Event_Callback
(Widget : access Gtk.Widget.Gtk_Widget_Record'Class);
function On_Button_1_Pressed_Callback
(Self : access Gtk.Widget.Gtk_Widget_Record'Class;
Event : Gdk.Event.Gdk_Event_Button) return Boolean;
function On_Button_2_Pressed_Callback
(Self : access Gtk.Widget.Gtk_Widget_Record'Class;
Event : Gdk.Event.Gdk_Event_Button) return Boolean;
-------------
-- Gtk_New --
-------------
procedure Gtk_New (Main_Window : out App_Main_Window) is
begin
Main_Window := new App_Main_Window_Record;
App.Main_Window.Initialize (Main_Window);
end Gtk_New;
----------------
-- Initialize --
----------------
procedure Initialize
(Main_Window : not null access App_Main_Window_Record'Class)
is
begin
-- Initialize and setup the window.
Gtk.Window.Initialize (Main_Window);
Main_Window.Set_Title ("Demo Window");
Main_Window.Set_Size_Request (Window_Width, Window_Height);
Main_Window.Set_Resizable (False);
-- Attach callback: properly end the GTK application when requested.
Main_Window.On_Destroy
(Call => Destroy_Event_Callback'Access);
-- Add a grid.
Gtk_New (Main_Window.Grid);
Main_Window.Grid.Set_Hexpand (True);
Main_Window.Grid.Set_Vexpand (True);
Main_Window.Grid.Set_Column_Homogeneous (True);
Main_Window.Grid.Set_Row_Homogeneous (True);
Main_Window.Add (Main_Window.Grid);
-- Create two frames and two buttons. The frames are needed to
-- ensure that the position and size are retrained if either buttons
-- are hidden (layout containers like grid and box recompute the
-- expansions when the visibility of their child wigeds change).
--
-- The object hierchy is as follows:
--
-- +------------------------+
-- | Window |
-- +-----------+------------+
-- |
-- +-----------+------------+
-- | Grid |
-- | (0,0) (1,0) |
-- +----+-------------+-----+
-- | |
-- +----+-----+ +----+-----+
-- | Frame_1 | | Frame_2 |
-- +----+-----+ +----+-----+
-- | |
-- +----+-----+ +----+-----+
-- | Button_1 | | Button_2 |
-- +----------+ +----------+
Gtk_New (Main_Window.Frame_1);
Gtk_New (Main_Window.Frame_2);
Gtk_New (Main_Window.Button_1, Label => "Button 1");
Gtk_New (Main_Window.Button_2, Label => "Button 2");
-- Add the buttons to their respective frame.
Main_Window.Frame_1.Add (Main_Window.Button_1);
Main_Window.Frame_2.Add (Main_Window.Button_2);
-- Insert both frames into the grid.
Main_Window.Grid.Attach
(Child => Main_Window.Frame_1,
Left => 0,
Top => 0);
Main_Window.Grid.Attach
(Child => Main_Window.Frame_2,
Left => 1,
Top => 0);
-- Attach "button pressed" callbacks.
Main_Window.Button_1.On_Button_Press_Event
(Call => On_Button_1_Pressed_Callback'Access);
Main_Window.Button_2.On_Button_Press_Event
(Call => On_Button_2_Pressed_Callback'Access);
-- Show everything ...
Main_Window.Show_All;
-- ... and then hide button 2 initially.
Main_Window.Button_2.Hide;
end Initialize;
----------------------------
-- Destroy_Event_Callback --
----------------------------
procedure Destroy_Event_Callback
(Widget : access Gtk.Widget.Gtk_Widget_Record'Class)
is
begin
Gtk.Main.Main_Quit;
end Destroy_Event_Callback;
----------------------------------
-- On_Button_1_Pressed_Callback --
----------------------------------
function On_Button_1_Pressed_Callback
(Self : access Gtk.Widget.Gtk_Widget_Record'Class;
Event : Gdk.Event.Gdk_Event_Button) return Boolean
is
-- (parent) (parent) (parent)
-- Button (Self) -------> Frame -------> Grid -------> Window
Frame : Gtk_Frame := Gtk_Frame (Self.Get_Parent);
Grid : Gtk_Grid := Gtk_Grid (Frame.Get_Parent);
Window : App_Main_Window := App_Main_Window (Grid.Get_Parent);
begin
-- Just toggle visibility.
Window.Button_1.Hide;
Window.Button_2.Show;
return True; -- GDK_EVENT_STOP, do not propagate event to parent.
end On_Button_1_Pressed_Callback;
----------------------------------
-- On_Button_2_Pressed_Callback --
----------------------------------
function On_Button_2_Pressed_Callback
(Self : access Gtk.Widget.Gtk_Widget_Record'Class;
Event : Gdk.Event.Gdk_Event_Button) return Boolean
is
Frame : Gtk_Frame := Gtk_Frame (Self.Get_Parent);
Grid : Gtk_Grid := Gtk_Grid (Frame.Get_Parent);
Window : App_Main_Window := App_Main_Window (Grid.Get_Parent);
begin
Window.Button_1.Show;
Window.Button_2.Hide;
return True; -- GDK_EVENT_STOP, do not propagate event to parent.
end On_Button_2_Pressed_Callback;
end App.Main_Window;
main.adb
with Gtk.Main;
with App.Main_Window;
procedure Main is
use App.Main_Window;
Main_Window : App_Main_Window;
begin
Gtk.Main.Init;
Gtk_New (Main_Window);
Gtk.Main.Main;
end Main;

Related

postgresql the difference between with or without inverse transition function

dbfilddle
source
Quote from 38.12.1. Moving-Aggregate Mode
The forward transition function for moving-aggregate mode is not
allowed to return null as the new state value. If the inverse
transition function returns null, this is taken as an indication that
the inverse function cannot reverse the state calculation for this
particular input, and so the aggregate calculation will be redone from
scratch for the current frame starting position.
-- create aggregates that record the series of transform calls (these are
-- intentionally not true inverses)
create function logging_sfunc_strict(text, anyelement)
returns text as
$$
select $1 || '*' || quote_nullable($2)
$$
LANGUAGE sql strict IMMUTABLE;
create or replace function logging_msfunc_strict(text,anyelement)
returns text as
$$
select $1 || '+' || quote_nullable($2)
$$
LANGUAGE sql strict IMMUTABLE;
create or replace function logging_minvfunc_strict(text, anyelement)
returns text as
$$
select $1 || '-' || quote_nullable($2)
$$
LANGUAGE sql strict IMMUTABLE;
create aggregate logging_agg_strict(text)
(
stype = text,
sfunc = logging_sfunc_strict,
mstype = text,
msfunc = logging_msfunc_strict,
minvfunc = logging_minvfunc_strict
);
create aggregate logging_agg_strict_initcond(anyelement)
(
stype = text,
sfunc = logging_sfunc_strict,
mstype = text,
msfunc = logging_msfunc_strict,
minvfunc = logging_minvfunc_strict,
initcond = 'I',
minitcond = 'MI'
);
execute following query:
SELECT
p::text || ',' || i::text || ':' || COALESCE(v::text, 'NULL') AS _row,
logging_agg_strict (v) OVER w AS nstrict,
logging_agg_strict_initcond (v) OVER w AS nstrict
FROM (
VALUES (1, 1, NULL),
(1, 2, 'a'),
(1, 3, 'b'),
(1, 4, NULL),
(1, 5, NULL),
(1, 6, 'c'),
(2, 1, NULL),
(2, 2, 'x'),
(3, 1, 'z')) AS t (p, i, v)
WINDOW w AS (PARTITION BY p ORDER BY i ROWS BETWEEN 1 PRECEDING AND CURRENT ROW);
returns:
_row | nstrict | nstrict
----------+-----------+----------------
1,1:NULL | [[null]] | MI
1,2:a | a | MI+'a'
1,3:b | a+'b' | MI+'a'+'b'
1,4:NULL | a+'b'-'a' | MI+'a'+'b'-'a'
1,5:NULL | [[null]] | MI
1,6:c | c | MI+'c'
2,1:NULL | [[null]] | MI
2,2:x | x | MI+'x'
3,1:z | z | MI+'z'
(9 rows)
For now I don't understand row 1,4:NULL | a+'b'-'a' | MI+'a'+'b'-'a'.
I am not sure why you 1st time encounter NULL then it will call inverse transition function Overall, not sure the idea of inverse transition function.
Quote from CREATE AGGREGATE:
minvfunc
The name of the inverse state transition function to be used in moving-aggregate mode. This function has the same argument and result
types as msfunc, but it is used to remove a value from the current
aggregate state, rather than add a value to it. The inverse transition
function must have the same strictness attribute as the forward state
transition function.
search emaillist keyword: minvfunc. There is no hit.
update
now the question is different. I am trying to understand the following quoted part(manual chapter: 38.12.1. Moving-Aggregate Mode). The computation difference between with and without inverse transition function.
Without an inverse transition function, the window function mechanism
must recalculate the aggregate from scratch each time the frame
starting point moves, resulting in run time proportional to the number
of input rows times the average frame length. With an inverse
transition function, the run time is only proportional to the number
of input rows.
Let say the window frame is
WINDOW w AS (PARTITION BY p ORDER BY i ROWS BETWEEN 1 PRECEDING AND CURRENT ROW)
I assume the following is how with inverse transition function how does it go computation.
ordered_value sum_aggregate
a a
b a+b
c a+b+c-a
d a+b+c+d-a-b
e a+b+c+d+e-a-b-c
f a+b+c+d+e+f-a-b-c-d
So the question is does above explanation is with inverse transition function compute or not. If it is then without it, how does it go computed.

Firebird dynamic Var New and Old

I need validate dynamic Fields from a Table. For example:
CREATE TRIGGER BU_TPROYECTOS FOR TPROYECTOS
BEFORE UPDATE AS
DECLARE VARIABLE vCAMPO VARCHAR(64);
BEGIN
/*In then table "TCAMPOS" are the fields to validate*/
for Select CAMPO from TCAMPOS where TABLA = TPROYECTOS and ACTUALIZA = 'V' into :vCAMPO do
Begin
if (New.:vCAMPO <> Old.:vCampo) then
/*How i get dynamic New.Field1, New.Field2 on query return*/
End;
END ;
The question is : How can I put "The name of the field that the query returns me " in the above code .
Ie if the query returns me the field1 and field5 , I would put the trigger
if ( New.Field1 < > Old.Field1 ) or ( New.Field5 < > Old.Field5 ) then
There is no such feature in Firebird. You will need to create (and preferably) generate triggers that will reference all fields hard coded. If the underlying table changes or the requirements for validation, you will need to recreate the trigger to take the added or removed fields into account.

Getting a value from stored procedure within a stored procedure

I have a stored procedure which returns an XML file. At the moment some calculations are done in XSL but I would like to do these within the database using another stored procedure. (adding the result of that calculation to the XML)
ALTER PROCEDURE [dbo].[app_Get_Phone_And_Tariffs]
-- Add the parameters for the stored procedure here
#phone nvarchar(150)
AS
BEGIN
-- SET NOCOUNT ON added to prevent extra result sets from
-- interfering with SELECT statements.
SET NOCOUNT ON;
-- Insert statements for procedure here
SELECT
PB.UID as '#phoneid',
PB.Short_Title as '#title',
PB.Description as '#desc',
PB.Camera as '#camera',
PB.Storage as '#storage',
PB.Screen_Size as '#screensize',
PB.OS as '#os',
PB.Processor as '#chip',
PB.Image1 as '#image',
PB.Trade_Price as '#tradeprice',
(SELECT
TB.UID as '#tariffid',
TB.Tariff_Name as '#name',
TB.Carrier as '#network',
TB.Inclusive_Minutes as '#mins',
TB.Inclusive_Texts as '#texts',
TB.Inclusive_Data as '#data',
TB.Monthly_Cost as '#monthly',
TB.Commission as '#comm',
(TB.Commission - PB.Trade_Price) as '#upfront'
FROM dbo.Tariff_Base TB
WHERE TB.Active = 1 AND TB.Type = 1
FOR XML PATH('tariff'), TYPE
),
(SELECT
OP.GP_Margin as '#gpmargin'
FROM dbo.Options OP
FOR XML PATH('options'), TYPE
)
FROM dbo.Phone_Base PB
WHERE PB.Friendly_URL_Name = #phone AND PB.Active = 1
FOR XML PATH('detail'), TYPE
END
What I want to do is:
In the inner select (TB) is to call another SP lets call it "calculate" passing 2 variables (TB.Commission and PB.Trade_Price) for the sum
Calculate will return a value i.e. #hp to the stored procedure which can be added/used in the XML List.
Can this be done in SQL Server 2014/T-SQL?
No. But you could do it with a function. See the MSDN documentation, especially example A.
Something like this (untested):
CREATE FUNCTION dbo.Calculate (#Comission float, #TradePrice float)
RETURNS float
WITH EXECUTE AS CALLER
AS
BEGIN
DECLARE #SumVal float;
SET #SumVal = #Commission + # TradeValue;
RETURN(#SumVal);
END;
GO
--In your sub-query
SELECT values, dbo.Calculate(TB.Commission, PB.Trade_Price) AS A_Sum
FROM ...;

Initialize generator with existing value

I am trying to set a generator with a value that is in some table, I have already seen this question How to set initial generator value? and did what they suggested but I don't know where am I going wrong here.
set term #
execute block
as
declare i int = 0;
begin
i = (select max(some_col) from Table);
gen_id(some_gen,-(gen_id(some_gen,0))); ---set some_gen to 0
gen_id(some_gen,:i); --- set to i
end #
set term ;#
The problem with your code is that you can't execute gen_id in isolation; the parser expects gen_id (or more precisely: a function call) only in a place where you can have a value (eg in a statement or an assignment). You need to assign its return value to a parameter, for example:
set term #;
execute block
as
declare i int = 0;
declare temp int = 0;
begin
i = (select max(id) from items);
temp = gen_id(GEN_ITEMS_ID, -(gen_id(GEN_ITEMS_ID, 0))); ---set some_gen to 0
temp = gen_id(GEN_ITEMS_ID, :i); --- set to i
end #
set term ;#
Please be aware that changing sequences like this is 'risky': if there are any interleaving actions using this same sequence, you might not actually get the result you expected (the sequence might end up at a different value than i and you might get duplicate key errors when another transaction uses the sequence after you subtract the current value (set to 0) and before you add i.
As also noted in the comments, you can also replace your code with:
set term #;
execute block
as
declare i int = 0;
declare temp int = 0;
begin
i = (select max(id) from items);
temp = gen_id(GEN_ITEMS_ID, :i - gen_id(GEN_ITEMS_ID, 0));
end #
set term ;#
Doing it in one statement will reduce the risk of interleaving operations (although it will not remove it entirely).
If you want to use "execute block", you may use something like :
execute block
as
declare i int = 0;
begin
i = (select max(some_col) from some_table);
execute statement ('set generator MY_GENERATOR to ' || :i);
end

Construction of a class with task property in Ada 2005

I have a class Test_Class in Ada 2005 which has a parent-linked task property called Primary, from type Primary_Task, defined as:
type Test_Class is tagged limited
record
Info : Integer;
Value : Float;
Primary : Primary_Task (Test_Class'Access);
end record;
I need build a one-step constructor for my class in the form
function Construct (T : access Test_Class) return Test_Class_Ptr is
begin
return new Test_Class'(Info => T.Info + 1,
Value => 0.0,
Primary => [WHAT I WANNA KNOW]);
end Construct;
Currently my code is:
-- test_pkg.ads
package Test_Pkg is
type Test_Class;
type Test_Class_Ptr is access all Test_Class;
task type Primary_Task (This_Test : access Test_Class) is
pragma Storage_Size (1000);
end Primary_Task;
type Test_Class is tagged limited
record
Info : Integer;
Value : Float;
Primary : Primary_Task (Test_Class'Access);
end record;
function Construct (T : access Test_Class) return Test_Class_Ptr;
end Test_Pkg;
-- test_pkg.adb
with Text_IO; use Text_IO;
package body Test_Pkg is
[...]
function Construct (T : access Test_Class) return Test_Class_Ptr is
T_Ptr : constant Test_Class_Ptr := new Test_Class;
begin
T_Ptr.Info := T.Info + 1;
T_Ptr.Value := 0.0;
return T_Ptr;
end Construct;
end Test_Pkg;
So, how can I code it? What should I put in Primary => [...] code? Should I change the definition of Primary : Primary_Task (Test_Class'Access); in Test_Class definition?
I got an answer from Randy Brukardt (thank you) on comp.lang.ada:
In Ada 2005 or later, use "<>" to default initialize a component in an
aggregate (which is the only thing you can do with a task).
(...)
function Construct (T : access Test_Class) return Test_Class_Ptr is
begin
return new Test_Class'(Info => T.Info + 1,
Value => 0.0,
Primary => <>);
end Construct;
However, I tried to compile it using GNAT GPL 2011 and got the GNATBUG below
c:\tst>gnatmake -gnat12 test_pkg.adb
gcc -c -gnat12 test_pkg.adb
+===========================GNAT BUG DETECTED==============================+
| GPL 2011 (20110428) (i686-pc-mingw32) GCC error: |
| in create_tmp_var, at gimplify.c:505 |
| Error detected around test_pkg.adb:20:29 |
| Please submit a bug report by email to report#adacore.com. |
| GAP members can alternatively use GNAT Tracker: |
| http://www.adacore.com/ section 'send a report'. |
| See gnatinfo.txt for full info on procedure for submitting bugs. |
| Use a subject line meaningful to you and us to track the bug. |
| Include the entire contents of this bug box in the report. |
| Include the exact gcc or gnatmake command that you entered. |
| Also include sources listed below in gnatchop format |
| (concatenated together with no headers between files). |
| Use plain ASCII or MIME attachment. |
+==========================================================================+
Please include these source files with error report
Note that list may not be accurate in some cases,
so please double check that the problem can still
be reproduced with the set of files listed.
Consider also -gnatd.n switch (see debug.adb).
test_pkg.adb
test_pkg.ads
raised TYPES.UNRECOVERABLE_ERROR : comperr.adb:423
gnatmake: "test_pkg.adb" compilation error
So GNAT GPL users may have to wait for the next release to use this solution.