diff lisp/w3/w3-display.el @ 108:360340f9fd5f r20-1b6

Import from CVS: tag r20-1b6
author cvs
date Mon, 13 Aug 2007 09:18:39 +0200
parents a145efe76779
children fe104dbd9147
line wrap: on
line diff
--- a/lisp/w3/w3-display.el	Mon Aug 13 09:17:27 2007 +0200
+++ b/lisp/w3/w3-display.el	Mon Aug 13 09:18:39 2007 +0200
@@ -1,7 +1,7 @@
 ;;; w3-display.el --- display engine v99999
 ;; Author: wmperry
-;; Created: 1997/02/20 21:48:44
-;; Version: 1.135
+;; Created: 1997/03/06 04:12:42
+;; Version: 1.144
 ;; Keywords: faces, help, hypermedia
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -42,6 +42,7 @@
 (defmacro w3-d-s-var-def (var)
   (` (make-variable-buffer-local (defvar (, var) nil))))
 
+(w3-d-s-var-def w3-display-label-marker)
 (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)
@@ -258,11 +259,11 @@
 			"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))
+	(font-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)))
+	(font-set-face-foreground w3-face-face (car w3-face-color)))
     (if (car w3-face-background-color)
-	(set-face-background w3-face-face (car w3-face-background-color)))
+	(font-set-face-background w3-face-face (car w3-face-background-color)))
     ;;(set-face-background-pixmap w3-face-face w3-face-pixmap)
     (setq w3-face-cache (cons
 			 (cons w3-face-descr w3-face-face)
@@ -411,6 +412,7 @@
       (while check
 	(and (boundp (car check))
 	     (stringp (symbol-value (car check)))
+	     (> (length (symbol-value (car check))) 0)
 	     (throw 'exit (symbol-value (car check))))
 	(pop check)))))
 
@@ -426,12 +428,7 @@
        (delete-other-windows)
        (w3-fetch href))
       (otherwise
-       (and target
-	    (let ((window-distance (cdr-safe (assq target w3-target-window-distances))))
-	      (if (numberp window-distance)
-		  (other-window window-distance)
-		(error "target %S not found." target))))
-       (w3-fetch href)))))
+       (w3-fetch href target)))))
 
 (defun w3-balloon-help-callback (object &optional event)
   (let* ((widget (widget-at (extent-start-position object)))
@@ -622,7 +619,8 @@
     (setq desc (and desc (intern dc-desc)))
     (case desc
       ((style stylesheet)
-       (w3-handle-style plist))
+       (if w3-honor-stylesheets
+	   (w3-handle-style plist)))
       (otherwise
        )
       )
@@ -742,6 +740,7 @@
 	  (usemap (w3-get-attribute 'usemap))
 	  (base (w3-get-attribute 'base))
 	  (href (and hyperlink-info (widget-get (cadr hyperlink-info) 'href)))
+	  (target (and hyperlink-info (widget-get (cadr hyperlink-info) 'target)))
 	  (widget nil)
 	  (align (or (w3-get-attribute 'align)
 		     (w3-get-style-info 'vertical-align node))))
@@ -754,9 +753,14 @@
 				   'ismap ismap ; Is it a server-side map?
 				   'usemap usemap ; Is it a client-side map?
 				   'href href ; Hyperlink destination
+				   'target target
 				   ))
        (widget-put widget 'buffer (current-buffer))
        (w3-maybe-start-image-download widget)
+       (if (widget-get widget :from)
+	   (add-text-properties (widget-get widget :from)
+				(widget-get widget :to)
+				(list 'html-stack w3-display-open-element-stack)))
        (goto-char (point-max))))))
 
 ;; The table handling
@@ -1078,8 +1082,8 @@
 			(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"))
+		     (font-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
@@ -1516,13 +1520,15 @@
 	cur
 	id
 	class
+	last-element
 	)
     (while content-stack
       (setq content (pop content-stack))
       (pop w3-active-faces)
       (pop w3-active-voices)
       (w3-display-progress-meter)
-      (case (car (pop w3-display-open-element-stack))
+      (setq last-element (pop w3-display-open-element-stack))
+      (case (car last-element)
 	;; 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*
@@ -1545,6 +1551,15 @@
 	 (setq hyperlink-info nil))
 	((ol ul dl dir menu)
 	 (pop w3-display-list-stack))
+	(label
+	 (if (and (markerp w3-display-label-marker)
+		  (marker-position w3-display-label-marker)
+		  (marker-buffer w3-display-label-marker))
+	     (push (cons (or (cdr-safe (assq 'for (cdr last-element)))
+			     (cdr-safe (assq 'id (cdr last-element)))
+			     "unknown")
+			 (buffer-substring w3-display-label-marker (point)))
+		   w3-form-labels)))
 	(otherwise
 	 nil))
       (if (car insert-after)
@@ -1619,23 +1634,27 @@
 		    (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
-					    :emacspeak-help 'w3-widget-echo
-					    )
-				      (alist-to-plist args))))
+	       (if (w3-get-attribute 'href)
+		   (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
+						:emacspeak-help 'w3-widget-echo
+						)
+					  (alist-to-plist args)))))
 	       (w3-handle-content node)
 	       )
 	     )
 	    ((ol ul dl menu)
-	     (push 0 w3-display-list-stack)
+	     (push (if (w3-get-attribute 'seqnum)
+		       (1- (string-to-int (w3-get-attribute 'seqnum)))
+		     0) w3-display-list-stack)
 	     (w3-handle-content node))
 	    (dir
 	     (push 0 w3-display-list-stack)
@@ -1691,6 +1710,9 @@
 	     (if w3-display-frames
 		 (w3-handle-empty-tag)
 	       (w3-handle-content node)))
+	    (applet			; Wow, Java
+	     (w3-handle-content node)
+	     )
 	    (script			; Scripts
 	     (w3-handle-empty-tag))
 	    ((embed object)		; Embedded images/content
@@ -1953,6 +1975,11 @@
 			       (cons (cons 'data (apply 'concat (nth 2 node)))
 				     (nth 1 node))))
 	     (w3-handle-empty-tag))
+	    (label
+	     (if (not (markerp w3-display-label-marker))
+		 (setq w3-display-label-marker (make-marker)))
+	     (set-marker w3-display-label-marker (point))
+	     (w3-handle-content node))
 	    ;; Emacs-W3 stuff that cannot be expressed in a stylesheet
 	    (pinhead
 	     ;; This check is so that we don't screw up table auto-layout
@@ -2050,7 +2077,7 @@
 (defun w3-region (st nd)
   (if (not w3-setup-done) (w3-do-setup))
   (let* ((source (buffer-substring st nd))
-	 (w3-dislplay-same-buffer t)
+	 (w3-display-same-buffer t)
 	 (parse nil))
     (save-window-excursion
       (save-excursion
@@ -2217,16 +2244,16 @@
 	      (reverse dimensions)
 	    ;; substitute numbers for *
 	    (let ((star-replacement (/ remaining-available-dimension nb-stars))
-		    (star-dimensions dimensions))
-		(setq dimensions nil)
-		(while star-dimensions
-		  (push (if (eq '* (car star-dimensions))
-			    star-replacement
-			  (car star-dimensions))
-			dimensions)
-		  (pop star-dimensions))
-		;; push + push => in order
-		dimensions))))))
+		  (star-dimensions dimensions))
+	      (setq dimensions nil)
+	      (while star-dimensions
+		(push (if (eq '* (car star-dimensions))
+			  star-replacement
+			(car star-dimensions))
+		      dimensions)
+		(pop star-dimensions))
+	      ;; push + push => in order
+	      dimensions))))))
 
 
 (provide 'w3-display)