[Mew-Win32 00378] New mew-caesar.el Beta.2

[Hideyuki SHIRAI]

白井です。

・tm|SEMI|nkfの自動判別
・nkfの文字コード関連の設定、
・(run-hooks 'mew-caesar-xrot-mode-hook)
を入れました。

もう、ユーザさんは何も設定する必要がありません。(本当か？)

最終的には『SEMI→tm→nkf』の順番でライブラリ&ソフトを探すつもり
なんですが、このバージョンは『nkf→SEMI→tm』という順番になって
ます。

## 理由は簡単です。nkfのときの文字コードの実験をしてもらいた
## いからです。^^;;;

また、xemacsがこれで動くのか全く自信はありません。m(__)m
勇気と愛がある方は実験してみて下さい。

# 本気でxemacs立ち上げようかと思っています。

--
白井秀行＠雪で電車が止まる前に帰ります

-------------- 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: Time-stamp: <03/05/1998 19:47>
;;
;; 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)))
;;

(eval-when-compile
  (require 'mew))

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

(defvar mew-caesar-function
  (cond
   ((mew-which
     (cond
      ((or (memq system-type '(OS/2 emx))
	   (eq system-type 'windows-nt))
       "nkf.exe")
      (t "nkf"))
     exec-path)
    'ext)
   ((or (featurep 'mule-caesar)
	(locate-library "mule-caesar"))
    (require 'mule-caesar)
    'semi)
   ((or (featurep 'tm-def)
	(locate-library "tm-def"))
    (require 'tm-def)
    'tm)
   (t
    (message "mew-caesar: program is not found.")
    nil))
  )

(defvar mew-caesar-ext-prog
  (mew-which
   (cond
    ((or (memq system-type '(OS/2 emx))
	 (eq system-type 'windows-nt))
     "nkf.exe")
    (t "nkf"))
   exec-path))
(defvar mew-caesar-ext-prog-arg '("-r"))

(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-syntax-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)
	;; buffer switched
	(setq mode-name "X-Rot13")
	(setq mode-line-buffer-identification mew-mode-line-id)
	(local-set-key "\C-c\C-q" 'mew-kill-buffer)
	(local-set-key "\C-cr" 'mew-caesar-whole-buffer)
	(local-set-key "\C-c\C-s" 'mew-caesar-save-exit)
	(insert " #     #         ######  ####### #######    #     #####\n"
		"  #   #          #     # #     #    #      ##    #     #\n"
		"   # #           #     # #     #    #     # #          #\n"
		"    #     #####  ######  #     #    #       #     #####\n"
		"   # #           #   #   #     #    #       #          #\n"
		"  #   #          #    #  #     #    #       #    #     #\n"
		" #     #         #     # #######    #     #####   #####\n")
	(insert "\n define-key \"\\C-cr\"    -> mew-caesar-whole-buffer.")
	(insert "\n define-key \"\\C-c\\C-s\" -> mew-caesar-save-exit.")
	(insert "\n\n Press any key to start editting.")
	(read-char-exclusive)
	(delete-region (point-min) (point-max))
	(run-hooks 'mew-caesar-xrot-mode-hook)
	))))

(defun mew-caesar-save-exit ()
  "Caesar encrypt/decrypt at whole buffer, save and exit."
  (interactive)
  (mew-caesar-whole-buffer)
  (if (y-or-n-p (format "Save & Exit ?"))
      (progn
	(save-buffer)
	(kill-buffer (current-buffer)))
    (mew-caesar-whole-buffer)))

(defun mew-caesar-whole-buffer ()
  "Caesar encrypt/decrypt at whole buffer."
  (interactive)
  (mew-caesar-region (point-min) (point-max)))

(defun mew-caesar-region (min max)
  "Caesar encrypt/decrypt in region."
  (interactive "r")
  (let (process)
    (save-excursion
      (cond
       ((eq mew-caesar-function 'semi)
	(mule-caesar-region min max))
       ((eq mew-caesar-function 'tm)
	(progn
	  (goto-char min)
	  (push-mark (point) nil t)
	  (goto-char max)
	  (tm:caesar-region)))
       ((and (eq mew-caesar-function 'ext)
	     mew-caesar-ext-prog mew-caesar-ext-prog-arg)
	(let ((input-coding-system mew-cs-autoconv)
	      (output-coding-system mew-cs-7bit)
	      (coding-system-for-read mew-cs-autoconv)
	      (coding-system-for-write mew-cs-7bit))
	  (apply 'call-process-region min max
		 mew-caesar-ext-prog 
		 t t nil
		 mew-caesar-ext-prog-arg)))
       (t
	(message "mew-caesar: program is not found.")))
    )))

(provide 'mew-caesar)
;;
-------------- next part --------------
テキスト形式以外の添付ファイルを保管しました...
ファイル名: 無し
型:         text/x-rot13-47-48
サイズ:     232 バイト
説明:       実験用
URL:        <http://www.mew.org/pipermail/mew-win32/attachments/19980305/6fbbb254/attachment.bin>