blob: 7d083078975b2d4a56b262c4176d90a130cedab4 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
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)))
|
