comparison lisp/gnus/nnml.el @ 110468:8ceac426a2d7

merge trunk

110384:8d0ea2f29215

  (nnmail-group-pathname (inline (nnml-decoded-group-name group server))
			 nnml-directory file))

(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)
      (let* ((file nil)
	     (number (length sequence))
	     (count 0)
	     (file-name-coding-system nnmail-pathname-coding-system)

      (nnheader-report 'nnml "Article %s retrieved" id)
      ;; We return the article number.
      (cons (if group-num (car group-num) group)
	    (string-to-number (file-name-nondirectory path)))))))

(deffoo nnml-request-group (group &optional server dont-check)
  (let ((file-name-coding-system nnmail-pathname-coding-system)
	(decoded (nnml-decoded-group-name group server)))
    (cond
     ((not (nnml-possibly-change-directory group server))
      (nnheader-report 'nnml "Invalid group (no such directory)"))

     (nnml-deletable-article-p group article)
     (nnml-request-article article group server)
     (let (nnml-current-directory
	   nnml-current-group
	   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))
     (progn

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

(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)
      (when (ignore-errors

				     nnml-current-directory))
	       nil (if (nnheader-be-verbose 5) nil 'nomesg))
	      t)
	(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.
	      (gnus-delete-line)

	    (not (eq (cdr (nth 1 (assoc group nnml-group-alist)))
		     article)))))))

;; Find an article number in the current group given the Message-ID.
(defun nnml-find-group-number (id server)
  (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.

(defun nnml-retrieve-headers-with-nov (articles &optional fetch-old)
  (if (or gnus-nov-is-evil nnml-nov-is-evil)
      nil
    (let ((nov (expand-file-name nnml-nov-file-name nnml-current-directory)))
      (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.

	(push (cons group buffer) nnml-incremental-nov-buffer-alist)
	buffer)))

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

(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 ()

					    (if incrementalp
						"incremental "
					      "")
					    decoded)))
	 (file-name-coding-system nnmail-pathname-coding-system))
    (save-excursion
      (set-buffer buffer)
      (set (make-local-variable 'nnml-nov-buffer-file-name)
	   (nnmail-group-pathname decoded nnml-directory nnml-nov-file-name))
      (erase-buffer)
      (when (and (not incrementalp)
		 (file-exists-p nnml-nov-buffer-file-name))

  ;; Recurse down the directories.
  (nnml-generate-nov-databases-directory nnml-directory nil t)
  ;; Save the active file.
  (nnmail-save-active nnml-group-alist nnml-active-file))

(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

      (dolist (dir (directory-files dir t nil t))
	(when (and (not (string-match "^\\." (file-name-nondirectory dir)))
		   (file-directory-p dir))
	  (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)))))))

(defvar files)
(defun nnml-generate-active-info (dir)
  ;; Update the active info for this group.
  (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))
    (push (list group
		(cons (or (caar files) (1+ last))
		      (max last
			   (or (caar (last files))
			       0))))
	  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)
      (buffer-disable-undo)
      (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
	     (re-search-forward "\n\r?\n" nil t)
	     (setq chars (- (point-max) (point)))
	     (max (point-min) (1- (point)))))
	  (unless (zerop (buffer-size))
	    (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)
	(nnmail-write-region (point-min) (point-max) nov nil 'nomesg)
	(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)

		(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))

	  (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)

						      (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:

110468:8ceac426a2d7

  (nnmail-group-pathname (inline (nnml-decoded-group-name group server))
			 nnml-directory file))

(deffoo nnml-retrieve-headers (sequence &optional group server fetch-old)
  (when (nnml-possibly-change-directory group server)
    (with-current-buffer nntp-server-buffer
      (erase-buffer)
      (let* ((file nil)
	     (number (length sequence))
	     (count 0)
	     (file-name-coding-system nnmail-pathname-coding-system)

      (nnheader-report 'nnml "Article %s retrieved" id)
      ;; We return the article number.
      (cons (if group-num (car group-num) group)
	    (string-to-number (file-name-nondirectory path)))))))

(deffoo nnml-request-group (group &optional server dont-check info)
  (let ((file-name-coding-system nnmail-pathname-coding-system)
	(decoded (nnml-decoded-group-name group server)))
    (cond
     ((not (nnml-possibly-change-directory group server))
      (nnheader-report 'nnml "Invalid group (no such directory)"))

     (nnml-deletable-article-p group article)
     (nnml-request-article article group server)
     (let (nnml-current-directory
	   nnml-current-group
	   nnml-article-file-alist)
       (with-current-buffer buf
	 (insert-buffer-substring nntp-server-buffer)
	 (setq result (eval accept-form))
	 (kill-buffer (current-buffer))
	 result))
     (progn

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

(deffoo nnml-request-replace-article (article group buffer)
  (nnml-possibly-change-directory group)
  (with-current-buffer buffer
    (nnml-possibly-create-directory group)
    (let ((chars (nnmail-insert-lines))
	  (art (concat (int-to-string article) "\t"))
	  headers)
      (when (ignore-errors

				     nnml-current-directory))
	       nil (if (nnheader-be-verbose 5) nil 'nomesg))
	      t)
	(setq headers (nnml-parse-head chars article))
	;; Replace the NOV line in the NOV file.
	(with-current-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.
	      (gnus-delete-line)

	    (not (eq (cdr (nth 1 (assoc group nnml-group-alist)))
		     article)))))))

;; Find an article number in the current group given the Message-ID.
(defun nnml-find-group-number (id server)
  (with-current-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.

(defun nnml-retrieve-headers-with-nov (articles &optional fetch-old)
  (if (or gnus-nov-is-evil nnml-nov-is-evil)
      nil
    (let ((nov (expand-file-name nnml-nov-file-name nnml-current-directory)))
      (when (file-exists-p nov)
	(with-current-buffer nntp-server-buffer
	  (erase-buffer)
	  (nnheader-insert-file-contents nov)
	  (if (and fetch-old
		   (not (numberp fetch-old)))
	      t				; Don't remove anything.

	(push (cons group buffer) nnml-incremental-nov-buffer-alist)
	buffer)))

(defun nnml-add-incremental-nov (group article headers)
  "Add a nov line for the GROUP nov headers, incrementally."
  (with-current-buffer (nnml-open-incremental-nov group)
    (goto-char (point-max))
    (mail-header-set-number headers article)
    (nnheader-insert-nov headers)))

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

(defsubst nnml-header-value ()

					    (if incrementalp
						"incremental "
					      "")
					    decoded)))
	 (file-name-coding-system nnmail-pathname-coding-system))
    (with-current-buffer buffer
      (set (make-local-variable 'nnml-nov-buffer-file-name)
	   (nnmail-group-pathname decoded nnml-directory nnml-nov-file-name))
      (erase-buffer)
      (when (and (not incrementalp)
		 (file-exists-p nnml-nov-buffer-file-name))

  ;; Recurse down the directories.
  (nnml-generate-nov-databases-directory nnml-directory nil t)
  ;; Save the active file.
  (nnmail-save-active nnml-group-alist nnml-active-file))

(defvar nnml-files)
(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

      (dolist (dir (directory-files dir t nil t))
	(when (and (not (string-match "^\\." (file-name-nondirectory dir)))
		   (file-directory-p dir))
	  (nnml-generate-nov-databases-directory dir seen)))
      ;; Do this directory.
      (let ((nnml-files (sort (nnheader-article-to-file-alist dir)
			 'car-less-than-car)))
	(if (not nnml-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 nnml-files)
	  (unless no-active
	    (nnmail-save-active nnml-group-alist nnml-active-file)))))))

(defun nnml-generate-active-info (dir)
  ;; Update the active info for this group.
  (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))
    (push (list group
		(cons (or (caar nnml-files) (1+ last))
		      (max last
			   (or (caar (last nnml-files))
			       0))))
	  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)
    (with-current-buffer nov-buffer
      ;; Init the nov buffer.
      (buffer-disable-undo)
      (erase-buffer)
      (set-buffer nntp-server-buffer)
      ;; Delete the old NOV file.
      (when (file-exists-p nov)
	(funcall nnmail-delete-file-function nov))
      (dolist (file files)
	(unless (file-directory-p (setq file (concat dir (cdr file))))
	  (erase-buffer)
	  (nnheader-insert-file-contents file)
	  (narrow-to-region
	   (goto-char (point-min))
	   (progn
	     (re-search-forward "\n\r?\n" nil t)
	     (setq chars (- (point-max) (point)))
	     (max (point-min) (1- (point)))))
	  (unless (zerop (buffer-size))
	    (goto-char (point-min))
	    (setq headers (nnml-parse-head chars (car file)))
	    (with-current-buffer nov-buffer
	      (goto-char (point-max))
	      (nnheader-insert-nov headers)))
	  (widen)))
      (with-current-buffer nov-buffer
	(nnmail-write-region (point-min) (point-max) nov nil 'nomesg)
	(kill-buffer (current-buffer))))))

(defun nnml-nov-delete-article (group article)
  (with-current-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)

		(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.
    (with-current-buffer (nnml-get-nov-buffer nnml-current-group)
      (let ((list nil)
	    art)
	(goto-char (point-min))
	(while (not (eobp))
	  (setq art (read (current-buffer)))
	  (push art list)
	  (forward-line 1))

	  (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
    (with-current-buffer (nnml-get-nov-buffer nnml-current-group)
      (let ((alist nil)
	    art)
	(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)

						      (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
		  (with-current-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: