- cells-gtk-cvs@common-lisp.net - mailman3.common-lisp.net

[cells-gtk-cvs] CVS update: root/cells-gtk/drawing.lisp
by pdenno＠common-lisp.net 03 Jan '06

03 Jan '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv30407/root/cells-gtk Modified Files: drawing.lisp Log Message: trivial Date: Tue Jan 3 20:03:33 2006 Author: pdenno Index: root/cells-gtk/drawing.lisp diff -u root/cells-gtk/drawing.lisp:1.2 root/cells-gtk/drawing.lisp:1.3 --- root/cells-gtk/drawing.lisp:1.2 Fri Nov 4 16:02:05 2005 +++ root/cells-gtk/drawing.lisp Tue Jan 3 20:03:33 2006 @@ -56,7 +56,6 @@ (gdk-draw-drawable cgtk::*window* cgtk::*gcontext* drawable 0 0 dx dy -1 -1))))) 0) -;;; data is not used, AFAIK. (defun gtk-drawing-set-handlers (widget data) (gtk-signal-connect-swap widget "button-press-event" (ffx:ff-register-callable 'drawing-button-events-handler) @@ -70,7 +69,6 @@ (gtk-signal-connect-swap widget "expose-event" (ffx:ff-register-callable 'drawing-expose-event-handler) :data data)) - (export '(gtk-drawing-set-handlers)) ;;;============================================================================

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/widgets.lisp
by pdenno＠common-lisp.net 03 Jan '06

03 Jan '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv30390/root/cells-gtk Modified Files: widgets.lisp Log Message: CFFI : removed #+clisp stuff Date: Tue Jan 3 20:03:02 2006 Author: pdenno Index: root/cells-gtk/widgets.lisp diff -u root/cells-gtk/widgets.lisp:1.14 root/cells-gtk/widgets.lisp:1.15 --- root/cells-gtk/widgets.lisp:1.14 Sat Oct 8 16:33:19 2005 +++ root/cells-gtk/widgets.lisp Tue Jan 3 20:03:02 2006 @@ -209,11 +209,6 @@ ,@signals-outputs))))) (defmacro callback ((widg event data) &body body) - #+clisp - `(c? (without-c-dependency #'(lambda (,widg ,event ,data) - (declare (ignorable ,widg ,event ,data)) - ,@body t))) - #-clisp `(lambda (self ,widg ,event ,data) (declare (ignorable self ,widg ,event ,data)) ;(print (list :anon-callback self ,widg ,event ,data)) @@ -225,10 +220,7 @@ (defmacro callback-if (condition (widg event data) &body body) `(c? (and ,condition - #+clisp (without-c-dependency #'(lambda (,widg ,event ,data) - (declare (ignorable ,widg ,event ,data)) - ,@body t)) - #-clisp (lambda (self ,widg ,event ,data) + (lambda (self ,widg ,event ,data) (declare (ignorable self ,widg ,event ,data)) ;(print (list :anon-callback-if self ,widg ,event ,data)) ,@body @@ -298,7 +290,7 @@ (not-to-be old-value)) (when new-value (gtk-widget-set-popup (id self) (id (to-be new-value))))) - + (def-c-output visible ((self widget)) (if new-value (gtk-widget-show (id self)) @@ -393,6 +385,7 @@ (gtk-container-add (id self) (id (first new-value)))) #+clisp (call-next-method)) +(declaim (inline widget-id)) (defun widget-id (widget) (id widget))

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/tree-view.lisp
by pdenno＠common-lisp.net 03 Jan '06

