Mapping over Zmail to/from headers

[Jeffrey Mark Siskind <Qobi@zermatt.lcs.mit.edu>]

I thank everybody for the response to my query about Zmail headers.
I have written the enclosed command which people might be interested
in. It uses information provided to me by Christopher Garrigues
(7thSon@SPAR-20.ARPA).
To use it you enter Zmail and type <Suspend> to get a break loop
in the typeout window. Then type :Show Corresponders to get
a list of all people in either to or from fields of the current
Zmail sequence. I'm sure the functionality of this can be
enhanced, but right now it is a simple hack to see whom
I communicate with.
        Enjoy,
        Jeff

;;; -*- Mode: LISP; Package: USER; Base: 10; Syntax: Common-lisp -*-

(cp:define-command (com-show-corresponders :command-table "Global") ()
   (let ((corresponders (make-hash-table :test #'equal)))
     (send zwei:*sequence* :map-over-msgs
           (lambda (msg)
             (loop for from in (getf (zwei:msg-status msg) :from)
                   for id = (list (string-upcase (getf from :name))
                                  (map 'list
                                       (lambda (thing)
                                         (if (stringp thing)
                                             (string-upcase thing)
                                             thing))
                                       (getf from :host)))
                   for who = (getf from :original-string)
                   when (null (gethash id corresponders))
                     do (setf (gethash id corresponders) who))
             (loop for to in (getf (zwei:msg-status msg) :to)
                   for id = (list (string-upcase (getf to :name))
                                  (map 'list
                                       (lambda (thing)
                                         (if (stringp thing)
                                             (string-upcase thing)
                                             thing))
                                       (getf to :host)))
                   for who = (getf to :original-string)
                   when (null (gethash id corresponders))
                     do (setf (gethash id corresponders) who))))
     (loop for who being the hash-elements of corresponders
           do (format t "~&~A" who))))