Re: [spr28657] Re: PortableAserve (and WebActions, specifically)

John Foderaro <[email protected]> Thu, 4 Mar 2004 13:48:02 -0800
Newsgroups gmane.lisp.open-source.franz
Message-ID <[email protected]>
 I've put this fix in for this problem.


(defun scan-for-end-tag (p module fcn)
  ;; look for </module_fcn>
  ;; leave the file position after the tag
  ;;
  ;; return the number of characters read not including
  ;; the end tag
  ;; 
  ;; return  nil if the end tag wasn't found
  ;;
  
  ;; we define a search obj as a cons holding how far we've
  ;; matched so far and the string we're matching
  (macrolet ((create-search-obj (string)
	       `(cons 0 ,string))
	     
	     (init-search-obj (obj)
	       ;; set back to initial state
	       `(setf (car ,obj) 0))
	     
	     (end-of-search-p (obj)
	       ;; see if we've matched all characters
	       `(equal (car ,obj) (length (cdr ,obj))))
	     
	     (search-string (obj)
	       `(cdr ,obj))
	     
	     (search-counter (obj)
	       `(car ,obj))
	     
	     (match-search-string (obj ch)
	       `(if* (eql ,ch (schar (search-string ,obj) 
				      (search-counter ,obj)))
		   then (incf (search-counter ,obj))
		   else (init-search-obj ,obj))))
	     
    (let ((end-tag   (create-search-obj (format nil "</~a_~a>" module fcn)))
	  (start-tag (create-search-obj (format nil "<~a_~a>" module fcn)))
	  (nest-level 0)
	  (ch)
	  (chcount 0))

    
      (loop
	
	(if* (end-of-search-p end-tag)
	   then (if* (> nest-level 0)
		   then (decf nest-level)
			(init-search-obj end-tag)
		   else (return (- chcount (length (search-string end-tag))))))
	
	(if* (end-of-search-p start-tag)
	   then (incf nest-level)
		(init-search-obj start-tag))
	    

    
	; get next character ...
	(if* (null (setq ch (read-char p nil nil)))
	   then ; no end tag found
		(return nil))
	
	(incf chcount)

	;; and look for matches
	(match-search-string end-tag ch)
	(match-search-string start-tag ch)))))