[Bug: 21.5-b27] font-lock-fontify-* / infinite loop

[Aidan Kehoe]

 Ar an dara lá déag de mí Eanair, scríobh Aidan Kehoe: 

 > Okay, try recompiling and reloading gnus/message.el. If that doesn’t work,
 > apply the following patch to it and try again; if the patch doesn’t apply,
 > change the line
 > 
 >   (defun message-font-lock-make-header-matcher (regexp)
 > 
 > to 
 > 
 >   (defmacro message-font-lock-make-header-matcher (regexp)
 > 
 > and recompile and reload. (Note that I haven’t reproduced your problem, so I
 > can’t be very certain that I have a solution for it :-( )

Looking at the compiled version of the, I see my change didn’t do all I
wanted it to :-( . Here’s a version that does. 

(Hands up who noticed that I was relying on parameters to a macro being
evaluated, when they’re normally not?)  

--- /usr/local/lib/xemacs/xemacs-packages/lisp/gnus/message.el	2006-03-16 07:02:42.000000000 +0100
+++ message.el	2007-01-12 16:10:04.078125000 +0100
@@ -1265,63 +1265,58 @@
 ;; backward-compatibility alias
 (put 'message-mml-face 'face-alias 'message-mml)
 
-(defun message-font-lock-make-header-matcher (regexp)
-  (let ((form
-	 `(lambda (limit)
-	    (let ((start (point)))
-	      (save-restriction
-		(widen)
-		(goto-char (point-min))
-		(if (re-search-forward
-		     (concat "^" (regexp-quote mail-header-separator) "$")
-		     nil t)
-		    (setq limit (min limit (match-beginning 0))))
-		(goto-char start))
-	      (and (< start limit)
-		   (re-search-forward ,regexp limit t))))))
-    (if (featurep 'bytecomp)
-	(byte-compile form)
-      form)))
+(defmacro message-font-lock-make-header-matcher (regexp)
+  `(lambda (limit)
+     (let ((start (point)))
+       (save-restriction
+	 (widen)
+	 (goto-char (point-min))
+	 (if (re-search-forward
+	      (concat "^" (regexp-quote mail-header-separator) "$")
+	      nil t)
+	     (setq limit (min limit (match-beginning 0))))
+	 (goto-char start))
+       (and (< start limit)
+	    (re-search-forward 
+             (concat ,regexp
+                     "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?") limit t)))))
 
 (defvar message-font-lock-keywords
-  (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
-    `((,(message-font-lock-make-header-matcher
-	 (concat "^\\([Tt]o:\\)" content))
-       (1 'message-header-name)
-       (2 'message-header-to nil t))
-      (,(message-font-lock-make-header-matcher
-	 (concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content))
-       (1 'message-header-name)
-       (2 'message-header-cc nil t))
-      (,(message-font-lock-make-header-matcher
-	 (concat "^\\([Ss]ubject:\\)" content))
-       (1 'message-header-name)
-       (2 'message-header-subject nil t))
-      (,(message-font-lock-make-header-matcher
-	 (concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content))
-       (1 'message-header-name)
-       (2 'message-header-newsgroups nil t))
-      (,(message-font-lock-make-header-matcher
-	 (concat "^\\([A-Z][^: \n\t]+:\\)" content))
-       (1 'message-header-name)
-       (2 'message-header-other nil t))
-      (,(message-font-lock-make-header-matcher
-	 (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content))
-       (1 'message-header-name)
-       (2 'message-header-name))
-      ,@(if (and mail-header-separator
-		 (not (equal mail-header-separator "")))
-	    `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
-	       1 'message-separator))
-	  nil)
-      ((lambda (limit)
-	 (re-search-forward (concat "^\\("
-				    message-cite-prefix-regexp
-				    "\\).*")
-			    limit t))
-       (0 'message-cited-text))
-      ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>"
-       (0 'message-mml))))
+  `((,(message-font-lock-make-header-matcher "^\\([Tt]o:\\)")
+     (1 'message-header-name)
+     (2 'message-header-to nil t))
+    (,(message-font-lock-make-header-matcher
+       "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)")
+     (1 'message-header-name)
+     (2 'message-header-cc nil t))
+    (,(message-font-lock-make-header-matcher
+       "^\\([Ss]ubject:\\)")
+     (1 'message-header-name)
+     (2 'message-header-subject nil t))
+    (,(message-font-lock-make-header-matcher
+       "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)")
+     (1 'message-header-name)
+     (2 'message-header-newsgroups nil t))
+    (,(message-font-lock-make-header-matcher "^\\([A-Z][^: \n\t]+:\\)")
+     (1 'message-header-name)
+     (2 'message-header-other nil t))
+    (,(message-font-lock-make-header-matcher
+       "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)")
+     (1 'message-header-name)
+     (2 'message-header-name))
+    ,@(if (and mail-header-separator
+               (not (equal mail-header-separator "")))
+          `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
+             1 'message-separator))
+        nil)
+    (,(lambda (limit)
+        (re-search-forward (concat "^\\("
+                                   message-cite-prefix-regexp
+                                   "\\).*")
+                           limit t))
+     (0 'message-cited-text))
+    ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>"
+     (0 'message-mml)))
   "Additional expressions to highlight in Message mode.")
 
 



-- 
When I was in the scouts, the leader told me to pitch a tent. I couldn't
find any pitch, so I used creosote.