[cells-devel] Celtk and SBCL (and linux)
Hi all, I'm trying to get Celtk working on SBCL. I've attached a patch with several bugfixes. Much still does not work, however, I have managed to display the "one-button-window" demo (though it crashes immediately after display. Sometime later I will have questions. Celtk still crashes often in finish-business, and I'm not yet familiar enough with cells to perform the fixes. I made a change in item-pictorial that I'm not certain about. In lotsa-widgets, tcl chokes when I use :bitmap in mk-bitmap: debugger invoked on a SIMPLE-ERROR in thread #<THREAD "initial thread" {A549481}>: Tcl error: bitmap "/home/stu/tmp/cells/Celtk/x1.xbm" not defined I changed it to :file and added a -file entry in deftk bitmap. That fixed the first error, but created a new one (which occurs later): debugger invoked on a SIMPLE-ERROR in thread #<THREAD "initial thread" {A549481}>: Tcl error: unknown option "-file" I'm not sure how to proceed here. Any help would be great. Lastly, anonymous CVS access would be great. It would certainly help for creating patches and for keeping my sources updated. Regards, -Stu Glaser diff -c old-Celtk/composites.lisp Celtk/composites.lisp *** old-Celtk/composites.lisp Mon May 15 00:15:37 2006 --- Celtk/composites.lisp Tue May 23 04:00:59 2006 *************** *** 85,91 **** #+wishful (ewish :initarg :ewish :accessor ewish :initform nil :cell nil) ;; vestigial? (title$ :initarg :title$ :accessor title$ :initform (c? (string-capitalize (class-name (class-of self))))) ! (dictionary :initarg :dictionary :initform (make-hash-table :test 'string-equal) :accessor dictionary) (tkwins :initform (make-hash-table) :reader tkwins) (xwins :initform (make-hash-table) :reader xwins) (callbacks :initarg :callbacks :accessor callbacks --- 85,91 ---- #+wishful (ewish :initarg :ewish :accessor ewish :initform nil :cell nil) ;; vestigial? (title$ :initarg :title$ :accessor title$ :initform (c? (string-capitalize (class-name (class-of self))))) ! (dictionary :initarg :dictionary :initform (make-hash-table :test 'equalp) :accessor dictionary) (tkwins :initform (make-hash-table) :reader tkwins) (xwins :initform (make-hash-table) :reader xwins) (callbacks :initarg :callbacks :accessor callbacks diff -c old-Celtk/item-pictorial.lisp Celtk/item-pictorial.lisp *** old-Celtk/item-pictorial.lisp Tue May 2 01:57:22 2006 --- Celtk/item-pictorial.lisp Tue May 23 04:00:59 2006 *************** *** 31,36 **** --- 31,37 ---- -activebackground -disabledbackground -bitmap + -file -activebitmap -disabledbitmap -foreground diff -c old-Celtk/run.lisp Celtk/run.lisp *** old-Celtk/run.lisp Tue May 16 19:40:55 2006 --- Celtk/run.lisp Tue May 23 04:00:59 2006 *************** *** 39,45 **** (tk-app-init *tki*) (tk-togl-init *tki*) (tk-format-now "proc TraceOP {n1 n2 op} {event generate $n1 <<trace>> -data $op}") ! (tcl-create-command *tki* "do-on-command" (get-callback 'do-on-command) 42 0) (with-integrity () (setf *tkw* (make-instance root-class)) --- 40,46 ---- (tk-app-init *tki*) (tk-togl-init *tki*) (tk-format-now "proc TraceOP {n1 n2 op} {event generate $n1 <<trace>> -data $op}") ! (tcl-create-command *tki* "do-on-command" (get-callback 'do-on-command) 42 (null-pointer)) (with-integrity () (setf *tkw* (make-instance root-class)) *************** *** 85,88 **** (force-output *tkw*) (setf *tkw* nil)) ! (run-window root-class)) \ No newline at end of file --- 86,89 ---- (force-output *tkw*) (setf *tkw* nil)) ! (run-window root-class)) diff -c old-Celtk/tk-events.lisp Celtk/tk-events.lisp *** old-Celtk/tk-events.lisp Tue May 16 19:40:55 2006 --- Celtk/tk-events.lisp Tue May 23 04:00:59 2006 *************** *** 35,41 **** (tkwin :pointer) (mask :int) (proc :pointer) ! (client-data :int)) (defcenum tk-event-type ;; do not try to generate masks from these! "Ok for interpreting type field in event, but not for (expt 2 etype) to get mask" --- 35,41 ---- (tkwin :pointer) (mask :int) (proc :pointer) ! (client-data :pointer)) (defcenum tk-event-type ;; do not try to generate masks from these! "Ok for interpreting type field in event, but not for (expt 2 etype) to get mask" diff -c old-Celtk/tk-interp.lisp Celtk/tk-interp.lisp *** old-Celtk/tk-interp.lisp Tue May 16 16:17:15 2006 --- Celtk/tk-interp.lisp Tue May 23 04:00:59 2006 *************** *** 36,50 **** (define-foreign-library Tcl (:darwin (:framework "Tcl")) ! (:windows (:or "/tcl/bin/Tcl85.dll"))) (define-foreign-library Tk (:darwin (:framework "Tk")) ! (:windows (:or "/tcl/bin/tk85.dll"))) ;; Togl (define-foreign-library Togl (:darwin (:or "/opt/tcltk/togl/lib/Togl1.7/libtogl1.7.dylib")) ! (:windows (:or "/tcl/lib/togl/togl17.dll"))) (defctype tcl-retcode :int) --- 36,57 ---- (define-foreign-library Tcl (:darwin (:framework "Tcl")) ! (:windows (:or "/tcl/bin/Tcl85.dll")) ! (:unix "libtcl.so") ! (t (:default "libtcl"))) (define-foreign-library Tk (:darwin (:framework "Tk")) ! (:windows (:or "/tcl/bin/tk85.dll")) ! (:unix "libtk.so") ! (t (:default "libtk"))) ;; Togl (define-foreign-library Togl (:darwin (:or "/opt/tcltk/togl/lib/Togl1.7/libtogl1.7.dylib")) ! (:windows (:or "/tcl/lib/togl/togl17.dll")) ! (:unix "/usr/lib/Togl1.7/libTogl1.7.so")) ! ! (use-foreign-library Togl) (defctype tcl-retcode :int) *************** *** 233,239 **** (defun argv0 () #+allegro (sys:command-line-argument 0) ! #+lispworks (nth 0 (io::io-get-command-line-arguments))) (defun tk-interp-init-ensure () (unless *initialized* --- 240,247 ---- (defun argv0 () #+allegro (sys:command-line-argument 0) ! #+lispworks (nth 0 (io::io-get-command-line-arguments)) ! #+sbcl (nth 0 sb-ext:*posix-argv*)) (defun tk-interp-init-ensure () (unless *initialized* diff -c old-Celtk/widget.lisp Celtk/widget.lisp *** old-Celtk/widget.lisp Tue May 16 19:40:55 2006 --- Celtk/widget.lisp Tue May 23 04:00:59 2006 *************** *** 78,84 **** (defun tk-create-event-handler-ex (widget callback-name &rest masks) (let ((self-tkwin (widget-to-tkwin widget))) ! (assert (plusp self-tkwin)) (trc nil "setting up widget virtual-event handler" widget :tkwin self-tkwin) (tk-create-event-handler self-tkwin (apply 'foreign-masks-combine 'tk-event-mask masks) --- 78,84 ---- (defun tk-create-event-handler-ex (widget callback-name &rest masks) (let ((self-tkwin (widget-to-tkwin widget))) ! (assert (not (null-pointer-p self-tkwin))) (trc nil "setting up widget virtual-event handler" widget :tkwin self-tkwin) (tk-create-event-handler self-tkwin (apply 'foreign-masks-combine 'tk-event-mask masks)
On 5/23/06, Stu Glaser <stuglaser@gmail.com> wrote:
Hi all,
I'm trying to get Celtk working on SBCL. I've attached a patch with several bugfixes.
Thx for the patches. I will start working thru them and update CVS shortly. speaking of which, not sure what you mean by not having anonymous CVS, but I am a CVS dummy. I just use TortoiseCVS on win32 and I have write access so... well, like I said, i do not know a thing about CVS, not sur ehow to help. Much still does not work, however, I have managed to
display the "one-button-window" demo (though it crashes immediately after display.
Without you doing anything? And it takes out your Lisp session as well, or do you get a backtrace? Sometime later I will have questions. Celtk still crashes often in
finish-business, and I'm not yet familiar enough with cells to perform the fixes.
Well, almost everything happens in "finish-business", so I would not worry about Cells as much as OS differences and Lisp differences and installation issues (as you have been). I made a change in item-pictorial that I'm not certain about. In
lotsa-widgets, tcl chokes when I use :bitmap in mk-bitmap: debugger invoked on a SIMPLE-ERROR in thread #<THREAD "initial thread" {A549481}>: Tcl error: bitmap "/home/stu/tmp/cells/Celtk/x1.xbm" not defined
I changed it to :file and added a -file entry in deftk bitmap.
Looking here: http://tmml.sourceforge.net/doc/tk/canvas.html, I do not see a -file configuration option on the Bitmap Canvas item (you have to scroll waaaay down under the Canvas widget to find the items. Which explains.... That
fixed the first error, but created a new one (which occurs later): debugger invoked on a SIMPLE-ERROR in thread #<THREAD "initial thread" {A549481}>: Tcl error: unknown option "-file"
I'm not sure how to proceed here. Any help would be great.
I think what happened is that you just made Tcl break sooner. ie, before it saw the (correct, I think) -bitmap option and then died when it decided the file was not "defined" (strange, it should say found, right? I will investigate over trying to recreate your error. So let's go back to that weird <file location> "not defined". I have a hunch but prefer to investigate first. meanwhile, a couple of things for you to try: 1. naturally, make sure the file is there. :) I am not sure I even had that .xbm file in the distro until recently. 2. find the function tk-format-now and monkey with the debug stuff so that any message to Tk with the word "bitmap" in it gets printed, and see if you can catch the output and post that. When really confused I rig that so it prints everything, but on lotsa-widgets that would be a lot. if you are brave you can try moving Just Enough Code from lotsa-widgets to one-button. But it is probably easiest to use my yes/no filters in tk-format-now to get just the right amount of messaging. kenny Lastly, anonymous CVS access would be great. It would certainly help
for creating patches and for keeping my sources updated.
Regards, -Stu Glaser
diff -c old-Celtk/composites.lisp Celtk/composites.lisp *** old-Celtk/composites.lisp Mon May 15 00:15:37 2006 --- Celtk/composites.lisp Tue May 23 04:00:59 2006 *************** *** 85,91 **** #+wishful (ewish :initarg :ewish :accessor ewish :initform nil :cell nil) ;; vestigial? (title$ :initarg :title$ :accessor title$ :initform (c? (string-capitalize (class-name (class-of self))))) ! (dictionary :initarg :dictionary :initform (make-hash-table :test 'string-equal) :accessor dictionary) (tkwins :initform (make-hash-table) :reader tkwins) (xwins :initform (make-hash-table) :reader xwins) (callbacks :initarg :callbacks :accessor callbacks --- 85,91 ---- #+wishful (ewish :initarg :ewish :accessor ewish :initform nil :cell nil) ;; vestigial? (title$ :initarg :title$ :accessor title$ :initform (c? (string-capitalize (class-name (class-of self))))) ! (dictionary :initarg :dictionary :initform (make-hash-table :test 'equalp) :accessor dictionary) (tkwins :initform (make-hash-table) :reader tkwins) (xwins :initform (make-hash-table) :reader xwins) (callbacks :initarg :callbacks :accessor callbacks diff -c old-Celtk/item-pictorial.lisp Celtk/item-pictorial.lisp *** old-Celtk/item-pictorial.lisp Tue May 2 01:57:22 2006 --- Celtk/item-pictorial.lisp Tue May 23 04:00:59 2006 *************** *** 31,36 **** --- 31,37 ---- -activebackground -disabledbackground -bitmap + -file -activebitmap -disabledbitmap -foreground diff -c old-Celtk/run.lisp Celtk/run.lisp *** old-Celtk/run.lisp Tue May 16 19:40:55 2006 --- Celtk/run.lisp Tue May 23 04:00:59 2006 *************** *** 39,45 **** (tk-app-init *tki*) (tk-togl-init *tki*) (tk-format-now "proc TraceOP {n1 n2 op} {event generate $n1 <<trace>> -data $op}") ! (tcl-create-command *tki* "do-on-command" (get-callback 'do-on-command) 42 0)
(with-integrity () (setf *tkw* (make-instance root-class)) --- 40,46 ---- (tk-app-init *tki*) (tk-togl-init *tki*) (tk-format-now "proc TraceOP {n1 n2 op} {event generate $n1 <<trace>> -data $op}") ! (tcl-create-command *tki* "do-on-command" (get-callback 'do-on-command) 42 (null-pointer))
(with-integrity () (setf *tkw* (make-instance root-class)) *************** *** 85,88 **** (force-output *tkw*) (setf *tkw* nil))
! (run-window root-class)) \ No newline at end of file --- 86,89 ---- (force-output *tkw*) (setf *tkw* nil))
! (run-window root-class)) diff -c old-Celtk/tk-events.lisp Celtk/tk-events.lisp *** old-Celtk/tk-events.lisp Tue May 16 19:40:55 2006 --- Celtk/tk-events.lisp Tue May 23 04:00:59 2006 *************** *** 35,41 **** (tkwin :pointer) (mask :int) (proc :pointer) ! (client-data :int))
(defcenum tk-event-type ;; do not try to generate masks from these! "Ok for interpreting type field in event, but not for (expt 2 etype) to get mask" --- 35,41 ---- (tkwin :pointer) (mask :int) (proc :pointer) ! (client-data :pointer))
(defcenum tk-event-type ;; do not try to generate masks from these! "Ok for interpreting type field in event, but not for (expt 2 etype) to get mask" diff -c old-Celtk/tk-interp.lisp Celtk/tk-interp.lisp *** old-Celtk/tk-interp.lisp Tue May 16 16:17:15 2006 --- Celtk/tk-interp.lisp Tue May 23 04:00:59 2006 *************** *** 36,50 ****
(define-foreign-library Tcl (:darwin (:framework "Tcl")) ! (:windows (:or "/tcl/bin/Tcl85.dll"))) (define-foreign-library Tk (:darwin (:framework "Tk")) ! (:windows (:or "/tcl/bin/tk85.dll")))
;; Togl (define-foreign-library Togl (:darwin (:or "/opt/tcltk/togl/lib/Togl1.7/libtogl1.7.dylib")) ! (:windows (:or "/tcl/lib/togl/togl17.dll")))
(defctype tcl-retcode :int)
--- 36,57 ----
(define-foreign-library Tcl (:darwin (:framework "Tcl")) ! (:windows (:or "/tcl/bin/Tcl85.dll")) ! (:unix "libtcl.so") ! (t (:default "libtcl"))) (define-foreign-library Tk (:darwin (:framework "Tk")) ! (:windows (:or "/tcl/bin/tk85.dll")) ! (:unix "libtk.so") ! (t (:default "libtk")))
;; Togl (define-foreign-library Togl (:darwin (:or "/opt/tcltk/togl/lib/Togl1.7/libtogl1.7.dylib")) ! (:windows (:or "/tcl/lib/togl/togl17.dll")) ! (:unix "/usr/lib/Togl1.7/libTogl1.7.so")) ! ! (use-foreign-library Togl)
(defctype tcl-retcode :int)
*************** *** 233,239 ****
(defun argv0 () #+allegro (sys:command-line-argument 0) ! #+lispworks (nth 0 (io::io-get-command-line-arguments)))
(defun tk-interp-init-ensure () (unless *initialized* --- 240,247 ----
(defun argv0 () #+allegro (sys:command-line-argument 0) ! #+lispworks (nth 0 (io::io-get-command-line-arguments)) ! #+sbcl (nth 0 sb-ext:*posix-argv*))
(defun tk-interp-init-ensure () (unless *initialized* diff -c old-Celtk/widget.lisp Celtk/widget.lisp *** old-Celtk/widget.lisp Tue May 16 19:40:55 2006 --- Celtk/widget.lisp Tue May 23 04:00:59 2006 *************** *** 78,84 ****
(defun tk-create-event-handler-ex (widget callback-name &rest masks) (let ((self-tkwin (widget-to-tkwin widget))) ! (assert (plusp self-tkwin)) (trc nil "setting up widget virtual-event handler" widget :tkwin self-tkwin) (tk-create-event-handler self-tkwin (apply 'foreign-masks-combine 'tk-event-mask masks) --- 78,84 ----
(defun tk-create-event-handler-ex (widget callback-name &rest masks) (let ((self-tkwin (widget-to-tkwin widget))) ! (assert (not (null-pointer-p self-tkwin))) (trc nil "setting up widget virtual-event handler" widget :tkwin self-tkwin) (tk-create-event-handler self-tkwin (apply 'foreign-masks-combine 'tk-event-mask masks)
_______________________________________________ cells-devel site list cells-devel@common-lisp.net http://common-lisp.net/mailman/listinfo/cells-devel
2. find the function tk-format-now and monkey with the debug stuff so that any message to Tk with the word "bitmap" in it gets printed, and see if you can catch the output and post that.
I get: tk> .f332.cv334 create bitmap 140 140 -bitmap "@\\0dev\\Celtk\\x1.xbm" That works. Then changing the name to something it will not find, I get: Error: Tcl error: error reading bitmap file "\0dev\Celtk\xoxox1.xbm" Here is my theory: the string does not look like a filename path to Tcl on Linux, so it looks for a /named/ bitmap. ie, yeah, tcl has a mechanism (perhaps only in the C api, I do not know) to associate an arbitrary name with a bitmap being loaded from a file. Then all your code just uses that name, and you only have to change the filename in one place to get everyone to use a different bitmap. Anyway, that would explain the "not defined" complaint. It also makes sense since you are (I might have warned you earlier) the first Linux user. The bad news is that I am also ignorant of Linux. :) hth, kenny
On 5/23/06, Stu Glaser <stuglaser@gmail.com> wrote:
Hi all,
I'm trying to get Celtk working on SBCL. I've attached a patch with several bugfixes.
I'm not a Celtk user, but I am the Cells-on-SBCL guy, so I'm definately paying attention here. Could you please send patches in unified diff format? It's about 1000x easier to read (you can get diff to produce it with the -u option).
Much still does not work, however, I have managed to display the "one-button-window" demo (though it crashes immediately after display.
Sometime later I will have questions. Celtk still crashes often in finish-business, and I'm not yet familiar enough with cells to perform the fixes.
If Kenny or Frank doesn't get to this before I do, I can look into it in a couple weeks. If you guys haven't sorted it out with Celtk issues, it might be Cells related...
Lastly, anonymous CVS access would be great. It would certainly help for creating patches and for keeping my sources updated.
All of Cells uses the common-lisp.net infrastructure, and they turned off anonymous pserver access due to the constant security nightmare it implies. Sorry. I'd be happy with a move to svn, which would also mean reliable anonymous access, but I'm not sure if there's a reasonable client for Windows. There's a good OS X one, though, so I wouldn't be surprised if there was.
On 5/23/06, Thomas F. Burdick <tfb@ocf.berkeley.edu> wrote:
On 5/23/06, Stu Glaser <stuglaser@gmail.com> wrote:
Hi all,
I'm trying to get Celtk working on SBCL. I've attached a patch with several bugfixes.
I'm not a Celtk user, but I am the Cells-on-SBCL guy, so I'm definately paying attention here. Could you please send patches in unified diff format? It's about 1000x easier to read (you can get diff to produce it with the -u option).
I look forward to that, but I had no problem working from the diff. I take your word for it, tho.
Much still does not work, however, I have managed to
display the "one-button-window" demo (though it crashes immediately after display.
Sometime later I will have questions. Celtk still crashes often in finish-business, and I'm not yet familiar enough with cells to perform the fixes.
If Kenny or Frank doesn't get to this before I do, I can look into it in a couple weeks. If you guys haven't sorted it out with Celtk issues, it might be Cells related...
OK, we'll keep an open mind. But as I said, /everything/ happens in finish-business it seems. Especially with Tk, which is pretty fussy about the order in which things happen. (And I just got bit by a timer going off as a window was being shut down. Oops. new :client task type on the way (up to twenty, I think))
Lastly, anonymous CVS access would be great. It would certainly help
for creating patches and for keeping my sources updated.
All of Cells uses the common-lisp.net infrastructure, and they turned off anonymous pserver access due to the constant security nightmare it implies. Sorry. I'd be happy with a move to svn, which would also mean reliable anonymous access, but I'm not sure if there's a reasonable client for Windows. There's a good OS X one, though, so I wouldn't be surprised if there was.
I have TortoiseSVN now as well as TortoiseCVS. I hear svn is better. I am down with a switch. kenny
I'm happy to report that the one-button-window test appears to run correctly. I've attached the appropriate patch. (The patch works from the current version in CVS, so it includes the previous changes) Additionally, menu-button-test, spinbox-test, lotsa-widgets almost works. When I selected File|Quit, it quit my lisp process too. Other than that, it appears okay. I can't find gears, and ltktest-cells-inside doesn't work. One major change: SBCL has a special type for pointers. This type does not work in hashtables, so the integer address must be stored there. Also, I managed to get anonymous CVS working. Enjoy, -Stu Glaser Index: composites.lisp =================================================================== RCS file: /project/cells/cvsroot/Celtk/composites.lisp,v retrieving revision 1.8 diff -u -r1.8 composites.lisp --- composites.lisp 15 May 2006 05:15:37 -0000 1.8 +++ composites.lisp 24 May 2006 06:19:00 -0000 @@ -85,8 +85,8 @@ #+wishful (ewish :initarg :ewish :accessor ewish :initform nil :cell nil) ;; vestigial? (title$ :initarg :title$ :accessor title$ :initform (c? (string-capitalize (class-name (class-of self))))) - (dictionary :initarg :dictionary :initform (make-hash-table :test 'string-equal) :accessor dictionary) - (tkwins :initform (make-hash-table) :reader tkwins) + (dictionary :initarg :dictionary :initform (make-hash-table :test 'equalp) :accessor dictionary) + (tkwins :initform (make-hash-table) :reader tkwins) ; Stores integers corresponding to addresses (xwins :initform (make-hash-table) :reader xwins) (callbacks :initarg :callbacks :accessor callbacks :initform (make-hash-table :test #'eq)) Index: run.lisp =================================================================== RCS file: /project/cells/cvsroot/Celtk/run.lisp,v retrieving revision 1.11 diff -u -r1.11 run.lisp --- run.lisp 17 May 2006 00:40:55 -0000 1.11 +++ run.lisp 24 May 2006 06:19:00 -0000 @@ -39,7 +39,7 @@ (tk-app-init *tki*) (tk-togl-init *tki*) (tk-format-now "proc TraceOP {n1 n2 op} {event generate $n1 <<trace>> -data $op}") - (tcl-create-command *tki* "do-on-command" (get-callback 'do-on-command) 42 0) + (tcl-create-command *tki* "do-on-command" (get-callback 'do-on-command) (null-pointer) (null-pointer)) (with-integrity () (setf *tkw* (make-instance root-class)) @@ -51,7 +51,7 @@ (tcl-do-one-event-loop)) -(defcallback main-window-proc :void ((client-data :int)(xe :pointer)) +(defcallback main-window-proc :void ((client-data :pointer)(xe :pointer)) (declare (ignore client-data)) (when (eq (xevent-type xe) :virtualevent) (bwhen (n$ (xsv name xe)) Index: tk-events.lisp =================================================================== RCS file: /project/cells/cvsroot/Celtk/tk-events.lisp,v retrieving revision 1.3 diff -u -r1.3 tk-events.lisp --- tk-events.lisp 17 May 2006 00:40:55 -0000 1.3 +++ tk-events.lisp 24 May 2006 06:19:00 -0000 @@ -6,13 +6,13 @@ (defcfun ("Tcl_DoWhenIdle" tcl-do-when-idle) :void (tcl-idle-proc :pointer) - (client-data :int)) + (client-data :pointer)) (defcfun ("Tcl_CreateCommand" tcl-create-command) :pointer (interp :pointer) (cmdName :string) (proc :pointer) - (client-data :int) + (client-data :pointer) (delete-proc :pointer)) (defcfun ("Tcl_SetResult" tcl-set-result) :void @@ -23,7 +23,7 @@ (defcfun ("Tcl_GetString" tcl-get-string) :string (tcl-obj :pointer)) -(defcallback tcl-idle-proc :void ((client-data :int)) +(defcallback tcl-idle-proc :void ((client-data :pointer)) (unless (c-stopped) (print (list :idle-proc :client-data client-data)))) @@ -35,7 +35,7 @@ (tkwin :pointer) (mask :int) (proc :pointer) - (client-data :int)) + (client-data :pointer)) (defcenum tk-event-type ;; do not try to generate masks from these! "Ok for interpreting type field in event, but not for (expt 2 etype) to get mask" @@ -130,7 +130,7 @@ ;; sample event handler -(defcallback dump-event :void ((client-data :int)(xe :pointer)) +(defcallback dump-event :void ((client-data :pointer)(xe :pointer)) (call-dump-event client-data xe)) (defun call-dump-event (client-data xe) @@ -149,7 +149,7 @@ (xwin-widget (xsv root-window xe)) (xwin-widget (xsv sub-window xe))))) - (trc " > data" (when (plusp (xsv user-data xe)) + (trc " > data" (when (not (null-pointer-p (xsv user-data xe))) (tcl-get-string (xsv user-data xe))))))) Index: tk-interp.lisp =================================================================== RCS file: /project/cells/cvsroot/Celtk/tk-interp.lisp,v retrieving revision 1.9 diff -u -r1.9 tk-interp.lisp --- tk-interp.lisp 16 May 2006 21:17:15 -0000 1.9 +++ tk-interp.lisp 24 May 2006 06:19:01 -0000 @@ -36,15 +36,22 @@ (define-foreign-library Tcl (:darwin (:framework "Tcl")) - (:windows (:or "/tcl/bin/Tcl85.dll"))) + (:windows (:or "/tcl/bin/Tcl85.dll")) + (:unix "libtcl.so") + (t (:default "libtcl"))) (define-foreign-library Tk (:darwin (:framework "Tk")) - (:windows (:or "/tcl/bin/tk85.dll"))) + (:windows (:or "/tcl/bin/tk85.dll")) + (:unix "libtk.so") + (t (:default "libtk"))) ;; Togl (define-foreign-library Togl (:darwin (:or "/opt/tcltk/togl/lib/Togl1.7/libtogl1.7.dylib")) - (:windows (:or "/tcl/lib/togl/togl17.dll"))) + (:windows (:or "/tcl/lib/togl/togl17.dll")) + (:unix "/usr/lib/Togl1.7/libTogl1.7.so")) + +(use-foreign-library Togl) (defctype tcl-retcode :int) @@ -233,7 +240,8 @@ (defun argv0 () #+allegro (sys:command-line-argument 0) - #+lispworks (nth 0 (io::io-get-command-line-arguments))) + #+lispworks (nth 0 (io::io-get-command-line-arguments)) + #+sbcl (nth 0 sb-ext:*posix-argv*)) (defun tk-interp-init-ensure () (unless *initialized* Index: togl.lisp =================================================================== RCS file: /project/cells/cvsroot/Celtk/togl.lisp,v retrieving revision 1.5 diff -u -r1.5 togl.lisp --- togl.lisp 15 May 2006 09:00:47 -0000 1.5 +++ togl.lisp 24 May 2006 06:19:01 -0000 @@ -115,7 +115,7 @@ (callback :pointer)) (defcallback ,(intern cb$) :void ((,ptr-var :pointer)) (unless (c-stopped) - (let ((,self-var (or (gethash ,ptr-var (tkwins *tkw*)) + (let ((,self-var (or (gethash (pointer-address ,ptr-var) (tkwins *tkw*)) (gethash (togl-ident ,ptr-var)(dictionary *tkw*))))) ,@preamble (,(intern uc$) ,self-var)))) Index: widget.lisp =================================================================== RCS file: /project/cells/cvsroot/Celtk/widget.lisp,v retrieving revision 1.8 diff -u -r1.8 widget.lisp --- widget.lisp 17 May 2006 00:40:55 -0000 1.8 +++ widget.lisp 24 May 2006 06:19:01 -0000 @@ -35,11 +35,13 @@ xwin)))) (defun tkwin-widget (tkwin) - (gethash tkwin (tkwins *tkw*))) + (gethash (pointer-address tkwin) (tkwins *tkw*))) (defun xwin-widget (xwin) ;; assignment of xwin is deferred so...all this BS.. (when (plusp xwin) (or (gethash xwin (xwins *tkw*)) + ;; Next block might need changing for SBCL. (tkwins *tkw*) does NOT + ;; store pointers, so (cffi:pointer-address) should probably be called somewhere (loop for self being the hash-values of (tkwins *tkw*) using (hash-key tkwin) unless (xwin self) ;; we woulda found it by now @@ -78,14 +80,14 @@ (defun tk-create-event-handler-ex (widget callback-name &rest masks) (let ((self-tkwin (widget-to-tkwin widget))) - (assert (plusp self-tkwin)) + (assert (not (null-pointer-p self-tkwin))) (trc nil "setting up widget virtual-event handler" widget :tkwin self-tkwin) (tk-create-event-handler self-tkwin (apply 'foreign-masks-combine 'tk-event-mask masks) (get-callback callback-name) self-tkwin))) -(defcallback widget-event-handler :void ((client-data :int)(xe :pointer)) +(defcallback widget-event-handler :void ((client-data :pointer) (xe :pointer)) (let ((self (tkwin-widget client-data))) (assert self () "widget-event-handler > no widget for tkwin ~a" client-data) (bif (h (^event-handler)) @@ -97,7 +99,7 @@ (:default-initargs :command (c? (format nil "do-on-command ~a" (^path))))) -(defcallback do-on-command :int ((client-data :int)(interp :pointer)(argc :int)(argv :pointer)) +(defcallback do-on-command :int ((client-data :pointer)(interp :pointer)(argc :int)(argv :pointer)) (declare (ignore client-data)) (destructuring-bind (path &rest args) (loop for argn upfrom 1 below argc @@ -122,7 +124,7 @@ (let ((tkwin (or (tkwin self) (setf (tkwin self) (tk-name-to-window *tki* (^path) (tk-main-window *tki*)))))) - (setf (gethash tkwin (tkwins .tkw)) self))) + (setf (gethash (pointer-address tkwin) (tkwins .tkw)) self))) (defmethod make-tk-instance ((self widget)) (setf (gethash (^path) (dictionary .tkw)) self)
On 5/24/06, Stu Glaser <stuglaser@gmail.com> wrote:
I'm happy to report that the one-button-window test appears to run correctly. I've attached the appropriate patch.
(The patch works from the current version in CVS, so it includes the previous changes)
Additionally, menu-button-test, spinbox-test,
lotsa-widgets almost works. When I selected File|Quit, it quit my lisp process too. Other than that, it appears okay.
It /is/ okay. :) Just yesterday I was thinking, "I really should change that before some poor user hits it." <g> That buttons invoke a Tcl "exit", which is fine when talking to Tcl over a pipe. If it makes you feel better, I killed myself that way yesterday when testing. :) I can't find gears, Gears got moved into its own module under Cells. I did not want to commit Celtk to any one binding set to OpenGL, though Celtk does load the Togl widget. Reason? I do not like the new cl-opengl bindings on c-l.net, but I assume it will become the standard, so I will not force /my/ OpenGl bindings on anyone. They happen also to be called cl-opengl. and ltktest-cells-inside doesn't work. I am fighting it out with that over here as well. Not sure if we are talking about the same fight, of course. Oh, and I have not committed to CVS in quite a few days and things are really getting tossed around, so... let's talk again after the next CVS commit. I am sure we will need a second cycle of patches and then things should stabilize. One major change: SBCL has a special type for pointers. This type does
not work in hashtables, so the integer address must be stored there.
OK, I will look at that. Hey, thanks for bringing Linux/SBCL on-line. kenny
"Thomas F. Burdick" <tfb@ocf.berkeley.edu> writes:
All of Cells uses the common-lisp.net infrastructure, and they turned off anonymous pserver access due to the constant security nightmare it implies. Sorry. I'd be happy with a move to svn, which would also
The anoncvs is back online (for good and for bad), and as a quick test cells/cells checks out fine -- if something isn't available there, a quick note to admin@common-lisp.net should fix it. But SVN is, nice, yes. /relurk -- Nikodemus Schemer: "Buddha is small, clean, and serious." Lispnik: "Buddha is big, has hairy armpits, and laughs."
participants (4)
-
Ken Tilton -
Nikodemus Siivola -
Stu Glaser -
Thomas F. Burdick