sawfish r4310 - in trunk: . lisp/sawfish/ui lisp/sawfish/ui/layouts lisp/sawfish/ui/widgets

[chrisb svn gnome org]

Author: chrisb
Date: Sat Nov 29 22:28:35 2008
New Revision: 4310
URL: http://svn.gnome.org/viewvc/sawfish?rev=4310&view=rev

Log:
Added ATK-A11y support in sawfish-ui


Modified:
   trunk/ChangeLog
   trunk/configure.in
   trunk/lisp/sawfish/ui/layout.jl
   trunk/lisp/sawfish/ui/layouts/keymaps.jl
   trunk/lisp/sawfish/ui/widgets/frame-style.jl

Modified: trunk/configure.in
==============================================================================
--- trunk/configure.in	(original)
+++ trunk/configure.in	Sat Nov 29 22:28:35 2008
@@ -145,10 +145,10 @@
    fi], [: nothing])
 
 dnl Check for librep
-AM_PATH_REP(0.14)
+AM_PATH_REP(0.17)
 
 rep_gtk_function=gtk-widget-set-size-request
-rep_gtk_version=0.17
+rep_gtk_version=0.18.3
 
 AC_MSG_CHECKING([for rep-gtk >= $rep_gtk_version])
 cat >conftest <<EOF

Modified: trunk/lisp/sawfish/ui/layout.jl
==============================================================================
--- trunk/lisp/sawfish/ui/layout.jl	(original)
+++ trunk/lisp/sawfish/ui/layout.jl	Sat Nov 29 22:28:35 2008
@@ -36,6 +36,10 @@
 	   sawfish.gtk.widget)
      (access rep.structures))
 
+  (defvar widget-ptr nil)
+  (defvar label-ptr nil)
+  (defvar tempstring nil)
+
   (define (define-layout-type name fun) (put name 'nokogiri-layout fun))
 
   (define (layout-type name)
@@ -124,14 +128,21 @@
 		  (break (if (string-match "\\\\w" doc)
 			     (match-start)
 			   -2)))
+	      (setq widget-ptr (slot-gtk-widget slot))
 	      (when (> break 0)
-		(gtk-box-pack-start hbox (make-label (substring doc 0 break))))
+		(setq label-ptr (make-label (substring doc 0 break)))
+		(gtk-box-pack-start hbox label-ptr)
+		(gtk-widget-relate-label widget-ptr label-ptr))
 	      (if (memq 'expand-horizontally (slot-flags slot))
-		  (gtk-box-pack-start hbox (slot-gtk-widget slot) t t)
-		(gtk-box-pack-start hbox (slot-gtk-widget slot) nil nil))
+		  (gtk-box-pack-start hbox widget-ptr t t)
+		(gtk-box-pack-start hbox widget-ptr nil nil))
 	      (when (< break (length doc))
-		(gtk-box-pack-start
-		 hbox (make-label (substring doc (+ break 2)))))
+		(setq tempstring (substring doc (+ break 2)))	
+		(if (> (length tempstring) 0)
+		(progn
+		(setq label-ptr (make-label tempstring))
+		(gtk-box-pack-start hbox label-ptr)
+		(gtk-widget-relate-label widget-ptr label-ptr))))
 	      (setq hbox (add-tooltip hbox))
 	      (gtk-widget-show-all hbox)
 	      hbox))))))

Modified: trunk/lisp/sawfish/ui/layouts/keymaps.jl
==============================================================================
--- trunk/lisp/sawfish/ui/layouts/keymaps.jl	(original)
+++ trunk/lisp/sawfish/ui/layouts/keymaps.jl	Sat Nov 29 22:28:35 2008
@@ -31,6 +31,8 @@
 	  sawfish.ui.layout
 	  sawfish.gtk.widget)
 
+  (defvar label-ptr nil)
+
   (define (keymap-slot-p slot)
     ;; XXX so fucking evil!
     (string-match "-keymap$" (symbol-name (slot-name slot))))
@@ -48,8 +50,10 @@
 	   (active (car keymap-slots)))
 
       (when keymap-slots
-	(gtk-box-pack-start hbox (gtk-label-new (_ "Context:")))
+	(setq label-ptr (gtk-label-new (_ "Context:")))	
+	(gtk-box-pack-start hbox label-ptr)
 	(gtk-box-pack-start hbox omenu)
+	(gtk-widget-relate-label omenu label-ptr)
 	(gtk-box-pack-start vbox hbox)
 
 	(let loop ((rest keymap-slots)

Modified: trunk/lisp/sawfish/ui/widgets/frame-style.jl
==============================================================================
--- trunk/lisp/sawfish/ui/widgets/frame-style.jl	(original)
+++ trunk/lisp/sawfish/ui/widgets/frame-style.jl	Sat Nov 29 22:28:35 2008
@@ -53,6 +53,7 @@
 	  (update-readme value readme-text-view path)
 	  (call-callback changed-callback)))
 
+      (gtk-widget-relate-label combo doc-label)
       (gtk-box-set-spacing hbox box-spacing)
       (gtk-box-set-spacing vbox box-spacing)
       (gtk-container-add readme-scroller readme-text-view)