Mercurial > hg > xemacs-beta
comparison lisp/apel/mule-caesar.el @ 155:43dd3413c7c7 r20-3b4
Import from CVS: tag r20-3b4
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 09:39:39 +0200 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| 154:94141801dd7e | 155:43dd3413c7c7 |
|---|---|
| 1 ;;; mule-caesar.el --- ROT 13-47 Caesar rotation utility | |
| 2 | |
| 3 ;; Copyright (C) 1997 Free Software Foundation, Inc. | |
| 4 | |
| 5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> | |
| 6 ;; Version: $Id: mule-caesar.el,v 1.1 1997/06/03 04:18:36 steve Exp $ | |
| 7 ;; Keywords: ROT 13-47, caesar, mail, news, text/x-rot13-47 | |
| 8 | |
| 9 ;; This file is part of APEL (A Portable Emacs Library). | |
| 10 | |
| 11 ;; This program is free software; you can redistribute it and/or | |
| 12 ;; modify it under the terms of the GNU General Public License as | |
| 13 ;; published by the Free Software Foundation; either version 2, or (at | |
| 14 ;; your option) any later version. | |
| 15 | |
| 16 ;; This program is distributed in the hope that it will be useful, but | |
| 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 19 ;; General Public License for more details. | |
| 20 | |
| 21 ;; You should have received a copy of the GNU General Public License | |
| 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
| 23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 24 ;; Boston, MA 02111-1307, USA. | |
| 25 | |
| 26 ;;; Code: | |
| 27 | |
| 28 (defun char-to-octet-list (character) | |
| 29 "Return list of octets in code table of graphic character set." | |
| 30 (let* ((code (char-int character)) | |
| 31 (dim (charset-dimension (char-charset code))) | |
| 32 dest) | |
| 33 (while (> dim 0) | |
| 34 (setq dest (cons (logand code 127) dest) | |
| 35 dim (1- dim) | |
| 36 code (lsh code -7)) | |
| 37 ) | |
| 38 dest)) | |
| 39 | |
| 40 (defun mule-caesar-region (start end &optional stride-ascii) | |
| 41 "Caesar rotation of current region. | |
| 42 Optional argument STRIDE-ASCII is rotation-size for Latin alphabet | |
| 43 \(A-Z and a-z). For non-ASCII text, ROT-N/2 will be performed in any | |
| 44 case (N=charset-chars; 94 for 94 or 94x94 graphic character set; 96 | |
| 45 for 96 or 96x96 graphic character set)." | |
| 46 (interactive "r\nP") | |
| 47 (setq stride-ascii (if stride-ascii | |
| 48 (mod stride-ascii 26) | |
| 49 13)) | |
| 50 (save-excursion | |
| 51 (save-restriction | |
| 52 (narrow-to-region start end) | |
| 53 (goto-char start) | |
| 54 (while (< (point)(point-max)) | |
| 55 (let* ((chr (char-after (point))) | |
| 56 (charset (char-charset chr)) | |
| 57 ) | |
| 58 (if (eq charset 'ascii) | |
| 59 (cond ((and (<= ?A chr) (<= chr ?Z)) | |
| 60 (setq chr (+ chr stride-ascii)) | |
| 61 (if (> chr ?Z) | |
| 62 (setq chr (- chr 26)) | |
| 63 ) | |
| 64 (delete-char 1) | |
| 65 (insert chr) | |
| 66 ) | |
| 67 ((and (<= ?a chr) (<= chr ?z)) | |
| 68 (setq chr (+ chr stride-ascii)) | |
| 69 (if (> chr ?z) | |
| 70 (setq chr (- chr 26)) | |
| 71 ) | |
| 72 (delete-char 1) | |
| 73 (insert chr) | |
| 74 ) | |
| 75 (t | |
| 76 (forward-char) | |
| 77 )) | |
| 78 (let* ((stride (lsh (charset-chars charset) -1)) | |
| 79 (ret (mapcar (function | |
| 80 (lambda (octet) | |
| 81 (if (< octet 80) | |
| 82 (+ octet stride) | |
| 83 (- octet stride) | |
| 84 ))) | |
| 85 (char-to-octet-list chr)))) | |
| 86 (delete-char 1) | |
| 87 (insert (make-char (char-charset chr) | |
| 88 (car ret)(car (cdr ret)))) | |
| 89 ))))))) | |
| 90 | |
| 91 | |
| 92 (provide 'mule-caesar) | |
| 93 | |
| 94 ;;; mule-caesar.el ends here |