From: "William M. Perry" <wmperry@cherry.ucs.indiana.edu>
Subject: meta-server.el code for netrek junkies out there
Keywords: metaserver emacs ugly-hack
Organization: Indiana University, Bloomington
Date: Tue, 17 Nov 1992 01:24:02 -0500


Fellow netrek junkies,
    I wrote this while pulling an all nighter (playing netrek instead of
doing that graphics homework :).  I thought the x/motif metaserver client
was pretty slow, and I always have at least one emacs window up at all
times, so I figured I would just write it in elisp. :)
    This is what came of it.  Pretty ugly, but it works quite well.
There is a meta-server.doc file in the shell archive, but here are the
basics on how to get going.  
    Put the elisp file (.el) in a directory somewhere and add that
directory to your load-path variable in emacs.
    (setq load-path (append (list (expand-file-name "~/lisp")) load-path))
    or something similar.

   Then set the any variables you want (they are descriped in the .doc
file).  If you have problems connecting to charon.amdahl.com from your
site, try inbound.mail.amdahl.com or 129.212.11.1 as the metaserver-site.
For some reason there are 2 ip #s for charon.
 
   Please feel free to send any suggestions to me @ wmperry@indiana.edu,
and flames/etc to root@`hostname` :)

   This is my first attempt at posting something I wrote to the net,
please be gentle...

