diff lisp/w3/w3-display.el @ 98:0d2f883870bc r20-1b1

Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 821dec489c24
children 4be1180a9e89
line wrap: on
line diff
--- a/lisp/w3/w3-display.el	Mon Aug 13 09:12:43 2007 +0200
+++ b/lisp/w3/w3-display.el	Mon Aug 13 09:13:56 2007 +0200
@@ -1,7 +1,7 @@
 ;;; w3-display.el --- display engine v99999
 ;; Author: wmperry
-;; Created: 1997/01/31 04:26:17
-;; Version: 1.115
+;; Created: 1997/02/14 17:51:17
+;; Version: 1.127
 ;; Keywords: faces, help, hypermedia
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -32,6 +32,7 @@
 (require 'w3-widget)
 (require 'w3-imap)
 
+(define-widget-keywords :emacspeak-help)
 (autoload 'sentence-ify "flame")
 (autoload 'string-ify "flame")
 (autoload '*flame "flame")
@@ -365,7 +366,11 @@
 			 (point)))))
   (goto-char (point-max))
   (add-text-properties w3-scratch-start-point
-		       (point) (list 'face w3-active-faces 'duplicable t))
+		       (point) (list 'face w3-active-faces
+				     'start-open t
+				     'end-open t
+				     'rear-nonsticky t
+				     'duplicable t))
   (if (car w3-active-voices)
       (add-text-properties w3-scratch-start-point (point)
 			   (list 'personality (car w3-active-voices))))
@@ -618,43 +623,47 @@
 (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)))))))
