Vim window logic, slimv
This commit is contained in:
parent
babcc9e44b
commit
515847d07e
791 changed files with 51552 additions and 86 deletions
|
|
@ -0,0 +1,40 @@
|
|||
(in-package :cl-user)
|
||||
(defpackage cl-project
|
||||
(:use #:cl)
|
||||
(:import-from #:cl-project.specials
|
||||
#:*skeleton-directory*
|
||||
#:*skeleton-parameters*)
|
||||
(:import-from #:cl-project.skeleton
|
||||
#:make-skeleton-from-directory)
|
||||
(:import-from #:cl-project.file
|
||||
#:generate)
|
||||
(:export #:*skeleton-directory*
|
||||
#:make-project
|
||||
#:generate-skeleton))
|
||||
(in-package :cl-project)
|
||||
|
||||
(defun make-project (path &rest params &key name description author email license depends-on (without-tests nil) &allow-other-keys)
|
||||
"Generate a skeleton."
|
||||
(declare (ignore name description author email license depends-on without-tests))
|
||||
(check-type path pathname)
|
||||
|
||||
;; Ensure `path' ends with a slash(/).
|
||||
(setf path (uiop:ensure-directory-pathname path))
|
||||
|
||||
(unless (getf params :name)
|
||||
(setf (getf params :name)
|
||||
(car (last (pathname-directory path)))))
|
||||
(let ((files (generate-skeleton
|
||||
*skeleton-directory*
|
||||
path
|
||||
:env params)))
|
||||
(dolist (file files)
|
||||
(when (string= (pathname-type file) "asd")
|
||||
(let ((dir (make-pathname :name nil :type nil :defaults file)))
|
||||
(push dir asdf:*central-registry*)))))
|
||||
t)
|
||||
|
||||
(defun generate-skeleton (source-dir target-dir &key env)
|
||||
"General skeleton generator."
|
||||
(let ((*skeleton-parameters* env))
|
||||
(generate (make-skeleton-from-directory source-dir) target-dir)))
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
(in-package :cl-user)
|
||||
(defpackage cl-project.file
|
||||
(:use #:cl
|
||||
#:cl-project.specials)
|
||||
(:import-from #:cl-project.io
|
||||
#:copy-file-to-file)
|
||||
(:import-from #:cl-ppcre
|
||||
#:regex-replace-all)
|
||||
(:export #:template-file
|
||||
#:template-file-path
|
||||
#:make-template-file
|
||||
#:generate))
|
||||
(in-package :cl-project.file)
|
||||
|
||||
(defclass template-file ()
|
||||
((path :type pathname
|
||||
:initarg :path
|
||||
:accessor template-file-path)))
|
||||
|
||||
(defun make-template-file (path)
|
||||
(make-instance 'template-file :path path))
|
||||
|
||||
(defgeneric generate (file target-dir)
|
||||
(:method ((file template-file) target-dir)
|
||||
(let ((target-path
|
||||
(merge-pathnames (template-file-path file) target-dir)))
|
||||
(when (search "skeleton" (pathname-name target-path))
|
||||
(setf target-path
|
||||
(make-pathname :name
|
||||
(regex-replace-all "skeleton"
|
||||
(pathname-name target-path)
|
||||
(getf *skeleton-parameters* :name))
|
||||
:defaults target-path)))
|
||||
(copy-file-to-file (merge-pathnames (template-file-path file)
|
||||
*skeleton-directory*)
|
||||
target-path)
|
||||
(list target-path))))
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
(in-package :cl-user)
|
||||
(defpackage cl-project.io
|
||||
(:use #:cl
|
||||
#:cl-project.specials)
|
||||
(:import-from #:cl-emb
|
||||
#:execute-emb)
|
||||
(:export #:copy-file-to-file))
|
||||
(in-package :cl-project.io)
|
||||
|
||||
(defun copy-file-to-file (source-path target-path)
|
||||
"Copy a file `source-path` to the `target-path`."
|
||||
(format t "~&writing ~A~%" target-path)
|
||||
(ensure-directories-exist target-path)
|
||||
(with-open-file (stream target-path :direction :output :if-exists :supersede)
|
||||
(write-sequence
|
||||
(cl-emb:execute-emb source-path :env *skeleton-parameters*)
|
||||
stream)))
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
(in-package :cl-user)
|
||||
(defpackage cl-project.middleware
|
||||
(:use #:cl)
|
||||
(:import-from #:cl-project.file
|
||||
#:template-file-path)
|
||||
(:export #:*without-tests*))
|
||||
(in-package :cl-project.middleware)
|
||||
|
||||
(defparameter *without-tests*
|
||||
(lambda (app &key
|
||||
(test-asd "skeleton-test.asd")
|
||||
(test-directory #P"t/"))
|
||||
(lambda (file)
|
||||
(unless (or
|
||||
;; Skip test ASD file
|
||||
(string= (file-namestring (template-file-path file))
|
||||
test-asd)
|
||||
;; Skip test files
|
||||
(eql 0 (search (namestring test-directory)
|
||||
(namestring (template-file-path file)))))
|
||||
(funcall app file)))))
|
||||
|
|
@ -0,0 +1,63 @@
|
|||
(in-package :cl-user)
|
||||
(defpackage cl-project.skeleton
|
||||
(:use #:cl
|
||||
#:cl-project.specials)
|
||||
(:import-from #:cl-project.file
|
||||
#:make-template-file
|
||||
#:template-file-path
|
||||
#:generate)
|
||||
(:export #:skeleton
|
||||
#:make-skeleton
|
||||
#:make-skeleton-from-directory))
|
||||
(in-package :cl-project.skeleton)
|
||||
|
||||
(defclass skeleton ()
|
||||
((path :type pathname
|
||||
:initarg :path
|
||||
:accessor skeleton-path)
|
||||
(children :type list
|
||||
:initarg :children
|
||||
:initform '()
|
||||
:accessor skeleton-children)))
|
||||
|
||||
(defun make-skeleton (path children)
|
||||
(make-instance 'skeleton :path path :children children))
|
||||
|
||||
(defmethod generate ((skeleton skeleton) target-dir)
|
||||
(let ((app (lambda (file)
|
||||
(generate file target-dir))))
|
||||
(when (getf *skeleton-parameters* :without-tests)
|
||||
(setf app
|
||||
(funcall cl-project.middleware:*without-tests*
|
||||
app)))
|
||||
(mapcan app (skeleton-children skeleton))))
|
||||
|
||||
(defun maptree (fn path)
|
||||
(flet ((directory-files (path)
|
||||
;; Older ASDF/UIOP's uiop:directory-files returns also directories on Linux.
|
||||
;; The bug had been fixed at ASDF 3.1.0.64 (https://bugs.launchpad.net/asdf/+bug/1276748), however, it's safe to filter directories anyway.
|
||||
;; ref. https://github.com/fukamachi/cl-project/pull/17
|
||||
(set-difference (uiop:directory-files path)
|
||||
(uiop:subdirectories path)
|
||||
:test #'equal)))
|
||||
(if (uiop:file-pathname-p path)
|
||||
;; file
|
||||
(list (funcall fn path))
|
||||
;; directory
|
||||
(append
|
||||
(mapcar fn (directory-files path))
|
||||
(mapcan (lambda (subdir)
|
||||
(maptree fn subdir))
|
||||
(uiop:subdirectories path))))))
|
||||
|
||||
(defun make-skeleton-from-directory (directory)
|
||||
(flet ((relative-path (path)
|
||||
(pathname
|
||||
(subseq
|
||||
(namestring path)
|
||||
(length (namestring directory))))))
|
||||
(make-skeleton
|
||||
directory
|
||||
(maptree (lambda (file)
|
||||
(make-template-file (relative-path file)))
|
||||
directory))))
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
(in-package :cl-user)
|
||||
(defpackage cl-project.specials
|
||||
(:use #:cl)
|
||||
(:export #:*default-skeleton-directory*
|
||||
#:*skeleton-directory*
|
||||
#:*skeleton-parameters*))
|
||||
(in-package :cl-project.specials)
|
||||
|
||||
(defparameter *default-skeleton-directory*
|
||||
(asdf:system-relative-pathname :cl-project #P"skeleton/"))
|
||||
|
||||
(defvar *skeleton-directory*
|
||||
*default-skeleton-directory*)
|
||||
|
||||
(defvar *skeleton-parameters* nil)
|
||||
Loading…
Add table
Add a link
Reference in a new issue