03 Jan '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv30370/root/cells-gtk Modified Files: tree-view.lisp Log Message: Misplaced declare ignore makes clisp and cmucl error. Date: Tue Jan 3 20:01:59 2006 Author: pdenno Index: root/cells-gtk/tree-view.lisp diff -u root/cells-gtk/tree-view.lisp:1.11 root/cells-gtk/tree-view.lisp:1.12 --- root/cells-gtk/tree-view.lisp:1.11 Sun May 29 23:13:06 2005 +++ root/cells-gtk/tree-view.lisp Tue Jan 3 20:01:59 2006 @@ -84,7 +84,6 @@ ;;; Used by combo-box also, when it is using a tree model. (ff-defun-callable :cdecl :void tree-view-items-selector ((model :pointer-void) (path :pointer-void) (iter :pointer-void) (data :pointer-void)) - (declare (ignore path data)) (let ((tree (of-tree (gtk-object-find model)))) (push (item-from-path (children-fn tree)

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/textview.lisp
by pdenno＠common-lisp.net 03 Jan '06

03 Jan '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv30350/root/cells-gtk Modified Files: textview.lisp Log Message: Misplaced declare ignore makes clisp and cmucl error. Date: Tue Jan 3 20:01:20 2006 Author: pdenno Index: root/cells-gtk/textview.lisp diff -u root/cells-gtk/textview.lisp:1.5 root/cells-gtk/textview.lisp:1.6 --- root/cells-gtk/textview.lisp:1.5 Sat Oct 8 16:31:24 2005 +++ root/cells-gtk/textview.lisp Tue Jan 3 20:01:20 2006 @@ -71,7 +71,6 @@ (ff-defun-callable :cdecl :void text-view-populate-popup-handler ((widget :pointer-void) (signal :pointer-void) (data :pointer-void)) - (declare (ignorable signal data)) (let ((popup-menu (gtk-adds-text-view-popup-menu widget))) (bwhen (text-view (gtk-object-find widget)) (bwhen (cb (callback-recover text-view :populate-popup))

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/packages.lisp
by pdenno＠common-lisp.net 03 Jan '06

03 Jan '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv29272/root/cells-gtk Modified Files: packages.lisp Log Message: CFFI : No need for #+clisp stuff Date: Tue Jan 3 19:59:58 2006 Author: pdenno Index: root/cells-gtk/packages.lisp diff -u root/cells-gtk/packages.lisp:1.1 root/cells-gtk/packages.lisp:1.2 --- root/cells-gtk/packages.lisp:1.1 Sun May 29 23:01:21 2005 +++ root/cells-gtk/packages.lisp Tue Jan 3 19:59:58 2006 @@ -19,7 +19,7 @@ (defpackage :cells-gtk (:nicknames :cgtk) (:use :common-lisp :utils-kt :cells :gtk-ffi - #+clisp :ffi #-clisp :uffi #-clisp #:ffx)) + :uffi #:ffx))

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/layout.lisp
by pdenno＠common-lisp.net 03 Jan '06

