- ;; Various stopping points
- ((or
-
- ;; Stop before ALL CAPS acronyms, if preceded by mixed-case
- ;; words. Example: XT-DEM.
- (and (>= word-count 2)
- mixed-case-flag
- (looking-at mail-extr-weird-acronym-pattern)
- (not (looking-at mail-extr-roman-numeral-pattern)))
-
- ;; Stop before trailing alternative address
- (looking-at mail-extr-alternative-address-pattern)
-
- ;; Stop before trailing comment not introduced by comma
- ;; THIS CASE MUST BE AFTER AN EARLIER CASE.
- (looking-at mail-extr-trailing-comment-start-pattern)
-
- ;; Stop before telephone numbers
- (and (>= word-count 1)
- (looking-at mail-extr-telephone-extension-pattern)))
- (setq name-done-flag t))
-
- ;; Delete ham radio call signs
- ((looking-at mail-extr-ham-call-sign-pattern)
- (delete-region (match-beginning 0) (match-end 0)))
-
- ;; Fixup initials
- ((looking-at mail-extr-initial-pattern)
- (or (eq (following-char) (upcase (following-char)))
- (setq lower-case-flag t))
- (forward-char 1)
- (if (eq ?. (following-char))
- (forward-char 1)
- (insert ?.))
- (or (eq ?\ (following-char))
- (insert ?\ ))
- (setq word-found-flag t))
-
- ;; Handle BITNET LISTSERV list names.
- ((and (eq word-count 0)
- (looking-at mail-extr-listserv-list-name-pattern))
- (narrow-to-region (match-beginning 1) (match-end 1))
- (setq word-found-flag t)
- (setq name-done-flag t))
-
- ;; Handle & substitution, when & is last and is not first.
- ((and (> word-count 0)
- (eq ?\ (preceding-char))
- (eq (following-char) ?&)
- (eq (1+ (point)) (point-max)))
- (delete-char 1)
- (capitalize-region
- (point)
- (progn
- (insert-buffer-substring canonicalization-buffer
- mbox-beg mbox-end)
- (point)))
- (setq disable-initial-guessing-flag t)
- (setq word-found-flag t))
-
- ;; Handle & between names, as in "Bob & Susie".
- ((and (> word-count 0) (eq (following-char) ?\&))
- (setq name-beg (point))
- (setq name-end (1+ name-beg))
- (setq word-found-flag t)
- (goto-char name-end))
-
- ;; Regular name words
- ((looking-at mail-extr-name-pattern)
- (setq name-beg (point))
- (setq name-end (match-end 0))
-
- ;; Certain words will be dropped if they are at the end.
- (and (>= word-count 2)
- (not lower-case-flag)
- (or
- ;; A trailing 4-or-more letter lowercase words preceded by
- ;; mixed case or uppercase words will be dropped.
- (looking-at "[a-z][a-z][a-z][a-z]+[ \t]*\\'")
- ;; Drop a trailing word which is terminated with a period.
- (eq ?. (char-after (1- name-end))))
- (setq drop-this-word-if-trailing-flag t))
-
- ;; Set the flags that indicate whether we have seen a lowercase
- ;; word, a mixed case word, and an uppercase word.
- (if (re-search-forward "[a-z]" name-end t)
- (if (progn
- (goto-char name-beg)
- (re-search-forward "[A-Z]" name-end t))
- (setq mixed-case-flag t)
+ ;; Stop after name suffix
+ ((and (>= word-count 2)
+ (looking-at mail-extr-full-name-suffix-pattern))
+ (mail-extr-skip-whitespace-backward)
+ (setq suffix-flag (point))
+ (if (eq ?, (following-char))
+ (forward-char 1)
+ (insert ?,))
+ ;; Enforce at least one space after comma
+ (or (eq ?\ (following-char))
+ (insert ?\ ))
+ (mail-extr-skip-whitespace-forward)
+ (cond ((memq (following-char) '(?j ?J ?s ?S))
+ (capitalize-word 1)
+ (if (eq (following-char) ?.)
+ (forward-char 1)
+ (insert ?.)))
+ (t
+ (upcase-word 1)))
+ (setq word-found-flag t)
+ (setq name-done-flag t))
+
+ ;; Handle SCA names
+ ((looking-at "MKA \\(.+\\)") ; "Mundanely Known As"
+ (goto-char (match-beginning 1))
+ (narrow-to-region (point) (point-max))
+ (setq begin-again-flag t))
+
+ ;; Check for initial last name followed by comma
+ ((and (eq ?, (following-char))
+ (eq word-count 1))
+ (forward-char 1)
+ (setq last-name-comma-flag t)
+ (or (eq ?\ (following-char))
+ (insert ?\ )))
+
+ ;; Stop before trailing comma-separated comment
+ ;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
+ ;; *** This case is redundant???
+ ;;((eq ?, (following-char))
+ ;; (setq name-done-flag t))
+
+ ;; Delete parenthesized/quoted comment/nickname
+ ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`))
+ (setq cbeg (point))
+ (set-syntax-table mail-extr-address-text-comment-syntax-table)
+ (cond ((memq (following-char) '(?\' ?\`))
+ (or (search-forward "'" nil t
+ (if (eq ?\' (following-char)) 2 1))
+ (delete-char 1)))
+ (t
+ (or (mail-extr-safe-move-sexp 1)
+ (goto-char (point-max)))))
+ (set-syntax-table mail-extr-address-text-syntax-table)
+ (setq cend (point))
+ (cond
+ ;; Handle case of entire name being quoted
+ ((and (eq word-count 0)
+ (looking-at " *\\'")
+ (>= (- cend cbeg) 2))
+ (narrow-to-region (1+ cbeg) (1- cend))
+ (goto-char (point-min)))
+ (t
+ ;; Handle case of quoted initial
+ (if (and (or (= 3 (- cend cbeg))
+ (and (= 4 (- cend cbeg))
+ (eq ?. (char-after (+ 2 cbeg)))))
+ (not (looking-at " *\\'")))
+ (setq initial (char-after (1+ cbeg)))
+ (setq initial nil))
+ (delete-region cbeg cend)
+ (if initial
+ (insert initial ". ")))))
+
+ ;; Handle *Stupid* VMS date stamps
+ ((looking-at mail-extr-stupid-vms-date-stamp-pattern)
+ (replace-match "" t))
+
+ ;; Handle Chinese characters.
+ ((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern)
+ (goto-char (match-end 0))
+ (setq word-found-flag t))
+
+ ;; Skip initial garbage characters.
+ ;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
+ ((and (eq word-count 0)
+ (looking-at mail-extr-leading-garbage))
+ (goto-char (match-end 0))
+ ;; *** Skip backward over these???
+ ;; (skip-chars-backward "& \"")
+ (narrow-to-region (point) (point-max)))
+
+ ;; Various stopping points
+ ((or
+
+ ;; Stop before ALL CAPS acronyms, if preceded by mixed-case
+ ;; words. Example: XT-DEM.
+ (and (>= word-count 2)
+ mixed-case-flag
+ (looking-at mail-extr-weird-acronym-pattern)
+ (not (looking-at mail-extr-roman-numeral-pattern)))
+
+ ;; Stop before trailing alternative address
+ (looking-at mail-extr-alternative-address-pattern)
+
+ ;; Stop before trailing comment not introduced by comma
+ ;; THIS CASE MUST BE AFTER AN EARLIER CASE.
+ (looking-at mail-extr-trailing-comment-start-pattern)
+
+ ;; Stop before telephone numbers
+ (and (>= word-count 1)
+ (looking-at mail-extr-telephone-extension-pattern)))
+ (setq name-done-flag t))
+
+ ;; Delete ham radio call signs
+ ((looking-at mail-extr-ham-call-sign-pattern)
+ (delete-region (match-beginning 0) (match-end 0)))
+
+ ;; Fixup initials
+ ((looking-at mail-extr-initial-pattern)
+ (or (eq (following-char) (upcase (following-char)))