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

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

27 Feb '05

Update of /project/cells-gtk/cvsroot/root In directory common-lisp.net:/tmp/cvs-serv24461 Modified Files: config.lisp Log Message: Juergen Gmeiner's patch: moves specials referencing pathnames used in test-gtk out of config.lisp and into test-gtk.lisp Date: Sun Feb 27 04:23:19 2005 Author: pdenno Index: root/config.lisp diff -u root/config.lisp:1.2 root/config.lisp:1.3 --- root/config.lisp:1.2 Wed Feb 16 23:34:43 2005 +++ root/config.lisp Sun Feb 27 04:23:19 2005 @@ -6,7 +6,8 @@ #| - Tell ASDF where to find everything + Tell ASDF where to find everything. + This isn't used if you are loading a snapshot tarball. |# @@ -39,27 +40,3 @@ *load-pathname*) asdf:*central-registry*) -(defparameter *splash-image* - (merge-pathnames - (make-pathname :directory '(:relative "test-images") - :name "splash" - :type "png") - *load-pathname*)) - -(defparameter *small-image* - (merge-pathnames - (make-pathname :directory '(:relative "test-images") - :name "small" :type "png") - *load-pathname*)) - -(defparameter *tst-image* - (merge-pathnames - (make-pathname :directory '(:relative "test-images") - :name "tst" :type "gif") - *load-pathname*)) - -(defparameter *stock-icon-image* - (merge-pathnames - (make-pathname :directory '(:relative "test-images") - :name "my-g" :type "png") - *load-pathname*)) \ No newline at end of file

1 0

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

27 Feb '05

