/[slime]/slime/swank.lisp
ViewVC logotype

Diff of /slime/swank.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.538 by trittweiler, Thu Feb 28 19:43:58 2008 UTC revision 1.539 by trittweiler, Fri Mar 14 14:04:31 2008 UTC
# Line 493  If PACKAGE is not specified, the home pa Line 493  If PACKAGE is not specified, the home pa
493    
494    
495  (defun classify-symbol (symbol)  (defun classify-symbol (symbol)
496    "Returns a list of classifiers that classify SYMBOL according    "Returns a list of classifiers that classify SYMBOL according to its
497  to its underneath objects (e.g. :BOUNDP if SYMBOL constitutes a  underneath objects (e.g. :BOUNDP if SYMBOL constitutes a special
498  special variable.) The list may contain the following classification  variable.) The list may contain the following classification
499  keywords: :BOUNDP, :FBOUNDP, :GENERIC-FUNCTION, :CLASS, :MACRO,  keywords: :BOUNDP, :FBOUNDP, :CONSTANT, :GENERIC-FUNCTION,
500  :SPECIAL-OPERATOR, and/or :PACKAGE"  :TYPESPEC, :CLASS, :MACRO, :SPECIAL-OPERATOR, and/or :PACKAGE"
501    (check-type symbol symbol)    (check-type symbol symbol)
502    (let (result)    (flet ((type-specifier-p (s)
503      (when (boundp symbol)             (push :boundp result))             (or (documentation s 'type)
504      (when (fboundp symbol)            (push :fboundp result))                 (not (eq (type-specifier-arglist s) :not-available)))))
505      (when (find-class symbol nil)     (push :class result))      (let (result)
506      (when (macro-function symbol)     (push :macro result))        (when (boundp symbol)             (push (if (constantp symbol)
507      (when (special-operator-p symbol) (push :special-operator result))                                                    :constant :boundp) result))
508      (when (find-package symbol)       (push :package result))        (when (fboundp symbol)            (push :fboundp result))
509      (when (typep (ignore-errors (fdefinition symbol))        (when (type-specifier-p symbol)   (push :typespec result))
510                   'generic-function)        (when (find-class symbol nil)     (push :class result))
511        (push :generic-function result))        (when (macro-function symbol)     (push :macro result))
512      result))        (when (special-operator-p symbol) (push :special-operator result))
513          (when (find-package symbol)       (push :package result))
514          (when (typep (ignore-errors (fdefinition symbol))
515                       'generic-function)
516            (push :generic-function result))
517    
518          result)))
519    
520  (defun symbol-classification->string (flags)  (defun symbol-classification->string (flags)
521    (format nil "~A~A~A~A~A~A~A"    (format nil "~A~A~A~A~A~A~A~A"
522            (if (member :boundp flags) "b" "-")            (if (or (member :boundp flags)
523                      (member :constant flags)) "b" "-")
524            (if (member :fboundp flags) "f" "-")            (if (member :fboundp flags) "f" "-")
525            (if (member :generic-function flags) "g" "-")            (if (member :generic-function flags) "g" "-")
526            (if (member :class flags) "c" "-")            (if (member :class flags) "c" "-")
527              (if (member :typespec flags) "t" "-")
528            (if (member :macro flags) "m" "-")            (if (member :macro flags) "m" "-")
529            (if (member :special-operator flags) "s" "-")            (if (member :special-operator flags) "s" "-")
530            (if (member :package flags) "p" "-")))            (if (member :package flags) "p" "-")))

Legend:
Removed from v.1.538  
changed lines
  Added in v.1.539

  ViewVC Help
Powered by ViewVC 1.1.5