common-lisp/roswell.roswell
1
0
Fork 0
mirror of https://github.com/roswell/roswell.git synced 2026-09-10 07:16:17 -04:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

move some functions from ros.install to ros.util.

Browse source
This commit is contained in:
SANO Masatoshi 2016-12-11 17:03:50 +09:00
parent ed1c8fcc1f
commit 87707bfb03
3 changed files with 36 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
lisp/init.lisp
View file

@ -191,12 +191,17 @@ have the latest asdf, and this file has a workaround for this.
(defvar *included-names* '())
(defvar *include-path* #.*load-pathname*)
(defun include (name)
(unless (find name *included-names* :test 'equal)
(cl:load (make-pathname
:defaults *include-path*
:name name :type "lisp"))
(push name *included-names*)))
(defun include (names &key (load t))
(dolist (name (if (listp names)
names
(list names)))
(unless (find name *included-names* :test 'equal)
(when load
(cl:load (make-pathname
:defaults *include-path*
:name name :type "lisp")))
(push name *included-names*))))
(defun swank (&rest params)
(unless (cl:find-package :ros.swank.util)

23
lisp/util-install.lisp
View file

@ -1,6 +1,7 @@
(cl:in-package :cl-user)
(ros:include "locations")
(ros:include '("locations" "util"))
(ros:include "util-install" :load nil)
(defpackage :ros.install
(:use :cl :ros.util :ros.locations)
@ -22,12 +23,6 @@ ARGV2 contains a (possibly modified) ARGV.")
(defvar *list-cmd* nil)
(defvar *checkout-default* 'checkout-github)
(defun set-opt (item val)
(let ((found (assoc item (ros::ros-opts) :test 'equal)))
(if found
(setf (second found) val)
(push (list item val) ros::*ros-opts*))))
(defun probe-impl (impl)
(or (ignore-errors
(let ((imp (format nil "roswell.install.~A" impl)))
@ -74,20 +69,6 @@ ARGV2 contains a (possibly modified) ARGV.")
(read-call "install-system-script" imp)
result)))
(defun copy-dir (from to)
(when (wild-pathname-p from)
(error "wild card not supported"))
(loop with path = (truename from)
for l in (delete-if (lambda (x) (eql :absolute (first (pathname-directory (make-pathname :defaults x)))))
(mapcar (lambda(x) (enough-namestring (namestring x) path))
(directory (merge-pathnames "**/*.*" path))))
do (if (or (pathname-name l)
(pathname-type l))
(ignore-errors
(read-call "uiop:copy-file"
(merge-pathnames l path)
(ensure-directories-exist (merge-pathnames l to)))))))
(defun install-localpath-if-probed (namestring)
(when (and (eql #\. (aref namestring 0))
(find #\/ namestring))

24
lisp/util.lisp
View file

@ -7,10 +7,32 @@
(:import-from :ros :opt)
(:export :uname :uname-m :homedir :config :use :impl :which :list%
:parse-version-spec :download :expand :sh :chdir :system
:core-extention :clone-github :opt :read-call))
:core-extention :clone-github :opt :read-call :set-opt :copy-dir))
(in-package :ros.util)
(ros:include "util" :load nil)
(defun copy-dir (from to)
(when (wild-pathname-p from)
(error "wild card not supported"))
(loop with path = (truename from)
for l in (delete-if (lambda (x) (eql :absolute (first (pathname-directory (make-pathname :defaults x)))))
(mapcar (lambda(x) (enough-namestring (namestring x) path))
(directory (merge-pathnames "**/*.*" path))))
do (if (or (pathname-name l)
(pathname-type l))
(ignore-errors
(read-call "uiop:copy-file"
(merge-pathnames l path)
(ensure-directories-exist (merge-pathnames l to)))))))
(defun set-opt (item val)
(let ((found (assoc item (ros::ros-opts) :test 'equal)))
(if found
(setf (second found) val)
(push (list item val) ros::*ros-opts*))))
(defun read-call (func &rest params)
(ignore-errors (apply (let (*read-eval*) (read-from-string func)) params)))