1 files changed, 47 insertions, 83 deletions

diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index 56ea033a963..bb6682520ae 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -1,4 +1,4 @@
-;;; eudc-bob.el --- Binary Objects Support for EUDC
+;;; eudc-bob.el --- Binary Objects Support for EUDC  -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
 
@@ -39,19 +39,41 @@
 
 (require 'eudc)
 
-(defvar eudc-bob-generic-keymap nil
+(defvar eudc-bob-generic-keymap
+  (let ((map (make-sparse-keymap)))
+    (define-key map "s" 'eudc-bob-save-object)
+    (define-key map "!" 'eudc-bob-pipe-object-to-external-program)
+    (define-key map [down-mouse-3] 'eudc-bob-popup-menu)
+    map)
   "Keymap for multimedia objects.")
 
-(defvar eudc-bob-image-keymap nil
+(defvar eudc-bob-image-keymap
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map eudc-bob-generic-keymap)
+    (define-key map "t" 'eudc-bob-toggle-inline-display)
+    map)
   "Keymap for inline images.")
 
-(defvar eudc-bob-sound-keymap nil
+(defvar eudc-bob-sound-keymap
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map eudc-bob-generic-keymap)
+    (define-key map (kbd "RET") 'eudc-bob-play-sound-at-point)
+    (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse)
+    map)
   "Keymap for inline sounds.")
 
-(defvar eudc-bob-url-keymap nil
+(defvar eudc-bob-url-keymap
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "RET") 'browse-url-at-point)
+    (define-key map [down-mouse-2] 'browse-url-at-mouse)
+    map)
   "Keymap for inline urls.")
 
-(defvar eudc-bob-mail-keymap nil
+(defvar eudc-bob-mail-keymap
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "RET") 'goto-address-at-point)
+    (define-key map [down-mouse-2] 'goto-address-at-point)
+    map)
   "Keymap for inline e-mail addresses.")
 
 (defvar eudc-bob-generic-menu
@@ -74,13 +96,6 @@
      (fboundp 'play-sound-internal)]
     ,@(cdr (cdr eudc-bob-generic-menu))))
 
-(defun eudc-jump-to-event (event)
-  "Jump to the window and point where EVENT occurred."
-  (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)))))
-
 (defun eudc-bob-get-overlay-prop (prop)
   "Get property PROP from one of the overlays around."
   (let ((overlays (append (overlays-at (1- (point)))
@@ -205,42 +220,30 @@ display a button."
   "Play the sound data contained in the button where EVENT occurred."
   (interactive "e")
   (save-excursion
-    (eudc-jump-to-event event)
+    (mouse-set-point event)
     (eudc-bob-play-sound-at-point)))
 
-(defun eudc-bob-save-object ()
+(defun eudc-bob-save-object (filename)
   "Save the object data of the button at point."
-  (interactive)
+  (interactive "fWrite file: ")
   (let ((data (eudc-bob-get-overlay-prop 'object-data))
-        (buffer (generate-new-buffer "*eudc-tmp*")))
-    (save-excursion
-      (set-buffer-file-coding-system 'binary)
-      (set-buffer buffer)
-      (set-buffer-multibyte nil)
-      (insert data)
-      (save-buffer))
-    (kill-buffer buffer)))
+        (coding-system-for-write 'binary)) ;Inhibit EOL conversion.
+    (write-region data nil filename)))
 
-(defun eudc-bob-pipe-object-to-external-program ()
+(defun eudc-bob-pipe-object-to-external-program (program)
   "Pipe the object data of the button at point to an external program."
-  (interactive)
+  (interactive (list (completing-read "Viewer: " eudc-external-viewers)))
   (let ((data (eudc-bob-get-overlay-prop 'object-data))
-        (buffer (generate-new-buffer "*eudc-tmp*"))
-        program
-        viewer)
-    (condition-case nil
-        (save-excursion
-          (set-buffer-file-coding-system 'binary)
-          (set-buffer buffer)
-          (insert data)
-          (setq program (completing-read "Viewer: " eudc-external-viewers))
-          (if (setq viewer (assoc program eudc-external-viewers))
-              (call-process-region (point-min) (point-max)
-                                   (car (cdr viewer))
-                                   (cdr (cdr viewer)))
-            (call-process-region (point-min) (point-max) program)))
-      (error
-       (kill-buffer buffer)))))
+        (viewer (assoc program eudc-external-viewers)))
+    (with-temp-buffer
+      (set-buffer-multibyte nil)
+      (insert data)
+      (let ((coding-system-for-write 'binary)) ;Inhibit EOL conversion
+        (if viewer
+            (call-process-region (point-min) (point-max)
+                                 (car (cdr viewer))
+                                 (cdr (cdr viewer)))
+          (call-process-region (point-min) (point-max) program))))))
 
 (defun eudc-bob-menu ()
   "Retrieve the menu attached to a binary object."
@@ -250,47 +253,8 @@ display a button."
   "Pop-up a menu of EUDC multimedia commands."
   (interactive "@e")
   (run-hooks 'activate-menubar-hook)
-  (eudc-jump-to-event event)
-  (let ((result (x-popup-menu t (eudc-bob-menu)))
-        command)
-    (if result
-        (progn
-          (setq command (lookup-key (eudc-bob-menu)
-                                    (apply 'vector result)))
-          (command-execute command)))))
-
-(setq eudc-bob-generic-keymap
-      (let ((map (make-sparse-keymap)))
-        (define-key map "s" 'eudc-bob-save-object)
-        (define-key map "!" 'eudc-bob-pipe-object-to-external-program)
-        (define-key map [down-mouse-3] 'eudc-bob-popup-menu)
-        map))
-
-(setq eudc-bob-image-keymap
-      (let ((map (make-sparse-keymap)))
-        (define-key map "t" 'eudc-bob-toggle-inline-display)
-        map))
-
-(setq eudc-bob-sound-keymap
-      (let ((map (make-sparse-keymap)))
-        (define-key map [return] 'eudc-bob-play-sound-at-point)
-        (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse)
-        map))
-
-(setq eudc-bob-url-keymap
-      (let ((map (make-sparse-keymap)))
-        (define-key map [return] 'browse-url-at-point)
-        (define-key map [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 [down-mouse-2] 'goto-address-at-point)
-        map))
-
-(set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap)
-(set-keymap-parent eudc-bob-sound-keymap eudc-bob-generic-keymap)
+  (mouse-set-point event)
+  (popup-menu (eudc-bob-menu) event))
 
 ;; If the first arguments can be nil here, then these 3 can be
 ;; defconsts once more.