tm 7.23.

[elisp/tm.git] / tm-def.el

diff --git a/tm-def.el b/tm-def.el
index b7b7f39..297a3b3 100644 (file)
--- a/tm-def.el
+++ b/tm-def.el
@@ -6,7 +6,7 @@
 ;;;
 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;;; Version:
-;;;    $Id: tm-def.el,v 7.0 1995/10/05 13:27:34 morioka Exp $
+;;;    $Id: tm-def.el,v 7.1 1995/11/10 10:43:15 morioka Exp $
 ;;; Keywords: mail, news, MIME, multimedia, definition
 ;;;
 ;;; This file is part of tm (Tools for MIME).
@@ -149,6 +149,61 @@
   (concat "\\(Q\\)\\?" mime/Q-encoded-text-regexp))
 
 
+;;; @ rot13-47
+;;;
+;; caesar-region written by phr@prep.ai.mit.edu  Nov 86
+;; modified by tower@prep Nov 86
+;; gnus-caesar-region
+;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
+(defun tm:caesar-region (&optional n)
+  "Caesar rotation of region by N, default 13, for decrypting netnews.
+ROT47 will be performed for Japanese text in any case."
+  (interactive (if current-prefix-arg  ; Was there a prefix arg?
+                  (list (prefix-numeric-value current-prefix-arg))
+                (list nil)))
+  (cond ((not (numberp n)) (setq n 13))
+       (t (setq n (mod n 26))))        ;canonicalize N
+  (if (not (zerop n))          ; no action needed for a rot of 0
+      (progn
+       (if (or (not (boundp 'caesar-translate-table))
+               (/= (aref caesar-translate-table ?a) (+ ?a n)))
+           (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
+             (message "Building caesar-translate-table...")
+             (setq caesar-translate-table (make-vector 256 0))
+             (while (< i 256)
+               (aset caesar-translate-table i i)
+               (setq i (1+ i)))
+             (setq lower (concat lower lower) upper (upcase lower) i 0)
+             (while (< i 26)
+               (aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
+               (aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
+               (setq i (1+ i)))
+             ;; ROT47 for Japanese text.
+             ;; Thanks to ichikawa@flab.fujitsu.junet.
+             (setq i 161)
+             (let ((t1 (logior ?O 128))
+                   (t2 (logior ?! 128))
+                   (t3 (logior ?~ 128)))
+               (while (< i 256)
+                 (aset caesar-translate-table i
+                       (let ((v (aref caesar-translate-table i)))
+                         (if (<= v t1) (if (< v t2) v (+ v 47))
+                           (if (<= v t3) (- v 47) v))))
+                 (setq i (1+ i))))
+             (message "Building caesar-translate-table...done")))
+       (let ((from (region-beginning))
+             (to (region-end))
+             (i 0) str len)
+         (setq str (buffer-substring from to))
+         (setq len (length str))
+         (while (< i len)
+           (aset str i (aref caesar-translate-table (aref str i)))
+           (setq i (1+ i)))
+         (goto-char from)
+         (delete-region from to)
+         (insert str)))))
+
+
 ;;; @ end
 ;;;