1. xemacs
  2. os-utils

Source

os-utils / mchat.el

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
;;; mchat.el --- Multicast Chatting package for XEmacs.

;; Copyright (C) 1997-1998 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

;; This file is part of MChat.				 

;; MChat 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, 
;; 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.


;;; 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)

;; 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.

;; 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.


;;; 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 --------------------------------------------------------

(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-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-loaded-hook nil
  "*Hook to run when mchat is loaded. Convenient place to set variables."
  :type 'hook
  :group 'mchat)

(defface mchat-prompt-face '((t (:bold t)))
  "*The face to display mchat prompts with."
  :group 'mchat)

(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').
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."
  :group 'mchat
  :type '(repeat (cons (string :tag "   Name")
		       (string :tag "Address"))))

(defconst mchat-version "0.17"
  "Guess what ? ...")


;;; 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 ?!")

(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.
      )
  )

(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 !")


;;; Internal misc utilities -------------------------------------------------

(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)))
    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)))

(defmacro mchat-with-meta-face (&rest body)
  ;; Execute body and put all inserted text in mchat-meta-face
  `(let ((start (point)))
     ,@body
     (set-extent-face (make-extent start (point)) 'mchat-meta-face)))


;;; Private functions ------------------------------------------------------

(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-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-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-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-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")))

(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"))))
	    ))
     )))

(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-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))
	  ))
    ))


;;; Public functions --------------------------------------------------------

(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-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-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-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.
  (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)))

(defun mchat-version ()
  "Print the version number of the current mchat package."
  (interactive)
  (message "MChat version is %s" mchat-version))

;;;###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.

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")
	  )))
    ))

(provide 'mchat)

(run-hooks 'mchat-loaded-hook)


;;; mchat.el ends here