xemacs-beta: lisp/w3/w3-parse.el comparison

comparison lisp/w3/w3-parse.el @ 80:1ce6082ce73f r20-0b90

Import from CVS: tag r20-0b90

author	cvs
date	Mon, 13 Aug 2007 09:06:37 +0200
parents	131b0175ea99
children	6a378aca36af

comparison

equal deleted inserted replaced

-:5b0a5bbffab6
+:1ce6082ce73f
-;; Created by: Joe Wells, jbw@csb.bu.edu
+;; Created by: Joe Wells, jbw@cs.bu.edu
 ;; Created on: Sat Sep 30 17:25:40 1995
 ;; Filename: w3-parse.el
 ;; Purpose: Parse HTML and/or SGML for Emacs W3 browser.
 ;; Copyright © 1995, 1996  Joseph Brian Wells
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;;
 ;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, write to the Free Software
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 ;;
 ;; On November 13, 1995, the license was available at
 ;; <URL:ftp://prep.ai.mit.edu/pub/gnu/COPYING-2.0>.  It may still be
 ;; obtainable via that URL.
 ;; (remember this is really all one function).  Some of the code which
 ;; updates them is located inside the subfunctions.  So that the compiler
 ;; will not complain, these variables are defined with defvar.
 (require 'w3-vars)
+(require 'mule-sysdp)
 (eval-when-compile
 (defconst w3-p-s-var-list nil
 "A list of the scratch variables used by functions called by
 w3-parse-buffer which it is w3-parse-buffer's responsibility to
 (defvar w3-p-d-open-element-stack)
 (put 'w3-p-d-open-element-stack 'variable-documentation
 "A stack of the currently open elements, with the innermost enclosing
 element on top and the outermost on bottom.")
-(defvar w3-p-d-parse-tag-stream-tail-pointer)
-(put 'w3-p-d-parse-tag-stream-tail-pointer 'variable-documentation
-"Points to last cons cell in parse-tag stream.  We add items to tail of
-parse-tag-stream instead of head.")
 (defvar w3-p-d-shortrefs)
 (put 'w3-p-d-shortrefs 'variable-documentation
 "An alist of the magic entity reference strings in the current
 between-tags region and their replacements.  Each item is of the format
 (let ((html-entities w3-html-entities))
 (while html-entities
 (put (car (car html-entities)) 'html-entity-expansion
 	 (cons 'CDATA (if (integerp (cdr (car html-entities)))
 (char-to-string
-(let ((c (cdr (car html-entities))))
+(mule-make-iso-character (cdr (car html-entities))))
-(cond
-((and (> c 127) (boundp 'MULE))
-(make-character lc-ltn1 c))
-;;((and (> c 127) (featurep 'mule))
-;; What???
-;;)
-(t
-c))))
 			(cdr (car html-entities)))))
 (setq html-entities (cdr html-entities))))
 ;; These are handled differently than the normal HTML entities because
 ;; we need to define the entities with 'nil instead of 'CDATA so
 ;; char-to-string will hopefully do something useful with characters
 ;; larger than 255.  I think in MULE it does.  Is this true?
 ;; Bill wants to call w3-resolve-numeric-entity here, but I think
 ;; that functionality belongs in char-to-string.
 ;; The largest valid character in the I18N version of HTML is 65533.
-;; <URL:ftp://ds.internic.net/internet-drafts/draft-ietf-html-i18n-01.txt>
+;; ftp://ds.internic.net/internet-drafts/draft-ietf-html-i18n-01.txt
 ;; wrongo!  Apparently, mule doesn't do sane things with char-to-string
 ;; -wmp 7/9/96
 (insert (char-to-string
-(cond
+(mule-make-iso-character w3-p-s-num))))
-((and (boundp 'MULE) (> w3-p-s-num 127))
-(make-character lc-ltn1 w3-p-s-num))
-;;((and (featurep 'mule) (> w3-p-s-num 127))
-;;what??
-;;)
-(t
-w3-p-s-num)))))
 ((looking-at "&#\\(re\\|rs\\|space\\|tab\\)[\ ;\n]?") ; \n should be \r
 (replace-match (assq (upcase (char-after (+ 3 (point))))
 '(;; *** Strictly speaking, record end should be
 ;; carriage return.
 (?E . "\n") ; RE
 (concat "^&<"
 (w3-invalid-sgml-chars)
 (if w3-p-d-null-end-tag-enabled "/" "")
 (if w3-p-d-in-parsed-marked-section "]" "")
 (or w3-p-d-shortref-chars ""))))
-;; Modifies free variable:
-;;   w3-p-d-parse-tag-stream-tail-pointer
-(defsubst w3-add-display-item (tag value)
-(setcdr w3-p-d-parse-tag-stream-tail-pointer
-(list (cons tag value)))
-(setq w3-p-d-parse-tag-stream-tail-pointer
-(cdr w3-p-d-parse-tag-stream-tail-pointer)))
 )
 (eval-when-compile
 (w3-p-s-var-def w3-p-s-overrides)
 (w3-p-s-var-def w3-p-s-undo-list)
 ;;   w3-p-d-current-element, w3-p-d-open-element-stack
 ;; Destroys free variables:
 ;;   w3-p-s-overrides, w3-p-s-undo-list, w3-p-s-var
 (defsubst w3-open-element (tag attributes)
-;; Send trailing data character item in the old current element to
-;; display engine.
-(if (stringp (car-safe (w3-element-content w3-p-d-current-element)))
-(w3-add-display-item
-'text
-(car-safe (w3-element-content w3-p-d-current-element))))
 ;; Push new element on stack.
 (setq w3-p-d-open-element-stack (cons w3-p-d-current-element
 w3-p-d-open-element-stack))
 (setq w3-p-d-current-element (w3-fresh-element-for-tag tag))
 (if (eq 'XINHERIT (w3-element-content-model w3-p-d-current-element))
 (w3-set-element-content-model
 w3-p-d-current-element
 (w3-element-content-model (car w3-p-d-open-element-stack))))
-;; Send the start-tag and attributes to the display engine.
+)
-(if (memq tag '(plaintext style xmp textarea))
-;; Garbage special-casing for old display engine.
-;; Nothing is sent until end-tag is found.
-;; The DTD will ensure no subelements of these elements.
-nil
-;; Normal procedure.
-(w3-add-display-item tag attributes)))
 )
 ;; The protocol for handing items to the display engine is as follows.
 ;;
 ;; For an element, send (START-TAG . ATTS), each member of the content,
 ;; any trailing data character item to display engine.
 (setq w3-p-s-content (w3-element-content w3-p-d-current-element))
 (cond ((null w3-p-s-content))
 ((equal "\n" (car w3-p-s-content))
 (setq w3-p-s-content (cdr w3-p-s-content)))
-((and (stringp (car w3-p-s-content))
+)
-;; Garbage special-casing for old display engine.
-(not (memq w3-p-s-end-tag
-'(/plaintext /style /xmp /textarea))))
-(w3-add-display-item 'text (car w3-p-s-content))))
-;; Send the end-tag to the display engine, but only if the element is
+(cond ;; *** Handle LISTING the way the old parser did.
-;; allowed to have an end tag.
-(cond ((memq w3-p-s-end-tag '(/plaintext /style /xmp /textarea))
-;; Garbage special-casing for old display engine.
-;; Format old display engine expects for these elements:
-;;   (START-TAG . ((data . DATA-CHARACTERS) . ATTRIBUTES))
-(w3-add-display-item
-;; Use the *start*-tag, not the end-tag.
-(w3-element-name w3-p-d-current-element)
-(cons (cons 'data
-(condition-case nil
-(mapconcat 'identity w3-p-s-content "")
-(error "eeek!  subelement content!")))
-(w3-element-attributes w3-p-d-current-element))))
-;; *** Handle LISTING the way the old parser did.
 ((eq 'EMPTY (w3-element-content-model w3-p-d-current-element))
 ;; Do nothing, can't have an end tag.
 )
 (t
 ;; Normal case.
-(w3-add-display-item w3-p-s-end-tag nil)
 (if (null w3-p-s-content)
 (w3-debug-html
 :bad-style :outer
 ;; Don't warn for empty TD elements or empty A elements
 ;; with no HREF attribute.
 ;; client-side imagemaps
 (%imagemaps . (area map))
 ;; special action is taken for %text inside %body.content in the
 ;; content model of each element.
-(%body.content . (%heading %block hr div address %imagemaps))
+(%body.content . (%heading %block style hr div address %imagemaps))
 (%heading . (h1 h2 h3 h4 h5 h6))
 ;; Emacs-w3 extensions
 (%emacsw3-crud  . (pinhead flame cookie yogsothoth hype peek))
-(%block . (p %list dl form %preformatted font
+(%block . (p %list dl form %preformatted
 %blockquote isindex fn table fig note
 center %block-deprecated %block-obsoleted))
 (%list . (ul ol))
 (%preformatted . (pre))
 (%blockquote . (bq))
 ;; Why is IMG in this list?
 (%pre.exclusion . (*include img *discard tab math big small sub sup))
 (%text . (*data b %notmath sub sup %emacsw3-crud))
 (%notmath . (%special %font %phrase %misc))
-(%font . (i u s strike tt big small sub sup
+(%font . (i u s strike tt big small sub sup font
 roach secret wired)) ;; B left out for MATH
 (%phrase . (em strong dfn code samp kbd var cite blink))
-(%special . (a img applet font br script map math tab))
+(%special . (a img applet object font basefont br script style map math tab span bdo))
 (%misc . (q lang au person acronym abbrev ins del))
 (%formula . (*data %math))
 (%math . (box above below %mathvec root sqrt array sub sup
 %mathface))
 ;; I haven't bothered to enumerate them.
 (*close))])
 (end-tag-omissible . t))
 ;; SCRIPT - - (#PCDATA)
 ((script)
-(content-model . CDATA          ; not official, but allows
+(content-model . XCDATA         ; not official, but allows
-; comment hiding of script
+; comment hiding of script, and also
+; idiots that use '</' in scripts.
 ))
 ;; TITLE - - (#PCDATA)
 ((title)
 (content-model . RCDATA         ; not official
 ;; [((*data) include-space nil nil)]
 ((%heading)
 (content-model . [((%text)
 include-space
 ((%in-text-ignore))
 nil)]))
+((span bdo)
+(content-model . [((%text)
+include-space
+nil
+nil)])
+)
 ((p)
 (content-model . [((%text)
 include-space
 nil
 ;; *** Should only close if tag can
 ;; Push <P> before data characters.  Very non-SGML.
 (((%text) p)
 ((credit) *close))
 nil)])
 (end-tag-omissible . t))
-((%emacsw3-crud)
+((%emacsw3-crud basefont)
 (content-model . EMPTY))
 ;; FORM - - %body.content -(FORM) +(INPUT|KEYGEN|SELECT|TEXTAREA)
 ((form)
 ;; Same as BODY.  Ugh!
 (content-model . [((%body.content)
 nil)]))
 ((frame)
 (content-model . EMPTY))
 ;;
 ;; APPLET is a Java thing.
+;; OBJECT is a cougar thing
 ;; <URL:http://java.sun.com/JDK-beta/filesinkit/README>
-((applet)
+((applet object)
 ;; I really don't want to add another ANY content-model.
 (content-model . XINHERIT)
 (inclusions . (param)))
 ((param)
 (content-model . EMPTY))
 (w3-p-s-var-def w3-p-s-state-transitions)
 (w3-p-s-var-def w3-p-s-transition)
 (w3-p-s-var-def w3-p-s-tran-list)
 (w3-p-s-var-def w3-p-s-content-model)
 (w3-p-s-var-def w3-p-s-except)
+(w3-p-s-var-def w3-p-s-baseobject)
+(w3-p-s-var-def w3-p-s-btdt)
 ;; Uses free variables:
 ;;   w3-p-d-current-element, w3-p-d-exceptions
 ;; Destroys free variables:
 ;;   w3-p-s-includep, w3-p-s-state-transitions, w3-p-s-transition,
 ;;   w3-p-s-tran-list, w3-p-s-content-model, w3-p-s-except
 (w3-element-content-model w3-p-d-current-element)))
 (or (and (memq w3-p-s-content-model
 '(CDATA RCDATA XCDATA XXCDATA))
 (memq tag-name '(*data *space)))
 ;; *** Implement ANY.
-(error "impossible"))
+(error "impossible content model lossage"))
 (setq w3-p-s-includep t)
 ;; Exit loop.
 nil)
 (t
 ;; We have a complex content model.
 (w3-open-element (car w3-p-s-transition) nil)
 ;; Now we loop and try again in the new element's
 ;; content-model.
 t)
 (t
-(error "impossible")))))))
+(error "impossible transition")))))))
 ;; Empty while loop body.
 )
 ;; Return value to user indicating whether to include or discard item:
 ;; %                                                    %
 ;; % This is the *ONLY* valid entry point in this file! %
 ;; %       DO NOT call any of the other functions!      %
 ;; %                                                    %
 ;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-(defun w3-parse-buffer (&optional buff nodraw)
+(defun w3-parse-buffer (&optional buff)
 "Parse contents of BUFF as HTML.
 BUFF defaults to the value of url-working-buffer.
 Destructively alters contents of BUFF.
-Unless optional second argument NODRAW is non-nil, calls the display
-engine on the parsed HTML.
 Returns a data structure containing the parsed information."
 (set-buffer (or buff url-working-buffer))
 (setq buff (current-buffer))
 (set-syntax-table w3-sgml-md-syntax-table)
 (goto-char (point-min))
 ;; *** Should premunge line boundaries.
 ;; ********************
-;; Prepare another buffer to draw in unless told not to.
-(if (not nodraw)
-(w3-prepare-draw-buffer-for-parse-buffer))
 (let* (
 ;; Speed hack, see the variable doc string.
 (gc-cons-threshold (if (> w3-gc-cons-threshold-multiplier 0)
 (* w3-gc-cons-threshold-multiplier
 gc-cons-threshold)
 (format "Parsed %%3d%%%% of %d..." (- (point-max) (point-min)))))
 ;; Use a float value for 100 if possible, otherwise integer.
 ;; Determine which we can use outside of the loop for speed.
 (one-hundred (funcall (if (fboundp 'float) 'float 'identity) 100))
-;; Speed up checking whether to do incremental display.
-(w3-do-incremental-display (if nodraw nil w3-do-incremental-display))
-;; Used to convert parse tree to tag stream that old display
-;; engine expects.  Will change when display engine is rewritten.
-(parse-tag-stream '(*dummy))
-;; See doc string.
-(w3-p-d-parse-tag-stream-tail-pointer parse-tag-stream)
-;; Points to cons cell in parse-tag-stream whose car is the last
-;; item that has been sent to display engine.
-(parse-tag-stream-last-displayed-item parse-tag-stream)
 ;; The buffer which contains the HTML we are parsing.  This
 ;; variable is used to avoid using the more expensive
 ;; save-excursion.
 (parse-buffer (current-buffer))
 ;; Scratch variables used in this function
 ref attr-name attr-value content-model content open-list
 )
 ;; Scratch variables used by macros and defsubsts we call.
 (w3-p-s-let-bindings
 (w3-update-non-markup-chars)
+(setq w3-p-s-baseobject (url-generic-parse-url (url-view-url t)))
 ;; Main loop.  Handle markup as follows:
 ;;
 ;; non-empty tag: Handle the region since the previous tag as PCDATA,
 ;; RCDATA, CDATA, if allowed by syntax.  Then handle the tag.
 ;;
 (setq last-loop-start (point)))
 ;; Display progress messages if asked and/or do incremental display
 ;; of results
 (cond ((= 0 (% (setq loop-count (1+ loop-count)) 40))
-(if w3-do-incremental-display
-(w3-pause))
 (if status-message-format
 (message status-message-format
 ;; Percentage of buffer processed.
 (/ (* (point) one-hundred) (point-max))))))
 (forward-char)
 (cond
 ((looking-at "/?\\([a-z][-a-z0-9.]*\\)")
 ;; We are looking at a non-empty tag.
+;; Downcase it in the buffer, to save creation of a string
+(downcase-region (match-beginning 1) (match-end 1))
 (setq w3-p-d-tag-name
-(intern (downcase (buffer-substring (match-beginning 1)
+(intern (buffer-substring (match-beginning 1)
-(match-end 1)))))
+(match-end 1))))
 (setq w3-p-d-end-tag-p (= ?/ (following-char)))
 (setq between-tags-end (1- (point)))
 (goto-char (match-end 0))
 ;; Read the attributes from a start-tag.
-(or
+(if w3-p-d-end-tag-p
-w3-p-d-end-tag-p
+(if (looking-at "[ \t\r\n/]*>")
+nil
+;; This is in here to deal with those idiots who stick
+;; attribute/value pairs on end tags.  *sigh*
+(w3-debug-html "Evil attributes on end tag.")
+(skip-chars-forward "^>"))
 ;; Attribute values can be:
 ;;   "STRING"   where STRING does not contain the double quote
 ;;   'STRING'   where STRING does not contain the single quote
 ;;   name-start character, *name character
 (concat
 ;; Leading whitespace.
 "[ \n\r\t]*"
 ;; The attribute name, possibly with a bad syntax
 ;; component.
-"\\([a-z][-a-z0-9.]*\\(\\([_][-a-z0-9._]*\\)?\\)\\)"
+"\\([a-z_][-a-z0-9.]*\\(\\([_][-a-z0-9._]*\\)?\\)\\)"
 ;; Trailing whitespace and perhaps an "=".
 "[ \n\r\t]*\\(\\(=[ \n\r\t]*\\)?\\)")))
 (cond ((/= (match-beginning 2) (match-end 2))
 (w3-debug-html
 :nocontext
 (format "Bad attribute name syntax: %s"
 (buffer-substring (match-beginning 1)
 (match-end 1))))))
+;; Downcase it in the buffer, to save creation of a string
+(downcase-region (match-beginning 1) (match-end 1))
 (setq attr-name
-(intern (downcase (buffer-substring (match-beginning 1)
+(intern (buffer-substring (match-beginning 1)
-(match-end 1)))))
+(match-end 1))))
 (goto-char (match-end 0))
 (cond
 ((< (match-beginning 4) (match-end 4))
 ;; A value was specified (e.g. ATTRIBUTE=VALUE).
 (cond
 (concat
 ;; Literal with double quotes.
 "\"\\([^\"]*\\)\""
 "\\|"
 ;; Literal with single quotes.
-"'\\([^']\\)*'"
+"'\\([^']*\\)'"
 "\\|"
 ;; Handle bad HTML conflicting with NET-enabling
 ;; start-tags.
 "\\([-a-z0-9.]+/[-a-z0-9._/#]+\\)[ \t\n\r>]"
 "\\|"
 (goto-char (point-min))
 (while (progn
 (skip-chars-forward "^&")
 (not (eobp)))
 (w3-expand-entity-at-point-maybe))
-(subst-char-in-region (point-min) (point-max) ?\t 32)
+(subst-char-in-region (point-min) (point-max) ?\t ? )
-(subst-char-in-region (point-min) (point-max) ?\n 32))
+(subst-char-in-region (point-min) (point-max) ?\n ? ))
 ;; Set this after we have changed the size of the
 ;; attribute.
 (setq attribute-value-end (1+ (point-max))))
 ((match-beginning 4)
 (setq attribute-value-end (match-end 4))
 (match-end 3)))
 (w3-debug-html :nocontext
 (format "Evil attribute value syntax: %s"
 (buffer-substring (point-min) (point-max)))))
 (t
-(error "impossible"))))
+(error "impossible attribute value"))))
 ((memq (following-char) '(?\" ?'))
 ;; Missing terminating quote character.
 (narrow-to-region (point)
 (progn
 (forward-char 1)
-(skip-chars-forward "^ \t\n\r'\"=<>")
+(skip-chars-forward "^ \t\n\r'\"<>")
 (setq attribute-value-end (point))))
 (w3-debug-html :nocontext
 (format "Attribute value missing end quote: %s"
 (buffer-substring (point-min) (point-max))))
 (narrow-to-region (1+ (point-min)) (point-max)))
 (t
 ;; We have a syntactically invalid attribute value.  Let's
 ;; make a best guess as to what the author intended.
 (narrow-to-region (point)
 (progn
-(skip-chars-forward "^ \t\n\r'\"=<>")
+(skip-chars-forward "^ \t\n\r'\"<>")
 (setq attribute-value-end (point))))
 (w3-debug-html :nocontext
 (format "Bad attribute value syntax: %s"
 (buffer-substring (point-min) (point-max))))))
 ;; Now we have isolated the attribute value.  We need to
 ;; * smash case
 ;; * remove leading/trailing whitespace
 ;; * smash multiple space sequences into single spaces
 ;; * verify the syntax of each token
 (setq attr-value (buffer-substring (point-min) (point-max)))
+(case attr-name
+(class
+(setq attr-value (split-string attr-value "[ ,]+")))
+(align
+(if (string-match "^[ \t\r\n]*\\(.*\\)[ \t\r\n]*$"
+attr-value)
+(setq attr-value (downcase
+(substring attr-value
+(match-beginning 1)
+(match-end 1))))
+(setq attr-value (downcase attr-value)))
+(setq attr-value (intern attr-value)))
+((src href)
+;; I should expand URLs here
+)
+(otherwise nil)
+)
 (widen)
 (goto-char attribute-value-end))
 (t
 ;; No value was specified, in which case NAME should be
 ;; taken as ATTRIBUTE=NAME where NAME is one of the
 ;; is wrong.
 (setq attr-value (symbol-name attr-name))))
 ;; Accumulate the attributes.
 (setq tag-attributes (cons (cons attr-name attr-value)
-tag-attributes))))
+tag-attributes)))
+(cond
+((and (eq w3-p-d-tag-name 'base)
+(setq w3-p-s-baseobject
+(or (assq 'src tag-attributes)
+(assq 'href tag-attributes))))
+(setq w3-p-s-baseobject (url-generic-parse-url
+(cdr w3-p-s-baseobject))))
+((setq w3-p-s-btdt (or (assq 'src tag-attributes)
+(assq 'href tag-attributes)
+(assq 'action tag-attributes)))
+(setcdr w3-p-s-btdt (url-expand-file-name (cdr w3-p-s-btdt)
+w3-p-s-baseobject))
+(setq w3-p-s-btdt (if (url-have-visited-url (cdr w3-p-s-btdt))
+":visited"
+":link"))
+(if (assq 'class tag-attributes)
+(setcdr (assq 'class tag-attributes)
+(cons w3-p-s-btdt
+(cdr (assq 'class tag-attributes))))
+(setq tag-attributes (cons (cons 'class (list w3-p-s-btdt))
+tag-attributes))))
+)
+)
 ;; Process the end of the tag.
 (skip-chars-forward " \t\n\r")
 (cond ((= ?> (following-char))
 ;; Ordinary tag end.
 ((memq 'INCLUDE keywords))
 ((memq 'TEMP keywords))))))
 (or (= ?\[ (following-char))
 ;; I probably shouldn't even check this, since it is so
 ;; impossible.
-(error "impossible"))
+(error "impossible ??"))
 (forward-char 1)
 (delete-region (1- (match-beginning 0)) (point))
 (cond ((eq 'IGNORE keyword)
 ;; Scan forward skipping over matching <![ ... ]]>
 ;; until we find an unmatched "]]>".
 (if (= between-tags-start (point))
 ;; Do nothing.
 nil
 ;; We are definitely going to add data characters to the
 ;; content.
-;; Protocol is that all but last data character item
-;; must have been sent to display engine.
-(and content
-(stringp (car content))
-;; Gross, disgusting hack to deal with old interface
-;; to display engine.  Remove as soon as possible.
-(not (memq (w3-element-name w3-p-d-current-element)
-'(plaintext style xmp textarea)))
-(w3-add-display-item 'text (car content)))
 (cond
 ((and (= ?\n (preceding-char))
 (/= between-tags-start (1- (point))))
 (setq content (cons (buffer-substring between-tags-start
 (1- (point)))
 content))
-;; Gross, disgusting hack to deal with old interface
-;; to display engine.  Remove as soon as possible.
-(or (memq (w3-element-name w3-p-d-current-element)
-'(plaintext style xmp textarea))
-(w3-add-display-item 'text (car content)))
 (setq content (cons "\n" content)))
 (t
 (setq content (cons (buffer-substring between-tags-start
 (point))
 content))))
 (setq w3-p-d-end-tag-p nil)
 (setq net-tag-p nil)
 (setq tag-attributes nil)
 (setq tag-end nil)))
-;; Hand items to the display engine.
-(cond ((not nodraw)
-(set-buffer w3-draw-buffer)
-(while (not (eq parse-tag-stream-last-displayed-item
-w3-p-d-parse-tag-stream-tail-pointer))
-(setq parse-tag-stream-last-displayed-item
-(cdr parse-tag-stream-last-displayed-item))
-;; We call w3-handle-single-tag from only one spot so that it
-;; is reasonable to inline it, since it is a big function.
-(w3-handle-single-tag
-(car (car parse-tag-stream-last-displayed-item))
-(cdr (car parse-tag-stream-last-displayed-item))))
-(set-buffer parse-buffer)))
 ;; End of main while loop.
 )
 ;; We have finished parsing the buffer!
 (if status-message-format
 (message "%sdone" (format status-message-format 100)))
-;; Do this now so the user can see the full results before Emacs
-;; goes off and garbage-collects for an hour.  :-(
-(if w3-do-incremental-display
-(w3-pause))
 ;; *** For debugging, save the true parse tree.
 ;; *** Make this look inside *DOCUMENT.
 (setq w3-last-parse-tree
 (w3-element-content w3-p-d-current-element))
-;; Return the parse in the format expected, a stream of tags
+(w3-element-content w3-p-d-current-element)
-;; possibly with a buffer at the front.
-(if nodraw
-;; Discard the *dummy item at start of list.
-(cdr parse-tag-stream)
-(cons w3-draw-buffer (cdr parse-tag-stream)))
 )))
-;;;
-;;; Initialization of display engine to accept parser output.
-;;;
-(defun w3-prepare-draw-buffer-for-parse-buffer ()
-(setq list-buffers-directory nil)
-(let ((buf (get-buffer-create (url-generate-new-buffer-name
-"Untitled")))
-(info (mapcar (function (lambda (x) (cons x (symbol-value x))))
-w3-persistent-variables)))
-(setq w3-draw-buffer buf)
-(save-excursion
-(set-window-buffer (selected-window) buf)
-(set-buffer buf)
-(setq w3-draw-buffer (current-buffer))
-(erase-buffer)
-(buffer-disable-undo (current-buffer))
-(mapcar (function (lambda (x) (set (car x) (cdr x)))) info)
-(setq w3-last-fill-pos (point))
-(setq fill-column (min (- (or w3-strict-width (window-width))
-w3-right-border)
-(or w3-maximum-line-length (window-width))))
-(setq fill-prefix "")
-(w3-init-state))))
 (provide 'w3-parse)

Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-parse.el @ 80:1ce6082ce73f r20-0b90