;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: July 2003
;;;;
-;;;; $Id: uri.lisp,v 1.4 2003/07/23 23:08:29 kevin Exp $
+;;;; $Id: uri.lisp,v 1.5 2003/08/08 09:03:45 kevin Exp $
;;;;
;;;; This file and Wol are Copyright (c) 2003 by Kevin M. Rosenberg
;;;; *************************************************************************
+#+ignore
(defun make-html-url (page ent &optional query-args)
(make-url (concatenate 'string page ".html")
:base-dir (project-prefix
(entity-project ent))
:vars query-args :format :xhtml))
-(defvar *unspecified* (cons :unspecified nil))
-
-(defun make-wol-url (page ent
- &key (session-id *unspecified*)
- (object-id *unspecified*)
- (func *unspecified*) (key *unspecified*)
- (subobjects *unspecified*) (labels *unspecified*)
- (english-only *unspecified*)
- (format *unspecified*)
- (lang *unspecified*) (logged *unspecified*)
- (next-page *unspecified*) (caller *unspecified*)
- asp html)
- (let ((plist (list :page page))
+
+(defun make-wol-url (page ent &optional plist)
+ (let ((url-plist (append (list :page page) plist))
(prefix (project-prefix (entity-project ent))))
- (unless (eq session-id *unspecified*)
- (setq plist (append plist (list :session-id session-id))))
- (unless (eq object-id *unspecified*)
- (setq plist (append plist (list :object-id object-id))))
- (unless (eq lang *unspecified*)
- (setq plist (append plist (list :lang lang))))
- (unless (eq logged *unspecified*)
- (setq plist (append plist (list :logged logged))))
- (unless (eq func *unspecified*)
- (setq plist (append plist (list :func func))))
- (unless (eq subobjects *unspecified*)
- (setq plist (append plist (list :subobjects subobjects))))
- (unless (eq key *unspecified*)
- (setq plist (append plist (list :key key))))
- (unless (eq labels *unspecified*)
- (setq plist (append plist (list :labels labels))))
- (unless (eq english-only *unspecified*)
- (setq plist (append plist (list :english-only english-only))))
- (unless (eq next-page *unspecified*)
- (setq plist (append plist (list :next-page next-page))))
- (unless (eq format *unspecified*)
- (setq plist (append plist (list :format format))))
- (unless (eq caller *unspecified*)
- (setq plist (append plist (list :caller caller))))
- (if (and (null asp)
- (parameters-null session-id object-id lang logged func subobjects
- key labels english-only next-page format caller))
- (concatenate 'string prefix page ".html")
+ (if (null plist)
+ (concatenate 'string prefix page ".lsp")
(concatenate 'string
prefix
- (if html
- (concatenate 'string page ".lsp")
- +asp-header+)
- (concatenate 'string +plist-header+ (plist-to-url-string plist))))))
-
-(defun parameters-null (&rest params)
- (every #'(lambda (p) (or (null p) (eq p *unspecified*))) params))
+ +asp-header+
+ (concatenate 'string +plist-header+
+ (plist-to-url-string url-plist))))))
;; Property lists