Permalink
Browse files

autoload newly created application to asdf:*central-registry*

  • Loading branch information...
1 parent db760e0 commit 3058fef85dd65f55fe3bfefe414d601cad648387 asdr the admin committed Feb 13, 2011
Showing with 67 additions and 17 deletions.
  1. +55 −9 application-util.lisp
  2. +2 −2 server.lisp
  3. +10 −6 settings.lisp
View
64 application-util.lisp
@@ -6,9 +6,6 @@
("_view" . "lisp")
("template-app" . "asd")))
-(defvar *easyweb-template-application-dir* "/home/admin-o/pjs/easyweb/template-app")
-;(defvar *easyweb-template-application-dir* "/home/asdr/projects/easyweb/template-app")
-
(defun write-from-template (in out variables)
(let ((template-printer (html-template:create-template-printer in)))
(html-template:fill-and-print-template template-printer
@@ -35,7 +32,7 @@
(values (subseq correct-path 0 last-position)
(subseq correct-path last-position))))
-(defun make-application (application-path)
+(defun make-application (application-path &key (autoload-at-startup t))
(let* ((application-path-n (remove-trailing-slash application-path))
(last-position (1+ (position #\/
application-path-n
@@ -54,15 +51,64 @@
(when exist
(loop
for (name . type) in *files-be-cloned*
- do (let ((if-path (make-pathname
- :directory *easyweb-template-application-dir*
- :name name
- :type type))
+ do (let ((if-path (merge-pathnames (concatenate 'string
+ name
+ "."
+ type)
+ easyweb.settings:+default-application-dir+))
(of-path (progn
(when (string= type "asd")
(setf name application-name))
(make-pathname
:directory path
:name name
:type type))))
- (clone-file if-path of-path :application_name application-name))))))))
+ (clone-file if-path of-path :application_name application-name)))
+ (pushnew path asdf:*central-registry*)
+ (when autoload-at-startup
+ (add-to-init-file application-name path)))))))
+
+ ;;we need to add the path to the quicklisp autoload directory
+ ;;i am not sure where should i add the path
+ ;;therefore i will, for now, make symbolic link under ~/.local/share/common-lisp/source/
+ ;;(create-symbolic-link (concatenate 'string
+ ;; application-path-n
+ ;; "/")
+ ;; (merge-pathnames (concatenate 'string
+ ;; ".local/share/common-lisp/source/"
+ ;; application-name
+ ;; "/")
+ ;; (user-homedir-pathname))))))))
+
+(defun create-symbolic-link (destination-path link-name)
+ (labels ((path-to-string (path)
+ (when path
+ (let ((path-dir (cdr (pathname-directory path))))
+ (subseq (reduce #'(lambda (x y)
+ (concatenate 'string "/" x "/" y))
+ path-dir)
+ 1)))))
+ (let ((dest (if (pathnamep destination-path)
+ (concatenate 'string (path-to-string destination-path) "/")
+ destination-path))
+ (name (if (pathnamep link-name)
+ (path-to-string link-name)
+ link-name)))
+ #+:sbcl
+ (sb-ext:run-program "/bin/ln" (list "-s" dest name)))))
+
+(defun add-to-init-file (application-name application-path)
+ #-sbcl
+ (error "NO-SBCL")
+ #+sbcl
+ (let ((init-file-path (merge-pathnames ".sbclrc"
+ (user-homedir-pathname))))
+ (with-open-file (stream init-file-path
+ :direction :output
+ :if-exists :append
+ :if-does-not-exist :create)
+ (format stream
+ "~%~%~%~A~A~%~A~S~A~%~%~%"
+ "#-" application-name
+ "(pushnew " application-path " asdf:*central-registry*)"))))
+
View
4 server.lisp
@@ -19,8 +19,8 @@
;;start swank server
-(defparameter *swank*
- (swank:create-server :port *swank-port* :dont-close t))
+;;(defparameter *swank*
+;; (swank:create-server :port *swank-port* :dont-close t))
(defun easy-starter-hash (address port)
(format nil "~A" (cons address port)))
View
16 settings.lisp
@@ -2,16 +2,20 @@
(defpackage :easyweb.settings
(:use #:cl)
- (:export #:*template-directory*))
+ (:export #:+configuration-dir+
+ #:+default-application-dir+
+ #:+template-start-tag+
+ #:+template-end-tag+))
(in-package :easyweb.settings)
-(defparameter *template-directory* "template")
-(defparameter *template-start-tag* "(%")
-(defparameter *template-end-tag* "%)")
+(defconstant +configuration-dir+ (merge-pathnames ".easyweb/" (user-homedir-pathname)))
+(defconstant +default-application-dir+ (merge-pathnames "default-application/" +configuration-dir+))
+(defconstant +template-start-tag+ "(%")
+(defconstant +template-end-tag+ "%)")
@asdr
Owner
asdr added a line comment Feb 13, 2011

i dont know why this defconstants are defined more than once ...
there is a bug here ...!!!!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
;;html-template settings
-(setf html-template:*template-start-marker* *template-start-tag*
- html-template:*template-end-marker* *template-end-tag*)
+(setf html-template:*template-start-marker* +template-start-tag+
+ html-template:*template-end-marker* +template-end-tag+)

0 comments on commit 3058fef

Please sign in to comment.