]> code.delx.au - gnu-emacs/blobdiff - lisp/mail/feedmail.el
Remove arch-tags from all files, since these are no longer needed.
[gnu-emacs] / lisp / mail / feedmail.el
index 3180b05c818bae5fba02e53f4c5e60dcd06613eb..77d82f6076f369b12dde751d01888d9812508eac 100644 (file)
 
 (defconst feedmail-patch-level "8")
 
+(require 'mail-utils)               ; pick up mail-strip-quoted-names
+
+(eval-when-compile
+  (require 'smtpmail)
+  (require 'cl))
 
-;; from <URL:http://www.dina.kvl.dk/~abraham/custom/>:
-;; If you write software that must work without the new custom, you
-;; can use this hack stolen from w3-cus.el:
-(eval-and-compile
- (condition-case ()
-     (require 'custom)
-   (error nil))
- (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
-     nil ;; We've got what we needed
-     ;; We have the old custom-library, hack around it!
-     (defmacro defgroup (&rest args)
-       nil)
-     (defmacro defcustom (var value doc &rest args)
-       `(defvar ,var ,value ,doc))))
-
-(eval-when-compile (require 'smtpmail))
 (autoload 'mail-do-fcc "sendmail")
 
 (defgroup feedmail nil
@@ -497,11 +486,10 @@ header is fiddled after the From: header is fiddled."
 (defcustom feedmail-force-binary-write t
   "*If non-nil, force writing file as binary (this applies to queues and Fcc:).
 On systems where there is a difference between binary and text files,
-feedmail will temporarily manipulate the values of `buffer-file-type'
-and/or `default-buffer-file-type' to make the writing as binary.  If
-nil, writing will be in text mode.  On systems where there is no
-distinction or where it is controlled by other variables or other
-means, this option has no effect."
+feedmail will temporarily manipulate the value of `buffer-file-type'
+to make the writing as binary.  If nil, writing will be in text mode.
+On systems where there is no distinction or where it is controlled by other
+variables or other means, this option has no effect."
   :group 'feedmail-misc
   :type 'boolean
   )
@@ -629,7 +617,7 @@ configurations of sendmail).  Even if the latter case is true, it
 probably won't hurt you to generate your own, and it will then show up
 in the saved message if you use Fcc:."
   :group 'feedmail-headers
-  :type '(choice (const nil) function)
+  :type '(choice (const t) (const nil) function)
   )
 
 
@@ -678,7 +666,7 @@ configurations of sendmail).  Even if the latter case is true, it
 probably won't hurt you to generate your own, and it will then show up
 in the saved message if you use Fcc:."
   :group 'feedmail-headers
-  :type '(choice (const nil) function)
+  :type '(choice (const t) (const nil) function)
   )
 
 
@@ -824,30 +812,21 @@ without having to answer no to the individual message prompts."
   :type 'boolean)
 
 
-;; I provided a default for VMS because someone asked for it (the
-;; normal default doesn't work there), but, puh-lease!, it is a user
-;; definable option, so if you don't like the default, change it to
-;; whatever you want.  I am unable to directly test the VMS goop
-;; provided here by levitte@lp.se (Richard Levitte - VMS Whacker).
 (defcustom feedmail-queue-directory
-  (if (memq system-type '(axp-vms vax-vms))
-      (expand-file-name (concat (getenv "HOME") "[.MAIL.Q]"))
-    (concat (getenv "HOME") "/mail/q"))
+  (concat (getenv "HOME") "/mail/q")
   "*Name of a directory where messages will be queued.
 Directory will be created if necessary.  Should be a string that
-doesn't end with a slash.  Default, except on VMS, is \"$HOME/mail/q\"."
+doesn't end with a slash.  Default is \"$HOME/mail/q\"."
   :group 'feedmail-queue
   :type 'string
   )
 
 
 (defcustom feedmail-queue-draft-directory
-  (if (memq system-type '(axp-vms vax-vms))
-      (expand-file-name (concat (getenv "HOME") "[.MAIL.DRAFT]"))
-    (concat (getenv "HOME") "/mail/draft"))
+  (concat (getenv "HOME") "/mail/draft")
   "*Name of a directory where draft messages will be queued.
 Directory will be created if necessary.  Should be a string that
-doesn't end with a slash.  Default, except on VMS, is \"$HOME/mail/draft\"."
+doesn't end with a slash.  Default is \"$HOME/mail/draft\"."
   :group 'feedmail-queue
   :type 'string
   )
@@ -1547,6 +1526,9 @@ bail out with an appropriate answer to the global confirmation prompt."
   (interactive "p")
   (let ((feedmail-queue-runner-confirm-global t)) (feedmail-run-the-queue arg)))
 
+;; letf fools the byte-compiler.
+(defvar file-name-buffer-file-type-alist)
+
 ;;;###autoload
 (defun feedmail-run-the-queue (&optional arg)
   "Visit each message in the feedmail queue directory and send it out.
@@ -1588,7 +1570,7 @@ backup file names and the like)."
        (setq list-of-possible-fqms (directory-files feedmail-queue-directory t))
        (if feedmail-queue-run-orderer
            (setq list-of-possible-fqms (funcall feedmail-queue-run-orderer list-of-possible-fqms)))
-       (mapcar
+       (mapc
         '(lambda (blobby)
            (setq maybe-file (expand-file-name blobby feedmail-queue-directory))
            (cond
@@ -1626,9 +1608,9 @@ backup file names and the like)."
                           (not
                            (let ((mail-header-separator feedmail-queue-alternative-mail-header-separator))
                              (feedmail-find-eoh t)))))
-                 (let ((file-name-buffer-file-type-alist nil) (default-buffer-file-type nil))
-                   (erase-buffer) (insert-file-contents maybe-file))
-               )
+                 (letf ((file-name-buffer-file-type-alist nil)
+                         ((default-value 'buffer-file-type) nil))
+                   (erase-buffer) (insert-file-contents maybe-file)))
              ;; if M-H-S not found and (a-M-H-S is non-nil and is found)
              ;; temporarily set M-H-S to the value of a-M-H-S
              (if (and (not (feedmail-find-eoh t))
@@ -1651,8 +1633,7 @@ backup file names and the like)."
                      (if (and already-buffer (not (file-exists-p maybe-file)))
                          ;; we have gotten rid of the file associated with the
                          ;; buffer, so update the buffer's notion of that
-                         (save-excursion
-                           (set-buffer already-buffer)
+                         (with-current-buffer already-buffer
                            (setq buffer-file-name nil)))))
                (error (setq messages-skipped (1+ messages-skipped))))
              (kill-buffer blobby-buffer)
@@ -1824,7 +1805,8 @@ see the variable feedmail-prompt-before-queue-user-alist.
 ")
     (and (stringp feedmail-prompt-before-queue-help-supplement)
         (princ feedmail-prompt-before-queue-help-supplement))
-    (save-excursion (set-buffer standard-output) (if (fboundp 'help-mode) (help-mode)))))
+    (with-current-buffer standard-output
+      (if (fboundp 'help-mode) (help-mode)))))
 
 (defun feedmail-look-at-queue-directory (queue-directory)
   "Find out some things about a queue directory.
@@ -1835,7 +1817,7 @@ the counts."
   (let ((q-cnt 0) (q-oth 0) (high-water 0) (blobbet))
     ;; iterate, counting things we find along the way in the directory
     (if (file-directory-p queue-directory)
-       (mapcar
+       (mapc
         '(lambda (blobby)
            (cond
             ((file-directory-p blobby) nil) ; don't care about subdirs
@@ -1922,7 +1904,7 @@ mapped to mostly alphanumerics for safety."
       ;; progn to get nil result no matter what
       (progn (make-directory queue-directory t) nil)
       (file-accessible-directory-p queue-directory)
-      (error (concat "FQM: Message not queued; trouble with directory " queue-directory)))
+      (error "FQM: Message not queued; trouble with directory %s" queue-directory))
   (let ((filename)
        (is-fqm)
        (is-in-this-dir)
@@ -1938,7 +1920,8 @@ mapped to mostly alphanumerics for safety."
        (setq filename buffer-file-name)
       (setq filename (feedmail-create-queue-filename queue-directory)))
     ;; make binary file on DOS/Win95/WinNT, etc
-    (let ((buffer-file-type feedmail-force-binary-write)) (write-file filename))
+    (let ((buffer-file-type feedmail-force-binary-write))
+      (write-file filename))
     ;; convenient for moving from draft to q, for example
     (if (and previous-buffer-file-name (or (not is-fqm) (not is-in-this-dir))
             (y-or-n-p (format "FQM: Was previously %s; delete that? " previous-buffer-file-name)))
@@ -1972,6 +1955,7 @@ mapped to mostly alphanumerics for safety."
      (feedmail-rfc822-time-zone time)
      )))
 
+(declare-function expand-mail-aliases "mailalias" (beg end &optional exclude))
 
 (defun feedmail-send-it-immediately ()
   "Handle immediate sending, including during a queue run."
@@ -1992,7 +1976,7 @@ mapped to mostly alphanumerics for safety."
         (mail-header-separator mail-header-separator)
         )
     (unwind-protect
-       (save-excursion
+       (save-current-buffer
          (set-buffer feedmail-error-buffer) (erase-buffer)
          (set-buffer feedmail-prepped-text-buffer) (erase-buffer)
 
@@ -2097,21 +2081,21 @@ mapped to mostly alphanumerics for safety."
                  (if (and (not feedmail-queue-runner-is-active) (setq also-file (buffer-file-name feedmail-raw-text-buffer)))
                      (progn            ; if a file but not running the queue, offer to delete it
                        (setq also-file (expand-file-name also-file))
-                       (if (or feedmail-queue-auto-file-nuke
-                               (y-or-n-p (format "FQM: Delete message file %s? " also-file)))
-                           (save-excursion
-                             ;; if we delete the affiliated file, get rid
-                             ;; of the file name association and make sure we
-                             ;; don't annoy people with a prompt on exit
-                             (delete-file also-file)
-                             (set-buffer feedmail-raw-text-buffer)
-                             (setq buffer-offer-save nil)
-                             (setq buffer-file-name nil)
-                             )
-                         )))
+                       (when (or feedmail-queue-auto-file-nuke
+                                  (y-or-n-p
+                                   (format "FQM: Delete message file %s? "
+                                           also-file)))
+                          ;; if we delete the affiliated file, get rid
+                          ;; of the file name association and make sure we
+                          ;; don't annoy people with a prompt on exit
+                          (delete-file also-file)
+                          (with-current-buffer feedmail-raw-text-buffer
+                            (setq buffer-offer-save nil)
+                            (setq buffer-file-name nil)))))
                  (goto-char (point-min))
                  ;; re-insert and handle any Fcc fields (and, optionally, any Bcc).
-                 (if fcc (let ((default-buffer-file-type feedmail-force-binary-write))
+                 (if fcc (letf (((default-value 'buffer-file-type)
+                                  feedmail-force-binary-write))
                            (insert fcc)
                            (if (not feedmail-nuke-bcc-in-fcc)
                                (progn (if bcc-holder (insert bcc-holder))
@@ -2218,18 +2202,19 @@ fiddle-plex, as described in the documentation for the variable
        (mapcar
         '(lambda (feedmail-spray-this-address)
            (let ((spray-buffer (get-buffer-create " *FQM Outgoing Email Spray*")))
-             (save-excursion
-               (set-buffer spray-buffer)
+             (with-current-buffer spray-buffer
                (erase-buffer)
                ;; not life's most efficient methodology, but spraying isn't
                ;; an every-5-minutes event either
                (insert-buffer-substring feedmail-prepped-text-buffer)
-               ;; There's a good case to me made that each separate transmission of
-               ;; a message in the spray should have a distinct Message-Id:.  There
-               ;; is also a less compelling argument in the other direction.  I think
-               ;; they technically should have distinct Message-Id:s, but I doubt that
-               ;; anyone cares, practically.  If someone complains about it, I'll add
-               ;; it.
+               ;; There's a good case to me made that each separate
+               ;; transmission of a message in the spray should
+               ;; have a distinct Message-Id:.  There is also a less
+               ;; compelling argument in the other direction.
+               ;; I think they technically should have distinct
+               ;; Message-Id:s, but I doubt that anyone cares,
+               ;; practically.  If someone complains about it, I'll
+               ;; add it.
                (feedmail-fiddle-list-of-spray-fiddle-plexes feedmail-spray-address-fiddle-plex-list)
                ;; this (let ) is just in case some buffer eater
                ;; is cheating and using the global variable name instead
@@ -2603,7 +2588,6 @@ Resent-To:, Resent-Cc:, and Resent-Bcc:."
     ))
 
 
-(require 'mail-utils)                  ; pick up mail-strip-quoted-names
 (defun feedmail-deduce-address-list (message-buffer header-start header-end addr-regexp address-list)
   "Get address list with all comments and other excitement trimmed.
 Addresses are collected only from headers whose names match the fourth
@@ -2614,8 +2598,8 @@ been weeded out."
        (this-line)
        (this-line-end))
     (unwind-protect
-       (save-excursion
-         (set-buffer (get-buffer-create " *FQM scratch*")) (erase-buffer)
+       (with-current-buffer (get-buffer-create " *FQM scratch*")
+          (erase-buffer)
          (insert-buffer-substring message-buffer header-start header-end)
          (goto-char (point-min))
          (let ((case-fold-search t))
@@ -2678,5 +2662,5 @@ been weeded out."
 
 (provide 'feedmail)
 
-;;; arch-tag: ec27b380-11c0-4dfd-8436-f636cf2bb992
+;; arch-tag: ec27b380-11c0-4dfd-8436-f636cf2bb992
 ;;; feedmail.el ends here