--- a/lisp/mouse.el	Fri May 18 04:39:44 2001 +0000
+++ b/lisp/mouse.el	Sun May 20 01:17:16 2001 +0000
@@ -570,7 +570,9 @@
 	       event ex)
       t)))
 
-(defun mouse-track-run-hook (hook event &rest args)
+(defvar Mouse-track-gensym (gensym))
+
+(defun mouse-track-run-hook (hook override event &rest args)
   ;; ugh, can't use run-hook-with-args-until-success because we have
   ;; to get the value using symbol-value-in-buffer.  Doing a
   ;; save-excursion/set-buffer is wrong because the hook might want to
@@ -578,33 +580,40 @@
   ;; the hook might not want to change the buffer.
   ;; #### What we need here is a Lisp interface to
   ;; run_hook_with_args_in_buffer.  Here is a poor man's version.
-  (let ((buffer (event-buffer event)))
-    (and mouse-grabbed-buffer (setq buffer mouse-grabbed-buffer))
-    (when buffer
-      (let ((value (symbol-value-in-buffer hook buffer nil)))
-	(if (and (listp value) (not (eq (car value) 'lambda)))
-	    ;; List of functions.
-	    (let (retval)
-	      (while (and value (null retval))
-		;; Found `t': should process default value.  We could
-		;; splice it into the buffer-local value, but that
-		;; would cons, which is not a good thing for
-		;; mouse-track hooks.
-		(if (eq (car value) t)
-		    (let ((global (default-value hook)))
-		      (if (and (listp global) (not (eq (car global) 'lambda)))
-			  ;; List of functions.
-			  (while (and global
-				      (null (setq retval
-						  (apply (car global) event args))))
-			    (pop global))
-			;; lambda
-			(setq retval (apply (car global) event args))))
-		  (setq retval (apply (car value) event args)))
-		(pop value))
-	      retval)
-	  ;; lambda
-	  (apply value event args))))))
+  (let ((overridden (plist-get override hook Mouse-track-gensym)))
+    (if (not (eq overridden Mouse-track-gensym))
+	(if (and (listp overridden) (not (eq (car overridden) 'lambda)))
+	    (some #'(lambda (val) (apply val event args)) overridden)
+	  (apply overridden event args))
+      (let ((buffer (event-buffer event)))
+	(and mouse-grabbed-buffer (setq buffer mouse-grabbed-buffer))
+	(when buffer
+	  (let ((value (symbol-value-in-buffer hook buffer nil)))
+	    (if (and (listp value) (not (eq (car value) 'lambda)))
+		;; List of functions.
+		(let (retval)
+		  (while (and value (null retval))
+		    ;; Found `t': should process default value.  We could
+		    ;; splice it into the buffer-local value, but that
+		    ;; would cons, which is not a good thing for
+		    ;; mouse-track hooks.
+		    (if (eq (car value) t)
+			(let ((global (default-value hook)))
+			  (if (and (listp global) (not (eq (car global)
+							   'lambda)))
+			      ;; List of functions.
+			      (while (and global
+					  (null (setq retval
+						      (apply (car global)
+							     event args))))
+				(pop global))
+			    ;; lambda
+			    (setq retval (apply (car global) event args))))
+		      (setq retval (apply (car value) event args)))
+		    (pop value))
+		  retval)
+	      ;; lambda
+	      (apply value event args))))))))
 
 (defun mouse-track-scroll-undefined (random)
   ;; the old implementation didn't actually define this function,
@@ -615,7 +624,7 @@
   ;; difficult to do), this function may get called.
 )
 
-(defun mouse-track (event)
+(defun mouse-track (event &optional overriding-hooks)
   "Generalized mouse-button handler.  This should be bound to a mouse button.
 The behavior of this function is customizable using various hooks and
 variables: see `mouse-track-click-hook', `mouse-track-drag-hook',
@@ -629,6 +638,10 @@
 any custom-supplied handlers, by using the function `mouse-track-default'
 instead of `mouse-track'.
 
+\(In general, you can override specific hooks by using the argument
+OVERRIDING-HOOKS, which should be a plist of alternating hook names
+and values.)
+
 Default behavior is as follows:
 
 If you click-and-drag, the selection will be set to the region between the
@@ -669,7 +682,7 @@
       (setq mouse-track-click-count (1+ mouse-track-click-count)))
     (if (not (event-window event))
 	(error "Not over a window."))
-    (mouse-track-run-hook 'mouse-track-down-hook
+    (mouse-track-run-hook 'mouse-track-down-hook overriding-hooks
 			  event mouse-track-click-count)
     (unwind-protect
 	(while mouse-down
@@ -683,14 +696,17 @@
 		     (setq mouse-moved t))
 		 (if mouse-moved
 		     (mouse-track-run-hook 'mouse-track-drag-hook
-		      event mouse-track-click-count nil))
+					   overriding-hooks
+					   event mouse-track-click-count nil))
 		 (mouse-track-set-timeout event))
 		((and (timeout-event-p event)
 		      (eq (event-function event)
 			  'mouse-track-scroll-undefined))
 		 (if mouse-moved
 		     (mouse-track-run-hook 'mouse-track-drag-hook
-		      (event-object event) mouse-track-click-count t))
+					   overriding-hooks
+					   (event-object event)
+					   mouse-track-click-count t))
 		 (mouse-track-set-timeout (event-object event)))
 		((button-release-event-p event)
 		 (setq mouse-track-up-time (event-timestamp event))
@@ -698,12 +714,15 @@
 		 (setq mouse-track-up-y (event-y-pixel event))
 		 (setq mouse-down nil)
 		 (mouse-track-run-hook 'mouse-track-up-hook
-		  event mouse-track-click-count)
+				       overriding-hooks
+				       event mouse-track-click-count)
 		 (if mouse-moved
 		     (mouse-track-run-hook 'mouse-track-drag-up-hook
-		      event mouse-track-click-count)
+					   overriding-hooks
+					   event mouse-track-click-count)
 		   (mouse-track-run-hook 'mouse-track-click-hook
-		    event mouse-track-click-count)))
+					 overriding-hooks
+					 event mouse-track-click-count)))
 		((or (key-press-event-p event)
 		     (and (misc-user-event-p event)
 			  (eq (event-function event) 'cancel-mode-internal)))
@@ -717,7 +736,14 @@
       (and (buffer-live-p buffer)
 	   (save-excursion
 	     (set-buffer buffer)
-	     (run-hooks 'mouse-track-cleanup-hook))))))
+	     (let ((override (plist-get overriding-hooks
+					'mouse-track-cleanup-hook
+					Mouse-track-gensym)))
+	       (if (not (eq override Mouse-track-gensym))
+		   (if (and (listp override) (not (eq (car override) 'lambda)))
+		       (mapc #'funcall override)
+		     (funcall override))
+		 (run-hooks 'mouse-track-cleanup-hook))))))))
 
 
 ;;;;;;;;;;;; default handlers: new version of mouse-track
@@ -1319,12 +1345,14 @@
 (defun mouse-track-default (event)
   "Invoke `mouse-track' with only the default handlers active."
   (interactive "e")
-  (let ((mouse-track-down-hook 'default-mouse-track-down-hook)
-	(mouse-track-drag-hook 'default-mouse-track-drag-hook)
-	(mouse-track-drag-up-hook 'default-mouse-track-drag-up-hook)
-	(mouse-track-click-hook 'default-mouse-track-click-hook)
-	(mouse-track-cleanup-hook 'default-mouse-track-cleanup-hook))
-    (mouse-track event)))
+  (mouse-track event
+	       '(mouse-track-down-hook
+		 default-mouse-track-down-hook
+		 mouse-track-up-hook nil
+		 mouse-track-drag-hook default-mouse-track-drag-hook
+		 mouse-track-drag-up-hook default-mouse-track-drag-up-hook
+		 mouse-track-click-hook default-mouse-track-click-hook
+		 mouse-track-cleanup-hook default-mouse-track-cleanup-hook)))
 
 (defun mouse-track-do-rectangle (event)
   "Like `mouse-track' but selects rectangles instead of regions."
@@ -1355,37 +1383,37 @@
   (let ((default-mouse-track-adjust t))
     (mouse-track-default event)))
 
-(defvar mouse-track-insert-selected-region nil)
-
-(defun mouse-track-insert-drag-up-hook (event click-count)
-  (setq mouse-track-insert-selected-region
-	(default-mouse-track-return-dragged-selection event)))
-
 (defun mouse-track-insert (event &optional delete)
   "Make a selection with the mouse and insert it at point.
 This is exactly the same as the `mouse-track' command on \\[mouse-track],
 except that point is not moved; the selected text is immediately inserted
 after being selected\; and the selection is immediately disowned afterwards."
   (interactive "*e")
-  (setq mouse-track-insert-selected-region nil)
-  (let ((mouse-track-drag-up-hook 'mouse-track-insert-drag-up-hook)
- 	(mouse-track-click-hook 'mouse-track-insert-click-hook)
-	s)
-    (save-excursion
-      (save-window-excursion
-	(mouse-track event)
-	(if (consp mouse-track-insert-selected-region)
-	    (let ((pair mouse-track-insert-selected-region))
-	      (setq s (prog1
-			  (buffer-substring (car pair) (cdr pair))
-			(if delete
-			    (kill-region (car pair) (cdr pair)))))))))
-	(or (null s) (equal s "") (insert s))))
-
-(defun mouse-track-insert-click-hook (event click-count)
-  (default-mouse-track-drag-hook event click-count nil)
-  (mouse-track-insert-drag-up-hook event click-count)
-  t)
+  (let (s selreg)
+    (flet ((Mouse-track-insert-drag-up-hook (event count)
+	     (setq selreg
+		   (default-mouse-track-return-dragged-selection event))
+	     t)
+	   (Mouse-track-insert-click-hook (event count)
+	     (default-mouse-track-drag-hook event count nil)
+	     (setq selreg
+		   (default-mouse-track-return-dragged-selection event))
+	     t))
+      (save-excursion
+	(save-window-excursion
+	  (mouse-track
+	   event
+	   '(mouse-track-drag-up-hook
+	     Mouse-track-insert-drag-up-hook
+	     mouse-track-click-hook
+	     Mouse-track-insert-click-hook))
+	  (if (consp selreg)
+	      (let ((pair selreg))
+		(setq s (prog1
+			    (buffer-substring (car pair) (cdr pair))
+			  (if delete
+			      (kill-region (car pair) (cdr pair))))))))))
+    (or (null s) (equal s "") (insert s))))
 
 (defun mouse-track-delete-and-insert (event)
   "Make a selection with the mouse and insert it at point.