03 Jan '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv29248/root/cells-gtk Modified Files: layout.lisp Log Message: Stuff for divider position and checking whether page already is displayed (or something like that). Date: Tue Jan 3 19:58:55 2006 Author: pdenno Index: root/cells-gtk/layout.lisp diff -u root/cells-gtk/layout.lisp:1.5 root/cells-gtk/layout.lisp:1.6 --- root/cells-gtk/layout.lisp:1.5 Sun May 29 23:08:22 2005 +++ root/cells-gtk/layout.lisp Tue Jan 3 19:58:54 2006 @@ -76,7 +76,13 @@ (y-pad kid)))))) (def-widget hpaned () - () () ()) + ((divider-pos :accessor divider-pos :initarg :divider-pos :initform (c-in 0))) + () + ()) + +(def-c-output divider-pos ((self hpaned)) + (when new-value + (gtk-paned-set-position (id self) new-value))) (def-c-output .kids ((self hpaned)) (when new-value @@ -90,7 +96,13 @@ #+clisp (call-next-method)) (def-widget vpaned () - () () ()) + ((divider-pos :accessor divider-pos :initarg :divider-pos :initform (c-in 0))) + () + ()) + +(def-c-output divider-pos ((self vpaned)) + (when new-value + (gtk-paned-set-position (id self) new-value))) (def-c-output .kids ((self vpaned)) (when new-value @@ -184,7 +196,7 @@ #+clisp (call-next-method)) (def-widget notebook () - ((tab-labels :accessor tab-labels :initarg :tab-labels :initform nil) + ((tab-labels :accessor tab-labels :initarg :tab-labels :initform (c-in nil)) (tab-labels-widgets :accessor tab-labels-widgets :initform (c-in nil)) (show-page :accessor show-page :initarg :show-page :initform (c-in 0)) (tab-pos :accessor tab-pos :initarg :tab-pos :initform (c-in nil))) @@ -205,16 +217,22 @@ (:bottom 3) (t 2))))) +(defun notebook-contains-page-p (notebook widget &aux (wid (pointer-address (id widget)))) + (loop for i from 1 to (gtk-notebook-get-n-pages (id notebook)) + for page = (gtk-notebook-get-nth-page (id notebook) (1- i)) + when (= wid (pointer-address page)) return t)) + (def-c-output show-page ((self notebook)) (when (and new-value (>= new-value 0) (< new-value (length (kids self)))) (setf (current-page self) new-value))) (def-c-output .kids ((self notebook)) - (dolist (widget (tab-labels-widgets self)) - (not-to-be widget)) + ;(dolist (widget (tab-labels-widgets self)) ;; This was from the original code. + ; (not-to-be widget)) ;; It causes errors. (loop for kid in new-value for pos from 0 - for label = (nth pos (tab-labels self)) do + for label = (nth pos (tab-labels self)) + unless (notebook-contains-page-p self kid) do (let ((lbl (and label (make-be 'label :text label)))) (when lbl (push lbl (tab-labels-widgets self))) (gtk-notebook-append-page (id self) (id kid) (and lbl (id lbl)))))

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/gtk-app.lisp
by pdenno＠common-lisp.net 03 Jan '06

03 Jan '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv29218/root/cells-gtk Modified Files: gtk-app.lisp Log Message: Quit out of as many main loops as necessary. Date: Tue Jan 3 19:57:41 2006 Author: pdenno Index: root/cells-gtk/gtk-app.lisp diff -u root/cells-gtk/gtk-app.lisp:1.14 root/cells-gtk/gtk-app.lisp:1.15 --- root/cells-gtk/gtk-app.lisp:1.14 Sun May 29 23:06:47 2005 +++ root/cells-gtk/gtk-app.lisp Tue Jan 3 19:57:41 2006 @@ -91,13 +91,13 @@ (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) #+lispworks - (flet ((do-gtk () (loop while (gtk-events-pending) do (gtk-main-iteration-do nil)))) + (flet ((do-gtk () (loop while (gtk-events-pending) do + (gtk-main-iteration-do nil)))) (unwind-protect (catch 'try-again (handler-case @@ -109,11 +109,11 @@ (show-message (format nil "Cells-GTK Error: ~a" err) :message-type :error :title "Cells-GTK Error") (throw 'try-again nil)) ; This doesn't really work. u-p cleanup forms invoked. - (gtk-user-signals-quit (c) - (declare (ignore c)) - (return-from start-app nil)))) + (gtk-user-signals-quit () + (loop while (> (gtk-main-level) 0) do (gtk-main-quit)) + (return-from start-app)))) (not-to-be app) - (gtk-main-quit) + (loop while (> (gtk-main-level) 0) do (gtk-main-quit)) (do-gtk)))))))

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/cells-gtk.asd
by pdenno＠common-lisp.net 03 Jan '06

