gtk/gtk.lisp: Apparently when you ask for a stock Button, you get a Bin.

[clg] / glade-xml / glade-xml.lisp

diff --git a/glade-xml/glade-xml.lisp b/glade-xml/glade-xml.lisp
index d7b28a731af01faa7dab3a3610b053b7d61a9fe2..450bd65812c10a1729a6274a475e233094a7b1bf 100644 (file)
--- a/glade-xml/glade-xml.lisp
+++ b/glade-xml/glade-xml.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: glade-xml.lisp,v 1.2 2006-09-27 08:44:44 espen Exp $
+;; $Id: glade-xml.lisp,v 1.4 2008-10-09 18:45:33 espen Exp $
 
 
 (in-package "GLADE-XML")
@@ -67,7 +67,10 @@ (define-type-method parse-value ((type boolean) value)
 
 
 (defun find-enum-value (value type)
-  (second (assoc value (query-enum-values type nil) :test #'string=)))
+  (second
+   (or
+    (assoc value (query-enum-values type nil) :test #'string=)
+    (assoc value (query-enum-values type :nickname) :test #'string=))))
 
 (define-type-method parse-value ((type enum) value)
   (int-enum (find-enum-value value type) type))
@@ -129,7 +132,7 @@ (defun parse-property (class attributes body)
        (let ((parsed-value (handler-case (parse-value type (first body))
                              (serious-condition (condition)
                                (declare (ignore condition))
-                               (warn "Ignoring property with unhandled type or invalid value: ~A" pname)
+                               (warn "Ignoring property for ~A with unhandled type or invalid value: ~A" (class-name class)  pname)
                                (return-from parse-property)))))
          (list initarg parsed-value))))))
 
@@ -171,7 +174,7 @@ (defun build-widget (spec)
        as attributes = (rest (mklist tag))
        do (cond
           ((and (eq element :|child|) (not (eq (first body) :|placeholder|)))
-           (let ((initargs (parse-properties (container-child-class class) (rest (second body)))))
+           (let ((initargs (parse-properties (find-child-class class) (rest (second body)))))
              (add-child widget (build-widget (first body)) initargs)))
 
           ((eq element :|signal|)
@@ -202,7 +205,10 @@ (defun connect-signals (widgets toplevels)
    (loop
     for signal in (user-data widget 'signals)
     do (destructuring-bind (name callback &key after object) signal
-        (signal-connect widget name callback :after after :object (widget-find object toplevels))))
+        (signal-connect widget name callback :after after 
+         :object (if (eq object t)
+                     widget
+                   (widget-find object toplevels)))))
     (unset-user-data widget 'signals)
    (when (typep widget 'container)
      (connect-signals (container-children widget) toplevels))))