Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv24931/cells-gtk

Modified Files: gtk-app.lisp Log Message: A initialize-instance :after method to create user-defined stock icons -- these do not involve clos objects or cells, just gtk (that's why its a i-i on gtk-app). Date: Wed Feb 16 23:20:37 2005 Author: pdenno

Index: root/cells-gtk/gtk-app.lisp diff -u root/cells-gtk/gtk-app.lisp:1.11 root/cells-gtk/gtk-app.lisp:1.12 --- root/cells-gtk/gtk-app.lisp:1.11 Sun Feb 13 18:25:13 2005 +++ root/cells-gtk/gtk-app.lisp Wed Feb 16 23:20:37 2005 @@ -22,13 +22,23 @@ ((splash-screen-image :accessor splash-screen-image :initarg :splash-screen-image :initform nil) (tooltips :initarg :tooltips :accessor tooltips :initform (make-be 'tooltips)) (tooltips-enable :accessor tooltips-enable :initarg :tooltips-enable :initform (c-in t)) - (tooltips-delay :accessor tooltips-delay :initarg :tooltips-delay :initform (c-in nil))) + (tooltips-delay :accessor tooltips-delay :initarg :tooltips-delay :initform (c-in nil)) + (stock-icons :cell nil :accessor stock-icons :initarg :stock-icons :initform nil)) (:default-initargs :on-delete-event (lambda (self widget event data) (declare (ignore self widget event data)) (gtk-main-quit) 0)))

+(defmethod initialize-instance :after ((self gtk-app) &key stock-icons) + (loop for (name pathname) in stock-icons do + (let* ((image (gtk-image-new-from-file pathname)) + (pixbuf (gtk-image-get-pixbuf image)) + (icon-set (gtk-icon-set-new-from-pixbuf pixbuf)) + (factory (gtk-icon-factory-new))) + (gtk-icon-factory-add factory (format nil "gtk-~A" (string-downcase (string name))) icon-set) + (gtk-icon-factory-add-default factory)))) + (def-c-output tooltips-enable ((self gtk-app)) (when (tooltips self) (if new-value @@ -78,7 +88,7 @@ (not-to-be splash) (gtk-window-set-auto-startup-notification t)) (setf (visible app) t) - + (when *gtk-debug* (trc nil "STARTING GTK-MAIN") (force-output)) #-lispworks(gtk-main)