roswell.roswell/lisp/setup.ros
2019-06-10 10:01:43 +08:00

98 lines
4.4 KiB
Common Lisp

#!/bin/sh
#|-*- mode:lisp -*-|#
#|Initial setup
exec ros -Q -N roswell -- $0 "$@"
|#
(progn
(roswell:include "util-dump"))
(defpackage :ros.script.setup.3672012282
(:use :cl :roswell.util :roswell.util.dump))
(in-package :ros.script.setup.3672012282)
(defun dump-filter (name)
(lambda (file)
(ignore-errors
(with-open-file (in file)
(let (line pos package)
(and (equal (read-line in) "#!/bin/sh")
(equal "#|" (subseq (setq line (read-line in)) 0 2))
(equal "|#" (subseq line (- (length line) 2) (length line)))
(equal "#|" (subseq (setq line (read-line in)) 0 2))
(setq line (split-sequence #\space (read-line in)))
(setq pos (position "-m" line :test 'equal))
(equal (nth (1+ pos) line) name)
(equal "|#" (subseq (read-line in) 0 2))
(eql 'progn (first (read in)))
(eql 'defpackage (first (setq line (read in))))
(setq package (second line))
(eql 'in-package (first (setq line (read in))))
(eql package (second line))
(> (parse-integer (subseq (string package) (1+ (position #\. (string package) :from-end t))))
3500000000)
(setq in (make-string-input-stream
(with-output-to-string (o)
(loop for l = (read-line in nil nil)
while l
do (format o "~A~%" (substitute #\_ #\: l))))))
(loop with end = (gensym)
for i = (read in nil end)
until (eql i end)
always (member (first i) '(defun defvar defparameter quote)))))))))
(defun main (&optional (dump "roswell") &rest argv)
(declare (ignore argv))
#-win32
(ignore-errors
(require :sb-posix)
#+sbcl(sb-posix:setgid (parse-integer (sb-posix:getenv "SUDO_GID")))
#+sbcl(sb-posix:setuid (parse-integer (sb-posix:getenv "SUDO_UID"))))
(unless (probe-file (merge-pathnames "setup.lisp" (opt "quicklisp")))
(format *error-output* "Installing Quicklisp...")
(flet ((opt (x)
(when (opt x)
(list (format nil "~A=~A" x (opt x))))))
(let ((params `(,@(opt "quicklisp.client")
,@(opt "quicklisp.dist")
"install"
"quicklisp")))
(when (roswell:verbose)
(format *error-output* "~%Parameter for install quicklisp '~{~A ~}'" params))
(force-output *error-output*)
(format *error-output* " Done ~S~%" (length (roswell:roswell params :interactive nil))))))
(let* ((dir (sort
(delete-if-not
(dump-filter dump)
(append (directory (make-pathname :defaults *load-pathname* :name :wild :type "ros"))
(directory (merge-pathnames "cmds/*.ros" (homedir)))
(directory (merge-pathnames "lisp/*.lisp" (homedir)))
(directory (merge-pathnames "bin/*" (homedir))))) #'string< :key 'pathname-name))
(dump-dir (dump-dir (and (equal "roswell" dump) "roswell"))))
(when (roswell:verbose)
(format *error-output* "Targets for dump:~%~{~A~%~}~%" dir))
(force-output *error-output*)
(unless (ignore-errors
(when (> (file-write-date
(make-pathname :defaults dump-dir :name dump :type "core"))
(loop for i in dir
maximize (file-write-date i)))
t))
(format *error-output* "building dump:~A~%"
(make-pathname :defaults dump-dir :name dump :type "core"))
(roswell:roswell `(,(if (roswell:verbose) "-v" "") " +R" " +A" " -Q"
,(let ((env* (opt "*roswellenv")))
(if (and env*
(not (equal env* "-")))
(format nil " -N ~A " env*)
(format nil " -L ~A " (or (opt "*lisp") (opt "impl")))))
,@(loop for i in dir
collect "--load "
collect (format nil "~A " i))
"dump output -f " ,dump)
t nil)))
(when (equal dump "roswell")
(ignore-errors
(roswell:roswell '("init" "env" "roswell")))))
;;; vim: set ft=lisp lisp: