Update of /project/cells/cvsroot/cells-gtk3 In directory clnet:/tmp/cvs-serv5005

Added Files: INSTALL.TXT asdf.lisp config.lisp Log Message: cells-gtk3 initial.

--- /project/cells/cvsroot/cells-gtk3/INSTALL.TXT 2008/04/13 10:59:16 NONE +++ /project/cells/cvsroot/cells-gtk3/INSTALL.TXT 2008/04/13 10:59:16 1.1

You don't need to read this file if you are installing from a snapshot tarball. This only concerns the situation where you get the pieces cells, hello-c, cells-gtk etc, individually.

############################################################################################################# The notes below apply to the UFFI port of Cells-gtk done by Ken Tilton. (Actually I have forked UFFI and call it Hello-C, but the idea is the same: portable FFI.)

For the original version by Vasilis Margioulas, which uses native CLisp FFI to good advantage, grab this:

http://common-lisp.net/cgi-bin/viewcvs.cgi/cells-gtk/clisp-cgtk/clisp-cgtk.t...

...and follow the INSTALL.TXT in that.

##############################################################################################################

Dependencies: Utils-kt: http://common-lisp.net/cgi-bin/viewcvs.cgi/cell-cultures/utils-kt/utils-kt.t... Hello-C: http://common-lisp.net/cgi-bin/viewcvs.cgi/cell-cultures/hello-c/hello-c.tar... Cells: http://common-lisp.net/cgi-bin/viewcvs.cgi/cell-cultures/cells/cells.tar.gz?...

On windows install Gtk: http://prdownloads.sourceforge.net/gimp-win/gtk%2B-2.4.10-20041001-setup.zip...

Add the gtk libs to your PATH variable:

Start>Settings>Control Panel>System>Advanced>Environment Variables>

Then select PATH and hit "Edit". Append to existing value:

"C:\Program Files\Common Files\GTK\2.0\bin"; ..prior values...

Edit load.lisp and follow the instructions there. No, you cannot just load it.

Note: On windows under emacs with slime, the gtk window does not popup. You must start the application from a dos prompt.

Tested on: Windows xp with gtk 2.4.10 and clisp 2.33, using AllegroCL 6.2 Enterprise and Lispworks 4.3 Personal

Known bugs: On Windows: Clisp crash 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-gtk3/asdf.lisp 2008/04/13 10:59:16 NONE +++ /project/cells/cvsroot/cells-gtk3/asdf.lisp 2008/04/13 10:59:16 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 ;; it to default in funky ways if not supplied (relative-pathname :initarg :pathname) (operation-times :initform (make-hash-table ) :accessor component-operation-times) ;; XXX we should provide some atomic interface for updating the ;; component properties (properties :accessor component-properties :initarg :properties :initform nil)))

;;;; methods: conditions

(defmethod print-object ((c missing-dependency) s) (format s "~@<~A, required by ~A~@:>" (call-next-method c nil) (missing-required-by c)))

