Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-widget.el @ 44:8d2a9b52c682 r19-15prefinal

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15prefinal
author cvs
date Mon, 13 Aug 2007 08:55:10 +0200
parents e04119814345
children 6a22abad6937
comparison
equal deleted inserted replaced
43:23cafc5d2038 44:8d2a9b52c682
1 ;;; w3-widget.el --- An image widget 1 ;;; w3-widget.el --- An image widget
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/03/11 15:40:22 3 ;; Created: 1997/03/25 23:35:03
4 ;; Version: 1.23 4 ;; Version: 1.25
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.
156 'usemap (widget-get widget 'usemap) 156 'usemap (widget-get widget 'usemap)
157 'href href 157 'href href
158 'src (widget-get widget 'src) 158 'src (widget-get widget 'src)
159 'ismap server-map))) 159 'ismap server-map)))
160 160
161 (defun widget-image-emacspeak-tty-imagemap (usemap)
162 (let* ((default nil)
163 (href nil)
164 (tag nil)
165 (options (delete
166 nil
167 (mapcar
168 (function
169 (lambda (x)
170 (if (eq (aref x 0) 'default)
171 (setq default (aref x 2)))
172 (if (and (not default) (stringp (aref x 2)))
173 (setq default (aref x 2)))
174 (setq tag (or (aref x 3) (aref x 2))
175 href (aref x 2))
176 (and (stringp tag)
177 (stringp href)
178 (list 'a
179 (list
180 (cons 'href href)
181 (cons
182 'class
183 (list
184 (if (url-have-visited-url href)
185 ":visited" ":link"))))
186 (list tag)))))
187 usemap))))
188 (w3-display-node (list 'table '((border . "1"))
189 (w3-display-chop-into-table
190 (list nil nil options) 3)))))
191
192 (defun widget-image-value-create (widget) 161 (defun widget-image-value-create (widget)
193 ;; Insert the printed representation of the value 162 ;; Insert the printed representation of the value
194 (let ( 163 (let (
195 (href (widget-get widget 'href)) 164 (href (widget-get widget 'href))
196 (server-map (widget-get widget 'ismap)) 165 (server-map (widget-get widget 'ismap))
216 (save-excursion 185 (save-excursion
217 (if (= 0 (length alt)) (setq alt nil)) 186 (if (= 0 (length alt)) (setq alt nil))
218 (goto-char where) 187 (goto-char where)
219 (cond 188 (cond
220 (client-map 189 (client-map
221 (if (featurep 'emacspeak) 190 (let* ((default nil)
222 (widget-image-emacspeak-tty-imagemap client-map) 191 (href nil)
223 (let* ((default nil) 192 (tag nil)
224 (href nil) 193 (options (mapcar
225 (tag nil) 194 (function
226 (options (mapcar 195 (lambda (x)
227 (function 196 (if (eq (aref x 0) 'default)
228 (lambda (x) 197 (setq default (aref x 2)))
229 (if (eq (aref x 0) 'default) 198 (if (and (not default) (stringp (aref x 2)))
230 (setq default (aref x 2))) 199 (setq default (aref x 2)))
231 (if (and (not default) (stringp (aref x 2))) 200 (list 'choice-item
232 (setq default (aref x 2))) 201 :format "%[%t%]"
233 (list 'choice-item 202 :tag (or (aref x 3) (aref x 2))
234 :format "%[%t%]" 203 :value (aref x 2)))) client-map)))
235 :tag (or (aref x 3) (aref x 2)) 204 (setq real-widget
236 :value (aref x 2)))) client-map))) 205 (apply 'widget-create 'menu-choice
237 (setq real-widget 206 :tag (or (widget-get widget :tag) "Imagemap")
238 (apply 'widget-create 'menu-choice 207 :notify (widget-get widget :notify)
239 :tag (or (widget-get widget :tag) "Imagemap") 208 :action (widget-get widget :action)
240 :notify (widget-get widget :notify) 209 :value default
241 :action (widget-get widget :action) 210 :parent widget
242 :value default 211 :help-echo 'widget-image-summarize
243 :parent widget 212 options))))
244 :help-echo 'widget-image-summarize
245 options)))))
246 ((and server-map (stringp href)) 213 ((and server-map (stringp href))
247 (setq real-widget 214 (setq real-widget
248 (widget-image-create-subwidget 215 (widget-image-create-subwidget
249 'push-button 216 'item :format "%[%t%]"
250 :tag alt 217 :tag alt
251 :delete 'widget-default-delete 218 :delete 'widget-default-delete
252 :value href 219 :value href
253 :action (widget-get widget :action) 220 :action (widget-get widget :action)
254 :notify (widget-get widget :notify)))) 221 :notify (widget-get widget :notify))))
255 (href 222 (href
256 (setq real-widget 223 (setq real-widget
257 (widget-image-create-subwidget 224 (widget-image-create-subwidget
258 'push-button :tag (or alt "Image") 225 'item :format "%[%t%]"
226 :tag (or alt "Image")
259 :value href 227 :value href
260 :delete 'widget-default-delete 228 :delete 'widget-default-delete
261 :action (widget-get widget :action) 229 :action (widget-get widget :action)
262 :notify 'widget-image-callback))) 230 :notify 'widget-image-callback)))
263 (alt 231 (alt
264 (setq real-widget 232 (setq real-widget
265 (widget-image-create-subwidget 233 (widget-image-create-subwidget
266 'push-button :tag alt :format "%[%t%]" 234 'item :format "%[%t%]"
235 :tag alt
267 :tab-order -1 236 :tab-order -1
268 :delete 'widget-default-delete 237 :delete 'widget-default-delete
269 :action (widget-get widget :action) 238 :action (widget-get widget :action)
270 :notify 'widget-image-callback)))) 239 :notify 'widget-image-callback))))
271 (if (not real-widget) 240 (if (not real-widget)