diff --git a/install.scm b/install.scm index 70a1b4f..9010449 100755 --- a/install.scm +++ b/install.scm @@ -1,132 +1,3 @@ #!/bin/sh -exec scsh -e main -o let-opt -o srfi-1 -o srfi-37 -s "$0" "$@" +exec scsh -lm scheme/install-lib-module.scm -o install-lib -e install-main -s "$0" "$@" !# - -;; Install scsh's installation library as follows: -;; - files install-lib.scm and install-lib-module.scm go to -;; /share/scsh-install-lib/scheme/ -;; - file proposal.pdf goes to -;; /share/doc/scsh-install-lib/ -;; - a new file called scsh-install-pkg, providing an entry point to -;; the installation library, is installed in /bin - -;; TODO most of the following functions were lifted straight from -;; install-lib.scm, but should really be shared in some way. - -;; Replace all bindings of KEY in ALIST with one binding KEY to DATUM. -(define (alist-replace key datum alist) - (alist-cons key datum (alist-delete key alist))) - -;; Return the value associated with KEY in ALIST. If none exists, -;; return DEFAULT, or signal an error if no DEFAULT was given. -(define (alist-get key alist . rest) - (cond ((assoc key alist) => cdr) - ((not (null? rest)) (first rest)) - (else (error "cannot find key in alist" key alist)))) - -;; Return the name of the parent directory of FNAME. -(define (parent-directory fname) - (file-name-directory (directory-as-file-name fname))) - -;; Create directory FNAME and all its parents, as needed. -(define (create-directory&parents fname . rest) - (let-optionals rest ((perms #o777)) - (let ((parent (parent-directory fname))) - (if (not (file-exists? parent)) - (apply create-directory&parents parent rest)) - (if (not (file-exists? fname)) - (create-directory fname perms))))) - -;; Return the name of FNAME, which must be absolute, with NEW-ROOT as -;; root. -(define (re-root-file-name fname new-root) - (let ((fname-pl (split-file-name fname)) - (new-root-pl (split-file-name new-root))) - (if (string=? (first fname-pl) "") - (path-list->file-name (append new-root-pl (cdr fname-pl))) - (error "no root to replace in relative file name" fname)))) - -;; Copy SOURCE to TARGET-DIR, with the same name. -(define (copy-file-to-dir source target-dir) - (let ((target (absolute-file-name (file-name-nondirectory source) - target-dir))) - (run (cp ,source ,target)) - (set-file-mode target (file-mode source)))) - -(define usage #< specify directory where files are installed - (default: /usr/local) - --dest-dir specify prefix to used during installation - (to be used only during staged installations) - -END -) - -;; Template for scsh-install-pkg script, must be plugged with the -;; directory containing the Scheme code. -(define scsh-install-pkg-template #<