[mew-dist 21107] Re: dired-do-mew-attach-copy

[Hideyuki SHIRAI ( 白井秀行 )]

From:  MURAOKA Koji <mura050418 at example.com> さん曰く
Subject: [mew-dist 21105] dired-do-mew-attach-copy
Message-ID: <20020704.114404.85417988.mura050418 at example.com>
Date: Thu, 04 Jul 2002 11:44:04 +0900 (JST)

> [mew-dist 19329]で白井さんが投稿された一括添付用コードをとても
> 重宝して使っていました．

# 作った本人がすっかり忘れていました ^^;

> ところが 3.0.55 になってからこの一括添付機能を使うとエラーが出
> てしまいます．

(mew-match 1) のところを 
(match-string 1) または (mew-match-string 1) にすれば大丈夫です。

-- 
白井秀行 (mailto:shirai at example.com)

ちなみにその後、鯉江さんとやり取りをしてこんな風になっています。
(日頃使っていませんが)大体動いているみたいです。
しかし、XEmacs では動かないと思うし、その Frame 内で複数の
dired 画面があってもダメだと思います。


(add-hook 'dired-mode-hook
	  (lambda ()
	    (define-key dired-mode-map "\C-c\C-m" 'dired-do-mew-attach-copy)))

(add-hook 'mew-draft-mode-hook
	  (lambda ()
	    (define-key mew-draft-attach-map "M" 'mew-attach-from-dired)))

(defvar dired-mew-attach-copy-files nil)
(defvar mew-attach-from-dired-mark nil)

(defun dired-do-mew-attach-copy (&optional arg)
  (interactive "P")
  (when (featurep 'mew)
    (or (featurep 'dired) (load "dired" 'no-err))
    (or (featurep 'dired-aux) (load "dired-aux" 'no-err))
    (setq dired-mew-attach-copy-files nil)
    (dired-map-over-marks-check
     (function dired-mew-attach-copy) arg 'mew-attach-copy t)
    (if (null dired-mew-attach-copy-files)
	(message "No selected files!")
      (let ((draft (mew-max-draft-buffer)) buf)
	(if (null draft)
	    (message "No draft buffer exists!")
	  (if mew-attach-from-dired-mark
	      (progn
		(select-window
		 (get-buffer-window (car mew-attach-from-dired-mark)))
		(goto-char (cdr mew-attach-from-dired-mark))
		(mew-attach-from-dired-1))
	    (if (and (get-buffer draft) (get-buffer-window draft)
		     (string-match "[0-9]$" draft))
		(setq buf draft)
	      (setq buf (mew-input-buffer draft)))
	    (if (null (get-buffer buf))
		(message "No such draft buffer!")
	      (if (get-buffer-window buf)
		  (select-window (get-buffer-window buf))
		(switch-to-buffer buf))
	      (if (null (mew-draft-p))
		  (message "draft folder!")
		(unless (mew-attach-p) (mew-draft-prepare-attachments))
		(goto-char (mew-attach-begin))
		(if (not (re-search-forward " +\\([1-9][.0-9]*\\) +\\(\\.\\)" nil t)) ;; FIXME
		    (message "Error attach area!")
		  (goto-char (match-beginning 2))
		  (sit-for 0)
		  (if (y-or-n-p (format "Attach %s at \"%s\" now (or later) ? "
					(if (= (length dired-mew-attach-copy-files) 1)
					    "file" "files")
					(match-string 1)))
		      (let (mew-attach-move-next-after-copy)
			(mew-attach-from-dired-1))
		    (message
		     (substitute-command-keys
		      "Move cursor and press '\\<mew-draft-attach-map>\\[mew-attach-from-dired]'"))))))))))))

(defun dired-mew-attach-copy ()
  (let ((file (mew-file-chase-links (dired-get-filename))))
    (if (and (file-readable-p file)
	     (not (file-directory-p file)))
	(progn
	  (setq dired-mew-attach-copy-files (cons file dired-mew-attach-copy-files))
	  nil)
      ;; FIXME
      t)))

(defun mew-attach-from-dired (&optional args)
  (interactive "P")
  (let (buf)
    (if (and (interactive-p)
	     (mew-attach-not-line012-1)
	     (null dired-mew-attach-copy-files)
	     (save-excursion
	       (other-window -1)
	       (setq buf (current-buffer))
	       (eq major-mode 'dired-mode)))
	;; attach から dired に移動する
	(let ((mew-attach-from-dired-mark (cons (current-buffer) (point))))
	  (set-buffer buf)
	  (dired-do-mew-attach-copy args))
      (mew-attach-from-dired-1))))

(defun mew-attach-from-dired-1 ()
  (if (mew-attach-not-line012-1)
      (if dired-mew-attach-copy-files
	  (let (file)
	    (while (setq file (car dired-mew-attach-copy-files))
	      (mew-attach-copy file (file-name-nondirectory file))
	      (setq dired-mew-attach-copy-files (cdr dired-mew-attach-copy-files))))
	(message "Nothing to do!"))
    (message "Can not attach from dired here!")))