Commit a8053263 authored by Erick Gallesio's avatar Erick Gallesio

Adding the package manager directory pkgman

parent acb4240a
;;;;
;;;; split-record.stk -- ScmPkg record support
;;;;
;;;; Copyright 2006-2007 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 21-Dec-2006 12:00 (eg)
;;;; Last file update: 18-Feb-2007 21:22 (eg)
;;;;
(define (%define-scmpkg-record->struct name parent slots exported?)
(let ((pred (string->symbol (format "~a?" name)))
(constr (string->symbol (format "make-~a" name)))
(arg (gensym))
(val (gensym)))
`(begin
;; Build the structure
(define ,name (make-struct-type ',name ,parent ',(map car slots)))
;; Build the constructor
(define (,constr . ,arg)
(apply make-struct ,name ,arg))
;; Build the predicate
(define (,pred ,arg)
(and (struct? ,arg) (struct-is-a? ,arg ,name)))
;; Build the slot readers
,@(map (lambda (x)
`(define ,(cadr x)
(lambda (,arg)
(%fast-struct-ref ,arg ,name ',(cadr x) ,(cadddr x)))))
slots)
;; Build the slot setters
,@(map (lambda (x)
`(define ,(caddr x)
(lambda (,arg ,val)
(%fast-struct-set! ,arg ,name ',(caddr x) ,(cadddr x) ,val))))
slots)
,(if exported?
`(export ,name ,constr ,pred
,@(map cadr slots)
,@(map caddr slots))
'(void))
;; Build the toplevel result
(values (void) ',name))))
(define (%define-scmpkg-record name body exported?)
(let Loop ((body body)
(parent #f)
(fields '())
(offset 0))
(cond
((null? body)
(%define-scmpkg-record->struct name parent (reverse! fields) exported?))
((not (pair? body))
(error "bad record ~S" body))
((keyword? (car body))
(cond
((null? (cdr body))
(error "value expected after keyword ~S" (car body)))
((eq? (car body) parent:)
(Loop (cddr body) (cadr body) fields offset))
(else ;; ignore this keyword for STklos
(Loop (cddr body) parent fields offset))))
(else
(match-case (car body)
((? symbol?)
(let ((fld (car body)))
(Loop (cdr body)
parent
(cons (list fld
(string->symbol (format "~a-~a" name fld))
(string->symbol (format "~a-~a-set!" name fld))
offset)
fields)
(+ offset 1))))
(((? symbol?) (? symbol?) (? symbol?))
(let ((fld (caar body))
(getter (cadar body))
(setter (cadar body)))
(Loop (cdr body)
parent
(cons (list fld getter setter offset) fields)
(+ offset 1))))
(else
(error "bad record field ~S" (car body))))))))
;; ======================================================================
;; define-record ...
;; ======================================================================
(define-macro (define-record name . body)
(%define-scmpkg-record name body #f))
;; ======================================================================
;; %define-exported-record ...
;; ======================================================================
(define-macro (define-exported-record name . body)
(%define-scmpkg-record name body #t))
;;
;; Exports
;;
(export %define-scmpkg-record %define-scmpkg-record->struct)
(provide "split-record")
;;;;
;;;; split-runtime.stk -- ScmPkg runtime for STklos
;;;;
;;;; Copyright 2007 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 12-Feb-2007 18:51 (eg)
;;;; Last file update: 14-Feb-2007 15:08 (eg)
;;;;
;; ======================================================================
;; record ...
;; ======================================================================
;; ======================================================================
;; exception ...
;; ======================================================================
;;;;
;;;; definition of condition types for ScmPkg
;;;;
(define &scmpkg-cond (make-condition-type '&scmpkg-cond
&condition
'(location message backtrace)))
(define &@exception
(make-compound-condition-type '@exception
(list &condition &scmpkg-cond)))
(define &@error ;; &error-message)
(make-compound-condition-type '@error
(list &error-message &scmpkg-cond)))
(define &@io-error
(make-compound-condition-type '@io-error
(list &i/o-error &scmpkg-cond)))
(define &@type-error
(make-compound-condition-type '@type-error
(list &error-message &scmpkg-cond)))
(define &@not-implemented-error
(make-compound-condition-type '@not-implemented-error
(list &condition &scmpkg-cond)))
;;;;
;;;; @RAISE and @ERROR
;;;;
(define @raise raise)
(define (@error proc reason obj)
; (&raise (exception @error ?proc proc ?reason reason ?obj obj))
(error proc reason obj))
(define (@exception-message e)
(if (and (condition? e)
(condition-has-type? e &scmpkg-cond))
(condition-ref e 'message)
(error "cannot find a message associated to exception ~S" e)))
;; ======================================================================
;; File System Primitives ...
;; ======================================================================
(define (@directory-list dir)
(delete! "."
(delete! ".."
(directory-files dir))))
(define (@file-exists? filename)
(or (file-exists? filename)
(file-is-directory? filename)))
(define @file-directory? file-is-directory?)
(define @delete-file remove-file)
(define @rename-file rename-file)
(define (@create-directory dir)
(if (string? dir)
(with-handler (lambda (c) #f)
(make-directory dir)
#t)
(error "bad string ~S" dir)))
(define (@delete-directory dir)
(if (string? dir)
(with-handler (lambda (c) #f)
(remove-directory dir)
#t)
(error "bad string ~S" dir)))
;; ======================================================================
;; Host OS ...
;; ======================================================================
(define @exit exit)
(define @command-line (lambda () (cons (program-name) (argv))))
(define @getenv getenv)
(define @system system)
;; ======================================================================
;; Bit Operation ...
;; ======================================================================
(define @fxand bit-and)
(define @fxior bit-or)
(define @fxxor bit-xor)
(define @fxnot bit-not)
(define @fxarithmetic-shift-left bit-shift)
(define @fxarithmetic-shift-right bit-rshift)
;; ======================================================================
;; Misc ...
;; ======================================================================
(define @unspecified void)
(define @gensym gensym)
;;;;
;;;; split-support.stk -- SPLIT support
;;;;
;;;; Copyright © 2007 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 7-Feb-2007 11:03 (eg)
;;;; Last file update: 14-Feb-2007 11:33 (eg)
;;;;
;; ======================================================================
;; Split Runtime
;; ======================================================================
(define-condition-type &type-error &message &type-error?)
(include "Split.d/split-runtime.stk")
(define (exception-get-message cond)
(if (condition? cond)
(if (condition-has-type? cond &message)
(condition-ref cond 'message)
(format "condition of type ~S raised" (struct-type-name (struct-type cond))))
(error "bad exception ~S" cond)))
;; ======================================================================
;; The SPLIT STklos module
;; ======================================================================
(define-module |SPLIT|
(include "Split.d/split-languages.stk")
(include "Split.d/split-interface.stk")
(include "Split.d/split-exception.stk")
(include "Split.d/split-parameter.stk")
(include "Split.d/split-define.stk")
(include "Split.d/split-record.stk")
; (include "Snow.d/snow-srfi89.stk")
; (include "Snow.d/snow-record.stk")
; (include "Snow.d/snow-package.stk")
; (include "Snow.d/snow-misc.stk")
)
(%redefine-module-exports (find-module '|SPLIT|))
(provide "split-support")
# Makefile for stklos-pkgman
# Author: Erick Gallesio [eg@essi.fr]
# Creation date: 22-Dec-2006 12:00 (eg)
# Last file update: 16-Feb-2007 23:34 (eg)
makefiledir= $(prefix)/etc/stklos
makefile_DATA= etc/Makefile-stklospkg.tmpl
bin_SCRIPTS = stklos-pkg
SRC = main.stk add.stk extract.stk http.stk params.stk pkgball.stk \
repository.stk misc.stk tune.stk types.stk
SFLAGS = -l
RM = /bin/rm
SCC = ../utils/stklos-compile
$(bin_SCRIPTS): $(SRC)
$(SCC) $(SFLAGS) -o $(bin_SCRIPTS) main.stk
clean:
$(RM) -f $(bin_SCRIPTS) *~
distclean: clean
This diff is collapsed.
;;;;
;;;; add.stk -- Adding a file to local server
;;;;
;;;; Copyright 2007 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 18-Jan-2007 16:59 (eg)
;;;; Last file update: 19-Feb-2007 12:44 (eg)
;;;;
;; ----------------------------------------------------------------------
;; local-description-add! ...
;; ----------------------------------------------------------------------
(define (local-description-add! pkgball)
(receive (package tuning version)
(parse-pkgball-name pkgball)
;; Control name validity
(unless package
(die (format "Incorrect pkgball name ~S" pkgball)))
(when (negative? (version-number->integer version))
(die (format "Bad version number for pkgball ~S" pkgball)))
(let ((dirname (temporary-file-name)))
;; Untar the given pkgball
(make-directory dirname)
(untar pkgball dirname)
;; Adding a package or a tuning?
(if tuning
(local-description-add-tuning! pkgball package version tuning dirname)
(local-description-add-package! pkgball package version dirname))
;; Remove the temporary directory
(rm-rf dirname))))
;; ----------------------------------------------------------------------
;; local-description-add-package! ...
;; ----------------------------------------------------------------------
(define (local-description-add-package! pkgball package version directory)
(when (> (stklos-pkg-verbosity) 0)
(eprintf "Adding package ~S (~a) to local repository\n" package version))
(let* ((src (make-path directory package (format "~a.spi" package)))
(inf (make-path directory package "etc" "info"))
(infos (append (get-package-interface src)
(get-package-info inf))))
(let ((descr (build-package-description pkgball package version infos)))
(add-description-to-local-repository! descr))
(copy-file pkgball (make-path (stklos-pkg-cache-directory)
(basename pkgball)))))
;; ----------------------------------------------------------------------
;; local-description-add-tuning! ...
;; ----------------------------------------------------------------------
(define (local-description-add-tuning! pkgball package version tuning directory)
(unless (equal? tuning "stklos")
(die "Cannot manage non STklos tunings"))
(when (> (stklos-pkg-verbosity) 0)
(eprintf "Adding tuning for package ~S (~a) to local repository\n"
package version))
(let* ((cache-name (make-path (stklos-pkg-cache-directory) (basename pkgball)))
(descr `(tuning ,(format "~a" package)
:version ,version
:host "stklos"
:url #f
:path ,cache-name
:md5 ,(md5sum-file pkgball))))
(copy-file pkgball cache-name)
(add-description-to-local-repository! descr)))
;; ----------------------------------------------------------------------
;; build-package-description ...
;; ----------------------------------------------------------------------
(define (build-package-description pkgball package version lst)
(define (get-value key default)
(let ((val (assoc key lst)))
(if val
(cdr val)
(list default))))
(define (build-dependencies)
(let ((val (assoc 'import lst)))
(if val
(map (lambda (x) (list (symbol->string x) "*"))
(cdr val))
'())))
(let ((lang (get-value 'language "r5rs"))
(cat (get-value 'category "misc"))
(descr (get-value 'description "N/A"))
(author (get-value 'author "none")))
`(interface ,(format "~a" package)
:version ,version
:language ,@lang
:category ,@cat
:url #f
:path ,(make-path (stklos-pkg-cache-directory) (basename pkgball))
:md5 ,(md5sum-file pkgball)
:description ,@descr
:author ,@author
;;;; :failures ()
;;;; :provides ()
:dependencies ,(build-dependencies))))
# -*- Makefile -*- Automatically generated for STklos packages
# The main package
PKG=@PKG@
PKGVERS=@PKGVERS@
PKGSRC=@PKGSRC@
VERSION=@VERSION@€
# Compiler
SCC=stklos-compile
SFLAGS=
SO=@SO@
SCOMP=@SCOMP@
SLINK=@SLINK@
# Targets
OSTK=@OSTK@
# General rules
#all: $(OSTK) $(PKGVERS).$(SO)
all: $(OSTK)
clean:
# /bin/rm -f $(OSTK) $(PKGVERS).{c,stk,$(SO),o}
/bin/rm -f $(OSTK)
$(PKGVERS).ostk: $(PKG)/$(PKGSRC)
(cd $(PKG); $(SCC) $(SFLAGS) -L .. -o ../$(PKG).ostk $(PKGSRC))
# $(PKGVERS).$(SO): $(PKGVERS).c
# $(SCOMP) -c -DMODULE_ENTRY=1 -o $(PKGVERS).o $(PKGVERS).c
# $(SLINK) $(PKGVERS).so $(PKGVERS).o
# /bin/rm -f $(PKGVERS).o
#
# $(PKGVERS).c: $(PKGVERS).stk
# $(SCC) -C -o $(PKGVERS).c $(PKGVERS).stk
#
# Rules for imported packages
;;;;
;;;; extract.stk -- Implementation of stklos-pkg extract option
;;;;
;;;; Copyright 2007 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 15-Jan-2007 12:10 (eg)
;;;; Last file update: 14-Feb-2007 15:14 (eg)
;;;;
;; ----------------------------------------------------------------------
;; write-extract-makefile ...
;; ----------------------------------------------------------------------
(define (write-extract-makefile package version targets dir)
(define (find-src name)
(make-path name (format "~a.spi" name)))
(define (make-entry name)
(let ((src (find-src name)))
(printf "~a.ostk: ~a\n" name src)
(printf "\t(cd ~a; $(SCC) $(SFLAGS) -L .. -o ../~a.ostk ~a)\n\n"
name name (basename src))))
;;// (define (make-library-entry)
;;// (printf "\n#Source of library ~s\n" package)
;;// (printf "$(PKGVERS).stk:\n")
;;// (printf "\techo -n > $(PKGVERS).stk\n")
;;// ;; Produce provides
;;// (for-each (lambda (x)
;;// (printf "\techo '(provide ~s)' >> $(PKGVERS).stk\n" x))
;;// targets)
;;// ;; Produce inclusion of required packages + the package itself
;;// (for-each (lambda (x)
;;// (printf "\techo '(include ~s)' >> $(PKGVERS).stk\n"
;;// (find-src x)))
;;// (append targets (list (package-sans-version package)))))
(let* ((tmpl (make-path (%library-prefix)
"etc" "stklos" "Makefile-stklospkg.tmpl"))
(in (open-file tmpl "r")))
(if in
(let ((str (port->string in))
(flat (open-output-string)))
;; Create the list of all the module to build
(for-each (lambda (x) (format flat " ~a.ostk \\\n"x)) targets)
(format flat " $(PKGVERS).ostk\n")
;; Build Makefile
(with-output-to-file (make-path dir "Makefile")
(lambda ()
;; Header
(display
(sed str
`(("@OSTK@" ,(get-output-string flat))
("@PKGVERS@" ,package)
("@PKG@" ,(package-sans-version package))
("@PKGSRC@" ,(basename
(find-src (package-sans-version package))))
("@VERSION@" ,version)
("@SO@" ,(exec "stklos-config --shared-suffix"))
("@SCOMP@" ,(exec "stklos-config --compile"))
("@SLINK@" ,(exec "stklos-config --link")))))
(newline)
;; Build the entries for required packages
(for-each make-entry targets)
;; Build the source of the "library"
;;// (make-library-entry)
(printf "# End of Makefile\n"))))
(eprintf "Warning: cannot find template Makefile ~S\n" tmpl))))
;; ----------------------------------------------------------------------
;; find-and-extract-package ...
;; ----------------------------------------------------------------------
(define (find-and-extract-package package dir)
(define (extract-package pkg dir)
(let ((pkgball (package-path pkg))
(tuning (package-tuning pkg)))
;; create directory
(unless (file-exists? dir)
(make-directories dir))
;; extract package
(unless (file-exists? pkgball)
(die (format "cannot find pkgball in cache ~s" (basename pkgball))))
(untar pkgball dir)
;; if the package has a tuning extract it too.
(when tuning
(let ((tuneball (tuning-path tuning)))
(unless (file-exists? pkgball)
(die (format "cannot find tuning pkgball in cache ~s"
(basename tuneball))))
(untar tuneball dir)
;; Tune the original package
(tune-package pkg dir)))))
(let ((pkg (download-package package))
(deps (package-deps* package)))
;; package (as well as its dependencies) is now in the cache.
;; extract all its dependencies
(for-each (lambda (x) (extract-package (find-package x) dir))
deps)
;; extract the package itself and (eventually) its tuning
(extract-package pkg dir)
;; Create the Makefile able to build the package
(write-extract-makefile package (package-version pkg) deps dir)))
;;;;
;;;; http.stk -- Minimal HTTP management for stklos-pkg
;;;;
;;;; Copyright 2007 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 12-Jan-2007 09:03 (eg)
;;;; Last file update: 12-Feb-2007 18:40 (eg)
;;;;
(define (http-get url output)
;; Copy the content of url to the output port
(define (skip-header port)
(let loop ((line (read-line port)))
(unless (or (eof-object? line) (string=? line ""))
(loop (read-line port)))))
(define (read-header port)
(let loop ((line (read-line port))
(res '()))
(if (or (eof-object? line) (string=? line ""))
res
(let ((ln (regexp-match "([^:]+): *(.*)" line)))
(if ln
(loop (read-line port)
(cons (cons (string-upcase (cadr ln)) (caddr ln))
res))
(loop (read-line port) res))))))
(define (redirect-url server port user sock)
(let* ((header (read-header (socket-input sock)))
(loc (assoc "LOCATION" header)))
(if loc
(begin
(socket-shutdown sock #t)
(copy-url server port user (cdr loc) ""))
(error "bad redirection when fetching url ~S" url))))
(define (copy-url server port user path query)
(let* ((s (make-client-socket server port))
(out (socket-output s))
(in (socket-input s))
(pth (if (equal? query "") path (format "~a?~a" path query))))
;; Send HTTP request
(fprintf out "GET ~a HTTP/1.0\r\n" pth)
(fprintf out "Host: ~a\r\n" server)
(fprintf out "Port: ~a\r\n" port)
(when user
(fprintf out "Authorization: Basic ~a\r\n" (base64-encode-string user)))
(fprintf out "Connection: close\r\n")
(fprintf out "\r\n")
(flush-output-port out)
;; Read header
(let ((line (read-line in)))
(cond
((regexp-match "[Hh][Tt][Tt][Pp].* +200 +.*" line)
;; The request is correct. Skip the header
(skip-header in)
;; copy the content of the url on output
(copy-port in output)
(socket-shutdown s #t))
((regexp-match "[Hh][Tt][Tt][Pp].* +301 +.*" line)
;; Page has moved
(redirect-url server port user s))
(else
(error "cannot get the document at url ~s. code ~s" url line))))))
(let ((info (uri-parse url)))
(unless (equal? (key-get info :scheme) "http")
(error "bad url (protocol is not http) ~S" url))
(let ((user (key-get info :user #f))
(host (key-get info :host))
(port (key-get info :port))
(path (key-get info :path))
(query (key-get info :query)))
(copy-url host port user path query))))
;;;;
;;;; main.stk -- Stklos-Pkg main program
;;;;
;;;; Copyright 2006-2007 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 22-Dec-2006 11:32 (eg)
;;;; Last file update: 16-Feb-2007 19:22 (eg)