Mercurial > emacs
comparison lisp/mail/sendmail.el @ 101840:0d6b005df475
(mail-bury-selects-summary, mail-yank-original): Doc fix.
(rmail-output-to-rmail-buffer): Autoload it.
(mail-do-fcc): Give it a doc string. Update for mbox Rmail, simplify.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Sat, 07 Feb 2009 03:02:39 +0000 |
parents | d2c49097995e |
children | ac468e2eb03e |
comparison
equal
deleted
inserted
replaced
101839:1eedc742bd61 | 101840:0d6b005df475 |
---|---|
427 :type '(choice (const nil) string) | 427 :type '(choice (const nil) string) |
428 :group 'sendmail) | 428 :group 'sendmail) |
429 | 429 |
430 ;;;###autoload | 430 ;;;###autoload |
431 (defcustom mail-bury-selects-summary t | 431 (defcustom mail-bury-selects-summary t |
432 "If non-nil, try to show RMAIL summary buffer after returning from mail. | 432 "If non-nil, try to show Rmail summary buffer after returning from mail. |
433 The functions \\[mail-send-on-exit] or \\[mail-dont-send] select | 433 The functions \\[mail-send-on-exit] or \\[mail-dont-send] select |
434 the RMAIL summary buffer before returning, if it exists and this variable | 434 the Rmail summary buffer before returning, if it exists and this variable |
435 is non-nil." | 435 is non-nil." |
436 :type 'boolean | 436 :type 'boolean |
437 :group 'sendmail) | 437 :group 'sendmail) |
438 | 438 |
439 ;;;###autoload | 439 ;;;###autoload |
782 (not (null (delq (selected-frame) (visible-frame-list))))) | 782 (not (null (delq (selected-frame) (visible-frame-list))))) |
783 (progn | 783 (progn |
784 (if (display-multi-frame-p) | 784 (if (display-multi-frame-p) |
785 (delete-frame (selected-frame)) | 785 (delete-frame (selected-frame)) |
786 ;; The previous frame is where normally they have the | 786 ;; The previous frame is where normally they have the |
787 ;; RMAIL buffer displayed. | 787 ;; Rmail buffer displayed. |
788 (other-frame -1))) | 788 (other-frame -1))) |
789 (let (rmail-flag summary-buffer) | 789 (let (rmail-flag summary-buffer) |
790 (and (not arg) | 790 (and (not arg) |
791 (not (one-window-p)) | 791 (not (one-window-p)) |
792 (with-current-buffer | 792 (with-current-buffer |
1182 (buffer-substring (point-min) (point-max))))))) | 1182 (buffer-substring (point-min) (point-max))))))) |
1183 (kill-buffer tembuf) | 1183 (kill-buffer tembuf) |
1184 (if (bufferp errbuf) | 1184 (if (bufferp errbuf) |
1185 (kill-buffer errbuf))))) | 1185 (kill-buffer errbuf))))) |
1186 | 1186 |
1187 (autoload 'rmail-output-to-rmail-buffer "rmailout") | |
1188 | |
1187 (defun mail-do-fcc (header-end) | 1189 (defun mail-do-fcc (header-end) |
1190 "Find and act on any FCC: headers in the current message before HEADER-END. | |
1191 If a buffer is visiting the FCC file, append to it before | |
1192 offering to save it, if it was modified initially. If this is an | |
1193 Rmail buffer, update Rmail as needed. If there is no buffer, | |
1194 just append to the file, in Babyl format if necessary." | |
1188 (unless (markerp header-end) | 1195 (unless (markerp header-end) |
1189 (error "Value of `header-end' must be a marker")) | 1196 (error "Value of `header-end' must be a marker")) |
1190 (let (fcc-list | 1197 (let (fcc-list |
1191 (rmailbuf (current-buffer)) | 1198 (mailbuf (current-buffer)) |
1192 (time (current-time)) | 1199 (time (current-time))) |
1193 (tembuf (generate-new-buffer " rmail output")) | |
1194 (case-fold-search t)) | |
1195 (save-excursion | 1200 (save-excursion |
1196 (goto-char (point-min)) | 1201 (goto-char (point-min)) |
1197 (while (re-search-forward "^FCC:[ \t]*" header-end t) | 1202 (let ((case-fold-search t)) |
1198 (push (buffer-substring (point) | 1203 (while (re-search-forward "^FCC:[ \t]*" header-end t) |
1199 (progn | 1204 (push (buffer-substring (point) |
1200 (end-of-line) | 1205 (progn |
1201 (skip-chars-backward " \t") | 1206 (end-of-line) |
1202 (point))) | 1207 (skip-chars-backward " \t") |
1203 fcc-list) | 1208 (point))) |
1204 (delete-region (match-beginning 0) | 1209 fcc-list) |
1205 (progn (forward-line 1) (point)))) | 1210 (delete-region (match-beginning 0) |
1206 (set-buffer tembuf) | 1211 (progn (forward-line 1) (point))))) |
1207 (erase-buffer) | 1212 (with-temp-buffer |
1208 ;; This initial newline is written out if the fcc file already exists. | 1213 ;; This initial newline is not written out if we create a new |
1209 (insert "\nFrom " (user-login-name) " " | 1214 ;; file (see below). |
1210 (current-time-string time) "\n") | 1215 (insert "\nFrom " (user-login-name) " " (current-time-string time) "\n") |
1211 ;; Insert the time zone before the year. | 1216 ;; Insert the time zone before the year. |
1212 (forward-char -1) | 1217 (forward-char -1) |
1213 (forward-word -1) | 1218 (forward-word -1) |
1214 (require 'mail-utils) | 1219 (require 'mail-utils) |
1215 (insert (mail-rfc822-time-zone time) " ") | 1220 (insert (mail-rfc822-time-zone time) " ") |
1216 (goto-char (point-max)) | 1221 (goto-char (point-max)) |
1217 (insert-buffer-substring rmailbuf) | 1222 (insert-buffer-substring mailbuf) |
1218 ;; Make sure messages are separated. | 1223 ;; Make sure messages are separated. |
1219 (goto-char (point-max)) | 1224 (goto-char (point-max)) |
1220 (insert ?\n) | 1225 (insert ?\n) |
1221 (goto-char 2) | 1226 (goto-char 2) |
1222 ;; ``Quote'' "^From " as ">From " | 1227 ;; ``Quote'' "^From " as ">From " |
1223 ;; (note that this isn't really quoting, as there is no requirement | 1228 ;; (note that this isn't really quoting, as there is no requirement |
1224 ;; that "^[>]+From " be quoted in the same transparent way.) | 1229 ;; that "^[>]+From " be quoted in the same transparent way.) |
1225 (let ((case-fold-search nil)) | 1230 (let ((case-fold-search nil)) |
1226 (while (search-forward "\nFrom " nil t) | 1231 (while (search-forward "\nFrom " nil t) |
1227 (forward-char -5) | 1232 (forward-char -5) |
1228 (insert ?>))) | 1233 (insert ?>))) |
1229 (dolist (fcc fcc-list) | 1234 (dolist (fcc fcc-list) |
1230 (let* ((buffer (find-buffer-visiting fcc)) | 1235 (let* ((buffer (find-buffer-visiting fcc)) |
1231 (curbuf (current-buffer)) | 1236 (curbuf (current-buffer)) |
1232 dont-write-the-file | 1237 dont-write-the-file |
1233 buffer-matches-file | 1238 buffer-matches-file |
1234 (beg (point-min)) (end (point-max)) | 1239 (beg (point-min)) ; the initial blank line |
1235 (beg2 (save-excursion (goto-char (point-min)) | 1240 (end (point-max)) |
1236 (forward-line 2) (point)))) | 1241 ;; After the ^From line. |
1237 (if buffer | 1242 (beg2 (save-excursion (goto-char (point-min)) |
1238 ;; File is present in a buffer => append to that buffer. | 1243 (forward-line 2) (point)))) |
1239 (with-current-buffer buffer | 1244 (if buffer |
1240 (setq buffer-matches-file | 1245 ;; File is present in a buffer => append to that buffer. |
1241 (and (not (buffer-modified-p)) | 1246 (with-current-buffer buffer |
1242 (verify-visited-file-modtime buffer))) | 1247 (setq buffer-matches-file |
1243 ;; Keep the end of the accessible portion at the same place | 1248 (and (not (buffer-modified-p)) |
1244 ;; unless it is the end of the buffer. | 1249 (verify-visited-file-modtime buffer))) |
1245 (let ((max (if (/= (1+ (buffer-size)) (point-max)) | 1250 (let ((msg (bound-and-true-p rmail-current-message)) |
1246 (point-max)))) | 1251 (buffer-read-only nil)) |
1247 (unwind-protect | 1252 ;; If MSG is non-nil, buffer is in Rmail mode. |
1248 ;; Code below lifted from rmailout.el | 1253 (if msg |
1249 ;; function rmail-output-to-rmail-file: | 1254 (let ((buff (generate-new-buffer " *mail-do-fcc"))) |
1250 (let ((buffer-read-only nil) | 1255 (unwind-protect |
1251 (msg (and (boundp 'rmail-current-message) | 1256 (progn |
1252 rmail-current-message))) | 1257 (with-current-buffer buff |
1253 ;; If MSG is non-nil, buffer is in RMAIL mode. | 1258 (insert-buffer-substring curbuf (1+ beg) end)) |
1254 (if msg | 1259 (rmail-output-to-rmail-buffer buff msg)) |
1255 (progn | 1260 (kill-buffer buff))) |
1256 ;; Append to an ordinary buffer as a | 1261 ;; Output file not in Rmail mode => just insert |
1257 ;; Unix mail message. | 1262 ;; at the end. |
1258 (rmail-maybe-set-message-counters) | 1263 (save-restriction |
1259 (widen) | 1264 (widen) |
1260 (narrow-to-region (point-max) (point-max)) | 1265 (goto-char (point-max)) |
1261 (insert "\C-l\n0, unseen,,\n*** EOOH ***\n" | 1266 (insert-buffer-substring curbuf beg end))) |
1262 "Date: " (mail-rfc822-date) "\n") | 1267 ;; Offer to save the buffer if it was modified |
1263 (insert-buffer-substring curbuf beg2 end) | 1268 ;; before we started. |
1264 (insert "\n\C-_") | 1269 (unless buffer-matches-file |
1265 (goto-char (point-min)) | 1270 (if (y-or-n-p (format "Save file %s? " fcc)) |
1266 (widen) | 1271 (save-buffer)) |
1267 (search-backward "\n\^_") | 1272 (setq dont-write-the-file t))))) |
1268 (narrow-to-region (point) (point-max)) | 1273 ;; Append to the file directly, unless we've already taken |
1269 (rmail-count-new-messages t) | 1274 ;; care of it. |
1270 (rmail-show-message msg) | 1275 (unless dont-write-the-file |
1271 (setq max nil)) | 1276 (if (and (file-exists-p fcc) |
1272 ;; Output file not in rmail mode | 1277 (mail-file-babyl-p fcc)) |
1273 ;; => just insert at the end. | 1278 ;; If the file is a Babyl file, convert the message to |
1274 (narrow-to-region (point-min) (1+ (buffer-size))) | 1279 ;; Babyl format. Even though Rmail no longer uses |
1275 (goto-char (point-max)) | 1280 ;; Babyl, this code can remain for the time being, on |
1276 (insert-buffer-substring curbuf beg end)) | 1281 ;; the off-chance one FCCs to a Babyl file that has |
1277 (or buffer-matches-file | 1282 ;; not yet been converted to mbox. |
1278 (progn | 1283 (let ((coding-system-for-write |
1279 (if (y-or-n-p (format "Save file %s? " | 1284 (or rmail-file-coding-system 'emacs-mule))) |
1280 fcc)) | 1285 (with-temp-buffer |
1281 (save-buffer)) | 1286 (insert "\C-l\n0, unseen,,\n*** EOOH ***\nDate: " |
1282 (setq dont-write-the-file t)))) | 1287 (mail-rfc822-date) "\n") |
1283 (if max (narrow-to-region (point-min) max)))))) | 1288 (insert-buffer-substring curbuf beg2 end) |
1284 ;; Append to the file directly, | 1289 (insert "\n\C-_") |
1285 ;; unless we've already taken care of it. | 1290 (write-region (point-min) (point-max) fcc t))) |
1286 (unless dont-write-the-file | 1291 ;; Ensure there is a blank line between messages, but |
1287 (if (and (file-exists-p fcc) | 1292 ;; not at the very start of the file. |
1288 ;; Check that the file isn't empty. We don't | 1293 (write-region (if (file-exists-p fcc) |
1289 ;; want to insert a newline at the start of an | 1294 (point-min) |
1290 ;; empty file. | 1295 (1+ (point-min))) |
1291 (not (zerop (nth 7 (file-attributes fcc)))) | 1296 (point-max) fcc t))) |
1292 (mail-file-babyl-p fcc)) | 1297 (and buffer (not dont-write-the-file) |
1293 ;; If the file is a Babyl file, | 1298 (with-current-buffer buffer |
1294 ;; convert the message to Babyl format. | 1299 (set-visited-file-modtime))))))))) |
1295 (let ((coding-system-for-write | |
1296 (or rmail-file-coding-system | |
1297 'emacs-mule))) | |
1298 (with-current-buffer (get-buffer-create " mail-temp") | |
1299 (setq buffer-read-only nil) | |
1300 (erase-buffer) | |
1301 (insert "\C-l\n0, unseen,,\n*** EOOH ***\nDate: " | |
1302 (mail-rfc822-date) "\n") | |
1303 (insert-buffer-substring curbuf beg2 end) | |
1304 (insert "\n\C-_") | |
1305 (write-region (point-min) (point-max) fcc t) | |
1306 (erase-buffer))) | |
1307 (write-region | |
1308 (1+ (point-min)) (point-max) fcc t))) | |
1309 (and buffer (not dont-write-the-file) | |
1310 (with-current-buffer buffer | |
1311 (set-visited-file-modtime)))))) | |
1312 (kill-buffer tembuf))) | |
1313 | 1300 |
1314 (defun mail-sent-via () | 1301 (defun mail-sent-via () |
1315 "Make a Sent-via header line from each To or CC header line." | 1302 "Make a Sent-via header line from each To or CC header line." |
1316 (interactive) | 1303 (interactive) |
1317 (save-excursion | 1304 (save-excursion |
1460 (while (< (point) end) | 1447 (while (< (point) end) |
1461 (insert mail-yank-prefix) | 1448 (insert mail-yank-prefix) |
1462 (forward-line 1)))))) | 1449 (forward-line 1)))))) |
1463 | 1450 |
1464 (defun mail-yank-original (arg) | 1451 (defun mail-yank-original (arg) |
1465 "Insert the message being replied to, if any (in rmail). | 1452 "Insert the message being replied to, if any (in Rmail). |
1466 Puts point after the text and mark before. | 1453 Puts point after the text and mark before. |
1467 Normally, indents each nonblank line ARG spaces (default 3). | 1454 Normally, indents each nonblank line ARG spaces (default 3). |
1468 However, if `mail-yank-prefix' is non-nil, insert that prefix on each line. | 1455 However, if `mail-yank-prefix' is non-nil, insert that prefix on each line. |
1469 | 1456 |
1470 Just \\[universal-argument] as argument means don't indent, insert no prefix, | 1457 Just \\[universal-argument] as argument means don't indent, insert no prefix, |