;;; zwgc-znol.el -- part of the zwgc major mode for emacs.  This
;;; file contains code to create and maintain a *znol* buffer using
;;; emacs zwgc.
;;;
;;; Copyright 1991 by Barr3y Jaspan <bjaspan@mit.edu>
;;; This file is covered by the GNU General Public License.
;;;
;;; $Id: zwgc-znol.el,v 1.12 1996/04/24 10:09:22 bjaspan Exp bjaspan $
;;; $Source: /afs/athena.mit.edu/user/b/j/bjaspan/elisp/RCS/zwgc-znol.el,v $
;;; $Log: zwgc-znol.el,v $
; Revision 1.12  1996/04/24  10:09:22  bjaspan
; /usr/athena/znol -> /usr/athena/bin/znol
;
; Revision 1.11  93/02/23  16:12:31  bjaspan
; output failed znol line on failed match
; 
; Revision 1.10  1993/02/23  16:09:47  bjaspan
; comment changes, apparently; too long ago to remember
;
; Revision 1.9  91/08/30  13:40:49  bjaspan
; added r (rescan) and d (zwgc-znol-delete) commands
; 
; Revision 1.8  91/04/28  14:46:27  bjaspan
; fixed regexps to match [a-z0-9] instead of just [a-z]
; 
; Revision 1.7  91/04/25  23:06:06  bjaspan
; mapline, I said *mapline*.  Not maplines. :-)
; 
; Revision 1.6  91/04/23  18:36:45  bjaspan
; call mapline instead of mapfunc-lines
; 
; Revision 1.5  91/04/09  23:58:42  bjaspan
; changed kill-line to delete-matching-lines, keep the *znol* buffer
; read-only except when changing it
; 
; Revision 1.4  91/03/10  13:29:37  bjaspan
; zwgc-znol-2 was checking car instead of cdr of each cell for functions
; 
; Revision 1.3  91/03/05  19:22:00  bjaspan
; set the value cell of zwgc-znol-mode-map (magic!)
; 
; Revision 1.2  91/03/04  22:56:49  bjaspan
; first "real" version
; 
; Revision 1.1  91/02/28  19:28:38  bjaspan
; Initial revision
; 

(defvar zwgc-znol-version
  "$Id: zwgc-znol.el,v 1.12 1996/04/24 10:09:22 bjaspan Exp bjaspan $"
  "The RCS string defining the precise version of emacs zwgc znol.")

(defvar zwgc-znol-buffer-name "*znol*"
  "*Buffer name used for emacs-zwgc znol.")

(defvar zwgc-znol-login-regexp
  "[ 	]*\\([a-z0-9]+\\) logged in.*$
[ 	]*on \\(.+\\) on \\(.+\\).*$
[ 	]*at \\(.+\\).*$"
"*Regexp used to extract USER, HOST, DPY, and DATE from login notices.")

(defvar zwgc-znol-logout-regexp
  "[ 	]*\\([a-z0-9]+\\) logged out.*$
[ 	]*on \\(.+\\) on \\(.+\\).*$
[ 	]*at \\(.+\\).*$"
"*Regexp used to extract USER, HOST, DPY, and DATE from login notices.")

(defvar zwgc-znol-mode-map nil "*Keymap used for the *znol* buffer.")
   
(defvar zwgc-znol-prog "/usr/athena/bin/znol" "*Program to run as znol.")
(defvar zwgc-znol-args nil "*Arguments to pass to znol.")

(defvar zwgc-znol-output-regexp
  "^\\([a-z0-9]+\\): \\([^	]+\\)	\\([^	]+\\)	\\(.*\\)$"
  "Regexp used on znol output to match USER, HOST, DPY, and DATE.")

;;;
;;; Code to run znol and deal with its output.
;;;

