;;; moo.el --- a pimptight MOO/MUCK/MUSH/MUD client
;;;
;;; This code is copyright Jonathan Walther, January 28, 2002
;;; It is free to use, distribute, and modify under the terms
;;; of the GPL (GNU Public License).
;;;
;;; Special thanks to Edward O'Connor of #emacs on OpenProjects.net
;;; for proof reading this code and advising the author on correct
;;; elisp usage.
;;
;; This code will connect to a MOO; automatically log you in;
;; and it will make sure your password doesn't get logged or
;; displayed on the screen where a shoulder surfer could get
;; snatch it.
;;
;; MOO Mode Commands:
;;
;; |       moo-pipe-quote          Self-insert, or pipe-quote current line.
;; C-a     bol-or-prompt           Go to the prompt, or beginning of line.
;; C-m     moo-newline
;; C-j     moo-soft-newline
;; C-c C-i moo-send-text-invisibly Send text to MOO securely
;; C-c m1  browse-url-at-point     Browse the url that you clicked on.

;;; Todo:
;; allow different faces for old input, output, and current input.
;; input triggers/filters
;; output trigger/filters
;; MCP 2.1 support
;; write documentation
;; let C-g cause a beep
;; let users specify an ssh or ssl tunnel
;; fix read-only text pasting bug

