Corrected write-manifest name.

Pascal J. Bourguignon [2014-03-30 17:50]
Corrected write-manifest name.
Filename
tools/manifest.lisp
diff --git a/tools/manifest.lisp b/tools/manifest.lisp
index 02535e1..77a7e6b 100644
--- a/tools/manifest.lisp
+++ b/tools/manifest.lisp
@@ -58,17 +58,18 @@
 (defparameter *system-licenses*
   '(("cl-ppcre"       . "BSD-2")
     ("split-sequence" . :unknown)
-    ("terminfo"       . "MIT")))
+    ("terminfo"       . "MIT")
+    ("closer-mop"     . "MIT")))

 (defun asdf-system-name (system)
   (slot-value system 'asdf::name))

 (defun asdf-system-license (system-name)
   (let ((system  (asdf:find-system system-name)))
-    (if (slot-boundp system 'asdf::licence)
-        (slot-value system 'asdf::licence)
-        (or (cdr (assoc system-name *system-licenses* :test 'string-equal))
-            :unknown))))
+    (or (cdr (assoc system-name *system-licenses* :test 'string-equal))
+        (and (slot-boundp system 'asdf::licence)
+             (slot-value system 'asdf::licence))
+        :unknown)))

 (defun system-depends-on (system)
   (delete (string-downcase system)
@@ -106,7 +107,8 @@
 (defun shell-command-to-string (command)
   "Execute the COMMAND with asdf:run-shell-command and returns its
 stdout in a string (going thru a file)."
-  (let ((path (format nil "out-~36,8,'0R.txt" (random (expt 2 32)))))
+  (let ((*default-pathname-defaults* #P"")
+        (path (format nil "~:@(out-~36,8,'0R.txt~)" (random (expt 2 32)))))
     (unwind-protect
          (when (zerop (asdf:run-shell-command (format nil "~A > ~S" command path)))
            (with-output-to-string (out)
@@ -117,6 +119,7 @@ stdout in a string (going thru a file)."
       (ignore-errors (delete-file path)))))


+
 (defun distribution ()
   "Return a list identifying the system, distribution and release.
 RETURN: (system distrib release)
@@ -243,23 +246,46 @@ into the keyword package."



+(defun lisp-version ()
+  (let ((v (lisp-implementation-version)))
+    (when (prefixp "Version " v)
+      (setf v (subseq v (length "Version "))))
+    (with-output-to-string (out)
+      (with-input-from-string (inp v)
+        (loop
+          :with state = :normal
+          :for ch = (read-char inp nil nil)
+          :while ch
+          :do (if (char= ch #\space)
+                  (when (eq state :normal)
+                    (setf state :space)
+                    (write-char #\_ out))
+                  (progn
+                    (setf state :normal)
+                    (case ch
+                      ((#\( #\))) ; deleted characters
+                      ((#\-) ; substituted characters
+                       (write-char #\_ out))
+                      (otherwise ; plain characters
+                       (write-char ch out))))))))))
+
+;; (list (lisp-implementation-version) (lisp-version))

 (defun executable-name (base)
-  (format nil "~(~A-~A-~{~A-~A-~A~}-~A~)"
+  (format nil "~(~A-~A-~A-~{~A-~A-~A~}-~A~)"
           base
           (or (lisp-implementation-type-keyword) "unknown")
+          (lisp-version)
           (distribution)
           (or (machine-type-keyword) "unknown")))


-
 (defun executable-filename (base)
   (format nil "~A~A" (executable-name base)
           #+(or windows win32) ".exe"
           #-(or windows win32) ""))


-
 (defun date ()
   (multiple-value-bind (se mi ho da mo ye dow dls tz)
       (decode-universal-time (get-universal-time))
@@ -295,7 +321,7 @@ into the keyword package."
     (format t "~V,,,'-<~>  ~V,,,'-<~>~%" system-width license-width)))


-(defun write-manifest-file (program-name system)
+(defun write-manifest (program-name system)
   "
 DO:     write a {program-name}-{distribution}.manifest file for the given SYSTEM.
 "
ViewGit