Mercurial > emacs
annotate lisp/net/eudc-bob.el @ 44512:d9d12d6d22cc
(nnimap-retrieve-headers): Don't assume point-min == 1.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Fri, 12 Apr 2002 03:10:19 +0000 |
parents | c9c59300d7a6 |
children | 695cf19ef79e d7ddb3e565de |
rev | line source |
---|---|
27313 | 1 ;;; eudc-bob.el --- Binary Objects Support for EUDC |
2 | |
42554
bbfc062c0b51
(eudc-bob-can-display-inline-images)
Pavel Janík <Pavel@Janik.cz>
parents:
42519
diff
changeset
|
3 ;; Copyright (C) 1999, 2000, 2002 Free Software Foundation, Inc. |
27313 | 4 |
42775
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
5 ;; Author: Oscar Figueiredo <oscar@cpe.fr> |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
6 ;; Maintainer: Pavel Janík <Pavel@Janik.cz> |
42574 | 7 ;; Keywords: comm |
27313 | 8 |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 ;; Boston, MA 02111-1307, USA. | |
25 | |
38422
7a94f1c588c4
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
33516
diff
changeset
|
26 ;;; Commentary: |
7a94f1c588c4
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
33516
diff
changeset
|
27 |
27313 | 28 ;;; Usage: |
29 ;; See the corresponding info file | |
30 | |
31 ;;; Code: | |
32 | |
33 (require 'eudc) | |
34 | |
35 (defvar eudc-bob-generic-keymap nil | |
36 "Keymap for multimedia objects.") | |
37 | |
38 (defvar eudc-bob-image-keymap nil | |
39 "Keymap for inline images.") | |
40 | |
41 (defvar eudc-bob-sound-keymap nil | |
27317
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
42 "Keymap for inline sounds.") |
27313 | 43 |
44 (defvar eudc-bob-url-keymap nil | |
42519 | 45 "Keymap for inline urls.") |
27313 | 46 |
42775
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
47 (defvar eudc-bob-mail-keymap nil |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
48 "Keymap for inline e-mail addresses.") |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
49 |
27313 | 50 (defconst eudc-bob-generic-menu |
51 '("EUDC Binary Object Menu" | |
52 ["---" nil nil] | |
53 ["Pipe to external program" eudc-bob-pipe-object-to-external-program t] | |
54 ["Save object" eudc-bob-save-object t])) | |
55 | |
56 (defconst eudc-bob-image-menu | |
57 `("EUDC Image Menu" | |
58 ["---" nil nil] | |
59 ["Toggle inline display" eudc-bob-toggle-inline-display | |
60 (eudc-bob-can-display-inline-images)] | |
61 ,@(cdr (cdr eudc-bob-generic-menu)))) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42554
diff
changeset
|
62 |
27313 | 63 (defconst eudc-bob-sound-menu |
64 `("EUDC Sound Menu" | |
65 ["---" nil nil] | |
33516
92a7f3557095
(eudc-bob-can-display-inline-images): Use
Dave Love <fx@gnu.org>
parents:
27317
diff
changeset
|
66 ["Play sound" eudc-bob-play-sound-at-point |
27313 | 67 (fboundp 'play-sound)] |
68 ,@(cdr (cdr eudc-bob-generic-menu)))) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42554
diff
changeset
|
69 |
27313 | 70 (defun eudc-jump-to-event (event) |
71 "Jump to the window and point where EVENT occurred." | |
72 (if eudc-xemacs-p | |
73 (goto-char (event-closest-point event)) | |
74 (set-buffer (window-buffer (posn-window (event-start event)))) | |
75 (goto-char (posn-point (event-start event))))) | |
76 | |
77 (defun eudc-bob-get-overlay-prop (prop) | |
78 "Get property PROP from one of the overlays around." | |
79 (let ((overlays (append (overlays-at (1- (point))) | |
80 (overlays-at (point)))) | |
81 overlay value | |
82 (notfound t)) | |
83 (while (and notfound | |
84 (setq overlay (car overlays))) | |
85 (if (setq value (overlay-get overlay prop)) | |
86 (setq notfound nil)) | |
87 (setq overlays (cdr overlays))) | |
88 value)) | |
89 | |
90 (defun eudc-bob-can-display-inline-images () | |
91 "Return non-nil if we can display images inline." | |
27317
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
92 (if eudc-xemacs-p |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
93 (and (memq (console-type) '(x mswindows)) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
94 (fboundp 'make-glyph)) |
42554
bbfc062c0b51
(eudc-bob-can-display-inline-images)
Pavel Janík <Pavel@Janik.cz>
parents:
42519
diff
changeset
|
95 (and (fboundp 'display-graphic-p) |
33516
92a7f3557095
(eudc-bob-can-display-inline-images): Use
Dave Love <fx@gnu.org>
parents:
27317
diff
changeset
|
96 (display-graphic-p)))) |
27313 | 97 |
98 (defun eudc-bob-make-button (label keymap &optional menu plist) | |
99 "Create a button with LABEL. | |
33516
92a7f3557095
(eudc-bob-can-display-inline-images): Use
Dave Love <fx@gnu.org>
parents:
27317
diff
changeset
|
100 Attach KEYMAP, MENU and properties from PLIST to a new overlay covering |
27313 | 101 LABEL." |
102 (let (overlay | |
103 (p (point)) | |
104 prop val) | |
105 (insert label) | |
33516
92a7f3557095
(eudc-bob-can-display-inline-images): Use
Dave Love <fx@gnu.org>
parents:
27317
diff
changeset
|
106 (put-text-property p (point) 'face 'bold) |
27313 | 107 (setq overlay (make-overlay p (point))) |
108 (overlay-put overlay 'mouse-face 'highlight) | |
109 (overlay-put overlay 'keymap keymap) | |
110 (overlay-put overlay 'local-map keymap) | |
111 (overlay-put overlay 'menu menu) | |
112 (while plist | |
113 (setq prop (car plist) | |
114 plist (cdr plist) | |
115 val (car plist) | |
116 plist (cdr plist)) | |
117 (overlay-put overlay prop val)))) | |
118 | |
119 (defun eudc-bob-display-jpeg (data inline) | |
120 "Display the JPEG DATA at point. | |
33516
92a7f3557095
(eudc-bob-can-display-inline-images): Use
Dave Love <fx@gnu.org>
parents:
27317
diff
changeset
|
121 If INLINE is non-nil, try to inline the image otherwise simply |
27313 | 122 display a button." |
27317
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
123 (cond (eudc-xemacs-p |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
124 (let ((glyph (if (eudc-bob-can-display-inline-images) |
33516
92a7f3557095
(eudc-bob-can-display-inline-images): Use
Dave Love <fx@gnu.org>
parents:
27317
diff
changeset
|
125 (make-glyph (list (vector 'jpeg :data data) |
27317
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
126 [string :data "[JPEG Picture]"]))))) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
127 (eudc-bob-make-button "[JPEG Picture]" |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
128 eudc-bob-image-keymap |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
129 eudc-bob-image-menu |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
130 (list 'glyph glyph |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
131 'end-glyph (if inline glyph) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
132 'duplicable t |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
133 'invisible inline |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
134 'start-open t |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
135 'end-open t |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
136 'object-data data)))) |
42554
bbfc062c0b51
(eudc-bob-can-display-inline-images)
Pavel Janík <Pavel@Janik.cz>
parents:
42519
diff
changeset
|
137 ((fboundp 'create-image) |
27317
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
138 (let* ((image (create-image data nil t)) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
139 (props (list 'object-data data 'eudc-image image))) |
33516
92a7f3557095
(eudc-bob-can-display-inline-images): Use
Dave Love <fx@gnu.org>
parents:
27317
diff
changeset
|
140 (when (and inline (image-type-available-p 'jpeg)) |
27317
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
141 (setq props (nconc (list 'display image) props))) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
142 (eudc-bob-make-button "[Picture]" |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
143 eudc-bob-image-keymap |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
144 eudc-bob-image-menu |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
145 props))))) |
27313 | 146 |
147 (defun eudc-bob-toggle-inline-display () | |
148 "Toggle inline display of an image." | |
149 (interactive) | |
27317
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
150 (when (eudc-bob-can-display-inline-images) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
151 (cond (eudc-xemacs-p |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
152 (let ((overlays (append (overlays-at (1- (point))) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
153 (overlays-at (point)))) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
154 overlay glyph) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
155 (setq overlay (car overlays)) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
156 (while (and overlay |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
157 (not (setq glyph (overlay-get overlay 'glyph)))) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
158 (setq overlays (cdr overlays)) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
159 (setq overlay (car overlays))) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
160 (if overlay |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
161 (if (overlay-get overlay 'end-glyph) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
162 (progn |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
163 (overlay-put overlay 'end-glyph nil) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
164 (overlay-put overlay 'invisible nil)) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
165 (overlay-put overlay 'end-glyph glyph) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
166 (overlay-put overlay 'invisible t))))) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
167 (t |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
168 (let* ((overlays (append (overlays-at (1- (point))) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
169 (overlays-at (point)))) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
170 image) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
171 |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
172 ;; Search overlay with an image. |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
173 (while (and overlays (null image)) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
174 (let ((prop (overlay-get (car overlays) 'eudc-image))) |
33516
92a7f3557095
(eudc-bob-can-display-inline-images): Use
Dave Love <fx@gnu.org>
parents:
27317
diff
changeset
|
175 (if (eq 'image (car-safe prop)) |
27317
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
176 (setq image prop) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
177 (setq overlays (cdr overlays))))) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
178 |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
179 ;; Toggle that overlay's image display. |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
180 (when overlays |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
181 (let ((overlay (car overlays))) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
182 (overlay-put overlay 'display |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
183 (if (overlay-get overlay 'display) |
afeb81bc23e6
(eudc-bob-play-sound-at-point): Play sounds
Gerd Moellmann <gerd@gnu.org>
parents:
27313
diff
changeset
|
184 nil image))))))))) |
27313 | 185 |
186 (defun eudc-bob-display-audio (data) | |
187 "Display a button for audio DATA." | |
188 (eudc-bob-make-button "[Audio Sound]" | |
189 eudc-bob-sound-keymap | |
190 eudc-bob-sound-menu | |
191 (list 'duplicable t | |
192 'start-open t | |
193 'end-open t | |
194 'object-data data))) | |
195 | |
196 (defun eudc-bob-display-generic-binary (data) | |
197 "Display a button for unidentified binary DATA." | |
198 (eudc-bob-make-button "[Binary Data]" | |
199 eudc-bob-generic-keymap | |
200 eudc-bob-generic-menu | |
201 (list 'duplicable t | |
202 'start-open t | |
203 'end-open t | |
204 'object-data data))) | |
205 | |
206 (defun eudc-bob-play-sound-at-point () | |
207 "Play the sound data contained in the button at point." | |
208 (interactive) | |
209 (let (sound) | |
210 (if (null (setq sound (eudc-bob-get-overlay-prop 'object-data))) | |
211 (error "No sound data available here") | |
42775
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
212 (unless (fboundp 'play-sound) |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
213 (error "Playing sounds not supported on this system")) |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
214 (play-sound (list 'sound :data sound))))) |
27313 | 215 |
216 (defun eudc-bob-play-sound-at-mouse (event) | |
217 "Play the sound data contained in the button where EVENT occurred." | |
218 (interactive "e") | |
219 (save-excursion | |
220 (eudc-jump-to-event event) | |
221 (eudc-bob-play-sound-at-point))) | |
42554
bbfc062c0b51
(eudc-bob-can-display-inline-images)
Pavel Janík <Pavel@Janik.cz>
parents:
42519
diff
changeset
|
222 |
27313 | 223 (defun eudc-bob-save-object () |
224 "Save the object data of the button at point." | |
225 (interactive) | |
226 (let ((data (eudc-bob-get-overlay-prop 'object-data)) | |
227 (buffer (generate-new-buffer "*eudc-tmp*"))) | |
228 (save-excursion | |
229 (if (fboundp 'set-buffer-file-coding-system) | |
230 (set-buffer-file-coding-system 'binary)) | |
231 (set-buffer buffer) | |
42554
bbfc062c0b51
(eudc-bob-can-display-inline-images)
Pavel Janík <Pavel@Janik.cz>
parents:
42519
diff
changeset
|
232 (set-buffer-multibyte nil) |
27313 | 233 (insert data) |
234 (save-buffer)) | |
235 (kill-buffer buffer))) | |
236 | |
237 (defun eudc-bob-pipe-object-to-external-program () | |
238 "Pipe the object data of the button at point to an external program." | |
239 (interactive) | |
240 (let ((data (eudc-bob-get-overlay-prop 'object-data)) | |
241 (buffer (generate-new-buffer "*eudc-tmp*")) | |
242 program | |
243 viewer) | |
244 (condition-case nil | |
245 (save-excursion | |
246 (if (fboundp 'set-buffer-file-coding-system) | |
247 (set-buffer-file-coding-system 'binary)) | |
248 (set-buffer buffer) | |
249 (insert data) | |
250 (setq program (completing-read "Viewer: " eudc-external-viewers)) | |
251 (if (setq viewer (assoc program eudc-external-viewers)) | |
33516
92a7f3557095
(eudc-bob-can-display-inline-images): Use
Dave Love <fx@gnu.org>
parents:
27317
diff
changeset
|
252 (call-process-region (point-min) (point-max) |
92a7f3557095
(eudc-bob-can-display-inline-images): Use
Dave Love <fx@gnu.org>
parents:
27317
diff
changeset
|
253 (car (cdr viewer)) |
27313 | 254 (cdr (cdr viewer))) |
255 (call-process-region (point-min) (point-max) program))) | |
256 (t | |
257 (kill-buffer buffer))))) | |
258 | |
259 (defun eudc-bob-menu () | |
260 "Retrieve the menu attached to a binary object." | |
261 (eudc-bob-get-overlay-prop 'menu)) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42554
diff
changeset
|
262 |
27313 | 263 (defun eudc-bob-popup-menu (event) |
264 "Pop-up a menu of EUDC multimedia commands." | |
265 (interactive "@e") | |
266 (run-hooks 'activate-menubar-hook) | |
267 (eudc-jump-to-event event) | |
268 (if eudc-xemacs-p | |
33516
92a7f3557095
(eudc-bob-can-display-inline-images): Use
Dave Love <fx@gnu.org>
parents:
27317
diff
changeset
|
269 (progn |
27313 | 270 (run-hooks 'activate-popup-menu-hook) |
271 (popup-menu (eudc-bob-menu))) | |
272 (let ((result (x-popup-menu t (eudc-bob-menu))) | |
273 command) | |
274 (if result | |
275 (progn | |
276 (setq command (lookup-key (eudc-bob-menu) | |
277 (apply 'vector result))) | |
278 (command-execute command)))))) | |
279 | |
280 (setq eudc-bob-generic-keymap | |
281 (let ((map (make-sparse-keymap))) | |
282 (define-key map "s" 'eudc-bob-save-object) | |
42554
bbfc062c0b51
(eudc-bob-can-display-inline-images)
Pavel Janík <Pavel@Janik.cz>
parents:
42519
diff
changeset
|
283 (define-key map "!" 'eudc-bob-pipe-object-to-external-program) |
27313 | 284 (define-key map (if eudc-xemacs-p |
285 [button3] | |
286 [down-mouse-3]) 'eudc-bob-popup-menu) | |
287 map)) | |
288 | |
289 (setq eudc-bob-image-keymap | |
290 (let ((map (make-sparse-keymap))) | |
291 (define-key map "t" 'eudc-bob-toggle-inline-display) | |
292 map)) | |
293 | |
294 (setq eudc-bob-sound-keymap | |
295 (let ((map (make-sparse-keymap))) | |
296 (define-key map [return] 'eudc-bob-play-sound-at-point) | |
297 (define-key map (if eudc-xemacs-p | |
298 [button2] | |
299 [down-mouse-2]) 'eudc-bob-play-sound-at-mouse) | |
300 map)) | |
301 | |
302 (setq eudc-bob-url-keymap | |
303 (let ((map (make-sparse-keymap))) | |
304 (define-key map [return] 'browse-url-at-point) | |
305 (define-key map (if eudc-xemacs-p | |
306 [button2] | |
307 [down-mouse-2]) 'browse-url-at-mouse) | |
308 map)) | |
309 | |
42775
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
310 (setq eudc-bob-mail-keymap |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
311 (let ((map (make-sparse-keymap))) |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
312 (define-key map [return] 'goto-address-at-point) |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
313 (define-key map (if eudc-xemacs-p |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
314 [button2] |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
315 [down-mouse-2]) 'goto-address-at-mouse) |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
316 map)) |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
317 |
27313 | 318 (set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap) |
319 (set-keymap-parent eudc-bob-sound-keymap eudc-bob-generic-keymap) | |
320 | |
321 (if eudc-emacs-p | |
322 (progn | |
33516
92a7f3557095
(eudc-bob-can-display-inline-images): Use
Dave Love <fx@gnu.org>
parents:
27317
diff
changeset
|
323 (easy-menu-define eudc-bob-generic-menu |
27313 | 324 eudc-bob-generic-keymap |
325 "" | |
326 eudc-bob-generic-menu) | |
33516
92a7f3557095
(eudc-bob-can-display-inline-images): Use
Dave Love <fx@gnu.org>
parents:
27317
diff
changeset
|
327 (easy-menu-define eudc-bob-image-menu |
27313 | 328 eudc-bob-image-keymap |
329 "" | |
330 eudc-bob-image-menu) | |
33516
92a7f3557095
(eudc-bob-can-display-inline-images): Use
Dave Love <fx@gnu.org>
parents:
27317
diff
changeset
|
331 (easy-menu-define eudc-bob-sound-menu |
27313 | 332 eudc-bob-sound-keymap |
333 "" | |
334 eudc-bob-sound-menu))) | |
335 | |
336 ;;;###autoload | |
337 (defun eudc-display-generic-binary (data) | |
338 "Display a button for unidentified binary DATA." | |
339 (eudc-bob-display-generic-binary data)) | |
340 | |
341 ;;;###autoload | |
342 (defun eudc-display-url (url) | |
343 "Display URL and make it clickable." | |
344 (require 'browse-url) | |
345 (eudc-bob-make-button url eudc-bob-url-keymap)) | |
346 | |
347 ;;;###autoload | |
42775
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
348 (defun eudc-display-mail (mail) |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
349 "Display e-mail address and make it clickable." |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
350 (require 'goto-addr) |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
351 (eudc-bob-make-button mail eudc-bob-mail-keymap)) |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
352 |
c9c59300d7a6
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
353 ;;;###autoload |
27313 | 354 (defun eudc-display-sound (data) |
355 "Display a button to play the sound DATA." | |
356 (eudc-bob-display-audio data)) | |
357 | |
358 ;;;###autoload | |
359 (defun eudc-display-jpeg-inline (data) | |
360 "Display the JPEG DATA inline at point if possible." | |
361 (eudc-bob-display-jpeg data (eudc-bob-can-display-inline-images))) | |
362 | |
363 ;;;###autoload | |
364 (defun eudc-display-jpeg-as-button (data) | |
365 "Display a button for the JPEG DATA." | |
366 (eudc-bob-display-jpeg data nil)) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42554
diff
changeset
|
367 |
27313 | 368 ;;; eudc-bob.el ends here |