blob: a22807a16ddbb671f598700655bd3c1d00438bd6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
(in-package :swank)
(defslimefun package= (string1 string2)
(let* ((pkg1 (guess-package string1))
(pkg2 (guess-package string2)))
(and pkg1 pkg2 (eq pkg1 pkg2))))
(defslimefun export-symbol-for-emacs (symbol-str package-str)
(let ((package (guess-package package-str)))
(when package
(let ((*buffer-package* package))
(export `(,(from-string symbol-str)) package)))))
(defslimefun unexport-symbol-for-emacs (symbol-str package-str)
(let ((package (guess-package package-str)))
(when package
(let ((*buffer-package* package))
(unexport `(,(from-string symbol-str)) package)))))
#+sbcl
(defun list-structure-symbols (name)
(let ((dd (sb-kernel:find-defstruct-description name )))
(list* name
(sb-kernel:dd-default-constructor dd)
(sb-kernel:dd-predicate-name dd)
(sb-kernel::dd-copier-name dd)
(mapcar #'sb-kernel:dsd-accessor-name
(sb-kernel:dd-slots dd)))))
#+ccl
(defun list-structure-symbols (name)
(let ((definition (gethash name ccl::%defstructs%)))
(list* name
(ccl::sd-constructor definition)
(ccl::sd-refnames definition))))
(defun list-class-symbols (name)
(let* ((class (find-class name))
(slots (swank-mop:class-direct-slots class)))
(labels ((extract-symbol (name)
(if (and (consp name) (eql (car name) 'setf))
(cadr name)
name))
(slot-accessors (slot)
(nintersection (copy-list (swank-mop:slot-definition-readers slot))
(copy-list (swank-mop:slot-definition-readers slot))
:key #'extract-symbol)))
(list* (class-name class)
(mapcan #'slot-accessors slots)))))
(defslimefun export-structure (name package)
(let ((*package* (guess-package package)))
(when *package*
(let* ((name (from-string name))
(symbols (cond #+(or sbcl ccl)
((or (not (find-class name nil))
(subtypep name 'structure-object))
(list-structure-symbols name))
(t
(list-class-symbols name)))))
(export symbols)
symbols))))
(provide :swank-package-fu)
|
