diff -c font-lock.el font-lock-patched-2014-08-30.el
*** font-lock.el	Sat Aug 30 10:19:26 2014
--- font-lock-patched-2014-08-30.el	Sat Aug 30 11:45:52 2014
***************
*** 1236,1249 ****
  what properties to clear before refontifying a region.")
  
  (defun font-lock-default-unfontify-region (beg end)
!   "Unfontify the text between BEG and END.
! This function is the default `font-lock-unfontify-region-function'."
!   (remove-list-of-text-properties
!    beg end (append
! 	    font-lock-extra-managed-props
! 	    (if font-lock-syntactic-keywords
! 		'(syntax-table face font-lock-multiline)
! 	      '(face font-lock-multiline)))))
  
  ;; Called when any modification is made to buffer text.
  (defun font-lock-after-change-function (beg end &optional old-len)
--- 1236,1254 ----
  what properties to clear before refontifying a region.")
  
  (defun font-lock-default-unfontify-region (beg end)
!   "Unfontify from BEG to END, except text with property `font-lock-ignore'."
!   (let ((here  (min beg end))
!         (end1  (max beg end))
!         chg)
!     (while (< here end1)
!       (setq chg  (next-single-property-change here 'font-lock-ignore nil end1))
!       (unless (get-text-property here 'font-lock-ignore)
!         (remove-list-of-text-properties
!          here chg (append font-lock-extra-managed-props
!                           (if font-lock-syntactic-keywords
!                               '(syntax-table face font-lock-multiline)
!                             '(face font-lock-multiline)))))
!       (setq here  chg))))
  
  ;; Called when any modification is made to buffer text.
  (defun font-lock-after-change-function (beg end &optional old-len)
***************
*** 1380,1388 ****
  	   (or (keywordp (car prev))
  	       (memq (car prev) '(foreground-color background-color)))
  	   (setq prev (list prev)))
!       (put-text-property start next prop
! 			 (append val (if (listp prev) prev (list prev)))
! 			 object)
        (setq start next))))
  
  (defun font-lock-append-text-property (start end prop value &optional object)
--- 1385,1393 ----
  	   (or (keywordp (car prev))
  	       (memq (car prev) '(foreground-color background-color)))
  	   (setq prev (list prev)))
!       (put-text-property-unless-ignore start next prop
!                                        (append val (if (listp prev) prev (list prev)))
!                                        object)
        (setq start next))))
  
  (defun font-lock-append-text-property (start end prop value &optional object)
***************
*** 1400,1408 ****
  	   (or (keywordp (car prev))
  	       (memq (car prev) '(foreground-color background-color)))
  	   (setq prev (list prev)))
!       (put-text-property start next prop
! 			 (append (if (listp prev) prev (list prev)) val)
! 			 object)
        (setq start next))))
  
  (defun font-lock-fillin-text-property (start end prop value &optional object)
--- 1405,1413 ----
  	   (or (keywordp (car prev))
  	       (memq (car prev) '(foreground-color background-color)))
  	   (setq prev (list prev)))
!       (put-text-property-unless-ignore start next prop
!                                        (append (if (listp prev) prev (list prev)) val)
!                                        object)
        (setq start next))))
  
  (defun font-lock-fillin-text-property (start end prop value &optional object)
***************
*** 1413,1419 ****
    (let ((start (text-property-any start end prop nil object)) next)
      (while start
        (setq next (next-single-property-change start prop object end))
!       (put-text-property start next prop value object)
        (setq start (text-property-any next end prop nil object)))))
  
  ;; For completeness: this is to `remove-text-properties' as `put-text-property'
--- 1418,1424 ----
    (let ((start (text-property-any start end prop nil object)) next)
      (while start
        (setq next (next-single-property-change start prop object end))
!       (put-text-property-unless-ignore start next prop value object)
        (setq start (text-property-any next end prop nil object)))))
  
  ;; For completeness: this is to `remove-text-properties' as `put-text-property'
***************
*** 1480,1495 ****
        ;; still be necessary for other users of syntax-ppss anyway.
        (syntax-ppss-after-change-function start)
        (cond
!        ((not override)
! 	;; Cannot override existing fontification.
! 	(or (text-property-not-all start end 'syntax-table nil)
! 	    (put-text-property start end 'syntax-table value)))
!        ((eq override t)
! 	;; Override existing fontification.
! 	(put-text-property start end 'syntax-table value))
!        ((eq override 'keep)
! 	;; Keep existing fontification.
! 	(font-lock-fillin-text-property start end 'syntax-table value))))))
  
  (defun font-lock-fontify-syntactic-anchored-keywords (keywords limit)
    "Fontify according to KEYWORDS until LIMIT.
--- 1485,1500 ----
        ;; still be necessary for other users of syntax-ppss anyway.
        (syntax-ppss-after-change-function start)
        (cond
!         ((not override)
!          ;; Cannot override existing fontification.
!          (or (text-property-not-all start end 'syntax-table nil)
!              (put-text-property-unless-ignore start end 'syntax-table value)))
!         ((eq override t)
!          ;; Override existing fontification.
!          (put-text-property-unless-ignore start end 'syntax-table value))
!         ((eq override 'keep)
!          ;; Keep existing fontification.
!          (font-lock-fillin-text-property start end 'syntax-table value))))))
  
  (defun font-lock-fontify-syntactic-anchored-keywords (keywords limit)
    "Fontify according to KEYWORDS until LIMIT.
***************
*** 1585,1591 ****
  	    (setq beg (max (nth 8 state) start))
  	    (setq state (parse-partial-sexp (point) end nil nil state
  					    'syntax-table))
! 	    (when face (put-text-property beg (point) 'face face))
  	    (when (and (eq face 'font-lock-comment-face)
                         (or font-lock-comment-start-skip
  			   comment-start-skip))
--- 1590,1596 ----
  	    (setq beg (max (nth 8 state) start))
  	    (setq state (parse-partial-sexp (point) end nil nil state
  					    'syntax-table))
! 	    (when face (put-text-property-unless-ignore beg (point) 'face face))
  	    (when (and (eq face 'font-lock-comment-face)
                         (or font-lock-comment-start-skip
  			   comment-start-skip))
***************
*** 1595,1604 ****
  		(goto-char beg)
  		(if (looking-at (or font-lock-comment-start-skip
  				    comment-start-skip))
! 		    (put-text-property beg (match-end 0) 'face
  				       font-lock-comment-delimiter-face)))
  	      (if (looking-back comment-end-regexp (point-at-bol) t)
! 		  (put-text-property (match-beginning 0) (point) 'face
  				     font-lock-comment-delimiter-face))))
  	  (< (point) end))
        (setq state (parse-partial-sexp (point) end nil nil state
--- 1600,1609 ----
  		(goto-char beg)
  		(if (looking-at (or font-lock-comment-start-skip
  				    comment-start-skip))
! 		    (put-text-property-unless-ignore beg (match-end 0) 'face
  				       font-lock-comment-delimiter-face)))
  	      (if (looking-back comment-end-regexp (point-at-bol) t)
! 		  (put-text-property-unless-ignore (match-beginning 0) (point) 'face
  				     font-lock-comment-delimiter-face))))
  	  (< (point) end))
        (setq state (parse-partial-sexp (point) end nil nil state
***************
*** 1632,1641 ****
  	 ((not override)
  	  ;; Cannot override existing fontification.
  	  (or (text-property-not-all start end 'face nil)
! 	      (put-text-property start end 'face val)))
  	 ((eq override t)
  	  ;; Override existing fontification.
! 	  (put-text-property start end 'face val))
  	 ((eq override 'prepend)
  	  ;; Prepend to existing fontification.
  	  (font-lock-prepend-text-property start end 'face val))
--- 1637,1646 ----
  	 ((not override)
  	  ;; Cannot override existing fontification.
  	  (or (text-property-not-all start end 'face nil)
! 	      (put-text-property-unless-ignore start end 'face val)))
  	 ((eq override t)
  	  ;; Override existing fontification.
! 	  (put-text-property-unless-ignore start end 'face val))
  	 ((eq override 'prepend)
  	  ;; Prepend to existing fontification.
  	  (font-lock-prepend-text-property start end 'face val))
***************
*** 1661,1671 ****
        (when (and font-lock-multiline (>= limit (line-beginning-position 2)))
  	;; this is a multiline anchored match
  	;; (setq font-lock-multiline t)
! 	(put-text-property (if (= limit (line-beginning-position 2))
! 			       (1- limit)
! 			     (min lead-start (point)))
! 			   limit
! 			   'font-lock-multiline t)))
      (save-match-data
        ;; Find an occurrence of `matcher' before `limit'.
        (while (and (< (point) limit)
--- 1666,1676 ----
        (when (and font-lock-multiline (>= limit (line-beginning-position 2)))
  	;; this is a multiline anchored match
  	;; (setq font-lock-multiline t)
! 	(put-text-property-unless-ignore (if (= limit (line-beginning-position 2))
!                                              (1- limit)
!                                            (min lead-start (point)))
!                                          limit
!                                          'font-lock-multiline t)))
      (save-match-data
        ;; Find an occurrence of `matcher' before `limit'.
        (while (and (< (point) limit)
***************
*** 1707,1735 ****
  		    (funcall matcher end))
                    ;; Beware empty string matches since they will
                    ;; loop indefinitely.
!                   (or (> (point) (match-beginning 0))
!                       (progn (forward-char 1) t)))
! 	(when (and font-lock-multiline
! 		   (>= (point)
! 		       (save-excursion (goto-char (match-beginning 0))
! 				       (forward-line 1) (point))))
! 	  ;; this is a multiline regexp match
! 	  ;; (setq font-lock-multiline t)
! 	  (put-text-property (if (= (point)
! 				    (save-excursion
! 				      (goto-char (match-beginning 0))
! 				      (forward-line 1) (point)))
! 				 (1- (point))
! 			       (match-beginning 0))
! 			     (point)
! 			     'font-lock-multiline t))
! 	;; Apply each highlight to this instance of `matcher', which may be
! 	;; specific highlights or more keywords anchored to `matcher'.
! 	(setq highlights (cdr keyword))
! 	(while highlights
! 	  (if (numberp (car (car highlights)))
! 	      (font-lock-apply-highlight (car highlights))
! 	    (set-marker pos (point))
              (font-lock-fontify-anchored-keywords (car highlights) end)
              ;; Ensure forward progress.  `pos' is a marker because anchored
              ;; keyword may add/delete text (this happens e.g. in grep.el).
--- 1712,1738 ----
  		    (funcall matcher end))
                    ;; Beware empty string matches since they will
                    ;; loop indefinitely.
!                   (or (> (point) (match-beginning 0))  (progn (forward-char 1) t)))
!         (when (and font-lock-multiline
!                    (>= (point) (save-excursion (goto-char (match-beginning 0))
!                                                (forward-line 1) (point))))
!           ;; this is a multiline regexp match
!           ;; (setq font-lock-multiline  t)
!           (put-text-property-unless-ignore (if (= (point)
!                                                   (save-excursion
!                                                     (goto-char (match-beginning 0))
!                                                     (forward-line 1) (point)))
!                                                (1- (point))
!                                              (match-beginning 0))
!                                            (point)
!                                            'font-lock-multiline t))
!         ;; Apply each highlight to this instance of `matcher', which may be
!         ;; specific highlights or more keywords anchored to `matcher'.
!         (setq highlights  (cdr keyword))
!         (while highlights
!           (if (numberp (car (car highlights)))
!               (font-lock-apply-highlight (car highlights))
!             (set-marker pos (point))
              (font-lock-fontify-anchored-keywords (car highlights) end)
              ;; Ensure forward progress.  `pos' is a marker because anchored
              ;; keyword may add/delete text (this happens e.g. in grep.el).
***************
*** 1742,1747 ****
--- 1745,1761 ----
  
  ;; Various functions.
  
+ (defun put-text-property-unless-ignore (start end property value &optional object)
+   "`put-text-property', but ignore text with property `font-lock-ignore'."
+   (let ((here  (min start end))
+         (end1  (max start end))
+         chg)
+     (while (< here end1)
+       (setq chg  (next-single-property-change here 'font-lock-ignore object end1))
+       (unless (get-text-property here 'font-lock-ignore object)
+         (put-text-property here chg property value object))
+       (setq here  chg))))
+ 
  (defun font-lock-compile-keywords (keywords &optional syntactic-keywords)
    "Compile KEYWORDS into the form (t KEYWORDS COMPILED...)
  Here each COMPILED is of the form (MATCHER HIGHLIGHT ...) as shown in the
