Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-widget.el @ 46:6a22abad6937 r19-15

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15
author cvs
date Mon, 13 Aug 2007 08:55:31 +0200
parents 8d2a9b52c682
children 131b0175ea99
comparison
equal deleted inserted replaced
45:7705b7aa3b8a 46:6a22abad6937
1 ;;; w3-widget.el --- An image widget 1 ;;; w3-widget.el --- An image widget
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/03/25 23:35:03 3 ;; Created: 1997/03/26 15:31:17
4 ;; Version: 1.25 4 ;; Version: 1.27
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.
145 (if (and usemap (string-match "^#" usemap)) 145 (if (and usemap (string-match "^#" usemap))
146 (setq usemap (substring usemap 1 nil))) 146 (setq usemap (substring usemap 1 nil)))
147 (cdr-safe (assoc usemap w3-imagemaps))))) 147 (cdr-safe (assoc usemap w3-imagemaps)))))
148 148
149 (defun widget-image-callback (widget widget-ignore &optional event) 149 (defun widget-image-callback (widget widget-ignore &optional event)
150 (and (widget-get widget 'href) (w3-fetch (widget-get widget 'href) (widget-get widget 'target)))) 150 (if (widget-get widget 'href)
151 (w3-fetch (widget-get widget 'href) (widget-get widget 'target))))
151 152
152 (defmacro widget-image-create-subwidget (&rest args) 153 (defmacro widget-image-create-subwidget (&rest args)
153 (` (widget-create (,@ args) 154 (` (widget-create (,@ args)
154 :parent widget 155 :parent widget
155 :help-echo 'widget-image-summarize 156 :help-echo 'widget-image-summarize
186 (if (= 0 (length alt)) (setq alt nil)) 187 (if (= 0 (length alt)) (setq alt nil))
187 (goto-char where) 188 (goto-char where)
188 (cond 189 (cond
189 (client-map 190 (client-map
190 (let* ((default nil) 191 (let* ((default nil)
191 (href nil)
192 (tag nil)
193 (options (mapcar 192 (options (mapcar
194 (function 193 (function
195 (lambda (x) 194 (lambda (x)
196 (if (eq (aref x 0) 'default) 195 (if (eq (aref x 0) 'default)
197 (setq default (aref x 2))) 196 (setq default (aref x 2)))
202 :tag (or (aref x 3) (aref x 2)) 201 :tag (or (aref x 3) (aref x 2))
203 :value (aref x 2)))) client-map))) 202 :value (aref x 2)))) client-map)))
204 (setq real-widget 203 (setq real-widget
205 (apply 'widget-create 'menu-choice 204 (apply 'widget-create 'menu-choice
206 :tag (or (widget-get widget :tag) "Imagemap") 205 :tag (or (widget-get widget :tag) "Imagemap")
206 :ignore-case t
207 :notify (widget-get widget :notify) 207 :notify (widget-get widget :notify)
208 :action (widget-get widget :action) 208 :action (widget-get widget :action)
209 :value default 209 :value default
210 :parent widget 210 :parent widget
211 :help-echo 'widget-image-summarize 211 :help-echo 'widget-image-summarize
246 (set-extent-endpoints extent where where) 246 (set-extent-endpoints extent where where)
247 (widget-put widget 'extent extent) 247 (widget-put widget 'extent extent)
248 (widget-put widget :children nil) 248 (widget-put widget :children nil)
249 (set-extent-property extent 'keymap widget-image-keymap) 249 (set-extent-property extent 'keymap widget-image-keymap)
250 (set-extent-property extent 'begin-glyph glyph) 250 (set-extent-property extent 'begin-glyph glyph)
251 (set-extent-property extent 'detachable t)
251 (set-extent-property extent 'help-echo (cond 252 (set-extent-property extent 'help-echo (cond
252 ((and href (or client-map 253 ((and href (or client-map
253 server-map)) 254 server-map))
254 (format "%s [map]" href)) 255 (format "%s [map]" href))
255 (href href) 256 (href href)
296 (setq widget (widget-get widget :parent))) 297 (setq widget (widget-get widget :parent)))
297 (let* ((ismap (widget-get widget 'ismap)) 298 (let* ((ismap (widget-get widget 'ismap))
298 (usemap (widget-image-usemap widget)) 299 (usemap (widget-image-usemap widget))
299 (href (widget-get widget 'href)) 300 (href (widget-get widget 'href))
300 (alt (widget-get widget 'alt)) 301 (alt (widget-get widget 'alt))
301 (value (widget-value widget)) 302 (value (widget-value widget)))
302 (i nil))
303 (cond 303 (cond
304 (usemap 304 (usemap
305 (setq i (length usemap) 305 (setq usemap (widget-image-usemap-default usemap))
306 usemap (widget-image-usemap-default usemap))
307 ;; Perhaps we should do something here with showing the # of entries 306 ;; Perhaps we should do something here with showing the # of entries
308 ;; in the imagemap as well as the default href? Could get too long. 307 ;; in the imagemap as well as the default href? Could get too long.
309 (format "Client side imagemap: %s" value)) 308 (format "Client side imagemap: %s" value))
310 (ismap 309 (ismap
311 (format "Server side imagemap: %s" href)) 310 (format "Server side imagemap: %s" href))
333 (ismap (widget-get widget 'ismap)) 332 (ismap (widget-get widget 'ismap))
334 (usemap (widget-image-usemap widget)) 333 (usemap (widget-image-usemap widget))
335 (href (widget-get widget 'href)) 334 (href (widget-get widget 'href))
336 (img-src (or (widget-get widget 'src) 335 (img-src (or (widget-get widget 'src)
337 (and widget-changed (widget-get widget-changed 'src)))) 336 (and widget-changed (widget-get widget-changed 'src))))
338 (value (widget-value widget))
339 (target (widget-get widget 'target)) 337 (target (widget-get widget 'target))
340 ) 338 )
341 (cond 339 (cond
342 ((and glyph usemap) ; Do the client-side imagemap stuff 340 ((and glyph usemap) ; Do the client-side imagemap stuff
343 (setq href (w3-point-in-map (vector x y) usemap nil)) 341 (setq href (w3-point-in-map (vector x y) usemap nil))
350 (let ((choices (mapcar (function 348 (let ((choices (mapcar (function
351 (lambda (entry) 349 (lambda (entry)
352 (cons 350 (cons
353 (or (aref entry 3) (aref entry 2)) 351 (or (aref entry 3) (aref entry 2))
354 (aref entry 2)))) usemap)) 352 (aref entry 2)))) usemap))
355 (choice nil)) 353 (choice nil)
354 (case-fold-search t))
356 (setq choice (completing-read "Imagemap: " choices nil t) 355 (setq choice (completing-read "Imagemap: " choices nil t)
357 choice (cdr-safe (assoc choice choices))) 356 choice (cdr-safe (assoc choice choices)))
358 (and (stringp choice) (w3-fetch choice target)))) 357 (and (stringp choice) (w3-fetch choice target))))
359 (ismap ; Do server-side dummy imagemap for tty 358 (ismap ; Do server-side dummy imagemap for tty
360 (w3-fetch (concat href "?0,0") target)) 359 (w3-fetch (concat href "?0,0") target))