Mercurial > hg > xemacs-beta
comparison lisp/w3/w3-widget.el @ 82:6a378aca36af r20-0b91
Import from CVS: tag r20-0b91
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:07:36 +0200 |
parents | 1ce6082ce73f |
children | 0d2f883870bc |
comparison
equal
deleted
inserted
replaced
81:ebca3d831cea | 82:6a378aca36af |
---|---|
1 ;;; w3-widget.el --- An image widget | 1 ;;; w3-widget.el --- An image widget |
2 ;; Author: wmperry | 2 ;; Author: wmperry |
3 ;; Created: 1996/12/29 01:27:32 | 3 ;; Created: 1997/01/17 22:09:43 |
4 ;; Version: 1.12 | 4 ;; Version: 1.16 |
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 Free Software Foundation, Inc. | 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. |
10 ;;; | 10 ;;; |
11 ;;; This file is part of GNU Emacs. | 11 ;;; This file is part of GNU Emacs. |
12 ;;; | 12 ;;; |
13 ;;; GNU Emacs is free software; you can redistribute it and/or modify | 13 ;;; GNU Emacs is free software; you can redistribute it and/or modify |
14 ;;; it under the terms of the GNU General Public License as published by | 14 ;;; it under the terms of the GNU General Public License as published by |
300 ((stringp value) | 300 ((stringp value) |
301 (format "Image: %s" value)) | 301 (format "Image: %s" value)) |
302 (t ; Huh? | 302 (t ; Huh? |
303 "A very confused image widget.")))) | 303 "A very confused image widget.")))) |
304 | 304 |
305 (defvar widget-image-auto-retrieve 'ask | |
306 "*Whether to automatically retrieve the source of an image widget | |
307 if it is not an active hyperlink or imagemap. | |
308 If `nil', don't do anything. | |
309 If `t', automatically retrieve the source. | |
310 Any other value means ask the user each time.") | |
311 | |
305 (defun widget-image-notify (widget widget-changed &optional event) | 312 (defun widget-image-notify (widget widget-changed &optional event) |
306 ;; Happens when anything changes | 313 ;; Happens when anything changes |
307 (let* ((glyph (and event (widget-mouse-event-p event) (event-glyph event))) | 314 (let* ((glyph (and event (widget-mouse-event-p event) (event-glyph event))) |
308 (x (and glyph (event-glyph-x-pixel event))) | 315 (x (and glyph (event-glyph-x-pixel event))) |
309 (y (and glyph (event-glyph-y-pixel event))) | 316 (y (and glyph (event-glyph-y-pixel event))) |
310 (ismap (widget-get widget 'ismap)) | 317 (ismap (widget-get widget 'ismap)) |
311 (usemap (widget-image-usemap widget)) | 318 (usemap (widget-image-usemap widget)) |
312 (href (widget-get widget 'href)) | 319 (href (widget-get widget 'href)) |
320 (img-src (or (widget-get widget 'src) | |
321 (and widget-changed (widget-get widget-changed 'src)))) | |
313 (value (widget-value widget)) | 322 (value (widget-value widget)) |
314 ) | 323 ) |
315 (cond | 324 (cond |
316 ((and glyph usemap) ; Do the client-side imagemap stuff | 325 ((and glyph usemap) ; Do the client-side imagemap stuff |
317 (setq href (w3-point-in-map (vector x y) usemap nil)) | 326 (setq href (w3-point-in-map (vector x y) usemap nil)) |
318 (if href | 327 (if (stringp href) |
319 (w3-fetch href) | 328 (w3-fetch href) |
320 (message "No destination found for %d,%d" x y))) | 329 (message "No destination found for %d,%d" x y))) |
321 ((and glyph x y ismap) ; Do the server-side imagemap stuff | 330 ((and glyph x y ismap) ; Do the server-side imagemap stuff |
322 (w3-fetch (format "%s?%d,%d" href x y))) | 331 (w3-fetch (format "%s?%d,%d" href x y))) |
323 (usemap ; Dummed-down tty client side imap | 332 (usemap ; Dummed-down tty client side imap |
324 (w3-fetch value)) | 333 (let ((choices (mapcar (function |
334 (lambda (entry) | |
335 (cons | |
336 (or (aref entry 3) (aref entry 2)) | |
337 (aref entry 3)))) usemap)) | |
338 (choice nil)) | |
339 (setq choice (completing-read "Imagemap: " choices nil t)) | |
340 (and (stringp choice) (w3-fetch choice)))) | |
325 (ismap ; Do server-side dummy imagemap for tty | 341 (ismap ; Do server-side dummy imagemap for tty |
326 (w3-fetch (concat href "?0,0"))) | 342 (w3-fetch (concat href "?0,0"))) |
327 ((stringp href) ; Normal hyperlink | 343 ((stringp href) ; Normal hyperlink |
328 (w3-fetch href)) | 344 (w3-fetch href)) |
345 ((stringp img-src) | |
346 (cond | |
347 ((null widget-image-auto-retrieve) nil) | |
348 ((eq t widget-image-auto-retrieve) | |
349 (w3-fetch img-src)) | |
350 ((funcall url-confirmation-func | |
351 (format "Retrieve image (%s)?" | |
352 (url-truncate-url-for-viewing img-src))) | |
353 (w3-fetch img-src)))) | |
329 (t ; Huh? | 354 (t ; Huh? |
330 nil)))) | 355 nil)))) |
331 | 356 |
332 (provide 'w3-widget) | 357 (provide 'w3-widget) |