simyager/lspack
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

license templates

Browse Source
This commit is contained in:
simyager
2026-06-28 02:31:34 +03:00
parent dd1f3745de
commit 509f4a44bb
5 changed files with 163 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/license.lisp
+109
View File
@@ -0,0 +1,109 @@
(in-package :lspack)
(defparameter *licenses* (make-hash-table))
(defparameter *license-default-filename* "LICENSE")
(defclass <license> ()
((template-name :initarg :license-template-name
:accessor license-template-name)
(file-name :initarg :license-file-name
:accessor license-file-name
:initform *license-default-filename*)
(writer :initform nil
:accessor license-writer)))
(defun get-license (key)
(gethash key *licenses*))
(eval-always
(defun set-license (key value)
(setf (gethash key *licenses*) value)))
(eval-always
(defmacro deflicense (keys template-name &optional file-name)
(let ((sym (gensym "LICENSE")))
`(let ((,sym (make-instance '<license>
:license-template-name ,template-name
,@(unless (null file-name)
`(:license-file-name file-name)))))
,@(loop for key in (uiop:ensure-list keys)
collect `(set-license ,key ,sym))))))
(deflicense :mit "mit.txt")
(defmethod license-find-template ((license <license>))
(with-slots (template-name) license
(or (uiop:file-exists-p
(asdf:system-relative-pathname
:lspack
(uiop:merge-pathnames* template-name #P"data/")))
(uiop:file-exists-p
(uiop:xdg-data-home #P"lspack/data/" template-name)))))
(defmethod license-read-template ((license <license>))
(uiop:if-let ((name (license-find-template license)))
(uiop:read-file-string name)))
(defun template-find-args (template)
(loop with i = 0
while (< i (length template))
for arg = (uiop:if-let ((begin (search "{{" template :start2 i)))
(uiop:if-let ((end (search "}}" template :start2 begin)))
(prog1 (list (subseq template (+ begin 2) end) begin (+ end 2))
(setf i (+ end 2)))))
while arg
collect arg))
(defparameter *template-args* (make-hash-table :test 'equal))
(defun define-template-arg (argument-name expander)
(setf (gethash argument-name *template-args*) expander))
(defun get-arg-expander (arg)
(gethash arg *template-args*))
(define-template-arg "current-year"
(lambda (p s)
(declare (ignore p))
`(format ,s "~D" (get-current-year))))
(define-template-arg "project-author"
(lambda (p s)
`(format ,s "~A" (project-author ,p))))
(defun generate-argument-writer (arg project-sym stream-sym)
(uiop:if-let ((arg-expander (get-arg-expander arg)))
(funcall arg-expander project-sym stream-sym)))
(defun generate-writer-body (args project-sym template-sym stream-sym
&optional (prev-end 0))
(if (null args)
`((write-string ,template-sym ,stream-sym :start ,prev-end))
(let ((arg (car args)))
(destructuring-bind (name begin end) arg
(cons `(write-string ,template-sym ,stream-sym :start ,prev-end
:end ,begin)
(cons (generate-argument-writer name project-sym stream-sym)
(generate-writer-body (cdr args) project-sym template-sym
stream-sym end)))))))
(defun template-generate-writer (template-string)
(let ((args (template-find-args template-string))
(template-sym (gensym "TEMPLATE"))
(project-sym (gensym "PROJECT"))
(stream-sym (gensym "STREAM")))
`(lambda (,project-sym ,stream-sym)
(let ((,template-sym ,template-string))
,@(generate-writer-body args project-sym template-sym stream-sym)))))
(defmethod license-generate-writer ((license <license>))
(uiop:if-let (template (license-read-template license))
(setf (license-writer license)
(compile nil (template-generate-writer template)))))
(defmethod license-ensure-writer ((license <license>))
(with-slots (writer) license
(if (functionp writer)
writer
(license-generate-writer license))))
src/starter.lisp
+19 -5
View File
@@ -1,8 +1,8 @@
(in-package :lspack)
(defparameter *default-author* "")
(defparameter *default-license* "")
(defparameter *default-pathname* "")
(defparameter *default-license* nil)
(defparameter *default-pathname* "src")
(defparameter *default-version* "0.0.0")
(defclass <project> ()
@@ -24,7 +24,7 @@
(license :initarg :project-license
:accessor project-license
:initform *default-license*
:type string)
:type (or keyword null))
(version :initarg :project-version
:accessor project-version
:initform *default-version*
@@ -40,14 +40,14 @@
:project-name "my-project"
:project-author "name"
:project-description "a project"
:project-pathname ""))
:project-license :mit))
(defmethod project-defsystem-write ((project <project>) stream)
(with-slots (name author description license version pathname)
project
(fresh-line stream)
(write-char #\( stream)
(format stream "asdf:defsystem ~S" name)
(format stream "defsystem ~S" name)
(format stream "~& :author ~S" author)
(format stream "~& :description ~S" description)
(format stream "~& :license ~S" license)
@@ -99,9 +99,23 @@
(format out "(defpackage :~a~% (:use :cl))~%" name))
(format *error-output* "~&Created ~S" path))))
(defmethod project-license-create ((project <project>))
(let ((license (get-license (project-license project))))
(unless (null license)
(let ((writer (license-ensure-writer license))
(license-file (uiop:merge-pathnames* (license-file-name license)
(project-root project))))
(unless (null writer)
(with-open-file (out license-file :direction :output
:if-exists :supersede
:if-does-not-exist :create)
(funcall writer project out))
(format *error-output* "~&Created ~S" license-file))))))
(defmethod project-start ((project <project>))
(project-ensure-root project)
(project-defsystem-create project)
(project-license-create project)
(project-ensure-source-directory project)
(project-create-package project))
src/util.lisp
+9
View File
@@ -0,0 +1,9 @@
(in-package :lspack)
(defmacro eval-always (&body body)
`(eval-when (:compile-toplevel :load-toplevel :execute)
,@body))
(defun get-current-year ()
(let ((now (get-universal-time)))
(nth-value 5 (decode-universal-time now))))