branch: elpa/racket-mode
commit 27140827c5ca7b167a56d21a3ae5bc5a829c3647
Author: Greg Hendershott <[email protected]>
Commit: Greg Hendershott <[email protected]>
Add racket--cmd-ready-p and often use instead of racket--cmd-open-p
Arising from working on #763. Although this doesn't fix that issue,
this improvement is "adjacent".
---
racket-cmd.el | 82 ++++++++++++++++++++++++++++++++++++---------------
racket-hash-lang.el | 2 +-
racket-repl.el | 2 +-
racket-xp-complete.el | 6 ++--
racket-xp.el | 4 +--
5 files changed, 66 insertions(+), 30 deletions(-)
diff --git a/racket-cmd.el b/racket-cmd.el
index 00f215dc0c4..4ff46f57b7a 100644
--- a/racket-cmd.el
+++ b/racket-cmd.el
@@ -61,11 +61,43 @@ Before doing anything runs the hook
`racket-stop-back-end-hook'."
(racket--cmd-close))
(defun racket--cmd-open-p ()
- "Does a running process exist for `racket-back-end-name'?"
+ "Does a running process exist for `racket-back-end'?
+
+The process could be running, but the back end not yet fully
+initialized. See also `racket--cmd-ready-p'."
(pcase (get-process (racket--back-end-process-name (racket-back-end)))
((and (pred (processp)) proc)
(eq 'run (process-status proc)))))
+(defun racket--cmd-ready-p ()
+ "Is `racket-back-end' ready to accept commands?
+
+This is a \"superset\" of `racket--cmd-open-p': Not merely is the Racket
+process running, but also has our back end code fully loaded and issued
+a \"ready\" notification. In other words, will it respond to commands
+promptly.
+
+Despite the \"-p\" suffix, returns nil or a value more interesting than
+t: See `racket--put-start-and-load-timings'."
+ (pcase (get-process (racket--back-end-process-name (racket-back-end)))
+ ((and (pred (processp)) proc)
+ (and (eq 'run (process-status proc))
+ (process-get proc 'racket-back-end-ready)))))
+
+(defun racket--put-start-and-load-timings (proc)
+ "Set process prop \\='racket-back-end-ready for `racket--cmd-ready-p'.
+
+The value is a cons of the duration of the Racket process startup, and,
+the subsequent duration of our back end loading sufficiently to become
+ready.
+
+Intended to be called after a (ready) notification from back end."
+ (pcase (process-get proc 'racket-back-end-startup)
+ (`(,proc0 ,proc1) ;times before/after `make-process'
+ (let ((proc-dur (float-time (time-subtract proc1 proc0)))
+ (load-dur (float-time (time-subtract nil proc1))))
+ (process-put proc 'racket-back-end-ready (cons proc-dur load-dur))))))
+
(make-obsolete-variable
'racket-adjust-run-rkt
"This is no longer supported."
@@ -109,6 +141,7 @@ Before doing anything runs the hook
`racket-stop-back-end-hook'."
"--do-not-use-svg"))
(args (list main-dot-rkt svg-flag))
(command (racket--back-end-args->command back-end args))
+ (t0 (current-time))
(process
(make-process
:name process-name
@@ -122,6 +155,7 @@ Before doing anything runs the hook
`racket-stop-back-end-hook'."
:sentinel #'racket--cmd-process-sentinel))
(status (process-status process)))
(process-put process 'racket-back-end-name (racket-back-end-name
back-end))
+ (process-put process 'racket-back-end-startup (list t0 (current-time)))
(unless (eq status 'run)
(error "%s process status is not \"run\", instead it is %s"
process-name
@@ -160,9 +194,7 @@ sentinel is `ignore'."
(with-current-buffer buffer
(goto-char (point-max))
(insert string)
- (racket--cmd-read (apply-partially
- #'racket--cmd-dispatch
- (process-get proc 'racket-back-end-name)))))))
+ (racket--cmd-read (apply-partially #'racket--cmd-dispatch proc))))))
;; The process filter inserts text as it arrives in chunks. So the
;; challenge here is to read whenever the buffer accumulates one or
@@ -209,29 +241,33 @@ sentinel is `ignore'."
(defvar racket--cmd-nonce 0
"Number that increments for each command request we send.")
-(defun racket--cmd-dispatch (back-end response)
+(defun racket--cmd-dispatch (proc response)
"Do something with a sexpr sent to us from the command server.
Although mostly these are 1:1 responses to command requests, some
like \"logger\", \"debug-break\", and \"hash-lang\" are
notifications."
- (pcase response
- (`(startup-error ,kind ,data)
- (run-at-time 0.001 nil #'racket--on-startup-error kind data))
- (`(logger ,str)
- (run-at-time 0.001 nil #'racket--logger-on-notify back-end str))
- (`(debug-break . ,response)
- (run-at-time 0.001 nil #'racket--debug-on-break response))
- (`(hash-lang ,id . ,vs)
- (run-at-time 0.001 nil #'racket--hash-lang-on-notify id vs))
- (`(repl-output ,session-id ,kind ,v)
- (run-at-time 0.001 nil #'racket--repl-on-output session-id kind v))
- (`(pkg-op-notify . ,v)
- (run-at-time 0.001 nil #'racket--package-on-notify v))
- (`(,nonce . ,response)
- (when-let (callback (gethash nonce racket--cmd-nonce->callback))
- (remhash nonce racket--cmd-nonce->callback)
- (run-at-time 0.001 nil callback response)))
- (_ nil)))
+ (cl-flet ((soon (fun &rest args)
+ (apply #'run-at-time 0.001 nil fun args)))
+ (pcase response
+ (`(ready)
+ (racket--put-start-and-load-timings proc))
+ (`(startup-error ,kind ,data)
+ (soon #'racket--on-startup-error kind data))
+ (`(logger ,str)
+ (soon #'racket--logger-on-notify (process-get proc
'racket-back-end-name) str))
+ (`(debug-break . ,response)
+ (soon #'racket--debug-on-break response))
+ (`(hash-lang ,id . ,vs)
+ (soon #'racket--hash-lang-on-notify id vs))
+ (`(repl-output ,session-id ,kind ,v)
+ (soon #'racket--repl-on-output session-id kind v))
+ (`(pkg-op-notify . ,v)
+ (soon #'racket--package-on-notify v))
+ (`(,nonce . ,response)
+ (when-let (callback (gethash nonce racket--cmd-nonce->callback))
+ (remhash nonce racket--cmd-nonce->callback)
+ (soon callback response)))
+ (_ nil))))
(defun racket--assert-readable (sexp)
"Sanity check that SEXP is readable by Racket.
diff --git a/racket-hash-lang.el b/racket-hash-lang.el
index 652576f9d7e..334a6acfe29 100644
--- a/racket-hash-lang.el
+++ b/racket-hash-lang.el
@@ -323,7 +323,7 @@ A discussion of the information provided by a Racket
language:
;; 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)
+ (unless (racket--cmd-ready-p)
(setq-local header-line-format "Waiting for back end to start..."))
(setq-local buffer-read-only t)
(racket--cmd/async
diff --git a/racket-repl.el b/racket-repl.el
index 28c45fde1b5..a64d72d30b6 100644
--- a/racket-repl.el
+++ b/racket-repl.el
@@ -1234,7 +1234,7 @@ to supply this quickly enough or at all."
Obtains documentation for point, if any, else the head of the
s-expression."
-(when (and (racket--cmd-open-p)
+(when (and (racket--cmd-ready-p)
(racket--repl-in-input-p (point)))
(let ((point-pos (if (eq 32 (char-before))
(point)
diff --git a/racket-xp-complete.el b/racket-xp-complete.el
index 6f99c7d945f..45773acc878 100644
--- a/racket-xp-complete.el
+++ b/racket-xp-complete.el
@@ -1,6 +1,6 @@
;;; racket-xp-complete.el -*- lexical-binding: t -*-
-;; Copyright (c) 2013-2024 by Greg Hendershott.
+;; Copyright (c) 2013-2025 by Greg Hendershott.
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Author: Greg Hendershott
@@ -131,7 +131,7 @@ that are require transformers."
:exclusive 'no)))
(defun racket--xp-make-company-location-proc ()
- (when (racket--cmd-open-p)
+ (when (racket--cmd-ready-p)
(let ((how (racket-how-front-to-back (buffer-file-name))))
(lambda (str)
(let ((str (substring-no-properties str)))
@@ -140,7 +140,7 @@ that are require transformers."
(cons (racket-file-name-back-to-front path) line))))))))
(defun racket--xp-make-company-doc-buffer-proc ()
- (when (racket--cmd-open-p)
+ (when (racket--cmd-ready-p)
(let ((how (racket-how-front-to-back (buffer-file-name))))
(lambda (str)
(let ((str (substring-no-properties str)))
diff --git a/racket-xp.el b/racket-xp.el
index a311e0e44f3..40cd6040ff0 100644
--- a/racket-xp.el
+++ b/racket-xp.el
@@ -639,7 +639,7 @@ Obtains documentation for point, if any, else the head of
the
s-expression.
See also the customization variable `racket-xp-eldoc-level'."
- (when (racket--cmd-open-p)
+ (when (racket--cmd-ready-p)
(let ((point-pos (point))
(head-pos (when (> (point) (point-min))
(condition-case _
@@ -1340,7 +1340,7 @@ we've worked hard to help shr to convert these correctly."
(defun racket--xp-mode-lighter ()
(let ((prefix "Rkt"))
(pcase-let*
- ((status (and (racket--cmd-open-p)
+ ((status (and (racket--cmd-ready-p)
racket--xp-mode-status))
(`(,suffix ,face ,help-echo)
(cl-case status
