;;; mel-zip.el --- bzip2-64 encoder/decoder, etc.

;; Copyleft (^^) 1999 Katsumi Yamaoka

;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
;; Created: 1999/09/30
;; Revised: 1999/10/01
;; Keywords: x-bzip-2-64, x-rot13-47-48

;; This file is not part of any packages.

;;; Commentary:

;; このファイルには x-bzip-2-64 な記事などを FLIM や SEMI と併用して
;; encode/decode するためのプログラムが含まれています。これを使って
;; encode した記事を読める人は限られていますので、絶対に乱用しないで
;; 下さい。使い方は次の通りです。

;; 1. インストール
;;    このファイルを適当な load-path のディレクトリにコピーして、M-x
;;    byte-compile-file して下さい。そして .emacs ファイルのどこかに

;;	(require 'mel-zip)

;;    という一行を追加して下さい。

;; 2. エンコードの方法
;;    C-c C-c で送信する前に行ないます。
;;    まず、エンコードするテキストを text/plain なパートとして普通に
;;    作って下さい。そして、そのテキストのどこかで M-x zip-encode と
;;    タイプして、尋ねられたことに答えて下さい。

;;; Code:

(require 'mel)
(require 'mime-def)
(require 'path-util)

(defvar mel-zip-gzip-program (exec-installed-p "gzip"))
(defvar mel-zip-bzip2-program (exec-installed-p "bzip2"))

(defun bzip2-64-external-encode-region (start end)
  (interactive "*r")
  (if mel-zip-bzip2-program
      (save-restriction
	(narrow-to-region start end)
	(as-binary-process
	 (call-process-region start end mel-zip-bzip2-program t t))
	(funcall (mel-find-function 'mime-encode-region "base64")
		 (point-min) (point-max))
	(goto-char (point-min))
	(while (search-forward "\r\n" nil t)
	  (replace-match "\n")))))

(defun bzip2-64-external-decode-region (start end)
  (interactive "*r")
  (if mel-zip-bzip2-program
      (save-restriction
	(narrow-to-region start end)
	(funcall (mel-find-function 'mime-decode-region "base64")
		 start end)
	(as-binary-process
	 (call-process-region (point-min) (point-max)
			      mel-zip-bzip2-program t t nil "-d")))))

(defun bzip2-64-encode-string (string)
  (with-temp-buffer
    (insert string)
    (bzip2-64-external-encode-region (point-min) (point-max))
    (buffer-string)))

(defun bzip2-64-decode-string (string)
  (with-temp-buffer
    (insert string)
    (bzip2-64-external-decode-region (point-min) (point-max))
    (buffer-string)))

;;(mel-define-method-function (mime-encode-region start end (nil "x-bzip2-64"))
;;			    'bzip2-64-external-encode-region)
;;(mel-define-method-function (mime-decode-region start end (nil "x-bzip2-64"))
;;			    'bzip2-64-external-decode-region)
(mel-define-method-function (mime-encode-string string (nil "x-bzip2-64"))
			    'bzip2-64-encode-string)
(mel-define-method-function (mime-decode-string string (nil "x-bzip2-64"))
			    'bzip2-64-decode-string)


(eval-after-load "mime-edit"
  '(let ((text (assoc "text" mime-content-types))
;	 (application (assoc "application" mime-content-types))
;	 (image (assoc "image" mime-content-types))
	 )
     ;; x-rot13-47-48
     (or (assoc "x-rot13-47-48" text)
	 (setq text (append text '(("x-rot13-47-48")))))
;     ;; utf-8
;     (or (cdr (assoc "charset" (cdr (assoc "plain" text))))
;	 (if (find-coding-system 'utf-8)
;	     (set-alist 'text "plain"
;			'(("charset" "" "ISO-2022-JP" "US-ASCII"
;			   "ISO-8859-1" "ISO-8859-8" "UTF-8")))))
     (set-alist 'mime-content-types "text" (cdr text))
;     ;; x-patch
;     (or (assoc "x-patch" application)
;	 (setq application (append application '(("x-patch")))))
;     (set-alist 'mime-content-types "application" (cdr application))
;     (or (member "x-patch" (assoc "\\.diff$\\|\\.patch$" mime-file-types))
;	 (set-alist 'mime-file-types "\\.diff$\\|\\.patch$"
;		    '("application" "x-patch" (("type" . "patch"))
;		      nil
;		      "attachment" (("filename" . file)))))
;     ;; x-xpixmap
;     (or (assoc "x-xpixmap" image)
;	 (set-alist 'mime-content-types "image"
;		    (append (cdr image) '(("x-xpixmap")))))
     ))

;(eval-after-load "mime-view"
;  '(ctree-set-calist-strictly
;    'mime-preview-condition
;    '((type . application) (subtype . x-patch)
;      (body . visible)
;      (body-presentation-method . mime-display-text/plain))))


(defalias 'zip-encode 'mel-zip-manual-encode-at-point)

(autoload 'gzip64-external-encode-region "mel-g" nil t)

(defun mel-zip-manual-encode-at-point (subtype encoding)
  (interactive
   (list (completing-read "What content subtype: (default plain) "
			  '(("plain") ("x-rot13-47-48"))
			  nil t)
	 (completing-read "What transfer encoding: (default x-gzip64) "
			  '(("x-gzip64") ("x-bzip2-64"))
			  nil t
			  ;; "x-"
			  )))
  (if (zerop (length subtype))
      (setq subtype "plain"))
  (if (zerop (length encoding))
      (setq encoding "x-gzip64"))
  (let ((start (cond ((re-search-backward mime-edit-tag-regexp nil t)
		      (cons (match-beginning 0) (goto-char (match-end 0))))
		     ((search-backward (format "\n%s\n"
					       mail-header-separator) nil t)
		      (goto-char (match-end 0))
		      (prog1
			  (cons (point) (point))
			(insert "\n")))
		     (t (error "No tag or separator."))))
	(end (if (re-search-forward mime-edit-tag-regexp nil t)
		 (match-beginning 0)
	       (point-max)))
	charset cs)
    (save-window-excursion
      (save-restriction
	(narrow-to-region (1+ (cdr start)) end)
	(if (string-equal "x-rot13-47-48" subtype)
	    (mule-caesar-region (point-min) (point-max)))
	(setq charset (detect-mime-charset-region (point-min) (point-max)))
	(if (eq 'us-ascii charset)
	    nil
	  (if (or (not (find-coding-system 'utf-8))
		  (string-equal "x-rot13-47-48" subtype))
	      (setq cs charset)
	    (setq cs (completing-read
		      (format "What charset: (default \"%s\") " charset)
		      (list (list (symbol-name charset)) '("utf-8"))
		      nil t)
		  cs (if (zerop (length cs))
			 charset
		       (intern cs))))
	  (encode-mime-charset-region (point-min) (point-max) cs))
	(if (string-equal "x-gzip64" encoding)
	    (gzip64-external-encode-region (point-min) (point-max))
	  (bzip2-64-external-encode-region (point-min) (point-max)))
	(goto-char (point-max))
	(or (bolp) (insert "\n"))
	(if (and (not cs) (string-equal "x-rot13-47-48" subtype))
	    (mule-caesar-region (point-min) (point-max)))))
    (save-excursion
      (goto-char (car start))
      (delete-region (car start) (cdr start))
      (insert "--[[text/" subtype
	      (if cs
		  (concat "; charset=" (upcase (symbol-name cs)))
		"")
	      "][" encoding "]]"))))

(provide 'mel-zip)

;; mel-zip.el ends here