cgit.sxemacs.org Git - emchat/blob - emchat-doctor.el

   1 ;; emchat-doctor.el --- Let ICQ users psycho-analize themselves
   2
   3 ;; Copyright (C) 2005 - 2007 Steve Youngs
   4
   5 ;; Author:        Steve Youngs <steve@emchat.org>
   6 ;; Maintainer:    Steve Youngs <steve@emchat.org>
   7 ;; Created:       <2005-09-14>
   8 ;; Homepage:      http://www.emchat.org/
   9 ;; Keywords:      ICQ
  10
  11 ;; This file is part of EMchat.
  12
  13 ;; Redistribution and use in source and binary forms, with or without
  14 ;; modification, are permitted provided that the following conditions
  15 ;; are met:
  16 ;;
  17 ;; 1. Redistributions of source code must retain the above copyright
  18 ;;    notice, this list of conditions and the following disclaimer.
  19 ;;
  20 ;; 2. Redistributions in binary form must reproduce the above copyright
  21 ;;    notice, this list of conditions and the following disclaimer in the
  22 ;;    documentation and/or other materials provided with the distribution.
  23 ;;
  24 ;; 3. Neither the name of the author nor the names of any contributors
  25 ;;    may be used to endorse or promote products derived from this
  26 ;;    software without specific prior written permission.
  27 ;;
  28 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  29 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  30 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  31 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  32 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  33 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  34 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  35 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  36 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  37 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  38 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  39
  40 ;;; Commentary:
  41 ;;
  42 ;; Inspired by riece-doctor.el, where much of this was stolen from. :-)
  43
  44 ;;; Todo:
  45 ;;
  46 ;;
  47
  48 ;;; Code:
  49 (autoload 'doctor-mode "doctor")
  50 (autoload 'doctor-read-print "doctor")
  51
  52 (defgroup emchat-doctor nil
  53   "Let ICQ users psycho-analyze themselves."
  54   :prefix "emchat-"
  55   :group 'emchat)
  56
  57 (defcustom emchat-doctor-enabled-flag nil
  58   "When non-nil, the doctor is in."
  59   :type 'boolean
  60   :group 'emchat-doctor)
  61
  62 (defcustom emchat-doctor-begin-string ",,doctor"
  63   "When this is received as a msg, start the doctor."
  64   :type 'string
  65   :group 'emchat-doctor)
  66
  67 (defcustom emchat-doctor-end-string ",,doctor quit"
  68   "When this is received as a msg, end the doctor."
  69   :type 'string
  70   :group 'emchat-doctor)
  71
  72 (defcustom emchat-doctor-hello-string
  73   "Hello, I am your therapist.
  74 To end our session today, just say \",,doctor quit\".
  75
  76 Now, what seems to be the problem, today?"
  77   "Initial greeting from the EMchat Doctor."
  78   :type 'string
  79   :group 'emchat-doctor)
  80
  81 (defcustom emchat-doctor-goodbye-string
  82   "Thank you for coming to see me today.
  83
  84 To summarise:  basically, you're nuts.
  85
  86 My invoice will arrive in the mail shortly,
  87 unless you are suffering from a split personality
  88 disorder, in that case 2 invoices will arrive.
  89
  90 Goodbye, and please don't operate any heavy
  91 machinery for a while."
  92   "String sent when the therapy session ends."
  93   :type 'string
  94   :group 'emchat-doctor)
  95
  96 ;;; Internal variables
  97 (defvar emchat-doctor-patients nil
  98   "List of people who are talking to the doctor.")
  99
 100 (defun emchat-doctor-buffer-name (alias)
 101   (concat " *emchat-doctor--" alias "*"))
 102
 103 (defun emchat-doctor-reply (message alias)
 104   (emchat-v8-send-simple-message
 105    emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias)) message)
 106   (emchat-log-outgoing alias ">>> <Doctor>: %s" message))
 107
 108 (defun emchat-doctor (message alias)
 109   (if (equal message emchat-doctor-end-string)
 110       (progn
 111         (setq emchat-doctor-patients (remove alias emchat-doctor-patients))
 112         (when (buffer-live-p (emchat-doctor-buffer-name alias))
 113           (kill-buffer (emchat-doctor-buffer-name alias)))
 114         (emchat-doctor-reply emchat-doctor-goodbye-string alias))
 115     (if (equal message emchat-doctor-begin-string)
 116         (emchat-doctor-reply "You are already talking to me." alias)
 117       (set-buffer (get-buffer-create (emchat-doctor-buffer-name alias)))
 118       (doctor-mode)
 119       (insert message "\n")
 120       (let ((point (point))
 121             reply)
 122         (doctor-read-print)
 123         (setq reply (buffer-substring (1+ point) (- (point) 2)))
 124         (emchat-doctor-reply reply alias)))))
 125
 126 (provide 'emchat-doctor)
 127 ;;; emchat-doctor.el ends here
 128