annotate lisp/nnml.el @ 14789:d68b71228abd

(bibtex-pop): New generic function which unifies the functionality of bibtex-pop-previous and bibtex-pop-next. Now, bibtex-pop moves to the end of field after the pop. Concatenated strings are now handled correctly. Delimiters are not added to non-delimited entries. Changed occurences of bibtex-text-in-cfield to bibtex-text-in-field. (bibtex-pop-previous, bibtex-pop-next): Call bibtex-pop. (bibtex-complete-string): Fixed bug that removed delimiters around the following field if current field is already undelimited on completion. (bibtex-complete-string, bibtex-remove-double-quotes-or-braces): Only remove delimiters if field text is not concatenated. (bibtex-font-lock-keywords): Use the same regexps used in all other places of bibtex.el to parse the buffer. (bibtex-mode): Changed the definition of font-lock-defaults, so that quote-delimited entries aren't fontified as strings anymore. (bibtex-parse-keys): Changed the regexp used for finding crossref entries. (bibtex-field-const, bibtex-reference-key): Fixed the regexp to match more of the characters allowed here by BibTeX/LaTeX. (bibtex-field-name): Made it less restrictive. (bibtex-field-string): Changed so that quote-delimited entries with quotes inside aren't a problem anymore. Changed nesting level of braces in entries to support three inner braces. (bibtex-validate-buffer): By giving an optional argument, the user can now let it not validate the whole buffer, but only the portion starting at point. Small modification in strategy used to find next entry. (bibtex-print-help-message): Ignore case in field name when searching for help text. (bibtex-submit-bug-report): New function.
author Richard M. Stallman <rms@gnu.org>
date Fri, 08 Mar 1996 17:42:30 +0000
parents 83f275dcd93a
children 530d0d516a42
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1 ;;; nnml.el --- mail spool access for Gnus
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14040
diff changeset
2
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
3 ;; Copyright (C) 1995 Free Software Foundation, Inc.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
4
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
5 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
6 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
7 ;; Keywords: news, mail
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
8
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
10
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
14 ;; any later version.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
15
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
20
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14040
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14040
diff changeset
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14040
diff changeset
24 ;; Boston, MA 02111-1307, USA.
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
25
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
26 ;;; Commentary:
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
27
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
28 ;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
29 ;; For an overview of what the interface functions do, please see the
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
30 ;; Gnus sources.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
31
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
32 ;;; Code:
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
33
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
34 (require 'nnheader)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
35 (require 'nnmail)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
36
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
37 (defvar nnml-directory "~/Mail/"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
38 "Mail spool directory.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
39
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
40 (defvar nnml-active-file (concat nnml-directory "active")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
41 "Mail active file.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
42
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
43 (defvar nnml-newsgroups-file (concat nnml-directory "newsgroups")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
44 "Mail newsgroups description file.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
45
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
46 (defvar nnml-get-new-mail t
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
47 "If non-nil, nnml will check the incoming mail file and split the mail.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
48
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
49 (defvar nnml-nov-is-evil nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
50 "If non-nil, Gnus will never generate and use nov databases for mail groups.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
51 Using nov databases will speed up header fetching considerably.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
52 This variable shouldn't be flipped much. If you have, for some reason,
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
53 set this to t, and want to set it to nil again, you should always run
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
54 the `nnml-generate-nov-databases' command. The function will go
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
55 through all nnml directories and generate nov databases for them
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
56 all. This may very well take some time.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
57
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
58 (defvar nnml-prepare-save-mail-hook nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
59 "Hook run narrowed to an article before saving.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
60
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
61
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
62
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
63 (defconst nnml-version "nnml 1.0"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
64 "nnml version.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
65
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
66 (defvar nnml-nov-file-name ".overview")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
67
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
68 (defvar nnml-current-directory nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
69 (defvar nnml-status-string "")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
70 (defvar nnml-nov-buffer-alist nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
71 (defvar nnml-group-alist nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
72 (defvar nnml-active-timestamp nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
73
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
74
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
75
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
76 ;; Server variables.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
77
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
78 (defvar nnml-current-server nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
79 (defvar nnml-server-alist nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
80 (defvar nnml-server-variables
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
81 (list
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
82 (list 'nnml-directory nnml-directory)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
83 (list 'nnml-active-file nnml-active-file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
84 (list 'nnml-newsgroups-file nnml-newsgroups-file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
85 (list 'nnml-get-new-mail nnml-get-new-mail)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
86 (list 'nnml-nov-is-evil nnml-nov-is-evil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
87 (list 'nnml-nov-file-name nnml-nov-file-name)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
88 '(nnml-current-directory nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
89 '(nnml-status-string "")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
90 '(nnml-nov-buffer-alist nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
91 '(nnml-group-alist nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
92 '(nnml-active-timestamp nil)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
93
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
94
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
95
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
96 ;;; Interface functions.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
97
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
98 (defun nnml-retrieve-headers (sequence &optional newsgroup server)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
99 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
100 (set-buffer nntp-server-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
101 (erase-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
102 (let ((file nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
103 (number (length sequence))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
104 (count 0)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
105 beg article)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
106 (if (stringp (car sequence))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
107 'headers
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
108 (nnml-possibly-change-directory newsgroup)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
109 (if (nnml-retrieve-headers-with-nov sequence)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
110 'nov
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
111 (while sequence
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
112 (setq article (car sequence))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
113 (setq file
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
114 (concat nnml-current-directory (int-to-string article)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
115 (if (and (file-exists-p file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
116 (not (file-directory-p file)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
117 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
118 (insert (format "221 %d Article retrieved.\n" article))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
119 (setq beg (point))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
120 (nnheader-insert-head file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
121 (goto-char beg)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
122 (if (search-forward "\n\n" nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
123 (forward-char -1)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
124 (goto-char (point-max))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
125 (insert "\n\n"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
126 (insert ".\n")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
127 (delete-region (point) (point-max))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
128 (setq sequence (cdr sequence))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
129 (setq count (1+ count))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
130 (and (numberp nnmail-large-newsgroup)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
131 (> number nnmail-large-newsgroup)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
132 (zerop (% count 20))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
133 gnus-verbose-backends
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
134 (message "nnml: Receiving headers... %d%%"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
135 (/ (* count 100) number))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
136
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
137 (and (numberp nnmail-large-newsgroup)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
138 (> number nnmail-large-newsgroup)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
139 gnus-verbose-backends
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
140 (message "nnml: Receiving headers...done"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
141
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
142 ;; Fold continuation lines.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
143 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
144 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
145 (replace-match " " t t))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
146 'headers)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
147
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
148 (defun nnml-open-server (server &optional defs)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
149 (nnheader-init-server-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
150 (if (equal server nnml-current-server)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
151 t
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
152 (if nnml-current-server
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
153 (setq nnml-server-alist
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
154 (cons (list nnml-current-server
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
155 (nnheader-save-variables nnml-server-variables))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
156 nnml-server-alist)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
157 (let ((state (assoc server nnml-server-alist)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
158 (if state
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
159 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
160 (nnheader-restore-variables (nth 1 state))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
161 (setq nnml-server-alist (delq state nnml-server-alist)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
162 (nnheader-set-init-variables nnml-server-variables defs)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
163 (setq nnml-current-server server)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
164
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
165 (defun nnml-close-server (&optional server)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
166 t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
167
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
168 (defun nnml-server-opened (&optional server)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
169 (and (equal server nnml-current-server)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
170 nntp-server-buffer
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
171 (buffer-name nntp-server-buffer)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
172
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
173 (defun nnml-status-message (&optional server)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
174 nnml-status-string)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
175
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
176 (defun nnml-request-article (id &optional newsgroup server buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
177 (nnml-possibly-change-directory newsgroup)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
178 (let ((file (if (stringp id)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
179 nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
180 (concat nnml-current-directory (int-to-string id))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
181 (nntp-server-buffer (or buffer nntp-server-buffer)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
182 (if (and (stringp file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
183 (file-exists-p file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
184 (not (file-directory-p file)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
185 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
186 (nnmail-find-file file)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
187
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
188 (defun nnml-request-group (group &optional server dont-check)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
189 (if (not (nnml-possibly-change-directory group))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
190 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
191 (setq nnml-status-string "Invalid group (no such directory)")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
192 nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
193 (if dont-check
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
194 t
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
195 (nnml-get-new-mail group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
196 (nnmail-activate 'nnml)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
197 (let ((active (nth 1 (assoc group nnml-group-alist))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
198 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
199 (set-buffer nntp-server-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
200 (erase-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
201 (if (not active)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
202 ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
203 (insert (format "211 %d %d %d %s\n"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
204 (max (1+ (- (cdr active) (car active))) 0)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
205 (car active) (cdr active) group))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
206 t))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
207
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
208 (defun nnml-close-group (group &optional server)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
209 t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
210
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
211 (defun nnml-request-close ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
212 (setq nnml-current-server nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
213 (setq nnml-server-alist nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
214 t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
215
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
216 (defun nnml-request-create-group (group &optional server)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
217 (nnmail-activate 'nnml)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
218 (or (assoc group nnml-group-alist)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
219 (let (active)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
220 (setq nnml-group-alist (cons (list group (setq active (cons 1 0)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
221 nnml-group-alist))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
222 (nnml-possibly-create-directory group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
223 (nnml-possibly-change-directory group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
224 (let ((articles (mapcar
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
225 (lambda (file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
226 (string-to-int file))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
227 (directory-files
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
228 nnml-current-directory nil "^[0-9]+$"))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
229 (and articles
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
230 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
231 (setcar active (apply 'min articles))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
232 (setcdr active (apply 'max articles)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
233 (nnmail-save-active nnml-group-alist nnml-active-file)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
234 t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
235
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
236 (defun nnml-request-list (&optional server)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
237 (if server (nnml-get-new-mail))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
238 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
239 (nnmail-find-file nnml-active-file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
240 (setq nnml-group-alist (nnmail-get-active))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
241
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
242 (defun nnml-request-newgroups (date &optional server)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
243 (nnml-request-list server))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
244
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
245 (defun nnml-request-list-newsgroups (&optional server)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
246 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
247 (nnmail-find-file nnml-newsgroups-file)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
248
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
249 (defun nnml-request-post (&optional server)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
250 (mail-send-and-exit nil))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
251
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
252 (defalias 'nnml-request-post-buffer 'nnmail-request-post-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
253
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
254 (defun nnml-request-expire-articles (articles newsgroup &optional server force)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
255 (nnml-possibly-change-directory newsgroup)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
256 (let* ((days (or (and nnmail-expiry-wait-function
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
257 (funcall nnmail-expiry-wait-function newsgroup))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
258 nnmail-expiry-wait))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
259 (active-articles
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
260 (mapcar
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
261 (function
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
262 (lambda (name)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
263 (string-to-int name)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
264 (directory-files nnml-current-directory nil "^[0-9]+$" t)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
265 (max-article (and active-articles (apply 'max active-articles)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
266 (is-old t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
267 article rest mod-time)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
268 (nnmail-activate 'nnml)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
269
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
270 (while (and articles is-old)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
271 (setq article (concat nnml-current-directory
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
272 (int-to-string (car articles))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
273 (if (setq mod-time (nth 5 (file-attributes article)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
274 (if (and (or (not nnmail-keep-last-article)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
275 (not max-article)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
276 (not (= (car articles) max-article)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
277 (or force
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
278 (and (not (equal mod-time '(0 0)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
279 (setq is-old
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
280 (> (nnmail-days-between
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
281 (current-time-string)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
282 (current-time-string mod-time))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
283 days)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
284 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
285 (and gnus-verbose-backends
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
286 (message "Deleting article %s..." article))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
287 (condition-case ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
288 (delete-file article)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
289 (file-error
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
290 (setq rest (cons (car articles) rest))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
291 (setq active-articles (delq (car articles) active-articles))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
292 (nnml-nov-delete-article newsgroup (car articles)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
293 (setq rest (cons (car articles) rest))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
294 (setq articles (cdr articles)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
295 (let ((active (nth 1 (assoc newsgroup nnml-group-alist))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
296 (and active
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
297 (setcar active (or (and active-articles
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
298 (apply 'min active-articles))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
299 0)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
300 (nnmail-save-active nnml-group-alist nnml-active-file))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
301 (nnml-save-nov)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
302 (message "")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
303 (nconc rest articles)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
304
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
305 (defun nnml-request-move-article
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
306 (article group server accept-form &optional last)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
307 (let ((buf (get-buffer-create " *nnml move*"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
308 result)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
309 (and
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
310 (nnml-request-article article group server)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
311 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
312 (set-buffer buf)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
313 (insert-buffer-substring nntp-server-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
314 (setq result (eval accept-form))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
315 (kill-buffer (current-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
316 result)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
317 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
318 (condition-case ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
319 (delete-file (concat nnml-current-directory
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
320 (int-to-string article)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
321 (file-error nil))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
322 (nnml-nov-delete-article group article)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
323 (and last (nnml-save-nov))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
324 result))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
325
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
326 (defun nnml-request-accept-article (group &optional last)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
327 (let (result)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
328 (if (stringp group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
329 (and
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
330 (nnmail-activate 'nnml)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
331 ;; We trick the choosing function into believing that only one
14040
187735b53d52 Comment fixes.
Karl Heuer <kwzh@gnu.org>
parents: 13401
diff changeset
332 ;; group is available.
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
333 (let ((nnmail-split-methods (list (list group ""))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
334 (setq result (car (nnml-save-mail))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
335 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
336 (nnmail-save-active nnml-group-alist nnml-active-file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
337 (and last (nnml-save-nov))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
338 (and
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
339 (nnmail-activate 'nnml)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
340 (setq result (car (nnml-save-mail)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
341 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
342 (nnmail-save-active nnml-group-alist nnml-active-file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
343 (and last (nnml-save-nov)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
344 result))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
345
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
346 (defun nnml-request-replace-article (article group buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
347 (nnml-possibly-change-directory group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
348 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
349 (set-buffer buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
350 (nnml-possibly-create-directory group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
351 (if (not (condition-case ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
352 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
353 (write-region (point-min) (point-max)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
354 (concat nnml-current-directory
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
355 (int-to-string article))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
356 nil (if gnus-verbose-backends nil 'nomesg))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
357 t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
358 (error nil)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
359 ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
360 (let ((chars (nnmail-insert-lines))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
361 (art (concat (int-to-string article) "\t"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
362 nov-line)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
363 (setq nov-line (nnml-make-nov-line chars))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
364 ;; Replace the NOV line in the NOV file.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
365 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
366 (set-buffer (nnml-open-nov group))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
367 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
368 (if (or (looking-at art)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
369 (search-forward (concat "\n" art) nil t))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
370 ;; Delete the old NOV line.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
371 (delete-region (progn (beginning-of-line) (point))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
372 (progn (forward-line 1) (point)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
373 ;; The line isn't here, so we have to find out where
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
374 ;; we should insert it. (This situation should never
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
375 ;; occur, but one likes to make sure...)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
376 (while (and (looking-at "[0-9]+\t")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
377 (< (string-to-int
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
378 (buffer-substring
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
379 (match-beginning 0) (match-end 0)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
380 article)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
381 (zerop (forward-line 1)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
382 (beginning-of-line)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
383 (insert (int-to-string article) nov-line)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
384 (nnml-save-nov)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
385 t)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
386
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
387
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
388
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
389 ;;; Internal functions
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
390
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
391 (defun nnml-retrieve-headers-with-nov (articles)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
392 (if (or gnus-nov-is-evil nnml-nov-is-evil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
393 nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
394 (let ((first (car articles))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
395 (last (progn (while (cdr articles) (setq articles (cdr articles)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
396 (car articles)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
397 (nov (concat nnml-current-directory nnml-nov-file-name)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
398 (if (file-exists-p nov)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
399 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
400 (set-buffer nntp-server-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
401 (erase-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
402 (insert-file-contents nov)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
403 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
404 (while (and (not (eobp)) (< first (read (current-buffer))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
405 (forward-line 1))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
406 (beginning-of-line)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
407 (if (not (eobp)) (delete-region 1 (point)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
408 (while (and (not (eobp)) (>= last (read (current-buffer))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
409 (forward-line 1))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
410 (beginning-of-line)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
411 (if (not (eobp)) (delete-region (point) (point-max)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
412 t)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
413
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
414 (defun nnml-possibly-change-directory (newsgroup &optional force)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
415 (if newsgroup
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
416 (let ((pathname (nnmail-article-pathname newsgroup nnml-directory)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
417 (and (or force (file-directory-p pathname))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
418 (setq nnml-current-directory pathname)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
419 t))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
420
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
421 (defun nnml-possibly-create-directory (group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
422 (let (dir dirs)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
423 (setq dir (nnmail-article-pathname group nnml-directory))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
424 (while (not (file-directory-p dir))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
425 (setq dirs (cons dir dirs))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
426 (setq dir (file-name-directory (directory-file-name dir))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
427 (while dirs
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
428 (make-directory (directory-file-name (car dirs)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
429 (and gnus-verbose-backends
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
430 (message "Creating mail directory %s" (car dirs)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
431 (setq dirs (cdr dirs)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
432
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
433 (defun nnml-save-mail ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
434 "Called narrowed to an article."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
435 (let ((group-art (nreverse (nnmail-article-group 'nnml-active-number)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
436 chars nov-line)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
437 (setq chars (nnmail-insert-lines))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
438 (nnmail-insert-xref group-art)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
439 (run-hooks 'nnml-prepare-save-mail-hook)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
440 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
441 (while (looking-at "From ")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
442 (replace-match "X-From-Line: ")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
443 (forward-line 1))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
444 ;; We save the article in all the newsgroups it belongs in.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
445 (let ((ga group-art)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
446 first)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
447 (while ga
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
448 (nnml-possibly-create-directory (car (car ga)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
449 (let ((file (concat (nnmail-article-pathname
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
450 (car (car ga)) nnml-directory)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
451 (int-to-string (cdr (car ga))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
452 (if first
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
453 ;; It was already saved, so we just make a hard link.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
454 (add-name-to-file first file t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
455 ;; Save the article.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
456 (write-region (point-min) (point-max) file nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
457 (if gnus-verbose-backends nil 'nomesg))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
458 (setq first file)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
459 (setq ga (cdr ga))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
460 ;; Generate a nov line for this article. We generate the nov
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
461 ;; line after saving, because nov generation destroys the
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
462 ;; header.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
463 (setq nov-line (nnml-make-nov-line chars))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
464 ;; Output the nov line to all nov databases that should have it.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
465 (let ((ga group-art))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
466 (while ga
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
467 (nnml-add-nov (car (car ga)) (cdr (car ga)) nov-line)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
468 (setq ga (cdr ga))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
469 group-art))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
470
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
471 (defun nnml-active-number (group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
472 "Compute the next article number in GROUP."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
473 (let ((active (car (cdr (assoc group nnml-group-alist)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
474 ;; The group wasn't known to nnml, so we just create an active
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
475 ;; entry for it.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
476 (or active
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
477 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
478 (setq active (cons 1 0))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
479 (setq nnml-group-alist (cons (list group active) nnml-group-alist))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
480 (setcdr active (1+ (cdr active)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
481 (while (file-exists-p
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
482 (concat (nnmail-article-pathname group nnml-directory)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
483 (int-to-string (cdr active))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
484 (setcdr active (1+ (cdr active))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
485 (cdr active)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
486
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
487 (defun nnml-get-new-mail (&optional group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
488 "Read new incoming mail."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
489 (let* ((spools (nnmail-get-spool-files group))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
490 (group-in group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
491 incoming incomings)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
492 (if (or (not nnml-get-new-mail) (not nnmail-spool-file))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
493 ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
494 ;; We first activate all the groups.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
495 (nnmail-activate 'nnml)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
496 ;; The we go through all the existing spool files and split the
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
497 ;; mail from each.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
498 (while spools
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
499 (and
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
500 (file-exists-p (car spools))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
501 (> (nth 7 (file-attributes (car spools))) 0)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
502 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
503 (and gnus-verbose-backends
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
504 (message "nnml: Reading incoming mail..."))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
505 (if (not (setq incoming
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
506 (nnmail-move-inbox
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
507 (car spools) (concat nnml-directory "Incoming"))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
508 ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
509 (setq group (nnmail-get-split-group (car spools) group-in))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
510 (nnmail-split-incoming incoming 'nnml-save-mail nil group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
511 (setq incomings (cons incoming incomings)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
512 (setq spools (cdr spools)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
513 ;; If we did indeed read any incoming spools, we save all info.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
514 (if incoming
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
515 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
516 (nnmail-save-active nnml-group-alist nnml-active-file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
517 (nnml-save-nov)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
518 (run-hooks 'nnmail-read-incoming-hook)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
519 (and gnus-verbose-backends
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
520 (message "nnml: Reading incoming mail...done"))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
521 (while incomings
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
522 (setq incoming (car incomings))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
523 (and nnmail-delete-incoming
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
524 (file-exists-p incoming)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
525 (file-writable-p incoming)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
526 (delete-file incoming))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
527 (setq incomings (cdr incomings))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
528
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
529
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
530 (defun nnml-add-nov (group article line)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
531 "Add a nov line for the GROUP base."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
532 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
533 (set-buffer (nnml-open-nov group))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
534 (goto-char (point-max))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
535 (insert (int-to-string article) line)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
536
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
537 (defsubst nnml-header-value ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
538 (buffer-substring (match-end 0) (save-excursion (end-of-line) (point))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
539
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
540 (defun nnml-make-nov-line (chars)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
541 "Create a nov from the current headers."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
542 (let ((case-fold-search t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
543 subject from date id references lines xref in-reply-to char)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
544 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
545 (save-restriction
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
546 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
547 (narrow-to-region
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
548 (point)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
549 (1- (or (search-forward "\n\n" nil t) (point-max))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
550 ;; Fold continuation lines.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
551 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
552 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
553 (replace-match " " t t))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
554 (subst-char-in-region (point-min) (point-max) ?\t ? )
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
555 ;; [number subject from date id references chars lines xref]
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
556 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
557 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
558 (while (re-search-forward "^\\(from\\|subject\\|message-id\\|date\\|lines\\|xref\\|references\\|in-reply-to\\): "
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
559 nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
560 (beginning-of-line)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
561 (setq char (downcase (following-char)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
562 (cond
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
563 ((eq char ?s)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
564 (setq subject (nnml-header-value)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
565 ((eq char ?f)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
566 (setq from (nnml-header-value)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
567 ((eq char ?x)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
568 (setq xref (nnml-header-value)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
569 ((eq char ?l)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
570 (setq lines (nnml-header-value)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
571 ((eq char ?d)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
572 (setq date (nnml-header-value)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
573 ((eq char ?m)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
574 (setq id (setq id (nnml-header-value))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
575 ((eq char ?r)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
576 (setq references (nnml-header-value)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
577 ((eq char ?i)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
578 (setq in-reply-to (nnml-header-value))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
579 (forward-line 1))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
580
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
581 (and (not references)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
582 in-reply-to
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
583 (string-match "<[^>]+>" in-reply-to)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
584 (setq references
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
585 (substring in-reply-to (match-beginning 0)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
586 (match-end 0)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
587 ;; [number subject from date id references chars lines xref]
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
588 (format "\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t%s\t\n"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
589 (or subject "(none)")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
590 (or from "(nobody)") (or date "")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
591 (or id (concat "nnml-dummy-id-"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
592 (mapconcat
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
593 (lambda (time) (int-to-string time))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
594 (current-time) "-")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
595 (or references "")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
596 (or chars 0) (or lines "0") (or xref ""))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
597
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
598 (defun nnml-open-nov (group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
599 (or (cdr (assoc group nnml-nov-buffer-alist))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
600 (let ((buffer (find-file-noselect
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
601 (concat (nnmail-article-pathname
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
602 group nnml-directory) nnml-nov-file-name))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
603 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
604 (set-buffer buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
605 (buffer-disable-undo (current-buffer)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
606 (setq nnml-nov-buffer-alist
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
607 (cons (cons group buffer) nnml-nov-buffer-alist))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
608 buffer)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
609
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
610 (defun nnml-save-nov ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
611 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
612 (while nnml-nov-buffer-alist
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
613 (if (buffer-name (cdr (car nnml-nov-buffer-alist)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
614 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
615 (set-buffer (cdr (car nnml-nov-buffer-alist)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
616 (and (buffer-modified-p)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
617 (write-region
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
618 1 (point-max) (buffer-file-name) nil 'nomesg))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
619 (set-buffer-modified-p nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
620 (kill-buffer (current-buffer))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
621 (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
622
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
623 ;;;###autoload
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
624 (defun nnml-generate-nov-databases (dir)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
625 "Generate nov databases in all nnml mail newsgroups."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
626 (interactive
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
627 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
628 (setq nnml-group-alist nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
629 (list nnml-directory)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
630 (nnml-open-server (or nnml-current-server ""))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
631 (let ((dirs (directory-files dir t nil t)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
632 (while dirs
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
633 (if (and (not (string-match "/\\.\\.$" (car dirs)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
634 (not (string-match "/\\.$" (car dirs)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
635 (file-directory-p (car dirs)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
636 (nnml-generate-nov-databases (car dirs)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
637 (setq dirs (cdr dirs))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
638 (let ((files (sort
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
639 (mapcar
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
640 (function
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
641 (lambda (name)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
642 (string-to-int name)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
643 (directory-files dir nil "^[0-9]+$" t))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
644 (function <)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
645 (nov (concat dir "/" nnml-nov-file-name))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
646 (nov-buffer (get-buffer-create "*nov*"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
647 nov-line chars)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
648 (if files
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
649 (setq nnml-group-alist
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
650 (cons (list (nnmail-replace-chars-in-string
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
651 (substring (expand-file-name dir)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
652 (length (expand-file-name
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
653 nnml-directory)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
654 ?/ ?.)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
655 (cons (car files)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
656 (let ((f files))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
657 (while (cdr f) (setq f (cdr f)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
658 (car f))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
659 nnml-group-alist)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
660 (if files
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
661 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
662 (set-buffer nntp-server-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
663 (if (file-exists-p nov)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
664 (delete-file nov))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
665 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
666 (set-buffer nov-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
667 (buffer-disable-undo (current-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
668 (erase-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
669 (while files
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
670 (erase-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
671 (insert-file-contents (concat dir "/" (int-to-string (car files))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
672 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
673 (narrow-to-region 1 (save-excursion (search-forward "\n\n" nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
674 (setq chars (- (point-max)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
675 (point)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
676 (point)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
677 (if (not (= 0 chars)) ; none of them empty files...
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
678 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
679 (setq nov-line (nnml-make-nov-line chars))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
680 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
681 (set-buffer nov-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
682 (goto-char (point-max))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
683 (insert (int-to-string (car files)) nov-line))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
684 (widen)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
685 (setq files (cdr files)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
686 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
687 (set-buffer nov-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
688 (write-region 1 (point-max) (expand-file-name nov) nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
689 'nomesg)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
690 (kill-buffer (current-buffer)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
691 (nnmail-save-active nnml-group-alist nnml-active-file)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
692
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
693 (defun nnml-nov-delete-article (group article)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
694 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
695 (set-buffer (nnml-open-nov group))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
696 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
697 (if (re-search-forward (concat "^" (int-to-string article) "\t") nil t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
698 (delete-region (match-beginning 0) (progn (forward-line 1) (point))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
699 t))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
700
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
701 (provide 'nnml)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
702
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
703 ;;; nnml.el ends here