;;; arc-mode.el --- simple editing of archives
-;;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Author: Morten Welinder (terra@diku.dk)
;; Keywords: archives msdog editing major-mode
;; Favourite-brand-of-beer: None, I hate beer.
-;;; This file is part of GNU Emacs.
-;;;
-;;; GNU Emacs 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, or (at your option)
-;;; any later version.
-;;;
-;;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to
-;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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, or (at your option)
+;; any later version.
+
+;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
-;;
+
;; NAMING: "arc" is short for "archive" and does not refer specifically
;; to files whose name end in ".arc"
;;
;; Section: Configuration.
(defvar archive-dos-members t
- "*If non-nil then recognize member files using ^M^J as line terminator
-and do The Right Thing.")
+ "*If non-nil then recognize member files using ^M^J as line terminator.")
(defvar archive-tmpdir
(expand-file-name
(or (getenv "TMPDIR") (getenv "TMP") "/tmp"))
"*Directory for temporary files made by arc-mode.el")
-(defvar archive-remote-regexp "^/[^/:]*[^/:]:"
- "*Regexp recognizing archive files names that are not local (i.e., are
-not proper file names outside Emacs). A local copy a the archive will
-be used when updating.")
+(defvar archive-remote-regexp "^/[^/:]*[^/:.]:"
+ "*Regexp recognizing archive files names that are not local.
+A non-local file is one whose file name is not proper outside Emacs.
+A local copy of the archive will be used when updating.")
(defvar archive-extract-hooks nil
"*Hooks to run when an archive member has been extracted.")
;; to extract to stdout without junk getting added.
(defvar archive-arc-extract
'("arc" "x")
- "*Program and its options to run in order to extract an arc file member
-to the current directory. Archive and member name will be added.")
+ "*Program and its options to run in order to extract an arc file member.
+Extraction should happen to the current directory. Archive and member
+name will be added.")
(defvar archive-arc-expunge
'("arc" "d")
(defvar archive-lzh-extract
'("lha" "pq")
- "*Program and its options to run in order to extract an lzh file member
-to standard output. Archive and member name will be added.")
+ "*Program and its options to run in order to extract an lzh file member.
+Extraction should happen to standard output. Archive and member name will
+be added.")
(defvar archive-lzh-expunge
'("lha" "d")
;; Zip archive configuration
(defvar archive-zip-use-pkzip (memq system-type '(ms-dos windows-nt))
- "*If non-nil then all zip options default to values suitable when using
-pkzip and pkunzip. Only set to true for msdog systems!")
+ "*If non-nil then pkzip option are used instead of zip options.
+Only set to true for msdog systems!")
(defvar archive-zip-extract
(if archive-zip-use-pkzip '("pkunzip" "-e") '("unzip" "-qq" "-c"))
- "*Program and its options to run in order to extract a zip file member
-to standard output. Archive and member name will be added.\n
-If `archive-zip-use-pkzip' is non-nil then this program is expected to
-extract to a file junking the directory part of the name.")
+ "*Program and its options to run in order to extract a zip file member.
+Extraction should happen to standard output. Archive and member name will
+be added. If `archive-zip-use-pkzip' is non-nil then this program is
+expected to extract to a file junking the directory part of the name.")
-;; For several reasons the latter behaviour is not desireable in general.
+;; For several reasons the latter behaviour is not desirable in general.
;; (1) It uses more disk space. (2) Error checking is worse or non-
;; existent. (3) It tends to do funny things with other systems' file
;; names.
(defvar archive-zip-update-case
(if archive-zip-use-pkzip archive-zip-update '("zip" "-q" "-k"))
- "*Program and its options to run in order to update a case fiddled
-zip file member. Options should ensure that specified directory will
-be put into the zip file. Archive and member name will be added.")
+ "*Program and its options to run in order to update a case fiddled zip member.
+Options should ensure that specified directory will be put into the zip file.
+Archive and member name will be added.")
(defvar archive-zip-case-fiddle t
- "*If non-nil then zip file members are mapped to lower case if created
-by a system that under single case file names.")
+ "*If non-nil then zip file members are case fiddled.
+Case fiddling will only happen for members created by a system that
+uses caseless file names.")
;; ------------------------------
;; Zoo archive configuration
(defvar archive-zoo-extract
'("zoo" "xpq")
- "*Program and its options to run in order to extract a zoo file member
-to standard output. Archive and member name will be added.")
+ "*Program and its options to run in order to extract a zoo file member.
+Extraction should happen to standard output. Archive and member name will
+be added.")
(defvar archive-zoo-expunge
'("zoo" "DqPP")
(make-variable-buffer-local 'archive-subfile-mode)
(put 'archive-subfile-mode 'permanent-local t)
-;; buffer-file-type is a per-buffer variable in the msdog configuration
-(if (boundp 'buffer-file-type) nil
- (defvar buffer-file-type nil
- "*Nil for dos-style text file, non-nil otherwise.")
- (make-variable-buffer-local 'buffer-file-type)
- (put 'buffer-file-type 'permanent-local t)
- (setq-default buffer-file-type nil))
-
(defvar archive-subfile-dos nil
- "Negation of `buffer-file-type' which see.")
+ "Negation of `buffer-file-type', which see.")
(make-variable-buffer-local 'archive-subfile-dos)
(put 'archive-subfile-dos 'permanent-local t)
-(defvar archive-files nil "Vector of file descriptors. Each descriptor is
-a vector of [ext-file-name int-file-name case-fiddled mode ...]")
+(defvar archive-files nil
+ "Vector of file descriptors.
+Each descriptor is a vector of the form
+ [EXT-FILE-NAME INT-FILE-NAME CASE-FIDDLED MODE ...]")
(make-variable-buffer-local 'archive-files)
(defvar archive-lemacs
(intern (concat "archive-" (symbol-name archive-subtype) "-" suffix)))
(defun archive-l-e (str &optional len)
- "Convert little endian string/vector to integer. Alternatively, first
-argument may be a buffer position in the current buffer in which case a
-second arguemnt, length, should be supplied."
+ "Convert little endian string/vector to integer.
+Alternatively, first argument may be a buffer position in the current buffer
+in which case a second argument, length, should be supplied."
(if (stringp str)
(setq len (length str))
(setq str (buffer-substring str (+ str len))))
str))
(defun archive-calc-mode (oldmode newmode &optional error)
- "From the integer OLDMODE and the string NEWMODE calculate a new file
-mode.\n
+ "From the integer OLDMODE and the string NEWMODE calculate a new file mode.
NEWMODE may be an octal number including a leading zero in which case it
will become the new mode.\n
NEWMODE may also be a relative specification like \"og-rwx\" in which case
0))
(defun archive-get-descr (&optional noerror)
- "Return the descriptor vector for file at point. Do not signal an error
-if optional second argument NOERROR is non-nil."
+ "Return the descriptor vector for file at point.
+Does not signal an error if optional second argument NOERROR is non-nil."
(let ((no (archive-get-lineno)))
(if (and (>= (point) archive-file-list-start)
(< no (length archive-files)))
;;;###autoload
(defun archive-mode (&optional force)
- "Major mode for viewing an archive file as a dired-like listing of its
-contents. You can move around using the usual cursor motion commands.
+ "Major mode for viewing an archive file in a dired-like way.
+You can move around using the usual cursor motion commands.
Letters no longer insert themselves.
Type `e' to pull a file out of the archive and into its own buffer;
or click mouse-2 on the file's line in the archive mode buffer.
(setq require-final-newline nil)
(make-local-variable 'enable-local-variables)
(setq enable-local-variables nil)
- (setq buffer-file-type t)
+ (if (boundp 'default-buffer-file-type)
+ (setq buffer-file-type t))
(make-local-variable 'archive-read-only)
(setq archive-read-only (not (file-writable-p (buffer-file-name))))
(archive-next-line no)))
(defun archive-summarize-files (files)
- "Insert a desciption of a list of files annotated with proper mouse face"
+ "Insert a description of a list of files annotated with proper mouse face."
(setq archive-file-list-start (point-marker))
(setq archive-file-name-indent (if files (aref (car files) 1) 0))
;; We don't want to do an insert for each element since that takes too
(setq archive-file-list-end (point-marker)))
(defun archive-alternate-display ()
- "Toggle alternative display. To avoid very long lines some archive mode
-don't show all information. This function changes the set of information
-shown for each files."
+ "Toggle alternative display.
+To avoid very long lines some archive mode don't show all information.
+This function changes the set of information shown for each files."
(interactive)
(setq archive-alternate-display (not archive-alternate-display))
(archive-resummarize))
(set-buffer-modified-p (or modified (not unchanged))))))
(defun archive-delete-local (name)
- "Delete (robust) the file NAME and its parents up to and including the
-value of `archive-tmpdir'."
+ "Delete file NAME and its parents up to and including `archive-tmpdir'."
(let ((again t)
(top (directory-file-name (file-name-as-directory archive-tmpdir))))
(condition-case nil
(make-local-variable 'local-write-file-hooks)
(add-hook 'local-write-file-hooks 'archive-write-file-member)
(setq archive-subfile-mode descr)
- (setq archive-subfile-dos nil
- buffer-file-type t)
+ (setq archive-subfile-dos nil)
+ (if (boundp 'default-buffer-file-type)
+ (setq buffer-file-type t))
(if (fboundp extractor)
(funcall extractor archive ename)
(archive-*-extract archive ename (symbol-value extractor)))
(archive-extract 'view))
(defun archive-add-new-member (arcbuf name)
- "Add the file in the current buffer to the archive in ARCBUF naming it
-NAME."
+ "Add current buffer to the archive in ARCBUF naming it NAME."
(interactive
(list (get-buffer
(read-buffer "Buffer containing archive: "
;; Section: IO stuff
(defun archive-check-dos (&optional force)
- "*If this looks like a buffer with ^M^J as line terminator then remove
-those ^Ms and set archive-subfile-dos."
+ "*Possibly handle a buffer with ^M^J terminated lines."
(save-restriction
(widen)
(save-excursion
(goto-char (point-min))
(setq archive-subfile-dos
(or force (not (search-forward-regexp "[^\r]\n" nil t))))
- (setq buffer-file-type (not archive-subfile-dos))
+ (if (boundp 'default-buffer-file-type)
+ (setq buffer-file-type (not archive-subfile-dos)))
(if archive-subfile-dos
(let ((modified (buffer-modified-p)))
(buffer-disable-undo (current-buffer))
(while (search-forward "\n" nil t)
(replace-match "\r\n"))
(setq archive-subfile-dos nil)
- (setq buffer-file-type t)
+ (if (boundp 'default-buffer-file-type)
+ (setq buffer-file-type t))
;; OK, we're now have explicit ^M^Js -- save and re-unixfy
(archive-write-file-member))
(progn
(archive-next-line (- p)))
(defun archive-chmod-entry (new-mode)
- "Change the protection bits associated with all marked or this member
-in the archive.\n\
+ "Change the protection bits associated with all marked or this member.
The new protection bits can either be specified as an octal number or
as a relative change like \"g+rw\" as for chmod(2)"
(interactive "sNew mode (octal or relative): ")
(modtime (archive-l-e (+ p 16) 2))
(ucsize (archive-l-e (+ p 20) 4))
(namefld (buffer-substring (+ p 38) (+ p 38 13)))
- (fnlen (or (string-match "\0" namefld) 13))
- (efnname (substring namefld 0 fnlen))
- (fiddle (string= efnname (upcase efnname)))
+ (dirtype (char-after (+ p 4)))
+ (lfnlen (if (= dirtype 2) (char-after (+ p 56)) 0))
+ (ldirlen (if (= dirtype 2) (char-after (+ p 57)) 0))
+ (fnlen (+ ldirlen
+ (if (> lfnlen 0)
+ (1- lfnlen)
+ (or (string-match "\0" namefld) 13))))
+ (efnname (concat
+ (if (> ldirlen 0)
+ (concat (buffer-substring
+ (+ p 58 lfnlen) (+ p 58 lfnlen ldirlen -1))
+ "/")
+ "")
+ (if (> lfnlen 0)
+ (buffer-substring (+ p 58) (+ p 58 lfnlen -1))
+ (substring namefld 0 fnlen))))
+ (fiddle (and (= lfnlen 0) (string= efnname (upcase efnname))))
(ifnname (if fiddle (downcase efnname) efnname))
(text (format " %8d %-11s %-8s %s"
ucsize