# HG changeset patch # User steveb # Date 888508278 0 # Thu Feb 26 15:51:18 1998 +0000 # Node ID bd9908088c52b8714b5b6bf152c7676b1821751c # Parent 98e01d861d7b8ab946c8c9a59ed2e23f0b37f877 Add `q' for tar-mode Add new file mchat.el diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +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. diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -19,7 +19,7 @@ # 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 diff --git a/mchat.el b/mchat.el new file mode 100644 --- /dev/null +++ b/mchat.el @@ -0,0 +1,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 diff --git a/package-info.in b/package-info.in --- a/package-info.in +++ b/package-info.in @@ -13,7 +13,7 @@ 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 )) diff --git a/tar-mode.el b/tar-mode.el --- a/tar-mode.el +++ b/tar-mode.el @@ -445,8 +445,14 @@ 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) @@ -454,23 +460,22 @@ (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))) @@ -506,6 +511,8 @@ ["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] )) @@ -1383,6 +1390,11 @@ (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