weissman@apollo.uucp (Mark Weissman) (05/09/88)
Here's a macro that takes an existing function and adds
before and after hooks to it. It may lose for some
interactive arguments but its great for things like
checking parenthesis before saving a file etc.
Its used like:
(mdw:add-hooks some-existing-function)
(setq
mdw:some-existing-function-before-hooks '(func-1 func-2 ...)
mdw:some-existing-function-after-hooks '(func-3 func-4 ...))
Mark Weissman
APOLLO Computer Inc.
;;; -*- Mode: Emacs-Lisp -*-
(defvar mdw:gensym-name "GENSYM")
(defvar mdw:genysm-number 0)
(defmacro mdw:gensym ()
"Generate a new unused symbol"
(let (s)
(while (or (boundp (setq s (intern (format "mdw:%s-%s"
mdw:gensym-name
(setq mdw:gensym-number
(1+ mdw:gensym-number))))))
(fboundp s)))
(list 'quote s)))
(defmacro mdw:add-hooks (function)
"This macro is called with a symbol representing an emacs lisp
function. This function is redefined to funcall a list
of hooks before and after function execution.
This will may lose with complex (interactive) args.
This will create local-variables as follows:
mdw:<function-name> bound to the symbol function of function
mdw:<function-name>-documentation which will be the doc
string for the function.
mdw:<function-name>-before-hooks, a list of functions to funcall
before execution. These functions will be called with the
same arguments as the original function.
mdw:<function-name>-after-hooks, a list of functions to funcall
after execution. These functions will be called with the
result of executing the original function followed by the
original arguments.
This will take and return the same arguments as the original function.
"
(let* ((mdw-name (concat "mdw:" (symbol-name function)))
(mdw-before (concat mdw-name "-before-hooks"))
(mdw-after (concat mdw-name "-after-hooks"))
(mdw-doc (concat mdw-name "-documentation"))
(args (mdw:gensym))
(hook (mdw:gensym))
(result (mdw:gensym)))
(if (fboundp function)
(list 'progn
(list 'defvar (intern mdw-name)
(list 'symbol-function (list 'quote function)))
(list 'defvar (intern mdw-doc)
(list 'documentation (list 'quote function)))
(list 'defvar (intern mdw-before) nil)
(list 'defvar (intern mdw-after) nil)
(list 'defun function (list '&rest args)
(concat
(if (boundp (intern mdw-doc))
(eval (intern mdw-doc))
(documentation function))
"\n\nAdded hooks: " mdw-before " &\n"
" " mdw-after ".")
'(interactive)
(list 'mapcar
(list 'function
(list 'lambda (list hook)
(list 'apply hook args)))
(intern mdw-before))
(list 'let
(list
(list result (list 'apply (intern mdw-name) args)))
(list 'mapcar
(list 'function (list 'lambda (list hook)
(list 'apply hook args)))
(intern mdw-after))
result))))))liberte@uiucdcsm.cs.uiuc.edu (05/11/88)
/* Written 10:06 am May 5, 1988 by jwg1@bunny.UUCP in uiucdcsm:comp.emacs */ /* ---------- "redefining functions in gnuemacs" ---------- */ I would like to invoke a function every time delete-file is called. There doesn't appear to be a delete-file-hooks. Can I redefine delete-file and still use the old delete-file somehow ? -- Jim Gish /* End of text from uiucdcsm:comp.emacs */ You can redefine delete-file as you suggest. To get the current function for a symbol, use the symbol-function function, e.g. (setq old-delete-file (symbol-function 'delete-file)) However, delete-file is a primitive function and any calls to a primitive by a primitive will not use a lisp redefinition. There is a call of delete-file in the rename-file primitive. dan
jr@PEBBLES.BBN.COM (John Robinson) (05/12/88)
>> Someone has also posted some code for adding hooks to arbitrary >> functions; this is probably the best way to go, but I don't >> recall the poster. Here 'tis... /jr jr@bbn.com or bbn!jr -------- Date: 8 May 88 17:22:00 GMT From: Mark Weissman <apollo!weissman@EDDIE.MIT.EDU> Organization: Apollo Computer, Chelmsford, Mass. Subject: redefining functions in gnuemacs Message-Id: <3bee854e.12972@apollo.uucp> Sender: unix-emacs-request@BBN.COM To: unix-emacs@BBN.COM Here's a macro that takes an existing function and adds before and after hooks to it. It may lose for some interactive arguments but its great for things like checking parenthesis before saving a file etc. Its used like: (mdw:add-hooks some-existing-function) (setq mdw:some-existing-function-before-hooks '(func-1 func-2 ...) mdw:some-existing-function-after-hooks '(func-3 func-4 ...)) Mark Weissman APOLLO Computer Inc. ;;; -*- Mode: Emacs-Lisp -*- (defvar mdw:gensym-name "GENSYM") (defvar mdw:genysm-number 0) (defmacro mdw:gensym () "Generate a new unused symbol" (let (s) (while (or (boundp (setq s (intern (format "mdw:%s-%s" mdw:gensym-name (setq mdw:gensym-number (1+ mdw:gensym-number)))))) (fboundp s))) (list 'quote s))) (defmacro mdw:add-hooks (function) "This macro is called with a symbol representing an emacs lisp function. This function is redefined to funcall a list of hooks before and after function execution. This will may lose with complex (interactive) args. This will create local-variables as follows: mdw:<function-name> bound to the symbol function of function mdw:<function-name>-documentation which will be the doc string for the function. mdw:<function-name>-before-hooks, a list of functions to funcall before execution. These functions will be called with the same arguments as the original function. mdw:<function-name>-after-hooks, a list of functions to funcall after execution. These functions will be called with the result of executing the original function followed by the original arguments. This will take and return the same arguments as the original function. " (let* ((mdw-name (concat "mdw:" (symbol-name function))) (mdw-before (concat mdw-name "-before-hooks")) (mdw-after (concat mdw-name "-after-hooks")) (mdw-doc (concat mdw-name "-documentation")) (args (mdw:gensym)) (hook (mdw:gensym)) (result (mdw:gensym))) (if (fboundp function) (list 'progn (list 'defvar (intern mdw-name) (list 'symbol-function (list 'quote function))) (list 'defvar (intern mdw-doc) (list 'documentation (list 'quote function))) (list 'defvar (intern mdw-before) nil) (list 'defvar (intern mdw-after) nil) (list 'defun function (list '&rest args) (concat (if (boundp (intern mdw-doc)) (eval (intern mdw-doc)) (documentation function)) "\n\nAdded hooks: " mdw-before " &\n" " " mdw-after ".") '(interactive) (list 'mapcar (list 'function (list 'lambda (list hook) (list 'apply hook args))) (intern mdw-before)) (list 'let (list (list result (list 'apply (intern mdw-name) args))) (list 'mapcar (list 'function (list 'lambda (list hook) (list 'apply hook args))) (intern mdw-after)) result))))))