X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-doctor.el;h=6541157a5f49ca41ba5a94afbcd50cd568e14a6c;hp=7de1c1135aaff9bd1eb072b28a1628cdfa72f680;hb=71cfc726e9ef6ae459a3e490df9c307d5204acb2;hpb=93cc8b9f10b1b3e74d76de99a0e1e476b1ce0a11 diff --git a/lisp/riece-doctor.el b/lisp/riece-doctor.el index 7de1c11..6541157 100644 --- a/lisp/riece-doctor.el +++ b/lisp/riece-doctor.el @@ -26,7 +26,7 @@ ;; 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: @@ -40,23 +40,32 @@ :prefix "riece-" :group 'riece) -(defcustom riece-doctor-hello-regexp "^, doctor" +(defcustom riece-doctor-hello-regexp "^,doctor$" "Pattern of string patients start consultation." :type 'string :group 'riece-doctor) -(defcustom riece-doctor-bye-regexp "^, bye doctor" +(defcustom riece-doctor-bye-regexp "^,doctor bye$" "Pattern of string patients end consultation." :type 'string :group 'riece-doctor) (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 @@ -67,56 +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) - (format "%s: You are already talking with me." - (riece-format-identity user t))) - (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) - (format - "%s: I am the psychotherapist. Please, describe your problems." - (riece-format-identity user t)))) - (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) - (format "%s: Good bye." (riece-format-identity user t))))) - (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)))) + (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: %s" (riece-format-identity user t) string)))))))) + (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