# HG changeset patch
# User didierv
# Date 921891602 0
#      Sat Mar 20 01:00:02 1999 +0000
# Node ID 85efd0fdee01cde9c35a878659188daf0567a301
# Parent  8126737cfe3192e0b0124f1b4c27fe224c082651
mchat.el version 2.0 is released

diff --git a/mchat.el b/mchat.el
--- a/mchat.el
+++ b/mchat.el
@@ -1,25 +1,24 @@
-;;; mchat.el --- Multicast Chatting package for XEmacs.
+;;; mchat.el --- Multicast Chatting package for XEmacs
 
-;; Copyright (C) 1997-1998 Didier Verna.			 
+;; Copyright (C) 1997-99 Didier Verna.
 
-;; Author:          Didier Verna <verna@inf.enst.fr>
-;; Maintainer:      Didier Verna <verna@inf.enst.fr>
-;; Created:         Fri Nov 28 17:43:51 1997 
-;; Last Revision:   Mon Jan 12 19:40:38 1998
-;; Current Version: 1.0
-;; Keywords:        comm processes
+;; Author:        Didier Verna <didier@xemacs.org>
+;; Maintainer:    Didier Verna <didier@xemacs.org>
+;; Created:       Mon Feb 15 18:45:02 1999 under XEmacs 21.2 (beta 9)
+;; Last Revision: Fri Mar 19 16:22:04 1999
+;; Keywords:      comm processes
 
-;; This file is part of MChat.				 
+;; This file is part of XEmacs.
 
-;; MChat is free software; you can redistribute it and/or modify
+;; XEmacs 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.			 
-;; 							    
-;; MChat is distributed in the hope that it will be useful, 
+;; (at your option) any later version.
+
+;; XEmacs 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.		 
+;; 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
@@ -28,598 +27,1309 @@
 
 ;;; Commentary:
 
-;; Initial contents by file-contents v.0.4 (Didier Verna <verna@inf.enst.fr>)
-;; Written on emacs version 20.4 "Angora" XEmacs  Lucid (beta6)
+;; Contents management by FCM version 0.1.
 
