:type 'directory
:group 'archive)
-(defvar archive-file-name-invalid-regexp
- (cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
- (concat "\\(^\\([A-z]:\\)?/?.*:\\)\\|" ; colon except after drive
- "[+, ;=|<>\"?*]\\|\\[\\|\\]\\|" ; invalid characters
- "\\(/\\.\\.?[^/]\\)\\|" ; leading dots
- "\\(/[^/.]+\\.[^/.]*\\.\\)")) ; more than a single dot
- ((memq system-type '(ms-dos windows-nt))
- (concat "\\(^\\([A-z]:\\)?/?.*:\\)\\|" ; colon except after drive
- "[|<>\"?*]")) ; invalid characters
- (t "[\000]"))
- "Regexp recognizing file names which aren't allowed by the filesystem.")
-
(defcustom 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.
(make-local-variable 'require-final-newline)
(setq require-final-newline nil)
- (make-local-variable 'enable-local-variables)
- (setq enable-local-variables nil)
+ (make-local-variable 'local-enable-local-variables)
+ (setq local-enable-local-variables nil)
(make-local-variable 'archive-read-only)
;; Archives which are inside other archives and whose
(setq archive-read-only
(or (not (file-writable-p (buffer-file-name)))
(and archive-subfile-mode
- (string-match archive-file-name-invalid-regexp
+ (string-match file-name-invalid-regexp
(aref archive-subfile-mode 0)))))
;; Should we use a local copy when accessing from outside Emacs?
(or archive-remote
(setq archive-remote
(or (string-match archive-remote-regexp (buffer-file-name))
- (string-match archive-file-name-invalid-regexp
+ (string-match file-name-invalid-regexp
(buffer-file-name)))))
(setq major-mode 'archive-mode)
Optional argument SHUT-UP, if non-nil, means don't print messages
when parsing the archive."
(widen)
+ (set-buffer-multibyte nil)
(let (buffer-read-only)
(or shut-up
(message "Parsing archive file..."))
file by that name already exists in DIR, a unique new name is generated
using `make-temp-name', and the generated name is returned."
(let ((fullname (expand-file-name fname dir))
- (alien (string-match archive-file-name-invalid-regexp fname)))
+ (alien (string-match file-name-invalid-regexp fname)))
(if (or alien (file-exists-p fullname))
(make-temp-name
(expand-file-name
;; -------------------------------------------------------------------------
;; Section: Member extraction
+(defun archive-file-name-handler (op &rest args)
+ (or (eq op 'file-exists-p)
+ (let ((file-name-handler-alist nil))
+ (apply op args))))
+
+(defun archive-set-buffer-as-visiting-file (filename)
+ "Set the current buffer as if it were visiting FILENAME."
+ (save-excursion
+ (goto-char (point-min))
+ (let ((coding
+ (or coding-system-for-read
+ (and set-auto-coding-function
+ (funcall set-auto-coding-function
+ filename (- (point-max) (point-min))))
+ ;; dos-w32.el defines find-operation-coding-system for
+ ;; DOS/Windows systems which preserves the coding-system
+ ;; of existing files. We want it to act here as if the
+ ;; extracted file existed.
+ (let ((file-name-handler-alist
+ '(("" . archive-file-name-handler))))
+ (car (find-operation-coding-system 'insert-file-contents
+ filename t))))))
+ (if (and (not coding-system-for-read)
+ (not enable-multibyte-characters))
+ (setq coding
+ (coding-system-change-text-conversion coding 'raw-text)))
+ (if (and coding
+ (not (eq coding 'no-conversion)))
+ (decode-coding-region (point-min) (point-max) coding)
+ (setq last-coding-system-used coding))
+ (set-buffer-modified-p nil)
+ (kill-local-variable 'buffer-file-coding-system)
+ (after-insert-file-set-buffer-file-coding-system (- (point-max)
+ (point-min))))))
+
(defun archive-mouse-extract (event)
"Extract a file whose name you click on."
(interactive "e")
;; underlying filesystem, are treated as read-only.
(read-only-p (or archive-read-only
view-p
- (string-match archive-file-name-invalid-regexp ename)))
+ (string-match file-name-invalid-regexp ename)))
(buffer (get-buffer bufname))
(just-created nil))
(if buffer
(setq archive-subfile-mode descr)
(if (and
(null
- (if (fboundp extractor)
- (funcall extractor archive ename)
- (archive-*-extract archive ename (symbol-value extractor))))
+ (let (;; We may have to encode file name arguement for
+ ;; external programs.
+ (coding-system-for-write
+ (and enable-multibyte-characters
+ file-name-coding-system))
+ ;; We read an archive member by no-conversion at
+ ;; first, then decode appropriately by calling
+ ;; archive-set-buffer-as-visiting-file later.
+ (coding-system-for-read 'no-conversion))
+ (condition-case err
+ (if (fboundp extractor)
+ (funcall extractor archive ename)
+ (archive-*-extract archive ename
+ (symbol-value extractor)))
+ (error
+ (ding (message "%s" (error-message-string err)))
+ nil))))
just-created)
(progn
(set-buffer-modified-p nil)
(kill-buffer buffer))
+ (archive-set-buffer-as-visiting-file ename)
(goto-char (point-min))
(rename-buffer bufname)
(setq buffer-read-only read-only-p)
(or (not (buffer-name buffer))
(progn
(if view-p
- (view-buffer buffer (and just-created 'kill-buffer)))
- (if (eq other-window-p 'display)
- (display-buffer buffer)
- (if other-window-p
- (switch-to-buffer-other-window buffer)
- (switch-to-buffer buffer)))))))
+ (view-buffer buffer (and just-created 'kill-buffer))
+ (if (eq other-window-p 'display)
+ (display-buffer buffer)
+ (if other-window-p
+ (switch-to-buffer-other-window buffer)
+ (switch-to-buffer buffer))))))))
(defun archive-*-extract (archive name command)
(let* ((default-directory (file-name-as-directory archive-tmpdir))
success))
(defun archive-extract-by-stdout (archive name command)
- ;; We need the coding system of the output of the extract program,
- ;; including the EOL encoding, be decoded dynamically, since what
- ;; the extract program outputs is the contents of some file.
- (let ((coding-system-for-read (or coding-system-for-read 'undecided))
- (inherit-process-coding-system t))
- (apply 'call-process
- (car command)
- nil
- t
- nil
- (append (cdr command) (list archive name)))))
+ (apply 'call-process
+ (car command)
+ nil
+ t
+ nil
+ (append (cdr command) (list archive name))))
(defun archive-extract-other-window ()
"In archive mode, find this member in another window."
(if (aref descr 3)
;; Set the file modes, but make sure we can read it.
(set-file-modes tmpfile (logior ?\400 (aref descr 3))))
+ (if enable-multibyte-characters
+ (setq ename
+ (encode-coding-string ename file-name-coding-system)))
(let ((exitcode (apply 'call-process
(car command)
nil
(descr (archive-get-descr)))
(if (fboundp func)
(progn
- (funcall func (buffer-file-name) newname descr)
+ (funcall func (buffer-file-name)
+ (if enable-multibyte-characters
+ (encode-coding-string newname file-name-coding-system)
+ newname)
+ descr)
(archive-resummarize))
(error "Renaming is not supported for this archive type"))))
(setq archive-files nil)
(let ((revert-buffer-function nil)
(coding-system-for-read 'no-conversion))
+ (set-buffer-multibyte nil)
(revert-buffer t t))
(archive-mode)
(goto-char archive-file-list-start)
(save-restriction
(save-excursion
(widen)
+ (set-buffer-multibyte nil)
(goto-char (+ archive-proper-file-start (aref descr 4) 2))
(delete-char 13)
(insert name)))))
(moddate (archive-l-e (+ p 17) 2))
(hdrlvl (char-after (+ p 20)))
(fnlen (char-after (+ p 21)))
- (efnname (buffer-substring (+ p 22) (+ p 22 fnlen)))
+ (efnname (let ((str (buffer-substring (+ p 22) (+ p 22 fnlen))))
+ (if file-name-coding-system
+ (decode-coding-string str file-name-coding-system)
+ (string-as-multibyte str))))
(fiddle (string= efnname (upcase efnname)))
(ifnname (if fiddle (downcase efnname) efnname))
+ (width (string-width ifnname))
(p2 (+ p 22 fnlen))
(creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))
mode modestr uid gid text path prname
(archive-dosdate moddate)
(archive-dostime modtime)
ifnname)))
- (setq maxlen (max maxlen fnlen)
+ (setq maxlen (max maxlen width)
totalsize (+ totalsize ucsize)
visual (cons (vector text
(- (length text) (length ifnname))
files)
p (+ p hsize 2 csize))))
(goto-char (point-min))
+ (set-buffer-multibyte default-enable-multibyte-characters)
(let ((dash (concat (if archive-alternate-display
"- -------- ----- ----- "
"- ---------- -------- ----------- -------- ")
(save-restriction
(save-excursion
(widen)
+ (set-buffer-multibyte nil)
(let* ((p (+ archive-proper-file-start (aref descr 4)))
(oldhsize (char-after p))
(oldfnlen (char-after (+ p 21)))
(save-restriction
(save-excursion
(widen)
+ (set-buffer-multibyte nil)
(while files
(let* ((fil (car files))
(p (+ archive-proper-file-start (aref fil 4)))
(exlen (archive-l-e (+ p 30) 2))
(fclen (archive-l-e (+ p 32) 2))
(lheader (archive-l-e (+ p 42) 4))
- (efnname (buffer-substring (+ p 46) (+ p 46 fnlen)))
+ (efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen))))
+ (if file-name-coding-system
+ (decode-coding-string str file-name-coding-system)
+ (string-as-multibyte str))))
(isdir (and (= ucsize 0)
(string= (file-name-nondirectory efnname) "")))
(mode (cond ((memq creator '(2 3)) ; Unix + VMS
(not (not (memq creator '(0 2 4 5 9))))
(string= (upcase efnname) efnname)))
(ifnname (if fiddle (downcase efnname) efnname))
+ (width (string-width ifnname))
(text (format " %10s %8d %-11s %-8s %s"
modestr
ucsize
(archive-dosdate moddate)
(archive-dostime modtime)
ifnname)))
- (setq maxlen (max maxlen fnlen)
+ (setq maxlen (max maxlen width)
totalsize (+ totalsize ucsize)
visual (cons (vector text
(- (length text) (length ifnname))
(save-restriction
(save-excursion
(widen)
+ (set-buffer-multibyte nil)
(while files
(let* ((fil (car files))
(p (+ archive-proper-file-start (car (aref fil 4))))
(lfnlen (if (= dirtype 2) (char-after (+ p 56)) 0))
(ldirlen (if (= dirtype 2) (char-after (+ p 57)) 0))
(fnlen (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))))
+ (efnname (let ((str
+ (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)))))
+ (if file-name-coding-system
+ (decode-coding-string str file-name-coding-system)
+ (string-as-multibyte str))))
(fiddle (and (= lfnlen 0) (string= efnname (upcase efnname))))
(ifnname (if fiddle (downcase efnname) efnname))
+ (width (string-width ifnname))
(text (format " %8d %-11s %-8s %s"
ucsize
(archive-dosdate moddate)
(archive-dostime modtime)
ifnname)))
- (setq maxlen (max maxlen (length ifnname))
+ (setq maxlen (max maxlen (length width))
totalsize (+ totalsize ucsize)
visual (cons (vector text
(- (length text) (length ifnname))