(Download): Renamed from "Anonymous FTP"; modify for

[elisp/apel.git] / mule-caesar.el

diff --git a/mule-caesar.el b/mule-caesar.el
index d0269c0..172b586 100644 (file)
--- a/mule-caesar.el
+++ b/mule-caesar.el
@@ -19,35 +19,15 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Code:
 
-;; avoid bug of XEmacs
-(or (integerp (cdr (split-char ?a)))
-    (defun split-char (char)
-      "Return list of charset and one or two position-codes of CHAR."
-      (let ((charset (char-charset char)))
-       (if (eq charset 'ascii)
-           (list charset (char-int char))
-         (let ((i 0)
-               (len (charset-dimension charset))
-               (code (if (integerp char)
-                         char
-                       (char-int char)))
-               dest)
-           (while (< i len)
-             (setq dest (cons (logand code 127) dest)
-                   code (lsh code -7)
-                   i (1+ i)))
-           (cons charset dest)
-           ))))
-    )
-
-(defun char-to-octet-list (character)
-  "Return list of octets in code table of graphic character set."
-  (cdr (split-char character)))
+(require 'emu)                         ; for backward compatibility.
+(require 'poe)                         ; char-after.
+(require 'poem)                                ; charset-chars, char-charset,
+                                       ; and split-char.
 
 (defun mule-caesar-region (start end &optional stride-ascii)
   "Caesar rotation of current region.
@@ -64,43 +44,43 @@ for 96 or 96x96 graphic character set)."
       (narrow-to-region start end)
       (goto-char start)
       (while (< (point)(point-max))
-       (let* ((chr (char-after (point)))
-              (charset (char-charset chr))
-              )
-         (if (eq charset 'ascii)
-             (cond ((and (<= ?A chr) (<= chr ?Z))
-                    (setq chr (+ chr stride-ascii))
-                    (if (> chr ?Z)
-                        (setq chr (- chr 26))
-                      )
-                    (delete-char 1)
-                    (insert chr)
-                    )
-                   ((and (<= ?a chr) (<= chr ?z))
-                    (setq chr (+ chr stride-ascii))
-                    (if (> chr ?z)
-                        (setq chr (- chr 26))
-                      )
-                    (delete-char 1)
-                    (insert chr)
-                    )
-                   (t
-                    (forward-char)
-                    ))
-           (let* ((stride (lsh (charset-chars charset) -1))
-                  (ret (mapcar (function
-                                (lambda (octet)
-                                  (if (< octet 80)
-                                      (+ octet stride)
-                                    (- octet stride)
-                                    )))
-                               (char-to-octet-list chr))))
-             (delete-char 1)
-             (insert (make-char (char-charset chr)
-                                (car ret)(car (cdr ret))))
-             )))))))
-  
+       (let* ((chr (char-after (point))))
+         (cond ((and (<= ?A chr) (<= chr ?Z))
+                (setq chr (+ chr stride-ascii))
+                (if (> chr ?Z)
+                    (setq chr (- chr 26))
+                  )
+                (delete-char 1)
+                (insert chr)
+                )
+               ((and (<= ?a chr) (<= chr ?z))
+                (setq chr (+ chr stride-ascii))
+                (if (> chr ?z)
+                    (setq chr (- chr 26))
+                  )
+                (delete-char 1)
+                (insert chr)
+                )
+               ((<= chr ?\x9f)
+                (forward-char)
+                )
+               (t
+                (let* ((stride (lsh (charset-chars (char-charset chr)) -1))
+                       (ret (mapcar (function
+                                     (lambda (octet)
+                                       (if (< octet 80)
+                                           (+ octet stride)
+                                         (- octet stride)
+                                         )))
+                                    (cdr (split-char chr)))))
+                  (delete-char 1)
+                  (insert (make-char (char-charset chr)
+                                     (car ret)(car (cdr ret))))
+                  )))
+         )))))
+
 
-(provide 'mule-caesar)
+(require 'product)
+(product-provide (provide 'mule-caesar) (require 'apel-ver))
 
 ;;; mule-caesar.el ends here