NetNews Usenet Archive 1992 #16/NN_1992_16.iso/spool/gnu/emacs/sources/545

Text File | 1992-07-21 | 29.3 KB | 895 lines

Newsgroups: gnu.emacs.sources
Path: sparky!uunet!europa.asd.contel.com!darwin.sura.net!udel!rochester!cantaloupe.srv.cs.cmu.edu!crabapple.srv.cs.cmu.edu!spot
From: [e-mail] (Scott Draves)
Subject: new zephyr.el
Message-ID: <[e-mail]>
Date: Wed, 22 Jul 92 01:33:54 GMT
Organization: School of Computer Science, Carnegie Mellon University
Nntp-Posting-Host: cobol.fox.cs.cmu.edu
Distribution: gnu
Originator: [e-mail]
Lines: 882

;;; zephyr.el  an interface to the zephyr message system
;;; Copyright (C) 1992 Scott Draves ([e-mail])
;;;
;;; 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 2 of the License, 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.



;;; send and receive zephyrgrams with a convenient and flexible
;;; interface.  some people say the interface feels like IRC.
;;; here's a quick feature list:
;;;    asynchronously send and receive messages from a single buffer
;;;    handles instances, multiple destinations
;;;    aliases (can translate one name to many)
;;;    "lazy" beep for notification
;;;    sender/receiver history
;;;    filter messages based on sender and/or instance
;;;    multiple buffers, each with different filters
;;;    highly customizeable
;;;
;;; there's some support for encrypted instances, but it no longer
;;; works.  to use, copy the following lines into your .emacs:
;;;
;;;  (load-library "zephyr")
;;;  (zephyr-new-buffer)
;;;
;;; this mode requires the tzc program.  on afs, the binariers are in
;;; /afs/cs.cmu.edu/user/spot/bin/tzc, and the source in
;;; /afs/cs.cmu.edu/user/spot/src/tzc/tzc.c, or by ftp to
;;; hopeless.mess.cs.cmu.edu:/afs/cs/user/spot/ftp
;;;
;;; thanks to todd kaufmann and mark eichin for their contributions.
;;;
;;; i am always interested in bug reports and improvements to this
;;; code.


;;; todo:
;;; 1) subscripts:  when an unrecognized instance arrives, ask if you
;;; want to read it.  remember subs in a file (.zephyr.el).  should
;;; tie into encryption.  or just have simple functions for adding and
;;; removing instances to the regexps.

;;; CHANGES
;;; 11/7/92 - fixed: M-p and M-n raise error if no messages sent yet.
;;; split zephyr-notify into zephyr-notify-with-beep,
;;; zephyr-notify-with-message, and zephyr-notify-with-scroll. added
;;; zephyr-touch.  calls zephyr-touch from zephyr-insert (rather than
;;; notify).
;;;
;;; 9/7/92 - replaced a bunch of random hooks with zephyr-hook-list,
;;; including reorganizing the code, various small improvements.
;;; commented out dangling encryption stuff.  tzc now stamps with date
;;; string rather than integer so that it is human readable in the
;;; log, and also cuz emacs ints aren't big enuf. added todd's
;;; delete-messages function.  removed that bury crap.


;;; the next 4 variables control what messages you see

