;;; -*- Mode:Emacs-Lisp -*-
;;; Wizard interface to LPmud
;;
;; Copyright (C) 1990, 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

;;; This should be rewritten with comint-ipc, I think.

(defvar clpmud-ed-slow-transfer-mode nil
  "*If non-NIL, makes edit transfers go slowly, but more securely.
You might want to report under what circumstances you chose
to set this variable non-NIL.")

(defvar clpmud-ed-prompt nil
  "\"^\\*\C-h\" or \"^:\"")

(defvar clpmud-ed-buffer nil
  "Buffer for communicating with ed")

(defvar clpmud-ed-filter-last-prompt 0
  "Point (marker) where the prompt was last found in clpmud-send-to-ed-filter")
(make-variable-buffer-local 'clpmud-ed-filter-last-prompt)

(defvar clpmud-buffer nil
  "The clpmud buffer to use when reading and writing this buffer")
(make-variable-buffer-local 'clpmud-buffer)

(defconst clpmud-open-process-statuses '(run open))

(defvar clpmud-ed-mode-map nil
  "Keymap for clpmud-ed-mode")

(if (null clpmud-ed-mode-map)
    (let ((map (full-copy-sparse-keymap c-mode-map)))
      (mapcar (function (lambda (seq)
			  (define-key map seq 'clpmud-ed-save-buffer)))
	      (where-is-internal 'save-buffer (current-local-map)))
      (mapcar (function (lambda (seq)
			  (define-key map seq 'clpmud-ed-write-file)))
	      (where-is-internal 'write-file (current-local-map)))
      (define-key map "\C-c\C-e" 'clpmud-ed-ed-mode)
      (define-key map "\C-c\C-v" 'clpmud-view-file-ed-mode)
      (setq clpmud-ed-mode-map map)))

;; clpmud-ed mode is suitable only for specially formatted data.
(put 'clpmud-ed-mode 'mode-class 'special)
(defun clpmud-ed-mode ()
  "Mode for Wizards editing LPmud files.
Commands:
\\{clpmud-ed-mode-map}"
  (interactive)
  (c-mode)
  (setq major-mode 'clpmud-ed-mode)
  (setq mode-name "cLPMUD-ed")
  (use-local-map clpmud-ed-mode-map)
  (make-local-variable 'revert-buffer-function)
  (setq revert-buffer-function 'clpmud-ed-revert-buffer)
  (run-hooks 'clpmud-ed-mode-hook))
    

(defun clpmud-send-ed-string (string)
  (let* ((proc (get-buffer-process (current-buffer)))
	 (filter (process-filter proc))
	 (clpmud-ed-prompt (if (> (length clpmud-ed-prompt) 0) clpmud-ed-prompt "^\\*\C-h")))
    (unwind-protect
	(let ((s 0)
	      (e nil)
	      (size (length string))
	      (clpmud-got-ed-prompt nil))
	  (set-process-filter proc 'clpmud-send-to-ed-filter)
	  (while (setq e (string-match "\n" string s))
	    (process-send-string proc (substring string s (1+ e)))
	    (while (not clpmud-got-ed-prompt)
	      (if clpmud-ed-slow-transfer-mode
		  (sit-for 1)
		(accept-process-output proc))) ;Wait for output
	    (setq clpmud-got-ed-prompt nil)
	    (if (/= 0 e)
		(message "Sent %d bytes (%d%%)..." e (/ (* 100 e) size)))
	    (setq s (1+ e))))
      (set-process-filter proc filter))
    (if (not (string= string "\n"))
	(message "Transmission completed (%s)." (substring string 0 (min 20 (length string)))))))

;;; This version doesn't work, they say.
;;; Presumably that's because the prompt can come in two parts,
;;; in successive STRING args.
;(defun clpmud-send-to-ed-filter (proc string)
;  ;;Ignore proc, don't echo string unless clpmud-ed-buffer is a buffer
;  (if (bufferp clpmud-ed-buffer)
;      (save-excursion
;	(set-buffer clpmud-ed-buffer)
;	(goto-char (mark-marker))
;	(let ((start (point)))
;	  (insert-before-markers string)
;	  (while (search-backward "\r\n" start t)
;	    (delete-char 1)))
;	(goto-char (mark-marker))))
;  (if (string-match clpmud-ed-prompt string)
;      (setq clpmud-got-ed-prompt t)))
;;; This version works, they say.
(defun clpmud-send-to-ed-filter (proc string)
  ;;Ignore proc, don't echo string unless clpmud-ed-buffer is a buffer
  (if (bufferp clpmud-ed-buffer)
      (save-excursion
	(set-buffer clpmud-ed-buffer)
	(goto-char (mark-marker))
	(let ((start (point)))
	  (insert-before-markers string)
	  (while (search-backward "\r\n" start t)
	    (delete-char 1)))
	(goto-char (mark-marker))
	;; Make sure clpmud-ed-filter-last-prompt is a marker!
	(if (markerp clpmud-ed-filter-last-prompt)
	    (if (not (eq (marker-buffer clpmud-ed-filter-last-prompt)
			 clpmud-ed-buffer))
		(set-marker clpmud-ed-filter-last-prompt 0 clpmud-ed-buffer))
	  (setq clpmud-ed-filter-last-prompt (set-marker (make-marker) 0 clpmud-ed-buffer)))
	;;Range check: may be value from another time
	(if (> clpmud-ed-filter-last-prompt (point-max))
	    (set-marker clpmud-ed-filter-last-prompt 0))
	;;Find the prompt in the buffer, in case it came
	;;in two parts
	(if (re-search-backward clpmud-ed-prompt
				clpmud-ed-filter-last-prompt
				t)
	    (progn
	      (setq clpmud-got-ed-prompt t)
	      (set-marker clpmud-ed-filter-last-prompt (1- (match-beginning 0)))))
	(goto-char (mark-marker))
	)
    (if (string-match clpmud-ed-prompt string)
	(setq clpmud-got-ed-prompt t))))

(defun clpmud-send-ed-buffer (buffer)
  "Send a buffer to \"ed\". (WIZARD COMMAND)
First issue the normal \"ed\" command,
then this command (while still in the lpmud buffer),
and then the ususal \"w\" or \"w filename\"
and \"q\" or \"Q\" commands."
  (interactive (list
		(read-buffer "Send ed buffer: "
			     (if (one-window-p)
				 (other-buffer)
			       (window-buffer (next-window)))
			     t)))
  ;; This below defaults to current buffer, which is silly in this case.
;  (interactive "bSend ed buffer: ")
  (let ((buf (current-buffer))
	(clpmud-ed-prompt "^\\*\C-h")
	(string (progn
		  (set-buffer buffer)
		  (widen)
		  (if (and (> (point-max) 1)
			   (/= (char-after (1- (point-max))) ?\n)
			   (y-or-n-p (format "Buffer %s does not end in newline.  Add one? "
					     (buffer-name buffer))))
		      (let ((buffer-read-only nil))
			(goto-char (point-max))
			(insert ?\n)))
		  (buffer-string))))
    (set-buffer buf)
    (clpmud-send-ed-string "i\n")
    (clpmud-send-ed-string string)
    (let ((clpmud-ed-prompt "^:"))
      (clpmud-send-ed-string ".\n"))
    ))

(defun clpmud-ed-ed-mode (filename)
  (interactive "sEdit file: ")
  (clpmud-view-file-ed-mode filename)
  (setq buffer-read-only nil))

(defun clpmud-ed (filename)
  (interactive "sEdit file: ")
  (clpmud-view-file filename t)
  (setq buffer-read-only nil))

(defun clpmud-ed-save-buffer (&optional args)
  (interactive "p")
  (if (not (buffer-modified-p (current-buffer)))
      (message "(No changes need to be saved)")
    (let* ((fbuf (current-buffer))
	   (lpbuf (or (and clpmud-buffer
			   (buffer-name clpmud-buffer)
			   clpmud-buffer)
		      (if (one-window-p)
			  (other-buffer)
			(window-buffer (next-window)))))
	   (filename (or (buffer-file-name fbuf)
			 (buffer-name fbuf)))
	   (proc (and lpbuf (get-buffer-process lpbuf)))
	   (clpmud-ed-prompt "^:"))
      ;; This should never happen again...
      (if (or (null proc) (not (memq (process-status proc) clpmud-open-process-statuses)))
	  (error "Must have lpmud in other window or buffer!"))
      (save-excursion
	(set-buffer lpbuf)
	(clpmud-send-ed-string (concat "ed " filename "\n"))
	(condition-case err
	    (progn
	      (message "Deleting old contents...")
	      (clpmud-send-ed-string "1,$d\n")
	      (message "Sending buffer...")
	      (clpmud-send-ed-buffer fbuf)
	      (message "Saving...")
	      (clpmud-send-ed-string (concat "w " filename "\n"))
	      (message "quitting...")
	      (let ((clpmud-ed-prompt "^> "))
		(clpmud-send-ed-string "q\n"))
	      (save-excursion
		(set-buffer fbuf)
		(set-buffer-modified-p nil))
	      (message "Wrote %s" filename)
	      )
	  (quit
	   (clpmud-send-string "." t)
	   (clpmud-send-string "Q" t)
	   (message "Aborted.")
	   (beep)))))))

(defun clpmud-ed-write-file (filename)
  (interactive "sWrite file: ")
  (if (= 0 (length filename))
      (error "Must specify filename!"))
  (setq buffer-file-name (expand-file-name filename
					   (if (> (length clpmud-current-directory) 0)
					       clpmud-current-directory
					     (if buffer-file-name
						 (file-name-directory buffer-file-name)
					       ""))))
  (save-excursion
    (rename-buffer (concat " renaming " (buffer-name)))
    (let* ((buf (generate-new-buffer (file-name-nondirectory buffer-file-name)))
	   (name (buffer-name buf)))
      (kill-buffer buf)
      (rename-buffer name)))
  (set-buffer-modified-p t)
  (clpmud-ed-save-buffer))

(defun clpmud-ed-revert-buffer (arg noconfirm)
  (let* ((lpbuf (or (and clpmud-buffer
			 (buffer-name clpmud-buffer)
			 clpmud-buffer)
		    (if (one-window-p)
			(other-buffer)
		      (window-buffer (next-window)))))
	 (proc (get-buffer-process lpbuf))
	 (bfn buffer-file-name)
	 (point (point)))
    ;; This should never happen again...
    (if (or (null proc) (not (memq (process-status proc) clpmud-open-process-statuses)))
	(error "Must have lpmud in other window or buffer!"))
    (if (not (or noconfirm
		 (yes-or-no-p (format "Revert buffer %s from file %s? "
				      (buffer-name (current-buffer))
				      buffer-file-name))))
	(message "Not reverted.")
      (save-window-excursion
	(set-buffer lpbuf)
	(clpmud-view-file bfn)
	(if (< point (point-max))
	    (goto-char point))))))
      
(defun clpmud-view-file-ed-mode (filename)
  "View an LPmud file from a clpmud-ed mode buffer."
  (interactive "sView file: ")
  (let* ((obuf (current-buffer))
	 (lpbuf (or (and clpmud-buffer
			 (buffer-name clpmud-buffer)
			 clpmud-buffer)
		    (if (one-window-p)
			(other-buffer)
		      (window-buffer (next-window)))))
	 (proc (get-buffer-process lpbuf)))
    ;; This should never happen again...
    (if (or (null proc) (not (memq (process-status proc) clpmud-open-process-statuses)))
	(error "Must have lpmud in other window or buffer!"))
    (let ((vbuf (save-window-excursion
		  (set-buffer lpbuf)
		  (let ((odir clpmud-current-directory))
		    (unwind-protect
			(let ((clpmud-current-directory
			       (if (buffer-file-name obuf)
				   (file-name-directory (buffer-file-name obuf))
				 clpmud-current-directory)))
			  (clpmud-view-file filename t))
		      (save-excursion
			(set-buffer lpbuf)
			(setq clpmud-current-directory odir)))))))
      (if (bufferp vbuf)
	  (pop-to-buffer vbuf)))))

(defun clpmud-view-file (filename &optional interactive-p)
  "View an LPmud file. (WIZARD COMMAND)"
  (interactive "sView file: ")
  (let* ((obuf (current-buffer))
	 (proc (get-buffer-process obuf))
	 (clpmud-ed-prompt "^> ")
	 (b-file-name (expand-file-name filename clpmud-current-directory))
	 (out-buffer (or (get-file-buffer b-file-name)
			 (generate-new-buffer (file-name-nondirectory b-file-name)))))
    (if (or (null proc) (not (memq (process-status proc) clpmud-open-process-statuses)))
	(error "Must have lpmud in current buffer!")) 
    (if (and (or (interactive-p) interactive-p)
	     (save-excursion (set-buffer out-buffer) (> (point-max) 1))
	     (not (y-or-n-p (format "%s is already in a buffer.  Read it again? "
				    filename))))
	(pop-to-buffer out-buffer)
      (save-excursion (set-buffer out-buffer)
		      (set-marker (mark-marker) (point-max))
		      (setq buffer-read-only nil
			    case-fold-search nil)
		      (erase-buffer))
      (unwind-protect
	  (let ((clpmud-ed-prompt "^More: (line [0-9]+) \\|^> "))
	    ;(clpmud-send-ed-string "brief\n") ;Don't get "Autosave." messages
	    ;(clpmud-send-ed-string "earmuffs 19\n") ;Don't get shouts from novices
	    (setq clpmud-ed-buffer out-buffer)
	    (clpmud-send-ed-string (concat "more " b-file-name "\n"))
	    (set-buffer out-buffer)
	    (while (looking-at-backward "^More: (line \\([0-9]+\\)) ")
	      (message "Read %s lines..."
		       (buffer-substring (match-beginning 1) (match-end 1)))
	      (delete-region (point) (progn (beginning-of-line 1) (point)))
	      (set-buffer obuf)
	      (clpmud-send-ed-string "\n")
	      (set-buffer out-buffer)))
	(setq clpmud-ed-buffer nil)
	;(clpmud-send-ed-string "brief\n") ;Get "Autosave." messages again?
	;(clpmud-send-ed-string "earmuffs 0\n") ;Don't get shouts from novices
	)
      (pop-to-buffer out-buffer)
      (goto-char (point-min))
      (if (looking-at "Unrecognized or failed command.\n")
	  ;;New file (1,$p fails)
	  (kill-line 1))
      (if (and (> (point-max) 1)
	       (progn
		 (goto-char (point-max))
		 (looking-at-backward clpmud-ed-prompt)))
	  (delete-char -2))
      (if (and (> (point-max) 1)
	       (progn
		 (goto-char (point-max))
		 (looking-at-backward "EOF\n")))
	  (delete-char -4))
      (goto-char (point-min))
      (clpmud-ed-mode)
      ;;set this after setting mode, since it's a buffer-local variable
      (setq clpmud-buffer obuf)
      (setq buffer-file-name b-file-name)
      (set-buffer-modified-p nil)
      (setq buffer-read-only t)
      (message "Done.")
      ;;Return current buffer
      (current-buffer))))