;;; zwgc.el -- emacs mode for running zwgc as a sub-process; looks a
;;; lot like rmail.  See mode help for more information.
;;;
;;; Copyright 1991 by Barr3y Jaspan <bjaspan@mit.edu>
;;; This file is covered by the GNU General Public License.
;;; Presumably also Copyright 1996 by Greg Stark <gsstark@mit.edu>
;;; and most recently Copyright 1996 by Eric Mumpower <nocturne@mit.edu>
;;; $Id: zwgc.el,v 1.2 1996/05/15 01:10:34 nocturne Exp nocturne $
;;; $Source: /mit/nocturne/home/lib/elisp/RCS/zwgc.el,v $
;;;
;;; this file began its life as an RCS-managed file belonging to
;;; nocturne@mit.edu, and was originally wholly identical to
;;; gsstark@mit.edu's version of zwgc.el, which was not under RCS so I
;;; can't very well give you a rev number.
;;;
;;; Greg's source came from rev. 2.54 of bjaspan's zwgc.el
;;; (/mit/bjaspan/elisp/RCS/zwgc.el) ... but has been updated a *lot*
;;; by gsstark to handle features of emacs versions beyond 18.

(provide 'zwgc)

(defconst zwgc-emacs-type
  (cond  ((boundp 'epoch::version)                      'epoch)
         ((string-match "Lucid" emacs-version)          'lemacs)
         ((string-match "^19" emacs-version)            'emacs19)
         ((string-match "^18" emacs-version)            'emacs18))
  "Type of emacs we're running.  One of epoch, lemacs, emacs18, or emacs19")

(defvar zwgc-version
  "$Id: zwgc.el,v 1.2 1996/05/15 01:10:34 nocturne Exp nocturne $"
  "*The RCS string identifing the precise version of zwgc mode.")

(defvar zwgc-process nil)

(defvar zwgc-description-file (expand-file-name "~/.zwgc.desc")
  "*Filename passed after the \"-f\" argument to zwgc.")

(defvar zwgc-prog-additional-args '()
  "*A list containing extra arguments to pass to zwgc.")

(defvar zwgc-environment (list "EMACS=t" "DISPLAY=emacs-zwgc" "TERM=emacs")
  "*List of strings to add to the environment for zwgc.")

(defvar zwgc-bufnam "*zwgc*" "The actual name of the *zwgc* buffer.")

(defvar zwgc-window-min-height 7
  "*Minimum size of the *zwgc* buffer when it is displayed.  The intention is
to minimze repainting as the buffer size gets bounced around.")

(defvar zwgc-window-max-height 10
  "*Maximum size of the *zwgc* buffer when it is displayed.")

(defvar zwgc-notices 0
  "The total number of zephyr messages currently in the *zwgc* buffer.")

(defvar zwgc-current-notice 1
  "The number of the notice currently displayed in the *zwgc* buffer.")

(defvar zwgc-prog "/usr/athena/bin/zwgc"
  "*Program to run as the zwgc process. Should set it for the machine type.")

(defvar zwgc-zctl-prog "/usr/athena/bin/zctl"
  "*Program to run as zctl, used by zwgc-zctl-cmd.")

(defvar zwgc-zpunt-prog "/afs/sipb.mit.edu/project/sipb/@sys/zpunt"
  "*Program used by zwgc-zpunt.")

(defvar zwgc-zunpunt-prog "/afs/sipb.mit.edu/project/sipb/@sys/zunpunt"
  "*Program used by zwgc-zunpunt.")

(defvar zwgc-show-on-new t
  "*Toggles whether buffer pops up when new messages arrive.")

(defvar zwgc-show-on-first t
  "*Toggles whether buffer pops up when a zephyr arrives and there are none currently")

(defvar zwgc-warp-to-new nil
  "*Whether new messages are immediately displayed.")

(defvar zwgc-warp-on-first t
  "*Whether to display a message immediately if there are none currently")

(defvar zwgc-bury-buffer t
  "*Controls whether the *zwgc* buffer is buried when the last notice
is deleted.")

(defvar zwgc-hide-frame nil "
*Whether to make the frame containing zwgc 
invisible when the last zephyr is deleted. 
Is ignored unless there are other frames
")

(defvar zwgc-jump-on-new nil
  "*If non-nil, change the selected window when a new notice arrives if
the *zwgc* window is selected.")

(defvar zwgc-buffer-stack nil
  "Internal stack used to jump in and out of the *zwgc* buffer.")

(defvar zwgc-notifications-terminator "\n"
  "*String used by zwgc mode to identify the end of a notice.
Necessary for proper functioning of zwgc-got-notice-hook and
zwgc-notice-regexp-alist.")

(defvar zwgc-notifications-terminator-regexp "[\n\r]"
  "*String used by zwgc mode to identify the end of a notice.
Necessary for proper functioning of zwgc-got-notice-hook and
zwgc-notice-regexp-alist.")

(defvar zwgc-mode-map nil "*Keymap used by the zwgc major mode.  Binding a
key to this variable sets that key as a prefix for zwgc-mode functions
from outside the *zwgc* buffer.")

(defvar zwgc-notice-regexp-alist nil
  "*List of (REGEXP . function) pairs that are matched against each
notice as it is received.  If REGEXP matches a new notice, the
corresponding function is called with a single argument,
(match-data).")

(defvar zwgc-reply-cell nil "\\<zwgc-mode-map>
*Cons cell consisting of (REGEXP . FUNCTION).  REGEXP is matched
against the current notice when \\[zwgc-reply] (zwgc-reply) is
executed and the match data is passed as the only argument to
FUNCTION.")

(defvar zwgc-summary-regexp nil
  "*Regular expression used by zwgc-summary to extract information for
the *zwgc-summary* buffer.")

(defvar zwgc-current-data nil
  "Internal string used to build up each notice until the terminator
is received.")

(defvar zwgc-load-dir "/afs/athena.mit.edu/user/b/bjaspan/elisp"
  "*Path where emacs zwgc and related files live.")

(defvar zwgc-summary-hook nil
  "*Function called to produce a summary string for a zwgc notice.
Takes a list of strings matched by zwgc-summary-regexp as an argument.")

(defvar zwgc-window-placement 'bottom
  "*Where to pop up zwgc window, can be either 'bottom 'top")

(defvar zwgc-warp-on-string "warp"
  "String to insert into modeline to indicate warp-to-new mode")
(defvar zwgc-warp-off-string "impulse"
  "String to insert into modeline to indicate warp-to-new is false")
(defvar zwgc-current-notice-string
  (int-to-string zwgc-current-notice))
(defvar zwgc-notices-string 
  (int-to-string zwgc-notices))

;;; ------------------------------------------------------------------
;;; Utilities -- these functions have nothing to do with zwgc mode.
;;; They could (and should) be moved elsewhere.
;;; ------------------------------------------------------------------

(defun zwgc-silent-replace-regexp (old new)
  (save-excursion
    (while (re-search-forward old (point-max) t)
      (replace-match new))))

(defun zwgc-replace-regexp-on-string (from to string)
  "Replace occurences of regexp FROM with regexp TO in STRING; uses same
rules as replace-regexp."
  (save-excursion
    (let ((buf (generate-new-buffer "  *tmp"))
	  (new-string))
      (set-buffer buf)
      (insert string)
      (goto-char (point-min))
      ; (perform-replace from to nil t nil) ; (replace-regexp from to)
      (zwgc-silent-replace-regexp from to)
      (setq new-string (buffer-substring (point-min) (point-max)))
      (kill-buffer buf)
      new-string)))

(defun zwgc-split (string &optional regexp sep)
  "Splits STRING into a list of strings by choosing breakpoints 
according to REGEXP.  If REGEXP does not occur the entire STRING
is contained in the first element of the returned list.  REGEXP is
optional and defaults to [ \\t]+ (whitespace).  Optional third arg
SEPARATORS causes the text that matches grouped expressions in REGEXP
at each breakpoint to be included in the returned list.  If REGEXP
matches the null string \"\", split will behave as if it matched a
single character at that point; (zwgc-split \"foo\" \" *\") --> (\"f\" \"o\" \"o\")"
  (if regexp nil (setq regexp "[ \t]+"))
  (let ((buf (generate-new-buffer "  *tmp")))
    (unwind-protect 
	(save-excursion
	  (let* ((split-list (list 'split-list))
		 (split-tail split-list))
	    (set-buffer buf)
	    (insert string)
	    (goto-char (point-min))
	    (let ((p (point)) mtext)
	      (while (and (re-search-forward regexp nil t)
			  (< (1+ p) (point-max)))
		(if (/= (match-beginning 0) (match-end 0))
		    (setcdr split-tail
			    (list (buffer-substring p (match-beginning 0))))
		  (setcdr split-tail (list (buffer-substring p (1+ p))))
		  (forward-char 1))
		(setq split-tail (cdr split-tail))
		(setq mtext (zwgc-matched-strings))
		(if (and sep mtext)
		    (progn
		      (setcdr split-tail (list mtext))
		      (setq split-tail (cdr split-tail))))
		(setq p (point))))
	    (setcdr split-tail (list (buffer-substring (point) (point-max))))
	    (setq split-tail (cdr split-tail))
	    (cdr split-list)))
      (kill-buffer buf))))


(defun zwgc-filter (pred list)
  (apply 'append
	 (mapcar (function (lambda (elem)
			     (if (funcall pred elem)
				 (list elem)
			       nil)))
		 list)))

(defun zwgc-broken-filter (pred lst)
  "Applies PREDICATE to each element of LIST, returning the list of
all elemenets for which the predicate returns non-nil."
  (cond ((null lst) nil)
	((funcall pred (car lst))
	 (cons (car lst) (zwgc-filter pred (cdr lst))))
	(t (zwgc-filter pred (cdr lst)))))

(defun zwgc-matched-strings-list ()
  "Returns a list that contains each grouped subexpression matched in
the previous regular-expression search."
  ;; Skip the first pair of numbers since it is the ENTIRE matched string.
  (let* ((data (nthcdr 2 (match-data)))
	(mlist (list 'mlist))
	(mtail (nthcdr (1- (length mlist)) mlist)))
    (while data
      ;; XXX (match-data) is supposed to contain markers or nil.
      ;; 18.55.160 on the Sun sometimes returns 0's, too.
      (if (and (car data) (not (= 0 (car data))))
	  (progn
	    (setcdr mtail (list (buffer-substring (car data) (nth 1 data))))
	    (setq mtail (cdr mtail))))
      (setq data (nthcdr 2 data)))
    (cdr mlist)))

(defun zwgc-matched-strings ()
  "Returns a single string that is the concatenation of all the parenthesized
expressions in the previous regular-expression search."
  (apply 'concat (zwgc-matched-strings-list)))

;;; ------------------------------------------------------------------
;;; End of utilities
;;; ------------------------------------------------------------------

;;;XXX bug: if the current frame is a minibuffer frame then all hell breaks loose
;;;         notably infinite loops in zwgc-show
;;;         i don't know what it frame it should choose in this case though 
;;;         workaround: call zwgc-set-frame in a reasonable frame 
(defvar zwgc-frame nil)
(defun zwgc-get-frame ()
  (cond ((frame-live-p zwgc-frame) nil
	 zwgc-frame)
	(t 
	 (setq zwgc-frame (window-frame (frame-first-window))))))

(defun zwgc-set-frame (&optional frame)
  (interactive (list (window-frame (frame-first-window))))
  (setq zwgc-frame frame))
	 
(defun zwgc-visible-p ()
  (let ((window (zwgc-find-window)))
    (if (eq zwgc-emacs-type 'emacs19)
	(and window
	     (frame-visible-p (window-frame window)))
      window)))
	
(defun zwgc-update-mode-line ()
  (setq zwgc-current-notice-string 	(int-to-string zwgc-current-notice))
  (setq zwgc-notices-string 		(int-to-string zwgc-notices))
  (if (fboundp 'force-mode-line-update)
      (force-mode-line-update t)))
  

(defun zwgc-get-window ()
  "get the right window to place zwgc buffer in"
  (cond ((eq zwgc-emacs-type 'emacs19)
	 (cond ((eq zwgc-window-placement 'top)
		(frame-first-window (zwgc-get-frame)))
	       ((eq zwgc-window-placement 'bottom)
		;; (previous-window (frame-first-window (zwgc-get-frame)))
		(let ((w (previous-window (frame-first-window (zwgc-get-frame)))))
		  (while (eq (minibuffer-window) w)
		    (setq w (next-window w)))
		  w)
		)))
	(t ; emacs 18 method
	 (cond ((eq zwgc-window-placement 'top)
		(next-window (minibuffer-window)))
	       (t
		(previous-window (minibuffer-window)))))))

(defun zwgc-find-window ()
  "find window displaying zwgc buffer if any exist"
  (cond ((eq zwgc-emacs-type 'emacs19)
	 (get-buffer-window zwgc-bufnam t))
	(t ; emacs 18
	 (get-buffer-window zwgc-bufnam))))

(defun zwgc-push-to-buffer ()
  "Save the current window and buffer and move into the *zwgc* window,
if it exists."
  (let* ((buffer (current-buffer))
	 (window (selected-window))
	 (zwgc-buffer (get-buffer zwgc-bufnam))
	 (zwgc-window (zwgc-find-window)))
    
    (if (or (not zwgc-window) (not zwgc-buffer))
	(error "*zwgc* buffer not visible or does not exist")
      (setq zwgc-buffer-stack (cons (cons buffer window) zwgc-buffer-stack))
      (select-window zwgc-window)
      (set-buffer zwgc-buffer))))

(defun zwgc-pop-from-buffer ()
  "Restore the previously pushed (with zwgc-push-to-buffer) window and buffer."
  (if (not zwgc-buffer-stack)
      (error "zwgc buffer stack is empty.")
    (let ((p (car zwgc-buffer-stack)))
      (setq zwgc-buffer-stack (cdr zwgc-buffer-stack))
      (if (not (equal (cdr p) (next-window (previous-window (cdr p)))))
	  nil
	(select-window (cdr p))
	(set-buffer (car p))))))

(defun zwgc-pop-from-buffer-to-nowhere ()
  "Delete the top element from zwgc-buffer-stack."
  (if (not zwgc-buffer-stack)
      (error "zwgc buffer stack is empty.")
    (setq zwgc-buffer-stack (cdr zwgc-buffer-stack))))

(defun zwgc-wrap-function (symbol)
  "Returns a lambda expression that calls the function value of SYMBOL,
wrapped by calls to zwgc-push-to-buffer and zwgc-pop-from-buffer."
    (append '(lambda ())
	    (list
	     '(interactive)
	     '(zwgc-push-to-buffer)
	     '(mark-whole-buffer)
	     (list 'unwind-protect
		   (list 'call-interactively (list 'quote symbol))
		   '(zwgc-pop-from-buffer))
	     )))

(defun zwgc-apply-cell (cell)
  "CELL is (REGEXP . function).  Calls function with the argument
match-data if REGEXP matches the current notice."
  (save-excursion
    (goto-char (point-min))
    (let ((regexp (car cell)) (f (cdr cell)))
      (if (re-search-forward regexp nil t)
	  (progn
	    (condition-case err
		(funcall f (match-data))
	      (error
	       (message (format "zwgc: received %s applying %s" err cell))
	       (ding 1)
	       ))))
      )))

(defun zwgc-notice-iter (p &rest args)
  "Calls FUNCTION on each zwgc notice in turn, passing it ARGS.
FUNCTION must return t if it deletes the notice with zwgc-punt.
Called interatively, prompts for a symbol to call as FUNCTION, with no
args."
  (interactive "aFunction to iterate: ")
  (let ((n 0) (save-notice zwgc-current-notice))
    (zwgc-push-to-buffer)
    (while (<= (setq n (1+ n)) zwgc-notices)
      (zwgc-nth-notice n t)
      (if (eq (apply p args) t)
	  (setq n (1- n)))
      )
    (if (< save-notice zwgc-notices)
	(zwgc-nth-notice save-notice)
      (zwgc-nth-notice zwgc-notices))
    (zwgc-pop-from-buffer)
    ))

(defun zwgc-summary (regexp)
  "Produces a summary of all notices in the *zwgc* buffer by putting
the matched data from a regexp search in the *zwgc-summary* buffer (if
zwgc-summary-hook is defined, it is called with the list of matched
strings and its return value is used).  Uses zwgc-summary-regexp if it
is defined, or prompts for a regexp if it isn't or if a prefix
argument is given."
  (interactive (list (or (and (not current-prefix-arg)
			      zwgc-summary-regexp)
			 (read-string "Summary regexp: "))))
  (if (get-buffer "*zwgc-summary*")
      (kill-buffer "*zwgc-summary*"))
  (let ((buffer (get-buffer-create "*zwgc-summary*")))
    (zwgc-notice-iter
     (function (lambda (b)
		 (let ((found (re-search-forward regexp nil t))
		       (summary nil))
		   (if found
		       (progn
			 (if zwgc-summary-hook
			     (setq summary
				   (apply (symbol-value 'zwgc-summary-hook)
					  (zwgc-matched-strings-list)))
			   (setq summary (zwgc-matched-strings)))
			 (save-excursion
			   (set-buffer b)
			   (insert summary "\n"))
			 )))))
     buffer)
    (pop-to-buffer buffer)
    ))

(defun zwgc-eonp (string)
  ;; Returns t if the string ends with zwgc-notifications-terminator,
  ;; nil otherwise.
  (let* ((znt zwgc-notifications-terminator)
	 (znt-len (length znt)))
    (and (>= (length string) znt-len)
	 (equal (substring string (- znt-len)) znt))))

(defun zwgc-initial-wakeup (proc string)
  ;; Called for the *first* output from zwgc only.. this is a hack.
  (save-excursion
    (set-buffer (get-buffer zwgc-bufnam))
    (run-hooks 'zwgc-running-hook))
  (set-process-filter proc 'zwgc-wakeup)
  (zwgc-wakeup proc string)
  )

(defun zwgc-wakeup (proc string)
  ;; Does *NOT* use the proc argument.

  (let* ((string (zwgc-replace-regexp-on-string "\r" "" string))
	 (split-list (zwgc-split string zwgc-notifications-terminator)))

    ;; Everything except the last element is guaranteed to be the end
    ;; of a notice.
    (while (cdr split-list)
      (zwgc-wakeup-2 (car split-list) t)
      (setq split-list (cdr split-list)))

    ;; The last element is part of a notice if it is not "".
    (if (not (equal (car split-list) ""))
	(zwgc-wakeup-2 (car split-list) nil))
    ))

(defun zwgc-wakeup-2 (string end-of-notice)
  (setq zwgc-current-data (concat zwgc-current-data string))
  (if end-of-notice
      (let* ((zwgc-buffer (get-buffer zwgc-bufnam))
	     (zwgc-window (get-buffer-window zwgc-buffer))
	     (first-notice-flag))
	(save-excursion
	  (set-buffer zwgc-buffer)
	  ;; this is just a robust save-restriction
          (let ((beg (point-min-marker))
                (end (point-max-marker))
		(widep (and (= (point-min) 1)
			    (= (point-max) (1+ (buffer-size)))
			    (> zwgc-notices 0))))
            (unwind-protect
                (progn 
		  (widen)
		  (goto-char (point-max))
		  (insert zwgc-current-data zwgc-notifications-terminator)
		  (setq zwgc-notices (1+ zwgc-notices))
		  (if (/= zwgc-current-notice 0) nil
		    (setq zwgc-current-notice 1)
		    (setq first-notice-flag t))
		  (setq zwgc-current-data nil)
		  
		  ;; Really be at last notice, call hooks.
		  (zwgc-nth-notice zwgc-notices t)
		  (mapcar 'zwgc-apply-cell zwgc-notice-regexp-alist)
		  (run-hooks 'zwgc-got-notice-hook)
		  (zwgc-update-mode-line)
;;;		  (setq mode-line-process (format " %d/%d" 
;;;						  zwgc-current-notice 
;;;						  zwgc-notices))
		  ) ; unwind-protect:
	      (save-excursion
                (set-buffer (marker-buffer beg))
		(if widep
		    (widen)
		  (narrow-to-region beg end))
		))))

	(if (< zwgc-notices 1) nil
	  (if (and (or zwgc-show-on-new
		       first-notice-flag)
		   (not (zwgc-visible-p)))
	      (zwgc-pop-up-window (get-buffer zwgc-bufnam) zwgc-jump-on-new))
	  (if (and (or zwgc-warp-to-new
		       first-notice-flag)
		   (zwgc-visible-p))
	      (zwgc-last-notice)))
	)))

(defun zwgc-resize-window ()
  "Resizes the zwgc window to the current notice (within the
constraints of zwgc-window-{min,max}-height).  The *zwgc* buffer must
be visible and selected."  
  (let ((lines))
    (if (one-window-p t) 
	nil 
      (setq lines (1+ (count-lines (point-min) (point-max))))
      (if (> lines zwgc-window-max-height)
	  (setq lines zwgc-window-max-height)
	(if (< lines zwgc-window-min-height)
	    (setq lines zwgc-window-min-height))
	)
      (enlarge-window (- lines (window-height (selected-window))))
      )))

;;;
;;; Notice selecting/deleting functions
;;;

(defun zwgc-nth-notice (n &optional nodisplay)
  (interactive "Nnotice #:")
  (if (or (< n 1) (> n zwgc-notices))
      (error "No such notice: %d" n))
  (let ((beg))
    (if nodisplay nil (zwgc-push-to-buffer))
    (unwind-protect
	(progn
	  (save-restriction
	    (widen)
	    (goto-char (point-min))
	    
	    (if (= n 1)
		(setq beg (point))
	      (if (re-search-forward zwgc-notifications-terminator-regexp nil t (1- n))
		  (setq beg (point))
		(error "Rep invariant failure in zwgc!"))))
	  
	  (widen)
	  (goto-char beg)
	  (if (not (re-search-forward zwgc-notifications-terminator-regexp nil t))
	      (error "Rep invariant failure in zwgc!"))
	  (forward-char (- (length zwgc-notifications-terminator)))
	  (narrow-to-region beg (point))
	  ;; (mark-whole-buffer)
	  ;;(set-marker (mark-marker) (point-max))
	  ;;(goto-char (point-min))

	  (if nodisplay nil
	    (setq zwgc-current-notice n)
	    (zwgc-update-mode-line)
;;;	    (setq mode-line-process (format " %d/%d" n zwgc-notices))
	    (zwgc-resize-window))
	  )
      
      (if nodisplay nil (zwgc-pop-from-buffer)))
    ))

(defun zwgc-first-notice ()
  (interactive)
  (zwgc-nth-notice 1)
  ;; a hack to get the last non-restricted notice
  (zwgc-next-notice) (zwgc-prev-notice)
  )


;;; zwgc-next-notice and zwgc-prev-notice handle restrictions now (?)
(defun zwgc-internal-next-notice (&optional direction)
  "Display the next notice in the *zwgc* buffer."
  (let ((good)
	(prior-current zwgc-current-notice)
	(increment) (text))
    (if (or (not direction)
	    (>= direction 0))
	(setq increment +1
	      text "Last")
      (setq increment -1
	    text "First"))
    (condition-case nil
	(while (not good)
	  (zwgc-nth-notice (+ increment zwgc-current-notice))
	  (setq good (zwgc-is-valid-notice-p)))
      (error
       (if (not (zwgc-is-valid-notice-p))
	   (progn
	     (zwgc-nth-notice prior-current)
	     (message "%s unhidden zwgc notice, do zwgc-show-all to see hidden notices" text))
	 (message "%s zwgc notice" text))))))

(defun zwgc-next-notice (&optional arg)
  (interactive "p")
  (if arg nil (setq arg 1))
  (let ((count (abs arg)))
    (while (> count 0)
      (zwgc-internal-next-notice arg)
    (setq arg (1- arg)))))
(defun zwgc-prev-notice (&optional arg)
  (interactive "p")
  (if arg nil (setq arg 1))
  (zwgc-next-notice (- 0 arg)))

(defun zwgc-current-notice (&option backwards)
  "A peculiar command used to reset the narrowed region after a 
notice has been deleted."
  (interactive)
  (zwgc-nth-notice zwgc-current-notice)
  (if backwards 
      (progn
	
)))

(defun zwgc-is-valid-notice-p ()
  (let ((start (point-min)))
    (save-restriction 
      (widen) 
      (not (eq ?\r (char-after (1- start)))))))

(defun zwgc-last-notice ()
  (interactive)
  (zwgc-nth-notice zwgc-notices)
  ;; a hack to get the last non-restricted notice
  (zwgc-prev-notice) (zwgc-next-notice)
  )

(defun zwgc-punt (&optional nodisplay backwards)
  "Delete the current Zephyr notice.  Optional argument NODISPLAY
means not to display the new current notice after punting.  Returns t."
  (interactive)

  ;; Sanity check
  (if (< zwgc-notices 1)
      (error "No notices to punt!"))

  (let ((window-min-height 1) (buffer (current-buffer)) (beg) (end))

    (set-buffer (get-buffer zwgc-bufnam))
    (setq beg (point-min))
    (setq end (+ (point-max) (length zwgc-notifications-terminator)))
    (setq zwgc-notices (1- zwgc-notices))
    (if backwards 
	(setq zwgc-current-notice (1- zwgc-current-notice)))
	
    (cond ((> zwgc-current-notice zwgc-notices)
	   (setq zwgc-current-notice zwgc-notices))
	  ((< zwgc-current-notice 1)
	   (setq zwgc-current-notice 1)))
    
    (widen)
    (delete-region beg end)
    (if (= 0 zwgc-notices)
	(progn
;;;	  (setq mode-line-process " 0/0")
	  (setq zwgc-current-notice 0)
	  (zwgc-update-mode-line)
	  (if (not zwgc-bury-buffer)
	      (if (eq (selected-window) (get-buffer-window zwgc-bufnam))
		  (other-window 1))
	    (if (not (one-window-p))
		(progn 
		  (delete-windows-on zwgc-bufnam)
		  (bury-buffer zwgc-bufnam)))))
      (if nodisplay nil
	(zwgc-current-notice backwards))
      (run-hooks 'zwgc-killed-notice-hook)
      (zwgc-update-mode-line))
    (set-buffer buffer)
    t))

(defun zwgc-punt-backwards (&optional nodisplay)
  "Delete the currrent Zephyr notice, then go to previous one"
  (interactive)
  (zwgc-punt nodisplay t))

(defun zwgc-punt-regexp (regexp)
  "Cause zwgc to ignore all zwgc notices that match REGEXP.  With a
prefix, does the opposite operation."
  (interactive (list (if current-prefix-arg
			 (read-string "Regexp to unpunt: ")
		       (read-string "Regexp to punt: "))))
  (let ((cell (cons regexp 'zwgc-punt)))
    (if current-prefix-arg
	(setq zwgc-notice-regexp-alist
	      (zwgc-filter (function (lambda (x) (not (equal cell x))))
		      zwgc-notice-regexp-alist))
      (setq zwgc-notice-regexp-alist (cons cell zwgc-notice-regexp-alist)))
    ))

(defun zwgc-reply ()
  "Performs a regular-expression search on the current notice with the
car of zwgc-reply-cell as the regexp and then calls the cdr of
zwgc-reply-cell with the match data as an argument."
  (interactive)
  (if (not zwgc-reply-cell)
      (error "zwgc-reply-cell is not defined.")
    (zwgc-push-to-buffer)
    (zwgc-apply-cell zwgc-reply-cell)
    (zwgc-pop-from-buffer)
    ))
    

(defun zwgc-show ()
  (interactive)
  (zwgc-update-mode-line)
  (zwgc-pop-up-window (get-buffer zwgc-bufnam) nil))
		     
(defun zwgc-hide ()
  "Bury the *zwgc* buffer (make it the least likely to be selected by
\\[switch-to-buffer]) and delete the window it is in."
  (interactive)
  (zwgc-push-to-buffer)
  (bury-buffer)
  (if (one-window-p t) nil
    (delete-window))
  (zwgc-pop-from-buffer-to-nowhere)
  )
  
(defun kill-zwgc nil
  "Kill the zwgc subprocess and the *zwgc* buffer."
  (interactive)
  (let* ((buf (get-buffer zwgc-bufnam))
	(win (get-buffer-window buf))
	proc)
    (if (not (and buf
		  (setq proc (get-buffer-process buf))
		  (eq (process-status proc) 'run)))
	(error "No zwgc process currently running."))
    (interrupt-process proc)  
    (sit-for 1)
    (delete-process proc)
    (kill-buffer buf)
    (if (and win (not (one-window-p)))
	(delete-window win))
    (run-hooks 'zwgc-killed-hook)
    ))

(defun zwgc-set-min-height (height)
  (interactive "NMinimum height for zwgc buffer (incl. modeline): ")
  (if (> height zwgc-window-min-height)
      (setq zwgc-window-max-height height))
  (setq zwgc-window-min-height height)
  (if (zwgc-find-window)
      (zwgc-resize-window)))

(defun zwgc-inc-min-height ()
  (interactive)
  (zwgc-set-min-height (1+ zwgc-window-min-height)))

(defun zwgc-set-max-height (height)
  (interactive "NMaximum height for zwgc buffer (incl. modeline): ")
  (if (< height zwgc-window-min-height)
      (setq zwgc-window-min-height height))
  (setq zwgc-window-max-height height)
  (if (zwgc-find-window)
      (zwgc-resize-window)))

(defun zwgc-dec-max-height ()
  (interactive)
  (zwgc-set-max-height (1- zwgc-window-max-height)))

(defun zwgc-toggle-warp (arg)
  (interactive "P")
  (if arg
      (setq zwgc-warp-to-new (> 0 arg))
    (setq  zwgc-warp-to-new (not zwgc-warp-to-new)))
;;;  (message (if zwgc-warp-to-new 
;;;	     "Warp to New   (set zwgc-warp-to-new true)" 
;;;	     "Reverse Stack (set zwgc-warp-to-new false)"
;;;	     ))
  (zwgc-update-mode-line)
  )

(defun start-zwgc ()
  "Start the zwgc process."
  (let ((buffer (get-buffer zwgc-bufnam)) status)
    (setq zwgc-process (get-buffer-process buffer))
    (if zwgc-process (setq status (process-status zwgc-process)))
    (save-excursion
      (set-buffer buffer)
      (setq default-directory "/")
      (if (memq status '(run stop))
          nil
        (if zwgc-process (delete-process zwgc-process))
        (setq zwgc-process 
	      (let ((process-environment (append  zwgc-environment
						  process-environment))
		    process-connection-type)
		(apply 'start-process "Zwgc" buffer zwgc-prog "-ttymode"
		       "-nofork" "-f" zwgc-description-file
		       zwgc-prog-additional-args)))
	(set-process-sentinel zwgc-process 'zwgc-sentinel)
	(set-process-filter zwgc-process 'zwgc-initial-wakeup))
      )))

(defun zwgc ()
  "Run zwgc as a subprocess."
  (interactive)
  (let ((buffer (get-buffer-create zwgc-bufnam)))
    (save-excursion
      (set-buffer buffer)
      (zwgc-mode)
      (start-zwgc))
    ))

(defun zwgc-make-keymap ()
  (interactive)
  (define-prefix-command 'zwgc-mode-map)
    (setq zwgc-mode-map (symbol-function 'zwgc-mode-map))
    (suppress-keymap zwgc-mode-map)

    (define-key zwgc-mode-map "?" 	'describe-mode)
    (define-key zwgc-mode-map "[" 	'zwgc-set-min-height)
    (define-key zwgc-mode-map "]" 	'zwgc-set-max-height)
    (define-key zwgc-mode-map "{" 	'zwgc-dec-max-height)
    (define-key zwgc-mode-map "}" 	'zwgc-inc-min-height)
    (define-key zwgc-mode-map "<" 	'zwgc-first-notice)
    (define-key zwgc-mode-map ">" 	'zwgc-last-notice)
    (define-key zwgc-mode-map "n" 	'zwgc-next-notice)
    (define-key zwgc-mode-map "p" 	'zwgc-prev-notice)
    (define-key zwgc-mode-map "." 	'zwgc-current-notice)
    (define-key zwgc-mode-map "g"	'zwgc-nth-notice)
    (define-key zwgc-mode-map "r" 	'zwgc-reply)
    ;;(define-key zwgc-mode-map "\177" 	'zwgc-punt)
    (define-key zwgc-mode-map "d" 	'zwgc-punt)
    (define-key zwgc-mode-map "\C-d" 	'zwgc-punt-backwards)
    (define-key zwgc-mode-map "q" 	'zwgc-hide)
    (define-key zwgc-mode-map "s" 	'zwgc-show)
    (define-key zwgc-mode-map "f" 	'zwgc-toggle-warp)
    (define-key zwgc-mode-map "K" 	'kill-zwgc)
    (define-key zwgc-mode-map "\M-w" 	(zwgc-wrap-function 'copy-region-as-kill))
    (define-key zwgc-mode-map "w" 	(zwgc-wrap-function 'write-region))
    (define-key zwgc-mode-map " " 	(zwgc-wrap-function 'scroll-up))
    (define-key zwgc-mode-map "\177" 	(zwgc-wrap-function 'scroll-down))
    (define-key zwgc-mode-map "\M-p" 	'zwgc-zpunt)
    (define-key zwgc-mode-map "\C-\M-p"	'zwgc-punt-regexp)
    (define-key zwgc-mode-map "h" 	'zwgc-summary)
    (define-key zwgc-mode-map "=" 	'zwgc-summary)
    (define-key zwgc-mode-map "c" 	'zwgc-zctl-cmd)
    (define-key zwgc-mode-map "x" 	'zwgc-call-process)
    (define-key zwgc-mode-map "l" 	'zwgc-znol-mode-map)
    (run-hooks 'zwgc-make-keymap-hook)
    )

(zwgc-make-keymap)

(defun zwgc-mode ()
  "\\<zwgc-mode-map>Major mode for receiving and viewing Zephyr
notices.  Each time a notice is received it is displayed in the *zwgc*
window (which is created at the bottom of the screen if it does not
already exist).  When a notice is deleted with \\[zwgc-punt], the next
notice in the queue is displayed or, if there are no more notices, the
window disappears.

Each zephyr notice is expected to end with the value of the variable
zwgc-notifications-terminator (\"^L\\n\" by default).  The are several
variables that otherwise control the behavior of zwgc mode; UTFL.

All normal editing commands are turned off.  Instead, the following
commads are defined:

\\[zwgc-next-notice]		Move to next notice.
\\[zwgc-prev-notice]		Move to previous notice.
\\[zwgc-first-notice]		Move to first notice.
\\[zwgc-last-notice]		Move to last notice.
\\[zwgc-current-notice]		``Move'' to current notice.
\\[zwgc-punt]		Delete current notice.
\\[zwgc-hide]		Hide the *zwgc* buffer until a notice is received.
\\[zwgc-show]		Display the *zwgc* buffer.
\\[zwgc-summary]		Produce a summary of notice headers.
\\[kill-zwgc]		Kill the zwgc subprocess and *zwgc* buffer.
\\[zwgc-zpunt]		Punt/unpunt notices with zpunt.
\\[zwgc-punt-regexp]		Punt/unpunt notices matching regexp.
\\[zwgc-zctl-cmd]		Perform a 'zctl' command.
\\[zwgc-call-process]		Execute a program in zwgc's environment.
\\[zwgc-znol-mode-map]		Prefix key for *znol* buffer commands.
\\[write-region]		Write current notice to file.
\\[copy-region-as-kill]		Copy current notice as if killed.
\\[describe-mode]		This help message."
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'zwgc-mode)
  (setq mode-name "zwgc")
  (put 'zwgc-mode 'mode-class 'special)
  (setq mode-line-format ; The default modulo %n
	'("" mode-line-modified mode-line-buffer-identification "   " 
	  global-mode-string "   %[(" mode-name minor-mode-alist 
	  mode-line-process ")%]----" (-3 . "%p") "-%-"))
  (setq mode-line-process '(":" 
			    zwgc-current-notice-string "/" zwgc-notices-string " "
			    (zwgc-warp-to-new zwgc-warp-on-string zwgc-warp-off-string)
			    ))
			     
  (save-excursion
    (set-buffer (get-buffer zwgc-bufnam))
    (delete-region (point-min) (point-max)))
  (setq zwgc-notices 0)
  (setq zwgc-current-notice 0)
  (setq zwgc-mode-map nil)
  (if zwgc-mode-map nil 
    (zwgc-make-keymap))
  (use-local-map zwgc-mode-map)
  (run-hooks 'zwgc-mode-hook)
  )


;; Called when zwgc loses.  If it exited, restart it; if it was
;; killed, do nothing (let it die).
(defun zwgc-sentinel (process signal)
  (let ((buffer (process-buffer process))
	(status (process-status process)))
    (cond ((eq status 'exit)
	   (if (equal signal "finished\n")
	       nil
	     (ding)
	     (message "zwgc: %s, restarting" (substring signal 0 -1))
	     (start-zwgc)))
	  ((eq status 'signal)
	   nil)
	  (t
	   (ding)
	   (message "zwgc: sentinel called for unknown reason!"))
	  )))

;;;
;;; zwgc-related process functions
;;;

(defun zwgc-start-process (name buffer program &rest args)
  "Exactly like start-process except that zwgc-environment is added to
the process environment."
  (let ((process-environment (append zwgc-environment process-environment)))
    (apply 'start-process name buffer program args)))

(defun zwgc-call-process (program &optional infile buf-or-name dsp
				  &rest args)
  "Exactly like call-process except that zwgc-environment is added to
the processes environment.  Called interactively, prompts for a string
which is the program to run plus any arguments.  Output is discarded
unless there is a prefix argument, in which case it is inserted into
the current buffer."
  (interactive
   (let ((prog (zwgc-split (read-string "Program to run: ")))
	 (arg (not (null current-prefix-arg))))
     (append (list (car prog) nil arg arg) (cdr prog))))
    
  (let ((process-environment (append zwgc-environment process-environment)))
    (apply 'call-process program infile buf-or-name dsp
	   (zwgc-filter 'identity args))))

(defun zwgc-zpunt (arg1 &optional arg2 arg3)
  "Called interactively, prompts for a string of the form
'string1[,string2[,string3]' and passes the strings separately as
arguments to zwgc-zpunt-prog.  Called non-interactively, takes one
string and optionally two more that are passed to zwgc-zpunt-prog.
The program is executed with the same environment as zwgc.

With a prefix argument, uses zwgc-zunpunt-prog instead."
  (interactive (zwgc-split (if current-prefix-arg
			  (read-string "String to zunpunt: ")
			(read-string "String to zpunt: "))
		      "[ ,]+"))
  (if current-prefix-arg
      (zwgc-call-process zwgc-zunpunt-prog nil nil nil arg1 arg2 arg3)
    (zwgc-call-process zwgc-zpunt-prog nil nil nil arg1 arg2 arg3)))

(defun zwgc-zctl-cmd (&rest args)
  "Takes any number of arguments and passes then to zwgc-zctl-prog,
running the program with the same environment as zwgc.  Called
interactively, prompts for a string that are the arguments to pass."
  (interactive (zwgc-split (read-string "Zctl command: ") "[ ]+"))
  (apply 'zwgc-call-process zwgc-zctl-prog nil nil nil args))

(defun zwgc-pop-up-window (ignored &optional leave)
  ;; Note: This function *DOES NOT* use pop-to-buffer.  Keep it that way.
  (let* ((retwin (selected-window))
	 (retbuf (current-buffer))
         (pop-up-windows t)
         (window-min-height 1)
	 (zwgc-window (zwgc-find-window))
	 )

    ;; If the frame is not visible, make it visible
    (if (and (eq zwgc-emacs-type 'emacs19)
	     (not (frame-visible-p (zwgc-get-frame))))
	(make-frame-visible (zwgc-get-frame)))

    ;; If the window does not already exist, create it
    (if zwgc-window nil
      (split-window (zwgc-get-window))
      (setq zwgc-window (zwgc-get-window))
      )

    ;; Now, whether it was there or not, put the *zwgc* buffer in it,
    ;; resize, and return (or leave).
    (select-window zwgc-window)
    (switch-to-buffer zwgc-bufnam)
    (zwgc-resize-window)
    ;; a little hack 'cause splitting the top window 
    ;; can changed the window numbers
    (if (and (equal zwgc-window retwin)
	     (equal (window-buffer (next-window retwin))
		    retbuf))
	(select-window (next-window retwin))
      (select-window retwin))
    (if (and leave (equal (window-buffer retwin) (window-buffer zwgc-window)))
        (other-window 1))
    ))

;;;
;;; Other random stuff.
;;;

(defun zwgc-do-autoload (symbol)
  "Loads the file SYMBOL autoloads from, if SYMBOL is autoloaded."
  (let ((l (symbol-function symbol)))
    (if (eq (car l) 'autoload)
	(progn
	  (load-library (car (cdr l)))
	  (if (eq (car (symbol-function symbol)) 'autoload)
	      (error "Autoloading failed to define function %s"
		     (symbol-name symbol)))))))

(defun zwgc-install-window-functions ()
  "Installs replacements for C-x 0, C-x 1, and C-x 2 that try hard 
to keep the *zwgc* buffer displayed and fixed in size."
  (interactive)
  (define-key global-map "\C-x0" 'zwgc-hacked-delete-window)
  (define-key global-map "\C-x1" 'zwgc-hacked-delete-other-windows)
  (define-key global-map "\C-x2" 'zwgc-hacked-split-window)
  (zwgc-do-autoload 'zwgc-pop-to-buffer)
  (fset 'pop-to-buffer (symbol-function 'zwgc-pop-to-buffer))
  )

(defun zwgc-autoload (symbol file doc)
  (autoload symbol (concat zwgc-load-dir "/" file) doc t nil))

;;;
;;; Finally, all the code that is executed goes here, at the end.
;;;

(defun zwgc-startup ()
  (zwgc-autoload 'zwgc-znol "zwgc-znol"
		 "This is the main entry point for *znol* with emacs zwgc.")
  (zwgc-autoload 'zwgc-hacked-delete-window "zwgc-window"
		 "delete-window without resizing *zwgc* window")
  (zwgc-autoload 'zwgc-hacked-delete-other-windows "zwgc-window"
		 "delete-other-windows without resizing *zwgc* window")
  (zwgc-autoload 'zwgc-hacked-split-window "zwgc-window"
		 "split-window without resizing *zwgc* window")
  (zwgc-autoload 'zwgc-pop-to-buffer "zwgc-window"
		 "pop-to-buffer that will not choose *zwgc*")
  
  ;; So this function gets GC'ed
  (fmakunbound 'zwgc-startup)
  )
(zwgc-startup)

