Commits

Phil Hargett  committed 9130cbd

Draft version of automated generation of form-absed interface for
services completed. Used the auth services to validate behavior,
and appears to work. Thus, this also means auth services should
be function.

  • Participants
  • Parent commits 5d63527

Comments (0)

Files changed (4)

File hh-web-tags.asd

                (:file "tags")
 	       (:file "taglibraries")
 	       (:file "cookies")
+	       (:file "templates")
 	       (:file "services")
-	       (:file "templates")
 	       (:file "patterns")
 	       (:file "web")
 	       )

File taglibraries.lisp

     )
   )
 
+(defun flush-tag-library (library-name cached-library)
+  "Safely a cached library, typically for reloading"
+  ;; remove the library from the cache
+  (remhash library-name *available-tag-libraries*)
+  ;; also, delete the library's package...should make it easier to redefine it
+  (when (template-package cached-library)
+    (delete-package (tag-library-package cached-library))
+    )
+  )
+
 (defun find-cached-tag-library (library-name)
   (let (
 	(cached-library (gethash library-name *available-tag-libraries* nil) )
     :initarg :body
     :accessor body-of
     )
+   (id ;; corresponds the id of the DOM element, if needed
+    :initform ()
+    :initarg :id
+    :accessor id-of
+    )
    (class ;; corresponds to class attribute for CSS style information
     :initform nil
     :initarg :class
 		      ((:script-libraries script-libraries) nil)
 		      )
   (declare 
-   (type (or null string) script ready style)
+   ; (type (or null string) script ready style)
    (type (or null list) style-sheets script-libraries)
    )
   `(progn
        (,@attributes)
        )
 
+     ;; TODO should consider undefining some of these methods, 
+     ;; to avoid lingering effects when tags redefined (e.g, 
+     ;; define scripts, then redefine without scripts, method
+     ;; for scripts still exists)
+
      (defmethod tag-name ( (*current-tag* ,name) )
        (quote ,name)
        )

File templates.lisp

   '*template*
   '*template-provider-registry*
   'create-folder-template-provider
+  'create-asdf-system-template-provider
 
   )
 )
     )
   )
 
+(defun flush-template (template-path cached-template)
+  "Safely a cached template, typically for reloading"
+  ;; remove the template from the cache
+  (remhash template-path *template-cache*)
+  ;; also, delete the template's package...could cluter up the runtime
+  (when (template-package cached-template)
+    (delete-package (template-package cached-template))
+    )
+  )
+
 (defun find-cached-template (template-path)
   (let (
 	(cached-template (gethash template-path *template-cache* nil) )
     (if cached-template
 	(if (template-expiredp cached-template) 
 	    (progn
-	      (remhash template-path *template-cache*)
+	      (flush-template template-path cached-template)
 	      nil
 	      )
 	    cached-template
     )
   )
 
-;; -------- Folder provider ---------------------
+;; -------- File-based template provider ---------------------
 ;; 
-;;  provides templates in individual files of a specified 
-;;  folder on the filesystem
+;;  Generalized definitions designed to aid any template provider
+;;  that serves templates from a filesystem
 
-(defclass folder-template-provider (template-provider)
+(defclass file-based-template-provider ()
   (
-   (folder
-    :initarg :folder
-    :accessor folder-of
-    )
    )
+  (:documentation "Generalized type for providers serving templates from the filesystem")
 )
 
+(defgeneric template-provider-base-directory (provider)
+  (:documentation "Returns the base directory on a fileystem for templates 
+    served by the provider.  Directory name should end in /."
+		  )
+  )
+
 (defgeneric template-full-path (template-path provider)
-  (:method (template-path (provider folder-template-provider) )
+  (:method (template-path (provider file-based-template-provider) )
     (let (
-	   (provider-path (folder-of provider) )
+	   (provider-path (template-provider-base-directory provider) )
 					; folder-name should be an absolute path, ending / to indicate directory
 	   )
       (merge-pathnames (make-pathname :directory (pathname-directory template-path)
 )
 
 (defgeneric template-file-modified-time (template-path provider)
-  (:method (template-path (provider folder-template-provider) )
+  (:method (template-path (provider file-based-template-provider) )
     ;; not sure why, but mtime seems about 70 years off of the time reported
     ;; by get-internal-real-time--probably an OS-specific behavior (Mac in this case), so will need to adjust
     ;; later for other platforms (e.g., Linux)
     )
   )
 
-(defun create-folder-template-provider (folder)
-  (make-instance 'folder-template-provider :folder folder)
-  )
-
 ; -- Implementation of base template-provider functions
 
-(defmethod provider-template-expiredp (*template* (provider folder-template-provider) )
+(defmethod provider-template-expiredp (*template* (provider file-based-template-provider) )
   (let (
 	(full-path (template-full-path (template-path *template*) provider) )
 	)
     )
   )
 
-(defmethod load-template-from-provider ( (*template* template) template-path (provider folder-template-provider) )
+(defmethod load-template-from-provider ( (*template* template) template-path (provider file-based-template-provider) )
   (let (
 	(full-path (template-full-path template-path provider) )
 	)
     )
   )
 
+;; -------- Folder provider ---------------------
+;; 
+;;  provides templates in individual files of a specified 
+;;  folder on the filesystem
+
+(defclass folder-template-provider (template-provider file-based-template-provider)
+  (
+   (folder
+    :initarg :folder
+    :accessor folder-of
+    )
+   )
+)
+
+(defmethod template-provider-base-directory ( (provider folder-template-provider) )
+  (folder-of provider)
+  )
+
+(defun create-folder-template-provider (folder)
+  (make-instance 'folder-template-provider :folder folder)
+  )
+
 ;; -------- ASDF system provider ---------------------
 ;; 
-;;  searches packages (starting from *package*) for a "templates"
-;;  folder using asdf:system-relative-pathname, and provides
+;;  Services for templates a "templates" folder using 
+;;  asdf:system-relative-pathname and the indicated system, and provides
 ;;  templates in individual files from any of those locations
+;;
 
-(defclass asdf-system-provider (template-provider)
-  ()
+(defclass asdf-system-provider (template-provider file-based-template-provider)
+  (
+   (system
+    :initform nil
+    :initarg :system
+    :accessor system-of
+    )
+   )
 )
 
+(defmethod template-provider-base-directory ( (provider asdf-system-provider) )
+  (asdf:system-relative-pathname (system-of provider) "templates/")
+  )
+
+(defun create-asdf-system-template-provider (system)
+  (make-instance 'asdf-system-provider :system system)
+)
+
+; -- Implementation of base template-provider functions
+
+(defmethod provider-template-expiredp (*template* (provider asdf-system-provider) )
+  (let (
+	(full-path (template-full-path (template-path *template*) provider) )
+	)
+    (>  (template-file-modified-time full-path provider)
+	(modified-time-of *template*)
+	)
+    )
+  )
+
+(defmethod load-template-from-provider ( (*template* template) template-path (provider asdf-system-provider) )
+  (let (
+	(full-path (template-full-path template-path provider) )
+	)
+    (when (probe-file full-path)
+      (setf (template-provider *template*) provider)
+      (setf (modified-time-of *template*) 
+	    (template-file-modified-time template-path provider)
+	    )
+      (read-template-definition (open full-path :direction :input) (template-package *template*)
+				(template-args *template*)
+				(template-keyword-args *template*)
+				)
+      )
+    )
+  )
+
+
 ;;;------------------------------------------------------------------------------------
 ;;;  Template declaration
 ;;;
 	     )
 	 `(let (
 		(tmpl (or (find-cached-template ,path) 
-			  (load-template ,path ,template-args ,template-keyword-args)
+			  (load-template ,path (quote ,template-args) (quote ,template-keyword-args) )
 			  )
 		  )
 		)