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:
parent
748afc183c
commit
4bb2f39591
1 changed files with 35 additions and 65 deletions
|
|
@ -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.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue