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

enable local-project-searcher

Browse source
This commit is contained in:
SANO Masatoshi 2019-08-28 12:38:50 +08:00
parent 0919c9a9e1
commit 6e3293bce0
11 changed files with 54 additions and 48 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
configure.ac
View file

@ -2,7 +2,7 @@
# Process this file with autoconf to produce a configure script.
AC_PREREQ([2.59])
AC_INIT([roswell],[19.08.10.101],snmsts@gmail.com)
AC_INIT([roswell],[19.08.11.101],snmsts@gmail.com)

12
lisp/delete-git.lisp
View file

@ -5,10 +5,14 @@
(defun git (&rest argv)
(if (rest argv)
(dolist (x (rest argv) (roswell:quit 0))
(let* ((* (directory (merge-pathnames "**/.git/" (first ql:*local-project-directories*))))
(* (mapcar (lambda (x) (directory (merge-pathnames "../*.asd" x))) *))
(* (apply #'append *))
(* (remove x * :test (complement #'equal) :key #'pathname-name))
(let* ((* (loop for v being the hash-values in (roswell.util::local-project-build-hash)
for .git/ = (merge-pathnames ".git/"
(make-pathname :defaults v :name nil :type nil))
when (and (equal (pathname-name v)
(first (last (pathname-directory v))))
(uiop:directory-exists-p .git/))
collect v))
(* (sort * #'string< :key #'pathname-name))
(* (mapcar (lambda (x) (truename (make-pathname :defaults x :type nil :name nil))) *)))
(loop for x in *
with a = (namestring (truename (homedir)))

2
lisp/extend-quicklisp.lisp
View file

@ -79,7 +79,7 @@
(if (or (not *local-project-cache*)
rebuild)
(let ((hash (make-hash-table :test 'equal)))
(dolist (system-directory (reverse *local-project-directory*))
(dolist (system-directory (reverse *local-project-directories*))
(dolist (asd (local-project-enum system-directory))
(setf (gethash (pathname-name asd) hash) asd)))
(setf *local-project-cache* hash))

2
lisp/git.ros
View file

@ -27,7 +27,7 @@ exec ros -Q -m roswell -N roswell -- $0 "$@"
(roswell:exec
(cond
((equal (first argv) "clone")
(uiop:chdir (first ql:*local-project-directories*))
(uiop:chdir (first roswell:*local-project-directories*))
`(,name ,@argv))
((location (first argv))
(let* ((path (location (first argv))))

2
lisp/hg.ros
View file

@ -16,7 +16,7 @@ exec ros -Q -m roswell -N roswell -- $0 "$@"
(roswell:exec
(cond
((equal (first argv) "clone")
(uiop:chdir (first ql:*local-project-directories*))
(uiop:chdir (first roswell:*local-project-directories*))
`(,name ,@argv))
((ql:where-is-system (first argv))
(let* ((path (make-pathname

45
lisp/init.lisp
View file

@ -29,7 +29,7 @@ have the latest asdf, and this file has a workaround for this.
(:export :run :*argv* :*main* :*load* :*cmd* :quit :script :quicklisp :getenv :opt
:ignore-shebang :asdf :include :ensure-asdf :revert-extension
:roswell :exec :setenv :unsetenv :version :swank :verbose :*init-hook*
:*local-project-directory*)
:*local-project-directories*)
(:documentation "Roswell backend."))
(in-package :roswell)
@ -39,7 +39,7 @@ have the latest asdf, and this file has a workaround for this.
(defparameter *main* nil)
(defvar *cmd* nil)
(defparameter *load* `((identity . cl:load)))
(defvar *local-project-directory* nil)
(defvar *local-project-directories* nil)
;; small tools
(defun getenv (x)
@ -177,28 +177,31 @@ have the latest asdf, and this file has a workaround for this.
(and environment (getenv environment))
(opt "quicklisp"))))
(local (ignore-errors
(truename
(merge-pathnames
".roswell/local-projects/"
*default-pathname-defaults*)))))
(truename
(merge-pathnames
".roswell/local-projects/"
*default-pathname-defaults*)))))
(when (probe-file path)
(cl:load path :verbose (verbose))
(unless (getenv environment)
(loop with symbol = (read-from-string "ql:*local-project-directories*")
;; ql:*local-project-directories* defaults to a list of a single pathname,
;; which is <directory containing setup.lisp>/local-projects/ .
for path in `(;; Searches local-project/ in the current directory
,local
;; This is WHAAAAAT????
,(ignore-errors
(truename (merge-pathnames "../../../local-projects/" (first (symbol-value symbol)))))
;; Searches local-project/ in e.g. ~/.roswell/
,(ensure-directories-exist (merge-pathnames "local-projects/" (opt "homedir"))))
for probe = (and path (or (ignore-errors (probe-file path))
#+clisp(ext:probe-directory path)))
when probe
do (set symbol (cons path (symbol-value symbol)))
until probe))
(loop
;; *local-project-directories* defaults to a list of a single pathname,
;; which is <directory containing setup.lisp>/local-projects/ .
for path in `(;; Searches local-project/ in the current directory
,local
;; Searches relative path from env path
,(ignore-errors
(truename
(merge-pathnames
"../../../local-projects/"
(first (symbol-value (read-from-string "ql:*local-project-directories*"))))))
;; Searches local-project/ in e.g. ~/.roswell/
,(ensure-directories-exist (merge-pathnames "local-projects/" (opt "homedir"))))
for probe = (and path (or (ignore-errors (probe-file path))
#+clisp(ext:probe-directory path)))
when probe
do (push path *local-project-directories*)
until probe))
t))))
(defvar *included-names* '("init"))

12
lisp/init.ros
View file

@ -12,15 +12,9 @@ exec ros +Q -m roswell -N roswell -- $0 "$@"
(in-package :ros.script.init.3672012201)
(defun main (&rest r)
(let (#+quicklisp
(ql:*local-project-directories*
(append (mapcar (lambda (path)
(merge-pathnames "templates/" path))
ql:*local-project-directories*)
ql:*local-project-directories*)))
(module-main r :default (or (when (equal (roswell:opt "init.use-checkout") "true")
(roswell:opt "init.default"))
"default")))
(module-main r :default (or (when (equal (roswell:opt "init.use-checkout") "true")
(roswell:opt "init.default"))
"default"))
;; show usage ?
)
;;; vim: set ft=lisp lisp:

11
lisp/list-git.lisp
View file

@ -4,7 +4,12 @@
(defun git (&rest r)
(declare (ignore r))
(let* ((* (directory (merge-pathnames "**/.git/" (first ql:*local-project-directories*))))
(* (mapcar (lambda (x) (directory (merge-pathnames "../*.asd" x))) *))
(* (apply #'append *)))
(let* ((* (loop for v being the hash-values in (roswell.util::local-project-build-hash)
for .git/ = (merge-pathnames ".git/"
(make-pathname :defaults v :name nil :type nil))
when (and (equal (pathname-name v)
(first (last (pathname-directory v))))
(uiop:directory-exists-p .git/))
collect v))
(* (sort * #'string< :key #'pathname-name)))
(format t "~{~A~%~}" (mapcar #'pathname-name *))))

2
lisp/update-default.lisp
View file

@ -5,7 +5,7 @@
(defun default (param &rest args)
(declare (ignore args))
(let* ((subpath (uiop:subpathp param (first ql:*local-project-directories*)))
(let* ((subpath (uiop:subpathp param (first roswell:*local-project-directories*)))
(target (when subpath
(remove-if-not #'stringp (pathname-directory subpath)))))
(format *error-output* "Target project would be ~A~%" target)

5
lisp/util-template.lisp
View file

@ -72,7 +72,7 @@
(let* ((* (loop for x in (append *template-base-directories*
(mapcar (lambda (path)
(merge-pathnames "templates/" path))
ql:*local-project-directories*))
roswell:*local-project-directories*))
append (directory (merge-pathnames "**/*.asd" x))))
(* (remove-if-not (lambda (x) (ignore-errors (string-equal "roswell.init." (pathname-name x) :end2 13))) *))
(* (cons (merge-pathnames "init-default.lisp" (ros:opt "lispdir")) *))
@ -99,7 +99,8 @@
(if found
(make-pathname :type nil :name nil
:defaults (first found))
(merge-pathnames (format nil "templates/~A/" (sanitize name)) (first ql:*local-project-directories*)))))
(merge-pathnames (format nil "templates/~A/" (sanitize name))
(first roswell:*local-project-directories*)))))
(defun template-file-path (template-name path)
(merge-pathnames (enc-string path)

7
lisp/util.lisp
View file

@ -1,7 +1,7 @@
(roswell:include () "util")
(defpackage :roswell.util
(:use :cl)
(:import-from :ros :opt :ensure-asdf :*local-project-directory*)
(:import-from :ros :opt :ensure-asdf :*local-project-directories*)
(:export
:uname :uname-m :homedir :config :impl :which :config-env :checkoutdir
:parse-version-spec :download :expand :sh :chdir :system :module
@ -209,11 +209,10 @@ ccl-bin -> (\"ccl-bin\" nil)
`(,string nil)))))
(defun checkoutdir ()
"Returns the parent directory of the first local project directory in ql:*local-project-directories*."
"Returns the parent directory of the first local project directory in *local-project-directories*."
;; see roswell:quicklisp for why.
(roswell:quicklisp)
(let* ((* (read-from-string "ql:*local-project-directories*"))
(* (first (symbol-value *)))
(let* ((* (first *local-project-directories*))
(* (merge-pathnames "../" *)))
(truename *)))