[script] Improved hook-snooper

[Teika Kazura <teika lavabit com>]

(Sorry for sending many emails in one day. But I can't delay
any of them any more.)

Attached script is an improved version of "hook snooper" written by
Daniel Pfeiffer.

The change is that if a window hook is called, the window name is
printed. Enjoy!

# It may be good to put it under sawfish.dev. (Developers tools dir)

Regards,
Teika (Teika kazura)

Continental Chinese Goverment doesn't respect laws nor contracts. (Not
to mention humanity.)
Don't assume you're protected as in your society.

#| sawfish.wm.util.hook-snooper -- Code for seeing when which hook gets called

   Copyright (C) 2002 Daniel Pfeiffer <occitan esperanto org>

   This file is part of sawfish.

   sawfish 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.

   sawfish 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 sawfish; see the file COPYING.  If not, write to
   the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

|#

(define-structure sawfish.wm.util.hook-snooper

    (export snoop-hooks
	    unsnoop-hooks)

    (open rep
	  rep.lang.symbols
	  rep.regexp
	  rep.system
	  sawfish.wm)

  (define l ())
  (define ts "")

  (define (snooper hook args)
    (setq args
	  (mapcar
	   (lambda (x)
	     (if (windowp x)
		 (window-name x)
	       x))
	   args))
    (format standard-error "%s%s\n"
	    (if (string= ts (setq ts (current-time-string () "%X")))
		""
	      (format () "----- %s\n" ts))
	    (cons hook args)))

  (define (snoop hook)
    (and (boundp hook)
	 (listp (symbol-value hook))
	 (not (assq hook l))
	 (progn
	   (define (hook-snooper #!rest args)
	     (snooper hook args))
	   (setq l `((,hook . ,hook-snooper) ,@l))
	   (add-hook hook hook-snooper))))

  (define (snoop-hooks #!optional hooks)
    "Snoop a stderr tracing function to all list valued symbols matching \"-hook$\".
If optional `HOOKS' is given and a string, that's the regexp matched instead.
If `HOOKS' is a list, those variables get the funtion."
    (if (consp hooks)
	(filter snoop hooks)
      (apropos (if (stringp hooks) hooks "-hook$")
	       snoop)))

  (define (unsnoop-hooks)
    "Remove all the installed hook snooper functions."
    (mapc (lambda (h)
	    (remove-hook (car h) (cdr h)))
	  l)
    (setq l ())))