: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."
(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"))
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..."))
;; -------------------------------------------------------------------------
;; 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)
+(provide 'arc-mode)
+
;; arc-mode.el ends here.
HCoop / bpt / emacs.git / blobdiff