diff options
Diffstat (limited to 'vim/bundle/slimv/slime/contrib/swank-util.lisp')
-rw-r--r-- | vim/bundle/slimv/slime/contrib/swank-util.lisp | 63 |
1 files changed, 63 insertions, 0 deletions
diff --git a/vim/bundle/slimv/slime/contrib/swank-util.lisp b/vim/bundle/slimv/slime/contrib/swank-util.lisp new file mode 100644 index 0000000..72743ba --- /dev/null +++ b/vim/bundle/slimv/slime/contrib/swank-util.lisp @@ -0,0 +1,63 @@ +;;; swank-util.lisp --- stuff of questionable utility +;; +;; License: public domain + +(in-package :swank) + +(defmacro do-symbols* ((var &optional (package '*package*) result-form) + &body body) + "Just like do-symbols, but makes sure a symbol is visited only once." + (let ((seen-ht (gensym "SEEN-HT"))) + `(let ((,seen-ht (make-hash-table :test #'eq))) + (do-symbols (,var ,package ,result-form) + (unless (gethash ,var ,seen-ht) + (setf (gethash ,var ,seen-ht) t) + (tagbody ,@body)))))) + +(defun classify-symbol (symbol) + "Returns a list of classifiers that classify SYMBOL according to its +underneath objects (e.g. :BOUNDP if SYMBOL constitutes a special +variable.) The list may contain the following classification +keywords: :BOUNDP, :FBOUNDP, :CONSTANT, :GENERIC-FUNCTION, +:TYPESPEC, :CLASS, :MACRO, :SPECIAL-OPERATOR, and/or :PACKAGE" + (check-type symbol symbol) + (flet ((type-specifier-p (s) + (or (documentation s 'type) + (not (eq (type-specifier-arglist s) :not-available))))) + (let (result) + (when (boundp symbol) (push (if (constantp symbol) + :constant :boundp) result)) + (when (fboundp symbol) (push :fboundp result)) + (when (type-specifier-p symbol) (push :typespec result)) + (when (find-class symbol nil) (push :class result)) + (when (macro-function symbol) (push :macro result)) + (when (special-operator-p symbol) (push :special-operator result)) + (when (find-package symbol) (push :package result)) + (when (and (fboundp symbol) + (typep (ignore-errors (fdefinition symbol)) + 'generic-function)) + (push :generic-function result)) + result))) + +(defun symbol-classification-string (symbol) + "Return a string in the form -f-c---- where each letter stands for +boundp fboundp generic-function class macro special-operator package" + (let ((letters "bfgctmsp") + (result (copy-seq "--------"))) + (flet ((flip (letter) + (setf (char result (position letter letters)) + letter))) + (when (boundp symbol) (flip #\b)) + (when (fboundp symbol) + (flip #\f) + (when (typep (ignore-errors (fdefinition symbol)) + 'generic-function) + (flip #\g))) + (when (type-specifier-p symbol) (flip #\t)) + (when (find-class symbol nil) (flip #\c) ) + (when (macro-function symbol) (flip #\m)) + (when (special-operator-p symbol) (flip #\s)) + (when (find-package symbol) (flip #\p)) + result))) + +(provide :swank-util) |