;;; x-mouse.el --- Mouse support for X window system.
;; Copyright (C) 1985, 1992-4, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996 Ben Wing.
;; Maintainer: XEmacs Development Team
;; Keywords: mouse, dumped
;; This file is part of XEmacs.
;; XEmacs 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 2, or (at your option)
;; any later version.
;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Synched up with: Not synched.
;; This file is dumped with XEmacs (when X support is compiled in).
;;(define-key global-map 'button2 'x-set-point-and-insert-selection)
;; This is reserved for use by Hyperbole.
;;(define-key global-map '(shift button2) 'x-mouse-kill)
(define-key global-map '(control button2) 'x-set-point-and-move-selection)
(defun x-mouse-kill (event)
"Kill the text between the point and mouse and copy it to the clipboard and
to the cut buffer"
(let ((old-point (point)))
(let ((s (buffer-substring old-point (point))))
(kill-region old-point (point))))
(defun x-yank-function ()
"Insert the current X selection or, if there is none, insert the X cutbuffer.
A mark is pushed, so that the inserted text lies between point and mark."
(if (consp zmacs-region-extent)
;; pirated code from insert-rectangle in rect.el
;; perhaps that code should be modified to handle a list of extents
;; as the rectangle to be inserted?
(let ((lines zmacs-region-extent)
(or (bolp) (insert ?\n))
(move-to-column insertcolumn t)))
(setq first nil)
(insert (extent-string (car lines)))
(setq lines (cdr lines))))
(insert (extent-string zmacs-region-extent)))
(defun x-insert-selection (&optional check-cutbuffer-p move-point-event)
"Insert the current selection into buffer at point."
(let ((text (if check-cutbuffer-p
(or (condition-case () (x-get-selection) (error ()))
(error "No selection or cut buffer available"))
(make-obsolete 'x-set-point-and-insert-selection 'mouse-yank)
(defun x-set-point-and-insert-selection (event)
"Set point where clicked and insert the primary selection or the cut buffer."
(let ((mouse-yank-at-point nil))
(defun x-set-point-and-move-selection (event)
"Set point where clicked and move the selected text to that location."
;; Don't try to move the selection if x-kill-primary-selection if going
;; to fail; just let the appropriate error message get issued. (We need
;; to insert the selection and set point first, or the selection may
;; get inserted at the wrong place.)
(x-insert-selection t event))
(defun mouse-track-and-copy-to-cutbuffer (event)
"Make a selection like `mouse-track', but also copy it to the cutbuffer."
(set-buffer (extent-object (car primary-selection-extent)))
(extent-start-position (car primary-selection-extent))
(extent-end-position (car (reverse primary-selection-extent))))
(set-buffer (extent-object primary-selection-extent))
(buffer-substring (extent-start-position primary-selection-extent)
(defvar x-pointers-initialized nil)
(defun x-init-pointer-shape (device)
"Initialize the mouse-pointers of DEVICE from the X resource database."
(if x-pointers-initialized ; only do it when the first device is created
(or (x-get-resource "textPointer" "Cursor" 'string device)
(or (x-get-resource "selectionPointer" "Cursor" 'string device)
(or (x-get-resource "spacePointer" "Cursor" 'string device)
"xterm")) ; was "crosshair"
(or (x-get-resource "modeLinePointer" "Cursor" 'string device)
(or (x-get-resource "gcPointer" "Cursor" 'string device)
(when (featurep 'scrollbar)
(or (x-get-resource "scrollbarPointer" "Cursor" 'string device)
(or (x-get-resource "busyPointer" "Cursor" 'string device)
(or (x-get-resource "toolBarPointer" "Cursor" 'string device)
(x-get-resource "pointerColor" "Foreground" 'string device)))
(set-face-foreground 'pointer fg)))
(x-get-resource "pointerBackground" "Background" 'string device)))
(set-face-background 'pointer bg)))
(setq x-pointers-initialized t))
;;; x-mouse.el ends here