This commit is contained in:
SANO Masatoshi 2017-07-05 20:14:24 +09:00
parent 5e605cbd07
commit e85cb4a8ea
9 changed files with 79 additions and 80 deletions

View file

@ -15,7 +15,7 @@
(plump:parse file) "a")
for x = (string-right-trim "/" (plump:get-attribute a "href"))
when (digit-char-p (aref x 0))
collect x)))))
collect x)))))
(defun abcl-bin-impl ()
(merge-pathnames (format nil "impls/~A/~A/abcl-bin/" (uname-m) (uname)) (homedir)))

View file

@ -8,9 +8,9 @@
(mapcar #'car *allegro-agreement-uri*))
(defun make-allegro-uri (argv &key
(uname (uname))
(uname-m (uname-m))
(version (getf argv :version)))
(uname (uname))
(uname-m (uname-m))
(version (getf argv :version)))
(let ((os (intern uname :keyword))
(machine (intern uname-m :keyword)))
(cond ((find version '("10.1express" "100express") :test 'equal)

View file

@ -14,7 +14,7 @@
for len = (length href)
when (and (digit-char-p (aref href 0))
(char= (aref href (1- len)) #\/))
collect (string-right-trim "/" href))))
collect (string-right-trim "/" href))))
(defvar *ccl-uname-m-alist*
'(("x86-64" . "x86")

View file

@ -19,7 +19,7 @@
(not (eql (aref href 0) #\/))
(not (find #\: href))
(not (equal "latest/" href)))
collect (subseq href 0 len))))
collect (subseq href 0 len))))
(defun clisp-argv-parse (argv)
(let ((pos (position "--as" (getf argv :argv) :test 'equal)))

View file

@ -10,11 +10,11 @@
(< (get-universal-time) (+ (* 60 60) (file-write-date file))))
(download (format nil "~Arelease/" (cmu-bin-uri)) file))
(loop for link in (plump:get-elements-by-tag-name (plump:parse file) "a")
for href = (plump:get-attribute link "href")
for len = (length href)
when (and (digit-char-p (aref href 0))
(char= (aref href (1- len)) #\/))
collect (string-right-trim "/" href))))
for href = (plump:get-attribute link "href")
for len = (length href)
when (and (digit-char-p (aref href 0))
(char= (aref href (1- len)) #\/))
collect (string-right-trim "/" href))))
(defvar *cmu-uname-m-alist*
'(("x86-64" . "x86")))
@ -51,12 +51,12 @@
(defun cmu-bin-expand (argv)
(loop for archive in (list (opt "download.archive") (opt "download.extra.archive"))
do (format t "~%Extracting archive:~A~%" (opt "download.archive"))
(let* ((impls (merge-pathnames (format nil "impls/~A/~A/cmu-bin/~A/" (uname-m) (uname) (opt "as")) (homedir)))
(path (merge-pathnames (format nil "~A/" (opt "as")) impls)))
(expand archive (ensure-directories-exist impls))
(and (probe-file path)
(uiop/filesystem:delete-directory-tree
path :validate t))))
(let* ((impls (merge-pathnames (format nil "impls/~A/~A/cmu-bin/~A/" (uname-m) (uname) (opt "as")) (homedir)))
(path (merge-pathnames (format nil "~A/" (opt "as")) impls)))
(expand archive (ensure-directories-exist impls))
(and (probe-file path)
(uiop/filesystem:delete-directory-tree
path :validate t))))
(cons t argv))
(defun cmu-bin-help (argv)

View file

@ -49,7 +49,7 @@
((position (format nil "--without-~A" opt) (getf argv :argv) :test 'equal) nil)
(t default)))))
(loop for (opt default . nil) in *ecl-options*
do (with opt default)))
do (with opt default)))
(cons t argv))
(defun ecl-download (argv)
@ -125,15 +125,15 @@
(case type
(:help '())
(:install `(#+win32
ecl-msys
,(decide-version 'ecl-get-version)
ecl-argv-parse
start
,(decide-download 'ecl-download)
ecl-expand
ecl-config
ecl-make
ecl-install
ecl-clean
setup))
ecl-msys
,(decide-version 'ecl-get-version)
ecl-argv-parse
start
,(decide-download 'ecl-download)
ecl-expand
ecl-config
ecl-make
ecl-install
ecl-clean
setup))
#+nil(:list 'ecl-get-version)))

View file

@ -17,9 +17,9 @@ exec ros -Q -L sbcl-bin -- $0 "$@"
for to from 0
when (or (eql length to)
(eql (aref line to) #\space))
collect (prog1
(subseq line from to)
(setq from (1+ to)))
collect (prog1
(subseq line from to)
(setq from (1+ to)))
until (eql length to)))
(defun dump-filter (name)
@ -92,10 +92,10 @@ exec ros -Q -L sbcl-bin -- $0 "$@"
(format *error-output* "up to date. stop~%")
t))
(roswell:roswell `("+R " ,(if (roswell:verbose) "-v" "") " -L " "sbcl-bin"
" --eval " #-win32 "'" "(roswell:ignore-shebang)" #-win32 "'" " "
,@(loop for i in dir
collect "--load "
collect (format nil "~A " i))
"dump output -f " ,dump)
" --eval " #-win32 "'" "(roswell:ignore-shebang)" #-win32 "'" " "
,@(loop for i in dir
collect "--load "
collect (format nil "~A " i))
"dump output -f " ,dump)
t nil))))
;;; vim: set ft=lisp lisp:

