From: morioka Date: Fri, 13 Mar 1998 09:10:06 +0000 (+0000) Subject: Delete. X-Git-Tag: Hokutetsu-Ishikawa~5 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=37aa4b86f56757ff885472fd537d758ae1c332cd;p=elisp%2Fsemi.git Delete. --- diff --git a/mime-tar.el b/mime-tar.el deleted file mode 100644 index 129820c..0000000 --- a/mime-tar.el +++ /dev/null @@ -1,359 +0,0 @@ -;;; mime-tar.el --- mime-view internal method for tar or tar+gzip format - -;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. - -;; Author: Hiroshi Ueno -;; modified by MORIOKA Tomohiko -;; Renamed: 1997/2/26 from tm-tar.el -;; Version: $Id: mime-tar.el,v 0.7 1997-05-12 12:30:42 morioka Exp $ -;; Keywords: tar, tar+gzip, MIME, multimedia, mail, news - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Internal viewer for -;; - application/x-tar -;; - application/x-gzip, type="tar" -;; - aplication/octet-stream, type="tar" -;; - aplication/octet-stream, type="tar+gzip" - -;;; Code: - -(require 'mime-view) - - -;;; @ constants -;;; - -(defconst mime-tar-list-buffer "*mime-tar-List*") -(defconst mime-tar-view-buffer "*mime-tar-View*") -(defconst mime-tar-file-search-regexp "[0-9]+\:[0-9\:]+[ ]+[0-9]+[ ]+") -(defconst mime-tar-popup-menu-title "Action Menu") - - -;;; @ variables -;;; - -(defvar mime-tar-program "gtar") -(defvar mime-tar-decompress-arg '("-z")) -(defvar mime-tar-gzip-program "gzip") -(defvar mime-tar-mmencode-program "mmencode") -(defvar mime-tar-uudecode-program "uudecode") - -(defvar mime-tar-popup-menu-items - '(("View File" . mime-tar-view-file) - ("Key Help" . mime-tar-helpful-message) - ("Quit mime-tar Mode" . exit-recursive-edit) - )) - -(cond ((string-match "XEmacs\\|Lucid" emacs-version) - (defvar mime-tar-popup-menu - (cons mime-tar-popup-menu-title - (mapcar (function - (lambda (item) - (vector (car item)(cdr item) t) - )) - mime-tar-popup-menu-items))) - - (defun mime-tar-mouse-button-2 (event) - (popup-menu mime-tar-popup-menu) - ) - ) - ((>= emacs-major-version 19) - (defun mime-tar-mouse-button-2 (event) - (let ((menu - (cons mime-tar-popup-menu-title - (list (cons "Menu Items" mime-tar-popup-menu-items)) - ))) - (let ((func (x-popup-menu event menu))) - (if func - (funcall func) - )) - )) - )) - -(defvar mime-tar-mode-map nil) -(if mime-tar-mode-map - nil - (setq mime-tar-mode-map (make-keymap)) - (suppress-keymap mime-tar-mode-map) - (define-key mime-tar-mode-map "\C-c" 'exit-recursive-edit) - (define-key mime-tar-mode-map "q" 'exit-recursive-edit) - (define-key mime-tar-mode-map "n" 'mime-tar-next-line) - (define-key mime-tar-mode-map " " 'mime-tar-next-line) - (define-key mime-tar-mode-map "\C-m" 'mime-tar-next-line) - (define-key mime-tar-mode-map "p" 'mime-tar-previous-line) - (define-key mime-tar-mode-map "\177" 'mime-tar-previous-line) - (define-key mime-tar-mode-map "\C-\M-m" 'mime-tar-previous-line) - (define-key mime-tar-mode-map "v" 'mime-tar-view-file) - (define-key mime-tar-mode-map "\C-h" 'Helper-help) - (define-key mime-tar-mode-map "?" 'mime-tar-helpful-message) - (if mouse-button-2 - (define-key mime-tar-mode-map - mouse-button-2 'mime-button-dispatcher)) - ) - - -;;; @@ mime-tar mode functions -;;; - -(defun mime-tar-mode (&optional prev-buf) - "Major mode for listing the contents of a tar archive file." - (unwind-protect - (let ((buffer-read-only t) - (mode-name "mime-tar") - (mode-line-buffer-identification '("%17b")) - ) - (goto-char (point-min)) - (mime-tar-move-to-filename) - (catch 'mime-tar-mode (mime-tar-command-loop)) - ) - (if prev-buf - (switch-to-buffer prev-buf) - ) - )) - -(defun mime-tar-command-loop () - (let ((old-local-map (current-local-map))) - (unwind-protect - (progn - (use-local-map mime-tar-mode-map) - (mime-tar-helpful-message) - (recursive-edit) - ) - (save-excursion - (use-local-map old-local-map) - )) - )) - -(defun mime-tar-next-line () - (interactive) - (next-line 1) - (mime-tar-move-to-filename) - ) - -(defun mime-tar-previous-line () - (interactive) - (previous-line 1) - (mime-tar-move-to-filename) - ) - -(defun mime-tar-view-file () - (interactive) - (let ((name (mime-tar-get-filename)) - ) - (save-excursion - (switch-to-buffer mime-tar-view-buffer) - (setq buffer-read-only nil) - (erase-buffer) - (message "Reading a file from an archive. Please wait...") - (apply 'call-process mime-tar-program - nil t nil (append mime-tar-view-args (list name))) - (goto-char (point-min)) - ) - (view-buffer mime-tar-view-buffer) - )) - -(defun mime-tar-get-filename () - (let (eol) - (save-excursion - (end-of-line) - (setq eol (point)) - (beginning-of-line) - (save-excursion - (if (re-search-forward "^d" eol t) - (error "Cannot view a directory")) - ) - (if (re-search-forward mime-tar-file-search-regexp eol t) - (let ((beg (point))) - (skip-chars-forward "^ \n") - (buffer-substring beg (point)) - ) - (error "No file on this line") - )) - )) - -(defun mime-tar-move-to-filename () - (let ((eol (progn (end-of-line) (point)))) - (beginning-of-line) - (re-search-forward mime-tar-file-search-regexp eol t) - )) - -(defun mime-tar-set-properties () - (if mouse-button-2 - (let ((beg (point-min)) - (end (point-max)) - ) - (goto-char beg) - (save-excursion - (while (re-search-forward mime-tar-file-search-regexp end t) - (mime-add-button (point) - (progn - (end-of-line) - (point)) - 'mime-tar-view-file) - )) - ))) - -(defun mime-tar-helpful-message () - (interactive) - (message "Type %s, %s, %s, %s, %s, %s." - (substitute-command-keys "\\[Helper-help] for help") - (substitute-command-keys "\\[mime-tar-helpful-message] for keys") - (substitute-command-keys "\\[mime-tar-next-line] to next") - (substitute-command-keys "\\[mime-tar-previous-line] to prev") - (substitute-command-keys "\\[mime-tar-view-file] to view") - (substitute-command-keys "\\[exit-recursive-edit] to quit") - )) - -(defun mime-tar-y-or-n-p (prompt) - (prog1 - (y-or-n-p prompt) - (message "") - )) - -;;; @@ tar message decoder -;; - -(defun mime-decode-message/tar (beg end cal) - (if (mime-tar-y-or-n-p "Do you want to enter mime-tar mode? ") - (let ((coding (cdr (assoc 'encoding cal))) - (cur-buf (current-buffer)) - (mime-tar-file-name - (expand-file-name - (concat (make-temp-name - (expand-file-name "tm" mime-temp-directory)) ".tar"))) - (mime-tar-tmp-file-name - (expand-file-name - (make-temp-name (expand-file-name "tm" mime-temp-directory)))) - new-buf) - (find-file mime-tar-tmp-file-name) - (setq new-buf (current-buffer)) - (setq buffer-read-only nil) - (erase-buffer) - (save-excursion - (set-buffer cur-buf) - (goto-char beg) - (re-search-forward "^$") - (append-to-buffer new-buf (+ (match-end 0) 1) end) - ) - (if (member coding mime-view-uuencode-encoding-name-list) - (progn - (goto-char (point-min)) - (if (re-search-forward "^begin [0-9]+ " nil t) - (progn - (kill-line) - (insert mime-tar-file-name) - ) - (progn - (set-buffer-modified-p nil) - (kill-buffer new-buf) - (error "uuencode file signature was not found") - )))) - (save-buffer) - (kill-buffer new-buf) - (message "Listing the contents of an archive. Please wait...") - (cond ((string-equal coding "base64") - (call-process mime-tar-mmencode-program nil nil nil "-u" - "-o" mime-tar-file-name mime-tar-tmp-file-name) - ) - ((string-equal coding "quoted-printable") - (call-process mime-tar-mmencode-program nil nil nil "-u" "-q" - "-o" mime-tar-file-name mime-tar-tmp-file-name) - ) - ((member coding mime-view-uuencode-encoding-name-list) - (call-process mime-tar-uudecode-program nil nil nil - mime-tar-tmp-file-name) - ) - (t - (copy-file mime-tar-tmp-file-name mime-tar-file-name t) - )) - (delete-file mime-tar-tmp-file-name) - (setq mime-tar-list-args (list "-tvf" mime-tar-file-name)) - (setq mime-tar-view-args (list "-xOf" mime-tar-file-name)) - (if (eq 0 (call-process mime-tar-gzip-program - nil nil nil "-t" mime-tar-file-name)) - (progn - (setq mime-tar-list-args - (append mime-tar-decompress-arg mime-tar-list-args)) - (setq mime-tar-view-args - (append mime-tar-decompress-arg mime-tar-view-args)) - )) - (switch-to-buffer mime-tar-view-buffer) - (switch-to-buffer mime-tar-list-buffer) - (setq buffer-read-only nil) - (erase-buffer) - (apply 'call-process mime-tar-program - nil t nil mime-tar-list-args) - (if mouse-button-2 - (progn - (make-local-variable 'mime-button-mother-dispatcher) - (setq mime-button-mother-dispatcher 'mime-tar-mouse-button-2) - )) - (mime-tar-set-properties) - (mime-tar-mode mime-view-buffer) - (kill-buffer mime-tar-view-buffer) - (kill-buffer mime-tar-list-buffer) - (delete-file mime-tar-file-name) - ) - )) - -;;; @@ program/buffer coding system -;;; - -(cond ((boundp 'MULE) - (define-program-coding-system mime-tar-view-buffer nil '*autoconv*) - ) - ((boundp 'NEMACS) - (define-program-kanji-code mime-tar-view-buffer nil 1) - )) - -;;; @@ message types to use mime-tar -;;; - -(set-atype 'mime-acting-condition - '((type . "application/octet-stream") - (method . mime-decode-message/tar) - (mode . "play") ("type" . "tar") - )) - -(set-atype 'mime-acting-condition - '((type . "application/octet-stream") - (method . mime-decode-message/tar) - (mode . "play") ("type" . "tar+gzip") - )) - -(set-atype 'mime-acting-condition - '((type . "application/x-gzip") - (method . mime-decode-message/tar) - (mode . "play") ("type" . "tar") - )) - -(set-atype 'mime-acting-condition - '((type . "application/x-tar") - (method . mime-decode-message/tar) - (mode . "play") - )) - -;;; @ end -;;; - -(provide 'mime-tar) - -;;; mime-tar.el ends here