Re: setting marks for imported mailboxes, adding new mark types

[jbw@cs.bu.edu (Joe Wells)]

Enclosed below is a piece of code that sets the "answered" marks correctly
for mail imported from VM 5.32 mailboxes.

Instructions for use:

  0. Only tried with these versions: VM 5.32; Gnus v5.1; nnml
     1.0.  I have no idea if it will work with any others.

  1. Set up mail reading with some Gnus backend.  If you are not using
     nnml, you must hack the code by replacing (nnml "") with the
     appropriate method specification.

  2. Snarf the VM mailbox.  I did this by setting nnmail-spool-file to
     point to a copy of the mailbox and then starting Gnus.

  3. Invoke the command "M-x gnus-notice-vm-replied-marks".  Do this
     before answering any of the imported messages.  Your computer will
     explode if any of the messages are already marked as being answered
     in Gnus.

  4. Check if it worked.  If it didn't, fix the code and share the fixed
     version.

-- 
Enjoy,

Joe Wells <jbw@cs.bu.edu>

----------------------------------------------------------------------
;; Created by: Joe Wells, jbw@csb.bu.edu
;; Created on: Thu Jun 13 21:38:36 1996
;; Last modified by: Joe Wells, jbw@csb.bu.edu
;; Last modified on: Thu Jun 13 21:39:38 1996
;; Filename: fixup-mail-reply-marks.el
;; Purpose: import VM replied marks into Gnus

;; Hacked together from various pieces of Gnus.

(defun gnus-notice-vm-replied-marks ()
  (interactive)
  (save-excursion
    (set-buffer nntp-server-buffer)
    
    (let ((newsrc (cdr gnus-newsrc-alist))
          (method '(nnml ""))
          groups)

      ;; Get list of mail groups.
      (while newsrc
        (and (gnus-server-equal 
              (gnus-find-method-for-group 
               (car (car newsrc)) (car newsrc))
              method)
             (setq groups (cons (car (car newsrc)) groups)))
        (setq newsrc (cdr newsrc)))
      
      (while groups
        (let ((group (car groups))
              articles article replied headers)
          (setq groups (cdr groups))

          ;; Find articles in group.
          ;; Raw range possibly including expired articles.
          (setq articles
                (gnus-uncompress-sequence
                 (gnus-gethash group gnus-active-hashtb)))
          ;; Get headers for actual existing articles.
          (or (eq 'nov (gnus-retrieve-headers articles group))
              (error "oops .. not implemented"))
          ;; Bullshit so next step does not go awry.
          (setq gnus-newsgroup-dependencies 
                (gnus-make-hashtable (length articles)))
          ;; Parse the *nntpd* buffer to get article numbers.
          (setq headers (gnus-get-newsgroup-headers-xover articles))
          (setq articles
                (mapcar
                 (function (lambda (header) (mail-header-number header)))
                 headers))
          
          ;; Find sequence of answered messages in group.
          (while articles
            (let ((article (car articles)))
              (setq articles (cdr articles))

              ;; Load article's data.
              (gnus-request-article article group) ; buffer
              
              ;; Determine if article had been replied to in VM.
              ;; X-VM-v5-Data: ([nil nil nil nil t nil nil nil nil] ...
              (goto-char (point-min))
              (narrow-to-region (point-min)
                                (progn (search-forward "\n\n") (point)))
              (let* ((vm-data (read (mail-fetch-field "X-VM-v5-Data")))
                     (vm-flags (if (consp vm-data) (car vm-data)))
                     (replied-flag (if (vectorp vm-flags) (aref vm-flags 4))))
                (if replied-flag
                    (setq replied (cons article replied))))))
        
          ;; Mark sequence as answered.
          ;; The 'reply marks are kept uncompressed (Why!?!?). 
          (setq replied (nreverse replied))
          (gnus-add-marked-articles group 'reply replied))))))