# HG changeset patch
# User didierv
# Date 965392692 0
#      Fri Aug 04 12:38:12 2000 +0000
# Node ID e3f72d8c3341f14a6c52f24b9931919ee58ef8db
# Parent  4d5331fca01012f4dece19c83fd6184a85c4b9e5
MChat 2.1

diff --git a/mchat.el b/mchat.el
--- a/mchat.el
+++ b/mchat.el
@@ -1,11 +1,11 @@
 ;;; mchat.el --- Multicast Chatting package for XEmacs
 
-;; Copyright (C) 1997-99 Didier Verna.
+;; Copyright (C) 1997-2000 Didier Verna.
 
 ;; 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: Sat Mar 20 15:51:04 1999
+;; Last Revision: Fri Aug  4 13:47:56 2000
 ;; Keywords:      comm processes
 
 ;; This file is part of XEmacs.
@@ -36,6 +36,10 @@
 ;; feature, and almost nobody knew it, appart from the other developpers. This
 ;; version is much improved and completely backward incompatible ;-).
 
+;; #### NOTE: before using this package, you most likely have to customize the
+;; `mchat-nsl-method' first. It specifies a program like nsl or nslookup in
+;; order to retreive the IP number of your machine.
+
 ;; 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
@@ -43,7 +47,7 @@
 ;; at the bindings (C-h b) in MChat buffers, or at the menubar entries to get
 ;; an idea of what you can do.
 
-;; ### WARNING: the current version (but there's also a limitation in the
+;; #### 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).
@@ -51,9 +55,9 @@
 
 ;;; 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.
+;; The original idea of MChat is from Philippe Dax <dax@infres.enst.fr>. Akim
+;; Demaille <akim@epita.fr> was *THE* beta tester for the 2.0 release. Many
+;; good ideas come from him.
 
 
 ;;; TODO:
@@ -98,8 +102,8 @@
   :type 'integer)
 
 (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."
+  "*If non nil, consider the message caches as circular lists, allowing
+to jump directly from one end to the other."
   :group 'mchat
   :type 'boolean)
 
@@ -110,17 +114,17 @@
   :type 'symbol)
 
 (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:
+  "*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.
+  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)."
+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)
@@ -147,8 +151,8 @@
   :type 'hook)
 
 (defcustom mchat-before-send-hooks nil
-  "*Hooks to run before sending a message. The hooks are executed in the MChat
-message buffer."
+  "*Hooks to run before sending a message. The hooks are executed in the
+MChat message buffer."
   :group 'mchat
   :type 'hook)
 
@@ -207,9 +211,9 @@
 ;; Private variables ========================================================
 
 ;; $Format: "(defconst mchat-prcs-major-version \"$ProjectMajorVersion$\")"$
-(defconst mchat-prcs-major-version "version-2-0")
+(defconst mchat-prcs-major-version "version-2-1")
 ;; $Format: "(defconst mchat-prcs-minor-version \"$ProjectMinorVersion$\")"$
-(defconst mchat-prcs-minor-version "2")
+(defconst mchat-prcs-minor-version "1")
 (defconst mchat-version
   (let ((level mchat-prcs-minor-version)
 	major minor status)
@@ -227,7 +231,7 @@
 	   (concat major "." minor "-b" level)))
     ))
 
-;; ### NOTE: the group informations stored in each entry are constant stuff.
+;; #### 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
@@ -301,7 +305,7 @@
     [ "ring bell" mchat-ring t ]
     [ "show who's here" mchat-who t ]
     [ "show info" mchat-info t ]
-;;; [ "listening is " mchat-suspend t "on" ]
+    ;;[ "listening is " mchat-suspend t "on" ]
     [ "quit" mchat-quit t ]
     "Control:"
     "---"
@@ -374,35 +378,41 @@
   ;; 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)
+(defvar mchat-user-id nil
+  ;; #### FIXME: is it necessary to use 64bits for pids ?
   ;; 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.
   )
 
+(defun mchat-user-id ()
+  ;; Build and return the user id, or nil.
+  (condition-case nil
+      (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)
+    (t nil)
+    ))
+
 ;; MChat protocol atoms
 (defconst mchat-protocol-atom-join      (int-to-char 0))
 (defconst mchat-protocol-atom-quit      (int-to-char 1))
@@ -414,7 +424,7 @@
 
 ;; Message sending routines ------------------------------------------------
 
-;; ### NOTE: should implement message fragmentation
+;; #### 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.
@@ -492,7 +502,7 @@
 (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'.
+  ;; #### WARNING: BODY must use `insert-before-markers', not `insert'.
   `(save-excursion
      (let ((proc (get-buffer-process (current-buffer)))
 	   buffer-read-only)
@@ -502,7 +512,7 @@
      ))
 (put 'mchat-insertion 'lisp-indent-function 0)
 
-;; ### NOTE: For some reason, I've noticed that I'm likely to receive several
+;; #### 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
@@ -538,10 +548,10 @@
 	))
     ))
 
-;; ### 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.
+;; #### 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)))
@@ -616,7 +626,7 @@
 		   (while (setq msg (pop messages))
 		     (mchat-treat-data grp id msg))))))
 	    (t ;; completely known
-	     ;; ### FIXME: should check if tag is still the same
+	     ;; #### FIXME: should check if tag is still the same
 	     (mchat-update-time-stamp id))))
     ))
 
@@ -717,7 +727,7 @@
 		   (setq end (point))
 		   (run-hook-with-args 'mchat-treat-message-hooks
 				       beg end))))))
-      ;; ### WARNING: do this outside buf !!
+      ;; #### WARNING: do this outside buf !!
       ;; Now possibly flash if the buffer is not visible (but not if
       ;; we're in it).
       (when flash
@@ -774,7 +784,7 @@
 	   (mchat-treat-heart-bit grp id)))
 	))
 
-;; ### FIXME: I think we can loose UDP packets, but we can assume that if one
+;; #### 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
@@ -805,7 +815,7 @@
 	       "(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
+      ;; #### 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)))
@@ -856,7 +866,7 @@
     (when wcs
       (set-frame-property (selected-frame)
 			  'mchat-window-configurations (cdr wcs))
-      ;; ### NOTE: `set-window-configuration' doesn't seem to produce any
+      ;; #### 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)))
@@ -873,7 +883,7 @@
 	 (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
+    ;; #### 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 !!
@@ -892,9 +902,10 @@
 
 ;; 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.
+;; #### 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)))
@@ -983,7 +994,7 @@
       (mchat-pop-cached-message 0))
     ))
 
