File: rotate_arrow_global.adb

package info (click to toggle)
libadabindx 0.7.2-4
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 3,136 kB
  • ctags: 32
  • sloc: ada: 35,597; makefile: 556; sh: 10
file content (59 lines) | stat: -rw-r--r-- 3,160 bytes parent folder | download
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
-------------------------------------------------------------------------------
--                                                                           --
--  Ada Interface to the X Window System and Motif(tm)/Lesstif               --
--  Copyright (c) 1996-2000 Hans-Frieder Vogt                                --
--                                                                           --
--  This program is free software; you can redistribute it and/or modify     --
--  it under the terms of the GNU General Public License as published by     --
--  the Free Software Foundation; either version 2 of the License, or        --
--  (at your option) any later version.                                      --
--                                                                           --
--  This program is distributed in the hope that it will be useful,          --
--  but WITHOUT ANY WARRANTY; without even the implied warranty of           --
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
--  See the GNU General Public License for more details.                     --
--                                                                           --
--  You should have received a copy of the GNU General Public License        --
--  along with this program; if not, write to the                            --
--  Free Software Foundation, Inc.,                                          --
--  59 Temple Place - Suite 330,                                             --
--  Boston, MA 02111-1307, USA.                                              --
--                                                                           --
--                                                                           --
--  X Window System is copyrighted by the X Consortium                       --
--  Motif(tm)       is copyrighted by the Open Software Foundation, Inc.     --
--                                                                           --
--                                                                           --
-------------------------------------------------------------------------------

-------------------------------------------------------------------------------
--
-- HISTORY:
--          June 20, 1998 begin of history
--
-------------------------------------------------------------------------------

package body Rotate_Arrow_Global is

   procedure Arrow_Button_CB (W         : in Widget;
                              Closure   : Xt_Pointer;
                              Call_Data : Xt_Pointer) is
   begin
      if Dir /= Arrow_Direction_Type'Last then
         Dir := Arrow_Direction_Type'Succ (Dir);
      else
         Dir := Arrow_Direction_Type'First;
      end if;
      Argl := Null_Arg_List;
      Append_Set (Argl, Xm_N_Arrow_Direction, Dir);
      Xt_Set_Values (The_Button, Argl);

      The_Title := Xm_String_Create (Arrow_Direction_Type'Image (Dir));
      Argl := Null_Arg_List;
      Append_Set (Argl, Xm_N_Label_String, The_Title);
      Xt_Set_Values (The_Label, Argl);
      Xm_String_Free (The_Title);

   end Arrow_Button_CB;

end Rotate_Arrow_Global;