+(defun message-shorten-1 (list cut surplus)
+ ;; Cut SURPLUS elements out of LIST, beginning with CUTth one.
+ (setcdr (nthcdr (- cut 2) list)
+ (nthcdr (+ (- cut 2) surplus 1) list)))
+
+(defun message-shorten-references (header references)
+ "Trim REFERENCES to be less than 31 Message-ID long, and fold them.
+If folding is disallowed, also check that the REFERENCES are less
+than 988 characters long, and if they are not, trim them until they are."
+ (let ((maxcount 31)
+ (count 0)
+ (cut 6)
+ refs)
+ (with-temp-buffer
+ (insert references)
+ (goto-char (point-min))
+ ;; Cons a list of valid references.
+ (while (re-search-forward "<[^>]+>" nil t)
+ (push (match-string 0) refs))
+ (setq refs (nreverse refs)
+ count (length refs)))
+
+ ;; If the list has more than MAXCOUNT elements, trim it by
+ ;; removing the CUTth element and the required number of
+ ;; elements that follow.
+ (when (> count maxcount)
+ (let ((surplus (- count maxcount)))
+ (message-shorten-1 refs cut surplus)
+ (decf count surplus)))
+
+ ;; If folding is disallowed, make sure the total length (including
+ ;; the spaces between) will be less than MAXSIZE characters.
+ (when message-cater-to-broken-inn
+ (let ((maxsize 988)
+ (totalsize (+ (apply #'+ (mapcar #'length refs))
+ (1- count)))
+ (surplus 0)
+ (ptr (nthcdr (1- cut) refs)))
+ ;; Decide how many elements to cut off...
+ (while (> totalsize maxsize)
+ (decf totalsize (1+ (length (car ptr))))
+ (incf surplus)
+ (setq ptr (cdr ptr)))
+ ;; ...and do it.
+ (when (> surplus 0)
+ (message-shorten-1 refs cut surplus))))
+
+ ;; Finally, collect the references back into a string and insert
+ ;; it into the buffer.
+ (let ((refstring (mapconcat #'identity refs " ")))
+ (if message-cater-to-broken-inn
+ (insert (capitalize (symbol-name header)) ": "
+ refstring "\n")
+ (message-fill-header header refstring)))))
+