X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnbabyl.el;h=a0a8d8b79305b0dda3bcc6e46ec95a542eb1f4c3;hp=7217baa75ee9facd638569ed5c5a637bdb6209e7;hb=c881c2e5d77a85b1a0d46785ffc3e10228c78175;hpb=58b9ce04e4a9a05edbfd556a4caf6a265907aae4 diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el index 7217baa75..a0a8d8b79 100644 --- a/lisp/nnbabyl.el +++ b/lisp/nnbabyl.el @@ -1,8 +1,10 @@ ;;; nnbabyl.el --- rmail mbox access for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA +;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; Masanobu UMEDA ;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -19,8 +21,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: @@ -30,7 +32,10 @@ ;;; Code: (require 'nnheader) -(require 'rmail) +(condition-case nil + (require 'rmail) + (t (nnheader-message + 5 "Ignore rmail errors from this file, you don't have rmail"))) (require 'nnmail) (require 'nnoo) (eval-when-compile (require 'cl)) @@ -46,6 +51,7 @@ (defvoo nnbabyl-get-new-mail t "If non-nil, nnbabyl will check the incoming mail file and split the mail.") + (defvoo nnbabyl-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") @@ -64,9 +70,6 @@ (defvoo nnbabyl-previous-buffer-mode nil) -(eval-and-compile - (autoload 'gnus-set-text-properties "gnus-ems")) - ;;; Interface functions @@ -240,7 +243,7 @@ (nnmail-activate 'nnbabyl) (unless (assoc group nnbabyl-group-alist) (push (list group (cons 1 0)) - nnbabyl-group-alist) + nnbabyl-group-alist) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) t) @@ -257,7 +260,7 @@ (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented.")) (deffoo nnbabyl-request-expire-articles - (articles newsgroup &optional server force) + (articles newsgroup &optional server force) (nnbabyl-possibly-change-newsgroup newsgroup server) (let* ((is-old t) rest) @@ -265,7 +268,7 @@ (save-excursion (set-buffer nnbabyl-mbox-buffer) - (gnus-set-text-properties (point-min) (point-max) nil) + (set-text-properties (point-min) (point-max) nil) (while (and articles is-old) (goto-char (point-min)) (when (search-forward (nnbabyl-article-string (car articles)) nil t) @@ -275,6 +278,15 @@ (buffer-substring (point) (progn (end-of-line) (point))) force)) (progn + (unless (eq nnmail-expiry-target 'delete) + (with-temp-buffer + (nnbabyl-request-article (car articles) + newsgroup server + (current-buffer)) + (let ((nnml-current-directory nil)) + (nnmail-expiry-target-group + nnmail-expiry-target newsgroup))) + (nnbabyl-possibly-change-newsgroup newsgroup server)) (nnheader-message 5 "Deleting article %d in %s..." (car articles) newsgroup) (nnbabyl-delete-mail)) @@ -293,7 +305,7 @@ (nconc rest articles)))) (deffoo nnbabyl-request-move-article - (article group server accept-form &optional last) + (article group server accept-form &optional last move-is-internal) (let ((buf (get-buffer-create " *nnbabyl move*")) result) (and @@ -334,12 +346,16 @@ (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) (delete-region (point) (progn (forward-line 1) (point))))) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (nnmail-cache-insert (nnmail-fetch-field "message-id") + group + (nnmail-fetch-field "subject") + (nnmail-fetch-field "from"))) (setq result (if (stringp group) (list (cons group (nnbabyl-active-number group))) (nnmail-article-group 'nnbabyl-active-number))) - (if (null result) + (if (and (null result) + (yes-or-no-p "Moved to `junk' group; delete article? ")) (setq result 'junk) (setq result (car (nnbabyl-save-mail result)))) (set-buffer nnbabyl-mbox-buffer) @@ -349,7 +365,10 @@ (insert-buffer-substring buf) (when last (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (nnmail-cache-insert (nnmail-fetch-field "message-id") + group + (nnmail-fetch-field "subject") + (nnmail-fetch-field "from"))) (save-buffer) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) result)))) @@ -428,9 +447,9 @@ (widen) (narrow-to-region (save-excursion - (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) - (goto-char (point-min)) - (end-of-line)) + (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) + (goto-char (point-min)) + (end-of-line)) (if leave-delim (progn (forward-line 1) (point)) (match-beginning 0))) (progn @@ -471,7 +490,7 @@ (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " nil t) (cons (buffer-substring (match-beginning 1) (match-end 1)) - (string-to-int + (string-to-number (buffer-substring (match-beginning 2) (match-end 2))))))) (defun nnbabyl-insert-lines () @@ -554,10 +573,10 @@ (nnbabyl-create-mbox) (unless (and nnbabyl-mbox-buffer - (buffer-name nnbabyl-mbox-buffer) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file)))) + (buffer-name nnbabyl-mbox-buffer) + (save-excursion + (set-buffer nnbabyl-mbox-buffer) + (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file)))) ;; This buffer has changed since we read it last. Possibly. (save-excursion (let ((delim (concat "^" nnbabyl-mail-delimiter)) @@ -565,13 +584,13 @@ start end number) (set-buffer (setq nnbabyl-mbox-buffer (nnheader-find-file-noselect - nnbabyl-mbox-file nil 'raw))) + nnbabyl-mbox-file nil t))) ;; Save previous buffer mode. (setq nnbabyl-previous-buffer-mode (cons (cons (point-min) (point-max)) major-mode)) - (buffer-disable-undo (current-buffer)) + (buffer-disable-undo) (widen) (setq buffer-read-only nil) (fundamental-mode) @@ -642,8 +661,9 @@ (when (buffer-modified-p (current-buffer)) (save-buffer)) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - (message "")))) + (nnheader-message 5 "")))) (provide 'nnbabyl) +;;; arch-tag: aa7ddedb-8c07-4c0e-beb0-58e795c2b81b ;;; nnbabyl.el ends here