From e8d4483aa0ba6ea9ee91c06d2c6374ef4e6ea59b Mon Sep 17 00:00:00 2001 From: emre Date: Thu, 2 Jul 2026 10:34:30 +0300 Subject: [PATCH] parse cli arguments and call create project in main --- lspack.asd | 2 +- src/main.lisp | 80 +++++++++++++++++++++++++++++++++++++++++++++++- src/package.lisp | 4 ++- src/starter.lisp | 10 +++--- 4 files changed, 88 insertions(+), 8 deletions(-) diff --git a/lspack.asd b/lspack.asd index f311f3c..e0ea0ca 100644 --- a/lspack.asd +++ b/lspack.asd @@ -2,7 +2,7 @@ :author "Emre Akan" :description "Quickstart Common Lisp projects" :license "GPL-3.0" - :version "0.0.2" + :version "0.0.3" :depends-on ("uiop") :pathname "src/" :serial t diff --git a/src/main.lisp b/src/main.lisp index 7218cdd..3ea412a 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -4,5 +4,83 @@ (in-package :lspack/exe) +(defun string-starts-with (str substr) + (when (>= (length str) (length substr)) + (string= str substr :end1 (length substr)))) + +(defclass () + ((name :initform nil + :accessor name) + (root :initform nil + :accessor root) + (author :initform nil + :accessor author) + (license :initform nil + :accessor license) + (description :initform "" + :accessor description))) + +(defun argument-key-p (arg) + (or (string-starts-with arg "-") + (string-starts-with arg "--"))) + +(defun parse-keyword (args acc) + (destructuring-bind (key val . rest) args + (if (or (null val) (null key)) + acc + (progn + (cond ((or (string= key "-r") + (string= key "--root")) + (setf (slot-value acc 'root) val)) + ((or (string= key "-a") + (string= key "--author")) + (setf (slot-value acc 'author) val)) + ((or (string= key "-l") + (string= key "--license")) + (setf (slot-value acc 'license) val)) + ((or (string= key "-d") + (string= key "--description")) + (setf (slot-value acc 'description) val))) + (parse-keyword-arguments rest acc))))) + +(defun parse-keyword-arguments (args acc) + (let ((arg (car args))) + (cond ((null arg) acc) + ((argument-key-p arg) (parse-keyword args acc)) + (t )))) + +(defun parse-arguments-header (args acc) + (let ((arg (car args))) + (unless (or (null arg) (argument-key-p arg)) + (setf (slot-value acc 'name) arg) + (parse-keyword-arguments (cdr args) acc)))) + +(defun parse-arguments (args) + (let ((acc (make-instance '))) + (parse-arguments-header args acc))) + +(defmethod create-project ((argument )) + (lspack:start (name argument) (root argument) + :license (license argument) + :description (description argument) + :author (author argument))) + +(defmethod normalize-arguments ((argument )) + (setf (root argument) + (if (null (root argument)) + (uiop:ensure-directory-pathname (name argument)) + (uiop:ensure-directory-pathname (root argument)))) + (when (null (author argument)) + (setf (author argument) lspack:*default-author*)) + (let ((license (license argument))) + (setf (license argument) + (cond ((null license) lspack:*default-license*) + ((stringp license) (intern (string-upcase license) :keyword)) + (t lspack:*default-license*)))) + argument) + (defun main () - (format t "Hello World!")) + (format t "cwd: ~S~%" (uiop:getcwd)) + (let ((args (parse-arguments (uiop:command-line-arguments)))) + (normalize-arguments args) + (create-project args))) diff --git a/src/package.lisp b/src/package.lisp index c79f75a..7eedfea 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1,3 +1,5 @@ (defpackage :lspack (:use :cl) - (:export :start)) + (:export #:start + #:*default-author* + #:*default-license*)) diff --git a/src/starter.lisp b/src/starter.lisp index 34402a0..ea7de6b 100644 --- a/src/starter.lisp +++ b/src/starter.lisp @@ -61,12 +61,12 @@ :if-exists :supersede :if-does-not-exist :create) (project-defsystem-write project out)) - (format *error-output* "~&Created ~S" path))) + (format *error-output* "~&Created ~S~%" path))) (defmethod project-ensure-root ((project )) (with-slots (root) project (ensure-directories-exist (uiop:physicalize-pathname root)) - (format *error-output* "~&Starting project at ~S" root))) + (format *error-output* "~&Starting project at ~S~%" root))) (defmethod project-source-pathname ((project )) (uiop:merge-pathnames* (uiop:ensure-directory-pathname (project-pathname project)) @@ -78,7 +78,7 @@ (format *error-output* "~&Source directory: ~S" src) (unless (string= pathname "") (ensure-directories-exist (uiop:physicalize-pathname src)) - (format *error-output* " created."))))) + (format *error-output* " created.~%"))))) (defmethod project-write-notice ((project ) stream) (uiop:if-let ((notice (get-notice (project-license project)))) @@ -95,7 +95,7 @@ :if-does-not-exist :create) (project-write-notice project out) (format out "~&(defpackage :~a~% (:use :cl))~%" name)) - (format *error-output* "~&Created ~S" path)))) + (format *error-output* "~&Created ~S~%" path)))) (defmethod project-license-create ((project )) (let ((license (get-license (project-license project)))) @@ -108,7 +108,7 @@ :if-exists :supersede :if-does-not-exist :create) (funcall writer project out)) - (format *error-output* "~&Created ~S" license-file)))))) + (format *error-output* "~&Created ~S~%" license-file)))))) (defmethod project-start ((project )) (project-ensure-root project)