X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Frfc2047.el;h=1c14bef2d7ab5977b641fbaab6d18f97ea539163;hb=608739c5c38369a519375b394a55755f616231a4;hp=7fbcee7cf5577ab8a72d0700e79131c6904779ed;hpb=66adf82f0925ba1edee6b3b01e704648c8e0361a;p=gnus

diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el
index 7fbcee7cf..1c14bef2d 100644
--- 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."