diff options
Diffstat (limited to 'lisp/erc/erc-speak.el')
| -rw-r--r-- | lisp/erc/erc-speak.el | 230 |
1 files changed, 230 insertions, 0 deletions
diff --git a/lisp/erc/erc-speak.el b/lisp/erc/erc-speak.el new file mode 100644 index 00000000000..cd176f29fd2 --- /dev/null +++ b/lisp/erc/erc-speak.el @@ -0,0 +1,230 @@ +;;; erc-speak.el --- Speech-enable the ERC chat client + +;; Copyright 2001, 2002, 2003, 2004, 2007, +;; 2008, 2009 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file contains code to speech enable ERC using Emacspeak's functionality +;; to access a speech synthesizer. +;; +;; It tries to be intelligent and produce actually understandable +;; audio streams :). Hopefully it does. I use it on #debian at irc.debian.org +;; with about 200 users, and I am amazed how easy it works. +;; +;; Currently, erc-speak is only written to listen to channels. +;; There is no special functionality for interaction in the erc buffers. +;; Although this shouldn't be hard. Look at the Todo list, there are +;; definitely many things this script could do nicely to make a better +;; IRC experience for anyone. +;; +;; More info? Read the code. It isn't that complicated. +;; + +;;; Installation: + +;; Put erc.el and erc-speak.el somewhere in your load-path and +;; (require 'erc-speak) in your .emacs. Remember to require only erc-speak +;; because otherwise you get conflicts with emacspeak. + +;;; Bugs: + +;; erc-speak-rate doesn't seem to work here on outloud. Can anyone enlighten +;; me on the use of dtk-interp-queue-set-rate or equivalent? + +;;; Code: + +(require 'emacspeak) +(provide 'emacspeak-erc) +(require 'erc) +(require 'erc-button) + +(defgroup erc-speak nil + "Enable speech synthesis with the ERC chat client using Emacspeak" + :group 'erc) + +(defcustom erc-speak-personalities '((erc-default-face paul) + (erc-direct-msg-face paul-animated) + (erc-input-face paul-smooth) + (erc-bold-face paul-bold) + (erc-inverse-face betty) + (erc-underline-face ursula) + (erc-prompt-face harry) + (erc-notice-face paul-italic) + (erc-action-face paul-monotone) + (erc-error-face kid) + (erc-dangerous-host-face paul-surprized) + (erc-pal-face paul-animated) + (erc-fool-face paul-angry) + (erc-keyword-face paul-animated)) + "Maps faces used in erc to speaker personalities in emacspeak." + :group 'erc-speak + :type '(repeat + (list :tag "mapping" + (symbol :tag "face") + (symbol :tag "personality")))) + +(add-hook 'erc-mode-hook (lambda () (setq voice-lock-mode t))) + +;; Override the definition in erc.el +(defun erc-put-text-property (start end property value &optional object) + "This function sets the appropriate personality on the specified +region in addition to setting the requested face." + (put-text-property start end property value object) + (when (eq property 'face) + (put-text-property start end + 'personality + (cadr (assq value erc-speak-personalities)) + object))) + +(add-hook 'erc-insert-post-hook 'erc-speak-region) +(add-hook 'erc-send-post-hook 'erc-speak-region) + +(defcustom erc-speak-filter-host t + "Set to t if you want to filter out user@host constructs." + :group 'erc-speak + :type 'bool) + +(defcustom erc-speak-filter-timestamp t + "If non-nil, try to filter out the timestamp when speaking arriving messages. + +Note, your erc-timestamp-format variable needs to start with a [ +and end with ]." + :group 'erc-speak + :type 'bool) + +(defcustom erc-speak-acronyms '(("brb" "be right back") + ("btw" "by the way") + ("wtf" "what the fuck") + ("rotfl" "rolling on the floor and laughing") + ("afaik" "as far as I know") + ("afaics" "as far as I can see") + ("iirc" "if I remember correctly")) + "List of acronyms to expand." + :group 'erc-speak + :type '(repeat sexp)) + +(defun erc-speak-acronym-replace (string) + "Replace acronyms in the current buffer." + (let ((case-fold-search nil)) + (dolist (ac erc-speak-acronyms string) + (while (string-match (car ac) string) + (setq string (replace-match (cadr ac) nil t string)))))) + +(defcustom erc-speak-smileys '((":-)" "smiling face") + (":)" "smiling face") + (":-(" "sad face") + (":(" "sad face")) +;; please add more, send me patches, mlang@home.delysid.org tnx + "List of smileys and their textual description." + :group 'erc-speak + :type '(repeat (list 'symbol 'symbol))) + +(defcustom erc-speak-smiley-personality 'harry + "Personality used for smiley announcements." + :group 'erc-speak + :type 'symbol) + +(defun erc-speak-smiley-replace (string) + "Replace smileys with textual description." + (let ((case-fold-search nil)) + (dolist (smiley erc-speak-smileys string) + (while (string-match (car smiley) string) + (let ((repl (cadr smiley))) + (put-text-property 0 (length repl) 'personality + erc-speak-smiley-personality repl) + (setq string (replace-match repl nil t string))))))) + +(defcustom erc-speak-channel-personality 'harry + "*Personality to announce channel names with." + :group 'erc-speak + :type 'symbol) + +(defun erc-speak-region () + "Speak a region containing one IRC message using Emacspeak. +This function tries to translate common IRC forms into +intelligent speech." + (let ((target (if (erc-channel-p (erc-default-target)) + (erc-propertize + (erc-default-target) + 'personality erc-speak-channel-personality) + "")) + (dtk-stop-immediately nil)) + (emacspeak-auditory-icon 'progress) + (when erc-speak-filter-timestamp + (save-excursion + (goto-char (point-min)) + (when (re-search-forward "^\\[[a-zA-Z:,;.0-9 \t-]+\\]" nil t) + (narrow-to-region (point) (point-max))))) + (save-excursion + (goto-char (point-min)) + (cond ((re-search-forward (concat "^<\\([^>]+\\)> " + (concat "\\(" + erc-valid-nick-regexp + "\\)[;,:]")) nil t) + (let ((from (match-string 1)) + (to (match-string 2)) + (text (buffer-substring (match-end 2) (point-max)))) + (tts-with-punctuations + "some" + (dtk-speak (concat (erc-propertize + (concat target " " from " to " to) + 'personality erc-speak-channel-personality) + (erc-speak-smiley-replace + (erc-speak-acronym-replace text))))))) + ((re-search-forward "^<\\([^>]+\\)> " nil t) + (let ((from (match-string 1)) + (msg (buffer-substring (match-end 0) (point-max)))) + (tts-with-punctuations + "some" + (dtk-speak (concat target " " from " " + (erc-speak-smiley-replace + (erc-speak-acronym-replace msg))))))) + ((re-search-forward (concat "^" (regexp-quote erc-notice-prefix) + "\\(.+\\)") + (point-max) t) + (let ((notice (buffer-substring (match-beginning 1) (point-max)))) + (tts-with-punctuations + "all" + (dtk-speak + (with-temp-buffer + (insert notice) + (when erc-speak-filter-host + (goto-char (point-min)) + (when (re-search-forward "([^)@]+@[^)@]+)" nil t) + (replace-match ""))) + (buffer-string)))))) + (t (let ((msg (buffer-substring (point-min) (point-max)))) + (tts-with-punctuations + "some" + (dtk-speak (concat target " " + (erc-speak-smiley-replace + (erc-speak-acronym-replace msg))))))))))) + +(provide 'erc-speak) + +;;; erc-speak.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 4499cd13-2829-43b8-83de-d313481531c4 |