- (cond
- ((not state)
- (if (memq (char-after) blank-list)
- (setq state 'blank)
- (setq state 'word)
- (if (not (eq (setq cs (mm-charset-after)) 'ascii))
- (setq current cs)))
- (setq b (point)))
- ((eq state 'blank)
- (cond
- ((memq (char-after) special-list)
- (setq state nil))
- ((memq (char-after) blank-list))
- (t
- (setq state 'word)
- (if (not (eq (setq cs (mm-charset-after)) 'ascii))
- (setq current cs)))))
- ((eq state 'word)
- (cond
- ((memq (char-after) special-list)
- (setq state nil)
- (push (list b (point) current) words)
- (setq current nil))
- ((memq (char-after) blank-list)
- (setq state 'blank)
- (push (list b (point) current) words)
- (setq current nil)
- (setq b (point)))
- ((or (eq (setq cs (mm-charset-after)) 'ascii)
- (if current
- (eq current cs)
- (setq current cs))))
- (t
- (push (list b (point) current) words)
- (setq current cs)
- (setq b (point))))))
- (if state
- (forward-char)
- (skip-chars-forward all-specials)))
- (if (eq state 'word)
- (push (list b (point) current) words)))
- words))
-
-(defun rfc2047-encode-region (b e)
- "Encode all encodable words in REGION."
- (let ((words (rfc2047-dissect-region b e))
- beg end current word)
- (while (setq word (pop words))
- (if (equal (nth 2 word) current)
- (setq beg (nth 0 word))
- (when current
- (rfc2047-encode beg end current))
- (setq current (nth 2 word)
- beg (nth 0 word)
- end (nth 1 word))))
- (when current
- (rfc2047-encode beg end current))))
-
-(defun rfc2047-encode-string (string)
+ (setq point (point))
+ (skip-chars-backward word-chars b)
+ (unless (eq b (point))
+ (push (cons (buffer-substring b (point)) nil) words))
+ (setq b (point))
+ (goto-char point)
+ (setq current (mm-charset-after))
+ (forward-char 1)
+ (skip-chars-forward word-chars)
+ (while (and (not (eobp))
+ (eq (mm-charset-after) current))
+ (forward-char 1)
+ (skip-chars-forward word-chars))
+ (unless (eq b (point))
+ (push (cons (buffer-substring b (point)) current) words))
+ (setq b (point))
+ (skip-chars-forward "\000-\177"))
+ (unless (eq b (point))
+ (push (cons (buffer-substring b (point)) nil) words)))
+ ;; merge adjacent words
+ (setq word (pop words))
+ (while word
+ (if (and (cdr word)
+ (caar words)
+ (not (cdar words))
+ (not (string-match "[^ \t]" (caar words))))
+ (if (eq (cdr (nth 1 words)) (cdr word))
+ (progn
+ (setq word (cons (concat
+ (car (nth 1 words)) (caar words)
+ (car word))
+ (cdr word)))
+ (pop words)
+ (pop words))
+ (push (cons (concat (caar words) (car word)) (cdr word))
+ result)
+ (pop words)
+ (setq word (pop words)))
+ (push word result)
+ (setq word (pop words))))
+ result))
+
+(defun rfc2047-encode-region (b e &optional word-chars)
+ "Encode all encodable words in region B to E."
+ (let ((words (rfc2047-dissect-region b e word-chars)) word)
+ (save-restriction
+ (narrow-to-region b e)
+ (delete-region (point-min) (point-max))
+ (while (setq word (pop words))
+ (if (not (cdr word))
+ (insert (car word))
+ (rfc2047-fold-region (gnus-point-at-bol) (point))
+ (goto-char (point-max))
+ (if (> (- (point) (save-restriction
+ (widen)
+ (gnus-point-at-bol))) 76)
+ (insert "\n "))
+ ;; Insert blank between encoded words
+ (if (eq (char-before) ?=) (insert " "))
+ (rfc2047-encode (point)
+ (progn (insert (car word)) (point))
+ (cdr word))))
+ (rfc2047-fold-region (point-min) (point-max)))))
+
+(defun rfc2047-encode-string (string &optional word-chars)