(defvar zephyr-senders-ignore-regexp nil
  "if this regexp matches the sender, then ignore the message.  it's
typical to put yourself in this list so that you don't get what you
send to instances you also read.  to ignore nobody, use nil.")

(defvar zephyr-senders-accept-regexp nil
  "only accept messages from users who match this regexp.  nil means
match everybody.")

(defvar zephyr-instances-ignore-regexp nil
  "if this regexp mathces the instance, then ignore the message. use
nil to ignore nobody.")

(defvar zephyr-instances-accept-regexp nil
  "only accept messages from instances that match this regexp.  nil
means match all instances")


(defvar zephyr-hook-list
  '(zephyr-parse
    zephyr-parse-fields
    zephyr-add-banner
    zephyr-insert
    zephyr-notify-with-message
    zephyr-notify-with-beep
    zephyr-notify-with-scroll
    )
  "a list of functions to call to process an incoming message.  a lot
of customization can be done by changing this list.  for example, to
visibly timestamp messages, add the function zephyr-add-timestamp next
to zephyr-add-banner.")


(defvar zephyr-send-divider "<<< "
  "pattern to mark the beginning of the message to be sent.
everything between it and point is considered part of the message.
everything between it and the beginning of the line is considered a
list of recipients.")

(defvar zephyr-send-divider-regexp "<<<\\( \\|$\\)"
  "regexp to match zephyr-send-divider.  it pays to be a bit lenient.")

(defvar zephyr-send-program "/usr/misc/.zephyr/bin/zwrite"
  "invoke this program to send zephyr-grams. see
zephyr-send-options.")

(defvar zephyr-send-options '("-q" "-l" "-t")
  "command line options to the zephyr-send-program")

(defvar zephyr-receive-program '("/afs/cs.cmu.edu/user/spot/bin/tzc")
  "list containing program and its options. invoked to receive
zephyr-grams.")

(defvar zephyr-aliases '(("stooges" . ("larry" "curly" "moe")))
  "alist of non-recursive aliases.")

(defvar zephyr-instance-xlate-hook 'zephyr-instance-xlate
  "call this function with each recipient.  returns a list of options
for the send program.  typically, it recognizes instances.")

(defvar zephyr-receive-divider ">>> "
  "string that appears immediately before the message body of incoming
zephyr-grams.")

(defvar zephyr-unauth-string "(NOAUTH)"
  "string that appears next to messages that are from unauthenticated
sources.")

(defvar zephyr-failed-string "(FORGED)"
  "string that appears next to messages whose authentication attempt
failed.")

(defvar zephyr-lazy-beep-time 120
  "beep, unless a msg has been received since this many seconds ago.
if this is nil, then never beep.")

(defvar zephyr-log-buffer-limit 32000
  "prevent the zephyr-log-buffer from expanding beyond this many
characters.  the buffer acts as a queue -- text from the beginning is
thrown away as new messages arrive.  the value nil means that the
buffer will grow without bound.")

(defvar zephyr-buffer-limit 32000
  "prevent the *zephyr* buffer from expanding beyond this many
characters.  the buffer acts as a queue -- text from the beginning is
thrown away as new messages arrive.  the value nil means that the
buffer will grow without bound.")

(defvar zephyr-client-eom-string "\0"
  "string matching the end of the output from the zephyr client
receiving messages.  for zwgc this is usually ^G.")

(defvar zephyr-client-bom-string "\1"
  "string matching the beginning of the output from the zephyr client
receiving messages.  must be different from
zephyr-client-eom-string.")

; (defvar zephyr-encrypt-program "crypt"
;   "invoke this program to encrypt messages.")

; (defvar zephyr-decrypt-program "crypt"
;  "invoke this program to decrypt messages.")

; (defvar zephyr-cypher-is-binary t
;   "true if the cypher-text generated by zephyr-encrypt-program is
; binary.")

; (defvar zephyr-passwords '(("an-encrypted-instance" .
;                 "some-password"))
;   "alist of instance-password pairs.  if the password is nil, the user
; is prompted when it is needed.  the passwords can be cleared with
; zephyr-clear-passwords. encrpytion doesn't work.")


; how to remove buffers when they are killed? rebind C-xk?!
(defvar zephyr-buffer-list nil
  "list of buffers that are receiving zephyrgrams")

(defun zephyr-new-buffer (&optional name)
  "create a new buffer for reading and sending zephyrgrams.  the
buffer is named *zephyr-NAME*, where NAME is printed representation of
the argument, or just *zephyr* if NAME is nil, or not provided."
  (interactive)
  (let ((name (if name
          (concat "*zephyr-" name "*")
        "*zephyr*")))
    (switch-to-buffer name)
    (zephyr-mode)
    (zephyr-compose "")
    (setq zephyr-buffer-list (cons (current-buffer)
                   zephyr-buffer-list))))

(defun zephyr-match (s n)
  (substring s
         (match-beginning n)
         (match-end n)))

;;; convert a name to an instance
(defun zephyr-instance-xlate (name)
  (let ((l (assoc name zephyr-aliases))
    (n (string-match "(\\(.*\\))" name)))
    (cond (l (cdr l))
      ((and n (= n 0))
       (list "-i" (zephyr-match name 1)))
      (n (list (substring name 0 n)
           "-i" (zephyr-match name 1)))
      (t (list name)))))

;;; convert string to list of strings, basically seperate it into
;;; words.  space, tab, and comma are considered seperators.
(defun zephyr-send-make-recipient-list (recipient)
  (if (string-match "[ \t,]*\\([^ \t,]+\\)" recipient)
      (let* ((beg (match-beginning 1))
         (end (match-end 1))
         (name (substring recipient beg end)))
    (append (funcall zephyr-instance-xlate-hook name)
        (zephyr-send-make-recipient-list
         (substring recipient end))))
    nil))

(defun zephyr-get-instance (l)
  (if l
      (if (equal (car l) "-i")
      (car (cdr l))
    (zephyr-get-instance (cdr l)))
    nil))


(defvar zephyr-last-recipient "nobody")

(defun zephyr-send-and-compose ()
  "send the zephyrgram before point, and start composing another one."
  (interactive)
  (unwind-protect
      (let* ((cur-buf (current-buffer))
         (log-buffer-size (progn (set-buffer zephyr-log-buffer)
                     (buffer-size))))
    (set-buffer cur-buf)
    (save-excursion
      (let* ((end-msg (point))
         (pat (concat "^.+\\("
                   zephyr-send-divider-regexp
                   "\\)"))
         (end-recipient (progn (re-search-backward pat)
                       (match-beginning 1)))
         (start-recipient (match-beginning 0))
         (start-msg (match-end 0))
         (msg (buffer-substring start-msg end-msg))
         (recipient (buffer-substring start-recipient end-recipient))
         (recip-list (zephyr-send-make-recipient-list recipient))
         (text-recip-list (mapconcat '(lambda (x) x)
                         recip-list " ")))
        (message (concat "Sending to " text-recip-list "..."))
        (setq zephyr-last-recipient recipient)
        (zephyr-touch-name recipient)
        ;; (let* ((inst (zephyr-get-instance recip-list))
        ;;   (a (assoc inst zephyr-passwords)))
        ;; (if a (progn
        ;;      (setq msg (zephyr-en/decrypt msg (cdr a) t))
        ;;    (if zephyr-cypher-is-binary
        ;;  (setq msg (zephyr-btoa msg))))))
        (zephyr-send msg recip-list)
        (message (concat "Sending to " text-recip-list "... done"))))
    (zephyr-limit-buffer-size zephyr-buffer-limit)
    (set-buffer zephyr-log-buffer)
    (if (not (equal log-buffer-size (buffer-size)))
        (progn
          (pop-to-buffer zephyr-log-buffer)
          (error "zwrite complained")))
    (set-buffer cur-buf))
    ; this is protected, so in case of error sending, we still set up
    ; for the next one
    (zephyr-compose "")))

(defun zephyr-send (msg to-list)
  (save-excursion
    (let ((src (generate-new-buffer " zwrite")))
      (set-buffer src)
      (insert msg)
      (apply 'call-process-region
         (append (list (point-min) (point-max)
               zephyr-send-program
               nil zephyr-log-buffer nil)
             to-list
             zephyr-send-options))
      (kill-buffer src))))


;;; go to the end of the buffer, add a new header
(defun zephyr-send-setup (recipient)
  (goto-char (point-max))
  (if (not (bolp))
      (insert "\n"))
  (insert (concat recipient zephyr-send-divider)))

(defun zephyr-compose (recipient)
  "compose a zephyr-gram to be sent.  prompts for recipient, if none
is given, use last recipient."
  (interactive "sTo: ")
  (if (not (equal mode-name "Zephyr"))
      (if zephyr-buffer-list
      (pop-to-buffer (car zephyr-buffer-list))
    (error "no zephyr buffers")))
  (if (equal recipient "")
      (zephyr-send-setup zephyr-last-recipient)
    (zephyr-send-setup recipient)))

;;; if the window where the messages appears is active, move so the
;;; end (where the message is) is visible
(defun zephyr-buffer-show-end (buf)
  (let* ((win (get-buffer-window buf)))
    (set-buffer buf)
    (if win
    (progn
      (if (pos-visible-in-window-p (point-max) win)
          nil
        (goto-char (point-max))
        (vertical-motion (- 2 (window-height win)))
        (set-window-start win (point)))))))

; some code for handling zwgc instead of tzc.  it's way out of date...

;
; (defvar zephyr-pattern-list
;   (list
;    (cons
;     (concat "\n\\*\\*\\* ..:..:.. \\*\\*\\* .* "
;         "(\\(possibly\\|probably\\|\\) ?"
;         "\\(.+\\)@\\(.+\\)): ?\\(.*\\)\n"
;         "\\([^\007]*\\)\n\007")
;     '(lambda (msg-text)
;        (let ((a (match-string 1))
;          (b (match-string 2))
;          (c (downcase (match-string 3)))
;          (d (downcase (match-string 4)))
;          (e (match-string 5)))
;      (list (cons 'instance (if (equal "" d) "personal" d))
;            (cons 'class "message")
;            (cons 'sender b)
;            (cons 'fromhost c)
;            (cons 'auth (if (equal "" a) 'yes
;                  (if (equal "possibly" a) 'no
;                    'failed)))
;            (cons 'message e)))))
;    (cons
;     "\n\\[ \\(.*\\) \\]\n\n\007"
;     '(lambda (msg-text)
;        (list (cons 'instance "mail_delivery")
;          (cons 'class "message")
;          (cons 'sender "root")
;          (cons 'message (concat (match-string 1) "\n"))))))
;
;
;   "list of (pattern . function) pairs used to parse the output of zwgc
; into an alist with standard tags.  the output of zwgc is matched
; against each of the patterns until one matches.  that pattern's
; function is then called to construct the alist.  the message text is
; passed to the function. see zephyr-parse-hook for the standard tags.")
;
;
; (defun zephyr-zwgc-parse-hook (buf start end)
;   (set-buffer buf)
;   (goto-char start)        ; -1 to lose the ^G at the end
;   (let ((msg-text (buffer-substring start (- end 1)))
;     (pattern-list zephyr-pattern-list)
;     (answer nil))
;     (while (not answer)
;       (if pattern-list
;       (if (re-search-forward (car (car pattern-list)) end t)
;           (setq answer (funcall (cdr (car pattern-list)) msg-text))
;         (setq pattern-list (cdr pattern-list)))
;     (setq answer (list (cons 'message msg-text)))))
;     answer))

;;; add most of the tags to the message alist.  since tzc prints out
;;; messages in lisp-readable from, this is mostly just a call to
;;; read.  if you were using zwgc instead, you would have to do
;;; something horrible, something like what's in the preceding
;;; comments.
;;;
;;; the tags in the alist contain at least:
;;;
;;;   message - a list of strings, one per field
;;;   instance - a string, often "PERSONAL"
;;;   auth - a symbol, either 'yes, 'no, or 'failed
;;;   kind - a symbol, usually 'acked
;;;   port - an integer, the sender's port
;;;   class - a symbol, usually 'MESSAGE
;;;   opcode - a symbol, usually either nil or 'PING
;;;   sender - a string, the login name of the sender
;;;   recipient - a string, either your login name or NIL
;;;   fromhost - a string, the hostname where the msg orginated
;;;   time - a string, just like from current-time-string
;;;
;;; these tags will sometimes be added, depending on what happens to the
;;; msg and what its contents are:
;;;
;;;   buffers - a list of buffers, where the message appeared
;;;   print-as - a string, how we should display it
;;;   signature - a string, from the sender (class MESSAGE)
;;;   body - a string, the message (class MESSAGE)
;;;   host - a string, (class LOGIN)
;;;   when - a string, (class LOGIN)
;;;   tty - a string, (class LOGIN)

(defun zephyr-parse (msg)
  (let* ((r (cdr (assq 'raw-source msg)))
     (buf (car r))
     (start (cadr r))
     (end (caddr r)))
    (set-buffer buf)
    (goto-char start)
    (read buf)))

(defvar zephyr-insert-p 'zephyr-default-insert-p
  "predicate that returns true if its argument, a msg-alist, should
appear in the current buffer")

;;; for each zephyr buffer, check if this msg should appear in it.  if
;;; so, insert it.
(defun zephyr-insert (msg)
  (let ((buffers nil)
    (loop zephyr-buffer-list))
    (while loop
      (if (buffer-name (car loop))
      (progn
        (set-buffer (car loop))
        (if (funcall zephyr-insert-p msg)
        (progn
          (zephyr-do-insert msg)
          (zephyr-touch msg)
          (setq buffers (cons (car loop) buffers))))
        (setq loop (cdr loop)))))
    (cons (cons 'buffers buffers) msg)))

(defun zephyr-default-insert-p (msg)
  (let ((instance (cdr (assq 'instance msg)))
    (sender  (cdr (assq 'sender msg)))
    (opcode  (cdr (assq 'opcode msg)))
    (msg-text (cdr (assq 'print-as msg))))

    (not (or (eq 'PING opcode)

         (and zephyr-instances-ignore-regexp
          (string-match zephyr-instances-ignore-regexp
                instance))

         (and zephyr-senders-ignore-regexp
          (string-match zephyr-senders-ignore-regexp
                     sender))

         (and zephyr-instances-accept-regexp
          (not (string-match zephyr-instances-accept-regexp
                     instance)))

         (and zephyr-senders-accept-regexp
          (not (string-match zephyr-senders-accept-regexp
                     sender)))))))

;;; really stick it in the current buffer.  guarantee newline termination
(defun zephyr-do-insert (msg)
  (let ((msg-banner (cdr (assq 'banner msg)))
    (msg-text   (cdr (assq 'print-as msg))))
    (goto-char (point-max))
    (re-search-backward zephyr-send-divider-regexp (point-min) t)
    (re-search-backward "^")
    (insert msg-banner
        msg-text)
    (if (or (= 0 (length msg-text))
        (not (equal "\n"
            (substring msg-text
                   (- (length msg-text) 1)))))
    (insert "\n"))))


;;; add the string used to "introduce" a message.
(defun zephyr-add-banner (msg)
  (let ((instance (cdr (assq 'instance msg)))
    (sender  (cdr (assq 'sender msg)))
    (auth (cdr (assq 'auth msg))))
    (cons (cons 'banner
        (concat sender
            (if (equal "PERSONAL" instance)
                ""
              (concat " (" instance ")"))
            (cond ((eq auth 'yes) "")
                  ((eq auth 'failed) zephyr-failed-string)
                  ((eq auth 'no) zephyr-unauth-string))
            zephyr-receive-divider))
      msg)))

;;; an example function you can add to the pipeline that
;;; timestamps messages.
(defun zephyr-add-timestamp (msg)
  (let ((banner (assq 'banner msg)))
    (setcdr banner (concat (cdr banner)
               "("
               (substring (current-time-string) 11 16)
               ")"))))

;;; this one comes in handy too...
(defun zephyr-dump (msg)
  (print msg (get-buffer "*scratch*"))
  msg)

; give names to the various fields and add them to the alist.  also
; add the print-as tag, containing the printed rep.
(defun zephyr-parse-fields (msg)
  (let ((class (cdr (assq 'class msg)))
    (sender (cdr (assq 'sender msg)))
    (fields (cdr (assq 'message msg))))
    (cond (; in messages, the first field is a signature, and the
       ; second is the message body.
       (eq class 'MESSAGE)

       (let* ((len (length fields))
          (sig (cond ((= 2 len)
                  (string-match "\\(.*\\)\n*"
                        (car fields))
                  (zephyr-match (car fields) 1))
                 ((= 1 len)
                  sender)))
          (body (cond ((= 2 len) (cadr fields))
                  ((= 1 len) (car fields)))))
         (append (list (cons 'print-as body)
               (cons 'signature sig)
               (cons 'body body))
             msg)))
      (; in logins, the fields are host, when, and tty.
       (eq class 'LOGIN)
       (let ((host (nth 0 fields))
         (when (nth 1 fields))
         (tty (nth 2 fields)))
         (append (list (cons 'print-as
                 (concat "on " host " at " when))
               (cons 'host host)
               (cons 'when when)
               (cons 'tty tty))
             msg)))
      (t (cons (cons 'print-as
             (mapconcat '(lambda (x) x)
                    fields "\n"))
           msg)))))


(defun zephyr-lazy-beep (now delay)
  (let ((then zephyr-lazy-beep-last))
    (setq zephyr-lazy-beep-last now) ; horrid global var
    (if (and delay (or (not then)
               (> (time-difference-in-seconds then now)
              delay)))
    (beep))))



;
;; convert binary to ascii, slow stupid, simple.
;(defun zephyr-btoa (s)
;  (mapconcat '(lambda (c) (int-to-string c)) s " "))
;
;; convert ascii to binary, slow stupid, simple.
;; returns nil if there is a formatting error
;(defun zephyr-atob (s)
;  (save-excursion
;    (let ((src (generate-new-buffer " atob-src"))
;      ans)
;      (set-buffer src)
;      (insert "(" s ")")
;      (goto-char (point-min))
;      (setq ans
;        (condition-case ERR
;        (mapconcat 'char-to-string (read src) "")
;          (error nil)))
;      (kill-buffer src)
;      ans)))
;
;; en/decrype S using KEY.  EN is true means encrypt, otherwise
;; decrypt.
;(defun zephyr-en/decrypt (s key en)
;  (save-excursion
;    (let ((in (generate-new-buffer " endecrypt-in"))
;      (out (generate-new-buffer " endecrypt-out"))
;      (pgm (if en zephyr-encrypt-program
;         zephyr-decrypt-program)))
;      (set-buffer in)
;      (insert s)
;      (call-process-region (point-min) (point-max)
;               pgm t out nil key)
;      (kill-buffer in)
;      (set-buffer out)
;      (let ((b (buffer-string)))
;    (kill-buffer out)
;    b))))
;


(defun zephyr-notify-with-message (msg)
  (let ((buffers (cdr (assq 'buffers msg))))
    (if buffers
    (message (concat "received "
             (or (downcase (cdr (assq 'instance msg)))
                 "instanceless")
             " zephyrgram from "
             (or (cdr (assq 'signature msg))
                 (cdr (assq 'sender msg))
                 "???")))))
  msg)

(defun zephyr-notify-with-beep (msg)
  (let ((buffers (cdr (assq 'buffers msg)))
    (instance (cdr (assq 'instance msg)))
    (time (cdr (assq 'time msg))))
    (if buffers
    (if (not (equal (downcase instance) "urgent"))
        (zephyr-lazy-beep time zephyr-lazy-beep-time)
      (beep) (beep) (beep))))
  msg)

(defun zephyr-notify-with-scroll (msg)
  (let ((buffers (cdr (assq 'buffers msg))))
    (while buffers
      (zephyr-buffer-show-end (car buffers))
      (setq buffers (cdr buffers))))
  msg)


(defun zephyr-limit-buffer-size (lim)
  (let ((max (point-max)))
    (if (and lim (> max lim))
    (delete-region (point-min) (- max lim)))))


(defun zephyr-receive-filter (process string)
  (save-excursion
    (set-buffer zephyr-log-buffer)
    (let ((start (point-max))
      (done nil))
      (goto-char start)
      (insert string)
      (goto-char start)
      (while (search-forward zephyr-client-eom-string
                 (point-max) t)
    (let ((end (point)))
      (forward-char -1)
      (if (search-backward zephyr-client-bom-string
                   (point-min) t)
          (forward-char 1)
        (goto-char (point-min)))
      (let ((loop zephyr-hook-list)
        (v (list (list 'raw-source
                   zephyr-log-buffer (point) end))))
        (while loop
          (setq v (funcall (car loop) v))
          (setq loop (cdr loop))))
      (set-buffer zephyr-log-buffer)
      (goto-char end)))
      (zephyr-limit-buffer-size zephyr-log-buffer-limit))))


(defun zephyr-restart-receiver ()
  "kill and start another receiver process.  this is a good thing to do if
your kerberos tickets expire, causing all messages authentication to
appear failed."
  (interactive)
  (delete-process zephyr-process)
  (zephyr-start-receiver))

(defun zephyr-start-receiver ()
  (setq zephyr-lazy-beep-last nil)
  (setq zephyr-process
    (apply 'start-process
           "zephyr-receive" zephyr-log-buffer
           zephyr-receive-program))
  (process-kill-without-query zephyr-process)
  (set-process-filter zephyr-process 'zephyr-receive-filter))

(defvar zephyr-previous-names nil
  "doubly linked list of names of destinations and sources of
zephyrgrams previously sent and received.  most recent is first.  no
duplicates.")

(defun cadr (l) (car (cdr l)))
(defun cddr (l) (cdr (cdr l)))
(defun cdddr (l) (cdr (cdr (cdr l))))
(defun cdadr (l) (cdr (car (cdr l))))
(defun caddr (l) (car (cdr (cdr l))))

(defun zephyr-touch (msg)
  "touch the name(s) appearing in msg"
  (let ((sender (cdr (assq 'sender msg)))
    (instance (cdr (assq 'instance msg))))
    (zephyr-touch-name sender)
    (if (not (equal "PERSONAL" instance))
    (zephyr-touch-name (concat "(" instance ")")))))

(defun zephyr-touch-name (name)
  "move NAME to head zephyr-previous-names, add if not already there."
  (if zephyr-previous-names
      (if (not (equal name (car zephyr-previous-names)))
      (progn
        (let ((h (cddr zephyr-previous-names)))
          (while (not (eq h zephyr-previous-names))
        (if (equal (car h) name)
            (progn
              (setcar (cdddr h) (cadr h))
              (setcdr (cdadr h) (cddr h))
              (setq h zephyr-previous-names))
          (setq h (cddr h)))))
        (let ((n (cons name (cons zephyr-previous-names
                      (cddr zephyr-previous-names)))))
          (setcar (cdddr n) n)
          (setcdr (cdadr n) n)
          (setq zephyr-previous-names n))))
    (let ((n (cons name (cons nil nil))))
      (setcar (cdr n) n)
      (setcdr (cdr n) n)
      (setq zephyr-previous-names n))))

(defun zephyr-replace-destination (name)
  "replace the current destination with NAME"
  (save-excursion
   (re-search-backward zephyr-send-divider-regexp)
   (let ((end-dest (point)))
     (re-search-backward "^")
     (delete-region (point) end-dest)
     (insert name))))

(defun zephyr-next-destination (arg)
  "cycle forward through previous senders/destinations"
  (interactive "*p")
  (if zephyr-previous-names
      (if (= arg 0)
      (zephyr-replace-destination (car zephyr-previous-names))
    (progn
      (setq zephyr-previous-names (cddr zephyr-previous-names))
      (zephyr-next-destination (- arg 1))))))

(defun zephyr-previous-destination (arg)
  "cycle backward through previous senders/destinations"
  (interactive "*p")
  (if zephyr-previous-names
      (if (= arg 0)
      (zephyr-replace-destination (car zephyr-previous-names))
    (progn
      (setq zephyr-previous-names (cadr zephyr-previous-names))
      (zephyr-previous-destination (- arg 1))))))



(defun zephyr-delete-messages-from (inst)
  "delete all messages from a particular person that appear after
point.  takes a regexp."
  (interactive "sInstance name (regexp): ")
  (let* ((receive-divider-regexp (regexp-quote zephyr-receive-divider))
     (kill (concat "\\("
               inst  ;; why not:  (regexp-quote inst)   ;????????
               "\\).*"
               receive-divider-regexp))
     (any-divider-regexp (concat "\\("
                     receive-divider-regexp
                     "\\|"
                     zephyr-send-divider-regexp
                     "\\)")))
    (while (and (not (eobp))
        (re-search-forward kill nil t))
      (beginning-of-line 1)
      (let ((p (point))
        (found (re-search-forward any-divider-regexp nil t 2)))
    (beginning-of-line 1)
    (if found
        (delete-region p (point))
      (end-of-line 1))))))

(defvar zephyr-log-buffer nil)

(defun zephyr-mode ()

  "major mode for sending and receiving zephyr-grams.  use
zephyr-send-and-compose [\\[zephyr-send-and-compose]] to send
messages.  instances are specified by enclosing their names in
parentheses.  multiple destinations are seperated by whitespace.  to
change the destination just edit it, or use zephyr-compose
[\\[zephyr-compose]].

in the composition buffer, the destinations for the current message
appear to the left of \"<<< \".  when you send the zgram, everything
between point and \"<<< \" will be transmitted.  at any time, you can
edit the current destinations, or go back to previous messages and
edit/send them.

when a message arrives, a beep will sound, unless message has arrived
in the previous 120 (the value of zephyr-lazy-beep-time, really)
seconds.  for more elaborate notification, use zephyr-notify-hook.

the output of the receiver process is kept in *log-zephyr* buffer.  the
zephyr-log-buffer-limit and zephyr-buffer-limit variables control how
much text is saved in the buffers.  additional text is thrown away.


\\{zephyr-mode-map}

this mode is highly customizable, there are many hooks and variables
you can use to change how it behaves.  here's some of what you can do:

  visibly time-stamp incoming messages (see zephyr-hook-list)

  filter out particular instances/users (see
     zephyr-instances-ignore-regexp)

  multiple receiving buffers with different hooks and regexps

  define aliases for sending to common groups of people (see
     zephyr-aliases)"

  (interactive)
  (kill-all-local-variables)

  (make-local-variable 'zephyr-senders-ignore-regexp)
  (make-local-variable 'zephyr-instances-ignore-regexp)
  (make-local-variable 'zephyr-senders-accept-regexp)
  (make-local-variable 'zephyr-instances-accept-regexp)
  (make-local-variable 'zephyr-previous-names)

  (set-syntax-table text-mode-syntax-table)
  (use-local-map zephyr-mode-map)
  (setq local-abbrev-table text-mode-abbrev-table)
  (setq major-mode 'zephyr-mode)
  (setq mode-name "Zephyr")
  (setq zephyr-log-buffer (get-buffer-create "*log-zephyr*"))
  (setq paragraph-start (concat "\\(" paragraph-start "\\|"
                "^.*" zephyr-send-divider-regexp "\\|"
                "^.*" zephyr-receive-divider "\\)"))
  (if (or (not zephyr-log-buffer)
      (not (eq 'run (process-status "zephyr-receive"))))
      (zephyr-start-receiver))
  (run-hooks 'text-mode-hook 'zephyr-mode-hook))

(setq zephyr-mode-map (make-sparse-keymap))
(define-key zephyr-mode-map "\C-j" 'zephyr-send-and-compose)
(define-key zephyr-mode-map "\C-c?" 'describe-mode)
(define-key zephyr-mode-map "\C-c\C-s" 'zephyr-compose)
(define-key zephyr-mode-map "\C-c\C-r" 'zephyr-restart-receiver)
(define-key zephyr-mode-map "\C-c\C-c" 'zephyr-send-and-compose)
(define-key zephyr-mode-map "\ep" 'zephyr-previous-destination)
(define-key zephyr-mode-map "\en" 'zephyr-next-destination)
(define-key zephyr-mode-map "\C-c\C-d" 'zephyr-delete-messages-from)

;; stolen from fancy-xmouse.el by Benjamin C. Pierce ([e-mail])
(defun time-difference-in-seconds (time1 time2)
  (let* ((t1 (substring time1 11))
      (t2 (substring time2 11))
      (date1 (substring time1 0 11))
      (date2 (substring time2 0 11))
      (h1 (string-to-int (substring t1 0 2)))
      (h2 (string-to-int (substring t2 0 2)))
      (m1 (string-to-int (substring t1 3 5)))
      (m2 (string-to-int (substring t2 3 5)))
      (s1 (string-to-int (substring t1 6 8)))
      (s2 (string-to-int (substring t2 6 8)))
      (sec1 (+ (* 3600 h1) (* 60 m1) s1))
      (sec2 (+ (* 3600 h2) (* 60 m2) s2)))
    (+ (- sec2 sec1)
       (if (string-equal date1 date2)
        0
     (* 3600 24) ; correction for passing midnight
     ))))

--
            l2o
Scott Draves        gso
[e-mail]        ddn