~ubuntu-branches/ubuntu/intrepid/libgtkada2/intrepid

« back to all changes in this revision

Viewing changes to src/gtk-menu.adb

• browse files at revision 7
• compare with another revision
• compare with revision 7
• download diff
• download tarball
• view history from revision 7

Show diffs side-by-side

added

removed

src/gtk-menu.adb

2

2

--               GtkAda - Ada95 binding for Gtk+/Gnome               --

3

3

--                                                                   --

4

4

--   Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet   --

 

5

--                 Copyright (C) 2000-2008, AdaCore                  --

5

6

--                                                                   --

6

7

-- This library is free software; you can redistribute it and/or     --

7

8

-- modify it under the terms of the GNU General Public               --

29

29

with Gtk.Menu_Shell; use Gtk.Menu_Shell;

30

30

with Gtk.Widget;     use Gtk.Widget;

31

31

 

 

32

with Ada.Unchecked_Deallocation;

 

33

 

32

34

package body Gtk.Menu is

33

35

 

34

 

   function Type_Conversion (Type_Name : String) return GObject;

35

 

   --  This function is used to implement a minimal automated type conversion

 

36

   package Type_Conversion is new Glib.Type_Conversion_Hooks.Hook_Registrator

 

37

     (Get_Type'Access, Gtk_Menu_Record);

 

38

   pragma Warnings (Off, Type_Conversion);

 

39

   --  This package is used to implement a minimal automated type conversion

36

40

   --  without having to drag the whole Gtk.Type_Conversion package for the

37

41

   --  most common widgets.

38

42

 

 

43

   procedure Internal_Menu_Position_Func

 

44

     (Menu    : access Gtk_Menu_Record'Class;

 

45

      X       : out Gint;

 

46

      Y       : out Gint;

 

47

      Push_In : out Gboolean;

 

48

      Data    : Gtk_Menu_Position_Func);

 

49

   pragma Convention (C, Internal_Menu_Position_Func);

 

50

   --  Wrapper function passed to C.

 

51

 

39

52

   ----------------------

40

53

   -- Attach_To_Widget --

41

54

   ----------------------

276

289

      Internal (Get_Object (Menu), Boolean'Pos (Torn_Off));

277

290

   end Set_Tearoff_State;

278

291

 

 

292

   ---------------------------------

 

293

   -- Internal_Menu_Position_Func --

 

294

   ---------------------------------

 

295

 

 

296

   procedure Internal_Menu_Position_Func

 

297

     (Menu    : access Gtk_Menu_Record'Class;

 

298

      X       : out Gint;

 

299

      Y       : out Gint;

 

300

      Push_In : out Gboolean;

 

301

      Data    : Gtk_Menu_Position_Func) is

 

302

   begin

 

303

      Data.all (Menu, X, Y);

 

304

      Push_In := Boolean'Pos (False); --  ???

 

305

   end Internal_Menu_Position_Func;

 

306

 

279

307

   -----------

280

308

   -- Popup --

281

309

   -----------

292

320

        (Menu          : System.Address;

293

321

         Parent_M      : System.Address;

294

322

         Parent_I      : System.Address;

295

 

         Func          : Gtk_Menu_Position_Func;

 

323

         Func          : System.Address;

296

324

         Data          : System.Address;

297

325

         Button        : Guint;

298

326

         Activate_Time : Guint32);

310

338

         Parent_Item := Get_Object (Parent_Menu_Item);

311

339

      end if;

312

340

 

313

 

      Internal (Get_Object (Menu), Parent_Shell, Parent_Item,

314

 

                Func, System.Null_Address, Button, Activate_Time);

 

341

      if Func = null then

 

342

         Internal

 

343

           (Get_Object (Menu), Parent_Shell, Parent_Item,

 

344

            System.Null_Address,

 

345

            System.Null_Address, Button, Activate_Time);

 

346

      else

 

347

         Internal

 

348

           (Get_Object (Menu), Parent_Shell, Parent_Item,

 

349

            Internal_Menu_Position_Func'Address,

 

350

            Func.all'Address, Button, Activate_Time);

 

351

      end if;

315

352

   end Popup;

316

353

 

317

354

   ---------------------------------------

320

357

 

321

358

   package body User_Menu_Popup is

322

359

 

 

360

      type Data_Access is access Data_Type;

 

361

 

 

362

      procedure Unchecked_Free is new Ada.Unchecked_Deallocation

 

363

        (Data_Type, Data_Access);

 

364

 

 

365

      type Data_And_Cb is record

 

366

         Data : Data_Access;

 

367

         Cb   : Gtk_Menu_Position_Func;

 

368

      end record;

 

369

 

 

370

      type Data_And_Cb_Access is access Data_And_Cb;

 

371

 

 

372

      procedure Unchecked_Free is new Ada.Unchecked_Deallocation

 

373

        (Data_And_Cb, Data_And_Cb_Access);

 

374

 

 

375

      procedure Internal_Menu_Position_Func_With_Data

 

376

        (Menu    : access Gtk_Menu_Record;

 

377

         X       : out Gint;

 

378

         Y       : out Gint;

 

379

         Push_In : out Gboolean;

 

380

         Data    : Data_And_Cb_Access);

 

381

      pragma Convention (C, Internal_Menu_Position_Func_With_Data);

 

382

      --  Wrapper function passed to C.

 

383

 

 

384

      -------------------------------------------

 

385

      -- Internal_Menu_Position_Func_With_Data --

 

386

      -------------------------------------------

 

387

 

 

388

      procedure Internal_Menu_Position_Func_With_Data

 

389

        (Menu    : access Gtk_Menu_Record;

 

390

         X       : out Gint;

 

391

         Y       : out Gint;

 

392

         Push_In : out Gboolean;

 

393

         Data    : Data_And_Cb_Access)

 

394

      is

 

395

         The_Data : Data_And_Cb_Access := Data;

 

396

      begin

 

397

         Data.Cb (Menu, X, Y, Data.Data);

 

398

         Push_In := Boolean'Pos (False); --  ???

 

399

         Unchecked_Free (Data.Data);

 

400

         Unchecked_Free (The_Data);

 

401

      end Internal_Menu_Position_Func_With_Data;

 

402

 

323

403

      -----------

324

404

      -- Popup --

325

405

      -----------

326

406

 

327

407

      procedure Popup

328

 

        (Menu              : access Gtk_Menu_Record;

 

408

        (Menu              : access Gtk_Menu_Record'Class;

329

409

         Data              : access Data_Type;

330

410

         Parent_Menu_Shell : Gtk.Menu_Shell.Gtk_Menu_Shell := null;

331

411

         Parent_Menu_Item  : Gtk.Menu_Item.Gtk_Menu_Item := null;

337

417

           (Menu          : System.Address;

338

418

            Parent_M      : System.Address;

339

419

            Parent_I      : System.Address;

340

 

            Func          : Gtk_Menu_Position_Func;

 

420

            Func          : System.Address;

341

421

            Data          : System.Address;

342

422

            Button        : Guint;

343

423

            Activate_Time : Guint32);

346

426

         Parent_Shell : System.Address := System.Null_Address;

347

427

         Parent_Item  : System.Address := System.Null_Address;

348

428

 

 

429

         The_Data : Data_And_Cb_Access;

349

430

      begin

350

431

         if Parent_Menu_Shell /= null then

351

432

            Parent_Shell := Get_Object (Parent_Menu_Shell);

355

436

            Parent_Item := Get_Object (Parent_Menu_Item);

356

437

         end if;

357

438

 

358

 

         Internal

359

 

           (Get_Object (Menu),

360

 

            Parent_Shell,

361

 

            Parent_Item,

362

 

            Func,

363

 

            Data.all'Address,

364

 

            Button,

365

 

            Activate_Time);

 

439

         if Func = null then

 

440

            Internal

 

441

              (Get_Object (Menu),

 

442

               Parent_Shell,

 

443

               Parent_Item,

 

444

               System.Null_Address,

 

445

               System.Null_Address,

 

446

               Button,

 

447

               Activate_Time);

 

448

         else

 

449

            The_Data := new Data_And_Cb'(new Data_Type'(Data.all), Func);

 

450

            Internal

 

451

              (Get_Object (Menu),

 

452

               Parent_Shell,

 

453

               Parent_Item,

 

454

               Internal_Menu_Position_Func_With_Data'Address,

 

455

               The_Data.all'Address,

 

456

               Button,

 

457

               Activate_Time);

 

458

         end if;

366

459

      end Popup;

367

460

   end User_Menu_Popup;

368

461

 

421

514

      Internal (Get_Object (Menu), Monitor_Num);

422

515

   end Set_Monitor;

423

516

 

424

 

   ---------------------

425

 

   -- Type_Conversion --

426

 

   ---------------------

427

 

 

428

 

   function Type_Conversion (Type_Name : String) return GObject is

429

 

   begin

430

 

      if Type_Name = "GtkMenu" then

431

 

         return new Gtk_Menu_Record;

432

 

      else

433

 

         return null;

434

 

      end if;

435

 

   end Type_Conversion;

436

 

 

437

 

begin

438

 

   Glib.Type_Conversion_Hooks.Add_Hook (Type_Conversion'Access);

439

517

end Gtk.Menu;

• Older »

Loggerhead is a web-based interface for Breezy
Version: 2.0.1