Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-widget.el @ 30:ec9a17fef872 r19-15b98

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b98
author cvs
date Mon, 13 Aug 2007 08:52:29 +0200
parents 859a2309aef8
children e04119814345
comparison
equal deleted inserted replaced
29:7976500f47f9 30:ec9a17fef872
1 ;;; w3-widget.el --- An image widget 1 ;;; w3-widget.el --- An image widget
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/02/09 06:37:14 3 ;; Created: 1997/03/05 23:37:58
4 ;; Version: 1.18 4 ;; Version: 1.20
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.
70 widget-mouse-button3 'return)) 70 widget-mouse-button3 'return))
71 (setq widget-mouse-button1 'mouse-1 71 (setq widget-mouse-button1 'mouse-1
72 widget-mouse-button2 'mouse-2 72 widget-mouse-button2 'mouse-2
73 widget-mouse-button3 'mouse-3)) 73 widget-mouse-button3 'mouse-3))
74 74
75 (defvar widget-image-inaudible-p nil
76 "*Whether to make images inaudible or not.")
77
75 (define-key widget-image-keymap (vector widget-mouse-button1) 78 (define-key widget-image-keymap (vector widget-mouse-button1)
76 'widget-image-button-press) 79 'widget-image-button-press)
77 (define-key widget-image-keymap (vector widget-mouse-button2) 80 (define-key widget-image-keymap (vector widget-mouse-button2)
78 'widget-image-button-press) 81 'widget-image-button-press)
79 82
124 (save-excursion 127 (save-excursion
125 (widget-image-delete widget) 128 (widget-image-delete widget)
126 (if (widget-glyphp value) 129 (if (widget-glyphp value)
127 (widget-put widget 'glyph value) 130 (widget-put widget 'glyph value)
128 (widget-put widget :value value)) 131 (widget-put widget :value value))
129 (widget-apply widget :create))) 132 (put-text-property (point)
133 (progn
134 (widget-apply widget :create)
135 (point))
136 'inaudible
137 widget-image-inaudible-p)))
130 138
131 (defsubst widget-image-usemap (widget) 139 (defsubst widget-image-usemap (widget)
132 (let ((usemap (widget-get widget 'usemap))) 140 (let ((usemap (widget-get widget 'usemap)))
133 (if (listp usemap) 141 (if (listp usemap)
134 usemap 142 usemap
135 (if (and usemap (string-match "^#" usemap)) 143 (if (and usemap (string-match "^#" usemap))
136 (setq usemap (substring usemap 1 nil))) 144 (setq usemap (substring usemap 1 nil)))
137 (cdr-safe (assoc usemap w3-imagemaps))))) 145 (cdr-safe (assoc usemap w3-imagemaps)))))
138 146
139 (defun widget-image-callback (widget widget-ignore &optional event) 147 (defun widget-image-callback (widget widget-ignore &optional event)
140 (and (widget-get widget 'href) (w3-fetch (widget-get widget 'href)))) 148 (and (widget-get widget 'href) (w3-fetch (widget-get widget 'href) (widget-get widget 'target))))
141 149
142 (defmacro widget-image-create-subwidget (&rest args) 150 (defmacro widget-image-create-subwidget (&rest args)
143 (` (widget-create (,@ args) 151 (` (widget-create (,@ args)
144 :parent widget 152 :parent widget
145 :help-echo 'widget-image-summarize 153 :help-echo 'widget-image-summarize
353 (usemap (widget-image-usemap widget)) 361 (usemap (widget-image-usemap widget))
354 (href (widget-get widget 'href)) 362 (href (widget-get widget 'href))
355 (img-src (or (widget-get widget 'src) 363 (img-src (or (widget-get widget 'src)
356 (and widget-changed (widget-get widget-changed 'src)))) 364 (and widget-changed (widget-get widget-changed 'src))))
357 (value (widget-value widget)) 365 (value (widget-value widget))
366 (target (widget-get widget 'target))
358 ) 367 )
359 (cond 368 (cond
360 ((and glyph usemap) ; Do the client-side imagemap stuff 369 ((and glyph usemap) ; Do the client-side imagemap stuff
361 (setq href (w3-point-in-map (vector x y) usemap nil)) 370 (setq href (w3-point-in-map (vector x y) usemap nil))
362 (if (stringp href) 371 (if (stringp href)
363 (w3-fetch href) 372 (w3-fetch href target)
364 (message "No destination found for %d,%d" x y))) 373 (message "No destination found for %d,%d" x y)))
365 ((and glyph x y ismap) ; Do the server-side imagemap stuff 374 ((and glyph x y ismap) ; Do the server-side imagemap stuff
366 (w3-fetch (format "%s?%d,%d" href x y))) 375 (w3-fetch (format "%s?%d,%d" href x y) target))
367 (usemap ; Dummed-down tty client side imap 376 (usemap ; Dummed-down tty client side imap
368 (let ((choices (mapcar (function 377 (let ((choices (mapcar (function
369 (lambda (entry) 378 (lambda (entry)
370 (cons 379 (cons
371 (or (aref entry 3) (aref entry 2)) 380 (or (aref entry 3) (aref entry 2))
372 (aref entry 2)))) usemap)) 381 (aref entry 2)))) usemap))
373 (choice nil)) 382 (choice nil))
374 (setq choice (completing-read "Imagemap: " choices nil t) 383 (setq choice (completing-read "Imagemap: " choices nil t)
375 choice (cdr-safe (assoc choice choices))) 384 choice (cdr-safe (assoc choice choices)))
376 (and (stringp choice) (w3-fetch choice)))) 385 (and (stringp choice) (w3-fetch choice target))))
377 (ismap ; Do server-side dummy imagemap for tty 386 (ismap ; Do server-side dummy imagemap for tty
378 (w3-fetch (concat href "?0,0"))) 387 (w3-fetch (concat href "?0,0") target))
379 ((stringp href) ; Normal hyperlink 388 ((stringp href) ; Normal hyperlink
380 (w3-fetch href)) 389 (w3-fetch href target))
381 ((stringp img-src) 390 ((stringp img-src)
382 (cond 391 (cond
383 ((null widget-image-auto-retrieve) nil) 392 ((null widget-image-auto-retrieve) nil)
384 ((eq t widget-image-auto-retrieve) 393 ((eq t widget-image-auto-retrieve)
385 (w3-fetch img-src)) 394 (w3-fetch img-src))