View file

@ -22,16 +22,15 @@
(defmethod sb-gray:stream-write-char ((stream count-line-stream) character)
(when (char= character (count-line-stream-count-char stream))
(loop
:with count := (incf (count-line-stream-count stream))
:with stream- := (count-line-stream-base stream)
:for (mod . char) :in (count-line-stream-print-char stream)
:when (zerop (mod count mod))
:do (if (characterp char)
(write-char char stream-)
(funcall char stream))
(force-output stream-)
(finish-output stream-)
)))
with count = (incf (count-line-stream-count stream))
with stream- = (count-line-stream-base stream)
for (mod . char) in (count-line-stream-print-char stream)
when (zerop (mod count mod))
do (if (characterp char)
(write-char char stream-)
(funcall char stream))
(force-output stream-)
(finish-output stream-))))
#+sbcl
(defun line-number (stream)

View file

@ -2,10 +2,10 @@
(defpackage :roswell.install
(:use :cl :roswell.util :roswell.locations)
(:export :*build-hook* :install-impl :read-call :*ros-path*
:install-system-script :install-impl-if-probed :install-script-if-probed
:install-system-if-probed :mingw-namestring :install-github :*checkout-default*
:install :decide-version :decide-download :require-system-package
:start :setup :date :github-version :version :install-script :count-line-stream))
:install-system-script :install-impl-if-probed :install-script-if-probed
:install-system-if-probed :mingw-namestring :install-github :*checkout-default*
:install :decide-version :decide-download :require-system-package
:start :setup :date :github-version :version :install-script :count-line-stream))
(in-package :roswell.install)
(defvar *ros-path* nil)
@ -73,7 +73,7 @@
(loop for link in (read-call "plump:get-elements-by-tag-name" elts "link")
for href = (read-call "plump:get-attribute" link "href")
when (eql (aref href 0) #\/)
collect (funcall filter href)))))
collect (funcall filter href)))))
(defun checkout-github (impl version tag)
(clone-github impl version :path "local-projects" :branch tag))
@ -125,28 +125,28 @@
for version = (if pos2 (subseq version/tag 0 pos2) version/tag)
for tag = (when pos2 (subseq version/tag (1+ pos2)))
do (setf argv (rest argv))
(setenv *env* (format nil "~A,~A" impl/version/tag envold))
(cond
;;registerd implementations like sbcl ccl-bin abcl etc
((setf (values _ argv) (install-impl-if-probed impl version/tag argv)))
;;local ros file like tool.ros
((install-script-if-probed impl/version/tag))
;;asd/quicklisp registered systems which contain "roswell" directory
((install-system-if-probed impl/version/tag))
;;local relative pathname
((install-localpath-if-probed impl/version/tag))
;;github registerd system like "fukamachi/sblint" checkout
(version
(funcall *checkout-default* impl version tag)
(read-call "quicklisp-client:register-local-projects")
(or (and (install-impl-if-probed version nil argv)
(or (setf argv nil) t))
(install-system-if-probed version)))
(t (format *error-output* "'~A' is not a valid target for 'install' -- It should be a name of either:
(setenv *env* (format nil "~A,~A" impl/version/tag envold))
(cond
;;registerd implementations like sbcl ccl-bin abcl etc
((setf (values _ argv) (install-impl-if-probed impl version/tag argv)))
;;local ros file like tool.ros
((install-script-if-probed impl/version/tag))
;;asd/quicklisp registered systems which contain "roswell" directory
((install-system-if-probed impl/version/tag))
;;local relative pathname
((install-localpath-if-probed impl/version/tag))
;;github registerd system like "fukamachi/sblint" checkout
(version
(funcall *checkout-default* impl version tag)
(read-call "quicklisp-client:register-local-projects")
(or (and (install-impl-if-probed version nil argv)
(or (setf argv nil) t))
(install-system-if-probed version)))
(t (format *error-output* "'~A' is not a valid target for 'install' -- It should be a name of either:
+ a quicklisp-installable system
+ a common lisp installation ~%" impl)
(roswell:quit 1)))
(setf changed t)
(roswell:quit 1)))
(setf changed t)
while argv
finally (when changed (roswell:exec `(,(opt "argv0") "setup")))))
@ -174,12 +174,12 @@
t)
(push to-install result))))
finally
(return
(if result
(cond
((equal mgr "dpkg")
(format *error-output*
"might cause error 'apt-get install ~{~A~^ ~}' would help~%" result)
t)) ;; Don't have confidence.
t))))
(return
(if result
(cond
((equal mgr "dpkg")
(format *error-output*
"might cause error 'apt-get install ~{~A~^ ~}' would help~%" result)
t)) ;; Don't have confidence.
t))))