* rfc2047.el (rfc2047-syntax-table): Funcall.

[gnus] / lisp / rfc2047.el

diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el
index 7fbcee7..1c14bef 100644 (file)
--- a/lisp/rfc2047.el
+++ b/lisp/rfc2047.el
@@ -29,7 +29,24 @@
 
 (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)
@@ -38,16 +55,17 @@
 (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)
@@ -237,7 +255,8 @@ The buffer may be narrowed."
   (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
@@ -246,11 +265,19 @@ The buffer may be narrowed."
 ;; 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)
@@ -287,14 +314,14 @@ Dynamically bind `rfc2047-encoding-type' to change that."
              ;; 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
@@ -498,8 +525,7 @@ By default, the region is treated as containing addresses (see
     (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]")
@@ -639,12 +665,14 @@ Return WORD if it is not not an encoded word or if the charset isn't
 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."