Mercurial > emacs
comparison lisp/arc-mode.el @ 102732:febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
extension entries for lookup tables or extended file name tables.
Distinguish the internal and external name, so lookup is easier.
(archive-ar-extract): Take advantage of more precise name.
Preserve point.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Thu, 26 Mar 2009 01:19:50 +0000 |
| parents | a9dc0e7c3f2b |
| children | 819d4646794e |
comparison
equal
deleted
inserted
replaced
| 102731:6673a663a72e | 102732:febdeb5803fd |
|---|---|
| 2013 (files ())) | 2013 (files ())) |
| 2014 (goto-char (point-min)) | 2014 (goto-char (point-min)) |
| 2015 (search-forward "!<arch>\n") | 2015 (search-forward "!<arch>\n") |
| 2016 (while (looking-at archive-ar-file-header-re) | 2016 (while (looking-at archive-ar-file-header-re) |
| 2017 (let ((name (match-string 1)) | 2017 (let ((name (match-string 1)) |
| 2018 extname | |
| 2018 ;; Emacs will automatically use float here because those | 2019 ;; Emacs will automatically use float here because those |
| 2019 ;; timestamps don't fit in our ints. | 2020 ;; timestamps don't fit in our ints. |
| 2020 (time (string-to-number (match-string 2))) | 2021 (time (string-to-number (match-string 2))) |
| 2021 (user (match-string 3)) | 2022 (user (match-string 3)) |
| 2022 (group (match-string 4)) | 2023 (group (match-string 4)) |
| 2023 (mode (string-to-number (match-string 5) 8)) | 2024 (mode (string-to-number (match-string 5) 8)) |
| 2024 (size (string-to-number (match-string 6)))) | 2025 (size (string-to-number (match-string 6)))) |
| 2025 ;; Move to the beginning of the data. | 2026 ;; Move to the beginning of the data. |
| 2026 (goto-char (match-end 0)) | 2027 (goto-char (match-end 0)) |
| 2027 (cond | 2028 (setq time |
| 2028 ((equal name "// ") | 2029 (format-time-string |
| 2029 ;; FIXME: todo | 2030 "%Y-%m-%d %H:%M" |
| 2030 nil) | 2031 (let ((high (truncate (/ time 65536)))) |
| 2031 ((equal name "/ ") | 2032 (list high (truncate (- time (* 65536.0 high))))))) |
| 2032 ;; FIXME: todo | 2033 (setq extname |
| 2033 nil) | 2034 (cond ((equal name "// ") |
| 2034 (t | 2035 (propertize ".<ExtNamesTable>." 'face 'italic)) |
| 2035 (setq time | 2036 ((equal name "/ ") |
| 2036 (format-time-string | 2037 (propertize ".<LookupTable>." 'face 'italic)) |
| 2037 "%Y-%m-%d %H:%M" | 2038 ((string-match "/? *\\'" name) |
| 2038 (let ((high (truncate (/ time 65536)))) | 2039 (substring name 0 (match-beginning 0))))) |
| 2039 (list high (truncate (- time (* 65536.0 high))))))) | 2040 (setq user (substring user 0 (string-match " +\\'" user))) |
| 2040 (setq name (substring name 0 (string-match "/? *\\'" name))) | 2041 (setq group (substring group 0 (string-match " +\\'" group))) |
| 2041 (setq user (substring user 0 (string-match " +\\'" user))) | 2042 (setq mode (tar-grind-file-mode mode)) |
| 2042 (setq group (substring group 0 (string-match " +\\'" group))) | 2043 ;; Move to the end of the data. |
| 2043 (setq mode (tar-grind-file-mode mode)) | 2044 (forward-char size) (if (eq ?\n (char-after)) (forward-char 1)) |
| 2044 ;; Move to the end of the data. | 2045 (setq size (number-to-string size)) |
| 2045 (forward-char size) (if (eq ?\n (char-after)) (forward-char 1)) | 2046 (if (> (length name) maxname) (setq maxname (length name))) |
| 2046 (setq size (number-to-string size)) | 2047 (if (> (length time) maxtime) (setq maxtime (length time))) |
| 2047 (if (> (length name) maxname) (setq maxname (length name))) | 2048 (if (> (length user) maxuser) (setq maxuser (length user))) |
| 2048 (if (> (length time) maxtime) (setq maxtime (length time))) | 2049 (if (> (length group) maxgroup) (setq maxgroup (length group))) |
| 2049 (if (> (length user) maxuser) (setq maxuser (length user))) | 2050 (if (> (length mode) maxmode) (setq maxmode (length mode))) |
| 2050 (if (> (length group) maxgroup) (setq maxgroup (length group))) | 2051 (if (> (length size) maxsize) (setq maxsize (length size))) |
| 2051 (if (> (length mode) maxmode) (setq maxmode (length mode))) | 2052 (push (vector name extname nil mode |
| 2052 (if (> (length size) maxsize) (setq maxsize (length size))) | 2053 time user group size) |
| 2053 (push (vector name name nil mode | 2054 files))) |
| 2054 time user group size) | |
| 2055 files))))) | |
| 2056 (setq files (nreverse files)) | 2055 (setq files (nreverse files)) |
| 2057 (goto-char (point-min)) | 2056 (goto-char (point-min)) |
| 2058 (let* ((format (format "%%%ds %%%ds/%%-%ds %%%ds %%%ds %%s" | 2057 (let* ((format (format "%%%ds %%%ds/%%-%ds %%%ds %%%ds %%s" |
| 2059 maxmode maxuser maxgroup maxsize maxtime)) | 2058 maxmode maxuser maxgroup maxsize maxtime)) |
| 2060 (sep (format format (make-string maxmode ?-) | 2059 (sep (format format (make-string maxmode ?-) |
| 2089 (from nil) size) | 2088 (from nil) size) |
| 2090 (with-current-buffer archivebuf | 2089 (with-current-buffer archivebuf |
| 2091 (save-restriction | 2090 (save-restriction |
| 2092 ;; We may be in archive-mode or not, so either with or without | 2091 ;; We may be in archive-mode or not, so either with or without |
| 2093 ;; narrowing and with or without a prepended summary. | 2092 ;; narrowing and with or without a prepended summary. |
| 2094 (widen) | 2093 (save-excursion |
| 2095 (search-forward "!<arch>\n") | 2094 (widen) |
| 2096 (while (and (not from) (looking-at archive-ar-file-header-re)) | 2095 (search-forward "!<arch>\n") |
| 2097 (let ((this (match-string 1))) | 2096 (while (and (not from) (looking-at archive-ar-file-header-re)) |
| 2098 (setq size (string-to-number (match-string 6))) | 2097 (let ((this (match-string 1))) |
| 2099 (goto-char (match-end 0)) | 2098 (setq size (string-to-number (match-string 6))) |
| 2100 (setq this (substring this 0 (string-match "/? *\\'" this))) | 2099 (goto-char (match-end 0)) |
| 2101 (if (equal name this) | 2100 (if (equal name this) |
| 2102 (setq from (point)) | 2101 (setq from (point)) |
| 2103 ;; Move to the end of the data. | 2102 ;; Move to the end of the data. |
| 2104 (forward-char size) (if (eq ?\n (char-after)) (forward-char 1))))) | 2103 (forward-char size) (if (eq ?\n (char-after)) (forward-char 1))))) |
| 2105 (when from | 2104 (when from |
| 2106 (set-buffer-multibyte nil) | 2105 (set-buffer-multibyte nil) |
| 2107 (with-current-buffer destbuf | 2106 (with-current-buffer destbuf |
| 2108 ;; Do it within the `widen'. | 2107 ;; Do it within the `widen'. |
| 2109 (insert-buffer-substring archivebuf from (+ from size))) | 2108 (insert-buffer-substring archivebuf from (+ from size))) |
| 2110 (set-buffer-multibyte 'to) | 2109 (set-buffer-multibyte 'to) |
| 2111 ;; Inform the caller that the call succeeded. | 2110 ;; Inform the caller that the call succeeded. |
| 2112 t))))) | 2111 t)))))) |
| 2113 | 2112 |
| 2114 ;; ------------------------------------------------------------------------- | 2113 ;; ------------------------------------------------------------------------- |
| 2115 ;; This line was a mistake; it is kept now for compatibility. | 2114 ;; This line was a mistake; it is kept now for compatibility. |
| 2116 ;; rms 15 Oct 98 | 2115 ;; rms 15 Oct 98 |
| 2117 (provide 'archive-mode) | 2116 (provide 'archive-mode) |