X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Friece-doctor.el;h=61a33f0561513298ed784830cba1f06c4c6c8eee;hb=31af90ee9dadd320e1820f0524de9dc3460f4ea4;hp=c922c9eabb05c4ce981d78c71668dc7d6139656f;hpb=005a2a7642c9f43d699922799801124a77d56f5d;p=riece diff --git a/lisp/riece-doctor.el b/lisp/riece-doctor.el index c922c9e..61a33f0 100644 --- a/lisp/riece-doctor.el +++ b/lisp/riece-doctor.el @@ -26,10 +26,15 @@ ;; 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) +;; (add-to-list 'riece-addons 'riece-doctor) ;;; Code: +(require 'riece-globals) +(require 'riece-identity) +(require 'riece-message) +(require 'riece-server) + (defgroup riece-doctor nil "Interface to doctor.el" :prefix "riece-" @@ -47,11 +52,20 @@ (defvar riece-doctor-patients nil) +(defvar riece-doctor-enabled nil) + +(defconst riece-doctor-description + "Allow users in channel to talk with the classic pseudo-AI") + +(put 'riece-doctor 'riece-addon-default-disabled t) + (autoload 'doctor-mode "doctor") (autoload 'doctor-read-print "doctor") (defun riece-doctor-buffer-name (user) - (concat " *riece-doctor*" (riece-format-identity user))) + (concat " *riece-doctor*" + (riece-format-identity + (riece-make-identity user riece-server-name)))) (defun riece-doctor-reply (target string) (riece-display-message @@ -62,49 +76,65 @@ (riece-send-string (format "NOTICE %s :%s\r\n" target string))) (defun riece-doctor-after-privmsg-hook (prefix string) - (let* ((user (riece-make-identity (riece-prefix-nickname prefix) - riece-server-name)) - (parameters (riece-split-parameters string)) - (targets (split-string (car parameters) ",")) - (message (nth 1 parameters))) - (if (string-match riece-doctor-hello-regexp message) - (if (riece-identity-member 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 riece-doctor-bye-regexp message) - (let ((pointer (riece-identity-member 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."))) - (if (riece-identity-member user riece-doctor-patients) - (let (string) + (if riece-doctor-enabled + (let* ((user (riece-prefix-nickname prefix)) + (parameters (riece-split-parameters string)) + (targets (split-string (car parameters) ",")) + (message (nth 1 parameters))) + (if (string-match riece-doctor-hello-regexp message) + (if (riece-identity-member user riece-doctor-patients t) + (riece-doctor-reply + (car targets) + (format "%s: You are already talking with me." user)) (save-excursion - (set-buffer (get-buffer (riece-doctor-buffer-name user))) - (goto-char (point-max)) - (insert message "\n") - (let ((point (point))) - (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 ? ) - (setq string (buffer-string)))) - (riece-doctor-reply (car targets) string))))))) + (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) + (format + "%s: I am the psychotherapist. \ +Please, describe your problems." + user))) + (if (string-match riece-doctor-bye-regexp message) + (let ((pointer (riece-identity-member user + riece-doctor-patients t))) + (when pointer + (kill-buffer (riece-doctor-buffer-name user)) + (setq riece-doctor-patients (delq (car pointer) + riece-doctor-patients)) + (riece-doctor-reply + (car targets) + (format "%s: Good bye." user)))) + (if (riece-identity-member user riece-doctor-patients t) + (let (string) + (save-excursion + (set-buffer (get-buffer (riece-doctor-buffer-name user))) + (goto-char (point-max)) + (insert message "\n") + (let ((point (point))) + (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 ? ) + (setq string (buffer-string)))) + (riece-doctor-reply + (car targets) + (format "%s: %s" user string))))))))) (defun riece-doctor-insinuate () (add-hook 'riece-after-privmsg-hook 'riece-doctor-after-privmsg-hook)) +(defun riece-doctor-enable () + (setq riece-doctor-enabled t)) + +(defun riece-doctor-disable () + (setq riece-doctor-enabled nil)) + (provide 'riece-doctor) ;;; riece-doctor.el ends here