+(defun nnml-update-file-alist (&optional force)
+ (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)))
+ (assert (or (eq what 'add) (eq what 'del)) nil
+ "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)
+ (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group server))
+ (nnheader-message 8 "Updating marks for %s..." group)
+ (nnml-open-marks group server)
+ ;; Update info using `nnml-marks'.
+ (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)
+ (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)
+
+(defun nnml-marks-changed-p (group server)
+ (let ((file (nnml-group-pathname group nnml-marks-file-name server)))
+ (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)
+ (file (nnml-group-pathname group nnml-marks-file-name server)))
+ (condition-case err
+ (progn
+ (nnml-possibly-create-directory group server)
+ (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))
+ (error "Cannot write to %s (%s)" file err))))))
+
+(defun nnml-open-marks (group server)
+ (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))
+ (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
+ (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)
+ (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)
+ (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))))
+
+
projects / gnus / blobdiff