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

Modified Files: actions.lisp callback.lisp cells-gtk.lpr gtk-app.lisp menus.lisp tree-view.lisp widgets.lisp Log Message: us pointer void in button-press-event-handler arglist Date: Mon Jan 3 23:33:17 2005 Author: ktilton

Index: root/cells-gtk/actions.lisp diff -u root/cells-gtk/actions.lisp:1.2 root/cells-gtk/actions.lisp:1.3 --- root/cells-gtk/actions.lisp:1.2 Tue Dec 14 05:01:51 2004 +++ root/cells-gtk/actions.lisp Mon Jan 3 23:33:16 2005 @@ -61,7 +61,7 @@

(defmethod add-action-group ((self ui-manager) (group action-group) &optional pos) (let ((grp (to-be group))) - (trc "ADD-ACTION-GROUP" grp) (force-output) + (trc nil "ADD-ACTION-GROUP" grp) (force-output) (gtk-ffi::gtk-ui-manager-insert-action-group (id self) (id group) (or pos (length (action-groups self)))) (push grp (action-groups self))))

Index: root/cells-gtk/callback.lisp diff -u root/cells-gtk/callback.lisp:1.3 root/cells-gtk/callback.lisp:1.4 --- root/cells-gtk/callback.lisp:1.3 Mon Dec 6 21:04:12 2004 +++ root/cells-gtk/callback.lisp Mon Jan 3 23:33:16 2005 @@ -3,7 +3,7 @@ (defun register-callback (self callback-id fun) (let ((id (intern (string-upcase (format nil "~a.~a" (id self) callback-id))))) - (trc "registering callback" self :id id) + (trc nil "registering callback" self :id id) (setf (gethash id (callbacks (nearest self gtk-app))) (cons fun self)) id))

Index: root/cells-gtk/cells-gtk.lpr diff -u root/cells-gtk/cells-gtk.lpr:1.1 root/cells-gtk/cells-gtk.lpr:1.2 --- root/cells-gtk/cells-gtk.lpr:1.1 Tue Dec 7 22:01:05 2004 +++ root/cells-gtk/cells-gtk.lpr Mon Jan 3 23:33:16 2005 @@ -1,11 +1,10 @@ -;; -*- lisp-version: "6.2 [Windows] (Sep 3, 2004 12:04)"; common-graphics: "1.389.2.105.2.14"; -*- +;; -*- lisp-version: "7.0 [Windows] (Dec 28, 2004 17:34)"; cg: "1.54.2.17"; -*-

-(in-package :common-graphics-user) +(in-package :cg-user)

-(defpackage :cells-gtk (:export)) +(defpackage :CELLS-GTK)

