🚀 go-pugleaf

I posted an older version of this around the same time.  Kyle, do you hate it?

;;; There are many systems where the user's real name is encoded in the
;;; user id.  This version of vm-su-do-author parses the user-id to extract
;;; the real name, so that the %F directive does what you want more of the
;;; time.  It handles the following forms of addresses:
;;;
;;;	Jamie.Zawinski@somehost		--> "Jamie Zawinski"
;;;	Jamie_Zawinski@somehost		--> "Jamie Zawinski"
;;;	Jamie_W._Zawinski@somehost	--> "Jamie W. Zawinski"
;;;	Jamie.W.Zawinski@somehost	--> "Jamie W Zawinski"
;;;	"Jamie Zawinski"@somehost	--> "Jamie Zawinski"
;;; also
;;;	jwz ("Jamie Zawinski")		--> "Jamie Zawinski"
;;;	jwz (Jamie Zawinski (comment))	--> "Jamie Zawinski"
;;;	jwz (Jamie Zawinski -- comment)	--> "Jamie Zawinski"
;;; and likewise in the "name <uid>" form.

(if (not (fboundp 'vm-su-do-author)) (load-library "vm-summary"))

(defun vm-su-do-author (m)
  (let (full-name from)
    (setq full-name (vm-get-header-contents m "Full-Name"))
    (setq from (or (vm-get-header-contents m "From") (vm-grok-From_-author m)))
    (cond ((null from)
	   (setq from "???")
	   (if (null full-name)
	       (setq full-name "???")))
	  ((string-match "^\\([^< \t\n]+\\([ \t\n]+[^< \t\n]+\\)*\\)?[ \t\n]*\\(<\\([^>]+\\)>\\)"
			 from)
	   ;; Matches "Real Name <uid>"
	   (if (and (match-beginning 1) (null full-name))
	       (setq full-name
		     (substring from (match-beginning 1) (match-end 1))))
	   (setq from (substring from (match-beginning 4) (match-end 4))))
	  ((string-match "^[^(]*(\\(.*\\))[^)]*$" from)
	   ;; Matches "uid (Real Name)" as well as "uid (real (really) name)"
	   ;; and "uid (real name (comment))"
	   (if (null full-name)
	       (setq full-name (substring from (match-beginning 1)
					  (match-end 1))))
	   (setq from
		 (concat
		  (substring from (match-beginning 0) (1- (match-beginning 1)))
		  (substring from (1+ (match-end 1)) (match-end 0))))))
    ;; ewe ewe see pee...
    (if (and vm-gargle-uucp (string-match
"\\([^!@:.]+\\)\\(\\.[^!@:]+\\)?!\\([^!@: \t\n]+\\)\\(@\\([^!@:. \t\n]+\\)\\(.[^ \t\n]+\\)?\\)?[ \t\n]*$"
			     from))
	(setq from
	      (concat
	       (substring from (match-beginning 3) (match-end 3)) "@"
	       (if (and (match-beginning 5) (match-beginning 2)
			(not (match-beginning 6)))
		   (concat (substring from (match-beginning 5) (match-end 5))
			   ".")
		 "")
	       (substring from (match-beginning 1)
			  (or (match-end 2) (match-end 1)))
	       (if (match-end 2) "" ".UUCP"))))
    (if (or (null full-name) (string-match "^[ \t]*$" full-name))
	(setq full-name from))
    ;; derive username from address if address is of the form "User.Name@Host"
    ;; or "User_Name@Host" or "\"User Name\"@Host".
    (if (or (string-match "^[^!@%]+[._][^._%@]*[^@%][@%]" full-name)
	    (string-match "^[^!@%]*\"[^!@%]+ [^ %@]*[^@%][@%]" full-name))
	(setq full-name (substring full-name 0 (1- (match-end 0)))))
    (setq full-name (vm-clean-username full-name))
    (vm-set-full-name-of m full-name)
    (vm-set-from-of m from)))

(defun vm-clean-username (string)
  "Strips garbage from the user full name string."
  (if (string-match "[@!]" string)  ; this ain't no user name!  It's an address!
      string
    (let ((case-fold-search t))
      ;; take off leading and trailing non-alpha chars (quotes, parens, digits, etc)
      (if (string-match "\\`[^a-z]+" string)
	  (setq string (substring string (match-end 0))))
      (if (string-match "[^a-z]+\\'" string)
	  (setq string (substring string 0 (match-beginning 0))))
      ;; replace tabs, multiple spaces, dots, and underscores with a single space.
      ;; but don't replace ". " with " " because that could be an initial.
      (while (string-match "\\(\t\\|  +\\|\\(\\.\\)[^ \t_]\\|_+\\)" string)
	(setq string (concat (substring string 0
					(or (match-beginning 2)
					    (match-beginning 1)))
			     " "
			     (substring string (or (match-end 2)
						   (match-end 1))))))
      ;; If the string contains trailing parenthesized comments, nuke 'em.
      ;; (As in "John Doe -- Pinhead" or "John Doe (Pinhead)".)
      (if (string-match "[^ \t]\\([ \t]*\\((\\| --\\)\\)" string)
	  (progn
	    (setq string (substring string 0 (match-beginning 1)))
	    ;; lose any non-alpha rubbish this may have exposed.
	    (if (string-match "[^a-z]+\\'" string)
		(setq string (substring string 0 (match-beginning 0))))))
      string)))