Commit 9b8e1bb6 authored by Gail Zacharias's avatar Gail Zacharias

Add support for enabling/disabling this version vs the standard one

parent 22d39baa
......@@ -29,11 +29,7 @@
(in-package :gendl-swank)
(defmacro defslimefun (name &rest body)
(assert (eq :external (nth-value 1 (find-symbol (symbol-name name) :swank))))
(defun ,name ,@body)
#+not-yet (maybe-redefine ',(find-symbol (symbol-name name) :swank) ',name)))
(defvar *enable-glime* t "If true, GLIME extensions are enabled. If false, run the unmodified original SWANK versions of everything.")
;;;; Utilities
......@@ -41,6 +37,12 @@
(defun arglist (fn)
(swank::arglist fn))
(defmacro when-let (binding &body body)
(destructuring-bind (var val) binding
`(let ((,var ,val))
(when ,var
(defun compose (&rest functions)
"Compose FUNCTIONS right-associatively, returning a function"
#'(lambda (x)
......@@ -103,6 +105,33 @@ Otherwise NIL is returned."
(progn ,@body))))
(defmacro defslimefun (name &rest body)
(multiple-value-bind (swank-sym flag) (find-symbol (symbol-name name) :swank)
(assert (eq flag :external))
(defun ,name ,@body)
(redefine-slimefun ',swank-sym ',name))))
(defun redefine-slimefun (swank-sym new-fn)
(multiple-value-bind (sym flag) (find-symbol (symbol-name swank-sym) :swank)
(assert (and (eq sym swank-sym) (eq flag :external))))
(unless (get swank-sym 'gendl-unwrapped)
(setf (get swank-sym 'gendl-unwrapped) (symbol-function swank-sym)))
(setf (symbol-function swank-sym)
(lambda (&rest args)
(declare (dynamic-extent args))
(if *enable-glime*
(apply new-fn args)
(when-let (old-fn (get swank-sym 'gendl-unwrapped))
(apply old-fn args)))))
(defun remove-glime ()
(do-external-symbols (swank-sym :swank)
(when-let (fn (get swank-sym 'gendl-unwrapped))
(setf (symbol-function swank-sym) fn)
(remprop swank-sym 'gendl-unwrapped))))
;;;; Arglist Definition
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment