Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
gendl
gendl
Commits
9a21c678
Commit
9a21c678
authored
Dec 11, 2015
by
Gail Zacharias
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
List all classes with named message and doc in m-x slime doc
parent
343f3790
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
41 additions
and
1 deletion
+41
-1
emacs/glime.lisp
emacs/glime.lisp
+41
-1
No files found.
emacs/glime.lisp
View file @
9a21c678
...
...
@@ -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*
))
nil
)))
(
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
)))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment