Skip to content

Commit

Permalink
Work with highlight-indent-guides-mode; fixes #669
Browse files Browse the repository at this point in the history
Don't set hooks or functions that depend on racket--hash-lang-id until
the back end responds that it has created the hash-lang object with
that id. (Previously we believed disabling font-lock-mode was a
reliable guard, but it's not.)

Just set buffer-read-only instead of using read-only-mode, which also
enables view-mode (although that wasn't causing a problem AFAIK, it
was doing more than we needed).

Instead of font-lock-fontify-region-function use a jit-lock-register
function. Although we don't use font-lock-keywords, a minor mode
might; let that work.
  • Loading branch information
greghendershott committed Nov 12, 2023
1 parent 1069f26 commit e8a7e90
Showing 1 changed file with 117 additions and 103 deletions.
220 changes: 117 additions & 103 deletions racket-hash-lang.el
Original file line number Diff line number Diff line change
Expand Up @@ -109,6 +109,24 @@ plainer `electric-pair-mode'.
#+END_SRC
")

(defvar-local racket--hash-lang-id nil
"Unique integer used to identify the back end hash-lang object.
Although it's tempting to use `buffer-file-name' for the ID, not
all buffers have files. Although it's tempting to use
`buffer-name', buffers can be renamed. Although it's tempting to
use the buffer object, we can't serialize that.")
(defvar racket--hash-lang-next-id 0
"Increment when we need a new id.")

(defvar-local racket--hash-lang-generation 1
"Monotonic increasing value for hash-lang updates.
This is set to 1 when we hash-lang create, incremented every time
we do a hash-lang update, and then supplied for all other, query
hash-lang operations. That way the queries can block if necessary
until the back end has handled the update commands and also
re-tokenization has progressed sufficiently.")

;;;###autoload
(define-derived-mode racket-hash-lang-mode prog-mode
"#lang"
Expand Down Expand Up @@ -142,95 +160,81 @@ can contribute more colors; see the customization variable
nil t)
(set-syntax-table racket--plain-syntax-table)
(setq-local font-lock-defaults nil)
(setq-local font-lock-fontify-region-function
#'racket--hash-lang-font-lock-fontify-region)
(font-lock-set-defaults) ;issue #642
(setq-local syntax-propertize-function nil)
(setq-local text-property-default-nonsticky
(append
(racket--hash-lang-text-prop-list #'cons t)
text-property-default-nonsticky))
(add-hook 'after-change-functions #'racket--hash-lang-after-change-hook t t)
(add-hook 'kill-buffer-hook #'racket--hash-lang-delete t t)
(add-hook 'change-major-mode-hook #'racket--hash-lang-delete t t)
(electric-indent-local-mode -1)
(setq-local electric-indent-inhibit t)
(setq-local blink-paren-function nil)
(setq-local imenu-create-index-function nil)
(setq-local completion-at-point-functions nil) ;rely on racket-xp-mode
(setq-local eldoc-documentation-function nil)
(setq racket-submodules-at-point-function nil) ;might change in on-new-lang
(racket--hash-lang-create))

(defvar-local racket--hash-lang-id nil
"Unique integer used to identify the back end hash-lang object.
Although it's tempting to use `buffer-file-name' for the ID, not
all buffers have files. Although it's tempting to use
`buffer-name', buffers can be renamed. Although it's tempting to
use the buffer object, we can't serialize that.")
(defvar racket--hash-lang-next-id 0
"Increment when we need a new id.")

(defvar-local racket--hash-lang-generation 1
"Monotonic increasing value for hash-lang updates.
This is set to 1 when we hash-lang create, incremented every time
we do a hash-lang update, and then supplied for all other, query
hash-lang operations. That way the queries can block if necessary
until the back end has handled the update commands and also
re-tokenization has progressed sufficiently.")

;; For use by both racket-hash-lang-mode and racket-repl-mode
(defun racket--hash-lang-create (&optional other-buffer)
(setq-local racket--hash-lang-id (cl-incf racket--hash-lang-next-id))
;; Create back end hash-lang object.
;;
;; On the one hand, `racket--cmd/await' would be simpler to use
;; here. On the other hand, when the back end isn't running, there's
;; a delay for that to start, during which the buffer isn't
;; displayed and Emacs seems frozen. On the third hand, if we use
;; `racket--cmd/async' naively the buffer could try to interact with
;; a back end object that doesn't yet exist, and error.
;;
;; Warm bowl of porridge: Make buffer read-only and use async
;; command to create hash-lang object. Only when the response
;; arrives, i.e. the back end object is ready, enable read/write and
;; set various hook functions that depend on `racket--hash-lang-id'.
;;
;; Also, handle the back end returning nil for the create -- meaning
;; there's no sufficiently new syntax-color-lib -- by downgrading to
;; plain `prog-mode'.
(setq-local racket--hash-lang-id nil) ;until async command response
(setq-local racket--hash-lang-generation 1)
(unless (racket--cmd-open-p)
(setq-local header-line-format "Waiting for back end to start..."))
(setq-local buffer-read-only t)
(racket--cmd/async
nil
`(hash-lang create
,(cl-incf racket--hash-lang-next-id)
,nil
,(buffer-substring-no-properties (point-min) (point-max)))
(lambda (maybe-id)
(setq-local header-line-format nil)
(cond
(maybe-id
(setq-local racket--hash-lang-id maybe-id)
;; These depend on `racket--hash-lang-id':
(jit-lock-register #'racket--hash-lang-jit-lock-function)
(add-hook 'after-change-functions #'racket--hash-lang-after-change-hook t t)
(add-hook 'kill-buffer-hook #'racket--hash-lang-delete t t)
(add-hook 'change-major-mode-hook #'racket--hash-lang-delete t t)
(setq-local buffer-read-only nil))
(t
(prog-mode) ;wipes all local variables including buffer-read-only
(message "hash-lang support not available; needs newer syntax-color-lib"))))) )

(defun racket--hash-lang-create-for-repl (edit-buffer)
(setq-local racket--hash-lang-id nil) ;until async command response
(setq-local racket--hash-lang-generation 1)
(cl-case major-mode
((racket-hash-lang-mode)
(let ((text (save-restriction
(widen)
(buffer-substring-no-properties (point-min) (point-max)))))
;; On the one hand, racket--cmd/await would be simpler to use
;; here. On the other hand, when someone visits a file without the
;; back end running yet, there's a delay for that to start, during
;; which the buffer isn't displayed and Emacs seems frozen. On the
;; third hand, if we use async the buffer could try to interact
;; with a back end object that doesn't yet exist, and error.
;;
;; Warm bowl of porridge: Make buffer read-only and not font-lock.
;; Set a timer to show a message in the header-line after awhile.
;; Send command async. Only when the response arrives, i.e. the
;; back end object is ready, enable read/write and font-lock.
;;
;; Finally, handle the back end returning nil for the create,
;; meaning there's no sufficiently new syntax-color-lib.
(font-lock-mode -1)
(read-only-mode 1)
(unless (racket--cmd-open-p)
(setq-local header-line-format "Waiting for back end to start..."))
(racket--cmd/async
nil
`(hash-lang create ,racket--hash-lang-id ,nil ,text)
(lambda (maybe-id)
(font-lock-mode 1)
(read-only-mode -1)
(setq-local header-line-format nil)
(unless maybe-id
(prog-mode)
(message "hash-lang support not available; needs newer syntax-color-lib"))))))
((racket-repl-mode)
(let ((other-lang-source
(when other-buffer
(with-current-buffer other-buffer
(save-restriction
(widen)
(buffer-substring-no-properties (point-min) (min 4096 (point-max)))))))
(text
(racket--hash-lang-repl-buffer-string (point-min) (point-max))))
(racket--cmd/async
nil
`(hash-lang create ,racket--hash-lang-id ,other-lang-source ,text))))
(otherwise
(error "racket--hash-lang-create doesn't work for %s" major-mode))))
(let ((other-lang-source
(with-current-buffer edit-buffer
(save-restriction
(widen)
(buffer-substring-no-properties (point-min) (min 4096 (point-max))))))
(text
(racket--hash-lang-repl-buffer-string (point-min) (point-max))))
(racket--cmd/async
nil
`(hash-lang create
,(cl-incf racket--hash-lang-next-id)
,other-lang-source
,text)
(lambda (maybe-id)
(when maybe-id
(setq-local racket--hash-lang-id maybe-id))))))

(defun racket--hash-lang-delete ()
(when racket--hash-lang-id
Expand Down Expand Up @@ -309,16 +313,17 @@ live prompt."
;;;(message "racket--hash-lang-after-change-hook %s %s %s" beg end len)
;; This might be called as frequently as once per single changed
;; character.
(racket--cmd/async
nil
`(hash-lang update
,racket--hash-lang-id
,(cl-incf racket--hash-lang-generation)
,beg
,len
,(if (eq major-mode 'racket-repl-mode)
(racket--hash-lang-repl-buffer-string beg end)
(buffer-substring-no-properties beg end)))))
(when racket--hash-lang-id
(racket--cmd/async
nil
`(hash-lang update
,racket--hash-lang-id
,(cl-incf racket--hash-lang-generation)
,beg
,len
,(if (eq major-mode 'racket-repl-mode)
(racket--hash-lang-repl-buffer-string beg end)
(buffer-substring-no-properties beg end))))))

;;; Notifications: Front end <-- back end

Expand Down Expand Up @@ -410,24 +415,29 @@ jit-lock do its thing if/when this span ever becomes visible."

;;; Fontification

(defun racket--hash-lang-font-lock-fontify-region (beg end &optional _loudly)
"Our value for the variable `font-lock-fontify-region-function'.
(defun racket--hash-lang-jit-lock-function (beg end)
"Our value for `jit-lock-register'.
We ask the back end for tokens, and handle its response
asynchronously in `racket--hash-lang-on-tokens' which does the
actual application of faces and syntax. It wouldn't be
appropriate to wait for a response while being called from Emacs
C redisplay engine, as is the case with `jit-lock-mode'."
;;;(message "racket--hash-lang-font-lock-fontify-region %s %s" beg end)
(racket--cmd/async
nil
`(hash-lang get-tokens
,racket--hash-lang-id
,racket--hash-lang-generation
,beg
,end)
#'racket--hash-lang-on-tokens)
`(jit-lock-bounds ,beg . ,end))
C redisplay engine."
;;;(message "racket--hash-lang-jit-lock-function %s %s" beg end)
(when racket--hash-lang-id
(racket--cmd/async nil
`(hash-lang get-tokens
,racket--hash-lang-id
,racket--hash-lang-generation
,beg
,end)
#'racket--hash-lang-on-tokens)))

(defun racket--hash-lang-repl-jit-lock-function (beg end)
(racket--repl-call-with-value-and-input-ranges
beg end
(lambda (beg end v)
(when v (racket--hash-lang-jit-lock-function beg end)))))

(defun racket--hash-lang-on-tokens (tokens)
(save-restriction
Expand Down Expand Up @@ -473,7 +483,7 @@ C redisplay engine, as is the case with `jit-lock-mode'."
(put-face beg end face)))))))))))