(define-project :name :cells-gtk - :application-type (intern "Standard EXE" (find-package :keyword)) :modules (list (make-instance 'module :name "cells-gtk.lisp") (make-instance 'module :name "widgets.lisp") (make-instance 'module :name "layout.lisp") @@ -19,28 +18,18 @@ (make-instance 'module :name "addon.lisp") (make-instance 'module :name "gtk-app.lisp")) :projects (list (make-instance 'project-module :name - "c:\cell-cultures\utils-kt\utils-kt") - (make-instance 'project-module :name "c:\cell-cultures\cells\cells") (make-instance 'project-module :name "c:\00\root\gtk-ffi\gtk-ffi")) :libraries nil :distributed-files nil + :internally-loaded-files nil :project-package-name :cells-gtk :main-form nil :compilation-unit t :verbose nil - :runtime-modules '(:cg :drag-and-drop :lisp-widget - :multi-picture-button :common-control - :edit-in-place :outline :grid :group-box - :header-control :progress-indicator-control - :common-status-bar :tab-control :trackbar-control - :up-down-control :dde :mci :carets :hotspots - :menu-selection :choose-list :directory-list - :color-dialog :find-dialog :font-dialog - :string-dialog :yes-no-list-dialog - :list-view-control :rich-edit :drawable :ole :www - :aclwin302) + :runtime-modules '(:cg-dde-utils :cg.base :cg.dialog-item :cg.timer + :cg.tooltip) :splash-file-module (make-instance 'build-module :name "") :icon-file-module (make-instance 'build-module :name "") :include-flags '(:compiler :top-level :local-name-info) @@ -48,6 +37,7 @@ :autoload-warning t :full-recompile-for-runtime-conditionalizations nil :default-command-line-arguments "+cx +t "Initializing"" + :additional-build-lisp-image-arguments '(:read-init-files nil) :old-space-size 256000 :new-space-size 6144 :runtime-build-option :standard

Index: root/cells-gtk/gtk-app.lisp diff -u root/cells-gtk/gtk-app.lisp:1.6 root/cells-gtk/gtk-app.lisp:1.7 --- root/cells-gtk/gtk-app.lisp:1.6 Thu Dec 23 17:34:42 2004 +++ root/cells-gtk/gtk-app.lisp Mon Jan 3 23:33:16 2005 @@ -54,7 +54,7 @@ (let ((*gtk-debug* debug)) (when (not *gtk-initialized*) (when *gtk-debug* - (trc "GTK INITIALIZATION") (force-output)) + (trc nil "GTK INITIALIZATION") (force-output)) (g-thread-init c-null) (gdk-threads-init) (assert (gtk-init-check c-null-int c-null)) @@ -80,7 +80,7 @@ (setf (visible app) t)

(when *gtk-debug* - (trc "STARTING GTK-MAIN") (force-output)) + (trc nil "STARTING GTK-MAIN") (force-output)) (gtk-main)))))

(defvar *gtk-global-callbacks* nil)

Index: root/cells-gtk/menus.lisp diff -u root/cells-gtk/menus.lisp:1.5 root/cells-gtk/menus.lisp:1.6 --- root/cells-gtk/menus.lisp:1.5 Wed Dec 22 17:23:50 2004 +++ root/cells-gtk/menus.lisp Mon Jan 3 23:33:16 2005 @@ -27,9 +27,9 @@ (changed) :new-tail '-text :on-changed (callback (widget event data) - (trc "combo-box onchanged cb" widget event data (id self)) + (trc nil "combo-box onchanged cb" widget event data (id self)) (let ((pos (gtk-combo-box-get-active (id self)))) - (trc "combo-box pos" pos) + (trc nil "combo-box pos" pos) (setf (md-value self) (and (not (= pos -1)) (nth pos (items self)))))))

Index: root/cells-gtk/tree-view.lisp diff -u root/cells-gtk/tree-view.lisp:1.7 root/cells-gtk/tree-view.lisp:1.8 --- root/cells-gtk/tree-view.lisp:1.7 Thu Dec 23 17:34:42 2004 +++ root/cells-gtk/tree-view.lisp Mon Jan 3 23:33:16 2005 @@ -105,7 +105,7 @@ (bif (tree-view (gtk-object-find column-widget)) (let ((cb (callback-recover tree-view :on-select))) (funcall cb tree-view column-widget event data)) - (trc "dude, clean up old widgets after runs" column-widget))) + (trc nil "dude, clean up old widgets after runs" column-widget)))

(def-c-output on-select ((self tree-view)) (when new-value @@ -119,7 +119,7 @@ (gtk-object-store selected-widget self) ;; tie column widg to clos tree-view (callback-register self :on-select new-value) (let ((cb (ff-register-callable 'tree-view-select-handler))) - (trc "tree-view on-select pcb:" cb selected-widget "changed") + (trc nil "tree-view on-select pcb:" cb selected-widget "changed") (gtk-signal-connect selected-widget "changed" cb)))))))

(defmodel listbox (tree-view) @@ -143,10 +143,11 @@ (id (tree-model self)) (append (column-types self) (list :string)) (loop for item in new-value - for index from 0 collect - (append - (funcall (items-factory self) item) - (list (format nil "(~d)" index))))))) + for index from 0 + collect (let ((i (funcall (items-factory self) item))) + (ukt:trc nil "items output: old,new" item i) + (append i + (list (format nil "(~d)" index))))))))

