Update of /project/cells/cvsroot/cells-gtk In directory clnet:/tmp/cvs-serv9292
Added Files: INSTALL.TXT actions.lisp addon.lisp asdf.lisp buttons.lisp callback.lisp cells-gtk.asd cells-gtk.lpr cells3-porting-notes.lisp clisp.bat compat.lisp conditions.lisp dialogs.lisp display.lisp drawing.lisp entry.lisp gtk-app-save.lisp gtk-app-win32.lisp gtk-app.lisp layout.lisp lisp.bat load.lisp menus.lisp packages.lisp pod-notes.txt textview.lisp tree-view.lisp widgets.lisp Log Message:
--- /project/cells/cvsroot/cells-gtk/INSTALL.TXT 2008/01/28 23:59:24 NONE +++ /project/cells/cvsroot/cells-gtk/INSTALL.TXT 2008/01/28 23:59:24 1.1
To compile and run:
STEP 0: WINDOWS USERS: Do the stuff marked "Windows Users" below.
STEP .5: CLISP Users edit the path in ./load.lisp (you'll see it).
STEP 1: EVERYONE: Start lisp, change to this directory and do (load "load")
STEP 2: EVERYONE: (test-gtk::gtk-demo)
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: Windows XP: (with gtk 2.4.10) AllegroCL 6.2 Enterprise, Lispworks 4.3 Personal Windows 2000: CLISP 2.38 Linux: 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 MACOSX
;;; -------- Windows Users ---------------
Get GTK and Install
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:
Start>Settings>Control Panel>System>Advanced>Environment Variables>
(I had to reboot after this, but then I don't know anything about Win32).
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 [My Computer]-> [Properties]-> [Advanced]-> [Perfomance Settings]-> [Show windows contents while dragging] is set and resize the window while viewing a listbox or treebox. --- /project/cells/cvsroot/cells-gtk/actions.lisp 2008/01/28 23:59:24 NONE +++ /project/cells/cvsroot/cells-gtk/actions.lisp 2008/01/28 23:59:24 1.1 (in-package :cgtk)
(def-object action () ((name :accessor name :initarg :name :initform nil) (accel :accessor accel :initarg :accel :initform nil) (visible :accessor visible :initarg :visible :initform (c-in t)) (sensitive :accessor sensitive :initarg :sensitive :initform (c-in t)) (label :accessor label :initarg :label :initform nil) (tooltip :accessor tooltip :initarg :tooltip :initform nil) (stock :accessor stock :initarg :stock :initform nil) (stock-id :accessor stock-id :initform (c? (when (stock self) (string-downcase (format nil "gtk-~a" (stock self))))))) () () :new-args (c_1 (list (name self) nil nil (stock-id self))))
(def-c-output visible ((self action)) (gtk-ffi::gtk-object-set-property (id self) "visible" 'boolean new-value)) (def-c-output sensitive ((self action)) (gtk-ffi::gtk-object-set-property (id self) "sensitive" 'boolean new-value))
(def-c-output label ((self action)) (when new-value (gtk-ffi::with-gtk-string (str new-value) (gtk-ffi::gtk-object-set-property (id self) "label" 'c-pointer str))))
(def-c-output tooltip ((self action)) (when new-value (gtk-ffi::with-gtk-string (str new-value) (gtk-ffi::gtk-object-set-property (id self) "tooltip" 'c-pointer str))))
(def-object action-group () ((name :accessor name :initarg :name :initform nil) (visible :accessor visible :initarg :visible :initform (c-in t)) (sensitive :accessor sensitive :initarg :sensitive :initform (c-in t))) () () :new-args (c_1 (list (name self))))
(def-c-output sensitive ((self action-group)) (gtk-ffi::gtk-action-group-set-sensitive (id self) new-value))
(def-c-output visible ((self action-group)) (gtk-ffi::gtk-action-group-set-visible (id self) new-value))
(def-c-output .kids ((self action-group)) (dolist (kid old-value) (gtk-ffi::gtk-action-group-remove-action (id self) (id kid))) (dolist (kid new-value) (gtk-ffi::gtk-action-group-add-action-with-accel (id self) (id kid) (accel kid))) #+clisp (call-next-method))
(def-object ui-manager () ((action-groups :accessor action-groups :initform (c-in nil)) (add-tearoffs :accessor tearoffs :initarg :tearoffs :initform nil)) () ())
(def-c-output tearoffs ((self ui-manager)) (gtk-ffi::gtk-ui-manager-set-add-tearoffs (id self) new-value))
(defmethod add-action-group ((self ui-manager) (group action-group) &optional pos) (let ((grp (to-be group))) (trc nil "ADD-ACTION-GROUP" grp) (force-output) (gtk-ffi::gtk-ui-manager-insert-action-group (id self) (id group) (or pos (length (action-groups self)))) (push grp (action-groups self))))
(defmodel test-actions (vbox) () (:default-initargs :action-group (mk-action-group :name "Group 1" :kids (kids-list? (mk-action :name "Action 1" :stock :cdrom :label "Action 1" :accel "<Control>a") (mk-action :name "Action 2" :stock :network :label "Action 2" :accel "<Control>b")))
:kids (kids-list? (mk-label :text "Actions test")))) --- /project/cells/cvsroot/cells-gtk/addon.lisp 2008/01/28 23:59:24 NONE +++ /project/cells/cvsroot/cells-gtk/addon.lisp 2008/01/28 23:59:24 1.1 #|
Cells Gtk
Copyright (c) 2004 by Vasilis Margioulas vasilism@sch.gr
You have the right to distribute and use this software as governed by the terms of the Lisp Lesser GNU Public License (LLGPL):
(http://opensource.franz.com/preamble.html)
This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the Lisp Lesser GNU Public License for more details.
|#
(in-package :cgtk)
(def-widget calendar () ((init :accessor init :initarg :init :initform nil)) () (day-selected) :on-day-selected (callback (widg signal data) (setf (value self) (get-date self))))
(defmethod get-date ((self calendar)) (uffi:with-foreign-objects ((year :int)(month :int)(day :int)) (gtk-calendar-get-date (id self) year month day) (encode-universal-time 0 0 0 (uffi:deref-pointer day :int) (1+ (uffi:deref-pointer month :int)) (uffi:deref-pointer year :int))))
(defobserver init ((self calendar)) (when new-value (multiple-value-bind (sec min hour day month year) (decode-universal-time new-value)
(declare (ignorable sec min hour)) (gtk-calendar-select-month (id self) (1- month) year) (gtk-calendar-select-day (id self) day)) (setf (value self) new-value)))
(def-widget arrow () ((type :accessor arrow-type :initarg :type :initform nil) (type-id :accessor type-id :initform (c? (case (arrow-type self) (:up 0) (:down 1) (:left 2) (:right 3) (t 3)))) (shadow :accessor arrow-shadow :initarg :shadow :initform nil) (shadow-id :accessor shadow-id :initform (c? (case (arrow-shadow self) (:none 0) (:in 1) (:out 2) (:etched-in 3) (:etched-out 4) (t 2))))) () () :new-args (c_1 (list (type-id self) (shadow-id self))))
(defobserver type ((self arrow)) (when new-value (gtk-arrow-set (id self) (type-id self) (shadow-id self))))
(defobserver shadow ((self arrow)) (when new-value (gtk-arrow-set (id self) (type-id self) (shadow-id self))))
--- /project/cells/cvsroot/cells-gtk/asdf.lisp 2008/01/28 23:59:24 NONE +++ /project/cells/cvsroot/cells-gtk/asdf.lisp 2008/01/28 23:59:24 1.1 ;;; This is asdf: Another System Definition Facility. $Revision: 1.1 $ ;;; ;;; Feedback, bug reports, and patches are all welcome: please mail to ;;; cclan-list@lists.sf.net. But note first that the canonical ;;; source for asdf is presently the cCLan CVS repository at ;;; URL:http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/cclan/asdf/ ;;; ;;; If you obtained this copy from anywhere else, and you experience ;;; trouble using it, or find bugs, you may want to check at the ;;; location above for a more recent version (and for documentation ;;; and test files, if your copy came without them) before reporting ;;; bugs. There are usually two "supported" revisions - the CVS HEAD ;;; is the latest development version, whereas the revision tagged ;;; RELEASE may be slightly older but is considered `stable'
;;; Copyright (c) 2001-2003 Daniel Barlow and contributors ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining ;;; a copy of this software and associated documentation files (the ;;; "Software"), to deal in the Software without restriction, including ;;; without limitation the rights to use, copy, modify, merge, publish, ;;; distribute, sublicense, and/or sell copies of the Software, and to ;;; permit persons to whom the Software is furnished to do so, subject to ;;; the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be ;;; included in all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE ;;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION ;;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION ;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
;;; the problem with writing a defsystem replacement is bootstrapping: ;;; we can't use defsystem to compile it. Hence, all in one file
(defpackage #:asdf (:export #:defsystem #:oos #:operate #:find-system #:run-shell-command #:system-definition-pathname #:find-component ; miscellaneous #:hyperdocumentation #:hyperdoc #:compile-op #:load-op #:load-source-op #:test-system-version #:test-op #:operation ; operations #:feature ; sort-of operation #:version ; metaphorically sort-of an operation #:input-files #:output-files #:perform ; operation methods #:operation-done-p #:explain #:component #:source-file #:c-source-file #:cl-source-file #:java-source-file #:static-file #:doc-file #:html-file #:text-file #:source-file-type #:module ; components #:system #:unix-dso #:module-components ; component accessors #:component-pathname #:component-relative-pathname #:component-name #:component-version #:component-parent #:component-property #:component-system #:component-depends-on
#:system-description #:system-long-description #:system-author #:system-maintainer #:system-license #:operation-on-warnings #:operation-on-failure ;#:*component-parent-pathname* #:*system-definition-search-functions* #:*central-registry* ; variables #:*compile-file-warnings-behaviour* #:*compile-file-failure-behaviour* #:*asdf-revision* #:operation-error #:compile-failed #:compile-warned #:compile-error #:system-definition-error #:missing-component #:missing-dependency #:circular-dependency ; errors
#:retry #:accept ; restarts ) (:use :cl))
#+nil (error "The author of this file habitually uses #+nil to comment out forms. But don't worry, it was unlikely to work in the New Implementation of Lisp anyway")
(in-package #:asdf)
(defvar *asdf-revision* (let* ((v "$Revision: 1.1 $") (colon (or (position #: v) -1)) (dot (position #. v))) (and v colon dot (list (parse-integer v :start (1+ colon) :junk-allowed t) (parse-integer v :start (1+ dot) :junk-allowed t)))))
(defvar *compile-file-warnings-behaviour* :warn) (defvar *compile-file-failure-behaviour* #+sbcl :error #-sbcl :warn)
(defvar *verbose-out* nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; utility stuff
(defmacro aif (test then &optional else) `(let ((it ,test)) (if it ,then ,else)))
(defun pathname-sans-name+type (pathname) "Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME, and NIL NAME and TYPE components" (make-pathname :name nil :type nil :defaults pathname))
(define-modify-macro appendf (&rest args) append "Append onto list")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; classes, condiitons
(define-condition system-definition-error (error) () ;; [this use of :report should be redundant, but unfortunately it's not. ;; cmucl's lisp::output-instance prefers the kernel:slot-class-print-function ;; over print-object; this is always conditions::%print-condition for ;; condition objects, which in turn does inheritance of :report options at ;; run-time. fortunately, inheritance means we only need this kludge here in ;; order to fix all conditions that build on it. -- rgr, 28-Jul-02.] #+cmu (:report print-object))
(define-condition formatted-system-definition-error (system-definition-error) ((format-control :initarg :format-control :reader format-control) (format-arguments :initarg :format-arguments :reader format-arguments)) (:report (lambda (c s) (apply #'format s (format-control c) (format-arguments c)))))
(define-condition circular-dependency (system-definition-error) ((components :initarg :components :reader circular-dependency-components)))
(define-condition missing-component (system-definition-error) ((requires :initform "(unnamed)" :reader missing-requires :initarg :requires) (version :initform nil :reader missing-version :initarg :version) (parent :initform nil :reader missing-parent :initarg :parent)))
(define-condition missing-dependency (missing-component) ((required-by :initarg :required-by :reader missing-required-by)))
(define-condition operation-error (error) ((component :reader error-component :initarg :component) (operation :reader error-operation :initarg :operation)) (:report (lambda (c s) (format s "~@<erred while invoking ~A on ~A~@:>" (error-operation c) (error-component c))))) (define-condition compile-error (operation-error) ()) (define-condition compile-failed (compile-error) ()) (define-condition compile-warned (compile-error) ())
(defclass component () ((name :accessor component-name :initarg :name :documentation "Component name: designator for a string composed of portable pathname characters") (version :accessor component-version :initarg :version) (in-order-to :initform nil :initarg :in-order-to) ;;; XXX crap name (do-first :initform nil :initarg :do-first) ;; methods defined using the "inline" style inside a defsystem form: ;; need to store them somewhere so we can delete them when the system ;; is re-evaluated (inline-methods :accessor component-inline-methods :initform nil) (parent :initarg :parent :initform nil :reader component-parent) ;; no direct accessor for pathname, we do this as a method to allow
[920 lines skipped] --- /project/cells/cvsroot/cells-gtk/buttons.lisp 2008/01/28 23:59:24 NONE +++ /project/cells/cvsroot/cells-gtk/buttons.lisp 2008/01/28 23:59:24 1.1
[1023 lines skipped] --- /project/cells/cvsroot/cells-gtk/callback.lisp 2008/01/28 23:59:24 NONE +++ /project/cells/cvsroot/cells-gtk/callback.lisp 2008/01/28 23:59:24 1.1
[1062 lines skipped] --- /project/cells/cvsroot/cells-gtk/cells-gtk.asd 2008/01/28 23:59:24 NONE +++ /project/cells/cvsroot/cells-gtk/cells-gtk.asd 2008/01/28 23:59:24 1.1
[1085 lines skipped] --- /project/cells/cvsroot/cells-gtk/cells-gtk.lpr 2008/01/28 23:59:24 NONE +++ /project/cells/cvsroot/cells-gtk/cells-gtk.lpr 2008/01/28 23:59:24 1.1
[1135 lines skipped] --- /project/cells/cvsroot/cells-gtk/cells3-porting-notes.lisp 2008/01/28 23:59:24 NONE +++ /project/cells/cvsroot/cells-gtk/cells3-porting-notes.lisp 2008/01/28 23:59:24 1.1
[1166 lines skipped] --- /project/cells/cvsroot/cells-gtk/clisp.bat 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/clisp.bat 2008/01/28 23:59:25 1.1
[1168 lines skipped] --- /project/cells/cvsroot/cells-gtk/compat.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/compat.lisp 2008/01/28 23:59:25 1.1
[1212 lines skipped] --- /project/cells/cvsroot/cells-gtk/conditions.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/conditions.lisp 2008/01/28 23:59:25 1.1
[1250 lines skipped] --- /project/cells/cvsroot/cells-gtk/dialogs.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/dialogs.lisp 2008/01/28 23:59:25 1.1
[1402 lines skipped] --- /project/cells/cvsroot/cells-gtk/display.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/display.lisp 2008/01/28 23:59:25 1.1
[1557 lines skipped] --- /project/cells/cvsroot/cells-gtk/drawing.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/drawing.lisp 2008/01/28 23:59:25 1.1
[1779 lines skipped] --- /project/cells/cvsroot/cells-gtk/entry.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/entry.lisp 2008/01/28 23:59:25 1.1
[1932 lines skipped] --- /project/cells/cvsroot/cells-gtk/gtk-app-save.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/gtk-app-save.lisp 2008/01/28 23:59:25 1.1
[2087 lines skipped] --- /project/cells/cvsroot/cells-gtk/gtk-app-win32.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/gtk-app-win32.lisp 2008/01/28 23:59:25 1.1
[2252 lines skipped] --- /project/cells/cvsroot/cells-gtk/gtk-app.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/gtk-app.lisp 2008/01/28 23:59:25 1.1
[2408 lines skipped] --- /project/cells/cvsroot/cells-gtk/layout.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/layout.lisp 2008/01/28 23:59:25 1.1
[2705 lines skipped] --- /project/cells/cvsroot/cells-gtk/lisp.bat 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/lisp.bat 2008/01/28 23:59:25 1.1
[2707 lines skipped] --- /project/cells/cvsroot/cells-gtk/load.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/load.lisp 2008/01/28 23:59:25 1.1
[2754 lines skipped] --- /project/cells/cvsroot/cells-gtk/menus.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/menus.lisp 2008/01/28 23:59:25 1.1
[3055 lines skipped] --- /project/cells/cvsroot/cells-gtk/packages.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/packages.lisp 2008/01/28 23:59:25 1.1
[3131 lines skipped] --- /project/cells/cvsroot/cells-gtk/pod-notes.txt 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/pod-notes.txt 2008/01/28 23:59:25 1.1
[3270 lines skipped] --- /project/cells/cvsroot/cells-gtk/textview.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/textview.lisp 2008/01/28 23:59:25 1.1
[3430 lines skipped] --- /project/cells/cvsroot/cells-gtk/tree-view.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/tree-view.lisp 2008/01/28 23:59:25 1.1
[3700 lines skipped] --- /project/cells/cvsroot/cells-gtk/widgets.lisp 2008/01/28 23:59:25 NONE +++ /project/cells/cvsroot/cells-gtk/widgets.lisp 2008/01/28 23:59:25 1.1
[4099 lines skipped]