r5381: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Wed, 23 Jul 2003 23:08:29 +0000 (23:08 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Wed, 23 Jul 2003 23:08:29 +0000 (23:08 +0000)
project.lisp
uri.lisp

index a0d40610b561d6468cbab955cccd534747701b3f..ad94d48f2aa99087ff062300aa2130098eb1f4cd 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  July 2003
 ;;;;
-;;;; $Id: project.lisp,v 1.4 2003/07/19 20:32:48 kevin Exp $
+;;;; $Id: project.lisp,v 1.5 2003/07/23 23:08:28 kevin Exp $
 ;;;;
 ;;;; This file and Wol are Copyright (c) 2001-2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************
   (string= (puri:uri-path (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 redirect-entity (page ent &optional plist)
+  (redirect-to-location (apply #'make-wol-url page ent plist)))
 
 (defun dispatch-request (req ent)
   (let ((proj (entity-project ent)))
        (typecase next-page
         (string
          (redirect-entity next-page ent))
+        (cons
+         (redirect-entity (car next-page) ent (cadr next-page)))
         (null
          t)
         (t
index 16764b7772fbe2e6016da5bd18dc5f37663c64ff..e0612a29c8ddd40da2d0462a91c67ea2c9ed42b9 100644 (file)
--- a/uri.lisp
+++ b/uri.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  July 2003
 ;;;;
-;;;; $Id: uri.lisp,v 1.3 2003/07/19 20:32:48 kevin Exp $
+;;;; $Id: uri.lisp,v 1.4 2003/07/23 23:08:29 kevin Exp $
 ;;;;
 ;;;; This file and Wol are Copyright (c) 2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************
     (:lang :l)
     (:logged :g)
     (:caller :c)
+    (:db :d)
     
     ;; For lookup-func1
     (:func :f)
     (:L :lang)
     (:G :logged)
     (:C :caller)
+    (:D :db)
     
     ;; For posting to lookup-func1
     (:F :func)