diff lisp/mouse.el @ 223:2c611d1463a6 r20-4b10

Import from CVS: tag r20-4b10
author cvs
date Mon, 13 Aug 2007 10:10:54 +0200
parents 41ff10fd062f
children 0e522484dd2a
line wrap: on
line diff
--- a/lisp/mouse.el	Mon Aug 13 10:10:03 2007 +0200
+++ b/lisp/mouse.el	Mon Aug 13 10:10:54 2007 +0200
@@ -382,121 +382,6 @@
   (interactive))
 
 
-;;
-;; Commands for the scroll bar.
-;;
-
-;; this stuff has never ever been used and should be junked.
-
-;; Vertical bar
-
-;(defun mouse-scroll-down (nlines)
-;  "Junk me, please."
-;  (interactive "@p")
-;  (scroll-down nlines))
-
-;(defun mouse-scroll-up (nlines)
-;  "Junk me, please."
-;  (interactive "@p")
-;  (scroll-up nlines))
-
-;(defun mouse-scroll-down-full ()
-;  "Junk me, please."
-;  (interactive "@")
-;  (scroll-down nil))
-
-;(defun mouse-scroll-up-full ()
-;  "Junk me, please."
-;  (interactive "@")
-;  (scroll-up nil))
-
-;(defun mouse-scroll-move-cursor (nlines)
-;  "Junk me, please."
-;  (interactive "@p")
-;  (move-to-window-line nlines))
-
-;(defun mouse-scroll-absolute (event)
-;  "Junk me, please."
-;  (interactive "@e")
-;  (let* ((position (event-x event))
-;	 (length (event-y event))
-;	 (size (buffer-size))
-;	 (scale-factor (max 1 (/ 8000000 size)))
-;	 (newpos (* (/ (* (/ size scale-factor) position) length)
-;		    scale-factor)))
-;    (goto-char newpos)
-;    (recenter '(4))))
-
-;; These scroll while the invoking button is depressed.
-
-;(defvar scrolled-lines 0)
-;(defvar scroll-speed 1)
-
-;(defun incr-scroll-down (event)
-;  "Junk me, please."
-;  (interactive "@e")
-;  (setq scrolled-lines 0)
-;  (incremental-scroll scroll-speed))
-
-;(defun incr-scroll-up (event)
-;  "Junk me, please."
-;  (interactive "@e")
-;  (setq scrolled-lines 0)
-;  (incremental-scroll (- scroll-speed)))
-
-;(defun incremental-scroll (n)
-;  "Junk me, please."
-;  (let ((down t))
-;    (while down
-;      (sit-for mouse-track-scroll-delay)
-;      (cond ((input-pending-p)
-;	     (let ((event (next-command-event)))
-;	       (if (or (button-press-event-p event)
-;		       (button-release-event-p event))
-;		   (setq down nil))
-;	       (dispatch-event event))))
-;      (setq scrolled-lines (1+ (* scroll-speed scrolled-lines)))
-;      (scroll-down n))))
-
-;(defun incr-scroll-stop (event)
-;  "Junk me, please."
-;  (interactive "@e")
-;  (setq scrolled-lines 0)
-;  (sleep-for 1))
-
-
-;(defun mouse-scroll-left (ncolumns)
-;  "Junk me, please."
-;  (interactive "@p")
-;  (scroll-left ncolumns))
-
-;(defun mouse-scroll-right (ncolumns)
-;  "Junk me, please."
-;  (interactive "@p")
-;  (scroll-right ncolumns))
-
-;(defun mouse-scroll-left-full ()
-;  "Junk me, please."
-;  (interactive "@")
-;  (scroll-left nil))
-
-;(defun mouse-scroll-right-full ()
-;  "Junk me, please."
-;  (interactive "@")
-;  (scroll-right nil))
-
-;(defun mouse-scroll-move-cursor-horizontally (ncolumns)
-;  "Junk me, please."
-;  (interactive "@p")
-;  (move-to-column ncolumns))
-
-;(defun mouse-scroll-absolute-horizontally (event)
-;  "Junk me, please."
-;  (interactive "@e")
-;  (set-window-hscroll (selected-window) 33))
-
-
-
 ;;; mouse/selection tracking
 ;;; generalized mouse-track
 
@@ -653,23 +538,40 @@
 			 (copy-event event)))))
 
 (defun mouse-track-run-hook (hook event &rest args)
-  ;; ugh, can't use run-special-hook-with-args 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 change the buffer, but just
-  ;; doing a set-buffer is wrong because the hook might
-  ;; not want to change the buffer.
+  ;; 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
+  ;; change the buffer, but just doing a set-buffer is wrong because
+  ;; 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)))
-    (if mouse-grabbed-buffer (setq buffer mouse-grabbed-buffer))
-    (if buffer
-	(let ((value (symbol-value-in-buffer hook buffer nil)))
-	  (if (and (listp value) (not (eq (car value) 'lambda)))
-	      (let (retval)
-		(while (and value
-			    (not (setq retval (apply (car value) event args))))
-		  (setq value (cdr value)))
-		retval)
-	    (apply value event args))))))
+    (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,