changeset 18389:f5f7ca6c4a96

(doctor-death): Give real advice to truly suicidal.
author Richard M. Stallman <rms@gnu.org>
date Sun, 22 Jun 1997 21:34:22 +0000
parents 7e14277c51f3
children 7c853eb6ad19
files lisp/play/doctor.el
diffstat 1 files changed, 16 insertions(+), 1 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/play/doctor.el	Sun Jun 22 20:08:32 1997 +0000
+++ b/lisp/play/doctor.el	Sun Jun 22 21:34:22 1997 +0000
@@ -542,6 +542,8 @@
   (setq eliza-flag nil)
   (make-local-variable 'zippy-flag)
   (setq zippy-flag nil)
+  (make-local-variable 'suicide-flag)
+  (setq suicide-flag nil)
   (make-local-variable 'lover)
   (setq lover '(your partner))
   (make-local-variable 'bak)
@@ -717,6 +719,7 @@
 (doctor-put-meaning suicides 'death)
 (doctor-put-meaning kill 'death)
 (doctor-put-meaning kills 'death)
+(doctor-put-meaning killing 'death)
 (doctor-put-meaning die 'death)
 (doctor-put-meaning dies 'death)
 (doctor-put-meaning died 'death)
@@ -1574,7 +1577,19 @@
       (doctor-foul)
     (doctor-type ($ sexlst))))
 
-(defun doctor-death () (doctor-type ($ deathlst)))
+(defun doctor-death ()
+  (cond (suicide-flag (doctor-type ($ deathlst)))
+	((or (equal found 'suicide)
+             (and (or (equal found 'kill)
+                      (equal found 'killing))
+                  (memq 'yourself sent)))
+	 (setq suicide-flag t)
+	 (doctor-type '(If you are really suicidal, you might
+			   want to contact the Samaritans via
+			   E-mail: jo@samaritans.org or, at your option,
+			   anonymous E-mail: samaritans@anon.penet.fi\ \.
+			   ($ please) ($ continue) \.)))
+	(t (doctor-type ($ deathlst)))))
 
 (defun doctor-foul ()
   (doctor-type ($ foullst)))