(defconst racket--hash-lang-text-properties
'(face syntax-table racket-token)
'(syntax-table racket-token)
"The text properties we use.")

(defun racket--hash-lang-text-prop-list (f val)
Expand Down Expand Up @@ -665,17 +675,21 @@ rhombus\"."
(with-racket-repl-buffer
;; Clean up from previous hash-lang use of REPL, if any
(racket--hash-lang-delete)
(jit-lock-unregister #'racket--hash-lang-repl-jit-lock-function)
;; ------------------------------------------------------------
;; char-syntax
(set-syntax-table (with-current-buffer edit-buffer (syntax-table)))
(setq-local syntax-propertize-function
(with-current-buffer edit-buffer syntax-propertize-function))
;; font-lock
(setq-local font-lock-defaults
(with-current-buffer edit-buffer font-lock-defaults))
(setq-local font-lock-keywords
(with-current-buffer edit-buffer font-lock-keywords))
(setq-local font-lock-fontify-region-function
(racket--repl-limited-fontify-region
(with-current-buffer edit-buffer font-lock-fontify-region-function)))
(font-lock-set-defaults)
(font-lock-flush)
(when hl
(jit-lock-register #'racket--hash-lang-repl-jit-lock-function))
;; indent
(setq-local indent-line-function
(with-current-buffer edit-buffer indent-line-function))
Expand All @@ -686,7 +700,7 @@ rhombus\"."
(with-current-buffer edit-buffer forward-sexp-function))
(racket-hash-lang-repl-mode (if hl 1 -1)) ;keybindings
(when hl
(racket--hash-lang-create edit-buffer))
(racket--hash-lang-create-for-repl edit-buffer))
(if hl
(add-hook 'after-change-functions #'racket--hash-lang-after-change-hook t t)
(remove-hook 'after-change-functions #'racket--hash-lang-after-change-hook t))
Expand Down

0 comments on commit e8a7e90

Please sign in to comment.