03 Jan '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv29184/root/cells-gtk Modified Files: cells-gtk.asd Log Message: Don't load drawing.lisp, it is not ready. Date: Tue Jan 3 19:55:17 2006 Author: pdenno Index: root/cells-gtk/cells-gtk.asd diff -u root/cells-gtk/cells-gtk.asd:1.5 root/cells-gtk/cells-gtk.asd:1.6 --- root/cells-gtk/cells-gtk.asd:1.5 Sat Oct 8 16:29:28 2005 +++ root/cells-gtk/cells-gtk.asd Tue Jan 3 19:55:16 2006 @@ -11,7 +11,7 @@ (:file "widgets" :depends-on ("conditions")) (:file "layout" :depends-on ("widgets")) (:file "display" :depends-on ("widgets")) - (:file "drawing" :depends-on ("widgets")) +#+notyet(:file "drawing" :depends-on ("widgets")) ; not ready yet. (:file "buttons" :depends-on ("widgets")) (:file "entry" :depends-on ("widgets")) (:file "tree-view" :depends-on ("widgets"))

1 0

[cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-other.lisp
by pdenno＠common-lisp.net 18 Nov '05

18 Nov '05

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv15734/root/gtk-ffi Modified Files: gtk-other.lisp Log Message: Added gtk-adds function gtk-adds-ok, which just returns 1. (Useful to determine that the .dll was built and loaded correctly, without needing to init gtk). Date: Fri Nov 18 05:35:32 2005 Author: pdenno Index: root/gtk-ffi/gtk-other.lisp diff -u root/gtk-ffi/gtk-other.lisp:1.9 root/gtk-ffi/gtk-other.lisp:1.10 --- root/gtk-ffi/gtk-other.lisp:1.9 Wed Nov 16 02:46:51 2005 +++ root/gtk-ffi/gtk-other.lisp Fri Nov 18 05:35:32 2005 @@ -747,8 +747,8 @@ (gtk-adds-color-set-rgb ((gdkcolor c-pointer) (red uint) (green uint) - (blue uint)))) - + (blue uint))) + (gtk-adds-ok () int)) #-libcellsgtk (defmacro you-need-libcellsgtk (&body names)

1 0

[cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-adds.c
by pdenno＠common-lisp.net 18 Nov '05

18 Nov '05

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv15697/root/gtk-ffi Modified Files: gtk-adds.c Log Message: Added some asm -export stuff used in the creation of the win32 .dll (and ignored in linux). Date: Fri Nov 18 05:31:29 2005 Author: pdenno Index: root/gtk-ffi/gtk-adds.c diff -u root/gtk-ffi/gtk-adds.c:1.4 root/gtk-ffi/gtk-adds.c:1.5 --- root/gtk-ffi/gtk-adds.c:1.4 Sat Oct 8 16:43:37 2005 +++ root/gtk-ffi/gtk-adds.c Fri Nov 18 05:31:27 2005 @@ -1,6 +1,18 @@ #include <gtk/gtk.h> +asm (".section .drectve"); +asm (".ascii \"-export:gtk_adds_text_iter_new\""); +asm (".ascii \" -export:gtk_adds_text_view_popup_menu\""); +asm (".ascii \" -export:gtk_adds_dialog_vbox\""); +asm (".ascii \" -export:gtk_adds_tree_iter_new\""); +asm (".ascii \" -export:gtk_adds_widget_mapped_p\""); +asm (".ascii \" -export:gtk_adds_widget_visible_p\""); +asm (".ascii \" -export:gtk_adds_widget_window\""); +asm (".ascii \" -export:gtk_adds_color_new\""); +asm (".ascii \" -export:gtk_adds_color_set_rgb\""); +asm (".ascii \" -export:gtk_adds_ok\""); + /* Return a pointer to the vbox of a dialog. * Useful for adding widgets to dialogs. For example, * if you need a dialog with text entry capability. @@ -15,6 +27,7 @@ * Useful if you need to add to the default textview menu * on a populate-popup event. */ + GtkWidget * gtk_adds_text_view_popup_menu (GtkWidget *text_view) { @@ -32,6 +45,7 @@ /* C programmers allocate iters on the stack. We use this. Free it with gtk-tree-iter-free */ + GtkTreeIter * gtk_adds_tree_iter_new () { @@ -69,6 +83,11 @@ color->blue = b; } - +/* You can run this one without having gtk running, to be sure the library was loaded. */ +int +gtk_adds_ok () +{ + return 1; +}

1 0