異なるパッケージで関数やマクロを上書きしたら *Trace Output* に警告を出す。 #xyzzy

gistfile1.cl

;; 異なるパッケージで関数やマクロを上書きしたら *Trace Output* に警告を出す
;; #xyzzy

(defmacro with-package-lock (handler &body body)
  `(let ((si-fset #'si:*fset))
     (funcall si-fset 'si:*fset
              #'(lambda (symbol function)
                  (when (and (fboundp symbol)
                             (not (eql (symbol-package symbol) *package*)))
                    (,handler "~A::~A redefined with ~A::~A."
                     (package-name (symbol-package symbol)) (symbol-name symbol)
                     (package-name *package*) (symbol-name symbol)))
                  (funcall si-fset symbol function)))
     (unwind-protect
         (progn ,@body)
       (funcall si-fset 'si:*fset si-fset))))
#+xyzzy
(setf (get 'with-package-lock 'ed::lisp-indent-hook) 1)

gistfile2.cl

;;; 実行例

;; パッケージは :user
*package*
;=> #<package: user>

;; 普通に上書き
(defun user-name ()
  "hoge")
;=> user-name
(user-name)
;=> "hoge"

;; パッケージが違う場合はエラーにする
(with-package-lock error
 (defun machine-name ()
   "hoge"))
;=> editor::machine-name redefined with user::machine-name.

;; パッケージが違う場合は警告するだけ
;; *Trace Output* に警告が出ているはず
(with-package-lock warn
 (defun machine-name ()
   "hoge"))
;=> machine-name
(machine-name)
;=> "hoge"

;; require した先の defmacro を捕まえる
(with-package-lock error
  (require "cmu_loop"))
;=> lisp::loop redefined with LOOP::loop.

;; 構造体のスロット定義
(with-package-lock error
  (defstruct user
    id name email))
;=> editor::user-name redefined with user::user-name.