Update of /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk In directory common-lisp.net:/tmp/cvs-serv24439/cells-gtk/test-gtk Modified Files: test-gtk.lisp Log Message: Juergen Gmeiner's patch: moves specials referencing pathnames used in test-gtk out of config.lisp and into test-gtk.lisp Date: Sun Feb 27 04:22:28 2005 Author: pdenno Index: root/cells-gtk/test-gtk/test-gtk.lisp diff -u root/cells-gtk/test-gtk/test-gtk.lisp:1.10 root/cells-gtk/test-gtk/test-gtk.lisp:1.11 --- root/cells-gtk/test-gtk/test-gtk.lisp:1.10 Wed Feb 16 23:36:45 2005 +++ root/cells-gtk/test-gtk/test-gtk.lisp Sun Feb 27 04:22:27 2005 @@ -3,16 +3,37 @@ (in-package :test-gtk) +(defvar *test-img-dir* + (make-pathname :name nil :type nil :version nil + :defaults (merge-pathnames + (make-pathname :directory '(:relative :back :back "test-images")) + (parse-namestring *load-truename*)))) +(defvar *splash-image* + (make-pathname :name "splash" :type "png" + :defaults *test-img-dir*)) + +(defvar *small-image* + (make-pathname :name "small" :type "png" + :defaults *test-img-dir*)) + +(defvar *stock-icon-image* + (make-pathname :name "my-g" :type "png" + :defaults *test-img-dir*)) + +(defvar *tst-image* + (make-pathname :name "tst" :type "gif" + :defaults *test-img-dir*)) + (defmodel test-gtk (gtk-app) () (:default-initargs :title "GTK Testing" ;;:tooltips nil ;;dkwt ;;:tooltips-enable nil ;;dkwt - :icon (namestring cl-user::*small-image*) - :stock-icons (list (list :my-g (namestring cl-user::*stock-icon-image*))) + :icon (namestring *small-image*) + :stock-icons (list (list :my-g (namestring *stock-icon-image*))) :position :center - :splash-screen-image (namestring cl-user::*splash-image*) + :splash-screen-image (namestring *splash-image*) :width 550 :height 550 :kids (let ((tabs '("Buttons" "Display" "Layout"

1 0

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

27 Feb '05

Update of /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk In directory common-lisp.net:/tmp/cvs-serv24412/cells-gtk/test-gtk Modified Files: test-display.lisp Log Message: Remove incorrect package specifier to correspond to Juergen Gmeiner's patch, which moves specials referencing pathnames used in test-gtk out of config.lisp and into test-gtk.lisp Date: Sun Feb 27 04:21:20 2005 Author: pdenno Index: root/cells-gtk/test-gtk/test-display.lisp diff -u root/cells-gtk/test-gtk/test-display.lisp:1.5 root/cells-gtk/test-gtk/test-display.lisp:1.6 --- root/cells-gtk/test-gtk/test-display.lisp:1.5 Wed Feb 16 23:35:57 2005 +++ root/cells-gtk/test-gtk/test-display.lisp Sun Feb 27 04:21:20 2005 @@ -20,7 +20,7 @@ :ratio 1 :kids (list (mk-image :width 200 :height 250 - :filename (namestring cl-user::*tst-image*)))) + :filename (namestring *tst-image*)))) (mk-hseparator) (mk-hbox :kids (list

1 0

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

27 Feb '05

Update of /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk In directory common-lisp.net:/tmp/cvs-serv24142/cells-gtk/test-gtk Modified Files: test-dialogs.lisp Log Message: Demonstrate dialog with text entry area Date: Sun Feb 27 04:17:29 2005 Author: pdenno Index: root/cells-gtk/test-gtk/test-dialogs.lisp diff -u root/cells-gtk/test-gtk/test-dialogs.lisp:1.1 root/cells-gtk/test-gtk/test-dialogs.lisp:1.2 --- root/cells-gtk/test-gtk/test-dialogs.lisp:1.1 Fri Nov 19 00:40:14 2004 +++ root/cells-gtk/test-gtk/test-dialogs.lisp Sun Feb 27 04:17:28 2005 @@ -26,9 +26,27 @@ (:default-initargs :kids (list (mk-hbox - :kids (loop for message-type in '(:info :warning :question :error) collect - (make-instance 'test-message :message-type message-type))) - (mk-label :md-name :message-response) + :kids + (append + #-libcellsgtk nil + #+libcellsgtk + (list + (mk-button :label "Query for text" + :on-clicked + (callback (w e d) + (let ((dialog + (to-be + (mk-message-dialog + :md-name :rule-name-dialog + :message "Type something:" + :title "My Title" + :message-type :question + :buttons-type :ok-cancel + :content-area (mk-entry :auto-aupdate t))))) + (setf (text (fm^ :message-response)) (md-value dialog)))))) + (loop for message-type in '(:info :warning :question :error) collect + (make-instance 'test-message :message-type message-type)))) + (mk-label :md-name :message-response) (mk-hbox :kids (cons (mk-check-button :md-name :select-multiple-files

1 0

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

26 Feb '05

Update of /project/cells-gtk/cvsroot/root In directory common-lisp.net:/tmp/cvs-serv9136 Modified Files: load.lisp Log Message: Push :libcellsgtk onto *features* when it can be found. Date: Sat Feb 26 23:46:42 2005 Author: pdenno Index: root/load.lisp diff -u root/load.lisp:1.5 root/load.lisp:1.6 --- root/load.lisp:1.5 Tue Jan 25 16:57:31 2005 +++ root/load.lisp Sat Feb 26 23:46:40 2005 @@ -1,6 +1,6 @@ (in-package :cl-user) -#| Step One: Get ASDF into the game. +#| Step 1: Get ASDF into the game. Obviously not necessary if you always have that loaded. Note that you will have to adjust the pathname to point to where you @@ -21,11 +21,26 @@ (make-pathname :name "config" :type "lisp") *load-pathname*)) -;;;; Step 3: Compile and load via ASDF +;;; Step 3: (completely optional) build libcellsgtk.so (see Makefile) and +;;; place it where the other gtk libraries will be found. + +#+mswindows +(warn "MSWindows users: If you want to use libcellsgtk.so see gtk-ffi/Makefile.") + +#-mswindows +(let ((libpath (cond ((directory "/usr/lib/libgtk*") "/usr/lib/") + ((directory "/opt/gnome/lib/libgtk*") "/opt/gnome/lib/")))) + (if libpath + (if (probe-file (concatenate 'string libpath "libcellsgtk.so")) + (pushnew :libcellsgtk *features*) + (warn "libcellsgtk.so not found. Just a few capabilities will be unavailable.")) + (error "Cannot find a path containing libgtk"))) + +;;;; Step 4: Compile and load via ASDF ; these are handy when one is first working up to getting things to build at all ; but the "test-gtk" ASDF has dependencies which will load everything else, so ; you can just execute that. -; + ;(Asdf:operate 'asdf:load-op :utils-kt :force nil) ;(Asdf:operate 'asdf:load-op :cells :force nil) ;(Asdf:operate 'asdf:load-op :hello-c :force nil) @@ -34,7 +49,6 @@ (Asdf:operate 'asdf:load-op :test-gtk :force nil) -#+Step-4 - +#+Step-5 (test-gtk::gtk-demo)

1 0

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

26 Feb '05

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv8536/gtk-ffi Modified Files: gtk-utilities.lisp Log Message: Use of event button-release-event for popups, because I have failed to get tree-views to send button-press-event. Date: Sat Feb 26 23:44:49 2005 Author: pdenno Index: root/gtk-ffi/gtk-utilities.lisp diff -u root/gtk-ffi/gtk-utilities.lisp:1.12 root/gtk-ffi/gtk-utilities.lisp:1.13 --- root/gtk-ffi/gtk-utilities.lisp:1.12 Wed Feb 16 23:31:53 2005 +++ root/gtk-ffi/gtk-utilities.lisp Sat Feb 26 23:44:48 2005 @@ -85,18 +85,20 @@ ((widget :pointer-void) (signal (* gdk-event-button)) (data :pointer-void)) (declare (ignorable data)) (let ((event (gdk-event-button-type signal))) - (when (eql (event-type event) :button_press) + (when (or (eql (event-type event) :button_press) + (eql (event-type event) :button_release)) (when (= (gdk-event-button-button signal) 3) (gtk-menu-popup widget nil nil nil nil 3 (gdk-event-button-time signal))))) - 1) + 0) (defun gtk-widget-set-popup (widget menu) (gtk-signal-connect-swap widget "button-press-event" - (let ((cbl (ffx:ff-register-callable 'button-press-event-handler))) - #+shhtk (print (list "gtk-widget-set-popup connecting callable" widget cbl)) - cbl) - :data menu)) + (ffx:ff-register-callable 'button-press-event-handler) + :data menu) + (gtk-signal-connect-swap widget "button-release-event" + (ffx:ff-register-callable 'button-press-event-handler) + :data menu)) (defun gtk-list-store-new (col-types) (let ((c-types (ffx:fgn-alloc :int (length col-types)))) @@ -196,8 +198,8 @@ (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))) + (:string (fli:convert-from-foreign-string (deref-pointer item))) + (t (deref-pointer item))) #+cmu (case cell-type (:string (alien:cast (alien:deref item) c-call:c-string))

1 0

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

26 Feb '05

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv8508/gtk-ffi Modified Files: gtk-other.lisp Log Message: Declaration of libcellsgtk foreign functions. Declaration of widget event mask manipulation functions, functions for checking the version of gtk. Date: Sat Feb 26 23:42:29 2005 Author: pdenno Index: root/gtk-ffi/gtk-other.lisp diff -u root/gtk-ffi/gtk-other.lisp:1.3 root/gtk-ffi/gtk-other.lisp:1.4 --- root/gtk-ffi/gtk-other.lisp:1.3 Wed Feb 16 23:30:03 2005 +++ root/gtk-ffi/gtk-other.lisp Sat Feb 26 23:42:29 2005 @@ -149,7 +149,7 @@ (obey_child boolean)) c-pointer) - ;;separetor + ;;separator (gtk-hseparator-new () c-pointer) (gtk-vseparator-new () @@ -329,6 +329,12 @@ (mods int) (flags int))) (gtk-widget-grab-focus ((widget c-pointer))) + (gtk-widget-add-events ((widget c-pointer) + (events int))) + (gtk-widget-set-events ((widget c-pointer) + (events int))) + (gtk-widget-get-events ((widget c-pointer)) + int) ;;window (gtk-window-new ((type int)) @@ -609,6 +615,35 @@ (above boolean))) (gtk-event-box-set-visible-window ((event-box c-pointer) (visible-window boolean)) - nil nil nil)) + nil nil nil) + + ;; miscellaneous + (gtk-check-version ((required-major uint) + (required-minor uint) + (required-micro uint)) + c-string)) + +#+libcellsgtk +(def-gtk-lib-functions :cgtk + (gtk-adds-dialog-vbox + ((dialog c-pointer)) + c-pointer) + (gtk-adds-text-view-popup-menu + ((treeview c-pointer)) + c-pointer)) + +(defmacro you-need-libcellsgtk (&body names) + `(progn + ,@(loop for name in names + collect `(defun ,name (&rest ignore) + (declare (ignore ignore)) + (error "You need libcellsgtk.so to use function ~A." ',name))))) + +#-libcellsgtk +(you-need-libcellsgtk + gtk-adds-dialog-box + gtk-adds-text-view-popup-menu) + + \ No newline at end of file

1 0

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

26 Feb '05

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv8438/gtk-ffi Modified Files: gtk-menu.lisp Log Message: Declaration of foreign function gtk-menu-item-get-submenu, though I have had no luck in using it. Date: Sat Feb 26 23:40:00 2005 Author: pdenno Index: root/gtk-ffi/gtk-menu.lisp diff -u root/gtk-ffi/gtk-menu.lisp:1.2 root/gtk-ffi/gtk-menu.lisp:1.3 --- root/gtk-ffi/gtk-menu.lisp:1.2 Tue Dec 14 05:02:05 2004 +++ root/gtk-ffi/gtk-menu.lisp Sat Feb 26 23:40:00 2005 @@ -76,6 +76,8 @@ (right-justified boolean))) (gtk-menu-item-set-submenu ((menu-item c-pointer) (submenu c-pointer))) + (gtk-menu-item-get-submenu ((menu-item c-pointer)) + c-pointer) (gtk-menu-item-remove-submenu ((menu-item c-pointer))) (gtk-menu-item-set-accel-path ((menu-item c-pointer) (acell-path c-pointer)))

1 0

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

26 Feb '05

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv8415/gtk-ffi Modified Files: gtk-list-tree.lisp Log Message: Declaration of foreign functions for tree store path manipulation. Date: Sat Feb 26 23:38:50 2005 Author: pdenno Index: root/gtk-ffi/gtk-list-tree.lisp diff -u root/gtk-ffi/gtk-list-tree.lisp:1.1 root/gtk-ffi/gtk-list-tree.lisp:1.2 --- root/gtk-ffi/gtk-list-tree.lisp:1.1 Mon Dec 6 21:03:00 2004 +++ root/gtk-ffi/gtk-list-tree.lisp Sat Feb 26 23:38:50 2005 @@ -61,6 +61,24 @@ int) (gtk-tree-view-get-selection ((tree-view c-pointer)) c-pointer) + (gtk-tree-view-get-path-at-pos ((tree-view c-pointer) + (x int) + (y int) + (path c-pointer) + (column c-pointer) + (cell-x c-pointer) + (cell-y c-pointer)) + boolean) + (gtk-tree-view-widget-to-tree-coords ((tree-view c-pointer) + (wx int) + (wy int) + (tx c-pointer) + (ty c-pointer))) + (gtk-tree-view-tree-to-widget-coords ((tree-view c-pointer) + (wx int) + (wy int) + (tx c-pointer) + (ty c-pointer))) ;;tree-model (gtk-tree-model-get ((tree-model c-pointer) @@ -76,6 +94,8 @@ ;;tree-path (gtk-tree-path-new-from-string ((path c-string)) c-pointer) + (gtk-tree-path-to-string ((path c-pointer)) + c-string) (gtk-tree-path-free ((path c-pointer))) ;;tree-selection @@ -146,4 +166,7 @@ (gtk-cell-renderer-toggle-new () c-pointer) (gtk-cell-renderer-pixbuf-new () - c-pointer)) \ No newline at end of file + c-pointer) + (gtk-cell-renderer-set-fixed-size ((cell c-pointer) + (width int) + (height int))))

1 0

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

26 Feb '05

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv8389/gtk-ffi Modified Files: gtk-ffi.lisp Log Message: provisions to load libcellsgtk, definition of gtk-event-key foreign structure. Date: Sat Feb 26 23:37:40 2005 Author: pdenno Index: root/gtk-ffi/gtk-ffi.lisp diff -u root/gtk-ffi/gtk-ffi.lisp:1.9 root/gtk-ffi/gtk-ffi.lisp:1.10 --- root/gtk-ffi/gtk-ffi.lisp:1.9 Sat Feb 12 16:07:58 2005 +++ root/gtk-ffi/gtk-ffi.lisp Sat Feb 26 23:37:40 2005 @@ -45,11 +45,12 @@ '(:array :int) index) new-value)) + (eval-when (:compile-toplevel :load-toplevel :execute) (export '(c-null c-null-int int-slot-indexed)) (defun gtk-function-name (lisp-name) (substitute #\_ #\- lisp-name)) - + (defun libname (lib) #+(or win32 mswindows) (concatenate 'string @@ -59,7 +60,7 @@ (:glib "libglib-2.0-0.dll") (:gthread "libgthread-2.0-0.dll") (:gdk "libgdk-win32-2.0-0.dll") - (:gtk "libgtk-win32-2.0-0.dll"))) + (:cgtk "libcellsgtk"))) #+macosx (concatenate 'string "/sw/lib/" @@ -68,25 +69,32 @@ (:glib "libglib-2.0.0.dylib") (:gthread "libgthread-2.0.0.dylib") (:gdk "libgdk-x11-2.0.0.dylib") - (:gtk "libgtk-x11-2.0.0.dylib"))) + (:gtk "libgtk-x11-2.0.0.dylib") + (:cgtk "libcellsgtk.dylib"))) #-(or macosx win32 mswindows) (ecase lib (:gobject "libgobject-2.0") (:glib "libglib-2.0") (:gthread "libgthread-2.0") (:gdk "libgdk-x11-2.0") - (:gtk "libgtk-x11-2.0"))) + (:gtk "libgtk-x11-2.0") + (:cgtk "libcellsgtk"))) + + + #+cmu - (loop for lib in '(:gthread :glib :gobject :gdk :gtk) + (loop for lib in '(:gthread :glib :gobject :gdk :gtk #+libcellsgtk :cgtk) with libpath = (cond ((directory "/usr/lib/libgtk*") "/usr/lib/") ((directory "/opt/gnome/lib/libgtk*") "/opt/gnome/lib/") ((find :mswindows *features*) nil) (t (error "Cannot find a path containing libgtk"))) do (assert (uffi:load-foreign-library ;;simon - (hic:find-foreign-library (gtk-ffi::libname lib) libpath) - :force-load nil - :module (string lib))) - ) + (hic:find-foreign-library (gtk-ffi::libname lib) libpath) + :force-load nil + :module (string lib)))) + + #-libcellsgtk + (warn "libcellsgtk.so not found. Just a few capabilities will be unavailable.") (defun ffi-to-uffi-type (clisp-type) #+clisp clisp-type @@ -103,6 +111,7 @@ (sint32 :int) (uint32 :unsigned-int) (uint8 :unsigned-byte) + (uint16 :short) ; no signed/unsigned types? (boolean :unsigned-int) (ulong :unsigned-long) (int :int) @@ -252,6 +261,18 @@ (x_root double-float) (y_root double-float)) +(def-c-struct gdk-event-key + (type int) + (window c-pointer) + (send-event uint8) + (time uint32) + (state uint) + (keyval uint) + (length int) + (string c-pointer) + (hardware-keycode uint16) + (group uint8)) + (defun event-type (event) (ecase event (-1 :nothing) @@ -347,7 +368,6 @@ (setf (get-slot-value ,iter-var 'gtk-tree-iter 'user-data2) c-null) (setf (get-slot-value ,iter-var 'gtk-tree-iter 'user-data3) c-null) ,@body)) - (eval-when (:compile-toplevel :load-toplevel :execute) (defun as-gtk-type-name (type)

1 0