1 ;;; x-mouse.el --- Mouse support for X window system.
3 ;; Copyright (C) 1985, 1992-4, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 1996 Ben Wing.
6 ;; Maintainer: SXEmacs Development Team
7 ;; Keywords: mouse, dumped
9 ;; This file is part of SXEmacs.
11 ;; SXEmacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; SXEmacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Synched up with: Not synched.
28 ;; This file is dumped with SXEmacs (when X support is compiled in).
32 (globally-declare-fboundp
33 '(x-store-cutbuffer x-get-resource))
35 ;;(define-key global-map 'button2 'x-set-point-and-insert-selection)
36 ;; This is reserved for use by Hyperbole.
37 ;;(define-key global-map '(shift button2) 'x-mouse-kill)
38 (define-key global-map '(control button2) 'x-set-point-and-move-selection)
40 (define-obsolete-function-alias 'x-insert-selection 'insert-selection)
42 (defun x-mouse-kill (event)
43 "Kill the text between the point and mouse and copy it to the clipboard and
46 (let ((old-point (point)))
47 (mouse-set-point event)
48 (let ((s (buffer-substring old-point (point))))
50 (x-store-cutbuffer s))
51 (kill-region old-point (point))))
53 (make-obsolete 'x-set-point-and-insert-selection 'mouse-yank)
54 (defun x-set-point-and-insert-selection (event)
55 "Set point where clicked and insert the primary selection or the cut buffer."
57 (let ((mouse-yank-at-point nil))
60 (defun x-set-point-and-move-selection (event)
61 "Set point where clicked and move the selected text to that location."
63 ;; Don't try to move the selection if x-kill-primary-selection if going
64 ;; to fail; just let the appropriate error message get issued. (We need
65 ;; to insert the selection and set point first, or the selection may
66 ;; get inserted at the wrong place.)
67 (and (selection-owner-p)
68 primary-selection-extent
69 (insert-selection t event))
70 (kill-primary-selection))
72 (defun mouse-track-and-copy-to-cutbuffer (event)
73 "Make a selection like `mouse-track', but also copy it to the cutbuffer."
77 ((null primary-selection-extent)
79 ((consp primary-selection-extent)
81 (set-buffer (extent-object (car primary-selection-extent)))
87 (extent-start-position (car primary-selection-extent))
88 (extent-end-position (car (reverse primary-selection-extent)))))
92 (set-buffer (extent-object primary-selection-extent))
94 (buffer-substring (extent-start-position primary-selection-extent)
95 (extent-end-position primary-selection-extent)))))))
98 (defvar x-pointers-initialized nil)
100 (defun x-init-pointer-shape (device)
101 "Initialize the mouse-pointers of DEVICE from the X resource database."
102 (if x-pointers-initialized ; only do it when the first device is created
104 (set-glyph-image text-pointer-glyph
105 (or (x-get-resource "textPointer" "Cursor" 'string device nil 'warn)
106 [cursor-font :data "xterm"]))
107 (set-glyph-image selection-pointer-glyph
108 (or (x-get-resource "selectionPointer" "Cursor" 'string device
110 [cursor-font :data "top_left_arrow"]))
111 (set-glyph-image nontext-pointer-glyph
112 (or (x-get-resource "spacePointer" "Cursor" 'string device nil 'warn)
113 [cursor-font :data "xterm"])) ; was "crosshair"
114 (set-glyph-image modeline-pointer-glyph
115 (or (x-get-resource "modeLinePointer" "Cursor" 'string device
118 [cursor-font :data "sb_v_double_arrow"]))
119 (set-glyph-image gc-pointer-glyph
120 (or (x-get-resource "gcPointer" "Cursor" 'string device nil 'warn)
121 [cursor-font :data "watch"]))
122 (when (featurep 'scrollbar)
124 scrollbar-pointer-glyph
125 (or (x-get-resource "scrollbarPointer" "Cursor" 'string device
127 ;; bizarrely if we don't specify the specific locale (x) this
128 ;; gets instantiated on the stream device. Bad puppy.
129 [cursor-font :data "top_left_arrow"]) 'global '(default x)))
130 (set-glyph-image busy-pointer-glyph
131 (or (x-get-resource "busyPointer" "Cursor" 'string device nil 'warn)
132 [cursor-font :data "watch"]))
133 (set-glyph-image toolbar-pointer-glyph
134 (or (x-get-resource "toolBarPointer" "Cursor" 'string device
136 [cursor-font :data "left_ptr"]))
137 (set-glyph-image divider-pointer-glyph
138 (or (x-get-resource "dividerPointer" "Cursor" 'string device
140 [cursor-font :data "sb_h_double_arrow"]))
142 (x-get-resource "pointerColor" "Foreground" 'string device
145 (set-face-foreground 'pointer fg)))
147 (x-get-resource "pointerBackground" "Background" 'string device
150 (set-face-background 'pointer bg)))
151 (setq x-pointers-initialized t))
154 ;;; x-mouse.el ends here