feat(emacs): implement non-blocking communication

The key idea is to pass a continuation function when we call
lean-server-send-cmd function. The passed continuation function is
called by lean-server-event-handler. Until the buffer is ready, the
event handler will be called in interval (lean-server-retry-time, 0.1
sec by default). When we have 'NAY' for INFO command, it will re-send
INFO commands to lean-server until we have one without 'NAY'.

Close #123
This commit is contained in:
Soonho Kong 2014-09-03 00:39:54 -07:00
parent 53390faebc
commit 72e1dfa296
6 changed files with 107 additions and 101 deletions

View file

@ -22,21 +22,7 @@
nil t "" nil (car key-list))) nil t "" nil (car key-list)))
(option (cdr (assoc option-name lean-global-option-record-alist))) (option (cdr (assoc option-name lean-global-option-record-alist)))
(option-value (lean-option-read option))) (option-value (lean-option-read option)))
(lean-server-send-cmd (lean-cmd-set option-name option-value)) (lean-server-send-cmd (lean-cmd-set option-name option-value) 'message)))
(while (not lean-global-server-message-to-process)
(accept-process-output (lean-server-get-process) 0 50 t))
(pcase lean-global-server-message-to-process
(`(SET ,pre ,body)
(lean-server-log "The following pre-message will be thrown away:")
(lean-server-log "%s" pre)
(setq lean-global-server-message-to-process nil)
(lean-server-log "We have the following response from lean-server")
(message "%s" (lean-set-parse-string body)))
(`(,type ,pre , body)
(lean-server-log "The following pre-message will be thrown away:")
(lean-server-log "%s" pre)
(lean-server-log "Something other than SET detected: %S" type)
(setq lean-global-server-message-to-process nil)))))
(defun lean-option-read-bool (prompt) (defun lean-option-read-bool (prompt)
(interactive) (interactive)
@ -154,22 +140,9 @@
"Get Lean option." "Get Lean option."
(interactive) (interactive)
(unless lean-global-option-record-alist (unless lean-global-option-record-alist
(lean-server-send-cmd (lean-cmd-options)) (lean-server-send-cmd (lean-cmd-options)
(while (not lean-global-server-message-to-process) '(lambda (option-record-alist)
(accept-process-output (lean-server-get-process) 0 50 t)) (setq lean-global-option-record-alist
(pcase lean-global-server-message-to-process option-record-alist)))))
(`(OPTIONS ,pre ,body)
(lean-server-log "The following pre-message will be thrown away:")
(lean-server-log "%s" pre)
(setq lean-global-server-message-to-process nil)
(lean-server-log "We have the following response from lean-server")
(setq lean-global-option-record-alist
(lean-options-parse-string body)))
(`(,type ,pre , body)
(lean-server-log "The following pre-message will be thrown away:")
(lean-server-log "%s" pre)
(lean-server-log "Something other than SET detected: %S" type)
(setq lean-global-server-message-to-process nil))))
lean-global-option-record-alist)
(provide 'lean-option) (provide 'lean-option)

View file

