[Gd-chatter] r11370 - branches/opendylan-melange/gtk-duim
andreas at gwydiondylan.org
andreas at gwydiondylan.org
Wed May 23 01:16:28 CEST 2007
Author: andreas
Date: Wed May 23 01:16:25 2007
New Revision: 11370
Modified:
branches/opendylan-melange/gtk-duim/duim.lid
branches/opendylan-melange/gtk-duim/gtk-colors.dylan
branches/opendylan-melange/gtk-duim/gtk-events.dylan
branches/opendylan-melange/gtk-duim/gtk-gadgets.dylan
branches/opendylan-melange/gtk-duim/gtk-medium.dylan
branches/opendylan-melange/gtk-duim/gtk-menus.dylan
branches/opendylan-melange/gtk-duim/gtk-mirror.dylan
branches/opendylan-melange/gtk-duim/gtk-top.dylan
Log:
Job: fd
fixed signals
reversi works :)
Modified: branches/opendylan-melange/gtk-duim/duim.lid
==============================================================================
--- branches/opendylan-melange/gtk-duim/duim.lid (original)
+++ branches/opendylan-melange/gtk-duim/duim.lid Wed May 23 01:16:25 2007
@@ -4,7 +4,6 @@
Files: duim-library
Major-version: 2
Minor-version: 1
-Executable: DxDUIM
Base-address: 0x65c00000
Copyright: Original Code is Copyright (c) 1995-2004 Functional Objects, Inc.
All rights reserved.
Modified: branches/opendylan-melange/gtk-duim/gtk-colors.dylan
==============================================================================
--- branches/opendylan-melange/gtk-duim/gtk-colors.dylan (original)
+++ branches/opendylan-melange/gtk-duim/gtk-colors.dylan Wed May 23 01:16:25 2007
@@ -8,7 +8,7 @@
Warranty: Distributed WITHOUT WARRANTY OF ANY KIND
/// Palettes
-// /*---*** No palettes for now...
+/*---*** No palettes for now...
//--- How much more do we need to flesh out palettes?
define sealed class <gtk-palette> (<basic-palette>)
sealed slot port :: false-or(<port>),
@@ -235,4 +235,4 @@
x/XStoreColor(x-display, x-colormap, x-color)
end
end method set-x-read-write-color;
-// */
+*/
Modified: branches/opendylan-melange/gtk-duim/gtk-events.dylan
==============================================================================
--- branches/opendylan-melange/gtk-duim/gtk-events.dylan (original)
+++ branches/opendylan-melange/gtk-duim/gtk-events.dylan Wed May 23 01:16:25 2007
@@ -9,181 +9,9 @@
/// GTK signals
-define constant $signal-handlers = make(<object-table>);
-
-define class <signal-handler> (<sealed-constructor-mixin>)
- constant sealed slot handler-name :: <C-string>,
- required-init-keyword: name:;
- constant sealed slot handler-function :: <GtkSignalFunc>,
- required-init-keyword: function:;
-end class <signal-handler>;
-
-define function register-signal-handler
- (name :: <string>, function :: <GtkSignalFunc>,
- #key key = as(<symbol>, name)) => ()
- $signal-handlers[key]
- := make(<signal-handler>,
- name: as(<C-string>, name),
- function: function)
-end function register-signal-handler;
-
-define function fetch-signal-handler
- (name :: <symbol>) => (_handler :: <signal-handler>)
- element($signal-handlers, name, default: #f)
- | error("No GTK handler registered for '%s'", name)
-end function fetch-signal-handler;
-
-define function do-with-disabled-event-handler
- (function :: <function>, widget :: <GtkWidget>, name :: <symbol>)
- => (#rest values)
- let _handler = handler-function(fetch-signal-handler(name));
- let object = widget;
- block ()
- gtk-signal-handler-block-by-func(object, _handler, $null-gpointer);
- function()
- cleanup
- gtk-signal-handler-unblock-by-func(object, _handler, $null-gpointer);
- end
-end function do-with-disabled-event-handler;
-
-define macro with-disabled-event-handler
- { with-disabled-event-handler (?widget:expression, ?name:expression)
- ?body:body
- end }
- => { do-with-disabled-event-handler(method () ?body end, ?widget, ?name) }
-end macro with-disabled-event-handler;
-
-define macro event-handler-definer
- { define event-handler (?name:name, ?event-type:name)
- ?eq:token ?handler:name }
- => { define gtk-callback ("_gtk-" ## ?name ## "-callback", ?event-type)
- ?eq "handle_" ## ?name;
- register-signal-handler(as-lowercase(?"name"), "_gtk-" ## ?name ## "-callback");
- define open generic ?handler
- (sheet :: <abstract-sheet>, widget :: <GtkWidget>,
- event :: ?event-type)
- => (handled? :: <boolean>);
- define function "handle_" ## ?name
- (widget :: <GtkWidget>, event :: ?event-type)
- => (code :: <integer>)
- do-handle-gtk-signal
- (?handler, widget, ?"name", widget, event)
- end }
-end macro event-handler-definer;
-
-define event-handler (destroy, <GdkEventAny>) = handle-gtk-destroy-event;
-define event-handler (delete_event, <GdkEventAny>) = handle-gtk-delete-event;
-define event-handler (motion_notify_event, <GdkEventMotion>) = handle-gtk-motion-event;
-define event-handler (button_press_event, <GdkEventButton>) = handle-gtk-button-press-event;
-define event-handler (button_release_event, <GdkEventButton>) = handle-gtk-button-release-event;
-define event-handler (key_press_event, <GdkEventKey>) = handle-gtk-key-press-event;
-define event-handler (key_release_event, <GdkEventKey>) = handle-gtk-key-release-event;
-define event-handler (configure_event, <GdkEventConfigure>) = handle-gtk-configure-event;
-define event-handler (expose_event, <GdkEventExpose>) = handle-gtk-expose-event;
-define event-handler (enter_event, <GdkEventCrossing>) = handle-gtk-enter-event;
-define event-handler (leave_event, <GdkEventCrossing>) = handle-gtk-leave-event;
-
-define event-handler (clicked, <GdkEventAny>) = handle-gtk-clicked-event;
-define event-handler (select_row, <GdkEventAny>) = handle-gtk-select-row-event;
-define event-handler (click_column, <GdkEventAny>) = handle-gtk-click-column-event;
-define event-handler (resize_column, <GdkEventAny>) = handle-gtk-resize-column-event;
-
-
-define inline function do-handle-gtk-signal
- (handler_ :: <function>, widget :: <GtkWidget>, name :: <string>,
- #rest args)
- => (code :: <integer>)
- let mirror = widget-mirror(widget);
- debug-assert(mirror, "Unknown widget");
- let gadget = mirror-sheet(mirror);
- duim-debug-message("Handling %s for %=", name, gadget);
- let value = apply(handler_, gadget, args);
- duim-debug-message(" handled?: %=", value);
- if (instance?(value, <integer>))
- value
- elseif (value)
- $true
- else
- $false
- end
-end function do-handle-gtk-signal;
-
-/// Non-event signals
-
-define macro signal-handler-definer
- { define signal-handler ?:name (?args:*) ?eq:token ?handler:name }
- => { signal-handler-aux ?"name",
- ?handler (?args),
- "%gtk-" ## ?name ## "-signal-handler" (?args),
- "_gtk-" ## ?name ## "-signal-handler" (?args)
- end }
-end macro;
-define macro signal-handler-aux
- { signal-handler-aux ?signal:expression,
- ?handler:name (?args),
- ?%handler:name (?params:*),
- ?_handler:name (?c-params)
- end }
- => { define function ?%handler (widget :: <GtkWidget>, ?params)
- do-handle-gtk-signal(?handler, widget, ?signal, ?args)
- end;
- define C-callable-wrapper ?_handler of ?%handler
- parameter widget :: <GtkWidget>;
- ?c-params
- end;
- register-signal-handler(?signal, ?_handler)
- }
-c-params:
- { } => { }
- { ?:variable, ... } => { parameter ?variable; ... }
-args:
- { } => { }
- { ?arg:name :: ?:expression, ... } => { ?arg, ... }
-end macro;
-
-define signal-handler changed (user-data :: <gpointer>)
- = gtk-changed-signal-handler;
-define signal-handler activate (user-data :: <gpointer>)
- = gtk-activate-signal-handler;
-
-
-/// Adjustments
-define function %gtk-adjustment-value-changed-signal-handler
- (adj :: <GtkAdjustment>, widget :: <GtkWidget>)
- do-handle-gtk-signal(gtk-adjustment-value-changed-signal-handler,
- widget, "adjustment/value_changed", adj)
-end;
-define C-callable-wrapper _gtk-adjustment-value-changed-signal-handler
- of %gtk-adjustment-value-changed-signal-handler
- parameter adj :: <GtkAdjustment>;
- parameter user-data :: <GtkWidget>;
-end;
-register-signal-handler("value_changed",
- _gtk-adjustment-value-changed-signal-handler,
- key: #"adjustment/value_changed");
-
define function install-named-handlers
(mirror :: <gtk-mirror>, handlers :: <sequence>, #key adjustment) => ()
let widget = mirror-widget(mirror);
- let object = widget;
- duim-debug-message("Installing handlers for %=: %=",
- mirror-sheet(mirror), handlers);
- for (key :: <symbol> in handlers)
- let handler_ = fetch-signal-handler(key);
- if (handler_)
- let name = as(<byte-string>, handler_.handler-name);
- let function = handler_.handler-function;
- let value = if (adjustment)
- g-signal-connect(adjustment, name, function, widget);
- else
- //--- Should we pass an object to help map back to a mirror?
- g-signal-connect(object, name, function, $null-gpointer);
- end;
- if (zero?(value))
- duim-debug-message("Unable to connect signal '%s'", name)
- end
- end
- end;
gtk-widget-add-events(widget,
logior($GDK-EXPOSURE-MASK, $GDK-LEAVE-NOTIFY-MASK,
if (member?(#"motion_notify_event", handlers))
@@ -231,10 +59,8 @@
end method handle-gtk-destroy-event;
define method handle-gtk-motion-event
- (sheet :: <sheet>, widget :: <GtkWidget>, event :: <GdkEventMotion>)
+ (sheet :: <sheet>, event :: <GdkEventMotion>)
=> (handled? :: <boolean>)
- let mirror = widget-mirror(widget);
- let sheet = mirror-sheet(mirror);
let _port = port(sheet);
when (_port)
ignoring("motion modifiers");
@@ -318,20 +144,8 @@
end
end function gtk-detail->duim-crossing-kind;
-define method handle-gtk-button-press-event
- (sheet :: <sheet>, widget :: <GtkWidget>, event :: <GdkEventButton>)
- => (handled? :: <boolean>)
- handle-gtk-button-event(sheet, widget, event)
-end method handle-gtk-button-press-event;
-
-define method handle-gtk-button-release-event
- (sheet :: <sheet>, widget :: <GtkWidget>, event :: <GdkEventButton>)
- => (handled? :: <boolean>)
- handle-gtk-button-press-event(sheet, widget, event)
-end method handle-gtk-button-release-event;
-
define method handle-gtk-button-event
- (sheet :: <sheet>, widget :: <GtkWidget>, event :: <GdkEventButton>)
+ (sheet :: <sheet>, event :: <GdkEventButton>)
=> (handled? :: <boolean>)
let _port = port(sheet);
when (_port)
@@ -376,7 +190,7 @@
end function gtk-button->duim-button;
define method handle-gtk-expose-event
- (sheet :: <sheet>, widget :: <GtkWidget>, event :: <GdkEventExpose>)
+ (sheet :: <sheet>, event :: <GdkEventExpose>)
=> (handled? :: <boolean>)
let _port = port(sheet);
when (_port)
Modified: branches/opendylan-melange/gtk-duim/gtk-gadgets.dylan
==============================================================================
--- branches/opendylan-melange/gtk-duim/gtk-gadgets.dylan (original)
+++ branches/opendylan-melange/gtk-duim/gtk-gadgets.dylan Wed May 23 01:16:25 2007
@@ -396,7 +396,8 @@
define method install-event-handlers
(sheet :: <gtk-button-mixin>, mirror :: <gadget-mirror>) => ()
next-method();
- install-named-handlers(mirror, #[#"clicked"])
+ let widget = mirror-widget(mirror);
+ g-signal-connect(widget, "clicked", method (#rest args) handle-button-gadget-click(sheet) end);
end method install-event-handlers;
define sealed method handle-gtk-clicked-event
@@ -1036,14 +1037,14 @@
define method install-event-handlers
(sheet :: <gtk-scroll-bar>, mirror :: <gadget-mirror>) => ()
next-method();
- let adj = gtk-range-get-adjustment(mirror-widget(mirror));
- install-named-handlers(mirror, #[#"adjustment/value_changed"],
- adjustment: adj);
+ let widget = mirror-widget(mirror);
+ g-signal-connect(widget, "value-changed", method (#rest args) gtk-adjustment-value-changed-signal-handler(sheet, widget) end);
end method install-event-handlers;
define method gtk-adjustment-value-changed-signal-handler
- (gadget :: <gtk-scroll-bar>, adjustment :: <GtkAdjustment>) => ()
- let value = adjustment.gtk-adjustment-get-value;
+ (gadget :: <gtk-scroll-bar>, widget :: <GtkWidget>) => ()
+ let adj = gtk-range-get-adjustment(widget);
+ let value = adj.gtk-adjustment-get-value;
scroll-to-position(gadget, value);
end;
@@ -1125,24 +1126,24 @@
define method install-event-handlers
(sheet :: <gtk-list-control-mixin>, mirror :: <gadget-mirror>) => ()
next-method();
- install-named-handlers(mirror,
- #[#"select_row", #"button_press_event"])
+ let widget = mirror-widget(mirror);
+ g-signal-connect(widget, "select-row", method (widget, row, column, event, #rest args) handle-gtk-select-row-event(sheet, row, event) end);
+ g-signal-connect(widget, "button-press-event", method (widget, event, #rest args) handle-gtk-button-press-event(sheet, event) end);
+ gtk-widget-add-events(widget, $GDK-BUTTON-PRESS-MASK);
end method install-event-handlers;
define sealed method handle-gtk-select-row-event
- (gadget :: <gtk-list-control-mixin>, widget :: <GtkWidget>,
- event :: <GdkEventAny>)
+ (gadget :: <gtk-list-control-mixin>, row :: <integer>, event :: <GdkEventButton>)
=> (handled? :: <boolean>)
gtk-debug("Clicked on list control!");
- let selection = list-selection(gadget, sheet-direct-mirror(gadget));
+ let selection = list(row); //list-selection(gadget, sheet-direct-mirror(gadget));
gtk-debug(" Selection now %=", selection);
distribute-selection-changed-callback(gadget, selection);
#t
end method handle-gtk-select-row-event;
define sealed method handle-gtk-button-press-event
- (gadget :: <gtk-list-control-mixin>, widget :: <GtkWidget>,
- event :: <GdkEventButton>)
+ (gadget :: <gtk-list-control-mixin>, event :: <GdkEventButton>)
=> (handled? :: <boolean>)
gtk-debug("Pressed button %=, type %=",
event.GdkEventButton-button,
Modified: branches/opendylan-melange/gtk-duim/gtk-medium.dylan
==============================================================================
--- branches/opendylan-melange/gtk-duim/gtk-medium.dylan (original)
+++ branches/opendylan-melange/gtk-duim/gtk-medium.dylan Wed May 23 01:16:25 2007
@@ -52,9 +52,10 @@
duim-debug-message("Attaching medium to %= (medium-sheet %=)",
sheet, medium-sheet(medium));
let widget = mirror.mirror-widget;
- let drawable = pointer-cast(<GdkDrawable>, widget.gtk-widget-get-window);
+// FIXME
+// let drawable = widget.gtk-widget-get-window;
clear-ink-cache(medium);
- medium-drawable(medium) := drawable;
+// medium-drawable(medium) := drawable;
// Set up the palette and fg/bg pixels
let widget = mirror-widget(mirror);
let palette = port-default-palette(_port);
@@ -175,15 +176,13 @@
let widget = mirror.mirror-widget;
let drawable = medium-drawable(medium);
// let gcontext = widget.gtk-widget-get-style.GtkStyle-black-gc;
- let gcontext = widget.gtk-widget-get-style.GtkStyle-fg-gc[widget.gtk-widget-get-state];
- if (null-pointer?(drawable))
- duim-debug-message("Null pointer drawable!");
- let drawable = widget.gtk-widget-get-window;
+ // let gcontext = widget.gtk-widget-get-style.GtkStyle-fg-gc[widget.gtk-widget-get-state];
+ unless (drawable)
+ drawable := widget.gtk-widget-get-window;
medium-drawable(medium) := drawable;
- values(drawable, gcontext)
- else
- values(drawable, gcontext)
- end
+ end;
+ let gcontext = gdk-gc-new(drawable);
+ values(drawable, gcontext)
end method get-gcontext;
// Note that the brush defaults to 'medium-brush(medium)',
Modified: branches/opendylan-melange/gtk-duim/gtk-menus.dylan
==============================================================================
--- branches/opendylan-melange/gtk-duim/gtk-menus.dylan (original)
+++ branches/opendylan-melange/gtk-duim/gtk-menus.dylan Wed May 23 01:16:25 2007
@@ -363,7 +363,8 @@
define method install-event-handlers
(sheet :: <gtk-menu-button-mixin>, mirror :: <gadget-mirror>) => ()
next-method();
- install-named-handlers(mirror, #[#"activate"])
+ let widget = mirror-widget(mirror);
+ g-signal-connect(widget, "activate", method (#rest args) activate-gtk-gadget(sheet) end);
end method install-event-handlers;
// #"activate" signal
Modified: branches/opendylan-melange/gtk-duim/gtk-mirror.dylan
==============================================================================
--- branches/opendylan-melange/gtk-duim/gtk-mirror.dylan (original)
+++ branches/opendylan-melange/gtk-duim/gtk-mirror.dylan Wed May 23 01:16:25 2007
@@ -314,18 +314,27 @@
define method install-event-handlers
(sheet :: <mirrored-sheet-mixin>, mirror :: <fixed-container-mirror>) => ()
next-method();
- install-named-handlers(mirror, #[#"expose_event"])
+ let widget = mirror-widget(mirror);
+ g-signal-connect(widget, "expose-event", method (widget, event, #rest args) handle-gtk-expose-event(sheet, event) end);
+ gtk-widget-add-events(widget, $GDK-EXPOSURE-MASK);
end method install-event-handlers;
define method install-event-handlers
(sheet :: <mirrored-sheet-mixin>, mirror :: <drawing-area-mirror>) => ()
next-method();
- install-named-handlers(mirror, #[#"expose_event", #"button_press_event", #"button_release_event", #"motion_notify_event"])
+ let widget = mirror-widget(mirror);
+ g-signal-connect(widget, "expose-event", method (widget, event, #rest args) handle-gtk-expose-event(sheet, event) end);
+ gtk-widget-add-events(widget, $GDK-EXPOSURE-MASK);
+ g-signal-connect(widget, "button-press-event", method (widget, event) handle-gtk-button-event(sheet, event) end);
+ gtk-widget-add-events(widget, $GDK-BUTTON-PRESS-MASK);
+ g-signal-connect(widget, "button-release-event", method (widget, event) handle-gtk-button-event(sheet, event) end);
+ gtk-widget-add-events(widget, $GDK-BUTTON-RELEASE-MASK);
+ g-signal-connect(widget, "motion-notify-event", method (widget, event, #rest args) handle-gtk-motion-event(sheet, event) end);
+ gtk-widget-add-events(widget, logior($GDK-POINTER-MOTION-MASK, $GDK-POINTER-MOTION-HINT-MASK));
end method install-event-handlers;
define sealed method handle-gtk-expose-event
- (sheet :: <mirrored-sheet-mixin>, widget :: <GtkWidget>,
- event :: <GdkEventExpose>)
+ (sheet :: <mirrored-sheet-mixin>, event :: <GdkEventExpose>)
=> (handled? :: <boolean>)
let area = event.GdkEventExpose-area;
let x = area.GdkRectangle-x;
Modified: branches/opendylan-melange/gtk-duim/gtk-top.dylan
==============================================================================
--- branches/opendylan-melange/gtk-duim/gtk-top.dylan (original)
+++ branches/opendylan-melange/gtk-duim/gtk-top.dylan Wed May 23 01:16:25 2007
@@ -378,8 +378,9 @@
define method install-event-handlers
(sheet :: <gtk-top-level-sheet-mixin>, mirror :: <top-level-mirror>) => ()
next-method();
- install-named-handlers(mirror,
- #[#"delete_event", #"configure_event"])
+ let widget = mirror-widget(mirror);
+ g-signal-connect(widget, "delete-event", method (#rest args) handle-gtk-delete-event(sheet) end);
+ g-signal-connect(widget, "configure-event", method (widget, event, #rest args) handle-gtk-configure-event(sheet, widget, event) end);
end method install-event-handlers;
@@ -415,8 +416,7 @@
end method lower-mirror;
define sealed method handle-gtk-delete-event
- (sheet :: <top-level-sheet>, widget :: <GtkWidget>,
- event :: <GdkEventAny>)
+ (sheet :: <top-level-sheet>)
=> (handled? :: <boolean>)
let frame = sheet-frame(sheet);
let controller = frame & frame-controlling-frame(frame);
More information about the chatter
mailing list