On multi-line font lock

On multi-line font lock

[Mark Oteiza]

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


Hi,

I'm writing to ask about correct use of font-lock-multiline and
font-lock-extend-* hooks, and possibly for a working example if possible.

I was writing a mode for mailcap files and was struggling to write
working elisp for handling multi-line constructs.  In mailcap, comments
begin with a # at BOL, and lines can be broken by a trailing \ in a
non-comment line:

  application/foobar; baz; copiousoutput; \
  # not a comment \
  # a comment

I discovered an existing mailcap-mode here:
http://user42.tuxfamily.org/mailcap-mode/index.html
which appears to take advantage of jit-lock-contextually.  I also
managed to figure out syntax-propertize to a degree, with the help of
some blog examples.

However, I'm not fond of jit-lock's delay (which is
configurable, but defaults are defaults are defaults), so I tried to get
the non-jit-lock option to work.  The attached
package somehow appears to be a working example of using
font-lock-extend-region-functions.

I'm puzzled because the function I've added to the hook always returns a
truthy value AFAICT, and the documentation suggests the hook is run
until all of its items return nil.

What is the correct way to use font-lock-extend-foo hooks?

Please Cc:, thanks.


[-- Attachment #2: mailcap-mode package --]
[-- Type: application/emacs-lisp, Size: 6991 bytes --]

Re: On multi-line font lock

[Stefan Monnier]

>   application/foobar; baz; copiousoutput; \
>   # not a comment \
>   # a comment

> I discovered an existing mailcap-mode here:
> http://user42.tuxfamily.org/mailcap-mode/index.html
> which appears to take advantage of jit-lock-contextually.  I also
> managed to figure out syntax-propertize to a degree, with the help of
> some blog examples.

> However, I'm not fond of jit-lock's delay (which is
> configurable, but defaults are defaults are defaults), so I tried to get
> the non-jit-lock option to work.  The attached
> package somehow appears to be a working example of using
> font-lock-extend-region-functions.

font-lock is the wrong tool for this, since it's in charge of changing
the appearance of what's displayed and makes no effort to pay attention
to any part of the buffer that's not displayed.  But in your case you
care about "what is a comment and what isn't", which has effects beyond
appearance (e.g. it influences navigation commands).  So the only right
way to do this is with syntax-propertize-function (or equivalent).

You can still use font-lock-extend-region-functions in order to avoid
jit-lock's delay, of course.

> I'm puzzled because the function I've added to the hook always returns a
> truthy value AFAICT, and the documentation suggests the hook is run
> until all of its items return nil.

The code assumes that a function on that hook takes care of its own work.
So the non-nil value only causes *other* functions to be run.  If one of
those other functions returns non-nil, then we'll re-run yours.


        Stefan

Re: On multi-line font lock

[Mark Oteiza]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> However, I'm not fond of jit-lock's delay (which is
>> configurable, but defaults are defaults are defaults), so I tried to get
>> the non-jit-lock option to work.  The attached
>> package somehow appears to be a working example of using
>> font-lock-extend-region-functions.
>
> font-lock is the wrong tool for this, since it's in charge of changing
> the appearance of what's displayed and makes no effort to pay attention
> to any part of the buffer that's not displayed.  But in your case you
> care about "what is a comment and what isn't", which has effects beyond
> appearance (e.g. it influences navigation commands).  So the only right
> way to do this is with syntax-propertize-function (or equivalent).
>
> You can still use font-lock-extend-region-functions in order to avoid
> jit-lock's delay, of course.

Thank you for the guidance--I think I now have a solid major mode.

>> I'm puzzled because the function I've added to the hook always returns a
>> truthy value AFAICT, and the documentation suggests the hook is run
>> until all of its items return nil.
>
> The code assumes that a function on that hook takes care of its own work.
> So the non-nil value only causes *other* functions to be run.  If one of
> those other functions returns non-nil, then we'll re-run yours.

I see.  I feel that's not really explained in the docs, but I also
haven't yet looked at the source.  I get the idea that I could also use
syntax rules to apply the font-lock-multiline property, so I'll try that
as well.

;;; mailcap-mode.el --- Major mode for editing mailcap files -*- lexical-binding: t -*-

;; Copyright (C) 2017  Mark Oteiza <mvoteiza@udel.edu>

;; Author: Mark Oteiza <mvoteiza@udel.edu>
;; Created: 02 September 2017
;; Keywords: wp, mail, multimedia

;; 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:

;; Major mode for editing mailcap files.

;; https://tools.ietf.org/html/rfc1524
;; https://tools.ietf.org/html/rfc1521
;; https://www.iana.org/assignments/media-types/media-types.xhtml
;; https://www.ch.ic.ac.uk/chemime/

;;; Code:

(require 'conf-mode)

(declare-function company-begin-backend "company")
(declare-function company-grab-symbol "company")
(declare-function mailcap-mime-types "mailcap")

(defvar font-lock-beg)
(defvar font-lock-end)

(eval-and-compile
  (defconst mailcap-field-names
    '("compose" "composetyped" "edit" "print" "test" "needsterminal"
      "copiousoutput" "description" "textualnewlines" "x11-bitmap"
      "nametemplate")
    "List of optional field names."))

(defun mailcap-entry-start-p ()
  "Return non-nil if the current line is the first in a mailcap entry."
  (let ((flag t))
    (save-excursion
      (while (and (zerop (forward-line -1))
                  (save-excursion
                    (goto-char (line-end-position))
                    (eq (preceding-char) ?\\))
                  (skip-chars-forward " \t")
                  (setq flag (eq (following-char) ?#)))))
    flag))

(defun mailcap-completion-table (string)
  (cond
   ((and (mailcap-entry-start-p)
         (= (- (point) (line-beginning-position)) (length string)))
    (require 'mailcap)
    (mailcap-mime-types))
   ((save-excursion
      (re-search-backward "[^\\];" (line-beginning-position) t 2))
    mailcap-field-names)))

(defun mailcap-complete-at-point ()
  "Complete the symbol at point"
  (let ((bounds (bounds-of-thing-at-point 'symbol)))
    (list (or (car bounds) (point))
          (or (cdr bounds) (point))
          (completion-table-dynamic #'mailcap-completion-table))))

(defun mailcap-company-backend (command &optional arg &rest ignored)
  "Backend for `company-mode' in `mailcap-mode' buffers."
  (interactive (list 'interactive))
  (pcase command
    (`interactive (company-begin-backend 'mailcap-company-backend))
    (`prefix (and (eq major-mode 'mailcap-mode) (company-grab-symbol)))
    (`candidates (all-completions arg (mailcap-completion-table arg)))))

\f
;; Syntax

(defun mailcap-syntax-propertize (start end)
  "`syntax-propertize-function' for `mailcap-mode' buffers."
  (let ((case-fold-search nil))
    (goto-char start)
    (funcall
     (syntax-propertize-rules
      ("^#$?" (0 (when (mailcap-entry-start-p) (string-to-syntax "<")))))
     start end)))

\f
;; Font-lock

(defun mailcap-typefield-anchored-matcher (limit)
  "Matcher for the MIME type form TYPE/SUBTYPE according to RFC1521."
  (let ((pos (car (match-data)))
        (token "[:alnum:]!#$%&'*+-.^_`{|}~")
        res)
    (when (and (mailcap-entry-start-p)
               (< 0 (skip-chars-forward token limit))
               (= (following-char) ?\/))
      (forward-char 1)
      (when (and (< 0 (skip-chars-forward token limit))
                 (skip-chars-forward " \t" limit)
                 (= (following-char) ?\;))
        (prog1 (setq res (list pos (point-marker)))
          (set-match-data res))))))

(defun mailcap-limit-field ()
  "Pre-matcher for `mailcap-field-anchored-matcher'."
  (when (not (eolp))
    (let ((limit (line-end-position)))
      (save-excursion
        (save-match-data
          (when (search-forward ";" limit t 1)
            (point)))))))

(defun mailcap-field-anchored-matcher (limit)
  "Matcher for the optional field names in the form FIELD[=ARG].
See https://tools.ietf.org/html/rfc1524 for details."
  (let ((fields (eval-when-compile
                  (regexp-opt mailcap-field-names 'symbols)))
        res)
    (let ((case-fold-search t))
      (setq res (re-search-forward fields limit t 1)))
    (when (null res)
      (re-search-forward "x-[[:alnum:]!#$%&'*+-.^_`{|}~]+" limit t 1))
    (when res
      (prog1 (setq res (list (car (match-data)) (point-marker)))
        (set-match-data res)))))

\f
;; Multi-line

(defun mailcap-entry-start-index ()
  "Return a negative number of lines to the start of a multi-line construct."
  (let ((count 0))
    (save-excursion
      (while (and (zerop (forward-line -1))
                  (save-excursion
                    (goto-char (line-end-position))
                    (eq (preceding-char) ?\\))
                  (skip-chars-forward " \t")
                  (/= (following-char) ?#))
        (cl-decf count)))
    count))

(defun mailcap-entry-end-index ()
  "Return a positive number of lines to the end of a multi-line construct."
  (let ((count 0))
    (save-excursion
      (while (and (save-excursion
                    (goto-char (line-end-position))
                    (eq (preceding-char) ?\\))
                  (skip-chars-forward " \t")
                  (/= (following-char) ?#)
                  (zerop (forward-line)))
        (cl-incf count)))
    count))

(defun mailcap-font-lock-extend-region ()
  (goto-char font-lock-beg)
  (forward-line (mailcap-entry-start-index))
  (setq font-lock-beg (point-marker))
  (goto-char font-lock-end)
  (forward-line (mailcap-entry-end-index))
  (setq font-lock-end (line-end-position)))

\f
;; Major mode support

(defvar mailcap-mode-syntax-table
  (let ((table (make-syntax-table)))
    (modify-syntax-entry ?\\ "/" table)
    (modify-syntax-entry ?% "'" table)
    (modify-syntax-entry ?\; "." table)
    table)
  "Syntax table used in `mailcap-mode' buffers.")

(defconst mailcap-font-lock-keywords-1
  '(("^[aAcCfFeEiImMtTvV]"
     (mailcap-typefield-anchored-matcher nil nil (0 'font-lock-keyword-face))))
  "Minimal keywords to highlight in `mailcap-mode'.")

(defconst mailcap-font-lock-keywords-2
  `(,@mailcap-font-lock-keywords-1
    ("\\\\$" 0 'font-lock-warning-face) ; line break
    ("%{\\(?:boundary\\|charset\\|media-type\\)}"
     0 'font-lock-variable-name-face)
    ("%[stFn]" 0 'font-lock-constant-face)
    (";[ \t]*?"
     (mailcap-field-anchored-matcher
      (mailcap-limit-field) nil (0 'font-lock-builtin-face))))
  "Accurate normal keywords to highlight in `mailcap-mode'.")

(defvar mailcap-font-lock-keywords 'mailcap-font-lock-keywords-1
  "Default expressions to highlight in `mailcap-mode'.")

;;;###autoload (add-to-list 'auto-mode-alist '("\\.mailcap\\'" . mailcap-mode))

(define-derived-mode mailcap-mode conf-mode "Mailcap"
  "Major mode for editing mailcap files."
  (set-keymap-parent mailcap-mode-map nil)
  (conf-mode-initialize "#")
  (setq-local comment-style 'plain)
  (add-hook 'company-backends #'mailcap-company-backend)
  (add-hook 'completion-at-point-functions #'mailcap-complete-at-point nil t)
  (add-hook 'font-lock-extend-region-functions
            'mailcap-font-lock-extend-region nil t)
  (setq-local syntax-propertize-function #'mailcap-syntax-propertize)
  (setq font-lock-defaults
        '((mailcap-font-lock-keywords
           mailcap-font-lock-keywords-1 mailcap-font-lock-keywords-2))))

(provide 'mailcap-mode)

;;; mailcap-mode.el ends here

Re: On multi-line font lock

[Stefan Monnier]

> I see.  I feel that's not really explained in the docs, but I also
> haven't yet looked at the source.

I don't think code should rely on this anyway.

> I get the idea that I could also use syntax rules to apply the
> font-lock-multiline property, so I'll try that as well.

Yes, it's probably easier.  This said, the jit-lock delay is not
something specific to mailcap syntax: it's just a preference of yours
and it probably applies to all major modes.  So a better fix for this
would be to work on jit-lock to offer an option for
jit-lock-contextually to be instantaneous.


        Stefan