Mercurial > emacs

comparison lisp/net/eudc-bob.el @ 27317:afeb81bc23e6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(eudc-bob-play-sound-at-point): Play sounds for Emacs. (eudc-bob-can-display-inline-images): Extend for Emacs. (eudc-bob-toggle-inline-display): Ditto. (eudc-bob-display-jpeg): Ditto.
author Gerd Moellmann <gerd@gnu.org>
date Thu, 13 Jan 2000 13:54:35 +0000
parents babfd92e24bf
children 92a7f3557095
comparison
equal deleted inserted replaced
27316:6e868e0bc324 27317:afeb81bc23e6
35 35
36 (defvar eudc-bob-image-keymap nil 36 (defvar eudc-bob-image-keymap nil
37 "Keymap for inline images.") 37 "Keymap for inline images.")
38 38
39 (defvar eudc-bob-sound-keymap nil 39 (defvar eudc-bob-sound-keymap nil
40 "Keymap for inline images.") 40 "Keymap for inline sounds.")
41 41
42 (defvar eudc-bob-url-keymap nil 42 (defvar eudc-bob-url-keymap nil
43 "Keymap for inline images.") 43 "Keymap for inline images.")
44 44
45 (defconst eudc-bob-generic-menu 45 (defconst eudc-bob-generic-menu
82 (setq overlays (cdr overlays))) 82 (setq overlays (cdr overlays)))
83 value)) 83 value))
84 84
85 (defun eudc-bob-can-display-inline-images () 85 (defun eudc-bob-can-display-inline-images ()
86 "Return non-nil if we can display images inline." 86 "Return non-nil if we can display images inline."
87 (and eudc-xemacs-p 87 (if eudc-xemacs-p
88 (memq (console-type) 88 (and (memq (console-type) '(x mswindows))
89 '(x mswindows)) 89 (fboundp 'make-glyph))
90 (fboundp 'make-glyph))) 90 (and (boundp 'image-types)
91 (not (null images-types)))))
91 92
92 (defun eudc-bob-make-button (label keymap &optional menu plist) 93 (defun eudc-bob-make-button (label keymap &optional menu plist)
93 "Create a button with LABEL. 94 "Create a button with LABEL.
94 Attach KEYMAP, MENU and properties from PLIST to a new overlay covering 95 Attach KEYMAP, MENU and properties from PLIST to a new overlay covering
95 LABEL." 96 LABEL."
110 plist (cdr plist)) 111 plist (cdr plist))
111 (overlay-put overlay prop val)))) 112 (overlay-put overlay prop val))))
112 113
113 (defun eudc-bob-display-jpeg (data inline) 114 (defun eudc-bob-display-jpeg (data inline)
114 "Display the JPEG DATA at point. 115 "Display the JPEG DATA at point.
115 if INLINE is non-nil, try to inline the image otherwise simply 116 If INLINE is non-nil, try to inline the image otherwise simply
116 display a button." 117 display a button."
117 (let ((glyph (if (eudc-bob-can-display-inline-images) 118 (cond (eudc-xemacs-p
118 (make-glyph (list (vector 'jpeg :data data) 119 (let ((glyph (if (eudc-bob-can-display-inline-images)
119 [string :data "[JPEG Picture]"]))))) 120 (make-glyph (list (vector 'jpeg :data data)
120 (eudc-bob-make-button "[JPEG Picture]" 121 [string :data "[JPEG Picture]"])))))
121 eudc-bob-image-keymap 122 (eudc-bob-make-button "[JPEG Picture]"
122 eudc-bob-image-menu 123 eudc-bob-image-keymap
123 (list 'glyph glyph 124 eudc-bob-image-menu
124 'end-glyph (if inline glyph) 125 (list 'glyph glyph
125 'duplicable t 126 'end-glyph (if inline glyph)
126 'invisible inline 127 'duplicable t
127 'start-open t 128 'invisible inline
128 'end-open t 129 'start-open t
129 'object-data data)))) 130 'end-open t
131 'object-data data))))
132 (t
133 (let* ((image (create-image data nil t))
134 (props (list 'object-data data 'eudc-image image)))
135 (when inline
136 (setq props (nconc (list 'display image) props)))
137 (eudc-bob-make-button "[Picture]"
138 eudc-bob-image-keymap
139 eudc-bob-image-menu
140 props)))))
130 141
131 (defun eudc-bob-toggle-inline-display () 142 (defun eudc-bob-toggle-inline-display ()
132 "Toggle inline display of an image." 143 "Toggle inline display of an image."
133 (interactive) 144 (interactive)
134 (if (eudc-bob-can-display-inline-images) 145 (when (eudc-bob-can-display-inline-images)
135 (let ((overlays (append (overlays-at (1- (point))) 146 (cond (eudc-xemacs-p
136 (overlays-at (point)))) 147 (let ((overlays (append (overlays-at (1- (point)))
137 overlay glyph) 148 (overlays-at (point))))
138 (setq overlay (car overlays)) 149 overlay glyph)
139 (while (and overlay 150 (setq overlay (car overlays))
140 (not (setq glyph (overlay-get overlay 'glyph)))) 151 (while (and overlay
141 (setq overlays (cdr overlays)) 152 (not (setq glyph (overlay-get overlay 'glyph))))
142 (setq overlay (car overlays))) 153 (setq overlays (cdr overlays))
143 (if overlay 154 (setq overlay (car overlays)))
144 (if (overlay-get overlay 'end-glyph) 155 (if overlay
145 (progn 156 (if (overlay-get overlay 'end-glyph)
146 (overlay-put overlay 'end-glyph nil) 157 (progn
147 (overlay-put overlay 'invisible nil)) 158 (overlay-put overlay 'end-glyph nil)
148 (overlay-put overlay 'end-glyph glyph) 159 (overlay-put overlay 'invisible nil))
149 (overlay-put overlay 'invisible t)))))) 160 (overlay-put overlay 'end-glyph glyph)
161 (overlay-put overlay 'invisible t)))))
162 (t
163 (let* ((overlays (append (overlays-at (1- (point)))
164 (overlays-at (point))))
165 image)
166
167 ;; Search overlay with an image.
168 (while (and overlays (null image))
169 (let ((prop (overlay-get (car overlays) 'eudc-image)))
170 (if (imagep prop)
171 (setq image prop)
172 (setq overlays (cdr overlays)))))
173
174 ;; Toggle that overlay's image display.
175 (when overlays
176 (let ((overlay (car overlays)))
177 (overlay-put overlay 'display
178 (if (overlay-get overlay 'display)
179 nil image)))))))))
150 180
151 (defun eudc-bob-display-audio (data) 181 (defun eudc-bob-display-audio (data)
152 "Display a button for audio DATA." 182 "Display a button for audio DATA."
153 (eudc-bob-make-button "[Audio Sound]" 183 (eudc-bob-make-button "[Audio Sound]"
154 eudc-bob-sound-keymap 184 eudc-bob-sound-keymap
156 (list 'duplicable t 186 (list 'duplicable t
157 'start-open t 187 'start-open t
158 'end-open t 188 'end-open t
159 'object-data data))) 189 'object-data data)))
160 190
161
162 (defun eudc-bob-display-generic-binary (data) 191 (defun eudc-bob-display-generic-binary (data)
163 "Display a button for unidentified binary DATA." 192 "Display a button for unidentified binary DATA."
164 (eudc-bob-make-button "[Binary Data]" 193 (eudc-bob-make-button "[Binary Data]"
165 eudc-bob-generic-keymap 194 eudc-bob-generic-keymap
166 eudc-bob-generic-menu 195 eudc-bob-generic-menu
173 "Play the sound data contained in the button at point." 202 "Play the sound data contained in the button at point."
174 (interactive) 203 (interactive)
175 (let (sound) 204 (let (sound)
176 (if (null (setq sound (eudc-bob-get-overlay-prop 'object-data))) 205 (if (null (setq sound (eudc-bob-get-overlay-prop 'object-data)))
177 (error "No sound data available here") 206 (error "No sound data available here")
178 (if (not (and (boundp 'sound-alist) 207 (cond (eudc-xemacs-p
179 sound-alist)) 208 (if (not (and (boundp 'sound-alist)
180 (error "Don't know how to play sound on this Emacs version") 209 sound-alist))
181 (setq sound-alist 210 (error "Don't know how to play sound on this Emacs version")
182 (cons (list 'eudc-sound 211 (setq sound-alist
183 :sound sound) 212 (cons (list 'eudc-sound
184 sound-alist)) 213 :sound sound)
185 (condition-case nil 214 sound-alist))
186 (play-sound 'eudc-sound) 215 (condition-case nil
187 (t 216 (play-sound 'eudc-sound)
188 (setq sound-alist (cdr sound-alist)))))))) 217 (t
218 (setq sound-alist (cdr sound-alist))))))
219 (t
220 (unless (fboundp 'play-sound)
221 (error "Playing sounds not supported on this system"))
222 (play-sound (list 'sound :data sound)))))))
189 223
190 224
191 (defun eudc-bob-play-sound-at-mouse (event) 225 (defun eudc-bob-play-sound-at-mouse (event)
192 "Play the sound data contained in the button where EVENT occurred." 226 "Play the sound data contained in the button where EVENT occurred."
193 (interactive "e") 227 (interactive "e")