(defun sysdef-error (format &rest arguments) (error 'formatted-system-definition-error :format-control format :format-arguments arguments))

;;;; methods: components

(defmethod print-object ((c missing-component) s) (format s "~@<component ~S not found~ ~@[ or does not match version ~A~]~ ~@[ in ~A~]~@:>" (missing-requires c) (missing-version c) (when (missing-parent c) (component-name (missing-parent c)))))

(defgeneric component-system (component) (:documentation "Find the top-level system containing COMPONENT"))

(defmethod component-system ((component component)) (aif (component-parent component) (component-system it) component))

(defmethod print-object ((c component) stream) (print-unreadable-object (c stream :type t :identity t) (ignore-errors (prin1 (component-name c) stream))))

(defclass module (component) ((components :initform nil :accessor module-components :initarg :components) ;; what to do if we can't satisfy a dependency of one of this module's ;; components. This allows a limited form of conditional processing (if-component-dep-fails :initform :fail :accessor module-if-component-dep-fails :initarg :if-component-dep-fails) (default-component-class :accessor module-default-component-class :initform 'cl-source-file :initarg :default-component-class)))

(defgeneric component-pathname (component) (:documentation "Extracts the pathname applicable for a particular component."))

(defun component-parent-pathname (component) (aif (component-parent component) (component-pathname it) *default-pathname-defaults*))

(defgeneric component-relative-pathname (component) (:documentation "Extracts the relative pathname applicable for a particular component."))

(defmethod component-relative-pathname ((component module)) (or (slot-value component 'relative-pathname) (make-pathname :directory `(:relative ,(component-name component)) :host (pathname-host (component-parent-pathname component)))))

(defmethod component-pathname ((component component)) (let ((*default-pathname-defaults* (component-parent-pathname component))) (merge-pathnames (component-relative-pathname component))))

(defgeneric component-property (component property))

(defmethod component-property ((c component) property) (cdr (assoc property (slot-value c 'properties) :test #'equal)))

(defgeneric (setf component-property) (new-value component property))

(defmethod (setf component-property) (new-value (c component) property) (let ((a (assoc property (slot-value c 'properties) :test #'equal))) (if a (setf (cdr a) new-value) (setf (slot-value c 'properties) (acons property new-value (slot-value c 'properties))))))

(defclass system (module) ((description :accessor system-description :initarg :description) (long-description :accessor system-long-description :initarg :long-description) (author :accessor system-author :initarg :author) (maintainer :accessor system-maintainer :initarg :maintainer) (licence :accessor system-licence :initarg :licence)))

;;; version-satisfies

;;; with apologies to christophe rhodes ... (defun split (string &optional max (ws '(#\Space #\Tab))) (flet ((is-ws (char) (find char ws))) (nreverse (let ((list nil) (start 0) (words 0) end) (loop (when (and max (>= words (1- max))) (return (cons (subseq string start) list))) (setf end (position-if #'is-ws string :start start)) (push (subseq string start end) list) (incf words) (unless end (return list)) (setf start (1+ end)))))))

(defgeneric version-satisfies (component version))

(defmethod version-satisfies ((c component) version) (unless (and version (slot-boundp c 'version)) (return-from version-satisfies t)) (let ((x (mapcar #'parse-integer (split (component-version c) nil '(#.)))) (y (mapcar #'parse-integer (split version nil '(#.))))) (labels ((bigger (x y) (cond ((not y) t) ((not x) nil) ((> (car x) (car y)) t) ((= (car x) (car y)) (bigger (cdr x) (cdr y)))))) (and (= (car x) (car y)) (or (not (cdr y)) (bigger (cdr x) (cdr y)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; finding systems

(defvar *defined-systems* (make-hash-table :test 'equal)) (defun coerce-name (name) (typecase name (component (component-name name)) (symbol (string-downcase (symbol-name name))) (string name) (t (sysdef-error "~@<invalid component designator ~A~@:>" name))))

;;; for the sake of keeping things reasonably neat, we adopt a ;;; convention that functions in this list are prefixed SYSDEF-

(defvar *system-definition-search-functions* '(sysdef-central-registry-search))

(defun system-definition-pathname (system) (some (lambda (x) (funcall x system)) *system-definition-search-functions*)) (defvar *central-registry* '(*default-pathname-defaults* #+nil "/home/dan/src/sourceforge/cclan/asdf/systems/" #+nil "telent:asdf;systems;"))

(defun sysdef-central-registry-search (system) (let ((name (coerce-name system))) (block nil (dolist (dir *central-registry*) (let* ((defaults (eval dir)) (file (and defaults (make-pathname :defaults defaults :version :newest :name name :type "asd" :case :local)))) (if (and file (probe-file file))

[755 lines skipped] --- /project/cells/cvsroot/cells-gtk3/config.lisp 2008/04/13 10:59:16 NONE +++ /project/cells/cvsroot/cells-gtk3/config.lisp 2008/04/13 10:59:16 1.1

[799 lines skipped]