[Mew-dist 14551] Re: 拙作の関数 for mew-1.95b70〜

[NARA Susumu]

Tatsuya Kinoshita <tatsuyak at example.com>wrote in message
mail:<20001015.035132.21934104.tatsuyak at example.com>...

tatsuyak> > ;; $Id: my-mew.el,v 1.1 2000/10/14 12:16:49 nara Exp $
tatsuyak> > ;; 
tatsuyak> > ;; Copyright (C) 2000 by NARA Susumu.
tatsuyak> > ;; 
tatsuyak> > ;; All rights reserved.
tatsuyak> 
tatsuyak> 改変、配布等についての許諾無しで、著作権が主張されています。
tatsuyak> 
tatsuyak> 上記のファイルがMewに取り込まれると、先日の「アイコンのCopyright」
tatsuyak> と同種の問題がまた起こってしまいます。
tatsuyak> 
tatsuyak> なるべく、無制限の改変、配布等を認めて、Mew developing teamへ提供
tatsuyak> するかたちになってほしい。

申し訳ありませんでした、修正した物をアップします。これで、良いのでしょ
うか。無制限の改変、配布等を認める記載は必要ですか？

--nara
-------------- next part --------------
;;; my-mew.el             -*-Emacs-Lisp-*-
;;; 
;;; $Id: my-mew.el,v 1.2 2000/10/15 01:51:52 nara Exp $

;;; Author: NARA Susumu <nara at example.com>
;;; Created: Oct 14, 2000
;;; Revised:

;;; Report bugs to <support at example.com>

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; １. 送信前に文字数を表示します。
;;     (add-hook 'mew-send-hook 'my-mew-send) 
;; 
;; ２. 複数のコンフィグを使用していて、どの自分宛てのアドレスかによっ
;;     て、コンフィグを切替ます。
;;
;;     (setq my-mew-config-reply-from-list 
;;         '(("address1" . "config-name1")
;;           ("address2" . "config-name2"))) と設定した場合に
;;
;;     address1 ならば config-name1 に
;;     address2 ならば config-name2 に設定します。
;;
;;    また、キーマップを以下の様に置き換えて下さい。
;;    
;;    (add-hook 'mew-summary-mode-hook
;;              (function 
;;               (lambda ()
;;                 (define-key mew-summary-mode-map "a" 'my-mew-summary-reply)
;;                 (define-key mew-summary-mode-map "A" 
;;                                     'my-mew-summary-reply-with-citation))))
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Code:

(defvar my-mew-config-reply-from-list nil)

(defun my-mew-summary-reply (&optional onlytofrom)
  "自分専用リプライ関数（引用なし）"
  (interactive)
  (mew-summary-analyze-again t)
  (mew-summary-reply onlytofrom)
  (my-mew-draft-set-auto-config))

(defun my-mew-summary-reply-with-citation (&optional onlytofrom)
  "自分専用リプライ関数（引用あり）"
  (interactive)
  (mew-summary-analyze-again t)
  (mew-summary-reply-with-citation onlytofrom)
  (my-mew-set-draft-position)
  (if (eq (char-after) 10)
      (delete-char 1))
  (my-mew-draft-set-auto-config))

(defun my-mew-send ()
  "送信する前に文字数を表示します。i-mode, c-mail等に便利
usage: (add-hook 'mew-send-hook 'my-mew-send)"
  (interactive)
  (save-excursion
    (let (start end mes)
      (run-hooks 'my-mew-send-hook)
      (my-mew-set-draft-position)
      (setq start (point))
      (goto-char (point-max))
      (setq end (point))
      (setq mes (count-lines-region start end))
      (if (y-or-n-p (format "%s" (concat mes " / Really send this message? ")))
          (setq mew-ask-send nil)
        (setq mew-ask-send t)))))
                    
(defun my-mew-set-draft-position ()
  "リプライ時にドラフト位置を先頭に移動します"
  (interactive)
  (goto-char (point-min))
  (if (re-search-forward "\\(^----$\\)" nil t)
      (if (match-beginning 1)
          (progn
            (goto-char (match-end 1))
            ;;(next-line 1)
            (forward-char 1)))))

(defun my-member-compare (lsta lstb)
  "ex: (my-member-compre list-a list-b)"
  (catch 'found
    (while
        (if (member (car lsta) lstb)
            (throw 'found (car (member (car lsta) lstb)))
          (setq lsta (cdr lsta))))))

(defun my-mew-draft-set-auto-config ()
  "リプライ時に自分の送信アドレスによってコンフィグを設定します。To: 
をチェックし、次に Cc: をチェックします。複数あった場合には先頭のみで
す。

  (setq my-mew-config-reply-from-list 
      '((\"address1\" . \"config-name1\")
        (\"address2\" . \"config-name2\")))"
  (interactive)
  (let (lst from to cc)
    (save-excursion
      (if (get-buffer "*Mew message*")
          (set-buffer "*Mew message*")
        (if (get-buffer "*Mew message*0")
            (set-buffer "*Mew message*0")))
      ;;(setq to (mew-header-parse-address mew-to:))
      ;;(setq cc (mew-header-parse-address mew-cc:))
      (setq lst (mapcar (function car) my-mew-config-reply-from-list))
      (setq to (my-member-compare
                (mew-header-parse-address-list2 mew-fromme-to-list) lst))
      (setq cc (my-member-compare
                (mew-header-parse-address-list2 mew-fromme-cc-list) lst)))
    (if to
        (setq from to)
      (if cc
          (setq from cc)))
    (if from
        (mew-draft-set-config-with-arg 
         (cdr (assoc from my-mew-config-reply-from-list)))
      ;;(mew-draft-set-config-with-arg "default")
      (mew-draft-set-config))))

(defun mew-draft-set-config-with-arg (config)
  "mew-draft-set-config のパラメータ版"
  (interactive)
  (let ((old-config mew-draft-buffer-config))
    (setq mew-draft-buffer-config config)
;;	  (mew-input-config mew-config-output "This draft"))
    (mew-draft-mode-name mew-header-message)
    (save-excursion
      (goto-char (point-min))
      (let ((new-config mew-draft-buffer-config) ;; save length
	    from cc dcc)
	(cond
	 ((re-search-forward "^Resent" (mew-header-end) t)
	  (setq from mew-resent-from:)
	  (setq cc   mew-resent-cc:)
	  (setq dcc  mew-resent-dcc:))
	 (t
	  (setq from mew-from:)
	  (setq cc   mew-cc:)
	  (setq dcc  mew-dcc:)))
	(mew-header-replace-value from (mew-from new-config))
;;	(mew-header-replace-value cc   (mew-cc   new-config))
	(mew-header-replace-value dcc  (mew-dcc  new-config))
	(mew-header-replace-value mew-fcc:      (mew-fcc new-config))
	(mew-header-replace-value mew-reply-to: (mew-reply-to new-config))
	(mew-header-delete-lines
	 (mapcar (function car) (mew-header-alist old-config)))
	(mew-header-goto-end)
	(mew-draft-header-insert-alist
	 (mew-header-alist mew-draft-buffer-config))
	(mew-highlight-header)
	(if (null mew-header-message) (mew-draft-header-keymap)))
      (save-buffer))))

;;; ends here