nnml.el 47.2 KB
Newer Older
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1
;;; nnml.el --- mail spool access for Gnus
2 3

;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
5

6 7 8
;; Authors: Didier Verna <didier@xemacs.org> (adding compaction)
;;	Simon Josefsson <simon@josefsson.org> (adding MARKS)
;;	Lars Magne Ingebrigtsen <larsi@gnus.org>
9
;;	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
10 11 12 13 14 15
;; Keywords: news, mail

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
16
;; the Free Software Foundation; either version 3, or (at your option)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
17 18 19 20 21 22 23 24 25
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
26 27
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
28 29 30 31 32 33 34 35 36

;;; Commentary:

;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
;; For an overview of what the interface functions do, please see the
;; Gnus sources.

;;; Code:

37
(require 'gnus)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
38 39 40
(require 'nnheader)
(require 'nnmail)
(require 'nnoo)
41
(eval-when-compile (require 'cl))
42

43
(eval-and-compile
44 45
  (autoload 'gnus-article-unpropagatable-p "gnus-sum")
  (autoload 'gnus-backlog-remove-article "gnus-bcklg"))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
46 47 48 49

(nnoo-declare nnml)

(defvoo nnml-directory message-directory
50
  "Spool directory for the nnml mail backend.")
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
51 52

(defvoo nnml-active-file
53
    (expand-file-name "active" nnml-directory)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
54 55 56
  "Mail active file.")

(defvoo nnml-newsgroups-file
57
    (expand-file-name "newsgroups" nnml-directory)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
58 59 60 61 62 63
  "Mail newsgroups description file.")

(defvoo nnml-get-new-mail t
  "If non-nil, nnml will check the incoming mail file and split the mail.")

(defvoo nnml-nov-is-evil nil
64
  "If non-nil, Gnus will never generate and use nov databases for mail spools.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
65 66 67 68 69 70 71
Using nov databases will speed up header fetching considerably.
This variable shouldn't be flipped much.  If you have, for some reason,
set this to t, and want to set it to nil again, you should always run
the `nnml-generate-nov-databases' command.  The function will go
through all nnml directories and generate nov databases for them
all.  This may very well take some time.")

72 73 74 75 76 77 78 79 80
(defvoo nnml-marks-is-evil nil
  "If non-nil, Gnus will never generate and use marks file for mail spools.
Using marks files makes it possible to backup and restore mail groups
separately from `.newsrc.eld'.  If you have, for some reason, set this
to t, and want to set it to nil again, you should always remove the
corresponding marks file (usually named `.marks' in the nnml group
directory, but see `nnml-marks-file-name') for the group.  Then the
marks file will be regenerated properly by Gnus.")

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
81 82 83 84 85 86
(defvoo nnml-prepare-save-mail-hook nil
  "Hook run narrowed to an article before saving.")

(defvoo nnml-inhibit-expiry nil
  "If non-nil, inhibit expiry.")

87
(defvoo nnml-use-compressed-files nil
88 89 90 91 92 93 94 95 96 97 98 99
  "If non-nil, allow using compressed message files.

If it is a string, use it as the file extension which specifies
the compression program.  You can set it to \".bz2\" if your Emacs
supports auto-compression using the bzip2 program.  A value of t
is equivalent to \".gz\".")

(defvoo nnml-compressed-files-size-threshold 1000
  "Default size threshold for compressed message files.
Message files with bodies larger than that many characters will
be automatically compressed if `nnml-use-compressed-files' is
non-nil.")
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
100 101 102 103 104 105 106



(defconst nnml-version "nnml 1.0"
  "nnml version.")

(defvoo nnml-nov-file-name ".overview")
107
(defvoo nnml-marks-file-name ".marks")
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
108 109 110 111 112 113 114 115 116 117 118

(defvoo nnml-current-directory nil)
(defvoo nnml-current-group nil)
(defvoo nnml-status-string "")
(defvoo nnml-nov-buffer-alist nil)
(defvoo nnml-group-alist nil)
(defvoo nnml-active-timestamp nil)
(defvoo nnml-article-file-alist nil)

(defvoo nnml-generate-active-function 'nnml-generate-active-info)

119 120
(defvar nnml-nov-buffer-file-name nil)

121 122
(defvoo nnml-file-coding-system nnmail-file-coding-system)

123 124 125
(defvoo nnml-marks nil)

(defvar nnml-marks-modtime (gnus-make-hashtable))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
126

127

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
128 129 130 131
;;; Interface functions.

(nnoo-define-basics nnml)

132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
(eval-when-compile
  (defsubst nnml-group-name-charset (group server-or-method)
    (gnus-group-name-charset
     (if (stringp server-or-method)
	 (gnus-server-to-method
	  (if (string-match "\\+" server-or-method)
	      (concat (substring server-or-method 0 (match-beginning 0))
		      ":" (substring server-or-method (match-end 0)))
	    (concat "nnml:" server-or-method)))
       (or server-or-method gnus-command-method '(nnml "")))
     group)))

(defun nnml-decoded-group-name (group &optional server-or-method)
  "Return a decoded group name of GROUP on SERVER-OR-METHOD."
  (if nnmail-group-names-not-encoded-p
      group
    (mm-decode-coding-string
     group
     (nnml-group-name-charset group server-or-method))))

(defun nnml-encoded-group-name (group &optional server-or-method)
  "Return an encoded group name of GROUP on SERVER-OR-METHOD."
  (mm-encode-coding-string
   group
   (nnml-group-name-charset group server-or-method)))

(defun nnml-group-pathname (group &optional file server)
  "Return an absolute file name of FILE for GROUP on SERVER."
  (nnmail-group-pathname (inline (nnml-decoded-group-name group server))
			 nnml-directory file))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
163 164 165 166 167
(deffoo nnml-retrieve-headers (sequence &optional group server fetch-old)
  (when (nnml-possibly-change-directory group server)
    (save-excursion
      (set-buffer nntp-server-buffer)
      (erase-buffer)
168 169 170 171 172
      (let* ((file nil)
	     (number (length sequence))
	     (count 0)
	     (file-name-coding-system nnmail-pathname-coding-system)
	     beg article)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
173 174 175 176 177 178 179 180 181 182 183 184 185 186
	(if (stringp (car sequence))
	    'headers
	  (if (nnml-retrieve-headers-with-nov sequence fetch-old)
	      'nov
	    (while sequence
	      (setq article (car sequence))
	      (setq file (nnml-article-to-file article))
	      (when (and file
			 (file-exists-p file)
			 (not (file-directory-p file)))
		(insert (format "221 %d Article retrieved.\n" article))
		(setq beg (point))
		(nnheader-insert-head file)
		(goto-char beg)
187
		(if (re-search-forward "\n\r?\n" nil t)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210
		    (forward-char -1)
		  (goto-char (point-max))
		  (insert "\n\n"))
		(insert ".\n")
		(delete-region (point) (point-max)))
	      (setq sequence (cdr sequence))
	      (setq count (1+ count))
	      (and (numberp nnmail-large-newsgroup)
		   (> number nnmail-large-newsgroup)
		   (zerop (% count 20))
		   (nnheader-message 6 "nnml: Receiving headers... %d%%"
				     (/ (* count 100) number))))

	    (and (numberp nnmail-large-newsgroup)
		 (> number nnmail-large-newsgroup)
		 (nnheader-message 6 "nnml: Receiving headers...done"))

	    (nnheader-fold-continuation-lines)
	    'headers))))))

(deffoo nnml-open-server (server &optional defs)
  (nnoo-change-server 'nnml server defs)
  (when (not (file-exists-p nnml-directory))
211
    (ignore-errors (make-directory nnml-directory t)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
212 213 214 215 216 217 218 219 220 221 222 223
  (cond
   ((not (file-exists-p nnml-directory))
    (nnml-close-server)
    (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory))
   ((not (file-directory-p (file-truename nnml-directory)))
    (nnml-close-server)
    (nnheader-report 'nnml "Not a directory: %s" nnml-directory))
   (t
    (nnheader-report 'nnml "Opened server %s using directory %s"
		     server nnml-directory)
    t)))

224
(deffoo nnml-request-regenerate (server)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
225
  (nnml-possibly-change-directory nil server)
226
  (nnml-generate-nov-databases server)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
227 228 229 230 231
  t)

(deffoo nnml-request-article (id &optional group server buffer)
  (nnml-possibly-change-directory group server)
  (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
232
	 (file-name-coding-system nnmail-pathname-coding-system)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
233 234
	 path gpath group-num)
    (if (stringp id)
235
	(when (and (setq group-num (nnml-find-group-number id server))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
236 237 238
		   (cdr
		    (assq (cdr group-num)
			  (nnheader-article-to-file-alist
239 240
			   (setq gpath (nnml-group-pathname (car group-num)
							    nil server))))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
241 242 243 244 245 246 247 248 249
	  (setq path (concat gpath (int-to-string (cdr group-num)))))
      (setq path (nnml-article-to-file id)))
    (cond
     ((not path)
      (nnheader-report 'nnml "No such article: %s" id))
     ((not (file-exists-p path))
      (nnheader-report 'nnml "No such file: %s" path))
     ((file-directory-p path)
      (nnheader-report 'nnml "File is a directory: %s" path))
250 251 252
     ((not (save-excursion (let ((nnmail-file-coding-system
				  nnml-file-coding-system))
			     (nnmail-find-file path))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
253 254 255 256 257
      (nnheader-report 'nnml "Couldn't read file: %s" path))
     (t
      (nnheader-report 'nnml "Article %s retrieved" id)
      ;; We return the article number.
      (cons (if group-num (car group-num) group)
258
	    (string-to-number (file-name-nondirectory path)))))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
259 260

(deffoo nnml-request-group (group &optional server dont-check)
261
  (let ((file-name-coding-system nnmail-pathname-coding-system))
262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282
    (cond
     ((not (nnml-possibly-change-directory group server))
      (nnheader-report 'nnml "Invalid group (no such directory)"))
     ((not (file-exists-p nnml-current-directory))
      (nnheader-report 'nnml "Directory %s does not exist"
		       nnml-current-directory))
     ((not (file-directory-p nnml-current-directory))
      (nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
     (dont-check
      (nnheader-report 'nnml "Group %s selected" group)
      t)
     (t
      (nnheader-re-read-dir nnml-current-directory)
      (nnmail-activate 'nnml)
      (let ((active (nth 1 (assoc group nnml-group-alist))))
	(if (not active)
	    (nnheader-report 'nnml "No such group: %s" group)
	  (nnheader-report 'nnml "Selected group %s" group)
	  (nnheader-insert "211 %d %d %d %s\n"
			   (max (1+ (- (cdr active) (car active))) 0)
			   (car active) (cdr active) group)))))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
283 284 285 286 287 288 289 290 291 292 293

(deffoo nnml-request-scan (&optional group server)
  (setq nnml-article-file-alist nil)
  (nnml-possibly-change-directory group server)
  (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group))

(deffoo nnml-close-group (group &optional server)
  (setq nnml-article-file-alist nil)
  t)

(deffoo nnml-request-create-group (group &optional server args)
294
  (nnml-possibly-change-directory nil server)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
295
  (nnmail-activate 'nnml)
296
  (cond
297 298 299 300 301 302 303
   ((let ((file (directory-file-name (nnml-group-pathname group nil server)))
	  (file-name-coding-system nnmail-pathname-coding-system))
      (and (file-exists-p file)
	   (not (file-directory-p file))))
    (nnheader-report 'nnml "%s is a file"
		     (directory-file-name (nnml-group-pathname group
							       nil server))))
304 305 306
   ((assoc group nnml-group-alist)
    t)
   (t
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
307 308 309
    (let (active)
      (push (list group (setq active (cons 1 0)))
	    nnml-group-alist)
310
      (nnml-possibly-create-directory group server)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
311
      (nnml-possibly-change-directory group server)
312 313
      (let* ((file-name-coding-system nnmail-pathname-coding-system)
	     (articles (nnml-directory-articles nnml-current-directory)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
314 315 316
	(when articles
	  (setcar active (apply 'min articles))
	  (setcdr active (apply 'max articles))))
317 318
      (nnmail-save-active nnml-group-alist nnml-active-file)
      t))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
319 320 321

(deffoo nnml-request-list (&optional server)
  (save-excursion
322
    (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
323 324
	  (file-name-coding-system nnmail-pathname-coding-system))
      (nnmail-find-file nnml-active-file))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
325 326 327 328 329 330 331 332 333 334
    (setq nnml-group-alist (nnmail-get-active))
    t))

(deffoo nnml-request-newgroups (date &optional server)
  (nnml-request-list server))

(deffoo nnml-request-list-newsgroups (&optional server)
  (save-excursion
    (nnmail-find-file nnml-newsgroups-file)))

335
(deffoo nnml-request-expire-articles (articles group &optional server force)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
336
  (nnml-possibly-change-directory group server)
337 338 339 340 341 342
  (let* ((file-name-coding-system nnmail-pathname-coding-system)
	 (active-articles
	  (nnml-directory-articles nnml-current-directory))
	 (is-old t)
	 (decoded (nnml-decoded-group-name group server))
	 article rest mod-time number target)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
343 344
    (nnmail-activate 'nnml)

345 346 347 348 349
    (setq active-articles (sort active-articles '<))
    ;; Articles not listed in active-articles are already gone,
    ;; so don't try to expire them.
    (setq articles (gnus-sorted-intersection articles active-articles))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
350
    (while (and articles is-old)
351 352 353 354 355 356 357 358
      (if (and (setq article (nnml-article-to-file
			      (setq number (pop articles))))
	       (setq mod-time (nth 5 (file-attributes article)))
	       (nnml-deletable-article-p group number)
	       (setq is-old (nnmail-expired-article-p group mod-time force
						      nnml-inhibit-expiry)))
	  (progn
	    ;; Allow a special target group.
359 360
	    (setq target nnmail-expiry-target)
	    (unless (eq target 'delete)
361 362 363 364 365
	      (with-temp-buffer
		(nnml-request-article number group server (current-buffer))
		(let (nnml-current-directory
		      nnml-current-group
		      nnml-article-file-alist)
366 367 368 369 370 371 372
		  (when (functionp target)
		    (setq target (funcall target group)))
		  (if (and target
			   (or (gnus-request-group target)
			       (gnus-request-create-group target)))
		      (nnmail-expiry-target-group target group)
		    (setq target nil))))
373 374
	      ;; Maybe directory is changed during nnmail-expiry-target-group.
	      (nnml-possibly-change-directory group server))
375 376 377 378 379 380 381 382 383 384 385
	    (if target
		(progn
		  (nnheader-message 5 "Deleting article %s in %s"
				    number decoded)
		  (condition-case ()
		      (funcall nnmail-delete-file-function article)
		    (file-error
		     (push number rest)))
		  (setq active-articles (delq number active-articles))
		  (nnml-nov-delete-article group number))
	      (push number rest)))
386
	(push number rest)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
387 388 389 390 391 392 393 394 395 396
    (let ((active (nth 1 (assoc group nnml-group-alist))))
      (when active
	(setcar active (or (and active-articles
				(apply 'min active-articles))
			   (1+ (cdr active)))))
      (nnmail-save-active nnml-group-alist nnml-active-file))
    (nnml-save-nov)
    (nconc rest articles)))

(deffoo nnml-request-move-article
397
    (article group server accept-form &optional last move-is-internal)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
398
  (let ((buf (get-buffer-create " *nnml move*"))
399
	(file-name-coding-system nnmail-pathname-coding-system)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
400 401 402 403 404 405
	result)
    (nnml-possibly-change-directory group server)
    (nnml-update-file-alist)
    (and
     (nnml-deletable-article-p group article)
     (nnml-request-article article group server)
406 407
     (let (nnml-current-directory
	   nnml-current-group
408 409 410 411 412 413 414
	   nnml-article-file-alist)
       (save-excursion
	 (set-buffer buf)
	 (insert-buffer-substring nntp-server-buffer)
	 (setq result (eval accept-form))
	 (kill-buffer (current-buffer))
	 result))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431
     (progn
       (nnml-possibly-change-directory group server)
       (condition-case ()
	   (funcall nnmail-delete-file-function
		    (nnml-article-to-file  article))
	 (file-error nil))
       (nnml-nov-delete-article group article)
       (when last
	 (nnml-save-nov)
	 (nnmail-save-active nnml-group-alist nnml-active-file))))
    result))

(deffoo nnml-request-accept-article (group &optional server last)
  (nnml-possibly-change-directory group server)
  (nnmail-check-syntax)
  (let (result)
    (when nnmail-cache-accepted-message-ids
432
      (nnmail-cache-insert (nnmail-fetch-field "message-id")
433 434 435
			   group
			   (nnmail-fetch-field "subject")
			   (nnmail-fetch-field "from")))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
436 437 438 439
    (if (stringp group)
	(and
	 (nnmail-activate 'nnml)
	 (setq result (car (nnml-save-mail
440 441 442
			    (list (cons group (nnml-active-number group
								  server)))
			    server)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
443 444 445 446 447
	 (progn
	   (nnmail-save-active nnml-group-alist nnml-active-file)
	   (and last (nnml-save-nov))))
      (and
       (nnmail-activate 'nnml)
448 449 450
       (if (and (not (setq result (nnmail-article-group
				   `(lambda (group)
				      (nnml-active-number group ,server)))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
451 452
		(yes-or-no-p "Moved to `junk' group; delete article? "))
	   (setq result 'junk)
453
	 (setq result (car (nnml-save-mail result server))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
454 455 456 457 458 459 460
       (when last
	 (nnmail-save-active nnml-group-alist nnml-active-file)
	 (when nnmail-cache-accepted-message-ids
	   (nnmail-cache-close))
	 (nnml-save-nov))))
    result))

461 462 463
(deffoo nnml-request-post (&optional server)
  (nnmail-do-request-post 'nnml-request-accept-article server))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
464 465 466 467 468 469 470 471
(deffoo nnml-request-replace-article (article group buffer)
  (nnml-possibly-change-directory group)
  (save-excursion
    (set-buffer buffer)
    (nnml-possibly-create-directory group)
    (let ((chars (nnmail-insert-lines))
	  (art (concat (int-to-string article) "\t"))
	  headers)
472 473 474 475 476 477 478 479
      (when (ignore-errors
	      (nnmail-write-region
	       (point-min) (point-max)
	       (or (nnml-article-to-file article)
		   (expand-file-name (int-to-string article)
				     nnml-current-directory))
	       nil (if (nnheader-be-verbose 5) nil 'nomesg))
	      t)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
480 481 482 483 484 485 486 487
	(setq headers (nnml-parse-head chars article))
	;; Replace the NOV line in the NOV file.
	(save-excursion
	  (set-buffer (nnml-open-nov group))
	  (goto-char (point-min))
	  (if (or (looking-at art)
		  (search-forward (concat "\n" art) nil t))
	      ;; Delete the old NOV line.
488
	      (gnus-delete-line)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
489 490 491 492
	    ;; The line isn't here, so we have to find out where
	    ;; we should insert it.  (This situation should never
	    ;; occur, but one likes to make sure...)
	    (while (and (looking-at "[0-9]+\t")
493
			(< (string-to-number
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
494 495 496 497 498 499 500 501 502 503 504
			    (buffer-substring
			     (match-beginning 0) (match-end 0)))
			   article)
			(zerop (forward-line 1)))))
	  (beginning-of-line)
	  (nnheader-insert-nov headers)
	  (nnml-save-nov)
	  t)))))

(deffoo nnml-request-delete-group (group &optional force server)
  (nnml-possibly-change-directory group server)
505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536
  (let ((file (directory-file-name nnml-current-directory))
	(file-name-coding-system nnmail-pathname-coding-system))
    (if (file-exists-p file)
	(if (file-directory-p file)
	    (progn
	      (when force
		;; Delete all articles in GROUP.
		(let ((articles
		       (directory-files
			nnml-current-directory t
			(concat
			 nnheader-numerical-short-files
			 "\\|" (regexp-quote nnml-nov-file-name) "$"
			 "\\|" (regexp-quote nnml-marks-file-name) "$")))
		      (decoded (nnml-decoded-group-name group server)))
		  (dolist (article articles)
		    (when (file-writable-p article)
		      (nnheader-message 5 "Deleting article %s in %s..."
					(file-name-nondirectory article)
					decoded)
		      (funcall nnmail-delete-file-function article))))
		;; Try to delete the directory itself.
		(ignore-errors (delete-directory nnml-current-directory))))
	  (nnheader-report 'nnml "%s is not a directory" file))
      (nnheader-report 'nnml "No such directory: %s/" file))
    ;; Remove the group from all structures.
    (setq nnml-group-alist
	  (delq (assoc group nnml-group-alist) nnml-group-alist)
	  nnml-current-group nil
	  nnml-current-directory nil)
    ;; Save the active file.
    (nnmail-save-active nnml-group-alist nnml-active-file))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
537 538 539 540
  t)

(deffoo nnml-request-rename-group (group new-name &optional server)
  (nnml-possibly-change-directory group server)
541
  (let ((new-dir (nnml-group-pathname new-name nil server))
Miles Bader's avatar
Miles Bader committed
542 543
	(old-dir (nnml-group-pathname group nil server))
	(file-name-coding-system nnmail-pathname-coding-system))
544 545 546
    (when (ignore-errors
	    (make-directory new-dir t)
	    t)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
547 548 549
      ;; We move the articles file by file instead of renaming
      ;; the directory -- there may be subgroups in this group.
      ;; One might be more clever, I guess.
550 551 552 553
      (dolist (file (nnheader-article-to-file-alist old-dir))
	(rename-file
	 (concat old-dir (cdr file))
	 (concat new-dir (cdr file))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
554 555 556 557
      ;; Move .overview file.
      (let ((overview (concat old-dir nnml-nov-file-name)))
	(when (file-exists-p overview)
	  (rename-file overview (concat new-dir nnml-nov-file-name))))
558 559 560 561
      ;; Move .marks file.
      (let ((marks (concat old-dir nnml-marks-file-name)))
	(when (file-exists-p marks)
	  (rename-file marks (concat new-dir nnml-marks-file-name))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
562
      (when (<= (length (directory-files old-dir)) 2)
563
	(ignore-errors (delete-directory old-dir)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580
      ;; That went ok, so we change the internal structures.
      (let ((entry (assoc group nnml-group-alist)))
	(when entry
	  (setcar entry new-name))
	(setq nnml-current-directory nil
	      nnml-current-group nil)
	;; Save the new group alist.
	(nnmail-save-active nnml-group-alist nnml-active-file)
	t))))

(deffoo nnml-set-status (article name value &optional group server)
  (nnml-possibly-change-directory group server)
  (let ((file (nnml-article-to-file article)))
    (cond
     ((not (file-exists-p file))
      (nnheader-report 'nnml "File %s does not exist" file))
     (t
581
      (with-temp-file file
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
582 583 584 585 586 587 588 589 590 591
	(nnheader-insert-file-contents file)
	(nnmail-replace-status name value))
      t))))


;;; Internal functions.

(defun nnml-article-to-file (article)
  (nnml-update-file-alist)
  (let (file)
592 593 594 595
    (if (setq file
	      (if nnml-use-compressed-files
		  (cdr (assq article nnml-article-file-alist))
		(number-to-string article)))
596
	(expand-file-name file nnml-current-directory)
597 598 599 600 601 602 603 604
      (when (not nnheader-directory-files-is-safe)
	;; Just to make sure nothing went wrong when reading over NFS --
	;; check once more.
	(when (file-exists-p
	       (setq file (expand-file-name (number-to-string article)
					    nnml-current-directory)))
	  (nnml-update-file-alist t)
	  file)))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
605 606 607

(defun nnml-deletable-article-p (group article)
  "Say whether ARTICLE in GROUP can be deleted."
608 609
  (let ((file-name-coding-system nnmail-pathname-coding-system)
	path)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
610 611 612 613 614 615 616
    (when (setq path (nnml-article-to-file article))
      (when (file-writable-p path)
	(or (not nnmail-keep-last-article)
	    (not (eq (cdr (nth 1 (assoc group nnml-group-alist)))
		     article)))))))

;; Find an article number in the current group given the Message-ID.
617
(defun nnml-find-group-number (id server)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
618 619 620 621 622 623 624
  (save-excursion
    (set-buffer (get-buffer-create " *nnml id*"))
    (let ((alist nnml-group-alist)
	  number)
      ;; We want to look through all .overview files, but we want to
      ;; start with the one in the current directory.  It seems most
      ;; likely that the article we are looking for is in that group.
625
      (if (setq number (nnml-find-id nnml-current-group id server))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
626
	  (cons nnml-current-group number)
627
      ;; It wasn't there, so we look through the other groups as well.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
628 629 630
	(while (and (not number)
		    alist)
	  (or (string= (caar alist) nnml-current-group)
631
	      (setq number (nnml-find-id (caar alist) id server)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
632 633 634 635 636
	  (or number
	      (setq alist (cdr alist))))
	(and number
	     (cons (caar alist) number))))))

637
(defun nnml-find-id (group id server)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
638
  (erase-buffer)
639
  (let ((nov (nnml-group-pathname group nnml-nov-file-name server))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
640 641 642 643 644 645 646
	number found)
    (when (file-exists-p nov)
      (nnheader-insert-file-contents nov)
      (while (and (not found)
		  (search-forward id nil t)) ; We find the ID.
	;; And the id is in the fourth field.
	(if (not (and (search-backward "\t" nil t 4)
647
		      (not (search-backward "\t" (point-at-bol) t))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
648 649 650 651 652
	    (forward-line 1)
	  (beginning-of-line)
	  (setq found t)
	  ;; We return the article number.
	  (setq number
653
		(ignore-errors (read (current-buffer))))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
654 655 656 657 658
      number)))

(defun nnml-retrieve-headers-with-nov (articles &optional fetch-old)
  (if (or gnus-nov-is-evil nnml-nov-is-evil)
      nil
659
    (let ((nov (expand-file-name nnml-nov-file-name nnml-current-directory)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679
      (when (file-exists-p nov)
	(save-excursion
	  (set-buffer nntp-server-buffer)
	  (erase-buffer)
	  (nnheader-insert-file-contents nov)
	  (if (and fetch-old
		   (not (numberp fetch-old)))
	      t				; Don't remove anything.
	    (nnheader-nov-delete-outside-range
	     (if fetch-old (max 1 (- (car articles) fetch-old))
	       (car articles))
	     (car (last articles)))
	    t))))))

(defun nnml-possibly-change-directory (group &optional server)
  (when (and server
	     (not (nnml-server-opened server)))
    (nnml-open-server server))
  (if (not group)
      t
680
    (let ((pathname (nnml-group-pathname group nil server))
681
	  (file-name-coding-system nnmail-pathname-coding-system))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
682 683 684 685 686 687
      (when (not (equal pathname nnml-current-directory))
	(setq nnml-current-directory pathname
	      nnml-current-group group
	      nnml-article-file-alist nil))
      (file-exists-p nnml-current-directory))))

688 689 690
(defun nnml-possibly-create-directory (group &optional server)
  (let ((dir (nnml-group-pathname group nil server))
	(file-name-coding-system nnmail-pathname-coding-system))
691 692 693
    (unless (file-exists-p dir)
      (make-directory (directory-file-name dir) t)
      (nnheader-message 5 "Creating mail directory %s" dir))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
694

695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713
(defun nnml-save-mail (group-art &optional server)
  "Save a mail into the groups GROUP-ART in the nnml server SERVER.
GROUP-ART is a list that each element is a cons of a group name and an
article number.  This function is called narrowed to an article."
  (let* ((chars (nnmail-insert-lines))
	 (extension (and nnml-use-compressed-files
			 (> chars nnml-compressed-files-size-threshold)
			 (if (stringp nnml-use-compressed-files)
			     nnml-use-compressed-files
			   ".gz")))
	 decoded dec file first headers)
    (when nnmail-group-names-not-encoded-p
      (dolist (ga (prog1 group-art (setq group-art nil)))
	(setq group-art (nconc group-art
			       (list (cons (nnml-encoded-group-name (car ga)
								    server)
					   (cdr ga))))
	      decoded (nconc decoded (list (car ga)))))
      (setq dec decoded))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
714 715 716 717 718 719 720 721
    (nnmail-insert-xref group-art)
    (run-hooks 'nnmail-prepare-save-mail-hook)
    (run-hooks 'nnml-prepare-save-mail-hook)
    (goto-char (point-min))
    (while (looking-at "From ")
      (replace-match "X-From-Line: ")
      (forward-line 1))
    ;; We save the article in all the groups it belongs in.
722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740
    (dolist (ga group-art)
      (if nnmail-group-names-not-encoded-p
	  (progn
	    (nnml-possibly-create-directory (car decoded) server)
	    (setq file (nnmail-group-pathname
			(pop decoded) nnml-directory
			(concat (number-to-string (cdr ga)) extension))))
	(nnml-possibly-create-directory (car ga) server)
	(setq file (nnml-group-pathname
		    (car ga) (concat (number-to-string (cdr ga)) extension)
		    server)))
      (if first
	  ;; It was already saved, so we just make a hard link.
	  (let ((file-name-coding-system nnmail-pathname-coding-system))
	    (funcall nnmail-crosspost-link-function first file t))
	;; Save the article.
	(nnmail-write-region (point-min) (point-max) file nil
			     (if (nnheader-be-verbose 5) nil 'nomesg))
	(setq first file)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
741 742 743 744 745
    ;; Generate a nov line for this article.  We generate the nov
    ;; line after saving, because nov generation destroys the
    ;; header.
    (setq headers (nnml-parse-head chars))
    ;; Output the nov line to all nov databases that should have it.
746 747 748 749 750 751 752 753 754 755 756 757 758
    (if nnmail-group-names-not-encoded-p
	(dolist (ga group-art)
	  (nnml-add-nov (pop dec) (cdr ga) headers))
      (dolist (ga group-art)
	(nnml-add-nov (car ga) (cdr ga) headers))))
  group-art)

(defun nnml-active-number (group &optional server)
  "Compute the next article number in GROUP on SERVER."
  (let ((active (cadr (assoc (if nnmail-group-names-not-encoded-p
				 (nnml-encoded-group-name group server)
			       group)
			     nnml-group-alist))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
759 760 761 762 763
    ;; The group wasn't known to nnml, so we just create an active
    ;; entry for it.
    (unless active
      ;; Perhaps the active file was corrupt?  See whether
      ;; there are any articles in this group.
764 765
      (nnml-possibly-create-directory group server)
      (nnml-possibly-change-directory group server)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
766 767 768
      (unless nnml-article-file-alist
	(setq nnml-article-file-alist
	      (sort
769
	       (nnml-current-group-article-to-file-alist)
770
	       'car-less-than-car)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
771 772 773 774 775 776 777 778
      (setq active
	    (if nnml-article-file-alist
		(cons (caar nnml-article-file-alist)
		      (caar (last nnml-article-file-alist)))
	      (cons 1 0)))
      (push (list group active) nnml-group-alist))
    (setcdr active (1+ (cdr active)))
    (while (file-exists-p
779
	    (nnml-group-pathname group (int-to-string (cdr active)) server))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
780 781 782 783 784 785 786 787 788 789 790 791
      (setcdr active (1+ (cdr active))))
    (cdr active)))

(defun nnml-add-nov (group article headers)
  "Add a nov line for the GROUP base."
  (save-excursion
    (set-buffer (nnml-open-nov group))
    (goto-char (point-max))
    (mail-header-set-number headers article)
    (nnheader-insert-nov headers)))

(defsubst nnml-header-value ()
792
  (buffer-substring (match-end 0) (point-at-eol)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
793 794 795 796 797

(defun nnml-parse-head (chars &optional number)
  "Parse the head of the current buffer."
  (save-excursion
    (save-restriction
798 799 800
      (unless (zerop (buffer-size))
	(narrow-to-region
	 (goto-char (point-min))
801 802 803 804
	 (if (re-search-forward "\n\r?\n" nil t)
	     (1- (point))
	   (point-max))))
      (let ((headers (nnheader-parse-naked-head)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
805 806 807 808
	(mail-header-set-chars headers chars)
	(mail-header-set-number headers number)
	headers))))

809
(defun nnml-get-nov-buffer (group)
810 811 812
  (let* ((decoded (nnml-decoded-group-name group))
	 (buffer (get-buffer-create (format " *nnml overview %s*" decoded)))
	 (file-name-coding-system nnmail-pathname-coding-system))
813 814 815
    (save-excursion
      (set-buffer buffer)
      (set (make-local-variable 'nnml-nov-buffer-file-name)
816
	   (nnmail-group-pathname decoded nnml-directory nnml-nov-file-name))
817 818 819 820 821
      (erase-buffer)
      (when (file-exists-p nnml-nov-buffer-file-name)
	(nnheader-insert-file-contents nnml-nov-buffer-file-name)))
    buffer))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
822 823
(defun nnml-open-nov (group)
  (or (cdr (assoc group nnml-nov-buffer-alist))
824
      (let ((buffer (nnml-get-nov-buffer group)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
825 826 827 828 829 830 831 832 833
	(push (cons group buffer) nnml-nov-buffer-alist)
	buffer)))

(defun nnml-save-nov ()
  (save-excursion
    (while nnml-nov-buffer-alist
      (when (buffer-name (cdar nnml-nov-buffer-alist))
	(set-buffer (cdar nnml-nov-buffer-alist))
	(when (buffer-modified-p)
834 835
	  (nnmail-write-region (point-min) (point-max)
			       nnml-nov-buffer-file-name nil 'nomesg))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
836 837 838 839 840
	(set-buffer-modified-p nil)
	(kill-buffer (current-buffer)))
      (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))

;;;###autoload
841
(defun nnml-generate-nov-databases (&optional server)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
842
  "Generate NOV databases in all nnml directories."
843
  (interactive (list (or (nnoo-current-server 'nnml) "")))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
844 845 846
  ;; Read the active file to make sure we don't re-use articles
  ;; numbers in empty groups.
  (nnmail-activate 'nnml)
847 848
  (unless (nnml-server-opened server)
    (nnml-open-server server))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
849 850
  (setq nnml-directory (expand-file-name nnml-directory))
  ;; Recurse down the directories.
851
  (nnml-generate-nov-databases-directory nnml-directory nil t)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
852 853 854
  ;; Save the active file.
  (nnmail-save-active nnml-group-alist nnml-active-file))

855 856 857 858 859 860 861 862
(defun nnml-generate-nov-databases-directory (dir &optional seen no-active)
  "Regenerate the NOV database in DIR.

Unless no-active is non-nil, update the active file too."
  (interactive (list (let ((file-name-coding-system
			    nnmail-pathname-coding-system))
		       (read-directory-name "Regenerate NOV in: "
					    nnml-directory nil t))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
863
  (setq dir (file-name-as-directory dir))
864 865 866 867 868 869
  (let ((file-name-coding-system nnmail-pathname-coding-system))
    ;; Only scan this sub-tree if we haven't been here yet.
    (unless (member (file-truename dir) seen)
      (push (file-truename dir) seen)
      ;; We descend recursively
      (dolist (dir (directory-files dir t nil t))
870
	(when (and (not (string-match "^\\." (file-name-nondirectory dir)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
871
		   (file-directory-p dir))
872 873 874 875 876 877 878 879 880 881 882 883 884 885 886
	  (nnml-generate-nov-databases-directory dir seen)))
      ;; Do this directory.
      (let ((files (sort (nnheader-article-to-file-alist dir)
			 'car-less-than-car)))
	(if (not files)
	    (let* ((group (nnheader-file-to-group
			   (directory-file-name dir) nnml-directory))
		   (info (cadr (assoc group nnml-group-alist))))
	      (when info
		(setcar info (1+ (cdr info)))))
	  (funcall nnml-generate-active-function dir)
	  ;; Generate the nov file.
	  (nnml-generate-nov-file dir files)
	  (unless no-active
	    (nnmail-save-active nnml-group-alist nnml-active-file)))))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
887

888
(eval-when-compile (defvar files))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
889 890
(defun nnml-generate-active-info (dir)
  ;; Update the active info for this group.
891 892 893 894 895 896 897
  (let ((group (directory-file-name dir))
	entry last)
    (setq group (nnheader-file-to-group (nnml-encoded-group-name group)
					nnml-directory)
	  entry (assoc group nnml-group-alist)
	  last (or (caadr entry) 0)
	  nnml-group-alist (delq entry nnml-group-alist))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
898
    (push (list group
899 900
		(cons (or (caar files) (1+ last))
		      (max last
901
			   (or (caar (last files))
902
			       0))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
903 904 905 906 907 908 909 910 911 912
	  nnml-group-alist)))

(defun nnml-generate-nov-file (dir files)
  (let* ((dir (file-name-as-directory dir))
	 (nov (concat dir nnml-nov-file-name))
	 (nov-buffer (get-buffer-create " *nov*"))
	 chars file headers)
    (save-excursion
      ;; Init the nov buffer.
      (set-buffer nov-buffer)
913
      (buffer-disable-undo)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
914 915 916 917 918 919 920 921 922 923 924 925
      (erase-buffer)
      (set-buffer nntp-server-buffer)
      ;; Delete the old NOV file.
      (when (file-exists-p nov)
	(funcall nnmail-delete-file-function nov))
      (while files
	(unless (file-directory-p (setq file (concat dir (cdar files))))
	  (erase-buffer)
	  (nnheader-insert-file-contents file)
	  (narrow-to-region
	   (goto-char (point-min))
	   (progn
926
	     (re-search-forward "\n\r?\n" nil t)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
927
	     (setq chars (- (point-max) (point)))
928
	     (max (point-min) (1- (point)))))
929
	  (unless (zerop (buffer-size))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
930 931 932 933 934 935 936 937 938 939
	    (goto-char (point-min))
	    (setq headers (nnml-parse-head chars (caar files)))
	    (save-excursion
	      (set-buffer nov-buffer)
	      (goto-char (point-max))
	      (nnheader-insert-nov headers)))
	  (widen))
	(setq files (cdr files)))
      (save-excursion
	(set-buffer nov-buffer)
940
	(nnmail-write-region (point-min) (point-max) nov nil 'nomesg)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958
	(kill-buffer (current-buffer))))))

(defun nnml-nov-delete-article (group article)
  (save-excursion
    (set-buffer (nnml-open-nov group))
    (when (nnheader-find-nov-line article)
      (delete-region (point) (progn (forward-line 1) (point)))
      (when (bobp)
	(let ((active (cadr (assoc group nnml-group-alist)))
	      num)
	  (when active
	    (if (eobp)
		(setf (car active) (1+ (cdr active)))
	      (when (and (setq num (ignore-errors (read (current-buffer))))
			 (numberp num))
		(setf (car active) num)))))))
    t))

959
(defun nnml-update-file-alist (&optional force)
960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019
  (when nnml-use-compressed-files
    (when (or (not nnml-article-file-alist)
	      force)
      (setq nnml-article-file-alist
	    (nnml-current-group-article-to-file-alist)))))

(defun nnml-directory-articles (dir)
  "Return a list of all article files in a directory.
Use the nov database for that directory if available."
  (if (or gnus-nov-is-evil nnml-nov-is-evil
	  (not (file-exists-p
		(expand-file-name nnml-nov-file-name dir))))
      (nnheader-directory-articles dir)
    ;; build list from .overview if available
    ;; We would use nnml-open-nov, except that nnml-nov-buffer-alist is
    ;; defvoo'd, and we might get called when it hasn't been swapped in.
    (save-excursion
      (let ((list nil)
	    art
	    (buffer (nnml-get-nov-buffer nnml-current-group)))
	(set-buffer buffer)
	(goto-char (point-min))
	(while (not (eobp))
	  (setq art (read (current-buffer)))
	  (push art list)
	  (forward-line 1))
	list))))

(defun nnml-current-group-article-to-file-alist ()
  "Return an alist of article/file pairs in the current group.
Use the nov database for the current group if available."
  (if (or nnml-use-compressed-files
	  gnus-nov-is-evil
	  nnml-nov-is-evil
	  (not (file-exists-p
		(expand-file-name nnml-nov-file-name
				  nnml-current-directory))))
      (nnheader-article-to-file-alist nnml-current-directory)
    ;; build list from .overview if available
    (save-excursion
      (let ((alist nil)
	    (buffer (nnml-get-nov-buffer nnml-current-group))
	    art)
	(set-buffer buffer)
	(goto-char (point-min))
	(while (not (eobp))
	  (setq art (read (current-buffer)))
	  ;; assume file name is unadorned (ie. not compressed etc)
	  (push (cons art (int-to-string art)) alist)
	  (forward-line 1))
	alist))))

(deffoo nnml-request-set-mark (group actions &optional server)
  (nnml-possibly-change-directory group server)
  (unless nnml-marks-is-evil
    (nnml-open-marks group server)
    (dolist (action actions)
      (let ((range (nth 0 action))
	    (what  (nth 1 action))
	    (marks (nth 2 action)))
1020
	(assert (or (eq what 'add) (eq what 'del)) nil
1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033
		"Unknown request-set-mark action: %s" what)
	(dolist (mark marks)
	  (setq nnml-marks (gnus-update-alist-soft
			    mark
			    (funcall (if (eq what 'add) 'gnus-range-add
				       'gnus-remove-from-range)
				     (cdr (assoc mark nnml-marks)) range)
			    nnml-marks)))))
    (nnml-save-marks group server))
  nil)

(deffoo nnml-request-update-info (group info &optional server)
  (nnml-possibly-change-directory group server)
1034
  (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group server))
1035 1036 1037
    (nnheader-message 8 "Updating marks for %s..." group)
    (nnml-open-marks group server)
    ;; Update info using `nnml-marks'.
1038 1039 1040 1041 1042 1043 1044 1045 1046 1047
    (mapc (lambda (pred)
	    (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
	      (gnus-info-set-marks
	       info
	       (gnus-update-alist-soft
		(cdr pred)
		(cdr (assq (cdr pred) nnml-marks))
		(gnus-info-marks info))
	       t)))
	  gnus-article-mark-lists)
1048 1049 1050 1051 1052 1053 1054 1055 1056
    (let ((seen (cdr (assq 'read nnml-marks))))
      (gnus-info-set-read info
			  (if (and (integerp (car seen))
				   (null (cdr seen)))
			      (list (cons (car seen) (car seen)))
			    seen)))
    (nnheader-message 8 "Updating marks for %s...done" group))
  info)

1057 1058
(defun nnml-marks-changed-p (group server)
  (let ((file (nnml-group-pathname group nnml-marks-file-name server)))
1059 1060 1061 1062 1063 1064 1065
    (if (null (gnus-gethash file nnml-marks-modtime))
	t ;; never looked at marks file, assume it has changed
      (not (equal (gnus-gethash file nnml-marks-modtime)
		  (nth 5 (file-attributes file)))))))

(defun nnml-save-marks (group server)
  (let ((file-name-coding-system nnmail-pathname-coding-system)
1066
	(file (nnml-group-pathname group nnml-marks-file-name server)))
1067 1068
    (condition-case err
	(progn
1069
	  (nnml-possibly-create-directory group server)
1070 1071 1072 1073 1074 1075 1076 1077 1078
	  (with-temp-file file
	    (erase-buffer)
	    (gnus-prin1 nnml-marks)
	    (insert "\n"))
	  (gnus-sethash file
			(nth 5 (file-attributes file))
			nnml-marks-modtime))
      (error (or (gnus-yes-or-no-p
		  (format "Could not write to %s (%s).  Continue? " file err))
1079
		 (error "Cannot write to %s (%s)" file err))))))
1080 1081

(defun nnml-open-marks (group server)
1082 1083 1084 1085
  (let* ((decoded (nnml-decoded-group-name group server))
	 (file (nnmail-group-pathname decoded nnml-directory
				      nnml-marks-file-name))
	 (file-name-coding-system nnmail-pathname-coding-system))
1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102
    (if (file-exists-p file)
	(condition-case err
	    (with-temp-buffer
	      (gnus-sethash file (nth 5 (file-attributes file))
			    nnml-marks-modtime)
	      (nnheader-insert-file-contents file)
	      (setq nnml-marks (read (current-buffer)))
	      (dolist (el gnus-article-unpropagated-mark-lists)
		(setq nnml-marks (gnus-remassoc el nnml-marks))))
	  (error (or (gnus-yes-or-no-p
		      (format "Error reading nnml marks file %s (%s).  Continuing will use marks from .newsrc.eld.  Continue? " file err))
		     (error "Cannot read nnml marks file %s (%s)" file err))))
      ;; User didn't have a .marks file.  Probably first time
      ;; user of the .marks stuff.  Bootstrap it from .newsrc.eld.
      (let ((info (gnus-get-info
		   (gnus-group-prefixed-name
		    group
1103 1104 1105 1106 1107 1108
		    (gnus-server-to-method
		     (format "nnml:%s" (or server "")))))))
	(setq decoded (if (member server '(nil ""))
			  (concat "nnml:" decoded)
			(format "nnml+%s:%s" server decoded)))
	(nnheader-message 7 "Bootstrapping marks for %s..." decoded)
1109 1110 1111 1112 1113
	(setq nnml-marks (gnus-info-marks info))
	(push (cons 'read (gnus-info-read info)) nnml-marks)
	(dolist (el gnus-article-unpropagated-mark-lists)
	  (setq nnml-marks (gnus-remassoc el nnml-marks)))
	(nnml-save-marks group server)
1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307
	(nnheader-message 7 "Bootstrapping marks for %s...done" decoded)))))


;;;
;;; Group and server compaction. -- dvl
;;;

;; #### FIXME: this function handles self Xref: entry correctly, but I don't
;; #### know how to handle external cross-references. I actually don't know if
;; #### this is handled correctly elsewhere. For instance, what happens if you
;; #### move all articles to a new group (that's what people do for manual
;; #### compaction) ?

;; #### NOTE: the function below handles the article backlog. This is
;; #### conceptually the wrong place to do it because the backend is at a
;; #### lower level. However, this is the only place where we have the needed
;; #### information to do the job. Ideally, this function should not handle
;; #### the backlog by itself, but return a list of moved groups / articles to
;; #### the caller. This will become important to avoid code duplication when
;; #### other backends get a compaction feature. Also, note that invalidating
;; #### the "original article buffer" is already done at an upper level.

;; Shouldn't `nnml-request-compact-group' be interactive? --rsteib

(defun nnml-request-compact-group (group &optional server save)
  (nnml-possibly-change-directory group server)
  (unless nnml-article-file-alist
    (setq nnml-article-file-alist
	  (sort (nnml-current-group-article-to-file-alist)
		'car-less-than-car)))
  (if (not nnml-article-file-alist)
      ;; The group is empty: do nothing but return t
      t
    ;; The group is not empty:
    (let* ((group-full-name
	    (gnus-group-prefixed-name
	     group
	     (gnus-server-to-method (format "nnml:%s" server))))
	   (info (gnus-get-info group-full-name))
	   (new-number 1)
	   compacted)
      (let ((articles nnml-article-file-alist)
	    article)
	(while (setq article (pop articles))
	  (let ((old-number (car article)))
	    (when (> old-number new-number)
	      ;; There is a gap here:
	      (let ((old-number-string (int-to-string old-number))
		    (new-number-string (int-to-string new-number)))
		(setq compacted t)
		;; #### NOTE: `nnml-article-to-file' calls
		;; #### `nnml-update-file-alist'  (which in turn calls
		;; #### `nnml-current-group-article-to-file-alist', which
		;; #### might use the NOV database). This might turn out to be
		;; #### inefficient. In that case, we will do the work
		;; #### manually.
		;; 1/ Move the article to a new file:
		(let* ((oldfile (nnml-article-to-file old-number))
		       (newfile
			(gnus-replace-in-string
			 oldfile
			 ;; nnml-use-compressed-files might be any string, but
			 ;; probably it's sufficient to take into account only
			 ;; "\\.[a-z0-9]+".  Note that we can't only use the
			 ;; value of nnml-use-compressed-files because old
			 ;; articles might have been saved with a different
			 ;; value.
			 (concat
			  "\\(" old-number-string "\\)\\(\\(\\.[a-z0-9]+\\)?\\)$")
			 (concat new-number-string "\\2"))))
		  (with-current-buffer nntp-server-buffer
		    (nnmail-find-file oldfile)
		    ;; Update the Xref header in the article itself:
		    (when (and (re-search-forward "^Xref: [^ ]+ " nil t)
			       (re-search-forward
				(concat "\\<"
					(regexp-quote
					 (concat group ":" old-number-string))
					"\\>")
				(point-at-eol) t))
		      (replace-match
		       (concat group ":" new-number-string)))
		    ;; Save to the new file:
		    (nnmail-write-region (point-min) (point-max) newfile))
		  (funcall nnmail-delete-file-function oldfile))
		;; 2/ Update all marks for this article:
		;; #### NOTE: it is possible that the new article number
		;; #### already belongs to a range, whereas the corresponding
		;; #### article doesn't exist (for example, if you delete an
		;; #### article). For that reason, it is important to update
		;; #### the ranges (meaning remove inexistant articles) before
		;; #### doing anything on them.
		;; 2 a/ read articles:
		(let ((read (gnus-info-read info)))
		  (setq read (gnus-remove-from-range read (list new-number)))
		  (when (gnus-member-of-range old-number read)
		    (setq read (gnus-remove-from-range read (list old-number)))
		    (setq read (gnus-add-to-range read (list new-number))))
		  (gnus-info-set-read info read))
		;; 2 b/ marked articles:
		(let ((oldmarks (gnus-info-marks info))
		      mark newmarks)
		  (while (setq mark (pop oldmarks))
		    (setcdr mark (gnus-remove-from-range (cdr mark)
							 (list new-number)))
		    (when (gnus-member-of-range old-number (cdr mark))
		      (setcdr mark (gnus-remove-from-range (cdr mark)
							   (list old-number)))
		      (setcdr mark (gnus-add-to-range (cdr mark)
						      (list new-number))))
		    (push mark newmarks))
		  (gnus-info-set-marks info newmarks))
		;; 3/ Update the NOV entry for this article:
		(unless nnml-nov-is-evil
		  (save-excursion
		    (set-buffer (nnml-open-nov group))
		    (when (nnheader-find-nov-line old-number)
		      ;; Replace the article number:
		      (looking-at old-number-string)
		      (replace-match new-number-string nil t)
		      ;; Update the Xref header:
		      (when (re-search-forward
			     (concat "\\(Xref:[^\t\n]* \\)\\<"
				     (regexp-quote
				      (concat group ":" old-number-string))
				     "\\>")
			     (point-at-eol) t)
			(replace-match
			 (concat "\\1" group ":" new-number-string))))))
		;; 4/ Possibly remove the article from the backlog:
		(when gnus-keep-backlog
		  ;; #### NOTE: instead of removing the article, we could
		  ;; #### modify the backlog to reflect the numbering change,
		  ;; #### but I don't think it's worth it.
		  (gnus-backlog-remove-article group-full-name old-number)
		  (gnus-backlog-remove-article group-full-name new-number))))
	    (setq new-number (1+ new-number)))))
      (if (not compacted)
	  ;; No compaction had to be done:
	  t
	;; Some articles have actually been renamed:
	;; 1/ Rebuild active information:
	(let ((entry (assoc group nnml-group-alist))
	      (active (cons 1 (1- new-number))))
	  (setq nnml-group-alist (delq entry nnml-group-alist))
	  (push (list group active) nnml-group-alist)
	  ;; Update the active hashtable to let the *Group* buffer display
	  ;; up-to-date lines. I don't think that either gnus-newsrc-hashtb or
	  ;; gnus-newwrc-alist are out of date, since all we did is to modify
	  ;; the info of the group internally.
	  (gnus-set-active group-full-name active))
	;; 1 bis/
	;; #### NOTE: normally, we should save the overview (NOV) file
	;; #### here, just like we save the marks file. However, there is no
	;; #### such function as nnml-save-nov for a single group. Only for
	;; #### all groups. Gnus inconsistency is getting worse every day...
	;; 2/ Rebuild marks file:
	(unless nnml-marks-is-evil
	  ;; #### NOTE: this constant use of global variables everywhere is
	  ;; #### truly disgusting. Gnus really needs a *major* cleanup.
	  (setq nnml-marks (gnus-info-marks info))
	  (push (cons 'read (gnus-info-read info)) nnml-marks)
	  (dolist (el gnus-article-unpropagated-mark-lists)
	    (setq nnml-marks (gnus-remassoc el nnml-marks)))
	  (nnml-save-marks group server))
	;; 3/ Save everything if this was not part of a bigger operation:
	(if (not save)
	    ;; Nothing to save (yet):
	    t
	  ;; Something to save:
	  ;; a/ Save the NOV databases:
	  ;; #### NOTE: this should be done directory per directory in 1bis
	  ;; #### above. See comment there.
	  (nnml-save-nov)
	  ;; b/ Save the active file:
	  (nnmail-save-active nnml-group-alist nnml-active-file)
	  t)))))

(defun nnml-request-compact (&optional server)
  "Request compaction of all SERVER nnml groups."
  (interactive (list (or (nnoo-current-server 'nnml) "")))
  (nnmail-activate 'nnml)
  (unless (nnml-server-opened server)
    (nnml-open-server server))
  (setq nnml-directory (expand-file-name nnml-directory))
  (let* ((groups (gnus-groups-from-server
		  (gnus-server-to-method (format "nnml:%s" server))))
	 (first (pop groups))
	 group)
    (when first
      (while (setq group (pop groups))
	(nnml-request-compact-group (gnus-group-real-name group) server))
      (nnml-request-compact-group (gnus-group-real-name first) server t))))