Function: spam-copy-or-move-routine

spam-copy-or-move-routine is a byte-compiled function defined in spam.el.gz.

Signature

(spam-copy-or-move-routine COPY GROUPS ARTICLES CLASSIFICATION)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/spam.el.gz
;;}}}

;;{{{ spam-use-move and spam-use-copy backend support functions

(defun spam-copy-or-move-routine (copy groups articles classification)

  (when (and (car-safe groups) (listp (car-safe groups)))
    (setq groups (pop groups)))

  (unless (listp groups)
    (setq groups (list groups)))

    ;; remove the current process mark
  (gnus-summary-kill-process-mark)

  (let ((backend-supports-deletions
         (gnus-check-backend-function
          'request-move-article gnus-newsgroup-name))
        (respool-method (gnus-find-method-for-group gnus-newsgroup-name))
        deletep respool valid-move-destinations) ;; article mark

    (when (member 'respool groups)
      (setq respool t)                  ; boolean for later
      (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it

    ;; exclude invalid move destinations
    (dolist (group groups)
      (unless
          (or
           (and
            (eq classification 'spam)
            (spam-group-spam-contents-p gnus-newsgroup-name)
            (spam-group-spam-contents-p group)
            (gnus-message
             3
             "Sorry, can't move spam from spam group %s to spam group %s"
             gnus-newsgroup-name
             group))
           (and
            (eq classification 'ham)
            (spam-group-ham-contents-p gnus-newsgroup-name)
            (spam-group-ham-contents-p group)
            (gnus-message
             3
             "Sorry, can't move ham from ham group %s to ham group %s"
             gnus-newsgroup-name
             group)))
        (push group valid-move-destinations)))

    (setq groups (nreverse valid-move-destinations))

    ;; now do the actual move
    (dolist (group groups)

      (when (and articles (stringp group))

        ;; first, mark the article with the process mark and, if needed,
        ;; the unread or expired mark (for ham and spam respectively)
        (dolist (article articles)
          (when (and (eq classification 'ham)
                     spam-mark-ham-unread-before-move-from-spam-group)
            (gnus-message 9 "Marking ham article %d unread before move"
                          article)
            (gnus-summary-mark-article article gnus-unread-mark))
          (when (and (eq classification 'spam)
                     (not copy))
            (gnus-message 9 "Marking spam article %d expirable before move"
                          article)
            (gnus-summary-mark-article article gnus-expirable-mark))
          (gnus-summary-set-process-mark article)

          (if respool              ; respooling is with a "fake" group
              (let ((spam-split-disabled
                     (or spam-split-disabled
                         (and (eq classification 'ham)
                              spam-disable-spam-split-during-ham-respool))))
                (gnus-message 9 "Respooling article %d with method %s"
                              article respool-method)
                (gnus-summary-respool-article nil respool-method))
            ;; else, we are not respooling
            (if (or (not backend-supports-deletions)
                    (> (length groups) 1))
                (progn              ; if copying, copy and set deletep
                  (gnus-message 9 "Copying article %d to group %s"
                                article group)
                  (gnus-summary-copy-article nil group)
                  (setq deletep t))
              (gnus-message 9 "Moving article %d to group %s"
                            article group)
              (gnus-summary-move-article nil group)))))) ; else move articles

    ;; now delete the articles, unless a) copy is t, and there was a copy done
    ;;                                 b) a move was done to a single group
    ;;                                 c) backend-supports-deletions is nil
    (unless copy
      (when (and deletep backend-supports-deletions)
	(dolist (article articles)
	  (gnus-summary-set-process-mark article)
	  (gnus-message 9 "Deleting article %d" article))
	(when articles
	  (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
	    (gnus-summary-delete-article nil)))))
    (gnus-summary-yank-process-mark)
    (length articles)))