[isidorus-cvs] r838 - branches/gdl-frontend/src/rest_interface

[lgiessmann at common-lisp.net]

Author: lgiessmann
Date: Wed Sep  7 01:25:11 2011
New Revision: 838

Log:


Modified:
   branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp

Modified: branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp
==============================================================================
--- branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp	Tue Sep  6 23:55:07 2011	(r837)
+++ branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp	Wed Sep  7 01:25:11 2011	(r838)
@@ -9,18 +9,16 @@
 
 (in-package :rest-interface)
 
-(defparameter *base-address* "/");"/gdl/")
-(defparameter *get-fragment* (concat *base-address* "fragment/(.+)$"))
-(defparameter *get-schema* (concat *base-address* "schema/?$"))
-(defparameter *commit-fragment* (concat *base-address* "commit/?"))
-(defparameter *delete-fragment* (concat *base-address* "delete/?"))
-(defparameter *host-address* (concat *base-address* "anatomia"))
+(defparameter *get-fragment* "/gdl/fragment/(.+)$")
+(defparameter *get-schema* "/gdl/schema/?$")
+(defparameter *commit-fragment* "/gdl/commit/?")
+(defparameter *delete-fragment* "/gdl/delete/?")
+(defparameter *host-address* "/anatomia")
 (defparameter *base-path* "anaToMia/hosted_files/")
 (defparameter *host-file* (concat *base-path* "GDL_Widgets.html"))
 
 
-(defun set-up-gdl-interface (&key (base-address *base-address*)
-			     (get-fragment *get-fragment*)
+(defun set-up-gdl-interface (&key (get-fragment *get-fragment*)
 			     (get-schema *get-schema*)
 			     (commit-fragment *commit-fragment*)
 			     (delete-fragment *delete-fragment*)
@@ -30,8 +28,8 @@
   (declare (String get-fragment get-schema commit-fragment
 		   delete-fragment host-address))
 
-  (init-cache nil)
-  (format t "~%")
+  ;(init-cache nil)
+  ;(format t "~%")
   (init-fragments nil)
 
   ;; registers the http-code 500 for an internal server error to the standard
@@ -41,7 +39,7 @@
   (push hunchentoot:+http-internal-server-error+ hunchentoot:*approved-return-codes*)
   
   (init-hosted-files :host-address host-address :host-file host-file
-		     :base-address base-address :base-path base-path)
+		     :base-path base-path)
   
   (push
    (create-regex-dispatcher get-fragment #'return-json-fragment-handler)
@@ -62,10 +60,9 @@
 
 (defun init-hosted-files (&key (host-address *host-address*)
 			  (host-file *host-file*)
-			  (base-address *base-address*)
 			  (base-path *base-path*))
   "Adds handlers for the css, html and js files needed by the frontend."
-  (declare (String host-address host-file base-address base-path))
+  (declare (String host-address host-file base-path))
   ;; add the actual html file
   (let ((full-host-path
 	 (concat (namestring
@@ -89,8 +86,7 @@
 		     (string= full-host-path (namestring item)))
 	   (let* ((rel-addr (subseq (namestring item) absolute-base-path-len))
 		  (content-type (generate-content-type (file-namestring item)))
-		  (rel-uri (concat base-address rel-addr)))
-	     (format t "~a >> ~a~%" rel-uri content-type)
+		  (rel-uri (concat "/" rel-addr)))
 	     (push
 	      (create-static-file-dispatcher-and-handler
 	       rel-uri item content-type)
@@ -167,7 +163,8 @@
    can be served separately."
   (let ((http-method (hunchentoot:request-method*)))
     (if (eq http-method :GET)
-	(jtm-exporter:export-as-jtm-string :revision 0)
+	(progn (setf (hunchentoot:content-type*) "application/json")
+	       (jtm-exporter:export-as-jtm-string :revision 0))
 	(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))