;;;
-;;; tm-comp.el: attachment for MIME composer
+;;; tm-comp.el --- attachment for MIME composer
;;;
-;;; by MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;;; and OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
-;;; modified by MORITA Masahiro <hiro@isl.ntt.JP>
-;;; MORIOKA Tomohiko,
-;;; Kazushi (Jam) MARUKAWA <kazusi-m@is.aist-nara.ac.jp>,
-;;; OKABE Yasuo,
-;;; KOBAYASHI Shuhei <shuhei@cmpt01.phys.tohoku.ac.jp>,
-;;; and YAMAOKA Katsumi <yamaoka@ga.sony.co.jp>
+;;; Copyright (C) 1995 Free Software Foundation, Inc.
+;;; Copyright (C) 1994,1995 MORIOKA Tomohiko
+;;; Copyright (C) 1994,1995 OKABE Yasuo
+;;;
+;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>,
+;;; OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
+;;; modified by MORITA Masahiro <hiro@isl.ntt.JP>
+;;; Kazushi (Jam) MARUKAWA <kazusi-m@is.aist-nara.ac.jp>,
+;;; KOBAYASHI Shuhei <shuhei@cmpt01.phys.tohoku.ac.jp>,
+;;; YAMAOKA Katsumi <yamaoka@ga.sony.co.jp>,
+;;; and Richard Stanton <stanton@haas.berkeley.edu>
+;;; Keywords: mail, news, MIME, multimedia
+;;;
+;;; This file is part of tm (Tools for MIME).
;;;
(require 'tm-view)
-(require 'tl-header)
+(require 'tl-822)
(require 'tl-list)
(require 'mail-utils)
;;;
(defconst mime/composer-RCS-ID
- "$Id: tm-comp.el,v 6.12 1995/09/28 03:56:17 morioka Exp $")
+ "$Id: tm-comp.el,v 7.2 1995/10/08 09:31:05 morioka Exp $")
(defconst mime/composer-version (get-version-string mime/composer-RCS-ID))
(let ((mc-flag nil) ;Mule
(file-coding-system-for-read
(if (featurep 'mule) *noconv*))
- (kanji-flag nil)) ;NEmacs
+ (kanji-flag nil) ;NEmacs
+ (emx-binary-mode t) ;Stop CRLF to LF conversion in OS/2
+ )
(let (jka-compr-compression-info-list
jam-zcat-filename-list)
(insert-file-contents file))))
)
(save-restriction
(narrow-to-region (1- (point)) (point))
- (let ((start (point)))
+ (let ((start (point))
+ (emx-binary-mode t)) ;Stop LF to CRLF conversion in OS/2
(insert-buffer-substring buffer)
;; Encode binary message if necessary.
(if encoding
(let ((hook (cdr (assq major-mode
mime/message-before-send-hook-alist))))
(run-hooks hook))
- (let* ((header (message/get-header-string-except
- mime/message-nuke-headers separator))
- (orig-header (message/get-header-string-except
+ (let* ((header (rfc822/get-header-string-except
+ mime/message-nuke-headers separator))
+ (orig-header (rfc822/get-header-string-except
mime/message-blind-headers separator))
(subject (mail-fetch-field "subject"))
(total (+ (/ lines mime/message-max-length)
;;; @ etc
;;;
-(defun message/get-header-string-except (pat boundary)
+(defun rfc822/get-header-string-except (pat boundary)
(let ((case-fold-search t))
(save-excursion
(save-restriction
))
(goto-char (point-min))
(let (field header)
- (while (re-search-forward message/field-regexp nil t)
+ (while (re-search-forward rfc822/field-top-regexp nil t)
(setq field (buffer-substring (match-beginning 0)
- (match-end 0)
+ (rfc822/field-end)
))
(if (not (string-match pat field))
(setq header (concat header field "\n"))
;;;
-;;; $Id: tm-tar.el,v 1.1 1995/09/18 17:09:19 H.Ueno Exp $
+;;; $Id: tm-tar.el,v 1.2 1995/10/07 21:47:24 H.Ueno Exp $
;;;
;;; tm-tar.el
;;;
(defconst tm-tar/list-buffer "*tm-tar/List*")
(defconst tm-tar/view-buffer "*tm-tar/View*")
(defconst tm-tar/file-search-regexp "[0-9]+\:[0-9\:]+[ ]+[0-9]+[ ]+")
+(defconst tm-tar/popup-menu-title "Action Menu")
;;; @ variables
;;;
(defvar tm-tar/tar-program "gtar")
-(defvar tm-tar/tar-compress-arg '("-z"))
+(defvar tm-tar/tar-decompress-arg '("-z"))
(defvar tm-tar/gzip-program "gzip")
(defvar tm-tar/mmencode-program "mmencode")
(defvar tm-tar/uudecode-program "uudecode")
-(defvar mime/tm-tar-mode-map nil)
-(if mime/tm-tar-mode-map
- nil
- (setq mime/tm-tar-mode-map (make-keymap))
- (suppress-keymap mime/tm-tar-mode-map)
- (define-key mime/tm-tar-mode-map "\C-c" 'exit-recursive-edit)
- (define-key mime/tm-tar-mode-map "q" 'exit-recursive-edit)
- (define-key mime/tm-tar-mode-map "n" 'mime/tm-tar/next-line)
- (define-key mime/tm-tar-mode-map " " 'mime/tm-tar/next-line)
- (define-key mime/tm-tar-mode-map "\C-m" 'mime/tm-tar/next-line)
- (define-key mime/tm-tar-mode-map "p" 'mime/tm-tar/previous-line)
- (define-key mime/tm-tar-mode-map "\177" 'mime/tm-tar/previous-line)
- (define-key mime/tm-tar-mode-map "\C-\M-m" 'mime/tm-tar/previous-line)
- (define-key mime/tm-tar-mode-map "v" 'mime/tm-tar/view-file)
- (define-key mime/tm-tar-mode-map "\C-h" 'Helper-help)
- (define-key mime/tm-tar-mode-map "?" 'mime/tm-tar/helpful-message)
- (cond ((string-match "XEmacs\\|Lucid" emacs-version)
- (define-key mime/tm-tar-mode-map
- 'button2 'mime/tm-tar/view-file-mouse)
- )
- ((> emacs-major-version 18)
- (define-key mime/tm-tar-mode-map
- [mouse-2] 'mime/tm-tar/view-file-mouse)
+(defvar tm-tar/show-popup-menu (>= emacs-major-version 19)
+ "*if non nil, TAR Mode popup menu will be shown to select an action.
+if nil, a selected file will be shown in a buffer")
+
+(defvar tm-tar/popup-menu-items
+ '(("View File" . tm-tar/view-file)
+ ("Key Help" . tm-tar/helpful-message)
+ ("Quit TAR Mode" . exit-recursive-edit)
+ ))
+
+(cond ((string-match "XEmacs\\|Lucid" emacs-version)
+ (defvar tm-tar/popup-menu
+ (cons tm-tar/popup-menu-title
+ (mapcar (function
+ (lambda (item)
+ (vector (car item)(cdr item) t)
+ ))
+ tm-tar/popup-menu-items)))
+
+ (defun tm-tar/mouse-button-2 ()
+ (if tm-tar/show-popup-menu
+ (popup-menu tm-tar/popup-menu)
+ (tm-tar/view-file)
))
+ )
+ ((>= emacs-major-version 19)
+ (defun tm-tar/mouse-button-2 ()
+ (let ((menu
+ (cons tm-tar/popup-menu-title
+ (list (cons "Menu Items" tm-tar/popup-menu-items))
+ )))
+ (if tm-tar/show-popup-menu
+ (let ((func (x-popup-menu last-input-event menu)))
+ (if func
+ (funcall func)
+ ))
+ (tm-tar/view-file)
+ )))
+ ))
+
+(defvar tm-tar/tar-mode-map nil)
+(if tm-tar/tar-mode-map
+ nil
+ (setq tm-tar/tar-mode-map (make-keymap))
+ (suppress-keymap tm-tar/tar-mode-map)
+ (define-key tm-tar/tar-mode-map "\C-c" 'exit-recursive-edit)
+ (define-key tm-tar/tar-mode-map "q" 'exit-recursive-edit)
+ (define-key tm-tar/tar-mode-map "n" 'tm-tar/next-line)
+ (define-key tm-tar/tar-mode-map " " 'tm-tar/next-line)
+ (define-key tm-tar/tar-mode-map "\C-m" 'tm-tar/next-line)
+ (define-key tm-tar/tar-mode-map "p" 'tm-tar/previous-line)
+ (define-key tm-tar/tar-mode-map "\177" 'tm-tar/previous-line)
+ (define-key tm-tar/tar-mode-map "\C-\M-m" 'tm-tar/previous-line)
+ (define-key tm-tar/tar-mode-map "v" 'tm-tar/view-file)
+ (define-key tm-tar/tar-mode-map "\C-h" 'Helper-help)
+ (define-key tm-tar/tar-mode-map "?" 'tm-tar/helpful-message)
+ (if mouse-button-2
+ (define-key tm-tar/tar-mode-map
+ mouse-button-2 'tm:button-dispatcher)
+ )
)
;;; @@ tm-tar mode functions
;;;
-(defun mime/tm-tar-mode (&optional prev-buf)
+(defun tm-tar/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 "tm-tar")
- (mode-line-buffer-identification '("%17b"))
- )
- (goto-char (point-min))
- (mime/tm-tar/move-to-filename)
- (catch 'mime/tm-tar-mode (mime/tm-tar-mode/command-loop))
- )
- (if prev-buf
- (switch-to-buffer prev-buf)
- )
+ (let ((buffer-read-only t)
+ (mode-name "tm-tar")
+ (mode-line-buffer-identification '("%17b"))
+ )
+ (goto-char (point-min))
+ (tm-tar/move-to-filename)
+ (catch 'tm-tar/tar-mode (tm-tar/command-loop))
+ )
+ (if prev-buf
+ (switch-to-buffer prev-buf)
+ )
))
-(defun mime/tm-tar-mode/command-loop ()
+(defun tm-tar/command-loop ()
(let ((old-local-map (current-local-map))
- )
- (unwind-protect
- (progn
- (use-local-map mime/tm-tar-mode-map)
- (mime/tm-tar/helpful-message)
- (recursive-edit)
- )
- (save-excursion
- (use-local-map old-local-map)
- ))
+ )
+ (unwind-protect
+ (progn
+ (use-local-map tm-tar/tar-mode-map)
+ (tm-tar/helpful-message)
+ (recursive-edit)
+ )
+ (save-excursion
+ (use-local-map old-local-map)
+ ))
))
-(defun mime/tm-tar/next-line ()
+(defun tm-tar/next-line ()
(interactive)
(next-line 1)
- (mime/tm-tar/move-to-filename)
+ (tm-tar/move-to-filename)
)
-(defun mime/tm-tar/previous-line ()
+(defun tm-tar/previous-line ()
(interactive)
(previous-line 1)
- (mime/tm-tar/move-to-filename)
+ (tm-tar/move-to-filename)
)
-(defun mime/tm-tar/view-file ()
+(defun tm-tar/view-file ()
(interactive)
- (let ((name (mime/tm-tar/get-filename))
- )
+ (let ((name (tm-tar/get-filename))
+ )
(save-excursion
- (switch-to-buffer tm-tar/view-buffer)
- (setq buffer-read-only nil)
- (erase-buffer)
- (message "Reading a file from the archive. Please wait...")
- (apply 'call-process tm-tar/tar-program
- nil t nil (append tm-tar/view-args (list name)))
- (goto-char (point-min))
+ (switch-to-buffer tm-tar/view-buffer)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (message "Reading a file from an archive. Please wait...")
+ (apply 'call-process tm-tar/tar-program
+ nil t nil (append tm-tar/view-args (list name)))
+ (goto-char (point-min))
)
- (view-buffer tm-tar/view-buffer)
+ (view-buffer tm-tar/view-buffer)
))
-(defun mime/tm-tar/view-file-mouse (e)
- (interactive "e")
- (mouse-set-point e)
- (mime/tm-tar/view-file)
- )
-
-(defun mime/tm-tar/get-filename ()
+(defun tm-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 tm-tar/file-search-regexp eol t)
- (progn (let ((beg (point))
- )
- (skip-chars-forward "^ \n")
- (buffer-substring beg (point))
- ))
- (error "No file on this line")
- ))
+ (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 tm-tar/file-search-regexp eol t)
+ (progn (let ((beg (point))
+ )
+ (skip-chars-forward "^ \n")
+ (buffer-substring beg (point))
+ ))
+ (error "No file on this line")
+ ))
))
-(defun mime/tm-tar/move-to-filename ()
+(defun tm-tar/move-to-filename ()
(let ((eol (progn (end-of-line) (point)))
- )
- (beginning-of-line)
- (re-search-forward tm-tar/file-search-regexp eol t)
+ )
+ (beginning-of-line)
+ (re-search-forward tm-tar/file-search-regexp eol t)
))
-(defun mime/tm-tar/set-properties ()
- (if (> emacs-major-version 18)
- (let ((beg (point-min))
- (end (point-max))
- )
- (goto-char beg)
+(defun tm-tar/set-properties ()
+ (if mouse-button-2
+ (let ((beg (point-min))
+ (end (point-max))
+ )
+ (goto-char beg)
(save-excursion
- (while (re-search-forward tm-tar/file-search-regexp end t)
- (put-text-property (point)
- (progn
- (end-of-line)
- (point))
- 'mouse-face 'highlight)
- ))
- )))
+ (while (re-search-forward tm-tar/file-search-regexp end t)
+ (tm:add-button (point)
+ (progn
+ (end-of-line)
+ (point))
+ 'tm-tar/mouse-button-2)
+ ))
+ )))
-(defun mime/tm-tar/helpful-message ()
+(defun tm-tar/helpful-message ()
(interactive)
(message "Type %s, %s, %s, %s, %s, %s."
- (substitute-command-keys "\\[Helper-help] for help")
- (substitute-command-keys "\\[mime/tm-tar/helpful-message] for key")
- (substitute-command-keys "\\[mime/tm-tar/next-line] to next")
- (substitute-command-keys "\\[mime/tm-tar/previous-line] to prev")
- (substitute-command-keys "\\[mime/tm-tar/view-file] to view")
- (substitute-command-keys "\\[exit-recursive-edit] to quit")
+ (substitute-command-keys "\\[Helper-help] for help")
+ (substitute-command-keys "\\[tm-tar/helpful-message] for keys")
+ (substitute-command-keys "\\[tm-tar/next-line] to next")
+ (substitute-command-keys "\\[tm-tar/previous-line] to prev")
+ (substitute-command-keys "\\[tm-tar/view-file] to view")
+ (substitute-command-keys "\\[exit-recursive-edit] to quit")
))
;;; @@ tar message decoder
(defun mime/decode-message/tar (beg end cal)
(let ((coding (cdr (assoc 'encoding cal)))
- (cur-buf (current-buffer))
- (tm-tar/tar-file-name (expand-file-name (concat (make-temp-name
- (expand-file-name "tm" mime/tmp-dir)) ".tar")))
- (tm-tar/tmp-file-name (expand-file-name (make-temp-name
- (expand-file-name "tm" mime/tmp-dir))))
- new-buf
- )
- (find-file tm-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-viewer/uuencode-encoding-name-list)
- (progn
- (goto-char (point-min))
- (if (re-search-forward "^begin [0-9]+ " nil t)
- (progn
- (kill-line)
- (insert tm-tar/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 archive. Please wait...")
- (cond ((string-equal coding "base64")
- (call-process tm-tar/mmencode-program nil nil nil "-u"
- "-o" tm-tar/tar-file-name tm-tar/tmp-file-name)
- )
- ((string-equal coding "quoted-printable")
- (call-process tm-tar/mmencode-program nil nil nil "-u" "-q"
- "-o" tm-tar/tar-file-name tm-tar/tmp-file-name)
- )
- ((member coding mime-viewer/uuencode-encoding-name-list)
- (call-process tm-tar/uudecode-program nil nil nil
- tm-tar/tmp-file-name)
- )
- (t
- (copy-file tm-tar/tmp-file-name tm-tar/tar-file-name t)
- ))
- (delete-file tm-tar/tmp-file-name)
- (setq tm-tar/list-args (list "-tvf" tm-tar/tar-file-name))
- (setq tm-tar/view-args (list "-xOf" tm-tar/tar-file-name))
- (if (eq 0 (call-process tm-tar/gzip-program
- nil nil nil "-t" tm-tar/tar-file-name))
- (progn
- (setq tm-tar/list-args
- (append tm-tar/tar-compress-arg tm-tar/list-args))
- (setq tm-tar/view-args
- (append tm-tar/tar-compress-arg tm-tar/view-args))
- ))
- (switch-to-buffer tm-tar/view-buffer)
- (switch-to-buffer tm-tar/list-buffer)
- (setq buffer-read-only nil)
- (erase-buffer)
- (apply 'call-process tm-tar/tar-program
- nil t nil tm-tar/list-args)
- (mime/tm-tar/set-properties)
- (mime/tm-tar-mode cur-buf)
- (kill-buffer tm-tar/view-buffer)
- (kill-buffer tm-tar/list-buffer)
- (delete-file tm-tar/tar-file-name)
+ (cur-buf (current-buffer))
+ (tm-tar/tar-file-name (expand-file-name (concat (make-temp-name
+ (expand-file-name "tm" mime/tmp-dir)) ".tar")))
+ (tm-tar/tmp-file-name (expand-file-name (make-temp-name
+ (expand-file-name "tm" mime/tmp-dir))))
+ new-buf
+ )
+ (find-file tm-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-viewer/uuencode-encoding-name-list)
+ (progn
+ (goto-char (point-min))
+ (if (re-search-forward "^begin [0-9]+ " nil t)
+ (progn
+ (kill-line)
+ (insert tm-tar/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 tm-tar/mmencode-program nil nil nil "-u"
+ "-o" tm-tar/tar-file-name tm-tar/tmp-file-name)
+ )
+ ((string-equal coding "quoted-printable")
+ (call-process tm-tar/mmencode-program nil nil nil "-u" "-q"
+ "-o" tm-tar/tar-file-name tm-tar/tmp-file-name)
+ )
+ ((member coding mime-viewer/uuencode-encoding-name-list)
+ (call-process tm-tar/uudecode-program nil nil nil
+ tm-tar/tmp-file-name)
+ )
+ (t
+ (copy-file tm-tar/tmp-file-name tm-tar/tar-file-name t)
+ ))
+ (delete-file tm-tar/tmp-file-name)
+ (setq tm-tar/list-args (list "-tvf" tm-tar/tar-file-name))
+ (setq tm-tar/view-args (list "-xOf" tm-tar/tar-file-name))
+ (if (eq 0 (call-process tm-tar/gzip-program
+ nil nil nil "-t" tm-tar/tar-file-name))
+ (progn
+ (setq tm-tar/list-args
+ (append tm-tar/tar-decompress-arg tm-tar/list-args))
+ (setq tm-tar/view-args
+ (append tm-tar/tar-decompress-arg tm-tar/view-args))
+ ))
+ (switch-to-buffer tm-tar/view-buffer)
+ (switch-to-buffer tm-tar/list-buffer)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (apply 'call-process tm-tar/tar-program
+ nil t nil tm-tar/list-args)
+ (tm-tar/set-properties)
+ (tm-tar/tar-mode mime::article/preview-buffer)
+ (kill-buffer tm-tar/view-buffer)
+ (kill-buffer tm-tar/list-buffer)
+ (delete-file tm-tar/tar-file-name)
))
;;; @@ program/buffer coding system
;;;
(set-atype 'mime/content-decoding-condition
- '((type . "application/octet-stream")
- (method . mime/decode-message/tar)
- (mode . "play") ("type" . "tar")
- ))
+ '((type . "application/octet-stream")
+ (method . mime/decode-message/tar)
+ (mode . "play") ("type" . "tar")
+ ))
(set-atype 'mime/content-decoding-condition
- '((type . "application/octet-stream")
- (method . mime/decode-message/tar)
- (mode . "play") ("type" . "tar+gzip")
- ))
+ '((type . "application/octet-stream")
+ (method . mime/decode-message/tar)
+ (mode . "play") ("type" . "tar+gzip")
+ ))
(set-atype 'mime/content-decoding-condition
- '((type . "application/x-gzip")
- (method . mime/decode-message/tar)
- (mode . "play") ("type" . "tar")
- ))
+ '((type . "application/x-gzip")
+ (method . mime/decode-message/tar)
+ (mode . "play") ("type" . "tar")
+ ))
(set-atype 'mime/content-decoding-condition
- '((type . "application/x-tar")
- (method . mime/decode-message/tar)
- (mode . "play")
- ))
+ '((type . "application/x-tar")
+ (method . mime/decode-message/tar)
+ (mode . "play")
+ ))
;;; @ end
;;;
(provide 'tm-tar)
-
projects / elisp / tm.git / commitdiff