diff lisp/w3/w3-display.el @ 14:9ee227acff29 r19-15b90

Import from CVS: tag r19-15b90
author cvs
date Mon, 13 Aug 2007 08:48:42 +0200
parents
children 0293115a14e9 6a378aca36af
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/w3/w3-display.el	Mon Aug 13 08:48:42 2007 +0200
@@ -0,0 +1,1866 @@
+;;; w3-display.el --- display engine v99999
+;; Author: wmperry
+;; Created: 1997/01/02 20:20:45
+;; Version: 1.90
+;; Keywords: faces, help, hypermedia
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu)
+;;; Copyright (c) 1996 Free Software Foundation, Inc.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; 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 GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(require 'cl)
+(require 'css)
+(require 'font)
+(require 'w3-widget)
+(require 'w3-imap)
+
+(defmacro w3-d-s-var-def (var)
+  (` (make-variable-buffer-local (defvar (, var) nil))))
+
+(w3-d-s-var-def w3-display-open-element-stack)
+(w3-d-s-var-def w3-display-alignment-stack)
+(w3-d-s-var-def w3-display-list-stack)
+(w3-d-s-var-def w3-display-form-stack)
+(w3-d-s-var-def w3-display-whitespace-stack)
+(w3-d-s-var-def w3-display-font-family-stack)
+(w3-d-s-var-def w3-display-font-weight-stack)
+(w3-d-s-var-def w3-display-font-variant-stack)
+(w3-d-s-var-def w3-display-font-size-stack)
+(w3-d-s-var-def w3-face-color)
+(w3-d-s-var-def w3-face-background)
+(w3-d-s-var-def w3-active-faces)
+(w3-d-s-var-def w3-active-voices)
+(w3-d-s-var-def w3-current-form-number)
+(w3-d-s-var-def w3-face-font-family)
+(w3-d-s-var-def w3-face-font-weight)
+(w3-d-s-var-def w3-face-font-variant)
+(w3-d-s-var-def w3-face-font-size)
+(w3-d-s-var-def w3-face-font-family)
+(w3-d-s-var-def w3-face-font-size)
+(w3-d-s-var-def w3-face-font-spec)
+(w3-d-s-var-def w3-face-text-decoration)
+(w3-d-s-var-def w3-face-face)
+(w3-d-s-var-def w3-face-descr)
+(w3-d-s-var-def w3-face-pixmap)
+(w3-d-s-var-def w3-display-css-properties)
+
+(eval-when-compile
+  (defmacro w3-get-attribute (attr)
+    (` (cdr-safe (assq (, attr) args))))
+  
+  (defmacro w3-get-face-info (info)
+    (let ((var (intern (format "w3-face-%s" info))))
+      (` (push (w3-get-style-info (quote (, info)) node (car (, var)))
+	       (, var)))))
+
+  (defmacro w3-pop-face-info (info)
+    (let ((var (intern (format "w3-face-%s" info))))
+      (` (pop (, var)))))
+
+  (defmacro w3-get-all-face-info ()
+    (`
+     (progn
+       (w3-get-face-info font-family)
+       (w3-get-face-info font-weight)
+       (w3-get-face-info font-variant)
+       (w3-get-face-info font-size)
+       (w3-get-face-info text-decoration)
+       ;;(w3-get-face-info pixmap)
+       (w3-get-face-info color)
+       (w3-get-face-info background)
+       (setq w3-face-font-spec (make-font
+				:weight (car w3-face-font-weight)
+				:family (car w3-face-font-family)
+				:size (car w3-face-font-size))))))
+
+  (defmacro w3-pop-all-face-info ()
+    (`
+     (progn
+       (w3-pop-face-info font-family)
+       (w3-pop-face-info font-weight)
+       (w3-pop-face-info font-variant)
+       (w3-pop-face-info font-size)
+       (w3-pop-face-info text-decoration)
+       ;;(w3-pop-face-info pixmap)
+       (w3-pop-face-info color)
+       (w3-pop-face-info background))))
+
+  )
+
+(defvar w3-face-cache nil  "Cache for w3-face-for-element")
+(defvar w3-face-index 0)
+(defvar w3-image-widgets-waiting nil)
+
+(make-variable-buffer-local 'w3-last-fill-pos)
+
+(defconst w3-fill-prefixes-vector
+  (let ((len 0)
+        (prefix-vector (make-vector 80 nil)))
+    (while (< len 80)
+      (aset prefix-vector len (make-string len ? ))
+      (setq len (1+ len)))
+    prefix-vector))
+
+(defconst w3-line-breaks-vector
+  (let ((len 0)
+	(breaks-vector (make-vector 10 nil)))
+    (while (< len 10)
+      (aset breaks-vector len (make-string len ?\n))
+      (setq len (1+ len)))
+    breaks-vector))
+
+(defun w3-pause ()
+  (cond
+   (w3-running-FSF19 (sit-for 0))
+   (w3-running-xemacs
+    (sit-for 0))
+   ;; (if (and (not (sit-for 0)) (input-pending-p))
+   ;;	(condition-case ()
+   ;;	    (dispatch-event (next-command-event))
+   ;;	  (error nil)))
+   (t (sit-for 0))))
+
+(defmacro w3-get-pad-string (len)
+  (` (cond
+      ((< (, len) 0)
+       "")
+      ((< (, len) 80)
+       (aref w3-fill-prefixes-vector (, len)))
+      (t (make-string (, len) ? )))))
+
+(defsubst w3-set-fill-prefix-length (len)
+  (setq fill-prefix (if (< len (- (or w3-strict-width (window-width)) 4))
+			(w3-get-pad-string len)
+		      (url-warn
+		       'html
+		       "Runaway indentation!  Too deep for window width!")
+		      fill-prefix)))
+
+(defsubst w3-get-style-info (info node &optional default)
+  (or (cdr-safe (assq info w3-display-css-properties)) default))
+
+(defun w3-decode-area-coords (str)
+  (let (retval)
+    (while (string-match "\\([ \t0-9]+\\),\\([ \t0-9]+\\)" str)
+      (setq retval (cons (vector (string-to-int (match-string 1 str))
+				 (string-to-int (match-string 2 str))) retval)
+	    str (substring str (match-end 0) nil)))
+    (if (string-match "\\([0-9]+\\)" str)
+	(setq retval (cons (vector (+ (aref (car retval) 0)
+				      (string-to-int (match-string 1 str)))
+				   (aref (car retval) 1)) retval)))
+    (nreverse retval)))
+
+(defun w3-normalize-color (color)
+  (cond
+   ((valid-color-name-p color)
+    color)
+   ((valid-color-name-p (concat "#" color))
+    (concat "#" color))
+   ((string-match "[ \t\r\n]" color)
+    (w3-normalize-color
+     (mapconcat (function (lambda (x) (if (memq x '(?\t ?\r ?\n ? )) ""
+					(char-to-string x)))) color "")))
+   ((valid-color-name-p (font-normalize-color color))
+    (font-normalize-color color))
+   (t
+    (w3-warn 'html (format "Bad color specification: %s" color))
+    nil)))
+
+(defsubst w3-voice-for-element (node)
+  (if (featurep 'emacspeak)
+      (let (family gain left right pitch pitch-range stress richness voice)
+	(setq family (w3-get-style-info 'voice-family node)
+	      gain (w3-get-style-info 'gain node)
+	      left (w3-get-style-info 'left-volume node)
+	      right (w3-get-style-info 'right-volume node)
+	      pitch (w3-get-style-info 'pitch node)
+	      pitch-range (w3-get-style-info 'pitch-range node)
+	      stress (w3-get-style-info 'stress node)
+	      richness (w3-get-style-info 'richness node))
+	(if (or family gain left right pitch pitch-range stress richness)
+	    (setq voice (dtk-personality-from-speech-style
+			 (make-dtk-speech-style :family (or family 'paul)
+						:gain (or gain 5)
+						:left-volume (or left 5)
+						:right-volume (or right 5)
+						:average-pitch (or pitch 5)
+						:pitch-range (or pitch-range 5)
+						:stress (or stress 5)
+						:richness (or richness 5))))
+	  (setq voice nil))
+	(or voice (car w3-active-voices)))))
+
+(defun w3-make-face-emacs19 (name &optional doc-string temporary)
+  "Defines and returns a new FACE described by DOC-STRING.
+If the face already exists, it is unmodified.
+If TEMPORARY is non-nil, this face will cease to exist if not in use."
+  (make-face name))
+
+(cond
+ ((not (fboundp 'make-face))
+  (fset 'w3-make-face 'ignore))
+ (w3-running-xemacs
+  (fset 'w3-make-face 'make-face))
+ (t
+  (fset 'w3-make-face 'w3-make-face-emacs19)))
+
+(defsubst w3-face-for-element (node)
+  (w3-get-all-face-info)
+  (if (car w3-face-text-decoration)
+      (set-font-style-by-keywords w3-face-font-spec
+				  (car w3-face-text-decoration)))
+  (if w3-face-font-variant
+      (set-font-style-by-keywords w3-face-font-spec
+				  (car w3-face-font-variant)))
+  (setq w3-face-descr (list w3-face-font-spec
+			    (car w3-face-color)
+			    (car w3-face-background))
+	w3-face-face (cdr-safe (assoc w3-face-descr w3-face-cache)))
+  (if (or w3-face-face (not (or (car w3-face-color)
+				(car w3-face-background)
+				w3-face-font-spec)))
+      nil				; Do nothing, we got it already
+    (setq w3-face-face
+	  (w3-make-face (intern (format "w3-style-face-%05d" w3-face-index))
+			"An Emacs-W3 face... don't edit by hand." t)
+	  w3-face-index (1+ w3-face-index))
+    (if w3-face-font-spec
+	(set-face-font w3-face-face w3-face-font-spec))
+    (if (car w3-face-color)
+	(set-face-foreground w3-face-face (car w3-face-color)))
+    (if (car w3-face-background)
+	(set-face-background w3-face-face (car w3-face-background)))
+    ;;(set-face-background-pixmap w3-face-face w3-face-pixmap)
+    (setq w3-face-cache (cons
+			 (cons w3-face-descr w3-face-face)
+			 w3-face-cache)))
+  w3-face-face)
+
+(defun w3-normalize-spaces (string)
+  ;; nuke spaces in the middle
+  (while (string-match "[ \t\r\n][ \r\t\n]+" string)
+    (setq string (concat (substring string 0 (1+ (match-beginning 0)))
+			 (substring string (match-end 0)))))
+
+  ;; nuke spaces at the beginning
+  (if (string-match "^[ \t\r\n]+" string)
+      (setq string (substring string (match-end 0))))
+
+  ;; nuke spaces at the end
+  (if (string-match "[ \t\n\r]+$" string)
+      (setq string (substring string 0 (match-beginning 0))))
+  string)
+
+(defvar w3-bullets
+  '((disc   . ?*)
+    (circle . ?o)
+    (square . ?#)
+    )
+  "*An assoc list of unordered list types mapping to characters to use
+as the bullet character.")    
+
+
+(defsubst w3-display-line-break (n)
+  (if (or
+       (memq (car w3-display-whitespace-stack) '(pre nowrap)) ; Been told
+       (= w3-last-fill-pos (point))
+       (> w3-last-fill-pos (point-max)))
+      (if (/= (preceding-char) ?\n) (setq n (1+ n))) ; at least put one line in
+    (let ((fill-column (max (1+ (length fill-prefix)) fill-column))
+	  width)
+      (case (car w3-display-alignment-stack)
+	(center
+	 (fill-region-as-paragraph w3-last-fill-pos (point))
+	 (center-region w3-last-fill-pos (point-max)))
+	((justify full)
+	 (fill-region-as-paragraph w3-last-fill-pos (point) t))
+	(right
+	 (fill-region-as-paragraph w3-last-fill-pos (point))
+	 (goto-char w3-last-fill-pos)
+	 (catch 'fill-exit
+	   (while (re-search-forward ".$" nil t)
+	     (if (>= (setq width (current-column)) fill-column)
+		 nil			; already justified, or error
+	       (beginning-of-line)
+	       (insert-char ?  (- fill-column width))
+	       (end-of-line)
+	       (if (eobp)
+		   (throw 'fill-exit t))
+	       (condition-case ()
+		   (forward-char 1)
+		 (error (throw 'fill-exit t))))))
+	 )
+	(otherwise			; Default is left justification
+	 (fill-region-as-paragraph w3-last-fill-pos (point)))
+	))
+    (setq n (1- n)))
+  (setq w3-last-fill-pos (point-max))
+  (insert (cond
+	   ((<= n 0) "")
+	   ((< n 10)
+	    (aref w3-line-breaks-vector n))
+	   (t
+	    (make-string n ?\n)))))
+
+(defsubst w3-munge-line-breaks-p ()
+  (eq (car w3-display-whitespace-stack) 'pre))
+
+(defvar w3-display-nil-face (w3-make-face nil "Stub face... don't ask." t))
+
+(defvar w3-scratch-start-point nil)
+
+(defsubst w3-handle-string-content (string)
+  (setq w3-scratch-start-point (point))
+  (insert string)
+  (if (w3-munge-line-breaks-p)
+      (progn
+	(goto-char w3-scratch-start-point)
+	(if (not (search-forward "\n" nil t))
+	    (subst-char-in-region w3-scratch-start-point (point-max) ?\r ?\n)
+	  (subst-char-in-region w3-scratch-start-point (point-max) ?\r ? )))
+    (goto-char w3-scratch-start-point)
+    (while (re-search-forward
+	    " [ \t\n\r]+\\|[\t\n\r][ \t\n\r]*"
+	    nil 'move)
+      (replace-match " "))
+    (goto-char w3-scratch-start-point)
+    (if (and (memq (preceding-char) '(?  ?\t ?\r ?\n))
+	     (looking-at "[ \t\r\n]"))
+	(delete-region (point)
+		       (progn
+			 (skip-chars-forward " \t\r\n")
+			 (point)))))
+  (goto-char (point-max))
+  (add-text-properties w3-scratch-start-point
+		       (point) (list 'face w3-active-faces 'duplicable t))
+  (if (car w3-active-voices)
+      (add-text-properties w3-scratch-start-point (point)
+			   (list 'personality (car w3-active-voices))))
+  )
+
+(defun w3-widget-echo (widget &rest ignore)
+  (let ((href (widget-get widget 'href))
+	(name (widget-get widget 'name))
+	(text (buffer-substring (widget-get widget :from)
+				(widget-get widget :to)))
+	(title (widget-get widget 'title))
+	(msg nil))
+    (if href
+	(setq href (url-truncate-url-for-viewing href)))
+    (if name
+	(setq name (concat "anchor:" name)))
+    (case w3-echo-link
+      (url (or href title text name))
+      (text (or text title href name))
+      (title (or title text href name))
+      (otherwise nil))))
+
+(defun w3-follow-hyperlink (widget &rest ignore)
+  (let* ((target (widget-get widget 'target))
+	 (href (widget-get widget 'href)))
+    (if target (setq target (intern (downcase target))))
+    (case target
+      ((_blank external)
+       (w3-fetch-other-frame href))
+      (_top
+       (delete-other-windows)
+       (w3-fetch href))
+      (otherwise
+       (w3-fetch href)))))
+
+(defun w3-balloon-help-callback (object &optional event)
+  (let* ((widget (widget-at (extent-start-position object)))
+	 (href (and widget (widget-get widget 'href))))
+    (if href
+	(url-truncate-url-for-viewing href)
+      nil)))
+
+
+;; Various macros
+(eval-when-compile
+  (defmacro w3-expand-url (url)
+    (`
+     (url-expand-file-name (, url)
+			   (cdr-safe
+			    (assoc
+			     (cdr-safe
+			      (assq 'base args)) w3-base-alist)))))
+
+  (defmacro w3-handle-empty-tag ()
+    (`
+     (progn
+       (push (cons tag args) w3-display-open-element-stack)
+       (push content content-stack)
+       (setq content nil))))
+
+  (defmacro w3-handle-content (node)
+    (`
+     (progn
+       (push (cons tag args) w3-display-open-element-stack)
+       (push content content-stack)
+       (setq content (nth 2 node)))))
+
+  (defmacro w3-display-handle-list-type ()
+    (`
+     (case (car break-style)
+       (list-item
+	(let ((list-style (w3-get-style-info 'list-style node))
+	      (list-num (if (car w3-display-list-stack)
+			    (incf (car w3-display-list-stack))
+			  1))
+	      (margin (1- (car left-margin-stack)))
+	      (indent (w3-get-style-info 'text-indent node 0)))
+	  (if (> indent 0)
+	      (setq margin (+ margin indent))
+	    (setq margin (max 0 (- margin indent))))
+	  (beginning-of-line)
+	  (case list-style
+	    ((disc circle square)
+	     (insert (format (format "%%%dc" margin)
+			     (or (cdr-safe (assq list-style w3-bullets))
+				 ?o))))
+	    ((decimal lower-roman upper-roman lower-alpha upper-alpha)
+	     (let ((x (case list-style
+			(lower-roman
+			 (w3-decimal-to-roman list-num))
+			(upper-roman
+			 (upcase
+			  (w3-decimal-to-roman list-num)))
+			(lower-alpha
+			 (w3-decimal-to-alpha list-num))
+			(upper-alpha
+			 (upcase
+			  (w3-decimal-to-alpha list-num)))
+			(otherwise
+			 (int-to-string list-num)))))
+	       (insert (format (format "%%%ds." margin) x))
+	       )
+	     )
+	    (otherwise
+	     (insert (w3-get-pad-string margin)))
+	    )
+	  )
+	)
+       (otherwise
+	(insert (w3-get-pad-string (+ (car left-margin-stack)
+				      (w3-get-style-info 'text-indent node 0)))))
+       )
+     )
+    )
+
+  (defmacro w3-display-set-margins ()
+    (`
+     (progn
+       (push (+ (w3-get-style-info 'margin-left node 0)
+		(car left-margin-stack)) left-margin-stack)
+       (push (-
+	      (car right-margin-stack)
+	      (w3-get-style-info 'margin-right node 0)) right-margin-stack)
+       (setq fill-column (car right-margin-stack))
+       (w3-set-fill-prefix-length (car left-margin-stack))
+       (w3-display-handle-list-type))))
+
+  (defmacro w3-display-restore-margins ()
+    (`
+     (progn
+       (pop right-margin-stack)
+       (pop left-margin-stack))))
+
+  (defmacro w3-display-handle-break ()
+    (`
+     (case (car break-style)
+       (block				; Full paragraph break
+	(if (eq (cadr break-style) 'list-item)
+	    (setf (cadr break-style) 'line)
+	  (w3-display-line-break 1))
+	(w3-display-set-margins)
+	(push
+	 (w3-get-style-info 'white-space node
+			    (car w3-display-whitespace-stack))
+	 w3-display-whitespace-stack)
+	(push
+	 (or (w3-get-attribute 'align)
+	     (w3-get-style-info 'text-align node
+				(car w3-display-alignment-stack)))
+	 w3-display-alignment-stack)
+	(and w3-do-incremental-display (w3-pause)))
+       ((line list-item)		; Single line break
+	(w3-display-line-break 0)
+	(w3-display-set-margins)
+	(push
+	 (w3-get-style-info 'white-space node
+			    (car w3-display-whitespace-stack))
+	 w3-display-whitespace-stack)
+	(push
+	 (w3-get-style-info 'text-align node
+			    (or (w3-get-attribute 'align)
+				(car w3-display-alignment-stack)))
+	 w3-display-alignment-stack))
+       (otherwise			; Assume 'inline' rendering as default
+	nil))
+     )
+    )
+
+  (defmacro w3-display-handle-end-break ()
+    (`
+     (case (pop break-style)
+       (block				; Full paragraph break
+	(w3-display-line-break 1)
+	(w3-display-restore-margins)
+	(pop w3-display-whitespace-stack)
+	(pop w3-display-alignment-stack)
+	(and w3-do-incremental-display (w3-pause)))
+       ((line list-item)		; Single line break
+	(w3-display-restore-margins)
+	(w3-display-line-break 0)
+	(pop w3-display-whitespace-stack)
+	(pop w3-display-alignment-stack))      
+       (otherwise			; Assume 'inline' rendering as default
+	nil))
+     )
+    )
+  )
+
+;; <link> handling
+(defun w3-parse-link (args)
+  (let* ((type (if (w3-get-attribute 'rel) 'rel 'rev))
+	 (desc (w3-get-attribute type))
+	 (dc-desc (and desc (downcase desc))) ; canonical case
+	 (dest (w3-get-attribute 'href))
+	 (plist (alist-to-plist args))
+	 (node-1 (assq type w3-current-links))
+	 (node-2 (and node-1 desc (or (assoc desc
+					     (cdr node-1))
+				      (assoc dc-desc
+					     (cdr node-1)))))
+	 )
+    ;; Canonicalize the case of link types we may look for
+    ;; specifically (toolbar etc.) since that's done with
+    ;; assoc.  See `w3-mail-document-author' and
+    ;; `w3-link-toolbar', at least.
+    (if (member dc-desc w3-defined-link-types)
+	(setq desc dc-desc))
+    (if dest				; ignore if HREF missing
+	(cond
+	 (node-2			; Add to old value
+	  (setcdr node-2 (cons plist (cdr node-2))))
+	 (node-1			; first rel/rev
+	  (setcdr node-1 (cons (cons desc (list plist))
+			       (cdr node-1))))
+	 (t (setq w3-current-links
+		  (cons (cons type (list (cons desc (list plist))))
+			w3-current-links)))))
+    (setq desc (and desc (intern dc-desc)))
+    (case desc
+      ((style stylesheet)
+       (w3-handle-style args))
+      (otherwise
+       )
+      )
+    )
+  )
+
+
+;; Image handling
+(defun w3-maybe-start-image-download (widget)
+  (let* ((src (widget-get widget 'src))
+	 (cached-glyph (w3-image-cached-p src)))
+    (if (and cached-glyph (widget-glyphp cached-glyph))
+	(setq w3-image-widgets-waiting (cons widget w3-image-widgets-waiting))
+      (cond
+       ((or w3-delay-image-loads	; Delaying images
+	    (not (fboundp 'valid-specifier-domain-p)) ; Can't do images
+	    (eq (device-type) 'tty))	; Why bother?
+	(w3-add-delayed-graphic widget))
+       ((not (w3-image-loadable-p src nil)) ; Hey, we can't load it!
+	(w3-warn 'images (format "Skipping image %s" (url-basepath src t)))
+	(w3-add-delayed-graphic widget))
+       (t				; Grab the images
+	(let (
+	      (url-request-method "GET")
+	      (old-asynch url-be-asynchronous)
+	      (url-request-data nil)
+	      (url-request-extra-headers nil)
+	      (url-source t)
+	      (url-mime-accept-string (substring
+				       (mapconcat
+					(function
+					 (lambda (x)
+					   (if x
+					       (concat (car x) ",")
+					     "")))
+					w3-allowed-image-types "")
+				       0 -1))
+	      (url-working-buffer (generate-new-buffer-name " *W3GRAPH*")))
+	  (setq-default url-be-asynchronous t)
+	  (setq w3-graphics-list (cons (cons src (make-glyph))
+				       w3-graphics-list))
+	  (save-excursion
+	    (set-buffer (get-buffer-create url-working-buffer))
+	    (setq url-current-callback-data (list widget)
+		  url-be-asynchronous t
+		  url-current-callback-func 'w3-finalize-image-download)
+	    (url-retrieve src))
+	  (setq-default url-be-asynchronous old-asynch)))))))
+
+(defun w3-finalize-image-download (widget)
+  (let ((glyph nil)
+	(url (widget-get widget 'src))
+	(node nil)
+	(buffer (widget-get widget 'buffer)))
+    (message "Enhancing image...")
+    (setq glyph (image-normalize (cdr-safe (assoc url-current-mime-type
+						  w3-image-mappings))
+				 (buffer-string)))
+    (message "Enhancing image... done")
+    (kill-buffer (current-buffer))
+    (cond
+     ((w3-image-invalid-glyph-p glyph)
+      (setq glyph nil)
+      (w3-warn 'image (format "Reading of %s failed." url)))
+     ((eq (aref glyph 0) 'xbm)
+      (let ((temp-fname (url-generate-unique-filename "%s.xbm")))
+	(save-excursion
+	  (set-buffer (generate-new-buffer " *xbm-garbage*"))
+	  (erase-buffer)
+	  (insert (aref glyph 2))
+	  (setq glyph temp-fname)
+	  (write-region (point-min) (point-max) temp-fname)
+	  (kill-buffer (current-buffer)))
+	(setq glyph (make-glyph (list (cons 'x glyph))))
+	(condition-case ()
+	    (delete-file temp-fname)
+	  (error nil))))
+     (t
+      (setq glyph (make-glyph glyph))))
+    (setq node (assoc url w3-graphics-list))
+    (cond
+     ((and node glyph)
+      (set-glyph-image (cdr node) (glyph-image glyph)))
+     (glyph
+      (setq w3-graphics-list (cons (cons url glyph) w3-graphics-list)))
+     (t nil))
+
+    (if (and (buffer-name buffer)	; Dest. buffer exists
+	     (widget-glyphp glyph))	; got a valid glyph
+	(save-excursion
+	  (set-buffer buffer)
+	  (if (eq major-mode 'w3-mode)
+	      (widget-value-set widget glyph)
+	    (setq w3-image-widgets-waiting
+		  (cons widget w3-image-widgets-waiting)))))))
+
+(defmacro w3-node-visible-p ()
+  (` (not (eq (car break-style) 'none))))
+
+(defmacro w3-handle-image ()
+  (`
+   (let* ((height (w3-get-attribute 'height))
+	  (width (w3-get-attribute 'width))
+	  (src (or (w3-get-attribute 'src) "Error Image"))
+	  (our-alt (cond
+		    ((null w3-auto-image-alt) "")
+		    ((eq t w3-auto-image-alt)
+		     (concat "[IMAGE(" (url-basepath src t) ")] "))
+		    ((stringp w3-auto-image-alt)
+		     (format w3-auto-image-alt (url-basepath src t)))))
+	  (alt (or (w3-get-attribute 'alt) our-alt))
+	  (ismap (and (assq 'ismap args) 'ismap))
+	  (usemap (w3-get-attribute 'usemap))
+	  (base (w3-get-attribute 'base))
+	  (href (and hyperlink-info (widget-get (cadr hyperlink-info) 'href)))
+	  (widget nil)
+	  (align (or (w3-get-attribute 'align)
+		     (w3-get-style-info 'vertical-align node))))
+     (setq widget (widget-create 'image
+				 :value-face w3-active-faces
+				 'src src ; Where to load the image from
+				 'alt alt ; Textual replacement
+				 'ismap ismap ; Is it a server-side map?
+				 'usemap usemap	; Is it a client-side map?
+				 'href href ; Hyperlink destination
+				 ))
+     (widget-put widget 'buffer (current-buffer))
+     (w3-maybe-start-image-download widget)
+     (goto-char (point-max)))))
+
+;; The table handling
+
+(defvar w3-display-table-cut-words-p nil
+  "*Whether to cut words that are oversized in table cells")
+  
+(defvar w3-display-table-force-borders nil
+  "*Whether to always draw table borders")
+
+(defun w3-display-table-cut ()
+  (save-excursion
+    (goto-char (point-min))
+    (let ((offset -1))
+      (while (< offset 0)
+  	(end-of-line)
+  	(setq offset (- fill-column (current-column)))
+  	(cond ((< offset 0)
+  	       (condition-case nil
+  		   (progn (forward-char offset)
+  			  (insert ?\n))
+ 		 (error (setq offset 0))))
+  	      ((not (eobp))
+  	       (forward-line 1)
+  	       (setq offset -1)))))))
+
+
+(defun w3-display-fix-widgets ()
+  ;; Make markers belong to the right buffer
+  (save-excursion
+    (let ((st (point-min))
+ 	  (nd nil)
+	  (widget nil) parent
+ 	  (to-marker nil)
+ 	  (from-marker nil))
+      (while (setq st (next-single-property-change st 'button))
+ 	(setq nd (or (next-single-property-change st 'button) (point-max))
+ 	      widget (widget-at st)
+ 	      to-marker (and widget (widget-get widget :to))
+ 	      from-marker (and widget (widget-get widget :from))
+ 	      parent (and widget (widget-get widget :parent))
+ 	      )
+	(if (not widget)
+	    nil
+	  (widget-put widget :from (set-marker (make-marker) st))
+	  (widget-put widget :to   (set-marker (make-marker) nd))
+	  (if (not parent)
+	      nil
+	    (widget-put parent :from (set-marker (make-marker) st))
+	    (widget-put parent :to   (set-marker (make-marker) nd))))
+ 	(if (condition-case ()
+ 		(get-text-property (1+ nd) 'button)
+ 	      (error nil))
+ 	    (setq st nd)
+ 	  (setq st (min (point-max) (1+ nd))))))))
+
+(defun w3-size-of-tree (tree minmax)
+  (save-excursion
+    (save-restriction
+      (narrow-to-region (point) (point))
+      ;; XXX fill-column set to 1 fails when fill-prefix is set
+      ;; XXX setting fill-column at all isn't really right
+      ;; for example <hr>s shouldn't be especially wide
+      ;; we should set a flag that makes w3 never wrap a line
+      (let ((fill-column (cond ((eq minmax 'min)
+				3)
+			       ((eq minmax 'max)
+				400))) 
+	    (fill-prefix "")
+	    (w3-last-fill-pos (point-min))
+	    a retval
+	    (w3-do-incremental-display nil)
+	    (hr-regexp  (concat "^"
+				(regexp-quote 
+				 (make-string 5 w3-horizontal-rule-char)) 
+				"*$"))
+	    )
+	;;(push 'left  w3-display-alignment-stack)
+	(push (if (eq minmax 'max) 'nowrap) w3-display-whitespace-stack)
+	(while tree
+	  (push (cons '*td args) w3-display-open-element-stack)
+	  (w3-display-node (pop tree)))
+	(pop w3-display-whitespace-stack)
+	(goto-char (point-min))
+	(while (re-search-forward hr-regexp nil t)
+	  (replace-match "" t t))
+	(goto-char (point-min))
+	(while (not (eobp))
+	  ;; loop invariant: at beginning of uncounted line
+	  (end-of-line)
+	  (skip-chars-backward " ")
+	  (setq retval (cons (current-column)
+			     retval))
+	  (beginning-of-line 2))
+	(if (= (point-min) (point-max))
+	    (setq retval 0)
+	  (setq retval (apply 'max (cons 0 retval))))
+	(delete-region (point-min) (point-max))
+	retval))))
+
+(defun w3-display-table-dimensions (node)
+  ;; fill-column sets maximum width
+  (let (min-vector
+	max-vector
+	rows cols
+	;;(w3-form-elements (and (boundp 'w3-form-elements) w3-form-elements))
+	(table-info (assq 'w3-table-info (cadr node)))) 
+    
+    (if table-info 
+	(setq min-vector (nth 1 table-info)
+	      max-vector (nth 2 table-info)
+	      rows       (nth 3 table-info)
+	      cols       (nth 4 table-info))
+
+      (push (cons '*table-autolayout args) w3-display-open-element-stack)
+      (let (content
+	    cur
+	    (table-spans (list nil))	; don't make this '(nil) 
+	    ptr
+	    col
+	    constraints
+	    
+	    colspan rowspan min max)
+	(setq content (nth 2 node))
+	(setq rows 0 cols 0)
+	(while content
+	  (setq cur (pop content))
+	  (if (stringp cur)
+	      nil
+	    (case (car cur)
+	      (tr
+	       (setq col 0)
+	       (setq rows (1+ rows))
+	       (setq ptr table-spans)
+	       (mapcar
+		(function
+		 (lambda (td)
+		   (setq colspan (string-to-int (or (cdr-safe (assq 'colspan (nth 1 td))) "1"))
+			 rowspan (string-to-int (or (cdr-safe (assq 'rowspan (nth 1 td))) "1"))
+			 min  (w3-size-of-tree  (nth 2 td) 'min)
+			 max  (w3-size-of-tree  (nth 2 td) 'max)
+			 )
+		   (while (eq (car-safe (car-safe (cdr ptr))) col)
+		     (setq col (+ col (cdr (cdr (car (cdr ptr))))))
+		     (if (= 0 (decf (car (cdr (car (cdr ptr))))))
+			 (pop (cdr ptr))
+		       (setq ptr (cdr ptr))))
+		   (push (list col colspan min max)
+			 constraints)
+		   (if (= rowspan 1) nil
+		     (push (cons col (cons (1- rowspan) colspan)) (cdr ptr))
+		     (setq ptr (cdr ptr)))
+		   (setq col (+ col colspan))
+		   ))
+		(nth 2 cur))
+	       (while (cdr ptr)
+		 (if (= 0 (decf (car (cdr (car (cdr ptr))))))
+		     (pop (cdr ptr))
+		   (setq ptr (cdr ptr))))
+	       (setq cols (max cols col))
+	       )
+	      (caption
+	       nil)
+	      (otherwise
+	       (setq content (nth 2 cur)))
+	      )
+	    )
+	  )
+	(setq constraints (sort constraints
+				(function
+				 (lambda (a b)
+				   (< (cadr a) (cadr b)))))
+	      min-vector (make-vector cols 0)
+	      max-vector (make-vector cols 0))
+	(let (start end i mincellwidth maxcellwidth)
+	  (mapcar (function (lambda (c)
+			      (cond ((= (cadr c) 1) 
+				     (aset min-vector (car c) 
+					   (max (aref min-vector (car c))
+						(nth 2 c)))
+				     (aset max-vector (car c) 
+					   (max (aref max-vector (car c))
+						(nth 3 c))))
+				    (t 
+				     (setq start (car c)
+					   end (+ (car c) (cadr c))
+					   mincellwidth 0
+					   maxcellwidth 0
+					   i start)
+				     (while (< i end)
+				       (setq mincellwidth (+ mincellwidth
+							     (aref min-vector i))
+					     maxcellwidth (+
+							   maxcellwidth
+							   (aref max-vector i))
+					     i (1+ i)))
+				     (setq i start)
+				     (if (= mincellwidth 0)
+					 ;; if existing width is 0 divide evenly
+					 (while (< i end)
+					   (aset min-vector i
+						 (/ (nth 2 c) (cadr c)))
+					   (aset max-vector i
+						 (/ (nth 3 c) (cadr c)))
+					   (setq i (1+ i)))
+				       ;; otherwise weight it by existing widths
+				       (while (< i end)
+					 (aset min-vector i
+					       (max (aref min-vector i)
+						    (/ (* (nth 2 c)
+							  (aref min-vector i))
+						       mincellwidth)))
+					 (aset max-vector i
+					       (max (aref max-vector i)
+						    (/ (* (nth 3 c)
+							  (aref max-vector i))
+						       maxcellwidth)))
+					 (setq i (1+ i))))
+				     ))))
+		  constraints)))
+      (push (cons 'w3-table-info
+		  (list min-vector max-vector rows cols))
+	    (cadr node))
+      (pop w3-display-open-element-stack))
+    
+    (let (max-width
+	  min-width 
+	  ret-vector
+	  col
+	  )
+    
+
+      (setq max-width (apply '+ (append max-vector (list cols 1))))
+      (setq min-width (apply '+ (append min-vector (list cols 1))))
+
+      ;; the comments in the cond are excerpts from rfc1942 itself
+      (cond 
+       ;;   1.  The minimum table width is equal to or wider than the available
+       ;;       space. In this case, assign the minimum widths and allow the
+       ;;       user to scroll horizontally. For conversion to braille, it will
+       ;;       be necessary to replace the cells by references to notes
+       ;;       containing their full content. By convention these appear
+       ;;       before the table.
+       ((>= min-width fill-column)
+	(setq ret-vector min-vector))
+     
+       ;;   2.  The maximum table width fits within the available space. In
+       ;;       this case, set the columns to their maximum widths.
+       ((<= max-width fill-column)
+	(setq ret-vector max-vector))
+     
+       ;;   3.  The maximum width of the table is greater than the available
+       ;;       space, but the minimum table width is smaller. In this case,
+       ;;       find the difference between the available space and the minimum
+       ;;       table width, lets call it W. Lets also call D the difference
+       ;;       between maximum and minimum width of the table.
+     
+       ;;       For each column, let d be the difference between maximum and
+       ;;       minimum width of that column. Now set the column's width to the
+       ;;       minimum width plus d times W over D. This makes columns with
+       ;;       large differences between minimum and maximum widths wider than
+       ;;       columns with smaller differences.
+       (t
+	(setq ret-vector (make-vector cols 0))
+	(let ((W (- fill-column min-width))
+	      (D (- max-width min-width))
+	      d extra)
+	  (setq col 0)
+	  (while (< col (length ret-vector))
+	    (setq d (- (aref max-vector col)
+		       (aref min-vector col)))
+	    (aset ret-vector col 
+		  (+ (aref min-vector col)
+		     (/ (* d W) D)))
+	    (setq col (1+ col)))
+	  (setq extra (- fill-column
+			 (apply '+ (append ret-vector
+					   (list (length ret-vector) 1))))
+		col 0)
+	  (while (and (< col (length ret-vector)) (> extra 0))
+	    (if (= 1 (- (aref max-vector col) (aref ret-vector col) ))
+		(aset ret-vector col (1+ (aref ret-vector col))))
+	    (setq extra (1- extra)
+		  col (1+ col)))
+	  )))
+      (list rows cols ret-vector))))
+
+(defvar w3-table-ascii-border-chars
+  [?  ?  ?  ?/ ?  ?- ?\\ ?- ?  ?\\ ?| ?| ?/ ?- ?| ?-]
+  "Vector of ascii characters to use to draw table borders.
+w3-table-unhack-border-chars uses this to restore w3-table-border-chars.")
+
+(defvar w3-table-border-chars w3-table-ascii-border-chars
+  "Vector of characters to use to draw table borders.
+If you set this you should set w3-table-ascii-border-chars to the same value
+so that w3-table-unhack-borders can restore the value if necessary.
+
+A reasonable value is [?  ?  ?  ?/ ?  ?- ?\\\\ ?^ ?  ?\\\\ ?| ?< ?/ ?- ?> ?-]
+Though i recommend replacing the ^ with - and the < and > with |")
+
+(defsubst w3-table-lookup-char (l u r b)
+  (aref w3-table-border-chars (logior (if l 1 0)
+				      (if u 2 0)
+				      (if r 4 0)
+				      (if b 8 0))))
+
+(defun w3-table-hack-borders nil
+  "Try to find the best set of characters to draw table borders with.
+I definitely recommend trying this on X. 
+On a console, this can trigger some Emacs display bugs.
+
+I haven't tried this on XEmacs or any window-system other than X."
+  (interactive)
+  (case (device-type)
+    (x
+     (let ((id (or (and (find-face 'w3-table-hack-x-face)
+			(face-id 'w3-table-hack-x-face))
+		   (progn
+		     (make-face 'w3-table-hack-x-face)
+		     (set-face-font 'w3-table-hack-x-face
+				    (make-font :family "terminal"))
+		     (face-id 'w3-table-hack-x-face)))))
+       (if (not (face-differs-from-default-p 'w3-table-hack-x-face))
+	   nil
+	 (aset standard-display-table 1 (vector (+ (* 256 id) ?l)))
+	 (aset standard-display-table 2 (vector (+ (* 256 id) ?q)))
+	 (aset standard-display-table 3 (vector (+ (* 256 id) ?k)))
+	 (aset standard-display-table 4 (vector (+ (* 256 id) ?t)))
+	 (aset standard-display-table 5 (vector (+ (* 256 id) ?n)))
+	 (aset standard-display-table 6 (vector (+ (* 256 id) ?u)))
+	 (aset standard-display-table 7 (vector (+ (* 256 id) ?m)))
+	 (aset standard-display-table 8 (vector (+ (* 256 id) ?x)))
+	 (aset standard-display-table 11 (vector (+ (* 256 id) ?j)))
+	 (aset standard-display-table 14 (vector (+ (* 256 id) ?v)))
+	 (aset standard-display-table 15 (vector (+ (* 256 id) ?w)))
+	 (setq w3-table-border-chars [?  ?  ?  11 ?  2 7 14 ?  3 8 6 1 15 4 5])
+	 (setq w3-horizontal-rule-char 2))))
+    (tty
+     (standard-display-g1 1 108)	; ulcorner 
+     (standard-display-g1 2 113)	; hline
+     (standard-display-g1 3 107)	; urcorner
+     (standard-display-g1 4 116)	; leftt
+     (standard-display-g1 5 110)	; intersection
+     (standard-display-g1 6 117)	; rightt
+     (standard-display-g1 7 109)	; llcorner
+     (standard-display-g1 8 120)	; vline
+     (standard-display-g1 11 106)	; lrcorner
+     (standard-display-g1 14 118)	; upt
+     (standard-display-g1 15 119)	; downt
+     (setq w3-table-border-chars [?  ?  ?  11 ?  2 7 14 ?  3 8 6 1 15 4 5])
+     (setq w3-horizontal-rule-char 2))
+    (otherwise
+     (error "Unknown window-system, can't do any better than ascii borders")))
+  )
+  
+(defun w3-table-unhack-borders nil
+  (interactive)
+  (w3-table-excise-hack (buffer-list))
+  (standard-display-default 1 15)
+  (setq w3-table-border-chars w3-table-ascii-border-chars)
+  (setq w3-horizontal-rule-char ?-))
+
+(defun w3-table-excise-hack (buffs)
+  "Replace hacked characters with ascii characters in buffers BUFFS.
+Should be run before restoring w3-table-border-chars to ascii characters."
+  (interactive (list (list (current-buffer))))
+  (let ((inhibit-read-only t)
+	(tr (make-string 16 ? ))
+	(i 0))
+    (while (< i (length tr))
+      (aset tr i i)
+      (setq i (1+ i)))
+    (setq i 0)
+    (while (< i (length w3-table-border-chars))
+      (if (< (aref w3-table-border-chars i) 16)
+	  (aset tr 
+		(aref w3-table-border-chars i)
+		(aref w3-table-ascii-border-chars i)))
+      (setq i (1+ i)))
+    (mapcar (function (lambda (buf)
+			(save-excursion
+			  (set-buffer buf)
+			  (if (eq major-mode 'w3-mode)
+			      (translate-region (point-min)
+						(point-max)
+						tr)))))
+	    buffs)))
+
+(defun w3-display-table (node)
+  (let* ((dimensions (w3-display-table-dimensions node))
+	 (num-cols (max (cadr dimensions) 1))
+	 (num-rows (max (car dimensions) 1))
+	 (column-dimensions (caddr dimensions))
+	 (table-width (apply '+ (append column-dimensions (list num-cols 1)))))
+    (cond
+     ((or (<= (cadr dimensions) 0) (<= (car dimensions) 0))
+      ;; We have an invalid table
+      nil)
+     ((assq '*table-autolayout w3-display-open-element-stack)
+      ;; don't bother displaying the table if all we really need is the size
+      (progn (insert-char ?T table-width) (insert "\n")))
+     (t
+      (let* ((tag  (nth 0 node))
+	     (args (nth 1 node))
+	     (border-node (cdr-safe (assq 'border args)))
+	     (border (or w3-display-table-force-borders
+			 (and border-node
+			      (or (/= 0 (string-to-int border-node))
+				  (string= "border" border-node)))))
+	     (w3-table-border-chars
+	      (if border
+		  w3-table-border-chars
+		(make-vector (length w3-table-border-chars) ? )))
+	     valign align 
+	     (content (nth 2 node))
+	     (avgwidth (/ (- fill-column num-cols num-cols) num-cols))
+	     (formatted-cols (make-vector num-cols nil))
+	     (table-rowspans (make-vector num-cols 0))
+	     (table-colspans (make-vector num-cols 1))
+	     (prev-colspans  (make-vector num-cols 0))
+	     (prev-rowspans  (make-vector num-cols 0))
+	     (table-colwidth (make-vector num-cols 0))
+	     (fill-prefix "")
+	     (height nil)
+	     (cur-height nil)
+	     (cols nil)
+	     (rows nil)
+	     (row 0)
+	     (this-rectangle nil)
+	     (i 0)
+	     )
+
+	(push (cons tag args) w3-display-open-element-stack)
+
+	(if (memq 'nowrap w3-display-whitespace-stack)
+	    (setq fill-prefix "")
+	  (case (car w3-display-alignment-stack)
+	    (center
+	     (w3-set-fill-prefix-length
+	      (max 0 (/ (- fill-column table-width) 2))))
+	    (right
+	     (w3-set-fill-prefix-length
+	      (max 0 (- fill-column table-width))))
+	    (t
+	     (setq fill-prefix ""))))
+	(while content
+	  (case (caar content)
+	    (tr
+	     (setq w3-display-css-properties (css-get
+					      (nth 0 (car content))
+					      (nth 1 (car content))
+					      w3-current-stylesheet
+					      w3-display-open-element-stack))
+	     (setq cols (nth 2 (car content))
+		   valign (or (cdr-safe (assq 'valign (nth 1 (car content))))
+			      (w3-get-style-info 'vertical-align node))
+		   align  (or (cdr-safe (assq 'align  (nth 1 (car content))))
+			      (w3-get-style-info 'text-align node))
+		   content (cdr content)
+		   row (1+ row))
+	     (if (and valign (stringp valign))
+		 (setq valign (intern (downcase valign))))
+	     ;; this is iffy
+	     ;;(if align (push (intern (downcase align)) w3-display-alignment-stack))
+	     (save-excursion
+	       (save-restriction
+		 (narrow-to-region (point) (point))
+		 (setq fill-column avgwidth
+		       inhibit-read-only t
+		       w3-last-fill-pos (point-min)
+		       i 0)
+		 ;; skip over columns that have leftover content
+		 (while (and (< i num-cols)
+			     (/= 0 (aref table-rowspans i)))
+		   (setq i (+ i (max 1 (aref table-colspans i)))))
+		 (while cols
+		   (let* ((node (car cols))
+			  (attributes (nth 1 node))
+			  (colspan (string-to-int
+				    (or (cdr-safe (assq 'colspan attributes))
+					"1")))
+			  (rowspan (string-to-int
+				    (or (cdr-safe (assq 'rowspan attributes))
+					"1")))
+			  fill-column column-width
+			  (fill-prefix "")
+			  (w3-do-incremental-display nil)
+			  (indent-tabs-mode nil)
+			  c e
+			  )
+
+		     (aset table-colspans i colspan)
+		     (aset table-rowspans i rowspan)
+
+		     (setq fill-column 0)
+		     (setq c i
+			   e (+ i colspan))
+		     (while (< c e)
+		       (setq fill-column (+ fill-column 
+					    (aref column-dimensions c)
+					    1)
+			     c (1+ c)))
+		     (setq fill-column (1- fill-column))
+		     (aset table-colwidth i fill-column)
+
+		     (setq w3-last-fill-pos (point-min))
+		     (push (cons (nth 0 node) (nth 1 node))
+			   w3-display-open-element-stack)
+		     (w3-display-node node)
+		     (setq fill-column (aref table-colwidth i))
+		     (if w3-display-table-cut-words-p
+			 (w3-display-table-cut))
+		     (setq cols (cdr cols))
+		     (goto-char (point-min))
+		     (skip-chars-forward "\t\n\r")
+		     (beginning-of-line)
+		     (delete-region (point-min) (point))
+		     (goto-char (point-max))
+		     (skip-chars-backward " \t\n\r")
+		     (delete-region (point) (point-max))
+		     (if (>= fill-column (current-column))
+			 (insert-char ?  (- fill-column (current-column))))
+		     (aset formatted-cols i (extract-rectangle (point-min) (point-max)))
+		     (delete-region (point-min) (point-max))
+		     (let ((j (1- colspan)))
+		       (while (> j 0)
+			 (aset table-colspans (+ i j) 0)
+			 (setq j (1- j))))		
+		     (setq i (+ i colspan))
+		     ;; skip over columns that have leftover content
+		     (while (and (< i num-cols)
+				 (/= 0 (aref table-rowspans i)))
+		       (setq i (+ i (max 1 (aref table-colspans i)))))
+		     ))
+
+		 ;; finish off the columns
+		 (while (< i num-cols)
+		   (aset table-colwidth i (aref column-dimensions i))
+		   (aset table-colspans i 1)
+		   (setq i (1+ i))
+		   (while (and (< i num-cols)
+			       (/= 0 (aref table-rowspans i)))
+		     (setq i (+ i (max 1 (aref table-colspans i))))))
+
+		 ;; on the last row empty any pending rowspans per the rfc
+		 (if content nil
+		   (fillarray table-rowspans 1)) 
+
+		 ;; Find the tallest rectangle that isn't a rowspanning cell
+		 (setq height 0 
+		       i 0)
+		 (while (< i num-cols)
+		   (if (= 1 (aref table-rowspans i))
+		       (setq height (max height (length (aref formatted-cols i)))))
+		   (setq i (+ i (max 1 (aref table-colspans i)))))
+
+		 ;; Make all rectangles the same height
+		 (setq i 0)
+		 (while (< i num-cols)
+		   (setq this-rectangle (aref formatted-cols i))
+		   (if (> height (length this-rectangle))
+		       (let ((colspan-fill-line
+			      (make-string (aref table-colwidth i) ? )))
+			 (case valign
+			   ((center middle)
+			    (aset formatted-cols i
+				  (append (make-list (/ (- height (length this-rectangle)) 2) 
+						     colspan-fill-line)
+					  this-rectangle)))
+			   (bottom
+			    (aset formatted-cols i 
+				  (append (make-list (- height (length this-rectangle))
+						     colspan-fill-line)
+					  this-rectangle))))))
+		   (setq i (+ i (max 1 (aref table-colspans i)))))))
+	     
+
+	     ;; fix broken colspans (this should only matter on illegal tables)
+	     (setq i 0)
+	     (while (< i num-cols)
+	       (if (= (aref table-colspans i) 0)
+		   (aset table-colspans i 1))
+	       (setq i (+ i (aref table-colspans i))))
+
+	     ;; Insert a separator 
+	     (insert fill-prefix)
+	     (setq i 0)
+	     (let (rflag bflag tflag lflag)
+	       (while (< i num-cols)
+
+		 (setq rflag (= (aref prev-rowspans i) 0))
+		 (setq bflag (/= (aref table-colspans i) 0))
+		 (setq tflag (/= (aref prev-colspans  i) 0))
+
+		 (insert (w3-table-lookup-char lflag tflag rflag bflag))
+		 (setq lflag t)
+		 (cond ((= (aref prev-rowspans i) 0)
+			(insert-char (w3-table-lookup-char t nil t nil) 
+				     (aref column-dimensions i))
+			(setq i (1+ i)))
+		       ((car (aref formatted-cols i))
+			(insert (pop (aref formatted-cols i)))
+			(setq lflag nil)
+			(setq i (+ i (max (aref table-colspans i)
+					  (aref prev-colspans  i) 1))))
+		       (t
+			(insert-char ?  (aref table-colwidth i))
+			(setq lflag nil)
+			(setq i (+ i (max (aref table-colspans i)
+					  (aref prev-colspans  i) 1))))))
+	       (insert (w3-table-lookup-char lflag (/= row 1) nil t) "\n"))
+
+	     ;; recalculate height (in case we've shortened a rowspanning cell
+	     (setq height 0 
+		   i 0)
+	     (while (< i num-cols)
+	       (if (= 1 (aref table-rowspans i))
+		   (setq height (max height (length (aref formatted-cols i)))))
+	       (setq i (+ i (max 1 (aref table-colspans i)))))
+
+	     ;; Insert a row back in original buffer
+	     (while (> height 0)
+	       (insert fill-prefix (w3-table-lookup-char nil t nil t))
+	       (setq i 0)
+	       (while (< i num-cols)
+		 (if (car (aref formatted-cols i))
+		     (insert (pop (aref formatted-cols i))) 
+		   (insert-char ?  (aref table-colwidth i))) 
+		 (insert (w3-table-lookup-char nil t nil t))
+		 (setq i (+ i (max (aref table-colspans i) 1))))
+	       (insert "\n")
+	       ;;(and w3-do-incremental-display (w3-pause))
+	       (setq height (1- height)))
+	     
+	     (setq i 0)
+	     (while (< i num-cols)
+	       (if (> (aref table-rowspans i) 0)
+		   (decf (aref table-rowspans i)))
+	       (incf i))
+	     
+	     (setq prev-rowspans (copy-seq table-rowspans))
+	     (setq prev-colspans (copy-seq table-colspans))
+	 
+	     (and w3-do-incremental-display (w3-pause))
+
+	     )
+	    (caption
+	     (let ((left (length fill-prefix))
+		   (fill-prefix "")
+		   (fill-column table-width)
+		   (start (point)))
+	       (w3-display-node (pop content))
+	       (indent-rigidly start (point) left)))
+	    (otherwise			
+	     (delete-horizontal-space)
+	     (setq content (nth 2 (car content))))
+	    ))
+	(if (= (length column-dimensions) 0) nil
+	  (insert fill-prefix)
+	  (setq i 0)
+	  (let (tflag lflag)
+	    (while (< i num-cols)
+	      (setq tflag (/= (aref prev-colspans  i) 0))
+	      (insert (w3-table-lookup-char lflag tflag t nil))
+	      (setq lflag t)
+	      (insert-char (w3-table-lookup-char t nil t nil) 
+			   (aref column-dimensions i))
+	      (setq i (1+ i)))
+	    (insert (w3-table-lookup-char t t nil nil) "\n")))
+	)
+      (pop w3-display-open-element-stack)))))
+
+
+
+(defun w3-display-create-unique-id ()
+  (let* ((date (current-time-string))
+	 (dateinfo (and date (timezone-parse-date date)))
+	 (timeinfo (and date (timezone-parse-time (aref dateinfo 3)))))
+    (if (and dateinfo timeinfo)
+	(concat (aref dateinfo 0)	; Year
+		(aref dateinfo 1)	; Month
+		(aref dateinfo 2)	; Day
+		(aref timeinfo 0)	; Hour
+		(aref timeinfo 1)	; Minute 
+		(aref timeinfo 2)	; Second
+		)
+      "HoplesSLYCoNfUSED")))
+
+(defun w3-display-node (node &optional nofaces)
+  (let (
+	(content-stack (list (list node)))
+	(right-margin-stack (list fill-column))
+	(left-margin-stack (list 0))
+	node
+	insert-before
+	insert-after
+	tag
+	args
+	content
+	hyperlink-info
+	break-style
+	cur
+	id
+	class
+	)
+    (while content-stack
+      (setq content (pop content-stack))
+      (pop w3-active-faces)
+      (pop w3-active-voices)
+      (case (car (pop w3-display-open-element-stack))
+	;; Any weird, post-display-of-content stuff for specific tags
+	;; goes here.   Couldn't think of any better way to do this when we
+	;; are iterative.  *sigh*
+	(a
+	 (if (not hyperlink-info)
+	     nil
+	   (add-text-properties (car hyperlink-info) (point)
+				(list
+				 'mouse-face 'highlight
+				 'duplicable t
+				 'help-echo 'w3-balloon-help-callback
+				 'balloon-help 'w3-balloon-help-callback))
+	   (fillin-text-property (car hyperlink-info) (point)
+				 'button 'button (cadr hyperlink-info))
+	   (widget-put (cadr hyperlink-info) :to (set-marker
+						  (make-marker) (point))))
+	 (setq hyperlink-info nil))
+	(form
+	 (pop w3-display-form-stack))
+	((ol ul dl dir menu)
+	 (pop w3-display-list-stack))
+	(otherwise
+	 nil))
+      (if (car insert-after)
+	  (w3-handle-string-content (car insert-after)))
+      (pop insert-after)
+      (w3-display-handle-end-break)
+      (w3-pop-all-face-info)
+      ;; Handle the element's content
+      (while content
+	(if (stringp (car content))
+	    (w3-handle-string-content (pop content))
+	  (setq node (pop content)
+		tag (nth 0 node)
+		args (nth 1 node)
+		id (or (w3-get-attribute 'name)
+		       (w3-get-attribute 'id))
+		)
+	  ;; This little bit of magic takes care of inline styles.
+	  ;; Evil Evil Evil, but it appears to work.
+	  (if (w3-get-attribute 'style)
+	      (let ((unique-id (or (w3-get-attribute 'id)
+				   (w3-display-create-unique-id)))
+		    (sheet ""))
+		(setq sheet (format "%s.%s { %s }\n" tag unique-id
+				    (w3-get-attribute 'style)))
+		(setf (nth 1 node) (cons (cons 'id unique-id) args))
+		(w3-handle-style (list (cons 'data sheet)
+				       (cons 'notation "css")))))
+	  (setq w3-display-css-properties (css-get
+					   (nth 0 node) (nth 1 node)
+					   w3-current-stylesheet
+					   w3-display-open-element-stack))
+	  (if nofaces
+	      nil
+	    (push (w3-face-for-element node) w3-active-faces)
+	    (push (w3-voice-for-element node) w3-active-voices))
+	  (push (w3-get-style-info 'display node) break-style)
+	  (push (w3-get-style-info 'insert-after node) insert-after)
+	  (setq insert-before (w3-get-style-info 'insert-before node))
+	  (w3-display-handle-break)
+	  (if (w3-node-visible-p)
+	      nil
+	    (setq insert-before nil
+		  tag '*invisible)
+	    (setcar insert-after nil))
+	  (if insert-before
+	      (w3-handle-string-content insert-before))
+	  (setq insert-before nil)
+	  (if id
+	      (setq w3-id-positions (cons
+				     (cons (intern id)
+					   (set-marker (make-marker)
+						       (point-max)))
+				     w3-id-positions)))
+	  (case tag
+	    (a				; Hyperlinks
+	     (let* (
+		    (title (w3-get-attribute 'title))
+		    (name (or (w3-get-attribute 'id)
+			      (w3-get-attribute 'name)))
+		    (btdt nil)
+		    class
+		    (before nil)
+		    (after nil)
+		    (face nil)
+		    (voice nil)
+		    (st nil))
+	       (setq st (point)
+		     hyperlink-info (list
+				     st
+				     (append 
+				      (list 'link :args nil
+					    :value "" :tag ""
+					    :action 'w3-follow-hyperlink
+					    :from
+					    (set-marker (make-marker) st)
+					    :help-echo 'w3-widget-echo
+					    )
+				      (alist-to-plist args))))
+	       (w3-handle-content node)
+	       )
+	     )
+	    ((ol ul dl dir menu)
+	     (push 0 w3-display-list-stack)
+	     (w3-handle-content node))
+	    (img			; inlined image
+	     (w3-handle-image)
+	     (w3-handle-empty-tag))
+	    (script			; Scripts
+	     (w3-handle-empty-tag))
+	    ((embed object)		; Embedded images/content
+	     (w3-handle-content node)
+	     )
+	    (hr				; Cause line break & insert rule
+	     (let* ((perc (or (w3-get-attribute 'width)
+			      (w3-get-style-info 'width node)
+			      "100%"))
+		    (rule nil)
+		    (width nil))
+	       (setq perc (/ (min (string-to-int perc) 100) 100.0)
+		     width (* fill-column perc)
+		     rule (make-string (max (truncate width) 0)
+				       w3-horizontal-rule-char)
+		     node (list 'hr nil (list rule)))
+	       (w3-handle-content node)))
+	    (map			; Client side imagemaps
+	     (let ((name (or (w3-get-attribute 'name)
+			     (w3-get-attribute 'id)
+			     "unnamed"))
+		   (areas
+		    (mapcar
+		     (function
+		      (lambda (node)
+			(let* ((args (nth 1 node))
+			       (type (downcase (or
+						(w3-get-attribute 'shape)
+						"rect")))
+			       (coords (w3-decode-area-coords
+					(or (cdr-safe
+					     (assq 'coords args)) "")))
+			       (alt (w3-get-attribute 'alt))
+			       (href (if (assq 'nohref args)
+					 t
+				       (or (w3-get-attribute 'src)
+					   (w3-get-attribute 'href))))
+			       )
+			  (vector type coords href alt))
+			)
+		      )
+		     (nth 2 node))))
+	       (setq w3-imagemaps (cons (cons name areas) w3-imagemaps)))
+	     (w3-handle-empty-tag)
+	     )
+	    (table			; Yeeee-hah!
+	     (w3-display-table node)
+	     (setq w3-last-fill-pos (point))
+	     (w3-handle-empty-tag)
+	     )
+	    (isindex
+	     (let ((prompt (or (w3-get-attribute 'prompt)
+			       "Search on (+ separates keywords): "))
+		   action node)
+	       (setq action (or (w3-get-attribute 'src)
+				(w3-get-attribute 'href)
+				(url-view-url t)))
+	       (if (and prompt (string-match "[^: \t-]+$" prompt))
+		   (setq prompt (concat prompt ": ")))
+	       (setq node
+		     (list 'isindex nil
+			   (list
+			    (list 'hr nil nil)
+			    (list 'form
+				  (list (cons 'action action)
+					(cons 'enctype
+					      "application/x-w3-isindex")
+					(cons 'method "get"))
+				  (list
+				   prompt
+				   (list 'input
+					 (list (cons 'type "text")
+					       (cons 'name "isindex"))))))))
+	       (w3-handle-content node)
+	       (setq w3-current-isindex (cons action prompt)))
+	     )
+	    (*document
+	     (let ((info (mapcar (lambda (x) (cons x (symbol-value x)))
+				 w3-persistent-variables)))
+	       (set-buffer (generate-new-buffer "Untitled"))
+	       (setq w3-current-form-number 0
+		     w3-display-open-element-stack nil
+		     w3-last-fill-pos (point-min)
+		     fill-column (min (- (or w3-strict-width (window-width))
+					 w3-right-margin)
+				      (or w3-maximum-line-length
+					  (window-width))))
+	       (switch-to-buffer (current-buffer))
+	       (buffer-disable-undo (current-buffer))
+	       (mapcar (function (lambda (x) (set (car x) (cdr x)))) info)
+	       ;; ACK!  We don't like filladapt mode!
+	       (set (make-local-variable 'filladapt-mode) nil)
+	       (set (make-local-variable 'adaptive-fill-mode) nil)
+	       (setq w3-current-stylesheet (css-copy-stylesheet
+					    w3-user-stylesheet)
+		     w3-last-fill-pos (point)
+		     fill-column (min (- (or w3-strict-width (window-width))
+					 w3-right-margin)
+				      (or w3-maximum-line-length
+					  (window-width)))
+		     fill-prefix "")
+	       (set (make-local-variable 'inhibit-read-only) t))
+	     (w3-handle-content node)
+	     )
+	    (*invisible
+	     (w3-handle-empty-tag))
+	    (meta
+	     (let* ((equiv (cdr-safe (assq 'http-equiv args)))
+		    (value (w3-get-attribute 'content))
+		    (name  (w3-get-attribute 'name))
+		    (node  (and equiv (assoc (setq equiv (downcase equiv))
+					     url-current-mime-headers))))
+	       (if equiv
+		   (setq url-current-mime-headers (cons
+						   (cons equiv value)
+						   url-current-mime-headers)))
+	       (if name
+		   (setq w3-current-metainfo (cons
+					      (cons name value)
+					      w3-current-metainfo)))
+
+	       ;; Special-case the Set-Cookie header
+	       (if (and equiv (string= (downcase equiv) "set-cookie"))
+		   (url-cookie-handle-set-cookie value))
+	       ;; Special-case the refresh header
+	       (if (and equiv (string= (downcase equiv) "refresh"))
+		   (url-handle-refresh-header value)))
+	     (w3-handle-empty-tag)
+	     )
+	    (link
+	     ;; This doesn't handle blank-separated values per the RFC.
+	     (w3-parse-link args)
+	     (w3-handle-empty-tag))
+	    (title
+	     (let ((potential-title "")
+		   (content (nth 2 node)))
+	       (while content
+		 (setq potential-title (concat potential-title (car content))
+		       content (cdr content)))
+	       (setq potential-title (w3-normalize-spaces potential-title))
+	       (if (string-match "^[ \t]*$" potential-title)
+		   nil
+		 (rename-buffer (generate-new-buffer-name
+				 (w3-fix-spaces potential-title)))))
+	     (w3-handle-empty-tag))
+	    (form
+	     (setq w3-current-form-number (1+ w3-current-form-number))
+	     (let* (
+		    (action (w3-get-attribute 'action))
+		    (url nil))
+	       (if (not action)
+		   (setq args (cons (cons 'action (url-view-url t)) args)))
+	       (push (cons
+		      (cons 'form-number
+			    w3-current-form-number)
+		      args) w3-display-form-stack)
+	       (w3-handle-content node)))
+	    (input
+	     (if (not (assq 'form w3-display-open-element-stack))
+		 (message "Input field outside of a <form>")
+	       (let* (
+		      (type (intern (downcase (or (w3-get-attribute 'type)
+						  "text"))))
+		      (name (w3-get-attribute 'name))
+		      (value (or (w3-get-attribute 'value) ""))
+		      (size (if (w3-get-attribute 'size)
+				(string-to-int (w3-get-attribute 'size))))
+		      (maxlength (cdr (assoc 'maxlength args)))
+		      (default value)
+		      (action (car w3-display-form-stack))
+		      (options)
+		      (id (w3-get-attribute 'id))
+		      (checked (assq 'checked args)))
+		 (if (and (string-match "^[ \t\n\r]+$" value)
+			  (not (eq type 'hidden)))
+		     (setq value ""))
+		 (if maxlength (setq maxlength (string-to-int maxlength)))
+		 (if (and name (string-match "[\r\n]" name))
+		     (setq name (mapconcat (function
+					    (lambda (x)
+					      (if (memq x '(?\r ?\n))
+						  ""
+						(char-to-string x))))
+					   name "")))
+		 (if (memq type '(checkbox radio)) (setq default checked))
+		 (if (and (eq type 'checkbox) (string= value ""))
+		     (setq value "on"))
+		 (w3-form-add-element type name
+				      value size maxlength default action
+				      options w3-current-form-number id checked
+				      (car w3-active-faces))
+		 )
+	       )
+	     (w3-handle-empty-tag)
+	     )
+	    (select
+	     (if (not (assq 'form w3-display-open-element-stack))
+		 (message "Input field outside of a <form>")
+	       (let* (
+		      (name (w3-get-attribute 'name))
+		      (size (string-to-int (or (w3-get-attribute 'size)
+					       "20")))
+		      (maxlength (cdr (assq 'maxlength args)))
+		      (value nil)
+		      (tmp nil)
+		      (action (car w3-display-form-stack))
+		      (options)
+		      (id (w3-get-attribute 'id))
+		      (checked (assq 'checked args)))
+		 (if maxlength (setq maxlength (string-to-int maxlength)))
+		 (if (and name (string-match "[\r\n]" name))
+		     (setq name (mapconcat (function
+					    (lambda (x)
+					      (if (memq x '(?\r ?\n))
+						  ""
+						(char-to-string x))))
+					   name "")))
+		 (setq options
+		       (mapcar
+			(function
+			 (lambda (n)
+			   (setq tmp (w3-normalize-spaces
+				      (apply 'concat (nth 2 n)))
+				 tmp (cons tmp
+					   (or
+					    (cdr-safe (assq 'value (nth 1 n)))
+					    tmp)))
+			   (if (assq 'selected (nth 1 n))
+			       (setq value (car tmp)))
+			   tmp))
+			(nth 2 node)))
+		 (if (not value)
+		     (setq value (caar options)))
+		 (w3-form-add-element 'option name
+				      value size maxlength value action
+				      options w3-current-form-number id nil
+				      (car w3-active-faces))
+		 ;; This should really not be necessary, but some versions
+		 ;; of the widget library leave point _BEFORE_ the menu
+		 ;; widget instead of after.
+		 (goto-char (point-max))
+		 )
+	       )
+	     (w3-handle-empty-tag)
+	     )
+	    (textarea
+	     (if (not (assq 'form w3-display-open-element-stack))
+		 (message "Input field outside of a <form>")
+	       (let* (
+		      (name (w3-get-attribute 'name))
+		      (size (string-to-int (or (w3-get-attribute 'size)
+					       "20")))
+		      (maxlength (cdr (assq 'maxlength args)))
+		      (value (w3-normalize-spaces
+			      (apply 'concat (nth 2 node))))
+		      (default value)
+		      (tmp nil)
+		      (action (car w3-display-form-stack))
+		      (options)
+		      (id (w3-get-attribute 'id))
+		      (checked (assq 'checked args)))
+		 (if maxlength (setq maxlength (string-to-int maxlength)))
+		 (if (and name (string-match "[\r\n]" name))
+		     (setq name (mapconcat (function
+					    (lambda (x)
+					      (if (memq x '(?\r ?\n))
+						  ""
+						(char-to-string x))))
+					   name "")))
+		 (w3-form-add-element 'multiline name
+				      value size maxlength value action
+				      options w3-current-form-number id nil
+				      (car w3-active-faces))
+		 )
+	       )
+	     (w3-handle-empty-tag)
+	     )
+	    (style
+	     (w3-handle-style (cons (cons 'data (apply 'concat (nth 2 node)))
+				    (nth 1 node)))
+	     (w3-handle-empty-tag))
+	    (otherwise
+	     ;; Generic formatting
+	     (w3-handle-content node))
+	    )				; case tag
+	  )				; stringp content
+	)				; while content
+      )					; while content-stack
+    )
+  )
+
+(defun w3-draw-tree (tree)
+  ;; The main entry point - wow complicated
+  (setq w3-current-stylesheet w3-user-stylesheet)
+  (while tree
+    (w3-display-node (car tree))
+    (setq tree (cdr tree)))
+  (w3-display-fix-widgets)
+  (w3-form-resurrect-widgets))
+
+(defun time-display (&optional tree)
+  ;; Return the # of seconds it took to draw 'tree'
+  (let ((st (nth 1 (current-time)))
+	(nd nil))
+    (w3-draw-tree (or tree w3-last-parse-tree))
+    (setq nd (nth 1 (current-time)))
+    (- nd st)))
+
+
+(defun w3-prepare-buffer (&rest args)
+  ;; The text/html viewer - does all the drawing and displaying of the buffer
+  ;; that is necessary to go from raw HTML to a good presentation.
+  (let* ((source (buffer-string))
+	 (source-buf (current-buffer))
+	 (parse (w3-parse-buffer source-buf)))
+    (set-buffer-modified-p nil)
+    (w3-draw-tree parse)
+    (kill-buffer source-buf)
+    (set-buffer-modified-p nil)
+    (setq w3-current-source source
+	  w3-current-parse parse)
+    (if (and (boundp 'w3-image-widgets-waiting) w3-image-widgets-waiting)
+	(let (url glyph widget)
+	  (while w3-image-widgets-waiting
+	    (setq widget (car w3-image-widgets-waiting)
+		  w3-image-widgets-waiting (cdr w3-image-widgets-waiting)
+		  url (widget-get widget 'src)
+		  glyph (cdr-safe (assoc url w3-graphics-list)))
+	    (widget-value-set widget glyph))))
+    (w3-mode)
+    ;;(w3-handle-annotations)
+    ;;(w3-handle-headers)
+    (set-buffer-modified-p nil)
+    (goto-char (point-min))
+    (if url-keep-history
+	(let ((url (url-view-url t)))
+	  (if (not url-history-list)
+	      (setq url-history-list (make-hash-table :size 131 :test 'equal)))
+	  (cl-puthash url (buffer-name) url-history-list)
+	  (if (fboundp 'w3-shuffle-history-menu)
+	      (w3-shuffle-history-menu)))))
+  )
+
+(provide 'w3-display)