cells-gtk-cvs

cells-gtk-cvs@common-lisp.net

371 discussions

[cells-gtk-cvs] CVS root/cells-gtk
by pdenno 16 Feb '06

16 Feb '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv10718/root/cells-gtk Modified Files: menus.lisp Log Message: nil --> +c-null+ --- /project/cells-gtk/cvsroot/root/cells-gtk/menus.lisp 2005/10/08 14:28:49 1.11 +++ /project/cells-gtk/cvsroot/root/cells-gtk/menus.lisp 2006/02/16 18:16:28 1.12 @@ -74,7 +74,7 @@ (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 + (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. But then there would be no point ;; in set-active-iter. Well, the spec seems to be wrong (or poorly worded). @@ -162,7 +162,7 @@ (label-widget :accessor label-widget :initarg :label-widget :initform (c-in nil))) (use-underline stock-id) (clicked) - :new-args (list c-null c-null)) + :new-args (list +c-null+ +c-null+)) (def-c-output icon-widget ((self tool-button)) (when old-value @@ -276,7 +276,7 @@ (not-first-p (not (eql (first (kids (fm-parent self))) self)))) (if (and in-group-p not-first-p) (list (id (first (kids (fm-parent self))))) - (list c-null))))) + (list +c-null+))))) (def-c-output .md-value ((self radio-menu-item)) (when (and new-value (upper self menu-item)) @@ -291,7 +291,8 @@ :new-tail (c? (when (stock self) '-from-stock)) :new-args (c? (when (stock self) - (list (string-downcase (format nil "gtk-~a" (stock self))) nil)))) + (list (string-downcase (format nil "gtk-~a" (stock self))) +c-null+)))) + (def-c-output image ((self image-menu-item)) (when old-value

1 0

[cells-gtk-cvs] CVS root/cells-gtk
by pdenno 16 Feb '06

16 Feb '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv10692/root/cells-gtk Modified Files: layout.lisp Log Message: nil --> +c-null+ --- /project/cells-gtk/cvsroot/root/cells-gtk/layout.lisp 2006/01/03 18:58:54 1.6 +++ /project/cells-gtk/cvsroot/root/cells-gtk/layout.lisp 2006/02/16 18:15:47 1.7 @@ -185,7 +185,7 @@ () :expand t :fill t :policy (list 1 1) - :new-args (list c-null c-null)) + :new-args (list +c-null+ +c-null+)) (def-c-output .kids ((self scrolled-window)) (assert-bin self)

1 0

[cells-gtk-cvs] CVS root/cells-gtk
by pdenno 16 Feb '06

16 Feb '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv9994/root/cells-gtk Modified Files: gtk-app.lisp Log Message: Uses restarts instead of kludgy code. --- /project/cells-gtk/cvsroot/root/cells-gtk/gtk-app.lisp 2006/01/03 18:57:41 1.15 +++ /project/cells-gtk/cvsroot/root/cells-gtk/gtk-app.lisp 2006/02/16 18:15:14 1.16 @@ -25,11 +25,10 @@ (tooltips-delay :accessor tooltips-delay :initarg :tooltips-delay :initform (c-in nil)) (stock-icons :cell nil :accessor stock-icons :initarg :stock-icons :initform nil)) (:default-initargs - :on-delete-event (lambda (self widget event data) - (declare (ignore self widget event data)) - #+lispworks(signal 'gtk-user-signals-quit) - #-lispworks(gtk-main-quit) - 0))) + :on-delete-event (lambda (self widget event data) + (declare (ignore self widget event data)) + (signal 'gtk-user-signals-quit) + 0))) (defmethod initialize-instance :after ((self gtk-app) &key stock-icons) @@ -62,16 +61,16 @@ (defvar *gtk-initialized* nil) + (defun start-app (app-name &key debug) (let ((*gtk-debug* debug)) (when (not *gtk-initialized*) (when *gtk-debug* (trc nil "GTK INITIALIZATION") (force-output)) - (g-thread-init c-null) + (g-thread-init +c-null+) (gdk-threads-init) - (assert (gtk-init-check c-null-int c-null)) + (assert (gtk-init-check +c-null+ +c-null+)) (setf *gtk-initialized* t)) - (setf (gtk-user-quit-p) nil) (with-gdk-threads (let ((app (make-instance app-name :visible (c-in nil))) @@ -84,38 +83,49 @@ (setf (visible splash) t) (loop while (gtk-events-pending) do (gtk-main-iteration))) - + (to-be app) - + (when splash (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)))) - (unwind-protect - (catch 'try-again - (handler-case - (loop - (do-gtk) - (when (gtk-user-quit-p) (signal 'gtk-user-signals-quit)) - (process-wait-with-timeout .01 "GTK event loop waiting")) - (gtk-continuable-error (err) - (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 () - (loop while (> (gtk-main-level) 0) do (gtk-main-quit)) - (return-from start-app)))) - (not-to-be app) - (loop while (> (gtk-main-level) 0) do (gtk-main-quit)) - (do-gtk))))))) - + (when *gtk-debug* (trc nil "STARTING GTK-MAIN") (force-output)) + (unwind-protect + (loop + (restart-case + (handler-bind + ((gtk-user-signals-quit #'give-up-cleanly) + (gtk-continuable-error #'continue-from-error) + (error #'report-error-and-give-up)) + #-lispworks + (gtk-main) + #+lispworks ; give slime a chance. + (loop ; just running your app in a process is not enough. + (loop while (gtk-events-pending) do + (gtk-main-iteration-do nil)) + (process-wait-with-timeout .01 "GTK event loop waiting"))) + ;; Restart cases + (continue-from-error (c) + (show-message (format nil "Cells-GTK Error: ~a" (text c)) + :message-type :error :title "Cells-GTK Error")) + (give-up-cleanly () (return-from start-app)) + (report-error-and-give-up (c) (error c)))) + ;; clean-up forms (takes down application). + (not-to-be app) ; while (> (gtk-main-level) 0) do (gtk-main-quit) NG. Why? + (loop for i from 0 to 99 do (gtk-main-quit)) + (loop while (gtk-events-pending) do (gtk-main-iteration-do nil))))))) + +;;; Restarts +(defun continue-from-error (c) + (invoke-restart 'continue-from-error c)) + +(defun report-error-and-give-up (c) + (invoke-restart 'report-error-and-give-up c)) + +(defun give-up-cleanly (c) + (declare (ignore c)) + (invoke-restart 'give-up-cleanly)) (defvar *gtk-global-callbacks* nil) (defvar *gtk-loaded* #+clisp t #-clisp nil) ;; kt: looks like CLisp does this on its own @@ -127,8 +137,7 @@ (make-array 128 :adjustable t :fill-pointer 0))) (defun gtk-global-callback-register (callback) - (vector-push-extend callback - *gtk-global-callbacks* 16)) + (vector-push-extend callback *gtk-global-callbacks* 16)) (defun gtk-global-callback-funcall (n) (trc nil "gtk-global-callback-funcall >" n @@ -143,13 +152,7 @@ (setf *gtk-loaded* t)) (gtk-reset)) -;;; Implements quits other than through destroy. -(let (quit) - (defun gtk-user-quit-p () quit) - (defun (setf gtk-user-quit-p) (val) - (setf quit val)) -) - (eval-when (compile load eval) (export '(gtk-app gtk-reset cells-gtk-init title icon tooltips tooltips-enable tooltips-delay - start-app gtk-global-callback-register gtk-global-callback-funcall gtk-user-quit-p))) \ No newline at end of file + start-app gtk-global-callback-register gtk-global-callback-funcall))) +

1 0

[cells-gtk-cvs] CVS root/cells-gtk
by pdenno 16 Feb '06

16 Feb '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv9347/root/cells-gtk Modified Files: drawing.lisp Log Message: trivial --- /project/cells-gtk/cvsroot/root/cells-gtk/drawing.lisp 2006/02/11 03:34:09 1.4 +++ /project/cells-gtk/cvsroot/root/cells-gtk/drawing.lisp 2006/02/16 18:13:57 1.5 @@ -1,7 +1,6 @@ #| - Cells Gtk Copyright (c) 2004 by Vasilis Margioulas <vasilism(a)sch.gr> - This file Copyright (c) 2005 by Peter Denno <peter.denno(a)nist.gov> + Copyright (c) 2005 by Peter Denno <peter.denno(a)nist.gov> You have the right to distribute and use this software as governed by the terms of the Lisp Lesser GNU Public License (LLGPL):

1 0

[cells-gtk-cvs] CVS root/cells-gtk
by pdenno 16 Feb '06

16 Feb '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv9313/root/cells-gtk Modified Files: dialogs.lisp Log Message: nil --> +c-null+ --- /project/cells-gtk/cvsroot/root/cells-gtk/dialogs.lisp 2005/02/26 22:24:27 1.5 +++ /project/cells-gtk/cvsroot/root/cells-gtk/dialogs.lisp 2006/02/16 18:12:54 1.6 @@ -29,7 +29,7 @@ (markup) () :position :mouse - :new-args (c? (list c-null + :new-args (c? (list +c-null+ 2 (ecase (message-type self) (:info 0) @@ -125,7 +125,7 @@ () :on-selection-changed nil :position :mouse - :new-args (c? (list (title self) c-null (action-id self) + :new-args (c? (list (title self) +c-null+ (action-id self) "gtk-cancel" -6 ;;response-cancel (format nil "gtk-~a" (string-downcase @@ -136,7 +136,7 @@ :apply (action self)))))) -5 ;;response-ok - nil))) + +c-null+))) (defmethod md-awaken :after ((self file-chooser-dialog)) (let ((response (gtk-dialog-run (id self))))

1 0

[cells-gtk-cvs] CVS root/cells-gtk
by pdenno 16 Feb '06

16 Feb '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv9292/root/cells-gtk Modified Files: conditions.lisp Log Message: trivial --- /project/cells-gtk/cvsroot/root/cells-gtk/conditions.lisp 2005/02/26 22:22:05 1.2 +++ /project/cells-gtk/cvsroot/root/cells-gtk/conditions.lisp 2006/02/16 18:12:15 1.3 @@ -21,18 +21,18 @@ (defmacro gtk-report-error (type string &body args) `(error ',type :format-string ,string :format-arguments (list ,@args))) -(define-condition gtk-continuable-error (condition) ()) +(define-condition gtk-continuable-error (condition) + ((text :initarg :text :reader text))) (define-condition gtk-cells-error (gtk-continuable-error) - ((format-string :initarg :format-string) - (format-arguments :initarg :format-arguments)) - (:report (lambda (err stream) - (with-slots (format-string format-arguments) err - (apply #'format stream format-string format-arguments))))) + ((format-string :initarg :format-string :reader format-string) + (format-arguments :initarg :format-arguments :reader format-arguments)) + (:report (lambda (c stream) + (apply #'format stream (format-string c) (format-arguments c))))) -(define-condition gtk-object-id-error (gtk-cells-error) - ()) +(define-condition gtk-object-id-error (gtk-cells-error) ()) -(define-condition gtk-user-signals-quit (condition) - ()) +(define-condition gtk-user-signals-quit (condition) ()) + +(export '(gtk-user-signals-quit gtk-continuable-error gtk-report-error))

1 0

[cells-gtk-cvs] CVS root/cells-gtk
by pdenno 16 Feb '06

16 Feb '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv9273/root/cells-gtk Modified Files: cells-gtk.asd Log Message: trivial --- /project/cells-gtk/cvsroot/root/cells-gtk/cells-gtk.asd 2006/01/03 18:55:16 1.6 +++ /project/cells-gtk/cvsroot/root/cells-gtk/cells-gtk.asd 2006/02/16 18:11:08 1.7 @@ -11,7 +11,7 @@ (:file "widgets" :depends-on ("conditions")) (:file "layout" :depends-on ("widgets")) (:file "display" :depends-on ("widgets")) -#+notyet(:file "drawing" :depends-on ("widgets")) ; not ready yet. +; (:file "drawing" :depends-on ("widgets")) (:file "buttons" :depends-on ("widgets")) (:file "entry" :depends-on ("widgets")) (:file "tree-view" :depends-on ("widgets"))

1 0

[cells-gtk-cvs] CVS root/cells-gtk
by pdenno 16 Feb '06

16 Feb '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv9254/root/cells-gtk Modified Files: buttons.lisp Log Message: trivial --- /project/cells-gtk/cvsroot/root/cells-gtk/buttons.lisp 2004/12/22 16:23:50 1.5 +++ /project/cells-gtk/cvsroot/root/cells-gtk/buttons.lisp 2006/02/16 18:10:10 1.6 @@ -85,7 +85,7 @@ :new-args (c? (and (upper self box) (list (if (eql (first (kids (fm-parent self))) self) - c-null + +c-null+ (id (first (kids (fm-parent self)))))))) :on-toggled (callback (widget event data) ;;(print (list :radio-button widget event data))

1 0

[cells-gtk-cvs] CVS
by pdenno 16 Feb '06

16 Feb '06

Update of /project/cells-gtk/cvsroot In directory common-lisp:/tmp/cvs-serv9159 Modified Files: INSTALL.TXT Log Message: New procedure *gtk-lib-path* is gone! Note testing of SBCL and new windows GTK+ lib --- /project/cells-gtk/cvsroot/INSTALL.TXT 2006/01/03 19:13:50 1.1 +++ /project/cells-gtk/cvsroot/INSTALL.TXT 2006/02/16 18:09:31 1.2 @@ -7,16 +7,13 @@ STEP 1: EVERYONE: Start lisp, change to this directory and do (load "load") -STEP 2: EVERYONE: If STEP 1 didn't go well, look at the settings of - *gtk-lib-path* in file ./root/gtk-ffi/gtk-ffi.asd +STEP 2: EVERYONE: (test-gtk::gtk-demo) -STEP 3: EVERYONE: (test-gtk::gtk-demo) - -STEP 4: ANYONE (optional) make libcellsgtk, (or get it from the cells-gtk site). To make: - 4a) In ./root/gtk-ffi 'make' - 4b) Move the library created to whatever *gtk-lib-path* is set to. - 4c) Uncomment the line (pushnew :libcellsgtk *features*) in ./root/gtk-ffi/gtk-ffi.asd - 4d) Recompile the distribution (remove fasls and type (load "load") again. +STEP 3: ANYONE (optional) make libcellsgtk, (or get it from the cells-gtk site). To make: + 3a) In ./root/gtk-ffi 'make' + 3b) Move the library created to where it will be found (Linux see /etc/ld.so.conf). + 3c) Uncomment the line (pushnew :libcellsgtk *features*) in ./root/gtk-ffi/gtk-ffi.asd + 3d) Recompile the distribution (remove fasls and type (load "load") again. TESTED ON: @@ -28,18 +25,17 @@ Lispworks 4.4 Pro, CMUCL 19c, CLISP 2.36 + SBCL 0.9.9.1 NOT TESTED SINCE SWITCHING TO CFFI: (as of 2006-01-03): AllegroCL - MACOS - SBCL - never tested, but probably pretty close to OK. + MACOSX ;;; -------- Windows Users --------------- - Get GTK and Install - http://gimp-win.sourceforge.net/stable.html + http://gimp-win.sourceforge.net/stable.html (I used version 2.8.9) Executing the setup.exe should add "C:\Program Files\Common Files\GTK\2.0\bin" to your path. You can verify that it has: @@ -50,6 +46,8 @@ Note: On windows under emacs with slime, the gtk window does not popup. You must start the application from a dos prompt. + (Solutions to this problem welcome!, probably involves putting something + like a call to gtk-iteration-do into some slime loop through a hook.) Known bugs: On Windows: Clisp crashes if

1 0

[cells-gtk-cvs] CVS root/gtk-ffi
by pdenno 16 Feb '06

16 Feb '06

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp:/tmp/cvs-serv9130/root/gtk-ffi Removed Files: gtk-definitions.lisp Log Message: Not used

1 0

← Newer
1
...
12
13
14
15
16
17
18
...
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