X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/807228175c9db4f8f668a8b12123fb29e9d1a73f..HEAD:/glade-xml/glade-xml.lisp

diff --git a/glade-xml/glade-xml.lisp b/glade-xml/glade-xml.lisp
index d7b28a7..450bd65 100644
--- 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))))