Surviving with Emacs/VM mail client where everybody else uses MS Outlook

Using Emacs and VM for e-mail in a company that has a lot of MS Outlook employees can be a difficult task. Microsoft Outlook handles e-mails in a non-standard way in many cases. Reading e-mails properly and making your e-mails properly read by others can be tough tasks. This post addresses some issues.

Removing HTML part from text messages

Outlook always includes an HTML portion of the message as well, even if the message was composed as “Plain text”. This function removes the HTML part, preserving only the text portion.

(defun upn-mail-remove-html ()
  "Removes HTML portions from reply e-mails."
  (interactive)
  (let (old-case-fold-val)
	 (setq old-case-fold-val case-fold-search)
	 (setq case-fold-search t)
	 (when (search-forward "")
			 (delete-region beg (point)))))
	 (setq case-fold-search old-case-fold-val)))

The above function can be conveniently added in the supercite’s post-hook so that it will be done after supercite prepares the reply buffer.

(add-hook 'sc-post-hook 'upn-mail-remove-html)

While all other mail clients show a name as “<FirstName> <LastName>”, Outlook shows it as “<LastName>, <FirstName>”, thereby breaking VM’s handling of the names and generating the right supercite prefixes. The following function extracts the first name and last name from both mail formats.

;; The following one matches the name from MS Outlook.
(defconst upn-ms-outlook-name-regexp "\\([^,\"]+\\),[ \t]+\\([^,\"]+\\)")

;; The following one matches the name from all "sensible" mailers.
(defconst upn-normal-name-regexp "\\([^\"<>]+\\)[ \t]+\\([^\"<>]+\\)")

(defun upn-get-ms-outlook-name (fromline)
  "Extracts First name and last name from a name in MS Outlook format.
   Returns nil if it doesn't match."
  (let (matched-retval)
    (setq matched-retval (string-match upn-ms-outlook-name-regexp fromline) )

    (if (not matched-retval)
        nil
      (let (
            (firstword (substring fromline (match-beginning 1) (match-end 1)))
            (secondword  (substring fromline (match-beginning 2) (match-end 2)))
            )
        ;; return the firstname which will be the second word:
        (list secondword firstword)))))

This function extract the same information from a normal name.

(defun upn-get-normal-name (fromline)
"Extracts First name and last name from a name in a normal format.
  Returns nil if it doesn't match."
  (let (matched-retval)
    (setq matched-retval (string-match upn-normal-name-regexp fromline) )

    (if (not matched-retval)
        nil
      (let (
            (firstword (substring fromline (match-beginning 1) (match-end 1)))
            (secondword  (substring fromline (match-beginning 2) (match-end 2)))
            )
        ;; return the firstname which will be the second word:
        (list firstword secondword)))))

The following function can be used to extract the name info from either format.

(defun upn-get-first-last-name (fromline)
  "Gets the first name and last name from the From: line of a mail header.
Handles normal names and names from MS outlook."
  (let (result)
    ;; Most people are rotten by Exchange sever, so check it first
    (setq result (upn-get-ms-outlook-name fromline))
    (unless result

      ;; Now check the normal one
      (setq result (upn-get-normal-name fromline))
      (unless result

        ;; Set the name as nil, so the calling function can take action
        (setq result nil)))

    ;; Return result
    (or result)))

The following function generates a word from the first name and the initial showing the last name from a name of either format, to be used as the supercite prefix.

(defun upn-get-FirstL-name (namestring)
  "Gets a string formed by a capitalized first name appended with the
first letter of the last name capitalized, from the From: header of an
e-mail.  This is used as the attribution if one has not been
provided."
  (let (result result-list)
    (setq result-list (upn-get-first-last-name namestring))
    (if (not result-list)
        (setq result namestring)
      (setq result
            (concat (capitalize (car result-list))
                    (upcase (substring (cadr result-list) 0 1)))))
    (or result)))