(require 'ansi-color)

;; XEmacs compatibility.
(if (not (featurep 'xemacs))
    (defun url-click ()
      [(shift down-mouse-3)])
  (defun replace-regexp-in-string (regexp newtext str)
    (replace-in-string str regexp newtext))
  (defun line-beginning-position ()
    (save-excursion (beginning-of-line) (point)))
  (defun line-end-position ()
    (save-excursion (end-of-line) (point)))
  (defun url-click ()
    [(shift button3)]))

(defalias 'bol 'line-beginning-position) ; beginning of line
(defalias 'eol 'line-end-position)       ; end of line
(defalias 'bob 'point-min)               ; beginning of buffer
(defalias 'eob 'point-max)               ; end of buffer
(defalias 'cat 'concat)                  ; concatenate

;; Don't forget to M-x customize-group RET browse-url RET
;; otherwise when you click on an url you might not see it
;; in your favorite web browser

;;; Code:

(defvar moo-servers-alist
  '(("Xao" "moo.xao.com" 7777 nil nil)
    ("Lambda" "lambda.moo.mud.org" 8888 nil nil lambda-guest-login)
    ("Wheel" "wotmud.org" 2222 nil nil diku-login))
  "*List your MOOs in the following format:
  MOO-NAME HOST PORT [USER-ID [PASSWORD [LOGIN-FUNCTION]]]
The MOO-NAME will be the name of the buffer for
your moo connection, the HOST is the internet address
of the moo, the PORT will be the port number on the internet
server the moo is located at, and USER-ID is your login name
on the moo.  If you are confident no one can read your .emacs
file, you can put your PASSWORD there.  Finally, if your MOO
requires a non-standard login function, you can specify your
own login function to use to log in.  It must accept the
arguments USER and PASS, in that order.")

(defvar moo-mode-map (make-sparse-keymap)
  "Keymap for MOO mode.")
(set-keymap-parent moo-mode-map (current-global-map))
(defvar moo-ctrl-c-map (make-sparse-keymap))

(define-key moo-mode-map [t] 'moo-self-insert-command)
(define-key moo-mode-map "|" 'moo-pipe-quote)
(define-key moo-mode-map "\C-c" moo-ctrl-c-map)
(define-key moo-mode-map "\C-a" 'bol-or-prompt)
(define-key moo-mode-map "\C-m" 'moo-newline)
(define-key moo-mode-map "\C-j" 'moo-soft-newline)
(define-key moo-mode-map (url-click) 'goto-address-at-mouse)
(define-key moo-ctrl-c-map "\C-i" 'moo-send-text-invisibly)

(defun moo-self-insert-command (N)
  "Do nothing if cursor is in the buffer history."
  (interactive "P")
  (if (>= (point) (marker-position (moo-mark)))
      (self-insert-command (or N 1))))

(make-variable-buffer-local 'logfile)

(defvar log-format
  "_%Y_%m_%d_%H_%M_%S.log"
  "*Format string for the logfile name.")
(defvar reconnect-format
  "***** Reconnecting on %a %b %e, %Y at %l:%M:%S %p *****\n"
  "*Format string for the reconnection notice.")
(defvar connect-format
  "***** Connection lost %a %b %e, %Y at %l:%M:%S %p *****\n"
  "*Format string for the connection notice.")

(defun moo-mode ()
  "A simple mode for interacting with a MOO, MUCK, or MUSH
\\{moo-mode-map}"
  (interactive)
  (setq major-mode 'moo-mode
	mode-name  "MOO")
  (use-local-map moo-mode-map))

;; We don't want the new buffers to use this mode
(put 'moo-mode 'mode-class 'special)

(defun moo-proc () (get-buffer-process (current-buffer)))

(defun moo-mark () (process-mark (moo-proc)))

(defun moo-filter (proc text)
  "When data comes from the MOO, stick it in the
buffer at an appropriate spot."
  (with-current-buffer (process-buffer proc)
    (let ((moving (= (point) (process-mark proc)))
	  (mark (marker-position (process-mark proc))))
      (save-excursion
	(goto-char mark)
	(insert-before-markers
	 (ansi-color-apply (replace-regexp-in-string "\r+" "" text)))
	(moo-log mark (point))
	(set-marker (process-mark proc) (point)))
      (when moving (goto-char (process-mark proc))))))

(defun moo-sentinel (proc event)
  "If the connection closes, don't kill the buffer."
  (if (buffer-name (process-buffer proc))
      (with-current-buffer (process-buffer proc)
	(let ((mark (marker-position (process-mark proc))))
	  (save-excursion
	    (goto-char (process-mark proc))
	    (insert-before-markers (format-time-string connect-format))
	    (moo-log mark (point)))))))

(defun moo-host () (read-string "MOO hostname: " nil nil "moo.xao.com"))

(defun moo-port () (string-to-number (read-string "MOO port: " nil nil "7777")))

(defun moo-args ()
  "Interactively retrieve the arguments for moo-select"
  (let* ((name (completing-read "MOO name: " moo-servers-alist))
	 (data (assoc name moo-servers-alist)))
    (if (not (string-equal name ""))
	(if data
	  (list (nth 0 data) (nth 1 data) (nth 2 data) (nth 3 data) (nth 4 data) (nth 5 data))
	  (list name (moo-host) (moo-port) nil nil nil))
      (list nil nil nil nil nil nil))))

(defun moo-select (name host port user pass func)
  "Opens a buffer in MOO mode, and connects it
to your desired MOO, MUCK, or MUSH."
  (interactive (moo-args))
  (when name
    (let* ((buf (get-buffer-create name))
	   (proc (open-network-stream "MOO" buf host port)))
      (when (eq (process-status proc) 'open)
	(switch-to-buffer buf)
	(delete-other-windows (get-buffer-window buf))
	(if (= (point-min) (point-max)) ; new buffer
	    (setq logfile (cat name (format-time-string log-format)))
	  (let ((mark (point-max)))
	    (goto-char mark)
	    (insert-before-markers (format-time-string reconnect-format))
	    (moo-log mark (point))))
	(if (> (point-max) 2)
	    (set-marker (moo-mark) (point-max))
	  (set-marker (moo-mark) 2))
	(set-process-filter proc 'moo-filter)
	(set-process-sentinel proc 'moo-sentinel)
	(funcall (or func 'moo-login) user pass)
	(moo-mode)))))

(defun moo-newline ()
  "When you hit enter, if the cursor is on the last line,
sends new text you typed to the MOO, else if you
pressed enter inside some old text, it appends the current
line of text to the current line of input, OR, if (mark)
is set, appends from the text from (mark) to (point) to
the current input line.  To insert a newline directly into
the line of input, use C-j"
  (interactive)
  (let ((mark (marker-position (moo-mark)))
	(text (moo-get-input)))
    (if (< (line (point)) (line mark))
	(save-excursion
	  (goto-char (eob))
	  (insert (cat text "\n"))
	  (set-marker (moo-mark) mark))
      (save-excursion
	(goto-char mark)
	(insert-before-markers (cat text "\n"))
	(moo-log mark (point))
	(set-marker (moo-mark) (point)))
      (goto-char (moo-mark))
      (delete-region (point) (eob))
      (process-send-string (moo-proc) (cat text "\n")))))

(defun moo-soft-newline ()
  "When you hit C-j, inserts a newline into the input text without
sending all the text to the MOO.  If (point) is in the read-only
part of the buffer, this function does nothing."
  (interactive)
  (if (not (> (moo-mark) (point)))
      (insert-before-markers "\n")))

(defun moo-get-input ()
  "Figure out what text is supposed to be used as input.
If cursor is in the read-only section, then the current line
is returned; else all the editable text is sent."
  (if (< (line (point)) (line (moo-mark)))
      (buffer-substring (bol) (eol))
    (buffer-substring (moo-mark) (eob))))

(defun moo-login (user pass)
  "Automatically logs you in, or prompts you for
password, or lets you do it all by hand depending
on your moo-servers-alist settings."
  (if user
      (process-send-string
       (moo-proc)
       (cat "connect " user " " (or pass (moo-get-password "Password: ")) "\n"))
    (message "To send sensitive text, use C-c C-i")))

(defun diku-login (user pass)
  "Automatically logs you in to a DIKU style MUD."
  (if user
      (process-send-string
       (moo-proc)
       (cat user "\n" (or pass (moo-get-password "Password: ")) "\n"))
    (message "To send sensitive text, use C-c C-i")))

(defun lambda-guest-login (user pass)
  "Log in as a guest on Lambdamoo."
  (process-send-string (moo-proc) "connect guest\nYES\nnoisy\n"))

(defun moo-get-password (&optional prompt)
  "Get a line of text without displaying it."
  (let ((text "") (done nil) (prompt (or prompt "Hidden Text: "))
	(echo-keystrokes 0) (cursor-in-echo-area t) (message-log-max nil))
    (while (not done)
      (message "%s%s" prompt (make-string (length text) ?*))
      (let ((c (read-char-exclusive)))
	(cond
	 ((= c ?\C-g)
	  (setq quit-flag t done t))
	 ((or (= c ?\n) (= c ?\r))
	  (setq done t))
	 ((= c ?\C-u)
	  (setq text ""))
	 ((and (/= c ?\b) (/= c ?\177))
	  (setq text (cat text (char-to-string c))))
	 ((> (length text) 0)
	  (setq text (substring text 0 -1))))))
    (if quit-flag (quit-minibuffer) (message "") text)))

(defun quit-minibuffer ()
  "Standard quit when you type C-g while typing text in the minibuffer."
  (message "Quit") (beep t) (setq quit-flag nil))

(defun line (pos)
  "Return the line number of the given buffer position."
  (count-lines (point-min) pos))

(defun moo-send-text-invisibly ()
  "Send text without logging or displaying it on screen."
  (interactive)
  (process-send-string (moo-proc) (cat (moo-get-password) "\n")))

(defun moo-pipe-quote ()
  "The | (pipe) character is used to quote lines of text."
  (interactive)
  (let ((p (point)) (m (marker-position (moo-mark))))
    (cond
     ((> p m) (insert-before-markers "|"))
     ((= p m) (insert-before-markers "|") (set-marker (moo-mark) m))
     (t (let ((s (cat "|" (buffer-substring (bol) (eol)) "\n")))
	  (process-send-string (moo-proc) s)
	  (save-excursion
	    (goto-char m)
	    (insert-before-markers s)
	    (moo-log m (point))
	    (set-marker (moo-mark) (point))))))))

(defun bol-or-prompt ()
  "Move to the beginning of the line, or to the end of the prompt."
  (interactive)
  (if (= (line (moo-mark)) (line (point)))
      (goto-char (moo-mark))
    (goto-char (bol))))

(defun moo-log (start end)
  "Logs specified region to the logfile for the buffer."
  (write-region start end logfile t -1))

(provide 'moo)

;;; moo.el ends here