From 4bb2f395912e6b99aef79d3891b98ff71024ee2b Mon Sep 17 00:00:00 2001 From: Stefan Monnier <monnier@iro.umontreal.ca> Date: Sat, 15 Aug 2020 17:30:11 -0400 Subject: [PATCH] * lisp/net/eudc-bob.el: Use lexical-binding; Misc simplifications (eudc-bob-generic-keymap, eudc-bob-image-keymap) (eudc-bob-sound-keymap, eudc-bob-url-keymap, eudc-bob-mail-keymap): Move initialization into declaration. Use RET rather than `return`. (eudc-jump-to-event): Delete; use `mouse-set-point` instead. (eudc-bob-save-object): Rewrite using `write-region`. (eudc-bob-popup-menu): Use `popup-menu`. --- lisp/net/eudc-bob.el | 100 +++++++++++++++---------------------------- 1 file changed, 35 insertions(+), 65 deletions(-) diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index 56ea033a963..1d7005bb844 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,21 +220,15 @@ 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 () "Pipe the object data of the button at point to an external program." @@ -250,47 +259,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. -- 2.39.5