+    (cond
+     ((and cached-glyph
+	   (widget-glyphp cached-glyph)
+	   (not (eq 'nothing
+		    (image-instance-type
+		     (glyph-image-instance cached-glyph)))))
+      (setq w3-image-widgets-waiting (cons widget w3-image-widgets-waiting)))
+     ((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!
+      (message "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)
@@ -670,7 +679,7 @@
     (cond
      ((w3-image-invalid-glyph-p glyph)
       (setq glyph nil)
-      (w3-warn 'image (format "Reading of %s failed." url)))
+      (message "Reading of %s failed." url))
      ((eq (aref glyph 0) 'xbm)
       (let ((temp-fname (url-generate-unique-filename "%s.xbm")))
 	(save-excursion
@@ -794,6 +803,7 @@
  	  (setq st (min (point-max) (1+ nd))))))))
 
 (defun w3-size-of-tree (tree minmax)
+  (declare (special args))
   (save-excursion
     (save-restriction
       (narrow-to-region (point) (point))
@@ -839,6 +849,7 @@
 
 (defun w3-display-table-dimensions (node)
   ;; fill-column sets maximum width
+  (declare (special args))
   (let (min-vector
 	max-vector
 	rows cols
@@ -1205,7 +1216,7 @@
 	       (save-restriction
 		 (narrow-to-region (point) (point))
 		 (setq fill-column avgwidth
-		       inhibit-read-only t
+		       ;; inhibit-read-only t
 		       w3-last-fill-pos (point-min)
 		       i 0)
 		 ;; skip over columns that have leftover content
@@ -1299,7 +1310,7 @@
 		   (setq this-rectangle (aref formatted-cols i))
 		   (if (> height (length this-rectangle))
 		       (let ((colspan-fill-line
-			      (make-string (aref table-colwidth i) ? )))
+			      (make-string (abs (aref table-colwidth i)) ? )))
 			 (case valign
 			   ((center middle)
 			    (aset formatted-cols i
@@ -1481,6 +1492,7 @@
 	(content-stack (list (list node)))
 	(right-margin-stack (list fill-column))
 	(left-margin-stack (list 0))
+	;; (inhibit-read-only t)
 	node
 	insert-before
 	insert-after
@@ -1600,9 +1612,9 @@
 				      (list 'link :args nil
 					    :value "" :tag ""
 					    :action 'w3-follow-hyperlink
-					    :from
-					    (set-marker (make-marker) st)
+					    :from (set-marker (make-marker) st)
 					    :help-echo 'w3-widget-echo
+					    :emacspeak-help 'w3-widget-echo
 					    )
 				      (alist-to-plist args))))
 	       (w3-handle-content node)
@@ -1751,7 +1763,8 @@
 				      (or w3-maximum-line-length
 					  (window-width)))
 		     fill-prefix "")
-	       (set (make-local-variable 'inhibit-read-only) t))
+	       ;; (set (make-local-variable 'inhibit-read-only) t)
+	       )
 	     (w3-handle-content node)
 	     )
 	    (*invisible
@@ -1808,25 +1821,25 @@
 					       w3-current-form-number)
 					 args))
 	       (w3-handle-content node)))
-	    (keygen
-	     (w3-form-add-element 'keygen
-				  (or (w3-get-attribute 'name)
-				      (w3-get-attribute 'id)
-				      "keygen")
-				  nil	; value
-				  nil	; size
-				  nil	; maxlength
-				  nil   ; default
-				  w3-display-form-id ; action
-				  nil	; options
-				  w3-current-form-number
-				  (w3-get-attribute 'id) ; id
-				  nil	; checked
-				  (car w3-active-faces)))
+;	    (keygen
+;	     (w3-form-add-element 'keygen
+;				  (or (w3-get-attribute 'name)
+;				      (w3-get-attribute 'id)
+;				      "keygen")
+;				  nil	; value
+;				  nil	; size
+;				  nil	; maxlength
+;				  nil   ; default
+;				  w3-display-form-id ; action
+;				  nil	; options
+;				  w3-current-form-number
+;				  (w3-get-attribute 'id) ; id
+;				  nil	; checked
+;				  (car w3-active-faces)))
 	    (input
 	     (w3-form-add-element
 	      (w3-display-normalize-form-info args)
-	      (car w3-active-faces))
+	      w3-active-faces)
 	     (w3-handle-empty-tag)
 	     )
 	    (select
@@ -1870,7 +1883,7 @@
 		     (w3-handle-content node))
 		 (setq plist (plist-put plist 'type 'option)
 		       plist (plist-put plist 'options options))
-		 (w3-form-add-element plist (car w3-active-faces))
+		 (w3-form-add-element plist 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.
@@ -1882,7 +1895,7 @@
 			    (apply 'concat (nth 2 node)))))
 	       (setq plist (plist-put plist 'type 'multiline)
 		     plist (plist-put plist 'value value))
-	       (w3-form-add-element plist (car w3-active-faces)))
+	       (w3-form-add-element plist w3-active-faces))
 	     (w3-handle-empty-tag)
 	     )
 	    (style
@@ -1954,34 +1967,46 @@
     (- nd st)))
 
 
+(defun w3-fixup-eol-faces ()
+  ;; Remove 'face property at end of lines - underlining screws up stuff
+  (let ((inhibit-read-only t))
+    (save-excursion
+      (goto-char (point-min))
+      (while (search-forward "\n" nil t)
+	(put-text-property (match-beginning 0) (match-end 0) 'face nil)))))
+
 (defsubst w3-finish-drawing ()
-  (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-handle-annotations)
-    ;;(w3-handle-headers)
-    )
+  (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)))
+      (condition-case nil
+	  (widget-value-set widget glyph)
+	(error nil))))
+  (and (not w3-running-xemacs)
+       (not (eq (device-type) 'tty))
+       (w3-fixup-eol-faces))
+  ;;(w3-handle-headers)
   )
 
 (defun w3-region (st nd)
   (if (not w3-setup-done) (w3-do-setup))
   (let* ((source (buffer-substring st nd))
-	 (w3-display-same-buffer t)
+	 (w3-dislplay-same-buffer t)
 	 (parse nil))
-    (save-excursion
-      (set-buffer (get-buffer-create " *w3-region*"))
-      (erase-buffer)
-      (insert source)
-      (setq parse (w3-parse-buffer (current-buffer))))
-    (narrow-to-region st nd)
-    (delete-region (point-min) (point-max))
-    (w3-draw-tree parse)
-    (w3-finish-drawing)))
+    (save-window-excursion
+      (save-excursion
+	(set-buffer (get-buffer-create " *w3-region*"))
+	(erase-buffer)
+	(insert source)
+	(setq parse (w3-parse-buffer (current-buffer))))
+      (narrow-to-region st nd)
+      (delete-region (point-min) (point-max))
+      (w3-draw-tree parse)
+      (w3-finish-drawing)
+      (widen))))
 
 (defun w3-refresh-buffer ()
   (interactive)