Skip to content

Commit

Permalink
Improve multiline highlighting via font-lock-syntactic-keywords
Browse files Browse the repository at this point in the history 
This improvement means that:
- there's no delay before multiline literals are recognized
- fontification can be controlled in detail via font-lock setup
- syntactic properties are always as up-to-date as possible

Basically, it's the same refactoring as in dbedb1e, but backported to
support Emacs23.  Emacs24 version is faster though, because font-lock
updates buffer line-by-line while `syntax-propertize' does that in
blocks of 500 characters.
  • Loading branch information
@immerrr
immerrr committed Mar 19, 2013
1 parent ff3f5e1 commit 2a0314b
Showing 1 changed file with 88 additions and 191 deletions.
279 changes: 88 additions & 191 deletions lua-mode.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -252,8 +252,7 @@ Should be a list of strings."
(mapc (lambda (key_defn)
(define-key result-map (read-kbd-macro (car key_defn)) (cdr key_defn)))
'(("C-l" . lua-send-buffer)
("C-f" . lua-search-documentation)
("C-;" . lua-mark-all-multiline-literals)))
("C-f" . lua-search-documentation)))
result-map))
"Keymap that is used to define keys accessible by `lua-prefix-key'.
Expand Down Expand Up @@ -660,12 +659,16 @@ Groups 6-9 can be used in any of argument regexps."
(set (make-local-variable 'comment-start) lua-comment-start)
(set (make-local-variable 'comment-start-skip) lua-comment-start-skip)
(set (make-local-variable 'font-lock-defaults)
'(lua-font-lock-keywords
nil
nil
'(lua-font-lock-keywords ;; keywords
nil ;; keywords-only
nil ;; case-fold
;; Not sure, why '_' is a word constituent only when font-locking.
;; --immerrr
((?_ . "w"))))
((?_ . "w")) ;; syntax-alist
nil ;; syntax-begin
(font-lock-syntactic-keywords . lua-font-lock-syntactic-keywords)
(font-lock-extra-managed-props . (syntax-table))))

(set (make-local-variable 'imenu-generic-expression)
lua-imenu-generic-expression)
(make-local-variable 'lua-default-eval)
Expand All @@ -691,9 +694,8 @@ Groups 6-9 can be used in any of argument regexps."
,(regexp-opt (mapcar 'cdr lua-sexp-alist) 'words) ;end
nil lua-forward-sexp)))

(set (make-local-variable 'parse-sexp-lookup-properties) t)
(lua-mark-all-multiline-literals)
(lua--automark-multiline-update-timer)))
(set (make-local-variable 'parse-sexp-lookup-properties) t)))


;;;###autoload
(add-to-list 'auto-mode-alist '("\\.lua$" . lua-mode))
Expand Down Expand Up @@ -751,12 +753,77 @@ If point is not inside a comment, return nil."
(save-excursion (let ((parse-result (syntax-ppss pos)))
(or (elt parse-result 3) (elt parse-result 4)))))

(defun lua-comment-or-string-start (&optional pos)
(defun lua-comment-or-string-start-pos (&optional pos)
"Returns start position of string or comment which contains point.
If point is not inside string or comment, return nil."
(save-excursion (elt (syntax-ppss pos) 8)))

;; They're propertized as follows:
;; 1. generic-comment
;; 2. generic-string
;; 3. equals signs
(defconst lua-ml-begin-regexp
"\\(?:\\(?1:-\\)-\\[\\|\\(?2:\\[\\)\\)\\(?3:=*\\)\\[")


(defun lua-try-match-multiline-end (end)
"Try to match close-bracket for multiline literal around point.
Basically, detect form of close bracket from syntactic
information provided at point and re-search-forward to it."
(let ((comment-or-string-start-pos (lua-comment-or-string-start-pos)))
;; Is there a literal around point?
(and comment-or-string-start-pos
;; It is, check if the literal is a multiline open-bracket
(save-excursion
(goto-char comment-or-string-start-pos)
(looking-at lua-ml-begin-regexp))

;; Yes it is, look for it matching close-bracket. Close-bracket's
;; match group is determined by match-group of open-bracket.
(re-search-forward
(format "]%s\\(?%s:]\\)"
(match-string-no-properties 3)
(if (match-beginning 1) 1 2))
end 'noerror))))


(defun lua-try-match-multiline-begin (limit)
"Try to match multiline open-brackets.
Find next opening long bracket outside of any string/comment.
If none can be found before reaching LIMIT, return nil."

(let (last-search-matched)
(while
;; This loop will iterate skipping all multiline-begin tokens that are
;; inside strings or comments ending either at EOL or at valid token.
(and (setq last-search-matched
(re-search-forward lua-ml-begin-regexp limit 'noerror))

;; (1+ (match-beginning 0)) is required to handle triple-hyphen
;; '---[[' situation: regexp matches starting from the second one,
;; but it's not yet a comment, because it's a part of 2-character
;; comment-start sequence, so if we try to detect if the opener is
;; inside a comment from the second hyphen, it'll fail. But the
;; third one _is_ inside a comment and considering it instead will
;; fix the issue. --immerrr
(lua-comment-or-string-start-pos (1+ (match-beginning 0)))))

last-search-matched))

(defun lua-match-multiline-literal-bounds (limit)
;; First, close any multiline literal spanning from previous block. This will
;; move the point accordingly so as to avoid double traversal.
(or (lua-try-match-multiline-end limit)
(lua-try-match-multiline-begin limit)))

(defvar lua-font-lock-syntactic-keywords
'((lua-match-multiline-literal-bounds
(1 "!" nil noerror)
(2 "|" nil noerror))))

(defun lua-indent-line ()
"Indent current line for Lua mode.
Return the amount the indentation changed by."
Expand Down Expand Up @@ -785,21 +852,17 @@ Return the amount the indentation changed by."
(if (and (lua-string-p) (not lua-indent-string-contents))
;; if inside string and strings aren't to be indented, return current indentation
(current-indentation)
;; Otherwise, indent as a comment
(save-excursion
(cond
;; If it is the end of a multi-line comment, simply mirror the opening
;; line's indent.
((looking-at "\\s *\\(?:--\\)?\\]\\(?1:=*\\)\\]")
(re-search-backward (format "\\[%s\\["
(or (match-string-no-properties 1) ""))
(lua-get-multiline-start)
'noerror)
(current-indentation))
;; otherwise indent by lua-indent-level relative to the line where literal starts
(t
(goto-char (lua-get-multiline-start))
(+ (current-indentation) lua-indent-level))))))

;; At this point, we know that we're inside comment, so make sure
;; close-bracket is unindented like a block that starts after
;; left-shifter.
(let ((left-shifter-p (looking-at "\\s *\\(?:--\\)?\\]\\(?1:=*\\)\\]")))
(save-excursion
(goto-char (lua-comment-or-string-start-pos))
(+ (current-indentation)
(if left-shifter-p
0
lua-indent-level))))))

(defun lua-find-regexp (direction regexp &optional limit ignore-p)
"Searches for a regular expression in the direction specified.
Expand Down Expand Up @@ -1714,172 +1777,6 @@ left out."
(define-key lua-mode-menu [search-documentation]
'("Search Documentation" . lua-search-documentation))

(defsubst lua-put-char-property (pos property value &optional object)
(lua--with-silent-modifications

(if value
(put-text-property pos (1+ pos) property value object)
(remove-text-properties pos (1+ pos) (list property nil))))

;; `lua--with-silent-modifications' inhibits modification hooks, one of which
;; is the hook that keeps `syntax-ppss' internal cache up-to-date. If this
;; isn't done, the results of subsequent calls to `syntax-ppss' are
;; invalid. To avoid such cache discrepancy, the hook must be run manually.
(syntax-ppss-flush-cache pos))

(defsubst lua-put-char-syntax-table (pos value &optional object)
(lua-put-char-property pos 'syntax-table value object))

(defsubst lua-get-multiline-delim-syntax (type)
(cond ((eq type 'string) '(15))
((eq type 'comment) '(14))
(nil)))

(defun lua-mark-char-multiline-delim (pos type)
"Mark character as a delimiter of Lua multiline construct
If TYPE is string, mark char as string delimiter. If TYPE is comment,
mark char as comment delimiter. Otherwise, remove the mark if any."
(lua-put-char-syntax-table pos (lua-get-multiline-delim-syntax type)))

(defsubst lua-inside-multiline-p (&optional pos)
(let ((status (syntax-ppss pos)))
(or (eq (elt status 3) t) ;; inside generic string
(eq (elt status 7) 'syntax-table)))) ;; inside generic comment

(defun lua-get-multiline-start (&optional pos)
(interactive)
(when (lua-inside-multiline-p pos) ;; return string/comment start
(elt (syntax-ppss pos) 8)))

(defun lua-unmark-multiline-literals (&optional begin end)
"Clears all Lua multiline construct markers in region
If BEGIN is nil, start from `beginning-of-buffer'.
If END is nil, stop at `end-of-buffer'."
(interactive)

(setq begin (or begin (point-min))
end (or end (point-max)))

(lua--with-silent-modifications
(remove-text-properties begin end '(syntax-table ())))

;; `lua--with-silent-modifications' inhibits modification hooks, one of which
;; is the hook that keeps `syntax-ppss' internal cache up-to-date. If this
;; isn't done, the results of subsequent calls to `syntax-ppss' are
;; invalid. To avoid such cache discrepancy, the hook must be run manually.
(syntax-ppss-flush-cache begin)

(font-lock-fontify-buffer))

(defun lua-mark-multiline-region (begin end)
(let ((type (if (eq ?- (char-after begin)) 'comment 'string)))
(lua-mark-char-multiline-delim begin type)
(when end
(lua-mark-char-multiline-delim (1- end) type))))

(defun lua-mark-all-multiline-literals (&optional begin end)
"Marks all Lua multiline constructs in region
If BEGIN is nil, start from `beginning-of-buffer'.
If END is nil, stop at `end-of-buffer'."
(interactive)

(if (and (lua--called-interactively-p 'any) (use-region-p))
(setq begin (region-beginning)
end (region-end)))

(lua-unmark-multiline-literals begin end)
(save-excursion
(goto-char (or begin (point-min)))

(while (and
;; must check for point range, because matching previous
;; multiline end might move point beyond end and this
;; drives `re-search-forward' crazy
(if end (< (point) end) t)
;; look for
;; 1. (optional) two or more dashes followed by
;; 2. lua multiline delimiter [[
(re-search-forward "\\(?2:--\\)?\\[\\(?1:=*\\)\\[" end 'noerror))
;; match-start + 1 is considered instead of match-start, because
;; such approach handles '---[[' situation correctly: Emacs
;; thinks 2nd dash (i.e. match-start) is not yet a comment, but
;; the third one is, hence the +1. In all the other situations,
;; '+1' is safe to use because it bears the same syntactic
;; properties, i.e. if match-start is inside string-or-comment,
;; then '+1' is too and vice versa.
;;
;; PS. ping me if you find a situation in which this is not true
(unless (lua-comment-or-string-p (1+ (match-beginning 0)))
(let (ml-begin ml-end)
(setq ml-begin (match-beginning 0))
(when (re-search-forward (format "\\]%s\\]" (or (match-string 1) "")) nil 'noerror)
;; (message "found match %s" (match-string 0))
(setq ml-end (match-end 0)))
(lua-mark-multiline-region ml-begin ml-end))))))

(defvar lua-automark-multiline-timer nil
"Contains idle-timer object used for automatical multiline literal markup which must be cleaned up on exit.")
(make-variable-buffer-local 'lua-automark-multiline-timer)

(defvar lua-automark-multiline-start-pos nil
"Contains position from which automark procedure should start.
Automarking shall start at the point before which no modification has been
made since last automark. Additionally, if such point is inside string or
comment, rewind start position to its beginning.
nil means automark is unnecessary because there were no updates.")
(make-variable-buffer-local 'lua-automark-multiline-start-pos)

(defun lua--automark-update-start-pos (change-begin change-end old-len)
"Updates `lua-automark-multiline-start-pos' upon buffer modification."
(save-excursion
(goto-char change-begin)
(beginning-of-line)
(setq lua-automark-multiline-start-pos
(or (lua-comment-or-string-start) (point)))))

(defun lua--automark-multiline-update-timer ()
(lua--automark-multiline-cleanup) ;; reset previous timer if it existed
(when lua-automark-multiline-interval
(add-hook 'change-major-mode-hook 'lua--automark-multiline-cleanup nil 'local)
(add-hook 'after-change-functions 'lua--automark-update-start-pos nil 'local)
(setq lua-automark-multiline-timer
(run-with-idle-timer lua-automark-multiline-interval 'repeat
'lua--automark-multiline-run))))

(defun lua--automark-multiline-cleanup ()
"Disable automatical multiline construct marking"
(unless (null lua-automark-multiline-timer)
(cancel-timer lua-automark-multiline-timer)
(setq lua-automark-multiline-timer nil)))

(defun lua--automark-multiline-run ()
(when (<= (buffer-size) lua-automark-multiline-maxsize)
(when lua-automark-multiline-start-pos
(lua-mark-all-multiline-literals lua-automark-multiline-start-pos)
(setq lua-automark-multiline-start-pos nil))))

(defun lua--customize-set-automark-multiline-interval (symbol value)
(set symbol value)
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (eq major-mode 'lua-mode)
(lua--automark-multiline-update-timer)))))

(defcustom lua-automark-multiline-interval 1
"If not 0, specifies idle time in seconds after which lua-mode will mark multiline literals."
:group 'lua
:type 'integer
:set 'lua--customize-set-automark-multiline-interval)

(defcustom lua-automark-multiline-maxsize 100000
"Maximum buffer size for which lua-mode will mark multiline literals automatically."
:group 'lua
:type 'integer)

(provide 'lua-mode)

Expand Down

0 comments on commit 2a0314b

Please sign in to comment.