You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
144 lines
4.7 KiB
144 lines
4.7 KiB
;;; le-lisp.el --- lispy support for Common Lisp. -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2014-2015 Oleh Krehel
|
|
|
|
;; This file is not part of GNU Emacs
|
|
|
|
;; This file is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 3, or (at your option)
|
|
;; any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; For a full copy of the GNU General Public License
|
|
;; see <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
;;
|
|
|
|
;;; Code:
|
|
|
|
(eval-and-compile
|
|
(require 'slime nil t)
|
|
(require 'sly nil t))
|
|
|
|
(declare-function slime-output-buffer "ext:slime-repl")
|
|
(declare-function slime "ext:slime")
|
|
(declare-function slime-current-connection "ext:slime")
|
|
(declare-function slime-eval "ext:slime")
|
|
(declare-function slime-edit-definition "ext:slime")
|
|
(declare-function sly-mrepl--find-buffer "ext:sly-mrepl")
|
|
(declare-function sly "ext:sly")
|
|
(declare-function sly-current-connection "ext:sly")
|
|
(declare-function sly-eval "ext:sly")
|
|
(declare-function sly-edit-definition "ext:sly")
|
|
|
|
(defcustom lispy-use-sly nil
|
|
"Whether to use SLY instead of SLIME."
|
|
:group 'lispy
|
|
:type 'boolean)
|
|
|
|
(defun lispy--eval-lisp (str)
|
|
"Eval STR as Common Lisp code."
|
|
(let* ((deactivate-mark nil)
|
|
(result (with-current-buffer (process-buffer (lispy--cl-process))
|
|
(if lispy-use-sly
|
|
(sly-eval `(slynk:eval-and-grab-output ,str))
|
|
(slime-eval `(swank:eval-and-grab-output ,str))))))
|
|
(if (equal (car result) "")
|
|
(cadr result)
|
|
(concat (propertize (car result)
|
|
'face 'font-lock-string-face)
|
|
"\n\n"
|
|
(cadr result)))))
|
|
|
|
(defun lispy--cl-process ()
|
|
(unless lispy-use-sly
|
|
(require 'slime-repl))
|
|
(or (if lispy-use-sly
|
|
(sly-current-connection)
|
|
(slime-current-connection))
|
|
(let (conn)
|
|
(let ((wnd (current-window-configuration)))
|
|
(if lispy-use-sly
|
|
(sly)
|
|
(slime))
|
|
(while (not (if lispy-use-sly
|
|
(and (setq conn (sly-current-connection))
|
|
(sly-mrepl--find-buffer conn))
|
|
(and
|
|
(setq conn (slime-current-connection))
|
|
(get-buffer-window (slime-output-buffer)))))
|
|
(sit-for 0.2))
|
|
(set-window-configuration wnd)
|
|
conn))))
|
|
|
|
(defun lispy--lisp-args (symbol)
|
|
"Return a pretty string with arguments for SYMBOL."
|
|
(let ((args
|
|
(list
|
|
(mapconcat
|
|
#'prin1-to-string
|
|
(read (lispy--eval-lisp
|
|
(format (if lispy-use-sly
|
|
"(slynk-backend:arglist #'%s)"
|
|
"(swank-backend:arglist #'%s)")
|
|
symbol)))
|
|
" "))))
|
|
(if (listp args)
|
|
(format
|
|
"(%s %s)"
|
|
(propertize symbol 'face 'lispy-face-hint)
|
|
(mapconcat
|
|
#'identity
|
|
(mapcar (lambda (x) (propertize (downcase x)
|
|
'face 'lispy-face-req-nosel))
|
|
args)
|
|
(concat "\n"
|
|
(make-string (+ 2 (length symbol)) ?\ ))))
|
|
(propertize args 'face 'lispy-face-hint))))
|
|
|
|
(defun lispy--lisp-describe (symbol)
|
|
"Return documentation for SYMBOL."
|
|
(read
|
|
(lispy--eval-lisp
|
|
(substring-no-properties
|
|
(format
|
|
"(let ((x '%s))
|
|
(or (if (boundp x)
|
|
(documentation x 'variable)
|
|
(documentation x 'function))
|
|
\"undocumented\"))"
|
|
symbol)))))
|
|
|
|
(defun lispy-flatten--lisp ()
|
|
(let* ((bnd (lispy--bounds-list))
|
|
(str (lispy--string-dwim bnd))
|
|
(expr (read str))
|
|
(fexpr (read (lispy--eval-lisp
|
|
(format "(function-lambda-expression #'%S)" (car expr))))))
|
|
(if (not (eq (car-safe fexpr) 'SB-INT:NAMED-LAMBDA))
|
|
(error "Could not find the body of %S" (car expr))
|
|
(setq fexpr (downcase
|
|
(prin1-to-string
|
|
`(lambda ,(nth 2 fexpr) ,(cl-caddr (nth 3 fexpr))))))
|
|
(goto-char (car bnd))
|
|
(delete-region (car bnd) (cdr bnd))
|
|
(let* ((e-args (cdr expr))
|
|
(body (lispy--flatten-function fexpr e-args)))
|
|
(lispy--insert body)))))
|
|
|
|
(defun lispy-goto-symbol-lisp (symbol)
|
|
;; start SLY or SLIME if necessary
|
|
(lispy--cl-process)
|
|
(if lispy-use-sly
|
|
(sly-edit-definition symbol)
|
|
(slime-edit-definition symbol)))
|
|
|
|
(provide 'le-lisp)
|
|
|
|
;;; le-lisp.el ends here
|