-#+allegro
-(defun parse-xml-no-ws (str)
- "Return list structure of XML string with removing whitespace strings"
- (remove-tree-if #'string-ws? (parse-xml str)))
+(defun find-start-tag (tag taglen xmlstr start end)
+ "Searches for the start of a tag in an xmlstring. Returns STARTPOS ATTRIBUTE-LIST)"
+ (declare (simple-string tag xmlstr)
+ (fixnum taglen start end)
+ (optimize (speed 3) (safety 0) (space 0)))
+ (do* ((search-str (concatenate 'string "<" tag))
+ (search-len (1+ taglen))
+ (bracketpos (fast-string-search search-str xmlstr search-len start end)
+ (fast-string-search search-str xmlstr search-len start end)))
+ ((null bracketpos) nil)
+ (let* ((endtag (+ bracketpos 1 taglen))
+ (char-after-tag (schar xmlstr endtag)))
+ (when (or (char= #\> char-after-tag)
+ (char= #\space char-after-tag))
+ (if (char= #\> char-after-tag)
+ (return-from find-start-tag (values (1+ endtag) nil))
+ (let ((endbrack (position-char #\> xmlstr (1+ endtag) end)))
+ (if endbrack
+ (return-from find-start-tag
+ (values (1+ endbrack)
+ (string-to-list-skip-delimiter
+ (subseq xmlstr endtag endbrack))))
+ (values nil nil)))))
+ (setq start endtag))))
+