Vim window logic, slimv

This commit is contained in:
Ian Keane 2020-02-24 20:27:04 -05:00
parent babcc9e44b
commit 515847d07e
791 changed files with 51552 additions and 86 deletions

View file

@ -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)))

View file

@ -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))))

View file

@ -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)))

View file

@ -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)))))

View 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))))

View file

@ -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)