Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 243 lines (223 sloc) 8.537 kb
c0f1554 @kazu-yamamoto initial import.
authored
1 ;; -*- emacs-lisp -*-
2 ;;
3 ;; mew-caesar.el --- Caesar encrypt/decrypt assistant package for Mew.
4 ;;
5 ;; Author: Hideyuki SHIRAI <shirai@mew.org>
6 ;; Created: <02/07/1998>
7 ;;
8 ;; To use mew-caesar.el, install (tm|SEMI) package or "nkf"
9 ;; , and put the following codes in your .emacs.
10 ;;
11 ;; (add-hook 'mew-init-hook
12 ;; (lambda ()
13 ;; (require 'mew-caesar)))
14 ;;
15
16 (eval-when-compile
17 (require 'mew))
18
19 (defconst mew-caesar-version "mew-caesar.el 0.21")
20
21 (defvar mew-caesar-ext-prog
22 (let (extprog)
23 (cond
24 ((or (memq system-type '(OS/2 emx))
25 (eq system-type 'windows-nt))
26 (cond
27 ((setq extprog (mew-which "nkf.exe" exec-path))
28 extprog)
29 ((setq extprog (mew-which "nkf32.exe" exec-path))
30 extprog)
31 (t nil)))
32 (t (setq extprog (mew-which "nkf" exec-path))
33 extprog)))
34 "mew-caesar external program.
35 Usually, auto searched \"nkf\", \"nkf.exe\" or \"nkf32.exe\"."
36 )
37
38 (defvar mew-caesar-ext-prog-arg '("-r"))
39
40 (defvar mew-caesar-function
41 (cond
42 ((or (featurep 'mule-caesar)
43 (locate-library "mule-caesar"))
44 (require 'mule-caesar)
45 'semi)
46 ((or (featurep 'tm-def)
47 (locate-library "tm-def"))
48 (require 'tm-def)
49 'tm)
50 (mew-caesar-ext-prog
51 'ext)
52 (t
53 (message "mew-caesar: program is not found")
54 nil))
55 "mew-caesar function select.
56 Usually auto selected, which
57 'semi(mule-caesar), 'tm(tm:caesar-region) or 'ext(mew-caesar-ext-prog)."
58 )
59
60 (defvar mew-caesar-prog-xrot '(mew-caesar-mime-text/x-rot () nil))
61 (defconst mew-caesar-ct-rot13 "Text/X-Rot13-47-48")
62 (defconst mew-caesar-rot13-suffix ".rot")
63
64 (define-key mew-summary-mode-map "\C-cr" 'mew-caesar-summary-insert-xrot)
65 (define-key mew-draft-attach-map "R" 'mew-caesar-attach-find-new-xrot)
66
67 (setq mew-mime-content-type
68 (append
69 '(("text/x-rot13-47-48" "\\.rot$" nil mew-caesar-prog-xrot mew-icon-text)
70 ("text/x-rot13.*" "\\.rot$" nil mew-caesar-prog-xrot mew-icon-text))
71 mew-mime-content-type))
72
73 (defun mew-caesar-mime-text/x-rot (cache beg end &optional params execute)
74 (if (> end beg)
75 (save-excursion
76 (set-buffer (mew-buffer-message))
77 (let ((buffer-read-only nil))
78 (insert " # # ###### ####### ####### # #####\n"
79 " # # # # # # # ## # #\n"
80 " # # # # # # # # # #\n"
81 " # ##### ###### # # # # #####\n"
82 " # # # # # # # # #\n"
83 " # # # # # # # # # #\n"
84 " # # # # ####### # ##### #####\n"
85 "\n")
86 (insert "To save this part, type "
87 (substitute-command-keys
88 "\\<mew-summary-mode-map>\\[mew-summary-save].")
89 "\nTo display this part in Message mode, type "
90 (substitute-command-keys
91 "\\<mew-summary-mode-map>\\[mew-caesar-summary-insert-xrot]."))
92 (insert "\n\n-------------------- Original \"X-ROT13\" follows --------------------\n")
93 (insert-buffer-substring cache beg end)
94 ))))
95
96 (defun mew-caesar-summary-insert-xrot ()
97 (interactive)
98 (mew-summary-part
99 (let* ((fld (mew-current-get-fld (mew-frame-id)))
100 (msg (mew-current-get-msg (mew-frame-id)))
101 (part (mew-syntax-nums))
102 (cache (mew-cache-hit fld msg 'must-hit))
103 (syntax (mew-cache-decode-syntax cache))
104 (stx (mew-syntax-get-entry syntax part))
105 (beg (mew-syntax-get-begin stx))
106 (end (mew-syntax-get-end stx))
107 (win (selected-window)))
108 (unwind-protect
109 (progn
110 (mew-summary-toggle-disp-msg 'on)
111 (mew-window-configure 'message)
112 (set-buffer (mew-buffer-message))
113 (mew-elet
114 (mew-summary-display-preamble)
115 (insert-buffer-substring cache beg end)
116 (mew-caesar-whole-buffer)
117 ;; (goto-char (point-min))
118 (mew-summary-display-postscript)))
119 (select-window win)))))
120
121 (defun mew-caesar-attach-find-new-xrot ()
122 "Open a new Caesar encrypt file into a buffer on \".\" in attachments."
123 (interactive)
124 (if (not (mew-attach-not-line012-1))
125 (message "Cannot find a new file here")
126 (let* ((nums (mew-syntax-nums))
127 (subdir (mew-attach-expand-path mew-encode-syntax nums))
128 (attachdir (mew-attachdir))
129 file filepath)
130 ;; attachdir / {subdir/} dir
131 (if (not (equal subdir ""))
132 (setq attachdir (expand-file-name subdir attachdir)))
133 ;; attachdir / file
134 (setq filepath (mew-random-filename attachdir 1 nil mew-caesar-rot13-suffix))
135 (if (null filepath)
136 (message "Could not make a text file, sorry")
137 (setq file (file-name-nondirectory filepath))
138 (setq mew-encode-syntax
139 (mew-syntax-insert-entry
140 mew-encode-syntax
141 nums
142 (mew-encode-syntax-single file (list mew-caesar-ct-rot13))))
143 (mew-encode-syntax-print mew-encode-syntax)
144 ;;
145 (find-file filepath)
146 ;; buffer switched
147 (setq mode-name "X-Rot13")
148 (setq mode-line-buffer-identification mew-mode-line-id)
149 (local-set-key "\C-c\C-q" 'mew-kill-buffer)
150 (local-set-key "\C-cr" 'mew-caesar-whole-buffer)
151 (local-set-key "\C-c\C-s" 'mew-caesar-save-exit)
152 (insert " # # ###### ####### ####### # #####\n"
153 " # # # # # # # ## # #\n"
154 " # # # # # # # # # #\n"
155 " # ##### ###### # # # # #####\n"
156 " # # # # # # # # #\n"
157 " # # # # # # # # # #\n"
158 " # # # # ####### # ##### #####\n")
159 (insert "\n define-key \"\\C-cr\" -> mew-caesar-whole-buffer.")
160 (insert "\n define-key \"\\C-c\\C-s\" -> mew-caesar-save-exit.")
161 (insert "\n\n Press any key to start editting.")
162 (read-char-exclusive)
163 (delete-region (point-min) (point-max))
164 (run-hooks 'mew-caesar-xrot-mode-hook)
165 ))))
166
167 (defun mew-caesar-save-exit ()
168 "Caesar encrypt/decrypt at whole buffer, save and exit."
169 (interactive)
170 (mew-caesar-whole-buffer)
171 (if (y-or-n-p (format "Save & Exit ?"))
172 (progn
173 (save-buffer)
174 (kill-buffer (current-buffer)))
175 (mew-caesar-whole-buffer)))
176
177 (defun mew-caesar-whole-buffer ()
178 "Caesar encrypt/decrypt at whole buffer."
179 (interactive)
180 (mew-caesar-region (point-min) (point-max)))
181
182 (defun mew-caesar-region (min max)
183 "Caesar encrypt/decrypt in region."
184 (interactive "r")
185 (save-excursion
186 (cond
187 ((eq mew-caesar-function 'semi)
188 (mule-caesar-region min max))
189 ((eq mew-caesar-function 'tm)
190 (progn
191 (goto-char min)
192 (push-mark (point) nil t)
193 (goto-char max)
194 (tm:caesar-region)))
195 ((and (eq mew-caesar-function 'ext)
196 mew-caesar-ext-prog mew-caesar-ext-prog-arg)
197 (save-excursion
198 (mew-piolet
199 mew-cs-autoconv mew-cs-m17n
200 (apply (function call-process-region)
201 min max
202 mew-caesar-ext-prog
203 t t nil
204 mew-caesar-ext-prog-arg))))
205 (t
206 (message "mew-caesar: program is not found")))
207 ))
208
209 (provide 'mew-caesar)
210
211 ;;; Copyright Notice:
212
213 ;; Copyright (C) 1998-2000 Hideyuki SHIRAI <shirai@mew.org>
214 ;; Copyright (C) 1994-2000 Mew developing team.
215 ;; All rights reserved.
216
217 ;; Redistribution and use in source and binary forms, with or without
218 ;; modification, are permitted provided that the following conditions
219 ;; are met:
220 ;;
221 ;; 1. Redistributions of source code must retain the above copyright
222 ;; notice, this list of conditions and the following disclaimer.
223 ;; 2. Redistributions in binary form must reproduce the above copyright
224 ;; notice, this list of conditions and the following disclaimer in the
225 ;; documentation and/or other materials provided with the distribution.
226 ;; 3. Neither the name of the team nor the names of its contributors
227 ;; may be used to endorse or promote products derived from this software
228 ;; without specific prior written permission.
229 ;;
230 ;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
231 ;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
232 ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
233 ;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
234 ;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
235 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
236 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
237 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
238 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
239 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
240 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
241
242 ;;; mew-caesar.el ends here
Something went wrong with that request. Please try again.