Path: utzoo!attcan!uunet!seismo!sundc!pitstop!sun!decwrl!ucbvax!PEBBLES.BBN.COM!jr
From: jr@PEBBLES.BBN.COM (John Robinson)
Newsgroups: comp.emacs
Subject: Re: redefining functions in gnuemacs
Message-ID: <4539.579446600@pebbles>
Date: 12 May 88 13:23:20 GMT
References: <10804@steinmetz.ge.com>
Sender: daemon@ucbvax.BERKELEY.EDU
Reply-To: jr@bbn.com
Organization: The Internet
Lines: 98
>> 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
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: bound to the symbol function of function
mdw:-documentation which will be the doc
string for the function.
mdw:-before-hooks, a list of functions to funcall
before execution. These functions will be called with the
same arguments as the original function.
mdw:-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))))))