Fontifying outside of region passed to registered JIT lock function

Fontifying outside of region passed to registered JIT lock function

[Barry OReilly]

[-- Attachment #1: Type: text/plain, Size: 1861 bytes --]

Background:

I'm writing a color-parens minor mode that will fontify parens if they
are inconsistent with indentation. For example:

   (if region
       (setq beg (min jit-lock-start (car region))
       end (max jit-lock-end (cdr region))))

Indentation implies the close paren of (setq ...) would be at the end
of the same line, but it's really on the next line, so the minor mode
fontifies that. The goal is to give the user clues when indentation
lies about where close parens are.

Problem:

I am passing my color-parens-propertize-region function to
jit-lock-register and it processes the regions passed to it. However,
the regions need expansion because it's possible parent lists' parens
outside the region need fontification too.

I found the Elisp manual's section on Multiline Font Lock Constructs
and tried adding a hook to font-lock-extend-region-functions to expand
the region. I discovered that doesn't work because
font-lock-fontify-region-function and
font-lock-extend-region-functions are used under
font-lock-fontify-region, which is another registered JIT lock
function. Those region expansions don't apply to the other registered
jit-lock-functions.

Obviously I could disregard the region inputs and fontify minimally
outside of it, but my concerns are:

   • Maybe the JIT lock infrastructure expects jit-lock-functions to
     fontify only within the region?

   • It might be needlessly inefficient to fontify outside the region
     without JIT lock knowing, then it calls the jit-lock-functions
     again for those regions.

I found the jit-lock-after-change-extend-region-functions, but those
hooks aren't called for the initial fontifications.

What is the recommended way to expand the JIT region or otherwise
fontify outside of the regions passed to a registered JIT lock
function?

[-- Attachment #2: Type: text/html, Size: 2030 bytes --]

Re: Fontifying outside of region passed to registered JIT lock function

[Stefan Monnier]

> However, the regions need expansion because it's possible parent
> lists' parens outside the region need fontification too.

I don't understand this explanation.
In general fontifying outside of the region is not needed and doing it
is troublesome, so I suggest you think really hard about why you think
it's needed.  Maybe your implementation strategy requires it, but
there's another approach which doesn't.
If you explain in more details, we can probably help you figure it out,


        Stefan

Re: Fontifying outside of region passed to registered JIT lock function

[Barry OReilly]

[-- Attachment #1.1: Type: text/plain, Size: 1572 bytes --]

> If you explain in more details, we can probably help you figure it
> out,

I can show you. It's a work in progress, but the basic algorithm is in
the attached color-parens.el. Load it, call color-parens-mode, open
the attached thread-test-binding.el (which was just a random .el file
lying around). You'll see the correct parens fontified in this block:

   (defun threads-test-thread2 ()
     (let ((threads-test-binding 23))
   (thread-yield))
     (setq threads-test-global 23))

But not in this block:

   (progn
     (setq threads-test-global nil)
     (make-thread #'threads-test-thread2)
     (while (not threads-test-global)
   (thread-yield))
     (and (not threads-test-binding)
          threads-test-global))

The reason is that the regions JIT lock passes begin and end in the
middle of the progn list.

If you highlight the progn list and 's/^/ /', you'll see
the desired fontification, since JIT now passes in the desired region.

To explain what I'm doing in simpler terms, suppose you have:

   (a b
      c
      d)

The close paren is where the indentation would imply, so there's no
coloring of parens.

Suppose you edit the code so as it is now:

   (a b
   c
      d)

The indentation implies the close paren would be after b. Since it is
not, the minor mode wants to update the color of the parens. JIT lock
may pass in a region that excludes those parens however.

By the way, I'd be interested if something already exists that does
something similar: gives some visual indication in Lisp code that
close parens and indentation are inconsistent.

[-- Attachment #1.2: Type: text/html, Size: 1808 bytes --]

[-- Attachment #2: color-parens.el --]
[-- Type: text/x-emacs-lisp, Size: 10243 bytes --]

;;; color-parens.el --- Color unbalanced parentheses and parentheses inconsistent with indentation -*- lexical-binding: t; -*-

;; Copyright (C) 2013  Free Software Foundation, Inc.

;; Author: Barry O'Reilly <gundaetiapo@gmail.com>
;; Version: 0

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

(require 'cl-lib)

(defgroup color-parens nil
  "Color unbalanced parentheses and parentheses inconsistent with indentation."
  :prefix "color-parens-"
  :group 'paren-matching)

(defgroup color-parens-faces nil
  "Faces for color-parens package. "
  :group 'color-parens
  :group 'faces)

(defface color-parens-inconsistent
  '((((class color) (background light))
     :foreground "dark orange")
    (((class color) (background dark))
     :foreground "orange"))
  "Face to use for matching open and close parens whose placement
is inconsistent with indentation."
  :group 'color-parens-faces)

;; TODO: Faces for mismatched open and close

;; TODO: Remove debugging message statements

;; TODO: Test close parens in doc of c-beginning-of-statement-1 in
;; cc-engine.el

;; TODO: Threshold column for `() is off.
;;
;; Consistent:
;;   `()
;;    foo
;;
;; Inconsistent:
;;   `()
;;   foo
;;
;; (But font lock is on the open paren, not the backtick)
;;
;; Similarly, ,@() is off by two

;; TODO: Algorithm doesn't account for:
;;
;; (abc
;;   (def))
;;  (ghi)
;;
;; (abc ...) are inconsistent parens because (ghi) is indented too far

;; TODO: How to handle:
;;
;; (abc a-symbol (a-func-call "word_a
;; word_b" (def ghi
;;         jkl)
;;
;; (abc a-symbol (a-func-call "word_a
;; word_b" (def)
;;                            jkl))
;;
;; And the inputted region is only the jkl lines.
;;
;; Probably doesn't matter significantly, as long as it's consistent
;; regardless of how JIT inputs the regions.

;; An open paren and algorithmic data about it. Instances are placed
;; on a stack as this packages parses a buffer region.
;;
;; position is the position in the buffer of the open paren
;;
;; column is the displayed column of the open paren in its logical
;; line of the buffer
;;
;; inconsistent is whether the open paren's close paren is inconsistent
;; with the indentation within the list defined by the parens.
;;
;;   nil means unknown
;;
;;   t means inconsistent
;;
;; NB: There's no value for "consistent" because once it is known, the
;; struct instance is popped and no longer used.
(cl-defstruct color-parens--Open position column inconsistent)

(defsubst color-parens--colorize (positions face-arg)
  "Colorize chars in the buffer to the specified FACE-ARG with
Font Lock.

POSITIONS is a list of positions in the buffer to colorize."
  (with-silent-modifications
    (mapc (lambda (pos-i)
            (add-text-properties pos-i
                                 (1+ pos-i)
                                 `(font-lock-face
                                   ,face-arg
                                   rear-nonsticky
                                   t)))
          positions)))

(defsubst color-parens--decolorize (positions)
  "Decolorize chars in the buffer colored with Font Lock.

POSITIONS is a list of positions in the buffer to colorize."
  (with-silent-modifications
    (mapc (lambda (pos-i)
            (remove-text-properties pos-i
                                    (1+ pos-i)
                                    '(font-lock-face
                                      nil
                                      rear-nonsticky
                                      nil)))
          positions)))

(defsubst color-parens--update-inconsistency-colors (inconsistentp
                                                     open-paren
                                                     close-paren)
  "Update inconsistency Font Lock colors for OPEN-PAREN and
CLOSE-PAREN as buffer positions based on INCONSISTENTP."
  (if inconsistentp
      (color-parens--colorize (list open-paren close-paren)
                              'color-parens-inconsistent)
    (color-parens--decolorize (list open-paren close-paren))))

(defun color-parens-propertize-region (start end)
  (message "Starting start=%s end=%s" start end)
  (save-excursion
    (goto-char start)
    (beginning-of-line)
    (let (;; Push at open parens, pop at close parens
          (paren-stack)
          (parse-state (syntax-ppss)))
      (while (< (point) end)
        (let ((line-start (point))
              ;; Column at which text starts on the line, except if
              ;; inside a string. Text doesn't start in a comment,
              ;; since ; is text.
              (text-column (progn (back-to-indentation)
                                  (current-column)))
              (line-end (save-excursion (end-of-line)
                                        (point))))
          ;; Skip whitespace only lines
          (unless (eq (point) line-end)
            (unless (nth 3 parse-state) ; Whether inside string
              ;; Mark open parens on the paren-stack that become
              ;; inconsistent because of the current line.
              (let ((open-i paren-stack))
                ;; If one considers only the inconsistent==nil Opens on
                ;; the paren-stack, their columns are strictly
                ;; decreasing moving down the stack (towards the tail).
                ;; Since we're only interested in marking Opens
                ;; inconsistent, that allows the iteration to stop at
                ;; the first inconsistent=nil Open with small enough
                ;; column.
                (while (and open-i
                            (or (<= text-column
                                    (color-parens--Open-column (car open-i)))
                                (color-parens--Open-inconsistent (car open-i))))
                  (setf (color-parens--Open-inconsistent (car open-i))
                        t)
                  (setq open-i (cdr open-i)))))
            ;; Note: point is at indentation
            (while (and (< (point) line-end))
              (let ((depth-change
                     (- (car parse-state)
                        (car (setq parse-state
                                   ;; TODO: Will it perform better not
                                   ;; parsing 1 char at a time?
                                   (parse-partial-sexp (point)
                                                       (1+ (point))
                                                       nil
                                                       nil
                                                       parse-state))))))
                (cond
                 ((or (= 0 depth-change)   ; Didn't cross a paren
                      (nth 3 parse-state)  ; Inside a string
                      (nth 4 parse-state)) ; Inside a comment
                  nil) ; Keep parsing
                 ;; Case: stopped at open paren
                 ((< depth-change 0)
                  ;; Push
                  (setq paren-stack
                        (cons (make-color-parens--Open :position (1- (point))
                                                       :column text-column)
                              paren-stack))
                  (message "Pushed: %s" (car paren-stack)))
                 ;; Case: stopped at close paren
                 ((< 0 depth-change)
                  (if paren-stack
                      (progn
                        (color-parens--update-inconsistency-colors
                         (color-parens--Open-inconsistent (car paren-stack))
                         (color-parens--Open-position (car paren-stack))
                         (1- (point)))
                        ;; Pop
                        (message "Popping: %s" (car paren-stack))
                        (setq paren-stack
                              (cdr paren-stack)))
                    ;; TODO: Handle close paren when nil paren-stack
                    ))))))
          ;; Go forward to beginning of next line, keeping parse-state
          ;; up to date
          (unless (eobp)
            (setq parse-state
                  (parse-partial-sexp (point)
                                      (1+ (point))
                                      nil
                                      nil
                                      parse-state))))))))

(defun color-parens-unpropertize-region (start end)
  ;; TODO: remove-text-properties
  )

(defun color-parens-extend-region ()
  "Extend region for JIT lock to fontify."
  (message "DEBUG: Start color-parens-extend-region font-lock-beg=%s font-lock-end=%s" font-lock-beg font-lock-end) 
  (save-excursion
    (let ((top-level (syntax-ppss-toplevel-pos (syntax-ppss font-lock-beg))))
      (when top-level
        (setq font-lock-beg (min font-lock-beg top-level))
        (goto-char top-level)
        (setq font-lock-end (max font-lock-end
                                (or (scan-lists (point) 1 0)
                                    (point-max)))))))
  (message "color-parens-extend-region font-lock-beg=%s font-lock-end=%s" font-lock-beg font-lock-end))

(define-minor-mode color-parens-mode
  "Color unbalanced parentheses and parentheses inconsistent with
  indentation."
  nil nil nil
  (if color-parens-mode
      (progn
        (jit-lock-register 'color-parens-propertize-region t)
        (add-hook 'font-lock-extend-region-functions
                  'color-parens-extend-region
                  nil
                  t))
    (jit-lock-unregister 'color-parens-propertize-region)
    (color-parens-unpropertize-region (point-min) (point-max))))

(provide 'color-parens)

;;; color-parens.el ends here

[-- Attachment #3: thread-test-binding.el --]
[-- Type: text/x-emacs-lisp, Size: 600 bytes --]

;; This buffer is for notes you don't want to save, and for Lisp evaluation.
;; If you want to create a file, visit that file with C-x C-f,
;; then enter the text in that file's own buffer.

   (setq debug-on-error t)
   (defvar threads-test-binding nil)

   (defun threads-test-thread2 ()
     (let ((threads-test-binding 23))
   (thread-yield))
     (setq threads-test-global 23))

   (progn
     (setq threads-test-global nil)
     (make-thread #'threads-test-thread2)
     (while (not threads-test-global)
   (thread-yield))
     (and (not threads-test-binding)
          threads-test-global))

Re: Fontifying outside of region passed to registered JIT lock function

[Stefan Monnier]

> To explain what I'm doing in simpler terms, suppose you have:

>    (a b
>       c
>       d)

> The close paren is where the indentation would imply, so there's no
> coloring of parens.

> Suppose you edit the code so as it is now:

>    (a b
>    c
>       d)

Right, indeed, jit-lock will probably only refresh the single line that
holds "c".  I see two ways to deal with it:
1- do add the face on the text before the beginning of the region.
   The problem there, is to make sure this face is kept up-to-date later
   on (e.g. removed if you add revert to the previous indentation).
   For that you'll want to add a jit-lock-multiline text-property.
2- Change your highlighting scheme so that the face is placed somewhere
   inside the region.  E.g. highlight the space before "c" instead of
   the open paren: highlighting always the parens makes it sound like
   you assume the indentation is right, whereas the error may
   be in the indentation.  So we can highlight either of them.


-- Stefan

Re: Fontifying outside of region passed to registered JIT lock function

[Barry OReilly]

[-- Attachment #1: Type: text/plain, Size: 743 bytes --]

Thank you for your help and ideas.

> 2- Change your highlighting scheme so that the face is placed
>    somewhere inside the region.  E.g. highlight the space before "c"
>    instead of the open paren: highlighting always the parens makes
>    it sound like you assume the indentation is right, whereas the
>    error may be in the indentation.  So we can highlight either of
>    them.

I considered that, and I'm not against either highlighting parens or
the indentation. I chose to hack the former case because I couldn't
think of a pleasing way to highlight the indentation. For example:
what to highlight when c is against the left margin? Is there a way to
put something visual in between characters? Like a colored dot or
little line?

[-- Attachment #2: Type: text/html, Size: 857 bytes --]

Re: Fontifying outside of region passed to registered JIT lock function

[Stefan Monnier]

> I considered that, and I'm not against either highlighting parens or
> the indentation. I chose to hack the former case because I couldn't
> think of a pleasing way to highlight the indentation. For example:
> what to highlight when c is against the left margin?

Actually, just after sending the other message I thought of this exact
problem and figured that maybe a way to do that is not to highlight the
indentation, but to insert a "display only" close-paren (with suitable
coloring).

> Is there a way to put something visual in between characters? Like
> a colored dot or little line?

You can insert display-only text via the after-string or
before-string property of overlays.


        Stefan