Mercurial > emacs

comparison lisp/gnus/nnbabyl.el @ 88155:d7ddb3e565de

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 0d8b17d428b5
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 ;;; nnbabyl.el --- rmail mbox access for Gnus 1 ;;; nnbabyl.el --- rmail mbox access for Gnus
2 2
3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000 3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000, 2001, 2002, 2003,
4 ;; Free Software Foundation, Inc. 4 ;; 2004, 2005 Free Software Foundation, Inc.
5 5
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 7 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
8 ;; Keywords: news, mail 8 ;; Keywords: news, mail
9 9
10 ;; This file is part of GNU Emacs. 10 ;; This file is part of GNU Emacs.
11 11
12 ;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;; GNU Emacs is free software; you can redistribute it and/or modify
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details. 20 ;; GNU General Public License for more details.
21 21
22 ;; You should have received a copy of the GNU General Public License 22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the 23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02111-1307, USA. 25 ;; Boston, MA 02110-1301, USA.
26 26
27 ;;; Commentary: 27 ;;; Commentary:
28 28
29 ;; For an overview of what the interface functions do, please see the 29 ;; For an overview of what the interface functions do, please see the
30 ;; Gnus sources. 30 ;; Gnus sources.
48 (defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active") 48 (defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active")
49 "The name of the active file for the rmail box.") 49 "The name of the active file for the rmail box.")
50 50
51 (defvoo nnbabyl-get-new-mail t 51 (defvoo nnbabyl-get-new-mail t
52 "If non-nil, nnbabyl will check the incoming mail file and split the mail.") 52 "If non-nil, nnbabyl will check the incoming mail file and split the mail.")
53
53 54
54 (defvoo nnbabyl-prepare-save-mail-hook nil 55 (defvoo nnbabyl-prepare-save-mail-hook nil
55 "Hook run narrowed to an article before saving.") 56 "Hook run narrowed to an article before saving.")
56 57
57 58
285 (nnbabyl-request-article (car articles) 286 (nnbabyl-request-article (car articles)
286 newsgroup server 287 newsgroup server
287 (current-buffer)) 288 (current-buffer))
288 (let ((nnml-current-directory nil)) 289 (let ((nnml-current-directory nil))
289 (nnmail-expiry-target-group 290 (nnmail-expiry-target-group
290 nnmail-expiry-target newsgroup)))) 291 nnmail-expiry-target newsgroup)))
292 (nnbabyl-possibly-change-newsgroup newsgroup server))
291 (nnheader-message 5 "Deleting article %d in %s..." 293 (nnheader-message 5 "Deleting article %d in %s..."
292 (car articles) newsgroup) 294 (car articles) newsgroup)
293 (nnbabyl-delete-mail)) 295 (nnbabyl-delete-mail))
294 (push (car articles) rest))) 296 (push (car articles) rest)))
295 (setq articles (cdr articles))) 297 (setq articles (cdr articles)))
345 (forward-line -1) 347 (forward-line -1)
346 (save-excursion 348 (save-excursion
347 (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) 349 (while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
348 (delete-region (point) (progn (forward-line 1) (point))))) 350 (delete-region (point) (progn (forward-line 1) (point)))))
349 (when nnmail-cache-accepted-message-ids 351 (when nnmail-cache-accepted-message-ids
350 (nnmail-cache-insert (nnmail-fetch-field "message-id"))) 352 (nnmail-cache-insert (nnmail-fetch-field "message-id")
353 group
354 (nnmail-fetch-field "subject")
355 (nnmail-fetch-field "from")))
351 (setq result 356 (setq result
352 (if (stringp group) 357 (if (stringp group)
353 (list (cons group (nnbabyl-active-number group))) 358 (list (cons group (nnbabyl-active-number group)))
354 (nnmail-article-group 'nnbabyl-active-number))) 359 (nnmail-article-group 'nnbabyl-active-number)))
355 (if (and (null result) 360 (if (and (null result)
361 (search-backward "\n\^_") 366 (search-backward "\n\^_")
362 (goto-char (match-end 0)) 367 (goto-char (match-end 0))
363 (insert-buffer-substring buf) 368 (insert-buffer-substring buf)
364 (when last 369 (when last
365 (when nnmail-cache-accepted-message-ids 370 (when nnmail-cache-accepted-message-ids
366 (nnmail-cache-insert (nnmail-fetch-field "message-id"))) 371 (nnmail-cache-insert (nnmail-fetch-field "message-id")
372 group
373 (nnmail-fetch-field "subject")
374 (nnmail-fetch-field "from")))
367 (save-buffer) 375 (save-buffer)
368 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) 376 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
369 result)))) 377 result))))
370 378
371 (deffoo nnbabyl-request-replace-article (article group buffer) 379 (deffoo nnbabyl-request-replace-article (article group buffer)
483 (save-excursion 491 (save-excursion
484 (goto-char (point-min)) 492 (goto-char (point-min))
485 (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " 493 (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
486 nil t) 494 nil t)
487 (cons (buffer-substring (match-beginning 1) (match-end 1)) 495 (cons (buffer-substring (match-beginning 1) (match-end 1))
488 (string-to-int 496 (string-to-number
489 (buffer-substring (match-beginning 2) (match-end 2))))))) 497 (buffer-substring (match-beginning 2) (match-end 2)))))))
490 498
491 (defun nnbabyl-insert-lines () 499 (defun nnbabyl-insert-lines ()
492 "Insert how many lines and chars there are in the body of the mail." 500 "Insert how many lines and chars there are in the body of the mail."
493 (let (lines chars) 501 (let (lines chars)
658 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) 666 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
659 (nnheader-message 5 "")))) 667 (nnheader-message 5 ""))))
660 668
661 (provide 'nnbabyl) 669 (provide 'nnbabyl)
662 670
671 ;;; arch-tag: aa7ddedb-8c07-4c0e-beb0-58e795c2b81b
663 ;;; nnbabyl.el ends here 672 ;;; nnbabyl.el ends here