(defmodel treebox (tree-view) () @@ -179,7 +180,7 @@ (let ((cb (callback-recover self :render-cell))) (assert cb () "No :render-cell callback for ~a" self) (funcall cb tree-column cell-renderer tree-model iter data)) - (trc "dude, clean up old widgets from prior runs" tree-column)) + (trc nil "dude, clean up old widgets from prior runs" tree-column)) 1)

(def-c-output columns ((self tree-view))

Index: root/cells-gtk/widgets.lisp diff -u root/cells-gtk/widgets.lisp:1.6 root/cells-gtk/widgets.lisp:1.7 --- root/cells-gtk/widgets.lisp:1.6 Thu Dec 23 17:34:42 2004 +++ root/cells-gtk/widgets.lisp Mon Jan 3 23:33:16 2005 @@ -32,7 +32,7 @@ (id :initarg :id :accessor id :initform (c? (without-c-dependency (when *gtk-debug* - (trc "NEW ID" (new-function-name self) (new-args self)) (force-output)) + (trc nil "NEW ID" (new-function-name self) (new-args self)) (force-output)) (let ((id (apply (symbol-function (new-function-name self)) (new-args self)))) (gtk-object-store id self) @@ -123,7 +123,7 @@ (bif (self (gtk-object-find widget)) (let ((cb (callback-recover self ,(intern (symbol-name event) :keyword)))) (funcall cb self widget event data)) - (trc "unknown widget. from prior run. clean up on errors" widget)))) + (trc nil "unknown widget. from prior run. clean up on errors" widget))))

(def-gtk-event-handler clicked) (def-gtk-event-handler changed) @@ -186,7 +186,7 @@ new-value) (let ((cb (cdr (assoc ',signal-slot *widget-callbacks*)))) (assert cb) - #+shhtk (trc "in def-c-output gtk-signal-connect pcb:" + #+shhtk (trc nil "in def-c-output gtk-signal-connect pcb:" cb ',slot-name (id self)) (gtk-signal-connect (id self) ,(string-downcase (string signal-slot)) cb)))) @@ -204,7 +204,7 @@ (export ',(mapcar #'first (append std-slots slots signals-slots))))

(defun ,(intern (format nil "MK-~a" class)) (&rest inits) - (when *gtk-debug* (trc "MAKE-INSTANCE" ',class) (force-output)) + (when *gtk-debug* (trc nil "MAKE-INSTANCE" ',class) (force-output)) (apply 'make-instance ',class inits)) (eval-when (compile load eval) (export ',(intern (format nil "MK-~a" class)))) @@ -306,7 +306,7 @@

(def-c-output visible ((self widget)) (when *gtk-debug* - (trc "VISIBLE" (md-name self) new-value) (force-output)) + (trc nil "VISIBLE" (md-name self) new-value) (force-output)) (if new-value (gtk-widget-show (id self)) (gtk-widget-hide (id self)))) @@ -317,7 +317,7 @@ (id self) new-value "")))

(defmethod not-to-be :after ((self widget)) - (when *gtk-debug* (trc "WIDGET DESTROY" (md-name self)) (force-output)) + (when *gtk-debug* (trc nil "WIDGET DESTROY" (md-name self)) (force-output)) (gtk-object-forget (id self) self) (gtk-widget-destroy (id self)))

@@ -380,7 +380,7 @@ (def-c-output .kids ((self window)) (assert-bin self) (dolist (kid new-value) - (when *gtk-debug* (trc "WINDOW ADD KID" (md-name self) (md-name kid)) (force-output)) + (when *gtk-debug* (trc nil "WINDOW ADD KID" (md-name self) (md-name kid)) (force-output)) (gtk-container-add (id self) (id kid))) #+clisp (call-next-method))