bug#4388: 23.1; rmailmm save option does not prompt for filename correctly (patch)

[David J. Biesack]

When decoding an RMAIL message with an attachement,
invoke rmail-view. rmailmm creates a button for each
attached file, such as 

  Attached application/rtf file: Ch7_2009_08_31.rtf

On the attachment button/link, press Enter to invoke rmail-mime-save
Currently, this prompts for a location to save the attachment but
does not pass the current file name and directory name correctly.
The attached patch fixes this.

In GNU Emacs 23.1.1 (i386-mingw-nt5.1.2600)
 of 2009-07-30 on SOFT-MJASON
Windowing system distributor `Microsoft Corp.', version 5.1.2600
configured using `configure --with-gcc (4.4)'

Important settings:
  value of $LC_ALL: nil
  value of $LC_COLLATE: nil
  value of $LC_CTYPE: nil
  value of $LC_MESSAGES: nil
  value of $LC_MONETARY: nil
  value of $LC_NUMERIC: nil
  value of $LC_TIME: nil
  value of $LANG: ENU
  value of $XMODIFIERS: nil
  locale-coding-system: cp1252
  default-enable-multibyte-characters: t

Major mode: Shell

Minor modes in effect:
  diff-auto-refine-mode: t
  display-time-mode: t
  shell-dirtrack-mode: t
  delete-selection-mode: t
  pc-selection-mode: t
  show-paren-mode: t
  iswitchb-mode: t
  compilation-shell-minor-mode: t
  tooltip-mode: t
  mouse-wheel-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  global-auto-composition-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  line-number-mode: t
  next-error-follow-minor-mode: t
  abbrev-mode: t

Recent input:
M-f M-f S w <return> M-p M-b M-b M-b M-f C-f C-f | 
<return> C-p C-e C-b C-b C-x <escape> F C-v C-v C-v 
C-v C-v C-v C-v C-v C-x k SPC M-p M-> M-x m a n <return> 
d i f f <return> C-x o C-s w h i C-a C-x p C-x b r 
m a i l m m . e l . o r C-g C-g C-x , C-x C-f r m a 
SPC m m . e l SPC . o SPC <return> C-x , C-x , C-x 
, M-x f i n d - f i l e - l SPC <return> r m a i l 
m m . e l <return> y M-x h s - s h o w - a l l <return> 
C-x p C-x , M-x r m a i l - C-g C-g M-x f i n d - f 
i l e - l i SPC <return> r m a i l . <backspace> m 
m . e l . o r SPC <return> y C-x p C-e C-x C-g C-g 
C-x l C-x o C-x l C-x o C-x ( C-e C-d C-n C-e C-x ) 
C-x e C-x e C-x e M-4 M-0 M-0 C-x e C-u C-x e C-u C-x 
e C-u C-x e C-u C-x e M-< C-a C-x C-s C-x * M-p <return> 
C-p C-e C-b C-b C-x <escape> F C-x 1 C-SPC C-n C-n 
C-n C-n C-n C-n C-n C-n C-n C-n C-n C-n C-n C-n C-n 
C-n C-n C-n C-n C-n C-n C-n C-n C-n C-n C-n C-n C-n 
C-n C-n C-n C-n C-n C-n C-n C-n C-n C-n C-n C-n M-w 
<down-mouse-1> <mouse-1> C-x 4 , C-n M-x r e p o r 
t - b SPC <return>

Recent messages:
History item: 1
rmailmm.patch [2 times]
Fontifying rmailmm.patch... (regexps................)
rmailmm.patch
Fontifying rmailmm.patch... (regexps................)
rmailmm.patch
Mark set
Region saved

8<------8<------8<------8<------8<------8<------8<------8<------8<------8<------8<------8<------
*** rmailmm.el.orig     Thu Aug 13 11:54:46 2009
--- rmailmm.el  Thu Sep 10 07:56:10 2009
***************
*** 81,86 ****
--- 81,89 ----
    (let* ((filename (button-get button 'filename))
         (directory (button-get button 'directory))
         (data (button-get button 'data)))
+     (setq directory (if (not (string-match "^~$\\.*/" directory))
+                         (concat directory "/")
+                       directory))
      (while (file-exists-p (expand-file-name filename directory))
        (let* ((f (file-name-sans-extension filename))
             (i 1))
***************
*** 89,98 ****
                f (substring f 0 (match-beginning 0))))
        (setq filename (concat f "-" (number-to-string i) "."
                               (file-name-extension filename)))))
      (setq filename (expand-file-name
                    (read-file-name (format "Save as (default: %s): " filename)
                                    directory
!                                   (expand-file-name filename directory))
                    directory))
      (when (file-regular-p filename)
        (error (message "File `%s' already exists" filename)))
--- 92,104 ----
                f (substring f 0 (match-beginning 0))))
        (setq filename (concat f "-" (number-to-string i) "."
                               (file-name-extension filename)))))
+ 
      (setq filename (expand-file-name
                    (read-file-name (format "Save as (default: %s): " filename)
                                    directory
!                                   (expand-file-name filename directory)
!                                     nil
!                                     filename)
                    directory))
      (when (file-regular-p filename)
        (error (message "File `%s' already exists" filename)))
***************


-- 
David J. Biesack, SAS
SAS Campus Dr. Cary, NC 27513
www.sas.com    (919) 531-7771