The unified diff between revisions [b93dcd99..] and [df87519a..] is displayed below. It can also be downloaded as a raw diff.
#
#
# delete "contrib/cairo-1.8.6.diff"
#
# delete "contrib/glib-2.18.4-win32.diff"
#
# delete "contrib/gtk+-2.14.7-darwin.diff"
#
# delete "contrib/gtk+-2.14.7-win32.diff"
#
# delete "contrib/gtk+-2.14.7.diff"
#
# rename "contrib/glib-2.20.4-win32.diff"
# to "contrib/glib-2.22.4-win32.diff"
#
# rename "contrib/gtk+-2.16.5-darwin.diff"
# to "contrib/gtk+-2.18.6-darwin.diff"
#
# rename "contrib/gtk+-2.16.5-win32.diff"
# to "contrib/gtk+-2.18.6-win32.diff"
#
# rename "contrib/gtk+-2.16.5.diff"
# to "contrib/gtk+-2.18.6.diff"
#
# rename "contrib/pygobject-2.18.0.diff"
# to "contrib/pygobject-2.20.0.diff"
#
# add_file "contrib/Python-2.6.4.diff"
# content [609653982ccbfa36782799cbd16e756abdf8185f]
#
# add_file "contrib/glib-2.22.4.diff"
# content [5b518e1f39473147d530e93ad4102a77afe0c48a]
#
# add_file "contrib/pango-1.26.1.diff"
# content [531522a0f5422e89c61a075aeb62362d29956e1a]
#
# add_file "contrib/pixman-0.15.12.diff"
# content [a74271be53b7a16e124793bae9b91d1edb706d83]
#
# add_file "contrib/pycairo-1.8.8-win32.diff"
# content [cb330d3c36797ed8486587341c8c525aa0836195]
#
# add_file "contrib/pycairo-1.8.8.diff"
# content [aa888c92102d40b2fee8da9dcec7b8abd98d6892]
#
# add_file "contrib/pygobject-2.20.0-win32.diff"
# content [929e5b2320cb68705fae6004796d650380147e4f]
#
# add_file "contrib/pygtk-2.16.0-win32.diff"
# content [2ebe9801c6bd3aa5a748f0bb1e154d6020dd8335]
#
# patch "README"
# from [724a5d2bb49ece3ce71969a01f408ff659641fcf]
# to [4c9cd863488faabfcfff7ac066d202705a65187a]
#
# patch "configure"
# from [2a0c47618af215c6a45a70469554924ae8e86fa0]
# to [bcd142d75c0713ecb3dc2b0fecda10372b998e94]
#
# patch "configure.in"
# from [13e616415969b698f50b0d0f067b22fe42d890b9]
# to [4727c748e061d62fea20bf54b1a406ac51416b7c]
#
# patch "contrib/README"
# from [05d680d54aa07c5e1dfeb1643ff5d2fa0c010508]
# to [53ec377f471be3e7d085c1a08bbed1d07044bf9a]
#
# patch "contrib/gtk+-2.18.6-win32.diff"
# from [21b23c4ce2fad447ffc22c11336e6d05752eea1e]
# to [71c27202453d053a418f855d9632ee0d05a9e11f]
#
# patch "contrib/gtk+-2.18.6.diff"
# from [6044693b5079a9f91191db8554e5f4c6caf9839c]
# to [ea500718c9516b477c38df9c52c20a18cd9cd1ee]
#
# patch "contrib/pygobject-2.20.0.diff"
# from [80dccaf30dea2450b944cb363a19534bf8f85001]
# to [397690d8c804d1a9cff28b4b823ba43ef5fd4881]
#
# patch "docs/gtkada_rm/gtkada_rm.texi"
# from [8e0e0c0ccd504c9fdb6bcae434ef664258995681]
# to [e8dddf864ae317b2f4852384751e5ae6fa1923d0]
#
# patch "docs/gtkada_ug/gtkada_ug.texi"
# from [29badfd1efd59e5aef7abec3fe0df9f1d46f0c0c]
# to [a52b54ce2d9afd1d346dd53726381b17be6fe270]
#
# patch "docs/texi2html"
# from [6effba94bba805f4768bda3bf8d55a839e6f1622]
# to [b627a27ecb751e7ea6e8960a73278e033f48337c]
#
# patch "features"
# from [02b80725ca608d83b2376021cf85acf8489ab685]
# to [6de6a7be5ccc597d5f2d8f989d9c795b17494dca]
#
# patch "known-problems"
# from [4853b0dbd1c7c8d494f62660bf196e3931ea23b6]
# to [639c4cb05a99f80db79165e2204f26d1d5bfe561]
#
# patch "src/gdk-screen.adb"
# from [715eb1de52a4400db42e965614cc23a9efa4efd9]
# to [088bbec2add576b9c3ae511b0e2c45855dce76e1]
#
# patch "src/gdk-screen.ads"
# from [66b9377e1701f42de25a394c38d7d88460e6a0fb]
# to [a80f43c920b199db650c6d95ab103f3009b7bce9]
#
# patch "src/gdk-window.adb"
# from [998afc966c1e4b084b4f4da975ab08765f7f61b3]
# to [b3ba7725dbd28683e6d00cdbde0170aff3409dca]
#
# patch "src/gdk-window.ads"
# from [24aa31d11d420842fbac3a3bca79eeca7a0e0e15]
# to [e431dddcfe8fcc0231608a73b8a1045b32d04aed]
#
# patch "src/glib-xml.adb"
# from [8efe9d36f4647971d8728c555172048e4fb69946]
# to [a3b71d19372a508035d901507c01b729db9c868a]
#
# patch "src/glib-xml.ads"
# from [cf9ea4ad1ebbbe94a8119c1b47b8f289071348d2]
# to [60df0e33e2da9df2f2fd10cb6a16b45e1c4525d0]
#
# patch "src/gnome/gnome-about.adb"
# from [f596de1a93129c6aabac266f5579e7439906a2fc]
# to [50642fcd1bcff02a3af64a5a5948d4d6937919df]
#
# patch "src/gnome/gnome-druid_page_edge.adb"
# from [14e0995f44ac05fee851b74f22f9fcdb95c25998]
# to [cf89a05e0aac5c87f6ed931a39504f28a611c923]
#
# patch "src/gnome/gnome-druid_page_standard.adb"
# from [eb0f29b370ee10965e33a1b1dc451f15348caba6]
# to [a47fa9b2d004364b86f38d4a8e418d8e6c93b258]
#
# patch "src/gtk-cell_renderer_text.ads"
# from [1b9c3b8ee7bc40cb100ddca26ecd5ec2dca0bad2]
# to [c27b4787cf9e81c5a12c188c647c6b498389d78c]
#
# patch "src/gtk-file_filter.ads"
# from [5f4cd7f24b7c2fd948c71dc38dae7f24702a0082]
# to [f71f3d83fd8cc9afdbdb69a8bf2290645f1fba88]
#
# patch "src/gtk-handlers.ads"
# from [65961b4c9579b6962e3748ad900e356891458c54]
# to [7e64c8d99f0b791d49bf184ee48faf77ce20b4f3]
#
# patch "src/gtk-marshallers.adb"
# from [785dc808408bf0de63b93d5f492bbd66d4991c8f]
# to [1ccb7d71ead1150769a88dc5ab5ae96cce503d74]
#
# patch "src/gtk-marshallers.ads"
# from [ee7d6e4458c3c51bdd8a8107d052572003b8e75e]
# to [4063f1e8c77e23fac55bfc7cf85a8e58b9419cf9]
#
# patch "src/gtk-tree_model.adb"
# from [49060392a3beb5541290a78155b299730e102df7]
# to [b00befcaa43c2b749c8ef4b3300c248da649cdae]
#
# patch "src/gtk-tree_model.ads"
# from [6be724852557ad2c53bf3c6ba5566aabd2ef3b5f]
# to [1cfe838cf33b32e23bcb30fd8ab88699df589b43]
#
# patch "src/gtk-window.ads"
# from [7010751ab8497310da07fff65ed8649047094b29]
# to [b030a152aae66e9e7c8bfe4905d773f47dbe4ea7]
#
# patch "src/gtkada-abstract_list_model.adb"
# from [94bb956a57455b26d089ae81dde6af0d5b18a858]
# to [8c52039765088510292f166e5074f29a535bbb5e]
#
# patch "src/gtkada-abstract_tree_model.ads"
# from [8e8f3e0f5be9076e8016222cdfb8589f90e8e1f0]
# to [ffb4ca2f599e1d62840c9e508c1c00e560ae49ed]
#
# patch "src/gtkada-mdi.adb"
# from [861ae4469ffa0dc44ad98784f675fde349de9307]
# to [65bc823f08e8081b530882a5431941c4b03c0ea4]
#
# patch "src/gtkada-mdi.ads"
# from [5cad0b6e59bf19be60d10bed1332407e767d99ca]
# to [9be971009fd7cc9cd75d0d293982c6e67a6970cc]
#
# patch "src/gtkada-multi_paned.adb"
# from [017aad7d870d1778ff26ebd1a0255729b4bdd789]
# to [90873d4b44c9abf7ea49d509f3fb8fbec03d618d]
#
# patch "src/gtkada-multi_paned.ads"
# from [ca114af08733d4dd39aa328b31df49f7fd2f6b34]
# to [b8634c129fdb397bc19d055b43727282b0ca2387]
#
# patch "testgtk/create_file_chooser.adb"
# from [89d31b5584f92ed9d2678fb73239d9dabc63eb83]
# to [a2d443c005b7a804d7ba3d3736852441806a4098]
#
============================================================
--- contrib/Python-2.6.4.diff 609653982ccbfa36782799cbd16e756abdf8185f
+++ contrib/Python-2.6.4.diff 609653982ccbfa36782799cbd16e756abdf8185f
@@ -0,0 +1,21 @@
+ * setup.py: Fix handling of --without-threads.
+ Already in Python 3.x
+
+--- setup.py.old 2009-12-21 15:30:21.000000000 +0100
++++ setup.py 2009-12-21 15:31:39.000000000 +0100
+@@ -1324,9 +1324,12 @@ class PyBuildExt(build_ext):
+ if macros.get('HAVE_SEM_OPEN', False):
+ multiprocessing_srcs.append('_multiprocessing/semaphore.c')
+
+- exts.append ( Extension('_multiprocessing', multiprocessing_srcs,
+- define_macros=macros.items(),
+- include_dirs=["Modules/_multiprocessing"]))
++ if sysconfig.get_config_var('WITH_THREAD'):
++ exts.append ( Extension('_multiprocessing', multiprocessing_srcs,
++ define_macros=macros.items(),
++ include_dirs=["Modules/_multiprocessing"]))
++ else:
++ missing.append('_multiprocessing')
+ # End multiprocessing
+
+
============================================================
--- contrib/glib-2.22.4.diff 5b518e1f39473147d530e93ad4102a77afe0c48a
+++ contrib/glib-2.22.4.diff 5b518e1f39473147d530e93ad4102a77afe0c48a
@@ -0,0 +1,22 @@
+ * gio/gsocket.c: Fix build on Solaris 8 by providing needed macros
+ defined on Solaris 10.
+
+--- gio/gsocket.c.old 2010-01-07 01:19:12.000000000 +0100
++++ gio/gsocket.c 2010-01-29 13:07:02.275043000 +0100
+@@ -55,6 +55,16 @@
+
+ #include "gioalias.h"
+
++#if defined (sun) && !defined (CMSG_SPACE)
++/* Amount of space + padding needed for a message of length l */
++#define CMSG_SPACE(l) \
++ ((unsigned int)_CMSG_HDR_ALIGN(sizeof (struct cmsghdr) + (l)))
++
++/* Value to be used in cmsg_len, does not include trailing padding */
++#define CMSG_LEN(l) \
++ ((unsigned int)_CMSG_DATA_ALIGN(sizeof (struct cmsghdr)) + (l))
++#endif
++
+ /**
+ * SECTION:gsocket
+ * @short_description: Low-level socket object
============================================================
--- contrib/pango-1.26.1.diff 531522a0f5422e89c61a075aeb62362d29956e1a
+++ contrib/pango-1.26.1.diff 531522a0f5422e89c61a075aeb62362d29956e1a
@@ -0,0 +1,16 @@
+ * pango/opentype/hb-common.h: Fix compilation on solaris.
+
+--- pango/opentype/hb-common.h.old 2010-01-29 15:49:53.248615000 +0100
++++ pango/opentype/hb-common.h 2010-01-29 15:54:14.183661000 +0100
+@@ -27,7 +27,11 @@
+ #ifndef HB_COMMON_H
+ #define HB_COMMON_H
+
++#ifdef sun
++#include <sys/inttypes.h>
++#else
+ #include <stdint.h>
++#endif
+
+ # ifdef __cplusplus
+ # define HB_BEGIN_DECLS extern "C" {
============================================================
--- contrib/pixman-0.15.12.diff a74271be53b7a16e124793bae9b91d1edb706d83
+++ contrib/pixman-0.15.12.diff a74271be53b7a16e124793bae9b91d1edb706d83
@@ -0,0 +1,10 @@
+ * pixman/solaris-hwcap.mapfile: Fix build failure on Solaris 8 x86
+
+--- pixman/solaris-hwcap.mapfile.old 2010-01-29 14:22:24.918260000 +0100
++++ pixman/solaris-hwcap.mapfile 2010-01-29 14:22:46.065066000 +0100
+@@ -33,4 +33,4 @@
+ # library isn't flagged as only usable on CPU's with those ISA's, since it
+ # checks at runtime for availability before calling them
+
+-hwcap_1 = V0x0 FPU OVERRIDE;
++# hwcap_1 = V0x0 FPU OVERRIDE;
============================================================
--- contrib/pycairo-1.8.8-win32.diff cb330d3c36797ed8486587341c8c525aa0836195
+++ contrib/pycairo-1.8.8-win32.diff cb330d3c36797ed8486587341c8c525aa0836195
@@ -0,0 +1,94 @@
+--- configure.old 2009-12-22 16:56:30.813761900 +0100
++++ configure 2009-12-22 16:56:47.084666200 +0100
+@@ -12759,6 +12759,7 @@ if test "$ac_cs_awk_cr" = "a${ac_cr}b";
+ else
+ ac_cs_awk_cr=$ac_cr
+ fi
++ac_cs_awk_cr=$ac_cr
+
+ echo 'BEGIN {' >"$tmp/subs1.awk" &&
+ _ACEOF
+--- src/context.c.old 2009-08-26 12:59:35.000000000 +0200
++++ src/context.c 2009-12-22 17:31:30.306420100 +0100
+@@ -1430,7 +1430,7 @@ PyTypeObject PycairoContext_Type = {
+ pycairo_methods, /* tp_methods */
+ 0, /* tp_members */
+ 0, /* tp_getset */
+- &PyBaseObject_Type, /* tp_base */
++ 0, /* &PyBaseObject_Type, */ /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+--- src/font.c.old 2009-08-26 12:59:35.000000000 +0200
++++ src/font.c 2009-12-22 17:32:24.095564900 +0100
+@@ -131,7 +131,7 @@ PyTypeObject PycairoFontFace_Type = {
+ 0, /* tp_methods */
+ 0, /* tp_members */
+ 0, /* tp_getset */
+- &PyBaseObject_Type, /* tp_base */
++ 0, /* &PyBaseObject_Type, */ /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+@@ -410,7 +410,7 @@ PyTypeObject PycairoScaledFont_Type = {
+ scaled_font_methods, /* tp_methods */
+ 0, /* tp_members */
+ 0, /* tp_getset */
+- &PyBaseObject_Type, /* tp_base */
++ 0, /* &PyBaseObject_Type, */ /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+@@ -595,7 +595,7 @@ PyTypeObject PycairoFontOptions_Type = {
+ font_options_methods, /* tp_methods */
+ 0, /* tp_members */
+ 0, /* tp_getset */
+- &PyBaseObject_Type, /* tp_base */
++ 0, /* &PyBaseObject_Type */ /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+--- src/matrix.c.old 2009-08-26 12:59:35.000000000 +0200
++++ src/matrix.c 2009-12-22 17:33:39.038445300 +0100
+@@ -332,7 +332,7 @@ PyTypeObject PycairoMatrix_Type = {
+ matrix_methods, /* tp_methods */
+ 0, /* tp_members */
+ 0, /* tp_getset */
+- &PyBaseObject_Type, /* tp_base */
++ 0, /* &PyBaseObject_Type */ /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+--- src/path.c.old 2009-08-26 12:59:35.000000000 +0200
++++ src/path.c 2009-12-22 17:32:55.092963600 +0100
+@@ -206,7 +206,7 @@ PyTypeObject PycairoPath_Type = {
+ 0, /* tp_methods */
+ 0, /* tp_members */
+ 0, /* tp_getset */
+- &PyBaseObject_Type, /* tp_base */
++ 0, /* &PyBaseObject_Type */ /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+--- src/pattern.c.old 2009-08-26 12:59:35.000000000 +0200
++++ src/pattern.c 2009-12-22 17:33:17.588307800 +0100
+@@ -194,7 +194,7 @@ PyTypeObject PycairoPattern_Type = {
+ pattern_methods, /* tp_methods */
+ 0, /* tp_members */
+ 0, /* tp_getset */
+- &PyBaseObject_Type, /* tp_base */
++ 0, /* &PyBaseObject_Type */ /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+--- src/surface.c.old 2009-08-26 12:59:35.000000000 +0200
++++ src/surface.c 2009-12-22 17:33:59.006573300 +0100
+@@ -365,7 +365,7 @@ PyTypeObject PycairoSurface_Type = {
+ surface_methods, /* tp_methods */
+ 0, /* tp_members */
+ 0, /* tp_getset */
+- &PyBaseObject_Type, /* tp_base */
++ 0, /* &PyBaseObject_Type */ /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
============================================================
--- contrib/pycairo-1.8.8.diff aa888c92102d40b2fee8da9dcec7b8abd98d6892
+++ contrib/pycairo-1.8.8.diff aa888c92102d40b2fee8da9dcec7b8abd98d6892
@@ -0,0 +1,12 @@
+--- src/surface.c.old 2009-08-26 12:59:35.000000000 +0200
++++ src/surface.c 2009-12-21 16:52:06.000000000 +0100
+@@ -110,6 +110,9 @@ PycairoSurface_FromSurface (cairo_surfac
+ return o;
+ }
+
++#define PyGILState_Ensure() 0
++#define PyGILState_Release(x) do {} while (0)
++
+ /* for use with
+ * cairo_surface_write_to_png_stream()
+ * cairo_pdf/ps/svg_surface_create_for_stream()
============================================================
--- contrib/pygobject-2.20.0-win32.diff 929e5b2320cb68705fae6004796d650380147e4f
+++ contrib/pygobject-2.20.0-win32.diff 929e5b2320cb68705fae6004796d650380147e4f
@@ -0,0 +1,20 @@
+--- configure.old 2009-12-22 15:40:04.056759800 +0100
++++ configure 2009-12-22 15:41:40.387377300 +0100
+@@ -15509,6 +15509,7 @@ if test "$ac_cs_awk_cr" = "a${ac_cr}b";
+ else
+ ac_cs_awk_cr=$ac_cr
+ fi
++ac_cs_awk_cr=$ac_cr
+
+ echo 'BEGIN {' >"$tmp/subs1.awk" &&
+ _ACEOF
+--- glib/pygiochannel.c.old 2009-06-17 22:48:38.000000000 +0200
++++ glib/pygiochannel.c 2009-12-22 15:54:47.615223600 +0100
+@@ -10,6 +10,7 @@
+
+ #include "pyglib.h"
+ #include "pyglib-private.h"
++#include "pygsource.h"
+
+ typedef struct {
+ PyObject_HEAD
============================================================
--- contrib/pygtk-2.16.0-win32.diff 2ebe9801c6bd3aa5a748f0bb1e154d6020dd8335
+++ contrib/pygtk-2.16.0-win32.diff 2ebe9801c6bd3aa5a748f0bb1e154d6020dd8335
@@ -0,0 +1,10 @@
+--- configure.old 2009-08-23 19:10:26.000000000 +0200
++++ configure 2009-12-22 17:43:34.400661700 +0100
+@@ -16446,6 +16446,7 @@ if test "$ac_cs_awk_cr" = "a${ac_cr}b";
+ else
+ ac_cs_awk_cr=$ac_cr
+ fi
++ac_cs_awk_cr=$ac_cr
+
+ echo 'BEGIN {' >"$tmp/subs1.awk" &&
+ _ACEOF
============================================================
--- README 724a5d2bb49ece3ce71969a01f408ff659641fcf
+++ README 4c9cd863488faabfcfff7ac066d202705a65187a
@@ -22,12 +22,12 @@
This home page will always contain the latest news for this toolkit.
-This is GtkAda version 2.14.2. This package is an Ada graphical library
+This is GtkAda version 2.18.0. This package is an Ada graphical library
for the Gimp Toolkit, which means this is a set of packages to allow you
to easily create some graphical interfaces under X11 and Win32, using Ada
as the programming language.
-This library has been tested using Gtk+ 2.14.7 on the following systems:
+This library has been tested using Gtk+ 2.18.6 on the following systems:
- GNU Linux/x86
- GNU Linux/x86-64
@@ -36,6 +36,7 @@
- Solaris/x86
- Windows XP
- FreeBSD/x86
+ - Darwin/x86-64
Disclaimer
==========
============================================================
--- configure 2a0c47618af215c6a45a70469554924ae8e86fa0
+++ configure bcd142d75c0713ecb3dc2b0fecda10372b998e94
@@ -1233,8 +1233,8 @@ GTKADA_MAJOR_VERSION=2
# Current release settings
GTKADA_MAJOR_VERSION=2
-GTKADA_MINOR_VERSION=14
-GTKADA_MICRO_VERSION=2
+GTKADA_MINOR_VERSION=18
+GTKADA_MICRO_VERSION=0
GTKADA_VERSION=$GTKADA_MAJOR_VERSION.$GTKADA_MINOR_VERSION.$GTKADA_MICRO_VERSION
ac_aux_dir=
============================================================
--- configure.in 13e616415969b698f50b0d0f067b22fe42d890b9
+++ configure.in 4727c748e061d62fea20bf54b1a406ac51416b7c
@@ -1,10 +1,10 @@
-AC_REVISION($Revision: 149669 $)
+AC_REVISION($Revision: 156012 $)
AC_INIT(src/glib.ads)
# Current release settings
GTKADA_MAJOR_VERSION=2
-GTKADA_MINOR_VERSION=14
-GTKADA_MICRO_VERSION=2
+GTKADA_MINOR_VERSION=18
+GTKADA_MICRO_VERSION=0
GTKADA_VERSION=$GTKADA_MAJOR_VERSION.$GTKADA_MINOR_VERSION.$GTKADA_MICRO_VERSION
AC_CANONICAL_SYSTEM
============================================================
--- contrib/README 05d680d54aa07c5e1dfeb1643ff5d2fa0c010508
+++ contrib/README 53ec377f471be3e7d085c1a08bbed1d07044bf9a
@@ -5,23 +5,34 @@ binding.pl: perl script used to automate
binding.pl: perl script used to automate generation and update of GtkAda files.
-gtk+-2.16.5.diff: a patch against Gtk+ sources containing some
+gtk+-2.18.6.diff: a patch against Gtk+ sources containing some
improvements/fixes not incorporated yet.
-gtk+-2.16.5-win32.diff: ditto for Windows
+gtk+-2.18.6-win32.diff: ditto for Windows
-glib-2.20.4-win32.diff: ditto for glib under Windows
+glib-2.22.4.diff: ditto for glib
+glib-2.22.4-win32.diff: ditto for Windows
+
cairo-1.8.8.diff: ditto for cairo
cairo-1.8.8-win32.diff: ditto for cairo under Windows
+pixman-0.15.12.diff: ditto for pixman
+
pixman-0.15.12-win32.diff: ditto for pixman under Windows
+pango-1.26.1.diff: ditto for pango
+
pango-1.20.3-win32.diff: ditto for pango under Windows
+pango-1.26.1-win32.diff: ditto for pango under Windows
-pygobject-2.18.0.diff: patch to build pygobject with --disable-thread
+Python-2.6.4.diff: patch to build python with --without-threads
+pygobject-2.20.0.diff: patch to build pygobject with --disable-thread
+
+pycairo-1.8.8.diff: patch to build pycairo with --disable-thread
+
gtkada-2.10-win32.diff: a patch to build GtkAda under Windows
glade-2.0.0.diff: a patch to enable Ada support in Glade 2.0.0
============================================================
--- contrib/gtk+-2.16.5-win32.diff 21b23c4ce2fad447ffc22c11336e6d05752eea1e
+++ contrib/gtk+-2.18.6-win32.diff 71c27202453d053a418f855d9632ee0d05a9e11f
@@ -1,8 +1,21 @@
-2009-07-21 Arnaud Charlet <charlet@adacore.com>
+2010-02-01 Arnaud Charlet <charlet@adacore.com>
- * gdk/win32/gdkselection-win32.c (BITMAPV5HEADER): Provide missing
- definition.
+ * gdk/win32/gdkdrawable-win32.c (draw_segments): Ignore LineTo
+ errors.
+2009-09-29 Nicolas Setton <setton@adacore.com>
+
+ * gdk/win32/gdkevents-win32.c:
+ Protect against infinite loop in the events processing queue, in cases
+ where the translation of events cause the same events to be
+ regenerated. This protects against two cases of loops that have been
+ observed under Citrix.
+ (gdk_event_translate): Protect against reentry on move or size events
+ that are being re-posted by Gtk+, which happens when a Citrix window
+ receives move events but has never been mapped to a Gtk+ window.
+ (_gdk_event_queue): After having processed all the messages, reset the
+ reentry flags.
+
2009-07-20 Arnaud Charlet <charlet@adacore.com>
* configure: Work around ^M handling on cygwin with igncr
@@ -12,10 +25,6 @@ 2009-02-24 Arnaud Charlet <charlet@adaco
* gtk/gtkmain.c (gtk_grab_notify_foreach): Disable event crossing
handling, causing crashes.
-2008-12-02 Arnaud Charlet <charlet@adacore.com>
-
- * gdk/win32/gdkevents-win32.c (gdk_events_translate): Fix build failure.
-
2007-10-10 Arnaud Charlet <charlet@adacore.com>
* modules/engines/ms-windows/msw_style.c (draw_themed_tab_button):
@@ -29,21 +38,17 @@ 2002-11-25 Arnaud Charlet <charlet@adaco
2002-11-25 Arnaud Charlet <charlet@adacore.com>
- * gdk/Makefile.in: Remove gdk-win32res.o dependency,
- since we do not want to use the default Gtk+ icon.
-
-2002-09-12 Florent Duguet <duguet@adacore.com>
-
* gdk/win32/gdkevents-win32.c (handle_wm_paint): Force an update when
paint message is received, otherwise windows in background are not
immediately refreshed when moving a modal window on top of them.
- Add handling of WM_NCPAINT message to refresh some areas when a window
- from another application is moved on top of the current app.
---- gdk/win32/gdkevents-win32.c.old 2006-02-21 10:02:58.000000000 +0100
-+++ gdk/win32/gdkevents-win32.c 2006-02-21 10:08:22.000000000 +0100
-@@ -2125,6 +2125,12 @@ handle_wm_paint (MSG *msg,
- _gdk_window_process_expose (window, update_region);
+ * gdk/Makefile.in: Remove gdk-win32res.o dependency,
+ since we do not want to use the default Gtk+ icon.
+
+--- gdk/win32/gdkevents-win32.c.old 2009-12-22 12:37:10.468370000 +0100
++++ gdk/win32/gdkevents-win32.c 2010-01-06 17:04:42.923000000 +0100
+@@ -1692,6 +1692,12 @@ handle_wm_paint (MSG *msg,
+ _gdk_window_invalidate_for_expose (window, update_region);
gdk_region_destroy (update_region);
+ /* Force a process_updates to refresh visible windows
@@ -55,42 +60,19 @@ 2002-09-12 Florent Duguet <duguet@adacor
DeleteObject (hrgn);
}
-@@ -2964,6 +2970,35 @@ gdk_event_translate (MSG *msg,
- *ret_valp = 1;
- break;
+--- gdk/Makefile.in.orig 2009-12-08 16:19:08.000000000 +0100
++++ gdk/Makefile.in 2009-12-21 18:05:08.160000000 +0100
+@@ -662,8 +662,8 @@ libgdk_win32_2_0_la_SOURCES = $(common_s
+ libgdk_win32_2_0_la_LIBADD = win32/libgdk-win32.la $(GDK_DEP_LIBS) \
+ $(top_builddir)/gdk-pixbuf/libgdk_pixbuf-$(GTK_API_VERSION).la
-+ case WM_NCPAINT:
-+ if (msg->wParam < 1)
-+ break;
-+
-+ {
-+ HRGN hrgn;
-+
-+ hrgn = CreateRectRgn (0, 0, 0, 0);
-+ if (GetUpdateRgn (msg->hwnd, hrgn, FALSE) == ERROR)
-+ {
-+ WIN32_GDI_FAILED ("GetUpdateRgn");
-+ break;
-+ }
-+
-+ {
-+ GdkRegion *update_region = _gdk_win32_hrgn_to_region (hrgn);
-+
-+ _gdk_windowing_window_get_offsets (window, &xoffset, &yoffset);
-+ gdk_region_offset (update_region, xoffset, yoffset);
-+
-+ _gdk_window_process_expose (window, update_region);
-+ gdk_region_destroy (update_region);
-+
-+ DeleteObject (hrgn);
-+ return_val = FALSE;
-+ }
-+ }
-+ break;
-+
- case WM_PAINT:
- handle_wm_paint (msg, window, FALSE, NULL);
- break;
+-libgdk_win32_2_0_la_DEPENDENCIES = win32/libgdk-win32.la win32/rc/gdk-win32-res.o gdk.def
+-libgdk_win32_2_0_la_LDFLAGS = -Wl,win32/rc/gdk-win32-res.o -export-symbols $(srcdir)/gdk.def $(LDADD)
++libgdk_win32_2_0_la_DEPENDENCIES = win32/libgdk-win32.la gdk.def
++libgdk_win32_2_0_la_LDFLAGS = -export-symbols $(srcdir)/gdk.def $(LDADD)
+ @MS_LIB_AVAILABLE_TRUE@noinst_DATA = gdk-win32-$(GTK_API_VERSION).lib
+ @OS_LINUX_TRUE@TESTS = abicheck.sh pltcheck.sh
+ lib_LTLIBRARIES = $(gdktargetlib)
--- gdk/win32/gdkgc-win32.c.old 2005-07-18 17:20:28.000000000 +0200
+++ gdk/win32/gdkgc-win32.c 2006-06-05 14:56:59.515625000 +0200
@@ -1160,8 +1160,7 @@ _gdk_win32_gdkregion_to_hrgn (GdkRegion
@@ -103,19 +85,6 @@ 2002-09-12 Florent Duguet <duguet@adacor
g_free (rgndata);
---- gdk/Makefile.in.orig 2008-07-01 15:44:02.000000000 +0200
-+++ gdk/Makefile.in 2008-08-28 14:35:53.531250000 +0200
-@@ -498,8 +498,8 @@ libgdk_win32_2_0_la_SOURCES = $(common_s
- libgdk_win32_2_0_la_LIBADD = win32/libgdk-win32.la $(GDK_DEP_LIBS) \
- $(top_builddir)/gdk-pixbuf/libgdk_pixbuf-$(GTK_API_VERSION).la
-
--libgdk_win32_2_0_la_DEPENDENCIES = win32/libgdk-win32.la win32/rc/gdk-win32-res.o gdk.def
--libgdk_win32_2_0_la_LDFLAGS = -Wl,win32/rc/gdk-win32-res.o -export-symbols $(srcdir)/gdk.def $(LDADD)
-+libgdk_win32_2_0_la_DEPENDENCIES = win32/libgdk-win32.la gdk.def
-+libgdk_win32_2_0_la_LDFLAGS = -export-symbols $(srcdir)/gdk.def $(LDADD)
-
- @MS_LIB_AVAILABLE_TRUE@noinst_DATA = gdk-win32-$(GTK_API_VERSION).lib
-
--- modules/engines/ms-windows/msw_style.c.orig 2008-03-12 05:17:03.000000000 +0100
+++ modules/engines/ms-windows/msw_style.c 2008-04-17 18:35:13.515625000 +0200
@@ -2649,6 +2649,9 @@ draw_themed_tab_button (GtkStyle *style,
@@ -144,17 +113,6 @@ 2002-09-12 Florent Duguet <duguet@adacor
}
return TRUE;
---- gdk/win32/gdkevents-win32.c.old 2009-07-21 09:13:51.547000000 +0200
-+++ gdk/win32/gdkevents-win32.c 2009-07-21 09:14:45.886000000 +0200
-@@ -3083,7 +3083,7 @@ gdk_event_translate (MSG *msg,
- {
- GdkRegion *update_region = _gdk_win32_hrgn_to_region (hrgn);
-
-- _gdk_windowing_window_get_offsets (window, &xoffset, &yoffset);
-+ _gdk_win32_windowing_window_get_offsets (window, &xoffset, &yoffset);
- gdk_region_offset (update_region, xoffset, yoffset);
-
- _gdk_window_process_expose (window, update_region);
--- gtk/gtkmain.c.old 2009-02-24 10:44:02.598600000 +0100
+++ gtk/gtkmain.c 2009-02-24 10:45:04.218600000 +0100
@@ -1707,19 +1707,23 @@ gtk_grab_notify_foreach (GtkWidget *chil
@@ -191,39 +149,89 @@ 2002-09-12 Florent Duguet <duguet@adacor
echo 'BEGIN {' >"$tmp/subs1.awk" &&
_ACEOF
---- gdk/win32/gdkselection-win32.c.old 2009-07-21 08:52:02.719000000 +0200
-+++ gdk/win32/gdkselection-win32.c 2009-07-21 08:52:16.012000000 +0200
-@@ -34,6 +34,33 @@
- #include "gdkdisplay.h"
- #include "gdkprivate-win32.h"
+*** gdk/win32/gdkevents-win32.c.before_patch 2009-09-22 20:06:09.000000000 +0200
+--- gdk/win32/gdkevents-win32.c 2009-09-24 16:25:23.000000000 +0200
+*************** static UINT client_message;
+*** 133,138 ****
+--- 133,144 ----
+ static UINT got_gdk_events_message;
+ static HWND modal_win32_dialog = NULL;
+
++ /* The following variables are used to protect against re-entry in the
++ _gdk_event_queue main loop, which can happen under Citrix. */
++ static gint activate_events = 0;
++ static gint move_or_size_events = 0;
++ static gint reentry_threshold = 3;
++
+ #if 0
+ static HKL latin_locale = NULL;
+ #endif
+*************** gdk_event_translate (MSG *msg,
+*** 2324,2330 ****
+ */
+ GDK_NOTE (EVENTS, g_print (" (posted)"));
+
+! PostMessageW (msg->hwnd, msg->message, msg->wParam, msg->lParam);
+ }
+ else if (msg->message == WM_CREATE)
+ {
+--- 2330,2340 ----
+ */
+ GDK_NOTE (EVENTS, g_print (" (posted)"));
+
+! /* Do not post this message if we have posted it too many times
+! within the same event loop. */
+! move_or_size_events += 1;
+! if (move_or_size_events < reentry_threshold)
+! PostMessageW (msg->hwnd, msg->message, msg->wParam, msg->lParam);
+ }
+ else if (msg->message == WM_CREATE)
+ {
+*************** gdk_event_translate (MSG *msg,
+*** 3695,3701 ****
+ if (is_modally_blocked (window) && LOWORD (msg->wParam) == WA_ACTIVE)
+ {
+ GdkWindow *modal_current = _gdk_modal_current ();
+! SetActiveWindow (GDK_WINDOW_HWND (modal_current));
+ *ret_valp = 0;
+ return_val = TRUE;
+ break;
+--- 3705,3717 ----
+ if (is_modally_blocked (window) && LOWORD (msg->wParam) == WA_ACTIVE)
+ {
+ GdkWindow *modal_current = _gdk_modal_current ();
+!
+! /* Do not change the active window if we have done this too many
+! times within the same event loop. */
+! activate_events += 1;
+! if (activate_events < reentry_threshold)
+! SetActiveWindow (GDK_WINDOW_HWND (modal_current));
+!
+ *ret_valp = 0;
+ return_val = TRUE;
+ break;
+*************** _gdk_events_queue (GdkDisplay *display)
+*** 3775,3780 ****
+--- 3791,3801 ----
+ TranslateMessage (&msg);
+ DispatchMessageW (&msg);
+ }
++
++ /* we are leaving the events queue processing: reset flags that protect
++ against re-entry */
++ activate_events = 0;
++ move_or_size_events = 0;
+ }
+
+ static gboolean
+--- gdk/win32/gdkdrawable-win32.c.old 2010-01-31 18:48:07.679800000 +0100
++++ gdk/win32/gdkdrawable-win32.c 2010-01-31 18:48:32.429800000 +0100
+@@ -1246,7 +1246,7 @@ draw_segments (GdkGCWin32 *gcwin32,
-+typedef struct {
-+ DWORD bV5Size;
-+ LONG bV5Width;
-+ LONG bV5Height;
-+ WORD bV5Planes;
-+ WORD bV5BitCount;
-+ DWORD bV5Compression;
-+ DWORD bV5SizeImage;
-+ LONG bV5XPelsPerMeter;
-+ LONG bV5YPelsPerMeter;
-+ DWORD bV5ClrUsed;
-+ DWORD bV5ClrImportant;
-+ DWORD bV5RedMask;
-+ DWORD bV5GreenMask;
-+ DWORD bV5BlueMask;
-+ DWORD bV5AlphaMask;
-+ DWORD bV5CSType;
-+ CIEXYZTRIPLE bV5Endpoints;
-+ DWORD bV5GammaRed;
-+ DWORD bV5GammaGreen;
-+ DWORD bV5GammaBlue;
-+ DWORD bV5Intent;
-+ DWORD bV5ProfileData;
-+ DWORD bV5ProfileSize;
-+ DWORD bV5Reserved;
-+} BITMAPV5HEADER, *PBITMAPV5HEADER;
-+
- /* We emulate the GDK_SELECTION window properties of windows (as used
- * in the X11 backend) by using a hash table from window handles to
- * GdkSelProp structs.
+ GDK_NOTE (DRAW, g_print (" +%d+%d..+%d+%d", x1, y1, x2, y2));
+ GDI_CALL (MoveToEx, (hdc, x1, y1, NULL)) &&
+- GDI_CALL (LineTo, (hdc, x2, y2));
++ LineTo (hdc, x2, y2);
+ }
+
+ GDK_NOTE (DRAW, g_print ("\n"));
============================================================
--- contrib/gtk+-2.16.5.diff 6044693b5079a9f91191db8554e5f4c6caf9839c
+++ contrib/gtk+-2.18.6.diff ea500718c9516b477c38df9c52c20a18cd9cd1ee
@@ -1,8 +1,14 @@
+2010-01-11 Arnaud Charlet <charlet@adacore.com>
+
+ * gdk/gdkwindow.c (gdk_window_get_composite_drawable): Protect
+ against NULL access.
+ Observed when creating a new file in GPS under Windows.
+
2009-09-19 Arnaud Charlet <charlet@adacore.com>
* gtk/gtktreemodel.c (gtk_tree_model_row_has_child_toggled): Replace
g_return_if_fail by explicit check, since path may legitimately
- be NULL (I918-021).2009-09-19 Arnaud Charlet <charlet@adacore.com>
+ be NULL (I918-021).
2009-01-12 Nicolas Setton <setton@adacore.com>
@@ -109,3 +115,14 @@ 2003-11-27 Arnaud Charlet <charlet@ada
g_signal_emit (tree_model, tree_model_signals[ROW_HAS_CHILD_TOGGLED], 0, path, iter);
}
+--- gdk/gdkwindow.c.old 2009-12-08 16:13:05.000000000 +0100
++++ gdk/gdkwindow.c 2010-01-10 20:33:05.783000000 +0100
+@@ -3858,7 +3858,7 @@ gdk_window_get_composite_drawable (GdkDr
+ width, height);
+
+ /* paint the backing stores */
+- if (implicit_paint)
++ if (implicit_paint && list != NULL)
+ {
+ GdkWindowPaint *paint = list->data;
+
============================================================
--- contrib/pygobject-2.18.0.diff 80dccaf30dea2450b944cb363a19534bf8f85001
+++ contrib/pygobject-2.20.0.diff 397690d8c804d1a9cff28b4b823ba43ef5fd4881
@@ -22,47 +22,27 @@
#define pyg_begin_allow_threads \
G_STMT_START { \
---- glib/pyglib.c.old 2009-07-21 10:32:50.000000000 +0200
-+++ glib/pyglib.c 2009-07-21 11:29:23.000000000 +0200
-@@ -107,7 +107,11 @@ pyglib_gil_state_ensure(void)
- if (!_PyGLib_API->threads_enabled)
- return PyGILState_LOCKED;
+--- glib/pyglib.h.old 2009-06-17 22:48:38.000000000 +0200
++++ glib/pyglib.h 2010-01-28 11:03:09.000000000 +0100
+@@ -28,6 +28,9 @@
-+#ifdef DISABLE_THREADING
-+ return PyGILState_LOCKED;
-+#else
- return PyGILState_Ensure();
-+#endif
- }
+ G_BEGIN_DECLS
- void
-@@ -118,7 +122,9 @@ pyglib_gil_state_release(PyGILState_STAT
- if (!_PyGLib_API->threads_enabled)
- return;
++#define PyGILState_Ensure() 0
++#define PyGILState_Release(x) do {} while (0)
++
+ typedef void (*PyGLibThreadsEnabledFunc) (void);
+ typedef void (*PyGLibThreadBlockFunc) (void);
-+#ifndef DISABLE_THREADING
- PyGILState_Release(state);
-+#endif
- }
+--- gobject/pygobject.h.old 2010-01-29 08:28:30.000000000 +0100
++++ gobject/pygobject.h 2010-01-29 08:28:53.000000000 +0100
+@@ -9,6 +9,9 @@
- /**
-@@ -184,13 +190,19 @@ _pyglib_notify_on_enabling_threads(PyGLi
- int
- pyglib_gil_state_ensure_py23 (void)
- {
-+#ifdef DISABLE_THREADING
-+ return 0;
-+#else
- return PyGILState_Ensure();
-+#endif
- }
+ G_BEGIN_DECLS
- void
- pyglib_gil_state_release_py23 (int flag)
- {
-+#ifndef DISABLE_THREADING
- PyGILState_Release(flag);
-+#endif
- }
++#define PyGILState_Ensure() 0
++#define PyGILState_Release(x) do {} while (0)
++
+ /* This is deprecated, don't use */
+ #define PYGIL_API_IS_BUGGY FALSE
- /**
============================================================
--- docs/gtkada_rm/gtkada_rm.texi 8e0e0c0ccd504c9fdb6bcae434ef664258995681
+++ docs/gtkada_rm/gtkada_rm.texi e8dddf864ae317b2f4852384751e5ae6fa1923d0
@@ -15,9 +15,9 @@
@titlepage
@title GtkAda Reference Manual
-@subtitle Version 2.14.1
-@subtitle Document revision level $Revision: 134935 $
-@subtitle Date: $Date: 2008-12-17 10:27:57 +0100 (Wed, 17 Dec 2008) $
+@subtitle Version 2.18.0
+@subtitle Document revision level $Revision: 156012 $
+@subtitle Date: $Date: 2010-02-01 10:02:19 +0100 (Mon, 01 Feb 2010) $
@author E. Briot, J. Brobecker, A. Charlet
@page
============================================================
--- docs/gtkada_ug/gtkada_ug.texi 29badfd1efd59e5aef7abec3fe0df9f1d46f0c0c
+++ docs/gtkada_ug/gtkada_ug.texi a52b54ce2d9afd1d346dd53726381b17be6fe270
@@ -9,14 +9,14 @@
* GtkAda_Ug: (gtkada_ug). Ada95 graphical tookit based on GTK+ (User's Guide)
@end direntry
-@set GtkAdaVersion 2.14.1
+@set GtkAdaVersion 2.18.0
@titlepage
@title GtkAda User's Guide
@subtitle Version @value{GtkAdaVersion}
-@subtitle Document revision level $Revision: 143240 $
-@subtitle Date: $Date: 2009-04-23 17:11:24 +0200 (Thu, 23 Apr 2009) $
+@subtitle Document revision level $Revision: 156012 $
+@subtitle Date: $Date: 2010-02-01 10:02:19 +0100 (Mon, 01 Feb 2010) $
@author E. Briot, J. Brobecker, A. Charlet
@page
@@ -48,7 +48,7 @@ @top GtkAda User's Guide
Version @value{GtkAdaVersion}
-Date: $Date: 2009-04-23 17:11:24 +0200 (Thu, 23 Apr 2009) $
+Date: $Date: 2010-02-01 10:02:19 +0100 (Mon, 01 Feb 2010) $
Copyright @copyright{} 1998-2000, Emmanuel Briot, Joel Brobecker, Arnaud Charlet
@@ -158,7 +158,7 @@ @chapter Introduction: What is GtkAda ?
The scheme used for GtkAda's version numbers is the following: the major
and minor version number is the same as for the underlying gtk+ library
-(e.g 2.14).
+(e.g 2.18).
The micro version number depends on GtkAda's release number.
This toolkit was tested on the following systems:
@@ -173,7 +173,7 @@ @chapter Introduction: What is GtkAda ?
with the latest version of the @code{GNAT} compiler, developed and supported by
Ada Core Technologies (see @uref{http://www.adacore.com}).
-This version of GtkAda is known to be compatible with @code{gtk+} @b{2.14.x}.
+This version of GtkAda is known to be compatible with @code{gtk+} @b{2.18.x}.
This release may or may not be compatible with older versions of gtk+.
This version of GtkAda is compatible with @code{Glade} @b{version
============================================================
--- docs/texi2html 6effba94bba805f4768bda3bf8d55a839e6f1622
+++ docs/texi2html b627a27ecb751e7ea6e8960a73278e033f48337c
@@ -10,7 +10,7 @@
#-##############################################################################
# From @(#)texi2html 1.52 01/05/98 Written (mainly) by Lionel Cons, Lionel.Cons@cern.ch
-# $Id: texi2html 104281 2001-01-15 16:00:19Z briot $
+# $Id: texi2html 153648 2009-12-01 18:01:18Z obry $
# This version of texi2html is currently maintained at
# ftp://ftp.cs.umb.edu/pub/tex/texi2html by kb@cs.umb.edu.
============================================================
--- features 02b80725ca608d83b2376021cf85acf8489ab685
+++ features 6de6a7be5ccc597d5f2d8f989d9c795b17494dca
@@ -12,9 +12,10 @@ New features in GtkAda 2.14.1
New features in GtkAda 2.14.1
-----------------------------
-I714-005 Support for glade-3
+I714-005 Initial support for glade-3
Support for glade-3 file format is added to 'gate'.
+ However, we still recommend using glade-2 for the time being
I327-027 API Additions
============================================================
--- known-problems 4853b0dbd1c7c8d494f62660bf196e3931ea23b6
+++ known-problems 639c4cb05a99f80db79165e2204f26d1d5bfe561
@@ -7,6 +7,19 @@ Known problems fixed in GtkAda 2.14.1
Workaround: Move manually the calls to Object_Connect to the end of the
Initialize procedure.
+- I116-034 Building problem with File Chooser Dialog
+ Problem: When building with the project mechanim, the package for the
+ file chooser dialog is not found by the compiler.
+ Workaround: Add mention of gtkada-file_chooser_dialog.ad[sb] in
+ <prefix>/lib/gnat/gtkada/gtkada.lgpr
+
+- H123-001 Memory leak in Gdk.Color.Copy (when using Set_Property)
+ Problem: If you are using Set_Property to change the color properties of
+ various widgets (a Text_Tag for instance), this results in a
+ memory leak
+ Workaround: There is no real workaround. The best is to reduce the number of
+ calls to Set_Property
+
Known problems fixed in GtkAda 2.12.0
- H421-008 GtkAda static library support broken on Windows.
============================================================
--- src/gdk-screen.adb 715eb1de52a4400db42e965614cc23a9efa4efd9
+++ src/gdk-screen.adb 088bbec2add576b9c3ae511b0e2c45855dce76e1
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
--- Copyright (C) 2006-2007, AdaCore --
+-- Copyright (C) 2006-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -438,4 +438,15 @@ package body Gdk.Screen is
Internal (Get_Object (Display), Get_Object (Screen), X, Y);
end Warp_Pointer;
+ -------------------
+ -- Is_Composited --
+ -------------------
+
+ function Is_Composited (Screen : access Gdk_Screen_Record) return Boolean is
+ function Internal (Screen : System.Address) return Gint;
+ pragma Import (C, Internal, "gdk_screen_is_composited");
+ begin
+ return Internal (Get_Object (Screen)) /= 0;
+ end Is_Composited;
+
end Gdk.Screen;
============================================================
--- src/gdk-screen.ads 66b9377e1701f42de25a394c38d7d88460e6a0fb
+++ src/gdk-screen.ads a80f43c920b199db650c6d95ab103f3009b7bce9
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
--- Copyright (C) 2006-2007, AdaCore --
+-- Copyright (C) 2006-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -31,6 +31,7 @@
-- form a large screen area.
-- </description>
-- <c_version>2.8.17</c_version>
+-- <c_version>2.12</c_version> for some of the functions
-- <group>Gdk, the low-level API</group>
-- <see>Gdk_Display</see>
@@ -174,6 +175,15 @@ package Gdk.Screen is
(Screen : access Gdk_Screen_Record) return Glib.Gint;
-- Returns the number of monitors which screen consists of.
+ function Is_Composited (Screen : access Gdk_Screen_Record) return Boolean;
+ -- Returns whether windows with an RGBA visual can reasonably be expected
+ -- to have their alpha channel drawn correctly on the screen.
+ --
+ -- On X11 this function returns whether a compositing manager is
+ -- compositing Screen.
+ --
+ -- Since: 2.10
+
--------------
-- Monitors --
--------------
@@ -239,4 +249,3 @@ end Gdk.Screen;
-- Binding would be nice, requires a list of C_Proxy:
-- No binding: gdk_screen_get_toplevel_windows
-- No binding: gdk_screen_list_visuals
-
============================================================
--- src/gdk-window.adb 998afc966c1e4b084b4f4da975ab08765f7f61b3
+++ src/gdk-window.adb b3ba7725dbd28683e6d00cdbde0170aff3409dca
@@ -2,7 +2,7 @@
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
-- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet --
--- Copyright (C) 2000-2008, AdaCore --
+-- Copyright (C) 2000-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -485,4 +485,15 @@ package body Gdk.Window is
Internal (Window, Rectangle, Boolean'Pos (Invalidate_Children));
end Invalidate_Rect;
+ --------------------
+ -- Set_Composited --
+ --------------------
+
+ procedure Set_Composited (Window : Gdk_Window; Composited : Boolean) is
+ procedure Internal (Window : Gdk_Window; Composited : Gboolean);
+ pragma Import (C, Internal, "gdk_window_set_composited");
+ begin
+ Internal (Window, Gboolean (Boolean'Pos (Composited)));
+ end Set_Composited;
+
end Gdk.Window;
============================================================
--- src/gdk-window.ads 24aa31d11d420842fbac3a3bca79eeca7a0e0e15
+++ src/gdk-window.ads e431dddcfe8fcc0231608a73b8a1045b32d04aed
@@ -2,7 +2,7 @@
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
-- Copyright (C) 1998-2000, E. Briot, J. Brobecker and A. Charlet --
--- Copyright (C) 2000-2008, AdaCore --
+-- Copyright (C) 2000-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -41,6 +41,7 @@
-- might want to handle scrolling yourself). See the function
-- Gdk.Event.Get_Graphics_Expose for more information.
-- <c_version>1.3.6</c_version>
+-- <c_version>2.12</c_version> for some of the functions
-- <group>Gdk, the low-level API</group>
with System;
@@ -417,6 +418,41 @@ package Gdk.Window is
procedure Set_Transient_For
(Window : Gdk_Window; Leader : Gdk_Window);
+ procedure Set_Opacity (Window : Gdk_Window; Opacity : Gdouble);
+ -- Request the windowing system to make Window partially transparent, with
+ -- opacity 0.0 being fully transparent and 1.0 fully opaque (Values of the
+ -- opacity parameter are clamped to the [0,1] range).
+ --
+ -- On X11, this works only on X screens with a compositing manager running
+ -- (see Gdk.Screen.Is_Composited)
+ --
+ -- For setting up per-pixel alpha, see Gdk.Screen.Get_Rgba_Colormap
+ -- For making non-toplevel windows translucent, see Set_Composited
+ --
+ -- Since: gtk+ 2.12
+
+ procedure Set_Composited (Window : Gdk_Window; Composited : Boolean);
+ -- Sets Window as composited, or unsets it. Composited windows do not
+ -- automatically have their contents drawn to the screen. Drawing is
+ -- redirected to an offscreen buffer and an expose event is emitted on the
+ -- parent of the composited window. It is the responsibility of the
+ -- parent's expose handler to manually merge the off-screen content onto
+ -- the screen in whatever way it sees fit.
+ --
+ -- It only makes sense for child windows to be composited; see Set_Opacity
+ -- if you need translucent toplevel windows.
+ --
+ -- An additional effect of this call is that the area of this window is no
+ -- longer clipped from regions marked for invalidation on its parent. Draws
+ -- done on the parent window are also no longer clipped by the child.
+ --
+ -- This call is only supported on some systems (currently, only X11 with
+ -- new enough Xcomposite and Xdamage extensions). You must call
+ -- gdk_display_supports_composite() to check if setting a window as
+ -- composited is supported before attempting to do so.
+ --
+ -- Since: 2.12
+
procedure Set_Background
(Window : Gdk_Window; Color : Gdk.Color.Gdk_Color);
@@ -450,6 +486,9 @@ package Gdk.Window is
X : out Gint;
Y : out Gint;
Success : out Boolean);
+ -- Obtains the position of a window in root window coordinates. (Compare
+ -- with Get_Position and Get_Geometry which return the position of a window
+ -- relative to its parent window)
procedure Get_Desk_Relative_Origin
(Window : Gdk_Window;
@@ -461,6 +500,8 @@ package Gdk.Window is
(Window : Gdk_Window;
X : out Gint;
Y : out Gint);
+ -- Obtains the top-left corner of the window manager frame in root window
+ -- coordinates.
procedure Get_Frame_Extents
(Window : Gdk_Window;
@@ -657,6 +698,7 @@ private
pragma Import (C, Set_Cursor, "gdk_window_set_cursor");
pragma Import (C, Set_Icon, "gdk_window_set_icon");
pragma Import (C, Get_Window_Id, "ada_gdk_get_window_id");
+ pragma Import (C, Set_Opacity, "gdk_window_set_opacity");
pragma Convention (C, Gdk_Window_Type);
============================================================
--- src/glib-xml.adb 8efe9d36f4647971d8728c555172048e4fb69946
+++ src/glib-xml.adb a3b71d19372a508035d901507c01b729db9c868a
@@ -2,7 +2,7 @@
-- GtkAda - Ada95 binding for the Gimp Toolkit --
-- --
-- Copyright (C) 1999-2000 E. Briot, J. Brobecker and A. Charlet --
--- Copyright (C) 2000-2009, AdaCore --
+-- Copyright (C) 2000-2010, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -218,7 +218,7 @@ package body Glib.XML is
Index : in out Natural;
Word : out String_Ptr)
is
- Terminator : Character := ' ';
+ Terminator : Character;
begin
Skip_Blanks (Buf, Index);
@@ -312,9 +312,9 @@ package body Glib.XML is
-------------------
function Get_Attribute
- (N : in Node_Ptr;
- Attribute_Name : in UTF8_String;
- Default : in UTF8_String := "") return UTF8_String
+ (N : Node_Ptr;
+ Attribute_Name : UTF8_String;
+ Default : UTF8_String := "") return UTF8_String
is
Index : Natural;
Key, Value : String_Ptr;
@@ -1186,4 +1186,22 @@ package body Glib.XML is
return True;
end Is_Equal;
+ --------------------
+ -- Children_Count --
+ --------------------
+
+ function Children_Count (N : Node_Ptr) return Natural is
+ Tmp : Node_Ptr;
+ Count : Natural := 0;
+ begin
+ if N /= null then
+ Tmp := N.Child;
+ while Tmp /= null loop
+ Count := Count + 1;
+ Tmp := Tmp.Next;
+ end loop;
+ end if;
+ return Count;
+ end Children_Count;
+
end Glib.XML;
============================================================
--- src/glib-xml.ads cf9ea4ad1ebbbe94a8119c1b47b8f289071348d2
+++ src/glib-xml.ads 60df0e33e2da9df2f2fd10cb6a16b45e1c4525d0
@@ -115,6 +115,9 @@ package Glib.XML is
-- If Append is true, the child is added at the end of the current list of
-- children.
+ function Children_Count (N : Node_Ptr) return Natural;
+ -- Return the number of child nodes
+
function Deep_Copy (N : Node_Ptr) return Node_Ptr;
-- Return a deep copy of the tree starting with N. N can then be freed
-- without affecting the copy.
============================================================
--- src/gnome/gnome-about.adb f596de1a93129c6aabac266f5579e7439906a2fc
+++ src/gnome/gnome-about.adb 50642fcd1bcff02a3af64a5a5948d4d6937919df
@@ -1,8 +1,7 @@
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for the Gimp Toolkit --
-- --
--- Copyright (C) 2000-2002 --
--- ACT-Europe --
+-- Copyright (C) 2000-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -75,7 +74,7 @@ package body Gnome.About is
Authors : Chars_Ptr_Array;
Documenters : Chars_Ptr_Array;
Translator_Credits : String;
- Logo : Gdk_Pixbuf) return System.Address;
+ Logo : System.Address) return System.Address;
pragma Import (C, Internal, "gnome_about_new");
begin
@@ -89,7 +88,7 @@ package body Gnome.About is
Authors_Padded,
Documenters_Padded,
Translator_Credits & ASCII.NUL,
- Logo));
+ Get_Object (Logo)));
end Initialize;
end Gnome.About;
============================================================
--- src/gnome/gnome-druid_page_edge.adb 14e0995f44ac05fee851b74f22f9fcdb95c25998
+++ src/gnome/gnome-druid_page_edge.adb cf89a05e0aac5c87f6ed931a39504f28a611c923
@@ -1,8 +1,7 @@
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
--- Copyright (C) 2001-2006 --
--- AdaCore --
+-- Copyright (C) 2001-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -172,10 +171,10 @@ package body Gnome.Druid_Page_Edge is
is
procedure Internal
(Druid_Page_Edge : System.Address;
- Logo_Image : Gdk.Pixbuf.Gdk_Pixbuf);
+ Logo_Image : System.Address);
pragma Import (C, Internal, "gnome_druid_page_edge_set_logo");
begin
- Internal (Get_Object (Druid_Page_Edge), Logo_Image);
+ Internal (Get_Object (Druid_Page_Edge), Get_Object (Logo_Image));
end Set_Logo;
-------------------
@@ -188,10 +187,10 @@ package body Gnome.Druid_Page_Edge is
is
procedure Internal
(Druid_Page_Edge : System.Address;
- Watermark : Gdk.Pixbuf.Gdk_Pixbuf);
+ Watermark : System.Address);
pragma Import (C, Internal, "gnome_druid_page_edge_set_watermark");
begin
- Internal (Get_Object (Druid_Page_Edge), Watermark);
+ Internal (Get_Object (Druid_Page_Edge), Get_Object (Watermark));
end Set_Watermark;
-----------------------
@@ -204,10 +203,10 @@ package body Gnome.Druid_Page_Edge is
is
procedure Internal
(Druid_Page_Edge : System.Address;
- Top_Watermark : Gdk.Pixbuf.Gdk_Pixbuf);
+ Top_Watermark : System.Address);
pragma Import (C, Internal, "gnome_druid_page_edge_set_top_watermark");
begin
- Internal (Get_Object (Druid_Page_Edge), Top_Watermark);
+ Internal (Get_Object (Druid_Page_Edge), Get_Object (Top_Watermark));
end Set_Top_Watermark;
end Gnome.Druid_Page_Edge;
============================================================
--- src/gnome/gnome-druid_page_standard.adb eb0f29b370ee10965e33a1b1dc451f15348caba6
+++ src/gnome/gnome-druid_page_standard.adb a47fa9b2d004364b86f38d4a8e418d8e6c93b258
@@ -1,8 +1,7 @@
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
--- Copyright (C) 2001-2006 --
--- AdaCore --
+-- Copyright (C) 2001-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -77,10 +76,10 @@ package body Gnome.Druid_Page_Standard i
is
procedure Internal
(Druid_Page_Standard : System.Address;
- Logo : Gdk.Pixbuf.Gdk_Pixbuf);
+ Logo : System.Address);
pragma Import (C, Internal, "gnome_druid_page_standard_set_logo");
begin
- Internal (Get_Object (Druid_Page_Standard), Logo);
+ Internal (Get_Object (Druid_Page_Standard), Get_Object (Logo));
end Set_Logo;
-----------------------
@@ -93,11 +92,11 @@ package body Gnome.Druid_Page_Standard i
is
procedure Internal
(Druid_Page_Standard : System.Address;
- Logo : Gdk.Pixbuf.Gdk_Pixbuf);
+ Logo : System.Address);
pragma Import (C, Internal,
"gnome_druid_page_standard_set_top_watermark");
begin
- Internal (Get_Object (Druid_Page_Standard), Top_Watermark);
+ Internal (Get_Object (Druid_Page_Standard), Get_Object (Top_Watermark));
end Set_Top_Watermark;
--------------------------
============================================================
--- src/gtk-cell_renderer_text.ads 1b9c3b8ee7bc40cb100ddca26ecd5ec2dca0bad2
+++ src/gtk-cell_renderer_text.ads c27b4787cf9e81c5a12c188c647c6b498389d78c
@@ -33,6 +33,7 @@ with Glib.Properties;
with Pango.Enums;
with Glib.Properties;
+with Gdk.Color;
with Gtk;
with Gtk.Cell_Renderer;
@@ -215,7 +216,7 @@ package Gtk.Cell_Renderer_Text is
Font_Property : constant Glib.Properties.Property_String;
-- Font_Desc_Property : constant Glib.Properties.Property_Boxed;
Foreground_Property : constant Glib.Properties.Property_String;
- -- Foreground_Gdk_Property : constant Glib.Properties.Property_Boxed;
+ Foreground_Gdk_Property : constant Gdk.Color.Property_Gdk_Color;
Language_Property : constant Glib.Properties.Property_String;
Markup_Property : constant Glib.Properties.Property_String;
Rise_Property : constant Glib.Properties.Property_Int;
@@ -296,8 +297,8 @@ private
-- Glib.Properties.Build ("font-desc");
Foreground_Property : constant Glib.Properties.Property_String :=
Glib.Properties.Build ("foreground");
--- Foreground_Gdk_Property : constant Glib.Properties.Property_Boxed :=
--- Glib.Properties.Build ("foreground-gdk");
+ Foreground_Gdk_Property : constant Gdk.Color.Property_Gdk_Color :=
+ Gdk.Color.Build ("foreground_gdk");
Language_Property : constant Glib.Properties.Property_String :=
Glib.Properties.Build ("language");
Markup_Property : constant Glib.Properties.Property_String :=
============================================================
--- src/gtk-file_filter.ads 5f4cd7f24b7c2fd948c71dc38dae7f24702a0082
+++ src/gtk-file_filter.ads f71f3d83fd8cc9afdbdb69a8bf2290645f1fba88
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
--- Copyright (C) 2006, AdaCore --
+-- Copyright (C) 2006-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -96,6 +96,8 @@ package Gtk.File_Filter is
(Filter : access Gtk_File_Filter_Record;
Mime_Type : String);
-- Adds a rule allowing a given mime type to Filter.
+ -- In particular, if you want to show directories only and not files, you
+ -- could use "x-directory/normal" as the Mime type
procedure Add_Pattern
(Filter : access Gtk_File_Filter_Record;
============================================================
--- src/gtk-handlers.ads 65961b4c9579b6962e3748ad900e356891458c54
+++ src/gtk-handlers.ads 7e64c8d99f0b791d49bf184ee48faf77ce20b4f3
@@ -2,7 +2,7 @@
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
-- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet --
--- Copyright (C) 2000-2007 AdaCore --
+-- Copyright (C) 2000-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -170,6 +170,7 @@ with Gtk.Notebook;
pragma Elaborate_All (Gtk.Marshallers);
with Gtk.Notebook;
+with Gtk.Tree_Model;
with Gtk.Widget;
with Unchecked_Conversion;
@@ -914,6 +915,16 @@ package Gtk.Handlers is
(Gtk.Widget.Gtk_Widget_Record, Gtk.Widget.Gtk_Widget);
package Notebook_Page_Marshaller is new Marshallers.Generic_Marshaller
(Gtk.Notebook.Gtk_Notebook_Page, Gtk.Notebook.Get_Notebook_Page);
+ package Tree_Path_Marshaller is new Marshallers.Generic_Marshaller
+ (Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path);
+ package Tree_Iter_Tree_Path_Marshaller is
+ new Marshallers.Generic_Marshaller_2
+ (Gtk.Tree_Model.Gtk_Tree_Iter, Gtk.Tree_Model.Get_Tree_Iter,
+ Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path);
+ package Tree_Path_Tree_Iter_Marshaller is
+ new Marshallers.Generic_Marshaller_2
+ (Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path,
+ Gtk.Tree_Model.Gtk_Tree_Iter, Gtk.Tree_Model.Get_Tree_Iter);
function To_Marshaller
(Cb : Gint_Marshaller.Handler)
@@ -941,6 +952,21 @@ package Gtk.Handlers is
return Marshallers.Marshaller
renames Notebook_Page_Marshaller.To_Marshaller;
+ function To_Marshaller
+ (Cb : Tree_Path_Marshaller.Handler)
+ return Marshallers.Marshaller
+ renames Tree_Path_Marshaller.To_Marshaller;
+
+ function To_Marshaller
+ (Cb : Tree_Iter_Tree_Path_Marshaller.Handler)
+ return Marshallers.Marshaller
+ renames Tree_Iter_Tree_Path_Marshaller.To_Marshaller;
+
+ function To_Marshaller
+ (Cb : Tree_Path_Tree_Iter_Marshaller.Handler)
+ return Marshallers.Marshaller
+ renames Tree_Path_Tree_Iter_Marshaller.To_Marshaller;
+
-- Emitting a signal
procedure Emit_By_Name
@@ -975,6 +1001,20 @@ package Gtk.Handlers is
Param : Gtk.Notebook.Gtk_Notebook_Page)
renames Notebook_Page_Marshaller.Emit_By_Name;
+ procedure Emit_By_Name is
+ new Tree_Path_Marshaller.Emit_By_Name_Generic
+ (Gtk.Tree_Model.To_Address);
+
+ procedure Emit_By_Name is
+ new Tree_Iter_Tree_Path_Marshaller.Emit_By_Name_Generic
+ (Gtk.Tree_Model.To_Address,
+ Gtk.Tree_Model.To_Address);
+
+ procedure Emit_By_Name is
+ new Tree_Path_Tree_Iter_Marshaller.Emit_By_Name_Generic
+ (Gtk.Tree_Model.To_Address,
+ Gtk.Tree_Model.To_Address);
+
private
-- <doc_ignore>
type Acc is access all Widget_Type'Class;
@@ -1124,6 +1164,16 @@ package Gtk.Handlers is
(Gtk.Widget.Gtk_Widget_Record, Gtk.Widget.Gtk_Widget);
package Notebook_Page_Marshaller is new Marshallers.Generic_Marshaller
(Gtk.Notebook.Gtk_Notebook_Page, Gtk.Notebook.Get_Notebook_Page);
+ package Tree_Path_Marshaller is new Marshallers.Generic_Marshaller
+ (Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path);
+ package Tree_Iter_Tree_Path_Marshaller is
+ new Marshallers.Generic_Marshaller_2
+ (Gtk.Tree_Model.Gtk_Tree_Iter, Gtk.Tree_Model.Get_Tree_Iter,
+ Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path);
+ package Tree_Path_Tree_Iter_Marshaller is
+ new Marshallers.Generic_Marshaller_2
+ (Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path,
+ Gtk.Tree_Model.Gtk_Tree_Iter, Gtk.Tree_Model.Get_Tree_Iter);
function To_Marshaller
(Cb : Gint_Marshaller.Handler)
@@ -1151,6 +1201,21 @@ package Gtk.Handlers is
return Marshallers.Marshaller
renames Notebook_Page_Marshaller.To_Marshaller;
+ function To_Marshaller
+ (Cb : Tree_Path_Marshaller.Handler)
+ return Marshallers.Marshaller
+ renames Tree_Path_Marshaller.To_Marshaller;
+
+ function To_Marshaller
+ (Cb : Tree_Iter_Tree_Path_Marshaller.Handler)
+ return Marshallers.Marshaller
+ renames Tree_Iter_Tree_Path_Marshaller.To_Marshaller;
+
+ function To_Marshaller
+ (Cb : Tree_Path_Tree_Iter_Marshaller.Handler)
+ return Marshallers.Marshaller
+ renames Tree_Path_Tree_Iter_Marshaller.To_Marshaller;
+
-- Emitting a signal
procedure Emit_By_Name
@@ -1185,6 +1250,20 @@ package Gtk.Handlers is
Param : Gtk.Notebook.Gtk_Notebook_Page)
renames Notebook_Page_Marshaller.Emit_By_Name;
+ procedure Emit_By_Name is
+ new Tree_Path_Marshaller.Emit_By_Name_Generic
+ (Gtk.Tree_Model.To_Address);
+
+ procedure Emit_By_Name is
+ new Tree_Iter_Tree_Path_Marshaller.Emit_By_Name_Generic
+ (Gtk.Tree_Model.To_Address,
+ Gtk.Tree_Model.To_Address);
+
+ procedure Emit_By_Name is
+ new Tree_Path_Tree_Iter_Marshaller.Emit_By_Name_Generic
+ (Gtk.Tree_Model.To_Address,
+ Gtk.Tree_Model.To_Address);
+
private
-- <doc_ignore>
type Acc is access all Widget_Type'Class;
============================================================
--- src/gtk-marshallers.adb 785dc808408bf0de63b93d5f492bbd66d4991c8f
+++ src/gtk-marshallers.adb 1ccb7d71ead1150769a88dc5ab5ae96cce503d74
@@ -2,7 +2,7 @@
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
-- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet --
--- Copyright (C) 2000-2008, AdaCore --
+-- Copyright (C) 2000-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -591,6 +591,106 @@ package body Gtk.Marshallers is
end Generic_Marshaller;
+ --------------------------
+ -- Generic_Marshaller_2 --
+ --------------------------
+
+ package body Generic_Marshaller_2 is
+ function To_Handler is new
+ Ada.Unchecked_Conversion (General_Handler, Handler);
+ function To_General_Handler is new
+ Ada.Unchecked_Conversion (Handler, General_Handler);
+
+ ----------
+ -- Call --
+ ----------
+
+ procedure Call
+ (Widget : access Widget_Type'Class;
+ Params : Glib.Values.GValues;
+ Cb : General_Handler)
+ is
+ Func : constant Handler := To_Handler (Cb);
+ begin
+ Func
+ (Widget,
+ Conversion (Nth (Params, 1)),
+ Conversion (Nth (Params, 2)));
+ end Call;
+
+ -------------------
+ -- To_Marshaller --
+ -------------------
+
+ function To_Marshaller (Cb : Handler) return Marshaller is
+ begin
+ -- We must have at least one argument in the real callback.
+ -- pragma Assert (Count_Arguments (Get_Type (Obj), Name) >= 1);
+
+ return (Func => To_General_Handler (Cb), Proxy => Call_Access);
+ end To_Marshaller;
+
+ ------------------
+ -- Emit_By_Name --
+ ------------------
+
+ procedure Emit_By_Name
+ (Object : access Widget_Type'Class;
+ Name : Glib.Signal_Name;
+ Param_1 : Base_Type_1;
+ Param_2 : Base_Type_2)
+ is
+ procedure Internal
+ (Object : System.Address;
+ Name : Glib.Signal_Name;
+ Param_1 : System.Address;
+ Param_2 : System.Address);
+ pragma Import (C, Internal, "ada_g_signal_emit_by_name_ptr_ptr");
+
+ pragma Warnings (Off);
+ function To_Address is new
+ Ada.Unchecked_Conversion (Base_Type_1, System.Address);
+ function To_Address is new
+ Ada.Unchecked_Conversion (Base_Type_2, System.Address);
+ pragma Warnings (On);
+
+ begin
+ -- pragma Assert (Count_Arguments (Get_Type (Object), Name) = 1);
+ Internal
+ (Get_Object (Object),
+ Name & ASCII.NUL,
+ To_Address (Param_1),
+ To_Address (Param_2));
+ end Emit_By_Name;
+
+ --------------------------
+ -- Emit_By_Name_Generic --
+ --------------------------
+
+ procedure Emit_By_Name_Generic
+ (Object : access Widget_Type'Class;
+ Name : Glib.Signal_Name;
+ Param_1 : Base_Type_1;
+ Param_2 : Base_Type_2)
+ is
+ procedure Internal
+ (Object : System.Address;
+ Name : Glib.Signal_Name;
+ Param_1 : System.Address;
+ Param_2 : System.Address);
+ pragma Import (C, Internal, "ada_g_signal_emit_by_name_ptr_ptr");
+
+ begin
+ -- pragma Assert (Count_Arguments (Get_Type (Object), Name) = 1);
+ Internal
+ (Get_Object (Object),
+ Name & ASCII.NUL,
+ Conversion (Param_1),
+ Conversion (Param_2));
+ end Emit_By_Name_Generic;
+
+ end Generic_Marshaller_2;
+
-------------------------------
-- Generic_Widget_Marshaller --
-------------------------------
@@ -809,6 +909,109 @@ package body Gtk.Marshallers is
end Generic_Marshaller;
+ --------------------------
+ -- Generic_Marshaller_2 --
+ --------------------------
+
+ package body Generic_Marshaller_2 is
+
+ function To_Handler is new
+ Ada.Unchecked_Conversion (General_Handler, Handler);
+ function To_General_Handler is new
+ Ada.Unchecked_Conversion (Handler, General_Handler);
+
+ ----------
+ -- Call --
+ ----------
+
+ procedure Call
+ (Widget : access Widget_Type'Class;
+ Params : Glib.Values.GValues;
+ Cb : General_Handler;
+ User_Data : User_Type)
+ is
+ Func : constant Handler := To_Handler (Cb);
+ begin
+ Func
+ (Widget,
+ Conversion (Nth (Params, 1)),
+ Conversion (Nth (Params, 2)),
+ User_Data);
+ end Call;
+
+ -------------------
+ -- To_Marshaller --
+ -------------------
+
+ function To_Marshaller (Cb : Handler) return Marshaller is
+ begin
+ -- We must have at least one argument in the real callback.
+ -- pragma Assert (Count_Arguments (Get_Type (Obj), Name) >= 1);
+
+ return (Func => To_General_Handler (Cb), Proxy => Call_Access);
+ end To_Marshaller;
+
+ ------------------
+ -- Emit_By_Name --
+ ------------------
+
+ procedure Emit_By_Name
+ (Object : access Widget_Type'Class;
+ Name : Glib.Signal_Name;
+ Param_1 : Base_Type_1;
+ Param_2 : Base_Type_2)
+ is
+ procedure Internal
+ (Object : System.Address;
+ Name : Glib.Signal_Name;
+ Param_1 : System.Address;
+ Param_2 : System.Address);
+ pragma Import (C, Internal, "ada_g_signal_emit_by_name_ptr_ptr");
+
+ pragma Warnings (Off);
+ function To_Address is new
+ Ada.Unchecked_Conversion (Base_Type_1, System.Address);
+ function To_Address is new
+ Ada.Unchecked_Conversion (Base_Type_2, System.Address);
+ pragma Warnings (On);
+
+ begin
+ -- pragma Assert (Count_Arguments (Get_Type (Object), Name) = 1);
+ Internal
+ (Get_Object (Object),
+ Name & ASCII.NUL,
+ To_Address (Param_1),
+ To_Address (Param_2));
+ end Emit_By_Name;
+
+ --------------------------
+ -- Emit_By_Name_Generic --
+ --------------------------
+
+ procedure Emit_By_Name_Generic
+ (Object : access Widget_Type'Class;
+ Name : Glib.Signal_Name;
+ Param_1 : Base_Type_1;
+ Param_2 : Base_Type_2)
+ is
+ procedure Internal
+ (Object : System.Address;
+ Name : Glib.Signal_Name;
+ Param_1 : System.Address;
+ Param_2 : System.Address);
+ pragma Import (C, Internal, "ada_g_signal_emit_by_name_ptr_ptr");
+
+ begin
+ -- pragma Assert (Count_Arguments (Get_Type (Object), Name) = 1);
+ Internal
+ (Get_Object (Object),
+ Name & ASCII.NUL,
+ Conversion (Param_1),
+ Conversion (Param_2));
+ end Emit_By_Name_Generic;
+
+ end Generic_Marshaller_2;
+
-------------------------------
-- Generic_Widget_Marshaller --
-------------------------------
============================================================
--- src/gtk-marshallers.ads ee7d6e4458c3c51bdd8a8107d052572003b8e75e
+++ src/gtk-marshallers.ads 4063f1e8c77e23fac55bfc7cf85a8e58b9419cf9
@@ -2,7 +2,7 @@
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
-- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet --
--- Copyright (C) 2000-2007 AdaCore --
+-- Copyright (C) 2000-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -382,6 +382,51 @@ package Gtk.Marshallers is
Call_Access : constant Handler_Proxy := Call'Access;
end Generic_Marshaller;
+ generic
+ type Base_Type_1 is private;
+ with function Conversion
+ (Value : Glib.Values.GValue) return Base_Type_1;
+ type Base_Type_2 is private;
+ with function Conversion
+ (Value : Glib.Values.GValue) return Base_Type_2;
+
+ package Generic_Marshaller_2 is
+ type Handler is access procedure
+ (Widget : access Widget_Type'Class;
+ Param_1 : Base_Type_1;
+ Param_2 : Base_Type_2);
+
+ function To_Marshaller (Cb : Handler) return Marshaller;
+
+ procedure Emit_By_Name
+ (Object : access Widget_Type'Class;
+ Name : Glib.Signal_Name;
+ Param_1 : Base_Type_1;
+ Param_2 : Base_Type_2);
+ -- The function above should be used when BASE_TYPE can be passed
+ -- as is to C.
+
+ generic
+ with function Conversion
+ (Param : Base_Type_1) return System.Address;
+ with function Conversion
+ (Param : Base_Type_2) return System.Address;
+ procedure Emit_By_Name_Generic
+ (Object : access Widget_Type'Class;
+ Name : Glib.Signal_Name;
+ Param_1 : Base_Type_1;
+ Param_2 : Base_Type_2);
+ -- Provide an explicit conversion function for PARAM.
+
+ private
+ procedure Call
+ (Widget : access Widget_Type'Class;
+ Params : Glib.Values.GValues;
+ Cb : General_Handler);
+
+ Call_Access : constant Handler_Proxy := Call'Access;
+ end Generic_Marshaller_2;
+
-- Widget Marshaller
generic
type Base_Type is new Gtk.Widget.Gtk_Widget_Record with private;
@@ -486,6 +531,54 @@ package Gtk.Marshallers is
Call_Access : constant Handler_Proxy := Call'Access;
end Generic_Marshaller;
+ generic
+ type Base_Type_1 is private;
+ with function Conversion
+ (Value : Glib.Values.GValue) return Base_Type_1;
+ type Base_Type_2 is private;
+ with function Conversion
+ (Value : Glib.Values.GValue) return Base_Type_2;
+
+ package Generic_Marshaller_2 is
+
+ type Handler is access procedure
+ (Widget : access Widget_Type'Class;
+ Param_1 : Base_Type_1;
+ Param_2 : Base_Type_2;
+ User_Data : User_Type);
+
+ function To_Marshaller (Cb : Handler) return Marshaller;
+
+ procedure Emit_By_Name
+ (Object : access Widget_Type'Class;
+ Name : Glib.Signal_Name;
+ Param_1 : Base_Type_1;
+ Param_2 : Base_Type_2);
+ -- The function above should be used when BASE_TYPE can be passed
+ -- as is to C.
+
+ generic
+ with function Conversion
+ (Param : Base_Type_1) return System.Address;
+ with function Conversion
+ (Param : Base_Type_2) return System.Address;
+ procedure Emit_By_Name_Generic
+ (Object : access Widget_Type'Class;
+ Name : Glib.Signal_Name;
+ Param_1 : Base_Type_1;
+ Param_2 : Base_Type_2);
+ -- Provide an explicit conversion function for PARAM.
+
+ private
+ procedure Call
+ (Widget : access Widget_Type'Class;
+ Params : Glib.Values.GValues;
+ Cb : General_Handler;
+ User_Data : User_Type);
+
+ Call_Access : constant Handler_Proxy := Call'Access;
+ end Generic_Marshaller_2;
+
-- Widget Marshaller
generic
type Base_Type is new Gtk.Widget.Gtk_Widget_Record with private;
============================================================
--- src/gtk-tree_model.adb 49060392a3beb5541290a78155b299730e102df7
+++ src/gtk-tree_model.adb b00befcaa43c2b749c8ef4b3300c248da649cdae
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
--- Copyright (C) 2001-2008, AdaCore --
+-- Copyright (C) 2001-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -33,6 +33,30 @@ package body Gtk.Tree_Model is
(Get_Type'Access, Gtk_Tree_Model_Record);
pragma Warnings (Off, Type_Conversion);
+ ---------
+ -- "=" --
+ ---------
+
+ function "=" (Left : Gtk_Tree_Iter; Right : Gtk_Tree_Iter) return Boolean is
+ begin
+ if Left.Stamp = Right.Stamp then
+ if Left.Stamp = 0 then
+ -- Stamp = 0 means the iterator is null iterator, we need not to
+ -- compare other fields in this case.
+
+ return True;
+
+ else
+ return Left.User_Data = Right.User_Data
+ and then Left.User_Data2 = Right.User_Data2
+ and then Left.User_Data3 = Right.User_Data3;
+ end if;
+
+ else
+ return False;
+ end if;
+ end "=";
+
---------------
-- Get_Flags --
---------------
@@ -85,6 +109,19 @@ package body Gtk.Tree_Model is
end;
end To_String;
+ -------------------
+ -- Get_Tree_Path --
+ -------------------
+
+ function Get_Tree_Path (Val : Glib.Values.GValue) return Gtk_Tree_Path is
+
+ function To_Gtk_Tree_Path is
+ new Ada.Unchecked_Conversion (System.Address, Gtk_Tree_Path);
+
+ begin
+ return To_Gtk_Tree_Path (Glib.Values.Get_Address (Val));
+ end Get_Tree_Path;
+
-----------------
-- Get_Indices --
-----------------
@@ -219,6 +256,28 @@ package body Gtk.Tree_Model is
Internal (Glib.Values.Get_Address (Val), Iter);
end Get_Tree_Iter;
+ -------------------
+ -- Get_Tree_Iter --
+ -------------------
+
+ function Get_Tree_Iter (Val : Glib.Values.GValue) return Gtk_Tree_Iter is
+ Result : Gtk_Tree_Iter;
+
+ begin
+ Get_Tree_Iter (Val, Result);
+
+ return Result;
+ end Get_Tree_Iter;
+
+ ----------------
+ -- To_Address --
+ ----------------
+
+ function To_Address (Iter : Gtk_Tree_Iter) return System.Address is
+ begin
+ return Iter'Address;
+ end To_Address;
+
--------------
-- Get_Iter --
--------------
============================================================
--- src/gtk-tree_model.ads 6be724852557ad2c53bf3c6ba5566aabd2ef3b5f
+++ src/gtk-tree_model.ads 1cfe838cf33b32e23bcb30fd8ab88699df589b43
@@ -123,6 +123,9 @@ package Gtk.Tree_Model is
-- Generate a string representation of the path.
-- This string is a colon-separated list of numbers, as described above.
+ function Get_Tree_Path (Val : Glib.Values.GValue) return Gtk_Tree_Path;
+ -- Extract the path from the given GValue.
+
procedure Append_Index (Path : Gtk_Tree_Path; Index : Gint);
-- Append a new index to a path.
-- As a result, the depth of the path is increased. See Path_Up for the
@@ -228,6 +231,8 @@ package Gtk.Tree_Model is
Null_Iter : constant Gtk_Tree_Iter;
+ function "=" (Left : Gtk_Tree_Iter; Right : Gtk_Tree_Iter) return Boolean;
+
function Iter_Get_Type return Glib.GType;
-- Return the internal type used for iterators
@@ -250,6 +255,12 @@ package Gtk.Tree_Model is
-- by the give GValue. Modifying the iterator returned does not modify
-- the iterator referenced by the GValue.
+ function Get_Tree_Iter (Val : Glib.Values.GValue) return Gtk_Tree_Iter;
+ -- Extract the iterator from the given GValue.
+
+ function To_Address (Iter : Gtk_Tree_Iter) return System.Address;
+ -- Returns address of the specified iterator.
+
function Get_Iter
(Tree_Model : access Gtk_Tree_Model_Record;
Path : Gtk_Tree_Path) return Gtk_Tree_Iter;
============================================================
--- src/gtk-window.ads 7010751ab8497310da07fff65ed8649047094b29
+++ src/gtk-window.ads b030a152aae66e9e7c8bfe4905d773f47dbe4ea7
@@ -310,12 +310,6 @@ package Gtk.Window is
--
-- If Window is hidden, this function calls Gtk.Widget.Show as well.
--
- -- This function should be used when the user tries to open a window
- -- that's already open. Say for example the preferences dialog is
- -- currently open, and the user chooses Preferences from the menu
- -- a second time; use Present to move the already-open dialog
- -- where the user can see it.
- --
-- If you are calling this function in response to a user interaction, it
-- is preferable to use Present_With_Time.
@@ -325,6 +319,12 @@ package Gtk.Window is
-- Present a window to the user in response to a user interaction.
-- Timestamp is the timestamp of the user interaction (typically a button
-- or key press event) which triggered this call.
+ --
+ -- This function should be used when the user tries to open a window
+ -- that's already open. Say for example the preferences dialog is
+ -- currently open, and the user chooses Preferences from the menu
+ -- a second time; use Present to move the already-open dialog
+ -- where the user can see it.
procedure Stick (Window : access Gtk_Window_Record);
-- Ask to stick Window, which means that it will appear on all user
============================================================
--- src/gtkada-abstract_list_model.adb 94bb956a57455b26d089ae81dde6af0d5b18a858
+++ src/gtkada-abstract_list_model.adb 8c52039765088510292f166e5074f29a535bbb5e
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for the Gimp Toolkit --
-- --
--- Copyright (C) 2008, AdaCore --
+-- Copyright (C) 2008-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -20,7 +20,7 @@
-- --
-----------------------------------------------------------------------
-with Gtk.Tree_Model.Utils;
+with Gtk.Tree_Model; use Gtk.Tree_Model;
package body Gtkada.Abstract_List_Model is
@@ -34,7 +34,7 @@ package body Gtkada.Abstract_List_Model
return Gtk.Tree_Model.Gtk_Tree_Iter
is
begin
- if Gtk.Tree_Model.Utils.Is_Null (Parent) then
+ if Parent = Null_Iter then
declare
Path : constant Gtk.Tree_Model.Gtk_Tree_Path
:= Gtk.Tree_Model.Gtk_New_First;
@@ -76,10 +76,10 @@ package body Gtkada.Abstract_List_Model
Iter : Gtk.Tree_Model.Gtk_Tree_Iter) return Boolean
is
begin
- if Gtk.Tree_Model.Utils.Is_Null (Iter) then
- return not Gtk.Tree_Model.Utils.Is_Null
- (Gtk.Tree_Model.Children
- (Gtk.Tree_Model.Gtk_Tree_Model (Self), (Iter)));
+ if Iter = Null_Iter then
+ return
+ Gtk.Tree_Model.Children
+ (Gtk.Tree_Model.Gtk_Tree_Model (Self), (Iter)) /= Null_Iter;
else
return False;
============================================================
--- src/gtkada-abstract_tree_model.ads 8e8f3e0f5be9076e8016222cdfb8589f90e8e1f0
+++ src/gtkada-abstract_tree_model.ads ffb4ca2f599e1d62840c9e508c1c00e560ae49ed
@@ -33,6 +33,17 @@ package Gtkada.Abstract_Tree_Model is
procedure Initialize (Self : access Gtk_Abstract_Tree_Model_Record'Class);
+ ------------------------------
+ -- Interface implementation --
+ ------------------------------
+
+ -- The following subprograms can be overridden to implement the custom
+ -- tree model.
+ -- Note that they are called from C (wrapped through calls to the
+ -- Dispatch_* functions defined in the body of this package) so it is
+ -- advised to add exception handlers in these subprograms, just like in
+ -- regular GtkAda callbacks.
+
function Get_Flags
(Self : access Gtk_Abstract_Tree_Model_Record)
return Gtk.Tree_Model.Tree_Model_Flags;
============================================================
--- src/gtkada-mdi.adb 861ae4469ffa0dc44ad98784f675fde349de9307
+++ src/gtkada-mdi.adb 65bc823f08e8081b530882a5431941c4b03c0ea4
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
--- Copyright (C) 2001-2009, AdaCore --
+-- Copyright (C) 2001-2010, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -41,6 +41,7 @@ with GNAT.IO; use GNAT.I
with Interfaces.C.Strings; use Interfaces.C.Strings;
with GNAT.IO; use GNAT.IO;
+with GNAT.Strings; use GNAT.Strings;
with Glib.Convert; use Glib.Convert;
with Glib.Object; use Glib.Object;
@@ -58,10 +59,10 @@ with Gdk.Rectangle; use Gdk.Re
with Gdk.Main; use Gdk.Main;
with Gdk.Pixbuf; use Gdk.Pixbuf;
with Gdk.Rectangle; use Gdk.Rectangle;
+with Gdk.Screen; use Gdk.Screen;
with Gdk.Types; use Gdk.Types;
with Gdk.Types.Keysyms;
with Gdk.Window; use Gdk.Window;
-with Gdk.Window_Attr; use Gdk.Window_Attr;
with Gtk; use Gtk;
with Gtk.Accel_Group; use Gtk.Accel_Group;
@@ -87,6 +88,7 @@ with Gtk.Rc;
with Gtk.Object; use Gtk.Object;
with Gtk.Radio_Menu_Item; use Gtk.Radio_Menu_Item;
with Gtk.Rc;
+with Gtk.Stock; use Gtk.Stock;
with Gtk.Style; use Gtk.Style;
with Gtk.Widget; use Gtk.Widget;
with Gtk.Window; use Gtk.Window;
@@ -102,6 +104,8 @@ package body Gtkada.MDI is
Traces : constant Boolean := False;
-- True if traces should be activated
+ Traces_Indent : Natural := 0;
+
Default_Title_Bar_Focus_Color : constant String := "#000088";
-- Default color to use for the title bar of the child that has
-- the focus.
@@ -124,7 +128,9 @@ package body Gtkada.MDI is
-- notebook with multiple pages.
Max_Drag_Border_Width : constant Gint := 30;
- -- Width or height of the drag-and-drop borders for each notebook
+ -- Width or height of the drag-and-drop borders for each notebook. On the
+ -- sides of the MDI, half of it is dedicated to moving the window so that
+ -- it occupies that whole side of the MDI
Drag_Threshold : constant Gint := 20;
-- Our own threshold (instead of Gtk.Dnd.Check_Threshold), since on
@@ -143,7 +149,8 @@ package body Gtkada.MDI is
4 => New_String (String (Signal_Child_Added)),
5 => New_String (String (Signal_Child_Removed)),
6 => New_String (String (Signal_Child_Icon_Changed)),
- 7 => New_String (String (Signal_Children_Reorganized)));
+ 7 => New_String (String (Signal_Children_Reorganized)),
+ 8 => New_String (String (Signal_Perspective_Changed)));
Child_Signals : constant chars_ptr_array :=
(1 => New_String (String (Signal_Float_Child)),
@@ -178,15 +185,8 @@ package body Gtkada.MDI is
end record;
type Selection_Dialog_Access is access all Selection_Dialog_Record'Class;
- type MDI_Notebook_Record is new Gtk_Notebook_Record with record
- Is_Default_Notebook : Boolean := False;
- end record;
- type MDI_Notebook is access all MDI_Notebook_Record'Class;
+ type MDI_Notebook_Record is new Gtk_Notebook_Record with null record;
-- The type of notebooks used in the MDI.
- -- Is_Default_Notebook is set to true if the notebook should be used when
- -- Position_Default children are inserted in the MDI and no other child is
- -- available. Such a notebook is also kept empty when its last child is
- -- removed, provided no other Position_Default child exists.
package Child_User_Data is new Glib.Object.User_Data (MDI_Child);
@@ -232,6 +232,12 @@ package body Gtkada.MDI is
-- that fact at the MDI_Child level, no matter whether the child is
-- currently floating or not.
+ function Insert_Child_If_Needed
+ (MDI : access MDI_Window_Record'Class;
+ Child : MDI_Child) return MDI_Child;
+ -- If the child is currently invisible in the perspective, insert it back
+ -- in the MDI. In both case, return the child itself
+
procedure Internal_Close_Child
(Child : access Gtk.Widget.Gtk_Widget_Record'Class);
-- Internal version of Close, for a MDI_Child
@@ -248,9 +254,7 @@ package body Gtkada.MDI is
-- If there are no visible pages and Hide_If_Empty is true, then the
-- notebook itself is hidden
- procedure Update_Tab_Color
- (Child : access MDI_Child_Record'Class;
- Force : Boolean := False);
+ procedure Update_Tab_Color (Child : access MDI_Child_Record'Class);
-- Change the background color of the notebook tab containing child,
-- depending on whether the child is selected or not.
@@ -298,7 +302,11 @@ package body Gtkada.MDI is
-- Position_Bottom .. Position_Right: To one of the sides
-- Position_Automatic: In the center
- procedure Draw_Dnd_Rectangle (MDI : access MDI_Window_Record'Class);
+ type Dnd_Rectangle_Mode is (Show, Hide, Destroy);
+ procedure Draw_Dnd_Rectangle
+ (MDI : access MDI_Window_Record'Class;
+ Mode : Dnd_Rectangle_Mode;
+ Ref_Window : Gdk.Gdk_Window := null);
-- Draw the DND rectangle
procedure Update_Float_Menu (Child : access MDI_Child_Record'Class);
@@ -339,13 +347,6 @@ package body Gtkada.MDI is
procedure Focus_Cb (Child : access Gtk_Widget_Record'Class);
-- Callbacks for the menu
- function Has_Default_Child
- (MDI : access MDI_Window_Record'Class;
- Ignore : MDI_Child := null;
- Ignore_Note : Gtk_Notebook := null) return Boolean;
- -- Return True if the MDI still contains a child in the Default_Group,
- -- apart from Ignore and all children of Ignore_Note.
-
procedure Set_Focus_Child_MDI
(MDI : access Gtk_Widget_Record'Class; Args : Gtk_Args);
procedure Set_Focus_Child_Notebook
@@ -388,6 +389,10 @@ package body Gtkada.MDI is
return Children_Array;
-- Return the list of children of the MDI that match Str
+ procedure Reset_Title_Bars_And_Colors
+ (MDI : access MDI_Window_Record'Class);
+ -- Reset the color and title bar of the MDI Child
+
procedure Update_Selection_Dialog
(MDI : access MDI_Window_Record'Class; Increment : Integer);
-- Update the currently selected child in the selection dialog, so that it
@@ -412,7 +417,8 @@ package body Gtkada.MDI is
-- Update the menu entry for Child
function Find_Current_In_Central
- (MDI : access MDI_Window_Record'Class;
+ (Pane : access Gtkada_Multi_Paned_Record'Class;
+ MDI : access MDI_Window_Record'Class;
Group : Child_Group := Group_Any;
Initial_Position : Child_Position := Position_Automatic)
return Gtk_Notebook;
@@ -427,9 +433,12 @@ package body Gtkada.MDI is
-- Called when a child is removed from one of the notebooks
procedure Update_Dnd_Window
- (MDI : access MDI_Window_Record'Class; Text : String);
+ (MDI : access MDI_Window_Record'Class;
+ Text : String;
+ In_Central : Boolean);
-- Create and update the contents of the small window displayed while a
- -- drag-and-drop operation is taking place
+ -- drag-and-drop operation is taking place.
+ -- In_Central should be True if the window will be part of the central area
procedure Destroy_Dnd_Window (MDI : access MDI_Window_Record'Class);
-- Destroy the small window displayed while a drag-and-drop operation is
@@ -454,15 +463,65 @@ package body Gtkada.MDI is
procedure Set_Child_Title_Bar (Child : access MDI_Child_Record'Class);
-- Hide or display the title bar of the child, depending on its status.
- function Find_Empty_Notebook
- (MDI : access MDI_Window_Record'Class) return Gtk_Notebook;
- -- Return the empty notebook, if there is any, in the MDI.
-
procedure Note_Notify (Data : System.Address; Where : System.Address);
pragma Convention (C, Note_Notify);
-- Notified if the old notebook that contained Child is destroyed
+ procedure Print_Debug (Msg : String);
+ procedure Indent_Debug (Amount : Integer);
+ -- Debug support
+
+ function In_Central_Area
+ (MDI : access MDI_Window_Record'Class;
+ Child : access Gtk_Widget_Record'Class) return Boolean;
+ -- Whether Child is in the central area
+
+ procedure Move_To_Next_Notebook (Iterator : in out Child_Iterator);
+ -- Move to the next notebook for this iterator (does nothing if Iterator
+ -- already points to a notebook).
+
+ ---------------------
+ -- In_Central_Area --
+ ---------------------
+
+ function In_Central_Area
+ (MDI : access MDI_Window_Record'Class;
+ Child : access Gtk_Widget_Record'Class) return Boolean
+ is
+ P : Gtk_Widget := Get_Parent (Child);
+ begin
+ while P /= null and then P /= Gtk_Widget (MDI) loop
+ if P = Gtk_Widget (MDI.Central) then
+ return True;
+ end if;
+
+ P := Get_Parent (P);
+ end loop;
+
+ return False;
+ end In_Central_Area;
+
+ -----------------
+ -- Print_Debug --
+ -----------------
+
+ procedure Print_Debug (Msg : String) is
+ begin
+ if Traces then
+ Put_Line ((1 .. Traces_Indent => ' ') & "MDI: " & Msg);
+ end if;
+ end Print_Debug;
+
------------------
+ -- Indent_Debug --
+ ------------------
+
+ procedure Indent_Debug (Amount : Integer) is
+ begin
+ Traces_Indent := Traces_Indent + Amount;
+ end Indent_Debug;
+
+ ------------------
-- Get_Notebook --
------------------
@@ -471,6 +530,7 @@ package body Gtkada.MDI is
begin
case Child.State is
when Floating => return null;
+ when Invisible => return null;
when Normal =>
if Get_Parent (Child) /= null
and then Get_Parent (Child).all in Gtk_Notebook_Record'Class
@@ -502,9 +562,7 @@ package body Gtkada.MDI is
Widget := Get_Focus_Child (Gtk_Container (Widget));
if Widget /= null then
- if Traces then
- Put_Line ("MDI: Set_Focus_Child_MDI");
- end if;
+ Print_Debug ("Set_Focus_Child_MDI");
Set_Focus_Child (MDI_Window (MDI), Containing => Widget);
end if;
end if;
@@ -526,10 +584,8 @@ package body Gtkada.MDI is
begin
Child := MDI_Child (Get_Nth_Page (N, Gint (Page)));
if Child /= null then
- if Traces then
- Put_Line ("MDI: Set_Focus_Child_Switch_Notebook_Page "
+ Print_Debug ("Set_Focus_Child_Switch_Notebook_Page "
& Get_Title (Child));
- end if;
Set_Focus_Child (Child);
end if;
end Set_Focus_Child_Switch_Notebook_Page;
@@ -549,10 +605,8 @@ package body Gtkada.MDI is
-- inside an open editor in GPS, for instance, will not properly give
-- the focus to the MDI child
if Widget /= null then
- if Traces then
- Put_Line ("MDI: Set_Focus_Child_Notebook "
+ Print_Debug ("Set_Focus_Child_Notebook "
& Get_Title (MDI_Child (Widget)));
- end if;
Set_Focus_Child (MDI_Child (Widget));
end if;
end Set_Focus_Child_Notebook;
@@ -564,9 +618,7 @@ package body Gtkada.MDI is
function Set_Focus_Child_MDI_Floating
(Child : access Gtk_Widget_Record'Class) return Boolean is
begin
- if Traces then
- Put_Line ("MDI: Set_Focus_Child_MDI_Floating");
- end if;
+ Print_Debug ("Set_Focus_Child_MDI_Floating");
Set_Focus_Child (MDI_Child (Child));
return False;
end Set_Focus_Child_MDI_Floating;
@@ -621,9 +673,7 @@ package body Gtkada.MDI is
is
M : constant MDI_Window := MDI_Window (MDI);
begin
- if Traces then
- Put_Line ("MDI: Toplevel_Focus_In");
- end if;
+ Print_Debug ("Toplevel_Focus_In");
-- If the current child was a floating window, make sure it keeps the
-- focus, and that no one gains the keyboard focus in the main window.
@@ -687,7 +737,8 @@ package body Gtkada.MDI is
4 => (1 => GType_Pointer),
5 => (1 => GType_Pointer),
6 => (1 => GType_Pointer),
- 7 => (1 => GType_None));
+ 7 => (1 => GType_None),
+ 8 => (1 => GType_None));
begin
Gtkada.Multi_Paned.Initialize (MDI);
@@ -1088,19 +1139,19 @@ package body Gtkada.MDI is
Background_Color : Gdk.Color.Gdk_Color := Gdk.Color.Null_Color;
Title_Bar_Color : Gdk.Color.Gdk_Color := Gdk.Color.Null_Color;
Focus_Title_Color : Gdk.Color.Gdk_Color := Gdk.Color.Null_Color;
- Draw_Title_Bars : Boolean := True;
+ Draw_Title_Bars : Title_Bars_Policy := Always;
Tabs_Position : Gtk.Enums.Gtk_Position_Type :=
Gtk.Enums.Pos_Bottom;
Show_Tabs_Policy : Show_Tabs_Policy_Enum := Automatic)
is
Desc : Pango_Font_Description;
W, H : Gint;
- List : Widget_List.Glist;
C : MDI_Child;
Need_Redraw : Boolean := MDI.Draw_Title_Bars /= Draw_Title_Bars;
- Iter : Gtkada.Multi_Paned.Child_Iterator;
- Pos_Changed : constant Boolean :=
- MDI.Tabs_Position /= Tabs_Position;
+ Iter : Child_Iterator;
+ Old_Tabs_Pos : constant Gtk_Position_Type := MDI.Tabs_Position;
+ Pos_Changed : constant Boolean := Old_Tabs_Pos /= Tabs_Position;
+ Note : Gtk_Notebook;
begin
MDI.Close_Floating_Is_Unfloat := Close_Floating_Is_Unfloat;
@@ -1151,16 +1202,29 @@ package body Gtkada.MDI is
(MDI.Highlight_Style, State_Insensitive, MDI.Focus_Title_Color);
end if;
- Iter := Start (MDI);
- while not At_End (Iter) loop
- if Get_Widget (Iter) /= null then
- if Pos_Changed then
- Set_Tab_Pos
- (Gtk_Notebook (Get_Widget (Iter)), MDI.Tabs_Position);
- end if;
+ Iter := First_Child
+ (MDI, Group_By_Notebook => True, Visible_Only => True);
- Configure_Notebook_Tabs (MDI, Gtk_Notebook (Get_Widget (Iter)));
+ loop
+ C := Get (Iter);
+ exit when C = null;
+
+ if Get_Notebook (Iter) /= Note then
+ Note := Get_Notebook (Iter);
+
+ if Note /= null then
+ -- Unless we had a specific position for tabs in this notebook
+
+ if Pos_Changed
+ and then Get_Tab_Pos (Note) = Old_Tabs_Pos
+ then
+ Set_Tab_Pos (Note, MDI.Tabs_Position);
+ end if;
+
+ Configure_Notebook_Tabs (MDI, Note);
+ end if;
end if;
+
Next (Iter);
end loop;
@@ -1181,28 +1245,38 @@ package body Gtkada.MDI is
end if;
end if;
- -- Resize the title bar of all children already in the MDI
+ Reset_Title_Bars_And_Colors (MDI);
+ if Need_Redraw then
+ Queue_Draw (MDI);
+ end if;
+ end Configure;
+
+ ---------------------------------
+ -- Reset_Title_Bars_And_Colors --
+ ---------------------------------
+
+ procedure Reset_Title_Bars_And_Colors
+ (MDI : access MDI_Window_Record'Class)
+ is
+ List : Widget_List.Glist;
+ C : MDI_Child;
+ begin
List := First (MDI.Items);
while List /= Null_List loop
C := MDI_Child (Get_Data (List));
Set_Child_Title_Bar (C);
- Update_Tab_Color (C, Force => True);
+ Update_Tab_Color (C);
List := Widget_List.Next (List);
end loop;
+ end Reset_Title_Bars_And_Colors;
- if Need_Redraw then
- Queue_Draw (MDI);
- end if;
- end Configure;
-
-----------------
-- Realize_MDI --
-----------------
procedure Realize_MDI (MDI : access Gtk_Widget_Record'Class) is
M : constant MDI_Window := MDI_Window (MDI);
- Window_Attr : Gdk.Window_Attr.Gdk_Window_Attr;
begin
Gdk.Window.Set_Background (Get_Window (M), M.Background_Color);
@@ -1218,21 +1292,7 @@ package body Gtkada.MDI is
if M.Cursor_Cross = null then
Gdk_New (M.Cursor_Cross, Cross);
end if;
- Gdk_New (Window_Attr,
- Window_Type => Window_Child,
- Wclass => Input_Output,
- Cursor => M.Cursor_Cross,
- Visual => Get_Visual (MDI),
- Colormap => Get_Colormap (MDI),
- Event_Mask => Get_Events (MDI)
- or Exposure_Mask
- or Button_Press_Mask
- or Button_Release_Mask
- or Button_Motion_Mask);
- -- Destroy the window attribute and the cursor
-
- Destroy (Window_Attr);
Queue_Resize (MDI);
end Realize_MDI;
@@ -1244,7 +1304,9 @@ package body Gtkada.MDI is
M : constant MDI_Window := MDI_Window (MDI);
Tmp : Widget_List.Glist := First (M.Items);
N : Widget_List.Glist;
+ C : MDI_Child;
begin
+ Print_Debug ("Destroy_MDI");
-- Note: we only destroy the floating children. Other children will be
-- destroyed when their parent container is destroyed, so we have
-- nothing to do for them.
@@ -1252,16 +1314,28 @@ package body Gtkada.MDI is
while Tmp /= Null_List loop
-- Get the next field first, since Destroy will actually destroy Tmp
+ C := MDI_Child (Get_Data (Tmp));
+
N := Next (Tmp);
- if MDI_Child (Get_Data (Tmp)).State = Floating then
- Destroy (Get_Data (Tmp));
+ if C.State = Floating then
+ Print_Debug
+ ("Destroy_MDI => Destroying floating " & Get_Title (C));
+ Destroy (C);
+
+ elsif C.State = Invisible then
+ Print_Debug
+ ("Destroy_MDI => Unref invisible " & Get_Title (C));
+ C.State := Normal;
+ Unref (C);
else
+ Print_Debug
+ ("Destroy_MDI => Do nothing to " & Get_Title (C));
-- Pretend the child is not docked or floating. Otherwise,
-- Destroy_Child would try to undock the child. Standard gtk+
-- containers handle this by having this destroy callback called
-- last, but it isn't doable from GtkAda since it means modifying
-- the pointer-to-subprogram in the Class struct.
- MDI_Child (Get_Data (Tmp)).State := Normal;
+ C.State := Normal;
end if;
Tmp := N;
end loop;
@@ -1289,6 +1363,10 @@ package body Gtkada.MDI is
Destroy (M.Menu);
end if;
+ Free (M.Perspectives);
+ Free (M.View_Contents);
+ Free (M.Perspective_Names);
+
Free (M.Accel_Path_Prefix);
end Destroy_MDI;
@@ -1328,13 +1406,15 @@ package body Gtkada.MDI is
is
MDI : constant MDI_Window := MDI_Window (Child.MDI);
Event : Gdk_Event;
+ Prevent_Delete : Boolean;
begin
-- Don't do anything for now if the MDI isn't realized, since we
-- can't send create the event anyway.
- if Realized_Is_Set (MDI) then
- Allocate (Event, Delete, Get_Window (MDI));
+ Print_Debug ("Close_Child, " & Get_Title (Child) & " force="
+ & Boolean'Image (Force));
+ if Realized_Is_Set (MDI) then
-- For a top-level window, we must rebuild the initial widget
-- temporarily, so that the application can do all the test it wants.
-- However, we need to restore the initial state before calling
@@ -1344,9 +1424,23 @@ package body Gtkada.MDI is
if Force
or else In_Destruction_Is_Set (MDI)
- or else not Return_Callback.Emit_By_Name
- (Child.Initial, "delete_event", Event)
then
+ Prevent_Delete := False;
+ else
+ Print_Debug ("Close_Child, emitting delete_event");
+ Indent_Debug (1);
+
+ Allocate (Event, Delete, Get_Window (MDI));
+ Prevent_Delete := Return_Callback.Emit_By_Name
+ (Child.Initial, "delete_event", Event);
+ Free (Event);
+
+ Indent_Debug (-1);
+ Print_Debug ("Close_Child, done delete_event, prevent_delete ?"
+ & Boolean'Image (Prevent_Delete));
+ end if;
+
+ if not Prevent_Delete then
-- Transfer the focus before unfloating, so that the parent in
-- which the child is unfloated (which might be random from the
-- user's point of view) doesn't influence who gets the focus.
@@ -1356,17 +1450,9 @@ package body Gtkada.MDI is
Float_Child (Child, False);
- if Traces then
- Put_Line ("Close_Child: destroying " & Get_Title (Child));
- end if;
-
+ Print_Debug ("Close_Child: about to destroy " & Get_Title (Child));
Destroy (Child);
-
- elsif Traces then
- Put_Line ("Close_Child: not destroying " & Get_Title (Child));
end if;
-
- Free (Event);
end if;
exception
@@ -1377,7 +1463,11 @@ package body Gtkada.MDI is
pragma Debug
(Put_Line
("Unexpected exception: " & Exception_Information (E)));
- null;
+
+ if Traces then
+ Print_Debug ("Unexpected exception "
+ & Exception_Information (E));
+ end if;
end Close_Child;
-------------------
@@ -1395,9 +1485,7 @@ package body Gtkada.MDI is
pragma Assert (Get_Parent (Child) = null);
- if Traces then
- Put_Line ("Destroy_Child " & Get_Title (C));
- end if;
+ Print_Debug ("Destroy_Child " & Get_Title (C));
Ref (C);
@@ -1420,9 +1508,7 @@ package body Gtkada.MDI is
end if;
if Get_Parent (C.Initial) /= null then
- if Traces then
- Put_Line ("Destroy_Child removing initial child from parent");
- end if;
+ Print_Debug ("Destroy_Child removing initial child from parent");
Remove (Gtk_Container (Get_Parent (C.Initial)), C.Initial);
end if;
@@ -1448,7 +1534,8 @@ package body Gtkada.MDI is
-- Report that the child has been removed only after it has indeed be
-- fully removed, but before we actually free it
Emit_By_Name_Child
- (Get_Object (MDI), "child_removed" & ASCII.NUL, Get_Object (C));
+ (Get_Object (MDI),
+ String (Signal_Child_Removed) & ASCII.NUL, Get_Object (C));
-- If we are currently displaying the window selection dialog, update it
-- so that the widget that has been destroyed does not show up in the
@@ -1459,7 +1546,13 @@ package body Gtkada.MDI is
Free (C.Title);
Free (C.Short_Title);
+ Free (C.XML_Node_Name);
+ if C.State = Invisible then
+ -- We owned an extra reference in this case
+ Unref (C);
+ end if;
+
-- Destroy the child, unless the user has explicitely kept a Ref on it
-- (therefore, do not use Destroy, only Unref). In all cases, it should
-- be hidden on the screen
@@ -1483,14 +1576,16 @@ package body Gtkada.MDI is
procedure Set_Child_Title_Bar (Child : access MDI_Child_Record'Class) is
begin
- if not Child.MDI.Draw_Title_Bars then
+ if not Has_Title_Bar (Child) then
Hide (Child.Title_Box);
Set_Child_Visible (Child.Title_Box, False);
- Set_USize (Child.Title_Box, -1, Child.MDI.Title_Bar_Height);
+ Set_USize (Child.Title_Box, -1, 0);
+ Set_Size_Request (Child.Title_Box, -1, 0);
else
Show (Child.Title_Box);
Set_Child_Visible (Child.Title_Box, True);
+ Set_USize (Child.Title_Box, -1, Child.MDI.Title_Bar_Height);
end if;
end Set_Child_Title_Bar;
@@ -1589,8 +1684,16 @@ package body Gtkada.MDI is
-----------------------
procedure Update_Dnd_Window
- (MDI : access MDI_Window_Record'Class; Text : String)
+ (MDI : access MDI_Window_Record'Class;
+ Text : String;
+ In_Central : Boolean)
is
+ In_Perspective_Txt : aliased constant String := "hidden";
+ In_Central_Txt : aliased constant String := "preserved";
+
+ type Cst_String_Access is access constant String;
+ Loc : Cst_String_Access;
+
Frame : Gtk_Frame;
Box : Gtk_Box;
begin
@@ -1598,6 +1701,8 @@ package body Gtkada.MDI is
Gtk_New (MDI.Dnd_Window, Window_Popup);
Set_Transient_For (MDI.Dnd_Window, Gtk_Window (Get_Toplevel (MDI)));
Set_Position (MDI.Dnd_Window, Win_Pos_Center_On_Parent);
+ Modify_Bg (MDI.Dnd_Window, State_Normal, MDI.Focus_Title_Color);
+ Set_Keep_Above (MDI.Dnd_Window, True);
Gtk_New (Frame);
Add (MDI.Dnd_Window, Frame);
@@ -1606,12 +1711,25 @@ package body Gtkada.MDI is
Add (Frame, Box);
Set_Border_Width (Box, 10);
- Gtk_New (MDI.Dnd_Window_Label, Text);
+ Gtk_New (MDI.Dnd_Window_Label, "");
+ Set_Use_Markup (MDI.Dnd_Window_Label, True);
Pack_Start (Box, MDI.Dnd_Window_Label, Expand => True);
Show_All (MDI.Dnd_Window);
+ end if;
+
+ if In_Central then
+ Loc := In_Central_Txt'Access;
else
- Set_Text (MDI.Dnd_Window_Label, Text);
+ Loc := In_Perspective_Txt'Access;
end if;
+
+ Set_Label
+ (MDI.Dnd_Window_Label,
+ ASCII.HT & Text
+ & ASCII.LF
+ & "<i>Will be <b>" & Loc.all & "</b> when changing perspective"
+ & ASCII.LF & "Use <b>control</b> to move the whole notebook"
+ & ASCII.LF & "Use <b>shift</b> to create a new view for editors</i>");
end Update_Dnd_Window;
------------------------
@@ -1684,9 +1802,7 @@ package body Gtkada.MDI is
-- Start a drag-and-drop operation. This won't be effective unless
-- the user actually drags the mouse a while
- if Traces then
- Put_Line ("Button_Pressed_Forced");
- end if;
+ Print_Debug ("Button_Pressed_Forced");
Child_Drag_Begin (C, Event);
-- Let the event through, the drag hasn't started yet
@@ -1711,11 +1827,10 @@ package body Gtkada.MDI is
Current : Gtk_Widget;
Note : Gtk_Notebook;
Position : Child_Position;
+ Pane : Gtkada_Multi_Paned;
begin
- if Traces then
- Put_Line
- ("Button release, drag=" & Drag_Status'Image (C.MDI.In_Drag));
- end if;
+ Print_Debug
+ ("Button release, drag=" & Drag_Status'Image (C.MDI.In_Drag));
Pointer_Ungrab (Time => 0);
@@ -1730,10 +1845,22 @@ package body Gtkada.MDI is
Child_Drag_Finished (C);
when In_Drag =>
+ Set_Border_Width (C.MDI.Central, 0);
+
Destroy_Dnd_Window (C.MDI);
- Draw_Dnd_Rectangle (C.MDI);
+ Draw_Dnd_Rectangle (C.MDI, Mode => Destroy);
Get_Dnd_Target (C.MDI, Current, Position, C.MDI.Dnd_Rectangle);
+ if Current = null then -- outside of the main window ?
+ Pane := null;
+ elsif Current = Gtk_Widget (C.MDI) then
+ Pane := Gtkada_Multi_Paned (C.MDI);
+ elsif Get_Parent (Current) = Gtk_Widget (C.MDI.Central) then
+ Pane := C.MDI.Central;
+ else
+ Pane := Gtkada_Multi_Paned (C.MDI);
+ end if;
+
C2 := Dnd_Data (C, Copy => Copy_Instead_Of_Move);
if C2 = null then
C2 := C;
@@ -1743,124 +1870,161 @@ package body Gtkada.MDI is
-- Floating child ?
Float_Child (C2, True);
- else
- -- Dropped in one of the notebooks
- -- Do nothing if the child is already in the middle area,
- -- and in a notebook that contains only one child, and the
- -- user is dropping on the same notebook
+ -- If the child is dropped at the same location, nothing to do
- if C2.State /= Normal
- or else Current /= Get_Parent (C2)
- or else (Position in Side_Position
- and then not Move_Whole_Notebook
- and then Get_Nth_Page
- (Gtk_Notebook (Current), 1) /= null)
- then
- declare
- Item : Widget_List.Glist := MDI.Items;
- It : MDI_Child;
- begin
- -- Raise the page that last had it in the same pane
+ elsif C2.State = Normal -- A floating child is always moved
+ and then Current = Get_Parent (C2) -- same notebook ?
+ and then
+ (Position = Position_Automatic -- inside the nook
+ or else Move_Whole_Notebook -- to one side but moving all
+ or else Get_Nth_Page (Gtk_Notebook (Current), 1) = null)
+ then
+ null;
- if C /= C2 then
- if Traces then
- Put_Line ("MDI: Button_Release raising last1 "
- & Get_Title (C));
+ -- Do the actual moving
+
+ else
+ -- In the notebook that contains the window we are moving, we
+ -- now raise the last window that had the focus
+
+ declare
+ Item : Widget_List.Glist := MDI.Items;
+ It : MDI_Child;
+ begin
+ if C /= C2 then
+ Print_Debug ("Button_Release raising last1 "
+ & Get_Title (C));
+ Raise_Child (C, False);
+ else
+ while Item /= Widget_List.Null_List loop
+ It := MDI_Child (Get_Data (Item));
+ if It /= C2
+ and then Get_Parent (C2) = Get_Parent (It)
+ then
+ Print_Debug
+ ("Button_Release raising last2 "
+ & Get_Title (It));
+ Raise_Child (It, False);
+ exit;
end if;
- Raise_Child (C, False);
- else
- while Item /= Widget_List.Null_List loop
- It := MDI_Child (Get_Data (Item));
- if It /= C2
- and then Get_Parent (C2) = Get_Parent (It)
- then
- if Traces then
- Put_Line ("MDI: Button_Release raising last2 "
- & Get_Title (It));
- end if;
- Raise_Child (It, False);
- exit;
- end if;
- Item := Widget_List.Next (Item);
- end loop;
- end if;
- end;
+ Item := Widget_List.Next (Item);
+ end loop;
+ end if;
+ end;
+ -- Find in which notebook the widget should be moved.
+
+ if Current = Gtk_Widget (C.MDI.Central)
+ or else Current = Gtk_Widget (C.MDI)
+ then
+ -- The central area is empty if Current has this value, we
+ -- always create a new notebook
+ Note := Create_Notebook (MDI);
+
+ if Current = Gtk_Widget (C.MDI) then
+ Current := null;
+ end if;
+
+ else
+ -- We dropped in a notebook, should we reuse or create one ?
if Position = Position_Automatic then
Note := Gtk_Notebook (Current);
else
Note := Create_Notebook (MDI);
end if;
+ end if;
- if Move_Whole_Notebook then
- declare
- Children : Widget_List.Glist :=
- Get_Children (Get_Notebook (C2));
- L : Widget_List.Glist := Children;
- begin
- while L /= Null_List loop
- Put_In_Notebook
- (C.MDI, MDI_Child (Get_Data (L)), Note,
- Force_Parent_Destruction => False);
- L := Next (L);
- end loop;
- Free (Children);
- end;
- else
- Put_In_Notebook
- (C.MDI, C2, Note, Force_Parent_Destruction => False);
- end if;
+ -- Add to the contents of this notebook
- case Position is
- when Position_Bottom =>
+ if Move_Whole_Notebook then
+ declare
+ Children : Widget_List.Glist :=
+ Get_Children (Get_Notebook (C2));
+ L : Widget_List.Glist := Children;
+ begin
+ while L /= Null_List loop
+ Put_In_Notebook
+ (C.MDI, MDI_Child (Get_Data (L)), Note,
+ Force_Parent_Destruction => False);
+ L := Next (L);
+ end loop;
+ Free (Children);
+ end;
+ else
+ Put_In_Notebook
+ (C.MDI, C2, Note, Force_Parent_Destruction => False);
+ end if;
+
+ case Position is
+ when Position_Bottom =>
+ if Current = null then
Split
- (C.MDI,
- Current, Note, Orientation_Vertical,
- Width => 0,
- Height => 0,
- After => True);
- when Position_Top =>
+ (Pane,
+ Root_Pane, Note, Orientation_Vertical,
+ Height => -1);
+ else
+ Split (Pane, Current, Note, Orientation_Vertical);
+ end if;
+
+ when Position_Top =>
+ if Current = null then
Split
- (C.MDI,
+ (Pane,
+ Root_Pane, Note, Orientation_Vertical,
+ Height => -1, After => False);
+ else
+ Split
+ (Pane,
Current, Note, Orientation_Vertical,
- Width => 0,
- Height => 0,
After => False);
- when Position_Left =>
+ end if;
+ when Position_Left =>
+ if Current = null then
Split
- (C.MDI,
+ (Pane,
+ Root_Pane, Note, Orientation_Horizontal,
+ Width => -1, After => False);
+ else
+ Split
+ (Pane,
Current, Note, Orientation_Horizontal,
- Width => 0,
- Height => 0,
After => False);
- when Position_Right =>
+ end if;
+
+ when Position_Right =>
+ if Current = null then
Split
- (C.MDI,
- Current, Note, Orientation_Horizontal,
- Width => 0,
- Height => 0,
- After => True);
- when others =>
+ (Pane,
+ Root_Pane, Note, Orientation_Horizontal,
+ Width => -1);
+ else
+ Split (Pane, Current, Note, Orientation_Horizontal);
+ end if;
+
+ when Position_Automatic =>
+ if Current = Gtk_Widget (C.MDI.Central) then
+ Add_Child
+ (Win => C.MDI.Central,
+ New_Child => Note,
+ Orientation => Orientation_Horizontal,
+ Width => 0,
+ Height => 0);
+
+ else
Emit_By_Name
(Get_Object (MDI),
- "children_reorganized" & ASCII.NUL);
- end case;
- end if;
+ String (Signal_Children_Reorganized)
+ & ASCII.NUL);
+ end if;
+ end case;
end if;
Child_Drag_Finished (C);
- if Traces then
- Put_Line ("MDI: Button_Release raising "
- & Get_Title (C2));
- end if;
-
+ Print_Debug ("Button_Release raising " & Get_Title (C2));
Raise_Child (C2, False);
- if Traces then
- Put_Line ("MDI: Button_Release, set_focus "
- & Get_Title (C2));
- end if;
+ Print_Debug ("Button_Release, set_focus " & Get_Title (C2));
Set_Focus_Child (C2);
when No_Drag =>
@@ -1889,6 +2053,7 @@ package body Gtkada.MDI is
Position : Child_Position;
Delta_X, Delta_Y : Gint;
pragma Unreferenced (Tmp);
+ In_Central : Boolean;
begin
if Get_Window (Child) /= Get_Window (Event) then
@@ -1904,60 +2069,105 @@ package body Gtkada.MDI is
-- location
if Current = null then
- Update_Dnd_Window (C.MDI, "Float");
+ Update_Dnd_Window (C.MDI, "Float", True);
+ C.MDI.Dnd_Target := null;
elsif Current = Gtk_Widget (C.MDI) then
- Update_Dnd_Window (C.MDI, "Put in central area");
+ C.MDI.Dnd_Target := Get_Window (C.MDI);
+ case Position is
+ when Position_Bottom =>
+ Update_Dnd_Window
+ (C.MDI, "Below all other windows", False);
+ when Position_Top =>
+ Update_Dnd_Window
+ (C.MDI, "Above all other windows", False);
+ when Position_Left =>
+ Update_Dnd_Window
+ (C.MDI, "On the left of all other windows", False);
+ when Position_Right =>
+ Update_Dnd_Window
+ (C.MDI, "On the right of all other windows", False);
+ when others =>
+ -- Cannot occur
+ null;
+ end case;
+ elsif Current = Gtk_Widget (C.MDI.Central) then
+ C.MDI.Dnd_Target := Get_Window (C.MDI.Central);
+
+ case Position is
+ when Position_Bottom =>
+ Update_Dnd_Window
+ (C.MDI, "Put below central area", False);
+ when Position_Top =>
+ Update_Dnd_Window
+ (C.MDI, "Put above central area", False);
+ when Position_Left =>
+ Update_Dnd_Window
+ (C.MDI, "Put on the left of central area", False);
+ when Position_Right =>
+ Update_Dnd_Window
+ (C.MDI, "Put on the right of central area", False);
+ when others =>
+ Update_Dnd_Window (C.MDI, "Put in central area", True);
+ end case;
+
elsif Current = Get_Parent (C)
and then Position = Position_Automatic
then
- Update_Dnd_Window (C.MDI, "Leave at current position");
+ C.MDI.Dnd_Target := Get_Window (C);
+ Update_Dnd_Window
+ (C.MDI, "Leave at current position",
+ In_Central_Area (C.MDI, C));
else
Note := Gtk_Notebook (Current);
C3 := MDI_Child (Get_Nth_Page (Note, Get_Current_Page (Note)));
if C3 = null then
- Update_Dnd_Window (C.MDI, "Put in central area");
+ Update_Dnd_Window (C.MDI, "Put in central area", True);
+ C.MDI.Dnd_Target := Get_Window (C.MDI.Central);
else
+ C.MDI.Dnd_Target := Get_Window (C3);
+ In_Central := In_Central_Area (C.MDI, C3);
+
case Position is
when Position_Bottom =>
Update_Dnd_Window
- (C.MDI, "Put below " & Get_Short_Title (C3));
+ (C.MDI,
+ "Put below <b>" & Get_Short_Title (C3) & "</b>",
+ In_Central);
when Position_Top =>
Update_Dnd_Window
- (C.MDI, "Put above " & Get_Short_Title (C3));
+ (C.MDI,
+ "Put above <b>" & Get_Short_Title (C3) & "</b>",
+ In_Central);
when Position_Left =>
Update_Dnd_Window
(C.MDI,
- "Put on the left of " & Get_Short_Title (C3));
+ "Put on the left of <b>"
+ & Get_Short_Title (C3) & "</b>",
+ In_Central);
when Position_Right =>
Update_Dnd_Window
(C.MDI,
- "Put on the right of " & Get_Short_Title (C3));
+ "Put on the right of <b>"
+ & Get_Short_Title (C3) & "</b>", In_Central);
when others =>
Update_Dnd_Window
- (C.MDI, "Put on top of " & Get_Short_Title (C3));
+ (C.MDI, "Put on top of <b>"
+ & Get_Short_Title (C3) & "</b>", In_Central);
end case;
end if;
end if;
- -- Highlight the destination area itself. This doesn't work on
- -- windows which doesn't support drawing on top of child windows
- -- in the graphic context.
-
if Current = null then
- Draw_Dnd_Rectangle (C.MDI);
- C.MDI.Dnd_Rectangle_Owner := null;
- elsif Rect2 /= C.MDI.Dnd_Rectangle
- or else C.MDI.Dnd_Rectangle_Owner /= Get_Window (Current)
- then
- Draw_Dnd_Rectangle (C.MDI);
+ Draw_Dnd_Rectangle (C.MDI, Mode => Hide);
+ else
C.MDI.Dnd_Rectangle := Rect2;
- C.MDI.Dnd_Rectangle_Owner := Get_Window (Current);
- Draw_Dnd_Rectangle (C.MDI);
+ Draw_Dnd_Rectangle
+ (C.MDI, Mode => Show, Ref_Window => Get_Window (Current));
end if;
return True;
@@ -2005,8 +2215,9 @@ package body Gtkada.MDI is
return False;
end if;
+ Set_Border_Width (C.MDI.Central, 10);
+
C.MDI.In_Drag := In_Drag;
- C.MDI.Dnd_Rectangle_Owner := null;
Pointer_Ungrab (Time => 0);
if C.MDI.Cursor_Fleur = null then
@@ -2265,10 +2476,8 @@ package body Gtkada.MDI is
if It.State = Child.State
and then Get_Parent (It) = Get_Parent (Child)
then
- if Traces then
- Put_Line ("MDI: Give_Focus_To_Previous_Child "
+ Print_Debug ("Give_Focus_To_Previous_Child "
& Get_Title (It));
- end if;
Set_Focus_Child (It);
return;
end if;
@@ -2279,13 +2488,11 @@ package body Gtkada.MDI is
-- No such child, give it to the last child that had the focus
if Last = null then
- if Traces then
- Put_Line ("MDI: Give_Focus_To_Previous_Child: no one");
- end if;
+ Print_Debug ("Give_Focus_To_Previous_Child: no one");
Child.MDI.Focus_Child := null;
Emit_By_Name_Child
- (Get_Object (Child.MDI), "child_selected" & ASCII.NUL,
- System.Null_Address);
+ (Get_Object (Child.MDI),
+ String (Signal_Child_Selected) & ASCII.NUL, System.Null_Address);
else
Set_Focus_Child (Last);
end if;
@@ -2307,9 +2514,14 @@ package body Gtkada.MDI is
-- We need to show the widget before inserting it in a notebook,
-- otherwise the notebook page will not be made visible.
+ Ref (Child);
+
Show_All (Child);
- Set_Child_Title_Bar (Child);
+ if Child.State = Invisible then
+ Unref (Child); -- Set in Remove_All_Items
+ end if;
+
Child.State := Normal;
Float_Child (Child, MDI.All_Floating_Mode);
@@ -2317,8 +2529,16 @@ package body Gtkada.MDI is
Put_In_Notebook (MDI, Child, Initial_Position => Initial_Position);
end if;
- Widget_List.Prepend (MDI.Items, Gtk_Widget (Child));
+ Set_Child_Title_Bar (Child);
+ -- Add the child to the list of widgets. It could in fact already be in
+ -- the list if we are reusing a Invisible child from a previous
+ -- perspective. We however want to move it to the front of the list
+
+ Remove (MDI.Items, Gtk_Widget (Child));
+ Prepend (MDI.Items, Gtk_Widget (Child));
+ Unref (Child);
+
if MDI.Menu /= null then
Create_Menu_Entry (Child);
end if;
@@ -2329,7 +2549,8 @@ package body Gtkada.MDI is
Give_Focus_To_Child (MDI.Focus_Child);
Emit_By_Name_Child
- (Get_Object (MDI), "child_added" & ASCII.NUL, Get_Object (Child));
+ (Get_Object (MDI),
+ String (Signal_Child_Added) & ASCII.NUL, Get_Object (Child));
end Put;
--------------
@@ -2389,7 +2610,7 @@ package body Gtkada.MDI is
end Get_Short_Title;
----------------------
- -- Create_Menu_Item --
+ -- Update_Menu_Item --
----------------------
procedure Update_Menu_Item (Child : access MDI_Child_Record'Class) is
@@ -2453,7 +2674,8 @@ package body Gtkada.MDI is
Update_Tab_Label (Child);
Emit_By_Name_Child
- (Get_Object (Child.MDI), "child_icon_changed" & ASCII.NUL,
+ (Get_Object (Child.MDI),
+ String (Signal_Child_Icon_Changed) & ASCII.NUL,
Get_Object (Child));
end Set_Icon;
@@ -2523,12 +2745,27 @@ package body Gtkada.MDI is
end if;
if Child.MDI /= null then
Emit_By_Name_Child
- (Get_Object (Child.MDI), "child_title_changed" & ASCII.NUL,
+ (Get_Object (Child.MDI),
+ String (Signal_Child_Title_Changed) & ASCII.NUL,
Get_Object (Child));
end if;
end if;
end Set_Title;
+ ----------------------------
+ -- Insert_Child_If_Needed --
+ ----------------------------
+
+ function Insert_Child_If_Needed
+ (MDI : access MDI_Window_Record'Class;
+ Child : MDI_Child) return MDI_Child is
+ begin
+ if Child /= null and then Child.State = Invisible then
+ Put (MDI, Child);
+ end if;
+ return Child;
+ end Insert_Child_If_Needed;
+
--------------------
-- Find_MDI_Child --
--------------------
@@ -2543,7 +2780,7 @@ package body Gtkada.MDI is
while Tmp /= Null_List loop
if MDI_Child (Get_Data (Tmp)).Initial = Gtk_Widget (Widget) then
- return MDI_Child (Get_Data (Tmp));
+ return Insert_Child_If_Needed (MDI, MDI_Child (Get_Data (Tmp)));
end if;
Tmp := Next (Tmp);
@@ -2561,6 +2798,7 @@ package body Gtkada.MDI is
is
W : Gtk_Widget := Gtk_Widget (Widget);
Win : Gtk_Window;
+ C : MDI_Child;
begin
-- As a special case, if the widget's parent is a notebook, we check
-- whether the associated page is a MDI child, and behave as if that
@@ -2568,16 +2806,17 @@ package body Gtkada.MDI is
while W /= null loop
if W.all in MDI_Child_Record'Class then
- return MDI_Child (W);
+ return Insert_Child_If_Needed (MDI_Child (W).MDI, MDI_Child (W));
elsif W.all in Gtk_Notebook_Record'Class
and then Get_Nth_Page
(Gtk_Notebook (W), Get_Current_Page (Gtk_Notebook (W))).all
in MDI_Child_Record'Class
then
- return MDI_Child
+ C := MDI_Child
(Get_Nth_Page
(Gtk_Notebook (W), Get_Current_Page (Gtk_Notebook (W))));
+ return Insert_Child_If_Needed (C.MDI, C);
end if;
W := Get_Parent (W);
@@ -2589,7 +2828,8 @@ package body Gtkada.MDI is
Win := Gtk_Window (Get_Toplevel (Widget));
if Win /= null then
begin
- return Child_User_Data.Get (Win, "parent_mdi_child");
+ C := Child_User_Data.Get (Win, "parent_mdi_child");
+ return Insert_Child_If_Needed (C.MDI, C);
exception
when Gtkada.Types.Data_Error =>
return null;
@@ -2605,10 +2845,12 @@ package body Gtkada.MDI is
function Find_MDI_Child_By_Tag
(MDI : access MDI_Window_Record;
- Tag : Ada.Tags.Tag) return MDI_Child
+ Tag : Ada.Tags.Tag;
+ Visible_Only : Boolean := False) return MDI_Child
is
Child : MDI_Child;
- Iter : Child_Iterator := First_Child (MDI);
+ Iter : Child_Iterator :=
+ First_Child (MDI, Visible_Only => Visible_Only);
begin
loop
Child := Get (Iter);
@@ -2616,7 +2858,11 @@ package body Gtkada.MDI is
Next (Iter);
end loop;
- return Get (Iter);
+ if Child /= null then
+ return Insert_Child_If_Needed (MDI, Child);
+ else
+ return null;
+ end if;
end Find_MDI_Child_By_Tag;
----------------------------
@@ -2628,7 +2874,7 @@ package body Gtkada.MDI is
Name : String) return MDI_Child
is
Child : MDI_Child;
- Iter : Child_Iterator := First_Child (MDI);
+ Iter : Child_Iterator := First_Child (MDI, Visible_Only => False);
begin
loop
Child := Get (Iter);
@@ -2638,7 +2884,7 @@ package body Gtkada.MDI is
Next (Iter);
end loop;
- return Get (Iter);
+ return Insert_Child_If_Needed (MDI, Get (Iter));
end Find_MDI_Child_By_Name;
-----------------
@@ -2677,6 +2923,8 @@ package body Gtkada.MDI is
case Child.State is
when Floating =>
return True;
+ when Invisible =>
+ return False;
when Normal =>
Note := Get_Notebook (Child);
return Get_Nth_Page (Note, Get_Current_Page (Note)) =
@@ -2747,10 +2995,8 @@ package body Gtkada.MDI is
-- not properly refresh the outline view
Give_Focus_To_Child (Old_Focus);
else
- if Traces then
- Put_Line ("MDI: Raise_Child, give focus to "
+ Print_Debug ("Raise_Child, give focus to "
& Get_Title (Child));
- end if;
Set_Focus_Child (Child);
end if;
end if;
@@ -2771,14 +3017,24 @@ package body Gtkada.MDI is
end if;
end Update_Float_Menu;
+ -------------------
+ -- Has_Title_Bar --
+ -------------------
+
+ function Has_Title_Bar (Child : access MDI_Child_Record) return Boolean is
+ begin
+ case Child.MDI.Draw_Title_Bars is
+ when Always => return True;
+ when Never => return False;
+ when Central_Only => return In_Central_Area (Child.MDI, Child);
+ end case;
+ end Has_Title_Bar;
+
----------------------
-- Update_Tab_Color --
----------------------
- procedure Update_Tab_Color
- (Child : access MDI_Child_Record'Class;
- Force : Boolean := False)
- is
+ procedure Update_Tab_Color (Child : access MDI_Child_Record'Class) is
Color : Gdk_Color := Get_Bg (Get_Default_Style, State_Normal);
Note : constant Gtk_Notebook := Get_Notebook (Child);
Label : Gtk_Widget;
@@ -2798,13 +3054,11 @@ package body Gtkada.MDI is
end Color_Equal;
begin
- if not Force and then MDI_Child (Child) = Child.MDI.Focus_Child then
- Color := Child.MDI.Focus_Title_Color;
- end if;
+ if Note /= null then
+ if MDI_Child (Child) = Child.MDI.Focus_Child then
+ Color := Child.MDI.Focus_Title_Color;
+ end if;
- if (Force or else not Child.MDI.Draw_Title_Bars)
- and then Note /= null
- then
-- If the color is already being applied to this notebook, avoid
-- the call to Modify_BG, which is quite costly since it causes
-- a queue_resize on the notebook.
@@ -2857,9 +3111,7 @@ package body Gtkada.MDI is
Show (C); -- Make sure the child is visible
Child.MDI.Focus_Child := C;
- if Traces then
- Put_Line ("MDI: Set_Focus_Child on " & Get_Title (C));
- end if;
+ Print_Debug ("Set_Focus_Child on " & Get_Title (C));
if Previous_Focus_Child /= null then
Update_Tab_Color (Previous_Focus_Child);
@@ -2877,9 +3129,7 @@ package body Gtkada.MDI is
-- manager.
if C.State /= Floating then
- if Traces then
- Put_Line ("MDI: Set_Focus_Child, raise child " & Get_Title (C));
- end if;
+ Print_Debug ("Set_Focus_Child, raise child " & Get_Title (C));
Raise_Child (C, False);
end if;
@@ -2940,8 +3190,9 @@ package body Gtkada.MDI is
Highlight_Child (C, False);
Widget_Callback.Emit_By_Name (C, "selected");
- Emit_By_Name_Child (Get_Object (C.MDI), "child_selected" & ASCII.NUL,
- Get_Object (C));
+ Emit_By_Name_Child
+ (Get_Object (C.MDI), String (Signal_Child_Selected) & ASCII.NUL,
+ Get_Object (C));
end Set_Focus_Child;
------------------
@@ -2962,10 +3213,8 @@ package body Gtkada.MDI is
then
Float_Child (MDI_Child (Child), False);
- if Traces then
- Put_Line
- ("MDI: Delete_Child, raising " & Get_Title (MDI_Child (Child)));
- end if;
+ Print_Debug
+ ("Delete_Child, raising " & Get_Title (MDI_Child (Child)));
Raise_Child (MDI_Child (Child), False);
return True;
@@ -3025,11 +3274,10 @@ package body Gtkada.MDI is
Groups : Object_List.GSlist;
W, H : Gint;
begin
- if Traces then
- Put_Line ("Float_Child " & Get_Title (Child)
- & " State=" & State_Type'Image (Child.State)
- & " Float=" & Boolean'Image (Float));
- end if;
+ Print_Debug
+ ("Float_Child " & Get_Title (Child)
+ & " State=" & State_Type'Image (Child.State)
+ & " Float=" & Boolean'Image (Float));
-- If the Child already has a window, the resulting floating window
-- should have the same size.
@@ -3162,9 +3410,10 @@ package body Gtkada.MDI is
Child.State := Floating;
Update_Float_Menu (Child);
- Emit_By_Name_Child (Get_Object (Child.MDI), "float_child" & ASCII.NUL,
- Get_Object (Child));
- Widget_Callback.Emit_By_Name (Child, "float_child");
+ Emit_By_Name_Child
+ (Get_Object (Child.MDI), String (Signal_Float_Child) & ASCII.NUL,
+ Get_Object (Child));
+ Widget_Callback.Emit_By_Name (Child, Signal_Float_Child);
Show_All (Win);
elsif Child.State = Floating and then not Float then
@@ -3180,7 +3429,7 @@ package body Gtkada.MDI is
Update_Float_Menu (Child);
Unref (Child);
- Widget_Callback.Emit_By_Name (Child, "unfloat_child");
+ Widget_Callback.Emit_By_Name (Child, Signal_Unfloat_Child);
end if;
end Internal_Float_Child;
@@ -3211,6 +3460,27 @@ package body Gtkada.MDI is
Set_Tab_Pos (Note, Pos);
end On_Tab_Pos;
+ -------------
+ -- Get_MDI --
+ -------------
+
+ function Get_MDI (Child : access MDI_Child_Record) return MDI_Window is
+ begin
+ return Child.MDI;
+ end Get_MDI;
+
+ -------------------------------------
+ -- Set_Tab_Contextual_Menu_Factory --
+ -------------------------------------
+
+ procedure Set_Tab_Contextual_Menu_Factory
+ (MDI : access MDI_Window_Record;
+ Factory : Tab_Contextual_Menu_Factory)
+ is
+ begin
+ MDI.Tab_Factory := Factory;
+ end Set_Tab_Contextual_Menu_Factory;
+
------------------------------
-- On_Notebook_Button_Press --
------------------------------
@@ -3263,6 +3533,10 @@ package body Gtkada.MDI is
On_Tab_Pos'Access, Note, Pos_Right);
Append (Submenu, Item);
+ if C.MDI.Tab_Factory /= null then
+ C.MDI.Tab_Factory (C, Menu);
+ end if;
+
Show_All (Menu);
Popup (Menu,
Button => 3,
@@ -3442,7 +3716,8 @@ package body Gtkada.MDI is
Initial_Position : Child_Position := Position_Automatic;
Force_Parent_Destruction : Boolean := True)
is
- Note, Old_Note : Gtk_Notebook;
+ Note : Gtk_Notebook;
+ Old_Parent : Gtk_Container;
Destroy_Old : Boolean := False;
Old_Note_Was_Destroyed : aliased Boolean := False;
@@ -3450,9 +3725,15 @@ package body Gtkada.MDI is
-- Embed the contents of the child into the notebook
if Notebook /= null then
- Note := Notebook;
+ Note := Notebook;
+
+ elsif Child.Group = Group_Default then
+ Note := Find_Current_In_Central
+ (MDI.Central, MDI, Child.Group, Initial_Position);
+
else
- Note := Find_Current_In_Central (MDI, Child.Group, Initial_Position);
+ Note := Find_Current_In_Central
+ (MDI, MDI, Child.Group, Initial_Position);
end if;
if Get_Parent (Child) = Gtk_Widget (Note) then
@@ -3462,30 +3743,30 @@ package body Gtkada.MDI is
Ref (Child);
if Get_Parent (Child) /= null then
- Old_Note := Gtk_Notebook (Get_Parent (Child));
+ Old_Parent := Gtk_Container (Get_Parent (Child));
-- Always destroy the notebook we were in, since we are
-- putting the item elsewhere anyway, there will still be
-- a notebook for items in the same position.
Destroy_Old := Force_Parent_Destruction
- and then not MDI_Notebook (Old_Note).Is_Default_Notebook
- and then Get_Nth_Page (Old_Note, 1) = null;
+ and then Old_Parent.all in Gtk_Notebook_Record'Class
+ and then Get_Nth_Page (Gtk_Notebook (Old_Parent), 1) = null;
Weak_Ref
- (Old_Note, Note_Notify'Access, Old_Note_Was_Destroyed'Address);
- Remove (Old_Note, Child);
+ (Old_Parent, Note_Notify'Access, Old_Note_Was_Destroyed'Address);
+ Remove (Old_Parent, Child);
if not Old_Note_Was_Destroyed then
Weak_Unref
- (Old_Note, Note_Notify'Access, Old_Note_Was_Destroyed'Address);
+ (Old_Parent, Note_Notify'Access, Old_Note_Was_Destroyed'Address);
end if;
-- Problem: Old_Note might no longer exist not, since
-- Removed_From_Notebook might have destroyed it.
if Destroy_Old and then not Old_Note_Was_Destroyed then
- Destroy (Old_Note);
+ Destroy (Old_Parent);
end if;
end if;
@@ -3498,60 +3779,25 @@ package body Gtkada.MDI is
Update_Tab_Label (Child);
+ -- In case the user displays title bars only in the central area, we
+ -- might need to change its visibility when moving in or out of the
+ -- central area
+ Set_Child_Title_Bar (Child);
+
Set_Child_Visible (Note, True);
Show (Note);
Queue_Resize (Note);
- if Child.Group = Group_Default then
- declare
- Children : Widget_List.Glist := Get_Children (MDI);
- L : Widget_List.Glist := Children;
- N : MDI_Notebook;
- begin
- while L /= Null_List loop
- N := MDI_Notebook (Get_Data (L));
- N.Is_Default_Notebook := False;
- L := Next (L);
- end loop;
- Free (Children);
- end;
- end if;
-
Unref (Child);
end Put_In_Notebook;
- -------------------------
- -- Find_Empty_Notebook --
- -------------------------
-
- function Find_Empty_Notebook
- (MDI : access MDI_Window_Record'Class) return Gtk_Notebook
- is
- Children : Widget_List.Glist := Get_Children (MDI);
- L : Widget_List.Glist := Children;
- N : Gtk_Notebook;
- begin
- while L /= Null_List loop
- N := Gtk_Notebook (Get_Data (L));
-
- if Get_Nth_Page (N, 0) = null then
- Free (Children);
- return N;
- end if;
-
- L := Next (L);
- end loop;
-
- Free (Children);
- return null;
- end Find_Empty_Notebook;
-
-----------------------------
-- Find_Current_In_Central --
-----------------------------
function Find_Current_In_Central
- (MDI : access MDI_Window_Record'Class;
+ (Pane : access Gtkada_Multi_Paned_Record'Class;
+ MDI : access MDI_Window_Record'Class;
Group : Child_Group := Group_Any;
Initial_Position : Child_Position := Position_Automatic)
return Gtk_Notebook
@@ -3562,43 +3808,55 @@ package body Gtkada.MDI is
Current : Gtk_Notebook;
Default_Current_Found : Boolean := False;
begin
- -- Do we already have a child within the same group ?
+ if Gtkada_Multi_Paned (Pane) = Gtkada_Multi_Paned (MDI) then
+ -- Do we already have a child within the same group ?
- while List /= Widget_List.Null_List loop
- C := MDI_Child (Get_Data (List));
+ while List /= Widget_List.Null_List loop
+ C := MDI_Child (Get_Data (List));
- if C.State = Normal then
- Note := Get_Notebook (C);
- if Current = null then
- Current := Note;
- end if;
+ if C.State = Normal then
+ Note := Get_Notebook (C);
+ if Current = null then
+ Current := Note;
+ end if;
- if not Default_Current_Found
- and then C.Group = Group_Default
- then
- Default_Current_Found := True;
- Current := Note;
+ if not Default_Current_Found
+ and then C.Group = Group_Default
+ then
+ Default_Current_Found := True;
+ Current := Note;
+ end if;
+
+ exit when Note /= null
+ and then (Group = Group_Any or else C.Group = Group);
+ Note := null;
end if;
- exit when Note /= null
- and then (Group = Group_Any or else C.Group = Group);
- Note := null;
- end if;
+ List := Next (List);
+ end loop;
- List := Next (List);
- end loop;
+ else
+ -- In the central area, look for the last child used, and put the new
+ -- window on top of it
- -- Look for an empty notebook
+ while List /= Widget_List.Null_List loop
+ C := MDI_Child (Get_Data (List));
- if Note = null and then Initial_Position = Position_Automatic then
- Note := Find_Empty_Notebook (MDI);
+ if In_Central_Area (MDI, C) then
+ Note := Get_Notebook (C);
+ Current := Note;
+ exit;
+ end if;
+
+ List := Next (List);
+ end loop;
end if;
if Note = null then
case Initial_Position is
when Position_Bottom =>
Note := Create_Notebook (MDI);
- Split (MDI,
+ Split (Pane,
New_Child => Note,
Ref_Pane => Root_Pane,
Orientation => Orientation_Vertical,
@@ -3607,7 +3865,7 @@ package body Gtkada.MDI is
After => True);
when Position_Top =>
Note := Create_Notebook (MDI);
- Split (MDI,
+ Split (Pane,
New_Child => Note,
Ref_Pane => Root_Pane,
Orientation => Orientation_Vertical,
@@ -3616,7 +3874,7 @@ package body Gtkada.MDI is
After => False);
when Position_Left =>
Note := Create_Notebook (MDI);
- Split (MDI,
+ Split (Pane,
New_Child => Note,
Ref_Pane => Root_Pane,
Orientation => Orientation_Horizontal,
@@ -3625,7 +3883,7 @@ package body Gtkada.MDI is
After => False);
when Position_Right =>
Note := Create_Notebook (MDI);
- Split (MDI,
+ Split (Pane,
New_Child => Note,
Ref_Pane => Root_Pane,
Orientation => Orientation_Horizontal,
@@ -3637,7 +3895,7 @@ package body Gtkada.MDI is
Note := Current;
else
Note := Create_Notebook (MDI);
- Add_Child (MDI, New_Child => Note);
+ Add_Child (Pane, New_Child => Note);
end if;
end case;
end if;
@@ -3753,36 +4011,6 @@ package body Gtkada.MDI is
return MDI.Focus_Child;
end Get_Focus_Child;
- -----------------------
- -- Has_Default_Child --
- -----------------------
-
- function Has_Default_Child
- (MDI : access MDI_Window_Record'Class;
- Ignore : MDI_Child := null;
- Ignore_Note : Gtk_Notebook := null) return Boolean
- is
- Child_Is_Being_Destroyed : constant Boolean :=
- Ignore = null
- or else Ignore.MDI.In_Drag = No_Drag;
- L : Widget_List.Glist := MDI.Items;
- C : MDI_Child;
- begin
- while L /= Null_List loop
- C := MDI_Child (Get_Data (L));
- if (Ignore /= C or else not Child_Is_Being_Destroyed)
- and then C.State = Normal -- In a notebook currently
- and then C.Group = Group_Default
- and then (Ignore_Note = null
- or else Get_Notebook (C) /= Ignore_Note)
- then
- return True;
- end if;
- L := Next (L);
- end loop;
- return False;
- end Has_Default_Child;
-
---------------------------
-- Removed_From_Notebook --
---------------------------
@@ -3792,10 +4020,7 @@ package body Gtkada.MDI is
is
C : constant Gtk_Widget :=
Gtk_Widget (To_Object (Args, 1));
- Page1 : Gtk_Widget;
Child : MDI_Child;
- Default_Child_Remains : Boolean := False;
- Must_Destroy : Boolean := False;
begin
if C.all not in MDI_Child_Record'Class then
return;
@@ -3803,97 +4028,24 @@ package body Gtkada.MDI is
Child := MDI_Child (C);
Child.Tab_Label := null;
-
Child.State := Normal;
if not Gtk.Object.In_Destruction_Is_Set (Note) then
- Configure_Notebook_Tabs
- (Child.MDI, Gtk_Notebook (Note), Hide_If_Empty => True);
+ Print_Debug ("Removed_From_Notebook: " & Get_Title (Child));
- Page1 := Get_Nth_Page (Gtk_Notebook (Note), 0);
+ -- No more pages in the notebook ? => Destroy it
- -- Do we have any child remaining with Group_Default ?
-
- if Child.Group = Group_Default then
- -- The current child should be taken into account only when it is
- -- moved to another notebook, ie will remain as part of the MDI.
- -- If it is being destroyed, it should no longer count as a
- -- Position_Default child.
- Default_Child_Remains := Has_Default_Child
- (Child.MDI, Ignore => Child);
+ if Get_Nth_Page (Gtk_Notebook (Note), 0) = null then
+ Destroy (Note);
+ else
+ Configure_Notebook_Tabs
+ (Child.MDI, Gtk_Notebook (Note), Hide_If_Empty => True);
end if;
if Traces then
- Put_Line ("Removed_From_Notebook: " & Get_Title (Child)
- & " default child remains ? "
- & Boolean'Image (Default_Child_Remains));
+ Print_Debug ("Removed_From_Notebook: desktop is now");
+ Dump (Child.MDI);
end if;
-
- -- No more pages in the notebook ?
- if Page1 = null then
- -- Are there any other notebook with only children in normal
- -- position ? (We need to ignore the notebooks with at least one
- -- child in the bottom, left,... position, since these are special
- -- notebooks
- -- Destroy the current notebook if:
- -- - There is no other empty notebook
- -- - Or there is at least one notebook with Position_Default
- -- children
-
- if Child.Group /= Group_Default then
- if not MDI_Notebook (Note).Is_Default_Notebook then
- Destroy (Note);
- end if;
- return;
- end if;
-
- -- The notebook will be destroyed if we already have an
- -- empty notebook, or if there is at least one Position_Default
- -- child remaining. Otherwise we keep this notebook as empty,
- -- and mark it as special.
-
- Must_Destroy := Default_Child_Remains;
- if not Must_Destroy then
- declare
- Children : Widget_List.Glist :=
- Get_Children (Gtk_Container (Child.MDI));
- Has_Empty_Notebook : Boolean := False;
- L : Widget_List.Glist;
- N : Gtk_Notebook;
- begin
- -- Identify which notebooks are empty
- L := Children;
- while L /= Null_List loop
- N := Gtk_Notebook (Get_Data (L));
- if N /= Gtk_Notebook (Note)
- and then Get_Nth_Page (N, 0) = null
- then
- Has_Empty_Notebook := True;
- exit;
- end if;
- L := Next (L);
- end loop;
- Free (Children);
-
- Must_Destroy := Has_Empty_Notebook;
- end;
- end if;
-
- if Must_Destroy then
- Destroy (Note);
- else
- MDI_Notebook (Note).Is_Default_Notebook := True;
- Show (Note); -- Default notebook always visible
- end if;
-
- else
- -- If we have only one page:
- if Child.Group = Group_Default
- and then not Default_Child_Remains
- then
- MDI_Notebook (Note).Is_Default_Notebook := True;
- end if;
- end if;
end if;
exception
@@ -3912,30 +4064,72 @@ package body Gtkada.MDI is
-----------
procedure Split
- (MDI : access MDI_Window_Record;
- Orientation : Gtk_Orientation;
- Reuse_If_Possible : Boolean := False;
- After : Boolean := False;
- Width, Height : Glib.Gint := 0)
+ (MDI : access MDI_Window_Record;
+ Orientation : Gtk.Enums.Gtk_Orientation;
+ Child : MDI_Child := null;
+ Mode : Split_Mode := Before;
+ Width, Height : Glib.Gint := 0)
is
Note, Note2 : Gtk_Notebook;
- Child : MDI_Child;
+ Target : MDI_Child;
+ Pane : Gtkada_Multi_Paned;
+ W : Gtk_Widget;
+ After : Boolean := True;
begin
- Note := Find_Current_In_Central (MDI);
+ if Child /= null then
+ Target := Child;
+ elsif MDI.Focus_Child /= null then
+ Target := MDI.Focus_Child;
+ elsif MDI.Items = Widget_List.Null_List then
+ return;
+ else
+ Target := MDI_Child (Get_Data (MDI.Items));
+ end if;
+ Note := Get_Notebook (Target);
+
-- Only split if there are at least two children
if Note /= null and then Get_Nth_Page (Note, 1) /= null then
- Child := MDI_Child (Get_Nth_Page (Note, Get_Current_Page (Note)));
- Ref (Child);
+ if In_Central_Area (MDI, Target) then
+ Pane := MDI.Central;
+ else
+ Pane := Gtkada_Multi_Paned (MDI);
+ end if;
- Note2 := Gtk_Notebook (Splitted_Area
- (MDI, Note, Orientation, After));
+ case Mode is
+ when Before =>
+ Note2 := null;
+ After := False;
- if not Reuse_If_Possible or else Note2 = null then
+ when Gtkada.MDI.After =>
+ Note2 := null;
+ After := True;
+
+ when Before_Reuse =>
+ W := Splitted_Area (Pane, Note, Orientation, After => False);
+ After := False;
+
+ when After_Reuse =>
+ W := Splitted_Area (Pane, Note, Orientation, After => True);
+ After := True;
+
+ when Any_Side_Reuse =>
+ W := Splitted_Area (Pane, Note, Orientation, After => True);
+ if W = null then
+ W := Splitted_Area (Pane, Note, Orientation, After => False);
+ end if;
+ After := True;
+ end case;
+
+ if W /= null and then W.all in Gtk_Notebook_Record'Class then
+ Note2 := Gtk_Notebook (W);
+ end if;
+
+ if Note2 = null then
Note2 := Create_Notebook (MDI);
Show_All (Note2);
- Split (MDI,
+ Split (Pane,
Ref_Widget => Note,
New_Child => Note2,
Width => Width,
@@ -3944,17 +4138,24 @@ package body Gtkada.MDI is
After => After);
end if;
- Give_Focus_To_Previous_Child (Child);
- Remove (Note, Child);
- Put_In_Notebook (MDI, Child, Note2);
- Unref (Child);
- Set_Focus_Child (Child);
+ Show (Note2);
- Show (Note2);
+ Ref (Target);
+ Give_Focus_To_Previous_Child (Target);
+ Remove (Note, Target);
+ Put_In_Notebook (MDI, Target, Note2);
+ Unref (Target);
+ Set_Focus_Child (Target);
Emit_By_Name
- (Get_Object (MDI), "children_reorganized" & ASCII.NUL);
+ (Get_Object (MDI),
+ String (Signal_Children_Reorganized) & ASCII.NUL);
end if;
+
+ if Traces then
+ Print_Debug ("After split " & Gtk_Orientation'Image (Orientation));
+ Dump (MDI);
+ end if;
end Split;
----------------
@@ -3962,15 +4163,17 @@ package body Gtkada.MDI is
----------------
procedure Split_H_Cb (MDI : access Gtk_Widget_Record'Class) is
+ M : constant MDI_Window := MDI_Window (MDI);
begin
-- Do nothing unless the current child is in the central area, since
-- otherwise this is disturbing for the user
- if MDI_Window (MDI).Focus_Child /= null
- and then MDI_Window (MDI).Focus_Child.State = Normal
+ if M.Focus_Child /= null
+ and then M.Focus_Child.State = Normal
then
- Split (MDI_Window (MDI), Orientation => Orientation_Horizontal);
+ Split (M, Orientation => Orientation_Horizontal);
end if;
+
exception
when E : others =>
pragma Debug
@@ -4197,90 +4400,6 @@ package body Gtkada.MDI is
MDI_Window (MDI).Float_Menu_Item := null;
end Menu_Destroyed;
- -----------------
- -- Create_Menu --
- -----------------
-
- function Create_Menu
- (MDI : access MDI_Window_Record;
- Accel_Path_Prefix : String := "<gtkada>") return Gtk.Menu.Gtk_Menu
- is
- Item : Gtk_Menu_Item;
- Child : MDI_Child;
- Tmp : Widget_List.Glist;
-
- begin
- if MDI.Menu = null then
- MDI.Accel_Path_Prefix := new String'(Accel_Path_Prefix);
- Gtk_New (MDI.Menu);
-
- Gtk_New (Item, "Split Side-by-Side");
- Append (MDI.Menu, Item);
- Widget_Callback.Object_Connect
- (Item, Gtk.Menu_Item.Signal_Activate,
- Widget_Callback.To_Marshaller (Split_H_Cb'Access), MDI);
- Set_Accel_Path (Item, Accel_Path_Prefix
- & "/window/split_horizontal", MDI.Group);
-
- Gtk_New (Item, "Split Up-Down");
- Append (MDI.Menu, Item);
- Widget_Callback.Object_Connect
- (Item, Gtk.Menu_Item.Signal_Activate,
- Widget_Callback.To_Marshaller (Split_V_Cb'Access), MDI);
- Set_Accel_Path (Item, Accel_Path_Prefix
- & "/window/split_vertical", MDI.Group);
-
- Gtk_New (Item);
- Append (MDI.Menu, Item);
-
- Gtk_New (MDI.Float_Menu_Item, "Floating");
- Append (MDI.Menu, MDI.Float_Menu_Item);
- Set_Active (MDI.Float_Menu_Item,
- MDI.Focus_Child /= null
- and then MDI.Focus_Child.State = Floating);
- MDI.Float_Menu_Item_Id := Widget_Callback.Object_Connect
- (MDI.Float_Menu_Item, Signal_Toggled,
- Widget_Callback.To_Marshaller (Float_Cb'Access), MDI);
- Set_Accel_Path
- (MDI.Float_Menu_Item, Accel_Path_Prefix
- & "/window/floating", MDI.Group);
-
- Gtk_New (Item);
- Append (MDI.Menu, Item);
-
- Gtk_New (MDI.Close_Menu_Item, "Close");
- Append (MDI.Menu, MDI.Close_Menu_Item);
- Widget_Callback.Object_Connect
- (MDI.Close_Menu_Item, Gtk.Menu_Item.Signal_Activate,
- Widget_Callback.To_Marshaller (Close_Cb'Access), MDI);
- Set_Accel_Path (Item, Accel_Path_Prefix
- & "/window/close", MDI.Group);
-
- Gtk_New (Item);
- Append (MDI.Menu, Item);
-
- Tmp := First (MDI.Items);
-
- while Tmp /= Null_List loop
- Child := MDI_Child (Get_Data (Tmp));
- Create_Menu_Entry (Child);
- Tmp := Next (Tmp);
- end loop;
-
- Widget_Callback.Object_Connect
- (MDI.Menu, Signal_Destroy,
- Widget_Callback.To_Marshaller (Menu_Destroyed'Access), MDI);
-
- elsif Accel_Path_Prefix /= MDI.Accel_Path_Prefix.all then
- Put_Line
- ("Accel_Path_Prefix must have the same prefix across calls"
- & " to Create_Menu");
- end if;
-
- Show_All (MDI.Menu);
- return MDI.Menu;
- end Create_Menu;
-
---------------------
-- Set_Focus_Child --
---------------------
@@ -4309,9 +4428,11 @@ package body Gtkada.MDI is
package body Desktop is
- Empty_Notebook_Filler : MDI_Child;
- -- Used to fill the empty notebook, and prevent it from being destroyed
- -- during a desktop load.
+ function Get_XML_For_Widget
+ (Child : MDI_Child;
+ User : User_Data) return Node_Ptr;
+ -- Get the XML node for a given widget. This automatically sets
+ -- Child.XML_Node_Name as well
procedure Parse_Child_Node
(MDI : access MDI_Window_Record'Class;
@@ -4325,18 +4446,20 @@ package body Gtkada.MDI is
Child : out MDI_Child;
To_Hide : in out Gtk.Widget.Widget_List.Glist);
-- Parse a <child> node and return the corresponding Child. The latter
- -- has not been inserted in the MDI
+ -- has not been inserted in the MDI.
procedure Parse_Notebook_Node
(MDI : access MDI_Window_Record'Class;
Child_Node : Node_Ptr;
User : User_Data;
+ Parent_Width, Parent_Height : Gint;
+ Parent_Orientation : Gtk_Orientation;
Focus_Child : in out MDI_Child;
Width, Height : out Gint;
Notebook : out Gtk_Notebook;
To_Raise : in out Gtk.Widget.Widget_List.Glist;
To_Hide : in out Gtk.Widget.Widget_List.Glist;
- Reuse_Empty_If_Needed : in out Boolean);
+ Empty_Notebook_Filler : in out MDI_Child);
-- Parse a <notebook> node.
-- A new notebook is created and returned.
-- If Reuse_Empty_If_Needed and we need to insert an empty notebook,
@@ -4347,19 +4470,338 @@ package body Gtkada.MDI is
-- into the desktop, they might be put in the same notebook temporarily,
-- before being moved to their actual location, and that would change
-- the current page.
+ -- Paned_Width and Paned_Height are the size of the multi_paned widget
+ -- to which the "width" and "height" attributes are relative.
procedure Parse_Pane_Node
- (MDI : access MDI_Window_Record'Class;
+ (Paned : access Gtkada_Multi_Paned_Record'Class;
+ MDI : access MDI_Window_Record'Class;
Node : Node_Ptr;
Focus_Child : in out MDI_Child;
+ Parent_Width, Parent_Height : Gint;
+ Parent_Orientation : Gtk_Orientation;
User : User_Data;
Initial_Ref_Child : Gtk_Notebook := null;
To_Raise : in out Gtk.Widget.Widget_List.Glist;
To_Hide : in out Gtk.Widget.Widget_List.Glist;
- Reuse_Empty_If_Needed : in out Boolean);
+ Empty_Notebook_Filler : in out MDI_Child);
-- Parse a <Pane> node
-- First_Child is the first notebook insert in pane (possibly inserted
+ -- From_Tree points to the project-specific part of the desktop, where
+ -- the contents of the children are saved.
+ procedure Restore_Multi_Pane
+ (Pane : access Gtkada_Multi_Paned_Record'Class;
+ MDI : access MDI_Window_Record'Class;
+ Focus_Child : in out MDI_Child;
+ To_Raise : in out Gtk.Widget.Widget_List.Glist;
+ To_Hide : in out Gtk.Widget.Widget_List.Glist;
+ Node : Node_Ptr;
+ User : User_Data;
+ Full_Width, Full_Height : Gint);
+ -- Restore a multi paned widget (either the perspective or the contents
+ -- of the editor area)
+ -- From_Tree points to the project-specific part of the desktop, where
+ -- the contents of the children are saved.
+
+ procedure Internal_Load_Perspective
+ (MDI : access MDI_Window_Record'Class;
+ Name : String;
+ User : User_Data;
+ Focus_Child : in out MDI_Child;
+ To_Raise : in out Gtk.Widget.Widget_List.Glist;
+ To_Hide : in out Gtk.Widget.Widget_List.Glist;
+ Width, Height : Gint := 0;
+ Do_Size_Allocate : Boolean);
+ -- Internal version of Load_Perspective
+
+ procedure Compute_Size_From_Attributes
+ (Node : Node_Ptr;
+ Parent_Width, Parent_Height : Gint;
+ Parent_Orientation : Gtk_Orientation;
+ Width, Height : out Gint;
+ Children_Count : Integer := 1);
+ -- Compute the actual size of the widget represented by node, from the
+ -- attributes of the node ("width" and "height", which use percent of
+ -- the total pane size), and the attributes of the parent container.
+ -- Children_Count is the number of children for the widget represented
+ -- by Node, since the size returned is the one really available for
+ -- sharing between the children (thus omitting the resize handles)
+
+ procedure Create_Perspective_Menu
+ (MDI : access MDI_Window_Record'Class;
+ User : User_Data);
+ -- Create the /Window/Perspectives submenu
+
+ procedure Recompute_Perspective_Names
+ (MDI : access MDI_Window_Record'Class);
+ -- Recompute the name of all perspectives, and cache them
+
+ ------------------------
+ -- Change_Perspective --
+ ------------------------
+
+ procedure Change_Perspective
+ (Item : access Gtk_Widget_Record'Class)
+ is
+ Persp : constant Perspective_Menu_Item :=
+ Perspective_Menu_Item (Item);
+
+ Name : constant String :=
+ Persp.MDI.Perspective_Names (Persp.Name).all;
+ -- Make a copy of the name, since Load_Perspective changes
+ -- Persp.MDI.Perspective_Names
+ begin
+ if Get_Active (Persp) then
+ Print_Debug ("++++ Change_Perspective to " & Name
+ & Integer'Image (Persp.Name));
+ if not Persp.MDI.Loading_Desktop then
+ Load_Perspective (Persp.MDI, Name, Persp.User);
+ end if;
+ end if;
+ end Change_Perspective;
+
+ ---------------------------
+ -- Create_Perspective_CB --
+ ---------------------------
+
+ procedure Create_Perspective_CB
+ (Item : access Gtk_Widget_Record'Class)
+ is
+ Persp : constant Perspective_Menu_Item :=
+ Perspective_Menu_Item (Item);
+ Dialog : Gtk_Dialog;
+ Label : Gtk_Label;
+ Ent : Gtk_Entry;
+ Button : Gtk_Widget;
+ pragma Warnings (Off, Button);
+ begin
+ Gtk_New (Dialog, Title => "Enter perspective name",
+ Parent => Gtk_Window (Get_Toplevel (Persp.MDI)),
+ Flags => Modal and Destroy_With_Parent);
+ Button := Add_Button (Dialog, Stock_Ok, Gtk_Response_OK);
+ Button := Add_Button (Dialog, Stock_Cancel, Gtk_Response_Cancel);
+ Set_Default_Response (Dialog, Gtk_Response_OK);
+
+ Gtk_New (Label, "Enter name of new perspective:");
+ Pack_Start (Get_Vbox (Dialog), Label, Expand => False);
+
+ Gtk_New (Ent);
+ Set_Activates_Default (Ent, True);
+ Pack_Start (Get_Vbox (Dialog), Ent, Expand => False);
+
+ Show_All (Dialog);
+
+ if Run (Dialog) = Gtk_Response_OK then
+ Create_Perspective (Persp.MDI, Get_Text (Ent), Persp.User);
+ end if;
+
+ Destroy (Dialog);
+ end Create_Perspective_CB;
+
+ ------------------------
+ -- Create_Perspective --
+ ------------------------
+
+ procedure Create_Perspective
+ (MDI : access MDI_Window_Record'Class;
+ Name : String;
+ User : User_Data)
+ is
+ Perspectives, Central : Node_Ptr;
+ begin
+ MDI.Current_Perspective := null;
+ Save_Desktop (MDI, User, Perspectives, Central);
+ Set_Attribute (MDI.Current_Perspective, "name", Name);
+ Free (Perspectives);
+ Free (Central);
+
+ Recompute_Perspective_Names (MDI);
+ Create_Perspective_Menu (MDI, User);
+
+ Emit_By_Name
+ (Get_Object (MDI), String (Signal_Perspective_Changed) & ASCII.NUL);
+ end Create_Perspective;
+
+ ------------------------
+ -- Define_Perspective --
+ ------------------------
+
+ procedure Define_Perspective
+ (MDI : access MDI_Window_Record'Class;
+ XML : Glib.Xml_Int.Node_Ptr;
+ User : User_Data)
+ is
+ Name : constant String := Get_Attribute (XML, "name");
+ Tmp : Node_Ptr;
+ begin
+ if Name = "" or else MDI.Perspectives = null then
+ return;
+ end if;
+
+ Tmp := MDI.Perspectives.Child;
+
+ while Tmp /= null loop
+ if Get_Attribute (Tmp, "name") = Name then
+ -- Perspective already exists
+ return;
+ end if;
+
+ Tmp := Tmp.Next;
+ end loop;
+
+ Add_Child (MDI.Perspectives, Deep_Copy (XML), Append => True);
+ Create_Perspective_Menu (MDI, User);
+ end Define_Perspective;
+
+ -----------------------------
+ -- Create_Perspective_Menu --
+ -----------------------------
+
+ procedure Create_Perspective_Menu
+ (MDI : access MDI_Window_Record'Class;
+ User : User_Data)
+ is
+ Submenu : Gtk_Menu;
+ Persp : Perspective_Menu_Item;
+ Group : Widget_SList.GSlist := Widget_SList.Null_List;
+ begin
+ Print_Debug ("Create_Perspective_Menu");
+ Indent_Debug (1);
+
+ -- Prevent changing perspective when setting "Active" on the buttons
+ MDI.Loading_Desktop := True;
+
+ Remove_Submenu (MDI.Perspective_Menu_Item);
+
+ Gtk_New (Submenu);
+ Set_Submenu (MDI.Perspective_Menu_Item, Submenu);
+
+ if MDI.Perspective_Names /= null then
+ for N in MDI.Perspective_Names'Range loop
+ Persp := new Perspective_Menu_Item_Record;
+ Persp.MDI := MDI_Window (MDI);
+ Persp.Name := N;
+ Persp.User := User;
+
+ Initialize (Persp, Group, MDI.Perspective_Names (N).all);
+ Set_Active (Persp,
+ MDI.Current_Perspective /= null
+ and then MDI.Perspective_Names (N).all =
+ Get_Attribute (MDI.Current_Perspective, "name"));
+ Group := Get_Group (Persp);
+ Append (Submenu, Persp);
+ Widget_Callback.Connect
+ (Persp, Gtk.Menu_Item.Signal_Activate, CP_Access);
+ end loop;
+ end if;
+
+ Persp := new Perspective_Menu_Item_Record;
+ Persp.MDI := MDI_Window (MDI);
+ Persp.User := User;
+ Gtk.Menu_Item.Initialize (Persp, "<create new>");
+
+ Widget_Callback.Connect
+ (Persp, Gtk.Menu_Item.Signal_Activate, CreateP_Access);
+ Append (Submenu, Persp);
+
+ Show_All (Submenu);
+ Show (MDI.Perspective_Menu_Item);
+
+ MDI.Loading_Desktop := False;
+
+ Indent_Debug (-1);
+ end Create_Perspective_Menu;
+
+ -----------------
+ -- Create_Menu --
+ -----------------
+
+ function Create_Menu
+ (MDI : access MDI_Window_Record'Class;
+ Accel_Path_Prefix : String := "<gtkada>";
+ User : User_Data) return Gtk.Menu.Gtk_Menu
+ is
+ Item : Gtk_Menu_Item;
+ Child : MDI_Child;
+ Tmp : Widget_List.Glist;
+
+ begin
+ if MDI.Menu = null then
+ MDI.Accel_Path_Prefix := new String'(Accel_Path_Prefix);
+ Gtk_New (MDI.Menu);
+
+ Gtk_New (MDI.Perspective_Menu_Item, "Perspectives");
+ Append (MDI.Menu, MDI.Perspective_Menu_Item);
+ Create_Perspective_Menu (MDI, User);
+
+ Gtk_New (Item, "Split Side-by-Side");
+ Append (MDI.Menu, Item);
+ Widget_Callback.Object_Connect
+ (Item, Gtk.Menu_Item.Signal_Activate,
+ Widget_Callback.To_Marshaller (Split_H_Cb'Access), MDI);
+ Set_Accel_Path (Item, Accel_Path_Prefix
+ & "/window/split_horizontal", MDI.Group);
+
+ Gtk_New (Item, "Split Up-Down");
+ Append (MDI.Menu, Item);
+ Widget_Callback.Object_Connect
+ (Item, Gtk.Menu_Item.Signal_Activate,
+ Widget_Callback.To_Marshaller (Split_V_Cb'Access), MDI);
+ Set_Accel_Path (Item, Accel_Path_Prefix
+ & "/window/split_vertical", MDI.Group);
+
+ Gtk_New (Item);
+ Append (MDI.Menu, Item);
+
+ Gtk_New (MDI.Float_Menu_Item, "Floating");
+ Append (MDI.Menu, MDI.Float_Menu_Item);
+ Set_Active (MDI.Float_Menu_Item,
+ MDI.Focus_Child /= null
+ and then MDI.Focus_Child.State = Floating);
+ MDI.Float_Menu_Item_Id := Widget_Callback.Object_Connect
+ (MDI.Float_Menu_Item, Signal_Toggled,
+ Widget_Callback.To_Marshaller (Float_Cb'Access), MDI);
+ Set_Accel_Path
+ (MDI.Float_Menu_Item, Accel_Path_Prefix
+ & "/window/floating", MDI.Group);
+
+ Gtk_New (Item);
+ Append (MDI.Menu, Item);
+
+ Gtk_New (MDI.Close_Menu_Item, "Close");
+ Append (MDI.Menu, MDI.Close_Menu_Item);
+ Widget_Callback.Object_Connect
+ (MDI.Close_Menu_Item, Gtk.Menu_Item.Signal_Activate,
+ Widget_Callback.To_Marshaller (Close_Cb'Access), MDI);
+ Set_Accel_Path (Item, Accel_Path_Prefix
+ & "/window/close", MDI.Group);
+
+ Gtk_New (Item);
+ Append (MDI.Menu, Item);
+
+ Tmp := First (MDI.Items);
+
+ while Tmp /= Null_List loop
+ Child := MDI_Child (Get_Data (Tmp));
+ Create_Menu_Entry (Child);
+ Tmp := Next (Tmp);
+ end loop;
+
+ Widget_Callback.Object_Connect
+ (MDI.Menu, Signal_Destroy,
+ Widget_Callback.To_Marshaller (Menu_Destroyed'Access), MDI);
+
+ elsif Accel_Path_Prefix /= MDI.Accel_Path_Prefix.all then
+ Put_Line
+ ("Accel_Path_Prefix must have the same prefix across calls"
+ & " to Create_Menu");
+ end if;
+
+ Show_All (MDI.Menu);
+ return MDI.Menu;
+ end Create_Menu;
+
--------------------------------
-- Register_Desktop_Functions --
--------------------------------
@@ -4374,6 +4816,65 @@ package body Gtkada.MDI is
Next => Registers);
end Register_Desktop_Functions;
+ ----------------------------------
+ -- Compute_Size_From_Attributes --
+ ----------------------------------
+
+ procedure Compute_Size_From_Attributes
+ (Node : Node_Ptr;
+ Parent_Width, Parent_Height : Gint;
+ Parent_Orientation : Gtk_Orientation;
+ Width, Height : out Gint;
+ Children_Count : Integer := 1)
+ is
+ WAttr : constant String := Get_Attribute (Node, "width", "100%");
+ HAttr : constant String := Get_Attribute (Node, "height", "100%");
+ Tmp : Gint;
+ begin
+ -- For backward compatibility, we accept absolute sizes in the XML
+ -- nodes, but that might lead to inconsistencies (and incorrect
+ -- reload of desktop) if the user modifies this by hand
+ --
+ -- Depending on the orientation of the parent, one of the dimensions
+ -- is in fact fixed (the full height or width of the parent).
+ --
+ -- If there are multiple children (case of panes for instance), the
+ -- size we return is the one really available for children, not the
+ -- physical size of the pane itself.
+
+ case Parent_Orientation is
+ when Orientation_Horizontal =>
+ Height := Parent_Height;
+
+ if WAttr (WAttr'Last) = '%' then
+ Tmp :=
+ Parent_Width - Gint (Children_Count - 1) * Handle_Width;
+ Width := Gint
+ (Float'Value (WAttr (WAttr'First .. WAttr'Last - 1))
+ * Float (Tmp) / 100.0);
+ else
+ Width := Gint'Value (WAttr);
+ end if;
+
+ when Orientation_Vertical =>
+ Width := Parent_Width;
+
+ if HAttr (HAttr'Last) = '%' then
+ Tmp :=
+ Parent_Height - Gint (Children_Count - 1) * Handle_Width;
+ Height := Gint
+ (Float'Value (HAttr (HAttr'First .. HAttr'Last - 1))
+ * Float (Tmp) / 100.0);
+ else
+ Height := Gint'Value (HAttr);
+ end if;
+ end case;
+
+ Print_Debug
+ ("Compute_Size_From_Attributes WAttr=" & WAttr & " HAttr=" & HAttr
+ & " => size " & Gint'Image (Width) & Gint'Image (Height));
+ end Compute_Size_From_Attributes;
+
-------------------------
-- Parse_Notebook_Node --
-------------------------
@@ -4382,12 +4883,14 @@ package body Gtkada.MDI is
(MDI : access MDI_Window_Record'Class;
Child_Node : Node_Ptr;
User : User_Data;
+ Parent_Width, Parent_Height : Gint;
+ Parent_Orientation : Gtk_Orientation;
Focus_Child : in out MDI_Child;
Width, Height : out Gint;
Notebook : out Gtk_Notebook;
To_Raise : in out Gtk.Widget.Widget_List.Glist;
To_Hide : in out Gtk.Widget.Widget_List.Glist;
- Reuse_Empty_If_Needed : in out Boolean)
+ Empty_Notebook_Filler : in out MDI_Child)
is
N : Node_Ptr := Child_Node.Child;
State : State_Type;
@@ -4396,46 +4899,32 @@ package body Gtkada.MDI is
Child : MDI_Child;
X, Y : Gint;
Dummy : Gtk_Label;
- Is_Default : Boolean;
Pos : Gtk_Position_Type;
+
begin
- Width := Gint'Value (Get_Attribute (Child_Node, "Width", "-1"));
- Height := Gint'Value (Get_Attribute (Child_Node, "Height", "-1"));
+ Print_Debug ("Parse_Notebook_Node Parent_Width="
+ & Gint'Image (Parent_Width) & " Parent_Height="
+ & Gint'Image (Parent_Height) & " Parent_Orientation="
+ & Gtk_Orientation'Image (Parent_Orientation));
+ Indent_Debug (1);
+
+ Compute_Size_From_Attributes
+ (Child_Node, Parent_Width, Parent_Height, Parent_Orientation,
+ Width, Height, Children_Count => 1);
+
Pos := Gtk_Position_Type'Value
(Get_Attribute (Child_Node, "Tabs",
Gtk_Position_Type'Image (MDI.Tabs_Position)));
- Is_Default := Boolean'Value
- (Get_Attribute (Child_Node, "default", "false"));
- if Traces then
- Put_Line ("MDI Parse_Notebook_Node Width=" & Gint'Image (Width)
- & " Height=" & Gint'Image (Height));
- end if;
+ Print_Debug
+ ("Parse_Notebook_Node: Width=" & Gint'Image (Width)
+ & " Height=" & Gint'Image (Height));
- Notebook := null;
+ Notebook := Create_Notebook (MDI);
+ Print_Debug
+ ("Parse_Notebook_Node: created new notebook "
+ & System.Address_Image (Notebook.all'Address));
- if Child_Node.Child = null
- and then Reuse_Empty_If_Needed
- then
- Notebook := Find_Empty_Notebook (MDI);
- if Notebook /= null then
- Reuse_Empty_If_Needed := False;
- if Traces then
- Put_Line ("MDI Using existing empty notebook "
- & System.Address_Image (Notebook.all'Address));
- end if;
- end if;
- end if;
-
- if Notebook = null then
- Notebook := Create_Notebook (MDI);
- MDI_Notebook (Notebook).Is_Default_Notebook := Is_Default;
- if Traces then
- Put_Line ("MDI About to create new notebook "
- & System.Address_Image (Notebook.all'Address));
- end if;
- end if;
-
Set_Tab_Pos (Notebook, Pos);
Set_Child_Visible (Notebook, True);
Show_All (Notebook);
@@ -4451,16 +4940,13 @@ package body Gtkada.MDI is
-- Child cannot be floating while in a notebook
if Child /= null then
- if Traces then
- Put_Line
- ("MDI: Parse_Notebook_Node, moving child into the"
- & " the notebook");
- end if;
+ Print_Debug
+ ("Parse_Notebook_Node, moving child into the"
+ & " the notebook");
Float_Child (Child, False);
Put_In_Notebook (MDI, Child, Notebook);
- if Traces then
- Put_Line ("MDI: Parse_Notebook_Node, done moving child");
- end if;
+ Print_Debug
+ ("Parse_Notebook_Node, done moving child");
end if;
else
@@ -4471,9 +4957,7 @@ package body Gtkada.MDI is
N := N.Next;
end loop;
- if Traces then
- Put_Line ("MDI Parse_Notebook_Node: done adding all children");
- end if;
+ Print_Debug ("Parse_Notebook_Node: done adding all children");
-- Create a dummy node if necessary, since otherwise the calls to
-- Split afterward will simply discard that notebook. This dummy
@@ -4485,7 +4969,6 @@ package body Gtkada.MDI is
Set_Title (Empty_Notebook_Filler, "<Dummy, notebook filler>");
Put (MDI, Empty_Notebook_Filler);
Put_In_Notebook (MDI, Empty_Notebook_Filler, Notebook);
- MDI_Notebook (Notebook).Is_Default_Notebook := True;
end if;
if Raised_Child /= null then
@@ -4500,6 +4983,8 @@ package body Gtkada.MDI is
Prepend (MDI.Items, Gtk_Widget (Raised_Child));
Unref (Raised_Child);
end if;
+
+ Indent_Debug (-1);
end Parse_Notebook_Node;
----------------------
@@ -4523,21 +5008,84 @@ package body Gtkada.MDI is
W, H : Allocation_Int := -1;
Visible : constant Boolean := Boolean'Value
(Get_Attribute (Child_Node, "visible", "true"));
+ Iter : Child_Iterator;
+ Tmp : MDI_Child;
begin
- Register := Registers;
+ Print_Debug ("Parse_Child_Node");
+ Indent_Debug (1);
+
Child := null;
Raised := False;
State := Normal;
X := 0;
Y := 0;
- if Traces then
- Put_Line ("MDI About to insert child. Will be moved elsewhere");
+ -- Check whether this child was already in a previous perspective.
+ -- If that's the case, reuse it
+
+ Iter := First_Child (MDI, Visible_Only => False);
+ loop
+ Tmp := Get (Iter);
+ exit when Tmp = null;
+
+ -- If not already used in the perspective
+
+ if Tmp.State = Invisible
+ and then Tmp.XML_Node_Name /= null
+ and then Tmp.XML_Node_Name.all = Child_Node.Child.Tag.all
+ then
+ Print_Debug ("Reusing existing hidden view for "
+ & Child_Node.Child.Tag.all);
+ Child := Tmp;
+ Put (MDI, Child); -- put it back in the MDI
+ exit;
+ end if;
+
+ Next (Iter);
+ end loop;
+
+ -- Check whether we have a project-specific contents for this child.
+ -- This always takes priority other any project-independent contents.
+ -- When we have multiple children with the same XML node name, we
+ -- should use the first project-dependent part, then the second,...,
+ -- and not reuse multiple times the first one. To do this, we simply
+ -- remove the nodes from the project-dependent part as we use them,
+ -- which also saves memory.
+
+ N := MDI.View_Contents;
+ if Child = null and then N /= null then
+ N := N.Child;
+ while N /= null loop
+ if N.Tag.all = Child_Node.Child.Tag.all then
+ Register := Registers;
+ while Child = null and then Register /= null loop
+ Child := Register.Load (MDI_Window (MDI), N, User);
+ Register := Register.Next;
+ end loop;
+
+ if Child /= null then
+ Print_Debug ("Found project-specific contents for "
+ & Child_Node.Child.Tag.all);
+
+ Free (N);
+ exit;
+ end if;
+ end if;
+
+ N := N.Next;
+ end loop;
end if;
+ -- Else search for project-specific contents
+
+ Register := Registers;
+
while Child = null and then Register /= null loop
- Child := Register.Load
- (MDI_Window (MDI), Child_Node.Child, User);
+ Child := Register.Load (MDI_Window (MDI), Child_Node.Child, User);
+ if Child /= null then
+ Print_Debug ("Found project-independent contents for "
+ & Child_Node.Child.Tag.all);
+ end if;
Register := Register.Next;
end loop;
@@ -4545,6 +5093,8 @@ package body Gtkada.MDI is
return;
end if;
+ Print_Debug ("Parse_Child_Node: created " & Get_Title (Child));
+
Child.Group := Child_Group'Value
(Get_Attribute (Child_Node, "Group",
Child_Group'Image (Child.Group)));
@@ -4570,10 +5120,10 @@ package body Gtkada.MDI is
elsif N.Tag.all = "Y" then
Y := Gint'Value (N.Value.all);
- elsif N.Tag.all = "Width" then
+ elsif N.Tag.all = "width" then
W := Gint'Value (N.Value.all);
- elsif N.Tag.all = "Height" then
+ elsif N.Tag.all = "height" then
H := Gint'Value (N.Value.all);
else
@@ -4589,331 +5139,301 @@ package body Gtkada.MDI is
end if;
if not Visible then
+ Print_Debug ("Parse_Child_Node: child will be hidden");
Prepend (To_Hide, Gtk_Widget (Child));
end if;
- if Traces then
- Put_Line ("MDI: Parse_Child_Node: done");
- end if;
+ Indent_Debug (-1);
end Parse_Child_Node;
---------------------
+ -- Get_XML_Content --
+ ---------------------
+
+ function Get_XML_Content
+ (MDI : access MDI_Window_Record'Class;
+ Tag : String) return Glib.Xml_Int.Node_Ptr
+ is
+ function Internal_Get_XML_Content
+ (N : Glib.Xml_Int.Node_Ptr) return Glib.Xml_Int.Node_Ptr;
+
+ ------------------------------
+ -- Internal_Get_XML_Content --
+ ------------------------------
+
+ function Internal_Get_XML_Content
+ (N : Glib.Xml_Int.Node_Ptr) return Glib.Xml_Int.Node_Ptr
+ is
+ Node : Glib.Xml_Int.Node_Ptr := N;
+ Child : Glib.Xml_Int.Node_Ptr;
+
+ begin
+ while Node /= null loop
+ if Node.Tag.all = Tag then
+ return Node;
+ end if;
+
+ Child := Internal_Get_XML_Content (Node.Child);
+
+ if Child /= null then
+ return Child;
+ end if;
+
+ Node := Node.Next;
+ end loop;
+
+ return null;
+ end Internal_Get_XML_Content;
+
+ begin
+ return Internal_Get_XML_Content (MDI.View_Contents);
+ end Get_XML_Content;
+
+ ---------------------
-- Parse_Pane_Node --
---------------------
procedure Parse_Pane_Node
- (MDI : access MDI_Window_Record'Class;
+ (Paned : access Gtkada_Multi_Paned_Record'Class;
+ MDI : access MDI_Window_Record'Class;
Node : Node_Ptr;
Focus_Child : in out MDI_Child;
+ Parent_Width, Parent_Height : Gint;
+ Parent_Orientation : Gtk_Orientation;
User : User_Data;
Initial_Ref_Child : Gtk_Notebook := null;
To_Raise : in out Gtk.Widget.Widget_List.Glist;
To_Hide : in out Gtk.Widget.Widget_List.Glist;
- Reuse_Empty_If_Needed : in out Boolean)
+ Empty_Notebook_Filler : in out MDI_Child)
is
Orientation : constant Gtk_Orientation := Gtk_Orientation'Value
(Get_Attribute (Node, "Orientation"));
N : Node_Ptr;
- Width, Height : Gint;
- Ref_Item : Gtk_Notebook := Initial_Ref_Child;
- Count : Natural := 0;
+ Ref_Item : Gtk_Widget := Gtk_Widget (Initial_Ref_Child);
+ Count : constant Natural := Children_Count (Node);
Notebook_Node : Node_Ptr;
+ Width, Height : Gint;
+ Width_For_Children : Gint := Parent_Width;
+ Height_For_Children : Gint := Parent_Height;
+
begin
- if Traces then
- Put_Line
- ("MDI Parsing pane node " & Gtk_Orientation'Image (Orientation));
- end if;
+ Compute_Size_From_Attributes
+ (Node, Parent_Width, Parent_Height, Parent_Orientation,
+ Width_For_Children, Height_For_Children, Count);
- N := Node.Child;
- while N /= null loop
- Count := Count + 1;
- N := N.Next;
- end loop;
+ Print_Debug
+ ("Parse_Pane_Node " & Gtk_Orientation'Image (Orientation)
+ & " children=" & Integer'Image (Count)
+ & " child_size=" & Gint'Image (Width_For_Children)
+ & "x" & Gint'Image (Height_For_Children));
+ Indent_Debug (1);
declare
Notebooks : array (1 .. Count) of Gtk_Notebook;
+ W : Gtk_Widget;
+ Tmp_Width, Tmp_Height : Gint;
+ Tmp_Orientation : Gtk_Orientation;
+ Index : Natural := Notebooks'First;
begin
-- First insert all direct children of the pane, splitting as
-- needed. Only then process the Pane children. Otherwise, the
-- children of Pane will have been split and reorganized so that
-- we won't be able to get a reference item for further splitting.
- Count := Notebooks'First;
N := Node.Child;
while N /= null loop
+ Tmp_Width := Width_For_Children;
+ Tmp_Height := Height_For_Children;
+ Tmp_Orientation := Orientation;
+
-- Find the first notebook node of N
Notebook_Node := N;
while Notebook_Node.Tag /= null
- and then Notebook_Node.Tag.all /= "Notebook"
+ and then Notebook_Node.Tag.all = "Pane"
loop
+ Compute_Size_From_Attributes
+ (Notebook_Node,
+ Parent_Width => Tmp_Width,
+ Parent_Height => Tmp_Height,
+ Parent_Orientation => Tmp_Orientation,
+ Width => Tmp_Width,
+ Height => Tmp_Height,
+ Children_Count => Children_Count (Notebook_Node));
+ Tmp_Orientation := Gtk_Orientation'Value
+ (Get_Attribute (Notebook_Node, "Orientation"));
+ Print_Debug
+ ("Descending into pane while looking for first notebook w="
+ & Gint'Image (Tmp_Width) & "x" & Gint'Image (Tmp_Height));
+
Notebook_Node := Notebook_Node.Child;
end loop;
- if Count = Notebooks'First
+ if Index = Notebooks'First
and then Initial_Ref_Child /= null
then
- Notebooks (Count) := Initial_Ref_Child;
+ Notebooks (Index) := Initial_Ref_Child;
+ W := Gtk_Widget (Initial_Ref_Child);
+
else
- Parse_Notebook_Node
- (MDI => MDI,
- Child_Node => Notebook_Node,
- User => User,
- Focus_Child => Focus_Child,
- Width => Width,
- Height => Height,
- Notebook => Notebooks (Count),
- To_Raise => To_Raise,
- To_Hide => To_Hide,
- Reuse_Empty_If_Needed => Reuse_Empty_If_Needed);
- if Traces then
- Put_Line
- ("MDI: Parse_Pane_Node: done parsing notebook node");
+ if Notebook_Node.Tag.all = "Notebook" then
+ Parse_Notebook_Node
+ (MDI => MDI,
+ Child_Node => Notebook_Node,
+ Parent_Width => Tmp_Width,
+ Parent_Height => Tmp_Height,
+ Parent_Orientation => Tmp_Orientation,
+ User => User,
+ Focus_Child => Focus_Child,
+ Width => Width,
+ Height => Height,
+ Notebook => Notebooks (Index),
+ To_Raise => To_Raise,
+ To_Hide => To_Hide,
+ Empty_Notebook_Filler => Empty_Notebook_Filler);
+
+ W := Gtk_Widget (Notebooks (Index));
+
+ else
+ W := Gtk_Widget (MDI.Central);
+ Compute_Size_From_Attributes
+ (Notebook_Node,
+ Parent_Width => Tmp_Width,
+ Parent_Height => Tmp_Height,
+ Parent_Orientation => Tmp_Orientation,
+ Width => Width,
+ Height => Height,
+ Children_Count => 1);
+
+ Print_Debug ("Parse_Pane_Node: seen <central> size="
+ & Gint'Image (Width) & Gint'Image (Height));
end if;
- if Get_Parent (Notebooks (Count)) = null then
+ if Get_Parent (W) = null then
if Ref_Item = null then
- if Traces then
- Put_Line
- ("MDI: Parse_Pane_Node, add notebook in MDI "
- & System.Address_Image
- (Notebooks (Count).all'Address));
- end if;
- Add_Child (Win => MDI,
- New_Child => Notebooks (Count),
+ Print_Debug
+ ("Parse_Pane_Node, add notebook in MDI "
+ & System.Address_Image (W.all'Address));
+ Add_Child (Win => Paned,
+ New_Child => W,
Orientation => Orientation,
Width => Width,
Height => Height);
else
- if Traces then
- Put_Line
- ("MDI: Parse_Pane_Node Split notebook into MDI "
- & System.Address_Image
- (Notebooks (Count).all'Address)
- & " ref="
- & System.Address_Image (Ref_Item.all'Address)
- & " Orient="
- & Gtk_Orientation'Image (Orientation));
- end if;
- Split (MDI,
+ Print_Debug
+ ("Parse_Pane_Node Split notebook into MDI "
+ & System.Address_Image (W.all'Address)
+ & " ref="
+ & System.Address_Image (Ref_Item.all'Address)
+ & " Orient="
+ & Gtk_Orientation'Image (Orientation));
+ Split (Paned,
Ref_Widget => Ref_Item,
- New_Child => Notebooks (Count),
+ New_Child => W,
Width => Width,
Height => Height,
Orientation => Orientation);
end if;
else
- if Traces then
- Put_Line
- ("MDI: Parse_Pane_Node: notebook already in MDI");
- Set_Size (MDI,
- Notebooks (Count),
- Width => Width,
- Height => Height);
- end if;
+ Print_Debug
+ ("Parse_Pane_Node: notebook already in MDI");
+ Set_Size (Paned,
+ W,
+ Width => Width,
+ Height => Height);
end if;
end if;
- Ref_Item := Notebooks (Count);
- Count := Count + 1;
+ Ref_Item := W;
+ Index := Index + 1;
N := N.Next;
end loop;
-- Now process the Pane children recursively, splitting as needed
+ Print_Debug ("Parse_Pane_Node: now process pane children");
+
N := Node.Child;
- Count := Notebooks'First;
+ Index := Notebooks'First;
while N /= null loop
if N.Tag.all = "Pane" then
Parse_Pane_Node
- (MDI => MDI,
+ (Paned => Paned,
+ MDI => MDI,
Node => N,
Focus_Child => Focus_Child,
User => User,
- Initial_Ref_Child => Notebooks (Count),
+ Parent_Width => Width_For_Children,
+ Parent_Height => Height_For_Children,
+ Parent_Orientation => Orientation,
+ Initial_Ref_Child => Notebooks (Index),
To_Raise => To_Raise,
To_Hide => To_Hide,
- Reuse_Empty_If_Needed => Reuse_Empty_If_Needed);
+ Empty_Notebook_Filler => Empty_Notebook_Filler);
end if;
- Count := Count + 1;
+ Index := Index + 1;
N := N.Next;
end loop;
end;
+
+ Indent_Debug (-1);
end Parse_Pane_Node;
- ---------------------
- -- Restore_Desktop --
- ---------------------
+ ------------------------
+ -- Restore_Multi_Pane --
+ ------------------------
- function Restore_Desktop
- (MDI : access MDI_Window_Record'Class;
- From_Tree : Glib.Xml_Int.Node_Ptr;
- User : User_Data) return Boolean
+ procedure Restore_Multi_Pane
+ (Pane : access Gtkada_Multi_Paned_Record'Class;
+ MDI : access MDI_Window_Record'Class;
+ Focus_Child : in out MDI_Child;
+ To_Raise : in out Gtk.Widget.Widget_List.Glist;
+ To_Hide : in out Gtk.Widget.Widget_List.Glist;
+ Node : Node_Ptr;
+ User : User_Data;
+ Full_Width, Full_Height : Gint)
is
- Child, Focus_Child : MDI_Child;
- Child_Node : Node_Ptr;
- State : State_Type;
- Raised : Boolean;
- X, Y : Gint := 0;
- Items_Removed : Boolean := False;
- To_Raise : Gtk.Widget.Widget_List.Glist;
- To_Hide : Gtk.Widget.Widget_List.Glist;
+ Child_Node : Node_Ptr := Node.Child;
+ Raised : Boolean;
+ X, Y : Gint;
+ Child : MDI_Child;
+ State : State_Type;
- procedure Remove_All_Items (Remove_All_Empty : Boolean);
- -- Remove all the items currently in the MDI.
- -- If Remove_All_Empty is False, then a single empty notebook is kept
- -- if there is one.
- -- Does nothing if called multiple times
+ Empty_Notebook_Filler : MDI_Child;
+ -- Used to fill the empty notebook, and prevent it from being
+ -- destroyed during a desktop load.
- ----------------------
- -- Remove_All_Items --
- ----------------------
-
- procedure Remove_All_Items (Remove_All_Empty : Boolean) is
- Children : Widget_List.Glist;
- L, L2 : Widget_List.Glist;
- Found_Empty : Boolean := Remove_All_Empty;
- Note : Gtk_Notebook;
- begin
- if Traces then
- Put_Line ("MDI Remove_All_Items: remove_empty="
- & Boolean'Image (Remove_All_Empty));
- end if;
- if not Items_Removed then
- -- First loop is to remove all children. We give them a chance
- -- to react to the delete_event, in case they do some cleanup
- -- at that point
- L := MDI.Items;
- while L /= Null_List loop
- L2 := Next (L);
- Close_Child (MDI_Child (Get_Data (L)));
- L := L2;
- end loop;
-
- -- Children that haven't been deleted at this point are those
- -- that refused the delete_event. We thus keep them, since they
- -- might need special handling later on. At worse, we break the
- -- desktop.
-
- -- We now force the closing of all empty notebooks
- Children := Get_Children (MDI);
- L := Children;
- while L /= Null_List loop
- Note := Gtk_Notebook (Get_Data (L));
- if Get_Nth_Page (Note, 0) = null then
- if Found_Empty then
- Remove (MDI, Note);
- else
- Found_Empty := True;
- end if;
- end if;
- L := Next (L);
- end loop;
- Free (Children);
- Items_Removed := True;
- end if;
-
- if Traces then
- Put_Line ("MDI Remove_All_Items: done");
- New_Line;
- New_Line;
- New_Line;
- end if;
- end Remove_All_Items;
-
- Reuse_Empty_If_Needed : Boolean := True;
- Initial_All_Floating_Mode : constant Boolean := MDI.All_Floating_Mode;
- Do_Size_Allocate : Boolean := True;
begin
- if From_Tree = null then
- return False;
- end if;
+ Print_Debug ("Restore_Multi_Pane Full size="
+ & Gint'Image (Full_Width) & "x"
+ & Gint'Image (Full_Height));
+ Indent_Debug (1);
- -- Temporarily disable the user of all floating mode, so that we can
- -- properly restore the desktop even if notebooks are referenced.
- MDI.All_Floating_Mode := False;
- Empty_Notebook_Filler := null;
+ while Child_Node /= null loop
+ Print_Debug
+ ("Restore_Multi_Pane, got child """
+ & Child_Node.Tag.all & """");
- Child_Node := From_Tree.Child;
- pragma Assert (From_Tree.Tag.all = "MDI");
-
- if Traces then
- Put_Line ("MDI Restore_Desktop");
- Put_Line ("Current MDI size is"
- & Gint'Image (Get_Allocation_Width (MDI))
- & "x" & Gint'Image (Get_Allocation_Height (MDI)));
- Put_Line
- ("Current window size is"
- & Gint'Image (Get_Allocation_Width (Get_Toplevel (MDI)))
- & "x"
- & Gint'Image (Get_Allocation_Height (Get_Toplevel (MDI))));
- end if;
-
- MDI.Loading_Desktop := True;
-
- Freeze (MDI);
-
- -- We must restore the size of the main window first, so that the
- -- rest of the desktop makes sense
-
- declare
- Width, Height : Gint;
- State : Gdk_Window_State;
- begin
- State := Gdk_Window_State'Value
- (Get_Attribute (From_Tree, "state", "0"));
-
- if (State and Window_State_Maximized) /= 0 then
- -- Issue: this will not be done immediately, since the
- -- window might not be mapped when loading the initial desktop.
- -- As a result, the first call to Size_Allocate below will
- -- use whatever current size the window has, and thus might
- -- break the desktop. See the call to Realize below
- Maximize (Gtk_Window (Get_Toplevel (MDI)));
- Do_Size_Allocate := False;
- else
- Width :=
- Gint'Value (Get_Attribute (From_Tree, "width", "640"));
- Height :=
- Gint'Value (Get_Attribute (From_Tree, "height", "480"));
-
- Set_Default_Size
- (Gtk_Window (Get_Toplevel (MDI)), Width, Height);
- end if;
- exception
- when others =>
- -- An invalid attribute in XML ?
- null;
- end;
-
- -- Now restore the rest of the desktop
-
- Child_Node := From_Tree.Child;
-
- while Child_Node /= null loop
if Child_Node.Tag.all = "Pane" then
- Remove_All_Items (Remove_All_Empty => True);
Parse_Pane_Node
- (MDI, Child_Node, Focus_Child, User, null,
+ (Pane,
+ MDI => MDI,
+ Node => Child_Node,
+ Focus_Child => Focus_Child,
+ Parent_Width => Full_Width,
+ Parent_Height => Full_Height,
+ Parent_Orientation => Orientation_Horizontal,
+ User => User,
+ Initial_Ref_Child => null,
To_Raise => To_Raise,
To_Hide => To_Hide,
- Reuse_Empty_If_Needed => Reuse_Empty_If_Needed);
+ Empty_Notebook_Filler => Empty_Notebook_Filler);
- elsif Child_Node.Tag.all = "Bottom_Dock_Height" then
- -- An old desktop ? Do not load it at all, and use the default
- -- desktop instead, so that at least we give the user something
- -- looking correct
- return False;
-
elsif Child_Node.Tag.all = "Child" then
-- Used for floating children, and children in the default
-- desktop (see Add_To_Tree)
- -- ??? Why would we want this, in case we already added some
- -- widgets to the tree
- -- Remove_All_Items (Remove_All_Empty => False);
-
Parse_Child_Node
(MDI, Child_Node, User,
Focus_Child, X, Y, Raised, State, Child,
@@ -4926,6 +5446,9 @@ package body Gtkada.MDI is
(Child, True, Position_At_Mouse => False,
X => X, Y => Y);
+ when Invisible =>
+ null;
+
when Normal =>
Float_Child (Child, False);
end case;
@@ -4935,123 +5458,360 @@ package body Gtkada.MDI is
Child_Node := Child_Node.Next;
end loop;
- MDI.Desktop_Was_Loaded := True;
-
- Queue_Resize (MDI);
-
if Empty_Notebook_Filler /= null then
-- The empty notebook has been created during the desktop load
declare
Note : constant Gtk_Notebook :=
Gtk_Notebook (Get_Parent (Empty_Notebook_Filler));
begin
- if Traces then
- Put_Line
- ("MDI: Restore desktop, removing empty_notebook_filler");
- end if;
+ Print_Debug
+ ("Restore desktop, removing empty_notebook_filler");
Remove_Page (Note, 0);
end;
end if;
- Set_All_Floating_Mode (MDI, Initial_All_Floating_Mode);
+ Indent_Debug (-1);
+ end Restore_Multi_Pane;
- -- Raise all appropriate items at the end, so that even if some items
- -- are added temporarily to notebooks, then have no long-lasting
- -- impact on the notebook itself.
+ ---------------------------------
+ -- Recompute_Perspective_Names --
+ ---------------------------------
+
+ procedure Recompute_Perspective_Names
+ (MDI : access MDI_Window_Record'Class)
+ is
+ N : Node_Ptr;
+ Count : Natural := 0;
+ begin
+ Free (MDI.Perspective_Names);
+
+ if MDI.Perspectives /= null then
+ N := MDI.Perspectives.Child;
+
+ while N /= null loop
+ Count := Count + 1;
+ N := N.Next;
+ end loop;
+
+ MDI.Perspective_Names := new GNAT.Strings.String_List (1 .. Count);
+
+ Count := MDI.Perspective_Names'First;
+ N := MDI.Perspectives.Child;
+ while N /= null loop
+ MDI.Perspective_Names (Count) :=
+ new String'(Get_Attribute (N, "name"));
+ Count := Count + 1;
+ N := N.Next;
+ end loop;
+ end if;
+ end Recompute_Perspective_Names;
+
+ ---------------------
+ -- Restore_Desktop --
+ ---------------------
+
+ function Restore_Desktop
+ (MDI : access MDI_Window_Record'Class;
+ Perspectives : Glib.Xml_Int.Node_Ptr;
+ From_Tree : Glib.Xml_Int.Node_Ptr;
+ User : User_Data) return Boolean
+ is
+ To_Raise : Gtk.Widget.Widget_List.Glist;
+ To_Hide : Gtk.Widget.Widget_List.Glist;
+ Focus_Child : MDI_Child;
+ Initial_All_Floating_Mode : constant Boolean := MDI.All_Floating_Mode;
+ Do_Size_Allocate : Boolean := True;
+ MDI_Width, MDI_Height : Gint;
+
+ begin
+ if Perspectives = null
+ or else Perspectives.Child = null -- <perspective> node
+ then
+ -- No desktop to load, but we still have to setup a minimal
+ -- environment to avoid critical errors later on.
+ if MDI.Central /= null then
+ Destroy (MDI.Central);
+ end if;
+
+ Gtk_New (MDI.Central);
+ Add_Child (MDI, MDI.Central);
+ return False;
+ end if;
+
+ Free (MDI.Perspectives);
+ MDI.Perspectives := Deep_Copy (Perspectives);
+ MDI.Current_Perspective := null;
+ Recompute_Perspective_Names (MDI);
+
+ Free (MDI.View_Contents);
+ MDI.View_Contents := Deep_Copy (From_Tree);
+ -- ??? We could save some memory by freeing the <pane> nodes, but is
+ -- there any point ?
+
+ -- Temporarily disable the user of all floating mode, so that we can
+ -- properly restore the desktop even if notebooks are referenced.
+ MDI.All_Floating_Mode := False;
+
+ if From_Tree /= null and then From_Tree.Tag.all /= "desktop" then
+ return False;
+ end if;
+
+ Print_Debug ("Restore_Desktop");
+ Print_Debug ("Current MDI size is"
+ & Gint'Image (Get_Allocation_Width (MDI))
+ & "x" & Gint'Image (Get_Allocation_Height (MDI)));
+ Print_Debug
+ ("Current window size is"
+ & Gint'Image (Get_Allocation_Width (Get_Toplevel (MDI)))
+ & "x"
+ & Gint'Image (Get_Allocation_Height (Get_Toplevel (MDI))));
+
+ -- We must restore the size of the main window first, so that the
+ -- rest of the desktop makes sense.
+
declare
- Item : Widget_List.Glist := To_Raise;
+ State : Gdk_Window_State;
begin
- while Item /= Widget_List.Null_List loop
- Child := MDI_Child (Widget_List.Get_Data (Item));
+ State := Gdk_Window_State'Value
+ (Get_Attribute (Perspectives, "state", "0"));
+
+ if (State and Window_State_Maximized) /= 0 then
+
+ -- Compute the width the window will have when maximized.
+ -- We cannot simply do a Maximize and then read the allocation
+ -- size, since that is asynchronous.
+ -- On many systems, the following calls seem to fail, so we
+ -- just simulate a size (this is irrelevant anyway, since the
+ -- call to Maximize will find the correct size, but it helps
+ -- debugging when we use the real sizes).
+
if Traces then
- Put_Line
- ("MDI: Restore desktop, raising child with no focus "
- & Get_Title (Child));
+ declare
+ Rect : Gdk_Rectangle;
+ begin
+ Get_Monitor_Geometry
+ (Screen => Gdk.Screen.Get_Default,
+ Monitor_Num =>
+ Get_Monitor_At_Window
+ (Gdk.Screen.Get_Default, Get_Window (MDI)),
+ Dest => Rect);
+ MDI_Width := Rect.Width;
+ MDI_Height := Rect.Height;
+ end;
+
+ else
+ MDI_Width := 1000;
+ MDI_Height := 1000;
end if;
- Raise_Child (Child, Give_Focus => False);
- Item := Widget_List.Next (Item);
+
+ Maximize (Gtk_Window (Get_Toplevel (MDI)));
+ Do_Size_Allocate := False;
+
+ Print_Debug
+ ("MDI must be maximized, to size "
+ & Gint'Image (MDI_Width) & "x" & Gint'Image (MDI_Height));
+
+ else
+ MDI_Width :=
+ Gint'Value (Get_Attribute (Perspectives, "width", "640"));
+ MDI_Height :=
+ Gint'Value (Get_Attribute (Perspectives, "height", "480"));
+ Print_Debug
+ ("MDI size computed read from desktop "
+ & Gint'Image (MDI_Width) & "x" & Gint'Image (MDI_Height));
+
+ Set_Default_Size
+ (Gtk_Window (Get_Toplevel (MDI)), MDI_Width, MDI_Height);
+ end if;
+ exception
+ when others =>
+ -- An invalid attribute in XML ?
+ null;
+ end;
+
+ -- Close all existing windows (internal_load_perspective would try to
+ -- preserve them, but they do not apply to the current desktop)
+
+ declare
+ Tmp : Widget_List.Glist := MDI.Items;
+ Tmp2 : Widget_List.Glist;
+ C : MDI_Child;
+ Widget_Node : Node_Ptr;
+ begin
+ while Tmp /= Null_List loop
+ Tmp2 := Next (Tmp);
+
+ -- Do not force closure, we want to keep desktop-independent
+ -- views
+ Close (MDI, MDI_Child (Get_Data (Tmp)));
+ Tmp := Tmp2;
end loop;
- Free (To_Raise);
- Item := To_Hide;
- while Item /= Widget_List.Null_List loop
- Child := MDI_Child (Widget_List.Get_Data (Item));
- Hide (Child);
- Item := Widget_List.Next (Item);
+ Tmp := MDI.Items;
+ while Tmp /= Null_List loop
+ C := MDI_Child (Get_Data (Tmp));
+
+ -- For those items still in the list, we must ensure we know
+ -- their XML node name, otherwise they will never be reused and
+ -- just waste memory (and result in memory leaks)
+
+ if C.XML_Node_Name = null then
+ Widget_Node := Get_XML_For_Widget (Child => C, User => User);
+ Free (Widget_Node);
+ end if;
+
+ Tmp := Next (Tmp);
end loop;
- Free (To_Hide);
end;
- -- Realize the window while frozen, so that windows that insist on
- -- setting their own size when realized (eg. the search window in
- -- GPS) will not break the desktop.
- -- However, don't do this when attempting to maximize the desktop,
- -- since otherwise we get a first Size_Allocate for whatever current
- -- size we have, and then a second one for the maximized size. The
- -- first one breaks the desktop partially.
- if Do_Size_Allocate then
- Realize (MDI);
+ -- Prepare the contents of the central area. This will automatically
+ -- replace the central area's contents in the perspective
+
+ Print_Debug ("+++++++ Destroying central area ++++++");
+
+ if MDI.Central /= null then
+ -- It could come from a previous desktop
+ Destroy (MDI.Central);
end if;
- MDI.Loading_Desktop := False;
- Thaw (MDI);
+ Gtk_New (MDI.Central);
- if Do_Size_Allocate then
- if Traces then
- Put_Line ("MDI: Restore_Desktop, forcing a Size_Allocate");
- end if;
+ -- The central area describes the floating children, so they are not
+ -- part of MDI.Central.
- Size_Allocate
- (MDI,
- Allocation => (X => Get_Allocation_X (MDI),
- Y => Get_Allocation_Y (MDI),
- Width => Get_Allocation_Width (MDI),
- Height => Get_Allocation_Height (MDI)));
+ Print_Debug ("+++++++ Loading central area ++++++");
+
+ To_Raise := Widget_List.Null_List;
+ To_Hide := Widget_List.Null_List;
+
+ if From_Tree /= null then
+ Restore_Multi_Pane
+ (Pane => MDI.Central,
+ MDI => MDI,
+ Focus_Child => Focus_Child,
+ To_Raise => To_Raise,
+ To_Hide => To_Hide,
+ User => User,
+ Node => From_Tree,
+ Full_Width => MDI_Width,
+ Full_Height => MDI_Height);
end if;
- Emit_By_Name (Get_Object (MDI), "children_reorganized" & ASCII.NUL);
+ Set_Child_Visible (MDI.Central, True);
+ -- Now restore the appropriate perspective, which gives the global
+ -- organization of the desktop apart from the default area (which is
+ -- restored later on).
+
+ Internal_Load_Perspective
+ (MDI,
+ Get_Attribute (From_Tree, "perspective", ""),
+ User, Focus_Child => Focus_Child,
+ To_Raise => To_Raise, To_Hide => To_Hide,
+ Width => MDI_Width,
+ Height => MDI_Height,
+ Do_Size_Allocate => Do_Size_Allocate);
+
+ -- And do the actual resizing on the screen
+
+ Set_All_Floating_Mode (MDI, Initial_All_Floating_Mode);
+
if Focus_Child /= null then
- if Traces then
- Put_Line
- ("MDI: Desktop set focus on " & Get_Title (Focus_Child));
- end if;
+ Print_Debug
+ ("Desktop set focus on " & Get_Title (Focus_Child));
Set_Focus_Child (Focus_Child);
end if;
+ Emit_By_Name
+ (Get_Object (MDI), String (Signal_Perspective_Changed) & ASCII.NUL);
+ Emit_By_Name
+ (Get_Object (MDI),
+ String (Signal_Children_Reorganized) & ASCII.NUL);
+
return True;
end Restore_Desktop;
+ ------------------------
+ -- Get_XML_For_Widget --
+ ------------------------
+
+ function Get_XML_For_Widget
+ (Child : MDI_Child;
+ User : User_Data) return Node_Ptr
+ is
+ Register : Register_Node := Registers;
+ Widget_Node : Node_Ptr;
+ begin
+ while Widget_Node = null and then Register /= null loop
+ Widget_Node := Register.Save (Child.Initial, User);
+ Register := Register.Next;
+ end loop;
+
+ if Widget_Node /= null then
+ -- Save the XML node name, which might be useful when switching
+ -- perspectives
+
+ Free (Child.XML_Node_Name);
+ Child.XML_Node_Name := new String'(Widget_Node.Tag.all);
+ end if;
+
+ return Widget_Node;
+ end Get_XML_For_Widget;
+
------------------
-- Save_Desktop --
------------------
- function Save_Desktop
- (MDI : access MDI_Window_Record'Class;
- User : User_Data) return Glib.Xml_Int.Node_Ptr
+ procedure Save_Desktop
+ (MDI : access MDI_Window_Record'Class;
+ User : User_Data;
+ Perspectives : out Glib.Xml_Int.Node_Ptr;
+ Central : out Glib.Xml_Int.Node_Ptr)
is
+ MDI_Width : constant Gint :=
+ Gint (Get_Allocation_Width (Get_Toplevel (MDI)));
+ MDI_Height : constant Gint :=
+ Gint (Get_Allocation_Height (Get_Toplevel (MDI)));
+
Item : Widget_List.Glist;
- Root, Child_Node : Node_Ptr;
- Widget_Node : Node_Ptr;
- Register : Register_Node;
+ Child_Node : Node_Ptr;
Child : MDI_Child;
- Iter : Gtkada.Multi_Paned.Child_Iterator;
procedure Add (Parent : Node_Ptr; Name, Value : String);
-- Add a new child to Child_Node
procedure Save_Widget
- (Parent : Node_Ptr;
- Child : MDI_Child;
- Raised : Boolean);
+ (Parent : Node_Ptr;
+ Child : MDI_Child;
+ Raised : Boolean;
+ In_Central : Boolean);
-- Save the Child. Raised is True if Child is the current page
- -- in a notebook.
+ -- in a notebook. In_Central is True if we are saving a child part of
+ -- the central area of the desktop
- procedure Save_Notebook
- (Current : Node_Ptr; Note : Gtk_Notebook);
+ procedure Save_Size
+ (Iter : Gtkada.Multi_Paned.Child_Iterator;
+ Node : Node_Ptr);
+ -- Set the size of Widget (relative to the total size of the window)
+ -- as attributes of Node
+
+ procedure Save_Paned
+ (Paned : access Gtkada_Multi_Paned_Record'Class;
+ Parent : Node_Ptr;
+ In_Central : Boolean);
+ -- Look through all the notebooks, and save the widgets in the
+ -- notebook order.
+
+ function Save_Notebook
+ (Current : Node_Ptr;
+ Note : Gtk_Notebook;
+ In_Central : Boolean) return Node_Ptr;
-- save all pages of the notebook
+ procedure Prune_Empty (N : in out Node_Ptr);
+ -- Prunes empty panes below N
+
---------
-- Add --
---------
@@ -5070,26 +5830,44 @@ package body Gtkada.MDI is
-----------------
procedure Save_Widget
- (Parent : Node_Ptr;
- Child : MDI_Child;
- Raised : Boolean) is
+ (Parent : Node_Ptr;
+ Child : MDI_Child;
+ Raised : Boolean;
+ In_Central : Boolean)
+ is
+ Widget_Node : Node_Ptr;
+ Tmp_Node : Node_Ptr;
begin
- Register := Registers;
- Widget_Node := null;
+ if Child.State = Invisible then
+ return;
+ end if;
- while Widget_Node = null and then Register /= null loop
- Widget_Node := Register.Save (Child.Initial, User);
- Register := Register.Next;
- end loop;
+ Widget_Node := Get_XML_For_Widget (Child, User);
if Widget_Node /= null then
+ -- We only save the name of the child, not its contents, which
+ -- is project specific and thus goes into the central area's
+ -- XML
+
+ if not In_Central
+ and then
+ (Widget_Node.Child /= null
+ or else Widget_Node.Attributes /= null)
+ then
+ Tmp_Node := new Node;
+ Tmp_Node.Tag := new String'(Widget_Node.Tag.all);
+ Add_Child (Central, Widget_Node, Append => True);
+ else
+ Tmp_Node := Widget_Node;
+ end if;
+
-- Note: We need to insert the children in the opposite order
-- from Restore_Desktop, since the children are added at the
-- beginning of the list.
Child_Node := new Node;
Child_Node.Tag := new String'("Child");
- Add_Child (Child_Node, Widget_Node, Append => True);
+ Add_Child (Child_Node, Tmp_Node, Append => True);
Set_Attribute (Child_Node, "State",
State_Type'Image (Child.State));
@@ -5106,8 +5884,8 @@ package body Gtkada.MDI is
-- decorations, doesn't seem to be a way to do this.
W := Get_Allocation_Width (Win);
H := Get_Allocation_Height (Win);
- Add (Child_Node, "Height", Gint'Image (H));
- Add (Child_Node, "Width", Gint'Image (W));
+ Add (Child_Node, "height", Gint'Image (H));
+ Add (Child_Node, "width", Gint'Image (W));
end;
end if;
@@ -5127,33 +5905,52 @@ package body Gtkada.MDI is
end if;
end Save_Widget;
+ ---------------
+ -- Save_Size --
+ ---------------
+
+ procedure Save_Size
+ (Iter : Gtkada.Multi_Paned.Child_Iterator;
+ Node : Node_Ptr)
+ is
+ Parent_Width, Parent_Height, Width, Height : Gint;
+ Orientation : Gtk_Orientation;
+ begin
+ Get_Size (Iter, Width, Height, Parent_Width, Parent_Height,
+ Orientation);
+
+ case Orientation is
+ when Orientation_Horizontal =>
+ Set_Attribute
+ (Node, "width",
+ Float'Image
+ (Float (Width) * 100.0 / Float (Parent_Width)) & "%");
+ when Orientation_Vertical =>
+ Set_Attribute
+ (Node, "height",
+ Float'Image
+ (Float (Height) * 100.0 / Float (Parent_Height)) & "%");
+ end case;
+ end Save_Size;
+
-------------------
-- Save_Notebook --
-------------------
- procedure Save_Notebook (Current : Node_Ptr; Note : Gtk_Notebook) is
+ function Save_Notebook
+ (Current : Node_Ptr;
+ Note : Gtk_Notebook;
+ In_Central : Boolean) return Node_Ptr
+ is
Length : constant Gint := Get_N_Pages (Note);
Current_Page : constant Gint := Get_Current_Page (Note);
Parent : Node_Ptr;
Has_Default_Group_Child : Boolean := False;
Child : MDI_Child;
- Is_Default_Notebook : Boolean := False;
-
- Border_Width : constant Allocation_Int := 0;
- -- +4 is to take into account the border of the notebook
-
begin
Parent := new Node;
Parent.Tag := new String'("Notebook");
Set_Attribute
- (Parent, "Width",
- Allocation_Int'Image
- (Get_Allocation_Width (Note) + Border_Width));
- Set_Attribute
- (Parent, "Height",
- Allocation_Int'Image
- (Get_Allocation_Height (Note) + Border_Width));
- Set_Attribute
(Parent, "Tabs",
Gtk_Position_Type'Image (Get_Tab_Pos (Note)));
@@ -5166,7 +5963,8 @@ package body Gtkada.MDI is
Save_Widget
(Parent,
Child,
- Raised => Current_Page = Page_Index);
+ Raised => Current_Page = Page_Index,
+ In_Central => In_Central);
end loop;
end if;
@@ -5176,85 +5974,88 @@ package body Gtkada.MDI is
-- in the desktop. Also add the default notebook always, since
-- it plays a special role
- Is_Default_Notebook := MDI_Notebook (Note).Is_Default_Notebook
- or else (Has_Default_Group_Child
- and not Has_Default_Child (MDI, Ignore_Note => Note));
- if Is_Default_Notebook then
- Set_Attribute (Parent, "default", "true");
- end if;
+ Print_Debug
+ ("Saving notebook, Length="
+ & Gint'Image (Length)
+ & " parent.child is null="
+ & Boolean'Image (Parent.Child = null));
- if Traces then
- Put_Line ("Saving notebook, Length="
- & Gint'Image (Length)
- & " Is_Default="
- & Boolean'Image (Is_Default_Notebook)
- & " parent.child is null="
- & Boolean'Image (Parent.Child = null));
- end if;
-
if Length = 0
or else Parent.Child /= null
- or else Is_Default_Notebook
then
Add_Child (Current, Parent, Append => True);
+ return Parent;
else
Free (Parent);
+ return null;
end if;
end Save_Notebook;
- begin
- Root := new Node;
- Root.Tag := new String'("MDI");
+ -----------------
+ -- Prune_Empty --
+ -----------------
- -- Save the general configuration of the MDI
-
- declare
- Win : constant Gtk_Window := Gtk_Window (Get_Toplevel (MDI));
- State : Gdk_Window_State;
- X, Y : Gint;
+ procedure Prune_Empty (N : in out Node_Ptr) is
+ C, Tmp : Node_Ptr;
begin
- if Win /= null then
- State := Get_State (Get_Window (Win));
- if (State and Window_State_Maximized) = 0 then
- Set_Attribute
- (Root, "width",
- Allocation_Int'Image (Get_Allocation_Width (Win)));
- Set_Attribute
- (Root, "height",
- Allocation_Int'Image (Get_Allocation_Height (Win)));
+ if N.Tag.all = "Pane" then
+ C := N.Child;
- Get_Root_Origin (Get_Window (Win), X, Y);
+ while C /= null loop
+ Tmp := C.Next;
+ Prune_Empty (C);
+ C := Tmp;
+ end loop;
- Set_Attribute (Root, "x", Gint'Image (X));
- Set_Attribute (Root, "y", Gint'Image (Y));
+ if N.Child = null then
+ Free (N);
end if;
-
- Set_Attribute (Root, "state", Gdk_Window_State'Image (State));
end if;
- end;
+ end Prune_Empty;
- -- Look through all the notebooks, and save the widgets in the
- -- notebook order.
+ ----------------
+ -- Save_Paned --
+ ----------------
- declare
- Current, N : Node_Ptr;
+ procedure Save_Paned
+ (Paned : access Gtkada_Multi_Paned_Record'Class;
+ Parent : Node_Ptr;
+ In_Central : Boolean)
+ is
+ Current : Node_Ptr := Parent;
+ N : Node_Ptr;
Depth : Natural := 0;
+ Iter : Gtkada.Multi_Paned.Child_Iterator := Start (Paned);
+ Orientation : Gtk_Orientation;
+
begin
- Current := Root;
- Iter := Start (MDI);
while not At_End (Iter) loop
for N in Get_Depth (Iter) + 1 .. Depth loop
Current := Current.Parent;
end loop;
- if Get_Widget (Iter) /= null then
- Save_Notebook (Current, Gtk_Notebook (Get_Widget (Iter)));
+ Orientation := Get_Orientation (Iter);
+
+ if Get_Widget (Iter) = Gtk_Widget (MDI.Central) then
+ N := new Node;
+ N.Tag := new String'("central");
+ Save_Size (Iter, N);
+ Add_Child (Current, N, Append => True);
+
+ elsif Get_Widget (Iter) /= null then
+ N := Save_Notebook
+ (Current, Gtk_Notebook (Get_Widget (Iter)),
+ In_Central => In_Central);
+ if N /= null then
+ Save_Size (Iter, N);
+ end if;
+
else
N := new Node;
N.Tag := new String'("Pane");
Set_Attribute
- (N, "Orientation",
- Gtk_Orientation'Image (Get_Orientation (Iter)));
+ (N, "Orientation", Gtk_Orientation'Image (Orientation));
+ Save_Size (Iter, N);
Add_Child (Current, N, Append => True);
Current := N;
end if;
@@ -5262,57 +6063,95 @@ package body Gtkada.MDI is
Depth := Get_Depth (Iter);
Next (Iter);
end loop;
- end;
- -- A pass to eliminate all empty
+ if Parent.Child /= null then
+ Prune_Empty (Parent.Child);
+ end if;
+ end Save_Paned;
- declare
- procedure Prune_Empty (N : in out Node_Ptr);
- -- Prunes empty panes below N
+ begin
+ if MDI.Perspectives = null then
+ MDI.Perspectives := new Node;
+ MDI.Perspectives.Tag := new String'("perspectives");
+ end if;
- -----------------
- -- Prune_Empty --
- -----------------
+ if MDI.Current_Perspective /= null then
+ -- Replace (in place) the perspective. This is so that the
+ -- order in the /Window/Perspectives menu is preserved as much
+ -- as possible
- procedure Prune_Empty (N : in out Node_Ptr) is
- C : Node_Ptr;
+ declare
+ N : Node_Ptr := MDI.Current_Perspective.Child;
+ N2 : Node_Ptr;
begin
- if N.Tag.all = "Pane" then
- C := N.Child;
+ while N /= null loop
+ N2 := N.Next;
+ Free (N);
+ N := N2;
+ end loop;
+ end;
- while C /= null loop
- Prune_Empty (C);
+ else
+ MDI.Current_Perspective := new Node;
+ MDI.Current_Perspective.Tag := new String'("perspective");
+ Set_Attribute (MDI.Current_Perspective, "name", "default");
+ Add_Child
+ (MDI.Perspectives, MDI.Current_Perspective, Append => False);
+ end if;
- if C /= null then
- C := C.Next;
- end if;
- end loop;
+ Central := new Node;
+ Central.Tag := new String'("desktop");
- if N.Child = null then
- Free (N);
- end if;
+ -- Save the general configuration of the MDI
+
+ declare
+ Win : constant Gtk_Window := Gtk_Window (Get_Toplevel (MDI));
+ State : Gdk_Window_State;
+ begin
+ if Win /= null then
+ State := Get_State (Get_Window (Win));
+ if (State and Window_State_Maximized) = 0 then
+ Set_Attribute
+ (MDI.Perspectives, "width", Gint'Image (MDI_Width));
+ Set_Attribute
+ (MDI.Perspectives, "height", Gint'Image (MDI_Height));
end if;
- end Prune_Empty;
- begin
- Prune_Empty (Root.Child);
+ Set_Attribute
+ (MDI.Perspectives, "state", Gdk_Window_State'Image (State));
+ Set_Attribute
+ (Central, "perspective", Current_Perspective (MDI));
+ end if;
end;
- -- Save the floating widgets
+ Print_Debug ("Save_Desktop: window size reported as"
+ & Gint'Image (MDI_Width) & "x"
+ & Gint'Image (MDI_Height));
+ Save_Paned (MDI, MDI.Current_Perspective, In_Central => False);
+ Save_Paned (MDI.Central, Central, In_Central => True);
+ -- Save the floating widgets (these are part of the perspective)
+
Item := MDI.Items;
while Item /= Widget_List.Null_List loop
Child := MDI_Child (Widget_List.Get_Data (Item));
case Child.State is
- when Normal => null;
- when Floating => Save_Widget (Root, Child, False);
+ when Normal | Invisible => null;
+ when Floating =>
+ Save_Widget (Central, Child, False, In_Central => True);
end case;
Item := Widget_List.Next (Item);
end loop;
- return Root;
+ Perspectives := Deep_Copy (MDI.Perspectives);
+
+ if Traces then
+ Print_Debug ("After saving the desktop (current perspective is "
+ & Current_Perspective (MDI) & "), desktop is");
+ Print (MDI.Perspectives);
+ end if;
end Save_Desktop;
---------------------------------------
@@ -5331,6 +6170,290 @@ package body Gtkada.MDI is
end loop;
end Free_Registered_Desktop_Functions;
+ -------------------------------
+ -- Internal_Load_Perspective --
+ -------------------------------
+
+ procedure Internal_Load_Perspective
+ (MDI : access MDI_Window_Record'Class;
+ Name : String;
+ User : User_Data;
+ Focus_Child : in out MDI_Child;
+ To_Raise : in out Gtk.Widget.Widget_List.Glist;
+ To_Hide : in out Gtk.Widget.Widget_List.Glist;
+ Width, Height : Gint := 0;
+ Do_Size_Allocate : Boolean)
+ is
+ Child : MDI_Child;
+
+ procedure Remove_All_Items (Remove_All_Empty : Boolean);
+ -- Remove all items from the MDI
+
+ ----------------------
+ -- Remove_All_Items --
+ ----------------------
+
+ procedure Remove_All_Items (Remove_All_Empty : Boolean) is
+ Children : Widget_List.Glist;
+ L : Widget_List.Glist;
+ Note : Gtk_Notebook;
+ C : MDI_Child;
+ begin
+ Print_Debug ("Remove_All_Items: remove_empty="
+ & Boolean'Image (Remove_All_Empty));
+ Indent_Debug (1);
+
+ -- Remove all children from the MDI. However, we do not close them
+ -- in case we switch back to the perspective (or the user opens
+ -- them while in the perspective). They will just be marked as
+ -- Invisible for now.
+
+ L := MDI.Items;
+ while L /= Null_List loop
+ C := MDI_Child (Get_Data (L));
+
+ if C.State = Normal
+ and then not In_Central_Area (MDI, C)
+ then
+ Print_Debug ("Remove_All_Items, markgin "
+ & Get_Title (C) & " as invisible");
+ Ref (C); -- Unref called in Destroy_Child and Put
+ Remove (Gtk_Container (Get_Parent (C)), C);
+
+ C.State := Invisible;
+
+ if C.Menu_Item /= null then
+ Destroy (C.Menu_Item);
+ end if;
+ end if;
+
+ L := Next (L);
+ end loop;
+
+ -- We now force the closing of all empty notebooks
+ -- The central area should no longer be part of the MDI at this
+ -- stage, so all we get are notebooks
+
+ Children := Get_Children (MDI);
+ L := Children;
+ while L /= Null_List loop
+ Note := Gtk_Notebook (Get_Data (L));
+ if Get_Nth_Page (Note, 0) = null then
+ Remove (MDI, Note);
+ end if;
+ L := Next (L);
+ end loop;
+ Free (Children);
+
+ -- We used to close empty notebooks, but in fact such notebooks
+ -- can now only be in the central area, whose contents has not
+ -- changed anyway.
+
+ Indent_Debug (-1);
+ Print_Debug ("Remove_All_Items: done");
+ end Remove_All_Items;
+
+ MDI_Width, MDI_Height : Gint;
+ Tmp_Persp : Node_Ptr;
+
+ begin
+ -- Find the right perspective node
+
+ Tmp_Persp := MDI.Perspectives.Child;
+ while Tmp_Persp /= null
+ and then Get_Attribute (Tmp_Persp, "name") /= Name
+ loop
+ Tmp_Persp := Tmp_Persp.Next;
+ end loop;
+
+ if Tmp_Persp = null then
+ -- If not found, and we already have a perspective => do nothing
+
+ if MDI.Current_Perspective /= null then
+ return;
+ end if;
+
+ -- Else load the first one
+ Print_Debug ("Perspective not found, loading default one");
+ Tmp_Persp := MDI.Perspectives.Child;
+ end if;
+
+ MDI.Current_Perspective := Tmp_Persp;
+
+ Print_Debug ("+++++++ Loading perspective " & Name
+ & " ++++++");
+
+ -- Get the size of the MDI
+
+ if Width = 0 then
+ MDI_Width := Gint (Get_Allocation_Width (MDI));
+ else
+ MDI_Width := Width;
+ end if;
+
+ if Height = 0 then
+ MDI_Height := Gint (Get_Allocation_Height (MDI));
+ else
+ MDI_Height := Height;
+ end if;
+
+ Print_Debug ("MDI size reported as "
+ & Gint'Image (MDI_Width)
+ & Gint'Image (MDI_Height));
+
+ -- Remove central from the MDI, and it will be put in the new
+ -- perspective
+ Ref (MDI.Central);
+ if Get_Parent (MDI.Central) /= null then
+ Remove (Gtk_Container (Get_Parent (MDI.Central)), MDI.Central);
+ end if;
+
+ MDI.Loading_Desktop := True;
+ Freeze (MDI);
+
+ -- Clean up MDI if necessary
+
+ Remove_All_Items (Remove_All_Empty => True);
+
+ if Traces then
+ Print_Debug ("Done removing all children, desktop is now:");
+ Dump (MDI);
+ end if;
+
+ Restore_Multi_Pane
+ (Pane => MDI,
+ MDI => MDI,
+ Focus_Child => Focus_Child,
+ To_Raise => To_Raise,
+ To_Hide => To_Hide,
+ User => User,
+ Node => MDI.Current_Perspective,
+ Full_Width => MDI_Width,
+ Full_Height => MDI_Height);
+
+ -- If the central area was not in the desktop, that's an error and
+ -- the application will not be usable anyway, so better break the
+ -- desktop but show the central area
+
+ if Get_Parent (MDI.Central) = null then
+ Add_Child (MDI, MDI.Central);
+ end if;
+
+ MDI.Desktop_Was_Loaded := True;
+ Queue_Resize (MDI);
+
+ -- Raise all appropriate items at the end, so that even if some items
+ -- are added temporarily to notebooks, they have no long-lasting
+ -- impact on the notebook itself.
+ declare
+ Item : Widget_List.Glist := To_Raise;
+ begin
+ while Item /= Widget_List.Null_List loop
+ Child := MDI_Child (Widget_List.Get_Data (Item));
+ Print_Debug
+ ("Restore_Desktop, raising child with no focus "
+ & Get_Title (Child));
+ Raise_Child (Child, Give_Focus => False);
+ Item := Widget_List.Next (Item);
+ end loop;
+ Free (To_Raise);
+
+ Print_Debug ("Restore_Desktop, hidding children");
+ Item := To_Hide;
+ while Item /= Widget_List.Null_List loop
+ Child := MDI_Child (Widget_List.Get_Data (Item));
+ Print_Debug
+ ("Restore_Desktop, hidding " & Get_Title (Child));
+ Hide (Child);
+ Item := Widget_List.Next (Item);
+ end loop;
+ Free (To_Hide);
+
+ if Traces then
+ Dump (MDI);
+ end if;
+ end;
+
+ Reset_Title_Bars_And_Colors (MDI);
+
+ Show_All (MDI);
+
+ -- If Central was not part of the perspective (an error...), we let
+ -- gtk+ display an error message. We cannot simply Add_Child the
+ -- central area to the MDI, since that doesn't seem to work correctly
+
+ Realize (MDI.Central);
+ Show_All (MDI.Central);
+ Unref (MDI.Central);
+
+ MDI.Loading_Desktop := False;
+ Thaw (MDI);
+
+ -- Update to show which menu is active
+ Create_Perspective_Menu (MDI, User);
+
+ -- Realize the window while frozen, so that windows that insist on
+ -- setting their own size when realized (eg. the search window in
+ -- GPS) will not break the desktop.
+ -- However, don't do this when attempting to maximize the desktop,
+ -- since otherwise we get a first Size_Allocate for whatever current
+ -- size we have, and then a second one for the maximized size. The
+ -- first one breaks the desktop partially.
+
+ if Do_Size_Allocate then
+ Print_Debug ("Internal_Load_Perspective, forcing a Size_Allocate");
+ Realize (MDI.Central);
+ Realize (MDI);
+ Size_Allocate
+ (MDI,
+ Allocation => (X => Get_Allocation_X (MDI),
+ Y => Get_Allocation_Y (MDI),
+ Width => Get_Allocation_Width (MDI),
+ Height => Get_Allocation_Height (MDI)));
+ end if;
+ end Internal_Load_Perspective;
+
+ ----------------------
+ -- Load_Perspective --
+ ----------------------
+
+ procedure Load_Perspective
+ (MDI : access MDI_Window_Record'Class;
+ Name : String;
+ User : User_Data)
+ is
+ To_Raise : Gtk.Widget.Widget_List.Glist;
+ To_Hide : Gtk.Widget.Widget_List.Glist;
+ Focus_Child : MDI_Child;
+ Perspectives : Node_Ptr;
+ begin
+ -- Save modifications to current perspective, so that we can restore
+ -- them when the user switches back to that perspective. A signal
+ -- "perspective_changed" will be sent to the user, so that he has a
+ -- chance to save the changes in an external file for persistency
+
+ Print_Debug ("++++++ Load_Perspective " & Name);
+ if MDI.Current_Perspective /= null then
+ if Get_Attribute (MDI.Current_Perspective, "name") = Name then
+ return;
+ end if;
+
+ -- We only rely on the side effect of changing MDI.Perspectives,
+ -- since the central area does not change in any case
+ Free (MDI.View_Contents);
+ Save_Desktop (MDI, User, Perspectives, MDI.View_Contents);
+ Free (Perspectives);
+ end if;
+
+ Print_Debug ("++++ Load_Perspective, desktop was saved, now loading");
+ Internal_Load_Perspective
+ (MDI, Name, User,
+ Focus_Child => Focus_Child,
+ To_Raise => To_Raise,
+ To_Hide => To_Hide,
+ Do_Size_Allocate => True);
+ end Load_Perspective;
+
end Desktop;
-----------------
@@ -5339,40 +6462,55 @@ package body Gtkada.MDI is
function First_Child
(MDI : access MDI_Window_Record;
- Group_By_Notebook : Boolean := False) return Child_Iterator
+ Group_By_Notebook : Boolean := False;
+ Visible_Only : Boolean := True) return Child_Iterator
is
Children : Widget_List.Glist;
+ C : MDI_Child;
begin
if Group_By_Notebook then
- Children := Get_Children (MDI);
- if Children /= Null_List then
- declare
- Iter : Child_Iterator :=
- (Group_By_Notebook => True,
- Notebook => Gtk_Notebook (Get_Data (Children)),
- Notebook_Page => 0,
- Floating_Iter => MDI.Items,
- MDI => MDI_Window (MDI));
- begin
- while Iter.Floating_Iter /= Null_List
- and then MDI_Child
- (Widget_List.Get_Data (Iter.Floating_Iter)).State /= Floating
- loop
- Iter.Floating_Iter := Widget_List.Next (Iter.Floating_Iter);
- end loop;
+ declare
+ Iter : Child_Iterator :=
+ (Group_By_Notebook => True,
+ Visible_Only => Visible_Only,
+ Paned_Iter => Start (MDI),
+ In_Central => False,
+ Notebook => null,
+ Notebook_Page => 0,
+ Floating_Iter => MDI.Items,
+ MDI => MDI_Window (MDI));
+ begin
+ if MDI.Central /= null then
+ Iter.Paned_Iter := Start (MDI.Central);
+ Iter.In_Central := True;
+ end if;
- Free (Children);
- return Iter;
- end;
- else
- return (Group_By_Notebook => True,
- Notebook => null,
- Notebook_Page => Gint'Last,
- Floating_Iter => Null_List,
- MDI => MDI_Window (MDI));
+ Move_To_Next_Notebook (Iter);
+
+ while Iter.Floating_Iter /= Null_List
+ and then MDI_Child
+ (Widget_List.Get_Data (Iter.Floating_Iter)).State /= Floating
+ loop
+ Iter.Floating_Iter := Widget_List.Next (Iter.Floating_Iter);
+ end loop;
+
+ return Iter;
+ end;
+ else
+ Children := MDI.Items;
+
+ if Children /= Widget_List.Null_List and then Visible_Only then
+ C := MDI_Child (Widget_List.Get_Data (MDI.Items));
+ if C.State = Invisible then
+ -- There are no visible child, since the first one should be
+ -- the one with the focus
+ Children := Widget_List.Null_List;
+ end if;
end if;
- else
- return (Group_By_Notebook => False, Iter => MDI.Items);
+
+ return (Group_By_Notebook => False,
+ Visible_Only => Visible_Only,
+ Iter => Children);
end if;
end First_Child;
@@ -5381,26 +6519,73 @@ package body Gtkada.MDI is
------------------
function Get_Notebook
- (Iterator : Child_Iterator) return Gtk.Notebook.Gtk_Notebook is
+ (Iterator : Child_Iterator) return Gtk.Notebook.Gtk_Notebook
+ is
+ C : constant MDI_Child := Get (Iterator);
begin
- return Get_Notebook (Get (Iterator));
+ if C = null then
+ return null;
+ else
+ return Get_Notebook (C);
+ end if;
end Get_Notebook;
+ ---------------------------
+ -- Move_To_Next_Notebook --
+ ---------------------------
+
+ procedure Move_To_Next_Notebook (Iterator : in out Child_Iterator) is
+ begin
+ Iterator.Notebook := null;
+ Iterator.Notebook_Page := 0;
+
+ loop
+ if At_End (Iterator.Paned_Iter) then
+ if Iterator.In_Central then
+ Iterator.In_Central := False;
+ Iterator.Paned_Iter := Start (Iterator.MDI);
+ exit when At_End (Iterator.Paned_Iter);
+ else
+ exit;
+ end if;
+ end if;
+
+ -- Assert (not At_End (Iterator.Paned_Iter))
+
+ if Get_Widget (Iterator.Paned_Iter) /= null
+ and then
+ (not Iterator.Visible_Only
+ or else Visible_Is_Set (Get_Widget (Iterator.Paned_Iter)))
+ and then Get_Widget (Iterator.Paned_Iter).all
+ in Gtk_Notebook_Record'Class
+ then
+ Iterator.Notebook :=
+ Gtk_Notebook (Get_Widget (Iterator.Paned_Iter));
+ exit;
+ end if;
+
+ Next (Iterator.Paned_Iter);
+ end loop;
+ end Move_To_Next_Notebook;
+
----------
-- Next --
----------
procedure Next (Iterator : in out Child_Iterator) is
- Children, Child : Widget_List.Glist;
+ C : MDI_Child;
begin
if Iterator.Group_By_Notebook then
if Iterator.Notebook = null then
-- Find the next floating child
- while Iterator.Iter /= Null_List
- and then MDI_Child (Widget_List.Get_Data (Iterator.Iter)).State
- /= Floating
loop
- Iterator.Iter := Widget_List.Next (Iterator.Iter);
+ Iterator.Floating_Iter :=
+ Widget_List.Next (Iterator.Floating_Iter);
+
+ exit when Iterator.Floating_Iter = Null_List
+ or else MDI_Child
+ (Widget_List.Get_Data (Iterator.Floating_Iter)).State =
+ Floating;
end loop;
else
@@ -5408,29 +6593,21 @@ package body Gtkada.MDI is
if Get_Nth_Page
(Iterator.Notebook, Iterator.Notebook_Page) = null
then
- Iterator.Notebook_Page := 0;
- Children := Get_Children (Iterator.MDI);
- Child := First (Children);
-
- while Child /= Null_List
- and then Get_Data (Child) /= Gtk_Widget (Iterator.Notebook)
- loop
- Child := Next (Child);
- end loop;
-
- if Child = Null_List or else Next (Child) = Null_List then
- Iterator.Notebook := null;
- -- We will start returning floating children
- else
- Iterator.Notebook := Gtk_Notebook (Get_Data (Next (Child)));
- end if;
-
- Free (Children);
+ Next (Iterator.Paned_Iter);
+ Move_To_Next_Notebook (Iterator);
end if;
end if;
else
- Iterator.Iter := Widget_List.Next (Iterator.Iter);
+ loop
+ Iterator.Iter := Widget_List.Next (Iterator.Iter);
+ if Iterator.Visible_Only then
+ C := Get (Iterator);
+ exit when C = null or else C.State /= Invisible;
+ else
+ exit;
+ end if;
+ end loop;
end if;
end Next;
@@ -5549,27 +6726,58 @@ package body Gtkada.MDI is
-- Draw_Dnd_Rectangle --
------------------------
- procedure Draw_Dnd_Rectangle (MDI : access MDI_Window_Record'Class) is
+ procedure Draw_Dnd_Rectangle
+ (MDI : access MDI_Window_Record'Class;
+ Mode : Dnd_Rectangle_Mode;
+ Ref_Window : Gdk.Gdk_Window := null)
+ is
+ Root_X, Root_Y : Gint;
+ Success : Boolean;
begin
- if MDI.Dnd_Xor_GC = null then
- Gdk_New (MDI.Dnd_Xor_GC, Get_Window (MDI));
- Set_Function (MDI.Dnd_Xor_GC, Invert);
- Set_Exposures (MDI.Dnd_Xor_GC, False);
- Set_Subwindow (MDI.Dnd_Xor_GC, Include_Inferiors);
- Set_Line_Attributes
- (MDI.Dnd_Xor_GC, 2, Line_On_Off_Dash, Cap_Not_Last, Join_Bevel);
- end if;
+ case Mode is
+ when Destroy =>
+ if MDI.Dnd_Target_Window /= null then
+ Destroy (MDI.Dnd_Target_Window);
+ MDI.Dnd_Target_Window := null;
+ end if;
- if MDI.Dnd_Rectangle_Owner /= null then
- Draw_Rectangle
- (MDI.Dnd_Rectangle_Owner,
- MDI.Dnd_Xor_GC,
- False,
- MDI.Dnd_Rectangle.X,
- MDI.Dnd_Rectangle.Y,
- MDI.Dnd_Rectangle.Width,
- MDI.Dnd_Rectangle.Height);
- end if;
+ when Hide =>
+ if MDI.Dnd_Target_Window /= null then
+ Hide (MDI.Dnd_Target_Window);
+ end if;
+
+ when Show =>
+ if MDI.Dnd_Target_Window = null then
+ Gtk_New (MDI.Dnd_Target_Window, Window_Popup);
+ Set_Transient_For
+ (MDI.Dnd_Target_Window, Gtk_Window (Get_Toplevel (MDI)));
+ Set_Events (MDI.Dnd_Target_Window, Exposure_Mask);
+ Modify_Bg
+ (MDI.Dnd_Target_Window, State_Normal, MDI.Focus_Title_Color);
+ Set_Decorated (MDI.Dnd_Target_Window, False);
+ Set_Accept_Focus (MDI.Dnd_Target_Window, False);
+
+ Realize (MDI.Dnd_Target_Window);
+
+ -- This will not work on all Unix platforms, though...
+ Set_Opacity (Get_Window (MDI.Dnd_Target_Window), 0.5);
+ end if;
+
+ Resize (MDI.Dnd_Target_Window,
+ MDI.Dnd_Rectangle.Width, MDI.Dnd_Rectangle.Height);
+
+ Get_Origin (Ref_Window, Root_X, Root_Y, Success);
+
+ Move (MDI.Dnd_Target_Window,
+ Root_X + MDI.Dnd_Rectangle.X,
+ Root_Y + MDI.Dnd_Rectangle.Y);
+
+ -- Keep the text above, for readability, especially when the
+ -- dnd window is not transparent
+ Gdk_Raise (Get_Window (MDI.Dnd_Window));
+
+ Show (MDI.Dnd_Target_Window);
+ end case;
end Draw_Dnd_Rectangle;
----------------------
@@ -5589,10 +6797,8 @@ package body Gtkada.MDI is
-- We have to raise the child, since otherwise the Pointer_Grab below
-- will fail
- if Traces then
- Put_Line ("MDI: Child_Drag_Begin, focus and raise "
+ Print_Debug ("Child_Drag_Begin, focus and raise "
& Get_Title (Child));
- end if;
Set_Focus_Child (Child);
Raise_Child (Child, False);
@@ -5617,10 +6823,10 @@ package body Gtkada.MDI is
Child.MDI.Drag_Start_X := Gint (Get_X_Root (Event));
Child.MDI.Drag_Start_Y := Gint (Get_Y_Root (Event));
Child.MDI.In_Drag := In_Pre_Drag;
- Child.MDI.Dnd_Rectangle_Owner := null;
Child.MDI.Dnd_Rectangle := (0, 0, 0, 0);
- elsif Traces then
- Put_Line ("MDI: Child is floating, did not initiate DnD");
+
+ else
+ Print_Debug ("Child is floating, did not initiate DnD");
end if;
end Child_Drag_Begin;
@@ -5630,9 +6836,7 @@ package body Gtkada.MDI is
procedure Cancel_Child_Drag (Child : access MDI_Child_Record'Class) is
begin
- if Traces then
- Put_Line ("MDI: Cancel_Child_Drag");
- end if;
+ Print_Debug ("Cancel_Child_Drag");
Pointer_Ungrab;
Child.MDI.In_Drag := No_Drag;
@@ -5665,6 +6869,15 @@ package body Gtkada.MDI is
begin
Window_At_Pointer (X, Y, Win);
+ if (MDI.Dnd_Target_Window /= null
+ and then Win = Get_Window (MDI.Dnd_Target_Window))
+ or else
+ (MDI.Dnd_Window /= null
+ and then Win = Get_Window (MDI.Dnd_Window))
+ then
+ Win := MDI.Dnd_Target;
+ end if;
+
if Win = null then
Position := Position_Automatic;
Parent := null;
@@ -5674,9 +6887,12 @@ package body Gtkada.MDI is
while Current /= null
and then Current /= Gtk_Widget (MDI)
+ and then Current.all not in Gtkada_Multi_Paned_Record'Class
and then Get_Parent (Current) /= null
- and then (Current.all not in Gtk_Notebook_Record'Class
- or else Get_Parent (Current) /= Gtk_Widget (MDI))
+ and then
+ (Current.all not in Gtk_Notebook_Record'Class
+ or else Get_Parent (Current).all
+ not in Gtkada_Multi_Paned_Record'Class)
and then Get_Parent (Current) /= Gtk_Widget (MDI)
loop
Current := Get_Parent (Current);
@@ -5691,75 +6907,122 @@ package body Gtkada.MDI is
end if;
if Current = Gtk_Widget (MDI) then
- Current := Gtk_Widget (Find_Empty_Notebook (MDI));
- end if;
+ Current := Gtk_Widget (MDI.Central);
- if Current = null then
- Parent := null;
- Position := Position_Automatic;
- return;
+ -- Central area not empty ? We have therefore passed the mouse on
+ -- one of the handles, and should not allow a drop there
+
+ if not At_End (Start (MDI.Central)) then
+ Position := Position_Automatic;
+ Parent := null;
+ return;
+ end if;
end if;
Parent := Current;
- Rectangle :=
- (X => Get_Allocation_X (Parent),
- Y => Get_Allocation_Y (Parent),
- Width => Get_Allocation_Width (Parent),
- Height => Get_Allocation_Height (Parent));
+ -- Are we on the sides of the MDI itself ?
- -- Never split the empty area
- if Get_Nth_Page (Gtk_Notebook (Current), 0) = null then
- Position := Position_Automatic;
- return;
- end if;
+ Rectangle :=
+ (X => 0,
+ Y => 0,
+ Width => Get_Allocation_Width (MDI),
+ Height => Get_Allocation_Height (MDI));
- Get_Pointer (Parent, X, Y);
+ Get_Pointer (MDI, X, Y);
- Border_Height := Gint'Min
- (Max_Drag_Border_Width, Get_Allocation_Height (Parent) / 3);
- Border_Width := Gint'Min
- (Max_Drag_Border_Width, Get_Allocation_Width (Parent) / 3);
-
- if Y < Border_Height then
+ if Y < Max_Drag_Border_Width / 2 then
Position := Position_Top;
+ Parent := Gtk_Widget (MDI);
Rectangle :=
(X => 0,
Y => 0,
- Width => Get_Allocation_Width (Parent),
- Height => Border_Height);
+ Width => Rectangle.Width,
+ Height => Max_Drag_Border_Width / 2);
- elsif Y > Get_Allocation_Height (Parent) - Border_Height then
+ elsif Y > Rectangle.Height - Max_Drag_Border_Width / 2 then
Position := Position_Bottom;
+ Parent := Gtk_Widget (MDI);
Rectangle :=
(X => 0,
- Y => Get_Allocation_Height (Parent) - Border_Height,
- Width => Get_Allocation_Width (Parent),
- Height => Border_Height);
+ Y => Rectangle.Height - Max_Drag_Border_Width / 2,
+ Width => Rectangle.Width,
+ Height => Max_Drag_Border_Width / 2);
- elsif X < Border_Width then
+ elsif X < Max_Drag_Border_Width / 2 then
Position := Position_Left;
+ Parent := Gtk_Widget (MDI);
Rectangle :=
(X => 0,
Y => 0,
- Width => Border_Width,
- Height => Get_Allocation_Height (Parent));
+ Width => Max_Drag_Border_Width / 2,
+ Height => Rectangle.Height);
- elsif X > Get_Allocation_Width (Parent) - Border_Width then
+ elsif X > Rectangle.Width - Max_Drag_Border_Width / 2 then
Position := Position_Right;
+ Parent := Gtk_Widget (MDI);
Rectangle :=
- (X => Get_Allocation_Width (Parent) - Border_Width,
+ (X => Rectangle.Width - Max_Drag_Border_Width / 2,
Y => 0,
- Width => Border_Width,
- Height => Get_Allocation_Height (Parent));
+ Width => Max_Drag_Border_Width / 2,
+ Height => Rectangle.Height);
else
- Position := Position_Automatic;
+ -- Are we on the sides of the current MDI child ?
+
Rectangle :=
- (X => Border_Width,
- Y => Border_Height,
- Width => Get_Allocation_Width (Parent) - 2 * Border_Width,
- Height => Get_Allocation_Height (Parent) - 2 * Border_Height);
+ (X => Get_Allocation_X (Parent),
+ Y => Get_Allocation_Y (Parent),
+ Width => Get_Allocation_Width (Parent),
+ Height => Get_Allocation_Height (Parent));
+
+ Get_Pointer (Parent, X, Y);
+
+ Border_Height := Gint'Min
+ (Max_Drag_Border_Width, Rectangle.Height / 3);
+ Border_Width :=
+ Gint'Min (Max_Drag_Border_Width, Rectangle.Width / 3);
+
+ if Y < Border_Height then
+ Position := Position_Top;
+ Rectangle :=
+ (X => 0,
+ Y => 0,
+ Width => Rectangle.Width,
+ Height => Border_Height);
+
+ elsif Y > Rectangle.Height - Border_Height then
+ Position := Position_Bottom;
+ Rectangle :=
+ (X => 0,
+ Y => Rectangle.Height - Border_Height,
+ Width => Rectangle.Width,
+ Height => Border_Height);
+
+ elsif X < Border_Width then
+ Position := Position_Left;
+ Rectangle :=
+ (X => 0,
+ Y => 0,
+ Width => Border_Width,
+ Height => Rectangle.Height);
+
+ elsif X > Rectangle.Width - Border_Width then
+ Position := Position_Right;
+ Rectangle :=
+ (X => Rectangle.Width - Border_Width,
+ Y => 0,
+ Width => Border_Width,
+ Height => Rectangle.Height);
+
+ else
+ Position := Position_Automatic;
+ Rectangle :=
+ (X => Border_Width,
+ Y => Border_Height,
+ Width => Rectangle.Width - 2 * Border_Width,
+ Height => Rectangle.Height - 2 * Border_Height);
+ end if;
end if;
if No_Window_Is_Set (Parent) then
@@ -5769,4 +7032,30 @@ package body Gtkada.MDI is
end if;
end Get_Dnd_Target;
+ --------------------------
+ -- List_Of_Perspectives --
+ --------------------------
+
+ function List_Of_Perspectives
+ (MDI : access MDI_Window_Record)
+ return GNAT.Strings.String_List_Access
+ is
+ begin
+ return MDI.Perspective_Names;
+ end List_Of_Perspectives;
+
+ -------------------------
+ -- Current_Perspective --
+ -------------------------
+
+ function Current_Perspective
+ (MDI : access MDI_Window_Record'Class) return String is
+ begin
+ if MDI.Current_Perspective = null then
+ return "";
+ else
+ return Get_Attribute (MDI.Current_Perspective, "name", "");
+ end if;
+ end Current_Perspective;
+
end Gtkada.MDI;
============================================================
--- src/gtkada-mdi.ads 5cad0b6e59bf19be60d10bed1332407e767d99ca
+++ src/gtkada-mdi.ads 9be971009fd7cc9cd75d0d293982c6e67a6970cc
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
--- Copyright (C) 2001-2007 AdaCore --
+-- Copyright (C) 2001-2010, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -28,6 +28,7 @@ with Ada.Tags;
-- <group>Layout containers</group>
with Ada.Tags;
+with GNAT.Strings;
with Glib; use Glib;
with Glib.Xml_Int;
with Gdk.GC;
@@ -51,6 +52,7 @@ with Gtk.Window;
with Gtk.Radio_Menu_Item;
with Gtk.Widget;
with Gtk.Window;
+with Gtkada.Handlers;
with Gtkada.Multi_Paned;
with Pango.Font;
with Pango.Layout;
@@ -65,6 +67,7 @@ package Gtkada.MDI is
type MDI_Child_Record is new Gtk.Event_Box.Gtk_Event_Box_Record
with private;
type MDI_Child is access all MDI_Child_Record'Class;
+ pragma No_Strict_Aliasing (MDI_Child);
-- A child of the MDI, that encapsulates the widgets you have put in the
-- MDI window.
-- You can easily convert from this to the initial widget using the
@@ -73,13 +76,16 @@ package Gtkada.MDI is
type MDI_Child_Array is array (Natural range <>) of MDI_Child;
No_Children : constant MDI_Child_Array := (1 .. 0 => null);
- type State_Type is (Normal, Floating);
+ type State_Type is (Normal, Floating, Invisible);
-- This type indicates the state of an item in the MDI:
-- - Normal: the item can be manipulated (moved and resized) by the user.
-- It is found either in the middle notebook (maximized items), or
-- in the layout.
-- - Floating: the item has its own toplevel window, and is thus managed
-- by the window manager.
+ -- - Invisible: the child was part of a previously displayed perspective,
+ -- but is no longer in the current perspective. We still keep it to
+ -- reuse it when switching back to the previous perspective.
procedure Gtk_New
(MDI : out MDI_Window;
@@ -105,6 +111,7 @@ package Gtkada.MDI is
-- Parent must be the toplevel window that contains the MDI.
type Show_Tabs_Policy_Enum is (Always, Never, Automatic);
+ type Title_Bars_Policy is (Always, Never, Central_Only);
procedure Configure
(MDI : access MDI_Window_Record;
@@ -114,7 +121,7 @@ package Gtkada.MDI is
Background_Color : Gdk.Color.Gdk_Color := Gdk.Color.Null_Color;
Title_Bar_Color : Gdk.Color.Gdk_Color := Gdk.Color.Null_Color;
Focus_Title_Color : Gdk.Color.Gdk_Color := Gdk.Color.Null_Color;
- Draw_Title_Bars : Boolean := True;
+ Draw_Title_Bars : Title_Bars_Policy := Always;
Tabs_Position : Gtk.Enums.Gtk_Position_Type := Gtk.Enums.Pos_Bottom;
Show_Tabs_Policy : Show_Tabs_Policy_Enum := Automatic);
-- Change the setup of the MDI.
@@ -270,6 +277,10 @@ package Gtkada.MDI is
-- This title will be the one used for the window when the child is set to
-- floating state.
+ function Get_MDI (Child : access MDI_Child_Record) return MDI_Window;
+ -- Return the MDI to which Child is associated. In Child is a floating
+ -- child, it might not be in the MDI window itself.
+
function Get_Title (Child : access MDI_Child_Record) return UTF8_String;
-- Return the title for a specific child
@@ -277,6 +288,9 @@ package Gtkada.MDI is
(Child : access MDI_Child_Record) return UTF8_String;
-- Return the name of the notebook tab used when children are maximized.
+ function Has_Title_Bar (Child : access MDI_Child_Record) return Boolean;
+ -- Whether a title bar is currently displayed for Child
+
function Get_State (Child : access MDI_Child_Record) return State_Type;
-- Return the current state of the child
@@ -330,18 +344,18 @@ package Gtkada.MDI is
-- Menus --
-----------
- function Create_Menu
- (MDI : access MDI_Window_Record;
- Accel_Path_Prefix : String := "<gtkada>") return Gtk.Menu.Gtk_Menu;
- -- Create a dynamic menu that can then be inserted into a menu bar. This
- -- menu is dynamic, ie its content will changed based on the focus
- -- child.
- -- If this function is called several times, the same menu is returned
- -- every time. Accel_Path_Prefix must be the same for every call.
- -- Accel_Path_Prefix is used so that the key shortcuts associated with
- -- these menu items can be changed dynamically by the user (see
- -- gtk-accel_map.ads). The prefix must start with "<" and end with ">".
+ type Tab_Contextual_Menu_Factory is access procedure
+ (Child : access MDI_Child_Record'Class;
+ Menu : access Gtk.Menu.Gtk_Menu_Record'Class);
+ procedure Set_Tab_Contextual_Menu_Factory
+ (MDI : access MDI_Window_Record;
+ Factory : Tab_Contextual_Menu_Factory);
+ -- Set (or unset if Factory is null) the callback to create the contextual
+ -- menu entries when the user clicks on a notebook tab.
+ -- Factory should add entries to Menu (which already contains the default
+ -- entries, but you can remove them if needed).
+
------------------------
-- Selecting children --
------------------------
@@ -421,28 +435,44 @@ package Gtkada.MDI is
Widget : access Gtk.Widget.Gtk_Widget_Record'Class) return MDI_Child;
-- Return the MDI_Child that encapsulates Widget.
-- Widget must be the exact same one you gave in argument to Put.
+ -- If the child is currently not visible in the perspective (for instance
+ -- it was created for another perspective, but is not present in the
+ -- current one), it is inserted automatically back in the MDI.
function Find_MDI_Child_From_Widget
(Widget : access Gtk.Widget.Gtk_Widget_Record'Class) return MDI_Child;
-- Return the MDI child that encapsulate the parent of Widget.
-- As opposed to Find_MDI_Child, Widget can be anywhere within the
-- widget tree. This function properly handles floating children
+ -- If the child is currently not visible in the perspective (for instance
+ -- it was created for another perspective, but is not present in the
+ -- current one), it is inserted automatically back in the MDI.
function Find_MDI_Child_By_Tag
(MDI : access MDI_Window_Record;
- Tag : Ada.Tags.Tag) return MDI_Child;
+ Tag : Ada.Tags.Tag;
+ Visible_Only : Boolean := False) return MDI_Child;
-- Return the first child matching Tag
+ -- If the child is currently not visible in the perspective (for instance
+ -- it was created for another perspective, but is not present in the
+ -- current one), it is inserted automatically back in the MDI.
+ -- If Visible_Only is True, an invisible child is not returned. This is
+ -- useful to check whether a child is currently visible.
function Find_MDI_Child_By_Name
(MDI : access MDI_Window_Record;
Name : String) return MDI_Child;
-- Return the first child matching Name.
+ -- If the child is currently not visible in the perspective (for instance
+ -- it was created for another perspective, but is not present in the
+ -- current one), it is inserted automatically back in the MDI.
type Child_Iterator is private;
function First_Child
(MDI : access MDI_Window_Record;
- Group_By_Notebook : Boolean := False) return Child_Iterator;
+ Group_By_Notebook : Boolean := False;
+ Visible_Only : Boolean := True) return Child_Iterator;
-- Return an access to the first child of the MDI.
--
-- If Group_By_Notebook is True, then the children are reported one after
@@ -454,6 +484,10 @@ package Gtkada.MDI is
-- If Group_By_Notebook is False, it is garanteed that the first child is
-- the one that currently has the focus in the MDI. The children are
-- returned in the order in which they last had the focus.
+ --
+ -- If Visible_Only is true, then only those children currently visible in
+ -- the perspective are returned. The children that were part of a former
+ -- perspective are not returned.
procedure Next (Iterator : in out Child_Iterator);
-- Move to the next child in the MDI
@@ -516,19 +550,30 @@ package Gtkada.MDI is
-- If the children are maximized, this selected the next page from the
-- notebook.
+ type Split_Mode is
+ (Before, Before_Reuse,
+ After, After_Reuse,
+ Any_Side_Reuse);
+ -- How a child should be split:
+ -- If "Before", the child is put above or to the left of its current
+ -- position. A new window is created to containing it. If the "_Reuse"
+ -- version is used, and a window already exist at that position, the child
+ -- will be put in it instead of creating a new one.
+ -- Any_Side_Reuse indicates that the child will be put on either side,
+ -- depending on where a window already exists. If there is no window on the
+ -- side, a new one is created.
+
procedure Split
- (MDI : access MDI_Window_Record;
- Orientation : Gtk.Enums.Gtk_Orientation;
- Reuse_If_Possible : Boolean := False;
- After : Boolean := False;
- Width, Height : Glib.Gint := 0);
- -- Split the central area. The split starting from either the currently
- -- selected child or the last child that had the focus in that area.
- -- If Reuse_If_Possible is True, and the current child is already splitted
- -- in the right directory, we reuse that area.
- -- If After is true, then the currently selected child is put below or
- -- to the right in the splitted area, otherwise it is left on the top or
- -- left of that area).
+ (MDI : access MDI_Window_Record;
+ Orientation : Gtk.Enums.Gtk_Orientation;
+ Child : MDI_Child := null;
+ Mode : Split_Mode := Before;
+ Width, Height : Glib.Gint := 0);
+ -- Split the notebook containing Child (by default, the current focus
+ -- child).
+ -- Mode indicates in which direction the splitting should occur. If you
+ -- are splitting a child in the central area, splitting will never reuse
+ -- a window outside of the central area.
-- Width and Height indicate the desired geometry for the splitted area,
-- 0 indicate a 50/50 split.
@@ -555,7 +600,7 @@ package Gtkada.MDI is
-- memory yourself, and thus hard-code the default desktop if need be.
generic
- type User_Data (<>) is private;
+ type User_Data is private;
-- Generic type of parameter that is passed to all the children's save
-- and restore functions.
@@ -563,6 +608,21 @@ package Gtkada.MDI is
package Desktop is
+ function Create_Menu
+ (MDI : access MDI_Window_Record'Class;
+ Accel_Path_Prefix : String := "<gtkada>";
+ User : User_Data) return Gtk.Menu.Gtk_Menu;
+ -- Create a dynamic menu that can then be inserted into a menu bar. This
+ -- menu is dynamic, ie its content will changed based on the focus
+ -- child.
+ -- If this function is called several times, the same menu is returned
+ -- every time. Accel_Path_Prefix must be the same for every call.
+ -- Accel_Path_Prefix is used so that the key shortcuts associated with
+ -- these menu items can be changed dynamically by the user (see
+ -- gtk-accel_map.ads). The prefix must start with "<" and end with ">".
+ -- User is used for the callbacks on perspective changes, and passed to
+ -- Load_Perspective
+
type Save_Desktop_Function is access function
(Widget : access Gtk.Widget.Gtk_Widget_Record'Class;
User : User_Data) return Glib.Xml_Int.Node_Ptr;
@@ -594,25 +654,70 @@ package Gtkada.MDI is
-- Neither Save nor Load can be null.
function Restore_Desktop
- (MDI : access MDI_Window_Record'Class;
- From_Tree : Glib.Xml_Int.Node_Ptr;
- User : User_Data) return Boolean;
+ (MDI : access MDI_Window_Record'Class;
+ Perspectives : Glib.Xml_Int.Node_Ptr;
+ From_Tree : Glib.Xml_Int.Node_Ptr;
+ User : User_Data) return Boolean;
-- Restore the contents of the MDI from its saved XML tree.
+ -- Perspectives is the list of perspectives. It is cloned as needed, so
+ -- the caller is still responsible for freeing it. The first perspective
+ -- is loaded.
+ -- From_Tree is the part of the desktop that describes the editor area.
-- User is passed as a parameter to all of the Load_Desktop_Function
-- registered by the widgets.
-- Return False if the desktop couldn't be loaded
-- It also restores the size and position of the toplevel window that
-- contains the MDI
- function Save_Desktop
- (MDI : access MDI_Window_Record'Class;
- User : User_Data) return Glib.Xml_Int.Node_Ptr;
- -- Return an XML tree that describes the current contents of the MDI.
+ procedure Load_Perspective
+ (MDI : access MDI_Window_Record'Class;
+ Name : String;
+ User : User_Data);
+ -- Replace the current perspective by another one. This preserves the
+ -- editor area.
+ -- If the perspective does not exist, nothing is done, unless no
+ -- perspective is currently loaded (in which case we load the first
+ -- on in the list).
+
+ procedure Create_Perspective
+ (MDI : access MDI_Window_Record'Class;
+ Name : String;
+ User : User_Data);
+ -- Create a new perspective with the current desktop layout. If another
+ -- perspective with the same name exists, it is replaced.
+
+ procedure Define_Perspective
+ (MDI : access MDI_Window_Record'Class;
+ XML : Glib.Xml_Int.Node_Ptr;
+ User : User_Data);
+ -- Define a new perspective (in the same format as returned by
+ -- Save_Desktop, the central area is under control of the user so you
+ -- cannot change it).
+ -- If such a perspective already exists, nothing is done (since the user
+ -- might have modified it already).
+ -- XML's root node is the <perspective> node, including its "name"
+ -- attribute.
+ -- XML must be freed by the caller.
+
+ procedure Save_Desktop
+ (MDI : access MDI_Window_Record'Class;
+ User : User_Data;
+ Perspectives : out Glib.Xml_Int.Node_Ptr;
+ Central : out Glib.Xml_Int.Node_Ptr);
+ -- Return XML representations of the perspectives and central area. Both
+ -- nodes need to be freed by the caller, and can be saved in a file (to
+ -- be passed to Restore_Desktop later on).
-- This function calls each of the registered function for the children
-- of the MDI.
-- It also saves the size and position of the toplevel window that
-- contains the MDI
+ function Get_XML_Content
+ (MDI : access MDI_Window_Record'Class;
+ Tag : String) return Glib.Xml_Int.Node_Ptr;
+ -- Return the first XML subtree starting with 'Tag'. This allows a
+ -- module to retrieve its content after the 'Load_Desktop' call.
+
procedure Free_Registered_Desktop_Functions;
-- Free the memory allocated for the registered functions.
@@ -625,6 +730,31 @@ package Gtkada.MDI is
Next : Register_Node;
end record;
+ type Perspective_Menu_Item_Record
+ is new Gtk.Radio_Menu_Item.Gtk_Radio_Menu_Item_Record
+ with record
+ MDI : MDI_Window;
+ Name : Natural;
+ User : User_Data;
+ end record;
+ type Perspective_Menu_Item
+ is access all Perspective_Menu_Item_Record'Class;
+
+ procedure Change_Perspective
+ (Item : access Gtk.Widget.Gtk_Widget_Record'Class);
+ CP_Access : constant
+ Gtkada.Handlers.Widget_Callback.Marshallers.Marshaller :=
+ Gtkada.Handlers.Widget_Callback.To_Marshaller
+ (Change_Perspective'Access);
+ -- Internal, but needed so that we can have a 'Access on a callback
+
+ procedure Create_Perspective_CB
+ (Item : access Gtk.Widget.Gtk_Widget_Record'Class);
+ CreateP_Access : constant
+ Gtkada.Handlers.Widget_Callback.Marshallers.Marshaller :=
+ Gtkada.Handlers.Widget_Callback.To_Marshaller
+ (Create_Perspective_CB'Access);
+
Registers : Register_Node;
-- Global variable that contains the list of functions that have been
-- registered.
@@ -634,6 +764,16 @@ package Gtkada.MDI is
-- Return True if a desktop was loaded, False if the MDI is only the result
-- of calls to Gtk_New and Put.
+ function List_Of_Perspectives
+ (MDI : access MDI_Window_Record)
+ return GNAT.Strings.String_List_Access;
+ -- Return the list of perspectives known to the MDI. The caller must not
+ -- free the list
+
+ function Current_Perspective
+ (MDI : access MDI_Window_Record'Class) return String;
+ -- Return the name of the currently displayed perspective
+
-------------
-- Signals --
-------------
@@ -696,6 +836,11 @@ package Gtkada.MDI is
-- Emitted when the children have been reorganized: either a split
-- occurred, or a window was dropped into another position
--
+ -- - "perspective_changed"
+ -- procedure Handler (MDI : access MDI_Window_Record'Class);
+ -- Called when the user has selected a new perspective. One use is to
+ -- save the new desktop to a file.
+ --
-- </signals>
--
-- <signals>
@@ -735,26 +880,18 @@ package Gtkada.MDI is
--
-- </signals>
- Signal_Child_Selected : constant Signal_Name :=
- "child_selected";
- Signal_Float_Child : constant Signal_Name :=
- "float_child";
- Signal_Child_Title_Changed : constant Signal_Name :=
- "child_title_changed";
- Signal_Child_Added : constant Signal_Name :=
- "child_added";
- Signal_Child_Removed : constant Signal_Name :=
- "child_removed";
- Signal_Child_Icon_Changed : constant Signal_Name :=
- "child_icon_changed";
+ Signal_Child_Selected : constant Signal_Name := "child_selected";
+ Signal_Float_Child : constant Signal_Name := "float_child";
+ Signal_Child_Title_Changed : constant Signal_Name := "child_title_changed";
+ Signal_Child_Added : constant Signal_Name := "child_added";
+ Signal_Child_Removed : constant Signal_Name := "child_removed";
+ Signal_Child_Icon_Changed : constant Signal_Name := "child_icon_changed";
+ Signal_Delete_Event : constant Signal_Name := "delete_event";
+ Signal_Selected : constant Signal_Name := "selected";
+ Signal_Unfloat_Child : constant Signal_Name := "unfloat_child";
+ Signal_Perspective_Changed : constant Signal_Name := "perspective_changed";
Signal_Children_Reorganized : constant Signal_Name :=
"children_reorganized";
- Signal_Delete_Event : constant Signal_Name :=
- "delete_event";
- Signal_Selected : constant Signal_Name :=
- "selected";
- Signal_Unfloat_Child : constant Signal_Name :=
- "unfloat_child";
private
type String_Access is access all UTF8_String;
@@ -775,6 +912,11 @@ private
-- Title of the item, as it appears in the title bar.
-- These are UTF8-Encoded
+ XML_Node_Name : String_Access;
+ -- The name of the XML node when this child is saved in a desktop (if
+ -- we know it). This is used to reuse a child when switching
+ -- perspectives.
+
MDI : MDI_Window;
-- The MDI to which the child belongs. We cannot get this information
-- directly from Get_Parent since some children are actually floating
@@ -802,14 +944,28 @@ private
end record;
type Child_Iterator (Group_By_Notebook : Boolean := False) is record
+ Visible_Only : Boolean;
+
case Group_By_Notebook is
when False =>
Iter : Gtk.Widget.Widget_List.Glist;
when True =>
MDI : MDI_Window;
+
+ -- While iterating children
+ Paned_Iter : Gtkada.Multi_Paned.Child_Iterator;
+
+ -- Whether we have already visited the children of the central
+ -- area. This is True while iterating them, False afterward
+ In_Central : Boolean;
+
+ -- While iterating the pages of a specific notebook (notebook is
+ -- set to null when returning floating children)
Notebook : Gtk.Notebook.Gtk_Notebook;
Notebook_Page : Glib.Gint;
+
+ -- While iterating the floating children
Floating_Iter : Gtk.Widget.Widget_List.Glist;
end case;
end record;
@@ -819,7 +975,11 @@ private
type MDI_Window_Record is new Gtkada.Multi_Paned.Gtkada_Multi_Paned_Record
with record
Items : Gtk.Widget.Widget_List.Glist := Gtk.Widget.Widget_List.Null_List;
- -- The list of all MDI children.
+ -- The list of all MDI children. This includes children in the editor
+ -- area, even though they are technically in a separate multi_paned.
+ -- Warning: this list might contain items which are in fact invisible in
+ -- the MDI (in fact that are not even children of the MDI), if they
+ -- existed in a previous perspective but no longer in the current one.
Desktop_Was_Loaded : Boolean := False;
-- True if a desktop was loaded
@@ -848,6 +1008,9 @@ private
-- The dynamic menu used to provide access to the most common
-- functions of MDI.
+ Tab_Factory : Tab_Contextual_Menu_Factory;
+ -- Build the contextual menu when right-clicking on tabs
+
Title_Layout : Pango.Layout.Pango_Layout;
-- Layout used to draw titles in the MDI children
@@ -872,7 +1035,7 @@ private
Cursor_Fleur : Gdk.Cursor.Gdk_Cursor;
-- Cached cursors
- Draw_Title_Bars : Boolean := True;
+ Draw_Title_Bars : Title_Bars_Policy := Always;
Tabs_Position : Gtk.Enums.Gtk_Position_Type := Gtk.Enums.Pos_Bottom;
Show_Tabs_Policy : Show_Tabs_Policy_Enum := Automatic;
@@ -894,10 +1057,20 @@ private
-- Handling of Dnd
Drag_Start_X, Drag_Start_Y : Gint;
- In_Drag : Drag_Status := No_Drag;
- Dnd_Rectangle : Gdk.Rectangle.Gdk_Rectangle;
- Dnd_Rectangle_Owner : Gdk.Gdk_Window;
- Dnd_Xor_GC : Gdk.Gdk_GC;
+ In_Drag : Drag_Status := No_Drag;
+ Dnd_Rectangle : Gdk.Rectangle.Gdk_Rectangle; -- Highlighted area
+ Dnd_Target : Gdk.Gdk_Window; -- The current target for DND
+ Dnd_Target_Window : Gtk.Window.Gtk_Window; -- The overlay window
+
+ -- Loaded perspectives
+ Perspective_Menu_Item : Gtk.Menu_Item.Gtk_Menu_Item;
+ Perspectives : Glib.Xml_Int.Node_Ptr;
+ View_Contents : Glib.Xml_Int.Node_Ptr;
+ Perspective_Names : GNAT.Strings.String_List_Access;
+ Central : Gtkada.Multi_Paned.Gtkada_Multi_Paned;
+
+ Current_Perspective : Glib.Xml_Int.Node_Ptr;
+ -- pointer into Perspectives
end record;
pragma Inline (Get_Widget);
============================================================
--- src/gtkada-multi_paned.adb 017aad7d870d1778ff26ebd1a0255729b4bdd789
+++ src/gtkada-multi_paned.adb 90873d4b44c9abf7ea49d509f3fb8fbec03d618d
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
--- Copyright (C) 2003-2008, AdaCore --
+-- Copyright (C) 2003-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -53,11 +53,6 @@ package body Gtkada.Multi_Paned is
Traces : constant Boolean := False;
-- Whether debug traces should be displayed on stdout
- Handle_Width : constant := 6;
- -- Width, in pixels, of the resizing handles.
- -- ??? Should be read from theme with
- -- gtk_widget_style_get (gtk_paned, "handle_size", &handle_size, NULL)
-
Minimum_Width : constant := 1;
-- Minimum width for a child
@@ -262,8 +257,9 @@ package body Gtkada.Multi_Paned is
Put_Line ("<null>");
elsif Child.Is_Widget then
- Put_Line (Prefix & "<w req=(" & Float'Image (Child.Width)
- & Float'Image (Child.Height)
+ Put_Line (Prefix & "<w req=("
+ & Gint'Image (Gint (Child.Width))
+ & Gint'Image (Gint (Child.Height))
& ") alloc=("
& Gint'Image (Get_Allocation_Width (Child.Widget))
& Gint'Image (Get_Allocation_Height (Child.Widget))
@@ -277,10 +273,17 @@ package body Gtkada.Multi_Paned is
& ") w=" & System.Address_Image (Child.Widget.all'Address)
& " C=" & System.Address_Image (Get_Object (Child.Widget))
& ">");
+
+ if Child.Widget.all in Gtkada_Multi_Paned_Record'Class then
+ Dump (Gtkada_Multi_Paned (Child.Widget),
+ Gtkada_Multi_Paned (Child.Widget).Children,
+ Prefix & " nested:");
+ end if;
+
else
Put_Line (Prefix & "<" & Image (Child.Orientation)
- & " req=(" & Float'Image (Child.Width)
- & Float'Image (Child.Height)
+ & " req=(" & Gint'Image (Gint (Child.Width))
+ & Gint'Image (Gint (Child.Height))
& ") x,y=(" & Gint'Image (Child.X)
& Gint'Image (Child.Y)
& ")"
@@ -323,17 +326,17 @@ package body Gtkada.Multi_Paned is
if Child.Handle.Win /= null then
Destroy (Child.Handle.Win);
end if;
- end if;
- if Recursive and then not Child.Is_Widget then
- while Child.First_Child /= null loop
- Tmp := Child.First_Child.Next;
- Free (Child.First_Child, Recursive);
- Child.First_Child := Tmp;
- end loop;
- end if;
+ if Recursive and then not Child.Is_Widget then
+ while Child.First_Child /= null loop
+ Tmp := Child.First_Child.Next;
+ Free (Child.First_Child, Recursive);
+ Child.First_Child := Tmp;
+ end loop;
+ end if;
- Unchecked_Free (Child);
+ Unchecked_Free (Child);
+ end if;
end Free;
-----------
@@ -364,6 +367,51 @@ package body Gtkada.Multi_Paned is
return Iter.Depth;
end Get_Depth;
+ --------------
+ -- Get_Size --
+ --------------
+
+ procedure Get_Size
+ (Iter : Child_Iterator;
+ Width, Height : out Gint;
+ Parent_Width, Parent_Height : out Gint;
+ Parent_Orientation : out Gtk_Orientation)
+ is
+ Count : Natural := 1;
+ Tmp : Child_Description_Access;
+ begin
+ -- Assert (Iter.Current /= null);
+
+ Width := Gint (Iter.Current.Width);
+ Height := Gint (Iter.Current.Height);
+
+ if Iter.Current.Parent /= null then
+ Tmp := Iter.Current.Parent.First_Child;
+ while Tmp /= null loop
+ Count := Count + 1;
+ Tmp := Tmp.Next;
+ end loop;
+
+ Parent_Orientation := Iter.Current.Parent.Orientation;
+
+ case Parent_Orientation is
+ when Orientation_Horizontal =>
+ Parent_Width := Gint (Iter.Current.Parent.Width)
+ - Gint (Count - 1) * Handle_Width;
+ Parent_Height := Gint (Iter.Current.Parent.Height);
+ when Orientation_Vertical =>
+ Parent_Width := Gint (Iter.Current.Parent.Width);
+ Parent_Height := Gint (Iter.Current.Parent.Height)
+ - Gint (Count - 1) * Handle_Width;
+ end case;
+
+ else
+ Parent_Width := Width;
+ Parent_Height := Height;
+ Parent_Orientation := Orientation_Horizontal;
+ end if;
+ end Get_Size;
+
------------
-- At_End --
------------
@@ -1114,7 +1162,12 @@ package body Gtkada.Multi_Paned is
Height => Current.Handle.Position.Height,
Orientation => Orientation);
- elsif Current.Handle.Win /= null then
+ -- Hide could cause another Expose event to be sent, resulting in an
+ -- infinite loop. So we first check whether it is already visible
+
+ elsif Current.Handle.Win /= null
+ and then Is_Visible (Current.Handle.Win)
+ then
Hide (Current.Handle.Win);
end if;
@@ -1583,10 +1636,16 @@ package body Gtkada.Multi_Paned is
begin
if not Realized_Is_Set (Split)
or else Split.Frozen
- or else Split.Children = null
or else Alloc.Width <= 1 -- Uninitialized yet
then
return;
+
+ elsif Split.Children = null then
+ -- With nested multi_paned, we must make sure we still properly store
+ -- the allocation.
+
+ Set_Allocation (Split, Alloc);
+ return;
end if;
if Split.Children.Width = -1.0 then
@@ -2136,7 +2195,9 @@ package body Gtkada.Multi_Paned is
-- So that Size_Allocate_Paned detects a visibility change, even
-- though the actual size of the window probably has not changed
- Win.Children.Width := -1.0;
+ if Win.Children /= null then
+ Win.Children.Width := -1.0;
+ end if;
if Traces then
Put_Line ("Multi_Paned: Thaw");
============================================================
--- src/gtkada-multi_paned.ads ca114af08733d4dd39aa328b31df49f7fd2f6b34
+++ src/gtkada-multi_paned.ads b8634c129fdb397bc19d055b43727282b0ca2387
@@ -40,6 +40,11 @@ package Gtkada.Multi_Paned is
with private;
type Gtkada_Multi_Paned is access all Gtkada_Multi_Paned_Record'Class;
+ Handle_Width : constant := 6;
+ -- Width, in pixels, of the resizing handles.
+ -- ??? Should be read from theme with
+ -- gtk_widget_style_get (gtk_paned, "handle_size", &handle_size, NULL)
+
type Pane is private;
-- An area of the window, which can is splitted either horizontally or
-- vertically. It can contain one or several children, next to each other,
@@ -230,6 +235,16 @@ package Gtkada.Multi_Paned is
-- This can be used to detect when the Iter has finished traversing one
-- of the panes.
+ procedure Get_Size
+ (Iter : Child_Iterator;
+ Width, Height : out Gint;
+ Parent_Width, Parent_Height : out Gint;
+ Parent_Orientation : out Gtk.Enums.Gtk_Orientation);
+ -- Return the size of the current element (pane or widget), as well as the
+ -- parent's pane (the resizable area that contains notebooks or other
+ -- panes). The parent size is the total size devoted to its children,
+ -- omitting the size occupied by resize handles.
+
procedure Dump (Split : access Gtkada_Multi_Paned_Record'Class);
-- Dump the configuration of Split to stdout. This is only intended for
-- testing purposes. If you want to save and restore this configuration,
============================================================
--- testgtk/create_file_chooser.adb 89d31b5584f92ed9d2678fb73239d9dabc63eb83
+++ testgtk/create_file_chooser.adb a2d443c005b7a804d7ba3d3736852441806a4098
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for the Gimp Toolkit --
-- --
--- Copyright (C) 2006, AdaCore --
+-- Copyright (C) 2006-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -27,6 +27,7 @@ with Gtk.File_Chooser_Button; use Gtk.
with Gtk.Button; use Gtk.Button;
with Gtk.File_Chooser; use Gtk.File_Chooser;
with Gtk.File_Chooser_Button; use Gtk.File_Chooser_Button;
+with Gtk.File_Filter; use Gtk.File_Filter;
with Gtk.Frame; use Gtk.Frame;
with Gtk.Stock; use Gtk.Stock;
with Gtkada.Handlers; use Gtkada.Handlers;
@@ -68,12 +69,23 @@ package body Create_File_Chooser is
Button : Gtk_Button;
File : Gtk_File_Chooser_Button;
Error : GError;
+ Filter1, Filter2 : Gtk_File_Filter;
begin
Set_Label (Frame, "File Chooser Button");
Gtk_New_Vbox (Box, Homogeneous => False);
Add (Frame, Box);
+ -- File chooser
+
+ Gtk_New (Filter1);
+ Add_Pattern (Filter1, "*");
+ Set_Name (Filter1, "All Files");
+
+ Gtk_New (Filter2);
+ Add_Pattern (Filter2, "*.ad[bs]");
+ Set_Name (Filter2, "Ada Files");
+
Gtk_New_Hbox (Hbox, Homogeneous => False);
Pack_Start (Box, Hbox, Fill => False);
Gtk_New (File,
@@ -81,16 +93,37 @@ package body Create_File_Chooser is
Action => Action_Open);
Pack_Start (Hbox, File, Expand => True);
+ Add_Filter (+File, Filter1);
+ Add_Filter (+File, Filter2);
+
Gtk_New_From_Stock (Button, Stock_Properties);
Pack_Start (Hbox, Button, Expand => False);
Widget_Callback.Object_Connect
(Button, "clicked", Show_Properties'Access, File);
+ -- Add a shortcut to the current directory
+
Error := Add_Shortcut_Folder (+File, Get_Current_Dir);
if Error /= null then
Put_Line (Get_Message (Error));
end if;
+ -- Directory chooser
+
+ Gtk_New (Filter1);
+ Add_Mime_Type (Filter1, "x-directory/normal");
+ Set_Name (Filter1, "Directories only");
+
+ Gtk_New_Hbox (Hbox, Homogeneous => False);
+ Pack_Start (Box, Hbox, Fill => False);
+ Gtk_New (File,
+ Title => "Select a file (Open mode)",
+ Action => Action_Open);
+ Pack_Start (Hbox, File, Expand => True);
+
+ Set_Action (+File, Action_Select_Folder);
+ Add_Filter (+File, Filter1);
+
Show_All (Frame);
end Run_Button;