:group 'archive-zip)
(defcustom archive-zip-update
- (if archive-zip-use-pkzip '("pkzip" "-u") '("zip" "-q"))
+ (if archive-zip-use-pkzip '("pkzip" "-u" "-P") '("zip" "-q"))
"*Program and its options to run in order to update a zip file member.
Options should ensure that specified directory will be put into the zip
file. Archive and member name will be added."
result))
(defun archive-int-to-mode (mode)
- "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------"
- (let ((str (make-string 10 ?-)))
- (or (zerop (logand 16384 mode)) (aset str 0 ?d))
- (or (zerop (logand 8192 mode)) (aset str 0 ?c)) ; completeness
- (or (zerop (logand 256 mode)) (aset str 1 ?r))
- (or (zerop (logand 128 mode)) (aset str 2 ?w))
- (or (zerop (logand 64 mode)) (aset str 3 ?x))
- (or (zerop (logand 32 mode)) (aset str 4 ?r))
- (or (zerop (logand 16 mode)) (aset str 5 ?w))
- (or (zerop (logand 8 mode)) (aset str 6 ?x))
- (or (zerop (logand 4 mode)) (aset str 7 ?r))
- (or (zerop (logand 2 mode)) (aset str 8 ?w))
- (or (zerop (logand 1 mode)) (aset str 9 ?x))
- (or (zerop (logand 1024 mode)) (aset str 3 (if (zerop (logand 64 mode))
- ?S ?s)))
- (or (zerop (logand 2048 mode)) (aset str 6 (if (zerop (logand 8 mode))
- ?S ?s)))
- str))
+ "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------."
+ ;; FIXME: merge with tar-grind-file-mode.
+ (string
+ (if (zerop (logand 8192 mode))
+ (if (zerop (logand 16384 mode)) ?- ?d)
+ ?c) ; completeness
+ (if (zerop (logand 256 mode)) ?- ?r)
+ (if (zerop (logand 128 mode)) ?- ?w)
+ (if (zerop (logand 64 mode))
+ (if (zerop (logand 1024 mode)) ?- ?S)
+ (if (zerop (logand 1024 mode)) ?x ?s))
+ (if (zerop (logand 32 mode)) ?- ?r)
+ (if (zerop (logand 16 mode)) ?- ?w)
+ (if (zerop (logand 8 mode))
+ (if (zerop (logand 2048 mode)) ?- ?S)
+ (if (zerop (logand 2048 mode)) ?x ?s))
+ (if (zerop (logand 4 mode)) ?- ?r)
+ (if (zerop (logand 2 mode)) ?- ?w)
+ (if (zerop (logand 1 mode)) ?- ?x)))
(defun archive-calc-mode (oldmode newmode &optional error)
"From the integer OLDMODE and the string NEWMODE calculate a new file mode.
(defun archive-dostime (time)
"Stringify dos packed TIME record."
(let ((hour (logand (ash time -11) 31))
- (minute (logand (ash time -5) 53))
+ (minute (logand (ash time -5) 63))
(second (* 2 (logand time 31)))) ; 2 seconds resolution
(format "%02d:%02d:%02d" hour minute second)))
(funcall default-major-mode)
(if (and (not force) archive-files) nil
(let* ((type (archive-find-type))
- (typename (copy-sequence (symbol-name type))))
- (aset typename 0 (upcase (aref typename 0)))
+ (typename (capitalize (symbol-name type))))
(kill-all-local-variables)
(make-local-variable 'archive-subtype)
(setq archive-subtype type)
(make-local-variable 'local-enable-local-variables)
(setq local-enable-local-variables nil)
+ ;; Prevent loss of data when saving the file.
+ (make-local-variable 'file-precious-flag)
+ (setq file-precious-flag t)
+
(make-local-variable 'archive-read-only)
;; Archives which are inside other archives and whose
;; names are invalid for this OS, can't be written.
(make-local-variable 'archive-file-list-start)
(make-local-variable 'archive-file-list-end)
(make-local-variable 'archive-file-name-indent)
- ;; Always edit an archive file in unibyte mode.
- (set-buffer-multibyte nil)
(archive-summarize nil)
(setq buffer-read-only t))))
(define-key archive-mode-map [down] 'archive-next-line)
(define-key archive-mode-map "o" 'archive-extract-other-window)
(define-key archive-mode-map "p" 'archive-previous-line)
+ (define-key archive-mode-map "q" 'quit-window)
(define-key archive-mode-map "\C-p" 'archive-previous-line)
(define-key archive-mode-map [up] 'archive-previous-line)
(define-key archive-mode-map "r" 'archive-rename-entry)
(if archive-lemacs
() ; out of luck
- ;; Get rid of the Edit menu bar item to save space.
- (define-key archive-mode-map [menu-bar edit] 'undefined)
(define-key archive-mode-map [menu-bar immediate]
(cons "Immediate" (make-sparse-keymap "Immediate")))
(define-key archive-mode-map [menu-bar immediate alternate]
- '("Alternate Display" . archive-alternate-display))
- (put 'archive-alternate-display 'menu-enable
- '(boundp (archive-name "alternate-display")))
+ '(menu-item "Alternate Display" archive-alternate-display
+ :enable (boundp (archive-name "alternate-display"))
+ :help "Toggle alternate file info display"))
(define-key archive-mode-map [menu-bar immediate view]
- '("View This File" . archive-view))
+ '(menu-item "View This File" archive-view
+ :help "Display file at cursor in View Mode"))
(define-key archive-mode-map [menu-bar immediate display]
- '("Display in Other Window" . archive-display-other-window))
+ '(menu-item "Display in Other Window" archive-display-other-window
+ :help "Display file at cursor in another window"))
(define-key archive-mode-map [menu-bar immediate find-file-other-window]
- '("Find in Other Window" . archive-extract-other-window))
+ '(menu-item "Find in Other Window" archive-extract-other-window
+ :help "Edit file at cursor in another window"))
(define-key archive-mode-map [menu-bar immediate find-file]
- '("Find This File" . archive-extract))
+ '(menu-item "Find This File" archive-extract
+ :help "Extract file at cursor and edit it"))
(define-key archive-mode-map [menu-bar mark]
(cons "Mark" (make-sparse-keymap "Mark")))
(define-key archive-mode-map [menu-bar mark unmark-all]
- '("Unmark All" . archive-unmark-all-files))
+ '(menu-item "Unmark All" archive-unmark-all-files
+ :help "Unmark all marked files"))
(define-key archive-mode-map [menu-bar mark deletion]
- '("Flag" . archive-flag-deleted))
+ '(menu-item "Flag" archive-flag-deleted
+ :help "Flag file at cursor for deletion"))
(define-key archive-mode-map [menu-bar mark unmark]
- '("Unflag" . archive-unflag))
+ '(menu-item "Unflag" archive-unflag
+ :help "Unmark file at cursor"))
(define-key archive-mode-map [menu-bar mark mark]
- '("Mark" . archive-mark))
+ '(menu-item "Mark" archive-mark
+ :help "Mark file at cursor"))
(define-key archive-mode-map [menu-bar operate]
(cons "Operate" (make-sparse-keymap "Operate")))
(define-key archive-mode-map [menu-bar operate chown]
- '("Change Owner..." . archive-chown-entry))
- (put 'archive-chown-entry 'menu-enable
- '(fboundp (archive-name "chown-entry")))
+ '(menu-item "Change Owner..." archive-chown-entry
+ :enable (fboundp (archive-name "chown-entry"))
+ :help "Change owner of marked files"))
(define-key archive-mode-map [menu-bar operate chgrp]
- '("Change Group..." . archive-chgrp-entry))
- (put 'archive-chgrp-entry 'menu-enable
- '(fboundp (archive-name "chgrp-entry")))
+ '(menu-item "Change Group..." archive-chgrp-entry
+ :enable (fboundp (archive-name "chgrp-entry"))
+ :help "Change group ownership of marked files"))
(define-key archive-mode-map [menu-bar operate chmod]
- '("Change Mode..." . archive-chmod-entry))
- (put 'archive-chmod-entry 'menu-enable
- '(fboundp (archive-name "chmod-entry")))
+ '(menu-item "Change Mode..." archive-chmod-entry
+ :enable (fboundp (archive-name "chmod-entry"))
+ :help "Change mode (permissions) of marked files"))
(define-key archive-mode-map [menu-bar operate rename]
- '("Rename to..." . archive-rename-entry))
- (put 'archive-rename-entry 'menu-enable
- '(fboundp (archive-name "rename-entry")))
+ '(menu-item "Rename to..." archive-rename-entry
+ :enable (fboundp (archive-name "rename-entry"))
+ :help "Rename marked files"))
;;(define-key archive-mode-map [menu-bar operate copy]
- ;; '("Copy to..." . archive-copy))
+ ;; '(menu-item "Copy to..." archive-copy))
(define-key archive-mode-map [menu-bar operate expunge]
- '("Expunge Marked Files" . archive-expunge))
+ '(menu-item "Expunge Marked Files" archive-expunge
+ :help "Delete all flagged files from archive"))
))
(let* ((item1 '(archive-subfile-mode " Archive"))
(string-match "\\.[aA][rR][cC]$"
(or buffer-file-name (buffer-name))))
'arc)
- (t (error "Buffer format not recognized.")))))
+ (t (error "Buffer format not recognized")))))
;; -------------------------------------------------------------------------
(defun archive-summarize (&optional shut-up)
"Parse the contents of the archive file in the current buffer.
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..."))
(let ((text (concat (aref fil 0) "\n")))
(if archive-lemacs
() ; out of luck
- (put-text-property (aref fil 1) (aref fil 2)
- 'mouse-face 'highlight
- text))
+ (add-text-properties
+ (aref fil 1) (aref fil 2)
+ '(mouse-face highlight
+ help-echo "mouse-2: extract this file into a buffer")
+ text))
text)))
files)))
(setq archive-file-list-end (point-marker)))
If FNAME can be uniquely created in DIR, it is returned unaltered.
If FNAME is something our underlying filesystem can't grok, or if another
file by that name already exists in DIR, a unique new name is generated
-using `make-temp-name', and the generated name is returned."
+using `make-temp-file', and the generated name is returned."
(let ((fullname (expand-file-name fname dir))
(alien (string-match file-name-invalid-regexp fname)))
(if (or alien (file-exists-p fullname))
- (make-temp-name
+ (make-temp-file
(expand-file-name
- (if (and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
+ (if (and (fboundp 'msdos-long-file-names)
+ (not (msdos-long-file-names)))
"am"
"arc-mode.")
dir))
;; -------------------------------------------------------------------------
;; 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
+ (save-excursion
+ (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")
(setq archive-subfile-mode descr)
(if (and
(null
- (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)))
+ (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)
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"))))
;; Revert the buffer and recompute the dired-like listing.
-(defun archive-mode-revert (&optional no-autosave no-confirm)
+(defun archive-mode-revert (&optional no-auto-save no-confirm)
(let ((no (archive-get-lineno)))
(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 width)
totalsize (+ totalsize ucsize)
visual (cons (vector text
(- (length text) (length ifnname))
(defun archive-zoo-extract (archive name)
(archive-extract-by-stdout archive name archive-zoo-extract))
;; -------------------------------------------------------------------------
+;; This line was a mistake; it is kept now for compatibility.
+;; rms 15 Oct 98
(provide 'archive-mode)
-;; arc-mode.el ends here.
+(provide 'arc-mode)
+
+;;; arc-mode.el ends here
HCoop / bpt / emacs.git / blobdiff