Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!uunet!seismo!mcvax!ukc!hrc63!ciaran
From: ciaran@hrc63.co.uk (Ciaran Byrne)
Newsgroups: comp.emacs
Subject: hooks in Gnumacs
Message-ID: <280@hrc63.co.uk>
Date: Tue, 15-Sep-87 05:02:46 EDT
Article-I.D.: hrc63.280
Posted: Tue Sep 15 05:02:46 1987
Date-Received: Sat, 19-Sep-87 18:48:32 EDT
Organization: GEC Hirst Research Centre, Wembley, England.
Lines: 125
Keywords: emacs,lisp,hooks

Here is something to help you go on living when you discover that
the author of your favorite function arrogantly thought that his
code did everything anyone could possible want, 
so didn't provide a user hook for you to prove him/her wrong.

The first command, add-hook, sticks any s-exp onto the end
of the target function definition,
the second, make-hook-var, uses add-hook to
invoke run-hooks on a variable of your choice.

I personally prefer using just the former for simple extras, since you
don't need to mess round with function or lambda definitions to 
provide arguments.


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; module: 	hook.el	
;;;; version: 	1.3
;;;; author: 	Ciaran A Byrne
;;;; date:	20:Aug:87
;;;;
;;;;;;;;;;;;;;;;;;;; hook insertion fns;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;	macros:
;;;;		some c[ad]+r fns
;;;;
;;;;	commands:
;;;;		add-hook		- appends s-exp to function
;;;;		make-hook-var		- adds hook variable to a function
;;;;

(defmacro caar (x) (list 'car (list 'car x)))
(defmacro cadr (x) (list 'car (list 'cdr x)))
(defmacro caadr (x) (list 'car (list 'car (list 'cdr x))))
(defmacro caddr (x) (list 'car (list 'cdr (list 'cdr x))))
(defmacro cadar (x) (list 'car (list 'cdr (list 'car x))))

(defmacro cdar (x) (list 'cdr (list 'car x)))
(defmacro cddr (l) "" (list 'cdr (list 'cdr l)))
(defmacro cdadr (x) (list 'cdr (list 'car (list 'cdr x))))


(defun add-hook (target-function extrafn) 
"Redefines FUNCTION so that SEXP is evaluated (apparently!) after the 
function has completed.

e.g. (add-hook 'next-line '(what-line))

The original return value is preserved.
Does not work with subr's.
"

;Even if it did attempt to put a wrapper around a subr,
;it would be only partially effective, 
;since subrs get called from other 'C'-coded fns.

    (interactive "aTarget function: 
xs-exp: ")

;	OLD FORM	    ==>		NEW FORM
;
;  (defun foo (args) "bar"	(defun foo (args) "bar"
;	(interactive "s")	     (interactive "s")
;	(s1)			     (prog1
;	(s2))				(progn 
;					    (s1)
;					    (s2))  ; old result
;					extrafn)   ; new action
;
  (if (subrp (symbol-function target-function))
      	 (message "No can do; %s is a subr" target-function)

    (let* (  (fval (symbol-function target-function))
	      (args (cadr fval))
	      (body (cddr fval))
	      (doc  (car body))
	      (newfn (list 'lambda args)) )
	
	(if (or (numberp doc) (stringp doc))	; move body past doc 
	    (setq newfn (append newfn (list doc))
		  body (cdr body)))

	(if (eq 'interactive (caar body)) ; move body past (interactive ..)
	    (setq newfn (append newfn (list (car body)))
		  body (cdr body)))

	(fset target-function
	    (append newfn
		(list 
		    (list 'prog1
			(append '(progn) body)
			extrafn))
	    )
	)
    ) ; let
  )
)

(defun make-hook-var (hook-name target-function) "Causes the functions (if any)
in  VARIABLE to be run at the completion of FUNCTION.
e.g.

(make-hook-var compilation-sentinel-hook-var compilation-sentinel)
; adds hook var to compilation-sentinel
; eg:
(setq compilation-sentinel-hook-var '(next-error))

use this instead of add-hook (qv) when you need to be able to change
the hook functions without reloading.
"
    (interactive "SNew hook var name : 
aFunction : ")
    (add-hook target-function
	(list 'run-hooks
	    (list 'quote hook-name))))

(provide 'hook)
;
;
; comments/suggestions to ...!seismo!mcvax!ukc!gec-rl-hrc!ciaran
;
; When you said ``HEAVILY FORESTED'' it reminded me of an overdue
; CLEANING BILL..  Don't you SEE?  O'Grogan SWALLOWED a VALUABLE
; COIN COLLECTION and HAD to murder the ONLY MAN who KNEW!!