2020-01-01 22:44:37 +00:00
|
|
|
|
;;; serene-init --- The entry point for serene extension
|
|
|
|
|
;;; Commentary:
|
2020-02-17 19:20:18 +00:00
|
|
|
|
;;
|
|
|
|
|
;; In order to connect to Serene's nRepl process, first you have to make
|
|
|
|
|
;; that it's running some where (consult Serene's README for learning more
|
|
|
|
|
;; about it). Then simply use `serene-nrepl-connect' to make a connection.
|
|
|
|
|
;; at this point you can evaluate Serene's expressions by using `serene-eval-expr-at-point'
|
|
|
|
|
;; function which evaluates the expression before point end prints out the
|
|
|
|
|
;; result in minibuffer.
|
|
|
|
|
;;
|
2020-01-01 22:44:37 +00:00
|
|
|
|
;;; Code:
|
|
|
|
|
(defvar serene-simple-mode-map
|
|
|
|
|
(make-sparse-keymap))
|
|
|
|
|
|
2020-01-26 11:12:42 +00:00
|
|
|
|
(defvar serene-nrepl-host "127.0.0.1")
|
|
|
|
|
(defvar serene-nrepl-port 5544)
|
|
|
|
|
(defvar serene-nrepl-process nil)
|
2020-01-01 22:44:37 +00:00
|
|
|
|
|
|
|
|
|
(defconst serene-simple-mode-syntax-table
|
|
|
|
|
(let ((table (make-syntax-table)))
|
|
|
|
|
(modify-syntax-entry ?\" "\"" table)
|
|
|
|
|
;; / is punctuation, but // is a comment starter
|
|
|
|
|
(modify-syntax-entry ?\; "<" table)
|
|
|
|
|
(modify-syntax-entry ?\n ">" table)
|
|
|
|
|
table))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defface serene-simple-mode-special-froms-face
|
|
|
|
|
'((t :inherit font-lock-builtin-face))
|
|
|
|
|
"Face of special forms."
|
|
|
|
|
:group 'simple-serene-mode)
|
|
|
|
|
|
|
|
|
|
(defface serene-simple-mode-builtin-fns-face
|
|
|
|
|
'((t :inherit font-lock-keyword-face))
|
|
|
|
|
"Face of builtin functions."
|
|
|
|
|
:group 'simple-serene-mode)
|
|
|
|
|
|
|
|
|
|
(defface serene-simple-mode-builtin-types-face
|
|
|
|
|
'((t :inherit font-lock-type-face))
|
|
|
|
|
"Face of built in types."
|
|
|
|
|
:group 'simple-serene-mode)
|
|
|
|
|
|
|
|
|
|
(defvar serene-simple-mode-special-forms
|
2021-01-04 20:52:11 +00:00
|
|
|
|
'("do" "let" "def" "fn" "quote" "cond" "if"
|
|
|
|
|
"defn" "defmacro" "list" "ns"))
|
2020-01-01 22:44:37 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defconst serene-simple-mode-builtin-fns
|
|
|
|
|
'("=" ">" "<" ">=" "<=" "and" "or" "not" "first" "rest" "println"
|
2021-01-04 20:52:11 +00:00
|
|
|
|
"quit" "+" "*" "/" "-" "conj" "mod" "new" "pr" "prn" "print"))
|
2020-01-01 22:44:37 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defconst serene-simple-mode-builtin-types
|
|
|
|
|
'("System" "String" "Boolean"))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define-derived-mode serene-simple-mode
|
|
|
|
|
scheme-mode "Serene(Simple)"
|
2020-02-17 19:20:18 +00:00
|
|
|
|
"Major mode for Serene simple."
|
|
|
|
|
(define-key serene-simple-mode-map (kbd "C-x C-e") 'serene-eval-expr-at-point))
|
2020-01-01 22:44:37 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun serene-simple-add-keywords (face-name keyword-rules)
|
|
|
|
|
"Set the FACE-NAME for keywords in serene-simple using KEYWORD-RULES."
|
|
|
|
|
(let* ((keyword-list (mapcar #'(lambda (x)
|
|
|
|
|
(symbol-name (cdr x)))
|
|
|
|
|
keyword-rules))
|
|
|
|
|
(keyword-regexp
|
|
|
|
|
(concat
|
|
|
|
|
"\\("
|
|
|
|
|
(regexp-opt keyword-list)
|
|
|
|
|
"\\)")))
|
|
|
|
|
(font-lock-add-keywords 'serene-simple-mode
|
|
|
|
|
`((,keyword-regexp 1 ',face-name))))
|
|
|
|
|
(mapc #'(lambda (x)
|
|
|
|
|
(put (cdr x)
|
|
|
|
|
'serene-simple-indent-function
|
|
|
|
|
(car x)))
|
|
|
|
|
keyword-rules))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(serene-simple-add-keywords 'serene-simple-mode-special-froms-face
|
|
|
|
|
(mapcar (lambda (x) (cons 1 (intern x))) serene-simple-mode-special-forms))
|
|
|
|
|
|
|
|
|
|
(serene-simple-add-keywords 'serene-simple-mode-builtin-fns-face
|
|
|
|
|
(mapcar (lambda (x) (cons 1 (intern x))) serene-simple-mode-builtin-fns))
|
|
|
|
|
|
|
|
|
|
(serene-simple-add-keywords 'serene-simple-mode-builtin-types-face
|
|
|
|
|
(mapcar (lambda (x) (cons 1 (intern x))) serene-simple-mode-builtin-types))
|
|
|
|
|
|
2020-01-26 11:12:42 +00:00
|
|
|
|
|
|
|
|
|
(defun serene-expr-at-point ()
|
|
|
|
|
"Return sexp before the point."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((opoint (point))
|
|
|
|
|
(left-quote ?‘)
|
|
|
|
|
expr)
|
|
|
|
|
(save-excursion
|
2020-02-17 19:20:18 +00:00
|
|
|
|
(with-syntax-table serene-simple-mode-syntax-table
|
2020-01-26 11:12:42 +00:00
|
|
|
|
;; If this sexp appears to be enclosed in `...' or ‘...’
|
|
|
|
|
;; then ignore the surrounding quotes.
|
|
|
|
|
(cond ((eq (preceding-char) ?’)
|
|
|
|
|
(progn (forward-char -1) (setq opoint (point))))
|
|
|
|
|
((or (eq (following-char) ?\')
|
|
|
|
|
(eq (preceding-char) ?\'))
|
|
|
|
|
(setq left-quote ?\`)))
|
|
|
|
|
|
|
|
|
|
;; When after a named character literal, skip over the entire
|
|
|
|
|
;; literal, not only its last word.
|
|
|
|
|
(when (= (preceding-char) ?})
|
|
|
|
|
(let ((begin (save-excursion
|
|
|
|
|
(backward-char)
|
|
|
|
|
(skip-syntax-backward "w-")
|
|
|
|
|
(backward-char 3)
|
|
|
|
|
(when (looking-at-p "\\\\N{") (point)))))
|
|
|
|
|
(when begin (goto-char begin))))
|
|
|
|
|
|
|
|
|
|
(forward-sexp -1)
|
|
|
|
|
;; If we were after `?\e' (or similar case),
|
|
|
|
|
;; use the whole thing, not just the `e'.
|
|
|
|
|
(when (eq (preceding-char) ?\\)
|
|
|
|
|
(forward-char -1)
|
|
|
|
|
(when (eq (preceding-char) ??)
|
|
|
|
|
(forward-char -1)))
|
|
|
|
|
|
|
|
|
|
;; Skip over hash table read syntax.
|
|
|
|
|
(and (> (point) (1+ (point-min)))
|
|
|
|
|
(looking-back "#s" (- (point) 2))
|
|
|
|
|
(forward-char -2))
|
|
|
|
|
|
|
|
|
|
(save-restriction
|
|
|
|
|
(if (eq (following-char) left-quote)
|
|
|
|
|
(forward-char))
|
|
|
|
|
(when (looking-at ",@?") (goto-char (match-end 0)))
|
|
|
|
|
(narrow-to-region (point-min) opoint)
|
|
|
|
|
(setq expr (read (current-buffer)))
|
|
|
|
|
expr)))))
|
|
|
|
|
|
|
|
|
|
(defun serene-eval-expr-at-point ()
|
|
|
|
|
"Send the expression at point to the nRepl for evaluation."
|
|
|
|
|
(interactive)
|
2020-02-17 19:20:18 +00:00
|
|
|
|
(if (and serene-nrepl-process (process-live-p serene-nrepl-process))
|
|
|
|
|
(let* ((buf (process-buffer serene-nrepl-process))
|
|
|
|
|
(expr (format "%s\n" (replace-regexp-in-string
|
|
|
|
|
(regexp-quote "\n")
|
|
|
|
|
" "
|
|
|
|
|
(prin1-to-string (serene-expr-at-point))
|
|
|
|
|
nil 'literal))))
|
|
|
|
|
(process-send-string serene-nrepl-process expr))
|
|
|
|
|
(message "Error: You need to connect to Serene's nRepl first.")))
|
2020-01-26 11:12:42 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun serene-nrepl-sentinel (process event)
|
|
|
|
|
"The sentinel fn for the given PROCESS to process the EVENT."
|
|
|
|
|
(message (format "Process: %s had the event '%s'" process event)))
|
|
|
|
|
|
|
|
|
|
(defun serene-process-incoming-result (process value)
|
|
|
|
|
"Process the incoming VALUE of the given PROCESS."
|
|
|
|
|
(if (not (= (length value) 0))
|
|
|
|
|
(let ((status (substring value 0 1)))
|
|
|
|
|
(if (string= status "0")
|
|
|
|
|
(message (format "=> %s" (substring value 1 -1)))
|
|
|
|
|
(message (format "Error: %s" (substring value 1 -1)))))
|
|
|
|
|
(message "Bad response from nRepl.")))
|
|
|
|
|
|
|
|
|
|
(defun serene-nrepl-connect ()
|
|
|
|
|
"Connect to the running nRepl of Serene and return the process value."
|
|
|
|
|
(interactive)
|
|
|
|
|
(if (not serene-nrepl-process)
|
|
|
|
|
(let ((p (open-network-stream "serene-nrepl"
|
|
|
|
|
(get-buffer-create "*serene-repl*")
|
|
|
|
|
serene-nrepl-host
|
|
|
|
|
serene-nrepl-port)))
|
|
|
|
|
(setq serene-nrepl-process p)
|
|
|
|
|
(set-process-sentinel p 'serene-nrepl-sentinel)
|
|
|
|
|
(set-process-filter p 'serene-process-incoming-result)
|
|
|
|
|
(message (format "Connected to tcp://%s:%s"
|
|
|
|
|
serene-nrepl-host
|
|
|
|
|
serene-nrepl-port)))
|
|
|
|
|
serene-nrepl-process))
|
|
|
|
|
|
|
|
|
|
(defun serene-nrepl-disconnect ()
|
|
|
|
|
"Disconnect from Serene nRepl."
|
|
|
|
|
(interactive)
|
|
|
|
|
(when serene-nrepl-process
|
|
|
|
|
(delete-process serene-nrepl-process)
|
|
|
|
|
(setq serene-nrepl-process nil)
|
|
|
|
|
(message "Disconnected from the nRepl.")))
|
|
|
|
|
|
|
|
|
|
(defun serene-nrepl-status ()
|
|
|
|
|
"Return the status of the connection to Serene's nRepl."
|
|
|
|
|
(interactive)
|
|
|
|
|
(if serene-nrepl-process
|
|
|
|
|
(message (format "%s" (process-status serene-nrepl-process)))
|
|
|
|
|
(message "Disconnected.")))
|
|
|
|
|
|
2020-01-01 22:44:37 +00:00
|
|
|
|
(provide 'extensions/serene/serene-simple-mode)
|
|
|
|
|
;;; serene-simple-mode.el ends here
|