Re: perl mode color highlighting working badly

[martin rudalics]

Unless/until you can think of a better solution consider the following
patches as point of departure (I know, you despise yet another text
property):


*** font-lock.el        Wed Oct 19 16:35:24 2005
--- font-lock.el        Fri Nov  4 13:38:08 2005
***************
*** 501,506 ****
--- 501,502 ----
  sometimes be slightly incorrect.")
  (make-variable-buffer-local 'font-lock-syntactically-fontified)

+ (defvar font-lock-fontify-syntactically nil
+   "Non-nil means do additional passes to assign syntax-table properties.
+ This variable tells font-lock to do additional passes in order to assign
+ syntax-table text properties.  These passes serve to establish a proper
+ syntactic context for fontification starting at some position POS and
+ are executed from the position calculated by `syntax-begin-function' at
+ POS to POS.  Major modes should set this to one of the following values:
+
+ - `keywords-only' means do `font-lock-fontify-syntactic-keywords' pass
+   only.  In this case `font-lock-syntactic-face-function' should not
+   assign any syntax-table properties.
+
+ - `syntax-only' means do `font-lock-fontify-syntactically' pass only.
+   In this case `font-lock-syntactic-keywords' should be nil.
+
+ - t means perform the `font-lock-fontify-syntactic-keywords' and the
+   `font-lock-fontify-syntactically' pass.
+
+ - nil means never do additional passes.
+
+ Major modes setting this variable to a non-nil value should set
+ `font-lock-syntactically-fontified' to nil.")
+ (make-variable-buffer-local 'font-lock-fontify-syntactically)
+
  (defvar font-lock-syntactic-face-function
    (lambda (state)
      (if (nth 3 state) font-lock-string-face font-lock-comment-face))
***************
*** 1065,1071 ****
          ;; Round up to a whole line.
            (unless (bolp) (setq end (line-beginning-position 2)))
          ;; Now do the fontification.
!         (font-lock-unfontify-region beg end)
          (when font-lock-syntactic-keywords
            (font-lock-fontify-syntactic-keywords-region beg end))
          (unless font-lock-keywords-only
--- 1089,1121 ----
          ;; Round up to a whole line.
            (unless (bolp) (setq end (line-beginning-position 2)))
            ;; Now do the fontification.
!           (if (and font-lock-fontify-syntactically
!                    (not (or (= beg (point-min))
!                             (get-text-property (1- beg) 'fontified)
!                             (get-text-property
!                              (1- beg) 'fontified-syntactically))))
!               ;; Do additional pass(es) to establish syntactic context at BEG.
!               (let ((sbeg (if syntax-begin-function
!                               (progn
!                                 ;; Avoid passes for BEG at syntax-begin.
!                                 (goto-char (min (1+ beg) (point-max)))
!                                 (funcall syntax-begin-function))
!                             (point-min))))
!                 (unless (= sbeg beg)
!                   ;; Don't refontify already fontified text.
!                   (setq sbeg (max sbeg
!                                   (previous-single-property-change
!                                    beg 'fontified nil sbeg)
!                                   (previous-single-property-change
!                                    beg 'fontified-syntactically nil sbeg))))
!                 (font-lock-unfontify-region sbeg end)
!                 (unless (eq font-lock-fontify-syntactically 'syntax-only)
!                   (font-lock-fontify-syntactic-keywords-region sbeg beg))
!                 (unless (eq font-lock-fontify-syntactically 'keywords-only)
!                   (font-lock-fontify-syntactically-region sbeg beg loudly))
!                 (put-text-property sbeg beg 'fontified-syntactically t)
!                 (remove-text-properties beg end '(fontified-syntactically 
nil)))
!             (font-lock-unfontify-region beg end))
          (when font-lock-syntactic-keywords
            (font-lock-fontify-syntactic-keywords-region beg end))
          (unless font-lock-keywords-only


*** jit-lock.el Wed Oct 19 16:35:24 2005
--- jit-lock.el Fri Nov  4 08:45:24 2005
***************
*** 537,543 ****
             ;; Force contextual refontification.
             (remove-text-properties
              jit-lock-context-unfontify-pos (point-max)
!             '(fontified nil jit-lock-defer-multiline nil)))
            (setq jit-lock-context-unfontify-pos (point-max))))))))

  (defun jit-lock-after-change (start end old-len)
--- 537,543 ----
             ;; Force contextual refontification.
             (remove-text-properties
              jit-lock-context-unfontify-pos (point-max)
!             '(fontified nil fontified-syntactically nil 
jit-lock-defer-multiline nil)))
            (setq jit-lock-context-unfontify-pos (point-max))))))))

  (defun jit-lock-after-change (start end old-len)
***************
*** 569,575 ****
         ;; Make sure we change at least one char (in case of deletions).
         (setq end (min (max end (1+ start)) (point-max)))
         ;; Request refontification.
!        (put-text-property start end 'fontified nil))
        ;; Mark the change for deferred contextual refontification.
        (when jit-lock-context-unfontify-pos
        (setq jit-lock-context-unfontify-pos
--- 569,576 ----
         ;; Make sure we change at least one char (in case of deletions).
         (setq end (min (max end (1+ start)) (point-max)))
         ;; Request refontification.
!        (remove-text-properties
!         start end '(fontified nil fontified-syntactically nil)))
        ;; Mark the change for deferred contextual refontification.
        (when jit-lock-context-unfontify-pos
        (setq jit-lock-context-unfontify-pos


*** perl-mode.el        Wed Oct 19 16:36:00 2005
--- perl-mode.el        Fri Nov  4 10:48:18 2005
***************
*** 533,539 ****
                              . perl-font-lock-syntactic-keywords)
                             (font-lock-syntactic-face-function
                              . perl-font-lock-syntactic-face-function)
!                            (parse-sexp-lookup-properties . t)))
    ;; Tell imenu how to handle Perl.
    (set (make-local-variable 'imenu-generic-expression)
         perl-imenu-generic-expression)
--- 533,542 ----
                              . perl-font-lock-syntactic-keywords)
                             (font-lock-syntactic-face-function
                              . perl-font-lock-syntactic-face-function)
!                            (parse-sexp-lookup-properties . t)
!                              (font-lock-syntactically-fontified . nil)
!                              (font-lock-fontify-syntactically . t)))
!   (set (make-local-variable 'syntax-begin-function) 
'perl-syntax-begin-function)
    ;; Tell imenu how to handle Perl.
    (set (make-local-variable 'imenu-generic-expression)
         perl-imenu-generic-expression)
***************
*** 919,924 ****
--- 922,933 ----
         (goto-char (1- (match-end 0))))
    (point))

+ (defun perl-syntax-begin-function ()
+   "Rudimentary `syntax-begin-function' for perl-mode."
+   (if (re-search-backward "^sub[ ]+\\w" nil t)
+       (point)
+     (point-min)))
+
  ;; note: this routine is adapted directly from emacs lisp.el, end-of-defun;
  ;; no bugs have been removed :-)
  (defun perl-end-of-function (&optional arg)