cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/contrib/mew-caesar.el

   1 ;; -*- emacs-lisp -*-
   2 ;; mew-caesar.el --- Caesar encrypt/decrypt assistant package for Mew.
   3 ;;
   4 ;;                         "Hideyuki SHIRAI" <Shirai@rdmg.mgcs.mei.co.jp>
   5 ;;                                            Created: <02/07/1998>
   6 ;;                                Revised: Time-stamp: <04/02/1999 18:27 shirai>
   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-text-list
  68       (append
  69        '("Text/X-Rot13-47-48")
  70        mew-mime-content-type-text-list))
  71
  72 (setq mew-mime-content-type-list
  73       (append
  74        '("Text/X-Rot13-47-48")
  75        mew-mime-content-type-list))
  76
  77 (setq mew-mime-content-type
  78       (append
  79        '(("text/x-rot13-47-48" "\\.rot$" nil mew-caesar-prog-xrot mew-icon-text)
  80          ("text/x-rot13.*" "\\.rot$" nil mew-caesar-prog-xrot mew-icon-text))
  81        mew-mime-content-type))
  82
  83 (defun mew-caesar-mime-text/x-rot (begin end &optional params execute)
  84   (if (> end begin)
  85       (save-excursion
  86         (set-buffer (mew-buffer-message))
  87         (let ((buffer-read-only nil))
  88           (insert " #     #         ######  ####### #######    #     #####\n"
  89                   "  #   #          #     # #     #    #      ##    #     #\n"
  90                   "   # #           #     # #     #    #     # #          #\n"
  91                   "    #     #####  ######  #     #    #       #     #####\n"
  92                   "   # #           #   #   #     #    #       #          #\n"
  93                   "  #   #          #    #  #     #    #       #    #     #\n"
  94                   " #     #         #     # #######    #     #####   #####\n"
  95                   "\n")
  96           (insert "To save this part, type "
  97                   (substitute-command-keys
  98                    "\\<mew-summary-mode-map>\\[mew-summary-save].")
  99                   "\nTo display this part in Message mode, type "
 100                   (substitute-command-keys
 101                    "\\<mew-summary-mode-map>\\[mew-caesar-summary-insert-xrot]."))
 102           (insert "\n\n-------------------- Original \"X-ROT13\" follows --------------------\n")
 103           (insert-buffer-substring (mew-current-get 'cache) begin end)
 104           ))))
 105
 106 (defun mew-caesar-summary-insert-xrot ()
 107   (interactive)
 108   (let* ((ofld-msg (mew-current-get 'message))
 109          (msg (mew-summary-message-number))
 110          (nums (mew-syntax-nums))
 111          (buf (buffer-name)))
 112     (if (or msg (not nums))
 113         (let ((mew-analysis nil))
 114           (mew-summary-display 'force))
 115       (unwind-protect
 116           (progn
 117             (mew-summary-toggle-disp-msg 'on)
 118             (mew-window-configure buf 'message)
 119             (set-buffer (mew-buffer-message))
 120             (let* ((buffer-read-only nil)
 121                    (syntax (mew-cache-decode-syntax (mew-cache-hit ofld-msg)))
 122                    (stx (mew-syntax-get-entry syntax nums))
 123                    (begin (mew-syntax-get-begin stx))
 124                    (end (mew-syntax-get-end stx)))
 125               (erase-buffer)
 126               (insert-buffer-substring (mew-current-get 'cache) begin end)
 127               (mew-caesar-whole-buffer)
 128               (mew-message-set-end-of)
 129               (goto-char (point-min))))
 130         (mew-pop-to-buffer buf)))
 131     ))
 132
 133 (defun mew-caesar-attach-find-new-xrot ()
 134   "Open a new Caesar encrypt file into a buffer on \".\" in attachments."
 135   (interactive)
 136   (if (not (mew-attach-not-line012-1))
 137       (message "Can't find a new file here.")
 138     (let* ((nums (mew-syntax-nums))
 139            (subdir (mew-attach-expand-path mew-encode-syntax nums))
 140            (mimedir (mew-expand-folder (mew-draft-to-mime (buffer-name))))
 141            file filepath)
 142       ;; mimedir / {subdir/} dir
 143       (if (not (equal subdir ""))
 144           (setq mimedir (expand-file-name subdir mimedir)))
 145       ;; mimedir / file
 146       (setq filepath (mew-random-filename mimedir mew-caesar-rot13-suffix))
 147       (if (null filepath)
 148           (message "Could not make a text file, sorry.")
 149         (setq file (file-name-nondirectory filepath))
 150         (setq mew-encode-syntax
 151               (mew-syntax-insert-entry
 152                mew-encode-syntax
 153                nums
 154                (mew-encode-syntax-single file (list mew-caesar-ct-rot13))))
 155         (mew-encode-syntax-print mew-encode-syntax)
 156         ;;
 157         (find-file filepath)
 158         ;; buffer switched
 159         (setq mode-name "X-Rot13")
 160         (setq mode-line-buffer-identification mew-mode-line-id)
 161         (local-set-key "\C-c\C-q" 'mew-kill-buffer)
 162         (local-set-key "\C-cr" 'mew-caesar-whole-buffer)
 163         (local-set-key "\C-c\C-s" 'mew-caesar-save-exit)
 164         (insert " #     #         ######  ####### #######    #     #####\n"
 165                 "  #   #          #     # #     #    #      ##    #     #\n"
 166                 "   # #           #     # #     #    #     # #          #\n"
 167                 "    #     #####  ######  #     #    #       #     #####\n"
 168                 "   # #           #   #   #     #    #       #          #\n"
 169                 "  #   #          #    #  #     #    #       #    #     #\n"
 170                 " #     #         #     # #######    #     #####   #####\n")
 171         (insert "\n define-key \"\\C-cr\"    -> mew-caesar-whole-buffer.")
 172         (insert "\n define-key \"\\C-c\\C-s\" -> mew-caesar-save-exit.")
 173         (insert "\n\n Press any key to start editing.")
 174         (read-char-exclusive)
 175         (delete-region (point-min) (point-max))
 176         (run-hooks 'mew-caesar-xrot-mode-hook)
 177         ))))
 178
 179 (defun mew-caesar-save-exit ()
 180   "Caesar encrypt/decrypt at whole buffer, save and exit."
 181   (interactive)
 182   (mew-caesar-whole-buffer)
 183   (if (y-or-n-p (format "Save & Exit ?"))
 184       (progn
 185         (save-buffer)
 186         (kill-buffer (current-buffer)))
 187     (mew-caesar-whole-buffer)))
 188
 189 (defun mew-caesar-whole-buffer ()
 190   "Caesar encrypt/decrypt at whole buffer."
 191   (interactive)
 192   (mew-caesar-region (point-min) (point-max)))
 193
 194 (defun mew-caesar-region (min max)
 195   "Caesar encrypt/decrypt in region."
 196   (interactive "r")
 197   (save-excursion
 198     (cond
 199      ((eq mew-caesar-function 'semi)
 200       (mule-caesar-region min max))
 201      ((eq mew-caesar-function 'tm)
 202       (progn
 203         (goto-char min)
 204         (push-mark (point) nil t)
 205         (goto-char max)
 206         (tm:caesar-region)))
 207      ((and (eq mew-caesar-function 'ext)
 208            mew-caesar-ext-prog mew-caesar-ext-prog-arg)
 209       (let ((input-coding-system mew-cs-autoconv)
 210             (output-coding-system mew-cs-7bit)
 211             (coding-system-for-read mew-cs-autoconv)
 212             (coding-system-for-write mew-cs-7bit))
 213         (apply 'call-process-region min max
 214                mew-caesar-ext-prog
 215                t t nil
 216                mew-caesar-ext-prog-arg)))
 217      (t
 218       (message "mew-caesar: program is not found.")))
 219     ))
 220
 221 (provide 'mew-caesar)
 222 ;;