comparison lisp/arc-mode.el @ 86928:29dfee94a77f

(archive-find-type): Add recognition of rar-exe format. (archive-rar-summarize): Allow the file name to be passed as argument. Remove unused vars `header' and `footer'. (archive-rar-exe-summarize, archive-rar-exe-extract): New functions.

86927:d4651506a112

          ;; This pattern modelled on the BSD/GNU+Linux `file' command.
          ;; Have seen capital "LHA's", and file has lower case "LHa's" too.
          ;; Note this regexp is also in archive-exe-p.
          ((looking-at "MZ\\(.\\|\n\\)\\{34\\}LH[aA]'s SFX ") 'lzh-exe)
          ((looking-at "Rar!") 'rar)
	  (t (error "Buffer format not recognized")))))
;; -------------------------------------------------------------------------

(defun archive-desummarize ()
  (let ((inhibit-read-only t)

  (archive-extract-by-stdout archive name archive-zoo-extract))

;; -------------------------------------------------------------------------
;;; Section: Rar Archives

(defun archive-rar-summarize ()
  (let* ((file buffer-file-name)
         (copy (file-local-copy file))
         header footer
         (maxname 10)
         (maxsize 5)
         (files ()))
    (with-temp-buffer
      (call-process "unrar-free" nil t nil "--list" (or file copy))
      (if copy (delete-file copy))
      (goto-char (point-min))
      (re-search-forward "^-+\n")
      (setq header
            (buffer-substring (save-excursion (re-search-backward "^[^ ]"))
                              (point)))
      (while (looking-at (concat " \\(.*\\)\n" ;Name.
                                 ;; Size ; Packed.
                                 " +\\([0-9]+\\) +[0-9]+"
                                 ;; Ratio ; Date'
                                 " +\\([0-9%]+\\) +\\([-0-9]+\\)"

          (push (vector name name nil nil
                        ;; Size, Ratio.
                        size (match-string 3)
                        ;; Date, Time.
                        (match-string 4) (match-string 5))
                files)))
      (setq footer (buffer-substring (point) (point-max))))
    (setq files (nreverse files))
    (goto-char (point-min))
    (let* ((format (format " %%s %%s  %%%ds %%5s  %%s" maxsize))
           (sep (format format "--------" "-----" (make-string maxsize ?-)
                        "-----" ""))

        (while (file-name-directory name)
          (setq name (directory-file-name (file-name-directory name)))
          (delete-directory (expand-file-name name dest)))
        (delete-directory dest)))))

;; -------------------------------------------------------------------------
;; This line was a mistake; it is kept now for compatibility.
;; rms  15 Oct 98
(provide 'archive-mode)

(provide 'arc-mode)

;; arch-tag: e5966a01-35ec-4f27-8095-a043a79b457b

86928:29dfee94a77f

          ;; This pattern modelled on the BSD/GNU+Linux `file' command.
          ;; Have seen capital "LHA's", and file has lower case "LHa's" too.
          ;; Note this regexp is also in archive-exe-p.
          ((looking-at "MZ\\(.\\|\n\\)\\{34\\}LH[aA]'s SFX ") 'lzh-exe)
          ((looking-at "Rar!") 'rar)
          ((and (looking-at "MZ")
                (re-search-forward "Rar!" (+ (point) 100000) t))
           'rar-exe)
	  (t (error "Buffer format not recognized")))))
;; -------------------------------------------------------------------------

(defun archive-desummarize ()
  (let ((inhibit-read-only t)

  (archive-extract-by-stdout archive name archive-zoo-extract))

;; -------------------------------------------------------------------------
;;; Section: Rar Archives

(defun archive-rar-summarize (&optional file)
  ;; File is used internally for `archive-rar-exe-summarize'.
  (unless file (setq file buffer-file-name))
  (let* ((copy (file-local-copy file))
         (maxname 10)
         (maxsize 5)
         (files ()))
    (with-temp-buffer
      (call-process "unrar-free" nil t nil "--list" (or file copy))
      (if copy (delete-file copy))
      (goto-char (point-min))
      (re-search-forward "^-+\n")
      (while (looking-at (concat " \\(.*\\)\n" ;Name.
                                 ;; Size ; Packed.
                                 " +\\([0-9]+\\) +[0-9]+"
                                 ;; Ratio ; Date'
                                 " +\\([0-9%]+\\) +\\([-0-9]+\\)"

          (push (vector name name nil nil
                        ;; Size, Ratio.
                        size (match-string 3)
                        ;; Date, Time.
                        (match-string 4) (match-string 5))
                files))))
    (setq files (nreverse files))
    (goto-char (point-min))
    (let* ((format (format " %%s %%s  %%%ds %%5s  %%s" maxsize))
           (sep (format format "--------" "-----" (make-string maxsize ?-)
                        "-----" ""))

        (while (file-name-directory name)
          (setq name (directory-file-name (file-name-directory name)))
          (delete-directory (expand-file-name name dest)))
        (delete-directory dest)))))

;;; Section: Rar self-extracting .exe archives.

(defun archive-rar-exe-summarize ()
  (let ((tmpfile (make-temp-file "rarexe")))
    (unwind-protect
        (progn
          (goto-char (point-min))
          (re-search-forward "Rar!")
          (write-region (match-beginning 0) (point-max) tmpfile)
          (archive-rar-summarize tmpfile))
      (delete-file tmpfile))))

(defun archive-rar-exe-extract (archive name)
  (let* ((tmpfile (make-temp-file "rarexe"))
         (buf (find-buffer-visiting archive))
         (tmpbuf (unless buf (generate-new-buffer " *rar-exe*"))))
    (unwind-protect
        (progn
          (with-current-buffer (or buf tmpbuf)
            (save-excursion
              (save-restriction
                (if buf
                    ;; point-max unwidened is assumed to be the end of the
                    ;; summary text and the beginning of the actual file data.
                    (progn (goto-char (point-max)) (widen))
                  (insert-file-contents-literally archive)
                  (goto-char (point-min)))
                (re-search-forward "Rar!")
                (write-region (match-beginning 0) (point-max) tmpfile))))
          (archive-rar-extract tmpfile name))
      (if tmpbuf (kill-buffer tmpbuf))
      (delete-file tmpfile))))
  

;; -------------------------------------------------------------------------
;; This line was a mistake; it is kept now for compatibility.
;; rms  15 Oct 98

(provide 'archive-mode)

(provide 'arc-mode)

;; arch-tag: e5966a01-35ec-4f27-8095-a043a79b457b