Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
xcvb
cl-launch
Commits
ec6e14f8
Commit
ec6e14f8
authored
May 08, 2014
by
Francois-Rene Rideau
Browse files
4.0.4: Try much harder to load ASDF. Improve release scripts, documentation.
parent
6a0b694e
Changes
3
Hide whitespace changes
Inline
Side-by-side
cl-launch.sh
View file @
ec6e14f8
#!/bin/sh
#| cl-launch.sh -- shell wrapper generator for Common Lisp software -*- Lisp -*-
CL_LAUNCH_VERSION
=
'4.0.
2.3
'
CL_LAUNCH_VERSION
=
'4.0.
4
'
license_information
()
{
AUTHOR_NOTE
=
"
\
# Please send your improvements to the author:
...
...
@@ -176,8 +176,8 @@ We'd like to homestead the path /usr/bin/cl while we can, so that
script authors can reasonably expect a script to work when it starts with:
#!/usr/bin/cl
To work properly, cl-launch 4.0.
2
depends on ASDF 3.0.1 or later, and
on
its portability layer UIOP to manage compilation and image life cycle.
To work properly, cl-launch 4.0.
4
depends on ASDF 3.0.1 or later, and
on
its portability layer UIOP
,
to manage compilation and image life cycle.
The software is specified as the evaluation of code in several phases;
the distinction matters most for creating executable binaries,
...
...
@@ -259,9 +259,9 @@ file.
provided with option -E --entry (compatible with buildapp), it will be called
with one argument, being the list of arguments passed to the program,
not including argv[0], which is available on most implementations via the
function uiop:argv0
. Using either option, the argument may be a function name
or a lambda expression, that is read from
the current package (see below
option -p --package and -sp --system-pa
tch
).
function uiop:argv0
(available in ASDF 3.1.2 and later). Using either option,
the argument may be a function name
or a lambda expression, that is read from
the current package (see below
option -p --package and -sp --system-pa
ckage
).
Only one restart or entry function may be specified; if multiple are provided,
the last one provided overrides previous ones. If you want several functions
to be called, you may DEFUN one that calls them and use it as a restart,
...
...
@@ -484,7 +484,7 @@ To dump an image, make sure you have a license file in your target directory
create a build script with
echo '(hcl:save-image "lispworks" :environment nil)' > si.lisp
lispworks-6-1-0-x86-linux -siteinit - -init - -build si.lisp
LispWorks also requires that you have ASDF 3.1.
0.86
or later;
LispWorks also requires that you have ASDF 3.1.
2
or later;
make sure you have it installed and configured in your source registry.
Similarly, a mlisp image for allegro can be created as follows:
...
...
@@ -2107,43 +2107,138 @@ cat<<'NIL'
NIL
":"
't #-cl-launch ;'
;
cl_fragment
<<
'
NIL
'
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *print-readably* nil ; allegro 5.0 notably will bork without this
*print-level* nil
*load-verbose* nil *compile-verbose* nil *compile-print* nil *load-print* nil)
(handler-bind ((warning #'muffle-warning))
(unless (member :asdf *features*)
(ignore-errors (funcall 'require "asdf")))
(unless (member :asdf *features*)
(ignore-errors (load (merge-pathnames "common-lisp/asdf/build/asdf.lisp" (user-homedir-pathname)))))
(unless (member :asdf *features*)
(ignore-errors (load "/usr/share/common-lisp/source/asdf/build/asdf.lisp")))
(unless (member :asdf *features*)
(error "Could not load ASDF.")))
(in-package :asdf))
NIL
":"
't #-cl-launch ;'
;
cl_fragment
<<
'
NIL
'
(eval-when (:compile-toplevel :load-toplevel :execute)
;; In case we only have ASDF1 or ASDF2 so far, try harder.
(unless (member :asdf3 *features*)
(flet ((maybe-register (d)
(when (probe-file (merge-pathnames "asdf.asd" d))
(pushnew d *central-registry*)
(pushnew (merge-pathnames "uiop/" d) *central-registry*))))
(or (let ((asdf (find-system "asdf" nil)))
(and asdf #+asdf2 (version-satisfies asdf "3.0.1")))
(maybe-register (merge-pathnames "common-lisp/asdf/" (user-homedir-pathname)))
(maybe-register "/usr/share/common-lisp/source/asdf/"))))
;; Make sure we use the latest ASDF available, if not 3.0.1
(defparameter asdf::*asdf-verbose* nil) ; for old versions of ASDF such as XCL's 2.014.2
(setf *load-verbose* nil asdf::*verbose-out* nil)
(unless (or #+asdf2 (asdf:version-satisfies (asdf:asdf-version) "3.0.1"))
(handler-bind ((warning #'muffle-warning))
(let (#+(and abcl asdf3) ; Why does the above not suffice?
(uiop::*uninteresting-conditions* (cons 'warning uiop::*uninteresting-conditions*)))
(operate 'load-op :asdf :verbose nil)))))
;; Configure the printer
(setf *print-readably* nil ; allegro 5.0 may bork without this
*print-level* nil)
;; Hush the compiler and loader.
(setf *load-verbose* nil *compile-verbose* nil *compile-print* nil *load-print* nil)
;; The code below exemplifies how to try super-hard to load ASDF 3 from standard locations,
;; by trying nice methods first, then increasingly desperate ones.
;; Stage 1 is to load ASDF at all.
;; Stage 2 is to upgrade to whichever ASDF installation the user has configured (if any).
;; Versions older than ASDF 3.1 need to be told about ~/common-lisp/
;; ASDF 1 has no output translation layer, so can be configured to load ASDF 3
;; only if ASDF 3 is in a predictable place under the user's homedir, thus
;; ~/common-lisp/asdf/ or ~/.local/share/common-lisp/source/asdf/ only.
(block nil
(let ((required-asdf-version "3.0.1")
(verbose *load-verbose*))
(labels ((asdf-symbol (name)
(and (find-package :asdf) (find-symbol (string name) :asdf)))
(asdf-call (name &rest args)
(apply (asdf-symbol name) args))
(asdf-version ()
(when (find-package :asdf)
(or (symbol-value (or (asdf-symbol '*asdf-version*)
(asdf-symbol '*asdf-revision*)))
"1.0")))
(maybe-display (message)
(when (and verbose message) (format t "~&~A~%" message)))
(call-maybe-verbosely (message function &rest args)
(cond
(verbose
(maybe-display message)
(apply function args))
(t
#+abcl ;; Bug in ABCL 1.3.0: without this, loading asdf.fasl shows warnings
(let* ((uc (asdf-symbol '*uninteresting-conditions*))
(vars (when uc (list uc)))
(vals (when uc (list (cons 'warning (symbol-value uc))))))
(progv vars vals
(handler-bind ((warning #'muffle-warning))
(apply function args))))
#-abcl
(handler-bind ((warning #'muffle-warning))
(apply function args)))))
(try-stage-1 (message function)
(ignore-errors
(call-maybe-verbosely (format nil "Trying to ~A" message) function))
(maybe-done-stage-1))
(try-file-stage-1 (explanation pathname)
(try-stage-1 (format nil "load ASDF from ~A" explanation)
#'(lambda () (load pathname))))
(subpath (parent &key directory name type)
(merge-pathnames (make-pathname :defaults parent :version nil
:directory (cons :relative directory) :name name :type type)
parent))
(build/asdf.lisp (directory)
(subpath directory :directory '("build") :name "asdf" :type "lisp"))
(visible-default-user-asdf-directory ()
(subpath (user-homedir-pathname) :directory '("common-lisp" "asdf")))
(visible-default-user-asdf-lisp ()
(build/asdf.lisp (visible-default-user-asdf-directory)))
(hidden-default-user-asdf-directory ()
(subpath (user-homedir-pathname) :directory '(".local" "share" "common-lisp" "asdf")))
(hidden-default-user-asdf-lisp ()
(build/asdf.lisp (hidden-default-user-asdf-directory)))
(stage-1 () ;; Try to load ASDF at all, any ASDF.
(try-stage-1
;; Do nothing if ASDF is already loaded
"use an already loaded ASDF"
(constantly nil))
(try-stage-1
"require ASDF from the implementation"
;; Most implementations provide ASDF, but while most of them are case-insensitive,
;; CLISP is case-sensitive, so we need to specify a lowercase string,
;; and not the keyword :asdf or symbol 'asdf.
;; Most implementations provide ASDF 3, but some of them only ASDF 2
;; and antique versions only ASDF 1.
#'(lambda () (funcall 'require "asdf")))
(try-file-stage-1
"asdf/ under the default (visible) CL source directory ~/common-lisp/"
(visible-default-user-asdf-lisp))
(try-file-stage-1
"asdf/ under the default (hidden) CL source directory ~/.local/share/common-lisp/"
(hidden-default-user-asdf-lisp))
#+(or unix linux bsd)
(progn
(try-file-stage-1
"asdf/ under the local system CL source directory /usr/local/share/common-lisp/"
(build/asdf.lisp #p"/usr/local/share/common-lisp/asdf/"))
(try-file-stage-1
"asdf/ under the managed system CL source directory /usr/share/common-lisp/"
(build/asdf.lisp #p"/usr/share/common-lisp/asdf/"))
(try-file-stage-1
"cl-asdf/ under the managed system CL source directory /usr/share/common-lisp/"
(build/asdf.lisp #p"/usr/share/common-lisp/cl-asdf/")))
(error "Could not load ASDF."))
(maybe-done-stage-1 ()
;; If we have ASDF, then go to stage 2: have it upgrade itself.
(when (member :asdf *features*)
(maybe-display (format nil "Found ASDF ~A" (asdf-version)))
(stage-2))) ;; doesn't return.
(configure-asdf ()
;; configure older versions of ASDF, as needed
(cond
((probe-file (visible-default-user-asdf-lisp))
(unless (member :asdf3.1 *features*)
(maybe-display "Telling this old ASDF about your ~/common-lisp/asdf/")
(pushnew (visible-default-user-asdf-directory)
(symbol-value (asdf-symbol '*central-registry*)))))
((probe-file (hidden-default-user-asdf-lisp))
(unless (member :asdf2 *features*)
(maybe-display "Telling this antique ASDF about your ~/.local/share/common-lisp/asdf/")
(pushnew (hidden-default-user-asdf-directory)
(symbol-value (asdf-symbol '*central-registry*)))))))
(maybe-done-stage-2 ()
(when (ignore-errors (asdf-call 'version-satisfies
(asdf-version) required-asdf-version))
(when verbose
(format t "~&Victory! We now have ASDF ~A~%" (asdf-version)))
(return)))
(stage-2 ()
;; We have ASDF, now have it upgrade itself.
(configure-asdf)
(when (asdf-call 'find-system :asdf nil)
(call-maybe-verbosely
"Trying to upgrade ASDF"
(asdf-symbol 'operate) (asdf-symbol 'load-op) :asdf) :verbose nil)
(maybe-done-stage-2)
(error "We could only load ASDF ~A but we need ASDF ~A"
(asdf-version) required-asdf-version)))
(call-maybe-verbosely nil #'stage-1))))
(in-package :asdf))
NIL
":"
't #-cl-launch ;'
;
cl_fragment
<<
'
NIL
'
;; Because of ASDF upgrade punting, this ASDF package may be a new one.
...
...
debian/changelog
View file @
ec6e14f8
cl-launch (4.0.4-1) unstable; urgency=low
* Try even harder to load ASDF.
* Update documentation, version numbers, etc. Improve release.
-- Francois-Rene Rideau <fare@tunes.org> Sat, 26 Apr 2014 12:36:51 -0400
cl-launch (4.0.3-1) unstable; urgency=low
* ~/common-lisp/ not ~/cl/ is where ASDF 3.1 standardizes
...
...
release.lisp
View file @
ec6e14f8
...
...
@@ -2,92 +2,116 @@
#| -*- Lisp -*-
exec "$(dirname $0)/cl-launch.sh" \
--system inferior-shell --system optima.ppcre \
--package cl-launch-release --entry main -X -- "$0" "$@" ; exit
NB: this script requires ASDF 3.1.0.87 or later, for argv0.
-X --package cl-launch-release --entry main -- "$0" "$@" ; exit
|#
(
defpackage
:cl-launch-release
(
:use
:cl
:uiop
:asdf
:inferior-shell
:optima
:optima.ppcre
)
;; Note: the exports are the list of available commands.
(
:export
#:rep
#:clean
#:debian-package
#:debian-package-all
#:quickrelease
))
#:debian-package
#:publish-debian-package
#:debian-package-all
#:quickrelease
))
(
in-package
:cl-launch-release
)
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
(
unless
(
fboundp
'argv0
)
(
defun
argv0
()
"release.lisp"
))
;; only in ASDF 3.1.2 or later
(
flet
((
check-system-version
(
name
version
)
(
let
((
system
(
find-system
name
)))
(
unless
(
version-satisfies
system
version
)
(
die
2
"~A requires ~A at least ~A but only got version ~A"
(
argv0
)
name
version
(
component-version
system
))))))
(
check-system-version
"inferior-shell"
"2.0.0"
)))
(
check-system-version
"inferior-shell"
"2.0.0"
)))
;; for default run outputs
(
defvar
*cl-launch-directory*
;; interactive users may want to override that.
(
truenamize
(
pathname-directory-pathname
(
ensure-absolute-pathname
(
or
(
argv0
)
*load-pathname*
(
nil-pathname
))
#'
getcwd
))))
(
defun
pn
(
&optional
x
)
(
subpathname
*cl-launch-directory*
x
))
(
defun
rep
(
argument
)
(
eval-input
argument
))
;; read-eval-print, no loop.
(
defun
rep
(
argument
)
;; read-eval-print, no loop.
(
eval-input
(
strcat
"(in-package :cl-launch-release) "
argument
)))
(
defun
script-version
()
(
match
(
read-file-line
(
pn
"cl-launch.sh"
)
:at
2
)
((
ppcre
"^CL_LAUNCH_VERSION='([0-9]+([.][0-9]+)+)'$"
version
)
version
)))
(
defun
debian-version
()
(
match
(
read-file-line
"debian/changelog"
:at
0
)
(
match
(
read-file-line
(
pn
"debian/changelog"
)
:at
0
)
((
ppcre
"^[^(]*\\(([-0-9.]+)\\)"
x
)
x
)))
(
defun
debian-version-tag
(
&optional
(
version
(
debian-version
)))
(
first
(
split-string
version
:separator
"-"
)))
(
defun
get-version
()
(
let
((
sv
(
script-version
))
(
dv
(
debian-version-tag
)))
(
unless
(
equal
sv
dv
)
(
error
"version mismatch: cl-launch.sh says ~A whereas the debian/changelog says ~A"
sv
dv
))
sv
))
(
defun
debian-arch
()
"amd64"
)
(
defun
git-tag
(
&optional
(
pattern
"4.*"
))
(
run/ss
`
(
git
describe
--tags
--match
,
pattern
)))
(
with-current-directory
((
pn
))
(
run/ss
`
(
git
describe
--tags
--match
,
pattern
))))
(
defun
clean
()
(
run
'
(
git
clean
-xfd
))
(
with-current-directory
((
pn
))
(
run
'
(
git
clean
-xfd
)))
(
values
))
(
defun
debian-package
()
(
clean
)
(
let*
((
version
(
debian-version
))
(
tag
(
debian-version-tag
version
))
(
up
(
pathname-parent-directory-pathname
(
getcwd
)))
(
origtarball
(
subpathname
up
(
strcat
"cl-launch_"
tag
".orig.tar.gz"
))))
(
delete-file-if-exists
origtarball
)
(
run
`
(
git-buildpackage
--git-debian-branch=master
--git-upstream-branch=master
(
--git-upstream-tag=
,
tag
)
--git-tag
--git-retag
--git-ignore-branch
)
:show
t
)
(
run
`
(
lintian
-c
--fail-on-warnings
(
..
/cl-launch_
,
version
_
,
(
debian-arch
)
.
changes
))
:show
t
))
(
clean
))
(
let*
((
debian-version
(
debian-version
))
(
version
(
get-version
))
(
origtarball
(
pn
(
strcat
"../cl-launch_"
version
".orig.tar.gz"
))))
(
with-current-directory
((
pn
))
(
run
`
(
pwd
)
:show
t
)
(
clean
)
(
delete-file-if-exists
origtarball
)
(
run
`
(
git-buildpackage
--git-debian-branch=master
--git-upstream-branch=master
(
--git-upstream-tag=
,
version
)
--git-tag
--git-retag
--git-ignore-branch
)
:show
t
)
(
run
`
(
lintian
-c
--fail-on-warnings
(
..
/cl-launch_
,
debian-version
_
,
(
debian-arch
)
.
changes
))
:show
t
)
(
clean
))))
(
defun
debian-package-all
()
(
let*
((
version
(
debian-version
))
(
tag
(
debian-version-tag
version
))
(
up
(
pathname-parent-directory-pathname
(
getcwd
)))
(
defun
publish-debian-package
()
(
let*
((
version
(
get-version
))
(
debian-version
(
debian-version
))
(
home
(
user-homedir-pathname
))
(
cl-launch-
tag
(
strcat
"cl-launch-"
tag
))
(
cl-launch-
version
(
strcat
"cl-launch-"
version
))
(
cldir
(
subpathname
home
"files/cl-launch/"
)))
(
debian-package
)
(
run
`
(
.
/cl-launch.sh
--include
"."
"-B"
install_path
)
:show
t
)
(
run
`
(
.
/cl-launch.sh
--no-include
-o
cl-launch
"-B"
install_bin
)
:show
t
)
(
with-current-directory
(
up
)
(
run
`
(
rm
-f
,
cl-launch-tag
)
:show
t
)
(
run
`
(
ln
-s
cl-launch
,
cl-launch-tag
)
:show
t
)
(
run
`
(
tar
zcfh
(
,
cldir
,
cl-launch-tag
.
tar.gz
)
--exclude
.
git
,
cl-launch-tag
)
:show
t
)
(
run
`
(
cp
cl-launch/cl-launch.sh
(
,
cldir
cl-launch.sh
))
:show
t
)
(
run
(
format
nil
"mv cl-launch_~A* ~A"
tag
cldir
)
:show
t
)
(
run
`
(
rm
-f
,
cl-launch-tag
)
:show
t
))
(
with-current-directory
((
pn
))
(
run
`
(
pwd
)
:show
t
)
(
run
`
(
.
/cl-launch.sh
--include
"."
"-B"
install_path
)
:show
t
)
(
run
`
(
.
/cl-launch.sh
--no-include
-o
cl-launch
"-B"
install_bin
)
:show
t
)
(
run
`
(
cp
.
/cl-launch.sh
(
,
cldir
cl-launch.sh
))
:show
t
))
(
with-current-directory
((
pn
"../"
))
(
run
`
(
pwd
)
:show
t
)
(
run
`
(
rm
-f
,
cl-launch-version
)
:show
t
)
(
run
`
(
ln
-s
cl-launch
,
cl-launch-version
)
:show
t
)
(
run
`
(
tar
zcfh
(
,
cldir
,
cl-launch-version
.
tar.gz
)
--exclude
.
git
(
,
cl-launch-version
/
))
:show
t
)
(
run
`
(
mv
,@
(
directory
(
merge-pathnames*
(
strcat
"cl-launch_"
version
"*.*"
)
(
pn
"../"
)))
,
cldir
)
:show
t
)
(
run
`
(
rm
-f
,
cl-launch-version
)
:show
t
))
(
with-current-directory
(
cldir
)
(
run
`
(
ln
-sf
(
cl-launch
,
tag
.
tar.gz
)
cl-launch.tar.gz
)
:show
t
)
(
run/interactive
`
(
gpg
-b
-a
(
cl-launch-
,
tag
.
tar.gz
))
:show
t
)
(
run
`
(
ln
-sf
(
cl-launch-
,
tag
.
tar.gz
)
cl-launch.tar.gz
)
:show
t
)
(
run
`
(
ln
-sf
(
cl-launch-
,
tag
.
tar.gz.asc
)
cl-launch.tar.gz.asc
)
:show
t
)
(
run
`
(
dput
mentors
(
cl-launch_
,
version
_
,
(
debian-arch
)
.
changes
))
:show
t
)
(
run
`
(
pwd
)
:show
t
)
(
run/interactive
`
(
gpg
-b
-a
(
cl-launch-
,
version
.
tar.gz
))
:show
t
)
(
run
`
(
ln
-sf
(
,
cl-launch-
version
.
tar.gz
)
cl-launch.tar.gz
)
:show
t
)
(
run
`
(
ln
-sf
(
,
cl-launch-
version
.
tar.gz.asc
)
cl-launch.tar.gz.asc
)
:show
t
)
(
run
`
(
dput
mentors
(
cl-launch_
,
debian-
version
_
,
(
debian-arch
)
.
changes
))
:show
t
)
(
run
`
(
rsync
-av
--delete
,
cldir
"common-lisp.net:/project/xcvb/public_html/cl-launch/"
)
:show
t
))
(
values
)))
(
defun
cl-launch-version
()
(
match
(
read-file-line
"cl-launch.sh"
:at
2
)
((
ppcre
"^CL_LAUNCH_VERSION='([0-9]+([.][0-9]+)+)'$"
version
)
version
)))
(
defun
quickrelease
()
(
let*
((
version
(
cl-launch-
version
))
(
let*
((
version
(
script-version
))
;; no need to compare with the debian
version
(
link
(
strcat
"cl-launch-"
version
))
(
tarball
(
strcat
link
".tar.gz"
)))
(
with-current-directory
(
"../"
)
(
with-current-directory
((
pn
"../"
))
(
run
`
(
pwd
)
:show
t
)
(
clean
)
(
run
`
(
rm
-f
,
link
))
(
run
`
(
ln
-s
cl-launch
,
link
))
(
run
`
(
tar
zcfh
,
tarball
--exclude
.
git
,
link
))
...
...
@@ -97,6 +121,10 @@ NB: this script requires ASDF 3.1.0.87 or later, for argv0.
(
run
`
(
rm
-f
,
link
,
tarball
))))
(
values
))
(
defun
debian-package-all
()
(
debian-package
)
(
publish-debian-package
))
(
defun
valid-commands
()
(
sort
(
while-collecting
(
c
)
(
do-external-symbols
(
x
:cl-launch-release
)
(
c
x
)))
#'
string<
))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment