(defvar archive-file-list-end nil "Position just after last contents line.")
(defvar archive-proper-file-start nil "Position of real archive's start.")
(defvar archive-read-only nil "Non-nil if the archive is read-only on disk.")
-(defvar archive-local-name nil "Name of local copy of remote archive.")
+(defvar-local archive-local-name nil "Name of local copy of remote archive.")
(defvar archive-mode-map
(let ((map (make-keymap)))
(set-keymap-parent map special-mode-map)
(defvar archive-superior-buffer nil "In archive members, points to archive.")
(put 'archive-superior-buffer 'permanent-local t)
-(defvar archive-subfile-mode nil "Non-nil in archive member buffers.")
-(make-variable-buffer-local 'archive-subfile-mode)
+(defvar-local archive-subfile-mode nil
+ "Non-nil in archive member buffers.
+Its value is an `archive--file-desc'.")
(put 'archive-subfile-mode 'permanent-local t)
(defvar archive-file-name-coding-system nil)
(make-variable-buffer-local 'archive-file-name-coding-system)
(put 'archive-file-name-coding-system 'permanent-local t)
+(cl-defstruct (archive--file-desc
+ (:constructor nil)
+ (:constructor archive--file-desc
+ (ext-file-name int-file-name case-fiddled mode)))
+ 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 ...]")
+ "Vector of `archive--file-desc' objects.")
(make-variable-buffer-local 'archive-files)
;; -------------------------------------------------------------------------
(if (zerop (logand 2 mode)) ?- ?w)
(if (zerop (logand 1 mode)) ?- ?x)))
-(defun archive-calc-mode (oldmode newmode &optional error)
+(defun archive-calc-mode (oldmode newmode)
"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
-OLDMODE will be modified accordingly just like chmod(2) would have done.\n
-If optional third argument ERROR is non-nil an error will be signaled if
-the mode is invalid. If ERROR is nil then nil will be returned."
- (cond ((string-match "^0[0-7]*$" newmode)
- (let ((result 0)
- (len (length newmode))
- (i 1))
- (while (< i len)
- (setq result (+ (ash result 3) (aref newmode i) (- ?0))
- i (1+ i)))
- (logior (logand oldmode 65024) result)))
- ((string-match "^\\([agou]+\\)\\([---+=]\\)\\([rwxst]+\\)$" newmode)
- (let ((who 0)
- (result oldmode)
- (op (aref newmode (match-beginning 2)))
- (bits 0)
- (i (match-beginning 3)))
- (while (< i (match-end 3))
- (let ((rwx (aref newmode i)))
- (setq bits (logior bits (cond ((= rwx ?r) 292)
- ((= rwx ?w) 146)
- ((= rwx ?x) 73)
- ((= rwx ?s) 3072)
- ((= rwx ?t) 512)))
- i (1+ i))))
- (while (< who (match-end 1))
- (let* ((whoc (aref newmode who))
- (whomask (cond ((= whoc ?a) 4095)
- ((= whoc ?u) 1472)
- ((= whoc ?g) 2104)
- ((= whoc ?o) 7))))
- (if (= op ?=)
- (setq result (logand result (lognot whomask))))
- (if (= op ?-)
- (setq result (logand result (lognot (logand whomask bits))))
- (setq result (logior result (logand whomask bits)))))
- (setq who (1+ who)))
- result))
- (t
- (if error
- (error "Invalid mode specification: %s" newmode)))))
+OLDMODE will be modified accordingly just like chmod(2) would have done."
+ ;; FIXME: Use `file-modes-symbolic-to-number'!
+ (if (string-match "\\`0[0-7]*\\'" newmode)
+ (logior (logand oldmode #o177000) (string-to-number newmode 8))
+ (file-modes-symbolic-to-number newmode oldmode)))
(defun archive-dosdate (date)
"Stringify dos packed DATE record."
(if (and (>= (point) archive-file-list-start)
(< no (length archive-files)))
(let ((item (aref archive-files no)))
- (if (vectorp item)
+ (if (archive--file-desc-p item)
item
(if (not noerror)
(error "Entry is not a regular member of the archive"))))
(or (not (file-writable-p (buffer-file-name)))
(and archive-subfile-mode
(string-match file-name-invalid-regexp
- (aref archive-subfile-mode 0)))))
-
- ;; Should we use a local copy when accessing from outside Emacs?
- (make-local-variable 'archive-local-name)
+ (archive--file-desc-ext-file-name
+ archive-subfile-mode)))))
;; An archive can contain another archive whose name is invalid
;; on local filesystem. Treat such archives as remote.
(goto-char archive-file-list-start)
(archive-next-line no)))
+(cl-defstruct (archive--file-summary
+ (:constructor nil)
+ (:constructor archive--file-summary (text name-start name-end)))
+ text name-start name-end)
+
(defun archive-summarize-files (files)
"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))
+ ;; Here we assume that they all start at the same column.
+ (setq archive-file-name-indent
+ ;; FIXME: We assume chars=columns (no double-wide chars and such).
+ (if files (archive--file-summary-name-start (car files)) 0))
;; We don't want to do an insert for each element since that takes too
;; long when the archive -- which has to be moved in memory -- is large.
(insert
- (apply
- #'concat
- (mapcar
- (lambda (fil)
- ;; Using `concat' here copies the text also, so we can add
- ;; properties without problems.
- (let ((text (concat (aref fil 0) "\n")))
- (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)))
+ (mapconcat
+ (lambda (fil)
+ ;; Using `concat' here copies the text also, so we can add
+ ;; properties without problems.
+ (let ((text (concat (archive--file-summary-text fil) "\n")))
+ (add-text-properties
+ (archive--file-summary-name-start fil)
+ (archive--file-summary-name-end fil)
+ '(mouse-face highlight
+ help-echo "mouse-2: extract this file into a buffer")
+ text)
+ text))
+ files
+ ""))
(setq archive-file-list-end (point-marker)))
(defun archive-alternate-display ()
;; "foo.zip:bar.zip", which is invalid on DOS/Windows.
;; So use the actual name if available.
(archive-name
- (or (and archive-subfile-mode (aref archive-subfile-mode 0))
+ (or (and archive-subfile-mode (archive--file-desc-ext-file-name
+ archive-subfile-mode))
archive)))
(setq archive-local-name
(archive-unique-fname archive-name archive-tmpdir))
(if event (posn-set-point (event-end event)))
(let* ((view-p (eq other-window-p 'view))
(descr (archive-get-descr))
- (ename (aref descr 0))
- (iname (aref descr 1))
+ (ename (archive--file-desc-ext-file-name descr))
+ (iname (archive--file-desc-int-file-name descr))
(archive-buffer (current-buffer))
(arcdir default-directory)
(archive (buffer-file-name))
t)
(defun archive-*-write-file-member (archive descr command)
- (let* ((ename (aref descr 0))
+ (let* ((ename (archive--file-desc-ext-file-name descr))
(tmpfile (expand-file-name ename archive-tmpdir))
(top (directory-file-name (file-name-as-directory archive-tmpdir)))
(default-directory (file-name-as-directory top)))
;; further processing clobbers it (we restore it in
;; archive-write-file-member, above).
(setq archive-member-coding-system last-coding-system-used)
- (if (aref descr 3)
+ (if (archive--file-desc-mode descr)
;; Set the file modes, but make sure we can read it.
- (set-file-modes tmpfile (logior ?\400 (aref descr 3))))
+ (set-file-modes tmpfile
+ (logior ?\400 (archive--file-desc-mode descr))))
(setq ename
(encode-coding-string ename archive-file-name-coding-system))
(let* ((coding-system-for-write 'no-conversion)
"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): ")
+ (interactive "sNew mode (octal or symbolic): ")
(if archive-read-only (error "Archive is read-only"))
(let ((func (archive-name "chmod-entry")))
(if (fboundp func)
(goto-char archive-file-list-start)
(while (< (point) archive-file-list-end)
(if (= (following-char) ?D)
- (setq files (cons (aref (archive-get-descr) 0) files)))
+ (setq files (cons (archive--file-desc-ext-file-name
+ (archive-get-descr))
+ files)))
(forward-line 1)))
(setq files (nreverse files))
(and files
;; -------------------------------------------------------------------------
;;; Section: Arc Archives
+(cl-defstruct (archive-arc--file-desc
+ (:include archive--file-desc)
+ (:constructor nil)
+ (:constructor archive-arc--file-desc
+ (ext-file-name int-file-name case-fiddled mode
+ pos)))
+ pos)
+
(defun archive-arc-summarize ()
(let ((p 1)
(totalsize 0)
ifnname)))
(setq maxlen (max maxlen fnlen)
totalsize (+ totalsize ucsize)
- visual (cons (vector text
- (- (length text) (length ifnname))
- (length text))
+ visual (cons (archive--file-summary
+ text
+ (- (length text) (length ifnname))
+ (length text))
visual)
- files (cons (vector efnname ifnname fiddle nil (1- p))
+ files (cons (archive-arc--file-desc
+ efnname ifnname fiddle nil (1- p))
files)
p (+ p 29 csize))))
(goto-char (point-min))
(save-restriction
(save-excursion
(widen)
- (goto-char (+ archive-proper-file-start (aref descr 4) 2))
+ (goto-char (+ archive-proper-file-start 2
+ (archive-arc--file-desc-pos descr)))
(delete-char 13)
(arc-insert-unibyte name)))))
;; -------------------------------------------------------------------------
;;; Section: Lzh Archives
+(cl-defstruct (archive-lzh--file-desc
+ (:include archive--file-desc)
+ (:constructor nil)
+ (:constructor archive-lzh--file-desc
+ (ext-file-name int-file-name case-fiddled mode
+ pos)))
+ pos)
+
(defun archive-lzh-summarize (&optional start)
(let ((p (or start 1)) ;; 1 for .lzh, something further on for .exe
(totalsize 0)
prname)))
(setq maxlen (max maxlen width)
totalsize (+ totalsize ucsize)
- visual (cons (vector text
- (- (length text) (length prname))
- (length text))
+ visual (cons (archive--file-summary
+ text
+ (- (length text) (length prname))
+ (length text))
visual)
- files (cons (vector prname ifnname fiddle mode (1- p))
+ files (cons (archive-lzh--file-desc
+ prname ifnname fiddle mode (1- p))
files))
(cond ((= hdrlvl 1)
(setq p (+ p hsize 2 csize)))
(save-restriction
(save-excursion
(widen)
- (let* ((p (+ archive-proper-file-start (aref descr 4)))
+ (let* ((p (+ archive-proper-file-start
+ (archive-lzh--file-desc-pos descr)))
(oldhsize (get-byte p))
(oldfnlen (get-byte (+ p 21)))
(newfnlen (length newname))
(save-restriction
(widen)
(dolist (fil files)
- (let* ((p (+ archive-proper-file-start (aref fil 4)))
+ (let* ((p (+ archive-proper-file-start (archive-lzh--file-desc-pos fil)))
(hsize (get-byte p))
(fnlen (get-byte (+ p 21)))
(p2 (+ p 22 fnlen))
(delete-char 1)
(arc-insert-unibyte (archive-lzh-resum (1+ p) hsize)))
(message "Member %s does not have %s field"
- (aref fil 1) errtxt)))))))
+ (archive--file-desc-int-file-name fil) errtxt)))))))
(defun archive-lzh-chown-entry (newuid files)
(archive-lzh-ogm newuid files "an uid" 10))
(defun archive-lzh-chmod-entry (newmode files)
(archive-lzh-ogm
- ;; This should work even though newmode will be dynamically accessed.
- (lambda (old) (archive-calc-mode old newmode t))
+ (lambda (old) (archive-calc-mode old newmode))
files "a unix-style mode" 8))
;; -------------------------------------------------------------------------
;; -------------------------------------------------------------------------
;;; Section: Zip Archives
+(cl-defstruct (archive-zip--file-desc
+ (:include archive--file-desc)
+ (:constructor nil)
+ (:constructor archive-zip--file-desc
+ (ext-file-name int-file-name case-fiddled mode
+ pos+len)))
+ pos+len)
+
(defun archive-zip-summarize ()
(goto-char (- (point-max) (- 22 18)))
(search-backward-regexp "[P]K\005\006")
ifnname)))
(setq maxlen (max maxlen width)
totalsize (+ totalsize ucsize)
- visual (cons (vector text
- (- (length text) (length ifnname))
- (length text))
+ visual (cons (archive--file-summary
+ text
+ (- (length text) (length ifnname))
+ (length text))
visual)
files (cons (if isdir
nil
- (vector efnname ifnname fiddle mode
- (list (1- p) lheader)))
+ (archive-zip--file-desc efnname ifnname fiddle mode
+ (list (1- p) lheader)))
files)
p (+ p 46 fnlen exlen fclen))))
(goto-char (point-min))
(archive-*-write-file-member
archive
descr
- (if (aref descr 2) archive-zip-update-case archive-zip-update)))
+ (if (archive--file-desc-case-fiddled descr)
+ archive-zip-update-case archive-zip-update)))
(defun archive-zip-chmod-entry (newmode files)
(save-restriction
(save-excursion
(widen)
(dolist (fil files)
- (let* ((p (+ archive-proper-file-start (car (aref fil 4))))
+ (let* ((p (+ archive-proper-file-start
+ (car (archive-zip--file-desc-pos+len fil))))
(creator (get-byte (+ p 5)))
- (oldmode (aref fil 3))
- (newval (archive-calc-mode oldmode newmode t))
+ (oldmode (archive--file-desc-mode fil))
+ (newval (archive-calc-mode oldmode newmode))
(inhibit-read-only t))
(cond ((memq creator '(2 3)) ; Unix
(goto-char (+ p 40))
;; -------------------------------------------------------------------------
;;; Section: Zoo Archives
+(cl-defstruct (archive-zoo--file-desc
+ (:include archive--file-desc)
+ (:constructor nil)
+ (:constructor archive-zoo--file-desc
+ (ext-file-name int-file-name case-fiddled mode
+ pos)))
+ pos)
+
(defun archive-zoo-summarize ()
(let ((p (1+ (archive-l-e 25 4)))
(maxlen 8)
ifnname)))
(setq maxlen (max maxlen width)
totalsize (+ totalsize ucsize)
- visual (cons (vector text
- (- (length text) (length ifnname))
- (length text))
+ visual (cons (archive--file-summary
+ text
+ (- (length text) (length ifnname))
+ (length text))
visual)
- files (cons (vector efnname ifnname fiddle nil (1- p))
+ ;; FIXME: Keep size/date(/mode?) in the desc!
+ files (cons (archive-zoo--file-desc
+ ;; FIXME: The `pos' field seems unused!
+ efnname ifnname fiddle nil (1- p))
files)
p next)))
(goto-char (point-min))
;; -------------------------------------------------------------------------
;;; Section: Rar Archives
+(cl-defstruct (archive-rar--file-desc
+ (:include archive--file-desc)
+ (:constructor nil)
+ (:constructor archive-rar--file-desc
+ (ext-file-name int-file-name case-fiddled mode
+ size ratio date time)))
+ size ratio date time)
+
(defun archive-rar-summarize (&optional file)
;; File is used internally for `archive-rar-exe-summarize'.
(unless file (setq file buffer-file-name))
(size (match-string 1)))
(if (> (length name) maxname) (setq maxname (length name)))
(if (> (length size) maxsize) (setq maxsize (length size)))
- (push (vector name name nil nil
- ;; Size, Ratio.
- size (match-string 2)
- ;; Date, Time.
- (match-string 4) (match-string 5))
+ (push (archive-rar--file-desc name name nil nil
+ ;; Size, Ratio.
+ size (match-string 2)
+ ;; Date, Time.
+ (match-string 4) (match-string 5))
files))))
(setq files (nreverse files))
(goto-char (point-min))
(column (length sep)))
(insert (format format " Date " "Time " "Size" "Ratio" "Filename") "\n")
(insert sep (make-string maxname ?-) "\n")
- (archive-summarize-files (mapcar (lambda (desc)
- (let ((text
- (format format
- (aref desc 6)
- (aref desc 7)
- (aref desc 4)
- (aref desc 5)
- (aref desc 1))))
- (vector text
- column
- (length text))))
- files))
+ (archive-summarize-files
+ (mapcar (lambda (desc)
+ (let ((text
+ (format format
+ (archive-rar--file-desc-date desc)
+ (archive-rar--file-desc-time desc)
+ (archive-rar--file-desc-size desc)
+ (archive-rar--file-desc-ratio desc)
+ (archive--file-desc-int-file-name desc))))
+ (archive--file-summary
+ text
+ column
+ (length text))))
+ files))
(insert sep (make-string maxname ?-) "\n")
(apply #'vector files))))
;; -------------------------------------------------------------------------
;;; Section: 7z Archives
+(cl-defstruct (archive-7z--file-desc
+ (:include archive--file-desc)
+ (:constructor nil)
+ (:constructor archive-7z--file-desc
+ (ext-file-name int-file-name case-fiddled mode
+ time user group size)))
+ time user group size)
+
(defun archive-7z-summarize ()
(let ((maxname 10)
(maxsize 5)
(match-string 1)))))
(if (> (length name) maxname) (setq maxname (length name)))
(if (> (length size) maxsize) (setq maxsize (length size)))
- (push (vector name name nil nil time nil nil size)
+ (push (archive-7z--file-desc name name nil nil time nil nil size)
files))))
(setq files (nreverse files))
(goto-char (point-min))
(column (length sep)))
(insert (format format "Size " "Date Time " " Filename") "\n")
(insert sep (make-string maxname ?-) "\n")
- (archive-summarize-files (mapcar (lambda (desc)
- (let ((text
- (format format
- (aref desc 7)
- (aref desc 4)
- (aref desc 1))))
- (vector text
- column
- (length text))))
- files))
+ (archive-summarize-files
+ (mapcar (lambda (desc)
+ (let ((text
+ (format format
+ (archive-7z--file-desc-size desc)
+ (archive-7z--file-desc-time desc)
+ (archive--file-desc-int-file-name desc))))
+ (archive--file-summary
+ text column (length text))))
+ files))
(insert sep (make-string maxname ?-) "\n")
(apply #'vector files))))
;; not the GNU nor the BSD extensions. As it turns out, this is sufficient
;; for .deb packages.
+(cl-defstruct (archive-ar--file-desc
+ (:include archive--file-desc)
+ (:constructor nil)
+ (:constructor archive-ar--file-desc
+ (ext-file-name int-file-name case-fiddled mode
+ time user group size)))
+ time user group size)
+
(autoload 'tar-grind-file-mode "tar-mode")
(defconst archive-ar-file-header-re
(if (> (length group) maxgroup) (setq maxgroup (length group)))
(if (> (length mode) maxmode) (setq maxmode (length mode)))
(if (> (length size) maxsize) (setq maxsize (length size)))
- (push (vector extname extname nil mode
- time user group size)
+ (push (archive-ar--file-desc extname extname nil mode
+ time user group size)
files)))
(setq files (nreverse files))
(goto-char (point-min))
" Date " "Filename")
"\n")
(insert sep (make-string maxname ?-) "\n")
- (archive-summarize-files (mapcar (lambda (desc)
- (let ((text
- (format format
- (aref desc 3)
- (aref desc 5)
- (aref desc 6)
- (aref desc 7)
- (aref desc 4)
- (aref desc 1))))
- (vector text
- column
- (length text))))
- files))
+ (archive-summarize-files
+ (mapcar (lambda (desc)
+ (let ((text
+ (format format
+ (archive--file-desc-mode desc)
+ (archive-ar--file-desc-user desc)
+ (archive-ar--file-desc-group desc)
+ (archive-ar--file-desc-size desc)
+ (archive-ar--file-desc-time desc)
+ (archive--file-desc-int-file-name desc))))
+ (archive--file-summary text column (length text))))
+ files))
(insert sep (make-string maxname ?-) "\n")
(apply #'vector files))))
archive
(let ((d (copy-sequence descr)))
;; FIXME: Crude conversion from string modes to a number.
- (cl-callf (lambda (s) (if (string-match "x" s) ?\555 ?\444)) (aref d 3))
+ (cl-callf (lambda (s) (if (string-match "x" s) ?\555 ?\444))
+ (archive--file-desc-mode d))
d)
'("ar" "r")))
projects / emacs.git / commitdiff