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

Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 6a378aca36af
children 360340f9fd5f
line wrap: on
line diff
--- a/lisp/w3/w3-widget.el	Mon Aug 13 09:12:43 2007 +0200
+++ b/lisp/w3/w3-widget.el	Mon Aug 13 09:13:56 2007 +0200
@@ -1,7 +1,7 @@
 ;;; w3-widget.el --- An image widget
 ;; Author: wmperry
-;; Created: 1997/01/17 22:09:43
-;; Version: 1.16
+;; Created: 1997/02/09 06:37:14
+;; Version: 1.18
 ;; Keywords: faces, images
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -148,6 +148,37 @@
 		    'src (widget-get widget 'src)
 		    'ismap server-map)))
 
+(defun widget-image-emacspeak-tty-imagemap (usemap)
+  (let* ((default nil)
+	 (href nil)
+	 (tag nil)
+	 (options (delete
+		   nil
+		   (mapcar
+		    (function
+		     (lambda (x)
+		       (if (eq (aref x 0) 'default)
+			   (setq default (aref x 2)))
+		       (if (and (not default) (stringp (aref x 2)))
+			   (setq default (aref x 2)))
+		       (setq tag (or (aref x 3) (aref x 2))
+			     href (aref x 2))
+		       (and (stringp tag)
+			    (stringp href)
+			    (list 'a
+				  (list
+				   (cons 'href href)
+				   (cons
+				    'class
+				    (list
+				     (if (url-have-visited-url href)
+					 ":visited" ":link"))))
+				  (list tag)))))
+		    usemap))))
+    (w3-display-node (list 'table '((border . "1"))
+			   (w3-display-chop-into-table
+			    (list nil nil options) 3)))))
+
 (defun widget-image-value-create (widget)
   ;; Insert the printed representation of the value
   (let (
@@ -177,27 +208,31 @@
 	  (goto-char where)
 	  (cond
 	   (client-map
-	    (let* ((default nil)
-		   (options (mapcar
-			     (function
-			      (lambda (x)
-				(if (eq (aref x 0) 'default)
-				    (setq default (aref x 2)))
-				(if (and (not default) (stringp (aref x 2)))
-				    (setq default (aref x 2)))
-				(list 'choice-item
-				      :format "%[%t%]"
-				      :tag (or (aref x 3) (aref x 2))
-				      :value (aref x 2)))) client-map)))
-	      (setq real-widget
-		    (apply 'widget-create 'menu-choice
-			   :tag (or (widget-get widget :tag) "Imagemap")
-			   :notify (widget-get widget :notify)
-			   :action (widget-get widget :action)
-			   :value default
-			   :parent widget
-			   :help-echo 'widget-image-summarize
-			   options))))
+	    (if (featurep 'emacspeak)
+		(widget-image-emacspeak-tty-imagemap client-map)
+	      (let* ((default nil)
+		     (href nil)
+		     (tag nil)
+		     (options (mapcar
+			       (function
+				(lambda (x)
+				  (if (eq (aref x 0) 'default)
+				      (setq default (aref x 2)))
+				  (if (and (not default) (stringp (aref x 2)))
+				      (setq default (aref x 2)))
+				  (list 'choice-item
+					:format "%[%t%]"
+					:tag (or (aref x 3) (aref x 2))
+					:value (aref x 2)))) client-map)))
+		(setq real-widget
+		      (apply 'widget-create 'menu-choice
+			     :tag (or (widget-get widget :tag) "Imagemap")
+			     :notify (widget-get widget :notify)
+			     :action (widget-get widget :action)
+			     :value default
+			     :parent widget
+			     :help-echo 'widget-image-summarize
+			     options)))))
 	   ((and server-map (stringp href))
 	    (setq real-widget
 		  (widget-image-create-subwidget
@@ -334,9 +369,10 @@
 			      (lambda (entry)
 				(cons
 				 (or (aref entry 3) (aref entry 2))
-				 (aref entry 3)))) usemap))
+				 (aref entry 2)))) usemap))
 	    (choice nil))
-	(setq choice (completing-read "Imagemap: " choices nil t))
+	(setq choice (completing-read "Imagemap: " choices nil t)
+	      choice (cdr-safe (assoc choice choices)))
 	(and (stringp choice) (w3-fetch choice))))
      (ismap				; Do server-side dummy imagemap for tty
       (w3-fetch (concat href "?0,0")))