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

   1 ;;;
   2 ;;; mew-petname.el by Junichiro Kita (\e$B4nB?=_0lO:\e(B) <kita@sec.rd.nttdata.co.jp>
   3 ;;;
   4
   5 ;; [How to use]
   6 ;;     (add-hook 'mew-summary-mode-hook
   7 ;;               (function
   8 ;;                (lambda ()
   9 ;;                  (define-key mew-summary-mode-map "\M-p"
  10 ;;                    'mew-summary-petname-save-new-petname))))
  11 ;;     (autoload 'mew-summary-petname-save-new-petname "mew-petname" nil t)
  12
  13 (if (fboundp 'mew-toggle-kanji)
  14     nil
  15   (cond
  16    ((boundp 'WNN)
  17     (fset 'mew-toggle-kanji 'toggle-egg-mode))
  18    ((boundp 'CANNA)
  19     (fset 'mew-toggle-kanji 'canna-toggle-japanese-mode))
  20    ((eq system-type 'windows-nt)
  21     (fset 'mew-toggle-kanji 'win32-ime-toggle))
  22    (t          ; \e$BB>$N$OCN$j$^$;$s\e(B
  23     (fset 'mew-toggle-kanji '(lambda () nil)))))
  24
  25 (defun mew-summary-petname-save-new-petname ()
  26   (interactive)
  27   (cond
  28    ((eobp)
  29     (message "No message"))
  30    ((not (or (mew-summary-message-number) (mew-syntax-number)))
  31     (message "No message"))
  32    (t
  33     (let (msg from petname oldpetname replace)
  34       ;; \e$B$H$K$+$/\e(B save-excursion
  35       (save-excursion
  36         (if (mew-syntax-number)
  37             (re-search-backward mew-summary-message-regex nil t nil))
  38         ;; \e$B%a%C%;!<%8$rI=<($5$;$k\e(B
  39         (mew-summary-display t)
  40         (setq msg (mew-summary-message-number))
  41         (set-buffer (or (mew-cache-hit (cons (buffer-name) msg))
  42                         (mew-buffer-message)))
  43         ;; From:
  44         (setq from (mew-header-parse-address "From:"))
  45         ;; Petname \e$B$,EPO?$5$l$F$$$?$i\e(B
  46         (and (setq oldpetname (cdr (mew-assoc-case-equal
  47                                     from mew-petname-alist 0)))
  48              (setq replace (y-or-n-p
  49                             (format "Petname \"%s\" already exists. Replace?"
  50                                     oldpetname))))
  51         (if (and oldpetname (not replace))
  52             nil
  53           (let (minibuffer-setup-hook)
  54             ;; \e$BIaDL\e(B petname \e$B$O4A;z$G$7$g\e(B
  55             (add-hook 'minibuffer-setup-hook 'mew-toggle-kanji)
  56             (setq petname (read-from-minibuffer
  57                            (format "Petname for \"%s\": " from))))
  58           (cond
  59            ((and
  60              (y-or-n-p (format "Petname %s for \"%s\", correct and save?"
  61                                petname from))
  62              ;; mew-petname-alist \e$B$KEPO?\e(B
  63              (setq mew-petname-alist
  64                    (cons (cons from petname) mew-petname-alist))
  65              ;; mew-petname-file \e$B$K%;!<%V\e(B
  66              (let ((buffer (find-file mew-petname-file)))
  67                (set-buffer buffer)
  68                (if (not replace)
  69                    (insert (format "%s\t\"%s\"\n" from petname))
  70                  (perform-replace oldpetname petname nil nil nil))
  71                (save-buffer)
  72                (kill-buffer buffer)))))))))))