Added more bindings to accel-group and accel-map

diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp
index aaa9d45e1352213aa9774b779cb985f58a6ecd76..46214a6cd24e3571fdb794e13b075504d1b48fe2 100644 (file)
--- a/gtk/gtk.lisp
+++ b/gtk/gtk.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-;; $Id: gtk.lisp,v 1.42 2005/04/23 16:48:51 espen Exp $
+;; $Id: gtk.lisp,v 1.43 2005/04/24 13:30:40 espen Exp $
 
 
 (in-package "GTK")
@@ -107,7 +107,7 @@ (defbinding %accel-group-connect () nil
   (gclosure gclosure))
 
 (defun accel-group-connect (group accelerator function &optional flags)
-  (multiple-value-bind (key modifiers) (accelerator-parse accelerator)
+  (multiple-value-bind (key modifiers) (parse-accelerator accelerator)
     (let ((gclosure (make-callback-closure function)))
       (%accel-group-connect group key modifiers flags gclosure)
       gclosure)))
@@ -130,22 +130,45 @@ (defun accel-group-disconnect (group accelerator)
   (etypecase accelerator
     (gclosure (%accel-group-disconnect group accelerator))
     (string 
-     (multiple-value-bind (key modifiers) (accelerator-parse accelerator)
+     (multiple-value-bind (key modifiers) (parse-accelerator accelerator)
        (%accel-group-disconnect-key group key modifiers)))))
 
+(defbinding %accel-group-query () (copy-of (vector (inlined accel-group-entry) n))
+  (accel-group accel-group)
+  (key unsigned-int)
+  (modifiers gdk:modifier-type)
+  (n int :out))
+
+(defun accel-group-query (accel-group accelerator)
+  (multiple-value-bind (key modifiers) (parse-accelerator accelerator)
+    (%accel-group-query accel-group key modifiers)))
+
+(defbinding %accel-group-activate () boolean
+  (accel-group accel-group)
+  (acceleratable gobject)
+  (key unsigned-int)
+  (modifiers gdk:modifier-type))
+
+(defun accel-group-activate (accel-group acceleratable accelerator)
+  (multiple-value-bind (key modifiers) (parse-accelerator accelerator)
+    (%accel-group-activate accel-group acceleratable key modifiers)))
+
 (defbinding accel-group-lock () nil
   (accel-group accel-group))
 
 (defbinding accel-group-unlock () nil
   (accel-group accel-group))
 
+(defbinding accel-group-from-accel-closure () accel-group
+  (closure gclosure))
+
 (defbinding %accel-groups-activate () boolean
   (object gobject)
   (key unsigned-int)
   (modifiers gdk:modifier-type))
 
 (defun accel-groups-activate (object accelerator)
-  (multiple-value-bind (key modifiers) (accelerator-parse accelerator)
+  (multiple-value-bind (key modifiers) (parse-accelerator accelerator)
     (%accel-groups-activate object key modifiers)))
 
 (defbinding accel-groups-from-object () (gslist accel-groups)
@@ -160,12 +183,35 @@ (defbinding %accelerator-parse () nil
   (key unsigned-int :out)
   (modifiers gdk:modifier-type :out))
 
-(defun accelerator-parse (accelerator)
+(defgeneric parse-accelerator (accelerator))
+
+(defmethod parse-accelerator ((accelerator string))
   (multiple-value-bind (key modifiers) (%accelerator-parse accelerator)
     (if (zerop key)
        (error "Invalid accelerator: ~A" accelerator)
       (values key modifiers))))
 
+(defmethod parse-accelerator ((accelerator cons))
+  (destructuring-bind (key modifiers) accelerator
+    (values
+     (etypecase key
+       (integer key)
+       (string
+       (or 
+        (gdk:keyval-from-name key)
+        (error "Invalid key name: ~A" key)))
+       (character (parse-accelerator key)))
+     modifiers)))
+
+(defmethod parse-accelerator ((key integer))
+  key)
+
+(defmethod parse-accelerator ((key character))
+  (or
+   (gdk:keyval-from-name (string key))
+   (error "Invalid key name: ~A" key)))
+
+
 (defbinding accelerator-name () string
   (key unsigned-int)
   (modifiers gdk:modifier-type))
@@ -186,6 +232,9 @@ (defbinding (accelerator-default-modifier-mask "gtk_accelerator_get_default_mod_
 
 ;;; Acccel label
 
+(defbinding accel-label-get-accel-width () unsigned-int
+  (accel-label accel-label))
+
 (defbinding accel-label-refetch () boolean
   (accel-label accel-label))
 
@@ -193,7 +242,7 @@ (defbinding accel-label-refetch () boolean
 
 ;;; Accel map
 
-;(defbinding (accel-map-init "_gtk_accel_map_init") () nil)
+(defbinding (accel-map-init "_gtk_accel_map_init") () nil)
 
 (defbinding %accel-map-add-entry () nil
   (path string)
@@ -201,12 +250,20 @@ (defbinding %accel-map-add-entry () nil
   (modifiers gdk:modifier-type))
 
 (defun accel-map-add-entry (path accelerator)
-  (multiple-value-bind (key modifiers) (accelerator-parse accelerator)
+  (multiple-value-bind (key modifiers) (parse-accelerator accelerator)
     (%accel-map-add-entry path key modifiers)))
 
-(defbinding accel-map-lookup-entry () boolean
+(defbinding %accel-map-lookup-entry () boolean
   (path string)
-  (key pointer)) ;accel-key))
+  ((make-instance 'accel-key) accel-key :return))
+
+(defun accel-map-lookup-entry (path)
+  (multiple-value-bind (found-p accel-key) (%accel-map-lookup-entry path)
+    (when found-p
+      (values 
+       (slot-value accel-key 'key)
+       (slot-value accel-key 'modifiers)
+       (slot-value accel-key 'flags)))))
 
 (defbinding %accel-map-change-entry () boolean
   (path string)
@@ -215,7 +272,7 @@ (defbinding %accel-map-change-entry () boolean
   (replace boolean))
 
 (defun accel-map-change-entry (path accelerator &optional replace)
-  (multiple-value-bind (key modifiers) (accelerator-parse accelerator)
+  (multiple-value-bind (key modifiers) (parse-accelerator accelerator)
     (%accel-map-change-entry path key modifiers replace)))
 
 (defbinding accel-map-load () nil
@@ -224,6 +281,29 @@ (defbinding accel-map-load () nil
 (defbinding accel-map-save () nil
   (filename pathname))
 
+(defcallback %accel-map-foreach-func 
+    (nil
+     (callback-id unsigned-int) (accel-path (copy-of string)) 
+     (key unsigned-int) (modifiers gdk:modifier-type) (changed boolean))
+  (invoke-callback callback-id nil accel-path key modifiers changed))
+
+(defbinding %accel-map-foreach (callback-id) nil
+  (callback-id unsigned-int)
+  (%accel-map-foreach-func callback))
+
+(defbinding %accel-map-foreach-unfiltered (callback-id) nil
+  (callback-id unsigned-int)
+  (%accel-map-foreach-func callback))
+
+(defun accel-map-foreach (function &optional (filter-p t))
+  (with-callback-function (id function)
+    (if filter-p                         
+       (%accel-map-foreach id)
+      (%accel-map-foreach-unfiltered id))))
+
+(defbinding accel-map-add-filter () nil
+  (filter string))
+
 (defbinding accel-map-get () accel-map)
 
 (defbinding accel-map-lock-path () nil
@@ -234,7 +314,7 @@ (defbinding accel-map-unlock-path () nil
 
 
 
-;;; Accessible
+;;; Accessibility
 
 (defbinding accessible-connect-widget-destroyed () nil
   (accessible accessible))

diff --git a/gtk/gtktypes.lisp b/gtk/gtktypes.lisp
index 29c66589042b3724d09b8b5b3d4cd50cdac23f4a..ac439a7fcfb5f7cbd354390a1fa5d1b58895491f 100644 (file)
--- a/gtk/gtktypes.lisp
+++ b/gtk/gtktypes.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-;; $Id: gtktypes.lisp,v 1.37 2005/04/23 16:48:52 espen Exp $
+;; $Id: gtktypes.lisp,v 1.38 2005/04/24 13:30:40 espen Exp $
 
 (in-package "GTK")
 
@@ -1128,3 +1128,29 @@ (defclass file-filter-info (struct)
     :initarg :mime-type
     :type string))
   (:metaclass struct-class))
+
+
+(defclass accel-key (struct)
+  ((key
+    :allocation :alien
+    :type unsigned-int)
+   (modifiers
+    :allocation :alien
+    :type gdk:modifier-type)
+   (flags
+    :allocation :alien
+    :type (unsigned 16)))
+  (:metaclass struct-class))
+
+(defclass accel-group-entry (struct)
+  ((key
+    :allocation :alien
+    :setter nil
+    :type (inlined accel-key))
+   (gclosure
+    :allocation :alien
+    :type gclosure)
+   (accel_path_quark
+    :allocation :alien
+    :type quark))
+  (:metaclass struct-class))