[Mew-dist 03692] mew-caesar

[Hideyuki SHIRAI]

白井@松下電送です。

gnus や cmail + (tm|SEMI)の人から『content-type: X-Rot13-47-48』
なメールが来ると、読むのがたいへんで涙が出て来るため、
mew-caesar.el をでっちあげました。

caesar符号化/復号化の部分は tm|SEMI に依存しているので、どちらか
のパッケージが必要です。

(add-hook 'mew-init-hook
 	  (lambda ()
 	    (require 'mew-caesar)))

(setq mew-caesar-use-tm t|nil)
;;   caesar package select   t => tm:caesar-region
;;                         nil => mule-caesar-region

のようにしてお使いください。

効能はというと、

・読むときは "\C-cr" でどうぞ。

・ドラフトモードでマルチパートを作っているときに、"c" や "l" で 
 ".rot" という拡張子を持つファイルを指定すると、
『content-type: X-Rot13-47-48』を挿入します。

- 元のファイルのcaesar符号化は事前にしておいてください。
- 拡張子は、mew-os2を参考にさせていただきました。m(__)m

・ドラフトモードでマルチパートを作っているときに、"R" で 
"foo.rot" の様なファイル名でオープンします。
セーブする前に "\C-cr"を打つと、入力したファイル(バッファ)全体を
caesar符号化します。

- "F"のインタフェースをちょっとだけ拡張したものです。

# 基本的には皆様のcodeをいただいて、ちょっと変更しただけです。
## 実験に協力してくださった、mew-win32 MLの方々ありがとうございま
## した。

-------------- next part --------------
;; -*- emacs-lisp -*-
;; mew-caesar.el --- Caesar encode/decode assistant package for Mew.
;;
;;                         "Hideyuki SHIRAI" <Shirai at example.com>
;;                                            Created: "02/07/1998"
;;                                            Revised: "02/08/1998"
;; Don't byte-compile this file.
;;
;; To use mew-caesar.el, install (tm|SEMI) package
;; , and, put the following codes in your .emacs.
;;
;; (add-hook 'mew-init-hook
;;  	  (lambda ()
;;  	    (require 'mew-caesar)))
;;
;; (setq mew-caesar-use-tm t|nil)
;; ;;   caesar package select   t => tm:caesar-region
;; ;;                         nil => mule-caesar-region
;;

(defconst mew-caesar-version "mew-caesar.el 0.11")

(defvar mew-caesar-use-tm nil
  "nil require \"SEMI\", t require \"tm\".")

(defvar mew-caesar-prog-xrot '(mew-caesar-mime-text/x-rot () nil))
(defconst mew-caesar-ct-rot13 "Text/X-Rot13-47-48")
(defconst mew-caesar-rot13-suffix ".rot")

(define-key mew-summary-mode-map "\C-cr" 'mew-caesar-summary-insert-xrot)
(define-key mew-virtual-mode-map "\C-cr" 'mew-caesar-summary-insert-xrot)
(define-key mew-draft-attach-map "R" 'mew-caesar-attach-find-new-xrot)

(setq mew-mime-content-type-text-list
      (append
       '("Text/X-Rot13-47-48")
       mew-mime-content-type-text-list))

(setq mew-mime-content-type-list
      (append
       '("Text/X-Rot13-47-48")
       mew-mime-content-type-list))

(setq mew-mime-content-type
      (append
       '(("text/x-rot13-47-48" "\\.rot$" nil mew-caesar-prog-xrot mew-icon-text)
	 ("text/x-rot13.*" "\\.rot$" nil mew-caesar-prog-xrot mew-icon-text))
       mew-mime-content-type))

(defun mew-caesar-mime-text/x-rot (begin end &optional params)
  (if (> end begin)
      (save-excursion
	(set-buffer (mew-buffer-message))
	(let ((buffer-read-only nil))
	  (insert " #     #         ######  ####### #######    #     #####\n"
		  "  #   #          #     # #     #    #      ##    #     #\n"
		  "   # #           #     # #     #    #     # #          #\n"
		  "    #     #####  ######  #     #    #       #     #####\n"
		  "   # #           #   #   #     #    #       #          #\n"
		  "  #   #          #    #  #     #    #       #    #     #\n"
		  " #     #         #     # #######    #     #####   #####\n"
		  "\n")
	  (insert "To save this part, type "
		  (substitute-command-keys
		   "\\<mew-summary-mode-map>\\[mew-summary-save].")
		  "\nTo display this part in Message mode, type "
		  (substitute-command-keys
		   "\\<mew-summary-mode-map>\\[mew-caesar-summary-insert-xrot]."))
	  (insert "\n\n-------------------- Original \"X-ROT13\" follows --------------------\n")
	  (insert-buffer-substring (mew-current-get 'cache) begin end)
	  ))))

(defun mew-caesar-summary-insert-xrot ()
  (interactive)
  (let* ((ofld-msg (mew-current-get 'message))
	 (msg (mew-summary-message-number))
	 (part (mew-summary-part-number))
	 (buf (buffer-name)))
    (if (or msg (not part))
	(let ((mew-analysis nil))
	  (mew-summary-display))
      (unwind-protect
	  (progn
	    (mew-summary-toggle-disp-msg 'on)
	    (mew-window-configure buf 'message)
	    (set-buffer (mew-buffer-message))
	    (let* ((buffer-read-only nil)
		   (syntax (mew-cache-decode-syntax (mew-cache-hit ofld-msg)))
		   (stx (mew-syntax-get-entry-strnum syntax part))
		   (begin (mew-syntax-get-begin stx))
		   (end (mew-syntax-get-end stx)))
	      (erase-buffer)
	      (insert-buffer-substring (mew-current-get 'cache) begin end)
	      (goto-char (point-min))
	      (mew-caesar-whole-buffer)))
	(pop-to-buffer buf)))
    ))

(defun mew-caesar-attach-find-new-xrot ()
  "Open a new Caesar encoding file into a buffer on \".\" in attachments."
  (interactive)
  (if (not (mew-attach-not-line012-1))
      (message "Can't find a new file here.")
    (let* ((nums (mew-attach-nums))
	   (subdir (mew-attach-expand-path mew-encode-syntax nums))
	   (mimedir (mew-expand-folder (mew-draft-to-mime (buffer-name))))
	   file filepath)
      ;; mimedir / {subdir/} dir
      (if (not (equal subdir "")) 
	  (setq mimedir (expand-file-name subdir mimedir)))
      ;; mimedir / file
      (setq filepath (mew-random-filename mimedir mew-caesar-rot13-suffix))
      (if (null filepath)
	  (message "Could not make a text file, sorry.")
	(setq file (file-name-nondirectory filepath))
	(setq mew-encode-syntax
	      (mew-syntax-insert-entry
	       mew-encode-syntax 
	       nums
	       (mew-encode-syntax-single file (list mew-caesar-ct-rot13))))
	(mew-encode-syntax-print mew-encode-syntax)
	;;
	(find-file filepath)
	(message " Don't forget \"mew-caesar-whole-buffer(\C-cr)\".")
	;; buffer switched
	(local-set-key "\C-c\C-q" 'mew-kill-buffer)
	(local-set-key "\C-cr" 'mew-caesar-whole-buffer)
	))
    ))

(defun mew-caesar-whole-buffer ()
  "Caesar encoding/decoding at whole buffer."
  (interactive)
  (let ()
      (save-excursion
	(if mew-caesar-use-tm
	    (progn
	      (require 'tm-def)
	      (mark-whole-buffer)
	      (tm:caesar-region))
	  (progn
	    (require 'mule-caesar)
	    (mule-caesar-region (point-min) (point-max)))))))
    
(provide 'mew-caesar)
;;