[cells-cvs] CVS cells-gtk/root

ktilton ktilton at common-lisp.net
Tue Jan 29 00:00:33 UTC 2008


Update of /project/cells/cvsroot/cells-gtk/root
In directory clnet:/tmp/cvs-serv9292/root

Added Files:
	INSTALL.TXT asdf.lisp config.lisp 
Log Message:



--- /project/cells/cvsroot/cells-gtk/root/INSTALL.TXT	2008/01/29 00:00:29	NONE
+++ /project/cells/cvsroot/cells-gtk/root/INSTALL.TXT	2008/01/29 00:00:29	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.tar.gz?tarball=1&cvsroot=cells-gtk

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

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

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

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

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-gtk/root/asdf.lisp	2008/01/29 00:00:33	NONE
+++ /project/cells/cvsroot/cells-gtk/root/asdf.lisp	2008/01/29 00:00:33	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 at 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-gtk/root/config.lisp	2008/01/29 00:00:33	NONE
+++ /project/cells/cvsroot/cells-gtk/root/config.lisp	2008/01/29 00:00:33	1.1

[799 lines skipped]



More information about the Cells-cvs mailing list