;;; -*- Mode:Emacs-Lisp -*-
;;; 30-Nov-90 16:33:53, Bjorn Victor
;;; Comint-based lpmud interface.
;; Copyright (C) 1990, 1991, Bjorn Victor
;;
;; 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 1, 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 this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;
;; The author can be contacted as follows:
;;     e-mail: Bjorn.Victor@DoCS.UU.SE
;; paper-mail: Bjorn Victor
;;	       Dept of Computer Systems, Uppsala University
;;	       Box 520
;;	       S-751 20  Uppsala, SWEDEN
;;
;; Inspired by lpmud.el (Copyright (C) 1990 Lysator Computer Club)
;; by Lars Willfor <willfor@lysator.liu.se>
;; and Thomas Bellman <Bellman@Lysator.LiU.SE>
;;
;; but thanks Olin Shivers <shivers@cs.cmu.edu> for comint.el (Copyright 1988),
;; which makes everything much easier and coherent.

;;;
;;; To use this code, simply load it and say M-x clpmud,
;;; or add
;
;(autoload 'clpmud "clpmud"
;	  "Open an LPmud connection to HOST.
;HOST can be an Internet host name, or a name of an LPmud
;defined in clpmud-configuration-list.
;If it is a host name, the port number is given by prefix argument
; (e.g \\[universal-argument] 9000 \\[clpmud]),
;and defaults to 2000" t)
;
;;; to you .emacs file, and then use M-x clpmud.
;;; Use
;;;   C-h d clpmud
;;; and
;;;   C-h m
;;; when in clpmud-mode
;;; to get more documentation.

;;; Features:
; * Coherent with cmushell, cmulisp, cmugdb et al, since it's based on comint.
; * Dynamic abbrevs on TAB, word abbrevs work normally.
; * Dynamic spell and combat spell names (give an argument to M-q or M-s).
; * Powerful (I think) macro mechanism, with inversibility for simple actions.
; * Start at automatic return (see landmark functions below).
; * Gag feature for Harry, Drunkard and those.
; * Configuration list that *works*.
;   It includes:
;     selecting a mud name -> machine,port,default player
;     selecting a player name -> drink,spell
;   and will soon be automatically updatable.
; * A real nice "ed" interface
; * A nice file-reading interface
; * Auto-replies
; * Notification on messages when buffer is not in any window
; * Auto-shrinking of buffer, to keep Emacs small even after
;   playing for some hours.

;;; Wanted features:
; * Automagically find out which drink and spell are best.
; * Implement auto-actions a'la Lysator's lpmud.el
; * Auto-wait for soberness?

;;; To do:
; * Rework landmarks to use general macro mechanism instead.

(require 'comint)

;; Wiz interface
(autoload 'clpmud-ed "clpmud-ed" "Edit an LPmud file" t)
(autoload 'clpmud-view-file "clpmud-ed" "View an LPmud file" t)

(defvar clpmud-prompt-pattern "> \\|^\\]"
  "A regexp to recognize the prompt for lpmud")

(defvar clpmud-mode-map nil
  "Keymap for clpmud-mode")
(defvar clpmud-syntax-table nil
  "Syntax table for clpmud-mode")

(defvar clpmud-macro-file-name "~/clpmud.macros"
  "*The default filename to read and write macros from/to")

(defvar clpmud-macro-blink-beep 'beep
  "*Controls whether successful macro executions beeps, blinks the modeline,
or does nothing.  Set this to 'beep or 'blink or nil, to just get a message.
Failing or aborted macros always beep.")

(defvar clpmud-macro-fast-execution nil
  "*If non-NIL, execute macros as fast as possible
but still do redisplay during execution.")

(defvar clpmud-return-sends-whole-line nil
  "*If non-NIL and Return is pressed, the whole line is sent,
not just up to point.
This is obsoleted by comint version 2.02, which has a variable
called comint-eol-on-send serving the same purpose..")

(defvar clpmud-macro-brief nil
  "*If non-NIL, wrap macro executions in \"brief\" mode.")

(defvar clpmud-drink nil
  "*The default drink to buy and drink when you do \\[clpmud-drink]
This variable is buffer local.")
(make-variable-buffer-local 'clpmud-drink)

(defvar clpmud-combat-spell nil
  "*The default combat spell to cast when you do \\[clpmud-combat-spell]
This variable is buffer local.")
(make-variable-buffer-local 'clpmud-combat-spell)

(defconst clpmud-failure-string  "What ?"
  "*The error message string, normally \"What ?\".
If you're a wizard and use efun/notify_fail(), you should
set this if you want macros to stay working.")

(defvar clpmud-notify-on-messages t
  "*Whether to notify on messages from players
when the clpmud buffer is not in any window,
or when the output is not inside the window.")

(defvar clpmud-max-buffer-size (* 80 24 3 4)
  "*Maximum size (in chars) of a clpmud buffer, if non-zero.
When the buffer becomes larger, it is automatically shrunk
to the value of clpmud-min-buffer-size (which see)")

(defvar clpmud-min-buffer-size (* 80 24 3 3)
  "*Minimum size (in chars) of a clpmud buffer, if non-zero.
When the buffer becomes larger than clpmud-max-buffer-size,
it is shrunk to the value of clpmud-min-buffer-size.")

(defvar clpmud-auto-reply ""
  "An auto reply for when you're at lunch or so.
See \\[clpmud-set-auto-reply]")

(defconst clpmud-drink-table
  '(("beer") ("special") ("firebreather") ("whiskey") ("mixture")
    ;; Local at Mizar
    ("guinness") ("retsina") ("janx")
    )
  "Completing alist for selecting a drink in \\[clpmud-drink]")

(defconst clpmud-combat-spell-table
  '(("missile") ("shock") ("fireball"))
  "Completing alist for selecting a combat spell in \\[clpmud-combat-spell]")

(defvar clpmud-load-hook nil
  "Hook which is run when clpmud is loaded.
This is a list of function names or lambda expressions.
A nice thing to put here is 'clpmud-load-macros
Another is '(lambda () (clpmud-define-mud \"Local\" \"localhost\"))")

(defvar clpmud-configuration-list
  '(("Genesis" "milou.cd.chalmers.se" 2000)
    ("Batman" "batman.hut.fi" 2000)
    ("Nanny" "nanny.lysator.liu.se" 2000)
    ("DeathMUD" "gauss.NMSU.Edu" 2000)
    ("Mizar" "Mizar.DoCS.UU.SE" 9000)
    ("Mammoth" "mammoth.unr.edu" 2000)
    ("Lehtori" "lehtori.tut.fi" 2000)
    ("Wintergate" "orlith.bates.edu" 2000)
    ("Overdrive" "flakes.utah.edu" 2000)
    ("Assassin!" "luke.eecs.wsu.edu" 2000)
    ("Alderon" "alderon.lanl.gov" 2000)
;    ("Chevette" "130.111.112.11" 2000)	;can't hack numeric addr
;    ("DikuMud" "alfa.me.chelmers.se" 4000) ;not an LPMUD?
    ("LPSwat" "pompeii.cs.swarthmore.edu" 2020)
    ("Deep Trouble" "krikand.iesd.auc.dk" 2000)
    ("Infinity" "infinity.ccs.neu.edu" 3000))
  "*The configuration of clpmud.
Please use the functions
 clpmud-define-mud
and
 clpmud-define-player
\(which see) instead of setting this variable directly.

This lets you select an LPmud by its name, without having to
remember what machine or port number it uses.  It also lets
you configure your different players (see below).

The format of the configuration list is this:
\((name machine port
       (player drink spell)
       (player drink spell)
       ...)
 (name machine port ....))

For example, a value could be
 ((\"Genesis\" \"milou.cd.chalmers.se\" 2000)
  (\"Mizar\" \"Mizar.DoCS.UU.SE\" 9000
   (\"Gwydion\" \"beer\" \"fireball\"))
  (\"Nanny\" \"nanny.lysator.liu.se\" 2000))
which defines a couple of MUDs, and the player \"Gwydion\" in
the game \"Mizar\", who drinks \"beer\" per default, and
uses \"fireball\" for combat spell.

If you have a player on Mizar called Spoof, who is at a level
where \"shock\" is the best available combat spell, and \"special\"
is the mostly drunk drink, you could have the Mizar entry look
like this:
  (\"Mizar\" \"Mizar.DoCS.UU.SE\" 9000
           (\"Spoof\" \"special\" \"shock\"))
This will set up clpmud-combat-spell to \"shock\"
and clpmud-drink to \"special\" when you have connected
to Mizar and given \"Spoof\" (or \"spoof\") as your player name.
Player names in the configuration should be Capitalized.
")

(defvar clpmud-configuration nil
  "The actual configuration for this lpmud buffer")
(make-variable-buffer-local 'clpmud-configuration)

;; Landmark and macro things
(defvar clpmud-landmark-history nil)
(make-variable-buffer-local 'clpmud-landmark-history)
(defvar clpmud-current-macro nil)
(make-variable-buffer-local 'clpmud-current-macro)
(defvar clpmud-defining-macro nil)
(make-variable-buffer-local 'clpmud-defining-macro)
; Make modeline show it.
(setq minor-mode-alist (cons '(clpmud-defining-macro " LPdef") minor-mode-alist))
;
(defvar clpmud-macro-table nil
  "A table of macros, consisting of a list of (\"NAME\" . list-of-actions).
See \\[clpmud-start-macro-definition], \\[clpmud-end-macro-definition], \\[clpmud-run-macro]
and \\[clpmud-save-macros] and \\[clpmud-load-macros]")
;; Don't want this local, I think.
;(make-variable-buffer-local 'clpmud-macro-table)

(defconst clpmud-invertible-actions
  '("n" "s" "w" "e" "sw" "se" "ne" "nw" "u" "d" "up"
    "open" "close"))

(defconst clpmud-invertible-directions
  '(("n" . "s") ("s" . "n") ("e" . "w") ("w" . "e") ("nw" . "se") ("ne" . "sw")
    ("se" . "nw") ("sw" . "ne") ("u" . "d") ("d" . "u") ("up" . "d")))

(defvar clpmud-gagged-players-regexp ""
  "A regular expression of the names of players who are gagged.
A typical value could be \"Harry\\\\\|The drunkard\"
Don't set this variable by hand, use \\[clpmud-gag-player], \\[clpmud-ungag-player], \\[clpmud-list-gagged-players]")
(defvar clpmud-gagged-players-alist ()
  "An alist describing how people are gagged.
A NIL in the cdr means don't mention their mumbling,
anything else means they mumble.
Don't set this variable by hand, use \\[clpmud-gag-player], \\[clpmud-ungag-player], \\[clpmud-list-gagged-players]")
  

;; NPCs that are suggested to gag.
(defconst clpmud-gaggable-players
  '(("Harry" . "Harry") ("Drunkard" . "The drunkard") ("Go player" . "Go player")))

;; Abbrevs
(define-abbrev-table 'clpmud-mode-abbrev-table
  ;; This table is simply snarfed from Lysator's lpmud.el
  '(("fc"	"from corpse"		nil	0)
    ("gc"	"get corpse"		nil	0)
    ("dc"	"drop corpse"		nil	0)
    ("ec"	"exa corpse"		nil	0)
    ("sc"	"search corpse"		nil	0)
    ))

(defvar clpmud-mode-abbrev-mode t
  "*Whether to use Abbrev mode in clpmud-mode or not")

(defvar clpmud-player-name "")
(defvar clpmud-current-directory ""
  "Current working directory in lpmud, as we see it.")
(make-variable-buffer-local 'clpmud-player-name)
(make-variable-buffer-local 'clpmud-current-directory)

(if (null clpmud-mode-map)
    (let ((map (full-copy-sparse-keymap comint-mode-map)))
      ;; Don't interrupt, stop, quit or eof subjob!
      ;; (substitute-key-definition doesn't do prefix keys, so use define-key)
      ;(substitute-key-definition 'comint-interrupt-subjob 'undefined map)
      (define-key map "\C-c\C-c" 'undefined)
      ;(substitute-key-definition 'comint-stop-subjob 'undefined map)
      (define-key map "\C-c\C-z" 'undefined)
      ;(substitute-key-definition 'comint-quit-subjob 'undefined map)
      (define-key map "\C-c\C-\\" 'undefined)
      (substitute-key-definition 'comint-delchar-or-maybe-eof 'delete-char map)

      ;; Don't do mistakes
      (define-key map "\C-w" 'undefined)
      (define-key map "\M-g" 'undefined)

      ;; "Normal" commands
      ;; Try to be compatible with Lysator
      (define-key map "\r" 'clpmud-send-input)
      (define-key map "\^\?" 'clpmud-mode-delete-backward-char)
      (define-key map "\M-\^\?" 'clpmud-backward-kill-word)
      (define-key map "\M-\r" 'clpmud-repeat-last-command)
      (define-key map "\t" 'dabbrev-expand)
      (define-key map "\M-q" 'clpmud-drink)
      (define-key map "\M-s" 'clpmud-combat-spell)
      (define-key map "\M-m" 'clpmud-missile)
      (define-key map "\M-." 'clpmud-score)
      (define-key map "\M-i" 'clpmud-inventory)

      ;; "Advanced" commands
      ;; (put these in reverse interest order for prettier help text)
      (define-key map "\C-c\C-b" 'clpmud-return-to-landmark)
      (define-key map "\C-c\C-@" 'clpmud-set-landmark)
      (define-key map "\C-c\C-s" 'clpmud-send-ed-buffer)
      (define-key map "\C-c\C-e" 'clpmud-ed)
      (define-key map "\C-c\C-v" 'clpmud-view-file)
      (define-key map "\C-ce" 'clpmud-run-macro)
      (define-key map "\C-c\)" 'clpmud-end-macro-definition)
      (define-key map "\C-c\(" 'clpmud-start-macro-definition)
      (define-key map "\C-cg" 'clpmud-gag-player)
      (define-key map "\C-cu" 'clpmud-ungag-player)
      (define-key map "\C-cs" 'clpmud-combat-spell)
      (define-key map "\C-cq" 'clpmud-drink)
      (define-key map "\C-cm" 'clpmud-missile)
      (define-key map "\C-cl" 'clpmud-look)
      (define-key map "\C-cw" 'clpmud-who)
      (define-key map "\C-c." 'clpmud-score)
      (define-key map "\C-ci" 'clpmud-inventory)

      (setq clpmud-mode-map map)
      ))

(if (null clpmud-syntax-table)
    (let ((tab (make-syntax-table)))
      ;; Swedish chars, often used in talking
      (let ((i ?\{))
	(while (<= i ?\})
	  (modify-syntax-entry i "w" tab)
	  (setq i (1+ i))))
      (let ((i ?\[))
	(while (<= i ?\})
	  (modify-syntax-entry i "w" tab)
	  (setq i (1+ i))))
      ;; Don't mess with paren matching and stuff
      (modify-syntax-entry ?\( "." tab)
      (modify-syntax-entry ?\) "." tab)

      (setq clpmud-syntax-table tab)))

;; clpmud mode is suitable only for specially formatted data.
(put 'clpmud-mode 'mode-class 'special)

(defun clpmud-mode ()
  "Major mode for interacting with a remote LPMUD process.
Use the command \"help\" to get LPMUD help.
The following commands are available:
\\{clpmud-mode-map}

Also available are
 clpmud-list-macros	List defined macros
 clpmud-delete-macro	Delete a macro definition
 clpmud-save-macros	Save macros to a file
 clpmud-load-macros	Load macros from a file
 clpmud-set-auto-reply	Set auto-reply message

If Abbrev mode is turned on (see clpmud-mode-abbrev-mode),
the following commands are available:

\\[expand-abbrev]		expand-abbrev
\\[unexpand-abbrev]	   unexpand-abbrev
\\[add-mode-abbrev]		add-mode-abbrev
\\[inverse-add-mode-abbrev]		inverse-add-mode-abbrev
\\[abbrev-prefix-mark]		abbrev-prefix-mark

See also the following non-interactive functions:
 clpmud-define-mud
 clpmud-define-player

See also variables:
 clpmud-configuration-list
 clpmud-drink
 clpmud-combat-spell
 clpmud-notify-on-messages
 clpmud-macro-table
 clpmud-macro-file-name
 clpmud-macro-blink-beep
 clpmud-macro-brief
 clpmud-macro-fast-execution
 clpmud-max-buffer-size
 clpmud-min-buffer-size
 clpmud-return-sends-whole-line
 clpmud-mode-abbrev-mode
 clpmud-mode-abbrev-table
 clpmud-mode-hook
 clpmud-load-hook"
  (interactive)
  (comint-mode)
  (setq major-mode 'clpmud-mode)
  (setq mode-name "cLPMUD")		;c is for CMU
  (use-local-map clpmud-mode-map)
  (set-syntax-table clpmud-syntax-table)
  ;; Is this good?  I think so?
  ;(buffer-flush-undo (current-buffer))

  (setq local-abbrev-table clpmud-mode-abbrev-table)
  (setq abbrev-mode clpmud-mode-abbrev-mode)

  (setq comint-prompt-regexp clpmud-prompt-pattern)
  (setq comint-input-sentinel 'clpmud-input-sentinel)
  (setq comint-input-filter 'clpmud-input-filter)

  (run-hooks 'clpmud-mode-hook))

(defun clpmud (host-or-mud &optional port)
  "Open an LPmud connection to HOST.
HOST can be an Internet host name, or a name of an LPmud
defined in clpmud-configuration-list.
If it is a host name, the port number is given by prefix argument
 (e.g \\[universal-argument] 9000 \\[clpmud]),
and defaults to 2000"
  (interactive (list
		(let ((completion-ignore-case t))
		  (completing-read "Host (or MUD): "
				   clpmud-configuration-list))
		current-prefix-arg))
  (let (host
	(conf (clpmud-find-mud host-or-mud)))
    (if (not (null conf))
	(setq host (clpmud-conf-machine conf)
	      port (clpmud-conf-port conf))
      (setq host host-or-mud))
    (if (null port)
	(setq port 2000))
    (let* ((buffer (generate-new-buffer
		    (if (and (null conf) ;If it's configured, he already knows.
			     (/= port 2000))
			(format "*clpmud %s %d*" host-or-mud port)
		      (format "*clpmud %s*" host-or-mud))))
	   (buffer-name (buffer-name buffer))
	   (process (condition-case err
			(open-network-stream buffer-name buffer host port)
		      (error err))))
      (if (not (processp process))
	  (progn
	    (kill-buffer buffer)
	    (signal (car process) (cdr process))))
      (switch-to-buffer buffer)
      (goto-char (point-max))
      (set-marker (process-mark process) (point))
      (set-process-filter process 'clpmud-process-filter)
      (clpmud-mode)
      ;; Since this is a local variable,
      ;; we have to set it *after* changing modes.
      (setq clpmud-configuration conf))))

;;; comint uses these two functions
(defun clpmud-input-filter (str)
  "Predicate for filtering additions to input history.
Only inputs answering true to this function are saved on the input
history list.
Also check for cd commands, so we can keep track of current
directory for Wizards editing files."
  (if (string-match "^cd\\( \\|$\\)" str)
      (clpmud-hack-cd-command str))
  (and (not (string-match "\\`\\s *\\'" str)) ;Only whitespace
       (let ((len (ring-length input-ring))) ;Previous input
	 (not (and (> len 0)
		   (string= str (ring-ref input-ring 0)))))
       (not (string-match "^password " str)) ;setting password
       ))

(defun clpmud-hack-cd-command (str)
  (let ((dir (substring str (match-end 0))))
    (if (string= dir "")
	(setq clpmud-current-directory
	      (concat "/players/" clpmud-player-name "/"))
      ;; We had an arg
      (setq clpmud-current-directory
	    (expand-file-name (concat clpmud-current-directory dir)))
      (if (/= ?/ (aref clpmud-current-directory (1- (length clpmud-current-directory))))
	  (setq clpmud-current-directory
		(concat clpmud-current-directory "/"))))
    (message "Directory %s" clpmud-current-directory))) 

(defun clpmud-input-sentinel (str)
  "Called on each input submitted to comint mode process by comint-send-input.
This version, for clpmud, checks the following:
* If we're telling lpmud what our name is, we rename the current buffer
  to include the player name.  Also, check if we have a  configuration for
  this player, and set things up if so.
* If we're recording for a \"landmark\", we maybe record this action
  on the landmark history.
* If we're defining a macro, we record this action."
  (cond ((and (save-excursion
		;; Check for player name
		(re-search-backward "^What is your name: "
				    (save-excursion
				      (beginning-of-line 0) (point))
				    t))
	      (not (string= str "")))
	 (let ((bufnam (buffer-name (current-buffer))))
	   ;; Rename buffer
	   (let ((i (string-match "\\*" bufnam 2)))
	     (if (null i)
		 ()
	       (let* ((newname (concat (substring bufnam 0 i)
				       " (" str ")" (substring bufnam i)))
		      (newbuf (generate-new-buffer newname))
		      (name (buffer-name newbuf)))
		 (kill-buffer newbuf)
		 (rename-buffer name)
		 (clpmud-update-modeline)))))
	 ;; Set up for cd tracker
	 (setq clpmud-player-name (downcase str)
	       clpmud-current-directory (concat "/players/" (downcase str) "/"))	
	 ;; Auto-configure
	 (let ((play (clpmud-find-player str clpmud-configuration)))
	   (if (null play)
	       ()
	     (message "Configuring for player %s" str) (sit-for 1)
	     (clpmud-initialize-player play)))
	 )
	;; landmark stuff
	((not (null clpmud-landmark-history))
	 (let ((strsp (substring str 0 (string-match " " str))))
	   (if (clpmud-string-member str clpmud-invertible-actions)
	       (setq clpmud-landmark-history
		     (cons (clpmud-invert-action str)
			   clpmud-landmark-history)))))
	;; macro stuff
	((not (null clpmud-current-macro))
	 (setq clpmud-current-macro (cons str clpmud-current-macro)))
	))


(defun clpmud-process-filter (proc str)
  "This is the normal process filter for clpmud.
It cleans up the output from lpmud from netascii CRLF
and Telnet negotiations, and if we're prompted for the password,
we read it without echo and send it to lpmud."
  (let ((match-data (match-data)))
    (unwind-protect
	(save-excursion
	  (set-buffer (process-buffer proc))
	  (let ((user-point (point)))
	    (goto-char (process-mark proc))
	    (let ((start-pos (point)))
	      (insert-before-markers str)
	      (while (search-backward "\r\n" start-pos t)
		(delete-char 1))
	      (goto-char (process-mark proc))
	      (while (search-backward "\377" start-pos t)
		(cond ((looking-at "\377\\(\373\\|\374\\|\375\\|\376\\)")
		       ;; IAC WILL/WON'T/DO/DON'T <code>
		       (delete-char 3))
		      ))
	      (goto-char (process-mark proc))
	      ;; Now check for password
	      (cond ((looking-at-backward "^Password: $")
		     ;;(string-match "^Password: $" str)
		     (let ((pwd (comint-read-noecho "Password: ")))
		       ;; comint-read-noecho has a bug:
		       ;;  if you press a command char (e.g C-x) after
		       ;;  reading with comint-read-noecho, and wait a second
		       ;;  so that the C-x echos, the password is also echoed.
		       (process-send-string proc (concat pwd "\n")))))
	      ;; Now check for gagged persons
	      (if (/= 0 (length clpmud-gagged-players-regexp))
		  (progn
		    (while (re-search-backward (format "\\(%s\\) says: .*\n"
						       clpmud-gagged-players-regexp)
					       start-pos t)
		      (let* ((who (buffer-substring (match-beginning 1) (match-end 1)))
			     (cons (clpmud-string-assoc who clpmud-gagged-players-alist t)))
			(delete-region (match-beginning 0) (match-end 0))
			(if (and cons (null (cdr cons)))
			    ()		;Ignore
			  (insert-before-markers (format "%s mumbles.\n" who)))))
		    (goto-char (process-mark proc))))
	      (if (or (> (length clpmud-auto-reply) 0)
		      (and clpmud-notify-on-messages
			   (or (not (get-buffer-window (current-buffer))) ;no window
			       ;; point not in window
			       (if (= user-point start-pos)
				   (not (pos-visible-in-window-p user-point (get-buffer-window (current-buffer))))
				 (not (pos-visible-in-window-p
				       (point) (get-buffer-window (current-buffer))))))))
		  (if (let ((case-fold-search nil))
			(re-search-backward "\\([A-Z]\\w+\\) \\(says\\|shouts\\|tells you\\): .*"
					    start-pos t))
		      (if (> (length clpmud-auto-reply) 0)
			  ;; Auto-reply case
			  (let* ((who (buffer-substring (match-beginning 1) (match-end 1)))
				 (what (buffer-substring (match-beginning 2) (match-end 2)))
				 (cmd (cond ((string= what "says") "say")
					    ((string= what "shout") nil)
					    ((string= what "tells you") (concat "tell " who)))))
			    (if (null cmd)
				(goto-char (process-mark proc)) ;do nothing
			      (goto-char (process-mark proc))
			      (clpmud-send-string (concat cmd " " clpmud-auto-reply))))
			;; notify case
			(goto-char (process-mark proc))
			(message "%s" (buffer-substring (match-beginning 0) (match-end 0)))
			(beep t)))))
	    )
	  ;; Hack buffer shrinking
	  (if (and (numberp clpmud-max-buffer-size)
		   (/= 0 clpmud-max-buffer-size)
		   (numberp clpmud-min-buffer-size)
		   (/= 0 clpmud-min-buffer-size)
		   (> (point-max) clpmud-max-buffer-size)
		   (< clpmud-min-buffer-size clpmud-max-buffer-size))
	      (delete-region (point-min)
			     (- (point-max) clpmud-min-buffer-size))))	      
      (store-match-data match-data))))

;;;; Some replacements for standard commands

(defun clpmud-send-input ()
  "Send input to process.  After the process output mark, sends all text
from the process mark to point as input to the process.  Before the
process output mark, calls value of variable comint-get-old-input to retrieve
old input, copies it to the end of the buffer, and sends it.  A terminal
newline is also inserted into the buffer and sent to the process.  In either
case, value of variable comint-input-sentinel is called on the input before
sending it.  The input is entered into the input history ring, if value of
variable comint-input-filter returns T when called on the input.

See also comint-send-input.  If clpmud-return-sends-whole-line is non-NIL,
we go to end-of-line before calling comint-send-input, otherwise we just call
comint-send-input."
  (interactive)
  (if clpmud-return-sends-whole-line
      (end-of-line 1))
  (comint-send-input))

(defun clpmud-mode-delete-backward-char (n &optional killflag)
  "Delete the previous ARG characters (following, with negative ARG).
Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
Interactively, ARG is the prefix arg, and KILLFLAG is set if
ARG was explicitly specified.
Does NOT kill characters before process-mark."
  (interactive "*p\nP")
  (if (looking-at-backward clpmud-prompt-pattern)
;      (<= (- (point) (1- n))
;	  (process-mark (get-buffer-process (current-buffer))))
      (beep)
    (delete-backward-char n killflag)))

(defun clpmud-backward-kill-word (arg)
  "Kill characters backward until encountering the end of a word.
With argument, do this that many times.
Does NOT kill words before process-mark."
  (interactive "*p")
  (if (or (looking-at-backward clpmud-prompt-pattern)
	  (save-excursion
	    (forward-word (- (1- arg)))
	    (looking-at-backward clpmud-prompt-pattern)))
      (beep)
    (kill-word (- arg)))
;  (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
;    (if (or (= (point) pmark) ;simple case
;	    (< (save-excursion
;		 (progn (forward-word (- arg))
;			(point)))
;	       pmark))
;	(beep)
;      (kill-word (- arg))))
  )

(defun clpmud-repeat-last-command ()
  "Repeat last command.
This is like typing \\[comint-previous-input] followed by Return"
  (interactive)
  (let ((len (ring-length input-ring)))
    (cond ((<= len 0)
	   (message "Empty input ring")
	   (beep))
	  ((clpmud-check-after-pmark)
	   (clpmud-send-string
	    (ring-ref input-ring 0) t))
	  )))

;;;This piece of code is from comint.el, with check for string= added
(defun clpmud-maybe-add-to-history (input)
  (if (and (let ((len (ring-length input-ring)))
	     (if (> len 0)
		 (not (string= input (ring-ref input-ring 0)))
	       t))
	   (funcall comint-input-filter input))
      (ring-insert input-ring input)))



(defun clpmud-send-string (str &optional dont-add-to-history)
  "This is the function to use to send a STRING to lpmud.
Unless it is string= the previous string sent,
the string is added to the input history.
STRING should not contain a trailing newline.
If given a second optional arg DONT-ADD-TO-HISTORY as T,
it does not even test if it should be added to the history."
  (let ((string (concat str "\n")))
    (insert-before-markers string)
    (process-send-string (get-buffer-process (current-buffer))
			 string)
    (if (not dont-add-to-history)
	;;NOTE: str, not string (shd b w/o \n)
	(clpmud-maybe-add-to-history str))
    ))

(defun clpmud-check-after-pmark ()
  "Check if point is after process-mark, i.e. if we're in a position
to insert command text.  
If we are, we remove whatever was after process-mark and return T.
If we are not, we give a message, beep and return NIL"
  (if (comint-after-pmark-p)
      (progn
	;;Remove whatever we were typing in
	(if (> (point) (process-mark (get-buffer-process (current-buffer))))
	    ;; Shd this be kill-region instead?
	    (delete-region (process-mark (get-buffer-process (current-buffer)))
			   (point)))
	t)
    (message "Not after process mark")
    (beep)
    nil))

;;;; LPmud commands

(defmacro def-clpmud-simple-command (name string &optional doc)
  "Define a simple command that just sends a given string,
without saving in on the history"
  (if (null doc) (setq doc (concat "Issue a \"" string "\" command,
without saving it on the command history")))
  (list 'defun name ()
	doc
	'(interactive)
	(list 'if '(clpmud-check-after-pmark)
		  (list 'clpmud-send-string string t))))

(def-clpmud-simple-command clpmud-score "score")
(def-clpmud-simple-command clpmud-missile "missile")
(def-clpmud-simple-command clpmud-inventory "i")
(def-clpmud-simple-command clpmud-look "look")
(def-clpmud-simple-command clpmud-who "who")

(defun clpmud-drink (&optional arg)
  "Buy and drink a drink, selected by the variable clpmud-drink.
If it is NIL, ask for a drink (with completion)"
  (interactive "P")
  (if (clpmud-check-after-pmark)
      (progn
	(if (or arg (null clpmud-drink))
	    (setq clpmud-drink (completing-read "What drink: "
						clpmud-drink-table
						nil
						'must-match)))
	(clpmud-send-string (concat "buy " clpmud-drink))
	;; **** Should wait for prompt here!
	(clpmud-send-string (concat "drink " clpmud-drink)))))

(defun clpmud-combat-spell (&optional arg)
  "Cast a combat spell, selected by the variable clpmud-combat-spell.
If it is NIL, ask for a spell (with completion)"
  (interactive "P")
  (if (clpmud-check-after-pmark)
      (progn
	(if (or arg (null clpmud-combat-spell))
	    (setq clpmud-combat-spell
		  (completing-read "What spell: "
				   clpmud-combat-spell-table
				   nil
				   'must-match)))
	(clpmud-send-string clpmud-combat-spell))))

;;; Now for some hair...

(defun clpmud-invert-action (str)
  "Invert an action, i.e. tell how to do it backwards."
  (or
   (cdr (clpmud-string-assoc str clpmud-invertible-directions))
;   (cond ((string-match "open \\([a-z]+\\)" str)
;	  (concat "close " (substring str (match-beginning 1) (match-end 1))))
;	 ((string-match "close \\([a-z]+\\)" str)
;	  (concat "open " (substring str (match-beginning 1) (match-end 1))))
;	 )
   ))

(defun clpmud-start-macro-definition ()
  "Start a macro definition.
All actions up to \\[clpmud-end-macro-definition]
are saved, and can be redone at a selected time
with \\[clpmud-run-macro], listed with \\[clpmud-list-macros],
saved with \\[clpmud-save-macros], deleted with \\[clpmud-delete-macro].

See also \\[clpmud-set-landmark]."
  (interactive)
  (if (not (null clpmud-current-macro))
      (error "Already defining a macro!")
    (setq clpmud-current-macro (cons nil nil)
	  clpmud-defining-macro t)
    (clpmud-update-modeline)
    (message "Starting macro")))

(defun clpmud-end-macro-definition ()
  "End a macro definition started with \\[clpmud-start-macro-definition].
You are asked for a name for the macro, which is
used when you run it with \\[clpmud-run-macro] later.

See also \\[clpmud-set-landmark]"
  (interactive)
  (if (null clpmud-current-macro)
      (progn
	(message "No macro definition in progress")
	(beep))
    (let ((this-macro (cdr (nreverse clpmud-current-macro))))
      (setq clpmud-current-macro nil
	    ;; Mode line is automagically updated by completing-read.
	    clpmud-defining-macro nil)
      (let ((name (completing-read "Name this macro: "
				   clpmud-macro-table)))
	(if (string= name "")
	    (error "Must name the macro!"))
	(let ((previous (assq name clpmud-macro-table)))
	  (if (not (null previous))
	      (if (y-or-n-p (format "Redefine macro %s? " name))
		  (setcdr previous this-macro)
		(message "Macro %s not redefined." name))
	    (setq clpmud-macro-table (cons (cons name this-macro)
					   clpmud-macro-table)))
	  (message "Macro %s defined.  Run with %s %s" name
		   (substitute-command-keys "\\[clpmud-run-macro]") name))))))

(defun clpmud-get-macro-atoms (macro)
  ;; *HACK ALERT*
  ;; A macro can have the special atom + first in its definition,
  ;; meaning to concatenate the following definitions.
  ;; Or it can have the special atom - first in its definition,
  ;; meaning to invert the actions of the macro named second.
  (cond ((null macro)
	 (error "Undefined macro"))
	((stringp (car macro))
	 macro)
	((eq (car macro) '+)		;Hack hack
	 ;; ("pub-to-wardrobe" + "pub-to-angmar" "angmar-to-wardrobe")
	 (let ((constituents (cdr macro))
	       (result nil))
	   (while constituents
	     (let ((a (clpmud-string-assoc (car constituents)
					   clpmud-macro-table)))
	       (setq result (append result (clpmud-get-macro-atoms (cdr a)))))
	     (setq constituents (cdr constituents)))
	   result))
	((eq (car macro) '-)		;Hack hack
	 ;; ("wardrobe-to-pub" - "pub-to-wardrobe")
	 (let ((m2 (cdr (clpmud-string-assoc (car (cdr macro))
					     clpmud-macro-table))))
	   (if (null m2)
	       (error "Undefined macro: %s" (car (cdr macro)))
	     (let ((inverted (mapcar 'clpmud-invert-action
				     (clpmud-get-macro-atoms m2))))
	       (if (memq nil inverted)
		   (error "Can't inverse macro %s" (car (cdr macro)))
		 (nreverse inverted))))))
	(t (error "Bogus definition of macro"))))

(defun clpmud-list-macros ()
  "List all defined macros.
See also \\[clpmud-delete-macro]."
  (interactive)
  (let ((tab clpmud-macro-table))
    (with-output-to-temp-buffer "*cLPmud Macros*"
      (set-buffer standard-output)
      (insert "Name\t\tDefinition\n----\t\t----------\n")
      (while tab
	(let ((e (car tab)))
	  (insert (car e))
	  (insert-char ?\  (max 1 (- 16 (current-column))))
	  (let ((d (cdr e)))
	    (cond ((eq (car d) '+)
		   (insert "concatenation of ")
		   (setq d (cdr d)))
		  ((eq (car d) '-)
		   (insert "inverse of ")
		   (setq d (cdr d))))
	    (while d
	      (insert (car d))
	      (if (not (null (cdr d)))
		  (insert ","))
	      (setq d (cdr d))))
	  (insert "\n"))
	(setq tab (cdr tab))))))

(defun clpmud-load-macros (&optional filename)
  "Load clpmud macros from FILE, which defaults to clpmud-macro-file-name"
  (interactive "fLoad macros from file: ")
  (if (or (null filename)
	  (= (length (file-name-nondirectory filename)) 0))
      (setq filename clpmud-macro-file-name))
  (load-file filename))

(defun clpmud-save-macros (&optional filename)
  "Save clpmud macros to FILE, which defaults to clpmud-macro-file-name"
  (interactive "FSave macros to file: ")
  (if (or (null filename)
	  (= (length (file-name-nondirectory filename)) 0))
      (setq filename clpmud-macro-file-name))
  (save-excursion
    (set-buffer (get-buffer-create " save-macros-file"))
    (erase-buffer)
    (insert ";;;-*-Emacs-Lisp-*-\n\n")
    (insert "(setq clpmud-macro-table\n      '\(")
    (let ((tab clpmud-macro-table))
      (while tab
	(insert (prin1-to-string (car tab)))
	(if (null (cdr tab))
	    (insert "\)")
	  (insert "\n        "))
	(setq tab (cdr tab))))
    (insert ")\n")
    (write-region (point-min) (point-max) filename)
    (erase-buffer)))

(defun clpmud-delete-macro (name)
  "Delete macro named NAME.
See also \\[clpmud-list-macros]"
  (interactive (list (completing-read "Delete macro: "
				      clpmud-macro-table
				      nil
				      'must-match)))
  (let ((macro (clpmud-string-assoc name clpmud-macro-table)))
    (if (yes-or-no-p (format "Delete macro %s.  Are you sure? " name))
	(setq clpmud-macro-table (delq macro clpmud-macro-table))
      (message "Macro %s not deleted." name))))


(defun clpmud-run-macro (name &optional reverse-p)
  "Run a macro named NAME, defined with \\[clpmud-start-macro-definition]
and \\[clpmud-end-macro-definition].
The macro terminates when either you get a \"What ?\" response
to an action, or you press a key to interrupt.
Given a prefix argument (e.g. \\[universal-argument] \\[clpmud-run-macro]),
tries to run the macro inversed.
If the variable clpmud-macro-brief is non-NIL,
the macro execution is run in \"brief\" mode.
See also \\[clpmud-set-landmark]"
  (interactive (list (completing-read (if (null current-prefix-arg)
					  "Run macro: "
					"Run macro inversed: ")
				      clpmud-macro-table
				      (function (lambda (x)
						  (not (null (cdr x)))))
				      'must-match)
		     current-prefix-arg))
  (let ((macro (cdr (clpmud-string-assoc name clpmud-macro-table))))
    (if (null macro)
	(error "Undefined macro: %s" name)
      (if (null reverse-p)
	  (if clpmud-macro-brief
	      (clpmud-return-to-landmark
	       (cons "brief"
		     (append (clpmud-get-macro-atoms macro) '("brief")))
	       "brief")
	    (clpmud-return-to-landmark (clpmud-get-macro-atoms macro)))
	(let ((inverted (mapcar 'clpmud-invert-action
				(clpmud-get-macro-atoms macro))))
	  (if (not (memq nil inverted))
	      (if clpmud-macro-brief
		  (clpmud-return-to-landmark
		   (cons "brief" (nreverse (cons "brief" inverted)))
		   "brief")
		(clpmud-return-to-landmark (nreverse inverted)))
	    (message "Can't inverse this macro")
	    (beep)))))))

(defun clpmud-return-to-landmark (&optional actions throw-action)
  "Return to the previous landmark.
Stops either when the response to a command is \"What ?\"
or when you press a key to interrupt."
  (interactive)
  (let ((list-of-actions (if (null actions)
			     clpmud-landmark-history
			   actions)))
    (if (null list-of-actions)
	(progn
	  (message "No landmark set!")
	  (beep))
      (progn
	(if (null actions)		;Gave no arg, running a landmark
	    (setq clpmud-landmark-history nil))
	(let ((result (catch 'abort-landmark
			(clpmud-do-landmark-return list-of-actions))))
	  (cond ((eq result 'aborted)
		 (message "Aborted.")
		 (beep)
		 (if throw-action (clpmud-send-string throw-action)))
		((eq result 'what)
		 (message "Failed!!")
		 (beep)
		 (if throw-action (clpmud-send-string throw-action)))
		(t
		 (message "End of macro.")
		 ;; Pseudo-blink...
		 (cond ((eq clpmud-macro-blink-beep 'beep)
			(beep))
		       ((eq clpmud-macro-blink-beep 'blink)
			(clpmud-blink-mode-line))))
		))))))

(defun clpmud-do-landmark-return (l-o-actions)
  (let* ((proc (get-buffer-process (current-buffer)))
	 (filter (process-filter proc))
	 (landmark-prompt-found-p nil)
	 (landmark-what-found-p nil))
    (unwind-protect
	(progn
	  (set-process-filter proc 'clpmud-landmark-filter)
	  (while l-o-actions
	    (clpmud-send-string (car l-o-actions))
	    (while (and (not (input-pending-p))
			(not landmark-what-found-p)
			(not landmark-prompt-found-p))
	      (if (not clpmud-macro-fast-execution)
		  ;; Do it gently...
		  (sit-for 1)
		;; Else do it fast,
		(accept-process-output proc)
		;; but redisplay
		(sit-for 0))
	      )
	    (cond ((input-pending-p)
		   (throw 'abort-landmark 'aborted))
		  (landmark-what-found-p
		   (throw 'abort-landmark 'what))
		  (t
		   (setq landmark-prompt-found-p nil)
		   (setq l-o-actions (cdr l-o-actions))
		   (if (not (stringp (car l-o-actions)))
		       (setq l-o-actions nil)))))
	  nil)
	(set-process-filter proc filter))))

(defun clpmud-landmark-filter (proc str)
  (save-excursion
    (set-buffer (process-buffer proc))
    (goto-char (process-mark proc))
    (let ((start-pos (point)))
      (insert-before-markers str)
      (while (search-backward "\r\n" start-pos t)
	(delete-char 1))
      (goto-char (process-mark proc))
      (cond ((search-backward clpmud-failure-string start-pos t) ;"What ?"
	     (setq landmark-what-found-p t))
	    ((re-search-backward clpmud-prompt-pattern start-pos t)
	     (setq landmark-prompt-found-p t))))))

(defun clpmud-set-landmark (&optional arg)
  "Set a landmark that you can come back to with \\[clpmud-return-to-landmark]
Given an argument, forgets the current landmark (saving space)"
  (interactive "P")
  (if (not (null arg))
      (progn
	(setq clpmud-landmark-history nil)
	(message "Landmark cleared."))
    (setq clpmud-landmark-history (cons nil nil))))

;;;; Gagging

(defun clpmud-list-gagged-players ()
  "List what players are currently gagged.
See also \\[clpmud-gag-player] and \\[clpmud-ungag-player]"
  (interactive)
  (if (= 0 (length clpmud-gagged-players-regexp))
      (message "No players are gagged.")
    (let ((list nil))
      (save-excursion
	(set-buffer (get-buffer-create " clpmud gagged"))
	(erase-buffer)
	(insert clpmud-gagged-players-regexp)
	(goto-char (point-min))
	(perform-replace "\\|" ", " nil nil nil)
	(setq list (buffer-string)))
      (message "%s" list))))

(defun clpmud-gag-player (name &optional completely)
  "Gag a player (or non-player, e.g Harry).
When a player is gagged and he says something, all you see is that he mumbles.
If given a prefix arg, the talking is completely ignored.
See also \\[clpmud-ungag-player] and \\[clpmud-list-gagged-players]"
  (interactive (list
		(let* ((completion-ignore-case t)
		       (n (completing-read (if current-prefix-arg
					       "Gag player completely: "
					     "Gag player: ")
					   clpmud-gaggable-players)))
		  (or (cdr (clpmud-string-assoc n clpmud-gaggable-players t))
		      (capitalize n)))
		current-prefix-arg))
  (if (and (/= 0 (length clpmud-gagged-players-regexp))
	   (string-match clpmud-gagged-players-regexp name))
      (message "%s is already gagged." name)
    (let ((cons (clpmud-string-assoc name clpmud-gagged-players-alist t)))
      (if cons
	  (setcdr cons (not current-prefix-arg))
	(setq clpmud-gagged-players-alist
	      (cons (cons name (not current-prefix-arg))
		    clpmud-gagged-players-alist))))
    (if (/= 0 (length clpmud-gagged-players-regexp))
	(setq clpmud-gagged-players-regexp (concat name "\\|" clpmud-gagged-players-regexp))
      (setq clpmud-gagged-players-regexp name))))

(defun clpmud-ungag-player (name)
  "Ungag a player that you have previously gagged.
See \\[clpmud-gag-player] and \\[clpmud-list-gagged-players]"
  (interactive (list
		(let* ((completion-ignore-case t)
		       (n (completing-read "Ungag player: " clpmud-gagged-players-alist)))
		  (or (cdr (clpmud-string-assoc n clpmud-gaggable-players t))
		      (capitalize n)))))
  (if (or (= 0 (length clpmud-gagged-players-regexp))
	  (not (string-match clpmud-gagged-players-regexp name)))
      (message "%s is not gagged.")
    (setq clpmud-gagged-players-alist
	  (delq (clpmud-string-assoc name clpmud-gagged-players-alist t)
		clpmud-gagged-players-alist))
    (if (= (length name) (length clpmud-gagged-players-regexp))
	(setq clpmud-gagged-players-regexp "")
      (let ((p (string-match name
			     clpmud-gagged-players-regexp)))
	(let ((s (match-beginning 0))
	      (e (match-end 0))
	      (l (length clpmud-gagged-players-regexp)))
	  (setq clpmud-gagged-players-regexp
		(concat
		 (substring clpmud-gagged-players-regexp 0 (if (= e l)
							       (- s 2)
							     s))
		 (substring clpmud-gagged-players-regexp (if (/= e l)
							     (+ e 2)
							   e)))))))))

(defun clpmud-set-auto-reply (string)
  "Set the auto-reply string, which is sent to players
who \"say\" or \"tell\" you things.
To cancel auto-replying, just give an empty string."
  (interactive "sAuto-reply: ")
  (if (string-match "\n" string)
      (error "Can't have newlines in auto-reply string")
    (if (string= string "")
	(progn
	  (setq clpmud-auto-reply string)
	  (message "Auto-reply canceled."))
      (setq clpmud-auto-reply (concat "Auto-reply: " string))
      (message "Auto-reply set to \"%s\"." clpmud-auto-reply))))

;;;; Configuration stuff

;;; Think of a DEFSTRUCT here, but I don't want to drag in cl.el.
(defun clpmud-conf-name (conf)
  (car conf))
(defun clpmud-conf-machine (conf)
  (car (cdr conf)))
(defun clpmud-conf-port (conf)
  (car (cdr (cdr conf))))
(defun clpmud-conf-players (conf)
  (cdr (cdr (cdr conf))))
(defun clpmud-player-name (play)
  (car play))
(defun clpmud-player-drink (play)
  (car (cdr play)))
(defun clpmud-player-spell (play)
  (car (cdr (cdr play))))

(defun clpmud-find-mud (name)
  (clpmud-string-assoc name clpmud-configuration-list t))
(defun clpmud-define-mud (name host &optional port)
  "Define an lpmud called NAME, running at HOST on port PORT.
NAME and HOST should be strings.  PORT should be a number,
and defaults to 2000.

Example:
\(clpmud-define-mud \"Genesis\" \"milou.cd.chalmers.se\")
or
\(clpmud-define-mud \"Mizar\" \"Mizar.DoCS.UU.SE\" 9000)"
  (if (null port) (setq port 2000))
  (let ((conf (clpmud-find-mud name)))
    (if (null conf)
	(setq clpmud-configuration-list
	    (cons (list name host port)
		  clpmud-configuration-list))
      ;; (setf clpmud-conf-machine)
      (setcar (cdr conf) host)
      ;; (setf clpmud-conf-port)
      (setcar (cdr (cdr conf)) port))))

(defun clpmud-find-player (name conf)
  (clpmud-string-assoc name (clpmud-conf-players conf) t))
(defun clpmud-define-player (mudname playername &rest options)
  "Define a player in a defined lpmud.
MUDNAME is the name of an lpmud,
PLAYERNAME is the name o the player,
and any other args are used for player options.
See clpmud-define-mud for defining a lpmud.

Example:
\(clpmud-define-player \"Mizar\" \"Gwydion\" \"beer\" \"fireball\")"
  (let ((conf (clpmud-find-mud mudname)))
    (if (null conf)
	(error "No lpmud named %s defined." mudname)
      (let ((player (clpmud-find-player playername conf)))
	(if (null player)
	    ;; (setf clpmud-conf-players)
	    (setcdr (cdr (cdr conf))
		    (cons (cons playername options)
			  (clpmud-conf-players conf)))
	  (setcdr player options))))))

(defun clpmud-initialize-player (play)
  (setq clpmud-drink (clpmud-player-drink play)
	clpmud-combat-spell (clpmud-player-spell play)))

;;;; Utility functions

;; This function is from 'shellext.el' by Wolfgang Rupprecht <wolfgang@mgm.mit.edu>
(defun looking-at-backward (regexp)
  (let* ((begin (point))
	 (found (re-search-backward regexp nil t)))
    (goto-char begin)
    (and found (= begin (match-end 0)))))

(defun clpmud-string-member (item list &optional case-insensitive)
  "Iterative version of Common Lisp (member ITEM LIST :test #'string=),
or if CASE-INSENSITIVE is non-NIL, with :test #'string-equal"
  ;; Iteration makes us insensitive to execution stack depth
  (let ((l list)
	(val nil))
    (if case-insensitive
	(while l
	  (if (string= (downcase item) (downcase (car l)))
	      (setq val l
		    l nil)
	    (setq l (cdr l))))
      (while l
	(if (string= item (car l))
	    (setq val l
		  l nil)
	  (setq l (cdr l)))))
    val))

(defun clpmud-string-assoc (item alist &optional case-insensitive)
  "Iterative version of Common Lisp (assoc ITEM ALIST :test #'string=),
or if CASE-INSENSITIVE is non-NIL, with :test #'string-equal"
  ;; Iteration makes us insensitive to execution stack depth
  (let ((al alist)
	(val nil))
    (if case-insensitive
	(while al
	  (if (string= (downcase item) (downcase (car (car al))))
	      (setq val (car al)
		    al nil)
	    (setq al (cdr al))))
      (while al
	(if (string= item (car (car al)))
	    (setq val (car al)
		  al nil)
	  (setq al (cdr al)))))
    val))

(defun clpmud-string-delete (item list &optional case-insensitive)
  "Iterative version of Common Lisp (delete ITEM LISP :test #'string=),
or if CASE-INSENSITIVE is non-NIL, with :test #'string-equal"
  ;; Iteration makes us insensitive to execution stack depth
  (let* ((l list)
	 (val (cons nil nil))
	 (last val))
    (if case-insensitive
	(while l
	  (if (not (string= (downcase item) (downcase (car l))))
	      (progn
		(setcdr last (cons (car l) nil))
		(setq last (cdr last))))
	  (setq l (cdr l)))
      (while l
	(if (not (string= item (car l)))
	    (progn
	      (setcdr last (cons (car l) nil))
	      (setq last (cdr last))))
	(setq l (cdr l))))
    (cdr val)))

(defun clpmud-blink-mode-line ()
  ;; Reverse mode line and unreverse it
  ;; This is usually NO FUN in 2400 baud or less...
  (let ((m-l-i-v mode-line-inverse-video))
    (unwind-protect
	(progn
	  (setq mode-line-inverse-video (not m-l-i-v))
	  (clpmud-update-modeline))
      (setq mode-line-inverse-video m-l-i-v)
      (clpmud-update-modeline))))

(defun clpmud-update-modeline ()
  ;; Force a redisplay mode line, I hope (code from display-time.el)
  (save-excursion (set-buffer (other-buffer)))
  (set-buffer-modified-p (buffer-modified-p))
  (sit-for 0))

;; Finally, run the load hook
(run-hooks 'clpmud-load-hook)