Re: On multi-line font lock

[Mark Oteiza <mvoteiza@udel.edu>]

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