(defun zwgc-znol ()
  "This is the main entry point for *znol* with emacs zwgc."
  (interactive)
  ;; Create the *znol* buffer and enter "znol mode".
  (save-excursion
    (set-buffer (get-buffer-create zwgc-znol-buffer-name))
    (setq buffer-read-only nil)
    (delete-region (point-min) (point-max))
    (zwgc-znol-mode)
    (setq buffer-read-only t)
    )
    
  ;; Start znol in the background; zwgc-znol-2 will be called when it exits.
  (let ((buffer (get-buffer-create "  *zwgc-znol-temp*")) status)
    (setq zwgc-znol-process (get-buffer-process buffer))
    (if zwgc-znol-process (setq status (process-status zwgc-znol-process)))
    (save-excursion
      (set-buffer buffer)
      (if (memq status '(run stop))
	  (error "znol process is already running.")
        (if zwgc-znol-process (delete-process zwgc-znol-process))
	(setq zwgc-znol-process
	      (apply 'zwgc-start-process "znol" "  *znol-output-temp*"
		     zwgc-znol-prog zwgc-znol-args))
	(set-process-sentinel zwgc-znol-process 'zwgc-znol-2))
      )))

(defun zwgc-znol-2 (process signal)
  ;; If znol exited normally, handle its output and add the login/out
  ;; cells to zwgc-notice-regexp-alist.
  (let ((buffer (process-buffer process))
	(status (process-status process)))
    (if (not (eq status 'exit))
	(error "znol exited with non-zero status!")

      (save-excursion
	(set-buffer buffer)
	(zwgc-mapline
	 (point-min) (point-max)
	 (function (lambda ()
		     (if (re-search-forward zwgc-znol-output-regexp nil t)
			 (zwgc-znol-login)
		       (error "zwgc-znol-output-regexp failed on %s!"
			      (buffer-substring (point)
						(save-excursion
						  (end-of-line)
						  (point)))
			      ))))))

      (if (zwgc-filter (function (lambda (c) (eq (cdr c) 'zwgc-znol-login)))
		  zwgc-notice-regexp-alist)
	  nil ;; login/logout entries already on the list
	(setq zwgc-notice-regexp-alist
	      (append (list (cons zwgc-znol-login-regexp 'zwgc-znol-login)
			    (cons zwgc-znol-logout-regexp 'zwgc-znol-logout))
		      zwgc-notice-regexp-alist)))

      (kill-buffer buffer)
      )))

;;;
;;; Code to deal with zwgc-znol mode.
;;;

(defun zwgc-znol-mode ()
  "\\<zwgc-znol-mode-map>
Major mode for looking at Zephyr login/logout information.  All
normal editing commands are turned off.  Instead, the following
commands are available:

\\[zwgc-znol-show]		Switch current window to *znol* buffer.
\\[bury-buffer]		Hide the *znol* buffer.
\\[zwgc-znol]		Rescan (actually runs zwgc-znol again).
\\[zwgc-znol-delete]	Deletes an entry from the *znol* buffer."
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'zwgc-znol-mode)
  (setq mode-name "zwgc (znol)")
  (if zwgc-znol-mode-map
      nil
    (define-prefix-command 'zwgc-znol-mode-map)
    (setq zwgc-znol-mode-map (symbol-function 'zwgc-znol-mode-map))
    (suppress-keymap zwgc-znol-mode-map)
    (define-key zwgc-znol-mode-map "s" 'zwgc-znol-show)
    (define-key zwgc-znol-mode-map "q" 'bury-buffer)
    (define-key zwgc-znol-mode-map "\177" 'bury-buffer)
    (define-key zwgc-znol-mode-map "r" 'zwgc-znol)
    (define-key zwgc-znol-mode-map "d" 'zwgc-znol-delete)
    )
  (use-local-map zwgc-znol-mode-map)
  (run-hooks 'zwgc-znol-mode-hook)
  )

;;;
;;; Random mode functions
;;;

(defun zwgc-znol-show ()
  "Selects the *znol* buffer in the current window."
  (interactive)
  (switch-to-buffer (get-buffer zwgc-znol-buffer-name)))

(defun zwgc-znol-delete ()
  "Deletes the current line from the *znol* buffer."
  (interactive)
  (beginning-of-line)
  (let ((p (point))
	(buffer-read-only nil))
    (save-excursion
      (forward-line 1)
      (delete-region p (point))
      )))

;;;
;;; Code to be called by the zwgc-notice-regexp-alist to handle login
;;; and logout notices.
;;;

(defun zwgc-znol-pad-right (string len)
  (format (concat string "%" (int-to-string (- len (length string))) "s")
	  " "))

(defun zwgc-znol-fields-to-strings (user host dpy date)
  ;; Too bad format is broken in version 18..
  (list (format "%s%s%s"
		(zwgc-znol-pad-right (concat user ":") 10)
		(zwgc-znol-pad-right host 22)
		(zwgc-znol-pad-right dpy 15))
	(format "%s%s%s %s"
		(zwgc-znol-pad-right (concat user ":") 10)
		(zwgc-znol-pad-right host 22)
		(zwgc-znol-pad-right dpy 15)
		date))
  )
;;  (list (format "%-9s %-22s %-15s" (concat user ":") host dpy)
;;	(format "%-9s %-22s %-15s %s" (concat user ":") host dpy date)))

(defun zwgc-znol-login (&optional data)
  "Called when a login notice arrives.  Assumes that
zwgc-znol-login-regexp matches USERNAME, HOSTNAME, DISPLAY and DATE by
grouped subexpressions, in that order."
  (let ((lst (zwgc-matched-strings-list)))
    (if (= (length lst) 4)
	(apply 'zwgc-znol-loginout t
	       (apply 'zwgc-znol-fields-to-strings lst))
      (error "zwgc-znol-login-regexp didn't match fields correctly."))
    ))

(defun zwgc-znol-logout (&optional data)
  "Called when a logout notice arrives.  Assumes that
zwgc-znol-logout-regexp matches USERNAME, HOSTNAME, DISPLAY and DATE by
grouped subexpressions, in that order."
  (let ((lst (zwgc-matched-strings-list)))
    (if (= (length lst) 4)
	(apply 'zwgc-znol-loginout nil
	       (apply 'zwgc-znol-fields-to-strings lst))
      (error "zwgc-znol-logout-regexp didn't match fields correctly."))
    ))

(defun zwgc-znol-loginout (login lookfor insrt)
  (save-excursion
    (set-buffer (get-buffer-create zwgc-znol-buffer-name))
    (let ((buffer-read-only nil))
      (goto-char (point-min))
      (save-excursion
	(delete-matching-lines (concat "^" (regexp-quote lookfor))))
      (if login
	  (zwgc-znol-insert-sorted-line (concat insrt "\n")))
      (goto-char (point-min))
      )))

;;; Stuff to insert sorted lines

(defun zwgc-znol-rest-of-line ()
  (let ((p (point)))
    (save-excursion
      (end-of-line)
      (buffer-substring p (point)))))

(defun zwgc-znol-insert-sorted-line (string)
  (goto-char (point-min))
  (while (and (string< (zwgc-znol-rest-of-line) string)
	      (= 0 (forward-line 1))))
  (insert string)
  )