From pdenno at common-lisp.net Thu May 5 14:20:52 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Thu, 5 May 2005 16:20:52 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-ffi.lisp Message-ID: <20050505142052.B375C8871F@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv19048/gtk-ffi Modified Files: gtk-ffi.lisp Log Message: Was missing the identification of the libgtk filename in win32 Date: Thu May 5 16:20:51 2005 Author: pdenno Index: root/gtk-ffi/gtk-ffi.lisp diff -u root/gtk-ffi/gtk-ffi.lisp:1.10 root/gtk-ffi/gtk-ffi.lisp:1.11 --- root/gtk-ffi/gtk-ffi.lisp:1.10 Sat Feb 26 23:37:40 2005 +++ root/gtk-ffi/gtk-ffi.lisp Thu May 5 16:20:51 2005 @@ -60,6 +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 @@ -368,6 +369,7 @@ (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) , at body)) + (eval-when (:compile-toplevel :load-toplevel :execute) (defun as-gtk-type-name (type) From pdenno at common-lisp.net Sun May 29 21:01:21 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Sun, 29 May 2005 23:01:21 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/cells-gtk/packages.lisp Message-ID: <20050529210121.DF288880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv7981/cells-gtk Added Files: packages.lisp Log Message: New file, was cells-gtk.lisp (which has been removed). Date: Sun May 29 23:01:21 2005 Author: pdenno From pdenno at common-lisp.net Sun May 29 21:03:43 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Sun, 29 May 2005 23:03:43 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/cells-gtk/cells-gtk.asd Message-ID: <20050529210343.D3818880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv8014/cells-gtk Modified Files: cells-gtk.asd Log Message: Renamed cells-gtk.lisp to packages.lisp and moved some stuff in it to treeview.lisp Date: Sun May 29 23:03:43 2005 Author: pdenno Index: root/cells-gtk/cells-gtk.asd diff -u root/cells-gtk/cells-gtk.asd:1.3 root/cells-gtk/cells-gtk.asd:1.4 --- root/cells-gtk/cells-gtk.asd:1.3 Sat Feb 12 15:44:41 2005 +++ root/cells-gtk/cells-gtk.asd Sun May 29 23:03:43 2005 @@ -1,9 +1,11 @@ + + (asdf:defsystem :cells-gtk :name "cells-gtk" :depends-on (:cells :gtk-ffi) :serial t :components - ((:file "cells-gtk") + ((:file "packages") (:file "conditions") (:file "compat") (:file "widgets" :depends-on ("conditions")) From pdenno at common-lisp.net Sun May 29 21:04:13 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Sun, 29 May 2005 23:04:13 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/cells-gtk/cells-gtk.lisp Message-ID: <20050529210413.8C8CD880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv8031/cells-gtk Removed Files: cells-gtk.lisp Log Message: Renamed cells-gtk.lisp to packages.lisp and moved some stuff in it to treeview.lisp Date: Sun May 29 23:04:12 2005 Author: pdenno From pdenno at common-lisp.net Sun May 29 21:06:47 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Sun, 29 May 2005 23:06:47 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/cells-gtk/gtk-app.lisp Message-ID: <20050529210647.EB0A3880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv8059/cells-gtk Modified Files: gtk-app.lisp Log Message: Moved duplicated foreign loading code (substantially cleaned up) into gtk-ffi/gtk-ffi.lisp Date: Sun May 29 23:06:47 2005 Author: pdenno Index: root/cells-gtk/gtk-app.lisp diff -u root/cells-gtk/gtk-app.lisp:1.13 root/cells-gtk/gtk-app.lisp:1.14 --- root/cells-gtk/gtk-app.lisp:1.13 Sat Feb 26 23:26:09 2005 +++ root/cells-gtk/gtk-app.lisp Sun May 29 23:06:47 2005 @@ -137,23 +137,11 @@ (funcall (aref *gtk-global-callbacks* n))) (defun cells-gtk-init () - (gtk-reset) #-cmu (unless *gtk-loaded* - (loop for lib in '(:gthread :glib :gobject :gdk :gtk #+libcellsgtk :cgtk) - for libname = (gtk-ffi::libname lib) - 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 #-mswindows ;; probably have to refine this for diff implementations - (setq libname (uffi:find-foreign-library (gtk-ffi::libname lib) libpath)) - (assert (or (uffi:load-foreign-library libname - :force-load #+lispworks t #-lispworks nil - :module (string lib)) - (eql lib :cgtk))) - finally (setf *gtk-loaded* t)) - #-libcellsgtk(warn "libcellsgtk.so not found. Just a few capabilities will be unavailable."))) + (gtk-ffi:load-gtk-libs) + (setf *gtk-loaded* t)) + (gtk-reset)) ;;; Implements quits other than through destroy. (let (quit) From pdenno at common-lisp.net Sun May 29 21:08:23 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Sun, 29 May 2005 23:08:23 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/cells-gtk/layout.lisp Message-ID: <20050529210823.7ADAA880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv8082/cells-gtk Modified Files: layout.lisp Log Message: Not sure of this, but new arguments to gtk-box-pack-start. Date: Sun May 29 23:08:22 2005 Author: pdenno Index: root/cells-gtk/layout.lisp diff -u root/cells-gtk/layout.lisp:1.4 root/cells-gtk/layout.lisp:1.5 --- root/cells-gtk/layout.lisp:1.4 Sat Feb 12 15:52:10 2005 +++ root/cells-gtk/layout.lisp Sun May 29 23:08:22 2005 @@ -29,8 +29,8 @@ (def-c-output .kids ((self box)) (when new-value (dolist (kid new-value) - (gtk-box-pack-start (id self) (id kid) - (expand? kid) (fill? kid) (padding? kid))) + (gtk-box-pack-start (id self) (id kid) + (expand? kid) (fill? kid) (padding? kid))) #+clisp (call-next-method))) (def-widget hbox (box) From pdenno at common-lisp.net Sun May 29 21:09:40 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Sun, 29 May 2005 23:09:40 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/cells-gtk/menus.lisp Message-ID: <20050529210940.16DCB880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv8110/cells-gtk Modified Files: menus.lisp Log Message: New code for TreeModel ComboBoxes. Requires libcellsgtk.so Date: Sun May 29 23:09:40 2005 Author: pdenno Index: root/cells-gtk/menus.lisp diff -u root/cells-gtk/menus.lisp:1.9 root/cells-gtk/menus.lisp:1.10 --- root/cells-gtk/menus.lisp:1.9 Sat Feb 26 23:28:08 2005 +++ root/cells-gtk/menus.lisp Sun May 29 23:09:40 2005 @@ -18,20 +18,68 @@ (in-package :cgtk) +(defmacro with-tree-iters (vars &body body) + `(let (,@(loop for var in vars collect `(,var (gtk-adds-tree-iter-new)))) + (unwind-protect + (progn , at body) + ,@(loop for var in vars collect `(gtk-tree-iter-free ,var))))) + +;;; ============= Combo-box ============================ +;;; User should specify exactly one of :items or :roots +;;; If specify :roots, specify :children-fn too. (def-widget combo-box () ((items :accessor items :initarg :items :initform nil) (print-fn :accessor print-fn :initarg :print-fn - :initform #'(lambda (item) (format nil "~a" item))) - (init :accessor init :initarg :init :initform nil)) + :initform #'(lambda (item) (format nil "~a" item))) ; see below if :roots + (init :accessor init :initarg :init :initform nil) + (roots :accessor roots :initarg :roots :initform nil) + (children-fn :accessor children-fn :initarg :children-fn :initform #'(lambda (x) (declare (ignore x)) nil)) + (tree-model :cell nil :accessor tree-model :initform nil)) (active) (changed) :new-tail '-text - :on-changed (callback (widget event data) - (trc nil "combo-box onchanged cb" widget event data (id self)) - (let ((pos (gtk-combo-box-get-active (id self)))) - (trc nil "combo-box pos" pos) - (setf (md-value self) (and (not (= pos -1)) - (nth pos (items self))))))) + :on-changed + (callback (widget event data) + (trc nil "combo-box onchanged cb" widget event data (id self)) + (if (items self) + ;; flat model (:items specified) + (let ((pos (gtk-combo-box-get-active (id self)))) + ;;(trc nil "combo-box pos" pos) + (setf (md-value self) (and (not (= pos -1)) + (nth pos (items self))))) + ;; non-flat tree-model (:roots specified) + (with-tree-iters (iter) + (when (gtk-combo-box-get-active-iter (id self) iter) + (setf (md-value self) + (item-from-path + (children-fn self) + (roots self) + (read-from-string + (gtk-tree-model-get-cell (id (tree-model self)) iter 1 :string))))))))) + +;;; When user specifies :roots, he is using a tree-model. +;;; POD There is probably no reason he has to use :strings for the "columns" +(def-c-output roots ((self combo-box)) + (when old-value + (gtk-tree-store-clear (id (tree-model self)))) + (when new-value + (unless (tree-model self) + (let ((model (mk-tree-store :item-types '(:string :string)))) + (setf (tree-model self) model) + (setf (of-tree model) self) + (gtk-combo-box-set-model (id self) (id (to-be model))))) + (let* ((user-print-fn (print-fn self)) ; because he shouldn't need to know this detail. + (pfunc #'(lambda (x) (list (funcall user-print-fn x))))) + (loop for root in new-value + for index from 0 do + (gtk-tree-store-set-kids (id (tree-model self)) root c-null index + '(:string :string) pfunc (children-fn self))) + ;; Spec says iter must correspond to a path of depth one. Hence no point in set-active-iter. + ;; init should just be the index of the depth one item you want displayed. + (bwhen (item-index (init self)) + (gtk-combo-box-set-active (id self) item-index) + (let ((item (item-from-path (children-fn self) (roots self) (list item-index)))) + (setf (md-value self) item)))))) (def-c-output items ((self combo-box)) (when old-value @@ -45,7 +93,8 @@ (when index (gtk-combo-box-set-active (id self) index) (setf (md-value self) (init self))))))) - + +;;; ============= Toolbar/Toolbutton ============================ (def-object tooltips () () () ()) @@ -126,6 +175,7 @@ (when new-value (setf (stock-id self) (string-downcase (format nil "gtk-~a" new-value))))) +;;; ============= Menu ============================ (def-widget menu-shell () () () () :padding 0) From pdenno at common-lisp.net Sun May 29 21:13:06 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Sun, 29 May 2005 23:13:06 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/cells-gtk/tree-view.lisp Message-ID: <20050529211306.026A0880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv8145/cells-gtk Modified Files: tree-view.lisp Log Message: New ability: :expand-p allows tree to come up fully expanded. Moved code iter recording code from cells-gtk.lisp to here. Date: Sun May 29 23:13:06 2005 Author: pdenno Index: root/cells-gtk/tree-view.lisp diff -u root/cells-gtk/tree-view.lisp:1.10 root/cells-gtk/tree-view.lisp:1.11 --- root/cells-gtk/tree-view.lisp:1.10 Sat Feb 26 23:30:39 2005 +++ root/cells-gtk/tree-view.lisp Sun May 29 23:13:06 2005 @@ -16,6 +16,9 @@ |# +;;; Todo: separate tree-model/tree-store stuff into another file (used by combo box too). +;;; BTW Tree-store implements the tree-model interface, among other things. + (in-package :cgtk) (def-object list-store () @@ -56,6 +59,7 @@ (children-fn :accessor children-fn :initarg :children-fn :initform #'(lambda (x) (declare (ignore x)) nil)) (selected-items-cache :cell nil :accessor selected-items-cache :initform nil) (selection-mode :accessor selection-mode :initarg :selection-mode :initform :single) + (expand-all :accessor expand-all :initarg :expand-all :initform nil) (on-select :accessor on-select :initarg :on-select :initform nil) (tree-model :accessor tree-model :initarg :tree-model :initform nil)) () ; gtk-slots @@ -68,11 +72,16 @@ (when new-value (gtk-tree-view-set-model (id self) (id (to-be new-value))))) +(def-c-output expand-all ((self tree-view)) + (when new-value + (gtk-tree-view-expand-all (id self)))) + (defun item-from-path (child-fn roots path) (loop for index in path for node = (nth index roots) then (nth index (funcall child-fn node)) finally (return node))) +;;; 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)) @@ -161,8 +170,8 @@ (defmodel treebox (tree-view) () (:default-initargs - :tree-model (c? (make-instance 'tree-store - :item-types (append (column-types self) (list :string)))))) + :tree-model (c? (mk-tree-store + :item-types (append (column-types self) (list :string)))))) (defun mk-treebox (&rest inits) (let ((self (apply 'make-instance 'treebox inits))) @@ -182,7 +191,24 @@ for index from 0 do (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))))) + (print-fn self) (children-fn self))) + (when (expand-all self) + (gtk-tree-view-expand-all (id self))))) + +;;; These look like ("Trimmed Text" "(0 0 )") for example where menu structure is "Text --> Trimmed Text" +;;; Column-types is a list of :string, :float etc. used to reference g-value-set-string etc. +(defun gtk-tree-store-set-kids (model val-tree parent-iter index column-types print-fn children-fn &optional path) + (with-tree-iter (iter) + (gtk-tree-store-append model iter parent-iter) ; sets iter + (gtk-tree-store-set model iter ; Not a gtk function! + column-types + (append + (funcall print-fn val-tree) + (list (format nil "(~{~d ~})" (reverse (cons index path)))))) + (loop for sub-tree in (funcall children-fn val-tree) + for pos from 0 do + (gtk-tree-store-set-kids model sub-tree iter + pos column-types print-fn children-fn (cons index path))))) (ff-defun-callable :cdecl :int tree-view-render-cell-callback ((tree-column :pointer-void) (cell-renderer :pointer-void) From pdenno at common-lisp.net Sun May 29 21:15:52 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Sun, 29 May 2005 23:15:52 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/cells-gtk/widgets.lisp Message-ID: <20050529211552.42020880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv8997/cells-gtk Modified Files: widgets.lisp Log Message: Better error reporting on assert in the def-widget/def-gtk macro. Thanks to Kenny Tilton and Fred Gilham. Date: Sun May 29 23:15:51 2005 Author: pdenno Index: root/cells-gtk/widgets.lisp diff -u root/cells-gtk/widgets.lisp:1.12 root/cells-gtk/widgets.lisp:1.13 --- root/cells-gtk/widgets.lisp:1.12 Sun Mar 6 18:01:09 2005 +++ root/cells-gtk/widgets.lisp Sun May 29 23:15:51 2005 @@ -182,7 +182,7 @@ ,(intern (string signal-slot) :keyword) new-value) (let ((cb (cdr (assoc ',signal-slot *widget-callbacks*)))) - (assert cb) + (assert cb () "Callback ~a not defined in *widget-callbacks*" ',signal-slot) #+shhtk (trc nil "in def-c-output gtk-signal-connect pcb:" cb ',slot-name (id self)) (gtk-signal-connect (id self) From pdenno at common-lisp.net Sun May 29 21:16:56 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Sun, 29 May 2005 23:16:56 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-adds.c Message-ID: <20050529211656.68CEF880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv9019/gtk-ffi Modified Files: gtk-adds.c Log Message: New function gtk_adds_tree_iter_new , used by TreeModel-type ComboBoxes Date: Sun May 29 23:16:56 2005 Author: pdenno Index: root/gtk-ffi/gtk-adds.c diff -u root/gtk-ffi/gtk-adds.c:1.2 root/gtk-ffi/gtk-adds.c:1.3 --- root/gtk-ffi/gtk-adds.c:1.2 Sun Mar 6 18:04:02 2005 +++ root/gtk-ffi/gtk-adds.c Sun May 29 23:16:56 2005 @@ -30,3 +30,13 @@ return gtk_text_iter_copy(&example); } +/* C programmers allocate iters on the stack. We use this. + Free it with gtk-tree-iter-free */ +GtkTreeIter * +gtk_adds_tree_iter_new () +{ + GtkTreeIter example; + return gtk_tree_iter_copy(&example); +} + + From pdenno at common-lisp.net Sun May 29 21:18:24 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Sun, 29 May 2005 23:18:24 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-ffi.asd Message-ID: <20050529211824.E8B8E880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv9046/gtk-ffi Modified Files: gtk-ffi.asd Log Message: New procedure for finding libraries: set the path once, in here. Unfortunately it seems that we /still/ need the path for cmu. Reason to be investigated. Date: Sun May 29 23:18:24 2005 Author: pdenno Index: root/gtk-ffi/gtk-ffi.asd diff -u root/gtk-ffi/gtk-ffi.asd:1.5 root/gtk-ffi/gtk-ffi.asd:1.6 --- root/gtk-ffi/gtk-ffi.asd:1.5 Tue Dec 14 05:02:05 2004 +++ root/gtk-ffi/gtk-ffi.asd Sun May 29 23:18:24 2005 @@ -1,3 +1,28 @@ + +(in-package "CL-USER") +;;;--------------------- +;;; Two steps: +;;;--------------------- + +(defvar *gtk-lib-path* nil) + +;;; Step 1 -- If you are not using Linux nor BSD and the GTK libs are not +;;; in the places specified below, adjust these. + +#+macosx (setf *gtk-lib-path* "/sw/lib/") +#+(or win32 mswindows) (setf *gtk-lib-path* "C:/Program Files/Common Files/GTK/2.0/bin/") + +;;; This need not be specified for cmucl (leave as a null string). +#+cmu(setf *gtk-lib-path* "/usr/lib/") +;#+cmu(setf *gtk-lib-path* "/opt/gnome/lib/") ; For my Suse machine + +;;; Specify for Lispworks. +#-(or macosx win32 mswindows cmu) (setf *gtk-lib-path* "/usr/lib/") +;#-(or macosx win32 mswindows cmu) (setf *gtk-lib-path* "/opt/gnome/lib/") ; For my Suse machine + +;;; Step 2 -- If you built libcellsgtk.so, uncomment the next line. +;(pushnew :libcellsgtk *features*) + (asdf:defsystem :gtk-ffi :name "gtk-ffi" :depends-on (:cells :hello-c) From pdenno at common-lisp.net Sun May 29 21:19:59 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Sun, 29 May 2005 23:19:59 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-ffi.lisp Message-ID: <20050529211959.06BEE880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv9071/gtk-ffi Modified Files: gtk-ffi.lisp Log Message: New method to load foreign libraries. Date: Sun May 29 23:19:58 2005 Author: pdenno Index: root/gtk-ffi/gtk-ffi.lisp diff -u root/gtk-ffi/gtk-ffi.lisp:1.11 root/gtk-ffi/gtk-ffi.lisp:1.12 --- root/gtk-ffi/gtk-ffi.lisp:1.11 Thu May 5 16:20:51 2005 +++ root/gtk-ffi/gtk-ffi.lisp Sun May 29 23:19:58 2005 @@ -47,85 +47,67 @@ (eval-when (:compile-toplevel :load-toplevel :execute) - (export '(c-null c-null-int int-slot-indexed)) + (export '(c-null c-null-int int-slot-indexed load-gtk-libs)) (defun gtk-function-name (lisp-name) (substitute #\_ #\- lisp-name)) - - (defun libname (lib) - #+(or win32 mswindows) - (concatenate 'string - "/Program Files/Common Files/GTK/2.0/bin/" - (ecase lib - (:gobject "libgobject-2.0-0.dll") - (: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/" - (ecase lib - (:gobject "libgobject-2.0.0.dylib") - (: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") - (: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") - (:cgtk "libcellsgtk"))) - - - - #+cmu - (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)))) - - #-libcellsgtk - (warn "libcellsgtk.so not found. Just a few capabilities will be unavailable.") - + (defun load-gtk-libs () + (macrolet ((loadit (libname module) + `(uffi:load-foreign-library + (concatenate 'string cl-user::*gtk-lib-path* ,libname) + :force-load #+lispworks t #-lispworks nil + :module ,(string module)))) + #+(or win32 mswindows) + (progn + (loadit "libgobject-2.0-0.dll" :gobject) + (loadit "libglib-2.0-0.dll" :glib) + (loadit "libgthread-2.0-0.dll" :gthread) + (loadit "libgdk-win32-2.0-0.dll" :gdk) + (loadit "libgtk-win32-2.0-0.dll" :gtk) + #+libcellsgtk(loadit "libcellsgtk.dll" :cgtk)) + #+macosx + (progn + (loadit "libgobject-2.0-0.dynlib" :gobject) + (loadit "libglib-2.0-0.dynlib" :glib) + (loadit "libgthread-2.0-0.dynlib" :gthread) + (loadit "libgdk-win32-2.0-0.dynlib" :gdk) + (loadit "libgtk-win32-2.0-0.dynlib" :gtk) + #+libcellsgtk(loadit "libcellsgtk.dynlib" :cgtk)) + #-(or macosx win32 mswindows) + (progn + (loadit "libgobject-2.0.so" :gobject) + (loadit "libglib-2.0.so" :glib) + (loadit "libgthread-2.0.so" :gthread) + (loadit "libgdk-x11-2.0.so" :gdk) + (loadit "libgtk-x11-2.0.so" :gtk) + #+libcellsgtk(loadit "libcellsgtk.so" :cgtk)))) + #+cmu(load-gtk-libs) (defun ffi-to-uffi-type (clisp-type) #+clisp clisp-type #-clisp (if (consp clisp-type) (mapcar 'ffi-to-uffi-type clisp-type) - (case clisp-type - ((nil) :void) - (uint :UNSIGNED-INT) - (c-pointer :pointer-void) - (c-ptr-null '*) - (c-array-ptr '*) - (c-ptr '*) - (c-string :cstring) - (sint32 :int) - (uint32 :unsigned-int) - (uint8 :unsigned-byte) - (uint16 :short) ; no signed/unsigned types? - (boolean :unsigned-int) - (ulong :unsigned-long) - (int :int) - (long :long) - (single-float :float) - (double-float :double) - (otherwise clisp-type)))) - + (case clisp-type + ((nil) :void) + (uint :UNSIGNED-INT) + (c-pointer :pointer-void) + (c-ptr-null '*) + (c-array-ptr '*) + (c-ptr '*) + (c-string :cstring) + (sint32 :int) + (uint32 :unsigned-int) + (uint8 :unsigned-byte) + (uint16 :short) ; no signed/unsigned types? + (boolean :unsigned-int) + (ulong :unsigned-long) + (int :int) + (long :long) + (single-float :float) + (double-float :double) + (otherwise clisp-type)))) #-clisp (defun ffi-to-native-type (ffi-type) (uffi::convert-from-uffi-type - (ffi-to-uffi-type ffi-type) :type))) - + (ffi-to-uffi-type ffi-type) :type))) ;; END eval-when (defmacro def-gtk-function (library name &key arguments return-type (return-type-allocation :none) @@ -312,13 +294,10 @@ (32 :window_state) (33 :setting))) - - #-clisp (uffi:def-struct list-boolean (value :unsigned-int) (end :pointer-void)) - (defmacro with-gtk-string ((var string) &rest body) `(let ((,var ,string)) From pdenno at common-lisp.net Sun May 29 21:21:00 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Sun, 29 May 2005 23:21:00 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-list-tree.lisp Message-ID: <20050529212100.AE0A3880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv9098/gtk-ffi Modified Files: gtk-list-tree.lisp Log Message: Reference to gtk-tree-view-expand-all and gtk-tree-iter-free Date: Sun May 29 23:21:00 2005 Author: pdenno Index: root/gtk-ffi/gtk-list-tree.lisp diff -u root/gtk-ffi/gtk-list-tree.lisp:1.2 root/gtk-ffi/gtk-list-tree.lisp:1.3 --- root/gtk-ffi/gtk-list-tree.lisp:1.2 Sat Feb 26 23:38:50 2005 +++ root/gtk-ffi/gtk-list-tree.lisp Sun May 29 23:21:00 2005 @@ -79,6 +79,10 @@ (wy int) (tx c-pointer) (ty c-pointer))) + (gtk-tree-view-expand-all ((tree-view c-pointer))) + + ;;tree-iter + (gtk-tree-iter-free ((iter c-pointer))) ;;tree-model (gtk-tree-model-get ((tree-model c-pointer) From pdenno at common-lisp.net Sun May 29 21:22:23 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Sun, 29 May 2005 23:22:23 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-other.lisp Message-ID: <20050529212223.177D4880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv9125/gtk-ffi Modified Files: gtk-other.lisp Log Message: New external references for ComboBox Date: Sun May 29 23:22:22 2005 Author: pdenno Index: root/gtk-ffi/gtk-other.lisp diff -u root/gtk-ffi/gtk-other.lisp:1.5 root/gtk-ffi/gtk-other.lisp:1.6 --- root/gtk-ffi/gtk-other.lisp:1.5 Sun Mar 6 18:05:44 2005 +++ root/gtk-ffi/gtk-other.lisp Sun May 29 23:22:22 2005 @@ -440,6 +440,11 @@ (index int))) (gtk-combo-box-get-active ((combo-box c-pointer)) int) + (gtk-combo-box-set-model ((combo-box c-pointer) + (model c-pointer))) + (gtk-combo-box-get-active-iter ((combo-box c-pointer) + (iter c-pointer)) + boolean) ;;calendar (gtk-calendar-new () @@ -691,7 +696,10 @@ ((treeview c-pointer)) c-pointer) (gtk-adds-text-iter-new () - c-pointer)) + c-pointer) + (gtk-adds-tree-iter-new () + c-pointer)) + #-libcellsgtk (defmacro you-need-libcellsgtk (&body names) @@ -706,7 +714,8 @@ (you-need-libcellsgtk gtk-adds-dialog-box gtk-adds-text-view-popup-menu - gtk-adds-text-iter-new)) + gtk-adds-text-iter-new + gtk-adds-tree-iter-new)) From pdenno at common-lisp.net Sun May 29 21:24:11 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Sun, 29 May 2005 23:24:11 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-utilities.lisp Message-ID: <20050529212411.07290880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv9151/gtk-ffi Modified Files: gtk-utilities.lisp Log Message: Cleaned up so that it doesn't generate strings and intern just to call g-value functions. Date: Sun May 29 23:24:10 2005 Author: pdenno Index: root/gtk-ffi/gtk-utilities.lisp diff -u root/gtk-ffi/gtk-utilities.lisp:1.13 root/gtk-ffi/gtk-utilities.lisp:1.14 --- root/gtk-ffi/gtk-utilities.lisp:1.13 Sat Feb 26 23:44:48 2005 +++ root/gtk-ffi/gtk-utilities.lisp Sun May 29 23:24:10 2005 @@ -16,6 +16,7 @@ |# +;;; Function with equivalents in gtklib. (in-package :gtk-ffi) @@ -163,21 +164,22 @@ (gtk-tree-store-newv (length col-types) gtk-types))) (defun gtk-tree-store-set (tstore iter types-lst data-lst) + "Sets the value of one or more cells in a row referenced by iter." (with-g-value (value) (loop for col from 0 for data in data-lst for type in types-lst do ;; (print (list :tree-store-set value type (as-gtk-type type))) (g-value-init value (as-gtk-type type)) - (funcall (intern (format nil "G-VALUE-SET-~a" (case type - (:date 'float) - (:icon 'string) - (t type))) - :gtk-ffi) + (funcall (case type + ((:string :icon) #'g-value-set-string) + (:int #'g-value-set-int) + (:long #'g-value-set-long) + (:boolean #'g-value-set-boolean) + ((:float :date) #'g-value-set-float) + (t (error "Invalid type: ~S?" type))) value - (if (eql type :date) - (coerce data 'single-float) - data)) + (if (eql type :date) (coerce data 'single-float) data)) (gtk-tree-store-set-value tstore iter col value) (g-value-unset value)))) From pdenno at common-lisp.net Sun May 29 21:25:44 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Sun, 29 May 2005 23:25:44 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: root/cells-gtk/test-gtk/test-menus.lisp Message-ID: <20050529212544.8B105880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk In directory common-lisp.net:/tmp/cvs-serv9175/cells-gtk/test-gtk Modified Files: test-menus.lisp Log Message: New code to demo TreeModel ComboBoxes (requires libcellsgtk). Date: Sun May 29 23:25:44 2005 Author: pdenno Index: root/cells-gtk/test-gtk/test-menus.lisp diff -u root/cells-gtk/test-gtk/test-menus.lisp:1.3 root/cells-gtk/test-gtk/test-menus.lisp:1.4 --- root/cells-gtk/test-gtk/test-menus.lisp:1.3 Wed Feb 16 23:38:00 2005 +++ root/cells-gtk/test-gtk/test-menus.lisp Sun May 29 23:25:43 2005 @@ -130,6 +130,20 @@ (mk-label :text (c? (format nil "Combo value ~a" (md-value (fm^ :combo))))))) (mk-hseparator :padding 5) + #+libcellsgtk + (mk-hbox + :kids (list + (mk-combo-box + :roots '("Text" "Numeric" "Timepoint") + :init 0 + :children-fn + #'(lambda (x) + (cond ((equal x "Text") '("Trimmed Text" "Raw Text")) + ((equal x "Numeric") '("Integer" "Decimal" "Scientific")) + ((equal x "Timepoint") + '("DD/MM/YY" "DD/MM/YYYY" "MM/DD/YY" "YYYY-MM-DD" + "YYYY-MM-DDTHH:MM:SS" "DD/MM/YY HH:MM:SS"))))))) + (mk-hseparator :padding 5) (mk-hbox :kids (list (mk-event-box From pdenno at common-lisp.net Mon May 30 02:06:26 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Mon, 30 May 2005 04:06:26 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: public_html/index.html Message-ID: <20050530020626.3FB07880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv26389/public_html Modified Files: index.html Log Message: Update for May 29 update. Date: Mon May 30 04:06:25 2005 Author: pdenno Index: public_html/index.html diff -u public_html/index.html:1.3 public_html/index.html:1.4 --- public_html/index.html:1.3 Sat Mar 5 02:09:11 2005 +++ public_html/index.html Mon May 30 04:06:25 2005 @@ -74,6 +74,9 @@

News

  • cells-gtk-2005-02-26.tgz
  • From pdenno at common-lisp.net Mon May 30 02:10:19 2005 From: pdenno at common-lisp.net (Peter Denno) Date: Mon, 30 May 2005 04:10:19 +0200 (CEST) Subject: [cells-gtk-cvs] CVS update: public_html/index.html Message-ID: <20050530021019.A8711880DC@common-lisp.net> Update of /project/cells-gtk/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv26428/public_html Modified Files: index.html Log Message: Added news Date: Mon May 30 04:10:19 2005 Author: pdenno Index: public_html/index.html diff -u public_html/index.html:1.5 public_html/index.html:1.6 --- public_html/index.html:1.5 Mon May 30 04:08:02 2005 +++ public_html/index.html Mon May 30 04:10:19 2005 @@ -74,8 +74,7 @@

    News