245 lines
8.7 KiB
EmacsLisp
245 lines
8.7 KiB
EmacsLisp
(require 'cl-lib)
|
||
(require 'company)
|
||
|
||
;; "= . args"
|
||
;; "> . args"
|
||
;; ">= . args"
|
||
;; "< . args"
|
||
;; "<= . args"
|
||
;; "+ . args"
|
||
;; "- . args"
|
||
;; "* . args"
|
||
;; "/ . args"
|
||
;; "** a b"
|
||
;; "% a b"
|
||
;; "get-random-between a b"
|
||
;; "assert test"
|
||
;; "define-syntax form (:doc \"\") . body"
|
||
;; "define definee (:doc \"\") . body"
|
||
;; "mutate target source"
|
||
;; "vector-length v"
|
||
;; "vector-ref vec idx"
|
||
;; "vector-set! vec idx val"
|
||
;; "set! sym val"
|
||
;; "set-car! target source"
|
||
;; "set-cdr! target source"
|
||
;; "if test then_part else_part"
|
||
;; "quote datum"
|
||
;; "quasiquote expr"
|
||
;; "and . args"
|
||
;; "or . args"
|
||
;; "not test"
|
||
;; "lambda args . body"
|
||
;; "apply fun args"
|
||
;; "eval expr"
|
||
;; "begin . args"
|
||
;; "list . args"
|
||
;; "pair car cdr"
|
||
;; "first seq"
|
||
;; "rest seq"
|
||
;; "set-type! node new_type"
|
||
;; "delete-type! n"
|
||
;; "type n"
|
||
;; "mem-reset"
|
||
;; "info n"
|
||
;; "show n"
|
||
;; "addr-of var"
|
||
;; "generate-docs file_name"
|
||
;; "print (:sep \" \") (:end \"\\n\") . things"
|
||
;; "read (:prompt \">\""
|
||
;; "exit (:code 0)"
|
||
;; "break"
|
||
;; "memstat"
|
||
;; "mytry try_part catch_part"
|
||
;; "load file"
|
||
;; "import f"
|
||
;; "copy obj"
|
||
;; "error type message"
|
||
;; "symbol->keyword sym"
|
||
;; "string->symbol str"
|
||
;; "symbol->string sym"
|
||
;; "concat-strings . strings"
|
||
|
||
(defconst slime-built-ins
|
||
'("=" ">" ">=" "<" "<=" "+" "-" "*" "/" "**" "%" "get-random-between"
|
||
"assert" "define" "define-syntax" "mutate" "if" "vector-length"
|
||
"vector-ref" "vector-set!" "set!" "set-car!" "set-cdr!"
|
||
"quote" "quasiquote" "unquote" "unquote-splicing" "and" "or" "not" "let"
|
||
"lambda" "apply" "eval" "begin" "list" "pair" "create-hash-map"
|
||
"hash-map-get" "hash-map-set!" "hash-map-delete!" "vector"
|
||
"first" "rest" "set-type!" "delete-type!" "type" "info" "mem-reset"
|
||
"show" "addr-of" "generate-docs" "print" "read" "exit" "break" "memstat"
|
||
"mytry" "load" "import" "copy" "error" "symbol->keyword" "string->symbol"
|
||
"symbol->string" "concat-strings"))
|
||
|
||
(defun get-args (s)
|
||
(cond
|
||
((string= s "=") ". objects")
|
||
((string= s ">") ". objects")
|
||
((string= s ">=") ". objects")
|
||
((string= s "<") ". objects")
|
||
((string= s "<=") ". objects")
|
||
((string= s "+") ". objects")
|
||
((string= s "-") ". objects")
|
||
((string= s "*") ". objects")
|
||
((string= s "/") ". objects")
|
||
((string= s "**") "a b")
|
||
((string= s "%") "a b")
|
||
((string= s "get-random-between") "a b")
|
||
((string= s "assert") "test")
|
||
((string= s "define") "definee (:doc \"\") . body")
|
||
((string= s "define-syntax") "form (:doc \"\") . body")
|
||
((string= s "mutate") "(mutate <expression> <expression>)")
|
||
((string= s "if") "(if <test> <consequence> <alternative>)")
|
||
(t '())))
|
||
|
||
(defun sample-meta (s)
|
||
(message "%s%s%s%s"
|
||
(propertize "(" 'face '(:foreground "orange"))
|
||
(propertize s 'face '(:foreground "#859900"))
|
||
(let ((args (get-args s)))
|
||
(if args
|
||
(concat " " args)
|
||
""))
|
||
(propertize ")" 'face '(:foreground "orange"))
|
||
))
|
||
|
||
|
||
|
||
(defun my-slime-eldoc-function ()
|
||
(let ((sexp-text (thing-at-point 'sexp)))
|
||
(when sexp-text
|
||
(let* ((sexp (read sexp-text))
|
||
(symbol (if (listp sexp)
|
||
(symbol-name (car sexp))
|
||
(symbol-name sexp))))
|
||
(when (member symbol slime-built-ins)
|
||
(sample-meta symbol))))))
|
||
|
||
|
||
(add-to-list 'auto-mode-alist '("\\.slime\\'" . slime-mode))
|
||
|
||
(put 'lambda 'doc-string-elt 2)
|
||
(put 'special-lambda 'doc-string-elt 2)
|
||
(put 'define 'doc-string-elt 2)
|
||
(put 'define-syntax 'doc-string-elt 2)
|
||
|
||
(define-derived-mode slime-mode prog-mode "(slime)"
|
||
"Major mode for editing slime code."
|
||
:group 'lisp
|
||
|
||
(defvar project-vc-external-roots-function)
|
||
|
||
(set-syntax-table lisp-mode-syntax-table)
|
||
(setq-local lisp-mode-symbol-regexp "\\(?:\\sw\\|\\s_\\|\\\\.\\|?\\)+")
|
||
(setq-local paragraph-ignore-fill-prefix t)
|
||
(setq-local fill-paragraph-function 'lisp-fill-paragraph)
|
||
(setq-local adaptive-fill-function #'lisp-adaptive-fill)
|
||
;; Adaptive fill mode gets in the way of auto-fill,
|
||
;; and should make no difference for explicit fill
|
||
;; because lisp-fill-paragraph should do the job.
|
||
;; I believe that newcomment's auto-fill code properly deals with it -stef
|
||
;;(set (make-local-variable 'adaptive-fill-mode) nil)
|
||
(setq-local indent-line-function 'lisp-indent-line)
|
||
(setq-local indent-region-function 'lisp-indent-region)
|
||
(setq-local comment-indent-function #'lisp-comment-indent)
|
||
;; (setq-local outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(")
|
||
(setq-local outline-level 'lisp-outline-level)
|
||
(setq-local add-log-current-defun-function #'lisp-current-defun-name)
|
||
(setq-local comment-start ";")
|
||
(setq-local comment-start-skip ";+ *")
|
||
(setq-local comment-add 1) ;default to `;;' in comment-region
|
||
(setq-local comment-column 40)
|
||
(setq-local comment-use-syntax t)
|
||
(setq-local imenu-generic-expression lisp-imenu-generic-expression)
|
||
(setq-local multibyte-syntax-as-symbol t)
|
||
|
||
(defconst yess
|
||
(append
|
||
`((,(concat "\\(define\\)\\s-*(\\(\\_<[^ )]*\\)")
|
||
(1 font-lock-keyword-face)
|
||
(2 font-lock-function-name-face)
|
||
))
|
||
`((,(concat "(\\s-*\\_<"
|
||
(regexp-opt
|
||
slime-built-ins) "\\_>")
|
||
(0 font-lock-keyword-face)))
|
||
`((,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)"
|
||
lisp-mode-symbol-regexp "\\)['’]")
|
||
(1 font-lock-constant-face prepend))
|
||
;; Constant values.
|
||
(,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>")
|
||
(0 font-lock-builtin-face)))
|
||
|
||
))
|
||
|
||
(setq font-lock-defaults
|
||
`((yess)
|
||
nil nil nil nil
|
||
(font-lock-mark-block-function . mark-defun)
|
||
(font-lock-extra-managed-props help-echo)
|
||
(font-lock-syntactic-face-function
|
||
. lisp-font-lock-syntactic-face-function)))
|
||
;; (setq font-lock-defaults '((;; ads
|
||
;; ;; lisp-el-font-lock-keywords-1
|
||
;; ;; lisp-el-font-lock-keywords-2
|
||
;; )
|
||
;; nil nil nil nil
|
||
;; (font-lock-mark-block-function . mark-defun)
|
||
;; (font-lock-extra-managed-props help-echo)
|
||
;; (font-lock-syntactic-face-function
|
||
;; . lisp-font-lock-syntactic-face-function)))
|
||
(setq-local prettify-symbols-alist lisp-prettify-symbols-alist)
|
||
(setq-local electric-pair-skip-whitespace 'chomp)
|
||
(setq-local electric-pair-open-newline-between-pairs nil)
|
||
|
||
(add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
|
||
(unless noninteractive
|
||
(require 'elec-pair)
|
||
(defvar electric-pair-text-pairs)
|
||
(setq-local electric-pair-text-pairs
|
||
(append '((?\` . ?\') (?‘ . ?’)) electric-pair-text-pairs))
|
||
(setq-local electric-quote-string t))
|
||
(setq imenu-case-fold-search nil)
|
||
(add-function :before-until (local 'eldoc-documentation-function)
|
||
#'my-slime-eldoc-function)
|
||
(add-hook 'xref-backend-functions #'elisp--xref-backend nil t)
|
||
(setq-local project-vc-external-roots-function #'elisp-load-path-roots)
|
||
(add-hook 'completion-at-point-functions #'elisp-completion-at-point nil 'local)
|
||
(add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t)
|
||
(add-hook 'flymake-diagnostic-functions #'elisp-flymake-byte-compile nil t)
|
||
(modify-syntax-entry ?\{ "(}")
|
||
(modify-syntax-entry ?\} "){")
|
||
(modify-syntax-entry ?\[ "(]")
|
||
(modify-syntax-entry ?\] ")["))
|
||
|
||
|
||
(defun company-simple-backend (command &optional arg &rest ignored)
|
||
(interactive (list 'interactive))
|
||
(cl-case command
|
||
(interactive (company-begin-backend 'company-simple-backend))
|
||
(prefix (when (looking-back "foo\\>")
|
||
(match-string 0)))
|
||
(candidates (when (equal arg "foo")
|
||
(list "foobar" "foobaz" "foobarbaz")))
|
||
(meta (format "This value is named %s" arg))))
|
||
|
||
(defun company-sample-backend (command &optional arg &rest ignored)
|
||
(interactive (list 'interactive))
|
||
(cl-case command
|
||
(interactive (company-begin-backend 'company-sample-backend))
|
||
(prefix (and (eq major-mode 'slime-mode)
|
||
(company-grab-symbol)))
|
||
(candidates
|
||
(remove-if-not
|
||
(lambda (c) (string-prefix-p arg c))
|
||
slime-built-ins))
|
||
(meta (sample-meta arg))))
|
||
|
||
(add-hook 'slime-mode-hook
|
||
(lambda ()
|
||
(set (make-local-variable 'eldoc-documentation-function) 'my-slime-eldoc-function)
|
||
(set (make-local-variable 'company-backends) '(company-sample-backend))))
|
||
|
||
(provide 'slime-mode)
|