(eval-when-compile
(require 'cl)
- (defvar message-posting-charset))
+ (defvar message-posting-charset)
+ (unless (fboundp 'with-syntax-table) ; not in Emacs 20
+ (defmacro with-syntax-table (table &rest body)
+ "Evaluate BODY with syntax table of current buffer set to TABLE.
+The syntax table of the current buffer is saved, BODY is evaluated, and the
+saved table is restored, even in case of an abnormal exit.
+Value is what BODY returns."
+ (let ((old-table (make-symbol "table"))
+ (old-buffer (make-symbol "buffer")))
+ `(let ((,old-table (syntax-table))
+ (,old-buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (set-syntax-table ,table)
+ ,@body)
+ (save-current-buffer
+ (set-buffer ,old-buffer)
+ (set-syntax-table ,old-table))))))))
(require 'qp)
(require 'mm-util)
(require 'base64)
(autoload 'mm-body-7-or-8 "mm-bodies")
-;; Avoid gnus-util for mm- code.
-(defalias 'rfc2047-point-at-bol
- (if (fboundp 'point-at-bol)
- 'point-at-bol
- 'line-beginning-position))
+(eval-and-compile
+ ;; Avoid gnus-util for mm- code.
+ (defalias 'rfc2047-point-at-bol
+ (if (fboundp 'point-at-bol)
+ 'point-at-bol
+ 'line-beginning-position))
-(defalias 'rfc2047-point-at-eol
- (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position))
+ (defalias 'rfc2047-point-at-eol
+ (if (fboundp 'point-at-eol)
+ 'point-at-eol
+ 'line-end-position)))
(defvar rfc2047-header-encoding-alist
'(("Newsgroups" . nil)
(require 'message) ; for message-posting-charset
(let ((charsets
(mm-find-mime-charset-region (point-min) (point-max))))
- (and charsets (not (equal charsets (list message-posting-charset))))))
+ (and charsets
+ (not (equal charsets (list (car message-posting-charset)))))))
;; Use this syntax table when parsing into regions that may need
;; encoding. Double quotes are string delimiters, backslash is
;; skip to the end of regions appropriately. Nb. ietf-drums does
;; things differently.
(defconst rfc2047-syntax-table
- ;; This is what we should do, but XEmacs doesn't support the optional
- ;; arg of `make-syntax-table':
-;; (let ((table (make-char-table 'syntax-table '(2))))
- (let ((table (make-char-table 'syntax-table)))
- (map-char-table (lambda (k v) (aset table k '(2))) table)
+ ;; (make-char-table 'syntax-table '(2)) only works in Emacs.
+ (let ((table (make-syntax-table)))
+ ;; The following is done to work for setting all elements of the table
+ ;; in Emacs 21 and 22 and XEmacs; it appears to be the cleanest way.
+ ;; Play safe and don't assume the form of the word syntax entry --
+ ;; copy it from ?a.
+ (if (fboundp 'set-char-table-range) ; Emacs
+ (funcall (intern "set-char-table-range")
+ table t (aref (standard-syntax-table) ?a))
+ (if (fboundp 'put-char-table)
+ (if (fboundp 'get-char-table) ; warning avoidance
+ (put-char-table t (get-char-table ?a (standard-syntax-table))
+ table))))
(modify-syntax-entry ?\\ "\\" table)
(modify-syntax-entry ?\" "\"" table)
(modify-syntax-entry ?\( "." table)
;; token, either immediately or separated by space.
last-encoded)
(goto-char (point-min))
- (condition-case nil ; in case of unbalanced quotes
+ (condition-case nil ; in case of unbalanced quotes
;; Look for rfc2822-style: sequences of atoms, quoted
;; strings, specials, whitespace. (Specials mustn't be
;; encoded.)
(while (not (eobp))
(setq start (point))
;; Skip whitespace.
- (unless (= 0 (skip-chars-forward " \t"))
+ (unless (= 0 (skip-chars-forward " \t\n"))
(setq start (point)))
(cond
((not (char-after))) ; eob
(let ((bol (save-restriction
(widen)
(rfc2047-point-at-bol)))
- (eol (rfc2047-point-at-eol))
- leading)
+ (eol (rfc2047-point-at-eol)))
(forward-line 1)
(while (not (eobp))
(if (and (looking-at "[ \t]")
(let ((m (mm-multibyte-p)))
(if (string-match "=\\?" string)
(with-temp-buffer
+ ;; Fixme: This logic is wrong, but seems to be required by
+ ;; Gnus summary buffer generation. The value of `m' depends
+ ;; on the current buffer, not global multibyteness or that
+ ;; of the string. Also the string returned should always be
+ ;; multibyte in a multibyte session, i.e. the buffer should
+ ;; be multibyte before `buffer-string' is called.
(when m
(mm-enable-multibyte))
(insert string)
(inline
(rfc2047-decode-region (point-min) (point-max)))
- (mm-enable-multibyte)
- (buffer-string)))
- (if (and mail-parse-charset
- (not (eq mail-parse-charset 'us-ascii))
- (not (eq mail-parse-charset 'gnus-decoded)))
- (mm-decode-coding-string string mail-parse-charset)
- (mm-string-as-multibyte string))))
+ (buffer-string))
+ ;; Fixme: As above, `m' here is inappropriate.
+ (if (and m
+ mail-parse-charset
+ (not (eq mail-parse-charset 'us-ascii))
+ (not (eq mail-parse-charset 'gnus-decoded)))
+ (mm-decode-coding-string string mail-parse-charset)
+ (mm-string-as-multibyte string)))))
(defun rfc2047-parse-and-decode (word)
"Decode WORD and return it if it is an encoded word.
decodable."
(if (not (string-match rfc2047-encoded-word-regexp word))
word
- (condition-case nil
- (rfc2047-decode
- (match-string 1 word)
- (upcase (match-string 2 word))
- (match-string 3 word))
- (error word))))
+ (or
+ (condition-case nil
+ (rfc2047-decode
+ (match-string 1 word)
+ (upcase (match-string 2 word))
+ (match-string 3 word))
+ (error word))
+ word))) ; un-decodable
(defun rfc2047-pad-base64 (string)
"Pad STRING to quartets."