Commits

Anonymous committed bd99080

Add `q' for tar-mode
Add new file mchat.el

Comments (0)

Files changed (5)

+1998-02-21  Aki Vehtari  <Aki.Vehtari@hut.fi>
+
+	* tar-mode.el:  Add "q" for quit, and use "C" for copy and "R" for
+	rename as in dired. 
+
 1998-02-15  SL Baur  <steve@altair.xemacs.org>
 
 	* jka-compr.el: Reenable auto-compression-mode symbol.
 
 # This XEmacs package contains independent single file lisp packages
 
-VERSION = 1.05
+VERSION = 1.06
 AUTHOR_VERSION =
 MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
 PACKAGE = os-utils
+;;; 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
    filename FILENAME
    md5sum MD5SUM
    size SIZE
-   provides (archive-mode background crypt crypt++ inf-lisp jka-compr lpr ps-print tar-mode telnet terminal uncompress)
+   provides (archive-mode background crypt crypt++ inf-lisp jka-compr lpr mchat ps-print tar-mode telnet terminal uncompress)
    requires (REQUIRES)
    type single
 ))
     nil
   (setq tar-mode-map (make-keymap))
   (suppress-keymap tar-mode-map)
-  (define-key tar-mode-map " " 'tar-next-line)
-  (define-key tar-mode-map "c" 'tar-copy)
+  ;; Commands to mark certain categories of files
+  ;; Upper case keys for operating on the marked files
+  (define-key tar-mode-map "C" 'tar-copy)
+  (define-key tar-mode-map "R" 'tar-rename-entry)
+  (define-key tar-mode-map "M" 'tar-chmod-entry)
+  (define-key tar-mode-map "G" 'tar-chgrp-entry)
+  (define-key tar-mode-map "O" 'tar-chown-entry)
+  ;; Lower keys for commands not operating on all the marked files
   (define-key tar-mode-map "d" 'tar-flag-deleted)
   (define-key tar-mode-map "\^D" 'tar-flag-deleted)
   (define-key tar-mode-map "e" 'tar-extract)
   (define-key tar-mode-map [return] 'tar-extract)
   (define-key tar-mode-map "g" 'revert-buffer)
   (define-key tar-mode-map "h" 'describe-mode)
-  (define-key tar-mode-map "n" 'tar-next-line)
-  (define-key tar-mode-map "\^N" 'tar-next-line)
-  (define-key tar-mode-map [down] 'tar-next-line)
   (define-key tar-mode-map "o" 'tar-extract-other-window)
-  (define-key tar-mode-map "p" 'tar-previous-line)
-  (define-key tar-mode-map "\^P" 'tar-previous-line)
-  (define-key tar-mode-map [up] 'tar-previous-line)
-  (define-key tar-mode-map "r" 'tar-rename-entry)
+  (define-key tar-mode-map "q" 'tar-quit)
   (define-key tar-mode-map "u" 'tar-unflag)
   (define-key tar-mode-map "v" 'tar-view)
   (define-key tar-mode-map "x" 'tar-expunge)
   (define-key tar-mode-map 'backspace 'tar-unflag-backwards)
   (define-key tar-mode-map 'delete 'tar-unflag-backwards)
   (define-key tar-mode-map "E" 'tar-extract-other-window)
-  (define-key tar-mode-map "M" 'tar-chmod-entry)
-  (define-key tar-mode-map "G" 'tar-chgrp-entry)
-  (define-key tar-mode-map "O" 'tar-chown-entry)
+  ;; moving
+  (define-key tar-mode-map " " 'tar-next-line)
+  (define-key tar-mode-map "n" 'tar-next-line)
+  (define-key tar-mode-map "\^N" 'tar-next-line)
+  (define-key tar-mode-map [down] 'tar-next-line)
+  (define-key tar-mode-map "p" 'tar-previous-line)
+  (define-key tar-mode-map "\^P" 'tar-previous-line)
+  (define-key tar-mode-map [up] 'tar-previous-line)
 
   (cond ((and (featurep 'xemacs)
 	      (not (featurep 'infodock)))
     ["Edit Subfile Other Window" tar-extract-other-window t]
     ["Edit Subfile" tar-extract t]
     ["View Subfile" tar-view t]
+    "----"
+    ["Quit Tar Mode" tar-quit t]
     ))
 
 
     (fset 'tar-real-set-auto-mode (symbol-function 'set-auto-mode)))
 (fset 'set-auto-mode 'tar-set-auto-mode)
 
+(defun tar-quit ()
+  "Kill the current tar buffer."
+  (interactive)
+  (kill-buffer nil))
+
 (provide 'tar-mode)
 
 ;;; tar-mode.el ends here