Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 6a378aca36af
children 360340f9fd5f
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
1 ;;; w3-widget.el --- An image widget 1 ;;; w3-widget.el --- An image widget
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/01/17 22:09:43 3 ;; Created: 1997/02/09 06:37:14
4 ;; Version: 1.16 4 ;; Version: 1.18
5 ;; Keywords: faces, images 5 ;; Keywords: faces, images
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
146 'usemap (widget-get widget 'usemap) 146 'usemap (widget-get widget 'usemap)
147 'href href 147 'href href
148 'src (widget-get widget 'src) 148 'src (widget-get widget 'src)
149 'ismap server-map))) 149 'ismap server-map)))
150 150
151 (defun widget-image-emacspeak-tty-imagemap (usemap)
152 (let* ((default nil)
153 (href nil)
154 (tag nil)
155 (options (delete
156 nil
157 (mapcar
158 (function
159 (lambda (x)
160 (if (eq (aref x 0) 'default)
161 (setq default (aref x 2)))
162 (if (and (not default) (stringp (aref x 2)))
163 (setq default (aref x 2)))
164 (setq tag (or (aref x 3) (aref x 2))
165 href (aref x 2))
166 (and (stringp tag)
167 (stringp href)
168 (list 'a
169 (list
170 (cons 'href href)
171 (cons
172 'class
173 (list
174 (if (url-have-visited-url href)
175 ":visited" ":link"))))
176 (list tag)))))
177 usemap))))
178 (w3-display-node (list 'table '((border . "1"))
179 (w3-display-chop-into-table
180 (list nil nil options) 3)))))
181
151 (defun widget-image-value-create (widget) 182 (defun widget-image-value-create (widget)
152 ;; Insert the printed representation of the value 183 ;; Insert the printed representation of the value
153 (let ( 184 (let (
154 (href (widget-get widget 'href)) 185 (href (widget-get widget 'href))
155 (server-map (widget-get widget 'ismap)) 186 (server-map (widget-get widget 'ismap))
175 (save-excursion 206 (save-excursion
176 (if (= 0 (length alt)) (setq alt nil)) 207 (if (= 0 (length alt)) (setq alt nil))
177 (goto-char where) 208 (goto-char where)
178 (cond 209 (cond
179 (client-map 210 (client-map
180 (let* ((default nil) 211 (if (featurep 'emacspeak)
181 (options (mapcar 212 (widget-image-emacspeak-tty-imagemap client-map)
182 (function 213 (let* ((default nil)
183 (lambda (x) 214 (href nil)
184 (if (eq (aref x 0) 'default) 215 (tag nil)
185 (setq default (aref x 2))) 216 (options (mapcar
186 (if (and (not default) (stringp (aref x 2))) 217 (function
187 (setq default (aref x 2))) 218 (lambda (x)
188 (list 'choice-item 219 (if (eq (aref x 0) 'default)
189 :format "%[%t%]" 220 (setq default (aref x 2)))
190 :tag (or (aref x 3) (aref x 2)) 221 (if (and (not default) (stringp (aref x 2)))
191 :value (aref x 2)))) client-map))) 222 (setq default (aref x 2)))
192 (setq real-widget 223 (list 'choice-item
193 (apply 'widget-create 'menu-choice 224 :format "%[%t%]"
194 :tag (or (widget-get widget :tag) "Imagemap") 225 :tag (or (aref x 3) (aref x 2))
195 :notify (widget-get widget :notify) 226 :value (aref x 2)))) client-map)))
196 :action (widget-get widget :action) 227 (setq real-widget
197 :value default 228 (apply 'widget-create 'menu-choice
198 :parent widget 229 :tag (or (widget-get widget :tag) "Imagemap")
199 :help-echo 'widget-image-summarize 230 :notify (widget-get widget :notify)
200 options)))) 231 :action (widget-get widget :action)
232 :value default
233 :parent widget
234 :help-echo 'widget-image-summarize
235 options)))))
201 ((and server-map (stringp href)) 236 ((and server-map (stringp href))
202 (setq real-widget 237 (setq real-widget
203 (widget-image-create-subwidget 238 (widget-image-create-subwidget
204 'push-button :tag alt 239 'push-button :tag alt
205 :delete 'widget-default-delete 240 :delete 'widget-default-delete
332 (usemap ; Dummed-down tty client side imap 367 (usemap ; Dummed-down tty client side imap
333 (let ((choices (mapcar (function 368 (let ((choices (mapcar (function
334 (lambda (entry) 369 (lambda (entry)
335 (cons 370 (cons
336 (or (aref entry 3) (aref entry 2)) 371 (or (aref entry 3) (aref entry 2))
337 (aref entry 3)))) usemap)) 372 (aref entry 2)))) usemap))
338 (choice nil)) 373 (choice nil))
339 (setq choice (completing-read "Imagemap: " choices nil t)) 374 (setq choice (completing-read "Imagemap: " choices nil t)
375 choice (cdr-safe (assoc choice choices)))
340 (and (stringp choice) (w3-fetch choice)))) 376 (and (stringp choice) (w3-fetch choice))))
341 (ismap ; Do server-side dummy imagemap for tty 377 (ismap ; Do server-side dummy imagemap for tty
342 (w3-fetch (concat href "?0,0"))) 378 (w3-fetch (concat href "?0,0")))
343 ((stringp href) ; Normal hyperlink 379 ((stringp href) ; Normal hyperlink
344 (w3-fetch href)) 380 (w3-fetch href))