-;; @@ Freezing:
-;; ============
-;; Freezing transforms a `defadvice' into a redefining `defun/defmacro'
-;; for the advised function without keeping any advice information. This
-;; feature was jwz's idea: It generates a dumpable function definition
-;; whose documentation can be written to the DOC file, and the generated
-;; code does not need any Advice runtime support. Of course, frozen advices
-;; cannot be undone.
-
-;; Freezing only considers the advice of the particular `defadvice', other
-;; already existing advices for the same function will be ignored. To ensure
-;; proper interaction when an already advised function gets redefined with
-;; a frozen advice, frozen advices always use the actual original definition
-;; of the function, i.e., they are always at the core of the onion. E.g., if
-;; an already advised function gets redefined with a frozen advice and then
-;; unadvised, the frozen advice remains as the new definition of the function.
-
-;; While multiple freeze advices for a single function or freeze-advising
-;; of an already advised function are possible, they are better avoided,
-;; because definition/compile/load ordering is relevant, and it becomes
-;; incomprehensible pretty quickly.
-
-(defun ad-make-freeze-definition (function advice class position)
- (if (not (ad-has-proper-definition function))
- (error
- "ad-make-freeze-definition: `%s' is not yet defined"
- function))
- (let* ((name (ad-advice-name advice))
- ;; With a unique origname we can have multiple freeze advices
- ;; for the same function, each overloading the previous one:
- (unique-origname
- (intern (format "%s-%s-%s" (ad-make-origname function) class name)))
- (orig-definition
- ;; If FUNCTION is already advised, we'll use its current origdef
- ;; as the original definition of the frozen advice:
- (or (ad-get-orig-definition function)
- (symbol-function function)))
- (old-advice-info
- (if (ad-is-advised function)
- (ad-copy-advice-info function)))
- (real-docstring-fn
- (symbol-function 'ad-make-advised-definition-docstring))
- (real-origname-fn
- (symbol-function 'ad-make-origname))
- (frozen-definition
- (unwind-protect
- (progn
- ;; Make sure we construct a proper docstring:
- (ad-safe-fset 'ad-make-advised-definition-docstring
- 'ad-make-freeze-docstring)
- ;; Make sure `unique-origname' is used as the origname:
- (ad-safe-fset 'ad-make-origname (lambda (x) unique-origname))
- ;; No we reset all current advice information to nil and
- ;; generate an advised definition that's solely determined
- ;; by ADVICE and the current origdef of FUNCTION:
- (ad-set-advice-info function nil)
- (ad-add-advice function advice class position)
- ;; The following will provide proper real docstrings as
- ;; well as a definition that will make the compiler happy:
- (ad-set-orig-definition function orig-definition)
- (ad-make-advised-definition function))
- ;; Restore the old advice state:
- (ad-set-advice-info function old-advice-info)
- ;; Restore functions:
- (ad-safe-fset
- 'ad-make-advised-definition-docstring real-docstring-fn)
- (ad-safe-fset 'ad-make-origname real-origname-fn))))
- (if frozen-definition
- (let* ((macro-p (ad-macro-p frozen-definition))
- (body (cdr (if macro-p
- (ad-lambdafy frozen-definition)
- frozen-definition))))
- `(progn
- (if (not (fboundp ',unique-origname))
- (fset ',unique-origname
- ;; avoid infinite recursion in case the function
- ;; we want to freeze is already advised:
- (or (ad-get-orig-definition ',function)
- (symbol-function ',function))))
- (,(if macro-p 'defmacro 'defun)
- ,function
- ,@body))))))
-
-