From owner-ntemacs-users@june Thu Oct 3 15:59:23 1996 X-VM-v5-Data: ([nil nil nil nil nil nil nil nil nil] [nil "Thu" " 3" "October" "1996" "17:42:34" "-0400" "bill@lynxhub.ho.att.com" "bill@lynxhub.ho.att.com" nil "952" "RE: feedmail.el with queues" "^From:" nil nil "10" nil nil nil nil] nil) Received: from joker.cs.washington.edu (joker.cs.washington.edu [128.95.1.42]) by june.cs.washington.edu (8.7.6/7.2ju) with SMTP id PAA13634 for ; Thu, 3 Oct 1996 15:59:22 -0700 Received: from june.cs.washington.edu (june.cs.washington.edu [128.95.1.4]) by joker.cs.washington.edu (8.6.12/7.2ws+) with ESMTP id PAA29413 for ; Thu, 3 Oct 1996 15:59:21 -0700 Received: from cagw1.att.com (cagw1.att.com [192.128.52.89]) by june.cs.washington.edu (8.7.6/7.2ju) with SMTP id OAA07032 for ; Thu, 3 Oct 1996 14:45:22 -0700 Received: from attrh1.attrh.att.com by caig1.att.att.com (SMI-8.6/EMS-1.2 sol2) id RAA13645; Thu, 3 Oct 1996 17:42:22 -0400 Received: from lynxhub.ho.att.com by attrh1.attrh.att.com (8.7.3/EMS-1.1 SunOS) id RAA29099 for ; Thu, 3 Oct 1996 17:44:49 -0400 (EDT) Received: by lynxhub.ho.att.com (5.x/SMI-SVR4) id AA06248; Thu, 3 Oct 1996 17:42:34 -0400 Message-Id: X-Mailer: emacs 18.58.1 (via feedmail 3-beta-5 I) WJC Original-From: bill@attmail.com (WJCarpenter) In-Reply-To: WJCarpenter's note of 12:03:06, 26 Sep 1996 References: Reply-To: bill@attmail.com (WJCarpenter) Content-Type: text From: bill@lynxhub.ho.att.com To: ntemacs-users@cs.washington.edu, win-emacs@pearlsoft.com Subject: RE: feedmail.el with queues Date: Thu, 3 Oct 1996 17:42:34 -0400 ;;; This is feedmail.el, a replacement for parts of ;;; GNUemacs' sendmail.el (specifically, it's what handles your outgoing ;;; mail after you type C-c C-c in mail mode). ;;; ;;; feedmail.el ;;; LCD record: ;;; feedmail|Bill Carpenter|bill@att.com|Outbound mail handling|96-10-03|3|feedmail.el ;;; ;;; Written by Bill Carpenter ;;; original, 31 March 1991 ;;; patchlevel 1, 5 April 1991 ;;; patchlevel 2, 24 May 1991 ;;; 5-may-92 jwz Conditionalized calling expand-mail-aliases, since that ;;; function doesn't exist in Lucid GNU Emacs or when using ;;; mail-abbrevs.el. ;;; patchlevel 3, 3 Oct 1996 ;;; ;;; As far as I'm concerned, anyone can do anything they want with ;;; this specific piece of code. No warranty or promise of support is ;;; offered. This code is hereby released into the public domain. ;;; ;;; This stuff does in elisp the stuff that used to be done ;;; by the separate program "fakemail" for processing outbound email. ;;; In other words, it takes over after you hit "C-c C-c" in mail mode. ;;; By appropriate setting of options, you can still use "fakemail", ;;; or you can even revert to sendmail (which is not too popular ;;; locally). See the variables at the top of the elisp for how to ;;; achieve these effects: ;;; ;;; --- you can get one last look at the prepped outbound message and ;;; be prompted for confirmation ;;; ;;; --- removes BCC: headers after getting address info ;;; ;;; --- does smart filling of TO: and CC: headers ;;; ;;; --- processes FCC: lines and removes them ;;; ;;; --- empty headers are removed ;;; ;;; --- can force FROM: or SENDER: line ;;; ;;; --- can generate a Message-ID line ;;; ;;; --- strips comments from address info (both "()" and "<>" are ;;; handled via a call to mail-strip-quoted-names); the ;;; comments are stripped in the simplified address list given ;;; to a subprocess, not in the headers in the mail itself ;;; (they are left unchanged, modulo smart filling) ;;; ;;; --- error info is pumped into a normal buffer instead of the ;;; minibuffer ;;; ;;; --- just before the optional prompt for confirmation, lets you ;;; run a hook on the prepped message and simplified address ;;; list ;;; ;;; --- you can specify something other than /bin/mail for the ;;; subprocess ;;; ;;; --- you can park outgoing messages into a disk-based queue and ;;; stimulate sending them all later (handy for laptop users) ;;; ;;; --- you can generate an X-MAILER: message header ;;; ;;; After a few options below, you will find the function ;;; feedmail-send-it. Everything after that function is just local ;;; stuff for this file. There are two ways you can use the stuff in ;;; this file: ;;; ;;; (1) Put the contents of this file into sendmail.el and change the ;;; name of feedmail-send-it to sendmail-send-it, replacing that ;;; function in sendmail.el. (I don't recommend this.) ;;; ;;; or ;;; ;;; (2) Save this file as feedmail.el somewhere on your elisp ;;; loadpath; byte-compile it. Put the following lines somewhere in ;;; your ~/.emacs stuff: ;;; ;;; (setq send-mail-function 'feedmail-send-it) ;;; (autoload 'feedmail-send-it "feedmail") ;;; (autoload 'feedmail-run-the-queue "feedmail") ;;; (defconst feedmail-patch-level "3") (defvar feedmail-confirm-outgoing nil "*If non-nil, gives a y-or-n confirmation prompt after prepping, before sending mail.") (defvar feedmail-nuke-bcc t "*Non-nil means get rid of the BCC: lines from the message header text before sending the mail. In any case, the BCC: lines do participate in the composed address list. You probably want to keep them if you're using sendmail (see feedmail-buffer-eating-function).") (defvar feedmail-fill-to-cc t "*Non-nil means do smart filling (line-wrapping) of TO: and CC: header lines. If nil, the lines are left as-is. The filling is done after mail address alias expansion.") (defvar feedmail-fill-to-cc-fill-column default-fill-column "*Fill column used when wrapping mail TO: and CC: lines.") (defvar feedmail-nuke-empty-headers t "*If non-nil, headers with no contents are removed from the outgoing email. A completely empty SUBJECT: header is always removed, regardless of the setting of this variable. The only time you would want them left in would be if you used some headers whose presence indicated something rather than their contents.") ;;; wjc sez: I think the use of the SENDER: line is pretty pointless, ;;; but I left it in to be compatible with sendmail.el and because ;;; maybe some distant mail system needs it. Really, though, if you ;;; want a sender line in your mail, just put one in there and don't ;;; wait for feedmail to do it for you. (defvar feedmail-sender-line nil "*If nil, no SENDER: header is forced. If non-nil and the email already has a FROM: header, a SENDER: header is forced with this as its contents. You can probably leave this nil, but if you feel like using it, a good value would be a fully-qualified domain name form of your address. For example, bill@att.com. Don't include a trailing newline or the keyword SENDER:. They're automatically provided.") ;; user-full-name suggested by kpc@ptolemy.arc.nasa.gov (=Kimball Collins) (defvar feedmail-from-line (concat (user-login-name) "@" (system-name) " (" (user-full-name) ")") "*If non-nil and the email has no FROM: header, one will be forced with this as its contents. A good value would be a fully-qualified domain name form of your address. For example, bill@att.com. (The default value of this variable is probably not very good, since it doesn't have a domain part.) Don't include a trailing newline or the keyword FROM:. They're automatically provided.") (defvar feedmail-x-mailer-line-user-appendage nil "*See feedmail-x-mailer-line.") (defvar feedmail-x-mailer-line t "*Controls the form of an X-MAILER: header in an outgoing message. Moderately useful for debugging, keeping track of your correspondents' mailer preferences, or just wearing your MUA on your sleeve. If nil, no X-MAILER: header is produced. If t, an X-MAILER: header of a predetermined format is produced. If neither nil nor t, should be a string which is just the contents of the header, not the header itself or the trailing newline. If you want to take the default construct and just add a little blob of your own at the end, define the variable feedmail-x-mailer-line-user-appendage as that blob string.") ;;; Here's how I use the GNUS Message-ID generator for mail but not ;;; for news postings: ;;; ;;; (setq feedmail-message-id-generator 'wjc:gnusish-message-id) ;;; (setq gnus-your-domain "att.com") ;;; ;;; (defun wjc:gnusish-message-id () ;;; (require 'gnuspost) ;;; (if (fboundp 'wjc:gnus-inews-message-id) ;;; (wjc:gnus-inews-message-id) ;;; (gnus-inews-message-id))) ;;; ;;; (setq news-inews-hook ;;; '(lambda () ;;; (defun gnus-inews-date () nil) ;;; (fset 'wjc:gnus-inews-message-id (symbol-function 'gnus-inews-message-id)) ;;; (defun gnus-inews-message-id () nil) ;;; )) ;;; (defvar feedmail-message-id-generator nil "*If non-nil, should be a function (called with no arguments) which will generate a unique message ID which will be inserted on a Message-ID: header. The message ID should be the return value of the function. Don't include trailing newline, leading space, or the keyword MESSAGE-ID. They're automatically provided. Do include surrounding <> brackets. For an example of a message ID generating function, you could look at the GNUS function gnus-inews-message-id. When called, the current buffer is the prepped outgoing mail buffer (the function may inspect it, but shouldn't modify it). If the returned value doesn't contain any non-whitespace characters, no message ID header is generated, so you could generate them conditionally, based on the contents of the mail.") (defvar feedmail-enable-queue nil "*If non-nil, provides for stashing outgoing messages in a disk-based queue for later transmission. The messages are queued in their raw state as they appear in the mail-mode buffer and can be arbitrarily edited before sending by visiting the appropriate file in the queue directory (and setting the buffer to mail-mode or whatever). If you visit a file in the queue directory and try to queue it again, it will just get saved in its existing file name. Queuing is quite handy for laptop-based users. It's also handy if you get a lot of mail and process it more or less sequentially (you might change your mind about contents of a reply based on a message you see a bit later). To transmit all the messages in the queue, invoke command feedmail-run-the-queue.") (defvar feedmail-ask-before-queue t "*If non-nil and if queueing is enabled, feedmail will ask if you want the message to be queued, sent immediately, or if you want to be returned to the buffer to continue editing.") (defvar feedmail-queue-chatty t "*If non-nil, blat a few status messages and such in the mini-buffer. If nil, just do the work and don't pester people about what's going on. In some cases, though, specific options inspire mini-buffer prompting; that's not affected by this variable setting. Also does not control reporting of error/abnormal conditions.") (defvar feedmail-queue-chatty-sit-for 1 "*After some messages are divulged, it is prudent to pause before something else obliterates them. This value controls the duration of the pause.") (defvar feedmail-ask-for-queue-slug nil "*If non-nil, you get to specify part of the name of the file into which the message will be stored. The file will automatically get the FQM suffix and an embedded sequence number for uniqueness, so don't specify that. But, you are responsible for making sure the resulting filename is legit for the operating system where you are using. If this variable is nil or if you just hit return in response to the prompt, feedmail queuing will take care of things properly. At the prompt, completion is available if you want to see what filenames are already in use.") (defvar feedmail-queue-slug-maker 'feedmail-queue-subject-slug-maker "*If non-nil, a function to call to generate the file slug for storing the message in. The returned slug should be just the filename part, without FQM suffix or uniquifying sequence numbers. The current buffer holds the raw message. The default stuff creates the slug based on the message subject.") ;; just some bookkeeping due to differences between Unix and MS ;; operating environments (defvar feedmail-sep-thing (if (boundp 'directory-sep-char) (char-to-string directory-sep-char) "/")) (defvar feedmail-queue-directory (concat (getenv "HOME") feedmail-sep-thing "mail" feedmail-sep-thing "q") "*Name of an directory where messages will be queued. Directory will be created if necessary. Should be a string that doesn't end with a slash. Default is \"$HOME/mail/q\".") (defvar feedmail-queue-fqm-suffix ".fqm" "*The FQM suffix used to distinguish queued message files from other random files that happen to be in the feedmail-queue-directory. FQM stands for \"feedmail queued message\".") (defvar feedmail-nuke-buffer-after-queue nil "*If non-nil, silently kill the buffer after a message has been queued. You might like that since a side-effect of queueing the message is that its buffer name gets changed to the filename. That means that the buffer won't be reused for the next message you compose.") (defun feedmail-confirm-addresses-hook-example () "An example of a last chance hook that shows the simple addresses and gets a confirmation. Use as (setq feedmail-last-chance-hook 'feedmail-confirm-addresses-hook-example)." (save-window-excursion (display-buffer feedmail-address-buffer) (if (not (y-or-n-p "How do you like them apples? ")) (error "Sending...gave up in last chance hook")))) (defvar feedmail-last-chance-hook nil "*User's last opportunity to modify the message on its way out. It has already had all the header prepping from the standard package. The next step after running the hook will be to push the buffer into a subprocess that mails the mail. The hook might be interested in these buffers: (1) feedmail-prepped-text-buffer contains the header and body of the message, ready to go; (2) feedmail-address-buffer contains the space-separated, simplified list of addresses which is to be given to the subprocess (the hook may change them). feedmail-error-buffer is an empty buffer intended to soak up errors for display to the user. If the hook allows interactive activity, the user should not send more mail while in the hook since some of the internal buffers will be reused.") (defvar feedmail-queue-runner-mode-setter 'mail-mode "*A function to be called to set the proper mode of a message file read back out of the queue directory. Most people want mail-mode, but here's your chance to have something different.") (defvar feedmail-queue-runner-message-sender 'mail-send-and-exit "*Function to call to initiate sending a message file read back out of the queue directory. Most people want mail-send-and-exit (bound to C-c C-c in mail-mode), but here's your chance to have something different. Called with call-interactively.") (defvar feedmail-queue-runner-cleaner-upper '(lambda () (delete-file (buffer-file-name)) ) "*Function that will be called after a message has been successfully sent (it's not called in the case of errors). The default action is to get rid of the file from the queue directory. You could replace this, for example, to archive all of your sent messages someplace (though there are better ways to get that particular result). This function is called with the message buffer as the current buffer and the message queue file as the associated file. In any case, the current buffer is killed elsewhere, so don't do that inside this function.") (defvar feedmail-queue-runner-is-active nil "*Indicates whether or not we're inside the logic of the loop iterating over all messages in the queue to send them. This can be used for differentiating customized code for different scenarios. Users shouldn't set or change this variable.") (defvar feedmail-buffer-eating-function 'feedmail-buffer-to-binmail "*Function used to send the prepped buffer to a subprocess. The function's three (mandatory) arguments are: (1) the buffer containing the prepped message; (2) a buffer where errors should be directed; and (3) a string containing the space-separated list of simplified addresses. Two popular choices for this are 'feedmail-buffer-to-binmail and 'feedmail-buffer-to-sendmail. If you use the sendmail form, you probably want to set feedmail-nuke-bcc to nil. If you use the binmail form, check the value of feedmail-binmail-template.") (defvar feedmail-binmail-template (if mail-interactive "/bin/mail %s" "/bin/rmail %s") "*Command template for the subprocess which will get rid of the mail. It can result in any command understandable by /bin/sh. The single '%s', if present, gets replaced by the space-separated, simplified list of addressees. Used in feedmail-buffer-to-binmail to form the shell command which will receive the contents of the prepped buffer as stdin. If you'd like your errors to come back as mail instead of immediately in a buffer, try /bin/rmail instead of /bin/mail (this can be accomplished by keeping the default nil setting of mail-interactive). You might also like to consult local mail experts for any other interesting command line possibilities.") ;; feedmail-buffer-to-binmail and feedmail-buffer-to-sendmail are the ;; only things provided for values for the variable ;; feedmail-buffer-eating-function. It's pretty easy to write your ;; own, though. (defun feedmail-buffer-to-binmail (prepped-mail-buffer mail-error-buffer simple-address-list) "Function which actually calls /bin/mail as a subprocess and feeds the buffer to it." (save-excursion (set-buffer prepped-mail-buffer) (apply 'call-process-region (append (list (point-min) (point-max) "/bin/sh" nil mail-error-buffer nil "-c" (format feedmail-binmail-template simple-address-list )))) ) ;; save-excursion ) (defun feedmail-buffer-to-sendmail (prepped-mail-buffer feedmail-error-buffer simple-address-list) "Function which actually calls sendmail as a subprocess and feeds the buffer to it." (save-excursion (set-buffer prepped-mail-buffer) (apply 'call-process-region (append (list (point-min) (point-max) (if (boundp 'sendmail-program) sendmail-program "/usr/lib/sendmail") nil feedmail-error-buffer nil "-oi" "-t") ;; Don't say "from root" if running under su. (and (equal (user-real-login-name) "root") (list "-f" (user-login-name))) ;; These mean "report errors by mail" ;; and "deliver in background". (if (null mail-interactive) '("-oem" "-odb")))) )) ;; provided by jam@austin.asc.slb.com (James A. McLaughlin) (defun feedmail-buffer-to-smtpmail (prepped-mail-buffer mail-error-buffer simple-address-list) "Function which actually calls smtpmail-via-smtp to send buffer as e-mail." (let ((recipient-address-list nil)) (save-excursion (set-buffer feedmail-address-buffer) ;; adapted from smtpmail-deduce-address-list in smtpmail.el to put the ;; buffer of addresses into a list for smtpmail-via-smtp (goto-char (point-min)) (while (re-search-forward "\\([^ ]+\\)" (point-max) t) (setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1)) recipient-address-list))) (set-buffer mail-error-buffer) (if (not (smtpmail-via-smtp recipient-address-list prepped-mail-buffer)) (insert "Send failed. SMTP Protocol Error."))))) ;; feedmail-send-it is the only "public" function is this file. ;; All of the others are just little helpers. (defun feedmail-send-it () (if (not feedmail-enable-queue) (feedmail-send-it-immediately) ;; else, queuing is enabled, should we ask about it or just do it? (if feedmail-ask-before-queue (let ((desire (feedmail-queue-send-edit-prompt))) (cond ((eq desire 'send) (feedmail-send-it-immediately)) ((eq desire 'edit) (error "Message not queued; returning to edit.")) (t (feedmail-dump-message-to-queue)))) (feedmail-dump-message-to-queue)) )) (defun feedmail-run-the-queue (arg) "Visit each message in the feedmail queue directory and send it out." (interactive "P") (let* ((maybe-file) (qlist (feedmail-look-at-queue-directory "fake")) (message-count (nth 1 qlist)) (other-count (nth 2 qlist)) (messages-sent 0) (messages-skipped 0) ) (save-excursion (mapcar '(lambda (blobby) (setq maybe-file (expand-file-name blobby feedmail-queue-directory)) (cond ((file-directory-p maybe-file) nil) ;; don't care about subdirs ((string-match (concat (regexp-quote feedmail-queue-fqm-suffix) "$") blobby) (if feedmail-queue-chatty (find-file maybe-file) (find-file-noselect maybe-file)) (set-buffer (if (fboundp 'find-buffer-visiting) (find-buffer-visiting maybe-file) (get-file-buffer maybe-file))) (funcall feedmail-queue-runner-mode-setter) (condition-case nil ;; don't give up the loop if user skips some (let ((feedmail-enable-queue nil) (feedmail-queue-runner-is-active t)) (funcall feedmail-queue-runner-message-sender arg) (setq messages-sent (1+ messages-sent)) (set-buffer (if (fboundp 'find-buffer-visiting) (find-buffer-visiting maybe-file) (get-file-buffer maybe-file))) (funcall feedmail-queue-runner-cleaner-upper) ) (error (setq messages-skipped (1+ messages-skipped))) ) (kill-buffer nil) (if feedmail-queue-chatty (progn (message "Messages: %d to go, %d sent, %d skipped (%d other files ignored)" (- message-count messages-sent messages-skipped) messages-sent messages-skipped other-count) (sit-for feedmail-queue-chatty-sit-for) ) ;progn ) ;if ) ) ;cond ) ;lambda (directory-files feedmail-queue-directory) )) (if feedmail-queue-chatty (message "Messages: %d sent, %d skipped (%d other files ignored)" messages-sent messages-skipped other-count)) ) ;let ) (defun feedmail-queue-send-edit-prompt () "Ask whether to queue, send immediately, or return to editing a message. Some ideas here came from the userlock.el code." (discard-input) (save-window-excursion (let (answer) (while (null answer) (message "Message action (q, i, e, ?)? [q] ") (let ((user-sez (let ((inhibit-quit t) (cursor-in-echo-area t) (echo-keystrokes 0)) (downcase (if (fboundp 'read-char-exclusive) (read-char-exclusive) (read-char)) )))) (if (= user-sez help-char) (feedmail-queue-send-edit-prompt-help) (setq answer (assoc user-sez '((?q . queue) (?\C-m . queue) (?\C-j . queue) (?e . edit) (?\C-g . edit) (?i . send) (?s . send) (?? . help)))) (cond ((null answer) (beep) (message "Please type q, i, or e; or ? for help") (sit-for 3)) ((eq (cdr answer) 'help) (feedmail-queue-send-edit-prompt-help) (setq answer nil)) )))) (cdr answer) ))) (defun feedmail-queue-send-edit-prompt-help () (with-output-to-temp-buffer "*Help*" (princ "You're dispatching a message and feedmail queuing is enabled. Choices: q QUEUE the message for later sending (via feedmail-run-the-queue) i IMMEDIATELY send the message (but not the other queued messages) s SEND the message immediately (same as \"i\") e EDIT, returning to the message edit buffer (don't send, don't queue) The default is to QUEUE.") (save-excursion (set-buffer standard-output) (if (fboundp 'help-mode (help-mode))) ))) (defun feedmail-look-at-queue-directory (in-slug) "Find out some things about the queue directory. Result is a list containing the sequenced-slug, a count of queued messages in the directory, and a count of other files in the directory. Subdirectories are not included in the counts. The sequenced-slug is an available queued message filename (not including the FQM suffix). It comes from just bumping a sequence number in a pre-determined filename pattern based on in-slug. It's not guaranteed to be the highest numbered such filename." (and (string-match (concat (regexp-quote feedmail-queue-fqm-suffix) "$") in-slug) ;;nuke existing suffix (setq in-slug ;; replace-match for strings doesn't work in v18 (concat (substring in-slug 0 (match-beginning 0)) (substring in-slug (match-end 0))))) (and (string-match "-+$" in-slug) ;;nuke trailing dashes (why not?) (setq in-slug ;; replace-match for strings doesn't work in v18 (concat (substring in-slug 0 (match-beginning 0)) (substring in-slug (match-end 0))))) (while (string-match "--+" in-slug) ;;collapse multi dashes (why not?) (setq in-slug ;; replace-match for strings doesn't work in v18 (concat (substring in-slug 0 (match-beginning 0)) "-" (substring in-slug (match-end 0))))) (let ((ticker 1) (slug-sequence nil) (message-count 0) (other-count 0) (maybe-file nil)) ;; iterate, counting things we find along the way in the directory (mapcar '(lambda (blobby) (setq maybe-file (concat (directory-file-name feedmail-queue-directory) feedmail-sep-thing blobby)) (cond ((file-directory-p maybe-file) nil) ;; don't care about subdirs ((string-match (concat (regexp-quote feedmail-queue-fqm-suffix) "$") maybe-file) (setq message-count (1+ message-count))) (t (setq other-count (1+ other-count))) )) (directory-files feedmail-queue-directory)) (setq maybe-file nil) (while (or (null maybe-file) (file-exists-p maybe-file)) (setq slug-sequence (format "%s-%03d" in-slug ticker)) (setq maybe-file (expand-file-name (concat slug-sequence feedmail-queue-fqm-suffix) feedmail-queue-directory)) (setq ticker (1+ ticker)) ) ;while (list slug-sequence message-count other-count) ) ) (defun feedmail-queue-subject-slug-maker () "*Creates a name storing the message in the queue; the name is based on the SUBJECT: header (if there is one). Special characters are mapped to mostly alphanumerics for safety." (let ( (end-of-headers-marker) (case-fold-search t) (subject "") (cooked-subject "") (s-point) (dex 0) (leng) (this-dat) ) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) (setq end-of-headers-marker (point-marker)) (goto-char (point-min)) (if (re-search-forward "^subject:" end-of-headers-marker t) (progn (setq s-point (point-marker)) (end-of-line) (setq subject (buffer-substring s-point (point-marker))) ) ;progn ) (if (string-match " *" subject) ;; for tidyness, peel off leading spaces (setq subject (substring subject (match-end 0)))) (setq leng (length subject)) (if (or (eq leng 0) (null subject)) (progn (setq subject "no-subject") (setq leng 3))) ;; pretty inelegant elisp, but does the job ;; replace all non-alphanumerics with hyphen for safety (while (< dex leng) (setq this-dat (substring subject dex (1+ dex))) (if (string-match "[a-z0-9]" this-dat) (setq cooked-subject (concat cooked-subject this-dat)) (setq cooked-subject (concat cooked-subject "-"))) (setq dex (1+ dex))) cooked-subject )) (defun feedmail-create-queue-filename () (let ((slug "wjc")) (if feedmail-queue-slug-maker (save-excursion (setq slug (funcall feedmail-queue-slug-maker)))) (if feedmail-ask-for-queue-slug (setq slug (read-file-name (concat "Message filename slug [" slug "]? ") (concat (directory-file-name feedmail-queue-directory) feedmail-sep-thing) slug ; default-file-name nil) ;read-file-name )) (concat (expand-file-name (car (feedmail-look-at-queue-directory slug)) feedmail-queue-directory) feedmail-queue-fqm-suffix) )) (defun feedmail-dump-message-to-queue () (or (if (fboundp 'file-accessible-directory-p) (file-accessible-directory-p feedmail-queue-directory) (file-directory-p feedmail-queue-directory)) (progn ;; to get nil result no matter what (if (fboundp 'make-directory) (make-directory feedmail-queue-directory t)) nil) ;progn (if (fboundp 'file-accessible-directory-p) (file-accessible-directory-p feedmail-queue-directory) (file-directory-p feedmail-queue-directory)) (error (concat "Message not queued; trouble with directory " feedmail-queue-directory))) (let ((filename) (directory-stats)) (if (and buffer-file-name ;; if visiting a queued message, just save (string-match (concat (regexp-quote feedmail-queue-fqm-suffix) "$") buffer-file-name) (string-equal (downcase (directory-file-name feedmail-queue-directory)) (downcase (directory-file-name (file-name-directory buffer-file-name)))) ) (setq filename buffer-file-name) (setq filename (feedmail-create-queue-filename)) ) (write-file filename) (if feedmail-nuke-buffer-after-queue (kill-buffer nil)) (if feedmail-queue-chatty (progn (message (concat "Queued in " filename)) (sit-for feedmail-queue-chatty-sit-for) ) ) (setq directory-stats (feedmail-look-at-queue-directory "fake")) (if feedmail-queue-chatty (progn (message "%s messages, %s other files in %s" (nth 1 directory-stats) (nth 2 directory-stats) feedmail-queue-directory) (sit-for feedmail-queue-chatty-sit-for) ) ) )) (defun feedmail-send-it-immediately () (let* ((default-case-fold-search t) (feedmail-error-buffer (get-buffer-create " *Outgoing Email Errors*")) (feedmail-prepped-text-buffer (get-buffer-create " *Outgoing Email Text*")) (feedmail-address-buffer (get-buffer-create " *Outgoing Email Address List*")) (feedmail-raw-text-buffer (current-buffer)) (case-fold-search nil) end-of-headers-marker) (unwind-protect (save-excursion (set-buffer feedmail-prepped-text-buffer) (erase-buffer) ;; jam contents of user-supplied mail buffer into our scratch buffer (insert-buffer-substring feedmail-raw-text-buffer) ;; require one newline at the end. (goto-char (point-max)) (or (= (preceding-char) ?\n) (insert ?\n)) ;; Change header-delimiter to be what mailers expect (empty line). (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) (replace-match "\n") ;; why was this backward-char here? ;;(backward-char 1) (setq end-of-headers-marker (point-marker)) (if (and (fboundp 'expand-mail-aliases) ; nil = mail-abbrevs.el mail-aliases) (expand-mail-aliases (point-min) end-of-headers-marker)) ;; make it pretty (if feedmail-fill-to-cc (feedmail-fill-to-cc-function end-of-headers-marker)) ;; ignore any blank lines in the header (goto-char (point-min)) (while (and (re-search-forward "\n\n\n*" end-of-headers-marker t) (< (point) end-of-headers-marker)) (replace-match "\n")) (let ((case-fold-search t)) (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) end-of-headers-marker) (save-excursion (set-buffer feedmail-address-buffer) (goto-char (point-min)) (if (not (re-search-forward "\\S-" (point-max) t)) (error "Sending...abandoned, no addressees!"))) ;; Find and handle any BCC fields. (if feedmail-nuke-bcc (feedmail-do-bcc end-of-headers-marker)) ;; Find and handle any FCC fields. (goto-char (point-min)) (if (re-search-forward "^FCC:" end-of-headers-marker t) (mail-do-fcc end-of-headers-marker)) (goto-char (point-min)) (if (re-search-forward "^FROM:" end-of-headers-marker t) ;; If there is a FROM: and no SENDER:, put in a SENDER: ;; if requested by user (if (and feedmail-sender-line (not (save-excursion (goto-char (point-min)) (re-search-forward "^SENDER:" end-of-headers-marker t)))) (progn (forward-line 1) (insert "Sender: " feedmail-sender-line "\n"))) ;; no FROM: ... force one? (if feedmail-from-line (progn (goto-char (point-min)) (insert "From: " feedmail-from-line "\n"))) ) ;; X-Mailer: emacs xx.yy.zz (via feedmail N X) user appendage (if (and feedmail-x-mailer-line (not (save-excursion (goto-char (point-min)) (re-search-forward "^X-MAILER:" end-of-headers-marker t)))) (progn (goto-char (point-min)) (insert "X-Mailer: " (cond ((eq feedmail-x-mailer-line t) (concat (let ((case-fold-search t)) (if (string-match "emacs" emacs-version) "" "emacs ")) ;let emacs-version " (via feedmail " feedmail-patch-level (if feedmail-queue-runner-is-active " Q" " I") ") " feedmail-x-mailer-line-user-appendage) ;concat ) (t feedmail-x-mailer-line)) "\n") ;insert ) ;progn ) ;if ;; don't send out a blank subject line (goto-char (point-min)) (if (re-search-forward "^Subject:[ \t]*\n" end-of-headers-marker t) (replace-match "")) ;; don't send out a blank headers of various sorts (goto-char (point-min)) (and feedmail-nuke-empty-headers ;; hey, who's an empty-header? (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" end-of-headers-marker t) (replace-match "")))) ;; message ID generation (if feedmail-message-id-generator (progn (goto-char (point-min)) (if (re-search-forward "^MESSAGE-ID:[ \t]*\n" end-of-headers-marker t) (replace-match "")) (setq feedmail-msgid-part (funcall feedmail-message-id-generator)) (goto-char (point-min)) (and feedmail-msgid-part (string-match "[^ \t]" feedmail-msgid-part) (insert "Message-ID: " feedmail-msgid-part "\n")))) (save-excursion (set-buffer feedmail-error-buffer) (erase-buffer)) (run-hooks 'feedmail-last-chance-hook) (if (or (not feedmail-confirm-outgoing) (feedmail-one-last-look feedmail-prepped-text-buffer)) (funcall feedmail-buffer-eating-function feedmail-prepped-text-buffer feedmail-error-buffer (save-excursion (set-buffer feedmail-address-buffer) (buffer-string))) (error "Sending...abandoned") ) ) ;; unwind-protect body (save-excursion) ;; unwind-protect cleanup forms (kill-buffer feedmail-prepped-text-buffer) (kill-buffer feedmail-address-buffer) (set-buffer feedmail-error-buffer) (if (zerop (buffer-size)) (kill-buffer feedmail-error-buffer) (progn (display-buffer feedmail-error-buffer) (error "Sending...failed"))) (set-buffer feedmail-raw-text-buffer)) ) ;; let ) (defun feedmail-do-bcc (header-end) "Delete BCC: and their continuation lines from the header area. There may be multiple BCC: lines, and each may have arbitrarily many continuation lines." (let ((case-fold-search t)) (save-excursion (goto-char (point-min)) ;; iterate over all BCC: lines (while (re-search-forward "^BCC:" header-end t) (delete-region (match-beginning 0) (progn (forward-line 1) (point))) ;; get rid of any continuation lines (while (and (looking-at "^[ \t].*\n") (< (point) header-end)) (replace-match "")) ) ) ;; save-excursion ) ;; let ) (defun feedmail-fill-to-cc-function (header-end) "Smart filling of TO: and CC: headers. The filling tries to avoid splitting lines except at commas. This avoids, in particular, splitting within parenthesized comments in addresses." (let ((case-fold-search t) (fill-prefix "\t") (fill-column feedmail-fill-to-cc-fill-column) this-line this-line-end) (save-excursion (goto-char (point-min)) ;; iterate over all TO:/CC: lines (while (re-search-forward "^\\(TO:\\|CC:\\)" header-end t) (setq this-line (match-beginning 0)) ;; replace 0 or more spaces with a single space (and (looking-at "[ \t]*") (replace-match " ")) (forward-line 1) ;; get any continuation lines (while (and (looking-at "^[ \t]+") (< (point) header-end)) (replace-match " ") (forward-line 1)) (setq this-line-end (point-marker)) ;; The general idea is to break only on commas. Change ;; all the blanks to something unprintable; change the ;; commas to blanks; fill the region; change it back. (subst-char-in-region this-line this-line-end ? 2 t) ;; blank --> C-b (subst-char-in-region this-line this-line-end ?, ? t) ;; comma --> blank (fill-region-as-paragraph this-line this-line-end) (subst-char-in-region this-line this-line-end ? ?, t) ;; comma <-- blank (subst-char-in-region this-line this-line-end 2 ? t) ;; blank <-- C-b ;; look out for missing commas before continuation lines (save-excursion (goto-char this-line) (while (re-search-forward "\\([^,]\\)\n\t[ ]*" this-line-end t) (replace-match "\\1,\n\t"))) ) ) ;; while ) ;; save-excursion ) (defun feedmail-deduce-address-list (feedmail-text-buffer header-start header-end) "Get address list suitable for command line use on simple /bin/mail." (require 'mail-utils) ;; pick up mail-strip-quoted-names (let ((case-fold-search t) (simple-address-list "") this-line this-line-end) (unwind-protect (save-excursion (set-buffer feedmail-address-buffer) (erase-buffer) (insert-buffer-substring feedmail-text-buffer header-start header-end) (goto-char (point-min)) (while (re-search-forward "^\\(TO:\\|CC:\\|BCC:\\)" header-end t) (replace-match "") (setq this-line (match-beginning 0)) (forward-line 1) ;; get any continuation lines (while (and (looking-at "^[ \t]+") (< (point) header-end)) (forward-line 1)) (setq this-line-end (point-marker)) (setq simple-address-list (concat simple-address-list " " (mail-strip-quoted-names (buffer-substring this-line this-line-end)))) ) (erase-buffer) (insert-string simple-address-list) (subst-char-in-region (point-min) (point-max) 10 ? t) ;; newline --> blank (subst-char-in-region (point-min) (point-max) ?, ? t) ;; comma --> blank (subst-char-in-region (point-min) (point-max) 9 ? t) ;; tab --> blank (goto-char (point-min)) ;; tidyness in case hook is not robust when it looks at this (while (re-search-forward "[ \t]+" header-end t) (replace-match " ")) ) ) ) ) (defun feedmail-one-last-look (feedmail-prepped-text-buffer) "Offer the user one last chance to give it up." (save-excursion (save-window-excursion (switch-to-buffer feedmail-prepped-text-buffer) (y-or-n-p "Send this email? ")))) (provide 'feedmail) From rms@gnu.ai.mit.edu Sun Jan 26 22:10:55 1997 X-VM-v5-Data: ([nil nil nil nil t nil t nil nil] [nil "Mon" "27" "January" "1997" "01:12:52" "-0500" "Richard Stallman" "rms@gnu.ai.mit.edu" "<199701270612.BAA01787@psilocin.gnu.ai.mit.edu>" "181" "[gko@mail.net.tw: Re: smtpmail_delay.el: queues messages instead of sending them immediately]" "^From:" nil nil "1" nil nil nil nil] nil) Received: from psilocin.gnu.ai.mit.edu (psilocin.gnu.ai.mit.edu [128.52.46.62]) by june.cs.washington.edu (8.8.5+CS/7.2ju) with SMTP id WAA04567 for ; Sun, 26 Jan 1997 22:10:54 -0800 Received: by psilocin.gnu.ai.mit.edu (8.6.12/8.6.12GNU) id BAA01787; Mon, 27 Jan 1997 01:12:52 -0500 Message-Id: <199701270612.BAA01787@psilocin.gnu.ai.mit.edu> From: Richard Stallman To: voelker@cs.washington.edu Subject: [gko@mail.net.tw: Re: smtpmail_delay.el: queues messages instead of sending them immediately] Date: Mon, 27 Jan 1997 01:12:52 -0500 Here is the queueing patch for which I am awaiting papers. What do you think of it? ------- Start of forwarded message ------- Date: Tue, 21 Jan 1997 19:37:57 +0800 (CST) From: Georges KO Reply-To: gko@mail.net.tw, kott@ccms.ntu.edu.tw X-Machine: Linux gabegie 2.0.0 #7 Mon Nov 11 22:38:50 CST 1996 i586 MIME-Version: 1.0 Content-Type: text/plain; charset="iso-8859-1" Content-Transfert-Encoding: 8bit To: rms@gnu.ai.mit.edu In-reply-to: <199701210855.DAA23567@psilocin.gnu.ai.mit.edu> (message from Richard Stallman on Tue, 21 Jan 1997 03:55:17 -0500) Subject: Re: smtpmail_delay.el: queues messages instead of sending them immediately > Could you possibly rewrite this > into a version of smtpmail.el which uses a Lisp variable > to control whether to queue or not? OK, it's called smtpmail_off.el in the patch. > I think that interface is more convenient, and I'd like to install > the changes in Emacs if you do them that way. Great! gko@gabegie:~/elisp 501 $ diff -c smtpmail.el smtpmail_off.el *** smtpmail.el Tue Jan 21 19:16:48 1997 - --- smtpmail_off.el Tue Jan 21 19:15:46 1997 *************** *** 38,46 **** - --- 38,51 ---- ;;(setq smtpmail-code-conv-from nil) ;;(setq user-full-name "YOUR NAME HERE") + ;; To queue mail, set smtpmail-queue-mail to t and use + ;; smtpmail-send-queued-mail to send. + + ;;; Code: (require 'sendmail) + (require 'time-stamp) ;;; (defvar smtpmail-default-smtp-server nil *************** *** 64,73 **** - --- 69,91 ---- (defvar smtpmail-code-conv-from nil ;; *junet* "*smtpmail code convert from this code to *internal*..for tiny-mime..") + (defvar smtpmail-queue-mail nil + "*Specify if mail is queued (if t) or sent immediately (if nil). + If queued, it is stored in the directory `smtpmail-queue-dir' + and sent with `smtpmail-send-queued-mail'.") + + (defvar smtpmail-queue-dir "~/Mail/queued-mail/" + "Directory where queued mail is stored.") + (defvar smtpmail-queue-index-file "index" + "Filename of queued mail index") + ;;; ;;; ;;; + (defvar smtpmail-queue-index (concat smtpmail-queue-dir + smtpmail-queue-index-file)) + (defun smtpmail-send-it () (require 'mail-utils) (let ((errbuf (if mail-interactive *************** *** 200,217 **** (or resend-to-addresses (smtpmail-deduce-address-list tembuf (point-min) delimline))) (kill-buffer smtpmail-address-buffer) ! (smtpmail-do-bcc delimline) ! ! (if (not (null smtpmail-recipient-address-list)) ! (if (not (smtpmail-via-smtp smtpmail-recipient-address-list tembuf)) ! (error "Sending failed; SMTP protocol error")) ! (error "Sending failed; no recipients")) ! ) (kill-buffer tembuf) (if (bufferp errbuf) (kill-buffer errbuf))))) ;(defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer) - --- 218,294 ---- (or resend-to-addresses (smtpmail-deduce-address-list tembuf (point-min) delimline))) (kill-buffer smtpmail-address-buffer) ! (smtpmail-do-bcc delimline) ! ; Send or queue ! (if (not smtpmail-queue-mail) ! (if (not (null smtpmail-recipient-address-list)) ! (if (not (smtpmail-via-smtp ! smtpmail-recipient-address-list tembuf)) ! (error "Sending failed; SMTP protocol error")) ! (error "Sending failed; no recipients")) ! (let* ((file-data (concat ! smtpmail-queue-dir ! (time-stamp-strftime ! "%02y%02m%02d-%02H%02M%02S"))) ! (file-elisp (concat file-data ".el")) ! (buffer-data (create-file-buffer file-data)) ! (buffer-elisp (create-file-buffer file-elisp)) ! (buffer-scratch "*queue-mail*")) ! (save-excursion ! (set-buffer buffer-data) ! (erase-buffer) ! (insert-buffer tembuf) ! (write-file file-data) ! (set-buffer buffer-elisp) ! (erase-buffer) ! (insert (concat ! "(setq smtpmail-recipient-address-list '" ! (prin1-to-string smtpmail-recipient-address-list) ! ")\n")) ! (write-file file-elisp) ! (set-buffer (generate-new-buffer buffer-scratch)) ! (insert (concat file-data "\n")) ! (append-to-file (point-min) ! (point-max) ! smtpmail-queue-index) ! ) ! (kill-buffer buffer-scratch) ! (kill-buffer buffer-data) ! (kill-buffer buffer-elisp)))) (kill-buffer tembuf) (if (bufferp errbuf) (kill-buffer errbuf))))) + (defun smtpmail-send-queued-mail () + "Sends mail queued by smtpmail-send-it with smtpmail-queue-mail set to t." + (interactive) + ;;; Get index, get first mail, send it, get second mail, etc... + (let ((buffer-index (find-file-noselect smtpmail-queue-index)) + (file-msg "") + (tembuf nil)) + (save-excursion + (set-buffer buffer-index) + (beginning-of-buffer) + (while (not (eobp)) + (setq file-msg (buffer-substring (point) (save-excursion + (end-of-line) + (point)))) + (load file-msg) + (setq tembuf (find-file-noselect file-msg)) + (if (not (null smtpmail-recipient-address-list)) + (if (not (smtpmail-via-smtp smtpmail-recipient-address-list + tembuf)) + (error "Sending failed; SMTP protocol error")) + (error "Sending failed; no recipients")) + (delete-file file-msg) + (delete-file (concat file-msg ".el")) + (kill-buffer tembuf) + (kill-line 1)) + (set-buffer buffer-index) + (save-buffer smtpmail-queue-index) + (kill-buffer buffer-index) + ))) ;(defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer) - -- Georges KO at mailto:gko@mail.net.tw and mailto:m52021@mtc.ntnu.edu.tw http://mtc.ntnu.edu.tw:52021/~m52021 ------- End of forwarded message ------- - -- We are holding the second free software conference in San Francisco on February 20-21. We hope you can come. For more info, see http://www.gnu.ai.mit.edu/conferences/97san-fran/announcement.html or write to conf97@gnu.ai.mit.edu.