> >BTW, eieio is really cool. How do you think to add GtkObject/GObject's
> >signal like mechanism to eieio? (We will call it `hook'.)
> [ ... ]
>
> EIEIO is a port of CLOS, and extended where appropriate for Emacs
> facilities like custom, or lack of appropriate CL constructs.
>
> I am unaware of any signaling type mechanisms, nor am I too familiar
> with them.
>
> I commonly add hooks by just having a slot with a ":type 'function"
> specifier and call it where appropriate.
>
> Eric
Gtk's signal is similar to emacs's hook. However, in some aspects
Gtk's signal is more powerful than emacs's hook.
As you wrote ":type 'function" does what I want a bit. But not enough.
1) The is no agreement about number of arguments between hook and callback
functions.
(defun hook-func0 ())
(add-hook 'test-hook 'hook-func0)
(run-hook-with-args 'test-hook "xxx")
2) Client arguments are not supported.
You cannot pass hook function private data.
In above text, I call client arguments extra arguments.
I've extended hook mechanisms that overcome above limits.
Simple example:
(defhook message-broadcast-hook (func) "Just an example")
(defun hook-func (func msg) (funcall func msg) (sit-for 1))
(connect-hook 'message-broadcast-hook 'hook-func "E")
(connect-hook 'message-broadcast-hook 'hook-func "EI")
(connect-hook 'message-broadcast-hook 'hook-func "EIE")
(connect-hook 'message-broadcast-hook 'hook-func "EIEI")
(connect-hook 'message-broadcast-hook 'hook-func "EIEIO")
(emit-hook 'message-broadcast-hook 'message)
(describe-hook 'message-broadcast-hook)
Read comments in the program to know more.
What I'd like to do is add this new hook mechanism to eieio.
Imaginary code:
(defclass testclass nil
((state-changed :type hook
:arglist ((obj testclass) n)
:documentation "Hook called when the state is changed. N is number."))
"Test class")
(defun hook-func (obj n)
...)
(oconnect testclass state-changed hook-func)
...
(oemit testclass state-changed 42)
Masatake YAMATO
;; hook.el --- extended hook mechanism
;;
;; Copyright (C) 2003 Masatake YAMATO
;;
;; Author: Masatake YAMATO <jet@...>
;; Created: Thu May 1 19:55:05 2003
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;;; Commentary:
;;
;; Simple example:
;; (defhook message-broadcast-hook (func) "Just an example")
;; (defun hook-func (func msg) (funcall func msg) (sit-for 1))
;;
;; (connect-hook 'message-broadcast-hook 'hook-func "E")
;; (connect-hook 'message-broadcast-hook 'hook-func "EI")
;; (connect-hook 'message-broadcast-hook 'hook-func "EIE")
;; (connect-hook 'message-broadcast-hook 'hook-func "EIEI")
;; (connect-hook 'message-broadcast-hook 'hook-func "EIEIO")
;;
;; (emit-hook 'message-broadcast-hook 'message)
;;
;; This program provides following extension for emacs hook mechanism:
;; 1) Unification two run-hook* functions: `run-hooks' and `run-hook-with-args'.
;; Even if a hook takes arguments or not, you need call single new function
;; `emit-hook'.
;;
;; 2) Checking the number of arugments.
;; The number of arugments of a hook and the hook functions are checked.
;; First you can declare how many arguments a hook takes with new macro
;; `defhook'.
;; e.g. (defhook test-hook (filename versoin) "Hook example")
;;
;; This arguments declaration is used in `connect-hook', the replacement
;; of `add-hook' and `emit-hook'.
;; e.g. (defun test-func1 (f v) ...)
;; (connect-hook 'test-hook 'test-func1)
;;
;; Above code may work fine. Because test-func1 takes two arguments;
;; test-hook is defined with the arguments list: (filename versoin).
;; Both are matched.
;; In other hand following code causes an error because the numbers of arguments
;; are not matched.
;; e.g. (defun test-func2 (f) ...)
;; (connect-hook 'test-hook 'test-func2)
;; The number of arguments for `emit-hook' is also checked.
;; e.g. (emit-hook `test-hook "emacs" "21.3.50")
;;
;; This may work well. The number of arguments, "emacs" and "21.3.50" are
;; matched to the declaration of test-hook: (filename versoin).
;; Following causes an error:
;; e.g. (emit-hook `test-hook "emacs" "21.3.50" "something")
;; (emit-hook `test-hook)
;;
;; 3) Hook function side extra arguments
;; When you connect a hook function to a hook with `connect-hook', you can
;; pass extra arguments. The extra arguments are just registered when you
;; call `connect-hook'. But when you call `emit-hook', the registered extra
;; arguments are passed to the hook function.
;; e.g. (defun test-func3 (f v ex))
;; (connect-hook 'test-hook 'test-func3 "extra"
;; (emit-hook `test-hook "emacs" "21.3.50")
;; When test-func3 is called in `emit-hook', f is bound to "emacs".
;; v is bound to "21.3.50". ex is bound to "extra".
;; Even if you passed extra arguments, 2) the number of arugments checking is
;; done.
;;
;; 4) M-x describe-hook
;;
;;; Code:
(require 'help-fns)
(require 'advice)
(defvar hook-global-hooks-list ()
"List of hooks defined in defhook.")
(defalias 'defhook 'hook-defhook)
(defmacro hook-defhook (hook arglist &optional docstring)
"Define HOOK as a hook.
You are not required to define a hook in order to use it, but the
definition can supply documentation and arglist.
ARGLIST is used for checking number of arguments, when
`connect-hook'(similar to `add-hook'), `emit-hook'(similar to
`run-hook-with-args') is called. `describe-hook' shows the document
of a hook if it is defined with `defhook'.
Example 1.
Define two hook functions. `foo' takes one argument.
(defun foo (x) (message x))
`bar' takes two arguments.
(defun bar (a b) (insert (concat a b)))
Define hook that passes one argument to hook functions: MSG.
(defhook test-hook (msg))
Connect `foo' and `bar' to `test-hook':
(connect-hook 'test-hook 'foo)
(connect-hook 'test-hook 'bar \"!\")
`bar' takes one extra argument.
Emit `test-hook':
(emit-hook 'test-hook \"hello, world\")
=> works fine.
Above emission calls (foo \"hello, works\") and (bar \"hello, works\" \"!\")
inside.
Example 2.
Define a hook function that takes two argument.
(defun baz (a b) ...)
Connect `baz' to `test-hook':
(connect-hook 'test-hook 'baz)
=> error because the number of arguments for `baz' and `test-hook' are not matched.
`baz' takes two arguments. `test-hook' passes one argument to the hook function.
Example 3.
Emit `test-hook' with two arguments:
(emit-hook 'test-hook \"hello, world\" \"xxx\"))
=> error because the number of arguments passed to emit-hook and that for
test-hook are not matched.
"
`(progn
(if (not (numberp (length ',arglist)))
(error "wrong-type-of-argument"))
(prog1
(defconst ,hook nil
(format
(case (length ',arglist)
(0 "A hook with no argument.\n%s")
(1 "A hook with one argument.\n%s")
(t (format "A hook with %d arguments.\n%%s" (length ',arglist) )))
(if ,docstring ,docstring "Not documented")))
(hook-put-spec ',hook ',arglist ,docstring)
(setq hook-global-hooks-list (adjoin ',hook hook-global-hooks-list)))))
(put 'defhook 'lisp-indent-function 'defun)
(defmacro hook-p (hook)
"Non-nil iff HOOK is a type of hook."
`(if (hook-get-spec ,hook)
t
nil))
(defmacro connect-hook (hook function &rest extra-args)
`(connect-hook-internal ,hook ,function t nil ,@extra-args))
(defmacro connect-hook-prepend (hook function &rest extra-args)
`(connect-hook-internal ,hook ,function nil nil ,@extra-args))
(defmacro connect-to-local-hook (hook function &rest extra-args)
`(connect-hook-internal ,hook ,function t t ,@extra-args))
(defmacro connect-to-local-hook-prepend (hook function &rest extra-args)
`(connect-hook-internal ,hook ,function nil t ,@extra-args))
(defun connect-hook-internal (hook function append local &rest extra-args)
"Similar to add-hook, but checking number of arguments and passing extra arguments to the function.
EXTRA-ARGS is passed to function when the hook is emitted.
FUNCTION's arglist, the number of EXTRA-ARGS and HOOK's arglist given with `defhook` are
compared. The number of FUNCTION arguments must be equal to the number EXTRA-ARGS plus
the number of HOOK's argument. If number of arguments are matched, `connect-hook` is the
same to `add-hook'. If not, raise an error.
This returns a lambda added to HOOK. You can pass the return value to `remove-hook' or
`disconnect-hook' to remove the function from the hook."
(unless (hook-p hook)
(error "%S is not defined as a hook" hook))
(let* ((num (hook-get-number-of-hook-arguments hook))
(arglist (hook-get-hook-arglist hook))
closure)
(assert (not (eq arglist t)) "hook.el's internal error")
(hook-check-number-of-arguments
function
(+ num (length extra-args))
"Number of arguments taken by function are not matched with hook")
(setq closure (hook-generate-funciton
function
arglist
extra-args))
(add-hook hook closure append local)
closure))
(defun disconnect-hook (hook function)
(remove-hook hook function nil))
(defun disconnect-local-hook (hook function)
(remove-hook hook function t))
(defmacro emit-hook (hook &rest args)
"Similar to run-hook-with-args, but checking number and type(not implemented yet) of arguments.
ARGS and HOOK's arglist given with `defhook` are compared.
If number of arguments and type of them are matched, `emit-hook` is the
same to `run-hook-with-args'. If not, raise an error."
`(let* ((num (hook-get-number-of-hook-arguments ,hook)))
(unless (hook-p ,hook)
(error "%S is not defined as a hook" ,hook))
(unless (eq num (length ',args))
(error "Number of arguments are not match with hook"))
(run-hook-with-args ,hook ,@args)))
(defmacro emit-hook-until-success (hook &rest args)
`(let* ((num (hook-get-number-of-hook-arguments ,hook)))
(unless (hook-p ,hook)
(error "%S is not defined as a hook" ,hook))
(unless (eq num (length ',args))
(error "Number of arguments are not match with hook"))
(run-hook-with-args-until-success ,hook ,@args)))
(defmacro emit-hook-until-failure (hook &rest args)
`(let* ((num (hook-get-number-of-hook-arguments ,hook)))
(unless (hook-p ,hook)
(error "%S is not defined as a hook" ,hook))
(unless (eq num (length ',args))
(error "Number of arguments are not match with hook"))
(run-hook-with-args-until-failure ,hook ,@args)))
(defmacro emit-hook (hook &rest args)
"Similar to run-hook-with-args, but checking number and type(not implemented yet) of arguments.
ARGS and HOOK's arglist given with `defhook` are compared.
If number of arguments and type of them are matched, `emit-hook` is the
same to `run-hook-with-args'. If not, raise an error."
`(let* ((num (hook-get-number-of-hook-arguments ,hook)))
(unless (hook-p ,hook)
(error "%S is not defined as a hook" ,hook))
(unless (eq num (length ',args))
(error "Number of arguments are not match with hook"))
(run-hook-with-args ,hook ,@args)))
;;
;; Helper functions
;;
(defvar hook-read-hook nil
"History of the function `hook-read-hook' prompt.")
(defun hook-build-hook-alist ()
(mapcar (lambda (x)
(list (symbol-name x)))
hook-global-hooks-list))
(defun hook-read-hook (prompt &optional histvar)
"Return a hook chosen by the user using PROMPT.
Optional argument HISTVAR is a variable to use as history."
(intern (completing-read prompt (hook-build-hook-alist) nil t nil
(or histvar 'hook-read-hook))))
(defun hook-get-function-arglist (func)
(help-function-arglist func))
;; (hook-get-min-number-of-function-arguments 'find-file)
;; (hook-get-min-number-of-function-arguments 'car)
;; (hook-get-min-number-of-function-arguments 'describe-hook)
;; (hook-get-min-number-of-function-arguments 'emit-hook)
(defun hook-get-min-number-of-function-arguments (func)
;; autoload and builtin returns nil
(let ((arglist (hook-get-function-arglist func))
(min 0))
(unless (listp arglist)
(setq arglist nil)
(setq min nil))
(dolist (elt arglist min)
(cond
((or (eq elt '&optional)
(eq elt '&rest))
(return min))
(t
(incf min))))))
;; (hook-get-max-number-of-function-arguments 'find-file)
;; (hook-get-max-number-of-function-arguments 'car)
;; (hook-get-max-number-of-function-arguments 'describe-hook)
;; (hook-get-max-number-of-function-arguments 'emit-hook)
(defun hook-get-max-number-of-function-arguments (func)
;; autoload and builtin returns nil
;; &rest returns t
(let ((arglist (hook-get-function-arglist func))
(max 0)
optional)
(unless (listp arglist)
(setq arglist nil)
(setq max nil))
(dolist (elt arglist max)
(cond
((eq elt '&optional)
(setq optional t))
((eq elt '&rest)
(setq max t)
(return max))
(t
(incf max))))))
(defun hook-check-number-of-arguments (func num &optional raise-error)
(let* ((min (hook-get-min-number-of-function-arguments func))
(max (hook-get-max-number-of-function-arguments func))
(result (cond
((not min)
;; autoload or builtin
t)
((eq max min)
(eq min num))
((and (<= min num)
(<= num (if (numberp max)
max
(1+ num)))))
(t
nil))))
(if (and raise-error (not result))
(error raise-error))
result))
(defun hook-put-spec (hook num docstring)
(put hook 'hook-defhook-spec (list num docstring)))
(defun hook-get-spec (hook)
(get hook 'hook-defhook-spec))
(defun hook-get-hook-arglist (hook)
"Get arguments list from HOOK.
Return t if no arguments list is attached to HOOK."
(let ((spec (hook-get-spec hook)))
(hook-get-hook-arglist-from-spec spec)))
(defun hook-get-hook-arglist-from-spec (spec)
"Get arguments list from SPEC
Return t if SPEC is not list."
(if (listp spec)
(car spec)
t))
(defun hook-get-number-of-hook-arguments (hook)
"Get number of arguments of HOOK.
Return -1 if no arguments list is attached to HOOK."
(let ((arglist (hook-get-hook-arglist hook)))
(if (eq arglist t)
-1
(length (hook-get-hook-arglist hook)))))
(defun hook-get-hook-docstring (hook)
(car (cdr (hook-get-spec hook))))
(defvar hook-generate-timestamp 0)
(defun hook-generate-funciton (function hook-arglist &optional extra-args)
(incf hook-generate-timestamp)
(list 'lambda
hook-arglist
hook-generate-timestamp
(list 'apply (list 'quote function)
(cons 'list
(if extra-args
(append hook-arglist extra-args)
hook-arglist)))))
(defun hook-ungenerate-funciton (function)
(let* ((base (cdr (nth 3 function)))
(fsymbol (cadar base))
(fargs (cdadr base)))
(cons fsymbol fargs)))
;;
;; Help
;;
(defun describe-hook (hook)
(interactive (list (hook-read-hook "Hook: ")))
(unless (hook-p hook)
(error "%S is not defined as a hook" hook))
(let ((doc (hook-get-hook-docstring hook))
(arglist (hook-get-hook-arglist hook))
(arglen (hook-get-number-of-hook-arguments hook)))
(assert (not (eq arglist t)) "hook.el's internal error")
(with-output-to-temp-buffer "*Help*"
(prin1 hook)
(princ " is a hook that takes ")
(cond
((eq 0 arglen)
(princ "no argument."))
((eq 1 arglen)
(princ "one argument."))
(t
(prin1 arglen)
(princ " arguments.")))
(terpri)
(terpri)
(if doc
(princ doc)
(princ "Not documented as a hook."))
(terpri)
(terpri)
(princ "Expected argument list: ")
(terpri)
(princ "\t")
(prin1 arglist)
(terpri)
(terpri)
(princ "Hook functions: ")
(terpri)
(dolist (f (eval hook))
(princ "\t")
(prin1 (hook-ungenerate-funciton f))
(terpri))
(buffer-string))))
(defadvice describe-variable (around hook-describe activate)
"Display the full documentation of FUNCTION (a symbol).
Returns the documentation as a string, also."
(if (hook-p (ad-get-arg 0))
(describe-hook (ad-get-arg 0))
ad-do-it))
(provide 'hook)
;; hook.el ends here
|