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

List all classes with named message and doc in m-x slime doc

parent 343f3790
......@@ -2394,11 +2394,51 @@ a security hole but is mighty convenient.")
(setf . "Setf Function")
(type . "Type")
(structure . "Structure")
(gdl-class . "GDL Class")))
(gdl-class . "GDL Class")
(gdl-messages . "GDL Messages")))
(defun map-gendl-classes (fn)
(let ((seen (make-hash-table :test #'eq :size 400)))
(labels ((call (class)
(unless (gethash class seen)
(setf (gethash class seen) t)
(funcall fn class)
(loop for sub in (swank-mop:class-direct-subclasses class) do (call sub)))))
(call (find-class 'gendl:vanilla-mixin*))
(defmethod slime-documentation ((sym symbol) type)
(documentation sym type))
(defun category-prompt (category)
(let* ((string (string category))
(len (length string)))
(when (and (> len 0) (char-equal (aref string (1- len)) #\s))
(setq string (subseq string 0 (1- len))))
(substitute #\space #\- string)))
(defmethod slime-documentation ((sym symbol) (type (eql 'gdl-messages)))
(when-let (key (find-symbol (symbol-name sym) keyword-package))
(let ((messages nil))
(map-gendl-classes (lambda (class)
(when-let (prototype (gendl-class-prototype class))
(block find-message
(flet ((filter (category message)
(when (eq key message)
(let ((desc (format nil " ~@(~a~) in class ~s"
(category-prompt category)
(class-name class))))
(when-let (doc (cadr (gendl:the-object prototype (:slot-documentation key))))
(setq desc
(gdl-clean-doc (concatenate 'string desc ": " doc))))
(push desc messages)
(push #.(string #\Newline) messages))
(return-from find-message))))
(gendl:the-object prototype (:message-list :message-type :local :filter #'filter)))))))
(if (< (length messages) lambda-parameters-limit)
(apply 'concatenate 'string messages)
(reduce (lambda (x y) (concatenate 'string x y)) messages)))))
(defmethod slime-documentation ((sym symbol) (type (eql 'function)))
(let ((arglist (arglist sym))
(fdoc (documentation sym type)))
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