-Bill Perry

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  meta-server.el meta-server.doc
# Wrapped by wmperry@cherry on Tue Nov 17 01:20:59 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'meta-server.el' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'meta-server.el'\"
else
echo shar: Extracting \"'meta-server.el'\" \(12316 characters\)
sed "s/^X//" >'meta-server.el' <<'END_OF_FILE'
X;; metaserver-mode.el --- major mode for watching netrek site info
X;; Author: 1992 William M. Perry, Indiana University (wmperry@indiana.edu)
X;; Maintainer: wmperry@indiana.edu
X;; Created: 10/17/92
X;; Version: 1.5b
X;; Last Modified: Thu Nov 12 23:41:40 1992
X;; Keywords: Netrek Metaserver
X
X;; This file is not part of GNU Emacs.
X
X;; This is free software; you can redistribute it and/or modify
X;; it under the terms of the GNU General Public License as published by
X;; the Free Software Foundation; either Version 2, or (at your option)
X;; any later version.
X
X;; This software is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY; without even the implied warranty of
X;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
X;; GNU General Public License for more details.
X
X;; For a copy of the GNU General Public License write to
X;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
X
X(defvar metaserver-use-background nil
X  "*Use the background.el package or not?  Default is nil")
X
X(defvar metaserver-site "charon.amdahl.com"
X  "*What machine is the metaserver on?")
X
X(defvar metaserver-port 3521 "*Which port to query on metaserver")
X
X(defvar metaserver-trailing-headers ".*That's.*"
X  "String that comes at the end of the metaserver output")
X
X(defvar metaserver-netrek-binary "netrek_udp" 
X  "*Normal netrek client to run when in non-borg mode.")
X
X(defvar metaserver-use-borg nil "*Use borg or not?")
X(defvar metaserver-ping-program "/usr/etc/ping -s" "*Ping Program.")
X(defvar metaserver-ping-packets 10 "*# of pings to send to a server.")
X(defvar metaserver-ping-sizeof 65 "*Size of packets to send a server.")
X(defvar metaserver-list-all nil "*List every server, open or not.")
X
X(defvar metaserver-borg-binary "sunborg3"
X  "*Borg netrek client to run when in borg mode.")
X
X(defvar metaserver-headers-kill-to "^-h *"
X  "*Denotes last line of metaserver headers.")
X
X(defvar metaserver-empty-site-regexp "Not Responding\\|Nobody"
X  "*Regular expression that matches empty sites.")
X
X(defvar metaserver-data-regexp "-h \\([^ ]*\\) *-p \\([^ ]*\\)\\(.*\\)"
X  "*Parenthesized regular expression where the first parenthesized regexp
Xmatches the host, the second matches the port, and the third matches any
Xdata to be kept in the MetaServer buffer.")
X
X(defvar metaserver-site-order "descending"
X  "*How to sort the open sites....  can be \"ascending\" or \"descending\".
XAscending means put sites with wait queues at the bottom of the list.")
X
X(defvar metaserver-brief-description
X  "- B Toggle Borg Status - L Toggle List All - R Refresh - RETURN Run Netrek"
X  "One line description of key bindings, etc.")
X
X(defvar metaserver-mode-map () "mode map used in metaserver-mode")
X
X(if metaserver-use-background
X    (load "background" nil t))
X
X
X(if metaserver-mode-map ()
X  (setq metaserver-mode-map (make-sparse-keymap)))
X
X(define-key metaserver-mode-map "b"     'metaserver-toggle-borg)
X(define-key metaserver-mode-map "B"     'metaserver-toggle-borg)
X(define-key metaserver-mode-map "n"     'next-line)
X(define-key metaserver-mode-map "p"     'previous-line)
X(define-key metaserver-mode-map "P"     'metaserver-ping)
X(define-key metaserver-mode-map "q"     'metaserver-quit)
X(define-key metaserver-mode-map "Q"     'metaserver-quit)
X(define-key metaserver-mode-map "l"     'metaserver-toggle-list)
X(define-key metaserver-mode-map "L"     'metaserver-toggle-list)
X(define-key metaserver-mode-map "r"     'metaserver-refresh)
X(define-key metaserver-mode-map "R"     'metaserver-refresh)
X(define-key metaserver-mode-map " "     'scroll-up)
X(define-key metaserver-mode-map "\C-?"  'scroll-down)
X(define-key metaserver-mode-map "\C-m"  'metaserver-run-netrek)
X(define-key metaserver-mode-map "?"     'metaserver-describe-briefly)
X(define-key metaserver-mode-map "h"     'metaserver-describe-briefly)
X
X(defun flip-list (thelist)
X  (interactive)
X  (if (cdr thelist)
X      (append (flip-list (cdr thelist)) (list (car thelist)))
X    (list (car thelist))))
X
X(defun metaserver-toggle-list ()
X  "Toggles whether to list all the servers and updates mode line accordingly."
X  (interactive)
X  (if buffer-read-only (toggle-read-only))
X  (setq metaserver-list-all (not metaserver-list-all))
X  (metaserver-update-mode-line)
X  (if (not metaserver-list-all)
X      (save-excursion
X	(goto-char (point-min))
X	(delete-matching-lines metaserver-empty-site-regexp))
X    (save-excursion
X      (goto-char (point-max))
X      (if (equal metaserver-site-order "descending")
X	  (metaserver-insert-list (flip-list metaserver-empty-list))
X	(metaserver-insert-list metaserver-empty-list))))
X  (if (not buffer-read-only) (toggle-read-only)))
X
X(defun metaserver-describe-briefly ()
X  "Describe briefly the keys used in metaserver-mode."
X  (interactive)
X  (message metaserver-brief-description))
X
X(defun metaserver-toggle-borg ()
X  "Toggles whether to use the borg binary or the netrek binary.  Updates the
Xmode line accordingly."
X  (interactive)
X  (setq metaserver-use-borg (not metaserver-use-borg))
X  (setq mode-line-process (if metaserver-use-borg "-Borg" ""))
X  (metaserver-update-mode-line))
X
X;;; Update the mode line to show flags of borg-use and list-all
X(defun metaserver-update-mode-line ()
X  "Change mode-line to include -Borg and/or -All if appropriate, and force an
Xupdate."
X  (setq mode-line-process 
X	(concat (if metaserver-use-borg "-Borg" "")
X		(if metaserver-list-all "-All" "")))
X  (set-buffer-modified-p nil))
X
X(defun metaserver-mode ()
X"   This is a major mode for viewing active netrek servers.  A list of active
Xservers is put in a buffer, displaying wait queue status, and time the server
Xwas last checked.
X
X    User modifiable variables are:
X      metaserver-netrek-binary: Normal netrek client binary
X        metaserver-borg-binary: Borg netrek client binary
X  metaserver-empty-site-regexp: Regular expression that matches empty sites
X    metaserver-headers-kill-to: Regular expression that matches last line of
X                                the metaserver headers.
X       metaserver-ping-program: Program to use to ping servers
X       metaserver-ping-packets: # of packets to send to server when pinging
X        metaserver-ping-sizeof: Size in bytes of packets sent during a ping
X           metaserver-list-all: Show all servers or just open ones?
X           metaserver-use-borg: Run normal client or borg client?
X         metaserver-site-order: Ascending or descending order when
X                                printing sites?  
X               metaserver-site: Home of the metaserver
X               metaserver-port: Port of the metaserver"
X  (interactive)
X  (kill-all-local-variables)
X  (use-local-map metaserver-mode-map)
X  (setq major-mode 'metaserver-mode)
X  (setq mode-name "MetaServer")
X  (metaserver-update-mode-line))
X
X;;; Get the millisecond seek time to the server
X(defun metaserver-ping ()
X  (interactive)
X  (save-excursion
X    (save-window-excursion
X      (let* ((tmp (grab-current-line))
X	     (server (substring tmp 0 (string-match " " tmp))))
X	(message "Pinging %s..." server)
X	(shell-command (concat metaserver-ping-program " "
X			       server " "
X			       (int-to-string metaserver-ping-sizeof) " "
X			       (int-to-string metaserver-ping-packets)))
X	(let ((ping-str (progn (set-buffer "*Shell Command Output*")
X			       (buffer-string)))
X	      (ping-regexp (concat ".*packets transmitted, "
X				   ".* packets received, \\(.*\\)\\\n"
X				   "round-trip (ms) \\(.*\\)")))
X	  (kill-buffer "*Shell Command Output*")
X	  (if (string-match ping-regexp ping-str)
X	      (message "%s:%s"
X		       (substring ping-str (match-beginning 1) (match-end 1))
X		       (substring ping-str (match-beginning 2) (match-end 2)))
X	    (message "%s is not responding..." server)))))))
X
X(defun metaserver-insert-headers ()
X  "Insert headers in metaserver buffer.... makes it easier to read."
X  (erase-buffer)
X  (insert (format "%53s\n%-40s%35s\n" "Mins" "Site"
X		  "Ago   Status        Flags"))
X  (while (< (current-column) 79) (insert "-"))
X  (insert "\n"))
X
X(defun metaserver-insert-list (thelist)
X  "Insert a list of (server . port . data) into the buffer"
X  (let* ((tmp thelist))
X    (while tmp
X      (let* ((site (car (car tmp)))
X	     (data (car (cdr (cdr (car tmp))))))
X	(insert (format "%-40s%39s\n" site data)))
X      (setq tmp (cdr tmp)))))
X
X(defun metaserver-filter (proc string)
X  "Filter for the stream to the metaserver.  Calls parser when appropriate."
X  (setq metaserver-server-output (concat metaserver-server-output string))
X  (if (string-match metaserver-trailing-headers string) (metaserver-parser)))
X
X(defun metaserver-parser ()
X  "Parses out the metaserver string into a list.  Constructs buffer."
X  (setq metaserver-server-output (substring 
X		     metaserver-server-output
X		     (string-match metaserver-headers-kill-to
X				   metaserver-server-output)
X		     nil))
X  (setq metaserver-server-output 
X	(substring metaserver-server-output
X		   0 (1- (string-match metaserver-trailing-headers 
X				       metaserver-server-output))))
X  (while (not (equal "" metaserver-server-output))
X    (let* ((tmp (substring metaserver-server-output 
X			   0 (string-match "$" metaserver-server-output))))
X      (setq metaserver-server-output 
X	    (substring metaserver-server-output
X		       (1+ (string-match "$" metaserver-server-output))
X				   nil))
X      (string-match metaserver-data-regexp tmp)
X      (let* ((site (substring tmp (match-beginning 1) (match-end 1)))
X	     (port (string-to-int 
X		    (substring tmp (match-beginning 2) (match-end 2))))
X	     (data (substring tmp (match-beginning 3) (match-end 3))))
X	(if (not (string-match metaserver-empty-site-regexp data))
X	    (setq metaserver-open-list
X		  (append (cons (cons site (cons port (cons data '()))) '())
X			  metaserver-open-list))
X	  (setq metaserver-empty-list
X		(append (cons (cons site (cons port (cons data '()))) '())
X			metaserver-empty-list))))))
X  (save-excursion
X    (switch-to-buffer "*MetaServer*")
X    (goto-char (point-min))
X    (metaserver-insert-headers)
X    (if (equal "descending" metaserver-site-order)
X	(metaserver-insert-list (flip-list metaserver-open-list))
X      (metaserver-insert-list metaserver-open-list))
X    (if metaserver-list-all 
X	(if (equal "descending" metaserver-site-order)
X	    (metaserver-insert-list (flip-list metaserver-empty-list))
X	  (metaserver-insert-list metaserver-empty-list)))
X    (message "")
X    (if (not buffer-read-only) (toggle-read-only))))
X	  
X(defun metaserver-refresh ()
X  "Start the metaserver.  Get site info, put in buffer, etc, etc."
X  (interactive)
X  (message "Calling metaserver at %s %d..." metaserver-site metaserver-port)
X  (switch-to-buffer "*MetaServer*")
X  (metaserver-mode)
X  (if buffer-read-only (toggle-read-only))
X  (erase-buffer)
X  (setq metaserver-server-output nil
X	metaserver-empty-list nil
X	metaserver-open-list nil)
X  (set-process-filter
X   (open-network-stream "metaserver" nil metaserver-site metaserver-port)
X   'metaserver-filter))
X
X(defun metaserver-quit ()
X  (interactive)
X  (kill-buffer "*MetaServer*"))
X
X(defun metaserver-run-netrek ()
X  "Run a netrek client in the background."
X  (interactive)
X  (if (and metaserver-use-background (not (boundp 'background)))
X      (load "background" nil t))
X  (if (not (getenv "DISPLAY"))
X      (message "DISPLAY variable not set... must use Xwindows to play netrek!")
X    (save-excursion
X      (let* ((tmp (buffer-substring (progn (beginning-of-line) (point))
X				    (progn (end-of-line) (point))))
X	     (site (substring tmp 0 (string-match " " tmp)))
X	     (port 2592)
X	     (tmplist (if metaserver-list-all
X			  (append metaserver-open-list metaserver-empty-list)
X			metaserver-open-list)))
X	(while tmplist
X	  (let* ((current-site (car (car tmplist)))
X		 (current-port (car (cdr (car tmplist)))))
X	    (if (equal current-site site)
X		(let* ((the-command (concat (if metaserver-use-borg
X						metaserver-borg-binary
X					      metaserver-netrek-binary)
X					    " -h " site " -p "
X					    (int-to-string port))))
X		  (if metaserver-use-background
X		      (background the-command)
X		    (start-process "netrek" nil shell-file-name "-c" 
X				    (message the-command)))
X		  (setq tmplist nil))
X	      (setq tmplist (cdr tmplist)))))))))
X  
X(defun grab-current-line ()
X  (buffer-substring (progn (beginning-of-line) (point))
X		    (progn (end-of-line) (point))))
END_OF_FILE
if test 12316 -ne `wc -c <'meta-server.el'`; then
    echo shar: \"'meta-server.el'\" unpacked with wrong size!
fi
# end of 'meta-server.el'
fi
if test -f 'meta-server.doc' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'meta-server.doc'\"
else
echo shar: Extracting \"'meta-server.doc'\" \(4871 characters\)
sed "s/^X//" >'meta-server.doc' <<'END_OF_FILE'
X			     METASERVER MODE v1.5b
X				      BY
X			     WILLIAM MICHAEL PERRY
X			     (wmperry@indiana.edu)
X			       November 14, 1992
X
X-------------------------------------------------------------------------------
XThis is an elisp package to interface with the netrek metaserver-II.
XIt will put a list of all active servers in a buffer.  Listing the #
Xof player slots open and the last time a server was checked by the
Xmetaserver.
X
XThe following keys are defined in metaserver-mode:
Xh/? metaserver-describe-briefly: show (very) incomplete list of key functions
X
Xb/B metaserver-toggle-borg: toggles whether to use the client
X                            specified by borg-binary or the normal
X                            netrek-binary.  Mode-name changes to
X                            Metaserver-Borg when borg option is
X                            active.
X
Xl/L metaserver-toggle-list: toggles whether to list all the netrek
X                            servers or just ones with active games.
X                            Mode-name changes to Metaserver-All when
X                            listing all sites.
X
X  P        metaserver-ping: pings the specified server.  Status of the
X                            ping is flashed in the minibuffer.
X
Xq/Q        quit-metaserver: exit metaserver-mode, killing buffer
X
Xr/R refresh-metaserver: update list from the metaserver.  Call
X                        this function to start the metaserver.
Xn            next-line: go to next line
Xp        previous-line: go to previous line
X                 Space: Scroll down thru list of sites
X                Delete: Scroll back up thru list of sites
X                Return: Run xtrek client on specified server.
X
X-------------------------------------------------------------------------------
XCustomizable variables:
Xmetaserver-use-background:
X    Should the program use the background.el package or spawn
X    processes on its own?  Default is to spawn on its own.  (This
X    doesn't notify you if a connection is refused or a server is down
X    though) 
X
Xmetaserver-use-borg:
X    Should the borg client be used?  Defaults to nil
X
Xmetaserver-list-all:
X    List all servers, or just the ones with active games?  Defaults to nil.
X
Xmetaserver-ping-program:
X    Program to use to ping servers.  Defaults to "/usr/etc/ping -s".
X
Xmetaserver-ping-packets:
X    # of packets to send when pinging.  Defaults to 5.
X
Xmetaserver-ping-sizeof:
X    Size in bytes of each packet to send when pinging.  Defaults to 64.
X
Xmetaserver-site: 
X    Host where the metaserver lives.  Defaults to "charon.amdahl.com"
X
Xmetaserver-port: 
X    Port to query.  Defaults to 3521.
X
Xmetaserver-borg-binary:
X    Client to run when using a borg.  Defaults to "sunborg3.sun"
X
Xnetaserver-netrek-binary:
X    The "normal" netrek client.  Defaults to "netrek_udp"
X
Xmetaserver-empty-site-regexp: 
X    Regular expression that matches empty sites.  Defaults to metaserver-II
X    type messages.  
X
Xmetaserver-headers-kill-to:
X    Regular expression that matches last line of header info from the
X    metaserver. 
X
Xmetaserver-data-regexp:
X    Parenthesized regular expression whose first set of parentheses matches the
X    netrek site, the second matches the port #, and the third matches any data
X    to be printed in the buffer.
X
X-------------------------------------------------------------------------------
XChanges since V1.2b:
X* Added metaserver-site-order to allow customization of ordering of servers in
X  the buffer.
X
X* Changed ping to include min/avg/max round-trip packet time.
X
X* Changed run-netrek to use either background or spawn its own processes.
X-------------------------------------------------------------------------------
XChanges since V1.0:
X* Basically a complete rewrite... only variables and function names stayed
X  the same
X
X* Doesn't kill its old buffer anymore.  I got the hang of process filters. :)
X
X* Does not need to call the metaserver to list all servers.  Keeps 2 lists -
X  one for empty servers and one for open servers.  Just insert the lists into
X  a buffer and you are set.
X
X* Can now support metaserver-I with some regular expression hacking.
X  Example: metaserver-empty-site-regexp = "Couldn't\\| 0 Players"
X           metaserver-data-regexp = "^\\([^(]*\\)((\\([^)]*\\)) *:\\(.*\\)"
X           metaserver-port = 3520 <- For charon.amdahl.com
X           metaserver-headers-kill-to = "^.*([0-9]*).*"
X  This works, but the formatting is a little screwy, I'd just stick with
X  metaserver-II.  If not, modify the (format XXXXX) call in the
X  metaserver-insert-list function.
X
X* No longer time stamps the buffer... if it matters, you can put it in by
X  adding a line in metaserver-insert-headers to insert the time (format it
X  as you see fit. :)
X
X* Fine tuning, but I think I made the code uglier :)
X
XThat does it!
XEnjoy!
X
X-Bill Perry | wmperry@ucs.indiana.edu | Commander Arioch | Captain Elric
X
X
X
X
END_OF_FILE
if test 4871 -ne `wc -c <'meta-server.doc'`; then
    echo shar: \"'meta-server.doc'\" unpacked with wrong size!
fi
# end of 'meta-server.doc'
fi
echo shar: End of shell archive.
exit 0
-- 
William M. Perry          / 'When you know a thing, to hold that you know it;
wmperry@ucs.indiana.edu  / and when you do not know a thing, to allow that you
Phone: (812) 336 - 3071 / do not know it; this is knowledge.' - Confucius
Newsgroups: gnu.emacs.sources