CVS update by viteno packages/xemacs-packages/net-utils,
browse-cltl2.el, feedmail.el, rcompile.el ...
xemacs-cvs at xemacs.org
xemacs-cvs at xemacs.org
Tue Mar 6 09:03:02 EST 2007
User: viteno
Date: 07/03/06 15:03:01
Modified: packages/xemacs-packages/net-utils ChangeLog Makefile
browse-cltl2.el dig.el dns-mode.el dns.el
feedmail.el metamail.el mozmail.el net-utils.el
rcompile.el shadowfile.el xemacsbug.el xml.el
Log:
Bring in changes from Steve Youngs.
Revision Changes Path
1.81 +175 -0 XEmacs/packages/xemacs-packages/net-utils/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/net-utils/ChangeLog,v
retrieving revision 1.80
retrieving revision 1.81
diff -u -p -r1.80 -r1.81
--- ChangeLog 2007/01/17 10:04:29 1.80
+++ ChangeLog 2007/03/06 14:02:59 1.81
@@ -1,3 +1,178 @@
+2007-03-05 Steve Youngs <steve at sxemacs.org>
+
+ Unless otherwise noted, what we have here is a big fat load of
+ whitespace and byte-compiler warning fixes.
+
+ * Makefile (REQUIRES): Update.
+
+ * browse-cltl2.el (*cltl2-use-url*):
+ (*cltl2-fetch-method*):
+ (*cltl2-url*):
+ (*cltl2-local-file-pos*):
+ (*cltl2-index-file-name*):
+ (*cltl2-home*):
+ (*cltl2-vfd-key*):
+ (*cltl2-old-find-file-noselect*): Removed.
+ (*cltl2-vi-key*):
+ (*cltl2-search-regexpr*):
+ (cltl2-fetch-index-by-file):
+ (cltl2-fetch-index-by-www):
+ Various "style" fixes, whitespace, and byte-compiler fixes.
+
+ * dig.el (dig):
+ (dig-run-mode-hooks): New.
+ (dig-mode):
+ Sync with upstream.
+
+ * dns-mode.el (dns-mode):
+ Sync with upstream.
+
+ * dns.el (dns-query-types):
+ (dns-read-type):
+ (dns-read-txt): New.
+ (dns-get-txt-answer): New.
+ (dns-cache): New.
+ (query-dns-cached): New.
+ (query-dns):
+ Sync with upstream
+
+ * feedmail.el (feedmail-confirm-outgoing):
+ (feedmail-confirm-outgoing-timeout):
+ (feedmail-nuke-bcc):
+ (feedmail-nuke-resent-bcc):
+ (feedmail-deduce-bcc-where):
+ (feedmail-fill-to-cc):
+ (feedmail-fill-to-cc-fill-column):
+ (feedmail-nuke-bcc-in-fcc):
+ (feedmail-nuke-body-in-fcc):
+ (feedmail-force-expand-mail-aliases):
+ (feedmail-nuke-empty-headers):
+ (feedmail-sender-line):
+ (feedmail-from-line):
+ (feedmail-force-binary-write): Removed.
+ (feedmail-sendmail-f-doesnt-sell-me-out):
+ (feedmail-deduce-envelope-from):
+ (feedmail-x-mailer-line-user-appendage):
+ (feedmail-x-mailer-line):
+ (feedmail-message-id-generator):
+ (feedmail-message-id-suffix):
+ (feedmail-date-generator):
+ (feedmail-spray-this-address):
+ (feedmail-spray-address-fiddle-plex-list):
+ (feedmail-spray-via-bbdb):
+ (feedmail-enable-queue):
+ (feedmail-queue-directory):
+ (feedmail-queue-draft-directory):
+ (feedmail-ask-before-queue):
+ (feedmail-ask-before-queue-prompt):
+ (feedmail-ask-before-queue-reprompt):
+ (feedmail-ask-before-queue-default):
+ (feedmail-prompt-before-queue-standard-alist):
+ (feedmail-prompt-before-queue-help-supplement):
+ (feedmail-queue-reminder-alist):
+ (feedmail-queue-chatty):
+ (feedmail-queue-chatty-sit-for):
+ (feedmail-queue-run-orderer):
+ (feedmail-queue-use-send-time-for-date):
+ (feedmail-queue-use-send-time-for-message-id):
+ (feedmail-ask-for-queue-slug):
+ (feedmail-queue-slug-maker):
+ (feedmail-queue-slug-suspect-regexp):
+ (feedmail-queue-default-file-slug):
+ (feedmail-queue-fqm-suffix):
+ (feedmail-nuke-buffer-after-queue):
+ (feedmail-queue-auto-file-nuke):
+ (feedmail-debug):
+ (feedmail-debug-sit-for):
+ (feedmail-queue-buffer-file-name):
+ (feedmail-queue-runner-is-active): New.
+ (feedmail-mail-send-hook-splitter):
+ (feedmail-confirm-addresses-hook-example):
+ (feedmail-last-chance-hook):
+ (feedmail-before-fcc-hook):
+ (feedmail-queue-express-hook):
+ (feedmail-queue-runner-mode-setter):
+ (feedmail-queue-alternative-mail-header-separator):
+ (feedmail-queue-runner-message-sender):
+ (feedmail-queue-runner-cleaner-upper):
+ (feedmail-is-a-resend):
+ (feedmail-buffer-eating-function):
+ (feedmail-binmail-linuxish-template):
+ (feedmail-binmail-template):
+ (feedmail-buffer-to-binmail):
+ (feedmail-buffer-to-sendmail):
+ (feedmail-buffer-to-smtpmail):
+ (feedmail-buffer-to-smtp):
+ (feedmail-fiddle-plex-blurb):
+ (feedmail-vm-mail-mode):
+ (feedmail-send-it):
+ (feedmail-queue-express-to-draft):
+ (feedmail-message-action-draft-strong):
+ (feedmail-message-action-queue-strong):
+ (feedmail-message-action-toggle-spray):
+ (feedmail-message-action-help):
+ (feedmail-message-action-help-blat):
+ (feedmail-run-the-queue):
+ (feedmail-queue-reminder):
+ (feedmail-queue-reminder-brief):
+ (feedmail-queue-reminder-medium):
+ (feedmail-queue-send-edit-prompt-inner):
+ (feedmail-scroll-buffer):
+ (feedmail-look-at-queue-directory):
+ (feedmail-tidy-up-slug):
+ (feedmail-queue-subject-slug-maker):
+ (feedmail-create-queue-filename):
+ (feedmail-dump-message-to-queue):
+ (feedmail-rfc822-time-zone):
+ (feedmail-rfc822-date):
+ (feedmail-send-it-immediately-wrapper):
+ (feedmail-send-it-immediately):
+ (feedmail-fiddle-header):
+ (feedmail-give-it-to-buffer-eater):
+ (feedmail-envelope-deducer):
+ (feedmail-fiddle-from):
+ (feedmail-fiddle-sender):
+ (feedmail-default-date-generator):
+ (feedmail-fiddle-date):
+ (feedmail-default-message-id-generator):
+ (feedmail-fiddle-message-id):
+ (feedmail-default-x-mailer-generator):
+ (feedmail-fiddle-x-mailer):
+ (feedmail-fiddle-spray-address):
+ (feedmail-fiddle-list-of-spray-fiddle-plexes):
+ (feedmail-fiddle-list-of-fiddle-plexes):
+ (feedmail-accume-n-nuke-header):
+ (feedmail-fill-to-cc-function):
+ (feedmail-fill-this-one):
+ (mail-utils):
+ (feedmail-one-last-look):
+ (feedmail-say-debug):
+ (feedmail-say-chatter):
+ (feedmail-find-eoh):
+ This is nearly all whitespace fixes, keeping everything under 80
+ columns. Plus various byte-compiler fixes.
+
+ * metamail.el (metamail-region):
+
+ * mozmail.el (mozmail-version): New. Use instead of relying on
+ CVS tags.
+ (mozmail-url-unhex): New. Removes dependence on w3.
+ (mozmail-url-unhex-string): New. Removes dependence on w3
+ (mozmail-compose-gnus): Use `mozmail-url-unhex-string'.
+ (mozmail-populate-headers): Ditto.
+
+ * net-utils.el:
+
+ * rcompile.el:
+
+ * shadowfile.el (shadow-expand-cluster-in-file-name):
+ (shadow-copy-file):
+
+ * xemacsbug.el:
+
+ * xml.el (xml-parse-region):
+ (xml-parse-tag):
+
2007-01-17 Norbert Koch <viteno at xemacs.org>
* Makefile (VERSION): XEmacs package 1.51 released.
1.65 +1 -2 XEmacs/packages/xemacs-packages/net-utils/Makefile
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/net-utils/Makefile,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -p -r1.64 -r1.65
--- Makefile 2007/01/17 10:04:29 1.64
+++ Makefile 2007/03/06 14:02:59 1.65
@@ -22,8 +22,7 @@ AUTHOR_VERSION = N/A
MAINTAINER = Steve Youngs <steve at youngs.au.com>
PACKAGE = net-utils
PKG_TYPE = single-file
-REQUIRES = bbdb w3 efs mail-lib xemacs-base eterm sh-script gnus rmail tm apel \
- vm mh-e mew ecrypto
+REQUIRES = mail-lib gnus bbdb xemacs-base efs
CATEGORY = standard
DONTCOMPILE = _pkg.el auto-autoloads.el custom-load.el
1.5 +56 -150 XEmacs/packages/xemacs-packages/net-utils/browse-cltl2.el
Index: browse-cltl2.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/net-utils/browse-cltl2.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -p -r1.4 -r1.5
--- browse-cltl2.el 2003/12/03 01:35:17 1.4
+++ browse-cltl2.el 2007/03/06 14:02:59 1.5
@@ -116,51 +116,51 @@
;; two arguments in Emacs 19.29.
-(defvar *cltl2-use-url* 'nil
- "Enables or disables retrieval of the index-file via WWW (or more
- exactly by the use of the function url-retrieve from url.el).
- Default is 't.")
+(defvar *cltl2-use-url* t
+ "Enables or disables retrieval of the index-file via WWW.
+Default is t.")
;; needed things
(require 'cl)
(require 'browse-url)
-(autoload 'url-retrieve "url")
-
-(when (not *cltl2-use-url*)
- (require 'url))
;;; ******************************
;;; Some variable and constant definitions
;;; ******************************
-(defvar *cltl2-fetch-method* 'local
- "This sets the method by which the index-file will be fetched. Three
- methods are possible: 'local assumes that all files are local.
- 'local-index-only assumes that just the index-file is locally but
- all other files will be fetched via www. 'www means that the index-file
- will be fetched via WWW, too. Don't change the value of this variable
- after loading.")
+(defvar *cltl2-fetch-method* 'www
+ "This sets the method by which the index-file will be fetched.
+
+Three methods are possible: 'local assumes that all files are
+local. 'local-index-only assumes that just the index-file is
+locally but all other files will be fetched via www. 'www means
+that the index-file will be fetched via WWW, too. Don't change
+the value of this variable after loading.")
(defvar *cltl2-url*
"http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/"
- "The url where the hypertext-version of Common Lisp the Language
- can be found. Note that this assumes to be the top-level of the
- directory structure which should be the same as in the hypertext
- version as provided by the CMU AI Repository. Defaults to
- http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/
- Note the / at the end.")
+ "The url where the HTML of Common Lisp the Language can be found.
+Note that this assumes to be the top-level of the directory structure
+which should be the same as in the hypertext version as provided by
+the CMU AI Repository. Defaults to
+http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/
+Note the / at the end.")
+
(defvar *cltl2-local-file-pos* "/usr/doc/html/cltl/"
- "A directory where the CLtl2 can be found. Note that this assumes
- to be the top-level of the directory structure which should be the
- same as in the hypertext version as provided by the CMU AI Repository.
- Defaults to /usr/doc/html/cltl/ Note the / at the end.")
+ "A directory where the CLtl2 can be found.
+
+Note that this assumes to be the top-level of the directory structure
+which should be the same as in the hypertext version as provided by
+the CMU AI Repository. Defaults to /usr/doc/html/cltl/ Note the / at
+the end.")
(defconst *cltl2-index-file-name* "clm/index.html"
"The name of the index-file, typically with directory on front.
- Defaults to clm/index.html, as this is the momentary position from
- the top-level directory of the CLtL2-home. Defaults to clm/index.html.
- Note that there is no leading /.")
+Defaults to clm/index.html, as this is the momentary position from the
+top-level directory of the CLtL2-home. Defaults to clm/index.html.
+Note that there is no leading /.")
+
(defvar *cltl2-index-home*
(concatenate 'string
(case *cltl2-fetch-method*
@@ -178,148 +178,52 @@
('local-index-only *cltl2-url*)
('www *cltl2-url*))
"clm/")
- "This specifies the home-position of the CLtL2. The value of this variable
- will be concatenated with the name of the nodes of the CLtL2.")
+ "This specifies the home-position of the CLtL2.
+
+The value of this variable will be concatenated with the name of the
+nodes of the CLtL2.")
(defvar *cltl2-index-buffer-name* "*cltl2-index*"
"The name of the buffer which holds the index for CLtL2.")
-(defvar *cltl2-old-find-file-noselect* 'nil
- "Older versions of Emacs (at least XEmacs 19.11) don't support the
- option RAWFILE with the function FIND-FILE-NO-SELECT. Set this variable
- to 't if you have such an old version. It will cause fontification and
- other useless stuff on the buffer in which the index is fetched. If
- you don't use a local copy (of the index) this won't bother you.")
-
(defvar *cltl2-vfd-key*
(if (featurep 'ilisp)
'[(control z) h]
'[(control c) b])
- "Shortcut for accessing cltl2-view-function-definition. Use meaningful
- setting with Ilisp.")
+ "Shortcut for accessing cltl2-view-function-definition.
+Use meaningful setting with Ilisp.")
(defvar *cltl2-vi-key*
(if (featurep 'ilisp)
'[(control z) H]
'[(control c) B])
- "Shortcut for accessing cltl2-view-index. Use meaningful
- setting with Ilisp.")
+ "Shortcut for accessing cltl2-view-index.
+Use meaningful setting with Ilisp.")
+
+(defvar *browse-cltl2-ht* (make-hash-table :size 25))
-(defvar *browse-cltl2-ht* (make-hash-table 0))
(defconst *cltl2-search-regexpr*
"<a href=\"\\(.+\\)\"><code>\\(.+\\)</code></a>"
- "A regular expression how to check for entries in the index-file
- of CLtL2. Note that you have to modify this and the
- prepare-get-entry*-functions if you want to change the search.")
+ "A regexp how to check for entries in the index-file of CLtL2.
+Note that you have to modify this and the prepare-get-entry*-functions
+if you want to change the search.")
+
(defvar *browse-cltl2-history* nil
"History of CLtL2-entries to lookup.")
;;; ******************************
-;;; First of all: Compatibility stuff
-;;; ******************************
-; no match-string in old versions
-(if (not (fboundp (function match-string)))
- (defun match-string (num &optional string)
- "Return string of text matched by last search.
- NUM specifies which parenthesized expression in the last regexp.
- Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
- Zero means the entire text matched by the whole regexp or whole string.
- STRING should be given if the last search was by `string-match' on STRING."
- (if (match-beginning num)
- (if string
- (substring string (match-beginning num) (match-end num))
- (buffer-substring
- (match-beginning num) (match-end num))))))
-
-; no buffer-live-p in old versions
- (if (not (fboundp (function buffer-live-p)))
- (defun buffer-live-p (buf-or-name)
- "Checks if BUF-OR-NAME is a live buffer. Returns non-nil
- if BOF-OR-NAME is an editor buffer which has not been deleted.
- Imitating a built-in function from newer Emacs versions."
- (let ((object (if (bufferp buf-or-name)
- buf-or-name
- (get-buffer buf-or-name))))
- (and (bufferp object) (buffer-name object)))))
-
-; no add-submenu in old versions of XEmacs
-(if (and (string-match "XEmacs\\|Lucid" emacs-version)
- (not (fboundp 'add-submenu)))
- (defun add-submenu (menu-path submenu &optional before)
- "Add a menu to the menubar or one of its submenus.
-If the named menu exists already, it is changed.
-MENU-PATH identifies the menu under which the new menu should be inserted.
- It is a list of strings; for example, (\"File\") names the top-level \"File\"
- menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
- If MENU-PATH is nil, then the menu will be added to the menubar itself.
-SUBMENU is the new menu to add.
- See the documentation of `current-menubar' for the syntax.
-BEFORE, if provided, is the name of a menu before which this menu should
- be added, if this menu is not on its parent already. If the menu is already
- present, it will not be moved."
- (add-menu menu-path (car submenu) (cdr submenu) before)))
-
-; stolen from XEmacs 19.15 syntax.el
-(if (not (fboundp (function symbol-near-point)))
- (defun symbol-near-point ()
- "Return the first textual item to the nearest point."
- (interactive)
- ;alg stolen from etag.el
- (save-excursion
- (if (not (memq (char-syntax (preceding-char)) '(?w ?_)))
- (while (not (looking-at "\\sw\\|\\s_\\|\\'"))
- (forward-char 1)))
- (while (looking-at "\\sw\\|\\s_")
- (forward-char 1))
- (if (re-search-backward "\\sw\\|\\s_" nil t)
- (regexp-quote
- (progn (forward-char 1)
- (buffer-substring (point)
- (progn (forward-sexp -1)
- (while (looking-at "\\s'")
- (forward-char 1))
- (point)))))
- nil))))
-
-; needed for 19.11, I think
-(if (not (fboundp (function url-lazy-message)))
- (defun url-lazy-message (&rest args)
- "Just like `message', but is a no-op if called more than once a second.
-Will not do anything if url-show-status is nil."
- (if (or (null url-show-status)
- (= url-lazy-message-time
- (setq url-lazy-message-time (nth 1 (current-time)))))
- nil
- (apply 'message args))))
-
-; old find-file-noselect has no RAWFILE argument
-(if *cltl2-old-find-file-noselect*
- (unless (boundp 'cltl2-old-find-file-noselect-func)
- (setf (symbol-value 'cltl2-old-find-file-noselect-func)
- (symbol-function 'find-file-noselect))
- (setf (symbol-function 'find-file-noselect)
- (function
- (lambda (file &optional nowarn rawfile)
- (funcall cltl2-old-find-file-noselect-func file nowarn))))))
-
-;;; ******************************
;;; Functions for fetching the index file
;;; ******************************
(defun cltl2-fetch-index ()
"Fetches the index page of the CLtl2 and puts it in its own
buffer called *cltl2-index*."
;; if the index isn't here load it into a buffer
- (when (or (not (get-buffer *cltl2-index-buffer-name*))
- (not (buffer-live-p *cltl2-index-buffer-name*)))
+ (unless (get-buffer *cltl2-index-buffer-name*)
(message "Fetching the CLtL2 index file ...")
- (case *cltl2-fetch-method*
- ('local
- (cltl2-fetch-index-by-file))
- ('local-index-only
- (cltl2-fetch-index-by-file))
- ('www
- (cltl2-fetch-index-by-www))))
+ (if (eq *cltl2-fetch-method* 'www)
+ (cltl2-fetch-index-by-www)
+ (cltl2-fetch-index-by-file)))
(cltl2-prepare-index)
)
@@ -327,20 +231,22 @@ Will not do anything if url-show-status
;; fetch methods
(defun cltl2-fetch-index-by-file ()
"Fetch the index from disk."
- (if (not (file-readable-p *cltl2-index-home*))
- (error "CLtL2 index file not readable: %s." *cltl2-index-home*))
+ (unless (file-readable-p *cltl2-index-home*)
+ (error "CLtL2 index file not readable: %s" *cltl2-index-home*))
(setf *cltl2-index-buffer-name*
- (find-file-noselect *cltl2-index-home* 'nil 't)))
+ (find-file-noselect *cltl2-index-home* nil t)))
+(eval-when-compile
+ (defvar url-working-buffer))
+
+(autoload 'url-retrieve "url")
+
(defun cltl2-fetch-index-by-www ()
"Fetch the index via WWW."
(save-excursion
- (let ((old-url-working-buffer url-working-buffer))
- (setf url-working-buffer *cltl2-index-buffer-name*)
- (url-retrieve *cltl2-index-home*)
- (setf url-working-buffer old-url-working-buffer))))
-
+ (let ((url-working-buffer *cltl2-index-buffer-name*))
+ (url-retrieve *cltl2-index-home*))))
;;; ******************************
;;; Main functions for viewing
1.2 +19 -5 XEmacs/packages/xemacs-packages/net-utils/dig.el
Index: dig.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/net-utils/dig.el,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -r1.1 -r1.2
--- dig.el 2003/05/01 21:32:17 1.1
+++ dig.el 2007/03/06 14:02:59 1.2
@@ -1,6 +1,8 @@
;;; dig.el --- Domain Name System dig interface
-;; Copyright (c) 2000, 2001, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
+
;; Author: Simon Josefsson <simon at josefsson.org>
;; Keywords: DNS BIND dig
@@ -18,8 +20,8 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
@@ -40,7 +42,8 @@
(eval-when-compile (require 'cl))
(defgroup dig nil
- "Dig configuration.")
+ "Dig configuration."
+:group 'comm)
(defcustom dig-program "dig"
"Name of dig (domain information groper) binary."
@@ -135,6 +138,16 @@ Buffer should contain output generated b
(define-key dig-mode-map "q" 'dig-exit))
+;; XEmacs change: The upstream uses `gnus-run-mode-hooks', but that
+;; doesn't exist in the XEmacs package Gnus, so it's defined here as
+;; `dig-run-mode-hooks' and used instead. --SY.
+(defun dig-run-mode-hooks (&rest funcs)
+ "Run `run-mode-hooks' if it is available, otherwise `run-hooks'.
+This function saves the current buffer."
+ (if (fboundp 'run-mode-hooks)
+ (save-current-buffer (apply 'run-mode-hooks funcs))
+ (save-current-buffer (apply 'run-hooks funcs))))
+
(defun dig-mode ()
"Major mode for displaying dig output."
(interactive)
@@ -147,7 +160,8 @@ Buffer should contain output generated b
(set (make-local-variable 'font-lock-defaults)
'(dig-font-lock-keywords t)))
(when (featurep 'font-lock)
- (font-lock-set-defaults)))
+ (font-lock-set-defaults))
+ (dig-run-mode-hooks 'dig-mode-hook))
(defun dig-exit ()
"Quit dig output buffer."
1.2 +5 -5 XEmacs/packages/xemacs-packages/net-utils/dns-mode.el
Index: dns-mode.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/net-utils/dns-mode.el,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -r1.1 -r1.2
--- dns-mode.el 2005/03/13 02:55:40 1.1
+++ dns-mode.el 2007/03/06 14:02:59 1.2
@@ -1,5 +1,5 @@
;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files
-;; Copyright (c) 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
+;; Copyright (c) 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon at josefsson.org>
;; Keywords: DNS master zone file SOA
@@ -18,8 +18,8 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
@@ -48,7 +48,8 @@
;;; Code:
(defgroup dns-mode nil
- "DNS master file mode configuration.")
+ "DNS master file mode configuration."
+:group 'comm)
(defconst dns-mode-classes '("IN" "CS" "CH" "HS")
"List of strings with known DNS classes.")
@@ -194,5 +195,4 @@ Turning on DNS mode runs `dns-mode-hook'
(provide 'dns-mode)
-;; arch-tag: 6a179f0a-072f-49db-8b01-37b8f23998c0
;;; dns-mode.el ends here
1.5 +67 -8 XEmacs/packages/xemacs-packages/net-utils/dns.el
Index: dns.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/net-utils/dns.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -p -r1.4 -r1.5
--- dns.el 2004/03/18 23:04:57 1.4
+++ dns.el 2007/03/06 14:02:59 1.5
@@ -1,6 +1,7 @@
;;; dns.el --- Domain Name Service lookups
-;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+
;; Author: Lars Magne Ingebrigtsen <larsi at gnus.org>
;; Keywords: network
@@ -18,8 +19,8 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
@@ -27,6 +28,9 @@
(eval-when-compile (require 'cl))
+(eval-when-compile
+ (defvar default-enable-multibyte-characters))
+
(require 'mm-util)
(defvar dns-timeout 5
@@ -56,6 +60,7 @@ If nil, /etc/resolv.conf will be consult
(MX 15)
(TXT 16)
(AAAA 28) ; RFC3596
+ (SRV 33) ; RFC2782
(AXFR 252)
(MAILB 253)
(MAILA 254)
@@ -185,6 +190,11 @@ If TCP-P, the first two bytes of the pac
(dns-write-bytes (buffer-size) 2))
(buffer-string)))
+(eval-when-compile
+ (defvar answers)
+ (defvar authorities)
+ (defvar additionals))
+
(defun dns-read (packet)
(mm-with-unibyte-buffer
(let ((spec nil)
@@ -284,6 +294,11 @@ If TCP-P, the first two bytes of the pac
(list 'retry (dns-read-int32))
(list 'expire (dns-read-int32))
(list 'minimum (dns-read-int32))))
+ ((eq type 'SRV)
+ (list (list 'priority (dns-read-bytes 2))
+ (list 'weight (dns-read-bytes 2))
+ (list 'port (dns-read-bytes 2))
+ (list 'target (dns-read-name buffer))))
((eq type 'MX)
(cons (dns-read-bytes 2) (dns-read-name buffer)))
((or (eq type 'CNAME) (eq type 'NS) (eq type 'PTR))
@@ -300,6 +315,25 @@ If TCP-P, the first two bytes of the pac
(push (match-string 1) dns-servers))
(setq dns-servers (nreverse dns-servers)))))
+(defun dns-read-txt (string)
+ (if (> (length string) 1)
+ (substring string 1)
+ string))
+
+(defun dns-get-txt-answer (answers)
+ (let ((result "")
+ (do-next nil))
+ (dolist (answer answers)
+ (dolist (elem answer)
+ (when (consp elem)
+ (cond
+ ((eq (car elem) 'type)
+ (setq do-next (eq (cadr elem) 'TXT)))
+ ((eq (car elem) 'data)
+ (when do-next
+ (setq result (concat result (dns-read-txt (cadr elem))))))))))
+ result))
+
;;; Interface functions.
(defmacro dns-make-network-process (server)
(if (featurep 'xemacs)
@@ -322,14 +356,33 @@ If TCP-P, the first two bytes of the pac
;; `make-network-process', so we fall back on opening a TCP
;; connection to the DNS server.
(open-network-stream "dns" (current-buffer) server "domain")))))
+
+(defvar dns-cache (make-vector 4096 0))
-(defun query-dns (name &optional type fullp)
+(defun query-dns-cached (name &optional type fullp reversep)
+ (let* ((key (format "%s:%s:%s:%s" name type fullp reversep))
+ (sym (intern-soft key dns-cache)))
+ (if (and sym
+ (boundp sym))
+ (symbol-value sym)
+ (let ((result (query-dns name type fullp reversep)))
+ (set (intern key dns-cache) result)
+ result))))
+
+(defun query-dns (name &optional type fullp reversep)
"Query a DNS server for NAME of TYPE.
-If FULLP, return the entire record returned."
+If FULLP, return the entire record returned.
+If REVERSEP, look up an IP address."
(setq type (or type 'A))
(unless dns-servers
(dns-parse-resolv-conf))
+ (when reversep
+ (setq name (concat
+ (mapconcat 'identity (nreverse (split-string name "\\.")) ".")
+ ".in-addr.arpa")
+ type 'PTR))
+
(if (not dns-servers)
(message "No DNS server configuration found")
(mm-with-unibyte-buffer
@@ -354,20 +407,26 @@ If FULLP, return the entire record retur
tcp-p))
(while (and (zerop (buffer-size))
(> times 0))
+ (sit-for (/ step 1000.0))
(accept-process-output process 0 step)
(decf times step))
(ignore-errors
(delete-process process))
- (when tcp-p
+ (when (and tcp-p
+ (>= (buffer-size) 2))
(goto-char (point-min))
(delete-region (point) (+ (point) 2)))
- (unless (zerop (buffer-size))
+ (when (and (>= (buffer-size) 2)
+ ;; We had a time-out.
+ (> times 0))
(let ((result (dns-read (buffer-string))))
(if fullp
result
(let ((answer (car (dns-get 'answers result))))
(when (eq type (dns-get 'type answer))
- (dns-get 'data answer)))))))))))
+ (if (eq type 'TXT)
+ (dns-get-txt-answer (dns-get 'answers result))
+ (dns-get 'data answer))))))))))))
(provide 'dns)
1.7 +1322 -1161XEmacs/packages/xemacs-packages/net-utils/feedmail.el
Index: feedmail.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/net-utils/feedmail.el,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -p -r1.6 -r1.7
--- feedmail.el 2003/12/03 01:35:17 1.6
+++ feedmail.el 2007/03/06 14:02:59 1.7
@@ -366,6 +366,9 @@
(eval-when-compile (require 'smtpmail))
+(eval-when-compile
+ (defvar smtp-server))
+
;; 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:
@@ -408,8 +411,8 @@
This is done after the message is completely prepped, and you'll be
looking at the top of the message in a buffer when you get the prompt.
If set to the symbol 'queued, give the confirmation prompt only while
-running the queue (however, the prompt is always suppressed if you are
-processing the queue via feedmail-run-the-queue-no-prompts). If set
+running the queue \(however, the prompt is always suppressed if you are
+processing the queue via feedmail-run-the-queue-no-prompts\). If set
to the symbol 'immediate, give the confirmation prompt only when
sending immediately. For any other non-nil value, prompt in both
cases. You can give a timeout for the prompt; see variable
@@ -441,30 +444,30 @@ shuttled robotically onward."
If a positive number, it's a timeout before sending. If a negative
number, it's a timeout before not sending. This will not work if your
version of emacs doesn't include the function y-or-n-p-with-timeout
-(e.g., some versions of XEmacs)."
+\(e.g., some versions of XEmacs\)."
:group 'feedmail-misc
:type '(choice (const nil) integer)
-)
+ )
(defcustom feedmail-nuke-bcc t
"*If non-nil remove BCC: lines from the message headers.
In any case, the BCC: lines do participate in the composed address
list. You may want to leave them in if you're using sendmail
-(see feedmail-buffer-eating-function)."
+see `feedmail-buffer-eating-function'."
:group 'feedmail-headers
:type 'boolean
-)
+ )
(defcustom feedmail-nuke-resent-bcc t
"*If non-nil remove RESENT-BCC: lines from the message headers.
In any case, the RESENT-BCC: lines do participate in the composed
address list. You may want to leave them in if you're using sendmail
-(see feedmail-buffer-eating-function)."
+see `feedmail-buffer-eating-function'."
:group 'feedmail-headers
:type 'boolean
-)
+ )
(defcustom feedmail-deduce-bcc-where nil
@@ -472,7 +475,7 @@ address list. You may want to leave the
Addresses for the message envelope are deduced by examining
appropriate address headers in the message. Generally, they will show
up in the list of deduced addresses in the order that the headers
-happen to appear (duplicate addresses are eliminated in any case).
+happen to appear \(duplicate addresses are eliminated in any case\).
This variable can be set to the symbol 'first, in which case the
BCC:/RESENT-BCC: addresses will appear at the beginning in the list;
or, it can be set to the symbol 'last, in which case they will appear
@@ -490,7 +493,7 @@ is an option for either 'first or 'last
delivery agent that processes the addresses backwards."
:group 'feedmail-headers
:type 'boolean
-)
+ )
(defcustom feedmail-fill-to-cc t
@@ -498,40 +501,40 @@ delivery agent that processes the addres
Smart filling means breaking long lines at appropriate points and
making continuation lines. Despite the function name, it includes
TO:, CC:, BCC: (and their RESENT-* forms), as well as FROM: and
-REPLY-TO: (though they seldom need it). If nil, the lines are left
+REPLY-TO: \(though they seldom need it\). If nil, the lines are left
as-is. The filling is done after mail address alias expansion."
:group 'feedmail-headers
:type 'boolean
-)
+ )
(defcustom feedmail-fill-to-cc-fill-column default-fill-column
"*Fill column used by feedmail-fill-to-cc."
:group 'feedmail-headers
:type 'integer
-)
+ )
(defcustom feedmail-nuke-bcc-in-fcc nil
"*If non-nil remove [RESENT-]BCC: lines in message copies saved via FCC:.
This is independent of whether the BCC: header lines are actually sent
-with the message (see feedmail-nuke-bcc). Though not implied in the name,
+with the message \(see feedmail-nuke-bcc\). Though not implied in the name,
the same FCC: treatment applies to both BCC: and RESENT-BCC: lines."
:group 'feedmail-headers
:type 'boolean
-)
+ )
(defcustom feedmail-nuke-body-in-fcc nil
"*If non-nil remove body of message in copies saved via FCC:.
-If an positive integer value, leave (up to) that many lines of the
+If an positive integer value, leave \(up to\) that many lines of the
beginning of the body intact. The result is that the FCC: copy will
consist only of the message headers, serving as a sort of an outgoing
message log."
:group 'feedmail-headers
:type '(choice (const nil) (const t) integer)
;; :type 'boolean
-)
+ )
(defcustom feedmail-force-expand-mail-aliases nil
@@ -543,7 +546,7 @@ the issue since there are configurations
out."
:group 'feedmail-headers
:type 'boolean
-)
+ )
(defcustom feedmail-nuke-empty-headers t
@@ -555,7 +558,7 @@ something rather than their contents. T
but common in some proprietary systems."
:group 'feedmail-headers
:type 'boolean
-)
+ )
;; 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
@@ -573,8 +576,8 @@ NB: it makes no sense to use the value t
default for SENDER:.
If not nil, it may be a string, a fiddle-plex, or a function which
-returns either nil, t, a string, or a fiddle-plex (or, in fact,
-another function, but let's not be ridiculous). If a string, it
+returns either nil, t, a string, or a fiddle-plex \(or, in fact,
+another function, but let's not be ridiculous\). If a string, it
should be just the contents of the header, not the name of the header
itself nor the trailing newline. If a function, it will be called
with no arguments. For an explanation of fiddle-plexes, see the
@@ -584,37 +587,23 @@ by feedmail to either \"X-Sender\" or \"
You can probably leave this nil, but if you feel like using it, a good
value would be a string of a fully-qualified domain name form of your
-address. For example, \"bill at bubblegum.net (WJCarpenter)\". The SENDER:
+address. For example, \"bill at bubblegum.net \(WJCarpenter\)\". The SENDER:
header is fiddled after the FROM: header is fiddled."
:group 'feedmail-headers
:type '(choice (const nil) string)
-)
-
-
-(defcustom feedmail-force-binary-write t
- "*If non-nil, force writing file as binary. 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."
-:group 'feedmail-misc
-:type 'boolean
-)
-
+ )
(defcustom feedmail-from-line t
"*If non-nil and the email has no FROM: header, use this value.
-May be t, in which case a default is computed (and you probably won't
-be happy with it). May be nil, in which case nothing in particular is
+May be t, in which case a default is computed \(and you probably won't
+be happy with it\). May be nil, in which case nothing in particular is
done with respect to FROM: lines. By design, will not replace an
existing FROM: line, but you can achieve that with a fiddle-plex 'replace
action.
If neither nil nor t, it may be a string, a fiddle-plex, or a function
-which returns either nil, t, a string, or a fiddle-plex (or, in fact,
-another function, but let's not be ridiculous). If a string, it
+which returns either nil, t, a string, or a fiddle-plex \(or, in fact,
+another function, but let's not be ridiculous\). If a string, it
should be just the contents of the header, not the name of the header
itself nor the trailing newline. If a function, it will be called
with no arguments. For an explanation of fiddle-plexes, see the
@@ -623,7 +612,7 @@ cases the name element of the fiddle-ple
by feedmail to either \"X-From\" or \"X-Resent-From\".
A good value would be a string fully-qualified domain name form of
-your address. For example, \"bill at bubblegum.net (WJCarpenter)\". The
+your address. For example, \"bill at bubblegum.net \(WJCarpenter\)\". The
default value of this variable uses the standard elisp variable
user-mail-address which should be set on every system but has a decent
chance of being wrong. It also honors mail-from-style. Better to set
@@ -631,7 +620,7 @@ this variable explicitly to the string y
to arrange for the message to get a FROM: line."
:group 'feedmail-headers
:type '(choice (const nil) string)
-)
+ )
(defcustom feedmail-sendmail-f-doesnt-sell-me-out nil
@@ -653,7 +642,7 @@ feedmail thinks with this variable. The
will believe that sendmail will sell you out."
:group 'feedmail-headers
:type 'boolean
-)
+ )
(defcustom feedmail-deduce-envelope-from t
@@ -668,9 +657,9 @@ feedmail-from-line and/or feedmail-sende
There are many and good reasons for having the message header
FROM:/SENDER: be different from the message envelope \"from\"
information. However, for most people and for most circumstances, it
-is usual for them to be the same (this is probably especially true for
+is usual for them to be the same \(this is probably especially true for
the case where the user doesn't understand the difference between the
-two in the first place).
+two in the first place\).
The idea behind this feature is that you can have everything set up
some normal way for yourself. If for some reason you want to send a
@@ -678,18 +667,18 @@ message with another FROM: line, you can
the message, and feedmail will take care of \"fixing up\" the envelope
\"from\". This only works for mail senders which make use of
user-mail-address as the envelope \"from\" value. For some mail
-senders (e.g., feedmail-buffer-to-bin-mail), there is no simple way to
+senders \(e.g., feedmail-buffer-to-bin-mail\), there is no simple way to
influence what they will use as the envelope."
:group 'feedmail-headers
:type 'boolean
-)
+ )
(defcustom feedmail-x-mailer-line-user-appendage nil
"*See feedmail-x-mailer-line."
:group 'feedmail-headers
:type '(choice (const nil) string)
-)
+ )
(defcustom feedmail-x-mailer-line t
@@ -709,8 +698,8 @@ as that blob string. A value of t is eq
feedmail-default-x-mailer-generator.
If neither nil nor t, it may be a string, a fiddle-plex, or a function
-which returns either nil, t, a string, or a fiddle-plex (or, in fact,
-another function, but let's not be ridiculous). If a string, it
+which returns either nil, t, a string, or a fiddle-plex \(or, in fact,
+another function, but let's not be ridiculous\). If a string, it
should be just the contents of the header, not the name of the header
itself nor the trailing newline. If a function, it will be called
with no arguments. For an explanation of fiddle-plexes, see the
@@ -719,7 +708,7 @@ cases the name element of the fiddle-ple
by feedmail to either \"X-Mailer\" or \"X-Resent-Mailer\"."
:group 'feedmail-headers
:type '(choice (const t) (const nil) string function)
-)
+ )
(defcustom feedmail-message-id-generator t
@@ -732,8 +721,8 @@ only if there is not already a MESSAGE-I
t is equivalent to using the function feedmail-default-message-id-generator.
If neither nil nor t, it may be a string, a fiddle-plex, or a function
-which returns either nil, t, a string, or a fiddle-plex (or, in fact,
-another function, but let's not be ridiculous). If a string, it
+which returns either nil, t, a string, or a fiddle-plex \(or, in fact,
+another function, but let's not be ridiculous\). If a string, it
should be just the contents of the header, not the name of the header
itself nor the trailing newline. If a function, it will be called
with one argument: the possibly-nil name of the file associated with
@@ -743,26 +732,28 @@ cases the name element of the fiddle-ple
by feedmail to either \"Message-ID\" or \"Resent-Message-ID\".
You should let feedmail generate a MESSAGE-ID: for you unless you are sure
-that whatever you give your messages to will do it for you (e.g., most
-configurations of sendmail). Even if the latter case is true, it
+that whatever you give your messages to will do it for you \(e.g., most
+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)
-)
+ )
(defcustom feedmail-message-id-suffix nil
"*If non-nil, used as a suffix in generated MESSAGE-ID: headers for uniqueness.
-The function feedmail-default-message-id-generator creates its work based
-on a formatted date-time string, a random number, and a domain-looking suffix.
-You can control the suffix used by assigning a string value to this variable. If
-you don't supply one, the value of the variable user-mail-address will be used.
-If the value of feedmail-message-id-suffix contains an \"@\" character, the string
-will be used verbatim, else an \"@\" character will be prepended automatically."
+The function feedmail-default-message-id-generator creates its work
+based on a formatted date-time string, a random number, and a
+domain-looking suffix. You can control the suffix used by assigning a
+string value to this variable. If you don't supply one, the value of
+the variable user-mail-address will be used. If the value of
+feedmail-message-id-suffix contains an \"@\" character, the string
+will be used verbatim, else an \"@\" character will be prepended
+automatically."
:group 'feedmail-headers
:type 'string
-)
+ )
;; this was suggested in various forms by several people; first was
;; Tony DeSimone in Oct 1992; sorry to be so tardy
@@ -776,8 +767,8 @@ if there is not already a DATE: in the m
equivalent to using the function feedmail-default-date-generator.
If neither nil nor t, it may be a string, a fiddle-plex, or a function
-which returns either nil, t, a string, or a fiddle-plex (or, in fact,
-another function, but let's not be ridiculous). If a string, it
+which returns either nil, t, a string, or a fiddle-plex \(or, in fact,
+another function, but let's not be ridiculous\). If a string, it
should be just the contents of the header, not the name of the header
itself nor the trailing newline. If a function, it will be called
with one argument: the possibly-nil name of the file associated with
@@ -791,13 +782,13 @@ what you're doing. Study the relevant p
Don't make me come up there!
You should let feedmail generate a DATE: for you unless you are sure
-that whatever you give your messages to will do it for you (e.g., most
-configurations of sendmail). Even if the latter case is true, it
+that whatever you give your messages to will do it for you \(e.g., most
+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)
-)
+ )
(defcustom feedmail-fiddle-headers-upwardly t
@@ -855,15 +846,17 @@ as well."
)
(defvar feedmail-spray-this-address nil
- "Do not set or change this variable, except as provided via feedmail-spray-address-fiddle-plex-list.")
+ "Do not set or change this variable.
+Except as provided via feedmail-spray-address-fiddle-plex-list.")
(defcustom feedmail-spray-address-fiddle-plex-list nil
"User-supplied specification for a crude form of mailmerge capability.
-When spraying is enabled, feedmail composes a list of envelope addresses.
-In turn, feedmail-spray-this-address is temporarily set to each address
-\(stripped of any comments and angle brackets\) and a function is called which
-fiddles message headers according to this variable. For an overview of
-fiddle-plex data structures, see the documentation for feedmail-fiddle-plex-blurb.
+When spraying is enabled, feedmail composes a list of envelope
+addresses. In turn, feedmail-spray-this-address is temporarily set
+to each address \(stripped of any comments and angle brackets\) and
+a function is called which fiddles message headers according to
+this variable. For an overview of fiddle-plex data structures, see
+the documentation for feedmail-fiddle-plex-blurb.
May be nil, in which case nothing in particular is done about message
headers for specific addresses.
@@ -885,27 +878,28 @@ string naming a message header like \"TO
fiddle-plex. For an example, see feedmail-spray-via-bbdb.
May be a list of any combination of the foregoing and/or
-fiddle-plexes. (A value for this variable which consists of a single
-fiddle-plex must be nested inside another list to avoid ambiguity.)
+fiddle-plexes. \(A value for this variable which consists of a single
+fiddle-plex must be nested inside another list to avoid ambiguity.\)
If a list, each item is acted on in turn as described above.
For example,
- (setq feedmail-spray-address-fiddle-plex-list 'feedmail-spray-via-bbdb)
+ \(setq feedmail-spray-address-fiddle-plex-list 'feedmail-spray-via-bbdb\)
The idea of the example is that, during spray mode, as each message is
about to be transmitted to an individual address, the function will be
called and will consult feedmail-spray-this-address to find the
-stripped envelope email address (no comments or angle brackets). The
+stripped envelope email address \(no comments or angle brackets\). The
function should return an embellished form of the address.
-The recipe for sending form letters is: (1) create a message with all
-addressees on BCC: headers; (2) tell feedmail to remove BCC: headers
-before sending the message; (3) create a function which will embellish
-stripped addresses, if desired; (4) define feedmail-spray-address-fiddle-plex-list
-appropriately; (5) send the message with feedmail-enable-spray set
-non-nil; (6) stand back and watch co-workers wonder at how efficient
-you are at accomplishing inherently inefficient things."
+The recipe for sending form letters is: \(1\) create a message with
+all addressees on BCC: headers; \(2\) tell feedmail to remove BCC:
+headers before sending the message; \(3\) create a function which will
+embellish stripped addresses, if desired; \(4\) define
+feedmail-spray-address-fiddle-plex-list appropriately; \(5\) send the
+message with feedmail-enable-spray set non-nil; \(6\) stand back and
+watch co-workers wonder at how efficient you are at accomplishing
+inherently inefficient things."
:group 'feedmail-spray
:type 'list
)
@@ -918,15 +912,15 @@ you are at accomplishing inherently inef
NB: it's up to the user to have the BBDB environment already set up properly
before using this."
(let (net-rec q-net-addy embellish)
- (setq q-net-addy (concat "^" (regexp-quote feedmail-spray-this-address) "$"))
- (setq net-rec (bbdb-search (bbdb-records) nil nil q-net-addy))
- (if (and (car net-rec) (not (cdr net-rec)))
- (setq net-rec (car net-rec))
- (setq net-rec nil))
- (if net-rec (setq embellish (bbdb-dwim-net-address net-rec)))
- (if embellish
- (list "To" embellish 'supplement)
- (list "To" feedmail-spray-this-address 'supplement))))
+ (setq q-net-addy (concat "^" (regexp-quote feedmail-spray-this-address) "$"))
+ (setq net-rec (bbdb-search (bbdb-records) nil nil q-net-addy))
+ (if (and (car net-rec) (not (cdr net-rec)))
+ (setq net-rec (car net-rec))
+ (setq net-rec nil))
+ (if net-rec (setq embellish (bbdb-dwim-net-address net-rec)))
+ (if embellish
+ (list "To" embellish 'supplement)
+ (list "To" feedmail-spray-this-address 'supplement))))
(defcustom feedmail-enable-queue nil
@@ -942,8 +936,8 @@ you from accidentally sending incomplete
disk-based and intended for later transmission. The messages are
queued in their raw state as they appear in the mail-mode buffer and
can be arbitrarily edited later, 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
+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. You can move a message from the draft to the main queue or vice
versa by pretending to send it and then selecting whichever queue
@@ -953,7 +947,7 @@ To transmit all the messages in the queu
feedmail-run-the-queue or feedmail-run-the-queue-no-prompts."
:group 'feedmail-queue
:type 'boolean
-)
+ )
(defcustom feedmail-queue-runner-confirm-global nil
@@ -973,25 +967,25 @@ without having to answer no to the indiv
(defcustom feedmail-queue-directory
(if (memq system-type '(axp-vms vax-vms))
(expand-file-name (concat (getenv "HOME") "[.MAIL.Q]"))
- (expand-file-name "~/mail/q"))
+ (expand-file-name "~/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 \"~/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]"))
- (expand-file-name "~/mail/draft"))
+ (expand-file-name "~/mail/draft"))
"*Name of an 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 \"~/mail/draft\"."
:group 'feedmail-queue
:type 'string
-)
+ )
(defcustom feedmail-ask-before-queue t
@@ -1003,25 +997,27 @@ queuing is enabled. If nil, the message
without a prompt."
:group 'feedmail-queue
:type 'boolean
-)
+ )
-(defcustom feedmail-ask-before-queue-prompt "FQM: Message action (q, i, d, e, ?)? [%s]: "
+(defcustom feedmail-ask-before-queue-prompt
+ "FQM: Message action (q, i, d, e, ?)? [%s]: "
"*A string which will be used for the message action prompt.
If it contains a \"%s\", that will be replaced with the value of
feedmail-ask-before-queue-default."
:group 'feedmail-queue
:type 'string
-)
+ )
-(defcustom feedmail-ask-before-queue-reprompt "FQM: Please type q, i, d, or e; or ? for help [%s]: "
+(defcustom feedmail-ask-before-queue-reprompt
+ "FQM: Please type q, i, d, or e; or ? for help [%s]: "
"*A string which will be used for repompting after invalid input.
If it contains a \"%s\", that will be replaced with the value of
feedmail-ask-before-queue-default."
:group 'feedmail-queue
:type 'string
-)
+ )
(defcustom feedmail-ask-before-queue-default "queue"
@@ -1030,41 +1026,41 @@ Should be a character or a string; if a
character is significant. Useful values are those described in
the help for the message action prompt."
:group 'feedmail-queue
-:type '(choice string integer) ;use integer to get char
-)
+:type '(choice string integer) ;use integer to get char
+ )
(defvar feedmail-prompt-before-queue-standard-alist
'((?q . feedmail-message-action-queue)
- (?Q . feedmail-message-action-queue-strong)
+ (?Q . feedmail-message-action-queue-strong)
- (?d . feedmail-message-action-draft)
- (?r . feedmail-message-action-draft)
- (?D . feedmail-message-action-draft-strong)
- (?R . feedmail-message-action-draft-strong)
-
- (?e . feedmail-message-action-edit)
- (?E . feedmail-message-action-edit)
- (?\C-g . feedmail-message-action-edit)
- (?n . feedmail-message-action-edit)
- (?N . feedmail-message-action-edit)
-
- (?i . feedmail-message-action-send)
- (?I . feedmail-message-action-send-strong)
- (?s . feedmail-message-action-send)
- (?S . feedmail-message-action-send-strong)
-
- (?* . feedmail-message-action-toggle-spray)
-
- (?> . feedmail-message-action-scroll-up)
- (?< . feedmail-message-action-scroll-down)
- (? . feedmail-message-action-scroll-up)
+ (?d . feedmail-message-action-draft)
+ (?r . feedmail-message-action-draft)
+ (?D . feedmail-message-action-draft-strong)
+ (?R . feedmail-message-action-draft-strong)
+
+ (?e . feedmail-message-action-edit)
+ (?E . feedmail-message-action-edit)
+ (?\C-g . feedmail-message-action-edit)
+ (?n . feedmail-message-action-edit)
+ (?N . feedmail-message-action-edit)
+
+ (?i . feedmail-message-action-send)
+ (?I . feedmail-message-action-send-strong)
+ (?s . feedmail-message-action-send)
+ (?S . feedmail-message-action-send-strong)
+
+ (?* . feedmail-message-action-toggle-spray)
+
+ (?> . feedmail-message-action-scroll-up)
+ (?< . feedmail-message-action-scroll-down)
+ (? . feedmail-message-action-scroll-up)
;; (?\C-v . feedmail-message-action-help)
- (?? . feedmail-message-action-help))
+ (?? . feedmail-message-action-help))
"An alist of choices for the message action prompt.
All of the values are function names, except help, which is a special
-symbol that calls up help for the prompt (the help describes the
-actions from the standard alist). To customize your own choices,
+symbol that calls up help for the prompt \(the help describes the
+actions from the standard alist\). To customize your own choices,
define a similar alist called feedmail-prompt-before-queue-user-alist.
The actual alist used for message action will be the standard alist
overlaid with the user-alist. To neutralize an item in the standard
@@ -1083,8 +1079,8 @@ in the user alist with a value of nil."
"User-provided supplementary help string for the message action prompt.
When the message action prompt is shown, the user can as for verbose help,
at which point a buffer pops up describing the meaning of possible
-responses to the prompt. Through various customizations (see, for
-example, feedmail-prompt-before-queue-user-alist), the available responses
+responses to the prompt. Through various customizations \(see, for
+example, `feedmail-prompt-before-queue-user-alist'\), the available responses
and the prompt itself can be changed. If this variable is set to a string
value, that string is written to the help buffer after the standard info.
It may contain embedded line breaks. It will be printed via princ."
@@ -1095,11 +1091,11 @@ It may contain embedded line breaks. It
(defcustom feedmail-queue-reminder-alist
'((after-immediate . feedmail-queue-reminder-brief)
- (after-queue . feedmail-queue-reminder-medium)
- (after-draft . feedmail-queue-reminder-medium)
- (after-run . feedmail-queue-reminder-brief)
- (on-demand . feedmail-run-the-queue-global-prompt))
- "See feedmail-queue-reminder."
+ (after-queue . feedmail-queue-reminder-medium)
+ (after-draft . feedmail-queue-reminder-medium)
+ (after-run . feedmail-queue-reminder-brief)
+ (on-demand . feedmail-run-the-queue-global-prompt))
+ "See `feedmail-queue-reminder'."
:group 'feedmail-queue
:type 'alist
)
@@ -1113,7 +1109,7 @@ That's not affected by this variable set
reporting of error/abnormal conditions."
:group 'feedmail-queue
:type 'boolean
-)
+ )
(defcustom feedmail-queue-chatty-sit-for 2
@@ -1123,7 +1119,7 @@ something else obliterates them. This v
the pause."
:group 'feedmail-queue
:type 'integer
-)
+ )
(defcustom feedmail-queue-run-orderer nil
@@ -1137,7 +1133,7 @@ order by queued file name, which will ty
they were placed in the queue."
:group 'feedmail-queue
:type '(choice (const nil) function)
-)
+ )
(defcustom feedmail-queue-use-send-time-for-date nil
@@ -1149,10 +1145,10 @@ message DATE: header; if there is no que
used. If you are using VM, it might be supplying this header for
you. To suppress VM's version
- (setq vm-mail-header-insert-date nil)"
+ \(setq vm-mail-header-insert-date nil\)"
:group 'feedmail-queue
:type 'boolean
-)
+ )
(defcustom feedmail-queue-use-send-time-for-message-id nil
@@ -1164,10 +1160,10 @@ message MESSAGE-ID: header; if there is
used. If you are using VM, it might be supplying this header for
you. To suppress VM's version
- (setq vm-mail-header-insert-message-id nil)"
+ \(setq vm-mail-header-insert-message-id nil\)"
:group 'feedmail-queue
:type 'boolean
-)
+ )
(defcustom feedmail-ask-for-queue-slug nil
@@ -1184,7 +1180,7 @@ with this prompting since feedmail, by d
based on the subjects of the messages."
:group 'feedmail-queue
:type 'boolean
-)
+ )
(defcustom feedmail-queue-slug-maker 'feedmail-queue-subject-slug-maker
@@ -1197,7 +1193,7 @@ default function creates the slug based
any."
:group 'feedmail-queue
:type '(choice (const nil) function)
-)
+ )
(defcustom feedmail-queue-slug-suspect-regexp "[^a-z0-9-]+"
@@ -1212,7 +1208,7 @@ no longer matches to transformed string.
feedmail-tidy-up-slug and indirectly by feedmail-queue-subject-slug-maker."
:group 'feedmail-queue
:type 'string
-)
+ )
(defcustom feedmail-queue-default-file-slug t
@@ -1227,7 +1223,7 @@ If t, an innocuous default is used.
If a string, it is used directly.
If a function, it is called with no arguments from the buffer containing the raw
-text of the message. It must return a string (which may be empty).
+text of the message. It must return a string \(which may be empty\).
If the symbol 'ask, you will be prompted for a string in the mini-buffer.
Filename completion is available so that you can inspect what's already been
@@ -1235,7 +1231,7 @@ used, but feedmail will do further manip
it's not expected to be a complete filename."
:group 'feedmail-queue
:type 'string
-)
+ )
(defcustom feedmail-queue-fqm-suffix ".fqm"
@@ -1247,7 +1243,7 @@ feedmail-queue-draft-directory. By the w
queued message."
:group 'feedmail-queue
:type 'string
-)
+ )
(defcustom feedmail-nuke-buffer-after-queue nil
@@ -1260,19 +1256,19 @@ nil, since VM has its own options for ma
message buffers."
:group 'feedmail-queue
:type 'boolean
-)
+ )
(defcustom feedmail-queue-auto-file-nuke nil
"*If non-nil, automatically delete queue files when a message is sent.
Normally, feedmail will notice such files when you send a message in
-immediate mode (i.e., not when you're running the queue) and will ask if
+immediate mode \(i.e., not when you're running the queue\) and will ask if
you want to delete them. Since the answer is usually yes, setting this
variable to non-nil will tell feedmail to skip the prompt and just delete
the file without bothering you."
:group 'feedmail-queue
:type 'boolean
-)
+ )
(defcustom feedmail-debug nil
@@ -1281,7 +1277,7 @@ This is intended as an aid to tracing wh
of casual real use only to the feedmail developer."
:group 'feedmail-debug
:type 'boolean
-)
+ )
(defcustom feedmail-debug-sit-for 0
@@ -1293,7 +1289,7 @@ has the effect of not pausing at all. D
the fact in the messages buffer."
:group 'feedmail-debug
:type 'integer
-)
+ )
(defvar feedmail-queue-buffer-file-name nil
@@ -1319,13 +1315,14 @@ feedmail-queue-buffer-file-name is resto
Example 'defadvice' for mail-send:
- (defadvice mail-send (before feedmail-mail-send-before-advice activate)
- (setq feedmail-queue-buffer-file-name buffer-file-name)
- (setq buffer-file-name nil))
+ \(defadvice mail-send \(before feedmail-mail-send-before-advice activate\)
+ \(setq feedmail-queue-buffer-file-name buffer-file-name\)
+ \(setq buffer-file-name nil\)\)
- (defadvice mail-send (after feedmail-mail-send-after-advice activate)
- (if feedmail-queue-buffer-file-name (setq buffer-file-name feedmail-queue-buffer-file-name))
- (setq feedmail-queue-buffer-file-name nil))
+ \(defadvice mail-send \(after feedmail-mail-send-after-advice activate\)
+ \(if feedmail-queue-buffer-file-name
+ \(setq buffer-file-name feedmail-queue-buffer-file-name\)\)
+ \(setq feedmail-queue-buffer-file-name nil\)\)
")
;; defvars to make byte-compiler happy(er)
@@ -1335,26 +1332,36 @@ Example 'defadvice' for mail-send:
(defvar feedmail-address-list nil "not a user option variable")
+
+(defvar feedmail-queue-runner-is-active nil
+ "*Non-nil means we're inside the logic of the queue-running loop.
+That is, iterating over all messages in the queue to send them. In
+that case, the value is the name of the queued message file currently
+being processed. This can be used for differentiating customized code
+for different scenarios. Users shouldn't set or change this
+variable, but may depend on its value as described here.")
+
(defun feedmail-mail-send-hook-splitter ()
"Facilitate dividing mail-send-hook things into queued and immediate cases.
If you have mail-send-hook functions that should only be called for sending/
queueing messages or only be called for the sending of queued messages, this is
for you. Add this function to mail-send-hook with something like this:
- (add-hook 'mail-send-hook 'feedmail-mail-send-hook-splitter)
+ \(add-hook 'mail-send-hook 'feedmail-mail-send-hook-splitter\)
Then add the functions you want called to either feedmail-mail-send-hook-queued
or feedmail-mail-send-hook, as apprpriate. The distinction is that
feedmail-mail-send-hook will be called when you send mail from a composition
-buffer (typically by typing C-c C-c), whether the message is sent immediately
+buffer \(typically by typing C-c C-c\), whether the message is sent immediately
or placed in the queue or drafts directory. feedmail-mail-send-hook-queued is
called when messages are being sent from the queue directory, typically via a
call to feedmail-run-the-queue."
- (feedmail-say-debug ">in-> feedmail-mail-send-hook-splitter %s" feedmail-queue-runner-is-active)
+ (feedmail-say-debug
+ ">in-> feedmail-mail-send-hook-splitter %s" feedmail-queue-runner-is-active)
(if feedmail-queue-runner-is-active
- (run-hooks 'feedmail-mail-send-hook-queued)
- (run-hooks 'feedmail-mail-send-hook))
-)
+ (run-hooks 'feedmail-mail-send-hook-queued)
+ (run-hooks 'feedmail-mail-send-hook))
+ )
(defvar feedmail-mail-send-hook nil
@@ -1368,14 +1375,14 @@ call to feedmail-run-the-queue."
(defun feedmail-confirm-addresses-hook-example ()
"An example of a feedmail-last-chance-hook.
It shows the simple addresses and gets a confirmation. Use as:
- (setq feedmail-last-chance-hook 'feedmail-confirm-addresses-hook-example)."
+ \(setq feedmail-last-chance-hook 'feedmail-confirm-addresses-hook-example\)."
(save-window-excursion
- (display-buffer (set-buffer (get-buffer-create " F-C-A-H-E")))
- (erase-buffer)
- (insert (mapconcat 'identity feedmail-address-list " "))
- (if (not (y-or-n-p "How do you like them apples? "))
- (error "FQM: Sending...gave up in last chance hook")
- )))
+ (display-buffer (set-buffer (get-buffer-create " F-C-A-H-E")))
+ (erase-buffer)
+ (insert (mapconcat 'identity feedmail-address-list " "))
+ (if (not (y-or-n-p "How do you like them apples? "))
+ (error "FQM: Sending...gave up in last chance hook")
+ )))
(defcustom feedmail-last-chance-hook nil
@@ -1383,17 +1390,17 @@ It shows the simple addresses and gets a
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: (1) feedmail-prepped-text-buffer contains the header and body
-of the message, ready to go; (2) feedmail-address-list contains a list
+these: \(1\) feedmail-prepped-text-buffer contains the header and body
+of the message, ready to go; \(2\) feedmail-address-list contains a list
of simplified recipients of addresses which are to be given to the
-subprocess (the hook may change the list); (3) feedmail-error-buffer
+subprocess \(the hook may change the list\); \(3\) 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 and things will get confused."
:group 'feedmail-misc
:type 'hook
-)
+ )
(defcustom feedmail-before-fcc-hook nil
@@ -1402,9 +1409,9 @@ When this hook runs, the current buffer
buffer. It has already had all the header prepping from the standard
package. The next step after running the hook will be to save the
message via FCC: processing. The hook might be interested in these:
-(1) feedmail-prepped-text-buffer contains the header and body of the
-message, ready to go; (2) feedmail-address-list contains a list of
-simplified recipients of addressees to whom the message was sent (3)
+\(1\) feedmail-prepped-text-buffer contains the header and body of the
+message, ready to go; \(2\) feedmail-address-list contains a list of
+simplified recipients of addressees to whom the message was sent \(3\)
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
@@ -1413,7 +1420,7 @@ not necessary to arrange for the undoing
the buffer."
:group 'feedmail-misc
:type 'hook
-)
+ )
(defcustom feedmail-queue-express-hook nil
"*Chance to modify a message being sent directly to a queue.
@@ -1423,10 +1430,10 @@ care of attachments. If you subsequentl
can undo the encoding."
:group 'feedmail-queue
:type 'hook
-)
+ )
(defcustom feedmail-queue-runner-mode-setter
- '(lambda (&optional arg) (mail-mode))
+ #'(lambda (&optional arg) (mail-mode))
"*A function to set the proper mode of a message file. Called when
the message is read back out of the queue directory with a single
argument, the optional argument used in the call to
@@ -1441,7 +1448,7 @@ really don't need that \(and it's not pa
Called with funcall, not call-interactively."
:group 'feedmail-queue
:type 'function
-)
+ )
(defcustom feedmail-queue-alternative-mail-header-separator nil
@@ -1449,7 +1456,7 @@ Called with funcall, not call-interactiv
If you sometimes get alternative values for mail-header-separator in
queued messages, set the value of this variable to whatever it is.
For example, rmail-resend uses a mail-header-separator value of empty
-string (\"\") when you send/queue a message.
+string \(\"\"\) when you send/queue a message.
When trying to send a queued message, if the value of this variable is
non-nil, feedmail will first try to send the message using the value
@@ -1458,30 +1465,30 @@ set mail-header-separator to the value o
feedmail-queue-alternative-mail-header-separator and try again."
:group 'feedmail-queue
:type 'string
-)
+ )
(defcustom feedmail-queue-runner-message-sender
- '(lambda (&optional arg) (mail-send))
+ #'(lambda (&optional arg) (mail-send))
"*Function to initiate sending a message file.
Called for each message read back out of the queue directory with a
single argument, the optional argument used in the call to
feedmail-run-the-queue or feedmail-run-the-queue-no-prompts.
Interactively, that argument will be the prefix argument.
-Most people want mail-send (bound to C-c C-s in mail-mode), but here's
+Most people want mail-send \(bound to C-c C-s in mail-mode\), but here's
your chance to have something different. The default value is just a
wrapper function which discards the optional argument and calls
mail-send. If you are a VM user, you might like vm-mail-send, though
you really don't need that. Called with funcall, not call-interactively."
:group 'feedmail-queue
:type 'function
-)
+ )
(defcustom feedmail-queue-runner-cleaner-upper
- '(lambda (fqm-file &optional arg)
- (delete-file fqm-file)
- (if arg (feedmail-say-chatter "Nuked %s" fqm-file)))
+ #'(lambda (fqm-file &optional arg)
+ (delete-file fqm-file)
+ (if arg (feedmail-say-chatter "Nuked %s" fqm-file)))
"*Function that will be called after a message has been sent. It's
not called in the case of errors. This function is called with two
arguments, the name of the message queue file for the message just
@@ -1495,23 +1502,13 @@ The default action is an anonymous funct
from the queue directory. With a non-nil second argument, a brief
message is give for each file deleted. You could replace this
function, for example, to archive all of your sent messages someplace
-(though there are better ways to get that particular result)."
+\(though there are better ways to get that particular result\)."
:group 'feedmail-queue
:type 'function
-)
-
-
-(defvar feedmail-queue-runner-is-active nil
- "*Non-nil means we're inside the logic of the queue-running loop.
-That is, iterating over all messages in the queue to send them. In
-that case, the value is the name of the queued message file currently
-being processed. This can be used for differentiating customized code
-for different scenarios. Users shouldn't set or change this
-variable, but may depend on its value as described here.")
-
+ )
(defvar feedmail-is-a-resend nil
- "*Non-nil means the the message is a RESEND (in the RFC-822 sense).
+ "*Non-nil means the the message is a RESEND \(in the RFC-822 sense\).
This affects the composition of certain headers. feedmail sets this
variable as soon as it starts prepping the message text buffer, so any
user-supplied functions can rely on it. Users shouldn't set or change this
@@ -1520,9 +1517,9 @@ variable, but may depend on its value as
(defcustom 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 list containing the addresses individually as
+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 list containing the addresses individually as
strings. Popular choices for this are feedmail-buffer-to-binmail,
feedmail-buffer-to-smtpmail, feedmail-buffer-to-sendmail, and
feedmail-buffer-to-smtp. If you use the sendmail form, you probably
@@ -1531,31 +1528,31 @@ If you use the binmail form, check the v
feedmail-binmail-template."
:group 'feedmail-misc
:type 'function
-)
+ )
(defconst feedmail-binmail-linuxish-template
(concat
- "(echo From "
- (if (boundp 'user-login-name) user-login-name "feedmail")
- " ; cat -) | /usr/bin/rmail %s")
+ "(echo From "
+ (if (fboundp #'user-login-name) (user-login-name) "feedmail")
+ " ; cat -) | /usr/bin/rmail %s")
"*Good candidate for Linux systems and maybe others.
You may need to modify this if your \"rmail\" is in a different place.
For example, I hear that in some Debian systems, it's /usr/sbin/rmail.
See feedmail-binmail-template documentation."
-)
+ )
(defcustom feedmail-binmail-template (if mail-interactive "/bin/mail %s"
- (if (file-exists-p "/bin/rmail")
- "/bin/rmail %s" "/bin/mail %s"))
+ (if (file-exists-p "/bin/rmail")
+ "/bin/rmail %s" "/bin/mail %s"))
"*Command template for the subprocess which will get rid of the
mail. It can result in any command understandable by /bin/sh. Might
not work at all in non-UNIX environments. 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. The default value uses /bin/rmail (if it exists) unless
+stdin. The default value uses /bin/rmail \(if it exists\) unless
mail-interactive has been set non-nil.
If you'd like your errors to come back as mail instead of immediately
@@ -1581,7 +1578,7 @@ to 'feedmail-binmail-linuxish-template'.
messages to make sure it works as expected."
:group 'feedmail-misc
:type 'string
-)
+ )
;; feedmail-buffer-to-binmail, feedmail-buffer-to-sendmail, and
@@ -1596,8 +1593,8 @@ Feeds the buffer to it."
(apply
'call-process-region
(append (list (point-min) (point-max) "/bin/sh" nil errors-to nil "-c"
- (format feedmail-binmail-template
- (mapconcat 'identity addr-listoid " "))))))
+ (format feedmail-binmail-template
+ (mapconcat 'identity addr-listoid " "))))))
(defun feedmail-buffer-to-sendmail (prepped errors-to addr-listoid)
@@ -1609,13 +1606,16 @@ local gurus."
(feedmail-say-debug ">in-> feedmail-buffer-to-sendmail %s" addr-listoid)
(set-buffer prepped)
(apply 'call-process-region
- (append (list (point-min) (point-max)
- (if (boundp 'sendmail-program) sendmail-program "/usr/lib/sendmail")
- nil errors-to nil "-oi" "-t")
- ;; provide envelope "from" to sendmail; results will vary
- (if feedmail-sendmail-f-doesnt-sell-me-out (list "-f" user-mail-address))
- ;; These mean "report errors by mail" and "deliver in background".
- (if (null mail-interactive) '("-oem" "-odb")))))
+ (append (list (point-min) (point-max)
+ (if (boundp 'sendmail-program)
+ sendmail-program "/usr/lib/sendmail")
+ nil errors-to nil "-oi" "-t")
+ ;; provide envelope "from" to sendmail; results will vary
+ (if feedmail-sendmail-f-doesnt-sell-me-out
+ (list "-f" user-mail-address))
+ ;; These mean "report errors by mail" and "deliver in
+ ;; background".
+ (if (null mail-interactive) '("-oem" "-odb")))))
;; provided by jam at austin.asc.slb.com (James A. McLaughlin);
;; simplified by WJC after more feedmail development;
@@ -1631,21 +1631,28 @@ local gurus."
(feedmail-say-debug ">in-> feedmail-buffer-to-smtpmail %s" addr-listoid)
(require 'smtpmail)
(if (not (smtpmail-via-smtp addr-listoid prepped))
- (progn
- (set-buffer errors-to)
- (insert "Send via smtpmail failed. Probable SMTP protocol error.\n")
- (insert "Look for details below or in the *Messages* buffer.\n\n")
- (let ((case-fold-search t)
- ;; don't be overconfident about the name of the trace buffer
- (tracer (concat "trace.*smtp.*" (regexp-quote smtpmail-smtp-server))))
- (mapcar
- '(lambda (buffy)
- (if (string-match tracer (buffer-name buffy))
- (progn
- (insert "SMTP Trace from " (buffer-name buffy) "\n---------------")
- (insert-buffer buffy)
- (insert "\n\n"))))
- (buffer-list))))))
+ (progn
+ (set-buffer errors-to)
+ (insert "Send via smtpmail failed. Probable SMTP protocol error.\n")
+ (insert "Look for details below or in the *Messages* buffer.\n\n")
+ (let ((case-fold-search t)
+ ;; don't be overconfident about the name of the trace buffer
+ (tracer (concat "trace.*smtp.*"
+ (regexp-quote smtpmail-smtp-server))))
+ (mapcar
+ #'(lambda (buffy)
+ (if (string-match tracer (buffer-name buffy))
+ (progn
+ (insert "SMTP Trace from "
+ (buffer-name buffy) "\n---------------")
+ (insert-buffer buffy)
+ (insert "\n\n"))))
+ (buffer-list))))))
+
+;; Hack-o-rama. This is to shut up the byte-compiler --SY.
+(eval-when-compile
+ (defalias 'smtp-via-smtp 'ignore)
+ (defalias 'expand-mail-aliases 'ignore))
;; FLIM's smtp.el pointed out to me by Kenichi Handa <handa at etl.go.jp>
(defun feedmail-buffer-to-smtp (prepped errors-to addr-listoid)
@@ -1653,21 +1660,22 @@ local gurus."
(feedmail-say-debug ">in-> feedmail-buffer-to-smtp %s" addr-listoid)
(require 'smtp)
(if (not (smtp-via-smtp user-mail-address addr-listoid prepped))
- (progn
- (set-buffer errors-to)
- (insert "Send via smtp failed. Probable SMTP protocol error.\n")
- (insert "Look for details below or in the *Messages* buffer.\n\n")
- (let ((case-fold-search t)
- ;; don't be overconfident about the name of the trace buffer
- (tracer (concat "trace.*smtp.*" (regexp-quote smtp-server))))
- (mapcar
- '(lambda (buffy)
- (if (string-match tracer (buffer-name buffy))
- (progn
- (insert "SMTP Trace from " (buffer-name buffy) "\n---------------")
- (insert-buffer buffy)
- (insert "\n\n"))))
- (buffer-list))))))
+ (progn
+ (set-buffer errors-to)
+ (insert "Send via smtp failed. Probable SMTP protocol error.\n")
+ (insert "Look for details below or in the *Messages* buffer.\n\n")
+ (let ((case-fold-search t)
+ ;; don't be overconfident about the name of the trace buffer
+ (tracer (concat "trace.*smtp.*" (regexp-quote smtp-server))))
+ (mapcar
+ #'(lambda (buffy)
+ (if (string-match tracer (buffer-name buffy))
+ (progn
+ (insert "SMTP Trace from "
+ (buffer-name buffy) "\n---------------")
+ (insert-buffer buffy)
+ (insert "\n\n"))))
+ (buffer-list))))))
;; just a place to park a docstring
(defconst feedmail-fiddle-plex-blurb nil
@@ -1675,15 +1683,16 @@ local gurus."
It is a list of up to 4 elements: NAME, VALUE, ACTION, FOLDING. The element
VALUE can also be a list sometimes.
-NAME is the name of the header field to be fiddled with. Although case doesn't
-matter in looking for headers, case of NAME is preserved when a header is inserted
-via fiddling. It shouldn't include the trailing colon.
+NAME is the name of the header field to be fiddled with. Although
+case doesn't matter in looking for headers, case of NAME is preserved
+when a header is inserted via fiddling. It shouldn't include the
+trailing colon.
VALUE is either nil, a simple string, a function returning nil or a string, or,
as described below for ACTION 'combine, a list of up to three values.
ACTION describes the nature of the fiddling to be done. Possibilities
-for ACTION (default is 'supplement):
+for ACTION \(default is 'supplement\):
'supplement Leave other like fields as-is, insert this one.
@@ -1695,8 +1704,8 @@ for ACTION (default is 'supplement):
In this case, VALUE has a special form. It is a list
of three items: VAL-PRE, VAL-LIKE, and VAL-POST.
VAL-PRE and VAL-POST are strings or nil. VAL-LIKE may
- be either a string or a function (it may also be nil,
- but there's not much point to that).
+ be either a string or a function \(it may also be nil,
+ but there's not much point to that\).
Values of like header fields are aggregated, leading and
trailing whitespace is removed, and embedded
@@ -1719,13 +1728,16 @@ for ACTION (default is 'supplement):
then starting the new value on a continuation line,
you might specify this:
- (nil \"%s;\\n\\t\" \"This is my new value\")
+ \(nil \"%s;\\n\\t\" \"This is my new value\"\)
FOLDING can be nil, in which case VALUE is used as-is. If FOLDING is
non-nil, feedmail \"smart filling\" is done on VALUE just before
insertion.
")
+
+(autoload 'vm-mail "vm-startup" nil t)
+
(defun feedmail-vm-mail-mode (&optional arg)
"Make something like a buffer that has been created via vm-mail.
The optional argument is ignored and is just for argument compatibility with
@@ -1734,29 +1746,30 @@ applied to a file after you've just read
feedmail FQM message file from a queue. You could use something like
this:
-\(setq auto-mode-alist \(cons \'\(\"\\\\.fqm$\" . feedmail-vm-mail-mode\) auto-mode-alist\)\)
+\(setq auto-mode-alist
+ \(cons \'\(\"\\\\.fqm$\" . feedmail-vm-mail-mode\) auto-mode-alist\)\)
"
(feedmail-say-debug ">in-> feedmail-vm-mail-mode")
(let ((the-buf (current-buffer)))
- (vm-mail)
- (delete-region (point-min) (point-max))
- (insert-buffer the-buf)
- (setq buffer-file-name (buffer-file-name the-buf))
- (set-buffer-modified-p (buffer-modified-p the-buf))
- ;; For some versions of emacs, saving the message to a queue
- ;; triggers running the mode function on the buffer, and that
- ;; leads (through a series of events I don't really understand)
- ;; to this function being called while the buffer is still
- ;; marked modified even though it is in the process of being
- ;; saved. I guess the function gets called during the renaming
- ;; that takes place en route to the save.
- ;;
- ;; This clearing of the marker probably wastes a buffer copy
- ;; but it's easy to do and more reliable than figuring out what
- ;; each variant of emacs does in this strange case.
- (set-buffer-modified-p nil the-buf)
- (kill-buffer the-buf)
- ))
+ (vm-mail)
+ (delete-region (point-min) (point-max))
+ (insert-buffer the-buf)
+ (setq buffer-file-name (buffer-file-name the-buf))
+ (set-buffer-modified-p (buffer-modified-p the-buf))
+ ;; For some versions of emacs, saving the message to a queue
+ ;; triggers running the mode function on the buffer, and that
+ ;; leads (through a series of events I don't really understand)
+ ;; to this function being called while the buffer is still
+ ;; marked modified even though it is in the process of being
+ ;; saved. I guess the function gets called during the renaming
+ ;; that takes place en route to the save.
+ ;;
+ ;; This clearing of the marker probably wastes a buffer copy
+ ;; but it's easy to do and more reliable than figuring out what
+ ;; each variant of emacs does in this strange case.
+ (set-buffer-modified-p nil the-buf)
+ (kill-buffer the-buf)
+ ))
(defun feedmail-send-it ()
@@ -1764,29 +1777,32 @@ this:
To use it, you probably want something like this in your .emacs or
similar place:
- (setq send-mail-function 'feedmail-send-it)
- (autoload 'feedmail-send-it \"feedmail\")"
+ \(setq send-mail-function 'feedmail-send-it\)
+ \(autoload 'feedmail-send-it \"feedmail\"\)"
(feedmail-say-debug ">in-> feedmail-send-it")
(save-excursion
- (let ((bfn-jiggle nil))
- ;; if buffer-file-name is nil, temporarily use the stashed value
- (if (and (not buffer-file-name) feedmail-queue-buffer-file-name)
- (setq buffer-file-name feedmail-queue-buffer-file-name
- bfn-jiggle t))
- ;; avoid matching trouble over slash vs backslash by getting canonical
- (if feedmail-queue-directory
- (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory)))
- (if feedmail-queue-draft-directory
- (setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory)))
- (if (not feedmail-enable-queue) (feedmail-send-it-immediately-wrapper)
- ;; else, queuing is enabled, should we ask about it or just do it?
- (if feedmail-ask-before-queue
- (funcall (feedmail-queue-send-edit-prompt))
- (feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue)))
- ;; put this back
- (if bfn-jiggle (setq feedmail-queue-buffer-file-name buffer-file-name))
- )))
+ (let ((bfn-jiggle nil))
+ ;; if buffer-file-name is nil, temporarily use the stashed value
+ (if (and (not buffer-file-name) feedmail-queue-buffer-file-name)
+ (setq buffer-file-name feedmail-queue-buffer-file-name
+ bfn-jiggle t))
+ ;; avoid matching trouble over slash vs backslash by getting canonical
+ (if feedmail-queue-directory
+ (setq feedmail-queue-directory
+ (expand-file-name feedmail-queue-directory)))
+ (if feedmail-queue-draft-directory
+ (setq feedmail-queue-draft-directory
+ (expand-file-name feedmail-queue-draft-directory)))
+ (if (not feedmail-enable-queue) (feedmail-send-it-immediately-wrapper)
+ ;; else, queuing is enabled, should we ask about it or just do it?
+ (if feedmail-ask-before-queue
+ (funcall (feedmail-queue-send-edit-prompt))
+ (feedmail-dump-message-to-queue
+ feedmail-queue-directory 'after-queue)))
+ ;; put this back
+ (if bfn-jiggle (setq feedmail-queue-buffer-file-name buffer-file-name))
+ )))
(defun feedmail-message-action-send ()
@@ -1796,19 +1812,20 @@ similar place:
(feedmail-send-it-immediately-wrapper))
-;; From a VM mailing list discussion and some suggestions from Samuel Mikes <smikes at alumni.hmc.edu>
+;; From a VM mailing list discussion and some suggestions from Samuel
+;; Mikes <smikes at alumni.hmc.edu>
(defun feedmail-queue-express-to-queue ()
"*Send message directly to the queue, with a minimum of fuss and bother."
(interactive)
(feedmail-say-debug ">in-> feedmail-queue-express-to-queue")
(run-hooks 'feedmail-queue-express-hook)
(let ((feedmail-enable-queue t)
- (feedmail-ask-before-queue nil)
- (feedmail-queue-reminder-alist nil)
- (feedmail-queue-chatty-sit-for 0))
- (feedmail-send-it)
- )
-)
+ (feedmail-ask-before-queue nil)
+ (feedmail-queue-reminder-alist nil)
+ (feedmail-queue-chatty-sit-for 0))
+ (feedmail-send-it)
+ )
+ )
(defun feedmail-queue-express-to-draft ()
@@ -1816,9 +1833,9 @@ similar place:
(interactive)
(feedmail-say-debug ">in-> feedmail-queue-express-to-draft")
(let ((feedmail-queue-directory feedmail-queue-draft-directory))
- (feedmail-queue-express-to-queue)
- )
-)
+ (feedmail-queue-express-to-queue)
+ )
+ )
(defun feedmail-message-action-send-strong ()
@@ -1839,7 +1856,7 @@ similar place:
(defun feedmail-message-action-draft-strong ()
(feedmail-say-debug ">in-> feedmail-message-action-draft-strong")
(let ((buffer-file-name nil))
- (feedmail-message-action-draft)))
+ (feedmail-message-action-draft)))
(defun feedmail-message-action-queue ()
@@ -1850,18 +1867,18 @@ similar place:
(defun feedmail-message-action-queue-strong ()
(feedmail-say-debug ">in-> feedmail-message-action-queue-strong")
(let ((buffer-file-name nil))
- (feedmail-message-action-queue)))
+ (feedmail-message-action-queue)))
(defun feedmail-message-action-toggle-spray ()
(feedmail-say-debug ">in-> feedmail-message-action-toggle-spray")
(let ((feedmail-enable-spray (not feedmail-enable-spray)))
- (if feedmail-enable-spray
- (message "FQM: For this message, spray toggled ON")
- (message "FQM: For this message, spray toggled OFF"))
- (sit-for 3)
- ;; recursion, but harmless
- (feedmail-send-it)))
+ (if feedmail-enable-spray
+ (message "FQM: For this message, spray toggled ON")
+ (message "FQM: For this message, spray toggled OFF"))
+ (sit-for 3)
+ ;; recursion, but harmless
+ (feedmail-send-it)))
(defconst feedmail-p-h-b-n "*FQM Help*")
@@ -1869,15 +1886,15 @@ similar place:
(defun feedmail-message-action-help ()
(feedmail-say-debug ">in-> feedmail-message-action-help")
(let ((d-string " ")
- (fqm-help (get-buffer feedmail-p-h-b-n)))
- (if (stringp feedmail-ask-before-queue-default)
- (setq d-string feedmail-ask-before-queue-default)
- (setq d-string (char-to-string feedmail-ask-before-queue-default)))
- (if (and fqm-help (get-buffer-window fqm-help))
- (feedmail-scroll-buffer 'up fqm-help)
- (feedmail-message-action-help-blat d-string))
- ;; recursive, but no worries (it goes deeper on user action)
- (feedmail-send-it)))
+ (fqm-help (get-buffer feedmail-p-h-b-n)))
+ (if (stringp feedmail-ask-before-queue-default)
+ (setq d-string feedmail-ask-before-queue-default)
+ (setq d-string (char-to-string feedmail-ask-before-queue-default)))
+ (if (and fqm-help (get-buffer-window fqm-help))
+ (feedmail-scroll-buffer 'up fqm-help)
+ (feedmail-message-action-help-blat d-string))
+ ;; recursive, but no worries (it goes deeper on user action)
+ (feedmail-send-it)))
(defun feedmail-message-action-help-blat (d-string)
(feedmail-say-debug ">in-> feedmail-message-action-help-blat")
@@ -1908,13 +1925,14 @@ Synonyms:
SPC SCROLL UP \(same as \">\"\)
The user-configurable default is currently \"")
- (princ d-string)
- (princ "\". For other possibilities,
+ (princ d-string)
+ (princ "\". For other possibilities,
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)))))
+ (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)))))
(defun feedmail-message-action-scroll-up ()
@@ -1951,127 +1969,147 @@ bail out with an appropriate answer to t
(defun feedmail-run-the-queue (&optional arg)
"Visit each message in the feedmail queue directory and send it out.
Return value is a list of three things: number of messages sent, number of
-messages skipped, and number of non-message things in the queue (commonly
-backup file names and the like)."
+messages skipped, and number of non-message things in the queue \(commonly
+backup file names and the like\)."
(interactive "p")
(feedmail-say-debug ">in-> feedmail-run-the-queue")
;; avoid matching trouble over slash vs backslash by getting canonical
(if feedmail-queue-directory
- (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory)))
+ (setq feedmail-queue-directory
+ (expand-file-name feedmail-queue-directory)))
(if feedmail-queue-draft-directory
- (setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory)))
+ (setq feedmail-queue-draft-directory
+ (expand-file-name feedmail-queue-draft-directory)))
(let* ((maybe-file)
- (qlist (feedmail-look-at-queue-directory feedmail-queue-directory))
- (dlist (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
- (q-cnt (nth 0 qlist))
- (q-oth (nth 1 qlist))
- (d-cnt (nth 0 dlist))
- (d-oth (nth 1 dlist))
- (messages-sent 0)
- (messages-skipped 0)
- (blobby-buffer)
- (already-buffer)
- (do-the-run t)
- (list-of-possible-fqms))
- (if (and (> q-cnt 0) feedmail-queue-runner-confirm-global)
- (setq do-the-run
- (if (fboundp 'y-or-n-p-with-timeout)
- (y-or-n-p-with-timeout (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? "
- d-cnt d-oth q-cnt q-oth)
- 5 nil)
- (y-or-n-p (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? "
- d-cnt d-oth q-cnt q-oth))
- )))
- (if (not do-the-run)
- (setq messages-skipped q-cnt)
- (save-window-excursion
- (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
- '(lambda (blobby)
- (setq maybe-file (expand-file-name blobby feedmail-queue-directory))
- (cond
- ((file-directory-p maybe-file) nil) ; don't care about subdirs
- ((feedmail-fqm-p blobby)
- (setq blobby-buffer (generate-new-buffer (concat "FQM " blobby)))
- (setq already-buffer
- (if (fboundp 'find-buffer-visiting) ; missing from XEmacs
- (find-buffer-visiting maybe-file)
- (get-file-buffer maybe-file)))
- (if (and already-buffer (buffer-modified-p already-buffer))
- (save-window-excursion
- (display-buffer (set-buffer already-buffer))
- (if (fboundp 'y-or-n-p-with-timeout)
- ;; make a guess that the user just forgot to save
- (if (y-or-n-p-with-timeout (format "FQM: Visiting %s; save before send? " blobby) 10 t)
- (save-buffer))
- (if (y-or-n-p (format "FQM: Visiting %s; save before send? " blobby))
- (save-buffer))
- )))
+ (qlist (feedmail-look-at-queue-directory feedmail-queue-directory))
+ (dlist (feedmail-look-at-queue-directory
+ feedmail-queue-draft-directory))
+ (q-cnt (nth 0 qlist))
+ (q-oth (nth 1 qlist))
+ (d-cnt (nth 0 dlist))
+ (d-oth (nth 1 dlist))
+ (messages-sent 0)
+ (messages-skipped 0)
+ (blobby-buffer)
+ (already-buffer)
+ (do-the-run t)
+ (list-of-possible-fqms))
+ (if (and (> q-cnt 0) feedmail-queue-runner-confirm-global)
+ (setq do-the-run
+ (if (fboundp 'y-or-n-p-with-timeout)
+ (y-or-n-p-with-timeout
+ (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? "
+ d-cnt d-oth q-cnt q-oth)
+ 5 nil)
+ (y-or-n-p
+ (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? "
+ d-cnt d-oth q-cnt q-oth))
+ )))
+ (if (not do-the-run)
+ (setq messages-skipped q-cnt)
+ (save-window-excursion
+ (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
+ #'(lambda (blobby)
+ (setq maybe-file (expand-file-name blobby feedmail-queue-directory))
+ (cond
+ ((file-directory-p maybe-file) nil) ; don't care about subdirs
+ ((feedmail-fqm-p blobby)
+ (setq blobby-buffer (generate-new-buffer (concat "FQM " blobby)))
+ (setq already-buffer
+ (if (fboundp 'find-buffer-visiting) ; missing from XEmacs
+ (find-buffer-visiting maybe-file)
+ (get-file-buffer maybe-file)))
+ (if (and already-buffer (buffer-modified-p already-buffer))
+ (save-window-excursion
+ (display-buffer (set-buffer already-buffer))
+ (if (fboundp 'y-or-n-p-with-timeout)
+ ;; make a guess that the user just forgot to save
+ (if (y-or-n-p-with-timeout
+ (format "FQM: Visiting %s; save before send? "
+ blobby) 10 t)
+ (save-buffer))
+ (if (y-or-n-p
+ (format "FQM: Visiting %s; save before send? "
+ blobby))
+ (save-buffer))
+ )))
- (set-buffer blobby-buffer)
- (setq buffer-offer-save nil)
- (buffer-disable-undo blobby-buffer)
- (insert-file-contents-literally maybe-file)
- (setq buffer-file-type t) ;;binary
- (goto-char (point-min))
- ;; if at least two line-endings with CRLF, translate the file
- (if (looking-at ".*\r\n.*\r\n")
- (while (search-forward "\r\n" nil t)
- (replace-match "\n" nil t)))
+ (set-buffer blobby-buffer)
+ (setq buffer-offer-save nil)
+ (buffer-disable-undo blobby-buffer)
+ (insert-file-contents-literally maybe-file)
+ (goto-char (point-min))
+ ;; if at least two line-endings with CRLF, translate the file
+ (if (looking-at ".*\r\n.*\r\n")
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n" nil t)))
;; ;; work around text-vs-binary wierdness
;; ;; if we don't find the normal M-H-S, try reading the file a different way
;; (if (not (feedmail-find-eoh t))
;; (let ((file-name-buffer-file-type-alist nil) (default-buffer-file-type nil))
;; (erase-buffer)
;; (insert-file-contents maybe-file)))
- (funcall feedmail-queue-runner-mode-setter arg)
- (condition-case signal-stuff ; don't give up the loop if user skips some
- (let ((feedmail-enable-queue nil)
- (feedmail-queue-runner-is-active maybe-file))
- ;; if can't find EOH, this is no message!
- (if (not (feedmail-find-eoh t))
- (progn
- (feedmail-say-chatter "Skipping %s; no mail-header-separator" maybe-file)
- (error "FQM: you should never see this message")))
- (feedmail-say-debug "Prepping %s" maybe-file)
- ;; the catch is a way out for users to voluntarily skip sending a message
- (catch 'skip-me-q (funcall feedmail-queue-runner-message-sender arg))
- (set-buffer blobby-buffer)
- (if (buffer-modified-p) ; still modified, means wasn't sent
- (progn
- (setq messages-skipped (1+ messages-skipped))
- (feedmail-say-chatter "%s wasn't sent by %s" maybe-file feedmail-buffer-eating-function))
- (setq messages-sent (1+ messages-sent))
- (funcall feedmail-queue-runner-cleaner-upper maybe-file arg)
- (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)
- (setq buffer-file-name nil)))))
- ;; the handler for the condition-case
- (error (setq messages-skipped (1+ messages-skipped))
- (ding t)
- (message "FQM: Trapped '%s', message left in queue." (car signal-stuff))
- (sit-for 3)
- (message "FQM: Trap details: \"%s\""
- (mapconcat 'identity (cdr signal-stuff) "\" \""))
- (sit-for 3)))
- (kill-buffer blobby-buffer)
- (feedmail-say-chatter "%d to go, %d sent, %d skipped (%d other files ignored)"
- (- q-cnt messages-sent messages-skipped)
- messages-sent messages-skipped q-oth)
- )))
- list-of-possible-fqms)))
- (if feedmail-queue-chatty
- (progn
- (feedmail-say-chatter "%d sent, %d skipped (%d other files ignored)"
- messages-sent messages-skipped q-oth)
- (feedmail-queue-reminder 'after-run)
- (sit-for feedmail-queue-chatty-sit-for)))
- (list messages-sent messages-skipped q-oth)))
+ (funcall feedmail-queue-runner-mode-setter arg)
+ (condition-case signal-stuff ; don't give up the
+ ; loop if user skips
+ ; some
+ (let ((feedmail-enable-queue nil)
+ (feedmail-queue-runner-is-active maybe-file))
+ ;; if can't find EOH, this is no message!
+ (if (not (feedmail-find-eoh t))
+ (progn
+ (feedmail-say-chatter
+ "Skipping %s; no mail-header-separator" maybe-file)
+ (error "FQM: you should never see this message")))
+ (feedmail-say-debug "Prepping %s" maybe-file)
+ ;; the catch is a way out for users to voluntarily
+ ;; skip sending a message
+ (catch 'skip-me-q
+ (funcall feedmail-queue-runner-message-sender arg))
+ (set-buffer blobby-buffer)
+ (if (buffer-modified-p) ; still modified, means wasn't sent
+ (progn
+ (setq messages-skipped (1+ messages-skipped))
+ (feedmail-say-chatter
+ "%s wasn't sent by %s"
+ maybe-file feedmail-buffer-eating-function))
+ (setq messages-sent (1+ messages-sent))
+ (funcall feedmail-queue-runner-cleaner-upper
+ maybe-file arg)
+ (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)
+ (setq buffer-file-name nil)))))
+ ;; the handler for the condition-case
+ (error (setq messages-skipped (1+ messages-skipped))
+ (ding t)
+ (message "FQM: Trapped '%s', message left in queue."
+ (car signal-stuff))
+ (sit-for 3)
+ (message
+ "FQM: Trap details: \"%s\""
+ (mapconcat 'identity (cdr signal-stuff) "\" \""))
+ (sit-for 3)))
+ (kill-buffer blobby-buffer)
+ (feedmail-say-chatter
+ "%d to go, %d sent, %d skipped (%d other files ignored)"
+ (- q-cnt messages-sent messages-skipped)
+ messages-sent messages-skipped q-oth)
+ )))
+ list-of-possible-fqms)))
+ (if feedmail-queue-chatty
+ (progn
+ (feedmail-say-chatter "%d sent, %d skipped (%d other files ignored)"
+ messages-sent messages-skipped q-oth)
+ (feedmail-queue-reminder 'after-run)
+ (sit-for feedmail-queue-chatty-sit-for)))
+ (list messages-sent messages-skipped q-oth)))
;;;###autoload
@@ -2080,25 +2118,30 @@ backup file names and the like)."
Called with an optional symbol argument which says what kind of event
is triggering the reminder activity. The default is 'on-demand, which
is what you typically would use if you were putting this in your emacs start-up
-or mail hook code. Other recognized values for WHAT-EVENT (these are passed
-internally by feedmail):
+or mail hook code. Other recognized values for WHAT-EVENT \(these are passed
+internally by feedmail\):
- after-immediate (a message has just been sent in immediate mode)
- after-queue (a message has just been queued)
- after-draft (a message has just been placed in the draft directory)
- after-run (the queue has just been run, possibly sending messages)
-
-WHAT-EVENT is used as a key into the table feedmail-queue-reminder-alist. If
-the associated value is a function, it is called without arguments and is expected
-to perform the reminder activity. You can supply your own reminder functions
-by redefining feedmail-queue-reminder-alist. If you don't want any reminders,
-you can set feedmail-queue-reminder-alist to nil."
+ after-immediate \(a message has just been sent in immediate mode\)
+ after-queue \(a message has just been queued\)
+ after-draft \(a message has just been placed in the draft directory\)
+ after-run \(the queue has just been run, possibly sending messages\)
+
+WHAT-EVENT is used as a key into the table feedmail-queue-reminder-alist.
+If the associated value is a function, it is called without arguments and
+is expected to perform the reminder activity. You can supply your own
+reminder functions by redefining feedmail-queue-reminder-alist. If you
+don't want any reminders, you can set feedmail-queue-reminder-alist to
+nil."
(interactive "p")
(feedmail-say-debug ">in-> feedmail-queue-reminder %s" what-event)
- (let ((key (if (and what-event (symbolp what-event)) what-event 'on-demand)) entry reminder)
- (setq entry (assoc key feedmail-queue-reminder-alist))
- (setq reminder (cdr entry))
- (if (fboundp reminder) (funcall reminder)))
+ (let ((key (if (and what-event
+ (symbolp what-event))
+ what-event
+ 'on-demand))
+ entry reminder)
+ (setq entry (assoc key feedmail-queue-reminder-alist))
+ (setq reminder (cdr entry))
+ (if (fboundp reminder) (funcall reminder)))
)
@@ -2107,13 +2150,15 @@ you can set feedmail-queue-reminder-alis
(interactive)
(feedmail-say-debug ">in-> feedmail-queue-reminder-brief")
(let (q-cnt d-cnt q-lis d-lis)
- (setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory))
- (setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
- (setq q-cnt (car q-lis))
- (setq d-cnt (car d-lis))
- (if (or (> q-cnt 0) (> d-cnt 0))
- (progn
- (message "FQM: [D: %d, Q: %d]" d-cnt q-cnt))))
+ (setq q-lis (feedmail-look-at-queue-directory
+ feedmail-queue-directory))
+ (setq d-lis (feedmail-look-at-queue-directory
+ feedmail-queue-draft-directory))
+ (setq q-cnt (car q-lis))
+ (setq d-cnt (car d-lis))
+ (if (or (> q-cnt 0) (> d-cnt 0))
+ (progn
+ (message "FQM: [D: %d, Q: %d]" d-cnt q-cnt))))
)
@@ -2122,18 +2167,21 @@ you can set feedmail-queue-reminder-alis
(interactive)
(feedmail-say-debug ">in-> feedmail-queue-reminder-medium")
(let (q-cnt d-cnt q-oth d-oth q-lis d-lis)
- (setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory))
- (setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
- (setq q-cnt (car q-lis))
- (setq d-cnt (car d-lis))
- (setq q-oth (nth 1 q-lis))
- (setq d-oth (nth 1 d-lis))
- (if (or (> q-cnt 0) (> d-cnt 0))
- (progn
- (message "FQM: Draft: %dm+%d in \"%s\", Queue: %dm+%d in \"%s\""
- d-cnt d-oth (file-name-nondirectory feedmail-queue-draft-directory)
- q-cnt q-oth (file-name-nondirectory feedmail-queue-directory)))))
- )
+ (setq q-lis (feedmail-look-at-queue-directory
+ feedmail-queue-directory))
+ (setq d-lis (feedmail-look-at-queue-directory
+ feedmail-queue-draft-directory))
+ (setq q-cnt (car q-lis))
+ (setq d-cnt (car d-lis))
+ (setq q-oth (nth 1 q-lis))
+ (setq d-oth (nth 1 d-lis))
+ (if (or (> q-cnt 0) (> d-cnt 0))
+ (progn
+ (message "FQM: Draft: %dm+%d in \"%s\", Queue: %dm+%d in \"%s\""
+ d-cnt d-oth
+ (file-name-nondirectory feedmail-queue-draft-directory)
+ q-cnt q-oth
+ (file-name-nondirectory feedmail-queue-directory))))))
(defun feedmail-queue-send-edit-prompt ()
@@ -2160,62 +2208,66 @@ you can set feedmail-queue-reminder-alis
feedmail-prompt-before-queue-user-alist
))
-(defun feedmail-queue-send-edit-prompt-inner (default prompt reprompt helper standard-alist user-alist)
+(defun feedmail-queue-send-edit-prompt-inner (default prompt reprompt helper
+ standard-alist user-alist)
(feedmail-say-debug ">in-> feedmail-queue-send-edit-prompt-inner")
;; Some implementation ideas here came from the userlock.el code
(or defining-kbd-macro (discard-input))
(save-window-excursion
- (let ((answer) (d-char) (d-string " "))
- (if (stringp default)
- (setq d-char (string-to-char default)
- d-string default)
- (setq d-string (char-to-string default))
- (setq d-char default)
- )
+ (let ((answer) (d-char) (d-string " "))
+ (if (stringp default)
+ (setq d-char (string-to-char default)
+ d-string default)
+ (setq d-string (char-to-string default))
+ (setq d-char default)
+ )
(while (null answer)
- (message prompt d-string)
- (let ((user-sez
- (let ((inhibit-quit t) (cursor-in-echo-area t) (echo-keystrokes 0))
- (read-char-exclusive))))
- (if (= user-sez help-char)
- (setq answer '(^ . helper))
- (if (or (eq user-sez ?\C-m) (eq user-sez ?\C-j) (eq user-sez ?y))
- (setq user-sez d-char))
- ;; these char-to-int things because of some incomprensible difference
- ;; between the two in byte-compiled stuff between GNUemacs and XEmacs
- ;; (well, I'm sure someone could comprehend it, but I say 'uncle')
- (setq answer (or (assoc user-sez user-alist)
- (and (fboundp 'char-to-int)
- (assoc (char-to-int user-sez) user-alist))
- (assoc user-sez standard-alist)
- (and (fboundp 'char-to-int)
- (assoc (char-to-int user-sez) standard-alist))))
- (if (or (null answer) (null (cdr answer)))
- (progn
- (beep)
- (message reprompt d-string)
- (sit-for 3)))
- )))
- (cdr answer)
- )))
+ (message prompt d-string)
+ (let ((user-sez
+ (let ((inhibit-quit t)
+ (cursor-in-echo-area t)
+ (echo-keystrokes 0))
+ (read-char-exclusive))))
+ (if (= user-sez help-char)
+ (setq answer '(^ . helper))
+ (if (or (eq user-sez ?\C-m) (eq user-sez ?\C-j) (eq user-sez ?y))
+ (setq user-sez d-char))
+ ;; these char-to-int things because of some incomprensible difference
+ ;; between the two in byte-compiled stuff between GNUemacs and XEmacs
+ ;; (well, I'm sure someone could comprehend it, but I say 'uncle')
+ (setq answer (or (assoc user-sez user-alist)
+ (and (fboundp 'char-to-int)
+ (assoc (char-to-int user-sez) user-alist))
+ (assoc user-sez standard-alist)
+ (and (fboundp 'char-to-int)
+ (assoc (char-to-int user-sez)
+ standard-alist))))
+ (if (or (null answer) (null (cdr answer)))
+ (progn
+ (beep)
+ (message reprompt d-string)
+ (sit-for 3)))
+ )))
+ (cdr answer)
+ )))
(defun feedmail-scroll-buffer (direction &optional buffy)
;; scrolling fun
;; emacs convention is that scroll-up moves text up, window down
(feedmail-say-debug ">in-> feedmail-scroll-buffer %s" direction)
(save-selected-window
- (let ((signal-error-on-buffer-boundary nil)
- (fqm-window (display-buffer (if buffy buffy (current-buffer)))))
- (select-window fqm-window)
- (if (eq direction 'up)
- (if (pos-visible-in-window-p (point-max) fqm-window)
- ;; originally just (goto-char (point-min)), but
- ;; pos-visible-in-window-p seems oblivious to that
- (scroll-down 999999)
- (scroll-up))
- (if (pos-visible-in-window-p (point-min) fqm-window)
- (scroll-up 999999)
- (scroll-down))))))
+ (let ((signal-error-on-buffer-boundary nil)
+ (fqm-window (display-buffer (if buffy buffy (current-buffer)))))
+ (select-window fqm-window)
+ (if (eq direction 'up)
+ (if (pos-visible-in-window-p (point-max) fqm-window)
+ ;; originally just (goto-char (point-min)), but
+ ;; pos-visible-in-window-p seems oblivious to that
+ (scroll-down 999999)
+ (scroll-up))
+ (if (pos-visible-in-window-p (point-min) fqm-window)
+ (scroll-up 999999)
+ (scroll-down))))))
(defun feedmail-look-at-queue-directory (queue-directory)
@@ -2226,23 +2278,24 @@ mark for prefix sequence numbers. Subdi
the counts."
(feedmail-say-debug ">in-> feedmail-look-at-queue-directory %s" queue-directory)
(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
- '(lambda (blobby)
- (cond
- ((file-directory-p blobby) nil) ; don't care about subdirs
- ((feedmail-fqm-p blobby)
- (setq blobbet (file-name-nondirectory blobby))
- (if (string-match "^[0-9][0-9][0-9]-" blobbet)
- (let ((water-mark))
- (setq water-mark (string-to-int (substring blobbet 0 3)))
- (if (> water-mark high-water) (setq high-water water-mark))))
- (setq q-cnt (1+ q-cnt)))
- (t (setq q-oth (1+ q-oth)))
- ))
- (directory-files queue-directory t)))
- (list q-cnt q-oth high-water)))
+ ;; iterate, counting things we find along the way in the directory
+ (if (file-directory-p queue-directory)
+ (mapcar
+ #'(lambda (blobby)
+ (cond
+ ((file-directory-p blobby) nil) ; don't care about subdirs
+ ((feedmail-fqm-p blobby)
+ (setq blobbet (file-name-nondirectory blobby))
+ (if (string-match "^[0-9][0-9][0-9]-" blobbet)
+ (let ((water-mark))
+ (setq water-mark (string-to-int (substring blobbet 0 3)))
+ (if (> water-mark high-water)
+ (setq high-water water-mark))))
+ (setq q-cnt (1+ q-cnt)))
+ (t (setq q-oth (1+ q-oth)))
+ ))
+ (directory-files queue-directory t)))
+ (list q-cnt q-oth high-water)))
(defun feedmail-tidy-up-slug (slug)
"Utility for mapping out suspect characters in a potential filename"
@@ -2250,7 +2303,8 @@ the counts."
;; even programmers deserve a break sometimes, so cover nil for them
(if (null slug) (setq slug ""))
;; replace all non-alphanumerics with hyphen for safety
- (while (string-match feedmail-queue-slug-suspect-regexp slug) (setq slug (replace-match "-" nil nil slug)))
+ (while (string-match feedmail-queue-slug-suspect-regexp slug)
+ (setq slug (replace-match "-" nil nil slug)))
;; collapse multiple hyphens to one
(while (string-match "--+" slug) (setq slug (replace-match "-" nil nil slug)))
;; for tidyness, peel off leading hyphens
@@ -2258,325 +2312,382 @@ the counts."
;; for tidyness, peel off trailing hyphens
(if (string-match "-*$" slug) (setq slug (replace-match "" nil nil slug)))
slug
-)
+ )
(defun feedmail-queue-subject-slug-maker (&optional queue-directory)
"Create a name for storing the message in the queue.
Optional argument QUEUE-DIRECTORY specifies into which directory the
-file will be placed. The name is based on the SUBJECT: header (if
-there is one). If there is no subject,
+file will be placed. The name is based on the SUBJECT: header \(if
+there is one\). If there is no subject,
feedmail-queue-default-file-slug is consulted Special characters are
mapped to mostly alphanumerics for safety."
(feedmail-say-debug ">in-> feedmail-queue-subject-slug-maker %s" queue-directory)
(let ((eoh-marker) (case-fold-search t) (subject "") (s-point))
- (setq eoh-marker (feedmail-find-eoh))
- (goto-char (point-min))
- ;; get raw subject value (first line, anyhow)
- (if (re-search-forward "^SUBJECT:" eoh-marker t)
- (progn (setq s-point (point))
- (end-of-line)
- (setq subject (buffer-substring-no-properties s-point (point)))))
- (setq subject (feedmail-tidy-up-slug subject))
- (if (zerop (length subject))
- (setq subject
- (cond
- ((stringp feedmail-queue-default-file-slug) feedmail-queue-default-file-slug)
- ((fboundp feedmail-queue-default-file-slug)
- (save-excursion (funcall feedmail-queue-default-file-slug)))
- ((eq feedmail-queue-default-file-slug 'ask)
- (file-name-nondirectory
- (read-file-name "FQM: Message filename slug? "
- (file-name-as-directory queue-directory) subject nil subject)))
- (t "no subject"))
- ))
- (feedmail-tidy-up-slug subject) ;; one more time, with feeling
- ))
+ (setq eoh-marker (feedmail-find-eoh))
+ (goto-char (point-min))
+ ;; get raw subject value (first line, anyhow)
+ (if (re-search-forward "^SUBJECT:" eoh-marker t)
+ (progn (setq s-point (point))
+ (end-of-line)
+ (setq subject (buffer-substring-no-properties s-point (point)))))
+ (setq subject (feedmail-tidy-up-slug subject))
+ (if (zerop (length subject))
+ (setq subject
+ (cond
+ ((stringp feedmail-queue-default-file-slug)
+ feedmail-queue-default-file-slug)
+ ((fboundp feedmail-queue-default-file-slug)
+ (save-excursion (funcall feedmail-queue-default-file-slug)))
+ ((eq feedmail-queue-default-file-slug 'ask)
+ (file-name-nondirectory
+ (read-file-name
+ "FQM: Message filename slug? "
+ (file-name-as-directory queue-directory) subject nil subject)))
+ (t "no subject"))
+ ))
+ (feedmail-tidy-up-slug subject) ;; one more time, with feeling
+ ))
(defun feedmail-create-queue-filename (queue-directory)
(feedmail-say-debug ">in-> feedmail-create-queue-filename %s" queue-directory)
(let ((slug "wjc"))
- (cond
- (feedmail-queue-slug-maker
- (save-excursion (setq slug (funcall feedmail-queue-slug-maker queue-directory))))
- (feedmail-ask-for-queue-slug
- (setq slug (file-name-nondirectory
- (read-file-name (concat "FQM: Message filename slug? [" slug "]? ")
- (file-name-as-directory queue-directory) slug nil slug))))
- )
- (setq slug (feedmail-tidy-up-slug slug))
- (setq slug (format "%03d-%s" (1+ (nth 2 (feedmail-look-at-queue-directory queue-directory))) slug))
- (concat
- (expand-file-name slug queue-directory)
- feedmail-queue-fqm-suffix)
- ))
+ (cond
+ (feedmail-queue-slug-maker
+ (save-excursion
+ (setq slug (funcall feedmail-queue-slug-maker queue-directory))))
+ (feedmail-ask-for-queue-slug
+ (setq slug (file-name-nondirectory
+ (read-file-name
+ (concat "FQM: Message filename slug? [" slug "]? ")
+ (file-name-as-directory queue-directory) slug nil slug))))
+ )
+ (setq slug (feedmail-tidy-up-slug slug))
+ (setq slug (format "%03d-%s" (1+ (nth 2 (feedmail-look-at-queue-directory
+ queue-directory))) slug))
+ (concat
+ (expand-file-name slug queue-directory)
+ feedmail-queue-fqm-suffix)
+ ))
(defun feedmail-dump-message-to-queue (queue-directory what-event)
- (feedmail-say-debug ">in-> feedmail-dump-message-to-queue %s %s" queue-directory what-event)
+ (feedmail-say-debug ">in-> feedmail-dump-message-to-queue %s %s"
+ queue-directory what-event)
(or (file-accessible-directory-p queue-directory)
- ;; 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)))
+ ;; 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)))
(let ((filename)
- (is-fqm)
- (is-in-this-dir)
- (previous-buffer-file-name buffer-file-name))
- (if buffer-file-name
- (progn
- (setq is-fqm (feedmail-fqm-p buffer-file-name))
- (setq is-in-this-dir (string-equal
- (directory-file-name (expand-file-name queue-directory))
- (directory-file-name (expand-file-name (file-name-directory buffer-file-name)))))))
- ;; if visiting a queued message, just save
- (if (and is-fqm is-in-this-dir)
- (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))
- ;; convenient for moving from draft to q, for example
- (if (and previous-buffer-file-name (or (not is-fqm) (not is-in-this-dir))
- (let (d b s)
- (setq b (file-name-nondirectory previous-buffer-file-name))
- (setq d (file-name-directory previous-buffer-file-name))
- (setq s (substring d (1- (length d))))
- (setq d (substring d 0 (1- (length d))))
- (setq d (file-name-nondirectory d))
- (y-or-n-p (format "FQM: Was previously %s%s%s; delete that? " d s b))
- )
- )
- (delete-file previous-buffer-file-name))
- (if feedmail-nuke-buffer-after-queue
- (let ((a-s-file-name buffer-auto-save-file-name))
- ;; be aggressive in nuking auto-save files
- (and (kill-buffer (current-buffer))
- delete-auto-save-files
- (file-exists-p a-s-file-name)
- (delete-file a-s-file-name))))
- (feedmail-say-chatter "Queued in %s" filename)
- (if feedmail-queue-chatty
- (progn
- (feedmail-queue-reminder what-event)
- (sit-for feedmail-queue-chatty-sit-for)))))
+ (is-fqm)
+ (is-in-this-dir)
+ (previous-buffer-file-name buffer-file-name))
+ (if buffer-file-name
+ (progn
+ (setq is-fqm (feedmail-fqm-p buffer-file-name))
+ (setq is-in-this-dir (string-equal
+ (directory-file-name
+ (expand-file-name queue-directory))
+ (directory-file-name
+ (expand-file-name
+ (file-name-directory buffer-file-name)))))))
+ ;; if visiting a queued message, just save
+ (if (and is-fqm is-in-this-dir)
+ (setq filename buffer-file-name)
+ (setq filename (feedmail-create-queue-filename queue-directory)))
+ ;; make binary file on DOS/Win95/WinNT, etc
+ (let ((coding-system-for-write 'binary))
+ (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))
+ (let (d b s)
+ (setq b (file-name-nondirectory previous-buffer-file-name))
+ (setq d (file-name-directory previous-buffer-file-name))
+ (setq s (substring d (1- (length d))))
+ (setq d (substring d 0 (1- (length d))))
+ (setq d (file-name-nondirectory d))
+ (y-or-n-p
+ (format "FQM: Was previously %s%s%s; delete that? " d s b))))
+ (delete-file previous-buffer-file-name))
+ (if feedmail-nuke-buffer-after-queue
+ (let ((a-s-file-name buffer-auto-save-file-name))
+ ;; be aggressive in nuking auto-save files
+ (and (kill-buffer (current-buffer))
+ delete-auto-save-files
+ (file-exists-p a-s-file-name)
+ (delete-file a-s-file-name))))
+ (feedmail-say-chatter "Queued in %s" filename)
+ (if feedmail-queue-chatty
+ (progn
+ (feedmail-queue-reminder what-event)
+ (sit-for feedmail-queue-chatty-sit-for)))))
;; from a similar function in mail-utils.el
(defun feedmail-rfc822-time-zone (time)
(feedmail-say-debug ">in-> feedmail-rfc822-time-zone %s" time)
(let* ((sec (or (car (current-time-zone time)) 0))
- (absmin (/ (abs sec) 60)))
+ (absmin (/ (abs sec) 60)))
(format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60))))
(defun feedmail-rfc822-date (arg-time)
(feedmail-say-debug ">in-> feedmail-rfc822-date %s" arg-time)
- (let ((time (if arg-time arg-time (current-time)))
- (system-time-locale "C"))
- (concat
- (format-time-string "%a, %e %b %Y %T " time)
- (feedmail-rfc822-time-zone time)
- )))
+ (let ((time (if arg-time arg-time (current-time))))
+ (concat
+ (format-time-string "%a, %e %b %Y %T " time)
+ (feedmail-rfc822-time-zone time))))
(defun feedmail-send-it-immediately-wrapper ()
"Wrapper to catch skip-me-i"
(if (eq 'skip-me-i (catch 'skip-me-i (feedmail-send-it-immediately)))
- (error "FQM: Sending...abandonned!")))
+ (error "FQM: Sending...abandonned!")))
(defun feedmail-send-it-immediately ()
"Handle immediate sending, including during a queue run."
(feedmail-say-debug ">in-> feedmail-send-it-immediately")
- (let ((feedmail-error-buffer (get-buffer-create " *FQM Outgoing Email Errors*"))
- (feedmail-prepped-text-buffer (get-buffer-create " *FQM Outgoing Email Text*"))
- (feedmail-raw-text-buffer (current-buffer))
- (feedmail-address-list)
- (eoh-marker)
- (bcc-holder)
- (resent-bcc-holder)
- (a-re-rtcb "^RESENT-\\(TO\\|CC\\|BCC\\):")
- (a-re-rtc "^RESENT-\\(TO\\|CC\\):")
- (a-re-rb "^RESENT-BCC:")
- (a-re-dtcb "^\\(TO\\|CC\\|BCC\\):")
- (a-re-dtc "^\\(TO\\|CC\\):")
- (a-re-db "^BCC:")
- (mail-header-separator mail-header-separator) ;; to get a temporary changable copy
- )
+ (let ((feedmail-error-buffer
+ (get-buffer-create " *FQM Outgoing Email Errors*"))
+ (feedmail-prepped-text-buffer
+ (get-buffer-create " *FQM Outgoing Email Text*"))
+ (feedmail-raw-text-buffer (current-buffer))
+ (feedmail-address-list)
+ (eoh-marker)
+ (bcc-holder)
+ (resent-bcc-holder)
+ (a-re-rtcb "^RESENT-\\(TO\\|CC\\|BCC\\):")
+ (a-re-rtc "^RESENT-\\(TO\\|CC\\):")
+ (a-re-rb "^RESENT-BCC:")
+ (a-re-dtcb "^\\(TO\\|CC\\|BCC\\):")
+ (a-re-dtc "^\\(TO\\|CC\\):")
+ (a-re-db "^BCC:")
+ (mail-header-separator mail-header-separator))
(unwind-protect
- (save-excursion
- (set-buffer feedmail-error-buffer) (erase-buffer)
- (set-buffer feedmail-prepped-text-buffer) (erase-buffer)
-
- ;; jam contents of user-supplied mail buffer into our scratch buffer
- (insert-buffer feedmail-raw-text-buffer)
-
- ;; require one newline at the end.
- (goto-char (point-max))
- (or (= (preceding-char) ?\n) (insert ?\n))
-
- (let ((case-fold-search nil))
- ;; Change header-delimiter to be what mailers expect (empty line).
- (feedmail-say-debug "looking for m-h-s \"%s\"" mail-header-separator)
- (setq eoh-marker (feedmail-find-eoh)) ;; leaves match data in place or signals error
- (feedmail-say-debug "found m-h-s %s" eoh-marker)
- (setq mail-header-separator "")
- (replace-match ""))
+ (save-excursion
+ (set-buffer feedmail-error-buffer) (erase-buffer)
+ (set-buffer feedmail-prepped-text-buffer) (erase-buffer)
+
+ ;; jam contents of user-supplied mail buffer into our scratch buffer
+ (insert-buffer feedmail-raw-text-buffer)
+
+ ;; require one newline at the end.
+ (goto-char (point-max))
+ (or (= (preceding-char) ?\n) (insert ?\n))
+
+ (let ((case-fold-search nil))
+ ;; Change header-delimiter to be what mailers expect (empty line).
+ (feedmail-say-debug "looking for m-h-s \"%s\"" mail-header-separator)
+ (setq eoh-marker (feedmail-find-eoh)) ;; leaves match data
+ ;; in place or
+ ;; signals error
+ (feedmail-say-debug "found m-h-s %s" eoh-marker)
+ (setq mail-header-separator "")
+ (replace-match ""))
;;