cells-gtk-cvs

cells-gtk-cvs@common-lisp.net

371 discussions

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

26 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 26 Feb '05

26 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

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

26 Feb '05

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv8345/cells-gtk Modified Files: widgets.lisp Log Message: Make gtk-object-forget recursive. Date: Sat Feb 26 23:31:41 2005 Author: pdenno Index: root/cells-gtk/widgets.lisp diff -u root/cells-gtk/widgets.lisp:1.10 root/cells-gtk/widgets.lisp:1.11 --- root/cells-gtk/widgets.lisp:1.10 Wed Feb 16 23:24:07 2005 +++ root/cells-gtk/widgets.lisp Sat Feb 26 23:31:41 2005 @@ -65,18 +65,11 @@ "gtk-object-store id ~a already known as ~a, not ~a" hash-id known gtk-object))))) -(defun gtk-object-forget (gtk-id gtk-object &aux (hash-id (pointer-address gtk-id))) - (assert *gtk-objects*) - (let ((known (gethash hash-id *gtk-objects*))) - (cond - ((not known)) - ((eql known gtk-object) - (setf (gethash hash-id *gtk-objects*) nil)) - (t - (gtk-report-error gtk-object-id-error - "gtk-object-store id ~a known as ~a, not forgettable ~a" - hash-id known gtk-object))))) - +(defun gtk-object-forget (gtk-id gtk-object) + (when gtk-id + (assert *gtk-objects*) + (remhash (pointer-address gtk-id) *gtk-objects*) + (mapc #'(lambda (k) (gtk-object-forget (id k) k)) (kids gtk-object)))) (defun gtk-object-find (gtk-id &optional must-find-p &aux (hash-id (pointer-address gtk-id))) (when *gtk-objects* @@ -117,7 +110,7 @@ (intern (format nil "GTK-~a~{-~a~}" class slot-access) :gtk-ffi)))) ;;; --- widget -------------------- - +;;; Define handlers that recover the the callback defined on the widget (defmacro def-gtk-event-handler (event) `(ff-defun-callable :cdecl :int ,(intern (string-upcase (format nil "~a-handler" event))) ((widget :pointer-void) (event :pointer-void) (data :pointer-void)) @@ -381,6 +374,7 @@ (def-c-output .kids ((self window)) (assert-bin self) (dolist (kid new-value) + (when *gtk-debug* (format t "~% window ~A has kid ~A" self kid)) (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))

1 0

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

26 Feb '05

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv8137/cells-gtk Modified Files: tree-view.lisp Log Message: Return integer values from handlers. Date: Sat Feb 26 23:30:40 2005 Author: pdenno Index: root/cells-gtk/tree-view.lisp diff -u root/cells-gtk/tree-view.lisp:1.9 root/cells-gtk/tree-view.lisp:1.10 --- root/cells-gtk/tree-view.lisp:1.9 Sat Feb 12 15:56:11 2005 +++ root/cells-gtk/tree-view.lisp Sat Feb 26 23:30:39 2005 @@ -46,9 +46,9 @@ (columns :accessor columns :initform (c? (mapcar #'(lambda (col-init) (apply #'make-be 'tree-view-column - :container self - col-init)) - (column-inits self)))) + :container self + col-init)) + (column-inits self)))) (select-if :unchanged-if #'fail :accessor select-if :initarg :select-if :initform (c-in nil)) (roots :accessor roots :initarg :roots :initform nil) @@ -82,7 +82,8 @@ (roots tree) (read-from-string (gtk-tree-model-get-cell model iter (length (column-types tree)) :string))) - (selected-items-cache tree)))) + (selected-items-cache tree))) + 0) (defmethod get-selection ((self tree-view)) (let ((selection (gtk-tree-view-get-selection (id self))) @@ -108,12 +109,13 @@ (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 "dude, clean up old widgets after runs" column-widget)) + 0) ;;; The check that previously was performed here (for a clos object) caused the handler ;;; not to be registered (a problem of execution ordering?). Anyway, do we need such a check? (def-c-output on-select ((self tree-view)) - (when new-value + (when new-value (let ((selected-widget (gtk-tree-view-get-selection (id self)))) (gtk-object-store selected-widget self) ;; tie column widget to clos tree-view (callback-register self :on-select new-value) @@ -176,9 +178,9 @@ (when old-value (gtk-tree-store-clear (id (tree-model self)))) (when new-value - (loop for sub-tree in new-value + (loop for root in new-value for index from 0 do - (gtk-tree-store-set-kids (id (tree-model self)) sub-tree c-null index + (gtk-tree-store-set-kids (id (tree-model self)) root c-null index (append (column-types self) (list :string)) (print-fn self) (children-fn self))))) @@ -212,7 +214,7 @@ nil nil) (gtk-tree-view-column-set-sort-column-id (id col) pos) (gtk-tree-view-insert-column (id self) (id col) pos)))) - + (def-object tree-view-column () ((title :accessor title :initarg :title :initform nil) (visible :accessor visible :initarg :visible :initform t))

1 0

← Newer
1
...
26
27
28
29
30
31
32
...
38
Older →

Jump to page:

2025

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

cells-gtk-cvs