From b834bf2df318ea6fb5ae02406cca8262ae22c0db Mon Sep 17 00:00:00 2001 From: ueno Date: Wed, 11 Jun 2003 09:16:07 +0000 Subject: [PATCH] * riece-doctor.el: New add-on. * COMPILE (riece-modules): Add riece-doctor. * Makefile.am (EXTRA_DIST): Add riece-doctor.el --- lisp/COMPILE | 3 +- lisp/ChangeLog | 6 ++++ lisp/Makefile.am | 2 +- lisp/riece-doctor.el | 94 ++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 103 insertions(+), 2 deletions(-) create mode 100644 lisp/riece-doctor.el diff --git a/lisp/COMPILE b/lisp/COMPILE index fde0e89..0d09239 100644 --- a/lisp/COMPILE +++ b/lisp/COMPILE @@ -43,7 +43,8 @@ riece-highlight riece-rdcc riece-url - riece-unread)))) + riece-unread + riece-doctor)))) (defun riece-compile-modules (modules) (let ((load-path (cons nil load-path))) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9669b9a..bdd8220 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,11 @@ 2003-06-11 Daiki Ueno + * riece-doctor.el: New add-on. + * COMPILE (riece-modules): Add riece-doctor. + * Makefile.am (EXTRA_DIST): Add riece-doctor.el + +2003-06-11 Daiki Ueno + * riece-identity.el (riece-identity-member): Assume that each element of list is identity object. (riece-identity-member-no-server): Ditto. diff --git a/lisp/Makefile.am b/lisp/Makefile.am index efa84d4..ed50ab6 100644 --- a/lisp/Makefile.am +++ b/lisp/Makefile.am @@ -7,7 +7,7 @@ EXTRA_DIST = COMPILE ChangeLog ChangeLog.Liece \ riece-options.el riece-server.el riece-user.el riece-version.el \ riece-xemacs.el riece.el \ riece-ctcp.el riece-url.el riece-unread.el \ - riece-ndcc.el riece-rdcc.el + riece-ndcc.el riece-rdcc.el riece-doctor.el CLEANFILES = auto-autoloads.el custom-load.el *.elc FLAGS ?= -batch -q -no-site-file diff --git a/lisp/riece-doctor.el b/lisp/riece-doctor.el new file mode 100644 index 0000000..022366e --- /dev/null +++ b/lisp/riece-doctor.el @@ -0,0 +1,94 @@ +;;; riece-doctor.el --- "become a psychotherapist" add-on +;; Copyright (C) 1998-2003 Daiki Ueno + +;; Author: Daiki Ueno +;; Keywords: IRC, riece + +;; This file is part of Riece. + +;; This program 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 2, 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 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., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This add-on allows you to become a psychotherapist. + +;; To use, add the following line to your ~/.riece/init.el: +;; (add-to-list 'riece-addons 'riece-doctor t) + +;;; Code: + +(require 'doctor) + +(defvar riece-doctor-patients nil) + +(defun riece-doctor-buffer-name (user) + (concat " *riece-doctor*" (riece-identity-canonicalize-prefix user))) + +(defun riece-doctor-reply (target string) + (riece-send-string (format "NOTICE %s :%s\r\n" target string)) + (riece-own-channel-message string + (riece-make-identity target riece-server-name) + 'notice)) + +(defun riece-doctor-after-privmsg-hook (prefix string) + (let* ((user (riece-prefix-nickname prefix)) + (parameters (riece-split-parameters string)) + (targets (split-string (car parameters) ",")) + (message (nth 1 parameters))) + (if (string-match "^, doctor" message) + (if (riece-identity-member-no-server user riece-doctor-patients) + (riece-doctor-reply + (car targets) + "You are already talking with me.") + (save-excursion + (set-buffer (get-buffer-create (riece-doctor-buffer-name user))) + (erase-buffer) + (doctor-mode)) + (setq riece-doctor-patients (cons user riece-doctor-patients)) + (riece-doctor-reply + (car targets) + "I am the psychotherapist. Please, describe your problems.")) + (if (string-match "^, bye doctor" message) + (let ((pointer (riece-identity-member-no-server + user riece-doctor-patients))) + (when pointer + (kill-buffer (riece-doctor-buffer-name user)) + (setq riece-doctor-patients (delq (car pointer) + riece-doctor-patients)) + (riece-doctor-reply (car targets) "Good bye."))) + (when (riece-identity-member-no-server user riece-doctor-patients) + (riece-doctor-reply + (car targets) + (save-excursion + (set-buffer (get-buffer (riece-doctor-buffer-name user))) + (goto-char (point-max)) + (insert message "\n") + (let ((point (point)) + string) + (doctor-read-print) + (setq string (buffer-substring (1+ point)(- (point) 2))) + (with-temp-buffer + (insert string) + (subst-char-in-region (point-min) (point-max) ?\n ? ) + (buffer-string)))))))))) + +(defun riece-doctor-insinuate () + (make-variable-buffer-local 'riece-doctor-patients) + (add-hook 'riece-after-privmsg-hook 'riece-doctor-after-privmsg-hook)) + +(provide 'riece-doctor) + +;;; riece-doctor.el ends here -- 1.7.10.4