Code: Select all
(defun save-symbol (sym)
(copy-symbol (find-symbol (symbol-name sym)) t))
(defun restore-symbol (sym)
(unintern (find-symbol (symbol-name sym)))
(import sym))
(defun replace-symbol (in-sym mode)
(let ((sym (intern (symbol-name in-sym))))
(setf (symbol-plist sym) (symbol-plist in-sym))
(cond ((constantp sym) (error "~S is a constant." sym))
((boundp in-sym) (setf (symbol-value sym)
(symbol-value in-sym)))
((boundp sym) (when (eq mode :substitute) (makunbound sym))))
(cond ((special-operator-p sym) (error "~S is a special operator." sym))
((fboundp in-sym) (if (macro-function in-sym)
(setf (macro-function sym)
(macro-function in-sym))
(progn (fmakunbound sym)
(setf (symbol-function sym)
(symbol-function in-sym)))))
((fmakunbound sym) (when (eq mode :substitute) (fmakunbound sym))))
sym))
(defmacro rebind-from ((pckg &key (mode :substitute)) &body body)
(unless (member mode #1='(:substitute :add))
(error "A bad mode passed: ~S~%Available modes: ~{~S~^, ~}" mode #1#))
(let ((backup (gensym))
(symbols (gensym)))
`(let ((,backup)
(,symbols))
(unwind-protect
(progn (do-external-symbols (sym (find-package ,pckg))
(push sym ,symbols))
(setf ,backup (loop for sym in ,symbols
collect (save-symbol sym)
do (replace-symbol sym ,mode)))
,@body)
(loop for sym in ,backup do (restore-symbol sym))))))