(require 'lisp-mode)
(require 'prog-mode)
(require 'inf-lisp)
(require 'thingatpt)
(require 'xref)
(require 'fennel-eldoc nil 'no-error)
(eval-when-compile
(defvar paredit-space-for-delimiter-predicates))
(declare-function paredit-open-curly "ext:paredit")
(declare-function paredit-close-curly "ext:paredit")
(declare-function lua-mode "ext:lua-mode")
(defcustom fennel-mode-switch-to-repl-after-reload t
"If the focus should switch to the REPL after a module reload."
:group 'fennel-mode
:type 'boolean
:package-version '(fennel-mode "0.1.0"))
(defcustom fennel-program "fennel --repl"
"Command to run the fennel REPL."
:group 'fennel-mode
:type 'string
:package-version '(fennel-mode "0.3.0"))
(defcustom fennel-mode-annotate-completion t
"Whether or not to show kind of completion candidates."
:group 'fennel-mode
:type 'boolean
:package-version '(fennel-mode "0.4.0"))
(defcustom fennel-mode-repl-prompt-regexp ">> "
"Regexp that matches REPL prompt."
:group 'fennel-mode
:type 'regexp
:package-version '(fennel-mode "0.5.0"))
(defcustom fennel-mode-repl-subprompt-regexp "\.\. "
"Regexp that matches REPL subprompt."
:group 'fennel-mode
:type 'regexp
:package-version '(fennel-mode "0.6.0"))
(defcustom fennel-mode-repl-prompt-readonly t
"Whether to use readonly prompt in the Fennel REPL buffer."
:group 'fennel-mode
:type 'boolean
:package-version '(fennel-mode "0.6.0"))
(defcustom fennel-mode-repl-log-communications nil
"Whether to log repl communication to a hidden *fennel-repl-log* buffer."
:group 'fennel-mode
:type 'boolean
:package-version '(fennel-mode "0.6.0"))
(defun fennel-show-documentation (symbol)
"Show SYMBOL documentation in the REPL."
(interactive (lisp-symprompt "Documentation" (lisp-fn-called-at-pt)))
(comint-proc-query
(inferior-lisp-proc)
(format ",doc %s\n" symbol)))
(defun fennel-show-variable-documentation (symbol)
"Show SYMBOL documentation in the REPL.
Main difference from `fennel-show-documentation' is that rather
than a function, a variable at point is picked automatically."
(interactive (lisp-symprompt "Documentation" (lisp-var-at-pt)))
(fennel-show-documentation symbol))
(defun fennel-show-arglist (symbol)
"Query SYMBOL in the scope for arglist.
Multi-syms are queried as is as those are fully qualified.
Non-multi-syms are first queried in the specials field of
Fennel's scope. If not found, then ___replLocals___ is tried.
Finally _G is queried. This should roughly match the symbol
lookup that Fennel does in the REPL."
(interactive (lisp-symprompt "Arglist" (format "%s" (lisp-fn-called-at-pt))))
(if (featurep 'fennel-eldoc)
(comint-proc-query
(inferior-lisp-proc)
(format "%s\n"
(fennel-eldoc-arglist-query-command
symbol " " (format "Arglist for %s:\n" symbol))))
(message "fennel-eldoc module is required to access the arglist")))
(defvar fennel-mode-syntax-table
(let ((table (make-syntax-table)))
(modify-syntax-entry '(0 . 127) "_" table)
(modify-syntax-entry '(?0 . ?9) "w" table)
(modify-syntax-entry '(?a . ?z) "w" table)
(modify-syntax-entry '(?A . ?Z) "w" table)
(modify-syntax-entry '(?! . ?&) "w" table)
(modify-syntax-entry ?\s " " table)
(modify-syntax-entry ?\xa0 " " table) (modify-syntax-entry ?\t " " table)
(modify-syntax-entry ?\f " " table)
(modify-syntax-entry ?\( "()" table)
(modify-syntax-entry ?\) ")(" table)
(modify-syntax-entry ?\[ "(]" table)
(modify-syntax-entry ?\] ")[" table)
(modify-syntax-entry ?\{ "(}" table)
(modify-syntax-entry ?\} "){" table)
(modify-syntax-entry ?` "'" table)
(modify-syntax-entry ?~ "'" table)
(modify-syntax-entry ?^ "'" table)
(modify-syntax-entry ?@ "'" table)
(modify-syntax-entry ?? "_ p" table)
(modify-syntax-entry ?\ (modify-syntax-entry ?\n ">" table) (modify-syntax-entry ?\" "\"" table) (modify-syntax-entry ?\\ "\\" table)
table)
"Syntax table for Fennel mode.")
(defvar-local fennel-module-name nil
"Buffer-local value for storing the current file's module name.")
(defvar fennel-keywords
'("#" "%" "*" "+" "-" "->" "->>" "-?>" "-?>>" "." ".." "/" "//" ":" "<"
"<=" "=" ">" ">=" "?." "^" "accumulate" "and" "band" "bnot" "bor" "bxor"
"collect" "comment" "do" "doto" "each" "eval-compiler" "fcollect" "fn"
"for" "global" "hashfn" "icollect" "if" "import-macros" "include"
"lambda" "length" "let" "local" "lshift" "lua" "macro" "macrodebug"
"macros" "match" "match-try" "not" "not=" "or" "partial" "pick-args"
"pick-values" "quote" "require-macros" "rshift" "set" "set-forcibly!"
"tset" "values" "var" "when" "while" "with-open" "~=" "λ"
"faccumulate" "case" "case-try"))
(defvar fennel-builtin-functions
'("assert" "collectgarbage" "dofile" "error" "getmetatable" "ipairs" "load"
"loadfile" "next" "pairs" "pcall" "print" "rawequal" "rawget" "rawlen"
"rawset" "require" "select" "setmetatable" "tonumber" "tostring" "type"
"warn" "xpcall"))
(defvar fennel-local-fn-pattern
(rx (syntax open-parenthesis)
(or "fn" "lambda" "λ" "macro") (1+ space)
(group (1+ (or (syntax word) (syntax symbol) "-" "_")))))
(defvar fennel-local-var-pattern
(rx (syntax open-parenthesis)
(or "global" "var" "local") (1+ space)
(group (1+ (or (syntax word) (syntax symbol))))))
(defvar fennel-font-lock-keywords
`((,fennel-local-fn-pattern 1 font-lock-function-name-face)
(,fennel-local-var-pattern 1 font-lock-variable-name-face)
(,(regexp-opt fennel-keywords 'symbols) . font-lock-keyword-face)
(,(regexp-opt fennel-builtin-functions 'symbols) . font-lock-builtin-face)
(,(rx bow "$" (optional digit) eow) . font-lock-keyword-face)
(,(rx (group ":" (1+ word))) 0 font-lock-builtin-face)
(,(rx (group letter (0+ word) "." (1+ word))) 0 font-lock-type-face)
(,(rx bow "&" (optional "as") eow) . font-lock-keyword-face)))
(defvar fennel-doc-string-elt-property 'doc-string-elt
"The symbol property that holds the docstring position info.")
(defun fennel-string-in-doc-position-p (listbeg startpos)
"Return non-nil if a doc string may occur at STARTPOS inside a list.
LISTBEG is the position of the start of the innermost list
containing STARTPOS."
(let* ((firstsym (and listbeg
(save-excursion
(goto-char listbeg)
(and (looking-at "([ \t\n]*\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\)")
(match-string 1)))))
(docelt (and firstsym
(function-get (intern-soft firstsym)
lisp-doc-string-elt-property))))
(and docelt
(save-excursion
(when (functionp docelt)
(goto-char (match-end 1))
(setq docelt (funcall docelt)))
(goto-char listbeg)
(forward-char 1)
(condition-case nil
(while (and (> docelt 0) (< (point) startpos)
(progn (forward-sexp 1) t))
(setq docelt (1- docelt)))
(error nil))
(and (zerop docelt) (<= (point) startpos)
(progn (forward-comment (point-max)) t)
(= (point) startpos))))))
(defun fennel-font-lock-syntactic-face-function (state)
"Return syntactic face function for the position represented by STATE.
STATE is a `parse-partial-sexp' state, and the returned function is the
Lisp font lock syntactic face function."
(if (nth 3 state)
(let ((startpos (nth 8 state)))
(let ((listbeg (nth 1 state)))
(if (fennel-string-in-doc-position-p listbeg startpos)
font-lock-doc-face
font-lock-string-face)))
font-lock-comment-face))
(defun fennel-font-lock-setup ()
"Setup font lock for keywords."
(setq font-lock-defaults
'(fennel-font-lock-keywords
nil nil
(("+-*/.<>=!?$%_&:" . "w"))
nil
(font-lock-mark-block-function . mark-defun)
(font-lock-syntactic-face-function
. fennel-font-lock-syntactic-face-function))))
(defvar calculate-lisp-indent-last-sexp)
(defun fennel-indent-function (indent-point state)
"Simplified version of function `lisp-indent-function'.
INDENT-POINT is the position at which the line being indented begins.
Point is located at the point to indent under (for default indentation);
STATE is the `parse-partial-sexp' state for that position."
(let ((normal-indent (current-column)))
(goto-char (1+ (elt state 1)))
(parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
(let* ((fn (buffer-substring (point) (progn (forward-sexp 1) (point))))
(open-paren (elt state 1))
(method (get (intern-soft fn) 'fennel-indent-function)))
(cond ((member (char-after open-paren) '(?\[ ?\{))
(goto-char open-paren)
(skip-chars-forward (string (char-after open-paren)))
(if (looking-at-p "[ \t\n]")
(progn
(skip-chars-forward "[ \t\n]")
(current-column))
(goto-char open-paren)
(+ 1 (current-column))))
((eq method 'defun)
(lisp-indent-defform state indent-point))
((integerp method)
(lisp-indent-specform method state indent-point normal-indent))
(method
(funcall method indent-point state))
((string-match (rx (or line-start ".") (or "with-" "def")) fn)
(lisp-indent-defform state indent-point))))))
(defun fennel-space-for-delimiter-p (endp _delim)
"Prevent paredit from inserting useless spaces.
See `paredit-space-for-delimiter-predicates' for the meaning of
ENDP and DELIM."
(and (not endp)
(not (looking-back "\\_<#" (if (fboundp 'line-beginning-position)
(line-beginning-position)
(with-no-warnings
(point-at-bol)))))))
(define-derived-mode fennel-mode prog-mode "Fennel"
"Major mode for editing Fennel code.
\\{fennel-mode-map}"
(setq-local comment-add 1) (setq-local comment-column 40)
(setq-local comment-end "")
(setq-local comment-start ";")
(setq-local comment-start-skip ";+ *")
(setq-local comment-use-syntax t)
(setq-local electric-pair-open-newline-between-pairs nil)
(setq-local electric-pair-skip-whitespace 'chomp)
(setq-local fill-paragraph-function #'lisp-fill-paragraph)
(setq-local indent-line-function #'lisp-indent-line)
(setq-local indent-tabs-mode nil)
(setq-local lisp-doc-string-elt-property 'fennel-doc-string-elt)
(setq-local lisp-indent-function #'fennel-indent-function)
(setq-local multibyte-syntax-as-symbol t)
(setq-local normal-auto-fill-function #'do-auto-fill)
(setq-local open-paren-in-column-0-is-defun-start nil)
(setq-local outline-level 'lisp-outline-level)
(setq-local outline-regexp ";;;;* ")
(setq-local paragraph-ignore-fill-prefix t)
(setq-local parse-sexp-ignore-comments t)
(setq-local inferior-lisp-program fennel-program)
(setq-local comint-prompt-regexp (format "^\\(?:%s\\|%s\\)"
fennel-mode-repl-prompt-regexp
fennel-mode-repl-subprompt-regexp))
(setq-local comint-use-prompt-regexp t)
(setq-local inferior-lisp-load-command "((. (require :fennel) :dofile) %s)")
(when (version<= "26.1" emacs-version)
(setq-local adaptive-fill-function #'lisp-adaptive-fill))
(add-to-list 'imenu-generic-expression `(nil ,fennel-local-fn-pattern 1))
(make-local-variable 'completion-at-point-functions)
(add-to-list 'completion-at-point-functions 'fennel-complete)
(set-syntax-table fennel-mode-syntax-table)
(fennel-font-lock-setup)
(add-hook 'paredit-mode-hook #'fennel-paredit-setup nil t)
(when (featurep 'fennel-eldoc)
(if (boundp 'eldoc-documentation-functions)
(add-hook 'eldoc-documentation-functions #'fennel-eldoc-function nil t)
(setq-local eldoc-documentation-function #'fennel-eldoc-function))))
(put 'fn 'fennel-doc-string-elt 3)
(put 'lambda 'fennel-doc-string-elt 3)
(put 'λ 'fennel-doc-string-elt 3)
(put 'macro 'fennel-doc-string-elt 3)
(defun fennel--paredit-setup (mode-map)
"Setup paredit keys for given MODE-MAP."
(define-key mode-map "{" #'paredit-open-curly)
(define-key mode-map "}" #'paredit-close-curly)
(make-local-variable 'paredit-space-for-delimiter-predicates)
(add-to-list 'paredit-space-for-delimiter-predicates #'fennel-space-for-delimiter-p))
(defun fennel-paredit-setup ()
"Setup paredit keys."
(fennel--paredit-setup fennel-mode-map))
(defun fennel-get-module (ask? last-module)
"Ask for the name of a module for the current file; return keyword.
If ASK? or LAST-MODULE were not supplied, asks for the name of a module."
(let ((module (if (or ask? (not last-module))
(read-string "Module: " (or last-module (file-name-base nil)))
last-module)))
(setq fennel-module-name module) (intern (concat ":" module))))
(defun fennel-reload-form (module-keyword)
"Return a string of the code to reload the MODULE-KEYWORD module."
(format "%s\n" `(let [old (require ,module-keyword)
_ (tset package.loaded ,module-keyword nil)
(ok new) (pcall require ,module-keyword)
new (if (not ok) (do (print new) old) new)]
(when (and (= (type old) :table) (= (type new) :table))
(each [k v (pairs new)]
(tset old k v))
(each [k (pairs old)]
(when (= nil ("." new k))
(tset old k nil)))
(tset package.loaded ,module-keyword old)))))
(defun fennel-reload (ask?)
"Reload the module for the current file.
ASK? forces module name prompt.
Tries to reload in a way that makes it retroactively visible; if
the module returns a table, then existing references to the same
module will have their contents updated with the new
value. Requires installing `fennel.searcher'.
Queries the user for a module name upon first run for a given
buffer, or when given a prefix arg."
(interactive "P")
(comint-check-source buffer-file-name)
(let* ((module (fennel-get-module ask? fennel-module-name)))
(when (and (file-exists-p (concat (file-name-base nil) ".lua"))
(yes-or-no-p "Lua file for module exists; delete it first?"))
(delete-file (concat (file-name-base nil) ".lua")))
(comint-send-string (inferior-lisp-proc) (fennel-reload-form module)))
(when fennel-mode-switch-to-repl-after-reload
(switch-to-lisp t)))
(defun fennel-completion--candidate-kind (item)
"Annotate completion kind of the ITEM for company-mode."
(when fennel-mode-annotate-completion
(let ((type (when-let ((buf (fennel-repl-redirect-one
(inferior-lisp-proc)
(format "(print (type %s))" item)
" *fennel-completion-annotation*")))
(with-current-buffer buf
(let ((contents (buffer-substring-no-properties (point-min) (point-max))))
(string-trim (ansi-color-apply contents)))))))
(cond ((string= type "function") 'function)
((string= type "table") 'module)
((and type (string-match-p "tried to reference a macro" type)) 'macro)
((and type (string-match-p "tried to reference a special form" type)) 'keyword)
((string-match-p "\\." item) 'field)
(t 'variable)))))
(defun fennel-completion--annotate (item)
"Annotate completion kind of the ITEM."
(let ((kind (fennel-completion--candidate-kind item)))
(cond ((eq kind 'module) " table")
((eq kind 'variable) " definition")
(kind (format " %s" kind))
(t ""))))
(defun fennel-completions (input)
"Query completions for the INPUT from the `inferior-lisp-proc'."
(condition-case nil
(when input
(let* ((command (format ",complete %s" input))
(proc (inferior-lisp-proc))
(buf (fennel-repl-redirect-one proc command " *fennel-completion*")))
(when buf
(with-current-buffer buf
(let ((contents (buffer-substring-no-properties (point-min) (point-max))))
(split-string (ansi-color-apply contents)))))))
(error nil)))
(defun fennel-complete ()
"Return a list of completion data for `completion-at-point'.
Requires Fennel 0.9.3+."
(interactive)
(let ((bounds (bounds-of-thing-at-point 'symbol))
(completions (fennel-completions (symbol-at-point))))
(when completions
(append
(list (car bounds)
(cdr bounds)
completions
:annotation-function #'fennel-completion--annotate
:company-kind #'fennel-completion--candidate-kind)
(when (featurep 'fennel-eldoc)
(list :company-doc-buffer #'fennel-eldoc-get-doc-buffer))))))
(defun fennel-find-definition-go (location)
"Go to the definition LOCATION."
(when (string-match "^@\\(.+\\)!\\(.+\\)" location)
(let ((file (match-string 1 location))
(line (string-to-number (match-string 2 location))))
(when file (find-file file))
(when line
(goto-char (point-min))
(forward-line (1- line))))))
(defun fennel-find-definition-for (identifier)
"Find the definition of IDENTIFIER."
(let ((tempfile (make-temp-file "fennel-find-")))
(comint-send-string
(inferior-lisp-proc)
(format "%s\n"
`(with-open [f (io.open ,(format "\"%s\"" tempfile) :w)]
(match (-?> ,identifier (debug.getinfo))
{:what :Lua
: source : linedefined} (f:write source :! linedefined)))))
(sit-for 0.1)
(unwind-protect
(when (file-exists-p tempfile)
(with-temp-buffer
(insert-file-contents tempfile)
(delete-file tempfile)
(buffer-substring-no-properties (point-min) (point-max)))))))
(defun fennel-find-definition (identifier)
"Jump to the definition of the function IDENTIFIER at point.
This will only work when the reference to the function is in scope for the repl;
for instance if you have already entered (local foo (require :foo)) then foo.bar
can be resolved. It also requires line number correlation."
(interactive (list (let* ((default-value (symbol-at-point))
(prompt (if default-value
(format "Find definition (default %s): "
default-value)
"Find definition: ")))
(read-string prompt nil nil default-value))))
(xref-push-marker-stack (point-marker))
(fennel-find-definition-go (fennel-find-definition-for identifier)))
(defvar fennel-module-history nil)
(defvar fennel-field-history nil)
(defun fennel-find-module-field (module fields-string)
"Find FIELDS-STRING in the MODULE."
(let ((tempfile (make-temp-file "fennel-module-"))
(fields (mapcar (apply-partially 'concat ":")
(split-string fields-string "\\."))))
(comint-send-string
(inferior-lisp-proc)
(format "%s\n"
`(with-open [f (io.open ,(format "\"%s\"" tempfile) :w)]
(match (-?> ("." (require ,(format "\"%s\"" module)) ,@fields)
(debug.getinfo))
{:what :Lua
: source : linedefined} (f:write source :! linedefined)))))
(sit-for 0.1)
(unwind-protect
(when (file-exists-p tempfile)
(with-temp-buffer
(insert-file-contents tempfile)
(delete-file tempfile)
(buffer-substring-no-properties (point-min) (point-max)))))))
(defun fennel-find-module-definition ()
"Ask for the module and the definition to find in that module."
(interactive)
(let* ((module (read-from-minibuffer "Find in module: " nil nil nil
'fennel-module-history
(car fennel-module-history)))
(fields (read-from-minibuffer "Find module field: " nil nil nil
'fennel-field-history
(car fennel-field-history))))
(xref-push-marker-stack (point-marker))
(fennel-find-definition-go (fennel-find-module-field module fields))))
(defun fennel-find-definition-pop ()
"Return point to previous position in previous buffer."
(interactive)
(require 'etags)
(let ((marker (if (fboundp 'xref-go-back)
(xref-go-back)
(with-no-warnings
(xref-pop-marker-stack)))))
(switch-to-buffer (marker-buffer marker))
(goto-char (marker-position marker))))
(defun fennel-view-compilation ()
"Compile the current buffer contents and view the output."
(interactive)
(let* ((tmp (make-temp-file (buffer-name)))
(compile-command (format "fennel --compile %s" tmp)))
(let ((inhibit-message t))
(write-region (point-min) (point-max) tmp))
(with-current-buffer (switch-to-buffer (format "*fennel %s*" (buffer-name)))
(read-only-mode -1)
(delete-region (point-min) (point-max))
(insert (shell-command-to-string compile-command))
(lua-mode)
(local-set-key (kbd "q") #'bury-buffer)
(read-only-mode 1)
(goto-char (point-min))
(delete-file tmp))))
(defun fennel-macroexpand ()
"Display macro expansion of expression at point in the REPL."
(interactive)
(comint-proc-query
(inferior-lisp-proc)
(format "(macrodebug %s)\n" (thing-at-point 'sexp))))
(defalias 'fennel-macrodebug 'fennel-macroexpand)
(defun fennel-format-region (start end)
"Run fnlfmt on the region."
(interactive "r")
(if (executable-find "fnlfmt")
(shell-command-on-region start end "fnlfmt -" nil t)
(message "fnlfmt not found")))
(defun fennel-format ()
"Run fnlfmt on the current buffer."
(interactive)
(fennel-format-region (point-min) (point-max)))
(define-key fennel-mode-map (kbd "M-.") 'fennel-find-definition)
(define-key fennel-mode-map (kbd "M-,") 'fennel-find-definition-pop)
(define-key fennel-mode-map (kbd "M-'") 'fennel-find-module-definition)
(define-key fennel-mode-map (kbd "C-c C-k") 'fennel-reload)
(define-key fennel-mode-map (kbd "C-c C-l") 'fennel-view-compilation)
(define-key fennel-mode-map (kbd "C-c C-z") 'fennel-repl)
(define-key fennel-mode-map (kbd "C-c C-t") 'fennel-format)
(define-key fennel-mode-map (kbd "C-c C-f") 'fennel-show-documentation)
(define-key fennel-mode-map (kbd "C-c C-d") 'fennel-show-documentation)
(define-key fennel-mode-map (kbd "C-c C-v") 'fennel-show-variable-documentation)
(define-key fennel-mode-map (kbd "C-c C-a") 'fennel-show-arglist)
(define-key fennel-mode-map (kbd "C-c C-p") 'fennel-macroexpand)
(define-key fennel-mode-map (kbd "C-x C-e") 'lisp-eval-last-sexp)
(define-key fennel-mode-map (kbd "C-c C-e") 'lisp-eval-defun)
(define-key fennel-mode-map (kbd "C-M-x") 'lisp-eval-defun)
(define-key fennel-mode-map (kbd "C-c C-n") 'lisp-eval-form-and-next)
(define-key fennel-mode-map (kbd "C-c C-p") 'lisp-eval-paragraph)
(define-key fennel-mode-map (kbd "C-c C-r") 'lisp-eval-region)
(put 'lambda 'fennel-indent-function 'defun)
(put 'λ 'fennel-indent-function 'defun)
(put 'fn 'fennel-indent-function 'defun)
(put 'while 'fennel-indent-function 'defun)
(put 'do 'fennel-indent-function 0)
(put 'let 'fennel-indent-function 1)
(put 'when 'fennel-indent-function 1)
(put 'for 'fennel-indent-function 1)
(put 'each 'fennel-indent-function 1)
(put 'eval-compiler 'fennel-indent-function 'defun)
(put 'macro 'fennel-indent-function 'defun)
(put 'doto 'fennel-indent-function 1)
(put 'match 'fennel-indent-function 1)
(put 'match-try 'fennel-indent-function 1)
(put 'case 'fennel-indent-function 1)
(put 'case-try 'fennel-indent-function 1)
(put 'with-open 'fennel-indent-function 1)
(put 'collect 'fennel-indent-function 1)
(put 'icollect 'fennel-indent-function 1)
(put 'fcollect 'fennel-indent-function 1)
(put 'accumulate 'fennel-indent-function 1)
(put 'faccumulate 'fennel-indent-function 1)
(add-to-list 'auto-mode-alist '("\\.fnl\\'" . fennel-mode))
(add-to-list 'interpreter-mode-alist '("fennel" . fennel-mode))
(defvar fennel-repl--buffer-name "*Fennel REPL*")
(defvar fennel-repl--buffer nil)
(defvar fennel-repl--last-buffer nil)
(defcustom fennel-repl-minify-code 'oneline
"How to minify code before sending it to the process.
The default value of `oneline' should not be changed unless there
are some misbehaviors when interacting with the REPL.
Possible variants:
- \\'strings - collapse strings with literal newlines into
one-line strings with `\\n'.
- \\'comments - remove comments, and lines completely consisting
out of comments.
- \\'both - collapse strings and remove comments.
- \\'oneline - collapse strings, remove comments, and remove any
newlines from the code.
- nil - don't modify anything."
:group 'fennel-mode
:type '(choice
(const :tag "collapse strings" strings)
(const :tag "remove comments" comments)
(const :tag "collapse strings and remove comments" both)
(const :tag "collapse to one line" oneline)
(const :tag "do not change" nil)))
(defun fennel-repl--input-filter (body)
"Input filter for the comint process.
Checks if BODY is a balanced expression."
(with-temp-buffer
(set-syntax-table fennel-mode-syntax-table)
(insert body)
(condition-case nil
(check-parens)
(error (user-error "[Fennel REPL] Input not complete")))))
(defun fennel-repl--remove-comments (buffer)
"Remove comments in the BUFFER."
(with-current-buffer buffer
(when (memq fennel-repl-minify-code '(comments oneline both))
(goto-char (point-min))
(while (re-search-forward ";" nil 'noerror)
(unless (or (nth 3 (syntax-ppss)) (looking-at-p "\""))
(delete-region (1- (point)) (progn (end-of-line) (point)))
(beginning-of-line)
(when (looking-at-p "[[:blank:]]*$")
(delete-line)))))))
(defun fennel-repl--collapse-strings (buffer)
"Replace literal newlines in BUFFER strings with secaped newlines."
(with-current-buffer buffer
(when (memq fennel-repl-minify-code '(strings oneline both))
(goto-char (point-min))
(while (re-search-forward "\"" nil 'noerror)
(when (nth 3 (syntax-ppss))
(let* ((start (1- (point)))
(end (progn (goto-char start)
(forward-sexp)
(point))))
(save-match-data
(save-restriction
(save-excursion
(narrow-to-region start end)
(goto-char (point-min))
(while (re-search-forward "\n" nil 'noerror)
(replace-match "\\\\n")))))))))))
(defun fennel-repl--delete-indentation (buffer)
"Delete all indentation in the BUFFER."
(with-current-buffer buffer
(when (eq fennel-repl-minify-code 'oneline)
(delete-indentation nil (point-min) (point-max)))))
(defun fennel-repl--minify-body (body)
"Minify BODY according to the `fennel-repl-minify-code' setting."
(with-temp-buffer
(let ((buf (current-buffer)))
(set-syntax-table fennel-mode-syntax-table)
(insert body)
(fennel-repl--remove-comments buf)
(fennel-repl--collapse-strings buf)
(fennel-repl--delete-indentation buf)
(string-trim
(buffer-substring-no-properties
(point-min) (point-max))))))
(defmacro fennel-repl--log-event (string event)
"Log the STRING and its EVENT type."
`(when fennel-mode-repl-log-communications
(with-current-buffer (get-buffer-create " *fennel-repl-log*")
(goto-char (point-max))
(insert (format "%s %s\n" ,event (string-trim ,string))))))
(defun fennel-repl--input-sender (proc string)
"Send STRING to PROC via `comint-simple-send' function.
Collapses fennel code as configured in the
`fennel-repl-minify-code' variable."
(let ((expr (fennel-repl--minify-body string)))
(fennel-repl--log-event expr "--eval->")
(comint-simple-send proc expr)))
(defun fennel-repl--make-response-log-handler (event)
"Response log handler builder for EVENT."
(lambda (resp)
(fennel-repl--log-event
(let ((fennel-repl-minify-code 'oneline))
(fennel-repl--minify-body resp))
event)
resp))
(defun fennel-repl--start (cmd &optional buffer)
"Create the REPL buffer for CMD or select an existing one.
If BUFFER is supplied, make it the last buffer."
(let* ((cmdlist (if (fboundp 'split-string-shell-command)
(split-string-shell-command cmd)
(split-string cmd)))
(repl-buffer (apply #'make-comint-in-buffer
fennel-repl--buffer-name
fennel-repl--buffer-name
(car cmdlist) nil (cdr cmdlist))))
(setq fennel-repl--last-buffer (or buffer (current-buffer)))
(setq fennel-repl--buffer repl-buffer)
(setq inferior-lisp-buffer repl-buffer)
(setq-local fennel-program cmd)
(with-current-buffer repl-buffer
(fennel-repl-mode)
(setq-local fennel-program cmd))
(pop-to-buffer repl-buffer)))
(defun fennel-repl (command &optional buffer)
"Switch to the fennel REPL, or start a new one if needed.
If there was a REPL buffer but its REPL process is dead,
a new one is started in the same buffer.
If invoked interactively with a prefix argument, asks for COMMAND
to start the REPL. If optional BUFFER is supplied it is used as
the last buffer before starting the REPL.
The command is persisted as a buffer-local variable, the REPL
buffer remembers the command that was used to start it.
Resetting the command to another value can be done by invoking by
using a prefix argument.
Return the REPL buffer."
(interactive
(list (if current-prefix-arg
(read-string "Fennel command: " fennel-program)
fennel-program)))
(if (and (eq major-mode 'fennel-repl-mode)
(not current-prefix-arg)
(get-buffer-process (current-buffer)))
(switch-to-buffer-other-window fennel-repl--last-buffer)
(fennel-repl--start command buffer)))
(defun fennel-repl-quit ()
"Kill the Fennel REPL buffer."
(interactive)
(if (not (eq 'fennel-repl-mode major-mode))
(user-error "Not a Fennel REPL buffer")
(let ((kill-buffer-query-functions
(delq 'process-kill-buffer-query-function
kill-buffer-query-functions)))
(kill-buffer))))
(defun fennel-repl-redirect-one (proc expr &optional outbuf)
"Redirect the result of one EXPR to OUTBUF, return the redirection buffer.
PROC must be an active Fennel REPL process. If OUTBUF is not
provided a difault fennel redirection buffer is created.
Can block Emacs if redirected command takes too long to execute.
Handles redirection cleanup in case of quit, waits for the
result."
(when expr
(with-current-buffer (process-buffer proc)
(let ((buf (get-buffer-create (or outbuf " *fennel-redirect*"))))
(with-current-buffer buf
(erase-buffer))
(let ((inhibit-quit t)
comint-preoutput-filter-functions)
(with-local-quit
(fennel-repl--log-event
(let ((fennel-repl-minify-code 'oneline))
(fennel-repl--minify-body expr))
"--redr->")
(comint-redirect-send-command-to-process expr buf proc nil t)
(while (or quit-flag (null comint-redirect-completed))
(accept-process-output proc 0.1 nil t)))
(when quit-flag
(comint-redirect-cleanup)))
(fennel-repl--log-event
(with-current-buffer buf
(let ((fennel-repl-minify-code 'oneline))
(fennel-repl--minify-body
(buffer-substring-no-properties (point-min) (point-max)))))
"<-redr--")
buf))))
(define-derived-mode fennel-repl-mode inferior-lisp-mode "Fennel REPL"
"Major mode for Fennel REPL.
\\{fennel-repl-mode-map}"
:group 'fennel-mode
(let ((prompt-re (format "^\\(?:%s\\|%s\\)"
fennel-mode-repl-prompt-regexp
fennel-mode-repl-subprompt-regexp)))
(setq-local comint-prompt-regexp prompt-re)
(setq-local inferior-lisp-prompt prompt-re))
(setq-local comint-input-sender #'fennel-repl--input-sender)
(setq-local comint-use-prompt-regexp t)
(setq-local comint-prompt-read-only fennel-mode-repl-prompt-readonly)
(add-hook 'comint-input-filter-functions 'fennel-repl--input-filter nil t)
(add-hook 'comint-preoutput-filter-functions (fennel-repl--make-response-log-handler "<-data--") nil t)
(setq-local lisp-indent-function 'fennel-indent-function)
(setq-local lisp-doc-string-elt-property 'fennel-doc-string-elt)
(setq-local comment-end "")
(fennel-font-lock-setup)
(set-syntax-table fennel-mode-syntax-table)
(add-hook 'completion-at-point-functions 'fennel-complete nil t)
(add-hook 'paredit-mode-hook #'fennel-repl-paredit-setup nil t))
(defun fennel-repl-paredit-setup ()
"Setup paredit keys in `fennel-repl-mode'."
(fennel--paredit-setup fennel-repl-mode-map))
(defun fennel-repl-move-beginning-of-line ()
"Go to the beginning of line, then skip past the prompt, if any."
(interactive)
(goto-char (comint-bol)))
(define-key fennel-repl-mode-map (kbd "TAB") 'completion-at-point)
(define-key fennel-repl-mode-map (kbd "C-c C-z") 'fennel-repl)
(define-key fennel-repl-mode-map (kbd "C-c C-f") 'fennel-show-documentation)
(define-key fennel-repl-mode-map (kbd "C-c C-d") 'fennel-show-documentation)
(define-key fennel-repl-mode-map (kbd "C-c C-v") 'fennel-show-variable-documentation)
(define-key fennel-repl-mode-map (kbd "C-c C-a") 'fennel-show-arglist)
(define-key fennel-repl-mode-map (kbd "M-.") 'fennel-find-definition)
(define-key fennel-repl-mode-map (kbd "C-c C-q") 'fennel-repl-quit)
(define-key fennel-repl-mode-map (kbd "C-a") 'fennel-repl-move-beginning-of-line)
(provide 'fennel-mode)