From: Stefan Monnier Date: Fri, 3 Apr 2020 20:45:54 +0000 (-0400) Subject: * lisp/arc-mode.el: Use cl-structs rather than vectors X-Git-Tag: emacs-28.0.90~7661 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=c640be60d918d5a7be4d9d5e717cf159f878d38c;p=emacs.git * lisp/arc-mode.el: Use cl-structs rather than vectors (archive--file-desc, archive--file-summary, archive-arc--file-desc) (archive-lzh--file-desc, archive-zip--file-desc) (archive-zoo--file-desc, archive-rar--file-desc) (archive-7z--file-desc, archive-ar--file-desc): New structs. (archive-get-descr, archive-mode, archive-summarize-files) (archive-maybe-copy, archive-extract, archive-*-write-file-member) (archive-expunge, archive-arc-summarize, archive-arc-rename-entry) (archive-lzh-summarize, archive-lzh-rename-entry, archive-lzh-ogm) (archive-zip-summarize, archive-zip-write-file-member) (archive-zip-chmod-entry, archive-zoo-summarize) (archive-rar-summarize, archive-7z-summarize, archive-ar-summarize) (archive-ar-write-file-member): Use struct constructors and accessors instead of `vector` and `aref`. (archive-calc-mode): Remove `error` arg which was always non-nil; adjust all callers. Rewrite using `string-to-number` and `file-modes-symbolic-to-number`. --- diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 21b9627e407..4609123dec9 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -366,7 +366,7 @@ file. Archive and member name will be added." (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) @@ -485,18 +485,23 @@ file. Archive and member name will be added." (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) ;; ------------------------------------------------------------------------- @@ -550,52 +555,16 @@ in which case a second argument, length LEN, should be supplied." (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." @@ -644,7 +613,7 @@ Does not signal an error if optional argument NOERROR is non-nil." (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")))) @@ -696,10 +665,8 @@ 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. @@ -806,27 +773,35 @@ when parsing the archive." (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 () @@ -880,7 +855,8 @@ using `make-temp-file', and the generated name is returned." ;; "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)) @@ -989,8 +965,8 @@ using `make-temp-file', and the generated name is returned." (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)) @@ -1234,7 +1210,7 @@ using `make-temp-file', and the generated name is returned." 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))) @@ -1251,9 +1227,10 @@ using `make-temp-file', and the generated name is returned." ;; 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) @@ -1357,7 +1334,7 @@ Use \\[archive-unmark-all-files] to remove all marks." "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) @@ -1396,7 +1373,9 @@ as a relative change like \"g+rw\" as for chmod(2)." (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 @@ -1460,6 +1439,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ------------------------------------------------------------------------- ;;; 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) @@ -1486,11 +1473,13 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." 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)) @@ -1519,12 +1508,21 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (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) @@ -1639,11 +1637,13 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." 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))) @@ -1689,7 +1689,8 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (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)) @@ -1709,7 +1710,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (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)) @@ -1726,7 +1727,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (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)) @@ -1736,8 +1737,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (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)) ;; ------------------------------------------------------------------------- @@ -1770,6 +1770,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ------------------------------------------------------------------------- ;;; 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") @@ -1832,14 +1840,15 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." 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)) @@ -1884,17 +1893,19 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (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)) @@ -1911,6 +1922,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ------------------------------------------------------------------------- ;;; 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) @@ -1952,11 +1971,15 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." 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)) @@ -1980,6 +2003,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ------------------------------------------------------------------------- ;;; 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)) @@ -2005,11 +2036,11 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (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)) @@ -2019,18 +2050,20 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (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)))) @@ -2078,6 +2111,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ------------------------------------------------------------------------- ;;; 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) @@ -2100,7 +2141,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (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)) @@ -2109,16 +2150,16 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (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)))) @@ -2142,6 +2183,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; 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 @@ -2193,8 +2242,8 @@ NAME is expected to be the 16-bytes part of an ar record." (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)) @@ -2210,19 +2259,18 @@ NAME is expected to be the 16-bytes part of an ar record." " 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)))) @@ -2259,7 +2307,8 @@ NAME is expected to be the 16-bytes part of an ar record." 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")))