From 1acfa21e0796f5d72d776b0fd53645813d5f2d98 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Thu, 1 Jun 2006 09:14:25 +0000 Subject: [PATCH] 0.9.13.16: preliminary Windows installer builder * Added "free software & no warranty" summary to top of COPYING. * tools-for-build/rtf.lisp turns COPYING into License.rtf needed for the installer. * tools-for-build/wxs.lisp generates the XML from which the installer is built. * refactor good-for-lisp pathname logic from make-target-contrib.sh to sbcl-pwd.sh. * make-windows-installer.sh builds sbcl.msi into output/, assuming WiX (2.0) is installed in $PROGRAMFILES/WiX or $WIX_PATH. The installer installs sbcl.exe, sbcl.core, and contribs into $PROGRAMFILES/Steel Bank Common Lisp// by default, though the location is configurable. .lisp and .fasl files are associated with the installed SBCL, action being to start SBCL and load the file. The installation directory is added to PATH. SBCL_HOME is set to the installation directory. A shortcut is added to the start-menu. The shortcut refers to the core explicitly, and will continue to work even if a newer SBCL is installed. --- .cvsignore | 1 + COPYING | 3 + install.sh | 6 +- make-target-contrib.sh | 17 +--- make-windows-installer.sh | 31 ++++++ sbcl-pwd.sh | 13 +++ tests/run-tests.sh | 10 +- tools-for-build/rtf.lisp | 44 ++++++++ tools-for-build/wxs.lisp | 246 +++++++++++++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 10 files changed, 355 insertions(+), 18 deletions(-) create mode 100644 make-windows-installer.sh create mode 100644 sbcl-pwd.sh create mode 100644 tools-for-build/rtf.lisp create mode 100644 tools-for-build/wxs.lisp diff --git a/.cvsignore b/.cvsignore index ef3a9ef..ea07510 100644 --- a/.cvsignore +++ b/.cvsignore @@ -5,3 +5,4 @@ customize-backend-subfeatures.lisp customize-target-features.lisp local-target-features.lisp-expr TAGS +.svn diff --git a/COPYING b/COPYING index 2bdd04d..5fc1779 100644 --- a/COPYING +++ b/COPYING @@ -1,3 +1,6 @@ +Steel Bank Common Lisp (SBCL) is free software, and comes with +absolutely no warranty. + SBCL is derived from CMU CL, which was released into the public domain, subject only to the BSD-style "free, but credit must be given and copyright notices must be retained" licenses in the LOOP macro diff --git a/install.sh b/install.sh index c00a6f4..4710e82 100644 --- a/install.sh +++ b/install.sh @@ -25,7 +25,6 @@ INFO_DIR=${INFO_DIR-$INSTALL_ROOT/share/info} DOC_DIR=${DOC_DIR-$INSTALL_ROOT/share/doc/sbcl} # Does the environment look sane? -SBCL_SOURCE=`pwd` if [ -n "$SBCL_HOME" -a "$INSTALL_ROOT/lib/sbcl" != "$SBCL_HOME" ];then echo SBCL_HOME environment variable is set, and conflicts with INSTALL_ROOT. echo Aborting installation. Unset one or reset the other, then try again @@ -70,7 +69,10 @@ cp output/sbcl.core $BUILD_ROOT$SBCL_HOME/sbcl.core # installing contrib -SBCL="`pwd`/src/runtime/sbcl --noinform --core `pwd`/output/sbcl.core --no-userinit --no-sysinit --disable-debugger" +. ./sbcl-pwd.sh +sbcl_pwd + +SBCL="$SBCL_PWD/src/runtime/sbcl --noinform --core $SBCL_PWD/output/sbcl.core --no-userinit --no-sysinit --disable-debugger" SBCL_BUILDING_CONTRIB=1 export SBCL SBCL_BUILDING_CONTRIB diff --git a/make-target-contrib.sh b/make-target-contrib.sh index 6d10ca3..78d6574 100644 --- a/make-target-contrib.sh +++ b/make-target-contrib.sh @@ -21,20 +21,13 @@ export LANG LC_ALL . ./find-gnumake.sh find_gnumake -# usually SBCL_HOME refers to the installed root of SBCL, not the -# build directory. Right now, however, where there are dependencies -# between contrib packages, we want the _uninstalled_ versions to be -# found -if [ "$OSTYPE" = "cygwin" ] ; then - SBCL_BASE=`cygpath -m $(pwd)` -else - SBCL_BASE=`pwd` -fi -SBCL_HOME=$SBCL_BASE/contrib -export SBCL_HOME +. ./sbcl-pwd.sh +sbcl_pwd +SBCL_HOME=$SBCL_PWD/contrib +export SBCL_HOME -SBCL="$SBCL_BASE/src/runtime/sbcl --noinform --core $SBCL_BASE/output/sbcl.core --disable-debugger --no-sysinit --no-userinit" +SBCL="$SBCL_PWD/src/runtime/sbcl --noinform --core $SBCL_PWD/output/sbcl.core --disable-debugger --no-sysinit --no-userinit" SBCL_BUILDING_CONTRIB=1 export SBCL SBCL_BUILDING_CONTRIB diff --git a/make-windows-installer.sh b/make-windows-installer.sh new file mode 100644 index 0000000..ccfa5f0 --- /dev/null +++ b/make-windows-installer.sh @@ -0,0 +1,31 @@ +#!/bin/sh + +# This software is part of the SBCL system. See the README file for +# more information. +# +# This software is derived from the CMU CL system, which was +# written at Carnegie Mellon University and released into the +# public domain. The software is in the public domain and is +# provided with absolutely no warranty. See the COPYING and CREDITS +# files for more information. + +WIX_PATH="${WIX_PATH:-$PROGRAMFILES\WiX}" + +. ./sbcl-pwd.sh +sbcl_pwd + +cd output + +"$SBCL_PWD/src/runtime/sbcl" --noinform --core "$SBCL_PWD/output/sbcl.core" \ + --disable-debugger --no-sysinit --no-userinit \ + --load ../tools-for-build/rtf.lisp \ + --load ../tools-for-build/wxs.lisp \ + --eval '(progn + (write-rtf (read-text "../COPYING") "License.rtf") + (write-wxs "sbcl.wxs") + (quit))' + +"$WIX_PATH/candle" sbcl.wxs +"$WIX_PATH/light" sbcl.wixobj "$WIX_PATH/wixui.wixlib" \ + -loc "$WIX_PATH/WixUI_en-us.wxl" \ + -out sbcl.msi diff --git a/sbcl-pwd.sh b/sbcl-pwd.sh new file mode 100644 index 0000000..e4be84d --- /dev/null +++ b/sbcl-pwd.sh @@ -0,0 +1,13 @@ +#!/bin/false +# Not a shell script, but something intended to be sourced from shell scripts + +# This ensures that SBCL_PWD is a path understandable to SBCL. + +sbcl_pwd() { + if [ "$OSTYPE" = "cygwin" ] ; then + SBCL_PWD=`cygpath -m $a(pwd)` + else + SBCL_PWD=`pwd` + fi + export SBCL_PWD +} diff --git a/tests/run-tests.sh b/tests/run-tests.sh index eb8f00b..debc22a 100644 --- a/tests/run-tests.sh +++ b/tests/run-tests.sh @@ -26,10 +26,14 @@ # pathname, but now we take care to bind it to an absolute pathname (still # generated relative to `pwd` in the tests/ directory) so that tests # can chdir before invoking SBCL and still work. -SBCL_HOME=`pwd`/../contrib +. ../sbcl-pwd.sh +sbcl_pwd + +SBCL_HOME=$SBCL_PWD/../contrib export SBCL_HOME -sbclstem=`pwd`/../src/runtime/sbcl -SBCL="$sbclstem --core `pwd`/../output/sbcl.core --noinform --sysinit /dev/null --userinit /dev/null --noprint --disable-debugger" +sbclstem=$SBCL_PWD/../src/runtime/sbcl + +SBCL="$sbclstem --core $SBCL_PWD/../output/sbcl.core --noinform --sysinit /dev/null --userinit /dev/null --noprint --disable-debugger" export SBCL echo /running tests on SBCL=\'$SBCL\' # more or less like SBCL, but without enough grot removed that appending diff --git a/tools-for-build/rtf.lisp b/tools-for-build/rtf.lisp new file mode 100644 index 0000000..d63805c --- /dev/null +++ b/tools-for-build/rtf.lisp @@ -0,0 +1,44 @@ +;;;; Generate RTF out of a regular text file, splitting +;;;; paragraphs on empty lines. +;;;; +;;;; Used to generate License.rtf out of COPYING for the +;;;; Windows installer. + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(defun read-text (pathname) + (let ((pars (list nil))) + (with-open-file (f pathname :external-format :ascii) + (loop for line = (read-line f nil) + for text = (string-trim '(#\Space #\Tab) line) + while line + when (plusp (length text)) + do (setf (car pars) + (if (car pars) + (concatenate 'string (car pars) " " text) + text)) + else + do (push nil pars))) + (nreverse pars))) + +(defun write-rtf (pars pathname) + (with-open-file (f pathname :direction :output :external-format :ascii + :if-exists :supersede) + ;; \rtf0 = RTF 1.0 + ;; \ansi = character set + ;; \deffn = default font + ;; \fonttbl = font table + ;; \fs = font size in half-points + (format f "{\\rtf1\\ansi~ + \\deffn0~ + {\\fonttbl\\f0\\fswiss Helvetica;}~ + \\fs20~ + ~{~A\\par\\par~%~}}~%" + pars))) diff --git a/tools-for-build/wxs.lisp b/tools-for-build/wxs.lisp new file mode 100644 index 0000000..b6d4faa --- /dev/null +++ b/tools-for-build/wxs.lisp @@ -0,0 +1,246 @@ +;;;; Generate WiX XML Source, from which we eventually generate the .MSI + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +;;;; XML generation + +(defvar *indent-level* 0) + +(defun print-xml (sexp &optional (stream *standard-output*)) + (destructuring-bind (tag &optional attributes &body children) sexp + (when attributes (assert (evenp (length attributes)))) + (format stream "~VT<~A~{ ~A='~A'~}~@[/~]>~%" + *indent-level* tag attributes (not children)) + (let ((*indent-level* (+ *indent-level* 3))) + (dolist (child children) + (unless (listp child) + (error "Malformed child: ~S in ~S" child children)) + (print-xml child stream))) + (when children + (format stream "~VT~%" *indent-level* tag)))) + +(defun xml-1.0 (pathname sexp) + (with-open-file (xml pathname :direction :output :if-exists :supersede + :external-format :ascii) + (format xml "") + (print-xml sexp xml))) + +(defun application-name () + (format nil "SBCL ~A" (lisp-implementation-version))) + +;;;; GUID generation +;;;; +;;;; Apparently this willy-nilly regeneration of GUIDs is a bad thing, and +;;;; we should probably have a single GUID per release / Component, so +;;;; that no matter by whom the .MSI is built the GUIDs are the same. +;;;; +;;;; Something to twiddle on a rainy day, I think. + +(load-shared-object "OLE32.DLL") + +(define-alien-type uuid + (struct uuid + (data1 unsigned-long) + (data2 unsigned-short) + (data3 unsigned-short) + (data4 (array unsigned-char 8)))) + +(define-alien-routine ("CoCreateGuid" co-create-guid) int (guid (* uuid))) + +(defun uuid-string (uuid) + (declare (type (alien (* uuid)) uuid)) + (let ((data4 (slot uuid 'data4))) + (format nil "~8,'0X-~4,'0X-~4,'0X-~2,'0X~2,'0X-~{~2,'0X~}" + (slot uuid 'data1) + (slot uuid 'data2) + (slot uuid 'data3) + (deref data4 0) + (deref data4 1) + (loop for i from 2 upto 7 collect (deref data4 i))))) + +(defun make-guid () + (let (guid) + (unwind-protect + (progn + (setf guid (make-alien (struct uuid))) + (co-create-guid guid) + (uuid-string guid)) + (free-alien guid)))) + +(defun list-all-contribs () + (loop for flag in (directory "../contrib/*/test-passed") + collect (car (last (pathname-directory flag))))) + +(defun id (string) + ;; Mangle a string till it can be used as an Id. A-Z, a-z, 0-9, and + ;; _ are ok, nothing else is. + (nsubstitute #\_ #\- + (nsubstitute #\. #\: + (nsubstitute #\. #\/ + (substitute #\. #\\ string))))) + +(defun directory-id (name) + (id (format nil "Directory_~A" (enough-namestring name)))) + +(defun directory-names (pathname) + (let ((name (car (last (pathname-directory pathname))))) + (if (< 8 (length name)) + (list "Name" (subseq name 0 8) + "LongName" name) + (list "Name" name)))) + +(defun file-id (pathname) + (id (format nil "File_~A" (enough-namestring pathname)))) + +(defparameter *ignored-directories* '("CVS" ".svn")) + +(defparameter *pathname-type-abbrevs* + '(("lisp" . "lsp") + ("fasl" . "fas") + ("SBCL" . "txt") ; README.SBCL -> README.txt + ("texinfo" . "tfo") + ("lisp-temp" . "lmp"))) + +(defun file-names (pathname) + (if (or (< 8 (length (pathname-name pathname))) + (< 3 (length (pathname-type pathname)))) + (let ((short-name (let ((name (pathname-name pathname))) + (if (< 8 (length name)) + (subseq name 0 8) + name))) + (short-type (let ((type (pathname-type pathname))) + (if (< 3 (length type)) + (or (cdr (assoc type *pathname-type-abbrevs* :test #'equalp)) + (error "No abbreviation for type: ~A" type)) + type)))) + (list "Name" (if short-type + (format nil "~A.~A" short-name short-type) + short-name) + "LongName" (file-namestring pathname))) + (list "Name" (file-namestring pathname)))) + +(defparameter *components* nil) + +(defun component-id (pathname) + (let ((id (id (format nil "Contrib_~A" (enough-namestring pathname))))) + (push id *components*) + id)) + +(defun ref-all-components () + (prog1 + (mapcar (lambda (id) + `("ComponentRef" ("Id" ,id))) + *components*) + (setf *components* nil))) + +(defun collect-1-component (root) + `("Directory" ("Id" ,(directory-id root) + ,@(directory-names root)) + ("Component" ("Id" ,(component-id root) + "Guid" ,(make-guid) + "DiskId" 1) + ,@(loop for file in (directory + (make-pathname :name :wild :type :wild :defaults root)) + when (or (pathname-name file) (pathname-type file)) + collect `("File" ("Id" ,(file-id file) + ,@(file-names file) + "Source" ,(enough-namestring file))))))) + +(defun collect-components (root) + (cons (collect-1-component root) + (loop for directory in + (directory + (merge-pathnames (make-pathname + :directory '(:relative :wild) + :name nil :type nil) + root)) + unless (member (car (last (pathname-directory directory))) + *ignored-directories* :test #'equal) + append (collect-components directory)))) + +(defun collect-contrib-components () + (loop for contrib in (directory "../contrib/*/test-passed") + append (collect-components (make-pathname :name nil + :type nil + :version nil + :defaults contrib)))) + +(defun make-extension (type mime) + `("Extension" ("Id" ,type "ContentType" ,mime) + ("Verb" ("Id" ,(format nil "load_~A" type) + "Argument" "--core \"[#sbcl.core]\" --load \"%1\"" + "Command" "Load with SBCL" + "Target" "[#sbcl.exe]")))) + +(defun write-wxs (pathname) + ;; both :INVERT and :PRESERVE could be used here, but this seemed + ;; better at the time + (xml-1.0 + pathname + `("Wix" ("xmlns" "http://schemas.microsoft.com/wix/2003/01/wi") + ("Product" ("Id" "????????-????-????-????-????????????" + "Name" ,(application-name) + "Version" ,(lisp-implementation-version) + "Manufacturer" "http://www.sbcl.org" + "Language" 1033) + ("Package" ("Id" "????????-????-????-????-????????????" + "Manufacturer" "http://www.sbcl.org" + "InstallerVersion" 200 + "Compressed" "yes")) + ("Media" ("Id" 1 + "Cabinet" "sbcl.cab" + "EmbedCab" "yes")) + ("Directory" ("Id" "TARGETDIR" + "Name" "SourceDir") + ("Directory" ("Id" "ProgramMenuFolder" + "Name" "PMFolder")) + ("Directory" ("Id" "ProgramFilesFolder" + "Name" "PFiles") + ("Directory" ("Id" "BaseFolder" + "Name" "SBCL" + "LongName" "Steel Bank Common Lisp") + ("Directory" ("Id" "VersionFolder" + "Name" ,(lisp-implementation-version)) + ("Directory" ("Id" "INSTALLDIR") + ("Component" ("Id" "SBCL_Base" + "Guid" ,(make-guid) + "DiskId" 1) + ("Environment" ("Id" "Env_SBCL_HOME" + "Action" "set" + "Name" "SBCL_HOME" + "Part" "all" + "Value" "[INSTALLDIR]")) + ("Environment" ("Id" "Env_PATH" + "Action" "set" + "Name" "PATH" + "Part" "first" + "Value" "[INSTALLDIR]")) + ,(make-extension "fasl" "application/x-lisp-fasl") + ,(make-extension "lisp" "text/x-lisp-source") + ("File" ("Id" "sbcl.exe" + "Name" "sbcl.exe" + "Source" "../src/runtime/sbcl.exe") + ("Shortcut" ("Id" "sbcl.lnk" + "Directory" "ProgramMenuFolder" + "Name" "SBCL" + "LongName" ,(application-name) + "Arguments" "--core \"[#sbcl.core]\""))) + ("File" ("Id" "sbcl.core" + "Name" "sbcl.cre" + "LongName" "sbcl.core" + "Source" "sbcl.core"))) + ,@(collect-contrib-components)))))) + ("Feature" ("Id" "Minimal" + "ConfigurableDirectory" "INSTALLDIR" + "Level" 1) + ("ComponentRef" ("Id" "SBCL_Base")) + ,@(ref-all-components)) + ("Property" ("Id" "WIXUI_INSTALLDIR" "Value" "INSTALLDIR")) + ("UIRef" ("Id" "WixUI_InstallDir")))))) diff --git a/version.lisp-expr b/version.lisp-expr index 084c954..d954088 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.13.15" +"0.9.13.16" -- 1.7.10.4