Use backquote/dolist/mapc/when. Docstring fixes.

(mail-extract-address-components): Downcase domain names.
(mail-extr-delete-char): Remove.  Use delete-char instead.

1 files changed, 322 insertions, 341 deletions

diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index d6a1f9ffe1c..f88f2565691 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -511,24 +511,20 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
 (defconst mail-extr-address-domain-literal-syntax-table (make-syntax-table))
 (defconst mail-extr-address-text-comment-syntax-table (make-syntax-table))
 (defconst mail-extr-address-text-syntax-table (make-syntax-table))
-(mapcar
- (function
-  (lambda (pair)
-    (let ((syntax-table (symbol-value (car pair))))
-      (mapcar
-       (function
-	(lambda (item)
-	  (if (eq 2 (length item))
-	      ;; modifying syntax of a single character
-	      (modify-syntax-entry (car item) (car (cdr item)) syntax-table)
-	    ;; modifying syntax of a range of characters
-	    (let ((char (nth 0 item))
-		  (bound (nth 1 item))
-		  (syntax (nth 2 item)))
-	      (while (<= char bound)
-		(modify-syntax-entry char syntax syntax-table)
-		(setq char (1+ char)))))))
-       (cdr pair)))))
+(mapc
+ (lambda (pair)
+   (let ((syntax-table (symbol-value (car pair))))
+     (dolist (item (cdr pair))
+       (if (eq 2 (length item))
+	   ;; modifying syntax of a single character
+	   (modify-syntax-entry (car item) (car (cdr item)) syntax-table)
+	 ;; modifying syntax of a range of characters
+	 (let ((char (nth 0 item))
+	       (bound (nth 1 item))
+	       (syntax (nth 2 item)))
+	   (while (<= char bound)
+	     (modify-syntax-entry char syntax syntax-table)
+	     (setq char (1+ char))))))))
  '((mail-extr-address-syntax-table
     (?\000 ?\037 "w")			;control characters
     (?\040	 " ")			;SPC
@@ -618,11 +614,6 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
 ;; Utility functions and macros.
 ;;
 
-(defsubst mail-extr-delete-char (n)
-  ;; in v19, delete-char is compiled as a function call, but delete-region
-  ;; is byte-coded, so it's much much faster.
-  (delete-region (point) (+ (point) n)))
-
 (defsubst mail-extr-skip-whitespace-forward ()
   ;; v19 fn skip-syntax-forward is more tasteful, but not byte-coded.
   (skip-chars-forward " \t\n\r\240"))
@@ -639,14 +630,14 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
       (goto-char (point-min))
       ;; undo \ quoting
       (while (search-forward "\\" nil t)
-	(mail-extr-delete-char -1)
+	(delete-char -1)
 	(or (eobp)
 	    (forward-char 1))))))
 
 (defsubst mail-extr-nuke-char-at (pos)
   (save-excursion
     (goto-char pos)
-    (mail-extr-delete-char 1)
+    (delete-char 1)
     (insert ?\ )))
 
 (put 'mail-extr-nuke-outside-range
@@ -655,27 +646,28 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
 (defmacro mail-extr-nuke-outside-range (list-symbol
 					beg-symbol end-symbol
 					&optional no-replace)
-  ;; LIST-SYMBOL names a variable holding a list of buffer positions
-  ;; BEG-SYMBOL and END-SYMBOL name variables delimiting a range
-  ;; Each element of LIST-SYMBOL which lies outside of the range is
-  ;;  deleted from the list.
-  ;; Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL
-  ;;  which lie outside of the range, one character at that position is
-  ;;  replaced with a SPC.
+  "Delete all elements outside BEG..END in LIST.
+LIST-SYMBOL names a variable holding a list of buffer positions
+BEG-SYMBOL and END-SYMBOL name variables delimiting a range
+Each element of LIST-SYMBOL which lies outside of the range is
+ deleted from the list.
+Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL
+ which lie outside of the range, one character at that position is
+ replaced with a SPC."
   (or (memq no-replace '(t nil))
       (error "no-replace must be t or nil, evaluable at macroexpand-time"))
-  (` (let ((temp (, list-symbol))
+  `(let ((temp ,list-symbol)
 	   ch)
        (while temp
 	 (setq ch (car temp))
-	 (cond ((or (> ch (, end-symbol))
-		    (< ch (, beg-symbol)))
-		(,@ (if no-replace
-			nil
-		      (` ((mail-extr-nuke-char-at ch)))))
-		(setcar temp nil)))
+	 (when (or (> ch ,end-symbol)
+		   (< ch ,beg-symbol))
+	   ,@(if no-replace
+		   nil
+		 `((mail-extr-nuke-char-at ch)))
+	   (setcar temp nil))
 	 (setq temp (cdr temp)))
-       (setq (, list-symbol) (delq nil (, list-symbol))))))
+       (setq ,list-symbol (delq nil ,list-symbol))))
 
 (defun mail-extr-demarkerize (marker)
   ;; if arg is a marker, destroys the marker, then returns the old value.
@@ -909,27 +901,25 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 	  ;; If multiple @s and a :, but no < and >, insert around buffer.
 	  ;; Example: @foo.bar.dom,@xxx.yyy.zzz:mailbox@aaa.bbb.ccc
 	  ;; This commonly happens on the UUCP "From " line.  Ugh.
-	  (cond ((and (> (length @-pos) 1)
+	  (when (and (> (length @-pos) 1)
 		      (eq 1 (length colon-pos))	;TODO: check if between last two @s
 		      (not \;-pos)
 		      (not <-pos))
-		 (goto-char (point-min))
-		 (mail-extr-delete-char 1)
-		 (setq <-pos (list (point)))
-		 (insert ?<)))
+	    (goto-char (point-min))
+	    (delete-char 1)
+	    (setq <-pos (list (point)))
+	    (insert ?<))
 
 	  ;; If < but no >, insert > in rightmost possible position
-	  (cond ((and <-pos
-		      (null >-pos))
-		 (goto-char (point-max))
-		 (setq >-pos (list (point)))
-		 (insert ?>)))
+	  (when (and <-pos (null >-pos))
+	    (goto-char (point-max))
+	    (setq >-pos (list (point)))
+	    (insert ?>))
 
 	  ;; If > but no <, replace > with space.
-	  (cond ((and >-pos
-		      (null <-pos))
-		 (mail-extr-nuke-char-at (car >-pos))
-		 (setq >-pos nil)))
+	  (when (and >-pos (null <-pos))
+	    (mail-extr-nuke-char-at (car >-pos))
+	    (setq >-pos nil))
 
 	  ;; Turn >-pos and <-pos into non-lists
 	  (setq >-pos (car >-pos)
@@ -937,15 +927,15 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 
 	  ;; Trim other punctuation lists of items outside < > pair to handle
 	  ;; stupid MTAs.
-	  (cond (<-pos			; don't need to check >-pos also
-		 ;; handle bozo software that violates RFC 822 by sticking
-		 ;; punctuation marks outside of a < > pair
-		 (mail-extr-nuke-outside-range @-pos <-pos >-pos t)
-		 ;; RFC 822 says nothing about these two outside < >, but
-		 ;; remove those positions from the lists to make things
-		 ;; easier.
-		 (mail-extr-nuke-outside-range !-pos <-pos >-pos t)
-		 (mail-extr-nuke-outside-range %-pos <-pos >-pos t)))
+	  (when <-pos			; don't need to check >-pos also
+	    ;; handle bozo software that violates RFC 822 by sticking
+	    ;; punctuation marks outside of a < > pair
+	    (mail-extr-nuke-outside-range @-pos <-pos >-pos t)
+	    ;; RFC 822 says nothing about these two outside < >, but
+	    ;; remove those positions from the lists to make things
+	    ;; easier.
+	    (mail-extr-nuke-outside-range !-pos <-pos >-pos t)
+	    (mail-extr-nuke-outside-range %-pos <-pos >-pos t))
 
 	  ;; Check for : that indicates GROUP list and for : part of
 	  ;; ROUTE-ADDR spec.
@@ -982,19 +972,18 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 		   (setq group-\;-pos temp))))
 
 	  ;; Nuke unmatched GROUP syntax characters.
-	  (cond ((and group-:-pos (not group-\;-pos))
-		 ;; *** Do I really need to erase it?
-		 (mail-extr-nuke-char-at group-:-pos)
-		 (setq group-:-pos nil)))
-	  (cond ((and group-\;-pos (not group-:-pos))
-		 ;; *** Do I really need to erase it?
-		 (mail-extr-nuke-char-at group-\;-pos)
-		 (setq group-\;-pos nil)))
+	  (when (and group-:-pos (not group-\;-pos))
+	    ;; *** Do I really need to erase it?
+	    (mail-extr-nuke-char-at group-:-pos)
+	    (setq group-:-pos nil))
+	  (when (and group-\;-pos (not group-:-pos))
+	    ;; *** Do I really need to erase it?
+	    (mail-extr-nuke-char-at group-\;-pos)
+	    (setq group-\;-pos nil))
 
 	  ;; Handle junk like ";@host.company.dom" that sendmail adds.
 	  ;; **** should I remember comment positions?
-	  (cond
-	   (group-\;-pos
+	  (when group-\;-pos
 	    ;; this is fine for now
 	    (mail-extr-nuke-outside-range !-pos group-:-pos group-\;-pos t)
 	    (mail-extr-nuke-outside-range @-pos group-:-pos group-\;-pos t)
@@ -1018,7 +1007,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 	    ;; *** The entire handling of GROUP addresses seems rather lame.
 	    ;; *** It deserves a complete rethink, except that these addresses
 	    ;; *** are hardly ever seen.
-	    ))
+	    )
 
 	  ;; Any commas must be between < and : of ROUTE-ADDR.  Nuke any
 	  ;; others.
@@ -1032,57 +1021,55 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 	  ;; handled above.
 
 	  ;; Locate PHRASE part of ROUTE-ADDR.
-	  (cond (<-pos
-		 (goto-char <-pos)
-		 (mail-extr-skip-whitespace-backward)
-		 (setq phrase-end (point))
-		 (goto-char (or ;;group-:-pos
-				(point-min)))
-		 (mail-extr-skip-whitespace-forward)
-		 (if (< (point) phrase-end)
-		     (setq phrase-beg (point))
-		   (setq phrase-end nil))))
+	  (when <-pos
+	    (goto-char <-pos)
+	    (mail-extr-skip-whitespace-backward)
+	    (setq phrase-end (point))
+	    (goto-char (or ;;group-:-pos
+			(point-min)))
+	    (mail-extr-skip-whitespace-forward)
+	    (if (< (point) phrase-end)
+		(setq phrase-beg (point))
+	      (setq phrase-end nil)))
 
 	  ;; handle ROUTE-ADDRS with real ROUTEs.
 	  ;; If there are multiple @s, then we assume ROUTE-ADDR syntax, and
 	  ;; any % or ! must be semantically meaningless.
 	  ;; TODO: do this processing into canonicalization buffer
-	  (cond (route-addr-:-pos
-		 (setq !-pos nil
-		       %-pos nil
-		       >-pos (copy-marker >-pos)
-		       route-addr-:-pos (copy-marker route-addr-:-pos))
-		 (goto-char >-pos)
-		 (insert-before-markers ?X)
-		 (goto-char (car @-pos))
-		 (while (setq @-pos (cdr @-pos))
-		   (mail-extr-delete-char 1)
-		   (setq %-pos (cons (point-marker) %-pos))
-		   (insert "%")
-		   (goto-char (1- >-pos))
-		   (save-excursion
-		     (insert-buffer-substring extraction-buffer
-					      (car @-pos) route-addr-:-pos)
-		     (delete-region (car @-pos) route-addr-:-pos))
-		   (or (cdr @-pos)
-		       (setq saved-@-pos (list (point)))))
-		 (setq @-pos saved-@-pos)
-		 (goto-char >-pos)
-		 (mail-extr-delete-char -1)
-		 (mail-extr-nuke-char-at route-addr-:-pos)
-		 (mail-extr-demarkerize route-addr-:-pos)
-		 (setq route-addr-:-pos nil
-		       >-pos (mail-extr-demarkerize >-pos)
-		       %-pos (mapcar 'mail-extr-demarkerize %-pos))))
+	  (when route-addr-:-pos
+	    (setq !-pos nil
+		  %-pos nil
+		  >-pos (copy-marker >-pos)
+		  route-addr-:-pos (copy-marker route-addr-:-pos))
+	    (goto-char >-pos)
+	    (insert-before-markers ?X)
+	    (goto-char (car @-pos))
+	    (while (setq @-pos (cdr @-pos))
+	      (delete-char 1)
+	      (setq %-pos (cons (point-marker) %-pos))
+	      (insert "%")
+	      (goto-char (1- >-pos))
+	      (save-excursion
+		(insert-buffer-substring extraction-buffer
+					 (car @-pos) route-addr-:-pos)
+		(delete-region (car @-pos) route-addr-:-pos))
+	      (or (cdr @-pos)
+		  (setq saved-@-pos (list (point)))))
+	    (setq @-pos saved-@-pos)
+	    (goto-char >-pos)
+	    (delete-char -1)
+	    (mail-extr-nuke-char-at route-addr-:-pos)
+	    (mail-extr-demarkerize route-addr-:-pos)
+	    (setq route-addr-:-pos nil
+		  >-pos (mail-extr-demarkerize >-pos)
+		  %-pos (mapcar 'mail-extr-demarkerize %-pos)))
 
 	  ;; de-listify @-pos
 	  (setq @-pos (car @-pos))
 
 	  ;; TODO: remove comments in the middle of an address
 
-	  (save-excursion
-	    (set-buffer canonicalization-buffer)
-
+	  (with-current-buffer canonicalization-buffer
 	    (widen)
 	    (erase-buffer)
 	    (insert-buffer-substring extraction-buffer)
@@ -1097,8 +1084,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 		  (narrow-to-region first-real-pos last-real-pos)
 		;; ****** Oh no!  What if the address is completely empty!
 		;; *** Is this correct?
-		(narrow-to-region (point-max) (point-max))
-		))
+		(narrow-to-region (point-max) (point-max))))
 
 	    (and @-pos %-pos
 		 (mail-extr-nuke-outside-range %-pos (point-min) @-pos))
@@ -1110,118 +1096,119 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 	    ;; Error condition:?? (and %-pos (not @-pos))
 
 	    ;; WARNING: THIS CODE IS DUPLICATED BELOW.
-	    (cond ((and %-pos
-			(not @-pos))
-		   (goto-char (car %-pos))
-		   (mail-extr-delete-char 1)
-		   (setq @-pos (point))
-		   (insert "@")
-		   (setq %-pos (cdr %-pos))))
-
-	    (if mail-extr-mangle-uucp
-		(cond (!-pos
-		       ;; **** I don't understand this save-restriction and the
-		       ;; narrow-to-region inside it.  Why did I do that?
-		       (save-restriction
-			 (cond ((and @-pos
-				     mail-extr-@-binds-tighter-than-!)
-				(goto-char @-pos)
-				(setq %-pos (cons (point) %-pos)
-				      @-pos nil)
-				(mail-extr-delete-char 1)
-				(insert "%")
-				(setq insert-point (point-max)))
-			       (mail-extr-@-binds-tighter-than-!
-				(setq insert-point (point-max)))
-			       (%-pos
-				(setq insert-point (car (last %-pos))
-				      saved-%-pos (mapcar 'mail-extr-markerize %-pos)
-				      %-pos nil
-				      @-pos (mail-extr-markerize @-pos)))
-			       (@-pos
-				(setq insert-point @-pos)
-				(setq @-pos (mail-extr-markerize @-pos)))
-			       (t
-				(setq insert-point (point-max))))
-			 (narrow-to-region (point-min) insert-point)
-			 (setq saved-!-pos (car !-pos))
-			 (while !-pos
-			   (goto-char (point-max))
-			   (cond ((and (not @-pos)
-				       (not (cdr !-pos)))
-				  (setq @-pos (point))
-				  (insert-before-markers "@ "))
-				 (t
-				  (setq %-pos (cons (point) %-pos))
-				  (insert-before-markers "% ")))
-			   (backward-char 1)
-			   (insert-buffer-substring 
-			    (current-buffer)
-			    (if (nth 1 !-pos)
-				(1+ (nth 1 !-pos))
-			      (point-min))
-			    (car !-pos))
-			   (mail-extr-delete-char 1)
-			   (or (save-excursion
-				 (mail-extr-safe-move-sexp -1)
-				 (mail-extr-skip-whitespace-backward)
-				 (eq ?. (preceding-char)))
-			       (insert-before-markers
-				(if (save-excursion
-				      (mail-extr-skip-whitespace-backward)
-				      (eq ?. (preceding-char)))
-				    ""
-				  ".")
-				"uucp"))
-			   (setq !-pos (cdr !-pos))))
-		       (and saved-%-pos
-			    (setq %-pos (append (mapcar 'mail-extr-demarkerize
-							saved-%-pos)
-						%-pos)))
-		       (setq @-pos (mail-extr-demarkerize @-pos))
-		       (narrow-to-region (1+ saved-!-pos) (point-max)))))
+	    (when (and %-pos (not @-pos))
+	      (goto-char (car %-pos))
+	      (delete-char 1)
+	      (setq @-pos (point))
+	      (insert "@")
+	      (setq %-pos (cdr %-pos)))
+
+	    (when (and mail-extr-mangle-uucp !-pos)
+	      ;; **** I don't understand this save-restriction and the
+	      ;; narrow-to-region inside it.  Why did I do that?
+	      (save-restriction
+		(cond ((and @-pos
+			    mail-extr-@-binds-tighter-than-!)
+		       (goto-char @-pos)
+		       (setq %-pos (cons (point) %-pos)
+			     @-pos nil)
+		       (delete-char 1)
+		       (insert "%")
+		       (setq insert-point (point-max)))
+		      (mail-extr-@-binds-tighter-than-!
+		       (setq insert-point (point-max)))
+		      (%-pos
+		       (setq insert-point (car (last %-pos))
+			     saved-%-pos (mapcar 'mail-extr-markerize %-pos)
+			     %-pos nil
+			     @-pos (mail-extr-markerize @-pos)))
+		      (@-pos
+		       (setq insert-point @-pos)
+		       (setq @-pos (mail-extr-markerize @-pos)))
+		      (t
+		       (setq insert-point (point-max))))
+		(narrow-to-region (point-min) insert-point)
+		(setq saved-!-pos (car !-pos))
+		(while !-pos
+		  (goto-char (point-max))
+		  (cond ((and (not @-pos)
+			      (not (cdr !-pos)))
+			 (setq @-pos (point))
+			 (insert-before-markers "@ "))
+			(t
+			 (setq %-pos (cons (point) %-pos))
+			 (insert-before-markers "% ")))
+		  (backward-char 1)
+		  (insert-buffer-substring
+		   (current-buffer)
+		   (if (nth 1 !-pos)
+		       (1+ (nth 1 !-pos))
+		     (point-min))
+		   (car !-pos))
+		  (delete-char 1)
+		  (or (save-excursion
+			(mail-extr-safe-move-sexp -1)
+			(mail-extr-skip-whitespace-backward)
+			(eq ?. (preceding-char)))
+		      (insert-before-markers
+		       (if (save-excursion
+			     (mail-extr-skip-whitespace-backward)
+			     (eq ?. (preceding-char)))
+			   ""
+			 ".")
+		       "uucp"))
+		  (setq !-pos (cdr !-pos))))
+	      (and saved-%-pos
+		   (setq %-pos (append (mapcar 'mail-extr-demarkerize
+					       saved-%-pos)
+				       %-pos)))
+	      (setq @-pos (mail-extr-demarkerize @-pos))
+	      (narrow-to-region (1+ saved-!-pos) (point-max)))
 
 	    ;; WARNING: THIS CODE IS DUPLICATED ABOVE.
-	    (cond ((and %-pos
-			(not @-pos))
-		   (goto-char (car %-pos))
-		   (mail-extr-delete-char 1)
-		   (setq @-pos (point))
-		   (insert "@")
-		   (setq %-pos (cdr %-pos))))
-
-	    (setq %-pos (nreverse %-pos))
-	    (cond (%-pos			; implies @-pos valid
-		   (setq temp %-pos)
-		   (catch 'truncated
-		     (while temp
-		       (goto-char (or (nth 1 temp)
-				      @-pos))
-		       (mail-extr-skip-whitespace-backward)
-		       (save-excursion
-			 (mail-extr-safe-move-sexp -1)
-			 (setq domain-pos (point))
-			 (mail-extr-skip-whitespace-backward)
-			 (setq \.-pos (eq ?. (preceding-char))))
-		       (cond ((and \.-pos
-				   ;; #### string consing
-				   (let ((s (intern-soft
-					     (buffer-substring domain-pos (point))
-					     mail-extr-all-top-level-domains)))
-				     (and s (get s 'domain-name))))
-			      (narrow-to-region (point-min) (point))
-			      (goto-char (car temp))
-			      (mail-extr-delete-char 1)
-			      (setq @-pos (point))
-			      (setcdr temp nil)
-			      (setq %-pos (delq @-pos %-pos))
-			      (insert "@")
-			      (throw 'truncated t)))
-		       (setq temp (cdr temp))))))
+	    (when (and %-pos (not @-pos))
+	      (goto-char (car %-pos))
+	      (delete-char 1)
+	      (setq @-pos (point))
+	      (insert "@")
+	      (setq %-pos (cdr %-pos)))
+
+	    (when (setq %-pos (nreverse %-pos))	; implies @-pos valid
+	      (setq temp %-pos)
+	      (catch 'truncated
+		(while temp
+		  (goto-char (or (nth 1 temp)
+				 @-pos))
+		  (mail-extr-skip-whitespace-backward)
+		  (save-excursion
+		    (mail-extr-safe-move-sexp -1)
+		    (setq domain-pos (point))
+		    (mail-extr-skip-whitespace-backward)
+		    (setq \.-pos (eq ?. (preceding-char))))
+		  (when (and \.-pos
+			     ;; #### string consing
+			     (let ((s (intern-soft
+				       (buffer-substring domain-pos (point))
+				       mail-extr-all-top-level-domains)))
+			       (and s (get s 'domain-name))))
+		    (narrow-to-region (point-min) (point))
+		    (goto-char (car temp))
+		    (delete-char 1)
+		    (setq @-pos (point))
+		    (setcdr temp nil)
+		    (setq %-pos (delq @-pos %-pos))
+		    (insert "@")
+		    (throw 'truncated t))
+		  (setq temp (cdr temp)))))
 	    (setq mbox-beg (point-min)
 		  mbox-end (if %-pos (car %-pos)
 			     (or @-pos
-				 (point-max)))))
+				 (point-max))))
+
+	    (when @-pos
+	      ;; Make the domain-name part lowercase since it's case
+	      ;; insensitive anyway.
+	      (downcase-region (1+ @-pos) (point-max))))
 
 	  ;; Done canonicalizing address.
 	  ;; We are now back in extraction-buffer.
@@ -1295,10 +1282,10 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 		     (setq quote-end (- (point) 2))
 		     (save-excursion
 		       (backward-char 1)
-		       (mail-extr-delete-char 1)
+		       (delete-char 1)
 		       (goto-char quote-beg)
 		       (or (eobp)
-			   (mail-extr-delete-char 1)))
+			   (delete-char 1)))
 		     (mail-extr-undo-backslash-quoting quote-beg quote-end)
 		     (or (eq ?\  (char-after (point)))
 			 (insert " "))
@@ -1308,16 +1295,16 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 		     (if (memq (char-after (1+ (point))) '(?_ ?=))
 			 (progn
 			   (forward-char 1)
-			   (mail-extr-delete-char 1)
+			   (delete-char 1)
 			   (insert ?\ ))
 		       (if \.-ends-name
 			   (narrow-to-region (point-min) (point))
-			 (mail-extr-delete-char 1)
+			 (delete-char 1)
 			 (insert " ")))
 		     ;;		 (setq mailbox-name-processed-flag t)
 		     )
 		    ((memq (char-syntax char) '(?. ?\\))
-		     (mail-extr-delete-char 1)
+		     (delete-char 1)
 		     (insert " ")
 		     ;;		 (setq mailbox-name-processed-flag t)
 		     )
@@ -1339,16 +1326,15 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 
 			 ;; Copy the contents of the individual fields that
 			 ;; might hold name data to the beginning.
-			 (mapcar
-			  (function
-			   (lambda (field-pattern)
-			     (cond
-			      ((save-excursion
-				 (re-search-forward field-pattern nil t))
-			       (insert-buffer-substring (current-buffer)
-							(match-beginning 1)
-							(match-end 1))
-			       (insert " ")))))
+			 (mapc
+			  (lambda (field-pattern)
+			    (when
+				(save-excursion
+				  (re-search-forward field-pattern nil t))
+			      (insert-buffer-substring (current-buffer)
+						       (match-beginning 1)
+						       (match-end 1))
+			      (insert " ")))
 			  (list mail-extr-x400-encoded-address-given-name-pattern
 				mail-extr-x400-encoded-address-surname-pattern
 				mail-extr-x400-encoded-address-full-name-pattern))
@@ -1396,47 +1382,46 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 	  ;; Initial code by Jamie Zawinski <jwz@lucid.com>
 	  ;; *** Make it work when there's a suffix as well.
 	  (goto-char (point-min))
-	  (cond ((and mail-extr-guess-middle-initial
-		      (not disable-initial-guessing-flag)
-		      (eq 3 (- mbox-end mbox-beg))
-		      (progn
-			(goto-char (point-min))
-			(looking-at mail-extr-two-name-pattern)))
-		 (setq fi (char-after (match-beginning 0))
-		       li (char-after (match-beginning 3)))
-		 (save-excursion
-		   (set-buffer canonicalization-buffer)
-		   ;; char-equal is ignoring case here, so no need to upcase
-		   ;; or downcase.
-		   (let ((case-fold-search t))
-		     (and (char-equal fi (char-after mbox-beg))
-			  (char-equal li (char-after (1- mbox-end)))
-			  (setq mi (char-after (1+ mbox-beg))))))
-		 (cond ((and mi
-			     ;; TODO: use better table than syntax table
-			     (eq ?w (char-syntax mi)))
-			(goto-char (match-beginning 3))
-			(insert (upcase mi) ". ")))))
+	  (when (and mail-extr-guess-middle-initial
+		     (not disable-initial-guessing-flag)
+		     (eq 3 (- mbox-end mbox-beg))
+		     (progn
+		       (goto-char (point-min))
+		       (looking-at mail-extr-two-name-pattern)))
+	    (setq fi (char-after (match-beginning 0))
+		  li (char-after (match-beginning 3)))
+	    (with-current-buffer canonicalization-buffer
+	      ;; char-equal is ignoring case here, so no need to upcase
+	      ;; or downcase.
+	      (let ((case-fold-search t))
+		(and (char-equal fi (char-after mbox-beg))
+		     (char-equal li (char-after (1- mbox-end)))
+		     (setq mi (char-after (1+ mbox-beg))))))
+	    (when (and mi
+		       ;; TODO: use better table than syntax table
+		       (eq ?w (char-syntax mi)))
+	      (goto-char (match-beginning 3))
+	      (insert (upcase mi) ". ")))
 
 	  ;; Nuke name if it is the same as mailbox name.
 	  (let ((buffer-length (- (point-max) (point-min)))
 		(i 0)
 		(names-match-flag t))
-	    (cond ((and (> buffer-length 0)
-			(eq buffer-length (- mbox-end mbox-beg)))
-		   (goto-char (point-max))
-		   (insert-buffer-substring canonicalization-buffer
-					    mbox-beg mbox-end)
-		   (while (and names-match-flag
-			       (< i buffer-length))
-		     (or (eq (downcase (char-after (+ i (point-min))))
-			     (downcase
-			      (char-after (+ i buffer-length (point-min)))))
-			 (setq names-match-flag nil))
-		     (setq i (1+ i)))
-		   (delete-region (+ (point-min) buffer-length) (point-max))
-		   (if names-match-flag
-		       (narrow-to-region (point) (point))))))
+	    (when (and (> buffer-length 0)
+		       (eq buffer-length (- mbox-end mbox-beg)))
+	      (goto-char (point-max))
+	      (insert-buffer-substring canonicalization-buffer
+				       mbox-beg mbox-end)
+	      (while (and names-match-flag
+			  (< i buffer-length))
+		(or (eq (downcase (char-after (+ i (point-min))))
+			(downcase
+			 (char-after (+ i buffer-length (point-min)))))
+		    (setq names-match-flag nil))
+		(setq i (1+ i)))
+	      (delete-region (+ (point-min) buffer-length) (point-max))
+	      (if names-match-flag
+		  (narrow-to-region (point) (point)))))
 
 	  ;; Nuke name if it's just one word.
 	  (goto-char (point-min))
@@ -1448,8 +1433,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 	  (setq value-list
 		(cons (list (if (not (= (point-min) (point-max)))
 				(buffer-string))
-			    (save-excursion
-			      (set-buffer canonicalization-buffer)
+			    (with-current-buffer canonicalization-buffer
 			      (if (not (= (point-min) (point-max)))
 				  (buffer-string))))
 		      value-list))
@@ -1492,12 +1476,11 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 	(skip-chars-forward "^({[\"'`")
 	(let ((cbeg (point)))
 	  (set-syntax-table mail-extr-address-text-comment-syntax-table)
-	  (cond ((memq (following-char) '(?\' ?\`))
-		 (search-forward "'" nil 'move
-				 (if (eq ?\' (following-char)) 2 1)))
-		(t
-		 (or (mail-extr-safe-move-sexp 1)
-		     (goto-char (point-max)))))
+	  (if (memq (following-char) '(?\' ?\`))
+	      (search-forward "'" nil 'move
+			      (if (eq ?\' (following-char)) 2 1))
+	    (or (mail-extr-safe-move-sexp 1)
+		(goto-char (point-max))))
 	  (set-syntax-table mail-extr-address-text-syntax-table)
 	  (when (eq (char-after cbeg) ?\()
 	    ;; Delete the comment itself.
@@ -1522,44 +1505,43 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
       ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t)
       ;;  (replace-match "\\1 \\2" t))
 
-      (cond ((not (search-forward " " nil t))
-	     (goto-char (point-min))
-	     (cond ((search-forward "_" nil t)
-		    ;; Handle the *idiotic* use of underlines as spaces.
-		    ;; Example: fml@foo.bar.dom (First_M._Last)
-		    (goto-char (point-min))
-		    (while (search-forward "_" nil t)
-		      (replace-match " " t)))
-		   ((search-forward "." nil t)
-		    ;; Fix . used as space
-		    ;; Example: danj1@cb.att.com (daniel.jacobson)
-		    (goto-char (point-min))
-		    (while (re-search-forward mail-extr-bad-dot-pattern nil t)
-		      (replace-match "\\1 \\2" t))))))
+      (unless (search-forward " " nil t)
+	(goto-char (point-min))
+	(cond ((search-forward "_" nil t)
+	       ;; Handle the *idiotic* use of underlines as spaces.
+	       ;; Example: fml@foo.bar.dom (First_M._Last)
+	       (goto-char (point-min))
+	       (while (search-forward "_" nil t)
+		 (replace-match " " t)))
+	      ((search-forward "." nil t)
+	       ;; Fix . used as space
+	       ;; Example: danj1@cb.att.com (daniel.jacobson)
+	       (goto-char (point-min))
+	       (while (re-search-forward mail-extr-bad-dot-pattern nil t)
+		 (replace-match "\\1 \\2" t)))))
 
       ;; Loop over the words (and other junk) in the name.
       (goto-char (point-min))
       (while (not name-done-flag)
 	
-	(cond (word-found-flag
-	       ;; Last time through this loop we skipped over a word.
-	       (setq last-word-beg this-word-beg)
-	       (setq drop-last-word-if-trailing-flag
-		     drop-this-word-if-trailing-flag)
-	       (setq word-found-flag nil)))
-
-	(cond (begin-again-flag
-	       ;; Last time through the loop we found something that
-	       ;; indicates we should pretend we are beginning again from
-	       ;; the start.
-	       (setq word-count 0)
-	       (setq last-word-beg nil)
-	       (setq drop-last-word-if-trailing-flag nil)
-	       (setq mixed-case-flag nil)
-	       (setq lower-case-flag nil)
-;;	       (setq upper-case-flag nil)
-	       (setq begin-again-flag nil)
-	       ))
+	(when word-found-flag
+	  ;; Last time through this loop we skipped over a word.
+	  (setq last-word-beg this-word-beg)
+	  (setq drop-last-word-if-trailing-flag
+		drop-this-word-if-trailing-flag)
+	  (setq word-found-flag nil))
+
+	(when begin-again-flag
+	  ;; Last time through the loop we found something that
+	  ;; indicates we should pretend we are beginning again from
+	  ;; the start.
+	  (setq word-count 0)
+	  (setq last-word-beg nil)
+	  (setq drop-last-word-if-trailing-flag nil)
+	  (setq mixed-case-flag nil)
+	  (setq lower-case-flag nil)
+	  ;;	       (setq upper-case-flag nil)
+	  (setq begin-again-flag nil))
 	
 	;; Initialize for this iteration of the loop.
 	(mail-extr-skip-whitespace-forward)
@@ -1625,7 +1607,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 	  (cond ((memq (following-char) '(?\' ?\`))
 		 (or (search-forward "'" nil t
 				     (if (eq ?\' (following-char)) 2 1))
-		     (mail-extr-delete-char 1)))
+		     (delete-char 1)))
 		(t
 		 (or (mail-extr-safe-move-sexp 1)
 		     (goto-char (point-max)))))
@@ -1718,7 +1700,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 	       (eq ?\  (preceding-char))
 	       (eq (following-char) ?&)
 	       (eq (1+ (point)) (point-max)))
-	  (mail-extr-delete-char 1)
+	  (delete-char 1)
 	  (capitalize-region
 	   (point)
 	   (progn
@@ -1801,24 +1783,24 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
       ;; here at all.  Actually I guess it would be best to map patterns
       ;; like foo.hoser@xerox.com into foo@hoser.xerox.com, but I don't
       ;; actually know that that is what's going on.
-      (cond ((not suffix-flag)
-	     (goto-char (point-min))
-	     (let ((case-fold-search t))
-	       (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'")
-		   (erase-buffer)))))
+      (unless suffix-flag
+	(goto-char (point-min))
+	(let ((case-fold-search t))
+	  (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'")
+	      (erase-buffer))))
 
       ;; If last name first put it at end (but before suffix)
-      (cond (last-name-comma-flag
-	     (goto-char (point-min))
-	     (search-forward ",")
-	     (setq name-end (1- (point)))
-	     (goto-char (or suffix-flag (point-max)))
-	     (or (eq ?\  (preceding-char))
-		 (insert ?\ ))
-	     (insert-buffer-substring (current-buffer) (point-min) name-end)
-	     (goto-char name-end)
-	     (skip-chars-forward "\t ,")
-	     (narrow-to-region (point) (point-max))))
+      (when last-name-comma-flag
+	(goto-char (point-min))
+	(search-forward ",")
+	(setq name-end (1- (point)))
+	(goto-char (or suffix-flag (point-max)))
+	(or (eq ?\  (preceding-char))
+	    (insert ?\ ))
+	(insert-buffer-substring (current-buffer) (point-min) name-end)
+	(goto-char name-end)
+	(skip-chars-forward "\t ,")
+	(narrow-to-region (point) (point-max)))
       
       ;; Delete leading and trailing junk characters.
       ;; *** This is probably completely unneeded now.
@@ -1851,14 +1833,13 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 
 (defconst mail-extr-all-top-level-domains
   (let ((ob (make-vector 739 0)))
-    (mapcar
-     (function
-      (lambda (x)
-	(put (intern (downcase (car x)) ob)
-	     'domain-name
-	     (if (nth 2 x)
-		 (format (nth 2 x) (nth 1 x))
-	       (nth 1 x)))))
+    (mapc
+     (lambda (x)
+       (put (intern (downcase (car x)) ob)
+	    'domain-name
+	    (if (nth 2 x)
+		(format (nth 2 x) (nth 1 x))
+	      (nth 1 x))))
      '(
        ;; ISO 3166 codes:
        ("ad" "Andorra")