rmail-sort-by-correspondent sort criteria

[Pascal J. Bourguignon]

I  find  it  more  useful  if  rmail-sort-by-correspondent  sorts  the
correspondents taking  into account the logical structure  of an email
address  instead  of  doing   a  mere  lexicographic  sort.  When  the
"correspondent" is not a single person, but a composite entity such as
an  enterprise, the  proposed  version of  rmail-sort-by-correspondent
keeps   together   emails   from   alfred.machin@acme.com   and   from
zyla.thingy@acme.com.

------------------------------------------------------------------------
(defun rmail-sort-by-correspondent (reverse)
  "Sort messages of current Rmail file by other correspondent.
If prefix argument REVERSE is non-nil, sort them in reverse order.
The correspondant domain is heavier than the correspondant name.
Email addresses are not case sensitive."
  (interactive "P")
  (rmail-sort-messages reverse
                       (function
                        (lambda (msg)
              (let* ((address
                      (rmail-select-correspondent
                       msg
                       '("From" "Sender" "To" "Apparently-To")))
                     (atpos (string-index address ?@)))
                (downcase
                 (if atpos
                     (concat 
                      (unsplit-string (reverse (split-string 
                               (substring address (+ 1 atpos)) "[.]")) ".")
                      "@"
                      (substring address 0 atpos))
                   address)))))))


(defun string-index (string char &optional frompos)
  "Return the position in STRING of the first occurence of CHAR searching  
FROMPOS, or from the start if FROMPOS is absent or nil. 
If CHAR is not found, then return nil."
  (let ((index (cond ((null frompos) 0)
                     ((integerp frompos) frompos)
                      (t (error (format 
                         "Wrong type of argument: integerp, 3 (got: %S)"
                         frompos)))))
        (len   (length string))
        (target (cond ((charp char) char)
                      ((symbolp char) (string-to-char (symbol-name char)))
                      ((stringp char) (string-to-char char))
                      (t (error (format 
                         "Wrong type of argument: charp, 2 (got: %S)" char))))))
    (while (and (< index len) (not (= (aref string index) target)))
      (setq index (+ 1 index)))
    (if (< index len)
        index
      nil)))

(defun charp (x)
  (integerp x))

(defun unsplit-string (string-list &rest separator)
  "Does the inverse than split-string. If no separator is provided 
then a simple space is used."
  (if (null separator)
      (setq separator " ")
    (if (= 1 (length separator))
        (setq separator (car separator))
      (error "unsplit-string: Too many separator arguments.")))
  (if (not (char-or-string-p separator))
      (error "unsplit-string: separator must be a string or a char."))
  (apply 'concat (list-insert-separator string-list separator)))

(defun list-insert-separator (list separator)
  (if (or (null list)
          (null (cdr list)))
      list
    (cons (car list) (cons separator 
                           (list-insert-separator (cdr list) separator)))))

------------------------------------------------------------------------


-- 
__Pascal Bourguignon__    PGP Key ID:      0xEF5E9966
mailto:pjb@imaginet.fr    PGP fingerprint: 00 F5 7B DB CA 51 8A AD 04 5B 
http://www.imaginet.fr/~pjb/               6C DE 32 60 16 8E EF 5E 99 66

() Join the ASCII ribbon campaign against html email and Microsoft attachments.
/\ Software patents are endangering the computer industry all around the world.
   Join the LPF:     http://lpf.ai.mit.edu/      http://petition.eurolinux.org/