February 2005 - cells-gtk-cvs@common-lisp.net

[cells-gtk-cvs] CVS update: root/cells-gtk/widgets.lisp
by pdenno＠common-lisp.net 16 Feb '05

16 Feb '05

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv24983/cells-gtk Modified Files: widgets.lisp Log Message: Removed def-c-output method on event-box. I added it two versions ago, but it is the wrong approach to the problem. Date: Wed Feb 16 23:24:08 2005 Author: pdenno Index: root/cells-gtk/widgets.lisp diff -u root/cells-gtk/widgets.lisp:1.9 root/cells-gtk/widgets.lisp:1.10 --- root/cells-gtk/widgets.lisp:1.9 Mon Feb 14 23:46:19 2005 +++ root/cells-gtk/widgets.lisp Wed Feb 16 23:24:07 2005 @@ -310,7 +310,7 @@ (trc nil "VISIBLE" (md-name self) new-value) (force-output)) (if new-value (gtk-widget-show (id self)) - (gtk-widget-hide (id self)))) + (gtk-widget-hide (id self)))) (def-c-output tooltip ((self widget)) (when new-value @@ -390,10 +390,6 @@ (above-child) () :above-child t) - -(def-c-output popup ((self event-box)) - (when new-value - (setf (fm-parent new-value) self))) (def-c-output visible-window ((self event-box)) (gtk-event-box-set-visible-window (id self) new-value))

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/menus.lisp
by pdenno＠common-lisp.net 16 Feb '05

16 Feb '05

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv24960/cells-gtk Modified Files: menus.lisp Log Message: owner slot on menu object -- useful for situation like popup menus, where the menu isn't in the kids hierarchy. Date: Wed Feb 16 23:22:01 2005 Author: pdenno Index: root/cells-gtk/menus.lisp diff -u root/cells-gtk/menus.lisp:1.7 root/cells-gtk/menus.lisp:1.8 --- root/cells-gtk/menus.lisp:1.7 Sat Feb 12 15:53:18 2005 +++ root/cells-gtk/menus.lisp Wed Feb 16 23:22:01 2005 @@ -140,7 +140,7 @@ () () ()) (def-widget menu (menu-shell) - () + ((owner :initarg :owner :accessor owner :initform (c-in nil))) (title) ())

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/gtk-app.lisp
by pdenno＠common-lisp.net 16 Feb '05

16 Feb '05

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)

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/display.lisp
by pdenno＠common-lisp.net 16 Feb '05

16 Feb '05

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv24903/cells-gtk Modified Files: display.lisp Log Message: One line of documentation Date: Wed Feb 16 23:18:06 2005 Author: pdenno Index: root/cells-gtk/display.lisp diff -u root/cells-gtk/display.lisp:1.2 root/cells-gtk/display.lisp:1.3 --- root/cells-gtk/display.lisp:1.2 Sun Dec 5 07:33:22 2004 +++ root/cells-gtk/display.lisp Wed Feb 16 23:18:05 2005 @@ -97,6 +97,7 @@ (list (or (filename self) ""))))) (def-c-output stock ((self image)) + "Set the image of a stock icon" (when new-value (gtk-image-set-from-stock (id self) (stock-id self) (icon-size-id self))))

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/widgets.lisp
by pdenno＠common-lisp.net 14 Feb '05

14 Feb '05

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv2871/cells-gtk Modified Files: widgets.lisp Log Message: def-c-output on event-box, slot popup should have been wrapped in a (when new-value ...) Date: Mon Feb 14 23:46:20 2005 Author: pdenno Index: root/cells-gtk/widgets.lisp diff -u root/cells-gtk/widgets.lisp:1.8 root/cells-gtk/widgets.lisp:1.9 --- root/cells-gtk/widgets.lisp:1.8 Sat Feb 12 16:02:56 2005 +++ root/cells-gtk/widgets.lisp Mon Feb 14 23:46:19 2005 @@ -392,7 +392,8 @@ :above-child t) (def-c-output popup ((self event-box)) - (setf (fm-parent new-value) self)) + (when new-value + (setf (fm-parent new-value) self))) (def-c-output visible-window ((self event-box)) (gtk-event-box-set-visible-window (id self) new-value))

