bknr-cvs

Download

bknr-cvs@common-lisp.net

October 2007

1 participants
67 discussions

[bknr-cvs] r2243 - branches/bos/thirdparty/asdf
by bknr＠bknr.net 20 Oct '07

20 Oct '07

Author: hhubner Date: 2007-10-20 13:32:49 -0400 (Sat, 20 Oct 2007) New Revision: 2243 Modified: branches/bos/thirdparty/asdf/asdf.lisp Log: revert to older asdf on this branch as the current one does not play nice with cxml Modified: branches/bos/thirdparty/asdf/asdf.lisp =================================================================== --- branches/bos/thirdparty/asdf/asdf.lisp 2007-10-20 17:22:25 UTC (rev 2242) +++ branches/bos/thirdparty/asdf/asdf.lisp 2007-10-20 17:32:49 UTC (rev 2243) @@ -1,4 +1,4 @@ -;;; This is asdf: Another System Definition Facility. $Revision: 1.110 $ +;;; This is asdf: Another System Definition Facility. $Revision: 1.1 $ ;;; ;;; Feedback, bug reports, and patches are all welcome: please mail to ;;; <cclan-list(a)lists.sf.net>. But note first that the canonical @@ -13,7 +13,7 @@ ;;; is the latest development version, whereas the revision tagged ;;; RELEASE may be slightly older but is considered `stable' -;;; Copyright (c) 2001-2007 Daniel Barlow and contributors +;;; 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 @@ -78,10 +78,7 @@ #:system-author #:system-maintainer #:system-license - #:system-licence - #:system-source-file - #:system-relative-pathname - + #:operation-on-warnings #:operation-on-failure @@ -93,29 +90,24 @@ #:*asdf-revision* #:operation-error #:compile-failed #:compile-warned #:compile-error - #:error-component #:error-operation #:system-definition-error #:missing-component #:missing-dependency #:circular-dependency ; errors - #:duplicate-names - + #:retry #:accept ; restarts - #:preference-file-for-system/operation - #:load-preferences ) (: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.110 $") +(defvar *asdf-revision* (let* ((v "$Revision: 1.1 $") (colon (or (position #\: v) -1)) (dot (position #\. v))) (and v colon dot @@ -125,14 +117,10 @@ :junk-allowed t))))) (defvar *compile-file-warnings-behaviour* :warn) - (defvar *compile-file-failure-behaviour* #+sbcl :error #-sbcl :warn) (defvar *verbose-out* nil) -(defparameter +asdf-methods+ - '(perform explain output-files operation-done-p)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; utility stuff @@ -168,9 +156,6 @@ (define-condition circular-dependency (system-definition-error) ((components :initarg :components :reader circular-dependency-components))) -(define-condition duplicate-names (system-definition-error) - ((name :initarg :name :reader duplicate-names-name))) - (define-condition missing-component (system-definition-error) ((requires :initform "(unnamed)" :reader missing-requires :initarg :requires) (version :initform nil :reader missing-version :initarg :version) @@ -183,7 +168,7 @@ ((component :reader error-component :initarg :component) (operation :reader error-operation :initarg :operation)) (:report (lambda (c s) - (format s "~@<erred while invoking ~A on ~A~@:>" + (format s (formatter "~@<erred while invoking ~A on ~A~@:>") (error-operation c) (error-component c))))) (define-condition compile-error (operation-error) ()) (define-condition compile-failed (compile-error) ()) @@ -214,8 +199,9 @@ ;;;; methods: conditions (defmethod print-object ((c missing-dependency) s) - (format s "~@<~A, required by ~A~@:>" - (call-next-method c nil) (missing-required-by c))) + (format s (formatter "~@<~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)) @@ -223,9 +209,9 @@ ;;;; methods: components (defmethod print-object ((c missing-component) s) - (format s "~@<component ~S not found~ - ~@[ or does not match version ~A~]~ - ~@[ in ~A~]~@:>" + (format s (formatter "~@<component ~S not found~ + ~@[ or does not match version ~A~]~ + ~@[ in ~A~]~@:>") (missing-requires c) (missing-version c) (when (missing-parent c) @@ -295,8 +281,7 @@ :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 - :accessor system-license :initarg :license))) + (licence :accessor system-licence :initarg :licence))) ;;; version-satisfies @@ -341,7 +326,8 @@ (component (component-name name)) (symbol (string-downcase (symbol-name name))) (string name) - (t (sysdef-error "~@<invalid component designator ~A~@:>" name)))) + (t (sysdef-error (formatter "~@<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- @@ -370,14 +356,6 @@ (if (and file (probe-file file)) (return file))))))) -(defun make-temporary-package () - (flet ((try (counter) - (ignore-errors - (make-package (format nil "ASDF~D" counter) - :use '(:cl :asdf))))) - (do* ((counter 0 (+ counter 1)) - (package (try counter) (try counter))) - (package package)))) (defun find-system (name &optional (error-p t)) (let* ((name (coerce-name name)) @@ -386,18 +364,15 @@ (when (and on-disk (or (not in-memory) (< (car in-memory) (file-write-date on-disk)))) - (let ((package (make-temporary-package))) - (unwind-protect - (let ((*package* package)) - (format - *verbose-out* - "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%" - ;; FIXME: This wants to be (ENOUGH-NAMESTRING - ;; ON-DISK), but CMUCL barfs on that. + (let ((*package* (make-package (gensym (package-name #.*package*)) + :use '(:cl :asdf)))) + (format *verbose-out* + (formatter "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%") + ;; FIXME: This wants to be (ENOUGH-NAMESTRING + ;; ON-DISK), but CMUCL barfs on that. on-disk *package*) - (load on-disk)) - (delete-package package)))) + (load on-disk))) (let ((in-memory (gethash name *defined-systems*))) (if in-memory (progn (if on-disk (setf (car in-memory) (file-write-date on-disk))) @@ -405,7 +380,8 @@ (if error-p (error 'missing-component :requires name)))))) (defun register-system (name system) - (format *verbose-out* "~&~@<; ~@;registering ~A as ~A~@:>~%" system name) + (format *verbose-out* + (formatter "~&~@<; ~@;registering ~A as ~A~@:>~%") system name) (setf (gethash (coerce-name name) *defined-systems*) (cons (get-universal-time) system))) @@ -451,20 +427,17 @@ (defmethod source-file-type ((c static-file) (s module)) nil) (defmethod component-relative-pathname ((component source-file)) - (let ((relative-pathname (slot-value component 'relative-pathname))) - (if relative-pathname - (merge-pathnames - relative-pathname - (make-pathname - :type (source-file-type component (component-system component)))) - (let* ((*default-pathname-defaults* - (component-parent-pathname component)) - (name-type - (make-pathname - :name (component-name component) - :type (source-file-type component - (component-system component))))) - name-type)))) + (let* ((*default-pathname-defaults* (component-parent-pathname component)) + (name-type + (make-pathname + :name (component-name component) + :type (source-file-type component + (component-system component))))) + (if (slot-value component 'relative-pathname) + (merge-pathnames + (slot-value component 'relative-pathname) + name-type) + name-type))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; operations @@ -564,26 +537,8 @@ (member node (operation-visiting-nodes (operation-ancestor o)) :test 'equal))) -(defgeneric component-depends-on (operation component) - (:documentation - "Returns a list of dependencies needed by the component to perform - the operation. A dependency has one of the following forms: +(defgeneric component-depends-on (operation component)) - (<operation> <component>*), where <operation> is a class - designator and each <component> is a component - designator, which means that the component depends on - <operation> having been performed on each <component>; or - - (FEATURE <feature>), which means that the component depends - on <feature>'s presence in *FEATURES*. - - Methods specialized on subclasses of existing component types - should usually append the results of CALL-NEXT-METHOD to the - list.")) - -(defmethod component-depends-on ((op-spec symbol) (c component)) - (component-depends-on (make-instance op-spec) c)) - (defmethod component-depends-on ((o operation) (c component)) (cdr (assoc (class-name (class-of o)) (slot-value c 'in-order-to)))) @@ -612,40 +567,26 @@ (defmethod input-files ((operation operation) (c module)) nil) (defmethod operation-done-p ((o operation) (c component)) - (flet ((fwd-or-return-t (file) - ;; if FILE-WRITE-DATE returns NIL, it's possible that the - ;; user or some other agent has deleted an input file. If - ;; that's the case, well, that's not good, but as long as - ;; the operation is otherwise considered to be done we - ;; could continue and survive. - (let ((date (file-write-date file))) - (cond - (date) - (t - (warn "~@<Missing FILE-WRITE-DATE for ~S: treating ~ - operation ~S on component ~S as done.~@:>" - file o c) - (return-from operation-done-p t)))))) - (let ((out-files (output-files o c)) - (in-files (input-files o c))) - (cond ((and (not in-files) (not out-files)) - ;; arbitrary decision: an operation that uses nothing to - ;; produce nothing probably isn't doing much - t) - ((not out-files) - (let ((op-done - (gethash (type-of o) - (component-operation-times c)))) - (and op-done - (>= op-done - (apply #'max - (mapcar #'fwd-or-return-t in-files)))))) - ((not in-files) nil) - (t - (and - (every #'probe-file out-files) - (> (apply #'min (mapcar #'file-write-date out-files)) - (apply #'max (mapcar #'fwd-or-return-t in-files))))))))) + (let ((out-files (output-files o c)) + (in-files (input-files o c))) + (cond ((and (not in-files) (not out-files)) + ;; arbitrary decision: an operation that uses nothing to + ;; produce nothing probably isn't doing much + t) + ((not out-files) + (let ((op-done + (gethash (type-of o) + (component-operation-times c)))) + (and op-done + (>= op-done + (or (apply #'max + (mapcar #'file-write-date in-files)) 0))))) + ((not in-files) nil) + (t + (and + (every #'probe-file out-files) + (> (apply #'min (mapcar #'file-write-date out-files)) + (apply #'max (mapcar #'file-write-date in-files)) )))))) ;;; So you look at this code and think "why isn't it a bunch of ;;; methods". And the answer is, because standard method combination @@ -735,15 +676,16 @@ (defmethod perform ((operation operation) (c source-file)) (sysdef-error - "~@<required method PERFORM not implemented ~ - for operation ~A, component ~A~@:>" + (formatter "~@<required method PERFORM not implemented~ + for operation ~A, component ~A~@:>") (class-of operation) (class-of c))) (defmethod perform ((operation operation) (c module)) nil) (defmethod explain ((operation operation) (component component)) - (format *verbose-out* "~&;;; ~A on ~A~%" operation component)) + (format *verbose-out* "~&;;; ~A on ~A~%" + operation component)) ;;; compile-op @@ -759,39 +701,38 @@ (defmethod perform :after ((operation operation) (c component)) (setf (gethash (type-of operation) (component-operation-times c)) - (get-universal-time)) - (load-preferences c operation)) + (get-universal-time))) ;;; perform is required to check output-files to find out where to put ;;; its answers, in case it has been overridden for site policy (defmethod perform ((operation compile-op) (c cl-source-file)) - #-:broken-fasl-loader (let ((source-file (component-pathname c)) - (output-file (car (output-files operation c)))) + (output-file (car (output-files operation c)))) (multiple-value-bind (output warnings-p failure-p) - (compile-file source-file - :output-file output-file) + (compile-file source-file + :output-file output-file) ;(declare (ignore output)) (when warnings-p - (case (operation-on-warnings operation) - (:warn (warn - "~@<COMPILE-FILE warned while performing ~A on ~A.~@:>" - operation c)) - (:error (error 'compile-warned :component c :operation operation)) - (:ignore nil))) + (case (operation-on-warnings operation) + (:warn (warn + (formatter "~@<COMPILE-FILE warned while ~ + performing ~A on ~A.~@:>") + operation c)) + (:error (error 'compile-warned :component c :operation operation)) + (:ignore nil))) (when failure-p - (case (operation-on-failure operation) - (:warn (warn - "~@<COMPILE-FILE failed while performing ~A on ~A.~@:>" - operation c)) - (:error (error 'compile-failed :component c :operation operation)) - (:ignore nil))) + (case (operation-on-failure operation) + (:warn (warn + (formatter "~@<COMPILE-FILE failed while ~ + performing ~A on ~A.~@:>") + operation c)) + (:error (error 'compile-failed :component c :operation operation)) + (:ignore nil))) (unless output - (error 'compile-error :component c :operation operation))))) + (error 'compile-error :component c :operation operation))))) (defmethod output-files ((operation compile-op) (c cl-source-file)) - #-:broken-fasl-loader (list (compile-file-pathname (component-pathname c))) - #+:broken-fasl-loader (list (component-pathname c))) + (list (compile-file-pathname (component-pathname c)))) (defmethod perform ((operation compile-op) (c static-file)) nil) @@ -799,16 +740,10 @@ (defmethod output-files ((operation compile-op) (c static-file)) nil) -(defmethod input-files ((op compile-op) (c static-file)) - nil) - - ;;; load-op -(defclass basic-load-op (operation) ()) +(defclass load-op (operation) ()) -(defclass load-op (basic-load-op) ()) - (defmethod perform ((o load-op) (c cl-source-file)) (mapcar #'load (input-files o c))) @@ -826,7 +761,7 @@ ;;; load-source-op -(defclass load-source-op (basic-load-op) ()) +(defclass load-source-op (operation) ()) (defmethod perform ((o load-source-op) (c cl-source-file)) (let ((source (component-pathname c))) @@ -861,103 +796,46 @@ (defmethod perform ((operation test-op) (c component)) nil) -(defgeneric load-preferences (system operation) - (:documentation "Called to load system preferences after <perform operation system>. Typical uses are to set parameters that don't exist until after the system has been loaded.")) - -(defgeneric preference-file-for-system/operation (system operation) - (:documentation "Returns the pathname of the preference file for this system. Called by 'load-preferences to determine what file to load.")) - -(defmethod load-preferences ((s t) (operation t)) - ;; do nothing - (values)) - -(defmethod load-preferences ((s system) (operation basic-load-op)) - (let* ((*package* (find-package :common-lisp)) - (file (probe-file (preference-file-for-system/operation s operation)))) - (when file - (when *verbose-out* - (format *verbose-out* - "~&~@<; ~@;loading preferences for ~A/~(~A~) from ~A~@:>~%" - (component-name s) - (type-of operation) file)) - (load file)))) - -(defmethod preference-file-for-system/operation ((system t) (operation t)) - ;; cope with anything other than systems - (preference-file-for-system/operation (find-system system t) operation)) - -(defmethod preference-file-for-system/operation ((s system) (operation t)) - (let ((*default-pathname-defaults* - (make-pathname :name nil :type nil - :defaults *default-pathname-defaults*))) - (merge-pathnames - (make-pathname :name (component-name s) - :type "lisp" - :directory '(:relative ".asdf")) - (truename (user-homedir-pathname))))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; invoking operations -(defvar *operate-docstring* - "Operate does three things: - -1. It creates an instance of `operation-class` using any keyword parameters -as initargs. -2. It finds the asdf-system specified by `system` (possibly loading -it from disk). -3. It then calls `traverse` with the operation and system as arguments - -The traverse operation is wrapped in `with-compilation-unit` and error -handling code. If a `version` argument is supplied, then operate also -ensures that the system found satisfies it using the `version-satisfies` -method.") - -(defun operate (operation-class system &rest args &key (verbose t) version - &allow-other-keys) +(defun operate (operation-class system &rest args) (let* ((op (apply #'make-instance operation-class - :original-initargs args - args)) - (*verbose-out* (if verbose *standard-output* (make-broadcast-stream))) - (system (if (typep system 'component) system (find-system system)))) - (unless (version-satisfies system version) - (error 'missing-component :requires system :version version)) - (let ((steps (traverse op system))) - (with-compilation-unit () - (loop for (op . component) in steps do - (loop - (restart-case - (progn (perform op component) - (return)) - (retry () - :report - (lambda (s) - (format s "~@<Retry performing ~S on ~S.~@:>" - op component))) - (accept () - :report - (lambda (s) - (format s - "~@<Continue, treating ~S on ~S as ~ - having been successful.~@:>" - op component)) - (setf (gethash (type-of op) - (component-operation-times component)) - (get-universal-time)) - (return))))))))) + :original-initargs args args)) + (*verbose-out* + (if (getf args :verbose t) + *trace-output* + (make-broadcast-stream))) + (system (if (typep system 'component) system (find-system system))) + (steps (traverse op system))) + (with-compilation-unit () + (loop for (op . component) in steps do + (loop + (restart-case + (progn (perform op component) + (return)) + (retry () + :report + (lambda (s) + (format s + (formatter "~@<Retry performing ~S on ~S.~@:>") + op component))) + (accept () + :report + (lambda (s) + (format s + (formatter "~@<Continue, treating ~S on ~S as ~ + having been successful.~@:>") + op component)) + (setf (gethash (type-of op) + (component-operation-times component)) + (get-universal-time)) + (return)))))))) -(setf (documentation 'operate 'function) - *operate-docstring*) +(defun oos (&rest args) + "Alias of OPERATE function" + (apply #'operate args)) -(defun oos (operation-class system &rest args &key force (verbose t) version) - (declare (ignore force verbose version)) - (apply #'operate operation-class system args)) - -(setf (documentation 'oos 'function) - (format nil - "Short for _operate on system_ and an alias for the `operate` function. ~&~&~a" - *operate-docstring*)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; syntax @@ -993,30 +871,22 @@ :module (coerce-name ',name) :pathname (or ,pathname - (when *load-truename* - (pathname-sans-name+type - (resolve-symlinks *load-truename*))) + (pathname-sans-name+type + (resolve-symlinks *load-truename*)) *default-pathname-defaults*) ',component-options)))))) (defun class-for-type (parent type) - (let* ((extra-symbols (list (find-symbol (symbol-name type) *package*) - (find-symbol (symbol-name type) - (load-time-value - (package-name :asdf))))) - (class (dolist (symbol (if (keywordp type) - extra-symbols - (cons type extra-symbols))) - (when (and symbol - (find-class symbol nil) - (subtypep symbol 'component)) - (return (find-class symbol)))))) + (let ((class (find-class + (or (find-symbol (symbol-name type) *package*) + (find-symbol (symbol-name type) #.*package*)) nil))) (or class (and (eq type :file) (or (module-default-component-class parent) (find-class 'cl-source-file))) - (sysdef-error "~@<don't recognize component type ~A~@:>" type)))) + (sysdef-error (formatter "~@<don't recognize component type ~A~@:>") + type)))) (defun maybe-add-tree (tree op1 op2 c) "Add the node C at /OP1/OP2 in TREE, unless it's there already. @@ -1053,42 +923,27 @@ (defvar *serial-depends-on*) (defun parse-component-form (parent options) - (destructuring-bind (type name &rest rest &key ;; the following list of keywords is reproduced below in the ;; remove-keys form. important to keep them in sync components pathname default-component-class perform explain output-files operation-done-p - weakly-depends-on depends-on serial in-order-to ;; list ends &allow-other-keys) options - (declare (ignorable perform explain output-files operation-done-p)) - (check-component-input type name weakly-depends-on depends-on components in-order-to) - - (when (and parent - (find-component parent name) - ;; ignore the same object when rereading the defsystem - (not - (typep (find-component parent name) - (class-for-type parent type)))) - (error 'duplicate-names :name name)) - + (check-component-input type name depends-on components in-order-to) (let* ((other-args (remove-keys '(components pathname default-component-class perform explain output-files operation-done-p - weakly-depends-on depends-on serial in-order-to) rest)) (ret (or (find-component parent name) (make-instance (class-for-type parent type))))) - (when weakly-depends-on - (setf depends-on (append depends-on (remove-if (complement #'find-system) weakly-depends-on)))) (when (boundp '*serial-depends-on*) (setf depends-on - (concatenate 'list *serial-depends-on* depends-on))) + (concatenate 'list *serial-depends-on* depends-on))) (apply #'reinitialize-instance ret :name (coerce-name name) @@ -1106,19 +961,7 @@ for c = (parse-component-form ret c-form) collect c if serial - do (push (component-name c) *serial-depends-on*)))) - - ;; check for duplicate names - (let ((name-hash (make-hash-table :test #'equal))) - (loop for c in (module-components ret) - do - (if (gethash (component-name c) - name-hash) - (error 'duplicate-names - :name (component-name c)) - (setf (gethash (component-name c) - name-hash) - t))))) + do (push (component-name c) *serial-depends-on*))))) (setf (slot-value ret 'in-order-to) (union-of-dependencies @@ -1127,39 +970,28 @@ (load-op (load-op ,@depends-on)))) (slot-value ret 'do-first) `((compile-op (load-op ,@depends-on)))) - (%remove-component-inline-methods ret rest) - + (loop for (n v) in `((perform ,perform) (explain ,explain) + (output-files ,output-files) + (operation-done-p ,operation-done-p)) + do (map 'nil + ;; this is inefficient as most of the stored + ;; methods will not be for this particular gf n + ;; But this is hardly performance-critical + (lambda (m) (remove-method (symbol-function n) m)) + (component-inline-methods ret)) + when v + do (destructuring-bind (op qual (o c) &body body) v + (pushnew + (eval `(defmethod ,n ,qual ((,o ,op) (,c (eql ,ret))) + ,@body)) + (component-inline-methods ret)))) ret))) -(defun %remove-component-inline-methods (ret rest) - (loop for name in +asdf-methods+ - do (map 'nil - ;; this is inefficient as most of the stored - ;; methods will not be for this particular gf n - ;; But this is hardly performance-critical - (lambda (m) - (remove-method (symbol-function name) m)) - (component-inline-methods ret))) - ;; clear methods, then add the new ones - (setf (component-inline-methods ret) nil) - (loop for name in +asdf-methods+ - for v = (getf rest (intern (symbol-name name) :keyword)) - when v do - (destructuring-bind (op qual (o c) &body body) v - (pushnew - (eval `(defmethod ,name ,qual ((,o ,op) (,c (eql ,ret))) - ,@body)) - (component-inline-methods ret))))) - -(defun check-component-input (type name weakly-depends-on depends-on components in-order-to) +(defun check-component-input (type name depends-on components in-order-to) "A partial test of the values of a component." - (when weakly-depends-on (warn "We got one! XXXXX")) (unless (listp depends-on) (sysdef-error-component ":depends-on must be a list." type name depends-on)) - (unless (listp weakly-depends-on) - (sysdef-error-component ":weakly-depends-on must be a list." - type name weakly-depends-on)) (unless (listp components) (sysdef-error-component ":components must be NIL or a list of components." type name components)) @@ -1186,15 +1018,14 @@ (defun run-shell-command (control-string &rest args) "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and synchronously execute the result using a Bourne-compatible shell, with -output to *VERBOSE-OUT*. Returns the shell's exit code." +output to *verbose-out*. Returns the shell's exit code." (let ((command (apply #'format nil control-string args))) (format *verbose-out* "; $ ~A~%" command) #+sbcl - (sb-ext:process-exit-code + (sb-impl::process-exit-code (sb-ext:run-program - #+win32 "sh" #-win32 "/bin/sh" + "/bin/sh" (list "-c" command) - #+win32 #+win32 :search t :input nil :output *verbose-out*)) #+(or cmu scl) @@ -1222,9 +1053,8 @@ (ccl:run-program "/bin/sh" (list "-c" command) :input nil :output *verbose-out* :wait t))) - #+ecl ;; courtesy of Juan Jose Garcia Ripoll - (si:system command) - #-(or openmcl clisp lispworks allegro scl cmu sbcl ecl) + + #-(or openmcl clisp lispworks allegro scl cmu sbcl) (error "RUN-SHELL-PROGRAM not implemented for this Lisp") )) @@ -1236,29 +1066,7 @@ (defun hyperdoc (name doc-type) (hyperdocumentation (symbol-package name) name doc-type)) -(defun system-source-file (system-name) - (let ((system (asdf:find-system system-name))) - (make-pathname - :type "asd" - :name (asdf:component-name system) - :defaults (asdf:component-relative-pathname system)))) -(defun system-source-directory (system-name) - (make-pathname :name nil - :type nil - :defaults (system-source-file system-name))) - -(defun system-relative-pathname (system pathname &key name type) - (let ((directory (pathname-directory pathname))) - (when (eq (car directory) :absolute) - (setf (car directory) :relative)) - (merge-pathnames - (make-pathname :name (or name (pathname-name pathname)) - :type (or type (pathname-type pathname)) - :directory directory) - (system-source-directory system)))) - - (pushnew :asdf *features*) #+sbcl @@ -1276,24 +1084,14 @@ (asdf:operate 'asdf:load-op name) t)))) - (defun contrib-sysdef-search (system) - (let ((home (sb-ext:posix-getenv "SBCL_HOME"))) - (when home - (let* ((name (coerce-name system)) - (home (truename home)) - (contrib (merge-pathnames - (make-pathname :directory `(:relative ,name) - :name name - :type "asd" - :case :local - :version :newest) - home))) - (probe-file contrib))))) + (pushnew + '(merge-pathnames "systems/" + (truename (sb-ext:posix-getenv "SBCL_HOME"))) + *central-registry*) (pushnew - '(let ((home (sb-ext:posix-getenv "SBCL_HOME"))) - (when home - (merge-pathnames "site-systems/" (truename home)))) + '(merge-pathnames "site-systems/" + (truename (sb-ext:posix-getenv "SBCL_HOME"))) *central-registry*) (pushnew @@ -1301,8 +1099,6 @@ (user-homedir-pathname)) *central-registry*) - (pushnew 'module-provide-asdf sb-ext:*module-provider-functions*) - (pushnew 'contrib-sysdef-search *system-definition-search-functions*)) + (pushnew 'module-provide-asdf sb-ext:*module-provider-functions*)) (provide 'asdf) -

1 0

[bknr-cvs] r2242 - in branches/bos/bknr/src: . utils web
by bknr＠bknr.net 20 Oct '07

20 Oct '07

Author: hhubner Date: 2007-10-20 13:22:25 -0400 (Sat, 20 Oct 2007) New Revision: 2242 Modified: branches/bos/bknr/src/packages.lisp branches/bos/bknr/src/utils/utils.lisp branches/bos/bknr/src/web/templates.lisp Log: Template expander needed for new BOS version. Modified: branches/bos/bknr/src/packages.lisp =================================================================== --- branches/bos/bknr/src/packages.lisp 2007-10-20 09:40:58 UTC (rev 2241) +++ branches/bos/bknr/src/packages.lisp 2007-10-20 17:22:25 UTC (rev 2242) @@ -268,6 +268,7 @@ ;; templates #:expand-template + #:expand-variables #:get-template-var #:with-template-vars #:emit-template-node Modified: branches/bos/bknr/src/utils/utils.lisp =================================================================== --- branches/bos/bknr/src/utils/utils.lisp 2007-10-20 09:40:58 UTC (rev 2241) +++ branches/bos/bknr/src/utils/utils.lisp 2007-10-20 17:22:25 UTC (rev 2242) @@ -514,7 +514,7 @@ (with-open-file (s pathname :element-type '(unsigned-byte 8)) (let ((result (make-array (file-length s) :element-type '(unsigned-byte 8)))) - (read-sequence result s ) + (read-sequence result s) result))) (defun class-subclasses (class) Modified: branches/bos/bknr/src/web/templates.lisp =================================================================== --- branches/bos/bknr/src/web/templates.lisp 2007-10-20 09:40:58 UTC (rev 2241) +++ branches/bos/bknr/src/web/templates.lisp 2007-10-20 17:22:25 UTC (rev 2242) @@ -85,7 +85,7 @@ ,(intern (symbol-name var) :keyword))))) ,@body)) -(defun expand-variables (string) +(defun expand-variables (string lookup-variable) (if (find #\$ string) (regex-replace-all #?r"\$$([\*_-\w]+)$" string @@ -94,7 +94,7 @@ (let* ((var (make-keyword-from-string (subseq target-string (aref reg-starts 0) (aref reg-ends 0)))) - (val (get-template-var var))) + (val (funcall lookup-variable var))) (cond ((stringp val) val) ((null val) "") @@ -128,7 +128,7 @@ (defun emit-template-node (node) (if (stringp node) - (sax:characters *html-sink* (expand-variables node)) + (sax:characters *html-sink* (expand-variables node #'get-template-var)) (let* ((name (node-name node)) (ns (node-ns node)) (children (node-children node)) @@ -140,12 +140,12 @@ (apply (find-tag-function *template-expander* name ns) (append (loop for (key name) in (remove-if #'(lambda (attr) (scan "^xmlns" (car attr))) attrs) collect (make-keyword-from-string key) - collect (expand-variables name)) + collect (expand-variables name #'get-template-var)) (when children (list :children children))))) (t (sax:start-element *html-sink* nil nil name - (xmls-attributes-to-sax #'expand-variables attrs)) + (xmls-attributes-to-sax (lambda (var) (expand-variables var #'get-template-var)) attrs)) (dolist (child children) (emit-template-node child)) (sax:end-element *html-sink* nil nil name))))))

1 0

[bknr-cvs] r2241 - in branches/bos/projects/bos: m2 payment-website payment-website/templates/da payment-website/templates/de payment-website/templates/en worldpay-test
by bknr＠bknr.net 20 Oct '07

20 Oct '07

Author: hhubner Date: 2007-10-20 05:40:58 -0400 (Sat, 20 Oct 2007) New Revision: 2241 Added: branches/bos/projects/bos/payment-website/Manual-Regnskov (forside).doc branches/bos/projects/bos/payment-website/Manual_Regnskov.doc branches/bos/projects/bos/payment-website/templates/da/welcome-email.template branches/bos/projects/bos/payment-website/templates/de/welcome-email.template branches/bos/projects/bos/payment-website/templates/en/welcome-email.template Modified: branches/bos/projects/bos/m2/m2.lisp branches/bos/projects/bos/m2/mail-generator.lisp branches/bos/projects/bos/m2/packages.lisp branches/bos/projects/bos/payment-website/templates/da/contact.xml branches/bos/projects/bos/payment-website/templates/da/info-request.xml branches/bos/projects/bos/payment-website/templates/da/ueberweisung.xml branches/bos/projects/bos/payment-website/templates/de/ueberweisung.xml branches/bos/projects/bos/worldpay-test/allocation-area-handlers.lisp branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp branches/bos/projects/bos/worldpay-test/tags.lisp branches/bos/projects/bos/worldpay-test/worldpay-test.lisp Log: Store preferred language with sponsor. Send welcome email for "manual transfer" sponsors in correct language. Decide where to send sponsor data based on the country chosen during WorldPay payment. This way, swedish sponsors will be handled by the danish office. Website updates made by the danish office. Modified: branches/bos/projects/bos/m2/m2.lisp =================================================================== --- branches/bos/projects/bos/m2/m2.lisp 2007-10-14 20:28:22 UTC (rev 2240) +++ branches/bos/projects/bos/m2/m2.lisp 2007-10-20 09:40:58 UTC (rev 2241) @@ -112,15 +112,17 @@ ;;; SPONSOR-PASSWORD-ANSWER (sponsor) => string ;;; SPONSOR-INFO-TEXT (sponsor) => string ;;; SPONSOR-COUNTRY (sponsor) => string +;;; SPONSOR-LANGUAGE (sponsor) => string (preferred language) ;;; SPONSOR-CONTRACTS (sponsor) => list of contract ;;; ;;; Sowie Funktionen von USER. (define-persistent-class sponsor (user) - ((master-code :read :initform nil) - (info-text :update :initform nil) - (country :update :initform nil) - (contracts :update :initform nil)) + ((master-code :read :initform nil) + (info-text :update :initform nil) + (country :update :initform nil) + (contracts :update :initform nil) + (language :update :initform nil)) (:default-initargs :full-name nil :email nil)) (defmethod user-editable-p ((sponsor sponsor)) @@ -135,6 +137,13 @@ (deftransaction sponsor-set-country (sponsor newval) (setf (sponsor-country sponsor) newval)) +(deftransaction sponsor-set-language (sponsor newval) + (setf (sponsor-language sponsor) newval)) + +(defmethod sponsor-language :around ((sponsor sponsor)) + (or (call-next-method) + "en")) + (defvar *sponsor-counter* 0) (defun make-sponsor (&rest initargs &key login &allow-other-keys) Modified: branches/bos/projects/bos/m2/mail-generator.lisp =================================================================== --- branches/bos/projects/bos/m2/mail-generator.lisp 2007-10-14 20:28:22 UTC (rev 2240) +++ branches/bos/projects/bos/m2/mail-generator.lisp 2007-10-20 09:40:58 UTC (rev 2241) @@ -2,12 +2,16 @@ (enable-interpol-syntax) -(defvar *country->office-email* '(("DK" . "service(a)bosdanmark.dk"))) +(defvar *country->office-email* '(("DK" . "bosdanmark.regnskov(a)gmail.com") + ("SE" . "bosdanmark.regnskov(a)gmail.com"))) +(defun country->office-email (country) + (or (cdr (assoc country *country->office-email* :test #'string-equal)) + *office-mail-address*)) + (defun contract-office-email (contract) "Return the email address of the MXM office responsible for handling a contract" - (or (cdr (assoc (sponsor-country (contract-sponsor contract)) *country->office-email* :test #'string-equal)) - *office-mail-address*)) + (country->office-email (sponsor-country (contract-sponsor contract)))) (defun send-system-mail (&key (to *office-mail-address*) (subject "(no subject") (text "(no text)") (content-type "text/plain; charset=UTF-8") more-headers) (send-smtp "localhost" *mail-sender* to @@ -26,8 +30,9 @@ (not more-headers) text))) -(defun mail-info-request (email) +(defun mail-info-request (email country) (send-system-mail :subject "Mailing list request" + :to (country->office-email country) :text #?"Please enter into the mailing list: @@ -37,46 +42,35 @@ (defun mail-fiscal-certificate-to-office (contract name address country) (format t "mail-fiscal-certificate-to-office: ~a name: ~a address: ~a country: ~a~%" contract name address country)) -(defun mail-instructions-to-sponsor (contract email) - (let* ((sponsor (contract-sponsor contract)) - (sponsor-id (sponsor-id sponsor)) - (master-code (sponsor-master-code sponsor))) - (send-system-mail :to email - :subject "Willkommen zur Samboja Lestari Informations-Website" - :text #?"Sehr geehrte(r) Sponsor(in), +(defun mail-template-directory (language) + "Return the directory where the mail templates are stored" + (merge-pathnames (make-pathname :directory `(:relative "templates" ,(string-downcase language))) + (symbol-value (find-symbol "*WEBSITE-DIRECTORY*" "WORLDPAY-TEST")))) -wir haben Ihr Sponsoren-Profil fuer Sie eingerichtet. +(defun rest-of-file (file) + (let ((result (make-array (- (file-length file) + (file-position file)) + :element-type 'character))) + (read-sequence result file) + result)) -Ihre Sponsoren-ID lautet: $(sponsor-id) -Ihr Master-Code lautet: $(master-code) +(defun make-welcome-mail (sponsor) + "Return a plist containing the :subject and :text options to generate an email with send-system-mail" + (let ((vars (list :sponsor-id (sponsor-id sponsor) + :master-code (sponsor-master-code sponsor)))) + (labels + ((get-var (var-name) (getf vars var-name))) + (with-open-file (template (merge-pathnames #p"welcome-email.template" + (mail-template-directory (sponsor-language sponsor)))) + (let ((subject (expand-variables (read-line template) #'get-var)) + (text (expand-variables (rest-of-file template) #'get-var))) + (list :subject subject :text text)))))) -Besuchen Sie unsere Website http://create-rainforest.org/ regelmaessig, -um sich ein Bild darueber zu verschaffen, was auf \"Ihren\" Quadratmetern -passiert. +(defun mail-instructions-to-sponsor (contract email) + (apply #'send-system-mail + :to email + (make-welcome-mail (contract-sponsor contract)))) -Bedienungsanleitung: - -Mit Hilfe Ihrer Sponsoren-ID und Ihrem Kennwort oder auch Mastercode -koennen Sie sich auf der Webseite in Ihr persoenliches Profil einloggen -und \"Ihre\" Quadratmeter lokalisieren. -Die Zugangsdaten können in der linken unteren Ecke der Satellitenkarte unter -Sponsoren ID und Kennwort (oder Mastercode) eingegeben werden. -Sie gelangen in ihr Profil indem sie nach dem Eingeben der Daten das an -gleicher Stelle erscheinende \"Profil-Feld\" anklicken. -Es besteht zusaetzlich die Moeglichkeit für Sie, einen Grusstext zu -hinterlegen, -welcher fuer jeden Besucher dieser Webseite sichtbar wird, sofern dieser -Besucher auf Ihre Quadratmeter in dem Vergroesserungsfenster klickt. -Waehlen Sie in Ihrem Profil, ob Sie anonym bleiben wollen oder nicht. - -Wir wuenschen Ihnen viel Spass beim Lesen der Texte und betrachten der -Bilder vom immer groesser werdenden Regenwald in Samboja Lestari - Borneo! - -Nochmals danken wir Ihnen im Namen der Orang-Utans und Malaienbaeren, sowie -aller Waldbewohner und natuerlich der lokalen Bevoelkerung Indonesiens. - -Das Team von BOS Deutschland e.V."))) - (defun format-vcard (field-list) (with-output-to-string (s) (labels @@ -159,12 +153,12 @@ :content string)) (defparameter *common-element-names* - '(("MC_donationcert-yearly" "donationcert-yearly") - ("MC_sponsorid" "sponsor-id") - ("countryString" "country") - ("postcode" "plz") - ("MC_gift" "gift") - ("cartId" "contract-id"))) + '(("MC_donationcert-yearly" . "donationcert-yearly") + ("MC_sponsorid" . "sponsor-id") + ("countryString" . "country") + ("postcode" . "plz") + ("MC_gift" . "gift") + ("cartId" . "contract-id"))) (defun lookup-element-name (element-name) "Given an ELEMENT-NAME (which may be either a form field name or a name of a post parameter from @@ -180,9 +174,11 @@ :encoding :quoted-printable :content (format nil " <sponsor> + <date>~A</date> ~{<~A>~A</~A>~} </sponsor> " + (format-date-time (get-universal-time) :xml-style t) (apply #'append (mapcar #'(lambda (cons) (destructuring-bind (element-name . content) cons @@ -238,6 +234,8 @@ <tr><td>Name</td><td>~@[~A~]</td></tr> <tr><td>Adress</td><td>~@[~A~]</td></tr> <tr><td>Email</td><td>~@[~A~]</td></tr> + <tr><td>Country</td><td>~@[~A~]</td></tr> + <tr><td>Language</td><td>~@[~A~]</td></tr> </table> </body> </html>" @@ -245,7 +243,9 @@ numsqm name address - email)) + email + country + language)) (make-contract-xml-part (store-object-id contract) (all-request-params req)) (make-vcard-part (store-object-id contract) (make-vcard :sponsor-id (store-object-id (contract-sponsor contract)) Modified: branches/bos/projects/bos/m2/packages.lisp =================================================================== --- branches/bos/projects/bos/m2/packages.lisp 2007-10-14 20:28:22 UTC (rev 2240) +++ branches/bos/projects/bos/m2/packages.lisp 2007-10-20 09:40:58 UTC (rev 2241) @@ -85,11 +85,14 @@ #:sponsor-info-text #:sponsor-country #:sponsor-contracts + #:sponsor-id + #:sponsor-language #:sponsor-set-info-text #:sponsor-set-country - #:sponsor-id + #:sponsor-set-language #:country #:info-text + #:language #:editor-only-handler #:editor-p Added: branches/bos/projects/bos/payment-website/Manual-Regnskov (forside).doc =================================================================== (Binary files differ) Property changes on: branches/bos/projects/bos/payment-website/Manual-Regnskov (forside).doc ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/bos/projects/bos/payment-website/Manual_Regnskov.doc =================================================================== (Binary files differ) Property changes on: branches/bos/projects/bos/payment-website/Manual_Regnskov.doc ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Modified: branches/bos/projects/bos/payment-website/templates/da/contact.xml =================================================================== --- branches/bos/projects/bos/payment-website/templates/da/contact.xml 2007-10-14 20:28:22 UTC (rev 2240) +++ branches/bos/projects/bos/payment-website/templates/da/contact.xml 2007-10-20 09:40:58 UTC (rev 2241) @@ -27,8 +27,8 @@ Fax: 3537 3636<br></br><br></br> E-Mail: <img src="/images/pfeil_link_on.gif" width="10" height="9" alt=""></img> - <a href="mailto:bos@orangutang.dk" class="more"> - bos(a)orangutang.dk + <a href="mailto:regnskov@bosdanmark.dk" class="more"> + regnskov(a)bosdanmark.dk </a> <br></br><br></br><br></br><br></br><br></br><br></br> Vi besvarer alle henvendelser hurtigst muligt. Modified: branches/bos/projects/bos/payment-website/templates/da/info-request.xml =================================================================== --- branches/bos/projects/bos/payment-website/templates/da/info-request.xml 2007-10-14 20:28:22 UTC (rev 2240) +++ branches/bos/projects/bos/payment-website/templates/da/info-request.xml 2007-10-20 09:40:58 UTC (rev 2241) @@ -1,7 +1,7 @@ <?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" > <bknr:toplevel template="toplevel_extra" title="Regnskov i SAMBOJA LESTARI - Nyheder" xmlns="http://www.w3.org/1999/xhtml" xmlns:bknr="http://bknr.net" xmlns:bos="http://headcraft.de/bos"> - <bos:send-info-request email="$(email)"> + <bos:send-info-request email="$(email)" country="DK"> <p> <span class="headline"> Vi takker for din interesse. Modified: branches/bos/projects/bos/payment-website/templates/da/ueberweisung.xml =================================================================== --- branches/bos/projects/bos/payment-website/templates/da/ueberweisung.xml 2007-10-14 20:28:22 UTC (rev 2240) +++ branches/bos/projects/bos/payment-website/templates/da/ueberweisung.xml 2007-10-20 09:40:58 UTC (rev 2241) @@ -43,6 +43,7 @@ onsubmit="YY_checkform('mailtransfer','vorname','#q','0','Anuller venligst dette felt \'Fornavn\'.','name','#q','0','Anuller venligst dette felt \'Efternavn\'.','strasse','#q','0','Anuller venligst dette felt \'Gade/Nr.\'.','plz','#q','0','Anuller venligst dette felt \'Postnummer\'.','ort','#q','0','Anuller venligst dette felt \'Kommune\'.');return document.MM_returnValue"> <input type="hidden" name="country" value="DK" /> <input type="hidden" name="contract-id" value="$(contract-id)" /> + <input type="hidden" name="sponsor-id" value="$(sponsor-id)" /> <input type="hidden" name="amount" value="$(amount)" /> <input type="hidden" name="numsqm" value="$(numsqm)" /> <input type="hidden" name="gift" value="$(gift)" /> Added: branches/bos/projects/bos/payment-website/templates/da/welcome-email.template =================================================================== --- branches/bos/projects/bos/payment-website/templates/da/welcome-email.template 2007-10-14 20:28:22 UTC (rev 2240) +++ branches/bos/projects/bos/payment-website/templates/da/welcome-email.template 2007-10-20 09:40:58 UTC (rev 2241) @@ -0,0 +1,35 @@ +Velkommen til BOS Denmark +Kære sponsor + +Velkommen til BOS Danmark. Vi takker mange gange for din donation og +deltagelse i skovrejsningsprojektet i Samboja Lestari + +Følgende sponsorprofil er blevet oprettet til dig: + +Dit Sponsor ID: $(sponsor-id) +Din Masterkode: $(master-code) + + +Betjeningsvejledning + +Ved hjælp af dit sponsor-ID og masterkode kan du på websiden + +http://create-rainforest.org/ logge dig ind på din personlige profil +og lokalisere dine m2. Under "satellitkort" kan adgangsdata indføres i +nederste venstre hjørne ved sponsor ID og masterkodefeltet. Du når +dernæst til din profil ved at klikke på det fremkommende "profil". Du +har her mulighed for at vedlægge en hilsen, der vil være synlig for +alle de besøgende på web-siden, som klikker ind på dine m2 i +forstørrelsesvinduet, samt ligeledes mulighed for at hente dit +regnskovsdiplom ned i form af en pdf-fil. Vælg også i profilen, +hvorvidt du vil være anonym. + +Vi ønsker dig god fornøjelse med at læse om og se billeder fra et +stadigt voksende regnskovsområde i Samboja Lestari - Borneo! + +På vegne af orangutangerne og regnskovens øvrige dyr og planter samt +naturligvis den lokale indonesiske befolkning, takker vi endnu engang +for din donation. + + +BOS Danmark \ No newline at end of file Modified: branches/bos/projects/bos/payment-website/templates/de/ueberweisung.xml =================================================================== --- branches/bos/projects/bos/payment-website/templates/de/ueberweisung.xml 2007-10-14 20:28:22 UTC (rev 2240) +++ branches/bos/projects/bos/payment-website/templates/de/ueberweisung.xml 2007-10-20 09:40:58 UTC (rev 2241) @@ -42,6 +42,7 @@ id="mailtransfer" onsubmit="YY_checkform('mailtransfer','vorname','#q','0','Bitte das Feld \'Vorname\' ausfuellen.','name','#q','0','Bitte das Feld \'Name\' ausfuellen.','strasse','#q','0','Bitte das Feld \'Strasse\' ausfuellen.','plz','#q','0','Bitte das Feld \'PLZ\' ausfuellen.','ort','#q','0','Bitte das Feld \'Ort\' ausfuellen.');return document.MM_returnValue"> <input type="hidden" name="contract-id" value="$(contract-id)" /> + <input type="hidden" name="sponsor-id" value="$(sponsor-id)" /> <input type="hidden" name="amount" value="$(amount)" /> <input type="hidden" name="numsqm" value="$(numsqm)" /> <input type="hidden" name="gift" value="$(gift)" /> Added: branches/bos/projects/bos/payment-website/templates/de/welcome-email.template =================================================================== --- branches/bos/projects/bos/payment-website/templates/de/welcome-email.template 2007-10-14 20:28:22 UTC (rev 2240) +++ branches/bos/projects/bos/payment-website/templates/de/welcome-email.template 2007-10-20 09:40:58 UTC (rev 2241) @@ -0,0 +1,33 @@ +Willkommen zur Samboja Lestari Informations-Website +Sehr geehrte(r) Sponsor(in), + +wir haben Ihr Sponsoren-Profil fuer Sie eingerichtet. + +Ihre Sponsoren-ID lautet: $(sponsor-id) +Ihr Master-Code lautet: $(master-code) + +Besuchen Sie unsere Website http://create-rainforest.org/ regelmäßig, +um sich ein Bild darüber zu verschaffen, was auf "Ihren" Quadratmetern +passiert. + +Bedienungsanleitung: + +Mit Hilfe Ihrer Sponsoren-ID und Ihrem Kennwort oder auch Mastercode +können Sie sich auf der Webseite in Ihr persönliches Profil +einloggen und "Ihre" Quadratmeter lokalisieren. Die Zugangsdaten +können in der linken unteren Ecke der Satellitenkarte unter Sponsoren +ID und Kennwort (oder Mastercode) eingegeben werden. Sie gelangen in +ihr Profil indem sie nach dem Eingeben der Daten das an gleicher +Stelle erscheinende "Profil-Feld" anklicken. Es besteht zusätzlich +die Möglichkeit für Sie, einen Grußtext zu hinterlegen, welcher für +jeden Besucher dieser Webseite sichtbar wird, sofern dieser Besucher +auf Ihre Quadratmeter in dem Vergrößerungsfenster klickt. Wählen +Sie in Ihrem Profil, ob Sie anonym bleiben wollen oder nicht. + +Wir wünschen Ihnen viel Spaß beim Lesen der Texte und betrachten der +Bilder vom immer größer werdenden Regenwald in Samboja Lestari - Borneo! + +Nochmals danken wir Ihnen im Namen der Orang-Utans und Malaienbären, sowie +aller Waldbewohner und natürlich der lokalen Bevölkerung Indonesiens. + +Das Team von BOS Deutschland e.V. Added: branches/bos/projects/bos/payment-website/templates/en/welcome-email.template =================================================================== --- branches/bos/projects/bos/payment-website/templates/en/welcome-email.template 2007-10-14 20:28:22 UTC (rev 2240) +++ branches/bos/projects/bos/payment-website/templates/en/welcome-email.template 2007-10-20 09:40:58 UTC (rev 2241) @@ -0,0 +1,33 @@ +Willkommen zur Samboja Lestari Informations-Website +Sehr geehrte(r) Sponsor(in), + +wir haben Ihr Sponsoren-Profil fuer Sie eingerichtet. + +Ihre Sponsoren-ID lautet: $(sponsor-id) +Ihr Master-Code lautet: $(master-code) + +Besuchen Sie unsere Website http://create-rainforest.org/ regelmäßig, +um sich ein Bild darüber zu verschaffen, was auf "Ihren" Quadratmetern +passiert. + +Bedienungsanleitung: + +Mit Hilfe Ihrer Sponsoren-ID und Ihrem Kennwort oder auch Mastercode +können Sie sich auf der Webseite in Ihr persönliches Profil +einloggen und "Ihre" Quadratmeter lokalisieren. Die Zugangsdaten +können in der linken unteren Ecke der Satellitenkarte unter Sponsoren +ID und Kennwort (oder Mastercode) eingegeben werden. Sie gelangen in +ihr Profil indem sie nach dem Eingeben der Daten das an gleicher +Stelle erscheinende "Profil-Feld" anklicken. Es besteht zusätzlich +die Möglichkeit für Sie, einen Grußtext zu hinterlegen, welcher für +jeden Besucher dieser Webseite sichtbar wird, sofern dieser Besucher +auf Ihre Quadratmeter in dem Vergrößerungsfenster klickt. Wählen +Sie in Ihrem Profil, ob Sie anonym bleiben wollen oder nicht. + +Wir wünschen Ihnen viel Spaß beim Lesen der Texte und betrachten der +Bilder vom immer größer werdenden Regenwald in Samboja Lestari - Borneo! + +Nochmals danken wir Ihnen im Namen der Orang-Utans und Malaienbären, sowie +aller Waldbewohner und natürlich der lokalen Bevölkerung Indonesiens. + +Das Team von BOS Deutschland e.V. Modified: branches/bos/projects/bos/worldpay-test/allocation-area-handlers.lisp =================================================================== --- branches/bos/projects/bos/worldpay-test/allocation-area-handlers.lisp 2007-10-14 20:28:22 UTC (rev 2240) +++ branches/bos/projects/bos/worldpay-test/allocation-area-handlers.lisp 2007-10-20 09:40:58 UTC (rev 2241) @@ -230,7 +230,7 @@ (defun parse-point (line) (destructuring-bind (x y) (read-from-string (format nil "(~A)" line)) (cons (scale-coordinate 'x +nw-utm-x+ x) - (scale-coordinate 'y +nw-utm-y+ y)))) + (scale-coordinate 'y +nw-utm-y+ (- y +width+))))) (defun polygon-from-text-file (filename) (coerce (with-open-file (input-file filename) Modified: branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp =================================================================== --- branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp 2007-10-14 20:28:22 UTC (rev 2240) +++ branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp 2007-10-20 09:40:58 UTC (rev 2241) @@ -19,6 +19,23 @@ (contract (contract-sponsor object)) (otherwise nil)))) +(defmethod language-selector ((language string)) + (html + ((:select :name "language") + (loop + for (language-symbol language-name) in (website-languages) + do (if (string-equal language-symbol language) + (html ((:option :value language-symbol :selected "selected") + (:princ-safe language-name))) + (html ((:option :value language-symbol) + (:princ-safe language-name)))))))) + +(defmethod language-selector ((sponsor sponsor)) + (language-selector (sponsor-language sponsor))) + +(defmethod language-selector ((contract contract)) + (language-selector (contract-sponsor contract))) + (defmethod handle-object-form ((handler edit-sponsor-handler) action (sponsor (eql nil)) req) (with-query-params (req id key count) (when id @@ -76,11 +93,8 @@ (:td (text-field "country" :size 2 :value "DE"))) (:tr (:td "Email-Address") (:td (text-field "email" :size 40))) - (:tr (:td "Language for certificate") - (:td ((:select :name "language") - (loop - for (language-symbol language-name) in (website-languages) - do (html ((:option :value language-symbol) (:princ-safe language-name))))))) + (:tr (:td "Language for communication and certificate") + (:td (language-selector "en"))) (:tr (:td "Name for certificate") (:td (text-field "name" :size 20))) (:tr (:td "Postal address for certificate") @@ -94,7 +108,7 @@ (defmethod handle-object-form ((handler edit-sponsor-handler) (action (eql :create)) (sponsor (eql nil)) req) (with-query-params (req numsqm country email name address date language) - (let* ((sponsor (make-sponsor :email email :country country)) + (let* ((sponsor (make-sponsor :email email :country country :language language)) (contract (make-contract sponsor (parse-integer numsqm) :paidp (format nil "~A: manually created by ~A" (format-date-time (get-universal-time)) @@ -128,6 +142,8 @@ (:td (text-field "country" :value (sponsor-country sponsor) :size 2))) + (:tr (:td "language") + (:td (language-selector sponsor))) (:tr (:td "info-text") (:td (textarea-field "info-text" :value (sponsor-info-text sponsor) @@ -159,7 +175,7 @@ (defmethod handle-object-form ((handler edit-sponsor-handler) (action (eql :save)) sponsor req) (let (changed) (with-bos-cms-page (req :title "Saving sponsor data") - (dolist (field-name '(full-name email password country info-text)) + (dolist (field-name '(full-name email password country language info-text)) (let ((field-value (query-param req (string-downcase (symbol-name field-name))))) (when (and field-value (not (equal field-value (slot-value sponsor field-name)))) @@ -208,16 +224,13 @@ (:tr (:td "Country code (2 chars)") (:td (text-field "country" :size 2 :value "DE"))) (:tr (:td "Language") - (:td ((:select :name "language") - (loop - for (language-symbol language-name) in (website-languages) - do (html ((:option :value language-symbol) (:princ-safe language-name))))))) + (:td (:princ-safe (sponsor-language (contract-sponsor contract))))) (:tr (:td "Email-Address") (:td (text-field "email" :size 20 :value email))) (:tr (:td (submit-button "process" "process" :formcheck "javascript:return check_complete_sale()"))))))))))) (defmethod handle-object-form ((handler complete-transfer-handler) (action (eql :process)) contract req) - (with-query-params (req email country language) + (with-query-params (req email country) (with-bos-cms-page (req :title "Square meter sale completion") (if (contract-paidp contract) (html (:h2 "This sale has already been completed")) @@ -298,10 +311,7 @@ (:tr (:td "Name") (:td (text-field "name" :size 40))) (:tr (:td "Language") - (:td ((:select :name "language") - (loop - for (language-symbol language-name) in (website-languages) - do (html ((:option :value language-symbol) (:princ-safe language-name))))))) + (:td (language-selector contract))) (unless (contract-download-only-p contract) (html (:tr (:td "Address") Modified: branches/bos/projects/bos/worldpay-test/tags.lisp =================================================================== --- branches/bos/projects/bos/worldpay-test/tags.lisp 2007-10-14 20:28:22 UTC (rev 2240) +++ branches/bos/projects/bos/worldpay-test/tags.lisp 2007-10-20 09:40:58 UTC (rev 2241) @@ -71,14 +71,14 @@ (manual-transfer (or (scan #?r"rweisen" action) (scan #?r"rweisung" action) (scan #?r"verf" action))) - (sponsor (make-sponsor)) + (language (session-variable :language)) + (sponsor (make-sponsor :language language)) (contract (make-contract sponsor numsqm :download-only download-only :expires (+ (if manual-transfer bos.m2::*manual-contract-expiry-time* bos.m2::*online-contract-expiry-time*) - (get-universal-time)))) - (language (session-variable :language))) + (get-universal-time))))) (destructuring-bind (price currency) (case (make-keyword-from-string language) (:da (list (* numsqm 24) "DKK")) @@ -135,8 +135,8 @@ (when (some #'contract-pdf-pathname (sponsor-contracts sponsor)) (mapc #'emit-template-node children)))) -(define-bknr-tag send-info-request (&key children email) - (mail-info-request email) +(define-bknr-tag send-info-request (&key children email country) + (mail-info-request email (or country "DE")) (mapc #'emit-template-node children)) (define-bknr-tag save-profile (&key children) Modified: branches/bos/projects/bos/worldpay-test/worldpay-test.lisp =================================================================== --- branches/bos/projects/bos/worldpay-test/worldpay-test.lisp 2007-10-14 20:28:22 UTC (rev 2240) +++ branches/bos/projects/bos/worldpay-test/worldpay-test.lisp 2007-10-20 09:40:58 UTC (rev 2241) @@ -29,6 +29,7 @@ (setf lang *default-language*)) (bos.m2::remember-worldpay-params cartId (all-request-params request)) (let ((contract (get-contract (parse-integer cartId)))) + (sponsor-set-language (contract-sponsor contract) lang) (cond ((not (typep contract 'contract)) (user-error "Error: Invalid transaction ID."))

1 0

[bknr-cvs] r2240 - in branches/trunk-reorg/projects/scrabble: src website
by bknr＠bknr.net 14 Oct '07

14 Oct '07

Author: hhubner Date: 2007-10-14 16:28:22 -0400 (Sun, 14 Oct 2007) New Revision: 2240 Modified: branches/trunk-reorg/projects/scrabble/src/game.lisp branches/trunk-reorg/projects/scrabble/src/web.lisp branches/trunk-reorg/projects/scrabble/website/scrabble.css branches/trunk-reorg/projects/scrabble/website/scrabble.html branches/trunk-reorg/projects/scrabble/website/scrabble.js Log: tweak json output so that letters of the logged-on user are transmitted, other player's trays are reported as counts only. add html/css to display other player trays and score. Modified: branches/trunk-reorg/projects/scrabble/src/game.lisp =================================================================== --- branches/trunk-reorg/projects/scrabble/src/game.lisp 2007-10-14 19:27:25 UTC (rev 2239) +++ branches/trunk-reorg/projects/scrabble/src/game.lisp 2007-10-14 20:28:22 UTC (rev 2240) @@ -29,7 +29,7 @@ (define-condition no-tiles-remaining (simple-error) ()) -(defmethod draw-tile ((tile-bag tile-bag)) +(deftransaction draw-tile (tile-bag) (unless (plusp (remaining-tile-count tile-bag)) (error 'no-tiles-remaining)) (with-slots (tiles) tile-bag Modified: branches/trunk-reorg/projects/scrabble/src/web.lisp =================================================================== --- branches/trunk-reorg/projects/scrabble/src/web.lisp 2007-10-14 19:27:25 UTC (rev 2239) +++ branches/trunk-reorg/projects/scrabble/src/web.lisp 2007-10-14 20:28:22 UTC (rev 2240) @@ -37,8 +37,13 @@ (princ #\] stream)) (defmethod encode-json ((participant participant) stream) - (encode-json-alist (list :name (user-full-name (player-of participant)) - :remaining-tiles (length (tray-of participant))) + (start-session) + (encode-json-alist (append (list :name (user-full-name (player-of participant)) + :remaining-tiles) + (list (if (equal (user-login (player-of participant)) + (session-value :user)) + (tray-of participant) + (length (tray-of participant))))) stream)) (define-easy-handler (login :uri "/login" :default-request-type :post) Modified: branches/trunk-reorg/projects/scrabble/website/scrabble.css =================================================================== --- branches/trunk-reorg/projects/scrabble/website/scrabble.css 2007-10-14 19:27:25 UTC (rev 2239) +++ branches/trunk-reorg/projects/scrabble/website/scrabble.css 2007-10-14 20:28:22 UTC (rev 2240) @@ -1,4 +1,4 @@ -body { background-color: #004B36 } +body { background-color: #004B36; color: #ffffff; font-family: sans-serif } #playfield { position: absolute } #playfield div { position: absolute; width: 40px; height: 40px } #playfield img { position: absolute; top: 3px; left: 3px } @@ -234,3 +234,43 @@ #playfield #my-tray-4 { left: 346; top: 665 } #playfield #my-tray-5 { left: 384; top: 665 } #playfield #my-tray-6 { left: 422; top: 665 } +#playfield #their-name-0 { left: 670; top: 0 } +#playfield #their-score-0 { left: 887; top: 0; text-align: right } +#playfield #their-tray-0-0 { left: 665; top: 22 } +#playfield #their-tray-0-1 { left: 703; top: 22 } +#playfield #their-tray-0-2 { left: 741; top: 22 } +#playfield #their-tray-0-3 { left: 779; top: 22 } +#playfield #their-tray-0-4 { left: 817; top: 22 } +#playfield #their-tray-0-5 { left: 855; top: 22 } +#playfield #their-tray-0-6 { left: 893; top: 22 } + +#playfield #their-name-1 { left: 670; top: 66 } +#playfield #their-score-1 { left: 887; top: 66; text-align: right } +#playfield #their-tray-1-0 { left: 665; top: 88 } +#playfield #their-tray-1-1 { left: 703; top: 88 } +#playfield #their-tray-1-2 { left: 741; top: 88 } +#playfield #their-tray-1-3 { left: 779; top: 88 } +#playfield #their-tray-1-4 { left: 817; top: 88 } +#playfield #their-tray-1-5 { left: 855; top: 88 } +#playfield #their-tray-1-6 { left: 893; top: 88 } + +#playfield #their-name-2 { left: 670; top: 132 } +#playfield #their-score-2 { left: 887; top: 132; text-align: right } +#playfield #their-tray-2-0 { left: 665; top: 154 } +#playfield #their-tray-2-1 { left: 703; top: 154 } +#playfield #their-tray-2-2 { left: 741; top: 154 } +#playfield #their-tray-2-3 { left: 779; top: 154 } +#playfield #their-tray-2-4 { left: 817; top: 154 } +#playfield #their-tray-2-5 { left: 855; top: 154 } +#playfield #their-tray-2-6 { left: 893; top: 154 } + +#playfield #their-name-3 { left: 670; top: 198 } +#playfield #their-score-3 { left: 887; top: 198; text-align: right } +#playfield #their-tray-3-0 { left: 665; top: 220 } +#playfield #their-tray-3-1 { left: 703; top: 220 } +#playfield #their-tray-3-2 { left: 741; top: 220 } +#playfield #their-tray-3-3 { left: 779; top: 220 } +#playfield #their-tray-3-4 { left: 817; top: 220 } +#playfield #their-tray-3-5 { left: 855; top: 220 } +#playfield #their-tray-3-6 { left: 893; top: 220 } + Modified: branches/trunk-reorg/projects/scrabble/website/scrabble.html =================================================================== --- branches/trunk-reorg/projects/scrabble/website/scrabble.html 2007-10-14 19:27:25 UTC (rev 2239) +++ branches/trunk-reorg/projects/scrabble/website/scrabble.html 2007-10-14 20:28:22 UTC (rev 2240) @@ -238,6 +238,42 @@ <div id='my-tray-4'></div> <div id='my-tray-5'></div> <div id='my-tray-6'></div> + <div id='their-name-0'>Horst</div> + <div id='their-score-0'>192</div> + <div id='their-tray-0-0'><img src="images/NIL.png"/></div> + <div id='their-tray-0-1'><img src="images/NIL.png"/></div> + <div id='their-tray-0-2'><img src="images/NIL.png"/></div> + <div id='their-tray-0-3'><img src="images/NIL.png"/></div> + <div id='their-tray-0-4'><img src="images/NIL.png"/></div> + <div id='their-tray-0-5'><img src="images/NIL.png"/></div> + <div id='their-tray-0-6'><img src="images/NIL.png"/></div> + <div id='their-name-1'>Vladimir</div> + <div id='their-score-1'>188</div> + <div id='their-tray-1-0'><img src="images/NIL.png"/></div> + <div id='their-tray-1-1'><img src="images/NIL.png"/></div> + <div id='their-tray-1-2'><img src="images/NIL.png"/></div> + <div id='their-tray-1-3'><img src="images/NIL.png"/></div> + <div id='their-tray-1-4'><img src="images/NIL.png"/></div> + <div id='their-tray-1-5'><img src="images/NIL.png"/></div> + <div id='their-tray-1-6'><img src="images/NIL.png"/></div> + <div id='their-name-2'>Klarabella</div> + <div id='their-score-2'>190</div> + <div id='their-tray-2-0'><img src="images/NIL.png"/></div> + <div id='their-tray-2-1'><img src="images/NIL.png"/></div> + <div id='their-tray-2-2'><img src="images/NIL.png"/></div> + <div id='their-tray-2-3'><img src="images/NIL.png"/></div> + <div id='their-tray-2-4'><img src="images/NIL.png"/></div> + <div id='their-tray-2-5'><img src="images/NIL.png"/></div> + <div id='their-tray-2-6'><img src="images/NIL.png"/></div> + <div id='their-name-3'>Heidi</div> + <div id='their-score-3'>210</div> + <div id='their-tray-3-0'><img src="images/NIL.png"/></div> + <div id='their-tray-3-1'><img src="images/NIL.png"/></div> + <div id='their-tray-3-2'><img src="images/NIL.png"/></div> + <div id='their-tray-3-3'><img src="images/NIL.png"/></div> + <div id='their-tray-3-4'><img src="images/NIL.png"/></div> + <div id='their-tray-3-5'><img src="images/NIL.png"/></div> + <div id='their-tray-3-6'><img src="images/NIL.png"/></div> </div> </body> </html> \ No newline at end of file Modified: branches/trunk-reorg/projects/scrabble/website/scrabble.js =================================================================== --- branches/trunk-reorg/projects/scrabble/website/scrabble.js 2007-10-14 19:27:25 UTC (rev 2239) +++ branches/trunk-reorg/projects/scrabble/website/scrabble.js 2007-10-14 20:28:22 UTC (rev 2240) @@ -8,6 +8,13 @@ $('my-tray-' + n).innerHTML = letter ? '<img src="images/' + letter + '.png"/>' : ''; } +function setTheirTray(count, name, letterCount) { + $('their-name-' + count).innerHTML = name; + for (var i = 0; i < 7; i++) { + $('their-tray-' + count + '-' + i).style.visibility = (i < letterCount) ? 'visible' : 'hidden'; + } +} + function drawGameState (gameState) { for (var i = 0; i < gameState.board.length; i++) { var x = gameState.board[i][0]; @@ -26,13 +33,6 @@ for (var i = 0; i < 7; i++) { $('my-tray-' + i).onclick = trayClick; } - setMyTray(0, 'A'); - setMyTray(1, 'B'); - setMyTray(2, 'C'); - setMyTray(3, 'D'); - setMyTray(4, 'E'); - setMyTray(5, 'F'); - setMyTray(6, 'G'); var d = loadJSONDoc("/game/108"); d.addCallbacks(drawGameState, alert); }

1 0

[bknr-cvs] r2239 - branches/trunk-reorg/projects/scrabble/src
by bknr＠bknr.net 14 Oct '07

14 Oct '07

Author: hhubner Date: 2007-10-14 15:27:25 -0400 (Sun, 14 Oct 2007) New Revision: 2239 Modified: branches/trunk-reorg/projects/scrabble/src/load.lisp Log: Modified: branches/trunk-reorg/projects/scrabble/src/load.lisp =================================================================== --- branches/trunk-reorg/projects/scrabble/src/load.lisp 2007-10-14 19:26:19 UTC (rev 2238) +++ branches/trunk-reorg/projects/scrabble/src/load.lisp 2007-10-14 19:27:25 UTC (rev 2239) @@ -1,5 +1,4 @@ (in-package :cl-user) -(load (merge-pathnames #p"../thirdparty/asdf.lisp" *load-truename*)) -(load (merge-pathnames #p"setup-registry.lisp" *load-truename*)) \ No newline at end of file +(load (merge-pathnames #p"setup-registry.lisp" *load-truename*))

1 0

[bknr-cvs] r2238 - branches/trunk-reorg/bknr/web/src
by bknr＠bknr.net 14 Oct '07

14 Oct '07

Author: hhubner Date: 2007-10-14 15:26:19 -0400 (Sun, 14 Oct 2007) New Revision: 2238 Modified: branches/trunk-reorg/bknr/web/src/packages.lisp Log: remove bogus symbols OpenMCL refused to compile Modified: branches/trunk-reorg/bknr/web/src/packages.lisp =================================================================== --- branches/trunk-reorg/bknr/web/src/packages.lisp 2007-10-14 19:25:01 UTC (rev 2237) +++ branches/trunk-reorg/bknr/web/src/packages.lisp 2007-10-14 19:26:19 UTC (rev 2238) @@ -210,7 +210,7 @@ #:web-server-error-event-error #:all-web-server-error-events - #:;; web-utils + ;; web-utils #:*upload-file-size-limit* #:all-request-params #:request-uploaded-files @@ -300,7 +300,7 @@ #:bknr-authorizer #:find-user-from-request-parameters - #: + #:handle #:object-handler #:edit-object-handler

1 0

[bknr-cvs] r2237 - branches/trunk-reorg/bknr/datastore/src/utils
by bknr＠bknr.net 14 Oct '07

14 Oct '07

Author: hhubner Date: 2007-10-14 15:25:01 -0400 (Sun, 14 Oct 2007) New Revision: 2237 Modified: branches/trunk-reorg/bknr/datastore/src/utils/acl-mp-compat.lisp Log: OpenMCL locking primitives Modified: branches/trunk-reorg/bknr/datastore/src/utils/acl-mp-compat.lisp =================================================================== --- branches/trunk-reorg/bknr/datastore/src/utils/acl-mp-compat.lisp 2007-10-14 19:13:17 UTC (rev 2236) +++ branches/trunk-reorg/bknr/datastore/src/utils/acl-mp-compat.lisp 2007-10-14 19:25:01 UTC (rev 2237) @@ -1,12 +1,17 @@ (in-package :bknr.utils) +#+(not (or allegro sbcl cmu openmcl)) +(error "missing port for this compiler, please provide for locking primitives for this compiler in ~A" *load-pathname*) + (defun mp-make-lock (&optional (name "Anonymous")) #+allegro (mp:make-process-lock :name name) #+sbcl (sb-thread:make-mutex :name name) #+cmu - (mp:make-lock name)) + (mp:make-lock name) + #+openmcl + (ccl:make-lock name)) (defmacro mp-with-lock-held ((lock) &rest body) #+allegro @@ -17,6 +22,9 @@ ,@body) #+cmu `(mp:with-lock-held (,lock) + ,@body) + #+openmcl + `(ccl:with-lock-grabbed (,lock) ,@body)) (defmacro mp-with-recursive-lock-held ((lock) &rest body) @@ -28,4 +36,7 @@ ,@body) #+cmu `(mp:with-lock-held (,lock) + ,@body) + #+openmcl + `(ccl:with-lock-grabbed (,lock) ,@body))

1 0

[bknr-cvs] r2236 - in branches/trunk-reorg/thirdparty: . asdf asdf/CVS asdf/debian asdf/debian/CVS asdf/test asdf/test/CVS
by bknr＠bknr.net 14 Oct '07

14 Oct '07

Author: hhubner Date: 2007-10-14 15:13:17 -0400 (Sun, 14 Oct 2007) New Revision: 2236 Added: branches/trunk-reorg/thirdparty/asdf/ branches/trunk-reorg/thirdparty/asdf/CVS/ branches/trunk-reorg/thirdparty/asdf/CVS/Entries branches/trunk-reorg/thirdparty/asdf/CVS/Repository branches/trunk-reorg/thirdparty/asdf/CVS/Root branches/trunk-reorg/thirdparty/asdf/LICENSE branches/trunk-reorg/thirdparty/asdf/README branches/trunk-reorg/thirdparty/asdf/asdf-install.lisp branches/trunk-reorg/thirdparty/asdf/asdf.lisp branches/trunk-reorg/thirdparty/asdf/asdf.texinfo branches/trunk-reorg/thirdparty/asdf/cclan-package.lisp branches/trunk-reorg/thirdparty/asdf/cclan.asd branches/trunk-reorg/thirdparty/asdf/cclan.lisp branches/trunk-reorg/thirdparty/asdf/debian/ branches/trunk-reorg/thirdparty/asdf/debian/CVS/ branches/trunk-reorg/thirdparty/asdf/debian/CVS/Entries branches/trunk-reorg/thirdparty/asdf/debian/CVS/Repository branches/trunk-reorg/thirdparty/asdf/debian/CVS/Root branches/trunk-reorg/thirdparty/asdf/debian/README.Debian branches/trunk-reorg/thirdparty/asdf/debian/changelog branches/trunk-reorg/thirdparty/asdf/debian/cl-asdf.postinst branches/trunk-reorg/thirdparty/asdf/debian/cl-cclan.postinst branches/trunk-reorg/thirdparty/asdf/debian/cl-cclan.prerm branches/trunk-reorg/thirdparty/asdf/debian/compat branches/trunk-reorg/thirdparty/asdf/debian/control branches/trunk-reorg/thirdparty/asdf/debian/copyright branches/trunk-reorg/thirdparty/asdf/debian/docs branches/trunk-reorg/thirdparty/asdf/debian/postinst branches/trunk-reorg/thirdparty/asdf/debian/rules branches/trunk-reorg/thirdparty/asdf/test/ branches/trunk-reorg/thirdparty/asdf/test/CVS/ branches/trunk-reorg/thirdparty/asdf/test/CVS/Entries branches/trunk-reorg/thirdparty/asdf/test/CVS/Repository branches/trunk-reorg/thirdparty/asdf/test/CVS/Root branches/trunk-reorg/thirdparty/asdf/test/compile-asdf.lisp branches/trunk-reorg/thirdparty/asdf/test/file1.lisp branches/trunk-reorg/thirdparty/asdf/test/file2.lisp branches/trunk-reorg/thirdparty/asdf/test/file3.lisp branches/trunk-reorg/thirdparty/asdf/test/file4.lisp branches/trunk-reorg/thirdparty/asdf/test/run-tests.sh branches/trunk-reorg/thirdparty/asdf/test/script-support.lisp branches/trunk-reorg/thirdparty/asdf/test/static-and-serial.asd branches/trunk-reorg/thirdparty/asdf/test/test-force.asd branches/trunk-reorg/thirdparty/asdf/test/test-force.script branches/trunk-reorg/thirdparty/asdf/test/test-package.asd branches/trunk-reorg/thirdparty/asdf/test/test-package.script branches/trunk-reorg/thirdparty/asdf/test/test-preferences-1.lisp branches/trunk-reorg/thirdparty/asdf/test/test-preferences-1.script branches/trunk-reorg/thirdparty/asdf/test/test-preferences-system-1.asd branches/trunk-reorg/thirdparty/asdf/test/test-preferences-system-load.lisp branches/trunk-reorg/thirdparty/asdf/test/test-preferences-system-test.lisp branches/trunk-reorg/thirdparty/asdf/test/test-static-and-serial.script branches/trunk-reorg/thirdparty/asdf/test/test-version.script branches/trunk-reorg/thirdparty/asdf/test/test1.asd branches/trunk-reorg/thirdparty/asdf/test/test1.script branches/trunk-reorg/thirdparty/asdf/test/test2.asd branches/trunk-reorg/thirdparty/asdf/test/test2.script branches/trunk-reorg/thirdparty/asdf/test/test2a.asd branches/trunk-reorg/thirdparty/asdf/test/test2b1.asd branches/trunk-reorg/thirdparty/asdf/test/test2b2.asd branches/trunk-reorg/thirdparty/asdf/test/test2b3.asd branches/trunk-reorg/thirdparty/asdf/test/test3.asd branches/trunk-reorg/thirdparty/asdf/test/test3.script branches/trunk-reorg/thirdparty/asdf/test/test4.script branches/trunk-reorg/thirdparty/asdf/test/wild-module.asd branches/trunk-reorg/thirdparty/asdf/test/wild-module.script branches/trunk-reorg/thirdparty/asdf/wild-modules.lisp Log: update asdf from cvs Added: branches/trunk-reorg/thirdparty/asdf/CVS/Entries =================================================================== --- branches/trunk-reorg/thirdparty/asdf/CVS/Entries 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/CVS/Entries 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,11 @@ +/LICENSE/1.1/Wed Mar 6 23:59:29 2002// +/README/1.39/Mon Aug 21 10:52:32 2006// +/asdf-install.lisp/1.7/Mon Dec 1 03:14:35 2003// +/asdf.lisp/1.110/Thu Sep 27 13:15:06 2007// +/asdf.texinfo/1.8/Sat Jun 2 02:44:59 2007// +/cclan-package.lisp/1.4/Thu Jun 5 01:13:49 2003// +/cclan.asd/1.6/Thu Jun 5 01:13:49 2003// +/cclan.lisp/1.9/Fri Jul 18 05:32:53 2003// +/wild-modules.lisp/1.3/Tue Aug 12 03:56:43 2003// +D/debian//// +D/test//// Added: branches/trunk-reorg/thirdparty/asdf/CVS/Repository =================================================================== --- branches/trunk-reorg/thirdparty/asdf/CVS/Repository 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/CVS/Repository 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1 @@ +asdf Added: branches/trunk-reorg/thirdparty/asdf/CVS/Root =================================================================== --- branches/trunk-reorg/thirdparty/asdf/CVS/Root 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/CVS/Root 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1 @@ +:pserver:anonymous@cclan.cvs.sourceforge.net:/cvsroot/cclan Added: branches/trunk-reorg/thirdparty/asdf/LICENSE =================================================================== --- branches/trunk-reorg/thirdparty/asdf/LICENSE 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/LICENSE 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,24 @@ + +(This is the MIT / X Consortium license as taken from + http://www.opensource.org/licenses/mit-license.html) + +Copyright (c) 2001, 2002 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. Added: branches/trunk-reorg/thirdparty/asdf/README =================================================================== --- branches/trunk-reorg/thirdparty/asdf/README 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/README 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,762 @@ +$Id: README,v 1.39 2006/08/21 10:52:32 crhodes Exp $ -*- Text -*- + +The canonical documentation for asdf is in the file asdf.texinfo. +The significant overlap between this file and that will one day be +resolved by deleting text from this file; in the meantime, please look +there before here. + + + +asdf: another system definition facility +======================================== + +* Getting the latest version + +0) Decide which version you want. HEAD is the newest version and +usually OK, whereas RELEASE is for cautious people (e.g. who already +have systems using asdf that they don't want broken), a slightly older +version about which none of the HEAD users have complained. + +1) Check it out from sourceforge cCLan CVS: + +1a) cvs -d:pserver:anonymous@cvs.cclan.sourceforge.net:/cvsroot/cclan login + (no password: just press Enter) + +1a.1) cvs -z3 -d:pserver:anonymous@cvs.cclan.sourceforge.net:/cvsroot/cclan + co -r RELEASE asdf + +or for the bleeding edge, instead + +1a.2) cvs -z3 -d:pserver:anonymous@cvs.cclan.sourceforge.net:/cvsroot/cclan + co -A asdf + +If you are tracking the bleeding edge, you may want to subscribe to +the cclan-commits mailing list (see +<URL:http://sourceforge.net/mail/?group_id=28536>) to receive commit +messages and diffs whenever changes are made. + +For more CVS information, look at http://sourceforge.net/cvs/?group_id=28536 + + +* Getting started + +- The single file asdf.lisp is all you need to use asdf normally. For +maximum convenience you want to have it loaded whenever you start your +Lisp implementation, by loading it from the startup script, or dumping +a custom core, or something. + +- The variable asdf:*central-registry* is a list of system directory + designators. A system directory designator is a form which will be + evaluated whenever a system is to be found, and must evaluate to a + directory to look in. For example, you might have + + (*default-pathname-defaults* "/home/me/cl/systems/" + "/usr/share/common-lisp/systems/") + + (When we say "directory" here, we mean "designator for a pathname + with a supplied DIRECTORY component") + + It is possible to customize the system definition file search. + That's considered advanced use, and covered later: search forward + for *system-definition-search-functions* + +- To compile and load a system 'foo', you need to (1) ensure that + foo.asd is in one of the directories in *central-registry* (a + symlink to the real location of foo.asd is preferred), (2) execute + ``(asdf:operate 'asdf:load-op 'foo)'' + + $ cd /home/me/cl/systems/ + $ ln -s ~/src/foo/foo.asd . + $ lisp + * (asdf:operate 'asdf:load-op 'foo) + +- To write your own system definitions, look at the test systems in + test/ , and read the rest of this. Ignore systems/ which is old + and may go away when next I clean up + +- Syntax is similar to mk-defsystem 3 for straightforward systems, you + may only need to remove the :source-pathname option (and replace it + with :pathname if the asd file is not in the same place as the + system sources) + +- Join cclan-list(a)lists.sf.net for discussion, bug reports, questions, etc + +- cclan.asd and the source files listed therein contain useful extensions + for maintainers of systems in the cCLan. If this isn't you, you + don't need them - although you may want to look at them anyway + +- For systems that do complicated things (e.g. compiling C files to + load as foreign code), the packages in vn-cclan may provide some + guidance. db-sockets, for example, is known to do outlandish things + with preprocessors + + http://ww.telent.net/cliki/vn-cclan + + + +* Concepts + +This system definition utility talks in terms of 'components' and +'operations'. + +Components form systems: a component represents a source file, or a +collection of components. A system is therefore a component, +recursively formed of a tree of subcomponents. + +Operations are instantiated then performed on the nodes of a tree to +do things like + + - compile all its files + - load the files into a running lisp environment + - copy its source files somewhere else + +Operations can be invoked directly, or examined to see what their +effects would be without performing them. There are a bunch of +methods specialised on operation and component type which actually do +the grunt work. + +asdf is extensible to new operations and to new component types. This +allows the addition of behaviours: for example, a new component could +be added for Java JAR archives, and methods specialised on compile-op +added for it that would accomplish the relevant actions. Users +defining their own operations and component types should inherit from +the asdf base classes asdf:operation and asdf:component respectively. + +* Inspiration + +** mk-defsystem (defsystem-3.x) + +We aim to solve basically the same problems as mk-defsystem does. +However, our architecture for extensibility better exploits CL +language features (and is documented), and we intend to be portable +rather than just widely-ported. No slight on the mk-defsystem authors +and maintainers is intended here; that implementation has the +unenviable task of supporting non-ANSI implementations, which I +propose to ignore. + +The surface defsystem syntax of asdf is more-or-less compatible with +mk-defsystem + +The mk-defsystem code for topologically sorting a module's dependency +list was very useful. + +** defsystem-4 proposal + +Marco and Peter's proposal for defsystem 4 served as the driver for +many of the features in here. Notable differences are + +- we don't specify output files or output file extensions as part of + the system + + If you want to find out what files an operation would create, ask + the operation + +- we don't deal with CL packages + + If you want to compile in a particular package, use an in-package + form in that file (ilisp will like you more if you do this anyway) + +- there is no proposal here that defsystem does version control. + + A system has a given version which can be used to check + dependencies, but that's all. + +The defsystem 4 proposal tends to look more at the external features, +whereas this one centres on a protocol for system introspection. + +** kmp's "The Description of Large Systems", MIT AI Memu 801 + +Available in updated-for-CL form on the web at +http://world.std.com/~pitman/Papers/Large-Systems.html + +In our implementation we borrow kmp's overall PROCESS-OPTIONS and +concept to deal with creating component trees from defsystem surface +syntax. [ this is not true right now, though it used to be and +probably will be again soon ] + + +* The Objects + +** component + +*** Component Attributes + +**** A name (required) + +This is a string or a symbol. If a symbol, its name is taken and +lowercased. The name must be a suitable value for the :name initarg +to make-pathname in whatever filesystem the system is to be found. + +The lower-casing-symbols behaviour is unconventional, but was selected +after some consideration. Observations suggest that the type of +systems we want to support either have lowercase as customary case +(Unix, Mac, windows) or silently convert lowercase to uppercase +(lpns), so this makes more sense than attempting to use :case :common, +which is reported not to work on some implementations + +**** a version identifier (optional) + +This is used by the test-system-version operation (see later). + +**** *features* required + +Traditionally defsystem users have used reader conditionals to include +or exclude specific per-implementation files. This means that any +single implementation cannot read the entire system, which becomes a +problem if it doesn't wish to compile it, but instead for example to +create an archive file containing all the sources, as it will omit to +process the system-dependent sources for other systems. + +Each component in an asdf system may therefore specify features using +the same syntax as #+ does, and it will (somehow) be ignored for +certain operations unless the feature conditional matches + +**** dependencies on its siblings (optional but often necessary) + +There is an excitingly complicated relationship between the initarg +and the method that you use to ask about dependencies + +Dependencies are between (operation component) pairs. In your +initargs, you can say + +:in-order-to ((compile-op (load-op "a" "b") (compile-op "c")) + (load-op (load-op "foo"))) + +- before performing compile-op on this component, we must perform +load-op on "a" and "b", and compile-op on c, - before performing +load-op, we have to load "foo" + +The syntax is approximately + +(this-op {(other-op required-components)}+) + +required-components := component-name + | (required-components required-components) + +component-name := string + | (:version string minimum-version-object) + +[ This is on a par with what ACL defsystem does. mk-defsystem is less +general: it has an implied dependency + + for all x, (load x) depends on (compile x) + +and using a :depends-on argument to say that b depends on a _actually_ +means that + + (compile b) depends on (load a) + +This is insufficient for e.g. the McCLIM system, which requires that +all the files are loaded before any of them can be compiled ] + +In asdf, the dependency information for a given component and +operation can be queried using (component-depends-on operation +component), which returns a list + +((load-op "a") (load-op "b") (compile-op "c") ...) + +component-depends-on can be subclassed for more specific +component/operation types: these need to (call-next-method) and append +the answer to their dependency, unless they have a good reason for +completely overriding the default dependencies + +(If it weren't for CLISP, we'd be using a LIST method combination to +do this transparently. But, we need to support CLISP. If you have +the time for some CLISP hacking, I'm sure they'd welcome your fixes) + +**** a pathname + +This is optional and if absent will be inferred from name, type (the +subclass of source-file), and the location of parent. + +The rules for this inference are: + +(for source-files) +- the host is taken from the parent +- pathname type is (source-file-type component system) +- the pathname case option is :local +- the pathname is merged against the parent + +(for modules) +- the host is taken from the parent +- the name and type are NIL +- the directory is (:relative component-name) +- the pathname case option is :local +- the pathname is merged against the parent + +Note that the DEFSYSTEM operator (used to create a "top-level" system) +does additional processing to set the filesystem location of the +top component in that system. This is detailed elsewhere + +The answer to the frequently asked question "how do I create a system +definition where all the source files have a .cl extension" is thus + +(defmethod source-file-type ((c cl-source-file) (s (eql (find-system 'my-sys)))) + "cl") + +**** properties (optional) + +Packaging systems often require information about files or systems +additional to that specified here. Programs that create vendor +packages out of asdf systems therefore have to create "placeholder" +information to satisfy these systems. Sometimes the creator of an +asdf system may know the additional information and wish to provide it +directly. + +(component-property component property-name) and associated setf method +will allow the programmatic update of this information. Property +names are compared as if by EQL, so use symbols or keywords or something + +** Subclasses of component + +*** 'source-file' + +A source file is any file that the system does not know how to +generate from other components of the system. + +(Note that this is not necessarily the same thing as "a file +containing data that is typically fed to a compiler". If a file is +generated by some pre-processor stage (e.g. a ".h" file from ".h.in" +by autoconf) then it is not, by this definition, a source file. +Conversely, we might have a graphic file that cannot be automatically +regenerated, or a proprietary shared library that we received as a +binary: these do count as source files for our purposes. All +suggestions for better terminology gratefully received) + +Subclasses of source-file exist for various languages. + +*** 'module', a collection of sub-components + +This has extra slots for + + :components - the components contained in this module + + :default-component-class - for child components which don't specify + their class explicitly + + :if-component-dep-fails takes one of the values :fail, :try-next, :ignore + (default value is :fail). The other values can be used for implementing + conditional compilation based on implementation *features*, where + it is not necessary for all files in a module to be compiled + +The default operation knows how to traverse a module, so most +operations will not need to provide methods specialised on modules. + +The module may be subclassed to represent components such as +foreign-language linked libraries or archive files. + +*** system, subclasses module + +A system is a module with a few extra attributes for documentation +purposes. In behaviour, it's usually identical. + +Users can create new classes for their systems: the default defsystem +macro takes a :classs keyword argument. + + +** operation + +An operation is instantiated whenever the user asks that an operation +be performed, inspected, or etc. The operation object contains +whatever state is relevant to this purpose (perhaps a list of visited +nodes, for example) but primarily is a nice thing to specialise +operation methods on and easier than having them all be EQL methods. + +There are no differences between standard operations and user-defined +operations, except that the user is respectfully requested to keep his +(or more importantly, our) package namespace clean + +*** invoking operations + +(operate operation system &rest keywords-args) + +keyword-args are passed to the make-instance call when creating the +operation: valid keywords depend on the initargs that the operation is +defined to accept. Note that dependencies may cause the operation to +invoke other operations on the system or its components: the new +operation will be created with the same initargs as the original one. + +oos is accepted as a synonym for operate + +*** standard operations + +**** feature-dependent-op + +This is not intended to be instantiated directly, but other operations +may inherit from it. An instance of feature-dependent-op will ignore +any components which have a `features' attribute, unless the feature +combination it designates is satisfied by *features* + +See the earlier explanation about the component features attribute for +more information + +**** compile-op &key proclamations + +If proclamations are supplied, they will be proclaimed. This is a +good place to specify optimization settings + +When creating a new component, you should provide methods for this. + +If you invoke compile-op as a user, component dependencies often mean +you may get some parts of the system loaded. This may not necessarily +be the whole thing, though; for your own sanity it is recommended that +you use load-op if you want to load a system. + +**** load-op &key proclamations + +The default methods for load-op compile files before loading them. +For parity, your own methods on new component types should probably do +so too + +**** load-source-op + +This method will load the source for the files in a module even if the +source files have been compiled. Systems sometimes have knotty +dependencies which require that sources are loaded before they can be +compiled. This is how you do that. + +If you are creating a component type, you need to implement this +operation - at least, where meaningful. + +**** test-system-version &key minimum + +Asks the system whether it satisfies a version requirement. + +The default method accepts a string, which is expected to contain of a +number of integers separated by #\. characters. The method is not +recursive. The component satisfies the version dependency if it has +the same major number as required and each of its sub-versions is +greater than or equal to the sub-version number required. + +(defun version-satisfies (x y) + (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)))))) + +If that doesn't work for your system, you can override it. I hope +yoyu have as much fun writing the new method as #lisp did +reimplementing this one. + +*** Creating new operations + +subclass operation, provide methods for source-file for + +- output-files +- perform + The perform method must call output-files to find out where to + put its files, because the user is allowed to override output-files + for local policy +- explain +- operation-done-p, if you don't like the default one + +* Writing system definitions + +** System designators + +System designators are strings or symbols and behave just like +any other component names (including case conversion) + +** find-system + +Given a system designator, find-system finds an actual system - either +in memory, or in a file on the disk. It funcalls each element in the +*system-definition-search-functions* list, expecting a pathname to be +returned. + +If a suitable file exists, it is loaded if + +- there is no system of that name in memory, +- the file's last-modified time exceeds the last-modified time of the + system in memory + +When system definitions are loaded from .asd files, a new scratch +package is created for them to load into, so that different systems do +not overwrite each others operations. The user may also wish to (and +is recommended to) include defpackage and in-package forms in his +system definition files, however, so that they can be loaded manually +if need be. It is not recommended to use the CL-USER package for this +purpose, as definitions made in this package will affect the parsing +of asdf systems. + +For convenience in the normal case, and for backward compatibility +with the spirit of mk-defsystem, the default contents of +*system-definition-search-functions* is a function called +sysdef-central-registry-search. This looks in each of the directories +given by evaluating members of *central-registry*, for a file whose +name is the name of the system and whose type is "asd". The first +such file is returned, whether or not it turns out to actually define +the appropriate system + + + +** Syntax + +Systems can always be constructed programmatically by instantiating +components using make-instance. For most purposes, however, it is +likely that people will want a static defystem form. + +asdf is based around the principle that components should not have to +know defsystem syntax. That is, the initargs that a component accepts +are not necessarily related to the defsystem form which creates it. + +A defsystem parser must implement a `defsystem' macro, which can +be named for compatibility with whatever other system definition +utility is being emulated. It should instantiate components in +accordance with whatever language it accepts, and register the topmost +component using REGISTER-SYSTEM + +*** Native syntax + +The native syntax is inspired by mk-defsystem, to the extent that it +should be possible to take most straightforward mk- system definitions +and run them with only light editing. For my convenience, this turns +out to be basically the same as the initargs to the various +components, with a few extensions for convenience + +system-definition := ( defsystem system-designator {option}* ) + +option := :components component-list + | :pathname pathname + | :default-component-class + | :perform method-form + | :explain method-form + | :output-files method-form + | :operation-done-p method-form + | :depends-on ( {simple-component-name}* ) + | :serial [ t | nil ] + | :in-order-to ( {dependency}+ ) + +component-list := ( {component-def}* ) + +component-def := simple-component-name + | ( component-type name {option}* ) + +component-type := :module | :file | :system | other-component-type + +dependency := (dependent-op {requirement}+) +requirement := (required-op {required-component}+) + | (feature feature-name) +dependent-op := operation-name +required-op := operation-name | feature + +For example + +(defsystem "foo" + :version "1.0" + :components ((:module "foo" :components ((:file "bar") (:file"baz") + (:file "quux")) + :perform (compile-op :after (op c) + (do-something c)) + :explain (compile-op :after (op c) + (explain-something c))) + (:file "blah"))) + + +The method-form tokens need explaining: esentially, + + :perform (compile-op :after (op c) + (do-something c)) + :explain (compile-op :after (op c) + (explain-something c))) +has the effect of + +(defmethod perform :after ((op compile-op) (c (eql ...))) + (do-something c)) +(defmethod explain :after ((op compile-op) (c (eql ...))) + (explain-something c)) + +where ... is the component in question; note that although this also +supports :before methods, they may not do what you want them to - a +:before method on perform ((op compile-op) (c (eql ...))) will run +after all the dependencies and sub-components have been processed, but +before the component in question has been compiled. + +**** Serial dependencies + +If the `:serial t' option is specified for a module, asdf will add +dependencies for each each child component, on all the children +textually preceding it. This is done as if by :depends-on + +:components ((:file "a") (:file "b") (:file "c")) +:serial t + +is equivalent to +:components ((:file "a") + (:file "b" :depends-on ("a")) + (:file "c" :depends-on ("a" "b"))) + + + +have all the + +**** Source location + +The :pathname option is optional in all cases for native-syntax +systems, and in the usual case the user is recommended not to supply +it. If it is not supplied for the top-level form, defsystem will set +it from + +- The host/device/directory parts of *load-truename*, if it is bound +- *default-pathname-defaults*, otherwise + +If a system is being redefined, the top-level pathname will be + +- changed, if explicitly supplied or obtained from *load-truename* +- changed if it had previously been set from *default-pathname-defaults* +- left as before, if it had previously been set from *load-truename* + and *load-truename* is not now bound + +These rules are designed so that (i) find-system will load a system +from disk and have its pathname default to the right place, (ii) +this pathname information will not be overwritten with +*default-pathname-defaults* (which could be somewhere else altogether) +if the user loads up the .asd file into his editor and +interactively re-evaluates that form + + * Error handling + +It is an error to define a system incorrectly: an implementation may +detect this and signal a generalised instance of +SYSTEM-DEFINITION-ERROR. + +Operations may go wrong (for example when source files contain +errors). These are signalled using generalised instances of +OPERATION-ERROR, with condition readers ERROR-COMPONENT and +ERROR-OPERATION for the component and operation which erred. + +* Compilation error and warning handling + +ASDF checks for warnings and errors when a file is compiled. The +variables *compile-file-warnings-behaviour* and +*compile-file-errors-behavior* controls the handling of any such +events. The valid values for these variables are :error, :warn, and +:ignore. + +---------------------------------------------------------- + TODO List +---------------------------------------------------------- + +* Outstanding spec questions, things to add + +** packaging systems + +*** manual page component? + +** style guide for .asd files + +You should either use keywords or be careful with the package that you +evaluate defsystem forms in. Otherwise (defsystem partition ...) +being read in the cl-user package will intern a cl-user:partition +symbol, which will then collide with the partition:partition symbol. + +Actually there's a hairier packages problem to think about too. +in-order-to is not a keyword: if you read defsystem forms in a package +that doesn't use ASDF, odd things might happen + +** extending defsystem with new options + +You might not want to write a whole parser, but just to add options to +the existing syntax. Reinstate parse-option or something akin + +** document all the error classes + +** what to do with compile-file failure + +Should check the primary return value from compile-file and see if +that gets us any closer to a sensible error handling strategy + +** foreign files + +lift unix-dso stuff from db-sockets + +** Diagnostics + +A "dry run" of an operation can be made with the following form: + +(traverse (make-instance '<operation-name>) + (find-system <system-name>) + 'explain) + +This uses unexported symbols. What would be a nice interface for this +functionality? + +** patches + +Sometimes one wants to + + +* missing bits in implementation + +** all of the above +** reuse the same scratch package whenever a system is reloaded from disk +** rules for system pathname defaulting are not yet implemented properly +** proclamations probably aren't +** when a system is reloaded with fewer components than it previously + had, odd things happen + +we should do something inventive when processing a defsystem form, +like take the list of kids and setf the slot to nil, then transfer +children from old to new list as they're found + +** traverse may become a normal function + +If you're defining methods on traverse, speak up. + + +** a lot of load-op methods can be rewritten to use input-files + +so should be. + + +** (stuff that might happen later) + +*** david lichteblau's patch for symlink resolution? + +*** Propagation of the :force option. ``I notice that + + (oos 'compile-op :araneida :force t) + +also forces compilation of every other system the :araneida system +depends on. This is rarely useful to me; usually, when I want to force +recompilation of something more than a single source file, I want to +recompile only one system. So it would be more useful to have +make-sub-operation refuse to propagate ":force t" to other systems, and +propagate only something like ":force :recursively". '' + +Ideally what we actually want is some kind of criterion that says +to which systems (and which operations) a :force switch will propagate. + +The problem is perhaps that 'force' is a pretty meaningless concept. +How obvious is it that "load :force t" should force _compilation_? +But we don't really have the right dependency setup for the user to +compile :force t and expect it to work (files will not be loaded after +compilation, so the compile environment for subsequent files will be +emptier than it needs to be) + +What does the user actually want to do when he forces? Usually, for +me, update for use with a new version of the lisp compiler. Perhaps +for recovery when he suspects that something has gone wrong. Or else +when he's changed compilation options or configuration in some way +that's not reflected in the dependency graph. + +Other possible interface: have a 'revert' function akin to 'make clean' + + (asdf:revert 'asdf:compile-op 'araneida) + +would delete any files produced by 'compile-op 'araneida. Of course, it +wouldn't be able to do much about stuff in the image itself. + +How would this work? + +traverse + +There's a difference between a module's dependencies (peers) and its +components (children). Perhaps there's a similar difference in +operations? For example, (load "use") depends-on (load "macros") is a +peer, whereas (load "use") depends-on (compile "use") is more of a +`subservient' relationship. Added: branches/trunk-reorg/thirdparty/asdf/asdf-install.lisp =================================================================== --- branches/trunk-reorg/thirdparty/asdf/asdf-install.lisp 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/asdf-install.lisp 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,299 @@ +#|| sh asdf-install.lisp will compile this file to an exe called asdf-install +sbcl <<EOF +(require 'sb-executable) +(compile-file "asdf-install.lisp") +(sb-executable:make-executable "asdf-install" *) +EOF +exit 0 +||# + +;;; Install an ASDF system or anything else that looks convincingly +;;; like one, including updating symlink for all the toplevel .asd files it +;;; contains + +;;; If the file $HOME/.asdf-install exists, it is loaded. This can be +;;; used to override the default values of exported special variables +;;; (see the defpackage form for details) - however, most of them are +;;; sensible and/or taken from the environment anyway + +#|| +TODO: +a) gpg signature checking would be better if it actually checked against +a list of "trusted to write Lisp" keys, instead of just "trusted to be +who they say they are" + +d) in sbcl 0.8.1 we'll have a run-program that knows about $PATH and so +won't need to hardcode gpgpgpgp and tar locations. + +e) nice to have: resume half-done downloads instead of starting from scratch +every time. but right now we're dealing in fairly small packages, this is not +an immediate concern + +||# +(in-package :cl-user) +(eval-when (:compile-toplevel :load-toplevel :execute) + (require 'asdf) + (require 'sb-posix) + (require 'sb-executable) + (require 'sb-bsd-sockets)) + +(defpackage :asdf-install + (:use "CL" "SB-EXT" "SB-BSD-SOCKETS") + (:export #:*proxy* #:*cclan-mirror* #:*sbcl-home* + #:*verify-gpg-signatures* #:*locations*)) + +(defpackage :asdf-install-customize + (:use "CL" "SB-EXT" "SB-BSD-SOCKETS" "ASDF-INSTALL")) + +(in-package :asdf-install) + +(defvar *proxy* (posix-getenv "http_proxy")) +(defvar *cclan-mirror* + (or (posix-getenv "CCLAN_MIRROR") + "http://ftp.linux.org.uk/pub/lisp/cclan/")) + +(defun directorify (name) + ;; input name may or may not have a training #\/, but we know we + ;; want a directory + (let ((path (pathname name))) + (if (pathname-name path) + (merge-pathnames + (make-pathname :directory `(:relative ,(pathname-name path)) + :name "") + path) + path))) + +(defvar *sbcl-home* (directorify (posix-getenv "SBCL_HOME"))) +(defvar *dot-sbcl* + (merge-pathnames (make-pathname :directory '(:relative ".sbcl")) + (user-homedir-pathname))) + +(defvar *verify-gpg-signatures* t) + +(defvar *locations* + `((,(merge-pathnames "site/" *sbcl-home*) + ,(merge-pathnames "site-systems/" *sbcl-home*) + "System-wide install") + (,(merge-pathnames "site/" *dot-sbcl*) + ,(merge-pathnames "systems/" *dot-sbcl*) + "Personal installation"))) + +(let* ((*package* (find-package :asdf-install-customize)) + (file (probe-file (merge-pathnames + (make-pathname :name ".asdf-install") + (user-homedir-pathname))))) + (when file (load file))) + +(define-condition download-error (error) + ((url :initarg :url :reader download-url) + (response :initarg :response :reader download-response)) + (:report (lambda (c s) + (format s "Server responded ~A for GET ~A" + (download-response c) (download-url c))))) + +(define-condition signature-error (error) + ((cause :initarg :cause :reader signature-error-cause)) + (:report (lambda (c s) + (format s "Cannot verify package signature: ~A" + (signature-error-cause c))))) + +(defun url-host (url) + (assert (string-equal url "http://" :end1 7)) + (let* ((port-start (position #\: url :start 7)) + (host-end (min (or (position #\/ url :start 7) (length url)) + (or port-start (length url))))) + (subseq url 7 host-end))) + +(defun url-port (url) + (assert (string-equal url "http://" :end1 7)) + (let ((port-start (position #\: url :start 7))) + (if port-start (parse-integer url :start port-start :junk-allowed t) 80))) + +(defun url-connection (url) + (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)) + (host (url-host url)) + (port (url-port url))) + (socket-connect + s (car (host-ent-addresses (get-host-by-name (url-host (or *proxy* url))))) + (url-port (or *proxy* url))) + (let ((stream (socket-make-stream s :input t :output t :buffering :full))) + ;; we are exceedingly unportable about proper line-endings here. + ;; Anyone wishing to run this under non-SBCL should take especial care + (format stream "GET ~A HTTP/1.0~%Host: ~A~%Cookie: CCLAN-SITE=~A~%~%" + url host *cclan-mirror*) + (force-output stream) + (list + (let* ((l (read-line stream)) + (space (position #\Space l))) + (parse-integer l :start (1+ space) :junk-allowed t)) + (loop for line = (read-line stream nil nil) + until (or (null line) (eql (elt line 0) (code-char 13))) + collect + (let ((colon (position #\: line))) + (cons (intern (string-upcase (subseq line 0 colon)) :keyword) + (string-trim (list #\Space (code-char 13)) + (subseq line (1+ colon)))))) + stream)))) + +(defun download (package-name-or-url file-name) + (let ((url + (if (= (mismatch package-name-or-url "http://") 7) + package-name-or-url + (format nil "http://www.cliki.net/~A?download" + package-name-or-url)))) + (destructuring-bind (response headers stream) + (block got + (loop + (destructuring-bind (response headers stream) (url-connection url) + (unless (member response '(301 302)) + (return-from got (list response headers stream))) + (close stream) + (setf url (cdr (assoc :location headers)))))) + (if (>= response 400) + (error 'download-error :url url :response response)) + (let ((length (parse-integer + (or (cdr (assoc :content-length headers)) "") + :junk-allowed t))) + (format t "Downloading ~A bytes from ~A ..." + (if length length "some unknown number of") url) + (force-output) + (with-open-file (o file-name :direction :output) + (if length + (let ((buf (make-array length + :element-type + (stream-element-type stream) ))) + (read-sequence buf stream) + (write-sequence buf o)) + (sb-executable:copy-stream stream o)))) + (close stream) + (terpri) + ;; seems to have worked. let's try for a detached gpg signature too + (when *verify-gpg-signatures* + (verify-gpg-signature url file-name))))) + +(defun verify-gpg-signature (url file-name) + (destructuring-bind (response headers stream) + (url-connection (concatenate 'string url ".asc")) + (declare (ignore headers)) + (unwind-protect + (if (= response 200) + ;; sadly, we can't pass the stream directly to run-program, + ;; because (at least in sbcl 0.8) that ignores existing buffered + ;; data and only reads new fresh data direct from the file + ;; descriptor + (let ((data (make-string (parse-integer + (cdr (assoc :content-length headers)) + :junk-allowed t)))) + (read-sequence data stream) + (let ((ret + (process-exit-code + (sb-ext:run-program "/usr/bin/gpg" + (list "--verify" "-" + (namestring file-name)) + :output t + :input (make-string-input-stream data) + :wait t)))) + (unless (zerop ret) + (error 'signature-error + :cause (make-condition + 'simple-error + :format-control "GPG returned exit status ~A" + :format-arguments (list ret)))))) + (error 'signature-error + :cause + (make-condition + 'download-error :url (concatenate 'string url ".asc") + :response response))) + (close stream)))) + + + + +(defun where () + (format t "Install where?~%") + (loop for (source system name) in *locations* + for i from 1 + do (format t "~A) ~A: ~% System in ~A~% Files in ~A ~%" + i name system source)) + (format t " --> ") (force-output) + (let ((response (read))) + (when (> response 0) + (elt *locations* (1- response))))) + +(defun install (source system packagename) + "Returns a list of asdf system names for installed asdf systems" + (ensure-directories-exist source ) + (ensure-directories-exist system ) + (let* ((tar + (with-output-to-string (o) + (or + (sb-ext:run-program "/bin/tar" + (list "-C" (namestring source) + "-xzvf" (namestring packagename)) + :output o + :wait t) + (error "can't untar")))) + (dummy (princ tar)) + (pos-slash (position #\/ tar)) + (*default-pathname-defaults* + (merge-pathnames + (make-pathname :directory + `(:relative ,(subseq tar 0 pos-slash))) + source))) + (loop for asd in (directory + (make-pathname :name :wild :type "asd")) + do (let ((target (merge-pathnames + (make-pathname :name (pathname-name asd) + :type (pathname-type asd)) + system))) + (when (probe-file target) + (sb-posix:unlink target)) + (sb-posix:symlink asd target)) + collect (pathname-name asd)))) + +(defvar *temporary-files*) +(defun temp-file-name (p) + (let* ((pos-slash (position #\/ p :from-end t)) + (pos-dot (position #\. p :start (or pos-slash 0)))) + (merge-pathnames + (make-pathname + :name (subseq p (if pos-slash (1+ pos-slash) 0) pos-dot) + :type "asdf-install-tmp")))) + + + +(defun run (&optional (packages (cdr *posix-argv*))) + (destructuring-bind (source system name) (where) + (labels ((one-iter (packages) + (dolist (asd + (loop for p in packages + unless (probe-file p) + do (let ((tmp (temp-file-name p))) + (pushnew tmp *temporary-files*) + (download p tmp) + (setf p tmp)) + end + do (format t "Installing ~A in ~A,~A~%" p source system) + append (install source system p))) + (handler-case + (asdf:operate 'asdf:load-op asd) + (asdf:missing-dependency (c) + (format t "Downloading package ~A, required by ~A~%" + (asdf::missing-requires c) + (asdf:component-name (asdf::missing-required-by c))) + (one-iter (list + (symbol-name (asdf::missing-requires c))))))))) + (one-iter packages)))) + +(handler-case + (let ((*temporary-files* nil)) + (unwind-protect + (run) + (dolist (l *temporary-files*) + (when (probe-file l) (delete-file l))))) + (error (c) + (princ "Install failed due to error:") (terpri) + (princ c) (terpri) + (quit :unix-status 1))) + +;(quit) \ No newline at end of file Added: branches/trunk-reorg/thirdparty/asdf/asdf.lisp =================================================================== --- branches/trunk-reorg/thirdparty/asdf/asdf.lisp 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/asdf.lisp 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,1308 @@ +;;; This is asdf: Another System Definition Facility. $Revision: 1.110 $ +;;; +;;; Feedback, bug reports, and patches are all welcome: please mail to +;;; <cclan-list(a)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-2007 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 + #:system-licence + #:system-source-file + #:system-relative-pathname + + #: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 + #:error-component #:error-operation + #:system-definition-error + #:missing-component + #:missing-dependency + #:circular-dependency ; errors + #:duplicate-names + + #:retry + #:accept ; restarts + + #:preference-file-for-system/operation + #:load-preferences + ) + (: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.110 $") + (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) + +(defparameter +asdf-methods+ + '(perform explain output-files operation-done-p)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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 duplicate-names (system-definition-error) + ((name :initarg :name :reader duplicate-names-name))) + +(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 + :accessor system-license :initarg :license))) + +;;; 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)) + (return file))))))) + +(defun make-temporary-package () + (flet ((try (counter) + (ignore-errors + (make-package (format nil "ASDF~D" counter) + :use '(:cl :asdf))))) + (do* ((counter 0 (+ counter 1)) + (package (try counter) (try counter))) + (package package)))) + +(defun find-system (name &optional (error-p t)) + (let* ((name (coerce-name name)) + (in-memory (gethash name *defined-systems*)) + (on-disk (system-definition-pathname name))) + (when (and on-disk + (or (not in-memory) + (< (car in-memory) (file-write-date on-disk)))) + (let ((package (make-temporary-package))) + (unwind-protect + (let ((*package* package)) + (format + *verbose-out* + "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%" + ;; FIXME: This wants to be (ENOUGH-NAMESTRING + ;; ON-DISK), but CMUCL barfs on that. + on-disk + *package*) + (load on-disk)) + (delete-package package)))) + (let ((in-memory (gethash name *defined-systems*))) + (if in-memory + (progn (if on-disk (setf (car in-memory) (file-write-date on-disk))) + (cdr in-memory)) + (if error-p (error 'missing-component :requires name)))))) + +(defun register-system (name system) + (format *verbose-out* "~&~@<; ~@;registering ~A as ~A~@:>~%" system name) + (setf (gethash (coerce-name name) *defined-systems*) + (cons (get-universal-time) system))) + +(defun system-registered-p (name) + (gethash (coerce-name name) *defined-systems*)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; finding components + +(defgeneric find-component (module name &optional version) + (:documentation "Finds the component with name NAME present in the +MODULE module; if MODULE is nil, then the component is assumed to be a +system.")) + +(defmethod find-component ((module module) name &optional version) + (if (slot-boundp module 'components) + (let ((m (find name (module-components module) + :test #'equal :key #'component-name))) + (if (and m (version-satisfies m version)) m)))) + + +;;; a component with no parent is a system +(defmethod find-component ((module (eql nil)) name &optional version) + (let ((m (find-system name nil))) + (if (and m (version-satisfies m version)) m))) + +;;; component subclasses + +(defclass source-file (component) ()) + +(defclass cl-source-file (source-file) ()) +(defclass c-source-file (source-file) ()) +(defclass java-source-file (source-file) ()) +(defclass static-file (source-file) ()) +(defclass doc-file (static-file) ()) +(defclass html-file (doc-file) ()) + +(defgeneric source-file-type (component system)) +(defmethod source-file-type ((c cl-source-file) (s module)) "lisp") +(defmethod source-file-type ((c c-source-file) (s module)) "c") +(defmethod source-file-type ((c java-source-file) (s module)) "java") +(defmethod source-file-type ((c html-file) (s module)) "html") +(defmethod source-file-type ((c static-file) (s module)) nil) + +(defmethod component-relative-pathname ((component source-file)) + (let ((relative-pathname (slot-value component 'relative-pathname))) + (if relative-pathname + (merge-pathnames + relative-pathname + (make-pathname + :type (source-file-type component (component-system component)))) + (let* ((*default-pathname-defaults* + (component-parent-pathname component)) + (name-type + (make-pathname + :name (component-name component) + :type (source-file-type component + (component-system component))))) + name-type)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; operations + +;;; one of these is instantiated whenever (operate ) is called + +(defclass operation () + ((forced :initform nil :initarg :force :accessor operation-forced) + (original-initargs :initform nil :initarg :original-initargs + :accessor operation-original-initargs) + (visited-nodes :initform nil :accessor operation-visited-nodes) + (visiting-nodes :initform nil :accessor operation-visiting-nodes) + (parent :initform nil :initarg :parent :accessor operation-parent))) + +(defmethod print-object ((o operation) stream) + (print-unreadable-object (o stream :type t :identity t) + (ignore-errors + (prin1 (operation-original-initargs o) stream)))) + +(defmethod shared-initialize :after ((operation operation) slot-names + &key force + &allow-other-keys) + (declare (ignore slot-names force)) + ;; empty method to disable initarg validity checking + ) + +(defgeneric perform (operation component)) +(defgeneric operation-done-p (operation component)) +(defgeneric explain (operation component)) +(defgeneric output-files (operation component)) +(defgeneric input-files (operation component)) + +(defun node-for (o c) + (cons (class-name (class-of o)) c)) + +(defgeneric operation-ancestor (operation) + (:documentation "Recursively chase the operation's parent pointer until we get to the head of the tree")) + +(defmethod operation-ancestor ((operation operation)) + (aif (operation-parent operation) + (operation-ancestor it) + operation)) + + +(defun make-sub-operation (c o dep-c dep-o) + (let* ((args (copy-list (operation-original-initargs o))) + (force-p (getf args :force))) + ;; note explicit comparison with T: any other non-NIL force value + ;; (e.g. :recursive) will pass through + (cond ((and (null (component-parent c)) + (null (component-parent dep-c)) + (not (eql c dep-c))) + (when (eql force-p t) + (setf (getf args :force) nil)) + (apply #'make-instance dep-o + :parent o + :original-initargs args args)) + ((subtypep (type-of o) dep-o) + o) + (t + (apply #'make-instance dep-o + :parent o :original-initargs args args))))) + + +(defgeneric visit-component (operation component data)) + +(defmethod visit-component ((o operation) (c component) data) + (unless (component-visited-p o c) + (push (cons (node-for o c) data) + (operation-visited-nodes (operation-ancestor o))))) + +(defgeneric component-visited-p (operation component)) + +(defmethod component-visited-p ((o operation) (c component)) + (assoc (node-for o c) + (operation-visited-nodes (operation-ancestor o)) + :test 'equal)) + +(defgeneric (setf visiting-component) (new-value operation component)) + +(defmethod (setf visiting-component) (new-value operation component) + ;; MCL complains about unused lexical variables + (declare (ignorable new-value operation component))) + +(defmethod (setf visiting-component) (new-value (o operation) (c component)) + (let ((node (node-for o c)) + (a (operation-ancestor o))) + (if new-value + (pushnew node (operation-visiting-nodes a) :test 'equal) + (setf (operation-visiting-nodes a) + (remove node (operation-visiting-nodes a) :test 'equal))))) + +(defgeneric component-visiting-p (operation component)) + +(defmethod component-visiting-p ((o operation) (c component)) + (let ((node (cons o c))) + (member node (operation-visiting-nodes (operation-ancestor o)) + :test 'equal))) + +(defgeneric component-depends-on (operation component) + (:documentation + "Returns a list of dependencies needed by the component to perform + the operation. A dependency has one of the following forms: + + (<operation> <component>*), where <operation> is a class + designator and each <component> is a component + designator, which means that the component depends on + <operation> having been performed on each <component>; or + + (FEATURE <feature>), which means that the component depends + on <feature>'s presence in *FEATURES*. + + Methods specialized on subclasses of existing component types + should usually append the results of CALL-NEXT-METHOD to the + list.")) + +(defmethod component-depends-on ((op-spec symbol) (c component)) + (component-depends-on (make-instance op-spec) c)) + +(defmethod component-depends-on ((o operation) (c component)) + (cdr (assoc (class-name (class-of o)) + (slot-value c 'in-order-to)))) + +(defgeneric component-self-dependencies (operation component)) + +(defmethod component-self-dependencies ((o operation) (c component)) + (let ((all-deps (component-depends-on o c))) + (remove-if-not (lambda (x) + (member (component-name c) (cdr x) :test #'string=)) + all-deps))) + +(defmethod input-files ((operation operation) (c component)) + (let ((parent (component-parent c)) + (self-deps (component-self-dependencies operation c))) + (if self-deps + (mapcan (lambda (dep) + (destructuring-bind (op name) dep + (output-files (make-instance op) + (find-component parent name)))) + self-deps) + ;; no previous operations needed? I guess we work with the + ;; original source file, then + (list (component-pathname c))))) + +(defmethod input-files ((operation operation) (c module)) nil) + +(defmethod operation-done-p ((o operation) (c component)) + (flet ((fwd-or-return-t (file) + ;; if FILE-WRITE-DATE returns NIL, it's possible that the + ;; user or some other agent has deleted an input file. If + ;; that's the case, well, that's not good, but as long as + ;; the operation is otherwise considered to be done we + ;; could continue and survive. + (let ((date (file-write-date file))) + (cond + (date) + (t + (warn "~@<Missing FILE-WRITE-DATE for ~S: treating ~ + operation ~S on component ~S as done.~@:>" + file o c) + (return-from operation-done-p t)))))) + (let ((out-files (output-files o c)) + (in-files (input-files o c))) + (cond ((and (not in-files) (not out-files)) + ;; arbitrary decision: an operation that uses nothing to + ;; produce nothing probably isn't doing much + t) + ((not out-files) + (let ((op-done + (gethash (type-of o) + (component-operation-times c)))) + (and op-done + (>= op-done + (apply #'max + (mapcar #'fwd-or-return-t in-files)))))) + ((not in-files) nil) + (t + (and + (every #'probe-file out-files) + (> (apply #'min (mapcar #'file-write-date out-files)) + (apply #'max (mapcar #'fwd-or-return-t in-files))))))))) + +;;; So you look at this code and think "why isn't it a bunch of +;;; methods". And the answer is, because standard method combination +;;; runs :before methods most->least-specific, which is back to front +;;; for our purposes. And CLISP doesn't have non-standard method +;;; combinations, so let's keep it simple and aspire to portability + +(defgeneric traverse (operation component)) +(defmethod traverse ((operation operation) (c component)) + (let ((forced nil)) + (labels ((do-one-dep (required-op required-c required-v) + (let* ((dep-c (or (find-component + (component-parent c) + ;; XXX tacky. really we should build the + ;; in-order-to slot with canonicalized + ;; names instead of coercing this late + (coerce-name required-c) required-v) + (error 'missing-dependency :required-by c + :version required-v + :requires required-c))) + (op (make-sub-operation c operation dep-c required-op))) + (traverse op dep-c))) + (do-dep (op dep) + (cond ((eq op 'feature) + (or (member (car dep) *features*) + (error 'missing-dependency :required-by c + :requires (car dep) :version nil))) + (t + (dolist (d dep) + (cond ((consp d) + (assert (string-equal + (symbol-name (first d)) + "VERSION")) + (appendf forced + (do-one-dep op (second d) (third d)))) + (t + (appendf forced (do-one-dep op d nil))))))))) + (aif (component-visited-p operation c) + (return-from traverse + (if (cdr it) (list (cons 'pruned-op c)) nil))) + ;; dependencies + (if (component-visiting-p operation c) + (error 'circular-dependency :components (list c))) + (setf (visiting-component operation c) t) + (loop for (required-op . deps) in (component-depends-on operation c) + do (do-dep required-op deps)) + ;; constituent bits + (let ((module-ops + (when (typep c 'module) + (let ((at-least-one nil) + (forced nil) + (error nil)) + (loop for kid in (module-components c) + do (handler-case + (appendf forced (traverse operation kid )) + (missing-dependency (condition) + (if (eq (module-if-component-dep-fails c) :fail) + (error condition)) + (setf error condition)) + (:no-error (c) + (declare (ignore c)) + (setf at-least-one t)))) + (when (and (eq (module-if-component-dep-fails c) :try-next) + (not at-least-one)) + (error error)) + forced)))) + ;; now the thing itself + (when (or forced module-ops + (not (operation-done-p operation c)) + (let ((f (operation-forced (operation-ancestor operation)))) + (and f (or (not (consp f)) + (member (component-name + (operation-ancestor operation)) + (mapcar #'coerce-name f) + :test #'string=))))) + (let ((do-first (cdr (assoc (class-name (class-of operation)) + (slot-value c 'do-first))))) + (loop for (required-op . deps) in do-first + do (do-dep required-op deps))) + (setf forced (append (delete 'pruned-op forced :key #'car) + (delete 'pruned-op module-ops :key #'car) + (list (cons operation c)))))) + (setf (visiting-component operation c) nil) + (visit-component operation c (and forced t)) + forced))) + + +(defmethod perform ((operation operation) (c source-file)) + (sysdef-error + "~@<required method PERFORM not implemented ~ + for operation ~A, component ~A~@:>" + (class-of operation) (class-of c))) + +(defmethod perform ((operation operation) (c module)) + nil) + +(defmethod explain ((operation operation) (component component)) + (format *verbose-out* "~&;;; ~A on ~A~%" operation component)) + +;;; compile-op + +(defclass compile-op (operation) + ((proclamations :initarg :proclamations :accessor compile-op-proclamations :initform nil) + (on-warnings :initarg :on-warnings :accessor operation-on-warnings + :initform *compile-file-warnings-behaviour*) + (on-failure :initarg :on-failure :accessor operation-on-failure + :initform *compile-file-failure-behaviour*))) + +(defmethod perform :before ((operation compile-op) (c source-file)) + (map nil #'ensure-directories-exist (output-files operation c))) + +(defmethod perform :after ((operation operation) (c component)) + (setf (gethash (type-of operation) (component-operation-times c)) + (get-universal-time)) + (load-preferences c operation)) + +;;; perform is required to check output-files to find out where to put +;;; its answers, in case it has been overridden for site policy +(defmethod perform ((operation compile-op) (c cl-source-file)) + #-:broken-fasl-loader + (let ((source-file (component-pathname c)) + (output-file (car (output-files operation c)))) + (multiple-value-bind (output warnings-p failure-p) + (compile-file source-file + :output-file output-file) + ;(declare (ignore output)) + (when warnings-p + (case (operation-on-warnings operation) + (:warn (warn + "~@<COMPILE-FILE warned while performing ~A on ~A.~@:>" + operation c)) + (:error (error 'compile-warned :component c :operation operation)) + (:ignore nil))) + (when failure-p + (case (operation-on-failure operation) + (:warn (warn + "~@<COMPILE-FILE failed while performing ~A on ~A.~@:>" + operation c)) + (:error (error 'compile-failed :component c :operation operation)) + (:ignore nil))) + (unless output + (error 'compile-error :component c :operation operation))))) + +(defmethod output-files ((operation compile-op) (c cl-source-file)) + #-:broken-fasl-loader (list (compile-file-pathname (component-pathname c))) + #+:broken-fasl-loader (list (component-pathname c))) + +(defmethod perform ((operation compile-op) (c static-file)) + nil) + +(defmethod output-files ((operation compile-op) (c static-file)) + nil) + +(defmethod input-files ((op compile-op) (c static-file)) + nil) + + +;;; load-op + +(defclass basic-load-op (operation) ()) + +(defclass load-op (basic-load-op) ()) + +(defmethod perform ((o load-op) (c cl-source-file)) + (mapcar #'load (input-files o c))) + +(defmethod perform ((operation load-op) (c static-file)) + nil) +(defmethod operation-done-p ((operation load-op) (c static-file)) + t) + +(defmethod output-files ((o operation) (c component)) + nil) + +(defmethod component-depends-on ((operation load-op) (c component)) + (cons (list 'compile-op (component-name c)) + (call-next-method))) + +;;; load-source-op + +(defclass load-source-op (basic-load-op) ()) + +(defmethod perform ((o load-source-op) (c cl-source-file)) + (let ((source (component-pathname c))) + (setf (component-property c 'last-loaded-as-source) + (and (load source) + (get-universal-time))))) + +(defmethod perform ((operation load-source-op) (c static-file)) + nil) + +(defmethod output-files ((operation load-source-op) (c component)) + nil) + +;;; FIXME: we simply copy load-op's dependencies. this is Just Not Right. +(defmethod component-depends-on ((o load-source-op) (c component)) + (let ((what-would-load-op-do (cdr (assoc 'load-op + (slot-value c 'in-order-to))))) + (mapcar (lambda (dep) + (if (eq (car dep) 'load-op) + (cons 'load-source-op (cdr dep)) + dep)) + what-would-load-op-do))) + +(defmethod operation-done-p ((o load-source-op) (c source-file)) + (if (or (not (component-property c 'last-loaded-as-source)) + (> (file-write-date (component-pathname c)) + (component-property c 'last-loaded-as-source))) + nil t)) + +(defclass test-op (operation) ()) + +(defmethod perform ((operation test-op) (c component)) + nil) + +(defgeneric load-preferences (system operation) + (:documentation "Called to load system preferences after <perform operation system>. Typical uses are to set parameters that don't exist until after the system has been loaded.")) + +(defgeneric preference-file-for-system/operation (system operation) + (:documentation "Returns the pathname of the preference file for this system. Called by 'load-preferences to determine what file to load.")) + +(defmethod load-preferences ((s t) (operation t)) + ;; do nothing + (values)) + +(defmethod load-preferences ((s system) (operation basic-load-op)) + (let* ((*package* (find-package :common-lisp)) + (file (probe-file (preference-file-for-system/operation s operation)))) + (when file + (when *verbose-out* + (format *verbose-out* + "~&~@<; ~@;loading preferences for ~A/~(~A~) from ~A~@:>~%" + (component-name s) + (type-of operation) file)) + (load file)))) + +(defmethod preference-file-for-system/operation ((system t) (operation t)) + ;; cope with anything other than systems + (preference-file-for-system/operation (find-system system t) operation)) + +(defmethod preference-file-for-system/operation ((s system) (operation t)) + (let ((*default-pathname-defaults* + (make-pathname :name nil :type nil + :defaults *default-pathname-defaults*))) + (merge-pathnames + (make-pathname :name (component-name s) + :type "lisp" + :directory '(:relative ".asdf")) + (truename (user-homedir-pathname))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; invoking operations + +(defvar *operate-docstring* + "Operate does three things: + +1. It creates an instance of `operation-class` using any keyword parameters +as initargs. +2. It finds the asdf-system specified by `system` (possibly loading +it from disk). +3. It then calls `traverse` with the operation and system as arguments + +The traverse operation is wrapped in `with-compilation-unit` and error +handling code. If a `version` argument is supplied, then operate also +ensures that the system found satisfies it using the `version-satisfies` +method.") + +(defun operate (operation-class system &rest args &key (verbose t) version + &allow-other-keys) + (let* ((op (apply #'make-instance operation-class + :original-initargs args + args)) + (*verbose-out* (if verbose *standard-output* (make-broadcast-stream))) + (system (if (typep system 'component) system (find-system system)))) + (unless (version-satisfies system version) + (error 'missing-component :requires system :version version)) + (let ((steps (traverse op system))) + (with-compilation-unit () + (loop for (op . component) in steps do + (loop + (restart-case + (progn (perform op component) + (return)) + (retry () + :report + (lambda (s) + (format s "~@<Retry performing ~S on ~S.~@:>" + op component))) + (accept () + :report + (lambda (s) + (format s + "~@<Continue, treating ~S on ~S as ~ + having been successful.~@:>" + op component)) + (setf (gethash (type-of op) + (component-operation-times component)) + (get-universal-time)) + (return))))))))) + +(setf (documentation 'operate 'function) + *operate-docstring*) + +(defun oos (operation-class system &rest args &key force (verbose t) version) + (declare (ignore force verbose version)) + (apply #'operate operation-class system args)) + +(setf (documentation 'oos 'function) + (format nil + "Short for _operate on system_ and an alias for the `operate` function. ~&~&~a" + *operate-docstring*)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; syntax + +(defun remove-keyword (key arglist) + (labels ((aux (key arglist) + (cond ((null arglist) nil) + ((eq key (car arglist)) (cddr arglist)) + (t (cons (car arglist) (cons (cadr arglist) + (remove-keyword + key (cddr arglist)))))))) + (aux key arglist))) + +(defmacro defsystem (name &body options) + (destructuring-bind (&key pathname (class 'system) &allow-other-keys) options + (let ((component-options (remove-keyword :class options))) + `(progn + ;; system must be registered before we parse the body, otherwise + ;; we recur when trying to find an existing system of the same name + ;; to reuse options (e.g. pathname) from + (let ((s (system-registered-p ',name))) + (cond ((and s (eq (type-of (cdr s)) ',class)) + (setf (car s) (get-universal-time))) + (s + #+clisp + (sysdef-error "Cannot redefine the existing system ~A with a different class" s) + #-clisp + (change-class (cdr s) ',class)) + (t + (register-system (quote ,name) + (make-instance ',class :name ',name))))) + (parse-component-form nil (apply + #'list + :module (coerce-name ',name) + :pathname + (or ,pathname + (when *load-truename* + (pathname-sans-name+type + (resolve-symlinks *load-truename*))) + *default-pathname-defaults*) + ',component-options)))))) + + +(defun class-for-type (parent type) + (let* ((extra-symbols (list (find-symbol (symbol-name type) *package*) + (find-symbol (symbol-name type) + (load-time-value + (package-name :asdf))))) + (class (dolist (symbol (if (keywordp type) + extra-symbols + (cons type extra-symbols))) + (when (and symbol + (find-class symbol nil) + (subtypep symbol 'component)) + (return (find-class symbol)))))) + (or class + (and (eq type :file) + (or (module-default-component-class parent) + (find-class 'cl-source-file))) + (sysdef-error "~@<don't recognize component type ~A~@:>" type)))) + +(defun maybe-add-tree (tree op1 op2 c) + "Add the node C at /OP1/OP2 in TREE, unless it's there already. +Returns the new tree (which probably shares structure with the old one)" + (let ((first-op-tree (assoc op1 tree))) + (if first-op-tree + (progn + (aif (assoc op2 (cdr first-op-tree)) + (if (find c (cdr it)) + nil + (setf (cdr it) (cons c (cdr it)))) + (setf (cdr first-op-tree) + (acons op2 (list c) (cdr first-op-tree)))) + tree) + (acons op1 (list (list op2 c)) tree)))) + +(defun union-of-dependencies (&rest deps) + (let ((new-tree nil)) + (dolist (dep deps) + (dolist (op-tree dep) + (dolist (op (cdr op-tree)) + (dolist (c (cdr op)) + (setf new-tree + (maybe-add-tree new-tree (car op-tree) (car op) c)))))) + new-tree)) + + +(defun remove-keys (key-names args) + (loop for ( name val ) on args by #'cddr + unless (member (symbol-name name) key-names + :key #'symbol-name :test 'equal) + append (list name val))) + +(defvar *serial-depends-on*) + +(defun parse-component-form (parent options) + + (destructuring-bind + (type name &rest rest &key + ;; the following list of keywords is reproduced below in the + ;; remove-keys form. important to keep them in sync + components pathname default-component-class + perform explain output-files operation-done-p + weakly-depends-on + depends-on serial in-order-to + ;; list ends + &allow-other-keys) options + (declare (ignorable perform explain output-files operation-done-p)) + (check-component-input type name weakly-depends-on depends-on components in-order-to) + + (when (and parent + (find-component parent name) + ;; ignore the same object when rereading the defsystem + (not + (typep (find-component parent name) + (class-for-type parent type)))) + (error 'duplicate-names :name name)) + + (let* ((other-args (remove-keys + '(components pathname default-component-class + perform explain output-files operation-done-p + weakly-depends-on + depends-on serial in-order-to) + rest)) + (ret + (or (find-component parent name) + (make-instance (class-for-type parent type))))) + (when weakly-depends-on + (setf depends-on (append depends-on (remove-if (complement #'find-system) weakly-depends-on)))) + (when (boundp '*serial-depends-on*) + (setf depends-on + (concatenate 'list *serial-depends-on* depends-on))) + (apply #'reinitialize-instance + ret + :name (coerce-name name) + :pathname pathname + :parent parent + other-args) + (when (typep ret 'module) + (setf (module-default-component-class ret) + (or default-component-class + (and (typep parent 'module) + (module-default-component-class parent)))) + (let ((*serial-depends-on* nil)) + (setf (module-components ret) + (loop for c-form in components + for c = (parse-component-form ret c-form) + collect c + if serial + do (push (component-name c) *serial-depends-on*)))) + + ;; check for duplicate names + (let ((name-hash (make-hash-table :test #'equal))) + (loop for c in (module-components ret) + do + (if (gethash (component-name c) + name-hash) + (error 'duplicate-names + :name (component-name c)) + (setf (gethash (component-name c) + name-hash) + t))))) + + (setf (slot-value ret 'in-order-to) + (union-of-dependencies + in-order-to + `((compile-op (compile-op ,@depends-on)) + (load-op (load-op ,@depends-on)))) + (slot-value ret 'do-first) `((compile-op (load-op ,@depends-on)))) + + (%remove-component-inline-methods ret rest) + + ret))) + +(defun %remove-component-inline-methods (ret rest) + (loop for name in +asdf-methods+ + do (map 'nil + ;; this is inefficient as most of the stored + ;; methods will not be for this particular gf n + ;; But this is hardly performance-critical + (lambda (m) + (remove-method (symbol-function name) m)) + (component-inline-methods ret))) + ;; clear methods, then add the new ones + (setf (component-inline-methods ret) nil) + (loop for name in +asdf-methods+ + for v = (getf rest (intern (symbol-name name) :keyword)) + when v do + (destructuring-bind (op qual (o c) &body body) v + (pushnew + (eval `(defmethod ,name ,qual ((,o ,op) (,c (eql ,ret))) + ,@body)) + (component-inline-methods ret))))) + +(defun check-component-input (type name weakly-depends-on depends-on components in-order-to) + "A partial test of the values of a component." + (when weakly-depends-on (warn "We got one! XXXXX")) + (unless (listp depends-on) + (sysdef-error-component ":depends-on must be a list." + type name depends-on)) + (unless (listp weakly-depends-on) + (sysdef-error-component ":weakly-depends-on must be a list." + type name weakly-depends-on)) + (unless (listp components) + (sysdef-error-component ":components must be NIL or a list of components." + type name components)) + (unless (and (listp in-order-to) (listp (car in-order-to))) + (sysdef-error-component ":in-order-to must be NIL or a list of components." + type name in-order-to))) + +(defun sysdef-error-component (msg type name value) + (sysdef-error (concatenate 'string msg + "~&The value specified for ~(~A~) ~A is ~W") + type name value)) + +(defun resolve-symlinks (path) + #-allegro (truename path) + #+allegro (excl:pathname-resolve-symbolic-links path) + ) + +;;; optional extras + +;;; run-shell-command functions for other lisp implementations will be +;;; gratefully accepted, if they do the same thing. If the docstring +;;; is ambiguous, send a bug report + +(defun run-shell-command (control-string &rest args) + "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and +synchronously execute the result using a Bourne-compatible shell, with +output to *VERBOSE-OUT*. Returns the shell's exit code." + (let ((command (apply #'format nil control-string args))) + (format *verbose-out* "; $ ~A~%" command) + #+sbcl + (sb-ext:process-exit-code + (sb-ext:run-program + #+win32 "sh" #-win32 "/bin/sh" + (list "-c" command) + #+win32 #+win32 :search t + :input nil :output *verbose-out*)) + + #+(or cmu scl) + (ext:process-exit-code + (ext:run-program + "/bin/sh" + (list "-c" command) + :input nil :output *verbose-out*)) + + #+allegro + (excl:run-shell-command command :input nil :output *verbose-out*) + + #+lispworks + (system:call-system-showing-output + command + :shell-type "/bin/sh" + :output-stream *verbose-out*) + + #+clisp ;XXX not exactly *verbose-out*, I know + (ext:run-shell-command command :output :terminal :wait t) + + #+openmcl + (nth-value 1 + (ccl:external-process-status + (ccl:run-program "/bin/sh" (list "-c" command) + :input nil :output *verbose-out* + :wait t))) + #+ecl ;; courtesy of Juan Jose Garcia Ripoll + (si:system command) + #-(or openmcl clisp lispworks allegro scl cmu sbcl ecl) + (error "RUN-SHELL-PROGRAM not implemented for this Lisp") + )) + + +(defgeneric hyperdocumentation (package name doc-type)) +(defmethod hyperdocumentation ((package symbol) name doc-type) + (hyperdocumentation (find-package package) name doc-type)) + +(defun hyperdoc (name doc-type) + (hyperdocumentation (symbol-package name) name doc-type)) + +(defun system-source-file (system-name) + (let ((system (asdf:find-system system-name))) + (make-pathname + :type "asd" + :name (asdf:component-name system) + :defaults (asdf:component-relative-pathname system)))) + +(defun system-source-directory (system-name) + (make-pathname :name nil + :type nil + :defaults (system-source-file system-name))) + +(defun system-relative-pathname (system pathname &key name type) + (let ((directory (pathname-directory pathname))) + (when (eq (car directory) :absolute) + (setf (car directory) :relative)) + (merge-pathnames + (make-pathname :name (or name (pathname-name pathname)) + :type (or type (pathname-type pathname)) + :directory directory) + (system-source-directory system)))) + + +(pushnew :asdf *features*) + +#+sbcl +(eval-when (:compile-toplevel :load-toplevel :execute) + (when (sb-ext:posix-getenv "SBCL_BUILDING_CONTRIB") + (pushnew :sbcl-hooks-require *features*))) + +#+(and sbcl sbcl-hooks-require) +(progn + (defun module-provide-asdf (name) + (handler-bind ((style-warning #'muffle-warning)) + (let* ((*verbose-out* (make-broadcast-stream)) + (system (asdf:find-system name nil))) + (when system + (asdf:operate 'asdf:load-op name) + t)))) + + (defun contrib-sysdef-search (system) + (let ((home (sb-ext:posix-getenv "SBCL_HOME"))) + (when home + (let* ((name (coerce-name system)) + (home (truename home)) + (contrib (merge-pathnames + (make-pathname :directory `(:relative ,name) + :name name + :type "asd" + :case :local + :version :newest) + home))) + (probe-file contrib))))) + + (pushnew + '(let ((home (sb-ext:posix-getenv "SBCL_HOME"))) + (when home + (merge-pathnames "site-systems/" (truename home)))) + *central-registry*) + + (pushnew + '(merge-pathnames ".sbcl/systems/" + (user-homedir-pathname)) + *central-registry*) + + (pushnew 'module-provide-asdf sb-ext:*module-provider-functions*) + (pushnew 'contrib-sysdef-search *system-definition-search-functions*)) + +(provide 'asdf) + Added: branches/trunk-reorg/thirdparty/asdf/asdf.texinfo =================================================================== --- branches/trunk-reorg/thirdparty/asdf/asdf.texinfo 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/asdf.texinfo 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,1286 @@ +\input texinfo @c -*- texinfo -*- +@c %**start of header +@setfilename asdf.info +@settitle asdf Manual +@c %**end of header + +@c for install-info +@dircategory Software development +@direntry +* asdf: (asdf). another system definition facility +@end direntry + +@copying +This manual describes asdf, a system definition facility for Common +Lisp programs and libraries. + +asdf Copyright @copyright{} 2001-2007 Daniel Barlow and contributors + +This manual Copyright @copyright{} 2001-2007 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. + +@end copying + + + +@titlepage +@title asdf: another system definition facility + +@c The following two commands start the copyright page. +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@c Output the table of contents at the beginning. +@contents + +@c ------------------- + +@ifnottex + +@node Top, Using asdf to load systems, (dir), (dir) +@top asdf: another system definition facility + +@insertcopying + +@menu +* Using asdf to load systems:: +* Defining systems with defsystem:: +* The object model of asdf:: +* Error handling:: +* Compilation error and warning handling:: +* Miscellaneous additional functionality:: +* Getting the latest version:: +* TODO list:: +* missing bits in implementation:: +* Inspiration:: +* Concept Index:: +* Function and Class Index:: +* Variable Index:: + +@detailmenu + --- The Detailed Node Listing --- + +Defining systems with defsystem + +* The defsystem form:: +* A more involved example:: +* The defsystem grammar:: + +The object model of asdf + +* Operations:: +* Components:: + +Operations + +* Predefined operations of asdf:: +* Creating new operations:: + +Components + +* Common attributes of components:: +* Pre-defined subclasses of component:: +* Creating new component types:: + +properties + +* Pre-defined subclasses of component:: +* Creating new component types:: + +@end detailmenu +@end menu + +@end ifnottex + +@c ------------------- + + +@node Using asdf to load systems, Defining systems with defsystem, Top, Top +@comment node-name, next, previous, up +@chapter Using asdf to load systems +@cindex system directory designator +@vindex *central-registry* + +This chapter describes how to use asdf to compile and load ready-made +Lisp programs and libraries. + +@section Downloading asdf + +Some Lisp implementations (such as SBCL and OpenMCL) come with asdf +included already, so you don't need to download it separately. +Consult your Lisp system's documentation. If you need to download +asdf and install it by hand, the canonical source is the cCLan CVS +repository at +@url{http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/cclan/asdf/}. + +@section Setting up asdf + +The single file @file{asdf.lisp} is all you need to use asdf normally. +Once you load it in a running Lisp, you're ready to use asdf. For +maximum convenience you might want to have asdf loaded whenever you +start your Lisp implementation, for example by loading it from the +startup script or dumping a custom core -- check your Lisp +implementation's manual for details. + +The variable @code{asdf:*central-registry*} is a list of ``system +directory designators''@footnote{When we say ``directory'' here, we +mean ``designator for a pathname with a supplied DIRECTORY +component''.}. A @dfn{system directory designator} is a form which +will be evaluated whenever a system is to be found, and must evaluate +to a directory to look in. You might want to set or augment +@code{*central-registry*} in your Lisp init file, for example: + +@lisp +(setf asdf:*central-registry* + (list* '*default-pathname-defaults* + #p"/home/me/cl/systems/" + #p"/usr/share/common-lisp/systems/" + asdf:*central-registry*)) +@end lisp + +@section Setting up a system to be loaded + +To compile and load a system, you need to ensure that a symbolic link to its +system definition is in one of the directories in +@code{*central-registry*}@footnote{It is possible to customize the +system definition file search. That's considered advanced use, and +covered later: search forward for +@code{*system-definition-search-functions*}. @xref{Defining systems +with defsystem}.}. + +For example, if @code{#p"/home/me/cl/systems/"} (note the trailing +slash) is a member of @code{*central-registry*}, you would set up a +system @var{foo} that is stored in a directory +@file{/home/me/src/foo/} for loading with asdf with the following +commands at the shell (this has to be done only once): + +@example +$ cd /home/me/cl/systems/ +$ ln -s ~/src/foo/foo.asd . +@end example + +@section Loading a system + +The system @var{foo} is loaded (and compiled, if necessary) by +evaluating the following form in your Lisp implementation: + +@example +(asdf:operate 'asdf:load-op '@var{foo}) +@end example + +Output from asdf and asdf extensions are supposed to be sent to the CL +stream @code{*standard-output*}, and so rebinding that stream around +calls to @code{asdf:operate} should redirect all output from asdf +operations. + +That's all you need to know to use asdf to load systems written by +others. The rest of this manual deals with writing system +definitions for Lisp software you write yourself. + +@node Defining systems with defsystem, The object model of asdf, Using asdf to load systems, Top +@comment node-name, next, previous, up +@chapter Defining systems with defsystem + +This chapter describes how to use asdf to define systems and develop +software. + + +@menu +* The defsystem form:: +* A more involved example:: +* The defsystem grammar:: +* Other code in .asd files:: +@end menu + +@node The defsystem form, A more involved example, Defining systems with defsystem, Defining systems with defsystem +@comment node-name, next, previous, up +@section The defsystem form + +Systems can be constructed programmatically by instantiating +components using make-instance. Most of the time, however, it is much +more practical to use a static @code{defsystem} form. This section +begins with an example of a system definition, then gives the full +grammar of @code{defsystem}. + +Let's look at a simple system. This is a complete file that would +usually be saved as @file{hello-lisp.asd}: + +@lisp +(defpackage hello-lisp-system + (:use :common-lisp :asdf)) + +(in-package :hello-lisp-system) + +(defsystem "hello-lisp" + :description "hello-lisp: a sample Lisp system." + :version "0.2" + :author "Joe User <joe@@example.com>" + :licence "Public Domain" + :components ((:file "packages") + (:file "macros" :depends-on ("packages")) + (:file "hello" :depends-on ("macros")))) +@end lisp + +Some notes about this example: + +@itemize + +@item +The file starts with @code{defpackage} and @code{in-package} forms to +make and use a package expressly for defining this system in. This +package is named by taking the system name and suffixing +@code{-system} - note that it is @emph{not} the same package as you +will use for the application code. + +This is not absolutely required by asdf, but helps avoid namespace +pollution and so is considered good form. + +@item +The defsystem form defines a system named "hello-lisp" that contains +three source files: @file{packages}, @file{macros} and @file{hello}. + +@item +The file @file{macros} depends on @file{packages} (presumably because +the package it's in is defined in @file{packages}), and the file +@file{hello} depends on @file{macros} (and hence, transitively on +@file{packages}). This means that asdf will compile and load +@file{packages} and @file{macros} before starting the compilation of +file @file{hello}. + + +@item +The files are located in the same directory as the file with the +system definition. asdf resolves symbolic links before loading the system +definition file and stores its location in the resulting +system@footnote{It is possible, though almost never necessary, to +override this behaviour.}. This is a good thing because the user can +move the system sources without having to edit the system definition. + +@end itemize + +@node A more involved example, The defsystem grammar, The defsystem form, Defining systems with defsystem +@comment node-name, next, previous, up +@section A more involved example + +Let's illustrate some more involved uses of @code{defsystem} via a +slightly convoluted example: + +@lisp +(defsystem "foo" + :version "1.0" + :components ((:module "foo" :components ((:file "bar") (:file"baz") + (:file "quux")) + :perform (compile-op :after (op c) + (do-something c)) + :explain (compile-op :after (op c) + (explain-something c))) + (:file "blah"))) +@end lisp + +The method-form tokens need explaining: essentially, this part: + +@lisp + :perform (compile-op :after (op c) + (do-something c)) + :explain (compile-op :after (op c) + (explain-something c)) +@end lisp + +has the effect of + +@lisp +(defmethod perform :after ((op compile-op) (c (eql ...))) + (do-something c)) +(defmethod explain :after ((op compile-op) (c (eql ...))) + (explain-something c)) +@end lisp + +where @code{...} is the component in question; note that although this +also supports @code{:before} methods, they may not do what you want +them to -- a @code{:before} method on perform @code{((op compile-op) (c +(eql ...)))} will run after all the dependencies and sub-components +have been processed, but before the component in question has been +compiled. + +@node The defsystem grammar, Other code in .asd files, A more involved example, Defining systems with defsystem +@comment node-name, next, previous, up +@section The defsystem grammar + +@verbatim +system-definition := ( defsystem system-designator {option}* ) + +option := :components component-list + | :pathname pathname + | :default-component-class + | :perform method-form + | :explain method-form + | :output-files method-form + | :operation-done-p method-form + | :depends-on ( {simple-component-name}* ) + | :serial [ t | nil ] + | :in-order-to ( {dependency}+ ) + +component-list := ( {component-def}* ) + +component-def := simple-component-name + | ( component-type name {option}* ) + +component-type := :module | :file | :system | other-component-type + +dependency := (dependent-op {requirement}+) +requirement := (required-op {required-component}+) + | (feature feature-name) +dependent-op := operation-name +required-op := operation-name | feature +@end verbatim + +@subsection Serial dependencies + +If the @code{:serial t} option is specified for a module, asdf will add +dependencies for each each child component, on all the children +textually preceding it. This is done as if by @code{:depends-on}. + +@lisp +:components ((:file "a") (:file "b") (:file "c")) +:serial t +@end lisp + +is equivalent to + +@lisp +:components ((:file "a") + (:file "b" :depends-on ("a")) + (:file "c" :depends-on ("a" "b"))) +@end lisp + + +@subsection Source location + +The @code{:pathname} option is optional in all cases for systems +defined via @code{defsystem}, and in the usual case the user is +recommended not to supply it. + +Instead, asdf follows a hairy set of rules that are designed so that +@enumerate +@item @code{find-system} will load a system from disk and have its pathname +default to the right place +@item this pathname information will not be +overwritten with @code{*default-pathname-defaults*} (which could be +somewhere else altogether) if the user loads up the @file{.asd} file +into his editor and interactively re-evaluates that form. +@end enumerate + +If a system is being loaded for the first time, its top-level pathname +will be set to: + +@itemize +@item The host/device/directory parts of @code{*load-truename*}, if it is bound +@item @code{*default-pathname-defaults*}, otherwise +@end itemize + +If a system is being redefined, the top-level pathname will be + +@itemize +@item +changed, if explicitly supplied or obtained from +@code{*load-truename*} (so that an updated source location is +reflected in the system definition) +@item +changed if it had previously been set from +@code{*default-pathname-defaults*} +@item +left as before, if it had previously been set from +@code{*load-truename*} and @code{*load-truename*} is currently +unbound (so that a developer can evaluate a @code{defsystem} form from +within an editor without clobbering its source location) +@end itemize + +@node Other code in .asd files, , The defsystem grammar, Defining systems with defsystem +@section Other code in .asd files + +Files containing defsystem forms are regular Lisp files that are +executed by @code{load}. Consequently, you can put whatever Lisp code +you like into these files (e.g., code that examines the compile-time +environment and adds appropriate features to @code{*features*}). +However, some conventions should be followed, so that users can +control certain details of execution of the Lisp in .asd files: + +@itemize +@item +Any informative output (other than warnings and errors, which are the +condition system's to dispose of) should be sent to the standard CL +stream @code{*standard-output*}, so that users can easily control the +disposition of output from asdf operations. +@end itemize + + +@node The object model of asdf, Error handling, Defining systems with defsystem, Top +@comment node-name, next, previous, up +@chapter The object model of asdf + +asdf is designed in an object-oriented way from the ground up. Both a +system's structure and the operations that can be performed on systems +follow a protocol. asdf is extensible to new operations and to new +component types. This allows the addition of behaviours: for example, +a new component could be added for Java JAR archives, and methods +specialised on @code{compile-op} added for it that would accomplish the +relevant actions. + +This chapter deals with @emph{components}, the building blocks of a +system, and @emph{operations}, the actions that can be performed on a +system. + + + +@menu +* Operations:: +* Components:: +@end menu + +@node Operations, Components, The object model of asdf, The object model of asdf +@comment node-name, next, previous, up +@section Operations +@cindex operation + +An @dfn{operation} object of the appropriate type is instantiated +whenever the user wants to do something with a system like + +@itemize +@item compile all its files +@item load the files into a running lisp environment +@item copy its source files somewhere else +@end itemize + +Operations can be invoked directly, or examined to see what their +effects would be without performing them. @emph{FIXME: document how!} There +are a bunch of methods specialised on operation and component type +that actually do the grunt work. + +The operation object contains whatever state is relevant for this +purpose (perhaps a list of visited nodes, for example) but primarily +is a nice thing to specialise operation methods on and easier than +having them all be EQL methods. + +Operations are invoked on systems via @code{operate}. + +@deffn {Generic function} operate operation system &rest initargs +@deffnx {Generic function} oos operation system &rest initargs +@code{operate} invokes @var{operation} on @var{system}. @code{oos} +is a synonym for @code{operate}. + +@var{operation} is a symbol that is passed, along with the supplied +@var{initargs}, to @code{make-instance} to create the operation object. +@var{system} is a system designator. + +The initargs are passed to the @code{make-instance} call when creating +the operation object. Note that dependencies may cause the operation +to invoke other operations on the system or its components: the new +operations will be created with the same initargs as the original one. + +@end deffn + +@menu +* Predefined operations of asdf:: +* Creating new operations:: +@end menu + +@node Predefined operations of asdf, Creating new operations, Operations, Operations +@comment node-name, next, previous, up +@subsection Predefined operations of asdf + +All the operations described in this section are in the @code{asdf} +package. They are invoked via the @code{operate} generic function. + +@lisp +(asdf:operate 'asdf:@var{operation-name} '@var{system-name} @{@var{operation-options ...}@}) +@end lisp + +@deffn Operation compile-op &key proclamations + +This operation compiles the specified component. If proclamations are +supplied, they will be proclaimed. This is a good place to specify +optimization settings. + +When creating a new component type, you should provide methods for +@code{compile-op}. + +When @code{compile-op} is invoked, component dependencies often cause +some parts of the system to be loaded as well as compiled. Invoking +@code{compile-op} does not necessarily load all the parts of the +system, though; use @code{load-op} to load a system. +@end deffn + +@deffn Operation load-op &key proclamations + +This operation loads a system. + +The default methods for @code{load-op} compile files before loading them. +For parity, your own methods on new component types should probably do +so too. +@end deffn + +@deffn Operation load-source-op + +This operation will load the source for the files in a module even if +the source files have been compiled. Systems sometimes have knotty +dependencies which require that sources are loaded before they can be +compiled. This is how you do that. + +If you are creating a component type, you need to implement this +operation - at least, where meaningful. +@end deffn + +@deffn Operation test-system-version &key minimum + +Asks the system whether it satisfies a version requirement. + +The default method accepts a string, which is expected to contain of a +number of integers separated by #\. characters. The method is not +recursive. The component satisfies the version dependency if it has +the same major number as required and each of its sub-versions is +greater than or equal to the sub-version number required. + +@lisp +(defun version-satisfies (x y) + (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)))))) +@end lisp + +If that doesn't work for your system, you can override it. I hope +you have as much fun writing the new method as @verb{|#lisp|} did +reimplementing this one. +@end deffn + +@deffn Operation feature-dependent-op + +An instance of @code{feature-dependent-op} will ignore any components +which have a @code{features} attribute, unless the feature combination +it designates is satisfied by @code{*features*}. This operation is +not intended to be instantiated directly, but other operations may +inherit from it. + +@end deffn + +@node Creating new operations, , Predefined operations of asdf, Operations +@comment node-name, next, previous, up +@subsection Creating new operations + +asdf was designed to be extensible in an object-oriented fashion. To +teach asdf new tricks, a programmer can implement the behaviour he +wants by creating a subclass of @code{operation}. + + +asdf's pre-defined operations are in no way ``privileged'', but it is +requested that developers never use the @code{asdf} package for +operations they develop themselves. The rationale for this rule is +that we don't want to establish a ``global asdf operation name +registry'', but also want to avoid name clashes. + +An operation must provide methods for the following generic functions +when invoked with an object of type @code{source-file}: @emph{FIXME describe +this better} + +@itemize + +@item @code{output-files} +@item @code{perform} +The @code{perform} method must call @code{output-files} to find out +where to put its files, because the user is allowed to override +@item @code{output-files} for local policy @code{explain} +@item @code{operation-done-p}, if you don't like the default one + +@end itemize + +Operations that print output should send that output to the standard +CL stream @code{*standard-output*}, as the Lisp compiler and loader do. + +@node Components, , Operations, The object model of asdf +@comment node-name, next, previous, up +@section Components +@cindex component +@cindex system +@cindex system designator +@vindex *system-definition-search-functions* + +A @dfn{component} represents a source file or (recursively) a +collection of components. A @dfn{system} is (roughly speaking) a +top-level component that can be found via @code{find-system}. + +A @dfn{system designator} is a string or symbol and behaves just like +any other component name (including with regard to the case conversion +rules for component names). + + +@defun find-system system-designator &optional (error-p t) + +Given a system designator, @code{find-system} finds and returns a +system. If no system is found, an error of type +@code{missing-component} is thrown, or @code{nil} is returned if +@code{error-p} is false. + +To find and update systems, @code{find-system} funcalls each element +in the @code{*system-definition-search-functions*} list, expecting a +pathname to be returned. The resulting pathname is loaded if either +of the following conditions is true: + +@itemize +@item there is no system of that name in memory +@item the file's last-modified time exceeds the last-modified time of the + system in memory +@end itemize + +When system definitions are loaded from @file{.asd} files, a new +scratch package is created for them to load into, so that different +systems do not overwrite each others operations. The user may also +wish to (and is recommended to) include @code{defpackage} and +@code{in-package} forms in his system definition files, however, so +that they can be loaded manually if need be. + +The default value of @code{*system-definition-search-functions*} is a +function that looks in each of the directories given by evaluating +members of @code{*central-registry*} for a file whose name is the +name of the system and whose type is @file{asd}. The first such file +is returned, whether or not it turns out to actually define the +appropriate system. Hence, it is strongly advised to define a system +@var{foo} in the corresponding file @var{foo.asd}. +@end defun + + +@menu +* Common attributes of components:: +* Pre-defined subclasses of component:: +* Creating new component types:: +@end menu + +@node Common attributes of components, Pre-defined subclasses of component, Components, Components +@comment node-name, next, previous, up +@subsection Common attributes of components + +All components, regardless of type, have the following attributes. +All attributes except @code{name} are optional. + +@subsubsection Name + +A component name is a string or a symbol. If a symbol, its name is +taken and lowercased. The name must be a suitable value for the +@code{:name} initarg to @code{make-pathname} in whatever filesystem +the system is to be found. + +The lower-casing-symbols behaviour is unconventional, but was selected +after some consideration. Observations suggest that the type of +systems we want to support either have lowercase as customary case +(Unix, Mac, windows) or silently convert lowercase to uppercase +(lpns), so this makes more sense than attempting to use @code{:case +:common} as argument to @code{make-pathname}, which is reported not to +work on some implementations + +@subsubsection Version identifier + +This optional attribute is used by the test-system-version +operation. @xref{Predefined operations of asdf}. For the default method of +test-system-version, the version should be a string of intergers +separated by dots, for example @samp{1.0.11}. + +@subsubsection Required features + +Traditionally defsystem users have used reader conditionals to include +or exclude specific per-implementation files. This means that any +single implementation cannot read the entire system, which becomes a +problem if it doesn't wish to compile it, but instead for example to +create an archive file containing all the sources, as it will omit to +process the system-dependent sources for other systems. + +Each component in an asdf system may therefore specify features using +the same syntax as #+ does, and it will (somehow) be ignored for +certain operations unless the feature conditional is a member of +@code{*features*}. + + +@subsubsection Dependencies + +This attribute specifies dependencies of the component on its +siblings. It is optional but often necessary. + +There is an excitingly complicated relationship between the initarg +and the method that you use to ask about dependencies + +Dependencies are between (operation component) pairs. In your +initargs for the component, you can say + +@lisp +:in-order-to ((compile-op (load-op "a" "b") (compile-op "c")) + (load-op (load-op "foo"))) +@end lisp + +This means the following things: +@itemize +@item +before performing compile-op on this component, we must perform +load-op on @var{a} and @var{b}, and compile-op on @var{c}, +@item +before performing @code{load-op}, we have to load @var{foo} +@end itemize + +The syntax is approximately + +@verbatim +(this-op {(other-op required-components)}+) + +required-components := component-name + | (required-components required-components) + +component-name := string + | (:version string minimum-version-object) +@end verbatim + +Side note: + +This is on a par with what ACL defsystem does. mk-defsystem is less +general: it has an implied dependency + +@verbatim + for all x, (load x) depends on (compile x) +@end verbatim + +and using a @code{:depends-on} argument to say that @var{b} depends on +@var{a} @emph{actually} means that + +@verbatim + (compile b) depends on (load a) +@end verbatim + +This is insufficient for e.g. the McCLIM system, which requires that +all the files are loaded before any of them can be compiled ] + +End side note + +In asdf, the dependency information for a given component and +operation can be queried using @code{(component-depends-on operation +component)}, which returns a list + +@lisp +((load-op "a") (load-op "b") (compile-op "c") ...) +@end lisp + +@code{component-depends-on} can be subclassed for more specific +component/operation types: these need to @code{(call-next-method)} and +append the answer to their dependency, unless they have a good reason +for completely overriding the default dependencies + +(If it weren't for CLISP, we'd be using a @code{LIST} method +combination to do this transparently. But, we need to support CLISP. +If you have the time for some CLISP hacking, I'm sure they'd welcome +your fixes) + +@subsubsection pathname + +This attribute is optional and if absent will be inferred from the +component's name, type (the subclass of source-file), and the location +of its parent. + +The rules for this inference are: + +(for source-files) +@itemize +@item the host is taken from the parent +@item pathname type is @code{(source-file-type component system)} +@item the pathname case option is @code{:local} +@item the pathname is merged against the parent +@end itemize + +(for modules) +@itemize +@item the host is taken from the parent +@item the name and type are @code{NIL} +@item the directory is @code{(:relative component-name)} +@item the pathname case option is @code{:local} +@item the pathname is merged against the parent +@end itemize + +Note that the DEFSYSTEM operator (used to create a ``top-level'' +system) does additional processing to set the filesystem location of +the top component in that system. This is detailed +elsewhere, @xref{Defining systems with defsystem}. + +The answer to the frequently asked question "how do I create a system +definition where all the source files have a .cl extension" is thus + +@lisp +(defmethod source-file-type ((c cl-source-file) (s (eql (find-system 'my-sys)))) + "cl") +@end lisp + +@subsubsection properties + +This attribute is optional. + +Packaging systems often require information about files or systems in +addition to that specified by asdf's pre-defined component attributes. +Programs that create vendor packages out of asdf systems therefore +have to create ``placeholder'' information to satisfy these systems. +Sometimes the creator of an asdf system may know the additional +information and wish to provide it directly. + +(component-property component property-name) and associated setf +method will allow the programmatic update of this information. +Property names are compared as if by @code{EQL}, so use symbols or +keywords or something. + +@menu +* Pre-defined subclasses of component:: +* Creating new component types:: +@end menu + +@node Pre-defined subclasses of component, Creating new component types, Common attributes of components, Components +@comment node-name, next, previous, up +@subsection Pre-defined subclasses of component + +@deffn Component source-file + +A source file is any file that the system does not know how to +generate from other components of the system. + +Note that this is not necessarily the same thing as ``a file +containing data that is typically fed to a compiler''. If a file is +generated by some pre-processor stage (e.g. a @file{.h} file from +(a)file{.h.in} by autoconf) then it is not, by this definition, a source +file. Conversely, we might have a graphic file that cannot be +automatically regenerated, or a proprietary shared library that we +received as a binary: these do count as source files for our purposes. + +Subclasses of source-file exist for various languages. @emph{FIXME: +describe these.} +@end deffn + +@deffn Component module + +A module is a collection of sub-components. + +A module component has the following extra initargs: + +@itemize +@item +@code{:components} the components contained in this module + +@item +@code{:default-component-class} All child components which don't +specify their class explicitly are inferred to be of this type. + +@item +@code{:if-component-dep-fails} This attribute takes one of the values +@code{:fail}, @code{:try-next}, @code{:ignore}, its default value is +@code{:fail}. The other values can be used for implementing +conditional compilation based on implementation @code{*features*}, for +the case where it is not necessary for all files in a module to be +compiled. + +@item +@code{:serial} When this attribute is set, each subcomponent of this +component is assumed to depend on all subcomponents before it in the +list given to @code{:components}, i.e. all of them are loaded before +a compile or load operation is performed on it. + +@end itemize + +The default operation knows how to traverse a module, so most +operations will not need to provide methods specialised on modules. + +@code{module} may be subclassed to represent components such as +foreign-language linked libraries or archive files. +@end deffn + +@deffn Component system + +@code{system} is a subclass of @code{module}. + +A system is a module with a few extra attributes for documentation +purposes; these are given elsewhere. @xref{The defsystem grammar}. + +Users can create new classes for their systems: the default +@code{defsystem} macro takes a @code{:classs} keyword +argument. +@end deffn + +@node Creating new component types, , Pre-defined subclasses of component, Components +@comment node-name, next, previous, up +@subsection Creating new component types + +New component types are defined by subclassing one of the existing +component classes and specializing methods on the new component class. + +@emph{FIXME: this should perhaps be explained more throughly, not only by +example ...} + +As an example, suppose we have some implementation-dependent +functionality that we want to isolate in one subdirectory per Lisp +implementation our system supports. We create a subclass of +@code{cl-source-file}: + +@lisp +(defclass unportable-cl-source-file (cl-source-file) + ()) +@end lisp + +A hypothetical function @code{system-dependent-dirname} gives us the +name of the subdirectory. All that's left is to define how to +calculate the pathname of an @code{unportable-cl-source-file}. + +@lisp +(defmethod component-pathname ((component unportable-cl-source-file)) + (let ((pathname (call-next-method)) + (name (string-downcase (system-dependent-dirname)))) + (merge-pathnames + (make-pathname :directory (list :relative name)) + pathname))) +@end lisp + +The new component type is used in a @code{defsystem} form in this way: + +@lisp +(defsystem :foo + :components + ((:file "packages") + ... + (:unportable-cl-source-file "threads" + :depends-on ("packages" ...)) + ... + ) +@end lisp + +@node Error handling, Compilation error and warning handling, The object model of asdf, Top +@comment node-name, next, previous, up +@chapter Error handling +@findex SYSTEM-DEFINITION-ERROR +@findex OPERATION-ERROR + +It is an error to define a system incorrectly: an implementation may +detect this and signal a generalised instance of +@code{SYSTEM-DEFINITION-ERROR}. + +Operations may go wrong (for example when source files contain +errors). These are signalled using generalised instances of +@code{OPERATION-ERROR}. + +@node Compilation error and warning handling, Miscellaneous additional functionality, Error handling, Top +@comment node-name, next, previous, up +@chapter Compilation error and warning handling +@vindex *compile-file-warnings-behaviour* +@vindex *compile-file-errors-behavior* + +ASDF checks for warnings and errors when a file is compiled. The +variables @code{*compile-file-warnings-behaviour*} and +@code{*compile-file-errors-behavior*} controls the handling of any +such events. The valid values for these variables are @code{:error}, +@code{:warn}, and @code{:ignore}. + +@node Miscellaneous additional functionality, Getting the latest version, Compilation error and warning handling, Top +@comment node-name, next, previous, up +@chapter Additional Functionality + +ASDF includes several additional features that are generally +useful for system definition and development. These include: + +@enumerate +@item +system-relative-pathname + +It's often handy to locate a file relative to some system. The system-relative-pathname function meets this need. It takes two arguments: the name of a system and a relative pathname. It returns a pathname built from the +location of the system's source file and the relative pathname. For example + +@lisp +> (asdf:system-relative-pathname 'cl-ppcre "regex.data") +#P"/repository/other/cl-ppcre/regex.data" +@end lisp + +@item +hyperdocumentation + +to be documented + +@item +hyperdoc + +to be documented + +@end enumerate + + +@node Getting the latest version, TODO list, Miscellaneous additional functionality, Top +@comment node-name, next, previous, up +@chapter Getting the latest version + +@enumerate +@item +Decide which version you want. HEAD is the newest version and +usually OK, whereas RELEASE is for cautious people (e.g. who already +have systems using asdf that they don't want broken), a slightly older +version about which none of the HEAD users have complained. + +@item +Check it out from sourceforge cCLan CVS: + +@kbd{cvs -d:pserver:anonymous@@cvs.cclan.sourceforge.net:/cvsroot/cclan login} + +(no password: just press @key{Enter}) + +@kbd{cvs -z3 -d:pserver:anonymous@@cvs.cclan.sourceforge.net:/cvsroot/cclan co -r RELEASE asdf} + +or for the bleeding edge, instead + +@kbd{cvs -z3 -d:pserver:anonymous@@cvs.cclan.sourceforge.net:/cvsroot/cclan co -A asdf} + +@end enumerate + +If you are tracking the bleeding edge, you may want to subscribe to +the cclan-commits mailing list (see +@url{http://sourceforge.net/mail/?group_id=28536}) to receive commit +messages and diffs whenever changes are made. + +For more CVS information, look at +@url{http://sourceforge.net/cvs/?group_id=28536}. + + + + +@node TODO list, missing bits in implementation, Getting the latest version, Top +@comment node-name, next, previous, up +@chapter TODO list + +* Outstanding spec questions, things to add + +** packaging systems + +*** manual page component? + +** style guide for .asd files + +You should either use keywords or be careful with the package that you +evaluate defsystem forms in. Otherwise (defsystem partition ...) +being read in the cl-user package will intern a cl-user:partition +symbol, which will then collide with the partition:partition symbol. + +Actually there's a hairier packages problem to think about too. +in-order-to is not a keyword: if you read defsystem forms in a package +that doesn't use ASDF, odd things might happen + +** extending defsystem with new options + +You might not want to write a whole parser, but just to add options to +the existing syntax. Reinstate parse-option or something akin + +** document all the error classes + +** what to do with compile-file failure + +Should check the primary return value from compile-file and see if +that gets us any closer to a sensible error handling strategy + +** foreign files + +lift unix-dso stuff from db-sockets + +** Diagnostics + +A ``dry run'' of an operation can be made with the following form: + +@lisp +(traverse (make-instance '<operation-name>) + (find-system <system-name>) + 'explain) +@end lisp + +This uses unexported symbols. What would be a nice interface for this +functionality? + +@node missing bits in implementation, Inspiration, TODO list, Top +@comment node-name, next, previous, up +@chapter missing bits in implementation + +** all of the above + +** reuse the same scratch package whenever a system is reloaded from disk + +** rules for system pathname defaulting are not yet implemented properly + +** proclamations probably aren't + +** when a system is reloaded with fewer components than it previously + had, odd things happen + +we should do something inventive when processing a defsystem form, +like take the list of kids and setf the slot to nil, then transfer +children from old to new list as they're found + +** traverse may become a normal function + +If you're defining methods on traverse, speak up. + + +** a lot of load-op methods can be rewritten to use input-files + +so should be. + + +** (stuff that might happen later) + +*** david lichteblau's patch for symlink resolution? + +*** Propagation of the :force option. ``I notice that + + (oos 'compile-op :araneida :force t) + +also forces compilation of every other system the :araneida system +depends on. This is rarely useful to me; usually, when I want to force +recompilation of something more than a single source file, I want to +recompile only one system. So it would be more useful to have +make-sub-operation refuse to propagate @code{:force t} to other systems, and +propagate only something like @code{:force :recursively}. + +Ideally what we actually want is some kind of criterion that says to +which systems (and which operations) a @code{:force} switch will +propagate. + +The problem is perhaps that `force' is a pretty meaningless concept. +How obvious is it that @code{load :force t} should force +@emph{compilation}? But we don't really have the right dependency +setup for the user to compile @code{:force t} and expect it to work +(files will not be loaded after compilation, so the compile +environment for subsequent files will be emptier than it needs to be) + +What does the user actually want to do when he forces? Usually, for +me, update for use with a new version of the lisp compiler. Perhaps +for recovery when he suspects that something has gone wrong. Or else +when he's changed compilation options or configuration in some way +that's not reflected in the dependency graph. + +Other possible interface: have a 'revert' function akin to 'make clean' + +@lisp +(asdf:revert 'asdf:compile-op 'araneida) +@end lisp + +would delete any files produced by 'compile-op 'araneida. Of course, it +wouldn't be able to do much about stuff in the image itself. + +How would this work? + +traverse + +There's a difference between a module's dependencies (peers) and its +components (children). Perhaps there's a similar difference in +operations? For example, @code{(load "use") depends-on (load "macros")} is a +peer, whereas @code{(load "use") depends-on (compile "use")} is more of a +`subservient' relationship. + +@node Inspiration, Concept Index, missing bits in implementation, Top +@comment node-name, next, previous, up +@chapter Inspiration + +@section mk-defsystem (defsystem-3.x) + +We aim to solve basically the same problems as mk-defsystem does. +However, our architecture for extensibility better exploits CL +language features (and is documented), and we intend to be portable +rather than just widely-ported. No slight on the mk-defsystem authors +and maintainers is intended here; that implementation has the +unenviable task of supporting pre-ANSI implementations, which is +no longer necessary. + +The surface defsystem syntax of asdf is more-or-less compatible with +mk-defsystem, except that we do not support the @code{source-foo} and +@code{binary-foo} prefixes for separating source and binary files, and +we advise the removal of all options to specify pathnames. + +The mk-defsystem code for topologically sorting a module's dependency +list was very useful. + +@section defsystem-4 proposal + +Marco and Peter's proposal for defsystem 4 served as the driver for +many of the features in here. Notable differences are: + +@itemize +@item +We don't specify output files or output file extensions as part of the +system. + +If you want to find out what files an operation would create, ask the +operation. + +@item +We don't deal with CL packages + +If you want to compile in a particular package, use an in-package form +in that file (ilisp / SLIME will like you more if you do this anyway) + +@item +There is no proposal here that defsystem does version control. + +A system has a given version which can be used to check dependencies, +but that's all. +@end itemize + +The defsystem 4 proposal tends to look more at the external features, +whereas this one centres on a protocol for system introspection. + +@section kmp's ``The Description of Large Systems'', MIT AI Memu 801 + +Available in updated-for-CL form on the web at +@url{http://world.std.com/~pitman/Papers/Large-Systems.html} + +In our implementation we borrow kmp's overall PROCESS-OPTIONS and +concept to deal with creating component trees from defsystem surface +syntax. [ this is not true right now, though it used to be and +probably will be again soon ] + + +@c ------------------- + + +@node Concept Index, Function and Class Index, Inspiration, Top +@unnumbered Concept Index + +@printindex cp + +@node Function and Class Index, Variable Index, Concept Index, Top +@unnumbered Function and Class Index + +@printindex fn + +@node Variable Index, , Function and Class Index, Top +@unnumbered Variable Index + +@printindex vr + + + + +@bye + Added: branches/trunk-reorg/thirdparty/asdf/cclan-package.lisp =================================================================== --- branches/trunk-reorg/thirdparty/asdf/cclan-package.lisp 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/cclan-package.lisp 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,5 @@ +(in-package :cl-user) + +(defpackage :cclan (:use #:cl #:asdf) + (:export #:all-components #:write-package)) + Added: branches/trunk-reorg/thirdparty/asdf/cclan.asd =================================================================== --- branches/trunk-reorg/thirdparty/asdf/cclan.asd 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/cclan.asd 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,8 @@ +;;; -*- Lisp -*- +(defpackage :cclan-system (:use #:cl #:asdf)) +(in-package :cclan-system) + +(defsystem cclan + :version "0.1" + :components ((:file "cclan-package") + (:file "cclan" :depends-on ("cclan-package")))) Added: branches/trunk-reorg/thirdparty/asdf/cclan.lisp =================================================================== --- branches/trunk-reorg/thirdparty/asdf/cclan.lisp 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/cclan.lisp 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,99 @@ +(in-package :cclan) + +;;;; This file contains functions, classes etc that are not part of +;;;; asdf itself, but extend it in various ways useful for maintainers +;;;; of new-style cCLan packages + +;;;; The public interface consists of the functions whose symbols are +;;;; exported from the package + +;;;; This file does not contain references to asdf internals - or +;;;; shouldn't, anyway. Send bug reports + + +(defun mapappend (function list) + (let ((f (coerce function 'function))) + (loop for i in list append (funcall f i)))) + +(defgeneric all-components (component)) +(defmethod all-components ((source-file source-file)) + (list source-file)) + +(defmethod all-components ((module module)) + (cons module (mapappend #'all-components (module-components module)))) + +(defmethod all-components ((module symbol)) + (all-components (find-system module))) + +(defun cvs-tag-name (system) + (let* ((system (find-system system)) + (version (component-version system))) + (format nil "release_~A" (substitute #\_ #\. version)))) + +(defun cvs-tag (system) + (let* ((system (find-system system)) + (directory (component-pathname system))) + (run-shell-command "cd ~A && cvs tag -F ~A" + (namestring directory) (cvs-tag-name system)))) + + +(defun write-readme-file (stream suggested-registry system-name) + "Write a README.install file detailing a possible sequence of commands to use the newly-untarred system." + (format stream "~ +1. Make a symlink in ~W[*] pointing to the .asd file +2. Start your asdf-enabled lisp +2a. Ensure that ~W[*] is in asdf:*central-registry* +3. At the lisp prompt, type '(asdf:operate 'asdf:load-op ~W)'. This + will compile and load the system into your running lisp. + +[*] This path (~W) is only a suggestion; the important +thing is that asdf know where to find the .asd file. asdf uses the +contents of the variable ASDF:*CENTRAL-REGISTRY* to find its system +definitions. + +These instructions were automatically generated by cCLan software. Use +at your own peril.~%" suggested-registry suggested-registry system-name suggested-registry)) + +(defun write-package (system) + (let* ((parent-dir + (parse-namestring + (format nil "/tmp/~A.~A/" + #+sbcl (sb-unix:unix-getpid) + #-sbcl (random 1000000) + (get-internal-run-time)))) + (system (find-system system)) + (sub-dir-name + (format nil "~A_~A" + (component-name system) (component-version system))) + (cvsroot-file + (merge-pathnames "CVS/Root" (component-pathname system))) + (old-pwd *default-pathname-defaults*) + (*default-pathname-defaults* parent-dir)) + (ensure-directories-exist parent-dir) + (cvs-tag system) + (and + (zerop (asdf:run-shell-command + "cd ~A && cvs -d `cat ~A` checkout -d ~A -r ~A -kv ~A" + (namestring parent-dir) + (namestring cvsroot-file) + sub-dir-name + (cvs-tag-name system) + (component-name system))) + (with-open-file (o (format nil "~A/INSTALL.asdf" sub-dir-name) + :direction :output) + (write-readme-file o "$HOME/lisp/systems/" (component-name system)) + t) + (zerop (asdf:run-shell-command "cd ~A && tar cf ~A~A.tar ~A" + (namestring parent-dir) + (namestring old-pwd) sub-dir-name + sub-dir-name)) + (zerop (asdf:run-shell-command + "gzip -f9 ~A~A.tar" + (namestring old-pwd) sub-dir-name)) + (format t "Now run~% gpg -b -a ~A~A.tar.gz~%in a shell with a tty" + (namestring old-pwd) sub-dir-name)))) + +(defun class-name-of (x) + (class-name (class-of x))) + + Added: branches/trunk-reorg/thirdparty/asdf/debian/CVS/Entries =================================================================== --- branches/trunk-reorg/thirdparty/asdf/debian/CVS/Entries 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/debian/CVS/Entries 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,12 @@ +/README.Debian/1.2/Sat Jul 2 19:58:38 2005// +/changelog/1.61/Fri Sep 30 06:18:46 2005// +/cl-asdf.postinst/1.6/Sun Feb 9 19:34:40 2003// +/cl-cclan.postinst/1.5/Mon Dec 9 17:27:21 2002// +/cl-cclan.prerm/1.5/Mon Dec 9 17:27:21 2002// +/compat/1.2/Sat Jun 7 22:34:20 2003// +/control/1.17/Fri Jul 1 12:03:47 2005// +/copyright/1.2/Mon Dec 2 16:29:15 2002// +/docs/1.1/Sun Aug 18 07:41:36 2002// +/postinst/1.6/Wed May 25 06:23:00 2005// +/rules/1.9/Fri Sep 30 06:18:46 2005// +D Added: branches/trunk-reorg/thirdparty/asdf/debian/CVS/Repository =================================================================== --- branches/trunk-reorg/thirdparty/asdf/debian/CVS/Repository 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/debian/CVS/Repository 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1 @@ +asdf/debian Added: branches/trunk-reorg/thirdparty/asdf/debian/CVS/Root =================================================================== --- branches/trunk-reorg/thirdparty/asdf/debian/CVS/Root 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/debian/CVS/Root 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1 @@ +:pserver:anonymous@cclan.cvs.sourceforge.net:/cvsroot/cclan Added: branches/trunk-reorg/thirdparty/asdf/debian/README.Debian =================================================================== --- branches/trunk-reorg/thirdparty/asdf/debian/README.Debian 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/debian/README.Debian 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,18 @@ +Debian Package cl-asdf +---------------------- + +This package was created for Debian by Kevin M. Rosenberg +<kmr(a)debian.org> in Aug 2002. The URL for asdf is +http://www.telent.net/cliki/asdf. The README file has details +about the use of asdf. + +To load asdf into your Lisp system, give the command +(load "/usr/share/common-lisp/source/asdf/asdf.lisp") + +Additionally, there is an optional module that you can load +with the command +(load "/usr/share/common-lisp/source/asdf/wild-modules.lisp") + +This package is build using darcs-buildpackage and the darcs archives can be +downloaded from http://people.debian.org/~pvaneynd/repository/ + Added: branches/trunk-reorg/thirdparty/asdf/debian/changelog =================================================================== --- branches/trunk-reorg/thirdparty/asdf/debian/changelog 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/debian/changelog 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,358 @@ +cl-asdf (1.88-1) unstable; urgency=low + + * Noticed that I actually increased the version with the CVS commit + * Updated the standards version + * Remove the prepare build stuff, build through darcs + * Improve duplicate names test: use equal instead of equalp. + From a comment from Faré. + + -- Peter Van Eynde <pvaneynd(a)debian.org> Thu, 22 Sep 2005 12:52:31 +0200 + +cl-asdf (1.86-5) unstable; urgency=low + + * Fixed duplicate components patch to better handle reloading + defsystem files. Now works again with McClim. Closes: #310640 + * Corrected dependencies. + * Added postinst rebuild of all clc-enabled lisps so the new version + actually gets loaded. + + -- Peter Van Eynde <pvaneynd(a)debian.org> Wed, 25 May 2005 08:22:17 +0200 + +cl-asdf (1.86-4) unstable; urgency=low + + * My release script stripped the patch. So this should really contain the + patch. Damn. + + -- Peter Van Eynde <pvaneynd(a)debian.org> Tue, 10 May 2005 14:17:51 +0200 + +cl-asdf (1.86-3) unstable; urgency=low + + * Now checks if components names are unique Closes: #304972, #304970 + * Fix dependency on common-lisp-controller Closes: #308385 + + -- Peter Van Eynde <pvaneynd(a)debian.org> Tue, 10 May 2005 07:50:25 +0200 + +cl-asdf (1.86-2) unstable; urgency=low + + * New maintainer. (Closes: #297349: O: cl-asdf -- Another System + Definition Facility) + * Adopted by Peter Van Eynde + + -- Peter Van Eynde <pvaneynd(a)debian.org> Tue, 1 Mar 2005 10:11:55 +0100 + +cl-asdf (1.86-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg <kmr(a)debian.org> Wed, 4 Aug 2004 21:19:16 -0600 + +cl-asdf (1.84-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg <kmr(a)debian.org> Wed, 12 May 2004 12:43:58 -0600 + +cl-asdf (1.81-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg <kmr(a)debian.org> Tue, 30 Dec 2003 12:12:38 -0700 + +cl-asdf (1.80-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg <kmr(a)debian.org> Fri, 5 Dec 2003 14:55:43 -0700 + +cl-asdf (1.79-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg <kmr(a)debian.org> Tue, 11 Nov 2003 16:12:07 -0700 + +cl-asdf (1.78-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg <kmr(a)debian.org> Thu, 9 Oct 2003 16:46:38 -0600 + +cl-asdf (1.77.2-1) unstable; urgency=low + + * Don't export asdf:wild-module as can cause a full warning when + reloading asdf + + -- Kevin M. Rosenberg <kmr(a)debian.org> Mon, 11 Aug 2003 21:55:16 -0600 + +cl-asdf (1.77.1-1) unstable; urgency=low + + * cclan.lisp: conditionalize for sbcl (closes: 201822) + + -- Kevin M. Rosenberg <kmr(a)debian.org> Thu, 17 Jul 2003 23:30:57 -0600 + +cl-asdf (1.77-1) unstable; urgency=low + + * New upstream + * Add automated [cvs2cl] ChangeLog + + -- Kevin M. Rosenberg <kmr(a)debian.org> Thu, 17 Jul 2003 10:27:27 -0600 + +cl-asdf (1.76) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg <kmr(a)debian.org> Thu, 10 Jul 2003 16:42:48 -0600 + +cl-asdf (1.75) unstable; urgency=low + + * New upstream + * Use compat rather than DH_COMPAT + + -- Kevin M. Rosenberg <kmr(a)debian.org> Thu, 5 Jun 2003 00:15:11 -0600 + +cl-asdf (1.73b) unstable; urgency=low + + * Update README + * export two variables + + -- Kevin M. Rosenberg <kmr(a)debian.org> Wed, 28 May 2003 11:19:40 -0600 + +cl-asdf (1.73) unstable; urgency=low + + * Update README to mention asdf::*compile-file-warnings-behaviour* + (closes:194957) + + -- Kevin M. Rosenberg <kmr(a)debian.org> Tue, 27 May 2003 16:00:36 -0600 + +cl-asdf (1.72) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg <kmr(a)debian.org> Tue, 20 May 2003 14:07:10 -0600 + +cl-asdf (1.71) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg <kmr(a)debian.org> Tue, 13 May 2003 09:33:51 -0600 + +cl-asdf (1.70) unstable; urgency=low + + * Add another check in check-component-values. + * Signal a generalized instance of SYSTEM-DEFINITION-ERROR + from check-component-values + + -- Kevin M. Rosenberg <kmr(a)debian.org> Tue, 6 May 2003 09:32:16 -0600 + +cl-asdf (1.69) unstable; urgency=low + + * Add check-component-values function with partial checking of components + + -- Kevin M. Rosenberg <kmr(a)debian.org> Tue, 6 May 2003 08:26:11 -0600 + +cl-asdf (1.68) unstable; urgency=low + + * New upstream with 'asdf:test-op + + -- Kevin M. Rosenberg <kmr(a)debian.org> Wed, 19 Mar 2003 10:16:01 -0700 + +cl-asdf (1.66) unstable; urgency=low + + * New upstream version, added changes to dependent system + compilations with :force option. + + -- Kevin M. Rosenberg <kmr(a)debian.org> Mon, 17 Mar 2003 12:50:00 -0700 + +cl-asdf (1.62) unstable; urgency=low + + * New upstream, fixes a sbcl-specific directory name + + -- Kevin M. Rosenberg <kmr(a)debian.org> Fri, 7 Mar 2003 09:23:11 -0700 + +cl-asdf (1.61-1) unstable; urgency=low + + * New upstream, fixes 'load-source-op + + -- Kevin M. Rosenberg <kmr(a)debian.org> Tue, 4 Mar 2003 09:48:40 -0700 + +cl-asdf (1.60-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg <kmr(a)debian.org> Mon, 3 Mar 2003 12:40:27 -0700 + +cl-asdf (1.59-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg <kmr(a)debian.org> Fri, 14 Feb 2003 09:24:59 -0700 + +cl-asdf (1.58-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg <kmr(a)debian.org> Sun, 9 Feb 2003 11:55:03 -0700 + +cl-asdf (1.57-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg <kmr(a)debian.org> Tue, 4 Feb 2003 10:23:03 -0700 + +cl-asdf (1.55-1) unstable; urgency=low + + * New upstream.version (closes: 172074) + + -- Kevin M. Rosenberg <kmr(a)debian.org> Mon, 9 Dec 2002 10:23:21 -0700 + +cl-asdf (1.54-1) unstable; urgency=low + + * New upstream. + + -- Kevin M. Rosenberg <kmr(a)debian.org> Fri, 8 Nov 2002 07:30:41 -0700 + +cl-asdf (1.49-1) unstable; urgency=low + + * Remove clc-reregister-all-impl from postinst + + -- Kevin M. Rosenberg <kmr(a)debian.org> Sat, 5 Oct 2002 09:38:18 -0600 + +cl-asdf (1.49) unstable; urgency=low + + * New upstream release, fixes run-shell-command for allegro. Code + refactoring for run-shell-code. + * Support new CLC reregister command + + -- Kevin M. Rosenberg <kmr(a)debian.org> Wed, 25 Sep 2002 23:57:23 -0600 + +cl-asdf (1.47) unstable; urgency=low + + * Return numeric exit status for openmcl's run-shell-command + + -- Kevin M. Rosenberg <kmr(a)debian.org> Fri, 20 Sep 2002 10:22:36 -0600 + +cl-asdf (1.46) unstable; urgency=low + + * New upstream version, adds run-shell-command for openmcl + + -- Kevin M. Rosenberg <kmr(a)debian.org> Fri, 20 Sep 2002 10:11:48 -0600 + +cl-asdf (1.45) unstable; urgency=low + + * Changes to improve clisp support + + -- Kevin M. Rosenberg <kmr(a)debian.org> Fri, 20 Sep 2002 07:12:21 -0600 + +cl-asdf (1.44.1-1) unstable; urgency=low + + * Make cclan.asd a symlink, remove :pathname keyword + + -- Kevin M. Rosenberg <kmr(a)debian.org> Wed, 18 Sep 2002 00:19:26 -0600 + +cl-asdf (1.44-1) unstable; urgency=low + + * New upstream version + + -- Kevin M. Rosenberg <kmr(a)debian.org> Tue, 17 Sep 2002 12:24:27 -0600 + +cl-asdf (1.43-1) unstable; urgency=low + + * New upstream version + + -- Kevin M. Rosenberg <kmr(a)debian.org> Tue, 17 Sep 2002 10:34:57 -0600 + +cl-asdf (1.42-2) unstable; urgency=low + + * Add reregister-common-lisp-implementations call when installing cl-asdf. + + -- Kevin M. Rosenberg <kmr(a)debian.org> Mon, 16 Sep 2002 08:31:13 -0600 + +cl-asdf (1.42-1) unstable; urgency=low + + * Remove Depends on lisp-compiler for cl-asdf (fixes problem with + circular dependencies) + + -- Kevin M. Rosenberg <kmr(a)debian.org> Sat, 14 Sep 2002 11:59:58 -0600 + +cl-asdf (1.42) unstable; urgency=low + + * New upstream. + + -- Kevin M. Rosenberg <kmr(a)debian.org> Fri, 13 Sep 2002 08:40:58 -0600 + +cl-asdf (1.41) unstable; urgency=low + + * Same release as 1.40, but with proper version number. + + -- Kevin M. Rosenberg <kmr(a)debian.org> Fri, 13 Sep 2002 08:38:30 -0600 + +cl-asdf (1.40) unstable; urgency=low + + * New upstream version. + + -- Kevin M. Rosenberg <kmr(a)debian.org> Fri, 13 Sep 2002 07:31:27 -0600 + +cl-asdf (1.39) unstable; urgency=low + + * New upstream version. + + -- Kevin M. Rosenberg <kmr(a)debian.org> Wed, 11 Sep 2002 19:21:32 -0600 + +cl-asdf (1.38) unstable; urgency=low + + * New upstream version + * Re-add register and unregister clc-source for cclan + + -- Kevin M. Rosenberg <kmr(a)debian.org> Wed, 11 Sep 2002 13:39:51 -0600 + +cl-asdf (1.35-1) unstable; urgency=low + + * Comment call to register and unregister clc-source until new + version of clc is released. (closes: 158697) + + -- Kevin M. Rosenberg <kmr(a)debian.org> Wed, 28 Aug 2002 18:58:59 -0600 + +cl-asdf (1.35) unstable; urgency=high + + * New upstream version, fixes important bugs. + + -- Kevin M. Rosenberg <kmr(a)debian.org> Wed, 28 Aug 2002 09:36:58 -0600 + +cl-asdf (1.34) unstable; urgency=low + + * New upstream version. + + -- Kevin M. Rosenberg <kmr(a)debian.org> Wed, 28 Aug 2002 07:18:57 -0600 + +cl-asdf (0.0+cvs.2002.08.26-1) unstable; urgency=low + + * Add Common Lisp Controller registration functions for cl-cclan + + -- Kevin M. Rosenberg <kmr(a)debian.org> Mon, 26 Aug 2002 04:21:32 -0600 + +cl-asdf (0.0+cvs.2002.08.26) unstable; urgency=low + + * New upstream version + + -- Kevin M. Rosenberg <kmr(a)debian.org> Mon, 26 Aug 2002 01:23:48 -0600 + +cl-asdf (0.0+cvs.2002.08.22) unstable; urgency=low + + * Add new binary package: cl-cclan + + -- Kevin M. Rosenberg <kmr(a)debian.org> Thu, 22 Aug 2002 12:43:21 -0600 + +cl-asdf (0.0+cvs.2002.08.18) unstable; urgency=low + + * New upstream version + * Expand description in control file. + * Change version numbering scheme since upstream has native debian + directory + + -- Kevin M. Rosenberg <kmr(a)debian.org> Sat, 17 Aug 2002 14:25:33 -0600 + +cl-asdf (0.0+cvs.2002.08.15-1) unstable; urgency=low + + * Initial Release (closes: 157009) + + -- Kevin M. Rosenberg <kmr(a)debian.org> Fri, 16 Aug 2002 23:14:49 -0600 + Added: branches/trunk-reorg/thirdparty/asdf/debian/cl-asdf.postinst =================================================================== --- branches/trunk-reorg/thirdparty/asdf/debian/cl-asdf.postinst 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/debian/cl-asdf.postinst 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,45 @@ +#! /bin/sh +# postinst script for asdf + +set -e + +# summary of how this script can be called: +# * <postinst> `configure' <most-recently-configured-version> +# * <old-postinst> `abort-upgrade' <new version> +# * <conflictor's-postinst> `abort-remove' `in-favour' <package> +# <new-version> +# * <deconfigured's-postinst> `abort-deconfigure' `in-favour' +# <failed-install-package> <version> `removing' +# <conflicting-package> <version> +# for details, see http://www.debian.org/doc/debian-policy/ or +# the debian-policy package +# +# quoting from the policy: +# Any necessary prompting should almost always be confined to the +# post-installation script, and should be protected with a conditional +# so that unnecessary prompting doesn't happen if a package's +# installation fails and the `postinst' is called with `abort-upgrade', +# `abort-remove' or `abort-deconfigure'. + +case "$1" in + configure) + if [ -x /usr/sbin/clc-reregister-all-impl ]; then + /usr/sbin/clc-reregister-all-impl + fi + ;; + abort-upgrade|abort-remove|abort-deconfigure) + ;; + *) + echo "postinst called with unknown argument \`$1'" >&2 + exit 1 + ;; +esac + +# dh_installdeb will replace this with shell code automatically +# generated by other debhelper scripts. + +#DEBHELPER# + +exit 0 + + Added: branches/trunk-reorg/thirdparty/asdf/debian/cl-cclan.postinst =================================================================== --- branches/trunk-reorg/thirdparty/asdf/debian/cl-cclan.postinst 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/debian/cl-cclan.postinst 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,41 @@ +#!/bin/sh + +set -e + +pkg=cclan + +# summary of how this script can be called: +# * <postinst> `configure' <most-recently-configured-version> +# * <old-postinst> `abort-upgrade' <new version> +# * <conflictor's-postinst> `abort-remove' `in-favour' <package> +# <new-version> +# * <deconfigured's-postinst> `abort-deconfigure' `in-favour' +# <failed-install-package> <version> `removing' +# <conflicting-package> <version> +# for details, see http://www.debian.org/doc/debian-policy/ or +# the debian-policy package +# +# quoting from the policy: +# Any necessary prompting should almost always be confined to the +# post-installation script, and should be protected with a conditional +# so that unnecessary prompting doesn't happen if a package's +# installation fails and the `postinst' is called with `abort-upgrade', +# `abort-remove' or `abort-deconfigure'. + +case "$1" in + configure) + /usr/sbin/register-common-lisp-source $pkg + ;; + abort-upgrade|abort-remove|abort-deconfigure) + ;; + *) + echo "postinst called with unknown argument \`$1'" >&2 + exit 1 + ;; +esac + +#DEBHELPER# + +exit 0 + + Added: branches/trunk-reorg/thirdparty/asdf/debian/cl-cclan.prerm =================================================================== --- branches/trunk-reorg/thirdparty/asdf/debian/cl-cclan.prerm 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/debian/cl-cclan.prerm 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,36 @@ +#!/bin/sh + +set -e + +pkg=cclan + +# summary of how this script can be called: +# * <prerm> `remove' +# * <old-prerm> `upgrade' <new-version> +# * <new-prerm> `failed-upgrade' <old-version> +# * <conflictor's-prerm> `remove' `in-favour' <package> <new-version> +# * <deconfigured's-prerm> `deconfigure' `in-favour' +# <package-being-installed> <version> `removing' +# <conflicting-package> <version> +# for details, see http://www.debian.org/doc/debian-policy/ or +# the debian-policy package + + +case "$1" in + remove|upgrade|deconfigure) + /usr/sbin/unregister-common-lisp-source $pkg + ;; + failed-upgrade) + ;; + *) + echo "prerm called with unknown argument \`$1'" >&2 + exit 1 + ;; +esac + + +#DEBHELPER# + +exit 0 + + Added: branches/trunk-reorg/thirdparty/asdf/debian/compat =================================================================== --- branches/trunk-reorg/thirdparty/asdf/debian/compat 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/debian/compat 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,2 @@ +4 +4 Added: branches/trunk-reorg/thirdparty/asdf/debian/control =================================================================== --- branches/trunk-reorg/thirdparty/asdf/debian/control 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/debian/control 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,25 @@ +Source: cl-asdf +Section: devel +Priority: optional +Maintainer: Peter Van Eynde <pvaneynd(a)debian.org> +Build-Depends-Indep: debhelper (>> 4.0.0), cvs2cl +Standards-Version: 3.6.2.1 + +Package: cl-asdf +Architecture: all +Recommends: common-lisp-controller, sbcl | lisp-compiler +Description: Another System Definition Facility + asdf provides a "make" type functions for Common Lisp packages. It + provides compilation and loading features for complex Lisp systems + with multiple modules and files. It is similar in concept to, but + with features different from, "defsystem" which is included in the + common-lisp-controller package. Unlike defsystem3 in CLC, asdf is + object-oriented and extensible. + +Package: cl-cclan +Architecture: all +Depends: common-lisp-controller +Description: Comprehensive Common Lisp Archive Network + cclan is a tool for creating a repository of Common Lisp packages. + cclan utilizes asdf to automatically create installable packages for various + operating systems. Added: branches/trunk-reorg/thirdparty/asdf/debian/copyright =================================================================== --- branches/trunk-reorg/thirdparty/asdf/debian/copyright 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/debian/copyright 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,37 @@ +This package was debianized by Kevin M. Rosenberg <kmr(a)debian.org> on +Fri, 16 Aug 2002 23:14:49 -0600. + +It was downloaded from SourceForge CVS server with the below commands: + cvs -d:pserver:anonymous@cvs.cclan.sourceforge.net:/cvsroot/cclan login + (no password: just press Enter) + cvs -z3 -d:pserver:anonymous@cvs.cclan.sourceforge.net:/cvsroot/cclan \ + co asdf + +Upstream Authors: Dan Barlow <dan(a)telent.net> & Contributors + +Copyright: + +(This is the MIT / X Consortium license as taken from + http://www.opensource.org/licenses/mit-license.html) + +Copyright (c) 2001, 2002 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. + Added: branches/trunk-reorg/thirdparty/asdf/debian/docs =================================================================== --- branches/trunk-reorg/thirdparty/asdf/debian/docs 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/debian/docs 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1 @@ +README Added: branches/trunk-reorg/thirdparty/asdf/debian/postinst =================================================================== --- branches/trunk-reorg/thirdparty/asdf/debian/postinst 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/debian/postinst 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,62 @@ +#!/bin/bash +# postinst script for common-lisp-controller +# +# see: dh_installdeb(1) + +set -e + +# summary of how this script can be called: +# * <postinst> `configure' <most-recently-configured-version> +# * <old-postinst> `abort-upgrade' <new version> +# * <conflictor's-postinst> `abort-remove' `in-favour' <package> +# <new-version> +# * <deconfigured's-postinst> `abort-deconfigure' `in-favour' +# <failed-install-package> <version> `removing' +# <conflicting-package> <version> +# for details, see /usr/share/doc/packaging-manual/ +# +# quoting from the policy: +# Any necessary prompting should almost always be confined to the +# post-installation script, and should be protected with a conditional +# so that unnecessary prompting doesn't happen if a package's +# installation fails and the `postinst' is called with `abort-upgrade', +# `abort-remove' or `abort-deconfigure'. + + +. /usr/share/debconf/confmodule + +case "$1" in + configure) + # We need to rebuild the images + for compiler in /usr/lib/common-lisp/bin/*.sh ; do + if [ -f "$compiler" -a -r "$compiler" ] ; then + i=${compiler##*/} + i=${i%.sh} + if [ -x "$compiler" ] ; then + echo Reinstalling for $i + echo Recompiling Common Lisp Controller for $i + bash "$compiler" install-clc || true + echo + echo Done rebuilding + fi + fi + done + ;; + + abort-upgrade|abort-remove|abort-deconfigure) + ;; + + *) + echo "postinst called with unknown argument \`$1'" >&2 + exit 0 + ;; +esac + +# dh_installdeb will replace this with shell code automatically +# generated by other debhelper scripts. + +#DEBHELPER# + +exit 0 + + Added: branches/trunk-reorg/thirdparty/asdf/debian/rules =================================================================== --- branches/trunk-reorg/thirdparty/asdf/debian/rules 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/debian/rules 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,86 @@ +#!/usr/bin/make -f +# GNU copyright 1997 to 1999 by Joey Hess. + +pkg=cl-asdf +pkg-cclan=cl-cclan +clc-base=usr/share/common-lisp +clc-src=$(clc-base)/source +clc-systems=$(clc-base)/systems +asdf-files=$(clc-src)/asdf +cclan-files=$(clc-src)/cclan +doc-dir=usr/share/doc/$(pkg) + +configure: configure-stamp +configure-stamp: + dh_testdir + # Add here commands to configure the package. + touch configure-stamp + + +build: build-stamp + +build-stamp: configure-stamp + dh_testdir + # Add here commands to compile the package. + touch build-stamp + +clean: + dh_testdir + dh_testroot + rm -f build-stamp configure-stamp + # Add here commands to clean up after the build process. + dh_clean + +install: build + dh_testdir + dh_testroot + dh_clean -k + dh_installdirs + + # Add here commands to install the package into debian/asdf. + dh_installdirs -p $(pkg) $(asdf-files) $(doc-dir)/examples + dh_install -p $(pkg) asdf.lisp wild-modules.lisp asdf-install.lisp $(asdf-files) + chmod +x test/run-tests.sh + dh_install -p $(pkg) test/* $(doc-dir)/examples + dh_installdirs -p $(pkg-cclan) $(clc-systems) $(cclan-files) + dh_install -p $(pkg-cclan) cclan-package.lisp cclan.lisp cclan.asd $(cclan-files) + dh_link -p $(pkg-cclan) $(cclan-files)/cclan.asd $(clc-systems)/cclan.asd + +# Build architecture-independent files here. +binary-indep: build install +# We have nothing to do by default. + +# Build architecture-dependent files here. +binary-arch: build install + dh_testdir + dh_testroot +# dh_installdebconf + dh_installdocs +# dh_installexamples + dh_installmenu +# dh_installlogrotate +# dh_installemacsen +# dh_installpam +# dh_installmime +# dh_installinit + dh_installcron + dh_installman + dh_installinfo +# dh_undocumented + dh_installchangelogs ChangeLog + find debian/cl-asdf -name CVS -print0 | xargs -0t rm -rf || true + find debian/cl-asdf -name .cvsignore -print0 | xargs -0t rm -f || true + dh_link + dh_strip + dh_compress + dh_fixperms +# dh_makeshlibs + dh_installdeb +# dh_perl + dh_shlibdeps + dh_gencontrol + dh_md5sums + dh_builddeb + +binary: binary-indep binary-arch +.PHONY: build clean binary-indep binary-arch binary install configure Property changes on: branches/trunk-reorg/thirdparty/asdf/debian/rules ___________________________________________________________________ Name: svn:executable + * Added: branches/trunk-reorg/thirdparty/asdf/test/CVS/Entries =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/CVS/Entries 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/CVS/Entries 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,33 @@ +/compile-asdf.lisp/1.1/Fri Jul 27 02:58:19 2007// +/file1.lisp/1.2/Mon Sep 9 14:28:56 2002// +/file2.lisp/1.1/Wed Feb 20 11:12:35 2002// +/file3.lisp/1.2/Mon Sep 9 14:28:56 2002// +/file4.lisp/1.1/Wed Feb 20 11:12:35 2002// +/run-tests.sh/1.12/Thu Sep 27 13:15:06 2007// +/script-support.lisp/1.1/Fri Jul 27 02:58:19 2007// +/static-and-serial.asd/1.1/Fri Jul 27 02:58:19 2007// +/test-force.asd/1.1/Tue May 30 18:14:40 2006// +/test-force.script/1.2/Wed Jun 13 01:30:55 2007// +/test-package.asd/1.1/Mon Aug 21 10:52:34 2006// +/test-package.script/1.2/Wed Jun 13 01:30:55 2007// +/test-preferences-1.lisp/1.1/Thu Jul 6 02:26:00 2006// +/test-preferences-1.script/1.2/Wed Jun 13 01:30:55 2007// +/test-preferences-system-1.asd/1.1/Thu Jul 6 02:26:00 2006// +/test-preferences-system-load.lisp/1.1/Thu Jul 6 02:26:00 2006// +/test-preferences-system-test.lisp/1.1/Thu Jul 6 02:26:00 2006// +/test-static-and-serial.script/1.1/Fri Jul 27 02:58:19 2007// +/test-version.script/1.2/Wed Jun 13 01:30:55 2007// +/test1.asd/1.1/Wed Feb 20 11:12:35 2002// +/test1.script/1.4/Wed Jun 13 01:30:55 2007// +/test2.asd/1.1/Wed Feb 20 11:12:35 2002// +/test2.script/1.4/Wed Jun 13 01:30:55 2007// +/test2a.asd/1.1/Wed Feb 20 11:12:35 2002// +/test2b1.asd/1.1/Wed Feb 20 11:12:35 2002// +/test2b2.asd/1.1/Wed Feb 20 11:12:35 2002// +/test2b3.asd/1.1/Wed Feb 20 11:12:35 2002// +/test3.asd/1.2/Mon May 20 14:16:27 2002// +/test3.script/1.4/Wed Jun 13 01:30:55 2007// +/test4.script/1.2/Wed Jun 13 01:30:55 2007// +/wild-module.asd/1.2/Sun May 14 16:03:16 2006// +/wild-module.script/1.3/Wed Jun 13 01:30:55 2007// +D Added: branches/trunk-reorg/thirdparty/asdf/test/CVS/Repository =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/CVS/Repository 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/CVS/Repository 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1 @@ +asdf/test Added: branches/trunk-reorg/thirdparty/asdf/test/CVS/Root =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/CVS/Root 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/CVS/Root 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1 @@ +:pserver:anonymous@cclan.cvs.sourceforge.net:/cvsroot/cclan Added: branches/trunk-reorg/thirdparty/asdf/test/compile-asdf.lisp =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/compile-asdf.lisp 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/compile-asdf.lisp 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,18 @@ +(in-package #:common-lisp-user) + +(load "test/script-support.lisp") + +(cond ((probe-file "asdf.lisp") + (multiple-value-bind (result warnings-p errors-p) + (compile-file "asdf.lisp") + (declare (ignore result)) + (cond (warnings-p + (leave-lisp "Testuite failed: ASDF compiled with warnings" 1)) + (errors-p + (leave-lisp "Testuite failed: ASDF compiled with ERRORS" 2)) + (t + (leave-lisp "ASDF compiled cleanly" 0))))) + (t + (leave-lisp "Testsuite failed: unable to find ASDF source" 3))) + + \ No newline at end of file Added: branches/trunk-reorg/thirdparty/asdf/test/file1.lisp =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/file1.lisp 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/file1.lisp 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,4 @@ +(defpackage :test-package (:use :cl)) +(in-package :test-package) +(defvar *file1* t) + Added: branches/trunk-reorg/thirdparty/asdf/test/file2.lisp =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/file2.lisp 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/file2.lisp 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,2 @@ +(in-package :test-package) +(assert *file1*) Added: branches/trunk-reorg/thirdparty/asdf/test/file3.lisp =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/file3.lisp 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/file3.lisp 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,4 @@ +(defpackage :test-package (:use :cl)) +(in-package :test-package) +(defvar *file3* t) + Added: branches/trunk-reorg/thirdparty/asdf/test/file4.lisp =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/file4.lisp 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/file4.lisp 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,2 @@ +(in-package :test-package) +(assert *file3*) Added: branches/trunk-reorg/thirdparty/asdf/test/run-tests.sh =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/run-tests.sh 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/run-tests.sh 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,97 @@ +#!/bin/sh + +# do_tests {lisp invocation} {fasl extension} +# - read lisp forms one at a time from standard input +# - quit with exit status 0 on getting eof +# - quit with exit status >0 if an unhandled error occurs + + +if [ -z "$2" ]; then + scripts="*.script" +else + scripts="$2" +fi + +sok=1 + +do_tests() { +rm *.$2 || true +( cd .. && echo '(load "test/compile-asdf.lisp")' | $1 ) +if [ $? -eq 0 ] ; then + test_count=0 + test_pass=0 + test_fail=0 + failed_list="" + for i in $scripts ; + do + echo "Testing: $i" >&2 + test_count=`expr "$test_count" + 1` + rm *.$2 || true + if $1 < $i ;then + echo "Using $1, $i passed" >&2 + test_pass=`expr "$test_pass" + 1` + else + echo "Using $1, $i failed" >&2 + test_fail=`expr "$test_fail" + 1` + failed_list="$failed_list $i" + sok=0 + fi + done + echo >&2 + echo "Using $1" >&2 + echo "Ran $test_count tests: " >&2 + echo " $test_pass passing and $test_fail failing" >&2 + if [ $test_fail -eq 0 ] ; then + echo "all tests apparently successful" >&2 + else + echo "failing test(s): $failed_list" >&2 + fi + echo >&2 +fi +} + +# terminate on error +set -e + +lisp=$1 +if [ -z $1 ] ; then + lisp="sbcl" +fi + +if [ "$lisp" = "sbcl" ] ; then + if type sbcl ; then + fasl_ext="fasl" + command="sbcl --userinit /dev/null --sysinit /dev/null --noprogrammer" + fi +elif [ "$lisp" = "clisp" ] ; then + if type clisp ; then + fasl_ext="fas" + command=`where clisp` + command="$command -norc -ansi -I - " + fi +elif [ "$lisp" = "allegro" ] ; then + if type alisp ; then + fasl_ext="fasl" + command="alisp -q --batch " + fi +elif [ "$lisp" = "allegromodern" ] ; then + if type mlisp ; then + fasl_ext="fasl" + command="mlisp -q --batch " + fi +fi + + +#if [ -x /usr/bin/lisp ] +#then +# do_tests "/usr/bin/lisp -batch -noinit" x86f +#fi + + +if [ -z "$command" ] ; then + echo "Error: don't know how to run Lisp named $lisp" +else + echo $command + do_tests "$command" $fasl_ext +fi + Added: branches/trunk-reorg/thirdparty/asdf/test/script-support.lisp =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/script-support.lisp 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/script-support.lisp 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,36 @@ +(in-package #:common-lisp-user) + +#+allegro +(setf excl:*warn-on-nested-reader-conditionals* nil) + +;;; code adapted from cl-launch (any errors in transcription are mine!) +;; http://www.cliki.net/cl-launch +(defun leave-lisp (message return) + (when message + (format *error-output* message)) + #+allegro + (excl:exit return) + #+clisp + (ext:quit return) + #+(or cmu scl) + (unix:unix-exit code) + #+ecl + (si:quit return) + #+gcl + (lisp:quit code) + #+lispworks + (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t) + #+(or openmcl mcl) + (ccl::quit return) + #+sbcl + (sb-ext:quit :unix-status return) + + (error "Don't know how to quit Lisp; wanting to use exit code ~a" return)) + +(defmacro exit-on-error (&body body) + `(handler-case + (progn ,@body + (leave-lisp "Script succeeded" 0)) + (error (c) + (format *error-output* "~a" c) + (leave-lisp "Script failed" 1)))) \ No newline at end of file Added: branches/trunk-reorg/thirdparty/asdf/test/static-and-serial.asd =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/static-and-serial.asd 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/static-and-serial.asd 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,12 @@ +#| +make sure that serial t and static-files don't cause full rebuilds all +the time... +|# + +(defsystem static-and-serial + :version "0.1" + :serial t + :components + ((:static-file "file2.lisp") + (:static-file "run-tests.sh") + (:file "file1"))) Added: branches/trunk-reorg/thirdparty/asdf/test/test-force.asd =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test-force.asd 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test-force.asd 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,5 @@ +;;; -*- Lisp -*- +(asdf:defsystem test-force + :components + ((:file "file1"))) + Added: branches/trunk-reorg/thirdparty/asdf/test/test-force.script =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test-force.script 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test-force.script 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,19 @@ +;;; -*- Lisp -*- +(load "script-support") +(load "../asdf") +(exit-on-error + (setf asdf:*central-registry* '(*default-pathname-defaults*)) + + (asdf:operate 'asdf:load-op 'test-force) + (defvar file1-date (file-write-date (compile-file-pathname "file1"))) + + ;; unforced, date should stay same + (sleep 1) + (asdf:operate 'asdf:load-op 'test-force) + (assert (= (file-write-date (compile-file-pathname "file1")) file1-date)) + + ;; forced, it should be later + (sleep 1) + (asdf:operate 'asdf:load-op 'test-force :force t) + (assert (> (file-write-date (compile-file-pathname "file1")) file1-date)) + ) \ No newline at end of file Added: branches/trunk-reorg/thirdparty/asdf/test/test-package.asd =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test-package.asd 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test-package.asd 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,10 @@ +;;; NB: This way of managing packages is explicitly NOT recommended. +;;; However, it is found in the wild, and debugging it is a pain, so +;;; we should probably not break. The thing that this is testing is +;;; that unrelated definitions of symbols naming ASDF keywords should +;;; not affect the parsing of a system. + +(in-package :cl-user) ; BAD BAD BAD + +(asdf:defsystem test-package + :components ((:module "foo" :components ((:file "bar") (:file "baz"))))) \ No newline at end of file Added: branches/trunk-reorg/thirdparty/asdf/test/test-package.script =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test-package.script 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test-package.script 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,14 @@ +(in-package :cl-user) +;;; -*- Lisp -*- +(load "script-support") +(load "../asdf") +(exit-on-error + + (defun module () 1) + + (load "test-package.asd") + + (defclass module () ()) + + (load "test-package.asd") +) Added: branches/trunk-reorg/thirdparty/asdf/test/test-preferences-1.lisp =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test-preferences-1.lisp 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test-preferences-1.lisp 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,3 @@ +(in-package #:common-lisp-user) + +(defvar *test-preferences-variable-1* :default) Added: branches/trunk-reorg/thirdparty/asdf/test/test-preferences-1.script =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test-preferences-1.script 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test-preferences-1.script 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,11 @@ +;;; -*- Lisp -*- +(load "script-support") +(load "../asdf") +(exit-on-error + (setf asdf:*central-registry* '(*default-pathname-defaults*)) + (in-package :asdf) + (asdf:oos 'asdf:load-op 'test-preferences-system-1) + (assert (eq common-lisp-user::*test-preferences-variable-1* :load)) + (asdf:oos 'asdf:test-op 'test-preferences-system-1) + (assert (eq common-lisp-user::*test-preferences-variable-1* :test)) + ) \ No newline at end of file Added: branches/trunk-reorg/thirdparty/asdf/test/test-preferences-system-1.asd =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test-preferences-system-1.asd 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test-preferences-system-1.asd 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,35 @@ +;;; -*- Lisp -*- +(in-package #:common-lisp) + +(defpackage #:test-preferences-1-asdf-system + (:use #:common-lisp #:asdf)) +(in-package #:asdf) + +(defsystem test-preferences-system-1 + :components + ((:file "test-preferences-1")) + :in-order-to ((test-op (load-op test-preferences-system-1)))) + +(defmethod operation-done-p + ((o test-op) + (c (eql (find-system 'test-preferences-system-1)))) + (values nil)) + +(defmethod load-preferences + ((system (eql (find-system 'test-preferences-system-1))) + (operation test-op)) + ;; the default load-preferences does nothing for anything other than a + ;; basic-load-op. So, ... we hack it + (load (make-pathname + :name "test-preferences-system-test" + :type "lisp" + :defaults *default-pathname-defaults*))) + +(defmethod preference-file-for-system/operation + ((system (eql (find-system 'test-preferences-system-1))) + (operation load-op)) + (make-pathname + :name "test-preferences-system-load" + :type "lisp" + :defaults *default-pathname-defaults*)) + Added: branches/trunk-reorg/thirdparty/asdf/test/test-preferences-system-load.lisp =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test-preferences-system-load.lisp 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test-preferences-system-load.lisp 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,3 @@ +(in-package #:common-lisp-user) + +(setf *test-preferences-variable-1* :load) Added: branches/trunk-reorg/thirdparty/asdf/test/test-preferences-system-test.lisp =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test-preferences-system-test.lisp 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test-preferences-system-test.lisp 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,3 @@ +(in-package #:common-lisp-user) + +(setf *test-preferences-variable-1* :test) Added: branches/trunk-reorg/thirdparty/asdf/test/test-static-and-serial.script =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test-static-and-serial.script 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test-static-and-serial.script 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,17 @@ +;;; -*- Lisp -*- +(load "script-support") +(load "../asdf") +(exit-on-error + (setf asdf:*central-registry* '(*default-pathname-defaults*)) + + (asdf:operate 'asdf:load-op 'static-and-serial) + (defvar file1-date (file-write-date (compile-file-pathname "file1"))) + + ;; cheat + (setf asdf::*defined-systems* (make-hash-table :test 'equal)) + + ;; date should stay same + (sleep 1) + (asdf:operate 'asdf:load-op 'static-and-serial) + (assert (= (file-write-date (compile-file-pathname "file1")) file1-date)) + ) \ No newline at end of file Added: branches/trunk-reorg/thirdparty/asdf/test/test-version.script =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test-version.script 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test-version.script 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,31 @@ +;;; -*- Lisp -*- +(load "script-support") +(load "../asdf") +(setf asdf:*central-registry* '(*default-pathname-defaults*)) + +(defpackage :test-version-system + (:use :cl :asdf)) + +(in-package :test-version-system) + +(cl-user::exit-on-error + (defsystem :versioned-system-1 + :pathname #.*default-pathname-defaults* + :version "1.0") + + (defsystem :versioned-system-2 + :pathname #.*default-pathname-defaults* + :version "1.1") + + (defsystem :versioned-system-3 + :pathname #.*default-pathname-defaults* + :version "1.2") + + (flet ((test (name v &optional (true t)) + (or (eq true (asdf::version-satisfies (find-system name) v)) + (error "no satisfaction: ~S version ~A not ~A" name v true)))) + (test :versioned-system-1 "1.0") + (test :versioned-system-2 "1.0") + (test :versioned-system-3 "2.0" nil)) + + ) \ No newline at end of file Added: branches/trunk-reorg/thirdparty/asdf/test/test1.asd =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test1.asd 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test1.asd 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,12 @@ +;;; -*- Lisp -*- +(asdf:defsystem test1 + :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")))) + (:file "file1"))) + +#| +1) from clean, check that all fasl files build and that some function + defined in the second file is present + +2) delete the second fasl file, and build again. do test 1 again and + also check the date on file1.fasl +|# Added: branches/trunk-reorg/thirdparty/asdf/test/test1.script =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test1.script 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test1.script 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,36 @@ +;;; -*- Lisp -*- +(load "script-support") +(load "../asdf") +(exit-on-error + (setf asdf:*central-registry* '(*default-pathname-defaults*)) + (asdf:operate 'asdf:load-op 'test1) + + ;; test that it compiled + (defvar file1-date (file-write-date (compile-file-pathname "file1"))) + (assert (and file1-date (file-write-date (compile-file-pathname "file2"))))) + +;; and loaded +(assert test-package::*file1*) + +(exit-on-error + ;; now remove one output file and check that the other is _not_ + ;; recompiled + (sleep 1) ; mtime has 1-second granularity, so pause here for fast machines + + (asdf::run-shell-command "rm ~A" + (namestring (compile-file-pathname "file2"))) + (asdf:operate 'asdf:load-op 'test1) + (assert (= file1-date (file-write-date (compile-file-pathname "file1")))) + (assert (file-write-date (compile-file-pathname "file2"))) + + ;; now touch file1 and check that file2 _is_ also recompiled + + ;; XXX run-shell-command loses if *default-pathname-defaults* is not the + ;; unix cwd. this is not a problem for run-tests.sh, but can be in general + + (let ((before (file-write-date (compile-file-pathname "file2")))) + (asdf::run-shell-command "touch file1.lisp") + (sleep 1) + (asdf:operate 'asdf:load-op 'test1) + (assert (> (file-write-date (compile-file-pathname "file2")) before))) + ) \ No newline at end of file Added: branches/trunk-reorg/thirdparty/asdf/test/test2.asd =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test2.asd 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test2.asd 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,8 @@ +;;; -*- Lisp -*- +(asdf:defsystem test2b + :version "1.0" + :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")))) + (:file "file1")) + :depends-on (version 'test2a "1.1")) + + Added: branches/trunk-reorg/thirdparty/asdf/test/test2.script =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test2.script 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test2.script 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,22 @@ +;;; -*- Lisp -*- +(load "script-support") +(load "../asdf") +(exit-on-error + (setf asdf:*central-registry* '(*default-pathname-defaults*)) + ;(trace asdf::perform) + ;(trace asdf::find-component) + ;(trace asdf::traverse) + (asdf:oos 'asdf:load-op 'test2b1) + (assert (and (probe-file (compile-file-pathname "file3")) + (probe-file (compile-file-pathname "file4")))) + (handler-case + (asdf:oos 'asdf:load-op 'test2b2) + (asdf:missing-dependency (c) + (format t "load failed as expected: - ~%~A~%" c)) + (:no-error (c) (error "should have failed, oops"))) + (handler-case + (asdf:oos 'asdf:load-op 'test2b3) + (asdf:missing-dependency (c) + (format t "load failed as expected: - ~%~A~%" c)) + (:no-error (c) (error "should have failed, oops"))) + ) \ No newline at end of file Added: branches/trunk-reorg/thirdparty/asdf/test/test2a.asd =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test2a.asd 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test2a.asd 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,12 @@ +;;; -*- Lisp -*- +(asdf:defsystem test2a + :version "1.1" + :components ((:file "file4" :in-order-to ((compile-op (load-op "file3")))) + (:file "file3"))) +#| +this system is referenced by test2b[12] +|# + + + + Added: branches/trunk-reorg/thirdparty/asdf/test/test2b1.asd =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test2b1.asd 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test2b1.asd 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,8 @@ +;;; -*- Lisp -*- +(asdf:defsystem test2b1 + :version "1.0" + :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")))) + (:file "file1")) + :in-order-to ((load-op (load-op (version test2a "1.1"))))) + + Added: branches/trunk-reorg/thirdparty/asdf/test/test2b2.asd =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test2b2.asd 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test2b2.asd 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,8 @@ +;;; -*- Lisp -*- +(asdf:defsystem test2b2 + :version "1.0" + :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")))) + (:file "file1")) + :in-order-to ((load-op (load-op (version test2a "1.2"))))) + + Added: branches/trunk-reorg/thirdparty/asdf/test/test2b3.asd =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test2b3.asd 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test2b3.asd 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,8 @@ +;;; -*- Lisp -*- +(asdf:defsystem test2b3 + :version "1.0" + :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")))) + (:file "file1")) + :depends-on (bet-you-cant-find-this)) + + Added: branches/trunk-reorg/thirdparty/asdf/test/test3.asd =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test3.asd 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test3.asd 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,11 @@ +;;; -*- Lisp -*- +(asdf:defsystem test3 + :properties ((:prop1 . "value")) + :components + ((:module "deps" + :if-component-dep-fails :try-next + :pathname "." + :components + ((:file "file1" :in-order-to ((compile-op (feature :f1)))) + (:file "file2" :in-order-to ((compile-op (feature :f2)))))))) + Added: branches/trunk-reorg/thirdparty/asdf/test/test3.script =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test3.script 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test3.script 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,26 @@ +;;; -*- Lisp -*- +#+(or f1 f2) + (error "This test cannot run if :f1 or :f2 are on *features*") +(load "script-support") +(load "../asdf") +(in-package :asdf) +(cl-user::exit-on-error + (asdf:run-shell-command "rm ~A ~A" + (namestring (compile-file-pathname "file1")) + (namestring (compile-file-pathname "file2"))) + (setf asdf:*central-registry* '(*default-pathname-defaults*)) + (handler-case + (asdf:oos 'asdf:load-op 'test3) + (asdf:missing-dependency (c) + (format t "first test failed as expected: - ~%~A~%" c)) + (:no-error (c) (error "should have failed, oops"))) + (pushnew :f1 *features*) + (asdf:oos 'asdf:load-op 'test3) + (assert (probe-file (compile-file-pathname "file1"))) + (assert (not (probe-file (compile-file-pathname "file2")))) + (run-shell-command "rm ~A" (namestring (compile-file-pathname "file1"))) + (setf *features* (cons :f2 (cdr *features*))) + (asdf:oos 'asdf:load-op 'test3) + (assert (probe-file (compile-file-pathname "file2"))) + (assert (not (probe-file (compile-file-pathname "file1")))) + ) Added: branches/trunk-reorg/thirdparty/asdf/test/test4.script =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/test4.script 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/test4.script 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,12 @@ +;;; -*- Lisp -*- +;;; -*- Lisp -*- +(load "script-support") +(load "../asdf") +(in-package :asdf) +(cl-user::exit-on-error + (setf asdf:*central-registry* '(*default-pathname-defaults*)) + (assert (not (component-property (find-system 'test3) :foo))) + (assert (equal (component-property (find-system 'test3) :prop1) "value")) + (setf (component-property (find-system 'test3) :foo) "bar") + (assert (equal (component-property (find-system 'test3) :foo) "bar")) + ) \ No newline at end of file Added: branches/trunk-reorg/thirdparty/asdf/test/wild-module.asd =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/wild-module.asd 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/wild-module.asd 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,5 @@ +;;; -*- Lisp -*- + +(asdf:defsystem :wild-module + :version "0.0" + :components ((:wild-module "systems" :pathname "*.asd"))) Added: branches/trunk-reorg/thirdparty/asdf/test/wild-module.script =================================================================== --- branches/trunk-reorg/thirdparty/asdf/test/wild-module.script 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/test/wild-module.script 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,11 @@ +;;; -*- Lisp -*- +(load "script-support") +(load "../asdf") +(exit-on-error + + (load "../asdf") + (load "../wild-modules") + + (setf asdf:*central-registry* '(*default-pathname-defaults*)) + (asdf:operate 'asdf:load-op 'wild-module) + ) \ No newline at end of file Added: branches/trunk-reorg/thirdparty/asdf/wild-modules.lisp =================================================================== --- branches/trunk-reorg/thirdparty/asdf/wild-modules.lisp 2007-10-14 19:12:46 UTC (rev 2235) +++ branches/trunk-reorg/thirdparty/asdf/wild-modules.lisp 2007-10-14 19:13:17 UTC (rev 2236) @@ -0,0 +1,38 @@ +(in-package :asdf) + +(defclass wild-module (module) + ((component-class :accessor wild-module-component-class + :initform 'static-file :initarg :component-class) + (component-options :accessor wild-module-component-options + :initform nil :initarg :component-options))) + +(defmethod (setf module-components) (new-value (module wild-module)) + (when new-value + (sysdef-error "Cannot explicitly set wild-module ~A's components. Please ~ +use a wild pathname instead." module))) + +(defmethod reinitialize-instance :after ((self wild-module) &key) + (let ((pathname (slot-value self 'relative-pathname))) + (and pathname + (not (wild-pathname-p pathname)) + (sysdef-error "Wild-module ~A specified with non-wild pathname ~A." + self pathname)) + (setf (slot-value self 'components) + (let* ((*default-pathname-defaults* (component-parent-pathname self)) + (files (directory (merge-pathnames (component-relative-pathname self)))) + (class (wild-module-component-class self)) + (options (wild-module-component-options self))) + (mapcar (lambda (file) + (apply #'make-instance class + :name (file-namestring file) + ;; XXX fails when wildcards are in + ;; the directory or higher parts. + :pathname file + :parent self + options)) + files))))) + +;; Don't export wild-module or else will get a full warning +;; when (require 'asdf) if asdf is already loaded + +;;(export '(wild-module))

1 0

[bknr-cvs] r2235 - branches/trunk-reorg/thirdparty
by bknr＠bknr.net 14 Oct '07

14 Oct '07

Author: hhubner Date: 2007-10-14 15:12:46 -0400 (Sun, 14 Oct 2007) New Revision: 2235 Removed: branches/trunk-reorg/thirdparty/asdf/ Log: update asdf

1 0

[bknr-cvs] r2234 - in branches/trunk-reorg/projects/scrabble: src website website/images website/images/de website/images/en
by bknr＠bknr.net 09 Oct '07

09 Oct '07

Author: hhubner Date: 2007-10-09 03:11:50 -0400 (Tue, 09 Oct 2007) New Revision: 2234 Added: branches/trunk-reorg/projects/scrabble/website/images/ branches/trunk-reorg/projects/scrabble/website/images/de/ branches/trunk-reorg/projects/scrabble/website/images/de/double-letter.png branches/trunk-reorg/projects/scrabble/website/images/de/double-word.png branches/trunk-reorg/projects/scrabble/website/images/de/triple-letter.png branches/trunk-reorg/projects/scrabble/website/images/de/triple-word.png branches/trunk-reorg/projects/scrabble/website/images/en/ Removed: branches/trunk-reorg/projects/scrabble/website/de/ branches/trunk-reorg/projects/scrabble/website/en/ branches/trunk-reorg/projects/scrabble/website/images/de/double-letter.png branches/trunk-reorg/projects/scrabble/website/images/de/double-word.png branches/trunk-reorg/projects/scrabble/website/images/de/scrabble.css branches/trunk-reorg/projects/scrabble/website/images/de/scrabble.html branches/trunk-reorg/projects/scrabble/website/images/de/scrabble.js branches/trunk-reorg/projects/scrabble/website/images/de/triple-letter.png branches/trunk-reorg/projects/scrabble/website/images/de/triple-word.png branches/trunk-reorg/projects/scrabble/website/images/en/scrabble.css branches/trunk-reorg/projects/scrabble/website/images/en/scrabble.html branches/trunk-reorg/projects/scrabble/website/images/en/scrabble.js Modified: branches/trunk-reorg/projects/scrabble/src/package.lisp branches/trunk-reorg/projects/scrabble/src/scrabble.asd branches/trunk-reorg/projects/scrabble/src/start-webserver.lisp branches/trunk-reorg/projects/scrabble/src/web.lisp branches/trunk-reorg/projects/scrabble/website/scrabble.css branches/trunk-reorg/projects/scrabble/website/scrabble.html branches/trunk-reorg/projects/scrabble/website/scrabble.js Log: checkpoint Modified: branches/trunk-reorg/projects/scrabble/src/package.lisp =================================================================== --- branches/trunk-reorg/projects/scrabble/src/package.lisp 2007-10-09 05:52:40 UTC (rev 2233) +++ branches/trunk-reorg/projects/scrabble/src/package.lisp 2007-10-09 07:11:50 UTC (rev 2234) @@ -48,6 +48,11 @@ :hunchentoot :bknr.datastore :bknr.user + :cl-who + :cl-interpol + :cl-ppcre :json - :scrabble)) + :scrabble) + (:shadowing-import-from :cl-interpol "QUOTE-META-CHARS") + (:export "START-WEBSERVER")) \ No newline at end of file Modified: branches/trunk-reorg/projects/scrabble/src/scrabble.asd =================================================================== --- branches/trunk-reorg/projects/scrabble/src/scrabble.asd 2007-10-09 05:52:40 UTC (rev 2233) +++ branches/trunk-reorg/projects/scrabble/src/scrabble.asd 2007-10-09 07:11:50 UTC (rev 2234) @@ -13,7 +13,10 @@ :depends-on (:bknr-datastore :bknr-web :hunchentoot + :cl-who :cl-json + :cl-ppcre + :cl-interpol :vecto :alexandria :anaphora) @@ -23,5 +26,6 @@ (:file "rules") (:file "game") (:file "web") + (:file "start-webserver") (:file "make-html") (:file "make-letters"))) Modified: branches/trunk-reorg/projects/scrabble/src/start-webserver.lisp =================================================================== --- branches/trunk-reorg/projects/scrabble/src/start-webserver.lisp 2007-10-09 05:52:40 UTC (rev 2233) +++ branches/trunk-reorg/projects/scrabble/src/start-webserver.lisp 2007-10-09 07:11:50 UTC (rev 2234) @@ -9,11 +9,15 @@ (make-pathname :name nil :type nil :version nil :defaults (merge-pathnames #p"../../../thirdparty/MochiKit/MochiKit/"))) -(when (and (boundp '*server*) *server*) - (stop-server *server*)) +(defun start-webserver (&key (port 4242)) + (when (and (boundp '*server*) *server*) + (stop-server *server*)) -(setq *dispatch-table* - (list (create-folder-dispatcher-and-handler "/MochiKit/" *mochikit-directory*) - (create-folder-dispatcher-and-handler "/scrabble/" *website-directory*))) + (setq *dispatch-table* + (list 'dispatch-easy-handlers + (create-prefix-dispatcher "/game/" 'game-handler) + (create-folder-dispatcher-and-handler "/MochiKit/" *mochikit-directory*) + (create-folder-dispatcher-and-handler "/images/" (merge-pathnames "images/de/" *website-directory*)) + (create-folder-dispatcher-and-handler "/" *website-directory*))) -(setq *server* (start-server :port 4242)) \ No newline at end of file + (setq *server* (start-server :port port))) \ No newline at end of file Modified: branches/trunk-reorg/projects/scrabble/src/web.lisp =================================================================== --- branches/trunk-reorg/projects/scrabble/src/web.lisp 2007-10-09 05:52:40 UTC (rev 2233) +++ branches/trunk-reorg/projects/scrabble/src/web.lisp 2007-10-09 07:11:50 UTC (rev 2234) @@ -1,5 +1,7 @@ (in-package :scrabble.web) +(enable-interpol-syntax) + (defparameter *ignore-slots* '(bknr.datastore::id bknr.indices::destroyed-p)) (defun encode-json-alist (alist stream) @@ -23,7 +25,7 @@ (princ #\} stream)) (defmethod encode-json ((tile-bag tile-bag) stream) - (encode-json-alist (list "remainingTiles" (remaining-tile-count tile-bag)) stream)) + (encode-json-alist (list :remaining-tiles (remaining-tile-count tile-bag)) stream)) (defmethod encode-json ((board board) stream) (princ #\[ stream) @@ -35,7 +37,55 @@ (princ #\] stream)) (defmethod encode-json ((participant participant) stream) - (encode-json-alist (list :name (user-login (player-of participant)) + (encode-json-alist (list :name (user-full-name (player-of participant)) :remaining-tiles (length (tray-of participant))) stream)) +(define-easy-handler (login :uri "/login" :default-request-type :post) + (login password) + (when (and login + (find-user login)) + (start-session) + (setf (session-value :user) login) + (redirect "/games")) + (with-html-output-to-string (*standard-output* nil) + + (:html + (:head + (:title "scrabble login")) + (:body + (:form :method "POST" + (:table + (:tr (:td "Username") (:td (:input :type "TEXT" :name "login"))) + (:tr (:td "Password") (:td (:input :type "PASSWORD" :name "password"))) + (:tr (:td) (:td (:input :type "SUBMIT"))))))))) + +(define-easy-handler (games :uri "/games") () + (start-session) + (with-html-output-to-string (*standard-output* nil) + (:html + (:head + (:title "scrabble game list")) + (:body + (:ul + (dolist (game (remove-if-not (lambda (game) + (member (find-user (session-value :user)) (participants-of game) + :key #'player-of)) + (class-instances 'game))) + (htm + (:li (:a :href (str (format nil "/game/~A" (store-object-id game))) "game"))))))))) + +(defun game-handler () + (start-session) + (register-groups-bind (object-id-string) (#?r".*/(\d+)$" (request-uri)) + (let ((object (find-store-object (parse-integer object-id-string)))) + (when (typep object 'game) + (return-from game-handler + (with-output-to-string (s) + (encode-json object s)))))) + (with-html-output-to-string (*standard-output* nil) + (:html + (:head + (:title "Invalid game ID")) + (:body + (:div "Invalid game ID"))))) \ No newline at end of file Copied: branches/trunk-reorg/projects/scrabble/website/images/de (from rev 2213, branches/trunk-reorg/projects/scrabble/website/de) Deleted: branches/trunk-reorg/projects/scrabble/website/images/de/double-letter.png =================================================================== (Binary files differ) Copied: branches/trunk-reorg/projects/scrabble/website/images/de/double-letter.png (from rev 2233, branches/trunk-reorg/projects/scrabble/website/de/double-letter.png) Deleted: branches/trunk-reorg/projects/scrabble/website/images/de/double-word.png =================================================================== (Binary files differ) Copied: branches/trunk-reorg/projects/scrabble/website/images/de/double-word.png (from rev 2233, branches/trunk-reorg/projects/scrabble/website/de/double-word.png) Deleted: branches/trunk-reorg/projects/scrabble/website/images/de/scrabble.css =================================================================== --- branches/trunk-reorg/projects/scrabble/website/de/scrabble.css 2007-10-04 22:25:38 UTC (rev 2213) +++ branches/trunk-reorg/projects/scrabble/website/images/de/scrabble.css 2007-10-09 07:11:50 UTC (rev 2234) @@ -1,229 +0,0 @@ -body { background-color: #004B36 } -#playfield { position: absolute } -#playfield div { position: absolute; width: 40px; height: 40px } -#playfield img { position: absolute; top: 3px; left: 3px } -#playfield #field-0-0 { background-image: url(triple-word.png); left: 0; top: 0 } -#playfield #field-0-1 { background-image: url(standard.png); left: 0; top: 44 } -#playfield #field-0-2 { background-image: url(standard.png); left: 0; top: 88 } -#playfield #field-0-3 { background-image: url(double-letter.png); left: 0; top: 132 } -#playfield #field-0-4 { background-image: url(standard.png); left: 0; top: 176 } -#playfield #field-0-5 { background-image: url(standard.png); left: 0; top: 220 } -#playfield #field-0-6 { background-image: url(standard.png); left: 0; top: 264 } -#playfield #field-0-7 { background-image: url(triple-word.png); left: 0; top: 308 } -#playfield #field-0-8 { background-image: url(standard.png); left: 0; top: 352 } -#playfield #field-0-9 { background-image: url(standard.png); left: 0; top: 396 } -#playfield #field-0-10 { background-image: url(standard.png); left: 0; top: 440 } -#playfield #field-0-11 { background-image: url(double-letter.png); left: 0; top: 484 } -#playfield #field-0-12 { background-image: url(standard.png); left: 0; top: 528 } -#playfield #field-0-13 { background-image: url(standard.png); left: 0; top: 572 } -#playfield #field-0-14 { background-image: url(triple-word.png); left: 0; top: 616 } -#playfield #field-1-0 { background-image: url(standard.png); left: 44; top: 0 } -#playfield #field-1-1 { background-image: url(double-word.png); left: 44; top: 44 } -#playfield #field-1-2 { background-image: url(standard.png); left: 44; top: 88 } -#playfield #field-1-3 { background-image: url(standard.png); left: 44; top: 132 } -#playfield #field-1-4 { background-image: url(standard.png); left: 44; top: 176 } -#playfield #field-1-5 { background-image: url(triple-letter.png); left: 44; top: 220 } -#playfield #field-1-6 { background-image: url(standard.png); left: 44; top: 264 } -#playfield #field-1-7 { background-image: url(standard.png); left: 44; top: 308 } -#playfield #field-1-8 { background-image: url(standard.png); left: 44; top: 352 } -#playfield #field-1-9 { background-image: url(triple-letter.png); left: 44; top: 396 } -#playfield #field-1-10 { background-image: url(standard.png); left: 44; top: 440 } -#playfield #field-1-11 { background-image: url(standard.png); left: 44; top: 484 } -#playfield #field-1-12 { background-image: url(standard.png); left: 44; top: 528 } -#playfield #field-1-13 { background-image: url(double-word.png); left: 44; top: 572 } -#playfield #field-1-14 { background-image: url(standard.png); left: 44; top: 616 } -#playfield #field-2-0 { background-image: url(standard.png); left: 88; top: 0 } -#playfield #field-2-1 { background-image: url(standard.png); left: 88; top: 44 } -#playfield #field-2-2 { background-image: url(double-word.png); left: 88; top: 88 } -#playfield #field-2-3 { background-image: url(standard.png); left: 88; top: 132 } -#playfield #field-2-4 { background-image: url(standard.png); left: 88; top: 176 } -#playfield #field-2-5 { background-image: url(standard.png); left: 88; top: 220 } -#playfield #field-2-6 { background-image: url(double-letter.png); left: 88; top: 264 } -#playfield #field-2-7 { background-image: url(standard.png); left: 88; top: 308 } -#playfield #field-2-8 { background-image: url(double-letter.png); left: 88; top: 352 } -#playfield #field-2-9 { background-image: url(standard.png); left: 88; top: 396 } -#playfield #field-2-10 { background-image: url(standard.png); left: 88; top: 440 } -#playfield #field-2-11 { background-image: url(standard.png); left: 88; top: 484 } -#playfield #field-2-12 { background-image: url(double-word.png); left: 88; top: 528 } -#playfield #field-2-13 { background-image: url(standard.png); left: 88; top: 572 } -#playfield #field-2-14 { background-image: url(standard.png); left: 88; top: 616 } -#playfield #field-3-0 { background-image: url(double-letter.png); left: 132; top: 0 } -#playfield #field-3-1 { background-image: url(standard.png); left: 132; top: 44 } -#playfield #field-3-2 { background-image: url(standard.png); left: 132; top: 88 } -#playfield #field-3-3 { background-image: url(double-word.png); left: 132; top: 132 } -#playfield #field-3-4 { background-image: url(standard.png); left: 132; top: 176 } -#playfield #field-3-5 { background-image: url(standard.png); left: 132; top: 220 } -#playfield #field-3-6 { background-image: url(standard.png); left: 132; top: 264 } -#playfield #field-3-7 { background-image: url(double-letter.png); left: 132; top: 308 } -#playfield #field-3-8 { background-image: url(standard.png); left: 132; top: 352 } -#playfield #field-3-9 { background-image: url(standard.png); left: 132; top: 396 } -#playfield #field-3-10 { background-image: url(standard.png); left: 132; top: 440 } -#playfield #field-3-11 { background-image: url(double-word.png); left: 132; top: 484 } -#playfield #field-3-12 { background-image: url(standard.png); left: 132; top: 528 } -#playfield #field-3-13 { background-image: url(standard.png); left: 132; top: 572 } -#playfield #field-3-14 { background-image: url(double-letter.png); left: 132; top: 616 } -#playfield #field-4-0 { background-image: url(standard.png); left: 176; top: 0 } -#playfield #field-4-1 { background-image: url(standard.png); left: 176; top: 44 } -#playfield #field-4-2 { background-image: url(standard.png); left: 176; top: 88 } -#playfield #field-4-3 { background-image: url(standard.png); left: 176; top: 132 } -#playfield #field-4-4 { background-image: url(double-word.png); left: 176; top: 176 } -#playfield #field-4-5 { background-image: url(standard.png); left: 176; top: 220 } -#playfield #field-4-6 { background-image: url(standard.png); left: 176; top: 264 } -#playfield #field-4-7 { background-image: url(standard.png); left: 176; top: 308 } -#playfield #field-4-8 { background-image: url(standard.png); left: 176; top: 352 } -#playfield #field-4-9 { background-image: url(standard.png); left: 176; top: 396 } -#playfield #field-4-10 { background-image: url(double-word.png); left: 176; top: 440 } -#playfield #field-4-11 { background-image: url(standard.png); left: 176; top: 484 } -#playfield #field-4-12 { background-image: url(standard.png); left: 176; top: 528 } -#playfield #field-4-13 { background-image: url(standard.png); left: 176; top: 572 } -#playfield #field-4-14 { background-image: url(standard.png); left: 176; top: 616 } -#playfield #field-5-0 { background-image: url(standard.png); left: 220; top: 0 } -#playfield #field-5-1 { background-image: url(triple-letter.png); left: 220; top: 44 } -#playfield #field-5-2 { background-image: url(standard.png); left: 220; top: 88 } -#playfield #field-5-3 { background-image: url(standard.png); left: 220; top: 132 } -#playfield #field-5-4 { background-image: url(standard.png); left: 220; top: 176 } -#playfield #field-5-5 { background-image: url(triple-letter.png); left: 220; top: 220 } -#playfield #field-5-6 { background-image: url(standard.png); left: 220; top: 264 } -#playfield #field-5-7 { background-image: url(standard.png); left: 220; top: 308 } -#playfield #field-5-8 { background-image: url(standard.png); left: 220; top: 352 } -#playfield #field-5-9 { background-image: url(triple-letter.png); left: 220; top: 396 } -#playfield #field-5-10 { background-image: url(standard.png); left: 220; top: 440 } -#playfield #field-5-11 { background-image: url(standard.png); left: 220; top: 484 } -#playfield #field-5-12 { background-image: url(standard.png); left: 220; top: 528 } -#playfield #field-5-13 { background-image: url(triple-letter.png); left: 220; top: 572 } -#playfield #field-5-14 { background-image: url(standard.png); left: 220; top: 616 } -#playfield #field-6-0 { background-image: url(standard.png); left: 264; top: 0 } -#playfield #field-6-1 { background-image: url(standard.png); left: 264; top: 44 } -#playfield #field-6-2 { background-image: url(double-letter.png); left: 264; top: 88 } -#playfield #field-6-3 { background-image: url(standard.png); left: 264; top: 132 } -#playfield #field-6-4 { background-image: url(standard.png); left: 264; top: 176 } -#playfield #field-6-5 { background-image: url(standard.png); left: 264; top: 220 } -#playfield #field-6-6 { background-image: url(double-letter.png); left: 264; top: 264 } -#playfield #field-6-7 { background-image: url(standard.png); left: 264; top: 308 } -#playfield #field-6-8 { background-image: url(double-letter.png); left: 264; top: 352 } -#playfield #field-6-9 { background-image: url(standard.png); left: 264; top: 396 } -#playfield #field-6-10 { background-image: url(standard.png); left: 264; top: 440 } -#playfield #field-6-11 { background-image: url(standard.png); left: 264; top: 484 } -#playfield #field-6-12 { background-image: url(double-letter.png); left: 264; top: 528 } -#playfield #field-6-13 { background-image: url(standard.png); left: 264; top: 572 } -#playfield #field-6-14 { background-image: url(standard.png); left: 264; top: 616 } -#playfield #field-7-0 { background-image: url(triple-word.png); left: 308; top: 0 } -#playfield #field-7-1 { background-image: url(standard.png); left: 308; top: 44 } -#playfield #field-7-2 { background-image: url(standard.png); left: 308; top: 88 } -#playfield #field-7-3 { background-image: url(double-letter.png); left: 308; top: 132 } -#playfield #field-7-4 { background-image: url(standard.png); left: 308; top: 176 } -#playfield #field-7-5 { background-image: url(standard.png); left: 308; top: 220 } -#playfield #field-7-6 { background-image: url(standard.png); left: 308; top: 264 } -#playfield #field-7-7 { background-image: url(triple-word.png); left: 308; top: 308 } -#playfield #field-7-8 { background-image: url(standard.png); left: 308; top: 352 } -#playfield #field-7-9 { background-image: url(standard.png); left: 308; top: 396 } -#playfield #field-7-10 { background-image: url(standard.png); left: 308; top: 440 } -#playfield #field-7-11 { background-image: url(double-letter.png); left: 308; top: 484 } -#playfield #field-7-12 { background-image: url(standard.png); left: 308; top: 528 } -#playfield #field-7-13 { background-image: url(standard.png); left: 308; top: 572 } -#playfield #field-7-14 { background-image: url(triple-word.png); left: 308; top: 616 } -#playfield #field-8-0 { background-image: url(standard.png); left: 352; top: 0 } -#playfield #field-8-1 { background-image: url(standard.png); left: 352; top: 44 } -#playfield #field-8-2 { background-image: url(double-letter.png); left: 352; top: 88 } -#playfield #field-8-3 { background-image: url(standard.png); left: 352; top: 132 } -#playfield #field-8-4 { background-image: url(standard.png); left: 352; top: 176 } -#playfield #field-8-5 { background-image: url(standard.png); left: 352; top: 220 } -#playfield #field-8-6 { background-image: url(double-letter.png); left: 352; top: 264 } -#playfield #field-8-7 { background-image: url(standard.png); left: 352; top: 308 } -#playfield #field-8-8 { background-image: url(double-letter.png); left: 352; top: 352 } -#playfield #field-8-9 { background-image: url(standard.png); left: 352; top: 396 } -#playfield #field-8-10 { background-image: url(standard.png); left: 352; top: 440 } -#playfield #field-8-11 { background-image: url(standard.png); left: 352; top: 484 } -#playfield #field-8-12 { background-image: url(double-letter.png); left: 352; top: 528 } -#playfield #field-8-13 { background-image: url(standard.png); left: 352; top: 572 } -#playfield #field-8-14 { background-image: url(standard.png); left: 352; top: 616 } -#playfield #field-9-0 { background-image: url(standard.png); left: 396; top: 0 } -#playfield #field-9-1 { background-image: url(triple-letter.png); left: 396; top: 44 } -#playfield #field-9-2 { background-image: url(standard.png); left: 396; top: 88 } -#playfield #field-9-3 { background-image: url(standard.png); left: 396; top: 132 } -#playfield #field-9-4 { background-image: url(standard.png); left: 396; top: 176 } -#playfield #field-9-5 { background-image: url(triple-letter.png); left: 396; top: 220 } -#playfield #field-9-6 { background-image: url(standard.png); left: 396; top: 264 } -#playfield #field-9-7 { background-image: url(standard.png); left: 396; top: 308 } -#playfield #field-9-8 { background-image: url(standard.png); left: 396; top: 352 } -#playfield #field-9-9 { background-image: url(triple-letter.png); left: 396; top: 396 } -#playfield #field-9-10 { background-image: url(standard.png); left: 396; top: 440 } -#playfield #field-9-11 { background-image: url(standard.png); left: 396; top: 484 } -#playfield #field-9-12 { background-image: url(standard.png); left: 396; top: 528 } -#playfield #field-9-13 { background-image: url(triple-letter.png); left: 396; top: 572 } -#playfield #field-9-14 { background-image: url(standard.png); left: 396; top: 616 } -#playfield #field-10-0 { background-image: url(standard.png); left: 440; top: 0 } -#playfield #field-10-1 { background-image: url(standard.png); left: 440; top: 44 } -#playfield #field-10-2 { background-image: url(standard.png); left: 440; top: 88 } -#playfield #field-10-3 { background-image: url(standard.png); left: 440; top: 132 } -#playfield #field-10-4 { background-image: url(double-word.png); left: 440; top: 176 } -#playfield #field-10-5 { background-image: url(standard.png); left: 440; top: 220 } -#playfield #field-10-6 { background-image: url(standard.png); left: 440; top: 264 } -#playfield #field-10-7 { background-image: url(standard.png); left: 440; top: 308 } -#playfield #field-10-8 { background-image: url(standard.png); left: 440; top: 352 } -#playfield #field-10-9 { background-image: url(standard.png); left: 440; top: 396 } -#playfield #field-10-10 { background-image: url(double-word.png); left: 440; top: 440 } -#playfield #field-10-11 { background-image: url(standard.png); left: 440; top: 484 } -#playfield #field-10-12 { background-image: url(standard.png); left: 440; top: 528 } -#playfield #field-10-13 { background-image: url(standard.png); left: 440; top: 572 } -#playfield #field-10-14 { background-image: url(standard.png); left: 440; top: 616 } -#playfield #field-11-0 { background-image: url(double-letter.png); left: 484; top: 0 } -#playfield #field-11-1 { background-image: url(standard.png); left: 484; top: 44 } -#playfield #field-11-2 { background-image: url(standard.png); left: 484; top: 88 } -#playfield #field-11-3 { background-image: url(double-word.png); left: 484; top: 132 } -#playfield #field-11-4 { background-image: url(standard.png); left: 484; top: 176 } -#playfield #field-11-5 { background-image: url(standard.png); left: 484; top: 220 } -#playfield #field-11-6 { background-image: url(standard.png); left: 484; top: 264 } -#playfield #field-11-7 { background-image: url(double-letter.png); left: 484; top: 308 } -#playfield #field-11-8 { background-image: url(standard.png); left: 484; top: 352 } -#playfield #field-11-9 { background-image: url(standard.png); left: 484; top: 396 } -#playfield #field-11-10 { background-image: url(standard.png); left: 484; top: 440 } -#playfield #field-11-11 { background-image: url(double-word.png); left: 484; top: 484 } -#playfield #field-11-12 { background-image: url(standard.png); left: 484; top: 528 } -#playfield #field-11-13 { background-image: url(standard.png); left: 484; top: 572 } -#playfield #field-11-14 { background-image: url(double-letter.png); left: 484; top: 616 } -#playfield #field-12-0 { background-image: url(standard.png); left: 528; top: 0 } -#playfield #field-12-1 { background-image: url(standard.png); left: 528; top: 44 } -#playfield #field-12-2 { background-image: url(double-word.png); left: 528; top: 88 } -#playfield #field-12-3 { background-image: url(standard.png); left: 528; top: 132 } -#playfield #field-12-4 { background-image: url(standard.png); left: 528; top: 176 } -#playfield #field-12-5 { background-image: url(standard.png); left: 528; top: 220 } -#playfield #field-12-6 { background-image: url(double-letter.png); left: 528; top: 264 } -#playfield #field-12-7 { background-image: url(standard.png); left: 528; top: 308 } -#playfield #field-12-8 { background-image: url(double-letter.png); left: 528; top: 352 } -#playfield #field-12-9 { background-image: url(standard.png); left: 528; top: 396 } -#playfield #field-12-10 { background-image: url(standard.png); left: 528; top: 440 } -#playfield #field-12-11 { background-image: url(standard.png); left: 528; top: 484 } -#playfield #field-12-12 { background-image: url(double-word.png); left: 528; top: 528 } -#playfield #field-12-13 { background-image: url(standard.png); left: 528; top: 572 } -#playfield #field-12-14 { background-image: url(standard.png); left: 528; top: 616 } -#playfield #field-13-0 { background-image: url(standard.png); left: 572; top: 0 } -#playfield #field-13-1 { background-image: url(double-word.png); left: 572; top: 44 } -#playfield #field-13-2 { background-image: url(standard.png); left: 572; top: 88 } -#playfield #field-13-3 { background-image: url(standard.png); left: 572; top: 132 } -#playfield #field-13-4 { background-image: url(standard.png); left: 572; top: 176 } -#playfield #field-13-5 { background-image: url(triple-letter.png); left: 572; top: 220 } -#playfield #field-13-6 { background-image: url(standard.png); left: 572; top: 264 } -#playfield #field-13-7 { background-image: url(standard.png); left: 572; top: 308 } -#playfield #field-13-8 { background-image: url(standard.png); left: 572; top: 352 } -#playfield #field-13-9 { background-image: url(triple-letter.png); left: 572; top: 396 } -#playfield #field-13-10 { background-image: url(standard.png); left: 572; top: 440 } -#playfield #field-13-11 { background-image: url(standard.png); left: 572; top: 484 } -#playfield #field-13-12 { background-image: url(standard.png); left: 572; top: 528 } -#playfield #field-13-13 { background-image: url(double-word.png); left: 572; top: 572 } -#playfield #field-13-14 { background-image: url(standard.png); left: 572; top: 616 } -#playfield #field-14-0 { background-image: url(triple-word.png); left: 616; top: 0 } -#playfield #field-14-1 { background-image: url(standard.png); left: 616; top: 44 } -#playfield #field-14-2 { background-image: url(standard.png); left: 616; top: 88 } -#playfield #field-14-3 { background-image: url(double-letter.png); left: 616; top: 132 } -#playfield #field-14-4 { background-image: url(standard.png); left: 616; top: 176 } -#playfield #field-14-5 { background-image: url(standard.png); left: 616; top: 220 } -#playfield #field-14-6 { background-image: url(standard.png); left: 616; top: 264 } -#playfield #field-14-7 { background-image: url(triple-word.png); left: 616; top: 308 } -#playfield #field-14-8 { background-image: url(standard.png); left: 616; top: 352 } -#playfield #field-14-9 { background-image: url(standard.png); left: 616; top: 396 } -#playfield #field-14-10 { background-image: url(standard.png); left: 616; top: 440 } -#playfield #field-14-11 { background-image: url(double-letter.png); left: 616; top: 484 } -#playfield #field-14-12 { background-image: url(standard.png); left: 616; top: 528 } -#playfield #field-14-13 { background-image: url(standard.png); left: 616; top: 572 } -#playfield #field-14-14 { background-image: url(triple-word.png); left: 616; top: 616 } Deleted: branches/trunk-reorg/projects/scrabble/website/images/de/scrabble.html =================================================================== --- branches/trunk-reorg/projects/scrabble/website/de/scrabble.html 2007-10-04 22:25:38 UTC (rev 2213) +++ branches/trunk-reorg/projects/scrabble/website/images/de/scrabble.html 2007-10-09 07:11:50 UTC (rev 2234) @@ -1,236 +0,0 @@ -<html> - <head> - <link rel="stylesheet" type="text/css" href="scrabble.css" /> - <script type="text/javascript" src="/MochiKit/MochiKit.js"> </script> - <script type="text/javascript" src="scrabble.js"> </script> - </head> - <body onload="init()"> - <div id='playfield'> - <div id='field-0-0'/></div> - <div id='field-0-1'/></div> - <div id='field-0-2'/></div> - <div id='field-0-3'/></div> - <div id='field-0-4'/></div> - <div id='field-0-5'/></div> - <div id='field-0-6'/></div> - <div id='field-0-7'/></div> - <div id='field-0-8'/></div> - <div id='field-0-9'/></div> - <div id='field-0-10'/></div> - <div id='field-0-11'/></div> - <div id='field-0-12'/></div> - <div id='field-0-13'/></div> - <div id='field-0-14'/></div> - <div id='field-1-0'/></div> - <div id='field-1-1'/></div> - <div id='field-1-2'/></div> - <div id='field-1-3'/></div> - <div id='field-1-4'/></div> - <div id='field-1-5'/></div> - <div id='field-1-6'/></div> - <div id='field-1-7'/></div> - <div id='field-1-8'/></div> - <div id='field-1-9'/></div> - <div id='field-1-10'/></div> - <div id='field-1-11'/></div> - <div id='field-1-12'/></div> - <div id='field-1-13'/></div> - <div id='field-1-14'/></div> - <div id='field-2-0'/></div> - <div id='field-2-1'/></div> - <div id='field-2-2'/></div> - <div id='field-2-3'/></div> - <div id='field-2-4'/></div> - <div id='field-2-5'/></div> - <div id='field-2-6'/></div> - <div id='field-2-7'/></div> - <div id='field-2-8'/></div> - <div id='field-2-9'/></div> - <div id='field-2-10'/></div> - <div id='field-2-11'/></div> - <div id='field-2-12'/></div> - <div id='field-2-13'/></div> - <div id='field-2-14'/></div> - <div id='field-3-0'/></div> - <div id='field-3-1'/></div> - <div id='field-3-2'/></div> - <div id='field-3-3'/></div> - <div id='field-3-4'/></div> - <div id='field-3-5'/></div> - <div id='field-3-6'/></div> - <div id='field-3-7'/></div> - <div id='field-3-8'/></div> - <div id='field-3-9'/></div> - <div id='field-3-10'/></div> - <div id='field-3-11'/></div> - <div id='field-3-12'/></div> - <div id='field-3-13'/></div> - <div id='field-3-14'/></div> - <div id='field-4-0'/></div> - <div id='field-4-1'/></div> - <div id='field-4-2'/></div> - <div id='field-4-3'/></div> - <div id='field-4-4'/></div> - <div id='field-4-5'/></div> - <div id='field-4-6'/></div> - <div id='field-4-7'/></div> - <div id='field-4-8'/></div> - <div id='field-4-9'/></div> - <div id='field-4-10'/></div> - <div id='field-4-11'/></div> - <div id='field-4-12'/></div> - <div id='field-4-13'/></div> - <div id='field-4-14'/></div> - <div id='field-5-0'/></div> - <div id='field-5-1'/></div> - <div id='field-5-2'/></div> - <div id='field-5-3'/></div> - <div id='field-5-4'/></div> - <div id='field-5-5'/></div> - <div id='field-5-6'/></div> - <div id='field-5-7'/></div> - <div id='field-5-8'/></div> - <div id='field-5-9'/></div> - <div id='field-5-10'/></div> - <div id='field-5-11'/></div> - <div id='field-5-12'/></div> - <div id='field-5-13'/></div> - <div id='field-5-14'/></div> - <div id='field-6-0'/></div> - <div id='field-6-1'/></div> - <div id='field-6-2'/></div> - <div id='field-6-3'/></div> - <div id='field-6-4'/></div> - <div id='field-6-5'/></div> - <div id='field-6-6'/></div> - <div id='field-6-7'/></div> - <div id='field-6-8'/></div> - <div id='field-6-9'/></div> - <div id='field-6-10'/></div> - <div id='field-6-11'/></div> - <div id='field-6-12'/></div> - <div id='field-6-13'/></div> - <div id='field-6-14'/></div> - <div id='field-7-0'/></div> - <div id='field-7-1'/></div> - <div id='field-7-2'/></div> - <div id='field-7-3'/></div> - <div id='field-7-4'/></div> - <div id='field-7-5'/></div> - <div id='field-7-6'/></div> - <div id='field-7-7'/></div> - <div id='field-7-8'/></div> - <div id='field-7-9'/></div> - <div id='field-7-10'/></div> - <div id='field-7-11'/></div> - <div id='field-7-12'/></div> - <div id='field-7-13'/></div> - <div id='field-7-14'/></div> - <div id='field-8-0'/></div> - <div id='field-8-1'/></div> - <div id='field-8-2'/></div> - <div id='field-8-3'/></div> - <div id='field-8-4'/></div> - <div id='field-8-5'/></div> - <div id='field-8-6'/></div> - <div id='field-8-7'/></div> - <div id='field-8-8'/></div> - <div id='field-8-9'/></div> - <div id='field-8-10'/></div> - <div id='field-8-11'/></div> - <div id='field-8-12'/></div> - <div id='field-8-13'/></div> - <div id='field-8-14'/></div> - <div id='field-9-0'/></div> - <div id='field-9-1'/></div> - <div id='field-9-2'/></div> - <div id='field-9-3'/></div> - <div id='field-9-4'/></div> - <div id='field-9-5'/></div> - <div id='field-9-6'/></div> - <div id='field-9-7'/></div> - <div id='field-9-8'/></div> - <div id='field-9-9'/></div> - <div id='field-9-10'/></div> - <div id='field-9-11'/></div> - <div id='field-9-12'/></div> - <div id='field-9-13'/></div> - <div id='field-9-14'/></div> - <div id='field-10-0'/></div> - <div id='field-10-1'/></div> - <div id='field-10-2'/></div> - <div id='field-10-3'/></div> - <div id='field-10-4'/></div> - <div id='field-10-5'/></div> - <div id='field-10-6'/></div> - <div id='field-10-7'/></div> - <div id='field-10-8'/></div> - <div id='field-10-9'/></div> - <div id='field-10-10'/></div> - <div id='field-10-11'/></div> - <div id='field-10-12'/></div> - <div id='field-10-13'/></div> - <div id='field-10-14'/></div> - <div id='field-11-0'/></div> - <div id='field-11-1'/></div> - <div id='field-11-2'/></div> - <div id='field-11-3'/></div> - <div id='field-11-4'/></div> - <div id='field-11-5'/></div> - <div id='field-11-6'/></div> - <div id='field-11-7'/></div> - <div id='field-11-8'/></div> - <div id='field-11-9'/></div> - <div id='field-11-10'/></div> - <div id='field-11-11'/></div> - <div id='field-11-12'/></div> - <div id='field-11-13'/></div> - <div id='field-11-14'/></div> - <div id='field-12-0'/></div> - <div id='field-12-1'/></div> - <div id='field-12-2'/></div> - <div id='field-12-3'/></div> - <div id='field-12-4'/></div> - <div id='field-12-5'/></div> - <div id='field-12-6'/></div> - <div id='field-12-7'/></div> - <div id='field-12-8'/></div> - <div id='field-12-9'/></div> - <div id='field-12-10'/></div> - <div id='field-12-11'/></div> - <div id='field-12-12'/></div> - <div id='field-12-13'/></div> - <div id='field-12-14'/></div> - <div id='field-13-0'/></div> - <div id='field-13-1'/></div> - <div id='field-13-2'/></div> - <div id='field-13-3'/></div> - <div id='field-13-4'/></div> - <div id='field-13-5'/></div> - <div id='field-13-6'/></div> - <div id='field-13-7'/></div> - <div id='field-13-8'/></div> - <div id='field-13-9'/></div> - <div id='field-13-10'/></div> - <div id='field-13-11'/></div> - <div id='field-13-12'/></div> - <div id='field-13-13'/></div> - <div id='field-13-14'/></div> - <div id='field-14-0'/></div> - <div id='field-14-1'/></div> - <div id='field-14-2'/></div> - <div id='field-14-3'/></div> - <div id='field-14-4'/></div> - <div id='field-14-5'/></div> - <div id='field-14-6'/></div> - <div id='field-14-7'/></div> - <div id='field-14-8'/></div> - <div id='field-14-9'/></div> - <div id='field-14-10'/></div> - <div id='field-14-11'/></div> - <div id='field-14-12'/></div> - <div id='field-14-13'/></div> - <div id='field-14-14'/></div> - </div> - </body> -</html> \ No newline at end of file Deleted: branches/trunk-reorg/projects/scrabble/website/images/de/scrabble.js =================================================================== --- branches/trunk-reorg/projects/scrabble/website/de/scrabble.js 2007-10-04 22:25:38 UTC (rev 2213) +++ branches/trunk-reorg/projects/scrabble/website/images/de/scrabble.js 2007-10-09 07:11:50 UTC (rev 2234) @@ -1,22 +0,0 @@ -// -*- Java -*- (really Javascript) - -function setLetter(x, y, letter) { - $('field-' + x + '-' + y).innerHTML = '<img src="' + letter + '.png"/>'; -} - -function setWord(x, y, word, down) { - for (i = 0; i < word.length; i++) { - setLetter(x, y, word.charAt(i)); - if (down) { - y++; - } else { - x++; - } - }; -} - -function init() { - setWord(6, 6, "ICH"); - setWord(7, 7, "LIEBE"); - setWord(8, 8, "DICH"); -} Deleted: branches/trunk-reorg/projects/scrabble/website/images/de/triple-letter.png =================================================================== (Binary files differ) Copied: branches/trunk-reorg/projects/scrabble/website/images/de/triple-letter.png (from rev 2233, branches/trunk-reorg/projects/scrabble/website/de/triple-letter.png) Deleted: branches/trunk-reorg/projects/scrabble/website/images/de/triple-word.png =================================================================== (Binary files differ) Copied: branches/trunk-reorg/projects/scrabble/website/images/de/triple-word.png (from rev 2233, branches/trunk-reorg/projects/scrabble/website/de/triple-word.png) Copied: branches/trunk-reorg/projects/scrabble/website/images/en (from rev 2228, branches/trunk-reorg/projects/scrabble/website/en) Deleted: branches/trunk-reorg/projects/scrabble/website/images/en/scrabble.css =================================================================== --- branches/trunk-reorg/projects/scrabble/website/en/scrabble.css 2007-10-06 23:09:39 UTC (rev 2228) +++ branches/trunk-reorg/projects/scrabble/website/images/en/scrabble.css 2007-10-09 07:11:50 UTC (rev 2234) @@ -1 +0,0 @@ -link ../de/scrabble.css \ No newline at end of file Deleted: branches/trunk-reorg/projects/scrabble/website/images/en/scrabble.html =================================================================== --- branches/trunk-reorg/projects/scrabble/website/en/scrabble.html 2007-10-06 23:09:39 UTC (rev 2228) +++ branches/trunk-reorg/projects/scrabble/website/images/en/scrabble.html 2007-10-09 07:11:50 UTC (rev 2234) @@ -1 +0,0 @@ -link ../de/scrabble.html \ No newline at end of file Deleted: branches/trunk-reorg/projects/scrabble/website/images/en/scrabble.js =================================================================== --- branches/trunk-reorg/projects/scrabble/website/en/scrabble.js 2007-10-06 23:09:39 UTC (rev 2228) +++ branches/trunk-reorg/projects/scrabble/website/images/en/scrabble.js 2007-10-09 07:11:50 UTC (rev 2234) @@ -1 +0,0 @@ -link ../de/scrabble.js \ No newline at end of file Modified: branches/trunk-reorg/projects/scrabble/website/scrabble.css =================================================================== --- branches/trunk-reorg/projects/scrabble/website/scrabble.css 2007-10-09 05:52:40 UTC (rev 2233) +++ branches/trunk-reorg/projects/scrabble/website/scrabble.css 2007-10-09 07:11:50 UTC (rev 2234) @@ -2,228 +2,235 @@ #playfield { position: absolute } #playfield div { position: absolute; width: 40px; height: 40px } #playfield img { position: absolute; top: 3px; left: 3px } -#playfield #field-0-0 { background-image: url(triple-word.png); left: 0; top: 0 } -#playfield #field-0-1 { background-image: url(standard.png); left: 0; top: 44 } -#playfield #field-0-2 { background-image: url(standard.png); left: 0; top: 88 } -#playfield #field-0-3 { background-image: url(double-letter.png); left: 0; top: 132 } -#playfield #field-0-4 { background-image: url(standard.png); left: 0; top: 176 } -#playfield #field-0-5 { background-image: url(standard.png); left: 0; top: 220 } -#playfield #field-0-6 { background-image: url(standard.png); left: 0; top: 264 } -#playfield #field-0-7 { background-image: url(triple-word.png); left: 0; top: 308 } -#playfield #field-0-8 { background-image: url(standard.png); left: 0; top: 352 } -#playfield #field-0-9 { background-image: url(standard.png); left: 0; top: 396 } -#playfield #field-0-10 { background-image: url(standard.png); left: 0; top: 440 } -#playfield #field-0-11 { background-image: url(double-letter.png); left: 0; top: 484 } -#playfield #field-0-12 { background-image: url(standard.png); left: 0; top: 528 } -#playfield #field-0-13 { background-image: url(standard.png); left: 0; top: 572 } -#playfield #field-0-14 { background-image: url(triple-word.png); left: 0; top: 616 } -#playfield #field-1-0 { background-image: url(standard.png); left: 44; top: 0 } -#playfield #field-1-1 { background-image: url(double-word.png); left: 44; top: 44 } -#playfield #field-1-2 { background-image: url(standard.png); left: 44; top: 88 } -#playfield #field-1-3 { background-image: url(standard.png); left: 44; top: 132 } -#playfield #field-1-4 { background-image: url(standard.png); left: 44; top: 176 } -#playfield #field-1-5 { background-image: url(triple-letter.png); left: 44; top: 220 } -#playfield #field-1-6 { background-image: url(standard.png); left: 44; top: 264 } -#playfield #field-1-7 { background-image: url(standard.png); left: 44; top: 308 } -#playfield #field-1-8 { background-image: url(standard.png); left: 44; top: 352 } -#playfield #field-1-9 { background-image: url(triple-letter.png); left: 44; top: 396 } -#playfield #field-1-10 { background-image: url(standard.png); left: 44; top: 440 } -#playfield #field-1-11 { background-image: url(standard.png); left: 44; top: 484 } -#playfield #field-1-12 { background-image: url(standard.png); left: 44; top: 528 } -#playfield #field-1-13 { background-image: url(double-word.png); left: 44; top: 572 } -#playfield #field-1-14 { background-image: url(standard.png); left: 44; top: 616 } -#playfield #field-2-0 { background-image: url(standard.png); left: 88; top: 0 } -#playfield #field-2-1 { background-image: url(standard.png); left: 88; top: 44 } -#playfield #field-2-2 { background-image: url(double-word.png); left: 88; top: 88 } -#playfield #field-2-3 { background-image: url(standard.png); left: 88; top: 132 } -#playfield #field-2-4 { background-image: url(standard.png); left: 88; top: 176 } -#playfield #field-2-5 { background-image: url(standard.png); left: 88; top: 220 } -#playfield #field-2-6 { background-image: url(double-letter.png); left: 88; top: 264 } -#playfield #field-2-7 { background-image: url(standard.png); left: 88; top: 308 } -#playfield #field-2-8 { background-image: url(double-letter.png); left: 88; top: 352 } -#playfield #field-2-9 { background-image: url(standard.png); left: 88; top: 396 } -#playfield #field-2-10 { background-image: url(standard.png); left: 88; top: 440 } -#playfield #field-2-11 { background-image: url(standard.png); left: 88; top: 484 } -#playfield #field-2-12 { background-image: url(double-word.png); left: 88; top: 528 } -#playfield #field-2-13 { background-image: url(standard.png); left: 88; top: 572 } -#playfield #field-2-14 { background-image: url(standard.png); left: 88; top: 616 } -#playfield #field-3-0 { background-image: url(double-letter.png); left: 132; top: 0 } -#playfield #field-3-1 { background-image: url(standard.png); left: 132; top: 44 } -#playfield #field-3-2 { background-image: url(standard.png); left: 132; top: 88 } -#playfield #field-3-3 { background-image: url(double-word.png); left: 132; top: 132 } -#playfield #field-3-4 { background-image: url(standard.png); left: 132; top: 176 } -#playfield #field-3-5 { background-image: url(standard.png); left: 132; top: 220 } -#playfield #field-3-6 { background-image: url(standard.png); left: 132; top: 264 } -#playfield #field-3-7 { background-image: url(double-letter.png); left: 132; top: 308 } -#playfield #field-3-8 { background-image: url(standard.png); left: 132; top: 352 } -#playfield #field-3-9 { background-image: url(standard.png); left: 132; top: 396 } -#playfield #field-3-10 { background-image: url(standard.png); left: 132; top: 440 } -#playfield #field-3-11 { background-image: url(double-word.png); left: 132; top: 484 } -#playfield #field-3-12 { background-image: url(standard.png); left: 132; top: 528 } -#playfield #field-3-13 { background-image: url(standard.png); left: 132; top: 572 } -#playfield #field-3-14 { background-image: url(double-letter.png); left: 132; top: 616 } -#playfield #field-4-0 { background-image: url(standard.png); left: 176; top: 0 } -#playfield #field-4-1 { background-image: url(standard.png); left: 176; top: 44 } -#playfield #field-4-2 { background-image: url(standard.png); left: 176; top: 88 } -#playfield #field-4-3 { background-image: url(standard.png); left: 176; top: 132 } -#playfield #field-4-4 { background-image: url(double-word.png); left: 176; top: 176 } -#playfield #field-4-5 { background-image: url(standard.png); left: 176; top: 220 } -#playfield #field-4-6 { background-image: url(standard.png); left: 176; top: 264 } -#playfield #field-4-7 { background-image: url(standard.png); left: 176; top: 308 } -#playfield #field-4-8 { background-image: url(standard.png); left: 176; top: 352 } -#playfield #field-4-9 { background-image: url(standard.png); left: 176; top: 396 } -#playfield #field-4-10 { background-image: url(double-word.png); left: 176; top: 440 } -#playfield #field-4-11 { background-image: url(standard.png); left: 176; top: 484 } -#playfield #field-4-12 { background-image: url(standard.png); left: 176; top: 528 } -#playfield #field-4-13 { background-image: url(standard.png); left: 176; top: 572 } -#playfield #field-4-14 { background-image: url(standard.png); left: 176; top: 616 } -#playfield #field-5-0 { background-image: url(standard.png); left: 220; top: 0 } -#playfield #field-5-1 { background-image: url(triple-letter.png); left: 220; top: 44 } -#playfield #field-5-2 { background-image: url(standard.png); left: 220; top: 88 } -#playfield #field-5-3 { background-image: url(standard.png); left: 220; top: 132 } -#playfield #field-5-4 { background-image: url(standard.png); left: 220; top: 176 } -#playfield #field-5-5 { background-image: url(triple-letter.png); left: 220; top: 220 } -#playfield #field-5-6 { background-image: url(standard.png); left: 220; top: 264 } -#playfield #field-5-7 { background-image: url(standard.png); left: 220; top: 308 } -#playfield #field-5-8 { background-image: url(standard.png); left: 220; top: 352 } -#playfield #field-5-9 { background-image: url(triple-letter.png); left: 220; top: 396 } -#playfield #field-5-10 { background-image: url(standard.png); left: 220; top: 440 } -#playfield #field-5-11 { background-image: url(standard.png); left: 220; top: 484 } -#playfield #field-5-12 { background-image: url(standard.png); left: 220; top: 528 } -#playfield #field-5-13 { background-image: url(triple-letter.png); left: 220; top: 572 } -#playfield #field-5-14 { background-image: url(standard.png); left: 220; top: 616 } -#playfield #field-6-0 { background-image: url(standard.png); left: 264; top: 0 } -#playfield #field-6-1 { background-image: url(standard.png); left: 264; top: 44 } -#playfield #field-6-2 { background-image: url(double-letter.png); left: 264; top: 88 } -#playfield #field-6-3 { background-image: url(standard.png); left: 264; top: 132 } -#playfield #field-6-4 { background-image: url(standard.png); left: 264; top: 176 } -#playfield #field-6-5 { background-image: url(standard.png); left: 264; top: 220 } -#playfield #field-6-6 { background-image: url(double-letter.png); left: 264; top: 264 } -#playfield #field-6-7 { background-image: url(standard.png); left: 264; top: 308 } -#playfield #field-6-8 { background-image: url(double-letter.png); left: 264; top: 352 } -#playfield #field-6-9 { background-image: url(standard.png); left: 264; top: 396 } -#playfield #field-6-10 { background-image: url(standard.png); left: 264; top: 440 } -#playfield #field-6-11 { background-image: url(standard.png); left: 264; top: 484 } -#playfield #field-6-12 { background-image: url(double-letter.png); left: 264; top: 528 } -#playfield #field-6-13 { background-image: url(standard.png); left: 264; top: 572 } -#playfield #field-6-14 { background-image: url(standard.png); left: 264; top: 616 } -#playfield #field-7-0 { background-image: url(triple-word.png); left: 308; top: 0 } -#playfield #field-7-1 { background-image: url(standard.png); left: 308; top: 44 } -#playfield #field-7-2 { background-image: url(standard.png); left: 308; top: 88 } -#playfield #field-7-3 { background-image: url(double-letter.png); left: 308; top: 132 } -#playfield #field-7-4 { background-image: url(standard.png); left: 308; top: 176 } -#playfield #field-7-5 { background-image: url(standard.png); left: 308; top: 220 } -#playfield #field-7-6 { background-image: url(standard.png); left: 308; top: 264 } -#playfield #field-7-7 { background-image: url(double-word.png); left: 308; top: 308 } -#playfield #field-7-8 { background-image: url(standard.png); left: 308; top: 352 } -#playfield #field-7-9 { background-image: url(standard.png); left: 308; top: 396 } -#playfield #field-7-10 { background-image: url(standard.png); left: 308; top: 440 } -#playfield #field-7-11 { background-image: url(double-letter.png); left: 308; top: 484 } -#playfield #field-7-12 { background-image: url(standard.png); left: 308; top: 528 } -#playfield #field-7-13 { background-image: url(standard.png); left: 308; top: 572 } -#playfield #field-7-14 { background-image: url(triple-word.png); left: 308; top: 616 } -#playfield #field-8-0 { background-image: url(standard.png); left: 352; top: 0 } -#playfield #field-8-1 { background-image: url(standard.png); left: 352; top: 44 } -#playfield #field-8-2 { background-image: url(double-letter.png); left: 352; top: 88 } -#playfield #field-8-3 { background-image: url(standard.png); left: 352; top: 132 } -#playfield #field-8-4 { background-image: url(standard.png); left: 352; top: 176 } -#playfield #field-8-5 { background-image: url(standard.png); left: 352; top: 220 } -#playfield #field-8-6 { background-image: url(double-letter.png); left: 352; top: 264 } -#playfield #field-8-7 { background-image: url(standard.png); left: 352; top: 308 } -#playfield #field-8-8 { background-image: url(double-letter.png); left: 352; top: 352 } -#playfield #field-8-9 { background-image: url(standard.png); left: 352; top: 396 } -#playfield #field-8-10 { background-image: url(standard.png); left: 352; top: 440 } -#playfield #field-8-11 { background-image: url(standard.png); left: 352; top: 484 } -#playfield #field-8-12 { background-image: url(double-letter.png); left: 352; top: 528 } -#playfield #field-8-13 { background-image: url(standard.png); left: 352; top: 572 } -#playfield #field-8-14 { background-image: url(standard.png); left: 352; top: 616 } -#playfield #field-9-0 { background-image: url(standard.png); left: 396; top: 0 } -#playfield #field-9-1 { background-image: url(triple-letter.png); left: 396; top: 44 } -#playfield #field-9-2 { background-image: url(standard.png); left: 396; top: 88 } -#playfield #field-9-3 { background-image: url(standard.png); left: 396; top: 132 } -#playfield #field-9-4 { background-image: url(standard.png); left: 396; top: 176 } -#playfield #field-9-5 { background-image: url(triple-letter.png); left: 396; top: 220 } -#playfield #field-9-6 { background-image: url(standard.png); left: 396; top: 264 } -#playfield #field-9-7 { background-image: url(standard.png); left: 396; top: 308 } -#playfield #field-9-8 { background-image: url(standard.png); left: 396; top: 352 } -#playfield #field-9-9 { background-image: url(triple-letter.png); left: 396; top: 396 } -#playfield #field-9-10 { background-image: url(standard.png); left: 396; top: 440 } -#playfield #field-9-11 { background-image: url(standard.png); left: 396; top: 484 } -#playfield #field-9-12 { background-image: url(standard.png); left: 396; top: 528 } -#playfield #field-9-13 { background-image: url(triple-letter.png); left: 396; top: 572 } -#playfield #field-9-14 { background-image: url(standard.png); left: 396; top: 616 } -#playfield #field-10-0 { background-image: url(standard.png); left: 440; top: 0 } -#playfield #field-10-1 { background-image: url(standard.png); left: 440; top: 44 } -#playfield #field-10-2 { background-image: url(standard.png); left: 440; top: 88 } -#playfield #field-10-3 { background-image: url(standard.png); left: 440; top: 132 } -#playfield #field-10-4 { background-image: url(double-word.png); left: 440; top: 176 } -#playfield #field-10-5 { background-image: url(standard.png); left: 440; top: 220 } -#playfield #field-10-6 { background-image: url(standard.png); left: 440; top: 264 } -#playfield #field-10-7 { background-image: url(standard.png); left: 440; top: 308 } -#playfield #field-10-8 { background-image: url(standard.png); left: 440; top: 352 } -#playfield #field-10-9 { background-image: url(standard.png); left: 440; top: 396 } -#playfield #field-10-10 { background-image: url(double-word.png); left: 440; top: 440 } -#playfield #field-10-11 { background-image: url(standard.png); left: 440; top: 484 } -#playfield #field-10-12 { background-image: url(standard.png); left: 440; top: 528 } -#playfield #field-10-13 { background-image: url(standard.png); left: 440; top: 572 } -#playfield #field-10-14 { background-image: url(standard.png); left: 440; top: 616 } -#playfield #field-11-0 { background-image: url(double-letter.png); left: 484; top: 0 } -#playfield #field-11-1 { background-image: url(standard.png); left: 484; top: 44 } -#playfield #field-11-2 { background-image: url(standard.png); left: 484; top: 88 } -#playfield #field-11-3 { background-image: url(double-word.png); left: 484; top: 132 } -#playfield #field-11-4 { background-image: url(standard.png); left: 484; top: 176 } -#playfield #field-11-5 { background-image: url(standard.png); left: 484; top: 220 } -#playfield #field-11-6 { background-image: url(standard.png); left: 484; top: 264 } -#playfield #field-11-7 { background-image: url(double-letter.png); left: 484; top: 308 } -#playfield #field-11-8 { background-image: url(standard.png); left: 484; top: 352 } -#playfield #field-11-9 { background-image: url(standard.png); left: 484; top: 396 } -#playfield #field-11-10 { background-image: url(standard.png); left: 484; top: 440 } -#playfield #field-11-11 { background-image: url(double-word.png); left: 484; top: 484 } -#playfield #field-11-12 { background-image: url(standard.png); left: 484; top: 528 } -#playfield #field-11-13 { background-image: url(standard.png); left: 484; top: 572 } -#playfield #field-11-14 { background-image: url(double-letter.png); left: 484; top: 616 } -#playfield #field-12-0 { background-image: url(standard.png); left: 528; top: 0 } -#playfield #field-12-1 { background-image: url(standard.png); left: 528; top: 44 } -#playfield #field-12-2 { background-image: url(double-word.png); left: 528; top: 88 } -#playfield #field-12-3 { background-image: url(standard.png); left: 528; top: 132 } -#playfield #field-12-4 { background-image: url(standard.png); left: 528; top: 176 } -#playfield #field-12-5 { background-image: url(standard.png); left: 528; top: 220 } -#playfield #field-12-6 { background-image: url(double-letter.png); left: 528; top: 264 } -#playfield #field-12-7 { background-image: url(standard.png); left: 528; top: 308 } -#playfield #field-12-8 { background-image: url(double-letter.png); left: 528; top: 352 } -#playfield #field-12-9 { background-image: url(standard.png); left: 528; top: 396 } -#playfield #field-12-10 { background-image: url(standard.png); left: 528; top: 440 } -#playfield #field-12-11 { background-image: url(standard.png); left: 528; top: 484 } -#playfield #field-12-12 { background-image: url(double-word.png); left: 528; top: 528 } -#playfield #field-12-13 { background-image: url(standard.png); left: 528; top: 572 } -#playfield #field-12-14 { background-image: url(standard.png); left: 528; top: 616 } -#playfield #field-13-0 { background-image: url(standard.png); left: 572; top: 0 } -#playfield #field-13-1 { background-image: url(double-word.png); left: 572; top: 44 } -#playfield #field-13-2 { background-image: url(standard.png); left: 572; top: 88 } -#playfield #field-13-3 { background-image: url(standard.png); left: 572; top: 132 } -#playfield #field-13-4 { background-image: url(standard.png); left: 572; top: 176 } -#playfield #field-13-5 { background-image: url(triple-letter.png); left: 572; top: 220 } -#playfield #field-13-6 { background-image: url(standard.png); left: 572; top: 264 } -#playfield #field-13-7 { background-image: url(standard.png); left: 572; top: 308 } -#playfield #field-13-8 { background-image: url(standard.png); left: 572; top: 352 } -#playfield #field-13-9 { background-image: url(triple-letter.png); left: 572; top: 396 } -#playfield #field-13-10 { background-image: url(standard.png); left: 572; top: 440 } -#playfield #field-13-11 { background-image: url(standard.png); left: 572; top: 484 } -#playfield #field-13-12 { background-image: url(standard.png); left: 572; top: 528 } -#playfield #field-13-13 { background-image: url(double-word.png); left: 572; top: 572 } -#playfield #field-13-14 { background-image: url(standard.png); left: 572; top: 616 } -#playfield #field-14-0 { background-image: url(triple-word.png); left: 616; top: 0 } -#playfield #field-14-1 { background-image: url(standard.png); left: 616; top: 44 } -#playfield #field-14-2 { background-image: url(standard.png); left: 616; top: 88 } -#playfield #field-14-3 { background-image: url(double-letter.png); left: 616; top: 132 } -#playfield #field-14-4 { background-image: url(standard.png); left: 616; top: 176 } -#playfield #field-14-5 { background-image: url(standard.png); left: 616; top: 220 } -#playfield #field-14-6 { background-image: url(standard.png); left: 616; top: 264 } -#playfield #field-14-7 { background-image: url(triple-word.png); left: 616; top: 308 } -#playfield #field-14-8 { background-image: url(standard.png); left: 616; top: 352 } -#playfield #field-14-9 { background-image: url(standard.png); left: 616; top: 396 } -#playfield #field-14-10 { background-image: url(standard.png); left: 616; top: 440 } -#playfield #field-14-11 { background-image: url(double-letter.png); left: 616; top: 484 } -#playfield #field-14-12 { background-image: url(standard.png); left: 616; top: 528 } -#playfield #field-14-13 { background-image: url(standard.png); left: 616; top: 572 } -#playfield #field-14-14 { background-image: url(triple-word.png); left: 616; top: 616 } +#playfield #field-0-0 { background-image: url(images/triple-word.png); left: 0; top: 0 } +#playfield #field-0-1 { background-image: url(images/standard.png); left: 0; top: 44 } +#playfield #field-0-2 { background-image: url(images/standard.png); left: 0; top: 88 } +#playfield #field-0-3 { background-image: url(images/double-letter.png); left: 0; top: 132 } +#playfield #field-0-4 { background-image: url(images/standard.png); left: 0; top: 176 } +#playfield #field-0-5 { background-image: url(images/standard.png); left: 0; top: 220 } +#playfield #field-0-6 { background-image: url(images/standard.png); left: 0; top: 264 } +#playfield #field-0-7 { background-image: url(images/triple-word.png); left: 0; top: 308 } +#playfield #field-0-8 { background-image: url(images/standard.png); left: 0; top: 352 } +#playfield #field-0-9 { background-image: url(images/standard.png); left: 0; top: 396 } +#playfield #field-0-10 { background-image: url(images/standard.png); left: 0; top: 440 } +#playfield #field-0-11 { background-image: url(images/double-letter.png); left: 0; top: 484 } +#playfield #field-0-12 { background-image: url(images/standard.png); left: 0; top: 528 } +#playfield #field-0-13 { background-image: url(images/standard.png); left: 0; top: 572 } +#playfield #field-0-14 { background-image: url(images/triple-word.png); left: 0; top: 616 } +#playfield #field-1-0 { background-image: url(images/standard.png); left: 44; top: 0 } +#playfield #field-1-1 { background-image: url(images/double-word.png); left: 44; top: 44 } +#playfield #field-1-2 { background-image: url(images/standard.png); left: 44; top: 88 } +#playfield #field-1-3 { background-image: url(images/standard.png); left: 44; top: 132 } +#playfield #field-1-4 { background-image: url(images/standard.png); left: 44; top: 176 } +#playfield #field-1-5 { background-image: url(images/triple-letter.png); left: 44; top: 220 } +#playfield #field-1-6 { background-image: url(images/standard.png); left: 44; top: 264 } +#playfield #field-1-7 { background-image: url(images/standard.png); left: 44; top: 308 } +#playfield #field-1-8 { background-image: url(images/standard.png); left: 44; top: 352 } +#playfield #field-1-9 { background-image: url(images/triple-letter.png); left: 44; top: 396 } +#playfield #field-1-10 { background-image: url(images/standard.png); left: 44; top: 440 } +#playfield #field-1-11 { background-image: url(images/standard.png); left: 44; top: 484 } +#playfield #field-1-12 { background-image: url(images/standard.png); left: 44; top: 528 } +#playfield #field-1-13 { background-image: url(images/double-word.png); left: 44; top: 572 } +#playfield #field-1-14 { background-image: url(images/standard.png); left: 44; top: 616 } +#playfield #field-2-0 { background-image: url(images/standard.png); left: 88; top: 0 } +#playfield #field-2-1 { background-image: url(images/standard.png); left: 88; top: 44 } +#playfield #field-2-2 { background-image: url(images/double-word.png); left: 88; top: 88 } +#playfield #field-2-3 { background-image: url(images/standard.png); left: 88; top: 132 } +#playfield #field-2-4 { background-image: url(images/standard.png); left: 88; top: 176 } +#playfield #field-2-5 { background-image: url(images/standard.png); left: 88; top: 220 } +#playfield #field-2-6 { background-image: url(images/double-letter.png); left: 88; top: 264 } +#playfield #field-2-7 { background-image: url(images/standard.png); left: 88; top: 308 } +#playfield #field-2-8 { background-image: url(images/double-letter.png); left: 88; top: 352 } +#playfield #field-2-9 { background-image: url(images/standard.png); left: 88; top: 396 } +#playfield #field-2-10 { background-image: url(images/standard.png); left: 88; top: 440 } +#playfield #field-2-11 { background-image: url(images/standard.png); left: 88; top: 484 } +#playfield #field-2-12 { background-image: url(images/double-word.png); left: 88; top: 528 } +#playfield #field-2-13 { background-image: url(images/standard.png); left: 88; top: 572 } +#playfield #field-2-14 { background-image: url(images/standard.png); left: 88; top: 616 } +#playfield #field-3-0 { background-image: url(images/double-letter.png); left: 132; top: 0 } +#playfield #field-3-1 { background-image: url(images/standard.png); left: 132; top: 44 } +#playfield #field-3-2 { background-image: url(images/standard.png); left: 132; top: 88 } +#playfield #field-3-3 { background-image: url(images/double-word.png); left: 132; top: 132 } +#playfield #field-3-4 { background-image: url(images/standard.png); left: 132; top: 176 } +#playfield #field-3-5 { background-image: url(images/standard.png); left: 132; top: 220 } +#playfield #field-3-6 { background-image: url(images/standard.png); left: 132; top: 264 } +#playfield #field-3-7 { background-image: url(images/double-letter.png); left: 132; top: 308 } +#playfield #field-3-8 { background-image: url(images/standard.png); left: 132; top: 352 } +#playfield #field-3-9 { background-image: url(images/standard.png); left: 132; top: 396 } +#playfield #field-3-10 { background-image: url(images/standard.png); left: 132; top: 440 } +#playfield #field-3-11 { background-image: url(images/double-word.png); left: 132; top: 484 } +#playfield #field-3-12 { background-image: url(images/standard.png); left: 132; top: 528 } +#playfield #field-3-13 { background-image: url(images/standard.png); left: 132; top: 572 } +#playfield #field-3-14 { background-image: url(images/double-letter.png); left: 132; top: 616 } +#playfield #field-4-0 { background-image: url(images/standard.png); left: 176; top: 0 } +#playfield #field-4-1 { background-image: url(images/standard.png); left: 176; top: 44 } +#playfield #field-4-2 { background-image: url(images/standard.png); left: 176; top: 88 } +#playfield #field-4-3 { background-image: url(images/standard.png); left: 176; top: 132 } +#playfield #field-4-4 { background-image: url(images/double-word.png); left: 176; top: 176 } +#playfield #field-4-5 { background-image: url(images/standard.png); left: 176; top: 220 } +#playfield #field-4-6 { background-image: url(images/standard.png); left: 176; top: 264 } +#playfield #field-4-7 { background-image: url(images/standard.png); left: 176; top: 308 } +#playfield #field-4-8 { background-image: url(images/standard.png); left: 176; top: 352 } +#playfield #field-4-9 { background-image: url(images/standard.png); left: 176; top: 396 } +#playfield #field-4-10 { background-image: url(images/double-word.png); left: 176; top: 440 } +#playfield #field-4-11 { background-image: url(images/standard.png); left: 176; top: 484 } +#playfield #field-4-12 { background-image: url(images/standard.png); left: 176; top: 528 } +#playfield #field-4-13 { background-image: url(images/standard.png); left: 176; top: 572 } +#playfield #field-4-14 { background-image: url(images/standard.png); left: 176; top: 616 } +#playfield #field-5-0 { background-image: url(images/standard.png); left: 220; top: 0 } +#playfield #field-5-1 { background-image: url(images/triple-letter.png); left: 220; top: 44 } +#playfield #field-5-2 { background-image: url(images/standard.png); left: 220; top: 88 } +#playfield #field-5-3 { background-image: url(images/standard.png); left: 220; top: 132 } +#playfield #field-5-4 { background-image: url(images/standard.png); left: 220; top: 176 } +#playfield #field-5-5 { background-image: url(images/triple-letter.png); left: 220; top: 220 } +#playfield #field-5-6 { background-image: url(images/standard.png); left: 220; top: 264 } +#playfield #field-5-7 { background-image: url(images/standard.png); left: 220; top: 308 } +#playfield #field-5-8 { background-image: url(images/standard.png); left: 220; top: 352 } +#playfield #field-5-9 { background-image: url(images/triple-letter.png); left: 220; top: 396 } +#playfield #field-5-10 { background-image: url(images/standard.png); left: 220; top: 440 } +#playfield #field-5-11 { background-image: url(images/standard.png); left: 220; top: 484 } +#playfield #field-5-12 { background-image: url(images/standard.png); left: 220; top: 528 } +#playfield #field-5-13 { background-image: url(images/triple-letter.png); left: 220; top: 572 } +#playfield #field-5-14 { background-image: url(images/standard.png); left: 220; top: 616 } +#playfield #field-6-0 { background-image: url(images/standard.png); left: 264; top: 0 } +#playfield #field-6-1 { background-image: url(images/standard.png); left: 264; top: 44 } +#playfield #field-6-2 { background-image: url(images/double-letter.png); left: 264; top: 88 } +#playfield #field-6-3 { background-image: url(images/standard.png); left: 264; top: 132 } +#playfield #field-6-4 { background-image: url(images/standard.png); left: 264; top: 176 } +#playfield #field-6-5 { background-image: url(images/standard.png); left: 264; top: 220 } +#playfield #field-6-6 { background-image: url(images/double-letter.png); left: 264; top: 264 } +#playfield #field-6-7 { background-image: url(images/standard.png); left: 264; top: 308 } +#playfield #field-6-8 { background-image: url(images/double-letter.png); left: 264; top: 352 } +#playfield #field-6-9 { background-image: url(images/standard.png); left: 264; top: 396 } +#playfield #field-6-10 { background-image: url(images/standard.png); left: 264; top: 440 } +#playfield #field-6-11 { background-image: url(images/standard.png); left: 264; top: 484 } +#playfield #field-6-12 { background-image: url(images/double-letter.png); left: 264; top: 528 } +#playfield #field-6-13 { background-image: url(images/standard.png); left: 264; top: 572 } +#playfield #field-6-14 { background-image: url(images/standard.png); left: 264; top: 616 } +#playfield #field-7-0 { background-image: url(images/triple-word.png); left: 308; top: 0 } +#playfield #field-7-1 { background-image: url(images/standard.png); left: 308; top: 44 } +#playfield #field-7-2 { background-image: url(images/standard.png); left: 308; top: 88 } +#playfield #field-7-3 { background-image: url(images/double-letter.png); left: 308; top: 132 } +#playfield #field-7-4 { background-image: url(images/standard.png); left: 308; top: 176 } +#playfield #field-7-5 { background-image: url(images/standard.png); left: 308; top: 220 } +#playfield #field-7-6 { background-image: url(images/standard.png); left: 308; top: 264 } +#playfield #field-7-7 { background-image: url(images/double-word.png); left: 308; top: 308 } +#playfield #field-7-8 { background-image: url(images/standard.png); left: 308; top: 352 } +#playfield #field-7-9 { background-image: url(images/standard.png); left: 308; top: 396 } +#playfield #field-7-10 { background-image: url(images/standard.png); left: 308; top: 440 } +#playfield #field-7-11 { background-image: url(images/double-letter.png); left: 308; top: 484 } +#playfield #field-7-12 { background-image: url(images/standard.png); left: 308; top: 528 } +#playfield #field-7-13 { background-image: url(images/standard.png); left: 308; top: 572 } +#playfield #field-7-14 { background-image: url(images/triple-word.png); left: 308; top: 616 } +#playfield #field-8-0 { background-image: url(images/standard.png); left: 352; top: 0 } +#playfield #field-8-1 { background-image: url(images/standard.png); left: 352; top: 44 } +#playfield #field-8-2 { background-image: url(images/double-letter.png); left: 352; top: 88 } +#playfield #field-8-3 { background-image: url(images/standard.png); left: 352; top: 132 } +#playfield #field-8-4 { background-image: url(images/standard.png); left: 352; top: 176 } +#playfield #field-8-5 { background-image: url(images/standard.png); left: 352; top: 220 } +#playfield #field-8-6 { background-image: url(images/double-letter.png); left: 352; top: 264 } +#playfield #field-8-7 { background-image: url(images/standard.png); left: 352; top: 308 } +#playfield #field-8-8 { background-image: url(images/double-letter.png); left: 352; top: 352 } +#playfield #field-8-9 { background-image: url(images/standard.png); left: 352; top: 396 } +#playfield #field-8-10 { background-image: url(images/standard.png); left: 352; top: 440 } +#playfield #field-8-11 { background-image: url(images/standard.png); left: 352; top: 484 } +#playfield #field-8-12 { background-image: url(images/double-letter.png); left: 352; top: 528 } +#playfield #field-8-13 { background-image: url(images/standard.png); left: 352; top: 572 } +#playfield #field-8-14 { background-image: url(images/standard.png); left: 352; top: 616 } +#playfield #field-9-0 { background-image: url(images/standard.png); left: 396; top: 0 } +#playfield #field-9-1 { background-image: url(images/triple-letter.png); left: 396; top: 44 } +#playfield #field-9-2 { background-image: url(images/standard.png); left: 396; top: 88 } +#playfield #field-9-3 { background-image: url(images/standard.png); left: 396; top: 132 } +#playfield #field-9-4 { background-image: url(images/standard.png); left: 396; top: 176 } +#playfield #field-9-5 { background-image: url(images/triple-letter.png); left: 396; top: 220 } +#playfield #field-9-6 { background-image: url(images/standard.png); left: 396; top: 264 } +#playfield #field-9-7 { background-image: url(images/standard.png); left: 396; top: 308 } +#playfield #field-9-8 { background-image: url(images/standard.png); left: 396; top: 352 } +#playfield #field-9-9 { background-image: url(images/triple-letter.png); left: 396; top: 396 } +#playfield #field-9-10 { background-image: url(images/standard.png); left: 396; top: 440 } +#playfield #field-9-11 { background-image: url(images/standard.png); left: 396; top: 484 } +#playfield #field-9-12 { background-image: url(images/standard.png); left: 396; top: 528 } +#playfield #field-9-13 { background-image: url(images/triple-letter.png); left: 396; top: 572 } +#playfield #field-9-14 { background-image: url(images/standard.png); left: 396; top: 616 } +#playfield #field-10-0 { background-image: url(images/standard.png); left: 440; top: 0 } +#playfield #field-10-1 { background-image: url(images/standard.png); left: 440; top: 44 } +#playfield #field-10-2 { background-image: url(images/standard.png); left: 440; top: 88 } +#playfield #field-10-3 { background-image: url(images/standard.png); left: 440; top: 132 } +#playfield #field-10-4 { background-image: url(images/double-word.png); left: 440; top: 176 } +#playfield #field-10-5 { background-image: url(images/standard.png); left: 440; top: 220 } +#playfield #field-10-6 { background-image: url(images/standard.png); left: 440; top: 264 } +#playfield #field-10-7 { background-image: url(images/standard.png); left: 440; top: 308 } +#playfield #field-10-8 { background-image: url(images/standard.png); left: 440; top: 352 } +#playfield #field-10-9 { background-image: url(images/standard.png); left: 440; top: 396 } +#playfield #field-10-10 { background-image: url(images/double-word.png); left: 440; top: 440 } +#playfield #field-10-11 { background-image: url(images/standard.png); left: 440; top: 484 } +#playfield #field-10-12 { background-image: url(images/standard.png); left: 440; top: 528 } +#playfield #field-10-13 { background-image: url(images/standard.png); left: 440; top: 572 } +#playfield #field-10-14 { background-image: url(images/standard.png); left: 440; top: 616 } +#playfield #field-11-0 { background-image: url(images/double-letter.png); left: 484; top: 0 } +#playfield #field-11-1 { background-image: url(images/standard.png); left: 484; top: 44 } +#playfield #field-11-2 { background-image: url(images/standard.png); left: 484; top: 88 } +#playfield #field-11-3 { background-image: url(images/double-word.png); left: 484; top: 132 } +#playfield #field-11-4 { background-image: url(images/standard.png); left: 484; top: 176 } +#playfield #field-11-5 { background-image: url(images/standard.png); left: 484; top: 220 } +#playfield #field-11-6 { background-image: url(images/standard.png); left: 484; top: 264 } +#playfield #field-11-7 { background-image: url(images/double-letter.png); left: 484; top: 308 } +#playfield #field-11-8 { background-image: url(images/standard.png); left: 484; top: 352 } +#playfield #field-11-9 { background-image: url(images/standard.png); left: 484; top: 396 } +#playfield #field-11-10 { background-image: url(images/standard.png); left: 484; top: 440 } +#playfield #field-11-11 { background-image: url(images/double-word.png); left: 484; top: 484 } +#playfield #field-11-12 { background-image: url(images/standard.png); left: 484; top: 528 } +#playfield #field-11-13 { background-image: url(images/standard.png); left: 484; top: 572 } +#playfield #field-11-14 { background-image: url(images/double-letter.png); left: 484; top: 616 } +#playfield #field-12-0 { background-image: url(images/standard.png); left: 528; top: 0 } +#playfield #field-12-1 { background-image: url(images/standard.png); left: 528; top: 44 } +#playfield #field-12-2 { background-image: url(images/double-word.png); left: 528; top: 88 } +#playfield #field-12-3 { background-image: url(images/standard.png); left: 528; top: 132 } +#playfield #field-12-4 { background-image: url(images/standard.png); left: 528; top: 176 } +#playfield #field-12-5 { background-image: url(images/standard.png); left: 528; top: 220 } +#playfield #field-12-6 { background-image: url(images/double-letter.png); left: 528; top: 264 } +#playfield #field-12-7 { background-image: url(images/standard.png); left: 528; top: 308 } +#playfield #field-12-8 { background-image: url(images/double-letter.png); left: 528; top: 352 } +#playfield #field-12-9 { background-image: url(images/standard.png); left: 528; top: 396 } +#playfield #field-12-10 { background-image: url(images/standard.png); left: 528; top: 440 } +#playfield #field-12-11 { background-image: url(images/standard.png); left: 528; top: 484 } +#playfield #field-12-12 { background-image: url(images/double-word.png); left: 528; top: 528 } +#playfield #field-12-13 { background-image: url(images/standard.png); left: 528; top: 572 } +#playfield #field-12-14 { background-image: url(images/standard.png); left: 528; top: 616 } +#playfield #field-13-0 { background-image: url(images/standard.png); left: 572; top: 0 } +#playfield #field-13-1 { background-image: url(images/double-word.png); left: 572; top: 44 } +#playfield #field-13-2 { background-image: url(images/standard.png); left: 572; top: 88 } +#playfield #field-13-3 { background-image: url(images/standard.png); left: 572; top: 132 } +#playfield #field-13-4 { background-image: url(images/standard.png); left: 572; top: 176 } +#playfield #field-13-5 { background-image: url(images/triple-letter.png); left: 572; top: 220 } +#playfield #field-13-6 { background-image: url(images/standard.png); left: 572; top: 264 } +#playfield #field-13-7 { background-image: url(images/standard.png); left: 572; top: 308 } +#playfield #field-13-8 { background-image: url(images/standard.png); left: 572; top: 352 } +#playfield #field-13-9 { background-image: url(images/triple-letter.png); left: 572; top: 396 } +#playfield #field-13-10 { background-image: url(images/standard.png); left: 572; top: 440 } +#playfield #field-13-11 { background-image: url(images/standard.png); left: 572; top: 484 } +#playfield #field-13-12 { background-image: url(images/standard.png); left: 572; top: 528 } +#playfield #field-13-13 { background-image: url(images/double-word.png); left: 572; top: 572 } +#playfield #field-13-14 { background-image: url(images/standard.png); left: 572; top: 616 } +#playfield #field-14-0 { background-image: url(images/triple-word.png); left: 616; top: 0 } +#playfield #field-14-1 { background-image: url(images/standard.png); left: 616; top: 44 } +#playfield #field-14-2 { background-image: url(images/standard.png); left: 616; top: 88 } +#playfield #field-14-3 { background-image: url(images/double-letter.png); left: 616; top: 132 } +#playfield #field-14-4 { background-image: url(images/standard.png); left: 616; top: 176 } +#playfield #field-14-5 { background-image: url(images/standard.png); left: 616; top: 220 } +#playfield #field-14-6 { background-image: url(images/standard.png); left: 616; top: 264 } +#playfield #field-14-7 { background-image: url(images/triple-word.png); left: 616; top: 308 } +#playfield #field-14-8 { background-image: url(images/standard.png); left: 616; top: 352 } +#playfield #field-14-9 { background-image: url(images/standard.png); left: 616; top: 396 } +#playfield #field-14-10 { background-image: url(images/standard.png); left: 616; top: 440 } +#playfield #field-14-11 { background-image: url(images/double-letter.png); left: 616; top: 484 } +#playfield #field-14-12 { background-image: url(images/standard.png); left: 616; top: 528 } +#playfield #field-14-13 { background-image: url(images/standard.png); left: 616; top: 572 } +#playfield #field-14-14 { background-image: url(images/triple-word.png); left: 616; top: 616 } +#playfield #my-tray-0 { left: 194; top: 665 } +#playfield #my-tray-1 { left: 232; top: 665 } +#playfield #my-tray-2 { left: 270; top: 665 } +#playfield #my-tray-3 { left: 308; top: 665 } +#playfield #my-tray-4 { left: 346; top: 665 } +#playfield #my-tray-5 { left: 384; top: 665 } +#playfield #my-tray-6 { left: 422; top: 665 } Modified: branches/trunk-reorg/projects/scrabble/website/scrabble.html =================================================================== --- branches/trunk-reorg/projects/scrabble/website/scrabble.html 2007-10-09 05:52:40 UTC (rev 2233) +++ branches/trunk-reorg/projects/scrabble/website/scrabble.html 2007-10-09 07:11:50 UTC (rev 2234) @@ -6,231 +6,238 @@ </head> <body onload="init()"> <div id='playfield'> - <div id='field-0-0'/></div> - <div id='field-0-1'/></div> - <div id='field-0-2'/></div> - <div id='field-0-3'/></div> - <div id='field-0-4'/></div> - <div id='field-0-5'/></div> - <div id='field-0-6'/></div> - <div id='field-0-7'/></div> - <div id='field-0-8'/></div> - <div id='field-0-9'/></div> - <div id='field-0-10'/></div> - <div id='field-0-11'/></div> - <div id='field-0-12'/></div> - <div id='field-0-13'/></div> - <div id='field-0-14'/></div> - <div id='field-1-0'/></div> - <div id='field-1-1'/></div> - <div id='field-1-2'/></div> - <div id='field-1-3'/></div> - <div id='field-1-4'/></div> - <div id='field-1-5'/></div> - <div id='field-1-6'/></div> - <div id='field-1-7'/></div> - <div id='field-1-8'/></div> - <div id='field-1-9'/></div> - <div id='field-1-10'/></div> - <div id='field-1-11'/></div> - <div id='field-1-12'/></div> - <div id='field-1-13'/></div> - <div id='field-1-14'/></div> - <div id='field-2-0'/></div> - <div id='field-2-1'/></div> - <div id='field-2-2'/></div> - <div id='field-2-3'/></div> - <div id='field-2-4'/></div> - <div id='field-2-5'/></div> - <div id='field-2-6'/></div> - <div id='field-2-7'/></div> - <div id='field-2-8'/></div> - <div id='field-2-9'/></div> - <div id='field-2-10'/></div> - <div id='field-2-11'/></div> - <div id='field-2-12'/></div> - <div id='field-2-13'/></div> - <div id='field-2-14'/></div> - <div id='field-3-0'/></div> - <div id='field-3-1'/></div> - <div id='field-3-2'/></div> - <div id='field-3-3'/></div> - <div id='field-3-4'/></div> - <div id='field-3-5'/></div> - <div id='field-3-6'/></div> - <div id='field-3-7'/></div> - <div id='field-3-8'/></div> - <div id='field-3-9'/></div> - <div id='field-3-10'/></div> - <div id='field-3-11'/></div> - <div id='field-3-12'/></div> - <div id='field-3-13'/></div> - <div id='field-3-14'/></div> - <div id='field-4-0'/></div> - <div id='field-4-1'/></div> - <div id='field-4-2'/></div> - <div id='field-4-3'/></div> - <div id='field-4-4'/></div> - <div id='field-4-5'/></div> - <div id='field-4-6'/></div> - <div id='field-4-7'/></div> - <div id='field-4-8'/></div> - <div id='field-4-9'/></div> - <div id='field-4-10'/></div> - <div id='field-4-11'/></div> - <div id='field-4-12'/></div> - <div id='field-4-13'/></div> - <div id='field-4-14'/></div> - <div id='field-5-0'/></div> - <div id='field-5-1'/></div> - <div id='field-5-2'/></div> - <div id='field-5-3'/></div> - <div id='field-5-4'/></div> - <div id='field-5-5'/></div> - <div id='field-5-6'/></div> - <div id='field-5-7'/></div> - <div id='field-5-8'/></div> - <div id='field-5-9'/></div> - <div id='field-5-10'/></div> - <div id='field-5-11'/></div> - <div id='field-5-12'/></div> - <div id='field-5-13'/></div> - <div id='field-5-14'/></div> - <div id='field-6-0'/></div> - <div id='field-6-1'/></div> - <div id='field-6-2'/></div> - <div id='field-6-3'/></div> - <div id='field-6-4'/></div> - <div id='field-6-5'/></div> - <div id='field-6-6'/></div> - <div id='field-6-7'/></div> - <div id='field-6-8'/></div> - <div id='field-6-9'/></div> - <div id='field-6-10'/></div> - <div id='field-6-11'/></div> - <div id='field-6-12'/></div> - <div id='field-6-13'/></div> - <div id='field-6-14'/></div> - <div id='field-7-0'/></div> - <div id='field-7-1'/></div> - <div id='field-7-2'/></div> - <div id='field-7-3'/></div> - <div id='field-7-4'/></div> - <div id='field-7-5'/></div> - <div id='field-7-6'/></div> - <div id='field-7-7'/></div> - <div id='field-7-8'/></div> - <div id='field-7-9'/></div> - <div id='field-7-10'/></div> - <div id='field-7-11'/></div> - <div id='field-7-12'/></div> - <div id='field-7-13'/></div> - <div id='field-7-14'/></div> - <div id='field-8-0'/></div> - <div id='field-8-1'/></div> - <div id='field-8-2'/></div> - <div id='field-8-3'/></div> - <div id='field-8-4'/></div> - <div id='field-8-5'/></div> - <div id='field-8-6'/></div> - <div id='field-8-7'/></div> - <div id='field-8-8'/></div> - <div id='field-8-9'/></div> - <div id='field-8-10'/></div> - <div id='field-8-11'/></div> - <div id='field-8-12'/></div> - <div id='field-8-13'/></div> - <div id='field-8-14'/></div> - <div id='field-9-0'/></div> - <div id='field-9-1'/></div> - <div id='field-9-2'/></div> - <div id='field-9-3'/></div> - <div id='field-9-4'/></div> - <div id='field-9-5'/></div> - <div id='field-9-6'/></div> - <div id='field-9-7'/></div> - <div id='field-9-8'/></div> - <div id='field-9-9'/></div> - <div id='field-9-10'/></div> - <div id='field-9-11'/></div> - <div id='field-9-12'/></div> - <div id='field-9-13'/></div> - <div id='field-9-14'/></div> - <div id='field-10-0'/></div> - <div id='field-10-1'/></div> - <div id='field-10-2'/></div> - <div id='field-10-3'/></div> - <div id='field-10-4'/></div> - <div id='field-10-5'/></div> - <div id='field-10-6'/></div> - <div id='field-10-7'/></div> - <div id='field-10-8'/></div> - <div id='field-10-9'/></div> - <div id='field-10-10'/></div> - <div id='field-10-11'/></div> - <div id='field-10-12'/></div> - <div id='field-10-13'/></div> - <div id='field-10-14'/></div> - <div id='field-11-0'/></div> - <div id='field-11-1'/></div> - <div id='field-11-2'/></div> - <div id='field-11-3'/></div> - <div id='field-11-4'/></div> - <div id='field-11-5'/></div> - <div id='field-11-6'/></div> - <div id='field-11-7'/></div> - <div id='field-11-8'/></div> - <div id='field-11-9'/></div> - <div id='field-11-10'/></div> - <div id='field-11-11'/></div> - <div id='field-11-12'/></div> - <div id='field-11-13'/></div> - <div id='field-11-14'/></div> - <div id='field-12-0'/></div> - <div id='field-12-1'/></div> - <div id='field-12-2'/></div> - <div id='field-12-3'/></div> - <div id='field-12-4'/></div> - <div id='field-12-5'/></div> - <div id='field-12-6'/></div> - <div id='field-12-7'/></div> - <div id='field-12-8'/></div> - <div id='field-12-9'/></div> - <div id='field-12-10'/></div> - <div id='field-12-11'/></div> - <div id='field-12-12'/></div> - <div id='field-12-13'/></div> - <div id='field-12-14'/></div> - <div id='field-13-0'/></div> - <div id='field-13-1'/></div> - <div id='field-13-2'/></div> - <div id='field-13-3'/></div> - <div id='field-13-4'/></div> - <div id='field-13-5'/></div> - <div id='field-13-6'/></div> - <div id='field-13-7'/></div> - <div id='field-13-8'/></div> - <div id='field-13-9'/></div> - <div id='field-13-10'/></div> - <div id='field-13-11'/></div> - <div id='field-13-12'/></div> - <div id='field-13-13'/></div> - <div id='field-13-14'/></div> - <div id='field-14-0'/></div> - <div id='field-14-1'/></div> - <div id='field-14-2'/></div> - <div id='field-14-3'/></div> - <div id='field-14-4'/></div> - <div id='field-14-5'/></div> - <div id='field-14-6'/></div> - <div id='field-14-7'/></div> - <div id='field-14-8'/></div> - <div id='field-14-9'/></div> - <div id='field-14-10'/></div> - <div id='field-14-11'/></div> - <div id='field-14-12'/></div> - <div id='field-14-13'/></div> - <div id='field-14-14'/></div> + <div id='field-0-0'></div> + <div id='field-0-1'></div> + <div id='field-0-2'></div> + <div id='field-0-3'></div> + <div id='field-0-4'></div> + <div id='field-0-5'></div> + <div id='field-0-6'></div> + <div id='field-0-7'></div> + <div id='field-0-8'></div> + <div id='field-0-9'></div> + <div id='field-0-10'></div> + <div id='field-0-11'></div> + <div id='field-0-12'></div> + <div id='field-0-13'></div> + <div id='field-0-14'></div> + <div id='field-1-0'></div> + <div id='field-1-1'></div> + <div id='field-1-2'></div> + <div id='field-1-3'></div> + <div id='field-1-4'></div> + <div id='field-1-5'></div> + <div id='field-1-6'></div> + <div id='field-1-7'></div> + <div id='field-1-8'></div> + <div id='field-1-9'></div> + <div id='field-1-10'></div> + <div id='field-1-11'></div> + <div id='field-1-12'></div> + <div id='field-1-13'></div> + <div id='field-1-14'></div> + <div id='field-2-0'></div> + <div id='field-2-1'></div> + <div id='field-2-2'></div> + <div id='field-2-3'></div> + <div id='field-2-4'></div> + <div id='field-2-5'></div> + <div id='field-2-6'></div> + <div id='field-2-7'></div> + <div id='field-2-8'></div> + <div id='field-2-9'></div> + <div id='field-2-10'></div> + <div id='field-2-11'></div> + <div id='field-2-12'></div> + <div id='field-2-13'></div> + <div id='field-2-14'></div> + <div id='field-3-0'></div> + <div id='field-3-1'></div> + <div id='field-3-2'></div> + <div id='field-3-3'></div> + <div id='field-3-4'></div> + <div id='field-3-5'></div> + <div id='field-3-6'></div> + <div id='field-3-7'></div> + <div id='field-3-8'></div> + <div id='field-3-9'></div> + <div id='field-3-10'></div> + <div id='field-3-11'></div> + <div id='field-3-12'></div> + <div id='field-3-13'></div> + <div id='field-3-14'></div> + <div id='field-4-0'></div> + <div id='field-4-1'></div> + <div id='field-4-2'></div> + <div id='field-4-3'></div> + <div id='field-4-4'></div> + <div id='field-4-5'></div> + <div id='field-4-6'></div> + <div id='field-4-7'></div> + <div id='field-4-8'></div> + <div id='field-4-9'></div> + <div id='field-4-10'></div> + <div id='field-4-11'></div> + <div id='field-4-12'></div> + <div id='field-4-13'></div> + <div id='field-4-14'></div> + <div id='field-5-0'></div> + <div id='field-5-1'></div> + <div id='field-5-2'></div> + <div id='field-5-3'></div> + <div id='field-5-4'></div> + <div id='field-5-5'></div> + <div id='field-5-6'></div> + <div id='field-5-7'></div> + <div id='field-5-8'></div> + <div id='field-5-9'></div> + <div id='field-5-10'></div> + <div id='field-5-11'></div> + <div id='field-5-12'></div> + <div id='field-5-13'></div> + <div id='field-5-14'></div> + <div id='field-6-0'></div> + <div id='field-6-1'></div> + <div id='field-6-2'></div> + <div id='field-6-3'></div> + <div id='field-6-4'></div> + <div id='field-6-5'></div> + <div id='field-6-6'></div> + <div id='field-6-7'></div> + <div id='field-6-8'></div> + <div id='field-6-9'></div> + <div id='field-6-10'></div> + <div id='field-6-11'></div> + <div id='field-6-12'></div> + <div id='field-6-13'></div> + <div id='field-6-14'></div> + <div id='field-7-0'></div> + <div id='field-7-1'></div> + <div id='field-7-2'></div> + <div id='field-7-3'></div> + <div id='field-7-4'></div> + <div id='field-7-5'></div> + <div id='field-7-6'></div> + <div id='field-7-7'></div> + <div id='field-7-8'></div> + <div id='field-7-9'></div> + <div id='field-7-10'></div> + <div id='field-7-11'></div> + <div id='field-7-12'></div> + <div id='field-7-13'></div> + <div id='field-7-14'></div> + <div id='field-8-0'></div> + <div id='field-8-1'></div> + <div id='field-8-2'></div> + <div id='field-8-3'></div> + <div id='field-8-4'></div> + <div id='field-8-5'></div> + <div id='field-8-6'></div> + <div id='field-8-7'></div> + <div id='field-8-8'></div> + <div id='field-8-9'></div> + <div id='field-8-10'></div> + <div id='field-8-11'></div> + <div id='field-8-12'></div> + <div id='field-8-13'></div> + <div id='field-8-14'></div> + <div id='field-9-0'></div> + <div id='field-9-1'></div> + <div id='field-9-2'></div> + <div id='field-9-3'></div> + <div id='field-9-4'></div> + <div id='field-9-5'></div> + <div id='field-9-6'></div> + <div id='field-9-7'></div> + <div id='field-9-8'></div> + <div id='field-9-9'></div> + <div id='field-9-10'></div> + <div id='field-9-11'></div> + <div id='field-9-12'></div> + <div id='field-9-13'></div> + <div id='field-9-14'></div> + <div id='field-10-0'></div> + <div id='field-10-1'></div> + <div id='field-10-2'></div> + <div id='field-10-3'></div> + <div id='field-10-4'></div> + <div id='field-10-5'></div> + <div id='field-10-6'></div> + <div id='field-10-7'></div> + <div id='field-10-8'></div> + <div id='field-10-9'></div> + <div id='field-10-10'></div> + <div id='field-10-11'></div> + <div id='field-10-12'></div> + <div id='field-10-13'></div> + <div id='field-10-14'></div> + <div id='field-11-0'></div> + <div id='field-11-1'></div> + <div id='field-11-2'></div> + <div id='field-11-3'></div> + <div id='field-11-4'></div> + <div id='field-11-5'></div> + <div id='field-11-6'></div> + <div id='field-11-7'></div> + <div id='field-11-8'></div> + <div id='field-11-9'></div> + <div id='field-11-10'></div> + <div id='field-11-11'></div> + <div id='field-11-12'></div> + <div id='field-11-13'></div> + <div id='field-11-14'></div> + <div id='field-12-0'></div> + <div id='field-12-1'></div> + <div id='field-12-2'></div> + <div id='field-12-3'></div> + <div id='field-12-4'></div> + <div id='field-12-5'></div> + <div id='field-12-6'></div> + <div id='field-12-7'></div> + <div id='field-12-8'></div> + <div id='field-12-9'></div> + <div id='field-12-10'></div> + <div id='field-12-11'></div> + <div id='field-12-12'></div> + <div id='field-12-13'></div> + <div id='field-12-14'></div> + <div id='field-13-0'></div> + <div id='field-13-1'></div> + <div id='field-13-2'></div> + <div id='field-13-3'></div> + <div id='field-13-4'></div> + <div id='field-13-5'></div> + <div id='field-13-6'></div> + <div id='field-13-7'></div> + <div id='field-13-8'></div> + <div id='field-13-9'></div> + <div id='field-13-10'></div> + <div id='field-13-11'></div> + <div id='field-13-12'></div> + <div id='field-13-13'></div> + <div id='field-13-14'></div> + <div id='field-14-0'></div> + <div id='field-14-1'></div> + <div id='field-14-2'></div> + <div id='field-14-3'></div> + <div id='field-14-4'></div> + <div id='field-14-5'></div> + <div id='field-14-6'></div> + <div id='field-14-7'></div> + <div id='field-14-8'></div> + <div id='field-14-9'></div> + <div id='field-14-10'></div> + <div id='field-14-11'></div> + <div id='field-14-12'></div> + <div id='field-14-13'></div> + <div id='field-14-14'></div> + <div id='my-tray-0'></div> + <div id='my-tray-1'></div> + <div id='my-tray-2'></div> + <div id='my-tray-3'></div> + <div id='my-tray-4'></div> + <div id='my-tray-5'></div> + <div id='my-tray-6'></div> </div> </body> </html> \ No newline at end of file Modified: branches/trunk-reorg/projects/scrabble/website/scrabble.js =================================================================== --- branches/trunk-reorg/projects/scrabble/website/scrabble.js 2007-10-09 05:52:40 UTC (rev 2233) +++ branches/trunk-reorg/projects/scrabble/website/scrabble.js 2007-10-09 07:11:50 UTC (rev 2234) @@ -1,32 +1,38 @@ // -*- Java -*- (really Javascript) function setLetter(x, y, letter) { - $('field-' + x + '-' + y).innerHTML = '<img src="' + letter + '.png"/>'; + $('field-' + x + '-' + y).innerHTML = '<img src="images/' + letter + '.png"/>'; } -function setWord(x, y, word, down) { - for (i = 0; i < word.length; i++) { - setLetter(x, y, word.charAt(i)); - if (down) { - y++; - } else { - x++; - } - }; +function setMyTray(n, letter) { + $('my-tray-' + n).innerHTML = letter ? '<img src="images/' + letter + '.png"/>' : ''; } +function drawGameState (gameState) { + for (var i = 0; i < gameState.board.length; i++) { + var x = gameState.board[i][0]; + var y = gameState.board[i][1]; + var char = gameState.board[i][2]; + setLetter(x, y, char); + } +} + +function trayClick(letter) { + this.clicked = !this.clicked; + setElementPosition(this, { y: (this.clicked ? 680 : 665) }); +} + function init() { + for (var i = 0; i < 7; i++) { + $('my-tray-' + i).onclick = trayClick; + } + setMyTray(0, 'A'); + setMyTray(1, 'B'); + setMyTray(2, 'C'); + setMyTray(3, 'D'); + setMyTray(4, 'E'); + setMyTray(5, 'F'); + setMyTray(6, 'G'); var d = loadJSONDoc("/game/108"); - d.addCallbacks( - function (gameState) { - for (var i = 0; i < gameState.board.length; i++) { - var x = gameState.board[i][0]; - var y = gameState.board[i][1]; - var char = gameState.board[i][2]; - setLetter(x, y, char); - } - }, - function (error) { - alert(error); - }); + d.addCallbacks(drawGameState, alert); }

1 0