-;; ### NOTE: contrary to `mchat-next-message', this function doesn't consider
+;; #### 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)
@@ -1074,7 +1085,7 @@
     (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
+      ;; #### 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))
@@ -1086,7 +1097,7 @@
   (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
+    ;; #### 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))
@@ -1101,7 +1112,7 @@
 
 ;; MChat major mode (for the group buffers) =================================
 
-;; ### NOTE: I could let more bindings here (the message ones in particular),
+;; #### 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.
 
@@ -1216,8 +1227,15 @@
     ))
 
 (defun mchat-create-group (name address)
-  ;; Create the MChat group NAME at address ADDRESS, update mchat-groups, and
-  ;; return the group description.
+  ;; Ensure the user id is created, create the MChat group NAME at address
+  ;; ADDRESS, update mchat-groups, and return the group description.
+  ;; #### NOTE: previously, the user id was created at load time which was
+  ;; VERY BAD, because the user would not have the opportunity to correct a
+  ;; bogus nsl-method.
+  (unless mchat-user-id
+    (or (setq mchat-user-id (mchat-user-id))
+	(error "Can't build user id. Please check your mchat-nsl-method.")
+	))
   (let* ((bufname (concat "MChat (" name ")"))
 	 (proc (open-multicast-group bufname bufname address))
 	 (buf (get-buffer-create (concat "MChat message (" name ")")))
@@ -1229,8 +1247,8 @@
     (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 :-/
+      ;; #### 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))
@@ -1264,7 +1282,7 @@
     (setq mchat-groups (cons desc mchat-groups))
     desc))
 
-;; ### FIXME: remove this function. It seems to be used only once.
+;; #### 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