annotate lisp/net/eudc-bob.el @ 95329:3bf215f97a31

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