Mercurial > hg > xemacs-beta

comparison lisp/gnus/earcon.el @ 16:0293115a14e9 r19-15b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents ac2d302a0011
children ec9a17fef872
comparison
equal deleted inserted replaced
15:ad457d5f7d04 16:0293115a14e9
28 28
29 (if (null (boundp 'running-xemacs)) 29 (if (null (boundp 'running-xemacs))
30 (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))) 30 (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)))
31 31
32 (require 'gnus) 32 (require 'gnus)
33 (require 'gnus-sound) 33 (require 'gnus-audio)
34 (require 'gnus-art)
34 (eval-when-compile (require 'cl)) 35 (eval-when-compile (require 'cl))
35 36
36 (defvar earcon-auto-play nil 37 (defgroup earcon nil
37 "When True, automatially play sounds as well as buttonize them.") 38 "Turn ** sounds ** into noise."
38 39 :group 'gnus-visual)
39 (defvar earcon-prefix "**" 40
40 "The start of an earcon") 41 (defcustom earcon-auto-play nil
41 42 "When True, automatically play sounds as well as buttonize them."
42 (defvar earcon-suffix "**" 43 :type 'boolean
43 "The end of an earcon") 44 :group 'earcon)
44 45
45 (defvar earcon-regexp-alist 46 (defcustom earcon-prefix "**"
47 "String denoting the start of an earcon."
48 :type 'string
49 :group 'earcon)
50
51 (defcustom earcon-suffix "**"
52 "String denoting the end of an earcon."
53 :type 'string
54 :group 'earcon)
55
56 (defcustom earcon-regexp-alist
46 '(("boring" 1 "Boring.au") 57 '(("boring" 1 "Boring.au")
47 ("evil[ \t]+laugh" 1 "Evil_Laugh.au") 58 ("evil[ \t]+laugh" 1 "Evil_Laugh.au")
48 ("gag\\|puke" 1 "Puke.au") 59 ("gag\\|puke" 1 "Puke.au")
49 ("snicker" 1 "Snicker.au") 60 ("snicker" 1 "Snicker.au")
50 ("meow" 1 "catmeow.au") 61 ("meow" 1 "catmeow.au")
51 ("sob\\|boohoo" 1 "cry.wav") 62 ("sob\\|boohoo" 1 "cry.wav")
52 ("drum[ \t]*roll" 1 "drumroll.au") 63 ("drum[ \t]*roll" 1 "drumroll.au")
53 ("blast" 1 "explosion.au") 64 ("blast" 1 "explosion.au")
54 ("flush" 1 "flush.au") 65 ("flush\\|plonk!*" 1 "flush.au")
55 ("kiss" 1 "kiss.wav") 66 ("kiss" 1 "kiss.wav")
56 ("tee[ \t]*hee" 1 "laugh.au") 67 ("tee[ \t]*hee" 1 "laugh.au")
57 ("shoot" 1 "shotgun.wav") 68 ("shoot" 1 "shotgun.wav")
58 ("yawn" 1 "snore.wav") 69 ("yawn" 1 "snore.wav")
59 ("cackle" 1 "witch.au") 70 ("cackle" 1 "witch.au")
60 ("yell\\|roar" 1 "yell2.au") 71 ("yell\\|roar" 1 "yell2.au")
61 ("whoop-de-doo" 1 "whistle.au")) 72 ("whoop-de-doo" 1 "whistle.au"))
62 "A list of regexps to map earcons to real sounds.") 73 "A list of regexps to map earcons to real sounds."
74 :type '(repeat (list regexp
75 (integer :tag "Match")
76 (string :tag "Sound")))
77 :group 'earcon)
63 78
64 (defvar earcon-button-marker-list nil) 79 (defvar earcon-button-marker-list nil)
65 (make-variable-buffer-local 'earcon-button-marker-list) 80 (make-variable-buffer-local 'earcon-button-marker-list)
66 81
67 82
152 (save-excursion 167 (save-excursion
153 (set-buffer gnus-article-buffer) 168 (set-buffer gnus-article-buffer)
154 (goto-char marker) 169 (goto-char marker)
155 (let* ((entry (earcon-button-entry)) 170 (let* ((entry (earcon-button-entry))
156 (inhibit-point-motion-hooks t) 171 (inhibit-point-motion-hooks t)
157 (fun 'gnus-sound-play) 172 (fun 'gnus-audio-play)
158 (args (list (nth 2 entry)))) 173 (args (list (nth 2 entry))))
159 (cond 174 (cond
160 ((fboundp fun) 175 ((fboundp fun)
161 (apply fun args)) 176 (apply fun args))
162 ((and (boundp fun) 177 ((and (boundp fun)
191 beg entry regexp) 206 beg entry regexp)
192 (goto-char (point-min)) 207 (goto-char (point-min))
193 (setq beg (point)) 208 (setq beg (point))
194 (while (setq entry (pop alist)) 209 (while (setq entry (pop alist))
195 (setq regexp (concat (regexp-quote earcon-prefix) 210 (setq regexp (concat (regexp-quote earcon-prefix)
196 ".*\\(" 211 ".*\\("
197 (car entry) 212 (car entry)
198 "\\).*" 213 "\\).*"
199 (regexp-quote earcon-suffix))) 214 (regexp-quote earcon-suffix)))
200 (goto-char beg) 215 (goto-char beg)
201 (while (re-search-forward regexp nil t) 216 (while (re-search-forward regexp nil t)
202 (let* ((start (and entry (match-beginning 1))) 217 (let* ((start (and entry (match-beginning 1)))
203 (end (and entry (match-end 1))) 218 (end (and entry (match-end 1)))
204 (from (match-beginning 1))) 219 (from (match-beginning 1)))
205 (earcon-article-add-button 220 (earcon-article-add-button
206 start end 'earcon-button-push 221 start end 'earcon-button-push
207 (car (push (set-marker (make-marker) from) 222 (car (push (set-marker (make-marker) from)
208 earcon-button-marker-list))) 223 earcon-button-marker-list)))
209 (gnus-sound-play (caddr entry)))))))) 224 (gnus-audio-play (caddr entry))))))))
210 225
211 ;;;###autoload 226 ;;;###autoload
212 (defun gnus-earcon-display () 227 (defun gnus-earcon-display ()
213 "Play sounds in message buffers." 228 "Play sounds in message buffers."
214 (interactive) 229 (interactive)