Mercurial > hg > xemacs-beta

comparison lisp/gnus/earcon.el @ 98:0d2f883870bc r20-1b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 131b0175ea99
children 360340f9fd5f
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
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)