*** empty log message ***

1 files changed, 162 insertions, 230 deletions

diff --git a/lisp/mouse.el b/lisp/mouse.el
index 533731290ef..2fa8cecf9e6 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1,170 +1,95 @@
-;; Mouse support that is independent of window systems.
-;; Copyright (C) 1988 Free Software Foundation, Inc.
+;;; Window system-independent mouse support.
+;;; Copyright (C) 1988 Free Software Foundation, Inc.
 
-;; This file is part of GNU Emacs.
+;;; This file is part of GNU Emacs.
 
-;; GNU Emacs 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 1, or (at your option)
-;; any later version.
+;;; GNU Emacs 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 1, or (at your option)
+;;; any later version.
 
-;; GNU Emacs 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.
+;;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to
+;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (provide 'mouse)
 
 
-(defun mouse-select ()
-  "Select the Emacs window the mouse is on."
-  (interactive "@"))
+;;; Utility functions.
 
-(defun mouse-delete-window ()
-  "Delete the Emacs window the mouse is on."
-  (interactive "@")
-  (delete-window))
+(defun mouse-movement-p (event)
+  (and (consp event)
+       (eq (car event) 'mouse-movement)))
 
-(defun mouse-keep-one-window ()
-  "Select Emacs window mouse is on, then kill all other Emacs windows."
-  (interactive "@")
-  (delete-other-windows))
+(defun event-window (event)	(nth 1 event))
+(defun event-point (event)	(nth 2 event))
+(defun mouse-coords (event)	(nth 3 event))
+(defun mouse-timestamp (event)	(nth 4 event))
 
-(defun mouse-select-and-split ()
-  "Select Emacs window mouse is on, then split it vertically in half."
-  (interactive "@")
-  (split-window-vertically nil))
+;;; Indent track-mouse like progn.
+(put 'track-mouse 'lisp-indent-function 0)
 
-(defun mouse-set-point (event)
-  "Select Emacs window mouse is on, and move point to mouse position."
-  (interactive "@e")
-  (let ((relative-coordinate
-	 (coordinates-in-window-p (car event) (selected-window))))
-    (if (consp relative-coordinate)
-	(progn
-	  (move-to-window-line (car (cdr relative-coordinate)))
-	  ;; Note that hscroll must get above 1
-	  ;; before the text actually starts to move.
-	  (move-to-column (+ (car relative-coordinate) (current-column)
-			     (1- (max 1 (window-hscroll (selected-window))))))
-	  (what-line)))))
-
-(defun mouse-eval-last-sexpr (event)
-  (interactive "@e")
-  (save-excursion
-    (mouse-set-point event)
-    (eval-last-sexp nil)))
+
+(defun mouse-delete-window (click)
+  "Delete the window clicked on.
+This must be bound to a mouse click."
+  (interactive "K")
+  (delete-window (event-window click)))
+
+(defun mouse-delete-other-windows (click)
+  "Select Emacs window clicked on, then kill all other Emacs windows.
+This must be bound to a mouse click."
+  (interactive "K")
+  (select-window (event-window click))
+  (delete-other-windows))
 
-(defun mouse-line-length (event)
-  "Print the length of the line indicated by the pointer."
-  (interactive "@e")
-  (let ((relative-coordinate
-	  (coordinates-in-window-p (car event) (selected-window))))
-    (if (consp relative-coordinate)
-	(save-excursion
-	  (move-to-window-line (car (cdr relative-coordinate)))
-	  (end-of-line)
-	  (push-mark nil t)
-	  (beginning-of-line)
-	  (message "Line length: %d"
-			   (- (region-end) (region-beginning)))
-	  (sleep-for 1)))))
-
-(defun mouse-set-mark (event)
-  "Select Emacs window mouse is on, and set mark at mouse position.
-Display cursor at that position for a second."
-  (interactive "@e")
+(defun mouse-split-window-vertically (click)
+  "Select Emacs window mouse is on, then split it vertically in half.
+The window is split at the line clicked on.
+This command must be bound to a mouse click."
+  (interactive "K")
+  (select-window (event-window click))
+  (split-window-vertically (1+ (cdr (mouse-coords click)))))
+
+(defun mouse-set-point (click)
+  "Move point to the position clicked on with the mouse.
+This must be bound to a mouse click."
+  (interactive "K")
+  (select-window (event-window click))
+  (goto-char (event-point click)))
+
+(defun mouse-set-mark (click)
+  "Set mark at the position clicked on with the mouse.
+Display cursor at that position for a second.
+This must be bound to a mouse click."
+  (interactive "K")
   (let ((point-save (point)))
     (unwind-protect
-	(progn (mouse-set-point event)
+	(progn (mouse-set-point click)
 	       (push-mark nil t)
 	       (sit-for 1))
       (goto-char point-save))))
 
-(defun mouse-fill-paragraph (event)
-  "Fill the paragraph at the mouse position."
-  (interactive "@e")
-  (save-excursion
-    (mouse-set-point event)
-    (fill-paragraph)))
-
-(defun mouse-fill-paragraph-with-prefix (event)
-  "Fill the paragraph at the mouse position with specified fill prefix.
-Click at the end of the fill prefix that you want; 
-The text before the mouse position, on the same line, is used as the prefix."
-  (interactive "@e")
-  (save-excursion
-    (mouse-set-point event)
-    (let ((fill-prefix (buffer-substring (save-excursion (beginning-of-line)
-							 (point))
-					 (point))))      
-      (fill-paragraph))))
-
-(defun mouse-scroll (event)
-  "Scroll point to the mouse position."
-  (interactive "@e")
-  (let ((relative-coordinate
-	 (coordinates-in-window-p (car event) (selected-window))))
-    (if (consp relative-coordinate)
-	(progn
-	  (recenter (car (cdr relative-coordinate)))
-	  (scroll-right (+ (car relative-coordinate) (current-column)))))))
-
-(defun mouse-del-char (event)
-  "Delete the char pointed to by the mouse."
-  (interactive "@e")
-  (let ((relative-coordinate
-	  (coordinates-in-window-p (car event) (selected-window))))
-    (if (consp relative-coordinate)
-	(progn
-	  (move-to-window-line (car (cdr relative-coordinate)))
-	  (move-to-column (+ (car relative-coordinate) (current-column)))
-	  (delete-char 1 nil)))))
+(defun mouse-kill (click)
+  "Kill the region between point and the mouse click.
+The text is saved in the kill ring, as with \\[kill-region]."
+  (interactive "K")
+  (mouse-set-mark click)
+  (kill-region))
 
-(defun mouse-kill-line (event)
-  "Kill the line pointed to by the mouse."
-  (interactive "@e")
-  (let ((relative-coordinate
-	 (coordinates-in-window-p (car event) (selected-window))))
-    (if (consp relative-coordinate)
-	(progn
-	  (move-to-window-line (car (cdr relative-coordinate)))
-	  (move-to-column (+ (car relative-coordinate) (current-column)))
-	  (kill-line nil)))))
+(defun mouse-kill-ring-save
+  "Copy the region between point and the mouse click in the kill ring.
+This does not delete the region; it acts like \\[kill-ring-save]."
+  (interactive "K")
+  (mouse-set-mark click)
+  (kill-ring-save))
 
-(defun narrow-window-to-region (m n)
-  "Narrow window to region between point and last mark"
-  (interactive "r")
-  (save-excursion
-    (save-restriction
-      (if (eq (selected-window) (next-window))
-	  (split-window))
-      (goto-char m)
-      (recenter 0)
-      (if (eq (selected-window)
-	      (if (zerop (minibuffer-depth))
-		  (next-window)))
-	  ()
-	(shrink-window (- (- (window-height) (count-lines m n)) 1))))))
-
-(defun mouse-window-to-region (event)
-  "Narrow window to region between cursor and mouse pointer."
-  (interactive "@e")
-  (let ((point-save (point)))
-    (unwind-protect
-	(progn (mouse-set-point event)
-	       (push-mark nil t)
-	       (sit-for 1))
-      (goto-char point-save)
-      (narrow-window-to-region (region-beginning) (region-end)))))
 
-(defun mouse-ignore ()
-  "Don't do anything."
-  (interactive))
 
 ;; Commands for the scroll bar.
 
@@ -231,77 +156,77 @@ The text before the mouse position, on the same line, is used as the prefix."
 
 ;; Set up these commands, including the prefix keys for the scroll bar.
 
-(fset 'mouse-vertical-scroll-bar-prefix (make-sparse-keymap))
-(define-key global-mouse-map mouse-vertical-scroll-bar-prefix
-  'mouse-vertical-scroll-bar-prefix)
-
-(defun mouse-scroll-motion (event)
-  (interactive "e")
-  (let ((pos (car (car event)))
-	(length (car (cdr (car event)))))
-    (message "[%d %d]" pos length)))
-
-(let ((map (function mouse-vertical-scroll-bar-prefix)))
-  (define-key map mouse-button-right 'mouse-scroll-down)
-  (define-key map mouse-button-left 'mouse-scroll-up)
-  (define-key map mouse-button-middle 'mouse-scroll-absolute)
-  (define-key map mouse-motion 'x-horizontal-line))
-
-;(fset 'mouse-vertical-slider-prefix (make-sparse-keymap))
-;(define-key global-mouse-map mouse-vertical-slider-prefix
-;  'mouse-vertical-slider-prefix)
-
-;(let ((map (function mouse-vertical-slider-prefix)))
-;  (define-key map mouse-button-right 'mouse-scroll-move-cursor)
-;  (define-key map mouse-button-left 'mouse-scroll-move-cursor)
-;  (define-key map mouse-button-middle 'mouse-scroll-move-cursor))
-
-(fset 'mouse-vertical-thumbup-prefix (make-sparse-keymap))
-(define-key global-mouse-map mouse-vertical-thumbup-prefix
-  'mouse-vertical-thumbup-prefix)
-
-(let ((map (function mouse-vertical-thumbup-prefix)))
-  (define-key map mouse-button-right 'mouse-scroll-down-full)
-  (define-key map mouse-button-left 'mouse-scroll-down-full)
-  (define-key map mouse-button-middle 'mouse-scroll-down-full))
-
-(fset 'mouse-vertical-thumbdown-prefix (make-sparse-keymap))
-(define-key global-mouse-map mouse-vertical-thumbdown-prefix
-  'mouse-vertical-thumbdown-prefix)
-
-(let ((map (function mouse-vertical-thumbdown-prefix)))
-  (define-key map mouse-button-right 'mouse-scroll-up-full)
-  (define-key map mouse-button-left 'mouse-scroll-up-full)
-  (define-key map mouse-button-middle 'mouse-scroll-up-full))
-
-;; Horizontal bar
-
-(fset 'mouse-horizontal-scroll-bar-prefix (make-sparse-keymap))
-(define-key global-mouse-map mouse-horizontal-scroll-bar-prefix
-  'mouse-horizontal-scroll-bar-prefix)
-
-(let ((map (function mouse-horizontal-scroll-bar-prefix)))
-  (define-key map mouse-button-right 'mouse-scroll-right)
-  (define-key map mouse-button-left 'mouse-scroll-left)
-  (define-key map mouse-button-middle 'mouse-scroll-absolute-horizontally))
-
-(fset 'mouse-horizontal-thumbleft-prefix (make-sparse-keymap))
-(define-key global-mouse-map mouse-horizontal-thumbleft-prefix
-  'mouse-horizontal-thumbleft-prefix)
-
-(let ((map (function mouse-horizontal-thumbleft-prefix)))
-  (define-key map mouse-button-right 'mouse-scroll-left-full)
-  (define-key map mouse-button-left 'mouse-scroll-left-full)
-  (define-key map mouse-button-middle 'mouse-scroll-left-full))
-
-(fset 'mouse-horizontal-thumbright-prefix (make-sparse-keymap))
-(define-key global-mouse-map mouse-horizontal-thumbright-prefix
-  'mouse-horizontal-thumbright-prefix)
-
-(let ((map (function mouse-horizontal-thumbright-prefix)))
-  (define-key map mouse-button-right 'mouse-scroll-right-full)
-  (define-key map mouse-button-left 'mouse-scroll-right-full)
-  (define-key map mouse-button-middle 'mouse-scroll-right-full))
+;;; (fset 'mouse-vertical-scroll-bar-prefix (make-sparse-keymap))
+;;; (define-key global-mouse-map mouse-vertical-scroll-bar-prefix
+;;;   'mouse-vertical-scroll-bar-prefix)
+;;; 
+;;; (defun mouse-scroll-motion (event)
+;;;   (interactive "e")
+;;;   (let ((pos (car (car event)))
+;;; 	(length (car (cdr (car event)))))
+;;;     (message "[%d %d]" pos length)))
+;;; 
+;;; (let ((map (function mouse-vertical-scroll-bar-prefix)))
+;;;   (define-key map mouse-button-right 'mouse-scroll-down)
+;;;   (define-key map mouse-button-left 'mouse-scroll-up)
+;;;   (define-key map mouse-button-middle 'mouse-scroll-absolute)
+;;;   (define-key map mouse-motion 'x-horizontal-line))
+;;; 
+;;; ;(fset 'mouse-vertical-slider-prefix (make-sparse-keymap))
+;;; ;(define-key global-mouse-map mouse-vertical-slider-prefix
+;;; ;  'mouse-vertical-slider-prefix)
+;;; 
+;;; ;(let ((map (function mouse-vertical-slider-prefix)))
+;;; ;  (define-key map mouse-button-right 'mouse-scroll-move-cursor)
+;;; ;  (define-key map mouse-button-left 'mouse-scroll-move-cursor)
+;;; ;  (define-key map mouse-button-middle 'mouse-scroll-move-cursor))
+;;; 
+;;; (fset 'mouse-vertical-thumbup-prefix (make-sparse-keymap))
+;;; (define-key global-mouse-map mouse-vertical-thumbup-prefix
+;;;   'mouse-vertical-thumbup-prefix)
+;;; 
+;;; (let ((map (function mouse-vertical-thumbup-prefix)))
+;;;   (define-key map mouse-button-right 'mouse-scroll-down-full)
+;;;   (define-key map mouse-button-left 'mouse-scroll-down-full)
+;;;   (define-key map mouse-button-middle 'mouse-scroll-down-full))
+;;; 
+;;; (fset 'mouse-vertical-thumbdown-prefix (make-sparse-keymap))
+;;; (define-key global-mouse-map mouse-vertical-thumbdown-prefix
+;;;   'mouse-vertical-thumbdown-prefix)
+;;; 
+;;; (let ((map (function mouse-vertical-thumbdown-prefix)))
+;;;   (define-key map mouse-button-right 'mouse-scroll-up-full)
+;;;   (define-key map mouse-button-left 'mouse-scroll-up-full)
+;;;   (define-key map mouse-button-middle 'mouse-scroll-up-full))
+;;; 
+;;; ;; Horizontal bar
+;;; 
+;;; (fset 'mouse-horizontal-scroll-bar-prefix (make-sparse-keymap))
+;;; (define-key global-mouse-map mouse-horizontal-scroll-bar-prefix
+;;;   'mouse-horizontal-scroll-bar-prefix)
+;;; 
+;;; (let ((map (function mouse-horizontal-scroll-bar-prefix)))
+;;;   (define-key map mouse-button-right 'mouse-scroll-right)
+;;;   (define-key map mouse-button-left 'mouse-scroll-left)
+;;;   (define-key map mouse-button-middle 'mouse-scroll-absolute-horizontally))
+;;; 
+;;; (fset 'mouse-horizontal-thumbleft-prefix (make-sparse-keymap))
+;;; (define-key global-mouse-map mouse-horizontal-thumbleft-prefix
+;;;   'mouse-horizontal-thumbleft-prefix)
+;;; 
+;;; (let ((map (function mouse-horizontal-thumbleft-prefix)))
+;;;   (define-key map mouse-button-right 'mouse-scroll-left-full)
+;;;   (define-key map mouse-button-left 'mouse-scroll-left-full)
+;;;   (define-key map mouse-button-middle 'mouse-scroll-left-full))
+;;; 
+;;; (fset 'mouse-horizontal-thumbright-prefix (make-sparse-keymap))
+;;; (define-key global-mouse-map mouse-horizontal-thumbright-prefix
+;;;   'mouse-horizontal-thumbright-prefix)
+;;; 
+;;; (let ((map (function mouse-horizontal-thumbright-prefix)))
+;;;   (define-key map mouse-button-right 'mouse-scroll-right-full)
+;;;   (define-key map mouse-button-left 'mouse-scroll-right-full)
+;;;   (define-key map mouse-button-middle 'mouse-scroll-right-full))
 
 
 ;;;;
@@ -402,10 +327,10 @@ The text before the mouse position, on the same line, is used as the prefix."
 	(x-erase-rectangle (selected-screen))
 	(setq last-line-drawn nil))))
 
-(defun test-x-rectangle ()
-  (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
-  (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
-  (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
+;;; (defun test-x-rectangle ()
+;;;   (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
+;;;   (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
+;;;   (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
 
 ;;
 ;; Here is how to do double clicking in lisp.  About to change.
@@ -433,10 +358,10 @@ The text before the mouse position, on the same line, is used as the prefix."
        (> (- (nth 4 event ) double-start) double-click-interval)
        (setq double-start nil)))
 
-(defun x-test-doubleclick ()
-  (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
-  (define-key doubleclick-test-map mouse-button-left 'double-down)
-  (define-key doubleclick-test-map mouse-button-left-up 'double-up))
+;;; (defun x-test-doubleclick ()
+;;;   (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
+;;;   (define-key doubleclick-test-map mouse-button-left 'double-down)
+;;;   (define-key doubleclick-test-map mouse-button-left-up 'double-up))
 
 ;;
 ;; This scrolls while button is depressed.  Use preferable in scrollbar.
@@ -467,12 +392,12 @@ The text before the mouse position, on the same line, is used as the prefix."
   (setq scrolled-lines 0)
   (sleep-for 1))
 
-(defun x-testing-scroll ()
-  (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
-    (define-key scrolling-map mouse-button-left 'incr-scroll-down)
-    (define-key scrolling-map mouse-button-right 'incr-scroll-up)
-    (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
-    (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
+;;; (defun x-testing-scroll ()
+;;;   (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
+;;;     (define-key scrolling-map mouse-button-left 'incr-scroll-down)
+;;;     (define-key scrolling-map mouse-button-right 'incr-scroll-up)
+;;;     (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
+;;;     (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
 
 ;;
 ;; Some playthings suitable for picture mode?  They need work.
@@ -522,3 +447,10 @@ The text before the mouse position, on the same line, is used as the prefix."
 	       (mouse-multiple-insert
 		(- (car relative-coordinate) (current-column)) " "))
 	      ((= (current-column) (car relative-coordinate)) (ding))))))
+
+
+;;; Bindings for mouse commands.
+
+(global-set-key   [mouse-1]	'mouse-set-point)
+(global-set-key [S-mouse-1]	'mouse-set-mark)
+(global-set-key   [mouse-3]	'mouse-delete-other-windows)