Update FSF street address; nfc.

[bpt/emacs.git] / lisp / net / eudc-bob.el

diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index bd1060d..668b9ed 100644 (file)
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -1,9 +1,10 @@
 ;;; eudc-bob.el --- Binary Objects Support for EUDC
 
-;; Copyright (C) 1999, 2000, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 
-;; Author: Oscar Figueiredo <oscar@xemacs.org>
-;; Maintainer: Oscar Figueiredo <oscar@xemacs.org>
+;; Author: Oscar Figueiredo <oscar@cpe.fr>
+;; Maintainer: Pavel Janík <Pavel@Janik.cz>
 ;; Keywords: comm
 
 ;; This file is part of GNU Emacs.
@@ -20,8 +21,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -44,6 +45,9 @@
 (defvar eudc-bob-url-keymap nil
   "Keymap for inline urls.")
 
+(defvar eudc-bob-mail-keymap nil
+  "Keymap for inline e-mail addresses.")
+
 (defconst eudc-bob-generic-menu
   '("EUDC Binary Object Menu"
     ["---" nil nil]
@@ -66,7 +70,7 @@
 
 (defun eudc-jump-to-event (event)
   "Jump to the window and point where EVENT occurred."
-  (if eudc-xemacs-p
+  (if (fboundp 'event-closest-point)
       (goto-char (event-closest-point event))
     (set-buffer (window-buffer (posn-window (event-start event))))
     (goto-char (posn-point (event-start event)))))
@@ -86,7 +90,7 @@
 
 (defun eudc-bob-can-display-inline-images ()
   "Return non-nil if we can display images inline."
-  (if eudc-xemacs-p
+  (if (fboundp 'console-type)
       (and (memq (console-type) '(x mswindows))
           (fboundp 'make-glyph))
     (and (fboundp 'display-graphic-p)
@@ -117,7 +121,7 @@ LABEL."
   "Display the JPEG DATA at point.
 If INLINE is non-nil, try to inline the image otherwise simply
 display a button."
-  (cond (eudc-xemacs-p
+  (cond ((fboundp 'make-glyph)
         (let ((glyph (if (eudc-bob-can-display-inline-images)
                          (make-glyph (list (vector 'jpeg :data data)
                                            [string :data "[JPEG Picture]"])))))
@@ -206,22 +210,9 @@ display a button."
   (let (sound)
     (if (null (setq sound (eudc-bob-get-overlay-prop 'object-data)))
        (error "No sound data available here")
-      (cond (eudc-xemacs-p
-            (if (not (and (boundp 'sound-alist)
-                          sound-alist))
-                (error "Don't know how to play sound on this Emacs version")
-              (setq sound-alist
-                    (cons (list 'eudc-sound
-                                :sound sound)
-                          sound-alist))
-              (condition-case nil
-                  (play-sound 'eudc-sound)
-                (t
-                 (setq sound-alist (cdr sound-alist))))))
-           (t
-            (unless (fboundp 'play-sound)
-              (error "Playing sounds not supported on this system"))
-            (play-sound (list 'sound :data sound)))))))
+      (unless (fboundp 'play-sound)
+       (error "Playing sounds not supported on this system"))
+      (play-sound (list 'sound :data sound)))))
 
 (defun eudc-bob-play-sound-at-mouse (event)
   "Play the sound data contained in the button where EVENT occurred."
@@ -230,7 +221,6 @@ display a button."
     (eudc-jump-to-event event)
     (eudc-bob-play-sound-at-point)))
 
-
 (defun eudc-bob-save-object ()
   "Save the object data of the button at point."
   (interactive)
@@ -318,6 +308,14 @@ display a button."
                          [down-mouse-2]) 'browse-url-at-mouse)
        map))
 
+(setq eudc-bob-mail-keymap
+      (let ((map (make-sparse-keymap)))
+       (define-key map [return] 'goto-address-at-point)
+       (define-key map (if eudc-xemacs-p
+                           [button2]
+                         [down-mouse-2]) 'goto-address-at-mouse)
+       map))
+
 (set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap)
 (set-keymap-parent eudc-bob-sound-keymap eudc-bob-generic-keymap)
 
@@ -347,6 +345,12 @@ display a button."
   (require 'browse-url)
   (eudc-bob-make-button url eudc-bob-url-keymap))
 
+;;;###autoload
+(defun eudc-display-mail (mail)
+  "Display e-mail address and make it clickable."
+  (require 'goto-addr)
+  (eudc-bob-make-button mail eudc-bob-mail-keymap))
+
 ;;;###autoload
 (defun eudc-display-sound (data)
   "Display a button to play the sound DATA."
@@ -362,4 +366,5 @@ display a button."
   "Display a button for the JPEG DATA."
   (eudc-bob-display-jpeg data nil))
 
+;;; arch-tag: 8f1853df-c9b6-4c5a-bdb1-d94dbd651fb3
 ;;; eudc-bob.el ends here