r5318: *** empty log message ***

[wol.git] / project.lisp

diff --git a/project.lisp b/project.lisp
index ac0e5a80c9d987135e0ab444c583cc8863baf93f..cc26b2783ff09dfe1348b8db4ac8873b926fcddb 100644 (file)
--- a/project.lisp
+++ b/project.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  July 2003
 ;;;;
-;;;; $Id: project.lisp,v 1.1 2003/07/16 16:02:21 kevin Exp $
+;;;; $Id: project.lisp,v 1.2 2003/07/16 20:40:43 kevin Exp $
 ;;;;
 ;;;; This file and Wol are Copyright (c) 2001-2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -90,16 +90,17 @@
   (string= (request-raw-uri req) 
           (project-prefix (entity-project ent))))
 
+(defun redirect-entity (page ent)
+  (redirect-to-location 
+   (format nil "~A~A" (project-prefix (entity-project ent)) page)))
+  
 (defun dispatch-request (req)
   (let ((ent (find-entity-for-request req)))
     (when ent
       (let ((proj (entity-project ent)))
        (if (is-index-request req ent)
            (progn
-             (redirect-to-location 
-              (format nil "~A~A" 
-                      (project-prefix proj)
-                      (project-index proj)))
+             (redirect-entity (project-index proj) ent)
              t)
          (progn
            (request-decompile-uri req ent)
@@ -133,9 +134,6 @@
   (nth-value 0 (gethash (request-page req) 
                        (project-hash-map (entity-project ent)))))
 
-(defun action-redirect (page req ent)
-  (cmsg "redirect to ~A" page))
-  
 (defun handle-request (handler req ent)
   (typecase handler
     (null
@@ -145,14 +143,14 @@
                (not (fboundp handler)))
        (cmsg "handler given a symbol without a function ~S" handler)
        (return-from handle-request nil))
-     (let ((res (funcall handler req ent)))
-       (typecase res
+     (let ((next-page (funcall handler req ent)))
+       (typecase next-page
         (string
-         (action-redirect res req ent))
+         (redirect-entity next-page ent))
         (null
          t)
         (t
-         (cmsg "handler should return nil or a string"))))
+         (cmsg "handler should return nil or a string, not ~S" next-page))))
      t)
     (string
      (cmsg "string handler not supported: ~A" handler)