@ -68,24 +68,16 @@
(defun lean-server-check-buffer-and-partition (buf-str) (defun lean-server-check-buffer-and-partition (buf-str)
"Return the status of buffer." "Return the status of buffer."
(let (result) (let (result)
(cl-loop for (type beg-regex end-regex) in lean-server-syntax-pattern (when buf-str
do (setq partition-result (lean-server-split-buffer buf-str beg-regex end-regex)) (cl-loop for (type beg-regex end-regex) in lean-server-syntax-pattern
if partition-result do (setq partition-result (lean-server-split-buffer buf-str beg-regex end-regex))
return `(,type ,partition-result)))) if partition-result
return `(,type ,partition-result)))))
(defun lean-server-process-received-message (buf str) (defun lean-server-process-received-message (buf str)
"Process received message from lean-server" "Process received message from lean-server"
(lean-server-log "Received String: %s" str) (lean-server-log "Received String: %s" str)
;; Append to buffer (setq lean-global-server-buffer (concat lean-global-server-buffer str)))
(setq lean-global-server-buffer (concat lean-global-server-buffer str))
(let ((partition-result (lean-server-check-buffer-and-partition lean-global-server-buffer)))
(pcase partition-result
(`(,type (,pre ,body ,post))
(lean-server-log "PRE: %s" pre)
(lean-server-log "BODY: %s" body)
(lean-server-log "POST: %s" post)
(setq lean-global-server-message-to-process `(,type ,pre ,body))
(setq lean-global-server-buffer post)))))
(defun lean-server-output-filter (process string) (defun lean-server-output-filter (process string)
"Filter function attached to lean-server process" "Filter function attached to lean-server process"
@ -109,9 +101,9 @@
(setq lean-global-server-message-to-process nil) (setq lean-global-server-message-to-process nil)
(setq lean-global-server-last-time-sent nil) (setq lean-global-server-last-time-sent nil)
(setq lean-global-option-record-alist nil) (setq lean-global-option-record-alist nil)
(when (timerp lean-global-nay-retry-timer) (when (timerp lean-global-retry-timer)
(cancel-timer lean-global-nay-retry-timer)) (cancel-timer lean-global-retry-timer))
(setq lean-global-nay-retry-timer nil)) (setq lean-global-retry-timer nil))
(defun lean-server-create-process () (defun lean-server-create-process ()
"Create lean-server process." "Create lean-server process."
@ -219,22 +211,78 @@ If it's not the same with file-name (default: buffer-file-name), send VISIT cmd.
('EVAL ()) ('EVAL ())
('OPTIONS ()))) ('OPTIONS ())))
(defun lean-server-send-cmd (cmd) (defun lean-server-send-cmd (cmd &optional cont)
"Send string to lean-server." "Send string to lean-server."
(let ((proc (lean-server-get-process)) (let ((proc (lean-server-get-process))
(string-to-send (concat (lean-cmd-to-string cmd) "\n"))) (string-to-send (concat (lean-cmd-to-string cmd) "\n")))
(lean-server-before-send-cmd cmd) (lean-server-before-send-cmd cmd)
;; Logging ;; Logging
(lean-server-log (lean-server-log
(concat "Send" "\n" (string-join
"================" "\n" '("Send"
"%s\n" "================"
"================" "\n") "%s"
string-to-send) "================") "\n") string-to-send)
;; Trace ;; Trace
(lean-server-trace (lean-server-trace
(format "%s" string-to-send)) (format "%s" string-to-send))
(process-send-string proc string-to-send) (process-send-string proc string-to-send)
(lean-server-after-send-cmd cmd))) (lean-server-after-send-cmd cmd)
(when cont
(lean-server-event-handler cont))))
(defun lean-server-set-timer-for-event-handler (cont)
(setq lean-global-retry-timer
(run-with-idle-timer
(if (current-idle-time)
(time-add (seconds-to-time lean-server-retry-time) (current-idle-time))
lean-server-retry-time)
nil
'lean-server-event-handler cont)))
(defun lean-server-get-info-record-at-pos (body)
(let* ((file-name (buffer-file-name))
(column (current-column))
(cur-char (char-after (point))))
(when (and cur-char
(or (char-equal cur-char ?\s)
(char-equal cur-char ?\t)
(char-equal cur-char ?\t)
(char-equal cur-char ?\,)
(char-equal cur-char ?\))
(char-equal cur-char ?\})
(char-equal cur-char ?\]))
(> column 1))
(setq column (1- column)))
(lean-info-record-parse body file-name column)))
(defun lean-server-event-handler (cont)
(let ((partition-result (lean-server-check-buffer-and-partition lean-global-server-buffer)))
(pcase partition-result
(`(,type (,pre ,body ,post))
(lean-server-log "The following pre-message will be thrown away:")
(lean-server-log "%s" pre)
(setq lean-global-server-buffer post)
(cl-case type
(INFO
(let ((info-record (lean-server-get-info-record-at-pos body)))
(cond
((lean-info-record-nay info-record)
(lean-server-send-cmd (lean-cmd-info (line-number-at-pos))
cont))
(t
(funcall cont info-record)))))
(SET
(funcall cont (lean-set-parse-string body)))
(EVAL
(funcall cont (lean-eval-parse-string body)))
(OPTIONS
(funcall cont (lean-options-parse-string body)))
(SHOW
(funcall cont (lean-show-parse-string body)))
(ERROR
(lean-server-log "Error detected:\n%s" body))))
(`()
(lean-server-set-timer-for-event-handler cont)
nil))))
(provide 'lean-server) (provide 'lean-server)

View file

@ -48,6 +48,9 @@
(defcustom lean-eldoc-nay-retry-time 0.3 (defcustom lean-eldoc-nay-retry-time 0.3
"When eldoc-function had nay, try again after this amount of time.") "When eldoc-function had nay, try again after this amount of time.")
(defcustom lean-server-retry-time 0.1
"Retry interval for event-handler")
(defcustom lean-flycheck-checker-name "linja" (defcustom lean-flycheck-checker-name "linja"
"lean-flychecker checker name" "lean-flychecker checker name"
:group 'lean :group 'lean

View file

@ -41,9 +41,9 @@
(defun lean-find-tag () (defun lean-find-tag ()
"lean-find-tag" "lean-find-tag"
(interactive) (interactive)
(let ((full-name (lean-get-full-name-at-point))) (lean-get-full-name-at-point
(when full-name (lambda (full-name)
(find-tag full-name)))) (when full-name (find-tag full-name)))))
(defun lean-complete-tag () (defun lean-complete-tag ()
"complete with tag" "complete with tag"

View file

@ -14,41 +14,35 @@
(require 'lean-debug) (require 'lean-debug)
(require 'flymake) (require 'flymake)
(defun lean-fill-placeholder () (setq-local lexical-binding t)
"Fill the placeholder with a synthesized expression by Lean."
(interactive) (defun lean-fill-placeholder-cont (info-record)
(let* ((info-record (lean-get-info-record-at-point)) "Continuation for lean-fill-placeholder"
(synth (and info-record (cl-first (lean-info-record-synth info-record))))) (let ((synth (and info-record (cl-first (lean-info-record-synth info-record)))))
(when synth (when synth
(let ((synth-str (let ((synth-str
(replace-regexp-in-string "?M_[0-9]+" "_" (lean-info-synth-body-str synth)))) (replace-regexp-in-string "?M_[0-9]+" "_" (lean-info-synth-body-str synth))))
(when (search " " synth-str) (when (search " " synth-str)
(setq synth-str (concat "(" synth-str ")"))) (setq synth-str (concat "(" synth-str ")")))
(delete-forward-char 1) (when (char-equal (char-after (point)) ?_)
(insert synth-str))))) (delete-forward-char 1)
(insert synth-str))))))
(defun lean-fill-placeholder ()
"Fill the placeholder with a synthesized expression by Lean."
(interactive)
(lean-get-info-record-at-point 'lean-fill-placeholder-cont))
(defun lean-eldoc-documentation-function-cont (info-record)
"Continuation for lean-eldoc-documentation-function"
(let ((info-string (lean-info-record-to-string info-record)))
(when info-string
(message "%s" info-string))))
(defun lean-eldoc-documentation-function () (defun lean-eldoc-documentation-function ()
"Show information of lean expression at point if any" "Show information of lean expression at point if any"
(interactive) (interactive)
(when (timerp lean-global-nay-retry-timer) (lean-get-info-record-at-point 'lean-eldoc-documentation-function-cont))
(cancel-timer lean-global-nay-retry-timer)
(setq lean-global-nay-retry-timer nil))
(let ((info-record (lean-get-info-record-at-point))
info-string)
(cond
((and info-record (lean-info-record-nay info-record))
(setq lean-global-nay-retry-timer
(run-with-idle-timer
(if (current-idle-time)
(time-add (seconds-to-time lean-eldoc-nay-retry-time) (current-idle-time))
lean-eldoc-nay-retry-time)
nil
'lean-eldoc-documentation-function))
nil)
(info-record
(setq info-string (lean-info-record-to-string info-record))
(when info-string
(message "%s" info-string))))))
;; ======================================================= ;; =======================================================
;; eval ;; eval
@ -67,20 +61,8 @@
(defun lean-eval-cmd (lean-cmd) (defun lean-eval-cmd (lean-cmd)
"Evaluate lean command." "Evaluate lean command."
(interactive "sLean CMD: ") (interactive "sLean CMD: ")
(lean-server-send-cmd (lean-cmd-eval lean-cmd)) (lean-server-send-cmd (lean-cmd-eval lean-cmd)
(while (not lean-global-server-message-to-process) 'message))
(accept-process-output (lean-server-get-process) 0 50 t))
(pcase lean-global-server-message-to-process
(`(EVAL ,pre ,body)
(lean-server-log "The following pre-message will be thrown away:")
(lean-server-log "%s" pre)
(setq lean-global-server-message-to-process nil)
(message "%s" (lean-eval-parse-string body)))
(`(,type ,pre , body)
(lean-server-log "The following pre-message will be thrown away:")
(lean-server-log "%s" pre)
(lean-server-log "Something other than EVAL detected: %S" type)
(setq lean-global-server-message-to-process nil))))
;; Clear Cache ;; Clear Cache
(defun lean-clear-cache () (defun lean-clear-cache ()

View file

@ -30,8 +30,8 @@ where TYPE := INFO | SET | EVAL | OPTIONS | ERROR,
(defvar lean-global-server-last-time-sent nil (defvar lean-global-server-last-time-sent nil
"Last time lean-mode sent a command to lean-server") "Last time lean-mode sent a command to lean-server")
(defvar lean-global-nay-retry-timer nil (defvar lean-global-retry-timer nil
"Timer used to re-try eldoc-documentation-function for NAY.") "Timer used to re-try event-handler-function.")
(defvar-local lean-changed-lines nil (defvar-local lean-changed-lines nil
"Changed lines") "Changed lines")