;;;; -*- mode:emacs-lisp;coding:utf-8 -*- ;;;;************************************************************************** ;;;;FILE: pjb-erc-speak.el ;;;;LANGUAGE: emacs lisp ;;;;SYSTEM: POSIX ;;;;USER-INTERFACE: NONE ;;;;DESCRIPTION ;;;; ;;;; erc speak stuff. ;;;; ;;;;AUTHORS ;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com> ;;;;MODIFICATIONS ;;;; 2014-02-24 <PJB> Extracted from ~/rc/emacs-common.el ;;;;BUGS ;;;;LEGAL ;;;; AGPL3 ;;;; ;;;; Copyright Pascal J. Bourguignon 2014 - 2014 ;;;; ;;;; This program is free software: you can redistribute it and/or modify ;;;; it under the terms of the GNU Affero General Public License as published by ;;;; the Free Software Foundation, either version 3 of the License, or ;;;; (at your option) any later version. ;;;; ;;;; This program 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 Affero General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU Affero General Public License ;;;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;;;;************************************************************************** (require 'cl) (require 'erc) (require 'pjb-speak) ;;;--------------------------------------------------------------------- ;;; ERC speach ;;;--------------------------------------------------------------------- (defparameter *pjb-erc-spoken-nicks* '(("\\<e1f\\>" . "elf") ("\\<tali[0-9]+" . "tali") ("\\<fsbot\\>" . "F. S. Bot") ("\\<qu1j0t3\\>" . "quijote") ("\\<chromaticwt\\>" . "chromatic W. T.") ("\\<jcowan\\>" . "J. Cowan") ("\\<cky\\>" . "C. K. Y.") ("\\<pjb\\>" . "Pascal") ("\\<H4ns\\>" . "Hans") ("\\<Corman[0-9]+\\>" . "Corman")) "An a-list mapping regexps of nicks to the corresponding text to be read aloud.") (defun pjb-erc-spoken-nick (nick) " RETURN: The text to be read aloud for the `nick' in `*pjb-erc-spoken-nicks*'. " (let ((entry (assoc* nick *pjb-erc-spoken-nicks* :test (lambda (nick ref) (string-match ref nick))))) (if entry (cdr entry) nick))) (defun erc-response.recipient (response) (first (erc-response.command-args response))) (defun erc-response.sender-nick (response) (let ((sender (erc-response.sender response))) (subseq sender 0 (position ?! sender)))) (defparameter *pjb-erc-massage-substitutions* '(("\\<pjb\\>" "Pascal") ("\\<CL\\>" "See Ell") ("\\<C-" "Control-") ("\\<M-" "Meta-") ("\\<A-" "Alt-") ("\\<S-" "Shift-") ("\\<s-" "super-") ("\\<H-" "Hyper-") ("\\(:-?)\\|(-?:\\)" "AhAhAh!") (":-?(" "BooBooBoo!") (":-/" "muek") (":-?[Pp]" "bruu") ("\\<\\(ty\\|thx\\)\\>" "Thank you!") ("\\<LOL\\>" "AhAhAh! Laughting Out Loud!") ("\\<ROFL\\>" "AhAhAh! Rolling On the Floor!") ("\\<hrm\\>" "errrmmm") ("\\<btw\\>" "by the way") ("\\<wtf\\>" "what the fuck") ("\\<imo\\>" "in my opinion") ("\\<imho\\>" "in my humble opinion") ("\\<imnsho\\>" "in my not so humble opinion"))) (defun pjb-erc-massage-message (message) (with-current-buffer (get-buffer-create "*pjb massage text*") (erase-buffer) (insert message) (let ((case-fold-search nil)) (loop for (reg sub) in *pjb-erc-massage-substitutions* do (progn (goto-char (point-min)) (loop while (re-search-forward reg nil t) do (progn (delete-region (match-beginning 0) (match-end 0)) (insert sub)))))) (buffer-string))) (defvar *pjb-erc-speak-reject-recipient* '() "can be: nil don't reject any channel. :all reject every channel. or a list of nicknames or channel names \"nick\" \"\#chan\" to reject (never speak them aloud). See: `*pjb-erc-speak-reject-sender*', `*pjb-erc-speak-accept-sender*', and `pjb-erc-privmsg-meat'. Messages are spoken if the recipient ") (defvar *pjb-erc-speak-reject-sender* '() "can be: nil don't reject anybody. :all reject everybody. or a list of nicknames or channel names \"nick\" \"\#chan\" to reject (never speak them aloud). See: `*pjb-erc-speak-reject-recipient*', `*pjb-erc-speak-accept-sender*', and `pjb-erc-privmsg-meat'. ") (defvar *pjb-erc-speak-accept-sender* '() "can be: nil don't accept anything. :all accept everything. or a list of nicknames or channel names \"nick\" \"\#chan\" to accept (speak them aloud). See: `*pjb-erc-speak-reject-recipient*', `*pjb-erc-speak-reject-sender*', and `pjb-erc-privmsg-meat'. ") (setf *pjb-erc-speak-accept-sender* :all *pjb-erc-speak-reject-sender* '("minion" "clhs" "specbot") *pjb-erc-speak-reject-recipient* '("minion" "clhs" "specbot")) (setf *pjb-erc-speak-reject-recipient* '("#emacs") *pjb-erc-speak-reject-recipient* :all *pjb-erc-speak-reject-sender* :all *pjb-erc-speak-accept-sender* '("Posterdati" "pjb-")) (defun pjb-erc-member (item list-designator) "Return whether the `item' is in a virtual list designated by `list-designator'. `list-designator' may be nil for an empty list), :all or t for a list containing everything, or an actual list. items are compared with `string='. " (case list-designator ((nil) nil) ((:all t) t) (otherwise (member* item list-designator :test 'string=)))) (defun pjb-erc-prepare-message (reponse last-speaker) "Return a list (formated-message new-last-speaker)" (let* ((nick (pjb-erc-spoken-nick (erc-response.sender-nick response))) (chan (pjb-erc-spoken-nick (remove ?# (erc-response.recipient response)))) (mesg (pjb-erc-massage-message (erc-response.contents response)))) (if (equal last-speaker (cons nick chan)) (list (format "%s" mesg) last-speaker) (list (format "%s said to %s: ... %s" nick chan mesg) (cons nick chan))))) (defvar *pjb-erc-speak-last-speaker* nil) (defun pjb-erc-speak-privmsg-meat (process response) "The messages are spoken if the sender is in `*pjb-erc-speak-accept-sender*', or the sender is not in `*pjb-erc-speak-reject-sender*', or the recipient is not in `*pjb-erc-speak-reject-recipient*', " (when (or (pjb-erc-member (erc-response.sender-nick response) *pjb-erc-speak-accept-sender*) (pjb-erc-member (erc-response.sender-nick response) *pjb-erc-speak-reject-sender*) (pjb-erc-member (erc-response.recipient response) *pjb-erc-speak-reject-recipient*)) (let ((message (pjb-erc-prepare-message response *pjb-erc-speak-last-speaker*))) (setf *pjb-erc-speak-last-speaker* (second message)) (speak (first message)))) nil) (defun pjb-erc-speak-on () (interactive) (pushnew 'pjb-erc-speak-privmsg-meat erc-server-PRIVMSG-functions)) (defun pjb-erc-speak-off () (interactive) (setf erc-server-PRIVMSG-functions (remove 'pjb-erc-speak-privmsg-meat erc-server-PRIVMSG-functions))) (defvar *pjb-erc-tooltip-last-tooltiper* nil) (defun pjb-erc-tooltip-privmsg-meat (process response) "The messages are displayed in tooltips." (let ((message (pjb-erc-prepare-message response *pjb-erc-tooltip-last-tooltiper*))) (setf *pjb-erc-tooltip-last-tooltiper* (second message)) (tooltip-show (first message))) nil) (defun pjb-erc-tooltip-on () (interactive) (pushnew 'pjb-erc-tooltip-privmsg-meat erc-server-PRIVMSG-functions)) (defun pjb-erc-tooltip-off () (interactive) (setf erc-server-PRIVMSG-functions (remove 'pjb-erc-tooltip-privmsg-meat erc-server-PRIVMSG-functions))) (provide 'pjb-erc-speak) ;;;; THE END ;;;;