1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-05 07:01:11 -08:00

* 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`.
This commit is contained in:
Stefan Monnier 2020-08-15 17:30:11 -04:00
parent 748afc183c
commit 4bb2f39591

View file

@ -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.