cgit.sxemacs.org Git - packages/blob - xemacs-packages/erc/erc-speak.el

   1 ;;; erc-speak.el --- Speech-enable the ERC chat client
   2
   3 ;; Copyright 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; GNU Emacs is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 2, or (at your option)
  10 ;; any later version.
  11
  12 ;; GNU Emacs is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  20 ;; Boston, MA 02110-1301, USA.
  21
  22 ;;; Commentary:
  23
  24 ;; This file contains code to speech enable ERC using Emacspeak's functionality
  25 ;; to access a speech synthesizer.
  26 ;;
  27 ;; It tries to be intelligent and produce actually understandable
  28 ;; audio streams :). Hopefully it does. I use it on #debian at irc.debian.org
  29 ;; with about 200 users, and I am amazed how easy it works.
  30 ;;
  31 ;; Currently, erc-speak is only written to listen to channels.
  32 ;; There is no special functionality for interaction in the erc buffers.
  33 ;; Although this shouldn't be hard. Look at the Todo list, there are
  34 ;; definitely many things this script could do nicely to make a better
  35 ;; IRC experience for anyone.
  36 ;;
  37 ;; More info? Read the code. It isn't that complicated.
  38 ;;
  39
  40 ;;; Installation:
  41
  42 ;; Put erc.el and erc-speak.el somewhere in your load-path and
  43 ;; (require 'erc-speak) in your .emacs. Remember to require only erc-speak
  44 ;; because otherwise you get conflicts with emacspeak.
  45
  46 ;;; Bugs:
  47
  48 ;; erc-speak-rate doesn't seem to work here on outloud. Can anyone enlighten
  49 ;; me on the use of dtk-interp-queue-set-rate or equivalent?
  50
  51 ;;; Code:
  52
  53 (require 'emacspeak)
  54 (provide 'emacspeak-erc)
  55 (require 'erc)
  56 (require 'erc-button)
  57
  58 (defgroup erc-speak nil
  59   "Enable speech synthesis with the ERC chat client using Emacspeak"
  60   :group 'erc)
  61
  62 (defcustom erc-speak-personalities '((erc-default-face paul)
  63                                      (erc-direct-msg-face paul-animated)
  64                                      (erc-input-face paul-smooth)
  65                                      (erc-bold-face paul-bold)
  66                                      (erc-inverse-face betty)
  67                                      (erc-underline-face ursula)
  68                                      (erc-prompt-face harry)
  69                                      (erc-notice-face paul-italic)
  70                                      (erc-action-face paul-monotone)
  71                                      (erc-error-face kid)
  72                                      (erc-dangerous-host-face paul-surprized)
  73                                      (erc-pal-face paul-animated)
  74                                      (erc-fool-face paul-angry)
  75                                      (erc-keyword-face paul-animated))
  76   "Maps faces used in erc to speaker personalities in emacspeak."
  77   :group 'erc-speak
  78   :type '(repeat
  79           (list :tag "mapping"
  80                 (symbol :tag "face")
  81                 (symbol :tag "personality"))))
  82
  83 (add-hook 'erc-mode-hook (lambda () (setq voice-lock-mode t)))
  84
  85 ;; Override the definition in erc.el
  86 (defun erc-put-text-property (start end property value &optional object)
  87   "This function sets the appropriate personality on the specified
  88 region in addition to setting the requested face."
  89   (put-text-property start end property value object)
  90   (when (eq property 'face)
  91     (put-text-property start end
  92                        'personality
  93                        (cadr (assq value erc-speak-personalities))
  94                        object)))
  95
  96 (add-hook 'erc-insert-post-hook 'erc-speak-region)
  97 (add-hook 'erc-send-post-hook 'erc-speak-region)
  98
  99 (defcustom erc-speak-filter-host t
 100   "Set to t if you want to filter out user@host constructs."
 101   :group 'erc-speak
 102   :type 'bool)
 103
 104 (defcustom erc-speak-filter-timestamp t
 105   "If non-nil, try to filter out the timestamp when speaking arriving messages.
 106
 107 Note, your erc-timestamp-format variable needs to start with a [
 108 and end with ]."
 109   :group 'erc-speak
 110   :type 'bool)
 111
 112 (defcustom erc-speak-acronyms '(("brb" "be right back")
 113                                 ("btw" "by the way")
 114                                 ("wtf" "what the fuck")
 115                                 ("rotfl" "rolling on the floor and laughing")
 116                                 ("afaik" "as far as I know")
 117                                 ("afaics" "as far as I can see")
 118                                 ("iirc" "if I remember correctly"))
 119   "List of acronyms to expand."
 120   :group 'erc-speak
 121   :type '(repeat sexp))
 122
 123 (defun erc-speak-acronym-replace (string)
 124   "Replace acronyms in the current buffer."
 125   (let ((case-fold-search nil))
 126     (dolist (ac erc-speak-acronyms string)
 127       (while (string-match (car ac) string)
 128         (setq string (replace-match (cadr ac) nil t string))))))
 129
 130 (defcustom erc-speak-smileys '((":-)" "smiling face")
 131                                (":)" "smiling face")
 132                                (":-(" "sad face")
 133                                (":(" "sad face"))
 134 ;; please add more, send me patches, mlang@home.delysid.org tnx
 135   "List of smileys and their textual description."
 136   :group 'erc-speak
 137   :type '(repeat (list 'symbol 'symbol)))
 138
 139 (defcustom erc-speak-smiley-personality 'harry
 140   "Personality used for smiley announcements."
 141   :group 'erc-speak
 142   :type 'symbol)
 143
 144 (defun erc-speak-smiley-replace (string)
 145   "Replace smileys with textual description."
 146   (let ((case-fold-search nil))
 147     (dolist (smiley erc-speak-smileys string)
 148       (while (string-match (car smiley) string)
 149         (let ((repl (cadr smiley)))
 150           (put-text-property 0 (length repl) 'personality
 151                              erc-speak-smiley-personality repl)
 152           (setq string (replace-match repl nil t string)))))))
 153
 154 (defcustom erc-speak-channel-personality 'harry
 155   "*Personality to announce channel names with."
 156   :group 'erc-speak
 157   :type 'symbol)
 158
 159 (defun erc-speak-region ()
 160   "Speak a region containing one IRC message using Emacspeak.
 161 This function tries to translate common IRC forms into
 162 intelligent speech."
 163   (let ((target (if (erc-channel-p (erc-default-target))
 164                     (erc-propertize
 165                      (erc-default-target)
 166                      'personality erc-speak-channel-personality)
 167                   ""))
 168         (dtk-stop-immediately nil))
 169     (emacspeak-auditory-icon 'progress)
 170     (when erc-speak-filter-timestamp
 171       (save-excursion
 172         (goto-char (point-min))
 173         (when (re-search-forward "^\\[[a-zA-Z:,;.0-9 \t-]+\\]" nil t)
 174           (narrow-to-region (point) (point-max)))))
 175     (save-excursion
 176       (goto-char (point-min))
 177       (cond ((re-search-forward (concat "^<\\([^>]+\\)> "
 178                                         (concat "\\("
 179                                                 erc-valid-nick-regexp
 180                                                 "\\)[;,:]")) nil t)
 181              (let ((from (match-string 1))
 182                    (to (match-string 2))
 183                    (text (buffer-substring (match-end 2) (point-max))))
 184                (tts-with-punctuations
 185                 "some"
 186                 (dtk-speak (concat (erc-propertize
 187                                     (concat target " " from " to " to)
 188                                     'personality erc-speak-channel-personality)
 189                                    (erc-speak-smiley-replace
 190                                     (erc-speak-acronym-replace text)))))))
 191             ((re-search-forward "^<\\([^>]+\\)> " nil t)
 192              (let ((from (match-string 1))
 193                    (msg (buffer-substring (match-end 0) (point-max))))
 194                (tts-with-punctuations
 195                 "some"
 196                 (dtk-speak (concat target " " from " "
 197                                    (erc-speak-smiley-replace
 198                                     (erc-speak-acronym-replace msg)))))))
 199             ((re-search-forward (concat "^" (regexp-quote erc-notice-prefix)
 200                                         "\\(.+\\)")
 201                                 (point-max) t)
 202              (let ((notice (buffer-substring (match-beginning 1) (point-max))))
 203                (tts-with-punctuations
 204                 "all"
 205                 (dtk-speak
 206                  (with-temp-buffer
 207                    (insert notice)
 208                    (when erc-speak-filter-host
 209                      (goto-char (point-min))
 210                      (when (re-search-forward "([^)@]+@[^)@]+)" nil t)
 211                        (replace-match "")))
 212                    (buffer-string))))))
 213             (t (let ((msg (buffer-substring (point-min) (point-max))))
 214                  (tts-with-punctuations
 215                   "some"
 216                   (dtk-speak (concat target " "
 217                                      (erc-speak-smiley-replace
 218                                       (erc-speak-acronym-replace msg)))))))))))
 219
 220 (provide 'erc-speak)
 221
 222 ;;; erc-speak.el ends here
 223 ;;
 224 ;; Local Variables:
 225 ;; indent-tabs-mode: t
 226 ;; tab-width: 8
 227 ;; End:
 228
 229 ;; arch-tag: 4499cd13-2829-43b8-83de-d313481531c4