upn-handle-ms-outlook.el

;; -*- emacs-lisp -*-

;; upn-handle-ms-outlook.el
;; RCS Id : $Id: upn-handle-ms-outlook.el,v 1.2 2003/02/25 19:54:17 unair Exp $
;; Umesh P Nair, 2001-2007

;; This file (normally the compiled form) is unconditionally loaded
;; (i.e., there is no autoload mechanism yet) by .emacs on startup

;; This file (normally the compiled form) is *not* loaded by .emacs on
;; startup.  It is loaded from upn-mail-settings.el[c] when VM is
;; started.

;; I have taken care to make this compile on GNU emacs and
;; xemacs. However, this has been used only on GNU Emacs. No serious
;; testing has been done on xemacs.
;; ------------------------------------------------------------------

;; Microsoft Outlook mail tool, which is used by majority of Mentor
;; Graphics employees, forced me and Brent Goodrick to invest some
;; time in Emacs Lisp programming to get rid of many of its
;; non-standard absurdities

;; MS Outlook sends text and HTML in messages. 
;; The following function removes the HTML 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 "<!DOCTYPE HTML" (point-max) t)
		(forward-char -14)
		(let ((beg (point)))
		  (when (search-forward "</HTML>")
			 (delete-region beg (point)))))
	 (setq case-fold-search old-case-fold-val)))

;; The above function is 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)


;; Microsoft Outlook records the e-mail address as "LastName,
;; FirstName" instead of the traditional "FirstName LastName", so
;; supercite takes "LastName," as first name and "FirstName" as last
;; name. This creates confusion when supercite quotes the reply,
;; especially since the comma in the first name makes further quoting
;; impossible.

;; The following regexp is a modified one from the one Brent Goodrick
;; came up with:
(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)
  "Converts Addresses from MS Outlook ('LastName, FirstName') format
to 'FirstName Lastname' format. Returns (firstname, lastname) as a
list. 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)))))

(defun upn-get-normal-name (fromline)
"Extracts First name and last name from a name in a normal format."
  (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)))))


(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)))


(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)))

;; Set the attribution for supercite
(setq 
 sc-attrib-selection-list     
 '(("sc-from-address"
    ((".*" . 
      (or 
       ;; If an attribution is set in bbdb, get that
       (bbdb/sc-consult-attr (sc-mail-field "sc-from-address")) 

       ;; Else see whether the first name and last initial could be combined
       ;; If that doesn't work, it returns the original From: field, use it
       (upn-get-FirstL-name (sc-mail-field "From"))
       ))))))