X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=web-utils.lisp;h=da7d6b73918bdd50e21b27c9be90628eec154c54;hp=ab765d608920776fd000bd21ebc25742387b0d86;hb=86a868a95313178cdc7a83d35856ccf5c2cf315f;hpb=f622f091a8648cac7e1e41a5207184c8618a19d5 diff --git a/web-utils.lisp b/web-utils.lisp index ab765d6..da7d6b7 100644 --- a/web-utils.lisp +++ b/web-utils.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: web-utils.lisp,v 1.14 2003/06/15 19:01:01 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -27,7 +27,7 @@ (defvar *standard-html-header* "") (defvar *standard-xhtml-header* - #.(format nil "~%")) + #.(format nil "~%")) ;;; User agent functions @@ -45,7 +45,7 @@ (defun base-url! (url) (setq *base-url* url)) -(defun make-url (page-name &key (base-dir *base-url*) (format :html) (vars nil)) +(defun make-url (page-name &key (base-dir *base-url*) (format :html) vars anchor) (let ((amp (case format (:html "&") @@ -56,40 +56,24 @@ (if vars (let ((first-var (first vars))) (concatenate 'string - "?" (car first-var) "=" (cadr first-var) + "?" (car first-var) "=" (cdr first-var) (mapcar-append-string #'(lambda (var) - (when (and (car var) (cadr var)) + (when (and (car var) (cdr var)) (concatenate 'string - amp (car var) "=" (cadr var)))) + amp (string-downcase (car var)) "=" (cdr var)))) (rest vars)))) + "") + (if anchor + (concatenate 'string "#" anchor) "")))) -(defun make-url-new (page-name &key (base-dir *base-url*) (format :html) - (vars nil)) - (let ((amp (ecase format - (:html "&") - ((:xml :ie-xml) "&")))) - (concatenate 'string - base-dir page-name - (if vars - (let ((first-var (first vars))) - (concatenate 'string - "?" (car first-var) "=" (cadr first-var) - (mapcar-append-string - #'(lambda (var) - (when (and (car var) (cadr var)) - (concatenate 'string - amp (car var) "=" (cadr var)))) - (rest vars)))) - "")))) - (defun decode-uri-query-string (s) "Decode a URI query string field" (declare (simple-string s) (optimize (speed 3) (safety 0) (space 0))) (do* ((old-len (length s)) - (new-len (- old-len (* 2 (count-string-char s #\%)))) + (new-len (- old-len (* 2 (the fixnum (count-string-char s #\%))))) (new (make-string new-len)) (p-old 0) (p-new 0 (1+ p-new))) @@ -111,3 +95,13 @@ (t (setf (schar new p-new) c) (incf p-old)))))) + +(defun split-uri-query-string (s) + (mapcar + (lambda (pair) + (let ((pos (position #\= pair))) + (when pos + (cons (subseq pair 0 pos) + (when (> (length pair) pos) + (decode-uri-query-string (subseq pair (1+ pos)))))))) + (delimited-string-to-list s #\&)))