;; Mouse support for X window system.;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.;; 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 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.(provide 'x-mouse)(defconst x-button-right (char-to-string 0))(defconst x-button-middle (char-to-string 1))(defconst x-button-left (char-to-string 2))(defconst x-button-right-up (char-to-string 4))(defconst x-button-middle-up (char-to-string 5))(defconst x-button-left-up (char-to-string 6))(defconst x-button-s-right (char-to-string 16))(defconst x-button-s-middle (char-to-string 17))(defconst x-button-s-left (char-to-string 18))(defconst x-button-s-right-up (char-to-string 20))(defconst x-button-s-middle-up (char-to-string 21))(defconst x-button-s-left-up (char-to-string 22))(defconst x-button-m-right (char-to-string 32))(defconst x-button-m-middle (char-to-string 33))(defconst x-button-m-left (char-to-string 34))(defconst x-button-m-right-up (char-to-string 36))(defconst x-button-m-middle-up (char-to-string 37))(defconst x-button-m-left-up (char-to-string 38))(defconst x-button-c-right (char-to-string 64))(defconst x-button-c-middle (char-to-string 65))(defconst x-button-c-left (char-to-string 66))(defconst x-button-c-right-up (char-to-string 68))(defconst x-button-c-middle-up (char-to-string 69))(defconst x-button-c-left-up (char-to-string 70))(defconst x-button-m-s-right (char-to-string 48))(defconst x-button-m-s-middle (char-to-string 49))(defconst x-button-m-s-left (char-to-string 50))(defconst x-button-m-s-right-up (char-to-string 52))(defconst x-button-m-s-middle-up (char-to-string 53))(defconst x-button-m-s-left-up (char-to-string 54))(defconst x-button-c-s-right (char-to-string 80))(defconst x-button-c-s-middle (char-to-string 81))(defconst x-button-c-s-left (char-to-string 82))(defconst x-button-c-s-right-up (char-to-string 84))(defconst x-button-c-s-middle-up (char-to-string 85))(defconst x-button-c-s-left-up (char-to-string 86))(defconst x-button-c-m-right (char-to-string 96))(defconst x-button-c-m-middle (char-to-string 97))(defconst x-button-c-m-left (char-to-string 98))(defconst x-button-c-m-right-up (char-to-string 100))(defconst x-button-c-m-middle-up (char-to-string 101))(defconst x-button-c-m-left-up (char-to-string 102))(defconst x-button-c-m-s-right (char-to-string 112))(defconst x-button-c-m-s-middle (char-to-string 113))(defconst x-button-c-m-s-left (char-to-string 114))(defconst x-button-c-m-s-right-up (char-to-string 116))(defconst x-button-c-m-s-middle-up (char-to-string 117))(defconst x-button-c-m-s-left-up (char-to-string 118))(defvar x-process-mouse-hook nil  "Hook to run after each mouse event is processed.  Should take twoarguments; the first being a list (XPOS YPOS) corresponding to characteroffset from top left of screen and the second being a specifier for thebuttons/keys.This will normally be set on a per-buffer basis.")(defun x-flush-mouse-queue ()   "Process all queued mouse events."  ;; A mouse event causes a special character sequence to be given  ;; as keyboard input.  That runs this function, which process all  ;; queued mouse events and returns.  (interactive)  (while (> (x-mouse-events) 0)    (x-proc-mouse-event)    (and (boundp 'x-process-mouse-hook)	 (symbol-value 'x-process-mouse-hook)	 (funcall x-process-mouse-hook x-mouse-pos x-mouse-item))))(define-key global-map "\C-c\C-m" 'x-flush-mouse-queue)(define-key global-map "\C-x\C-@" 'x-flush-mouse-queue)(defun x-mouse-select (arg)  "Select Emacs window the mouse is on."  (let ((start-w (selected-window))	(done nil)	(w (selected-window))	(rel-coordinate nil))    (while (and (not done)		(null (setq rel-coordinate			    (coordinates-in-window-p arg w))))      (setq w (next-window w))      (if (eq w start-w)	  (setq done t)))    (select-window w)    rel-coordinate))(defun x-mouse-keep-one-window (arg)  "Select Emacs window mouse is on, then kill all other Emacs windows."  (if (x-mouse-select arg)      (delete-other-windows)))(defun x-mouse-select-and-split (arg)  "Select Emacs window mouse is on, then split it vertically in half."  (if (x-mouse-select arg)      (split-window-vertically nil)))(defun x-mouse-set-point (arg)  "Select Emacs window mouse is on, and move point to mouse position."  (let* ((relative-coordinate (x-mouse-select arg))	 (rel-x (car relative-coordinate))	 (rel-y (car (cdr relative-coordinate))))    (if relative-coordinate	(progn	  (move-to-window-line rel-y)	  (move-to-column (+ rel-x (1- (max 1 (window-hscroll)))			     (current-column)))))))(defun x-mouse-set-mark (arg)  "Select Emacs window mouse is on, and set mark at mouse position.Display cursor at that position for a second."  (if (x-mouse-select arg)      (let ((point-save (point)))	(unwind-protect	    (progn (x-mouse-set-point arg)		   (push-mark nil t)		   (sit-for 1))	  (goto-char point-save)))))(defun x-cut-text (arg &optional kill)  "Copy text between point and mouse position into window system cut buffer.Save in Emacs kill ring also."  (if (coordinates-in-window-p arg (selected-window))      (save-excursion	(let ((opoint (point))	      beg end)	  (x-mouse-set-point arg)	  (setq beg (min opoint (point))		end (max opoint (point)))	  (x-store-cut-buffer (buffer-substring beg end))	  (copy-region-as-kill beg end)	  (if kill (delete-region beg end))))    (message "Mouse not in selected window")))(defun x-paste-text (arg)  "Move point to mouse position and insert window system cut buffer contents."  (x-mouse-set-point arg)  (insert (x-get-cut-buffer)))(defun x-cut-and-wipe-text (arg)  "Kill text between point and mouse; also copy to window system cut buffer."  (x-cut-text arg t))(defun x-mouse-ignore (arg)  "Don't do anything.")(defun x-buffer-menu (arg)  "Pop up a menu of buffers for selection with the mouse."  (let ((menu	 (list "Buffer Menu"	       (cons "Select Buffer"		     (let ((tail (buffer-list))			   head)		       (while tail			 (let ((elt (car tail)))			   (if (not (string-match "^ "						  (buffer-name elt)))			       (setq head (cons					   (cons					    (format					     "%14s   %s"					     (buffer-name elt)					     (or (buffer-file-name elt) ""))					    elt)					   head))))			 (setq tail (cdr tail)))		       (reverse head))))))    (switch-to-buffer (or (x-popup-menu arg menu) (current-buffer)))))(defun x-help (arg)  "Enter a menu-based help system."  (let ((selection	 (x-popup-menu	  arg	  '("Help" ("Is there a command that..."		    ("Command apropos" . command-apropos)		    ("Apropos" . apropos))		   ("Key Commands <==> Functions"		    ("List all keystroke commands" . describe-bindings)		    ("Describe key briefly" . describe-key-briefly)		    ("Describe key verbose" . describe-key)		    ("Describe Lisp function" . describe-function)		    ("Where is this command" . where-is))		   ("Manual and tutorial"		    ("Info system" . info)		    ("Invoke Emacs tutorial" . help-with-tutorial))		   ("Odds and ends"		    ("Last 100 Keystrokes" . view-lossage)		    ("Describe syntax table" . describe-syntax))		   ("Modes"		    ("Describe current major mode" . describe-mode)		    ("List all keystroke commands" . describe-bindings))		   ("Administrivia"		    ("View Emacs news" . view-emacs-news)		    ("View the GNU Emacs license" . describe-copying)		    ("Describe distribution" . describe-distribution)		    ("Describe (non)warranty" . describe-no-warranty))))))    (and selection (call-interactively selection)))); Prevent beeps on button-up.  If the button isn't bound to anything, it; will beep on button-down.(define-key mouse-map x-button-right-up 'x-mouse-ignore)(define-key mouse-map x-button-middle-up 'x-mouse-ignore)(define-key mouse-map x-button-left-up 'x-mouse-ignore)(define-key mouse-map x-button-s-right-up 'x-mouse-ignore)(define-key mouse-map x-button-s-middle-up 'x-mouse-ignore)(define-key mouse-map x-button-s-left-up 'x-mouse-ignore)(define-key mouse-map x-button-m-right-up 'x-mouse-ignore)(define-key mouse-map x-button-m-middle-up 'x-mouse-ignore)(define-key mouse-map x-button-m-left-up 'x-mouse-ignore)(define-key mouse-map x-button-c-right-up 'x-mouse-ignore)(define-key mouse-map x-button-c-middle-up 'x-mouse-ignore)(define-key mouse-map x-button-c-left-up 'x-mouse-ignore)(define-key mouse-map x-button-m-s-right-up 'x-mouse-ignore)(define-key mouse-map x-button-m-s-middle-up 'x-mouse-ignore)(define-key mouse-map x-button-m-s-left-up 'x-mouse-ignore)(define-key mouse-map x-button-c-s-right-up 'x-mouse-ignore)(define-key mouse-map x-button-c-s-middle-up 'x-mouse-ignore)(define-key mouse-map x-button-c-s-left-up 'x-mouse-ignore)(define-key mouse-map x-button-c-m-right-up 'x-mouse-ignore)(define-key mouse-map x-button-c-m-middle-up 'x-mouse-ignore)(define-key mouse-map x-button-c-m-left-up 'x-mouse-ignore)(define-key mouse-map x-button-c-m-s-right-up 'x-mouse-ignore)(define-key mouse-map x-button-c-m-s-middle-up 'x-mouse-ignore)(define-key mouse-map x-button-c-m-s-left-up 'x-mouse-ignore)(define-key mouse-map x-button-c-s-left 'x-buffer-menu)(define-key mouse-map x-button-c-s-middle 'x-help)(define-key mouse-map x-button-c-s-right 'x-mouse-keep-one-window)(define-key mouse-map x-button-s-middle 'x-cut-text)(define-key mouse-map x-button-s-right 'x-paste-text)(define-key mouse-map x-button-c-middle 'x-cut-and-wipe-text)(define-key mouse-map x-button-c-right 'x-mouse-select-and-split)(if (= window-system-version 10)    (progn      (define-key mouse-map x-button-right 'x-mouse-select)      (define-key mouse-map x-button-left 'x-mouse-set-mark)      (define-key mouse-map x-button-middle 'x-mouse-set-point))  (define-key mouse-map x-button-right 'x-cut-text)  (define-key mouse-map x-button-left 'x-mouse-set-point)  (define-key mouse-map x-button-middle 'x-paste-text))