;; Copyright (c) 2014 Microsoft Corporation. All rights reserved. ;; Released under Apache 2.0 license as described in the file LICENSE. ;; ;; Author: Soonho Kong ;; (require 'cl-lib) (require 'lean-variable) (require 'lean-cmd) (require 'lean-info) (require 'lean-util) (require 'flycheck) ;; Parameters ;; ========== (defvar-local lean-server-process-name "lean-server") (defvar-local lean-server-buffer-name "*lean-server*") (defvar-local lean-server-option "--server") ;; Log Function ;; ============ (defun lean-server-log (format-string &rest args) "Display a message at the bottom of the *lean-server* buffer." (with-current-buffer (lean-server-get-buffer) (goto-char (point-max)) (insert (apply 'format (concat format-string "\n") args)))) ;; How to read data from an async process ;; ====================================== (defconst lean-server-syntax-pattern `((INFO ,(rx line-start "-- BEGININFO" line-end) ,(rx line-start (group "-- ENDINFO") line-end)) (SET ,(rx line-start "-- BEGINSET" line-end) ,(rx line-start (group "-- ENDSET") line-end)) (EVAL ,(rx line-start "-- BEGINEVAL" line-end) ,(rx line-start (group "-- ENDEVAL") line-end)) (ERROR ,(rx line-start "-- " (0+ not-newline) line-end) ,(rx line-start (group "-- ERROR") line-end))) "Regular expression pattern for lean-server message syntax") (defun lean-server-split-buffer (buf-str beg-regex end-regex) "" (let ((beg (string-match beg-regex buf-str)) (end (string-match end-regex buf-str)) pre body post) (when (and beg end) (setq end (match-end 1)) (setq pre (substring-no-properties buf-str 0 beg)) (setq body (substring-no-properties buf-str beg end)) (setq post (substring-no-properties buf-str end)) `(,pre ,body ,post)))) (defun lean-server-check-buffer-and-partition (buf-str) "Return the status of buffer." (let (result) (cl-loop for (type beg-regex end-regex) in lean-server-syntax-pattern do (setq partition-result (lean-server-split-buffer buf-str beg-regex end-regex)) if partition-result return `(,type ,partition-result)))) (defun lean-server-process-received-message (buf str) "Process received message from lean-server" (lean-server-log "Received String: %s" str) ;; Append to buffer (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) "Filter function attached to lean-server process" (lean-server-process-received-message (process-buffer process) string)) ;; How to create an async process ;; ============================== (defun lean-server-create-process () "Create lean-server process." ;; (when (buffer-modified-p) ;; (error "Please save the buffer before start lean-server.")) (let ((process-connection-type nil) (lean-server-process (start-process lean-server-process-name lean-server-buffer-name (lean-get-executable lean-executable-name) lean-server-option))) (set-process-coding-system lean-server-process 'utf-8 'utf-8) (set-process-filter lean-server-process 'lean-server-output-filter) (setq lean-global-server-buffer nil) (setq lean-global-server-current-file-name nil) (setq lean-global-server-message-to-process nil) (setq lean-global-server-process lean-server-process) lean-server-process)) (defun lean-server-kill-process () "Kill lean-server process. Return t if killed, nil if nothing to kill" (interactive) (cond (lean-global-server-process (when (interactive-p) (message "lean-server-kill-process: %S killed" lean-global-server-process)) (kill-process lean-global-server-process) (setq lean-global-server-process nil) t) (t (when (interactive-p) (message "lean-server-kill-process: no process to kill")) nil))) (defun lean-server-restart-process () "Restart lean-server process." (interactive) (and (lean-server-kill-process) (lean-server-create-process))) (defun lean-server-get-process () "Get lean-server process. If needed, create a one." (cond ((not lean-global-server-process) (lean-server-create-process)) ((not (process-live-p lean-global-server-process)) (when (interactive-p) (message "lean-server-get-process: %S is not live, kill it" lean-global-server-process)) (lean-server-kill-process)) (t lean-global-server-process))) (defun lean-server-get-buffer () "Get lean-server buffer." (process-buffer (lean-server-get-process))) ;; How to send data to an async process ;; ==================================== (defun lean-flush-changed-lines () "Flush lean-changed-lines. Send REPLACE commands to lean-server, reset lean-changed-lines to nil." (cl-loop for n in lean-changed-lines do (lean-server-send-cmd (lean-cmd-replace n (lean-grab-line n))) finally (setq lean-changed-lines nil))) (defun lean-server-check-current-file (&optional file-name) "Check lean-global-server-current-file-name. If it's not the same with file-name (default: buffer-file-name), send VISIT cmd." (let ((current-file-name (or file-name (buffer-file-name)))) (unless (string= lean-global-server-current-file-name current-file-name) (lean-server-send-cmd (lean-cmd-visit current-file-name))))) (defun lean-server-before-send-cmd (cmd) "Operations to perform before sending a command." (cl-case (lean-cmd-type cmd) ('LOAD (setq lean-global-server-current-file-name (lean-cmd-load-get-file-name cmd))) ('VISIT (setq lean-global-server-current-file-name (lean-cmd-visit-get-file-name cmd))) ('REPLACE (lean-server-check-current-file)) ('INSERT (lean-server-check-current-file)) ('REMOVE (lean-server-check-current-file)) ('INFO (lean-flush-changed-lines)) ('CHECK ) ('SET ()) ('EVAL ()))) (defun lean-server-after-send-cmd (cmd) "Operations to perform after sending a command." (cl-case (lean-cmd-type cmd) ('LOAD ()) ('VISIT ()) ('REPLACE ()) ('INSERT ()) ('REMOVE ()) ('INFO ()) ('CHECK ()) ('SET ()) ('EVAL ()))) (defun lean-server-send-cmd (cmd) "Send string to lean-server." (let ((proc (lean-server-get-process)) (string-to-send (concat (lean-cmd-to-string cmd) "\n"))) (lean-server-before-send-cmd cmd) ;; Logging (lean-server-log (concat "Send" "\n" "================" "\n" "%s\n" "================" "\n") string-to-send) (process-send-string proc string-to-send)) (lean-server-after-send-cmd cmd)) (provide 'lean-server)