Mercurial > emacs

comparison lisp/mail/rmailmm.el @ 105019:a4b91a313ddf

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(rmail-mime-save): If file exists, don't try to be clever and add a suffix to make a unique name, just let the user decide whether or not to overwrite it. If the input is a directory, write the default filename to that directory. (Bug#4388) (rmail-mime-bulk-handler): Ensure the save button's 'directory property is a filename-as-a-directory.
author Glenn Morris <rgm@gnu.org>
date Tue, 15 Sep 2009 02:33:58 +0000
parents 6a35503cf20b
children 721db724bb12
comparison
equal deleted inserted replaced
105018:589ca5b7f8cc 105019:a4b91a313ddf
78 78
79 (defun rmail-mime-save (button) 79 (defun rmail-mime-save (button)
80 "Save the attachment using info in the BUTTON." 80 "Save the attachment using info in the BUTTON."
81 (let* ((filename (button-get button 'filename)) 81 (let* ((filename (button-get button 'filename))
82 (directory (button-get button 'directory)) 82 (directory (button-get button 'directory))
83 (data (button-get button 'data))) 83 (data (button-get button 'data))
84 (while (file-exists-p (expand-file-name filename directory)) 84 (ofilename filename))
85 (let* ((f (file-name-sans-extension filename))
86 (i 1))
87 (when (string-match "-\\([0-9]+\\)$" f)
88 (setq i (1+ (string-to-number (match-string 1 f)))
89 f (substring f 0 (match-beginning 0))))
90 (setq filename (concat f "-" (number-to-string i) "."
91 (file-name-extension filename)))))
92 (setq filename (expand-file-name 85 (setq filename (expand-file-name
93 (read-file-name (format "Save as (default: %s): " filename) 86 (read-file-name (format "Save as (default: %s): " filename)
94 directory 87 directory
95 (expand-file-name filename directory)) 88 (expand-file-name filename directory))
96 directory)) 89 directory))
97 (when (file-regular-p filename) 90 ;; If arg is just a directory, use the default file name, but in
98 (error (message "File `%s' already exists" filename))) 91 ;; that directory (copied from write-file).
99 (with-temp-file filename 92 (if (file-directory-p filename)
93 (setq filename (expand-file-name
94 (file-name-nondirectory ofilename)
95 (file-name-as-directory filename))))
96 (with-temp-buffer
100 (set-buffer-file-coding-system 'no-conversion) 97 (set-buffer-file-coding-system 'no-conversion)
101 (insert data)))) 98 (insert data)
102 99 (write-region nil nil filename nil nil nil t))))
103 (define-button-type 'rmail-mime-save 100
104 'action 'rmail-mime-save) 101 (define-button-type 'rmail-mime-save 'action 'rmail-mime-save)
105 102
106 ;;; Handlers 103 ;;; Handlers
107 104
108 (defun rmail-mime-text-handler (content-type 105 (defun rmail-mime-text-handler (content-type
109 content-disposition 106 content-disposition
152 (delete-region (point-min) (point-max)) 149 (delete-region (point-min) (point-max))
153 (insert label) 150 (insert label)
154 (insert-button filename 151 (insert-button filename
155 :type 'rmail-mime-save 152 :type 'rmail-mime-save
156 'filename filename 153 'filename filename
157 'directory directory 154 'directory (file-name-as-directory directory)
158 'data data))) 155 'data data)))
159 156
160 (defun test-rmail-mime-bulk-handler () 157 (defun test-rmail-mime-bulk-handler ()
161 "Test of a mail used as an example in RFC 2183." 158 "Test of a mail used as an example in RFC 2183."
162 (let ((mail "Content-Type: image/jpeg 159 (let ((mail "Content-Type: image/jpeg