-;; MChat is a small utility designed to illustrate the use of a multicast
-;; connection inside of xemacs. The connection, as for TCP, is seen as a
-;; subprocess.
-;; This program opens a multicast connection on the specified dest/port/ttl,
-;; and allows you to chat in (almost) real time with other participants on the
-;; group. The messages are displayed in a special buffer, and you can enter
- ;; your own messages from the minibuffer. A message is simply a short line of
-;; text.  The original idea of mchat is from Philippe Dax.
+;; MChat is a package allowing a conversation to take place between a
+;; potentially infinite number of people across the Internet. It uses the
+;; Multicast support that I've added to XEmacs in the early 21.0 days. At that
+;; time a rudimentary version of MChat was written, merely to illustrate the
+;; feature, and almost nobody knew it, appart from the other developpers. This
+;; version is much improved and completely backward incompatible ;-).
+
+;; The main entry point to the package is the `mchat' function which allows
+;; you to open a multicast group based on the MChat protocol. There are a
+;; number a variables that you can customize in the 'mchat custom group. Their
+;; doc-string is rather self-explanatory I think. You might also want to look
+;; at the bindings (C-h b) in MChat buffers, or at the menubar entries to get
+;; an idea of what you can do.
 
-;; M-x mchat to open a group (with a prefix -> in a new frame).
-;; From the mchat buffer, type:
-;; 'return' to enter a line of text to send.
-;; 'w' (who) to see the list of known group members.
-;; 'W' (Who) to request identification from members of the group.
-;; 'b' (beep) to ring the group.
-;; 'q' (quit) to quit the group.
-;; 'e' (erase) to erase the mchat buffer.
-;; 'd' (define) to save this group definition.
-;; 'r' (remove) to remove this group definition.
-;; 'a' (address) to see the current mchat group address
-;; 'v' (version) to see the current mchat version.
-;; 's' (suspend) to toggle between listening and suspended mode.
+;; ### WARNING: the current version (but there's also a limitation in the
+;; internals of XEmacs's processes) doesn't let you send messages longer than
+;; 500 octets or so, including the protocol header. I plan to change this in
+;; the future (see the todo list).
+
+
+;;; Acknowledgements:
+
+;; The original idea of MChat is from Philippe Dax <dax@infres.enst.fr>.
+;; Akim Demaille <demaille@infres.enst.fr> was THE beta tester for this
+;; release and gave me several good ideas.
+
+
+;;; TODO:
+
+;; - implement fragmentation support. When we have a proper packaging scheme
+;;   for providing both lisp and C modules, I'll probably rewrite the
+;;   multicast support as a module because the current process abstraction is
+;;   not very well suited to it. In UDP, you'd like to have access to more of
+;;   the datagrams components, and use proper non-connected mode routines to
+;;   send/receive to/from the network.
+;; - maybe implement dynamic heart-bit
 
 
 ;;; Change Log:
 
-;; Rev. of Mon Jan 12 1998 : Packaging cleanup.
-;; Rev. of Mon Dec 22 1997 : Added the menu.
-;; Rev. of Mon Dec 15 1997 : Improved completion + mchat-know-groups.
-;; Rev. of Mon Dec 15 1997 : added mchat-suspend
-;; Rev. of Fri Dec 12 1997 : Added mchat-group-address + eob when inserting.
-;; Rev. of Thu Dec 11 1997 : Added mchat-Who
-;; Rev. of Thu Dec 11 1997 : Added prefix management for mchat()
-;; Rev. of Wed Dec 10 1997 : Added mchat-erase-buffer & mchat-version
-;; Rev. of Wed Dec 10 1997 : mchat-with-meta-face macro + cleanup
-;; Rev. of Wed Dec 10 1997 : Added mchat-with-mchat-buffer macro
-;; Rev. of Tue Dec  9 1997 : Code cleanup
-;; Rev. of Tue Dec  9 1997 : Handle possible messages concatenation
-;; Rev. of Fri Dec  5 1997 : Added completion mechanism
-;; Rev. of Fri Dec  5 1997 : Added predefined groups
-;; Rev. of Fri Dec  5 1997 : Added the 'beep' command + cleanup
-;; Rev. of Mon Dec  1 1997 : Added the 'who' command
-;; Rev. of Mon Dec  1 1997 : Added mchat-living-groups
-;; Rev. of Sun Nov 30 1997 : Added join, quit commands.
-;; Rev. of Fri Nov 28 1997 : Inital version.
-
 
 ;;; Code:
 
-;;; Public variables --------------------------------------------------------
+
+;; User Configurable stuff ==================================================
 
 (defgroup mchat nil
   "Multicast Chatting package.")
 
-(defcustom mchat-prompt (user-full-name)
-  "*The tag used to identify your messages in the mchat buffer. It must not 
-contain any colons. Messages will appear like this:
-`prompt' > `message'"
-  :type 'string
-  :group 'mchat)
+(defcustom mchat-user-tag (user-full-name)
+  "*The tag to use to identify your messages."
+  :group 'mchat
+  :type 'string)
 
-(defcustom mchat-verbose-level 2
-  "*The verbose level of an mchat buffer.
-If 0, never print information not explicitely required.
-If > 0, print information on people arriving or quitting the group.
-If > 1, print possibly corrupted messages in the buffer too."
-  :type 'integer
-  :group 'mchat)
+(defcustom mchat-registered-groups nil
+  "*Alist of registered mchat groups. Each element looks like
+(NAME ADDRESS) where NAME is a string used to identify the group, and
+ADDRESS is the multicast address. NAME must be unique. Please refer to
+`open-multicast-group' for the syntax of ADDRESS."
+  :group 'mchat
+  :type '(repeat (group (string :tag "   Name")
+		        (string :tag "Address"))))
 
-(defcustom mchat-loaded-hook nil
-  "*Hook to run when mchat is loaded. Convenient place to set variables."
-  :type 'hook
-  :group 'mchat)
+(defcustom mchat-message-cache-size 32
+  "*Number of sent messages to remeber for each MChat group."
+  :group 'mchat
+  :type 'integer)
 
-(defface mchat-prompt-face '((t (:bold t)))
-  "*The face to display mchat prompts with."
-  :group 'mchat)
+(defcustom mchat-circulate-messages nil
+  "*If non nil, consider the message caches as circular lists, allowing to
+jump directly from one end to the other."
+  :group 'mchat
+  :type 'boolean)
 
-(defface mchat-meta-face '((t (:italic t)))
-  "*The face to display mchat groups information with."
-  :group 'mchat)
-
-(defcustom mchat-beep-sound t
-  "*Sound to use when somebody rings the mchat group (see `sound-alist').
+(defcustom mchat-ring-sound t
+  "*Sound to use when somebody rings an MChat group (see `sound-alist').
 Otherwise, t means just beep and nil means don't ever produce any sound."
   :group 'mchat
   :type 'symbol)
 
-(defcustom mchat-predefined-groups 
-  '(("xemacs-beta" . "230.137.194.160/32010/127"))
-  "*An alist of predefined mchat groups. Each element looks like
-(NAME . ADDRESS) where NAME is a name used to identify the group, and ADDRESS
-is the multicast address."
+(defcustom mchat-flash-on-message 'needed
+  "*When you receive a message in an MChat group, the selected frame can be
+flashed according to the value of this variable:
+- if t, always flash when a message arrives. As a special exception, this
+  doesn't flash when you are in one of the two MChat buffers corresponding to
+  this group.
+- if 'needed, flash only when the MChat buffer is not visible,
+- if nil, never flash.
+
+### NOTE: currently, it's not always possible to figure out exactly whether
+the MChat buffer is visible (for instance if its frame is mapped, but obscured
+by some other window)."
+  :group 'mchat
+  :type '(choice (const :tag "always" t)
+		 (const :tag "needed" needed)
+		 (const :tag "never" nil)))
+
+(defcustom mchat-major-mode-string "MChat"
+  "*String to use in the modeline when the MChat major mode is active."
+  :group 'mchat
+  :type 'string)
+
+(defcustom mchat-major-mode-hooks nil
+  "*Hooks to run after setting up the MChat major mode."
+  :group 'mchat
+  :type 'hook)
+
+(defcustom mchat-minor-mode-string " mchat"
+  "*String to use in the modeline when the MChat minor mode is active."
+  :group 'mchat
+  :type 'string)
+
+(defcustom mchat-minor-mode-hooks nil
+  "*Hooks to run after setting up the MChat minor mode."
+  :group 'mchat
+  :type 'hook)
+
+(defcustom mchat-before-send-hooks nil
+  "*Hooks to run before sending a message. The hooks are executed in the MChat
+message buffer."
   :group 'mchat
-  :type '(repeat (cons (string :tag "   Name")
-		       (string :tag "Address"))))
+  :type 'hook)
+
+(defcustom mchat-treat-message-hooks nil
+  "*Hooks to run after a message is received. The hooks will be called with
+two arguments, the beginning and end position of the message in the MChat
+group buffer. The group buffer will be current when the hooks are executed."
+  :group 'mchat
+  :type 'hook)
+
+(defcustom mchat-message-buffer-major-mode 'text
+  "*Major mode to use for MChat message buffers (less the -mode suffix)."
+  :group 'mchat
+  :type 'symbol)
+
+(defcustom mchat-loaded-hooks nil
+  "*Hooks run when mchat is loaded."
+  :group 'mchat
+  :type 'hook)
+
+(defcustom mchat-window-percent 75
+  "*Percentage of frame occupied by the Group buffer. The rest will go to the
+message buffer."
+  :group 'mchat
+  :type 'integer)
 
-(defconst mchat-version "0.17"
-  "Guess what ? ...")
+(defcustom mchat-nsl-method
+  '("nsl"
+    (system-name)
+    "\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)"
+    1)
+  "*Method to use in order to retreive one IP address from your machine. It
+looks like (PROGRAM ARGS REGEXP START) where:
+- PROGRAM is the program to be called (a string)
+- ARGS is a lisp expression returning a string of arguments you might want to
+  pass to PROGRAM,
+- REGEXP is the regexp to find the IP address in the output of PROGRAM,
+- START is the indice of the sub-match returning the first component of the
+  address."
+  :group 'mchat
+  :type '(list (string  :tag "    Program")
+	       (sexp    :tag "  Arguments")
+	       (string  :tag "     Regexp")
+	       (integer :tag "First match")))
+
+(defface mchat-comment-face '((t (:italic t)))
+  "*Face used when inserting text that is not a message in the MChat group
+buffers."
+  :group 'mchat)
+
+(defface mchat-tag-face '((t (:bold t)))
+  "*Face used for identifying the sender of a message."
+  :group 'mchat)
 
 
-;;; Private variables -------------------------------------------------------
+;; Private variables ========================================================
 
-(defvar mchat-mode-map
-  ;; MChat major mode map
-  (let ((m (make-sparse-keymap)))
-    (set-keymap-name m 'mchat-mode-map)
-    (define-key m 'return 'mchat-message)
-    (define-key m "q" 'mchat-quit)
-    (define-key m "w" 'mchat-who)
-    (define-key m "W" 'mchat-Who)
-    (define-key m "b" 'mchat-ring)
-    (define-key m "s" 'mchat-suspend)
-    (define-key m "e" 'mchat-erase-buffer)
-    (define-key m "d" 'mchat-define-group)
-    (define-key m "r" 'mchat-remove-group)
-    (define-key m "a" 'mchat-group-address)
-    (define-key m "v" 'mchat-version)
-    m)
-  "We're a lil' curious aren't we ?!")
+;; $Format: "(defconst mchat-prcs-major-version \"$ProjectMajorVersion$\")"$
+(defconst mchat-prcs-major-version "branch-2-0")
+;; $Format: "(defconst mchat-prcs-minor-version \"$ProjectMinorVersion$\")"$
+(defconst mchat-prcs-minor-version "24")
+(defconst mchat-version
+  (let ((level mchat-prcs-minor-version)
+	major minor status)
+    (string-match "\\(branch\\|version\\)-\\([0-9]+\\)-\\([0-9]+\\)"
+		  mchat-prcs-major-version)
+    (setq major (match-string 2 mchat-prcs-major-version)
+	  minor (match-string 3 mchat-prcs-major-version)
+	  status (match-string 1 mchat-prcs-major-version))
+    (cond ((string= status "version")
+	   (setq level (int-to-string (1- (string-to-int level))))
+	   (if (eq level 0)
+	       (concat major "." minor)
+	     (concat major "." minor "." level)))
+	  ((string= status "branch")
+	   (concat major "." minor "-b" level)))
+    ))
+
+;; ### NOTE: the group informations stored in each entry are constant stuff.
+;; Things likely to change (like members) are stored in buffer-local
+;; variables.
+(defvar mchat-groups nil
+  ;; List of all currently active mchat groups.
+  ;; Each element of the list is of the form: (NAME ADDRESS (KEY . VALUE) ...)
+  ;; NAME is the name use to identify the group,
+  ;; ADDRESS is the multicast address for the group,
+  ;; KEY can currently be one of the following:
+  ;; buffer:       VALUE is the message edition buffer for this group,
+  ;; proc:         VALUE is the process id associated with this group,
+  ;; zombie-check: VALUE is the timeout id corresponding to the zonbie check.
+  )
+
+;; Used to retrieve back the group desc from mchat-groups.
+(make-variable-buffer-local
+ (defvar mchat-group-name nil
+   ;; Becomes automatically buffer local when set. Contains the name of the
+   ;; MChat group the buffer is associated with.
+   ))
 
-(if (featurep 'menubar) ;; not really usefull, but cleaner I think ...
-    (defconst mchat-submenu
-      '("MChat"
-	"Group action:"
-	"---"
-	("members"
-	 [ "show" mchat-who t ]
-	 [ "re-ask" mchat-Who t ])
-	[ "ring" mchat-ring t ]
-	;; see mchat-menu-filter
-	[ "listening is " mchat-suspend t "on" ]
-	[ "show address" mchat-group-address t ]
-	[ "leave" mchat-quit t ]
-	"Groups control:"
-	"---"
-	[ "add group definition" mchat-define-group t ]
-	[ "remove group definition" mchat-remove-group t ]
-	"Misc."
-	"---"
-	[ "erase MChat buffer" mchat-erase-buffer t ]
-	[ "MChat version" mchat-version t ]
-	)
-      ;; MChat-menu definition.
-      )
+;; See the note on top of `mchat-groups'
+(make-variable-buffer-local
+ (defvar mchat-group-members nil
+   ;; Becomes automatically buffer local when set. This is a list of group
+   ;; members. Each element looks like: (ID (KEY . VALUE) ...)
+   ;; ID is the unique identifier for each member.
+   ;; KEY can be one the following:
+   ;; tag:        VALUE is the tag to used to identify messages from this guy,
+   ;; time-stamp: VALUE is the last time I received a message from this guy.
+   ;; messges:    VALUE is a list of buffered messages to be processed *after*
+   ;;             we get information on the guy (especially the tag).
+   ))
+
+(make-variable-buffer-local
+ (defvar mchat-heart-bit-timeout nil
+   ;; Becomes automatically buffer local when set. The heart-bit timeout id.
+   ))
+
+(make-variable-buffer-local
+ (defvar mchat-message-cache nil
+   ;; Becomes automatically buffer local when set. The cache of messages
+   ;; already sent.
+   ))
+
+(make-variable-buffer-local
+ (defvar mchat-message-cache-indice nil
+   ;; Becomes automatically buffer local when set. The cache indice of the
+   ;; message currently displayed in the mchat message buffer.
+   ))
+
+(make-variable-buffer-local
+ (defvar mchat-unsent-message nil
+   ;; Becomes automatically buffer local when set. Remembers a message being
+   ;; edited we're moving in the messages history
+   ))
+
+(defconst mchat-submenu
+  '("MChat"
+    :included mchat-group-name
+    "Message:"
+    "-"
+    [ "send it" mchat-message t ]
+    [ "discard it" mchat-discard-message t ]
+    [ "pop next" mchat-next-message t ]
+    [ "pop previous" mchat-previous-message t ]
+    [ "pop first" mchat-first-message t ]
+    [ "pop last" mchat-last-message t ]
+    "Group:"
+    "--"
+    [ "erase buffer" mchat-erase-buffer t ]
+    [ "ring bell" mchat-ring t ]
+    [ "show who's here" mchat-who t ]
+    [ "show info" mchat-info t ]
+;;; [ "listening is " mchat-suspend t "on" ]
+    [ "quit" mchat-quit t ]
+    "Control:"
+    "---"
+    [ "register group" mchat-register t ]
+    [ "unregister group" mchat-unregister t ]
+    [ "switch group" mchat-switch-to-group t ]
+    [ "bury group" mchat-bury t ]
+    "Misc."
+    "----"
+    [ "MChat version" mchat-version t ]
+    )
+  ;; MChat-menu definition.
   )
 
-(defvar mchat-living-groups nil
-  ;; An alist of the currently active mchat groups with related information. 
-  ;; Each element of the list looks like this: (PROC INFO ...)
-  ;; PROC is the process associated with the multicast connection.
-  ;; INFO is an alist of group information. Each element looks like this:
-  ;; (KEY VALUE ...). The following keys currently exist:
-  ;; name:    the mchat group name and address: "name" "dest/port/ttl"
-  ;; buffer:  the mchat group buffer id.		   
-  ;; who:     the list of known members of the group.
-  ;; mode:    wether you follow the conversation. 'suspended or 'listening
-  "Don't even think about this !")
+
+;; MChat protocol management routines =======================================
+
+;; Here's a description of the MChat protocol (version 2.0) in pseudo-BNF:
+
+;; MESSAGE := PROTO_VERSION USER_ID LENGTH DATA
+;; PROTO_VERSION := PROTO_MAJOR (1 octet) PROTO_MINOR (1 octet)
+;;                  (see `mchat-protocol-*-version')
+;; USER_ID := USER_IP USER_PID
+;; LENGTH := length of the data segment (2 octets)
+;; DATA := ATOM ATOM_DATA
+;; USER_IP := one IP address of the machine we're running on (4 octets)
+;; USER_PID := PID of the process running an MChat client (8 octets)
+
+;; ATOM <ATOM_DATA>: meaning (see `mchat-protocol-atom-*')
+;; 'join <user tag>:     join the group
+;; 'quit <nothing>:      quit the group
+;; 'whois <user id>:     ask <user id> for info
+;; 'iam <user tag>:      send info on me
+;; 'ring <nothing>:      ring the group
+;; 'msg  <text>:         send a message to the group
+;; 'heart-bit <nothing>: just show people that we exist
+
+;; The user id serves for identifying uniquely each member of the group. Some
+;; of them could use the same tag however.
+
+;; The main use of the LENGTH field is because of possible messages
+;; concatenation. It's then important to separate each message from the next
+;; one.
+
+;; - 'join and 'quit are sent once.
+;; - 'iam should be sent if somebody sent a 'whois request about me.
+;; - 'whois should be sent when we receive something (except 'join and 'iam)
+;;   about a member we don't know.
+;; 'heart-bit should be sent only if we were idle for a long time.
 
 
-;;; Internal misc utilities -------------------------------------------------
+;; Each one must be representable on 8 bits, but I doubt I'll ever reach 255.
+;; $Format: "(defconst mchat-protocol-major-version $ProtocolMajorVersion$)"$
+(defconst mchat-protocol-major-version 2)
+;; $Format: "(defconst mchat-protocol-minor-version $ProtocolMinorVersion$)"$
+(defconst mchat-protocol-minor-version 0)
 
-(defun mchat-read-string (prompt)
-  ;; Read a non empty string from minibuffer and return it.
-  (let ((str ""))
-    (while (equal str "")
-      (setq str (read-string prompt)))
+(defconst mchat-protocol-version
+  (let ((str "\0\0"))
+    (aset str 0 (int-to-char mchat-protocol-major-version))
+    (aset str 1 (int-to-char mchat-protocol-minor-version))
     str))
-	
-(defmacro mchat-with-mchat-buffer (where &rest body)
-  ;; Execute the forms in BODY with the buffer specified by WHERE as the
-  ;; current buffer. WHERE can be an mchat buffer or process. 
-  ;; It is temporarily set writable.
-  `(save-current-buffer
-     (set-buffer 
-      (or (and (processp ,where)
-	       (cdr (assoc 'buffer (assq ,where mchat-living-groups))))
-	  (and (bufferp ,where)
-	       ,where)
-	  (error "WHERE must be an mchat buffer or process")))
-      (setq buffer-read-only nil) ;; temporarily
-      (end-of-buffer)
-      ,@body
-      (setq buffer-read-only t)))
+
+(defconst mchat-heart-bit-delay 60
+  ;; Maximum inactivity period.
+  )
+
+(defconst mchat-zombie-latency 5
+  ;; If I didn't receive any message (heart-bit included) from a member after
+  ;; this number of times the heart-bit, the guy must have been killed.
+  )
+
+;; ### FIXME: is it necessary to use 64bits for pids ?
+(defconst mchat-user-id
+  (let ((str (make-string 12 0))
+	(pid (emacs-pid))
+	(i 0)
+	(n (cadddr mchat-nsl-method)))
+    (with-temp-buffer
+      (call-process (car mchat-nsl-method)
+		    nil (current-buffer)
+		    nil (eval (cadr mchat-nsl-method)))
+      (goto-char (point-min))
+      (re-search-forward (caddr mchat-nsl-method))
+      (while (< i 4)
+	(aset str i
+	      (int-to-char (string-to-int (match-string (+ i n)))))
+	(setq i (1+ i)))
+      (setq i 11)
+      (while (> i 4)
+	(setq n (% pid 256))
+	(aset str i (int-to-char n))
+	(setq pid (/ (- pid n) 256))
+	(setq i (1- i))))
+    str)
+  ;; 12 octets header for all mchat messages. Octets list with explanation:
+  ;; 0- 3 -> IP address
+  ;; 4-12 -> emacs pid on 64 bits
+  ;; The pair IP-addres/emacs pid makes a unique identifier for everybody.
+  )
+
+;; MChat protocol atoms
+(defconst mchat-protocol-atom-join      (int-to-char 0))
+(defconst mchat-protocol-atom-quit      (int-to-char 1))
+(defconst mchat-protocol-atom-whois     (int-to-char 10))
+(defconst mchat-protocol-atom-iam       (int-to-char 11))
+(defconst mchat-protocol-atom-ring      (int-to-char 50))
+(defconst mchat-protocol-atom-msg       (int-to-char 100))
+(defconst mchat-protocol-atom-heart-bit (int-to-char 255))
+
+;; Message sending routines ------------------------------------------------
 
-(defmacro mchat-with-meta-face (&rest body)
-  ;; Execute body and put all inserted text in mchat-meta-face
+;; ### NOTE: should implement message fragmentation
+(defun mchat-send (proc data)
+  ;; send DATA to the process PROC, in the MChat protocol format. Disable the
+  ;; heart bit before sending, and restores it afterwards.
+  (let ((data-len "\0\0")
+	(len (length data))
+	n)
+    (with-current-buffer (process-buffer proc)
+      (disable-timeout mchat-heart-bit-timeout)
+      ;; compute and add the length of the message
+      (setq n (% len 256))
+      (aset data-len 1 (int-to-char n))
+      (setq n (/ (- len n) 256))
+      (aset data-len 0 n)
+      (process-send-string proc (concat mchat-protocol-version
+					mchat-user-id
+					data-len
+					data))
+      (setq mchat-heart-bit-timeout
+	    (add-timeout mchat-heart-bit-delay 'mchat-heart-bit proc
+			 mchat-heart-bit-delay)))
+    ))
+
+(defun mchat-send-join (proc)
+  ;; Sends a `join' message
+  (mchat-send proc (concat (char-to-string mchat-protocol-atom-join)
+			   mchat-user-tag)))
+
+(defun mchat-send-quit (proc)
+  ;; Sends a `quit' message
+  (mchat-send proc (char-to-string mchat-protocol-atom-quit)))
+
+(defun mchat-send-whois (proc data)
+  ;; Sends a `whois' message
+  (mchat-send proc (concat (char-to-string mchat-protocol-atom-whois)
+			   data)))
+
+(defun mchat-send-iam (proc)
+  ;; Sends a `iam' message
+  (mchat-send proc (concat (char-to-string mchat-protocol-atom-iam)
+			   mchat-user-tag)))
+
+(defun mchat-send-ring (proc)
+  ;; Sends a `ring' message
+  (mchat-send proc (char-to-string mchat-protocol-atom-ring)))
+
+(defun mchat-send-msg (proc data)
+  ;; Sends a real text message
+  (mchat-send proc (concat (char-to-string mchat-protocol-atom-msg)
+			   data)))
+
+(defun mchat-send-heart-bit (proc)
+  ;; sends the heart-bit message
+  (mchat-send proc (char-to-string mchat-protocol-atom-heart-bit)))
+
+
+;; Message receiving routines ----------------------------------------------
+
+;; stolen from gnus.
+(defun mchat-current-time ()
+  ;; Return the current time in seconds
+  (let ((tm (current-time)))
+    (+ (* (car tm) 65536.0)
+       (cadr tm)
+       (/ (or (caddr tm) 0) 1000000.0))
+    ))
+
+(defmacro mchat-with-face (face &rest body)
+  ;; Execute BODY and put the result in face FACE
   `(let ((start (point)))
      ,@body
-     (set-extent-face (make-extent start (point)) 'mchat-meta-face)))
+     (set-extent-face (make-extent start (point)) ,face)
+     ))
+(put 'mchat-with-face 'lisp-indent-function 1)
+
+(defmacro mchat-insertion (&rest body)
+  ;; Execute BODY in current buffer as if it was a process output, and put it
+  ;; in face FACE.
+  ;; ### WARNING: BODY must use `insert-before-markers', not `insert'.
+  `(save-excursion
+     (let ((proc (get-buffer-process (current-buffer)))
+	   buffer-read-only)
+       (goto-char (process-mark proc))
+       ,@body
+       (set-marker (process-mark proc) (point)))
+     ))
+(put 'mchat-insertion 'lisp-indent-function 0)
 
-
-;;; Private functions ------------------------------------------------------
+;; ### NOTE: For some reason, I've noticed that I'm likely to receive several
+;; messages twice. I couldn't figure out why in the multicast API. Maybe a
+;; problem of loopback of some sort ? Just ignore doublets anyway.
+(defun mchat-treat-join (grp id data) ;; DATA is the user tag
+  (let* ((proc (cdr (assoc 'proc grp)))
+	 (buf (process-buffer proc))
+	 who)
+    (with-current-buffer buf
+      (setq who (assoc id mchat-group-members))
+      (unless who
+	;; update the members list
+	(setq who (list id
+			(cons 'tag data)
+			(cons 'time-stamp (mchat-current-time))))
+	(push who mchat-group-members)
+	(mchat-insertion
+	    (mchat-with-face 'mchat-comment-face
+	      (insert-before-markers (concat data " joins.\n"))))
+	))
+    ))
 
-(defun mchat-known-groups ()
-  ;; Returns an alist similar to mchat-predefined-groups, but with the living
-  ;; groups too.
-  (let ((grplist mchat-predefined-groups)
-	(ptr mchat-living-groups)
-	grp)
-    (while ptr
-      (setq grp (cdr (assoc 'name (car ptr))))
-      ;; If this current group is not predefined, add it.
-      (if (not (assoc (car grp) mchat-predefined-groups))
-	  (setq grplist (cons (cons (car grp) (cadr grp)) grplist)))
-      (setq ptr (cdr ptr)))
-    grplist
+(defun mchat-treat-quit (grp id)
+  (let ((buf (process-buffer (cdr (assoc 'proc grp))))
+	who)
+    (with-current-buffer buf
+      (setq who (assoc id mchat-group-members))
+      (when who ;; otherwise, I didn't know the guy anyway
+	(mchat-insertion
+	    (mchat-with-face 'mchat-comment-face
+	      (insert-before-markers
+	       (concat (or (cdr (assoc 'tag who)) "<unknown>") " quits.\n"))))
+	;; remove the guy
+	(setq mchat-group-members (remassoc id mchat-group-members))
+	))
+    ))
+
+;; ### NOTE: those two functions should probably use the CL package to perform
+;; substitutions, but I'm not sure it's worth it. Maybe if one day I have more
+;; things to update in the members structure, I could write a more general
+;; function.
+(defun mchat-update-time-stamp (id)
+  ;; Update the timestamp for user ID in current MChat group buffer
+  (let ((who (assoc id mchat-group-members)))
+    (setq mchat-group-members (remassoc id mchat-group-members))
+    (setq who (remassoc 'time-stamp who))
+    (setq who (append who (list (cons 'time-stamp (mchat-current-time)))))
+    (push who mchat-group-members)
+    ))
+
+(defun mchat-bufferize-message (id data)
+  ;; Add a message to the unprocessed list
+  (let* ((who (assoc id mchat-group-members))
+	 (messages (assoc 'messages who)))
+    (setq mchat-group-members (remassoc id mchat-group-members))
+    (setq who (remassoc 'messages who))
+    (if messages
+	(setq messages (append messages (list data)))
+      ;; else
+      (setq messages (list 'messages data)))
+    (setq who (append who messages))
+    (push who mchat-group-members)
     ))
 
-(defun mchat-get-group-from (key value)
-  ;; Given the (key value) pair, return the first group for which this pair
-  ;; exists in the group info alist, or nil otherwise.
-  ;; This will be used with ('group "name" "address") or with ('buffer buf)
-  ;; which should be unique anyway.
-  (let ((grplist mchat-living-groups)
-	found)
-    (while (and (not found) (car grplist))
-      (if (equal value (cdr (assoc key (car grplist))))
-	  (setq found t)
-	(setq grplist (cdr grplist))))
-    (car grplist)))
-
-(defun mchat-maybe-add-member (proc who)
-  ;; Add member to the who list if not present. 
-  ;; Return t if added, or nil if already present.
-  (let* ((group (assq proc mchat-living-groups))
-	 (wholist (cdr (assoc 'who group)))
-	 (here (member who wholist)))
-    (when (not here)
-      (setq mchat-living-groups (remassq proc mchat-living-groups))
-      (setq group (remassoc 'who group))
-      (setq wholist (cons 'who (cons who wholist)))
-      (setq group (append group (list wholist)))
-      (setq mchat-living-groups (append mchat-living-groups (list group))))
-    (not here)))
+(defun mchat-treat-whois (grp id data) ;; DATA is the user id to check
+  (let* ((proc (cdr (assoc 'proc grp)))
+	 (buf (process-buffer proc))
+	 who)
+    ;; honor the request
+    (when (string-equal mchat-user-id data)
+      (mchat-send-iam proc))
+    ;; update the guy
+    (with-current-buffer buf
+      (setq who (assoc id mchat-group-members))
+      (cond ((not who) ;; yet unknown
+	     ;; update the members list
+	     (setq who (list id	(cons 'time-stamp (mchat-current-time))))
+	     (push who mchat-group-members)
+	     (mchat-send-whois proc id))
+	    ((not (assoc 'tag who)) ;; half-known
+	     (mchat-update-time-stamp id)
+	     (mchat-send-whois proc id))
+	    (t ;; completely known
+	     (mchat-update-time-stamp id))))
+    ))
 
-(defun mchat-maybe-delete-member (proc who)
-  ;; Delete member from the 'who' list.
-  ;; I don't delete me, since I don't allow multiple occurences in the who 
-  ;; list. 
-  (when (not (string= who mchat-prompt))
-    (let* ((group (assq proc mchat-living-groups))
-	   (wholist (cdr (assoc 'who group)))
-	   (newlist (delete who wholist)))
-      (setq mchat-living-groups (remassq proc mchat-living-groups))
-      (setq group (remassoc 'who group))
-      (setq group (append group (list (cons 'who newlist))))
-      (setq mchat-living-groups (append mchat-living-groups (list group)))
-      )))
+(defun mchat-treat-iam (grp id data) ;; DATA is the user tag
+  (let ((buf (process-buffer (cdr (assoc 'proc grp))))
+	who)
+    (with-current-buffer buf
+      (setq who (assoc id mchat-group-members))
+      (cond ((not who) ;; yet unknown
+	     (setq who (list id
+			     (cons 'tag data)
+			     (cons 'time-stamp (mchat-current-time))))
+	     (push who mchat-group-members)
+	     (mchat-insertion
+	       (mchat-with-face 'mchat-comment-face
+		 (insert-before-markers (concat data " is here.\n")))))
+	    ((not (assoc 'tag who)) ;; half-known
+	     (let ((messages (cdr (assoc 'messages who))))
+	       (setq who (append who (list (cons 'tag data))))
+	       (when messages
+		 (setq who (remassoc 'messages who)))
+	       (setq mchat-group-members (remassoc id mchat-group-members))
+	       (push who mchat-group-members)
+	       (mchat-update-time-stamp id)
+	       (mchat-insertion
+		 (mchat-with-face 'mchat-comment-face
+		   (insert-before-markers (concat data " is here.\n"))))
+	       (when messages
+		 (let (msg)
+		   (while (setq msg (pop messages))
+		     (mchat-treat-data grp id msg))))))
+	    (t ;; completely known
+	     ;; ### FIXME: should check if tag is still the same
+	     (mchat-update-time-stamp id))))
+    ))
 
-(defun mchat-buffer-group-or-ask ()
-  ;; Return the current-buffer's group info alist, or prompts the user for an
-  ;; *existing* group.
-  (or (mchat-get-group-from 'buffer (current-buffer))
-      (let ((ptr mchat-living-groups)
-	    name current-groups)
-	(while ptr
-	  (setq current-groups 
-		(cons (cdr (assoc 'name (car ptr))) current-groups))
-	  (setq ptr (cdr ptr)))
-	(setq name (completing-read "Group: " current-groups nil t))
-	(mchat-get-group-from 'name (assoc name current-groups))
-	)))
-
-(defun mchat-kill-buffer-hook ()
-  ;; This should be called only on an mchat active group's buffer. The mchat
-  ;; buffer is current. However, we handle possible accidents such as 
-  ;; process deleted ...
-  (let* ((proc (get-buffer-process (current-buffer)))
-	 (group (mchat-get-group-from 'buffer (current-buffer))))
-    (when proc
-      (mchat-message proc ":quit")
-      (delete-process proc))
-    (when group
-      (setq mchat-living-groups (remassq (car group) mchat-living-groups)))
-    ))
-      
+(defun mchat-ding ()
+  ;; like 'ding but check mchat-ring-sound
+  (cond ((eq mchat-ring-sound t) ;; just the bell
+	 (ding t))
+	(mchat-ring-sound ;; a real sound. Try it or use the bell
+	 (if (and (or (featurep 'native-sound)
+		      (featurep 'nas-sound))
+		  (device-sound-enabled-p))
+	     (ding t mchat-ring-sound)
+	   ;; else
+	   (ding t)))))
 
-(defun mchat-mode ()
-  ;; Setup the mchat major mode in the current buffer.
-  (kill-all-local-variables)
-  (setq buffer-read-only t)
-  (use-local-map mchat-mode-map)
-  (setq major-mode 'mchat-mode)
-  (setq mode-name "MChat")
-  (make-local-hook 'kill-buffer-hook)
-  (add-hook 'kill-buffer-hook 'mchat-kill-buffer-hook nil t))
-
-(defun mchat-insert-meta-line (line &rest args)
-  ;; Insert a 'meta' message line in the current buffer
-  (insert (concat " > " (apply 'format line args) "\n")))
+;; Handles my own messages
+(defun mchat-treat-ring (grp id)
+  (let* ((proc (cdr (assoc 'proc grp)))
+	 (buf (process-buffer proc))
+	 who)
+    (if (string-equal id mchat-user-id)
+	(with-current-buffer buf
+	  (mchat-insertion
+	    (mchat-with-face 'mchat-comment-face
+	      (insert-before-markers "I ring.\n")))
+	  (mchat-ding))
+      ;; else
+      (with-current-buffer buf
+	(setq who (assoc id mchat-group-members))
+	(cond ((not who) ;; unknown
+	       (setq who (list id
+			       (cons 'time-stamp (mchat-current-time))
+			       (list 'messages
+				     (char-to-string
+				      mchat-protocol-atom-ring))
+			       ))
+	       (push who mchat-group-members)
+	       (mchat-send-whois proc id))
+	      ((not (assoc 'tag who)) ;; half known
+	       (mchat-bufferize-message id (char-to-string
+					    mchat-protocol-atom-ring))
+	       (mchat-update-time-stamp id)
+	       (mchat-send-whois proc id))
+	      (t ;;completely known
+	       (mchat-update-time-stamp id)
+	       (mchat-insertion
+		 (mchat-with-face 'mchat-comment-face
+		   (insert-before-markers
+		    (concat (cdr (assoc 'tag who)) " rings.\n"))))
+	       (mchat-ding)))))
+    ))
 
-(defun mchat-handle-message (proc from msg)
-  ;; Handle the messages and their possible special treatments.
-  ;; The messages here correspond to single datagrams.
-  (let ((mode (cdr (assoc 'mode (assq proc mchat-living-groups)))))
-    (mchat-with-mchat-buffer 
-     proc
-     (cond ((string= msg ":quit")
-	    (mchat-maybe-delete-member proc from)
-	    (and (> mchat-verbose-level 0) (equal mode 'listening)
-		 (mchat-with-meta-face
-		  (mchat-insert-meta-line (concat from " quits")))))
-	   ((string= msg ":join")
-	    (mchat-message proc ":here") ;; Say we're here.
-	    (and (mchat-maybe-add-member proc from)
-		 (> mchat-verbose-level 0)
-		 (equal mode 'listening)
-		 (mchat-with-meta-face
-		  (mchat-insert-meta-line (concat from " joins")))))
-	   ((string= msg ":who")
-	    (mchat-message proc ":here") ;; Say we're here.
-	    (and (mchat-maybe-add-member proc from)
-		 (> mchat-verbose-level 0)
-		 (equal mode 'listening)
-		 (mchat-with-meta-face
-		  (mchat-insert-meta-line (concat from " is here")))))
-	   ((string= msg ":here")
-	    (and (mchat-maybe-add-member proc from)
-		 (> mchat-verbose-level 0)
-		 (equal mode 'listening)
-		 (mchat-with-meta-face
-		  (mchat-insert-meta-line (concat from " is here")))))
-	   ((string= msg ":beep")
-	    (mchat-maybe-add-member proc from)
-	    (and (> mchat-verbose-level 0)
-		 (equal mode 'listening)
-		 (progn
-		   (mchat-with-meta-face
-		    (mchat-insert-meta-line (concat from " rings")))
-		   (when mchat-beep-sound
-		     (let ((snd (and (or (featurep 'native-sound)
-					 (featurep 'nas-sound))
-				     (device-sound-enabled-p))))
-		       (if (and (not (equal mchat-beep-sound 't)) snd)
-			   (ding t mchat-beep-sound)
-			 (ding t)))))))
-	   (t ;; A normal message
-	    (mchat-maybe-add-member proc from) ;; No use signaling him.
-	    (if (equal mode 'listening)
-		(let ((start (point)))
-		  (insert (concat from " > "))
-		  (set-extent-face (make-extent start (point))
-				   'mchat-prompt-face)
-		  (insert (concat msg "\n"))))
-	    ))
-     )))
+;; Handles my own messages
+(defun mchat-treat-msg (grp id data) ;; DATA is a normal message
+  (let* ((proc (cdr (assoc 'proc grp)))
+	 (buf (process-buffer proc))
+	 who flash)
+    (if (string-equal id mchat-user-id)
+	(with-current-buffer buf
+	  (mchat-insertion
+	    (mchat-with-face 'mchat-tag-face
+	      (insert-before-markers "I say:\n"))
+	    (let ((beg (point))
+		  end)
+	      (insert-before-markers (concat data "\n"))
+	      (setq end (point))
+	      (run-hook-with-args 'mchat-treat-message-hooks
+				  beg end))))
+      ;; else
+      (with-current-buffer buf
+	(setq who (assoc id mchat-group-members))
+	(cond ((not who) ;; unknown
+	       (setq who (list id
+			       (cons 'time-stamp (mchat-current-time))
+			       (list 'messages
+				     (concat (char-to-string
+					      mchat-protocol-atom-msg)
+					     data))
+			       ))
+	       (push who mchat-group-members)
+	       (mchat-send-whois proc id))
+	      ((not (assoc 'tag who)) ;; half known
+	       (mchat-bufferize-message
+		id
+		(concat (char-to-string mchat-protocol-atom-msg)
+			data))
+	       (mchat-update-time-stamp id)
+	       (mchat-send-whois proc id))
+	      (t ;; completely known
+	       (setq flash t)
+	       (mchat-insertion
+		 (mchat-with-face 'mchat-tag-face
+		   (insert-before-markers
+		    (concat (cdr (assoc 'tag who)) " says:\n")))
+		 (let ((beg (point))
+		       end)
+		   (insert-before-markers (concat data "\n"))
+		   (setq end (point))
+		   (run-hook-with-args 'mchat-treat-message-hooks
+				       beg end))))))
+      ;; ### WARNING: do this outside buf !!
+      ;; Now possibly flash if the buffer is not visible (but not if
+      ;; we're in it).
+      (when flash
+	(cond ((and (eq mchat-flash-on-message t)
+		    (not (eq (current-buffer) buf))
+		    (not (eq (current-buffer)
+			     (cdr (assoc 'buffer grp)))))
+	       (let ((visible-bell t)) (ding t t)))
+	      ((and (eq mchat-flash-on-message 'needed)
+		    (not (get-buffer-window buf 'visible)))
+	       (let ((visible-bell t)) (ding t t))))))
+    ))
 
-(defun mchat-decompose-message (proc str)
-  ;; Given a message, separate sender / message and check
-  (let ((mode (cdr (assoc 'mode (assq proc mchat-living-groups)))))
-    (or (and (string-match "^\\([^:]+\\):\\(.+\\)" str)
-	     (let ((from (match-string 1 str))
-		   (msg (match-string 2 str)))
-	       (when (and from msg)
-		 (mchat-handle-message proc from msg)
-		 t)))
-	(if (and (> mchat-verbose-level 1)
-		 (equal mode 'listening))
-	    (mchat-with-mchat-buffer
-	     proc
-	     (mchat-with-meta-face
-	      (mchat-insert-meta-line
-	       (concat "Corrupted message: '" str "'"))))))
+(defun mchat-treat-heart-bit (grp id)
+  (let* ((proc (cdr (assoc 'proc grp)))
+	 (buf (process-buffer proc))
+	 who)
+    (with-current-buffer buf
+      (setq who (assoc id mchat-group-members))
+      (cond ((not who) ;; unknown
+	     (setq who (list id (cons 'time-stamp (mchat-current-time))))
+	     (push who mchat-group-members)
+	     (mchat-send-whois proc id))
+	    ((not (assoc 'tag who)) ;; half known
+	     (mchat-update-time-stamp id)
+	     (mchat-send-whois proc id))
+	    (t ;; completely known
+	     (mchat-update-time-stamp id))))
     ))
 
+(defun mchat-treat-data (grp id data)
+  ;; treat an MChat protocol message for group GRP. Branch to the proper
+  ;; subroutine
+  (cond ((eq (aref data 0) mchat-protocol-atom-join) ;; join
+	 (unless (string-equal id mchat-user-id)
+	   (mchat-treat-join grp id (substring data 1))))
+	((eq (aref data 0) mchat-protocol-atom-quit) ;; quit
+	 (unless (string-equal id mchat-user-id)
+	   (mchat-treat-quit grp id)))
+	((eq (aref data 0) mchat-protocol-atom-whois) ;; whois
+	 (unless (string-equal id mchat-user-id)
+	   (mchat-treat-whois grp id (substring data 1))))
+	((eq (aref data 0) mchat-protocol-atom-iam) ;; iam
+	 (unless (string-equal id mchat-user-id)
+	   (mchat-treat-iam grp id (substring data 1))))
+	;; Handle my own messages
+	((eq (aref data 0) mchat-protocol-atom-ring) ;; ring
+	 (mchat-treat-ring grp id))
+	;; Handle my own messages
+	((eq (aref data 0) mchat-protocol-atom-msg) ;; msg
+	 (mchat-treat-msg grp id (substring data 1)))
+	((eq (aref data 0) mchat-protocol-atom-heart-bit) ;; heart bit
+	 (unless (string-equal id mchat-user-id)
+	   (mchat-treat-heart-bit grp id)))
+	))
+
+;; ### FIXME: I think we can loose UDP packets, but we can assume that if one
+;; is received, it's not corrupted, right ?
+;; Also, I think I've encountered cases where packets were concatenated, so I
+;; handle this by adding the length of each DATA segment, and calling again
+;; the process filter myself if the message is too long.
 (defun mchat-process-filter (proc str)
-  ;; Filter the output from the multicast group.
-  ;; There might be several messages concatenated, but we assume that all
-  ;; messages (that are contained in a single datagram) are received entirely.
-  ;; Messages are separated by a "\n", so here we separate the messages.
-  (let ((rest str)
-	(mode (cdr (assoc 'mode (assq proc mchat-living-groups)))))
-    (while rest
-      (or (and (string-match "\\(.+\\)\n" rest)
-	       (let ((end (match-end 0)))
-		 (mchat-decompose-message proc (match-string 1 rest))
-		 (if (= end (length rest))
-		     (setq rest nil)
-		   (setq rest (substring rest end)))
-		 t))
-	  (progn
-	    (if (and (> mchat-verbose-level 1)
-		     (equal mode 'listening))
-		(mchat-with-mchat-buffer
-		 proc
-		 (mchat-with-meta-face
-		  (mchat-insert-meta-line 
-		   (concat "Corrupted sequence: '" rest "'")))))
-	    (setq rest nil))
+  ;; Filter for all received mchat messages
+  (let ((grp (catch 'found
+	       (let ((grps mchat-groups) grp)
+		 (while (setq grp (pop grps))
+		   (if (equal proc (cdr (assoc 'proc grp)))
+		       (throw 'found grp))))))
+	(major (char-to-int (aref str 0)))
+	(minor (char-to-int (aref str 1)))
+	id len data next)
+    ;; Check that we understand this protocol version:
+    (if (> (+ (* 256 major) minor)
+	   (+ (* 256 mchat-protocol-major-version)
+	      mchat-protocol-minor-version))
+	(with-current-buffer (process-buffer proc)
+	  (mchat-insertion
+	    (mchat-with-face 'mchat-comment-face
+	      (insert-before-markers
+	       "Received a message with MChat protocol version "
+	       (int-to-string major) "." (int-to-string minor) " !\n")
+	      (insert-before-markers
+	       "Please check if you have an outdated package.\n")
+	      (insert-before-markers
+	       "(also, note that this might just be a corrupted message)\n")
+	      )))
+      ;; else, this protocol version is understood, decode the message.
+      ;; ### NOTE: the following stuff could change for newer protocol
+      ;; versions. Just there's only one now (2.0).
+      (setq id (substring str 2 14)
+	    len (+ (* 256 (char-to-int (aref str 14)))
+		   (char-to-int (aref str 15)))
+	    data (substring str 16 (+ 16 len))
+	    next (and (> (length str) (+ 16 len))
+		      (substring str (+ 16 len))))
+      (mchat-treat-data grp id data)
+      (and next (mchat-process-filter proc next)))
+    ))
+
+
+;; MChat groups display routines ============================================
+
+;; Each frame in which an MChat group is displayed gets a
+;; 'mchat-window-configurations property. This property is a list of
+;; window configurations current before each call to `mchat-switch-to-group'.
+
+(defun mchat-switch-to-group (grp)
+  "Switch to the MChat group GRP in the current frame. This function remembers
+the previous window configuration, that you will be able to get back using
+`mchat-bury'."
+  (interactive
+   (list (assoc (completing-read "Group: " mchat-groups nil t) mchat-groups)))
+  ;; Remember the window configuration
+  (set-frame-property (selected-frame) 'mchat-window-configurations
+		      (cons (current-window-configuration)
+			    (frame-property (selected-frame)
+					    'mchat-window-configurations)))
+  ;; Setup the frame for this group
+  (delete-other-windows)
+  (switch-to-buffer (process-buffer (cdr (assoc 'proc grp))))
+  (split-window nil (/ (* (window-height) mchat-window-percent) 100))
+  (other-window 1)
+  (switch-to-buffer (cdr (assoc 'buffer grp)))
+  )
+
+(defun mchat-bury ()
+  "Bury the MChat group displayed in the current frame. This function
+actually restores the window configuration immediately preceding the last call
+to `mchat-switch-to-group' in this frame.
+
+If this frame didn't display an MChat group before (properly speaking, that is
+if `mchat-switch-to-group' was not called in this frame before), this function
+does nothing."
+  (interactive)
+  (let ((wcs (frame-property (selected-frame) 'mchat-window-configurations)))
+    (when wcs
+      (set-frame-property (selected-frame)
+			  'mchat-window-configurations (cdr wcs))
+      ;; ### NOTE: `set-window-configuration' doesn't seem to produce any
+      ;; errors when the window configuration can't be restored (like, if one
+      ;; buffer is killed, or something).
+      (set-window-configuration (car wcs)))
+    ))
+
+
+;; MChat group destruction routines =========================================
+
+(defun mchat-kill-group (grp)
+  ;; Destroy the group and clean up.
+  ;; XEmacs handles deleting the processes associated with buffers being
+  ;; killed, but I prefer to do it myself, in priority.
+  (let* ((proc (cdr (assoc 'proc grp)))
+	 (group-buffer (process-buffer proc))
+	 (message-buffer (cdr (assoc 'buffer grp)))
+	 (zombie-check (cdr (assoc 'zombie-check grp))))
+    ;; ### WARNING: this is the first thing to do, because mchat-send reputs
+    ;; the timeout after sending the message !!
+    (mchat-send-quit proc)
+    ;; Don't call the hooks !!
+    (with-current-buffer group-buffer
+      (disable-timeout mchat-heart-bit-timeout)
+      (remove-hook 'kill-buffer-hook 'mchat-kill-buffer-hook t))
+    (with-current-buffer message-buffer
+      (remove-hook 'kill-buffer-hook 'mchat-kill-buffer-hook t))
+    (disable-timeout zombie-check)
+    (delete-process proc)
+    (kill-buffer group-buffer)
+    (kill-buffer message-buffer)
+    (setq mchat-groups (remassoc (car grp) mchat-groups))
+    ))
+
+
+;; MChat modes routines =====================================================
+
+;; ### NOTE: for the moment, all of the following functions are supposed to be
+;; run only from an MChat buffer. Maybe we could make some of them query the
+;; group otherwise, but there again, I don't find this particularly usefull.
+
+(defsubst mchat-interactive ()
+  (let* ((grp (assoc mchat-group-name mchat-groups)))
+    (if grp
+	(list grp)
+      (error "No MChat group associated with this buffer."))
+    ))
+
+(defun mchat-quit (grp)
+  "Quit the MChat group GRP."
+  (interactive (mchat-interactive))
+  (mchat-bury)
+  (mchat-kill-group grp))
+
+(defun mchat-ring (grp)
+  "Ring the bell on the MChat group GRP. If people are not looking at the
+buffer, at least they can hear you... Hmm maybe I should have called this
+function `mchat-annoy-user'... See also `mchat-flash-on-message'."
+  (interactive (mchat-interactive))
+  (mchat-send-ring (cdr (assoc 'proc grp))))
+
+(defsubst mchat-maybe-remember-message ()
+  ;; Remember the message being edited, *even* if it's still empty. Indeed, we
+  ;; want to get it back after moving in the cache.
+  (when (or (buffer-modified-p) (eq 0 (length (buffer-substring))))
+    (setq mchat-unsent-message (buffer-substring))))
+
+(defun mchat-next-message (grp &optional n)
+  "Restore the next Nth message (previous if N is negative) in the
+message buffer of group GRP. The variable `mchat-circulate-messages' controls
+the behavior when N is out of bounds. If N is not given, it is 1 by default.
+
+When called interactively, use the prefix to change N."
+  (interactive (append
+		(mchat-interactive)
+		(list (if current-prefix-arg
+			  (prefix-numeric-value current-prefix-arg)
+			1))))
+  (unless (eq 0 n)
+    (with-current-buffer (cdr (assoc 'buffer grp))
+      (mchat-maybe-remember-message)
+      ;; When moving in the cache the unset message must be virtually part of
+      ;; the cache in order to get it back.
+      (let* ((cache (append mchat-message-cache (list mchat-unsent-message)))
+	     (len (length cache))
+	     (indice (or mchat-message-cache-indice (1- len))))
+	;; find the new indice
+	(setq n (+ indice n))
+	(cond (mchat-circulate-messages
+	       (while (< n 0)
+		 (setq n (+ n len)))
+	       (setq n (% n len)))
+	      (t
+	       (if (< n 0)
+		   (setq n 0)
+		 (if (>= n len)
+		     (setq n (1- len))))))
+	;; Pop the message
+	(erase-buffer)
+	(insert (nth n cache))
+	(setq mchat-message-cache-indice n)
+	(unless (and (eq n (1- len)) (> (length (buffer-substring)) 0))
+	  (set-buffer-modified-p nil))
+	))
+    ))
+
+(defun mchat-previous-message (grp)
+  "Restore the previous message in the message buffer of group GRP. See also
+the variable `mchat-circulate-messages'"
+  (interactive (mchat-interactive))
+  (mchat-next-message grp -1))
+
+(defsubst mchat-pop-cached-message (n)
+  ;; Pops the message number n from the cache.
+  (erase-buffer)
+  (insert (nth n mchat-message-cache))
+  (setq mchat-message-cache-indice n)
+  (set-buffer-modified-p nil))
+
+(defun mchat-first-message (grp)
+  "Restore the oldest cached message in the message buffer of group GRP."
+  (interactive (mchat-interactive))
+  (with-current-buffer (cdr (assoc 'buffer grp))
+    (when mchat-message-cache
+      (mchat-maybe-remember-message)
+      (mchat-pop-cached-message 0))
+    ))
+
+;; ### NOTE: contrary to `mchat-next-message', this function doesn't consider
+;; the message currently edited as part of the cache. However, it is
+;; remembered and can be accessed with one `M-n'.
+(defun mchat-last-message (grp)
+  "Restore the youngest cached message in the message buffer of group GRP."
+  (interactive (mchat-interactive))
+  (with-current-buffer (cdr (assoc 'buffer grp))
+    (when mchat-message-cache
+      (mchat-maybe-remember-message)
+      (mchat-pop-cached-message (1- (length mchat-message-cache))))
+    ))
+
+(defun mchat-message (grp)
+  "Send the contents of the message buffer to the MChat group GRP."
+  (interactive (mchat-interactive))
+  (with-current-buffer (cdr (assoc 'buffer grp))
+    ;; the hooks might change something, so run them here.
+    (run-hooks 'mchat-before-send-hooks)
+    (let ((str (buffer-substring)))
+      (cond ((or (not str) (= 0 (length str)))
+	     (error "The message buffer is empty."))
+	    ((> (length str) 450)
+	     (error "Message too long. Please send it in shorter pieces."))
+	    (t
+	     (when (buffer-modified-p) ;; a new message
+	       ;; make room for it in the cache ('and should be enough)
+	       (while (>= (length mchat-message-cache)
+			  mchat-message-cache-size)
+		 (pop mchat-message-cache))
+	       ;; add it
+	       (setq mchat-message-cache
+		     (append mchat-message-cache (list str)))
+	       (setq mchat-message-cache-indice nil)
+	       (setq mchat-unsent-message nil)
+	       (erase-buffer)
+	       (set-buffer-modified-p nil))
+	     ;; Finally, send it
+	     (mchat-send-msg (cdr (assoc 'proc grp)) str)
+	     )))
+    ))
+
+(defun mchat-info (grp)
+  "Display information on the current MChat group."
+  (interactive (mchat-interactive))
+  (message "\"%s\" on %s" (car grp) (cadr grp)))
+
+(defun mchat-who (grp)
+  "Display the list of known members of the current group."
+  (interactive (mchat-interactive))
+  (with-current-buffer (process-buffer (cdr (assoc 'proc grp)))
+    (mchat-insertion
+	(mchat-with-face 'mchat-comment-face
+	  (let ((members mchat-group-members)
+		member)
+	    (if (not members)
+		(insert-before-markers
+		 "You're the only one, Max. Getting bored?\n")
+	      ;; else
+	      (insert-before-markers
+	       (concat "People currently known on `" (car grp) "' are:\n"))
+	      (while (setq member (pop members))
+		(insert-before-markers
+		 (concat "- "(cdr (assoc 'tag member)) ",\n")))
+	      (delete-backward-char 2)
+	      (insert-before-markers ".\n")))
 	  ))
     ))
 
-
-;;; Public functions --------------------------------------------------------
+(defun mchat-erase-buffer (grp)
+  "Erase the current MChat group buffer."
+  (interactive (mchat-interactive)) ;; this is just a protection
+  (with-current-buffer (process-buffer (cdr (assoc 'proc grp)))
+    (let ((buffer-read-only nil))
+      (erase-buffer))
+    ))
 
-(defun mchat-message (proc msg)
-  "Prompts you for a message to send to the mchat multicast group associated 
-with the current buffer. If not called from an mchat buffer, prompts you for 
-the group too."
-  (interactive 
-   (list (car (mchat-buffer-group-or-ask))
-	 (mchat-read-string "line: ")))
-  ;; The end of a message is signaled by a "\n"
-  (process-send-string proc (concat mchat-prompt ":" msg "\n")))
-
-(defun mchat-ring (proc)
-  "Ring the mchat group. If people are not looking at the buffer, 
-at least they can hear you... Annoy-user ;-)
-If not called from an mchat buffer, prompts you for the group too."
-  (interactive (list (car (mchat-buffer-group-or-ask))))
-  (mchat-message proc ":beep"))
+(defun mchat-discard-message (grp)
+  "Discard the contents of the current MChat message buffer."
+  (interactive (mchat-interactive))
+  (with-current-buffer (cdr (assoc 'buffer grp))
+    (erase-buffer)))
 
-(defun mchat-who (group)
-  "Displays all the people participating to the mchat group associated with
-the current buffer. If not called from an mchat buffer, prompts you for 
-the group too. This just displays the members you currently know. To actually
-send a request to the group, type `W' instead of `w' in the buffer."
-  (interactive (list (mchat-buffer-group-or-ask)))
-  (mchat-with-mchat-buffer 
-   (car group)
-   (let ((wholist (cdr (assoc 'who group))))
-     (mchat-with-meta-face
-      (insert "---\n")
-      (while wholist
-	(if (string= (car wholist) mchat-prompt)
-	    (mchat-insert-meta-line "I'm here")
-	  (mchat-insert-meta-line (concat (car wholist) " is here")))
-	(setq wholist (cdr wholist)))
-      (insert "---\n"))
-     )))
-
-(defun mchat-Who (proc)
-  "Send an identification request to the group. This will force people to
-answer, so you may update your member list if somehow you missed somebody.
-People you'd missed before will be displayed in the mchat buffer. To just 
-see the list of people you currently know, type `w' instead of `W' in the
-mchat buffer."
-  (interactive (list (car (mchat-buffer-group-or-ask))))
-  (mchat-message proc ":who"))
+(defun mchat-register (grp)
+  "Register the current group (add it to `mchat-registered-groups')."
+  (interactive (mchat-interactive))
+  (if (assoc (car grp) mchat-registered-groups)
+      (error "This group is already defined.")
+    ;; else
+    (setq mchat-registered-groups
+	  (append `((,(car grp) ,(cadr grp))) mchat-registered-groups))
+    (when (y-or-n-p "Group registered. Keep it for future sessions ? ")
+      ;; ### FIXME: should I use Custom also to set the variable, or only if
+      ;; we want to save the value ?
+      (custom-set-variables
+       `(mchat-registered-groups (quote ,mchat-registered-groups) t))
+      (custom-save-all))
+    ))
 
-(defun mchat-quit (group)
-  "Leave the mchat group and close the connection associated with the curent 
-buffer. If not called from an mchat buffer, prompts you for the group too."
-  (interactive (list (mchat-buffer-group-or-ask)))
-  ;; The hook will do the cleanup.
-  (kill-buffer (buffer-name (cdr (assoc 'buffer group)))))
-
-(defun mchat-suspend (proc)
-  "Toggle between listening and suspended mode. The normal mode is listening.
-In suspemded mode, you're still connected to the group (that is, you'll 
-answer control messages and requests) but the conversation will be lost."
-  (interactive (list (car (mchat-buffer-group-or-ask))))
-  (let* ((group (assq proc mchat-living-groups))
-	 (mode (if (equal (cdr (assoc 'mode group)) 'suspended)
-		   'listening 'suspended)))
-    (setq mchat-living-groups (remassq proc mchat-living-groups))
-    (setq group (remassoc 'mode group))
-    (setq group (append group (list (cons 'mode mode))))
-    (setq mchat-living-groups (append mchat-living-groups (list group)))
-    (mchat-with-mchat-buffer 
-     proc
-     (if (featurep 'menubar)
-	 (add-menu-button '("MChat")
-			  `[ "listening is " mchat-suspend t 
-			     ,(if (equal mode 'listening) "on" "off")]))
-     (mchat-with-meta-face
-      (mchat-insert-meta-line "mchat is %s" (symbol-name mode))))
+(defun mchat-unregister (grp)
+  "Unregister the current group (remove it to `mchat-registered-groups')."
+  (interactive (mchat-interactive))
+  (setq mchat-registered-groups (remassoc (car grp) mchat-registered-groups))
+  (when (y-or-n-p "Group unregistered. Forget it for future sessions ? ")
+    ;; ### FIXME: should I use Custom also to set the variable, or only if
+    ;; we want to save the value ?
+    (custom-set-variables
+     `(mchat-registered-groups (quote ,mchat-registered-groups) t))
+    (custom-save-all)
     ))
 
-(defun mchat-erase-buffer (group)
-  "Erase the contents of the mchat buffer. If not called from an mchat buffer,
-prompts you for the group too."
-  (interactive (list (mchat-buffer-group-or-ask)))
-  (mchat-with-mchat-buffer
-   (car group) ;; proc
-   (erase-buffer)))
-
-(defun mchat-define-group ()
-  "Add the current group to the list of predefined groups. 
-If not called from an mchat buffer, prompts you for the group too."
-  ;; The group doesn't have to be living, and doesn't have to bge known
-  ;; either. So don't use mchat-buffer-group-or-ask.
-  (interactive)
-  (let* ((grp (mchat-get-group-from 'buffer (current-buffer)))
-	 (name (or (and grp (cadr (assoc 'name grp)))
-		   (completing-read "Name: " (mchat-known-groups))))
-	 (address (or (and grp (caddr (assoc 'name grp)))
-		      (cdr (assoc name (mchat-known-groups)))
-		      (mchat-read-string "Address: "))))
-    (setq grp (cons name address))
-    (if (member grp mchat-predefined-groups)
-	(message "This group is already defined.")
-      ;; Else
-      (setq mchat-predefined-groups 
-	    (append (list grp) mchat-predefined-groups))
-      (when (y-or-n-p "Group defined. Save it for future sessions ? ")
-	(custom-set-variables 
-	 `(mchat-predefined-groups (quote ,mchat-predefined-groups) t))
-	(custom-save-all)))
-    ))
-    
-(defun mchat-remove-group ()
-  "Remove the current group from the list of predefined groups. 
-If not called from an mchat buffer, prompts you for the group too."
-  ;; The group doesn't have to be living, So don't use
-  ;; mchat-buffer-group-or-ask.
-  (interactive)
-  (let* ((grp (mchat-get-group-from 'buffer (current-buffer)))
-	 (name (or (and grp (cadr (assoc 'name grp)))
-		   (completing-read "Name: " (mchat-known-groups) nil t))))
-    (setq mchat-predefined-groups (remassoc name mchat-predefined-groups))
-    (when (y-or-n-p "Group removed. Save it for future sessions ? ")
-      (custom-set-variables 
-       `(mchat-predefined-groups (quote ,mchat-predefined-groups) t))
-      (custom-save-all))
-    ))
-    
-
-(defun mchat-group-address ()
-  "Show the address of the current mchat group. If not called from an mchat
-buffer, prompts you for the group too."
-  ;; The group doesn't have to be living. So don't use
-  ;; mchat-buffer-group-or-ask.
+(defun mchat-version ()
+  "Show the current version of MChat."
   (interactive)
-  (let* ((grp (mchat-get-group-from 'buffer (current-buffer)))
-	 (name (or (and grp (cadr (assoc 'name grp)))
-		   (completing-read "Name: " (mchat-known-groups) nil t)))
-	 (address (or (and grp (caddr (assoc 'name grp)))
-		      (cdr (assoc name (mchat-known-groups))))))
-    (message "%s address is %s" name address)))
+  (message "MChat version %s" mchat-version))
+
+
+;; MChat major mode (for the group buffers) =================================
+
+;; ### NOTE: I could let more bindings here (the message ones in particular),
+;; but since people are not supposed to live in the group buffer, I restrict
+;; the commands available on purpose.
 
-(defun mchat-version ()
-  "Print the version number of the current mchat package."
-  (interactive)
-  (message "MChat version is %s" mchat-version))
+(defvar mchat-major-mode-map
+  (let ((m (make-sparse-keymap 'mchat-major-mode-map)))
+    ;; -
+    (define-key m "e" 'mchat-erase-buffer)
+    (define-key m "b" 'mchat-ring)
+    (define-key m "w" 'mchat-who)
+    (define-key m "i" 'mchat-info)
+;;; (define-key m "s" 'mchat-suspend)
+    (define-key m "q" 'mchat-quit)
+    ;; --
+    (define-key m "r" 'mchat-register)
+    (define-key m "u" 'mchat-unregister)
+    (define-key m "o" 'mchat-switch-to-group)
+    (define-key m "x" 'mchat-bury)
+    ;; ---
+    (define-key m "v" 'mchat-version)
+    m)
+  ;; MChat major mode keymap
+  )
 
-;;;###autoload
-(defun mchat (name address)
-  "This function starts mchat on the given multicast group. You can select 
-either a predefined group (see `mchat-predefined-groups'), or give a group 
-name and an address. You can give the name you want. See the function 
-`open-multicast-group' for more details on the address.
+(defun mchat-major-mode ()
+  "Turns on the MChat major mode. Used for MChat group buffers. You're not
+supposed to use this. To join an MChat group, use `mchat' instead."
+  (kill-all-local-variables)
+  (setq buffer-read-only t)
+  (use-local-map mchat-major-mode-map)
+  (setq major-mode 'mchat-major-mode)
+  (setq mode-name mchat-major-mode-string)
+  (when (featurep 'menubar)
+    (setq mode-popup-menu mchat-submenu))
+  (run-hooks 'mchat-major-mode-hooks))
+
+
+;; MChat minor mode (for the message buffers) ===============================
 
-When called with a prefix, open the group in a newly created frame."
-  (interactive
-   ;; We won't allow the same name for different groups, so if a known name is
-   ;; given, don't ask for the address. The completion occurs for both
-   ;; predefined and current groups.
-   (let* ((groups (mchat-known-groups))
-	  (grpname (completing-read "Name: " groups))
-	  (grpaddr (or (cdr (assoc grpname groups))
-		       (mchat-read-string "Address: "))))
-     (list grpname grpaddr)))
-  (let ((group (mchat-get-group-from 'name (list name address))))
-    (if group
-	;; the group already exist, just switch to the buffer.
-	(funcall (if current-prefix-arg
-		     'switch-to-buffer-other-frame
-		   'switch-to-buffer)
-		 (cdr (assoc 'buffer group)))
-      ;; else (group doesn't exist) create a new group.
-      (let* ((bufname (concat "MChat on " name))
-	     (proc (open-multicast-group bufname bufname address)))
-	(when proc ;; usefull ?? neeeeeey.
-	  ;; Add this new group to the list.
-	  (setq mchat-living-groups
-		(cons
-		 `(,proc (name ,name ,address)
-			 (buffer . ,(process-buffer proc))
-			 (who ,mchat-prompt) ;; I know only me at startup.
-			 (mode . listening))
-		 mchat-living-groups))
-	  (set-process-filter proc 'mchat-process-filter)
-	  (if current-prefix-arg
-	      (select-frame (make-frame)))
-	  (switch-to-buffer (process-buffer proc))
-	  (delete-other-windows)
-	  (mchat-mode)
-	  (if (featurep 'menubar)
-	      (add-submenu nil mchat-submenu))
-	  ;; Announce my presence.
-	  (mchat-message proc ":join")
+(defvar mchat-minor-mode-map
+  (let ((m (make-sparse-keymap 'mchat-minor-mode-map)))
+    ;; -
+    (define-key m [(control c) (control c)] 'mchat-message)
+    (define-key m [(control c) (control d)] 'mchat-discard-message)
+    (define-key m [(meta n)] 'mchat-next-message)
+    (define-key m [(meta p)] 'mchat-previous-message)
+    (define-key m [(meta P)] 'mchat-first-message)
+    (define-key m [(meta N)] 'mchat-last-message)
+    ;; --
+    (define-key m [(control c) (control e)] 'mchat-erase-buffer)
+    (define-key m [(control c) (control b)] 'mchat-ring)
+    (define-key m [(control c) (control w)] 'mchat-who)
+    (define-key m [(control c) (control i)] 'mchat-info)
+;;; (define-key m "s" 'mchat-suspend)
+    (define-key m [(control c) (control q)] 'mchat-quit)
+    ;; ---
+    (define-key m [(control c) (control r)] 'mchat-register)
+    (define-key m [(control c) (control u)] 'mchat-unregister)
+    (define-key m [(control c) (control o)] 'mchat-switch-to-group)
+    (define-key m [(control c) (control x)] 'mchat-bury)
+    ;; ----
+    (define-key m [(control c) (control v)] 'mchat-version)
+    m)
+  ;; MChat minor mode keymap
+  )
+
+(make-variable-buffer-local
+ (defvar mchat-minor-mode nil))
+
+(defun mchat-minor-mode (arg)
+  "Toggles the MChat minor mode. Used for MChat message buffers. You're not
+supposed to use this. To join an MChat group, use `mchat' instead."
+  (interactive "*P")
+  (setq mchat-minor-mode
+	(if (null arg) (not mchat-minor-mode)
+	  (> (prefix-numeric-value arg) 0)))
+  (when (featurep 'menubar)
+    ;; I know, I know, this should be the *major* mode menu, not mine.
+    (setq mode-popup-menu mchat-submenu))
+  (run-hooks 'mchat-minor-mode-hooks))
+
+(add-minor-mode
+ 'mchat-minor-mode mchat-minor-mode-string mchat-minor-mode-map)
+
+
+;; MChat group creation routines ============================================
+
+;; It's OK to call mchat-kill-group, because it's OK to re-kill killed
+;; buffers.
+(defun mchat-kill-buffer-hook ()
+  (mchat-kill-group (assoc mchat-group-name mchat-groups)))
+
+(defun mchat-heart-bit (proc)
+  ;; Timeout to resend a `heart-bit' message
+  (mchat-send-heart-bit proc))
+
+(defun mchat-zombie-check (buffer)
+  (with-current-buffer buffer
+    (let ((members mchat-group-members)
+	  (now (mchat-current-time))
+	  member)
+      (while (setq member (pop members))
+	(when (> now (+ (cdr (assoc 'time-stamp member))
+			(* mchat-heart-bit-delay mchat-zombie-latency)))
+	  ;; this guy must be dead
+	  (setq mchat-group-members
+		(remassoc (car member) mchat-group-members))
+	  (mchat-insertion
+	    (mchat-with-face 'mchat-comment-face
+	      (insert-before-markers
+	       (concat (cdr (assoc 'tag member)) " seems to have died.\n"))))
 	  )))
     ))
 
+(defun mchat-create-group (name address)
+  ;; Create the MChat group NAME at address ADDRESS, update mchat-groups, and
+  ;; return the group description.
+  (let* ((bufname (concat "MChat (" name ")"))
+	 (proc (open-multicast-group bufname bufname address))
+	 (buf (get-buffer-create (concat "MChat message (" name ")")))
+	 (desc `(,name
+		 ,address
+		 (buffer . ,buf)
+		 (proc . ,proc))))
+    ;; Group buffer setup
+    (with-current-buffer bufname
+      (mchat-major-mode)
+      (setq mchat-group-name name)
+      ;; ### NOTE: it's a bit silly, but sending the 'join message will delete
+      ;; this timeout and reput it after :-/
+      (setq mchat-heart-bit-timeout
+	    (add-timeout mchat-heart-bit-delay 'mchat-heart-bit proc
+			 mchat-heart-bit-delay))
+      ;; I'm not sure this is really needed all the time, but in case the
+      ;; menubar is not the default one, make sure we have the submenu.
+      (and (featurep 'menubar) (add-submenu nil mchat-submenu))
+      (make-local-hook 'kill-buffer-hook)
+      (add-hook 'kill-buffer-hook 'mchat-kill-buffer-hook nil t))
+    ;; Message buffer setup
+    (with-current-buffer buf
+      (apply (intern (concat (symbol-name mchat-message-buffer-major-mode)
+			     "-mode"))
+	     nil) ;; I'm not sure why this is needed.
+      (setq mchat-group-name name)
+      (mchat-minor-mode 1)
+      (make-local-hook 'kill-buffer-hook)
+      (add-hook 'kill-buffer-hook 'mchat-kill-buffer-hook nil t))
+    ;; Final setup:
+    (set-process-filter proc 'mchat-process-filter)
+    (set-marker (process-mark proc) (point) (process-buffer proc))
+    (setq desc
+	  (append desc (list (cons 'zombie-check
+				   (add-timeout (* mchat-zombie-latency
+						   mchat-heart-bit-delay)
+						'mchat-zombie-check
+						(process-buffer proc)
+						(* mchat-zombie-latency
+						   mchat-heart-bit-delay))))))
+    ;; say `hello'
+    (mchat-send-join proc)
+    (setq mchat-groups (cons desc mchat-groups))
+    desc))
+
+;; ### FIXME: remove this function. It seems to be used only once.
+(defun mchat-known-groups ()
+  ;; Returns an alist of elements of the form (NAME  ADDRESS) for ALL groups
+  ;; known to MChat. This includes those in `mchat-registered-groups', and
+  ;; those that are currently known but not registered. Since group names must
+  ;; be unique, it's quicker to match the names only.
+  (let ((grps mchat-groups) grp res)
+    (while (setq grp (pop grps))
+      (if (not (assoc (car grp) mchat-registered-groups))
+	  (setq res (cons (list (car grp) (cadr grp)) res))))
+    (append res mchat-registered-groups)
+    ))
+
+(defsubst mchat-all-interactive ()
+  ;; We don't allow the same name for different groups, so if a known group
+  ;; name is given, don't ask for the address. The completion occurs for both
+  ;; predefined groups and groups that exist but are not registered.
+  (let* ((grps (mchat-known-groups))
+	 (grpname (completing-read "Name: " grps))
+	 (grpaddr (or (cadr (assoc grpname grps))
+		      (read-string "Address: "))))
+    (list grpname grpaddr)
+    ))
+
+(defmacro mchat-sanity-check ()
+  ;; For non interactive calls, check the validity of the given address, or
+  ;; find it. Really, I'm too good to you, guys.
+  `(unless (interactive-p)
+     (let ((grp (assoc name mchat-registered-groups)))
+       (if grp
+	   (if (not address)
+	       (setq address (cadr grp))
+	     (or (equal address (cadr grp))
+		 (error "Address doesn't not match group name!")))
+	 (or address
+	     (error "No address given for unregistered group!"))))))
+
+(defmacro mchat-maybe-create-and-switch-to-group (&rest body)
+  ;; Maybe create the group, execute body, and setup the frame
+  `(let ((grp (assoc name mchat-groups)))
+     (unless grp
+       (setq grp (mchat-create-group name address)))
+     ,@body
+     (mchat-switch-to-group grp)))
+
+;;;###autoload
+(defun mchat (name &optional address)
+  "Join MChat multicast group NAME at adress ADDRESS. When called
+interactively, you will be prompted for the group name, and if the group is
+not registered, for the corresponding multicast address. Please refer to
+`mchat-predefined-groups' for a list of known groups, and
+`open-multicast-group' for the syntax of ADDRESS."
+  (interactive (mchat-all-interactive))
+  (mchat-sanity-check)
+  (mchat-maybe-create-and-switch-to-group))
+
+;;;###autoload
+(defun mchat-other-frame (name &optional address)
+  "Like `mchat', but pop up a new frame."
+  (interactive (mchat-all-interactive))
+  (mchat-sanity-check)
+  (mchat-maybe-create-and-switch-to-group
+   (select-frame (make-frame))))
+
 (provide 'mchat)
 
-(run-hooks 'mchat-loaded-hook)
-
+(run-hooks 'mchat-loaded-hooks)
 
 ;;; mchat.el ends here