Permalink
Fetching contributors…
Cannot retrieve contributors at this time
145 lines (126 sloc) 4.71 KB
;;; 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) ,(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