commit 60c5f34193899399bcefe2e55312f38f2c2d5976 Spenser Truex <spensertruexonline@gmail.com> 2019-07-02 18:07:59 -0700 Init.
.gitignore | 2 ++ package.lisp | 2 ++ sl.asd | 10 ++++++++++ sl.lisp | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 77 insertions(+)
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..43e1651 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +png32:- +*.fasl diff --git a/package.lisp b/package.lisp new file mode 100644 index 0000000..ab4ebc0 --- /dev/null +++ b/package.lisp @@ -0,0 +1,2 @@ +(defpackage #:sl + (:use #:cl)) diff --git a/sl.asd b/sl.asd new file mode 100644 index 0000000..50b74eb --- /dev/null +++ b/sl.asd @@ -0,0 +1,10 @@ +(defsystem :sl + :version "0.0.1" + :description "Wrapper for the lowest common denominator of Sly and Slime" + :author "Spenser Truex <web@spensertruex.com>" + :serial t + :license "GNU GPL v3" + :components ((:file "package") + (:file "sl")) + :weakly-depends-on (:slynk :swank) + :depends-on (:alexandria)) diff --git a/sl.lisp b/sl.lisp new file mode 100644 index 0000000..5760a55 --- /dev/null +++ b/sl.lisp @@ -0,0 +1,63 @@ +(in-package :sl) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defun group (source n) + (labels ((rec (source acc) + (let ((rest (nthcdr n source))) + (if (consp rest) + (rec rest (cons + (subseq source 0 n) + acc)) + (nreverse + (cons source acc)))))) + (if source (rec source nil) nil))) + (defvar *preference-list* '("slynk" "swank") + "The order in which to choose the IDE for pinging. Use the name of the CL +interface, not the Emacs name (ie sly->slynk, slime->swank).")) + +(defun select (fn lst) + "Return the first element that matches the function." + (if (null lst) + nil + (let ((val (funcall fn (car lst)))) + (if val + (values (car lst) val) + (select fn (cdr lst)))))) + +(defun select-preference (boundp qnames &optional (preflist *preference-list*)) + (when preflist + (let* ((res (select (lambda (x) (string-equal (car x) (car preflist))) + qnames)) + (package (string-upcase (car res))) + (symname (string-upcase (cadr res)))) + (if (and res (find-package package)) + symname + (select-preference boundp qnames (cdr preflist)))))) + +#+5am (select-preference 'fboundp '(("slynk" "slynk:operator-arglist")) + '("slynk" "swank")) + +(defmacro defweak (namespace boundp sl-name &rest qualified-names) + "Make a weak definition, based on preferences. Probably should use wrapper +functions instead of this one." + ;; FIXME: Why can't I get the symbol's package without errors? + `(setf (,namespace (intern ,sl-name)) + (select-preference ',boundp ',(group qualified-names 2)))) + +(defmacro defweakfn (sl-name &rest qualified-names) + "Define a weak function, based on preferences." + `(defweak symbol-function fboundp ,sl-name ,@qualified-names)) + +(defmacro defweakvar (sl-name &rest qualified-names) + `(defweak symbol-value boundp ,sl-name ,@qualified-names)) + +(defmacro defweakequiv (defweak sl-name &optional (preflist *preference-list*)) + `(,defweak ,sl-name + ,@(mapcar #'(lambda (x) (list x (concatenate 'string x ":" sl-name))) + preflist))) + +(defweakfn "operator-arglist" + "swank" "swank:operator-arglist" + "slynk" "slynk:operator-arglist") + +(defweakequiv defweakfn "operator-arglist")