1 0

[cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-utilities.lisp
by pdenno＠common-lisp.net 13 Feb '05

13 Feb '05

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv10004/gtk-ffi Modified Files: gtk-utilities.lisp Log Message: non-printing characters in cut-and-paste of Andras's patch Date: Sun Feb 13 19:21:29 2005 Author: pdenno Index: root/gtk-ffi/gtk-utilities.lisp diff -u root/gtk-ffi/gtk-utilities.lisp:1.10 root/gtk-ffi/gtk-utilities.lisp:1.11 --- root/gtk-ffi/gtk-utilities.lisp:1.10 Sun Feb 13 18:28:02 2005 +++ root/gtk-ffi/gtk-utilities.lisp Sun Feb 13 19:21:29 2005 @@ -190,11 +190,11 @@ (with-foreign-object (item :pointer-void) (gtk-tree-model-get model iter column-no item -1) #-(or lispworks cmu allegro) (cast item (as-gtk-type-name cell-type)) - #+allegro - (case cell-type - (:string (uffi:convert-from-cstring (uffi:deref-pointer item :cstring))) - (t (cast item (as-gtk-type-name cell-type)))) - #+lispworks + #+allegro + (case cell-type + (:string (uffi:convert-from-cstring (uffi:deref-pointer item :cstring))) + (t (cast item (as-gtk-type-name cell-type)))) + #+lispworks (case cell-type (:string (fli:convert-from-foreign-string (fli:dereference item))) (t (fli:dereference item)))

1 0

[cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-utilities.lisp
by pdenno＠common-lisp.net 13 Feb '05

13 Feb '05

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv6967/gtk-ffi Modified Files: gtk-utilities.lisp Log Message: Andras's #+allegro patch for tree selection Date: Sun Feb 13 18:28:02 2005 Author: pdenno Index: root/gtk-ffi/gtk-utilities.lisp diff -u root/gtk-ffi/gtk-utilities.lisp:1.9 root/gtk-ffi/gtk-utilities.lisp:1.10 --- root/gtk-ffi/gtk-utilities.lisp:1.9 Sat Feb 12 16:09:52 2005 +++ root/gtk-ffi/gtk-utilities.lisp Sun Feb 13 18:28:02 2005 @@ -180,7 +180,7 @@ (g-value-unset value)))) ;;; todo: The deref-pointer-runtime-typed used by case needs work if -;;; it is going to be used for lispworks and cmu. +;;; it is going to be used for lispworks, cmu and allegro. ;;; (needs someone who knows how ffi-to-uffi-type maps types for those lisps.) ;;; Even better, eliminate it. It is ill-conceived. (defun gtk-tree-model-get-cell (model iter column-no cell-type) @@ -189,15 +189,19 @@ column-no = num-columns. (See gtk-tree-store-set-kids)." (with-foreign-object (item :pointer-void) (gtk-tree-model-get model iter column-no item -1) - #-(or lispworks cmu) (cast item (as-gtk-type-name cell-type)) - #+lispworks - (case cell-type - (:string (fli:convert-from-foreign-string (fli:dereference item))) - (t (fli:dereference item))) - #+cmu - (case cell-type - (:string (alien:cast (alien:deref item) c-call:c-string)) - (t (alien:deref item))))) + #-(or lispworks cmu allegro) (cast item (as-gtk-type-name cell-type)) + #+allegro + (case cell-type + (:string (uffi:convert-from-cstring (uffi:deref-pointer item :cstring))) + (t (cast item (as-gtk-type-name cell-type)))) + #+lispworks + (case cell-type + (:string (fli:convert-from-foreign-string (fli:dereference item))) + (t (fli:dereference item))) + #+cmu + (case cell-type + (:string (alien:cast (alien:deref item) c-call:c-string)) + (t (alien:deref item))))) (defun parse-cell-attrib (attribs) (loop for (attrib val) on attribs by #'cddr collect

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/gtk-app.lisp
by pdenno＠common-lisp.net 13 Feb '05

13 Feb '05

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv6944/cells-gtk Modified Files: gtk-app.lisp Log Message: better error message Date: Sun Feb 13 18:25:14 2005 Author: pdenno Index: root/cells-gtk/gtk-app.lisp diff -u root/cells-gtk/gtk-app.lisp:1.10 root/cells-gtk/gtk-app.lisp:1.11 --- root/cells-gtk/gtk-app.lisp:1.10 Sat Feb 12 20:11:55 2005 +++ root/cells-gtk/gtk-app.lisp Sun Feb 13 18:25:13 2005 @@ -90,7 +90,7 @@ do (gtk-main-iteration-do nil)) (process-wait-with-timeout .01 "GTK event loop waiting")) (gtk-cells-error (err) - (show-message (format nil "Error: ~a" err) :message-type :error) + (show-message (format nil "Cells-GTK Error: ~a" err) :message-type :error) (process-wait "Acknowledge error" #'gtk-events-pending) (loop while (gtk-events-pending) do (gtk-main-iteration-do nil)) (throw 'try-again nil))))))))

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/dialogs.lisp
by pdenno＠common-lisp.net 13 Feb '05

13 Feb '05

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv6914/cells-gtk Modified Files: dialogs.lisp Log Message: Without the gtk-object-forget, with frequent use of the file-chooser, you will get an error: Error: gtk-object-store id 136368864 already known as #<FILE-CHOOSER-DIALOG 239AA2A4>, not #<FILE-CHOOSER-DIALOG 206F656C> There are probably other places where widgets are destroyed but the hash-table not cleaned up, but this is the only one so far where I have seen an error. Date: Sun Feb 13 18:24:02 2005 Author: pdenno Index: root/cells-gtk/dialogs.lisp diff -u root/cells-gtk/dialogs.lisp:1.2 root/cells-gtk/dialogs.lisp:1.3 --- root/cells-gtk/dialogs.lisp:1.2 Sun Dec 5 07:33:22 2004 +++ root/cells-gtk/dialogs.lisp Sun Feb 13 18:24:02 2005 @@ -132,7 +132,8 @@ (if (select-multiple self) (setf (md-value self) (gtk-file-chooser-get-filenames-strs (id self))) (setf (md-value self) (gtk-file-chooser-get-filename (id self))))) - (gtk-widget-destroy (id self)))) + (gtk-widget-destroy (id self)) + (gtk-object-forget (id self) self))) (defun file-chooser (&rest inits) (let ((dialog (to-be (apply #'mk-file-chooser-dialog inits))))

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/gtk-app.lisp
by pdenno＠common-lisp.net 12 Feb '05

12 Feb '05

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv1611/cells-gtk Modified Files: gtk-app.lisp Log Message: The wait loop approach that works for lispworks doesn't really work for cmucl (uses too much processor). Nor does simple process-wait with gtk-event-pending work, which is unfortunate. Date: Sat Feb 12 20:11:56 2005 Author: pdenno Index: root/cells-gtk/gtk-app.lisp diff -u root/cells-gtk/gtk-app.lisp:1.9 root/cells-gtk/gtk-app.lisp:1.10 --- root/cells-gtk/gtk-app.lisp:1.9 Sat Feb 12 15:50:29 2005 +++ root/cells-gtk/gtk-app.lisp Sat Feb 12 20:11:55 2005 @@ -81,14 +81,14 @@ (when *gtk-debug* (trc nil "STARTING GTK-MAIN") (force-output)) - #+clisp(gtk-main) - #-clisp + #-lispworks(gtk-main) + #+lispworks (catch 'try-again (handler-case (loop (loop while (gtk-events-pending) do (gtk-main-iteration-do nil)) - (process-wait-with-timeout .01 "GTK event loop waiting" #'(lambda () t))) + (process-wait-with-timeout .01 "GTK event loop waiting")) (gtk-cells-error (err) (show-message (format nil "Error: ~a" err) :message-type :error) (process-wait "Acknowledge error" #'gtk-events-pending)

1 0