(font-lock-fontify-syntactically-region): Use new

features of parse-partial-sexp instead of doing regexp search.

1 files changed, 26 insertions, 72 deletions

diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 5186399ba34..81ed9d61541 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1027,14 +1027,8 @@ delimit the region to fontify."
 (defun font-lock-fontify-syntactically-region (start end &optional loudly)
   "Put proper face on each string and comment between START and END.
 START should be at the beginning of a line."
-  (let ((synstart (cond (font-lock-comment-start-regexp
-			 (concat "\\s\"\\|" font-lock-comment-start-regexp))
-			(comment-start-skip
-			 (concat "\\s\"\\|" comment-start-skip))
-			(t
-			 "\\s\"")))
-	(cache (marker-position font-lock-cache-position))
-	state prev here beg)
+  (let (state prev here comment
+	      (cache (marker-position font-lock-cache-position)))
     (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name)))
     (goto-char start)
     ;;
@@ -1058,73 +1052,33 @@ START should be at the beginning of a line."
       (set-marker font-lock-cache-position start))
     ;;
     ;; If the region starts inside a string, show the extent of it.
-    (when (nth 3 state)
-      (setq here (point))
-      (while (and (re-search-forward "\\s\"" end 'move)
-		  ;; Verify the state so we don't get fooled by quoting.
-		  (nth 3 (parse-partial-sexp here (point) nil nil state))))
-      (put-text-property here (point) 'face font-lock-string-face)
-      (setq state (parse-partial-sexp here (point) nil nil state)))
-    ;;
-    ;; Likewise for a comment.
-    (when (or (nth 4 state) (nth 7 state))
-      (let ((comstart (cond (font-lock-comment-start-regexp
-			     font-lock-comment-start-regexp)
-			    (comment-start-skip
-			     (concat "\\s<\\|" comment-start-skip))
-			    (t
-			     "\\s<")))
-	    (count 1))
-	(setq here (point))
-	(condition-case nil
-	    (save-restriction
-	      (narrow-to-region (point-min) end)
-	      ;; Go back to the real start of the comment.
-	      (re-search-backward comstart)
-	      (forward-comment 1)
-	      ;; If there is more than one comment type, then the previous
-	      ;; comment start might not be the real comment start.
-	      ;; For example, in C++ code, `here' might be on a line following
-	      ;; a // comment that is actually within a /* */ comment.
-	      (while (<= (point) here)
-		(goto-char here)
-		(re-search-backward comstart nil nil (incf count))
-		(forward-comment 1))
-	      ;; Go back to the real end of the comment.
-	      (skip-chars-backward " \t"))
-	  (error (goto-char end)))
-	(put-text-property here (point) 'face font-lock-comment-face)
-	(setq state (parse-partial-sexp here (point) nil nil state))))
+    (when (or (nth 4 state) (nth 3 state))
+      (setq comment (nth 4 state) here (point))
+      (setq state (parse-partial-sexp (point) end
+				      nil nil state 'syntax-table))
+      (put-text-property here (point) 'face 
+			 (if comment 
+			     font-lock-comment-face
+			   font-lock-string-face)))
     ;;
     ;; Find each interesting place between here and `end'.
     (while (and (< (point) end)
-		(setq prev (point))
-		(re-search-forward synstart end t)
-		(setq state (parse-partial-sexp prev (point) nil nil state)))
-      (cond ((nth 3 state)
-	     ;;
-	     ;; Found a real string start.
-	     (setq here (point) beg (match-beginning 0))
-	     (condition-case nil
-		 (save-restriction
-		   (narrow-to-region (point-min) end)
-		   (goto-char (scan-sexps beg 1)))
-	       (error (goto-char end)))
-	     (put-text-property beg (point) 'face font-lock-string-face)
-	     (setq state (parse-partial-sexp here (point) nil nil state)))
-	    ((or (nth 4 state) (nth 7 state))
-	     ;;
-	     ;; Found a real comment start.
-	     (setq here (point) beg (or (match-end 1) (match-beginning 0)))
-	     (goto-char beg)
-	     (condition-case nil
-		 (save-restriction
-		   (narrow-to-region (point-min) end)
-		   (forward-comment 1)
-		   (skip-chars-backward " \t"))
-	       (error (goto-char end)))
-	     (put-text-property beg (point) 'face font-lock-comment-face)
-	     (setq state (parse-partial-sexp here (point) nil nil state)))))))
+		(progn
+		  (setq prev (point)
+			state (parse-partial-sexp (point) end
+						  nil nil state 'syntax-table))
+		  (or (nth 3 state) (nth 4 state))))
+      (setq here (nth 8 state) comment (nth 4 state))
+      (setq state (parse-partial-sexp (point) end 
+				      nil nil state 'syntax-table))
+      (put-text-property here (point) 'face 
+			 (if comment 
+			     font-lock-comment-face
+			   font-lock-string-face))
+      ;;
+      ;; Make sure `prev' is non-nil after the loop
+      ;; only if it was set on the very last iteration.
+      (setq prev nil))))
 
 ;;; End of Syntactic fontification functions.