X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fmessage.el;h=85b917da17f627fe46cf6e76841ae58525a5fa77;hp=7b9eb76a817ffdb5ff70feb94a3e629e7f50765c;hb=68f412fcdd68a5d0c322fd69a5e4cf07c1209e2b;hpb=de5278e5aba946a080592a7cac39ac361e2a81e1

diff --git a/lisp/message.el b/lisp/message.el
index 7b9eb76a8..85b917da1 100644
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1807,7 +1807,10 @@ no, only reply back to the author."
 	       (let (mucs-ignore-version-incompatibilities)
 		 (require 'un-define))
 	     (error)))
-       (condition-case nil (require 'idna) (file-error))
+       (condition-case nil
+	   (require 'idna)
+	 (file-error)
+	 (invalid-operation))
        idna-program
        (executable-find idna-program)
        (string= (idna-to-ascii "räksmörgås") "xn--rksmrgs-5wao1o")
@@ -2013,7 +2016,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
   ;; "dead" nato bitnet uucp
   "Regular expression that matches a valid FQDN."
   ;; see also: gnus-button-valid-fqdn-regexp
-  :version "22.1"
+  :version "25.1"
   :group 'message-headers
   :type 'regexp)
 
@@ -3005,6 +3008,30 @@ See also `message-forbidden-properties'."
 
 (autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23.
 
+(defvar message-smileys '(":-)" ":)"
+                          ":-(" ":("
+                          ";-)" ";)")
+  "A list of recognized smiley faces in `message-mode'.")
+
+(defun message--syntax-propertize (beg end)
+  "Syntax-propertize certain message text specially."
+  (let ((citation-regexp (concat "^" message-cite-prefix-regexp ".*$"))
+        (smiley-regexp (regexp-opt message-smileys)))
+    (goto-char beg)
+    (while (search-forward-regexp citation-regexp
+                                  end 'noerror)
+      (let ((start (match-beginning 0))
+            (end (match-end 0)))
+        (add-text-properties start (1+ start)
+                             `(syntax-table ,(string-to-syntax "<")))
+        (add-text-properties end (min (1+ end) (point-max))
+                             `(syntax-table ,(string-to-syntax ">")))))
+    (goto-char beg)
+    (while (search-forward-regexp smiley-regexp
+            end 'noerror)
+      (add-text-properties (match-beginning 0) (match-end 0)
+                           `(syntax-table ,(string-to-syntax "."))))))
+
 ;;;###autoload
 (define-derived-mode message-mode text-mode "Message"
   "Major mode for editing mail and news to be sent.
@@ -3107,7 +3134,13 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
     ;; multibyte is not necessary at all. -- zsh
     (mm-enable-multibyte))
   (set (make-local-variable 'indent-tabs-mode) nil) ;No tabs for indentation.
-  (mml-mode))
+  (mml-mode)
+  ;; Syntactic fontification. Helps `show-paren-mode',
+  ;; `electric-pair-mode', and C-M-* navigation by syntactically
+  ;; excluding citations and other artifacts.
+  ;;
+  (set (make-local-variable 'syntax-propertize-function) 'message--syntax-propertize)
+  (set (make-local-variable 'parse-sexp-ignore-comments) t))
 
 (defun message-setup-fill-variables ()
   "Setup message fill variables."
@@ -4008,8 +4041,6 @@ This function uses `mail-citation-hook' if that is non-nil."
   "Cite function in the standard Message manner."
   (message-cite-original-1 nil))
 
-(defvar gnus-extract-address-components)
-
 (autoload 'format-spec "format-spec")
 (autoload 'gnus-date-get-time "gnus-util")
 
@@ -4031,13 +4062,13 @@ See `message-citation-line-format'."
     (unless from
       (setq from (mail-header-from message-reply-headers)))
     (let* ((data (condition-case ()
-		     (funcall (if (boundp gnus-extract-address-components)
+		     (funcall (if (boundp 'gnus-extract-address-components)
 				  gnus-extract-address-components
 				'mail-extract-address-components)
 			      from)
 		   (error nil)))
 	   (name (car data))
-	   (fname-or-net (or name (car (cdr data)) from))
+	   (fname name)
 	   (lname name)
 	   (net (car (cdr data)))
 	   (name-or-net (or (car data)
@@ -4084,7 +4115,7 @@ See `message-citation-line-format'."
                       (setq fname lname lname newlname)))))
 	      ;; The following letters are not used in `format-time-string':
 	      (push ?E lst) (push "<E>" lst)
-	      (push ?F lst) (push fname-or-net lst)
+	      (push ?F lst) (push (or fname name-or-net) lst)
 	      ;; We might want to use "" instead of "<X>" later.
 	      (push ?J lst) (push "<J>" lst)
 	      (push ?K lst) (push "<K>" lst)