Klimi's new dotfiles with stow.
Nelze vybrat více než 25 témat Téma musí začínat písmenem nebo číslem, může obsahovat pomlčky („-“) a může být dlouhé až 35 znaků.
 
 
 
 
 
 

65 řádky
2.3 KiB

(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)