;;; Code:
(require 'nnheader)
-(require 'rmail)
(require 'timezone)
(require 'sendmail)
+(require 'message)
(eval-when-compile (require 'cl))
(defvar nnmail-split-methods
;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
(defvar nnmail-keep-last-article nil
- "*If non-nil, nnmail will never delete the last expired article in a
-directory. You may need to set this variable if other programs are putting
+ "*If non-nil, nnmail will never delete the last expired article in a directory.
+You may need to set this variable if other programs are putting
new mail into folder numbers that Gnus has marked as expired.")
(defvar nnmail-use-long-file-names nil
\(& SPLIT...): Process each SPLIT expression.
FIELD must match a complete field name. VALUE must match a complete
-word according to the fundamental mode syntax table. You can use .*
-in the regexps to match partial field names or words.
+word according to the `nnmail-split-fancy-syntax-table' syntax table.
+You can use .* in the regexps to match partial field names or words.
FIELD and VALUE can also be lisp symbols, in that case they are expanded
as specified in `nnmail-split-abbrev-alist'.
;;; Internal variables.
+(defvar nnmail-split-fancy-syntax-table
+ (copy-syntax-table (standard-syntax-table))
+ "Syntax table used by `nnmail-split-fancy'.")
+
+(defvar nnmail-prepare-save-mail-hook nil
+ "Hook called before saving mail.")
+
\f
(defconst nnmail-version "nnmail 1.0"
(set-buffer nntp-server-buffer)
(erase-buffer)
(condition-case ()
- (progn (insert-file-contents file) t)
+ (progn (nnheader-insert-raw-file-contents file) t)
(file-error nil)))
(defun nnmail-group-pathname (group dir &optional file)
(erase-buffer)
(while group-assoc
(setq group (pop group-assoc))
- (insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) )
- (car (car (cdr group))))))
+ (insert (format "%s %d %d y\n" (car group) (cdadr group)
+ (caadr group))))
(unless (file-exists-p (file-name-directory file-name))
(make-directory (file-name-directory file-name) t))
(write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg)
;; Go to the beginning of the next article - or to the end
;; of the buffer.
(if do-search
- (if (re-search-forward "\n\1f" nil t)
- (goto-char (+ 1 (match-beginning 0)))
- (goto-char (- (point-max) 1))))
+ (if (re-search-forward "^\1f" nil t)
+ (goto-char (match-beginning 0))
+ (goto-char (1- (point-max)))))
(delete-char 1) ; delete ^_
(save-excursion
(save-restriction
(setq end (point-max))))
(goto-char end))))
+(defun nnmail-search-unix-mail-delim ()
+ "Put point at the beginning of the next message."
+ (let ((case-fold-search t)
+ (delim (concat "^" message-unix-mail-delimiter))
+ found)
+ (while (not found)
+ (if (re-search-forward delim nil t)
+ (when (or (looking-at "[^\n :]+ *:")
+ (looking-at delim)
+ (looking-at (concat ">" message-unix-mail-delimiter)))
+ (forward-line -1)
+ (setq found 'yes))
+ (setq found 'no)))
+ (eq found 'yes)))
+
(defun nnmail-process-unix-mail-format (func)
(let ((case-fold-search t)
- (delim (concat "^" rmail-unix-mail-delimiter))
+ (delim (concat "^" message-unix-mail-delimiter))
start message-id content-length end skip head-end)
(goto-char (point-min))
(if (not (and (re-search-forward delim nil t)
(insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
;; Look for a Content-Length header.
(goto-char (point-min))
- (if (not (re-search-forward "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
+ (if (not (re-search-forward
+ "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
(setq content-length nil)
(setq content-length (string-to-int (match-string 1)))
;; We destroy the header, since none of the backends ever
(goto-char (point-max))
(widen)
(setq head-end (point))
- ;; We try the Content-Length value.
+ ;; We try the Content-Length value. The idea: skip over the header
+ ;; separator, then check what happens content-length bytes into the
+ ;; message body. This should be either the end ot the buffer, the
+ ;; message separator or a blank line followed by the separator.
+ ;; The blank line should probably be deleted. If neither of the
+ ;; three is met, the content-length header is probably invalid.
(when content-length
(forward-line 1)
(setq skip (+ (point) content-length))
- (when (or (= skip (point-max))
- (and (< skip (point-max))
- (goto-char skip)
- (looking-at delim)))
- (setq end skip)))
+ (goto-char skip)
+ (cond ((or (= skip (point-max))
+ (= (1+ skip) (point-max)))
+ (setq end (point-max)))
+ ((looking-at delim)
+ (setq end skip))
+ ((looking-at
+ (concat "[ \t]*\n\\(" delim "\\)"))
+ (setq end (match-beginning 1)))
+ (t (setq end nil))))
(if end
(goto-char end)
;; No Content-Length, so we find the beginning of the next
;; article or the end of the buffer.
(goto-char head-end)
- (if (re-search-forward delim nil t)
- (goto-char (match-beginning 0))
- (goto-char (point-max))))
+ (or (nnmail-search-unix-mail-delim)
+ (goto-char (point-max))))
;; Allow the backend to save the article.
(save-excursion
(save-restriction
nnmail-use-procmail)
(not nnmail-resplit-incoming))
(list (list group ""))
- nnmail-split-methods))
- start end do-search message-id)
+ nnmail-split-methods)))
(save-excursion
- ;; Open the message-id cache.
- (nnmail-cache-open)
;; Insert the incoming file.
(set-buffer (get-buffer-create " *nnmail incoming*"))
(buffer-disable-undo (current-buffer))
(erase-buffer)
- (insert-file-contents incoming)
- (goto-char (point-min))
- (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
- ;; Handle both babyl, MMDF and unix mail formats, since movemail will
- ;; use the former when fetching from a mailbox, the latter when
- ;; fetches from a file.
- (cond ((or (looking-at "\^L")
- (looking-at "BABYL OPTIONS:"))
- (nnmail-process-babyl-mail-format func))
- ((looking-at "\^A\^A\^A\^A")
- (nnmail-process-mmdf-mail-format func))
- (t
- (nnmail-process-unix-mail-format func)))
- ;; Close the message-id cache.
- (nnmail-cache-close)
+ (nnheader-insert-raw-file-contents incoming)
+ (unless (zerop (buffer-size))
+ (goto-char (point-min))
+ (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
+ ;; Handle both babyl, MMDF and unix mail formats, since movemail will
+ ;; use the former when fetching from a mailbox, the latter when
+ ;; fetches from a file.
+ (cond ((or (looking-at "\^L")
+ (looking-at "BABYL OPTIONS:"))
+ (nnmail-process-babyl-mail-format func))
+ ((looking-at "\^A\^A\^A\^A")
+ (nnmail-process-mmdf-mail-format func))
+ (t
+ (nnmail-process-unix-mail-format func))))
(if exit-func (funcall exit-func))
(kill-buffer (current-buffer)))))
;; If there is only just one group to put everything in, we
;; just return a list with just this one method in.
(setq group-art
- (list (cons (car (car methods))
- (funcall func (car (car methods))))))
+ (list (cons (caar methods) (funcall func (caar methods)))))
;; We do actual comparison.
(save-excursion
;; Find headers.
(when (and
(condition-case ()
(if (stringp (nth 1 method))
- (re-search-backward (car (cdr method)) nil t)
+ (re-search-backward (cadr method) nil t)
;; Function to say whether this is a match.
(funcall (nth 1 method) (car method)))
(error nil))
(progn (forward-line 1) (point))))
(insert (format "Xref: %s" (system-name)))
(while group-alist
- (insert (format " %s:%d" (car (car group-alist))
- (cdr (car group-alist))))
+ (insert (format " %s:%d" (caar group-alist) (cdar group-alist)))
(setq group-alist (cdr group-alist)))
(insert "\n"))))
(defun nnmail-split-fancy ()
"Fancy splitting method.
See the documentation for the variable `nnmail-split-fancy' for documentation."
- (nnmail-split-it nnmail-split-fancy))
+ (let ((syntab (syntax-table)))
+ (unwind-protect
+ (progn
+ (set-syntax-table nnmail-split-fancy-syntax-table)
+ (nnmail-split-it nnmail-split-fancy))
+ (set-syntax-table syntab))))
(defvar nnmail-split-cache nil)
;; Alist of split expressions their equivalent regexps.
t))
(defun nnmail-message-id ()
- (concat "<" (nnmail-unique-id) "@totally-fudged-out-message-id>"))
-
-(defvar nnmail-unique-id-char nil)
-
-(defun nnmail-number-base36 (num len)
- (if (if (< len 0) (<= num 0) (= len 0))
- ""
- (concat (nnmail-number-base36 (/ num 36) (1- len))
- (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
- (% num 36))))))
-
-(defun nnmail-unique-id ()
- (setq nnmail-unique-id-char
- (% (1+ (or nnmail-unique-id-char (logand (random t) (1- (lsh 1 20)))))
- ;; (current-time) returns 16-bit ints,
- ;; and 2^16*25 just fits into 4 digits i base 36.
- (* 25 25)))
- (let ((tm (if (fboundp 'current-time)
- (current-time) '(12191 46742 287898))))
- (concat
- (nnmail-number-base36 (+ (car tm)
- (lsh (% nnmail-unique-id-char 25) 16)) 4)
- (nnmail-number-base36 (+ (nth 1 tm)
- (lsh (/ nnmail-unique-id-char 25) 16)) 4))))
+ (concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
;;;
;;; nnmail duplicate handling
(buffer-disable-undo (current-buffer))
(and (file-exists-p nnmail-message-id-cache-file)
(insert-file-contents nnmail-message-id-cache-file))
+ (set-buffer-modified-p nil)
(current-buffer))))
(defun nnmail-cache-close ()
t))
(write-region (point-min) (point-max)
nnmail-message-id-cache-file nil 'silent)
- (set-buffer-modified-p nil))))
+ (set-buffer-modified-p nil)
+ (setq nnmail-cache-buffer nil)
+ ;;(kill-buffer (current-buffer))
+ )))
(defun nnmail-cache-insert (id)
(when nnmail-treat-duplicates
(beginning-of-line)
(insert "Original-"))
(beginning-of-line)
- (insert "Message-ID: " newid "\n")
- (insert "Gnus-Warning: This is a duplication of message "
- message-id "\n")
+ (insert
+ "Message-ID: " newid "\n"
+ "Gnus-Warning: This is a duplicate of message " message-id "\n")
(nnmail-cache-insert newid)
(funcall func)))
(t
(nnmail-activate method)
;; Allow the user to hook.
(run-hooks 'nnmail-pre-get-new-mail-hook)
+ ;; Open the message-id cache.
+ (nnmail-cache-open)
;; The we go through all the existing spool files and split the
;; mail from each.
(while spools
(funcall exit-func))
(run-hooks 'nnmail-read-incoming-hook)
(nnheader-message 3 "%s: Reading incoming mail...done" method))
+ ;; Close the message-id cache.
+ (nnmail-cache-close)
;; Allow the user to hook.
(run-hooks 'nnmail-post-get-new-mail-hook)
;; Delete all the temporary files.
projects / gnus / blobdiff