[cells-gtk-cvs] CVS update: root/cells-gtk/actions.lisp root/cells-gtk/callback.lisp root/cells-gtk/cells-gtk.lpr root/cells-gtk/gtk-app.lisp root/cells-gtk/menus.lisp root/cells-gtk/tree-view.lisp root/cells-gtk/widgets.lisp
Kenny Tilton
ktilton at common-lisp.net
Mon Jan 3 22:33:20 UTC 2005
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))
More information about the Cells-gtk-cvs
mailing list