;;; znol.el by Raul J. Acevedo. 
;;;
;;; Runs znol in emacs.
;;;
;;; Allows you to specify the output format, in terms of how each user
;;; is displayed in the znol buffer, and allowing you to put different
;;; users under different sections.  (For example, you can have a
;;; "Friends" section, a "Idiots" section :-), etc.)  From the znol
;;; buffer, you can finger a user's workstation, or try zlocating that
;;; user.  Two functions, `znol-add-user' and `znol-remove-user' can be
;;; used with any zwgc.el mode so that when someone logs in/out, they
;;; will be automatically added/removed from the znol buffer.
;;; Full documentation available in /mit/acevedo/Emacs/Doc/znol.doc.

(require 'toolbox "/afs/athena/contrib/consult/lib/elisp/toolbox")
(require 'defstruct "/afs/athena/contrib/consult/lib/elisp/defstruct")
(provide 'znol)

;(autoload 'zwrite-personal
;	  "/afs/athena/user/a/acevedo/Emacs/zwrite"
;	  "Emacs Zwrite" t)

;(defvar znol-zwrite-function 'zwrite-personal
;  "*Function to call when zwriting to a user.")

(defvar znol-path "/usr/athena/bin/znol"
  "*Pathname of the znol program.")

(defvar znol-zlocate-path "/usr/athena/bin/zlocate"
  "*Pathname of zlocate.")

(defvar znol-default-args nil
  "*Default list of arguments given to znol.")

(defvar znol-default-section "Znol"
  "*Name of default section to put users in.")

(defvar znol-format-user-function 'znol-default-format-user
  "*The function to format how a user is displayed in the znol buffer.
Takes one argument, a `znol-user' struct. The string returned should
contain only one newline, at the end of the string.")

(defvar znol-buffer "*znol*"
  "*The name of the znol buffer.")

(defvar znol-temp-buffer " *znol temp*"
  "*The name of the znol temporary buffer.")

;(defvar znol-hide-empty-sections t
;  "*t if Znol should not show any sections which are empty.")

(defvar znol-user-alist nil
  "*The alist of znol users.  This list is used to determine the
nicknames of users, and under what section they are put in the znol
buffer. It has no effect whatsoever on which users are checked when
you do M-x znol.

Each element of the list is as follows:

	(USERNAME SECTION NICKNAME)

(all strings). USERNAME is the username, SECTION is the name of the
section under which that user should be placed, and NICKNAME is the
nickname for that user.")

(defvar znol-users nil
  "Internal alist of znol users.")

(defvar znol-file "~/.anyone"
  "The file containing the usernames of the users to use with znol.")
(setq znol-file (expand-file-name znol-file))

(defvar znol-retry-interval 300
  "*The number of seconds between znol retries.")

(defvar znol-load-hook nil
  "*Hook run after the `znol.el' file has been loaded.

This is useful to, for example, load a file which sets `znol-user-alist'
only when `znol' is actually used.")

(defvar znol-updating-p nil
  "t if the Znol buffer is updating.")

(defvar znol-background nil)

(DEFSTRUCT znol-user
  nickname
  username
  machine
  time
  other)

(defvar znol-mode-map nil
  "*Keymap for Znol mode.")

(Unless znol-mode-map
  (setq znol-mode-map (make-keymap))
  (suppress-keymap znol-mode-map)
  (define-key znol-mode-map "n" 'znol-next-user)
  (define-key znol-mode-map "p" 'znol-previous-user)
  (define-key znol-mode-map " " 'znol-next-section)
  (define-key znol-mode-map "\177" 'znol-previous-section)
  (define-key znol-mode-map "," 'znol-first-user)
  (define-key znol-mode-map "." 'znol-last-user)
  (define-key znol-mode-map "b" 'bury-buffer)
  (define-key znol-mode-map "u" 'znol)
  (define-key znol-mode-map "f" 'znol-finger)
  (define-key znol-mode-map "z" 'znol-zlocate)
  (define-key znol-mode-map "Z" 'znol-zwrite)
  (define-key znol-mode-map "q" 'remove-window))

(defun znol-mode ()
  "Major mode for Znol.
\\{znol-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (setq mode-name "Znol"
	major-mode 'znol-mode
	buffer-read-only t)
  (use-local-map znol-mode-map)
  (run-hooks 'znol-mode-hook))

(defun znol-initialize-buffer ()
  (znol-mode)
  (let ((buffer-read-only nil))
    (erase-buffer)
    (if znol-user-alist
	(progn
	  (setq znol-users (nreverse (znol-get-sections znol-user-alist)))
	  (Unless (assoc znol-default-section znol-users)
	    (nconc znol-users (ncons (ncons znol-default-section)))))
	(setq znol-users (ncons (ncons znol-default-section))))
    (Unless znol-hide-empty-sections
      (znol-insert-sections znol-users))
    (goto-char (point-min))))

(defun znol-get-sections (alist)
  (let (result section)
    (while alist
      (setq section (second (Pop alist)))
      (Unless (assoc section result)
	(Push (ncons section) result)))
    result))

(defun znol-get-user-section (username)
  "Get the section for user with username USERNAME by looking up 
USERNAME in `znol-users-alist'. Returns `nil' if not found."
  (second (assoc username znol-user-alist)))

(defun znol-get-user-nickname (username)
  "Get the nickname for user with username USERNAME by looking up 
USERNAME in `znol-users-alist'. Returns `nil' if not found."
  (third (assoc username znol-user-alist)))

(defun znol (&optional args background)
  "Runs znol in Emacs.
With prefix argument, prompts for arguments to znol.
If `znol-retry-interval' is a number, then that many seconds later, `znol'
is run automatically (and silently) again."
  (interactive
   (if current-prefix-arg
       (ncons (ncons (split-string (read-from-minibuffer "Arguments to znol: "))))))
  (if (or args (eq major-mode 'znol-mode) 
	  background
	  (not (get-buffer znol-buffer)))
      (save-excursion
	(When (get-buffer znol-buffer)
	  (set-buffer znol-buffer)
	  (setq buffer-read-only nil
		znol-updating-p t)
	  (erase-buffer)
	  (insert "\n... Updating Buffer ...")
	  (center-line)
	  (insert "\n\n"))
	(set-buffer (get-buffer-create znol-temp-buffer))
	(erase-buffer)
	(setq znol-background background)
	(set-process-sentinel
	 (let ((process-connection-type nil))
	   (apply 'start-process
		  "znol" (get-buffer-create znol-buffer) znol-path
		  (append (list "-f" znol-file) znol-default-args args)))
	 'znol-sentinel)
	(set-process-filter (get-process "znol") 'znol-filter)
	(set-marker (process-mark (get-process "znol")) 1 (get-buffer znol-buffer))
	(Unless background
	  (message "Zlocating users...")))
      (pop-to-buffer znol-buffer)))

(defun znol-filter (process output)
  (let ((buffer znol-temp-buffer))
    (save-excursion
      (set-buffer buffer)
      (goto-char (process-mark process))
      (insert output)
      (set-marker (process-mark process) (point)))))

(defun znol-sentinel (process status)
  (setq znol-proc (cons process status))
  (cond ((or (eq 'signal (process-status process))
	     (and (eq 'exit (process-status process))
		  (/= 0 (process-exit-status process))))
	 (pop-to-buffer (process-buffer process))
	 (goto-char (point-max))
	 (insert status)
	 (error "Znol process exited abnormally!"))
	((not (eq 'exit (process-status process))))
	((= 0 (process-exit-status process))
	 (setq znol-updating-p nil)
	 (znol-format-buffer znol-temp-buffer)
	 (When (numberp znol-retry-interval)
	   (When (get-process "znol-sleep")
	     (delete-process "znol-sleep"))
	   (set-process-sentinel
	    (start-process "znol-sleep" znol-buffer "/usr/bin/sleep"
			   (int-to-string znol-retry-interval))
	    'znol-sleep-sentinel)
	   (set-process-filter (get-process "znol-sleep") 'znol-sleep-filter))
	 (Unless znol-background
	   (if (get-buffer-window znol-buffer)
	       (message "Znol finished.")
	       (progn
		 (beep t)
		 (message "(Znol: Finished zlocating users.)")))))))

(defun znol-sleep-filter (process output))

(defun znol-sleep-sentinel (process status)
  (When (eq 'exit (process-status process))
    (znol nil 'background)))

(defun znol-format-buffer (buffer)
  (let (user)
    (save-excursion
      (When (get-buffer znol-buffer)
	(set-buffer znol-buffer)
	(znol-initialize-buffer))
      (set-buffer buffer)
      (goto-char (point-min))
      (while (looking-at "^\\([^:]+\\): \\([^ \t]+\\)[ \t]+[^ \t]+[ \t]+\\(.*\\)$")
	(setq user (make-znol-user (znol-get-user-nickname (buffer-match-string 1))
				   (buffer-match-string 1)
				   (buffer-match-string 2)
				   (buffer-match-string 3)
				   nil))
	(znol-add-user user)
	(forward-line 1)))
    (place-point znol-buffer 'znol-first-user)))

(defun znol-add-user (user &optional section)
  "Adds znol-user USER to the znol buffer, under section &optional SECTION.
If SECTION is not given as an argument, uses `znol-get-user-section' to get 
the section for USER; if it returns `nil', `znol-default-section' is used."
  (Unless znol-updating-p
    (save-excursion
      (set-buffer (get-buffer-create znol-buffer))
      (Unless section (setq section (or (znol-get-user-section (znol-user-username user))
					znol-default-section)))
      (save-excursion
	(Unless (eq major-mode 'znol-mode)
	  (znol-initialize-buffer))
	(let ((buffer-read-only nil)
	      (line (znol-insert-user user section znol-users)))
	  (When line
	    (znol-assert-section section)
	    (znol-jump-to-section section)
	    (goto-line (+ (current-line) line))
	    (insert (funcall znol-format-user-function user))))))))

(defun znol-assert-section (section)
  (goto-char (point-min))
  (Unless (re-search-forward (format "^[ \t]+%s\n\n" section)
			     (point-max) t)
    (let ((users (reverse znol-users))
	  next-section)
      (while (not (equal (car (car users)) section))
	(When (cdr (car users))
	  (setq next-section (car (car users))))
	(setq users (cdr users)))
      (goto-char (point-max))
      (When next-section
	(re-search-backward (format "^[ \t]+%s\n\n" next-section)))
      (znol-insert-section section))))

(defun znol-jump-to-section (section)
  (goto-char (point-min))
  (re-search-forward (format "^[ \t]+%s\n\n" section)))

(defun znol-remove-user (username machine)
  "Removes user with USERNAME logged into MACHINE from znol buffer."
  (Unless znol-updating-p
    (save-excursion
      (set-buffer (get-buffer-create znol-buffer))
      (let ((buffer-read-only nil)
	    line)
	(save-excursion
	  (if (eq major-mode 'znol-mode)
	      (let ((result (znol-delete-user username machine znol-users)))
		(while result
		  (znol-jump-to-section (car (car result)))
		  (goto-line (+ (current-line) (cdr (car result))))
		  (delete-region (point) (progn (end-of-line) (1+ (point))))
		  (and znol-hide-empty-sections
		       (not (cdr (assoc (car (car result)) znol-users)))
		       (znol-flush-section (car (car result))))
		  (setq result (cdr result))))
	      (znol-initialize-buffer)))))))

(defun znol-flush-section (section)
  (goto-char (point-min))
  (re-search-forward (format "^[ \t]+%s\n+" section))
  (replace-match ""))

(defun znol-delete-user (username machine users)
  (let (found-it list result count)
    (setq machine (downcase machine))
    (while users
      (setq found-it nil
	    count 0)
      (When (setq list (car users))
	(while (and (cdr list)
		    (not (setq found-it
			       (and (equal username (znol-user-username (second list)))
				    (equal machine (downcase (znol-user-machine (second list))))))))
	  (setq count (1+ count)
		list (cdr list)))
	(setcdr list (cdr (cdr list))))
      (When found-it
	(Push (cons (car (car users)) count) result))
      (setq users (cdr users)))
    result))

(defun znol-insert-sections (sections)
  (erase-buffer)
  (while sections
    (znol-insert-section (car (Pop sections))))
  (goto-char (point-max)))

(defun znol-insert-section (section)
  (insert section "\n")
  (forward-line -1)
  (end-of-line)
  (center-line)
  (insert "\n\n\n"))

(defun znol-insert-user (user section users)
  (let ((count 0)
	(list (assoc section users))
	(username (znol-user-username user))
	(machine (downcase (znol-user-machine user)))
	stop)
    (if list
	(progn
	  (while (and (cdr list)
		      (not (or (setq stop (and (string< username (znol-user-username (second list)))
					       'insert))
			       (setq stop (and (equal username (znol-user-username (second list)))
					       (equal machine (downcase (znol-user-machine (second list))))
					       'no-insert)))))
	    (setq count (1+ count)
		  list (cdr list)))
	  (Unless (eq stop 'no-insert)
	    (setcdr list (cons user (cdr list)))
	    count))
	(progn
	  (setcdr (cdr (assoc section users)) (ncons user))
	  0))))

(defun znol-default-format-user (user)
  "Default formatting function. Takes one argument, USER. 
Should return a string with only one newline, at the end of the string."
  (format "%s\t%s\t%s\t%s\n"
	  (pad-right (or (znol-user-nickname user)
			 (znol-user-username user))
		     20)
	  (pad-right (znol-user-username user) 8)
	  (pad-right (znol-user-machine user) 20)
	  (pad-right (znol-user-time user) 25)))

(defun znol-next-user ()
  "Move to the next znol user."
  (interactive)
  (if (re-search-forward "\n[^ \t\n]+" (point-max) t)
      (beginning-of-line)
      (znol-first-user)))

(defun znol-previous-user ()
  "Move to the previous znol user."
  (interactive)
  (Unless (re-search-backward "^[^ \t\n]+" (point-min) t)
    (znol-last-user)))

(defun znol-first-user ()
  "Move to the first user in the znol buffer."
  (interactive)
  (goto-line 3))

(defun znol-last-user ()
  "Move to the last user in the znol buffer."
  (interactive)
  (goto-char (point-max))
  (Unless (re-search-backward "^[^ \t\n]+" (point-min) t)
    (znol-first-user)))

(defun znol-next-section ()
  "Move to the next znol section."
  (interactive)
  (if (re-search-forward "\n[ \t]+.*\n\n[^ \t\n]+" (point-max) t)
      (beginning-of-line)
      (znol-first-user)))

(defun znol-previous-section ()
  "Move to the previous znol section."
  (interactive)
  (if (re-search-backward "^[ \t]+.*\n\n[^ \t\n]+" (point-min) t)
      (forward-line 2)
      (progn
	(goto-char (point-max))
	(re-search-backward "^[ \t]+.*\n\n")
	(forward-line 2))))

(defun znol-current-user ()
  (let ((count 0))
    (save-excursion
      (beginning-of-line)
      (while (looking-at "^[^ \t\n]+")
	(forward-line -1)
	(setq count (1+ count))))
    (Unless (zerop count)
      (nth (1- count) (cdr (assoc (znol-current-section) znol-users))))))

(defun znol-current-section ()
  (save-excursion
    (if (re-search-backward "^[ \t]+\\(.*\\)\n\n" (point-min) t)
	(buffer-match-string 1)
	(car (car znol-users)))))

(defun znol-finger ()
  "Finger the current znol user at his/her machine."
  (interactive)
  (let ((user (znol-current-user)))
    (if user
	(let* ((username (znol-user-username user))
	       (machine (znol-user-machine user))
	       (buffer (format "*finger %s@%s*" username machine)))
	  (save-excursion 
	    (set-buffer (get-buffer-create buffer))
	    (erase-buffer)
	    (message "Fingering %s@%s..." username machine)
	    (set-process-sentinel
	     (start-process "znol-finger" (current-buffer) "/usr/ucb/finger"
			    (concat "@" machine))
	     'znol-finger-sentinel)))
	(error "Not on a line with a user!"))))

(defun znol-finger-sentinel (process status)
  (save-window-excursion
    (pop-to-buffer (process-buffer process))
    (goto-char (point-min))
    (silent-replace-string "\r" "")
    (goto-char (point-min))
    (bury-buffer (current-buffer))
    (momentary-string-display "" (point))))

(defun znol-get-user (username)
  (let ((sections znol-users)
	list result)
    (while sections
      (setq list (cdr (Pop sections)))
      (while list
	(When (equal username (znol-user-username (car list)))
	  (Push (car list) result))
	(Pop list)))
    result))

(defun znol-remove-locations (username)
  (let ((locations (znol-get-user username)))
    (while locations
      (znol-remove-user (znol-user-username (car locations))
			(znol-user-machine (car locations)))
      (Pop locations))))

(defun znol-zlocate (username)
  "Zlocate the current znol user; with prefix arg, prompts for username.
The znol buffer is updated from the results of the zlocate."
  (interactive
   (ncons (if current-prefix-arg
	      (read-from-minibuffer "Zlocate user: ")
	      (znol-user-username (znol-current-user)))))
  (if username
      (save-excursion
	(set-buffer (get-buffer-create (format "*zlocate %s*" username)))
	(erase-buffer)
	(make-local-variable 'znol-username)
	(setq znol-username username)
	(message "Zlocating %s..." username)
	(set-process-sentinel
	 (start-process "znol-zlocate" (current-buffer) znol-zlocate-path
			username)
	 'znol-zlocate-sentinel))
      (error "Not on a line with a user!")))

(defun znol-zlocate-sentinel (process status)
  (save-window-excursion
    (pop-to-buffer (process-buffer process))
    (goto-char (point-min))
    (cond ((looking-at "Hidden or not logged-in")
	   (znol-remove-locations znol-username))
	  ((eq 'exit (process-status process))
	   (znol-remove-locations znol-username)
	   (while (looking-at "\\([^ ]+\\)[ \t]+[^ \t]+[ \t]+\\(.*\\)$")
	     (setq user (make-znol-user (znol-get-user-nickname znol-username)
					znol-username
					(buffer-match-string 1)
					(buffer-match-string 2)
					nil))
	     (znol-add-user user)
	     (forward-line 1))
	   (goto-char (point-min))))
    (bury-buffer (current-buffer))
    (momentary-string-display "" (point))))

(defun znol-zwrite (username)
  (interactive
   (ncons
    (if current-prefix-arg
	(read-from-minibuffer "Zwrite to user: ")
	(znol-user-username (znol-current-user)))))
  (funcall znol-zwrite-function username))

(run-hooks 'znol-load-hook)