view lisp/x-mouse.el @ 1261:465bd3c7d932

[xemacs-hg @ 2003-02-06 06:35:47 by ben] various bug fixes mule/cyril-util.el: Fix compile warning. loadup.el, make-docfile.el, update-elc-2.el, update-elc.el: Set stack-trace-on-error, load-always-display-messages so we get better debug results. update-elc-2.el: Fix typo in name of lisp/mule, leading to compile failure. simple.el: Omit M-S-home/end from motion keys. update-elc.el: Overhaul: -- allow list of "early-compile" files to be specified, not hardcoded -- fix autoload checking to include all .el files, not just dumped ones -- be smarter about regenerating autoloads, so we don't need to use loadup-el if not necessary -- use standard methods for loading/not loading auto-autoloads.el (maybe fixes "Already loaded" error?) -- rename misleading NOBYTECOMPILE flag file. window-xemacs.el: Fix bug in default param. window-xemacs.el: Fix compile warnings. lwlib-Xm.c: Fix compile warning. lispref/mule.texi: Lots of Mule rewriting. internals/internals.texi: Major fixup. Correct for new names of Bytebpos, Ichar, etc. and lots of Mule rewriting. config.inc.samp: Various fixups. Makefile.in.in: NOBYTECOMPILE -> BYTECOMPILE_CHANGE. esd.c: Warning fixes. fns.c: Eliminate bogus require-prints-loading-message; use already existent load-always-display-messages instead. Make sure `load' knows we are coming from `require'. lread.c: Turn on `load-warn-when-source-newer' by default. Change loading message to indicate when we are `require'ing. Eliminate purify_flag hacks to display more messages; instead, loadup and friends specify this explicitly with `load-always-display-messages'. Add spaces when batch to clearly indicate recursive loading. Fassoc() does not GC so no need to gcpro. gui-x.c, gui-x.h, menubar-x.c: Fix up crashes when selecting menubar items due to lack of GCPROing of callbacks in lwlib structures. eval.c, lisp.h, print.c: Don't canonicalize to selected-frame when noninteractive, or backtraces get all screwed up as some values are printed through the stream console and some aren't. Export canonicalize_printcharfun() and use in Fbacktrace().
author ben
date Thu, 06 Feb 2003 06:36:17 +0000
parents 7039e6323819
children 308d34e9f07d
line wrap: on
line source

;;; 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.

;;; Commentary:

;; This file is dumped with XEmacs (when X support is compiled in).

;;; Code:

(globally-declare-fboundp
 '(x-store-cutbuffer x-get-resource))

;;(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)

(define-obsolete-function-alias 'x-insert-selection 'insert-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."
  (interactive "@e")
  (let ((old-point (point)))
    (mouse-set-point event)
    (let ((s (buffer-substring old-point (point))))
      (own-clipboard s)
      (x-store-cutbuffer s))
    (kill-region old-point (point))))

(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."
  (interactive "e")
  (let ((mouse-yank-at-point nil))
    (mouse-yank event)))

(defun x-set-point-and-move-selection (event)
  "Set point where clicked and move the selected text to that location."
  (interactive "e")
  ;; 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.)
  (and (selection-owner-p)
       primary-selection-extent
       (insert-selection t event))
  (kill-primary-selection))

(defun mouse-track-and-copy-to-cutbuffer (event)
  "Make a selection like `mouse-track', but also copy it to the cutbuffer."
  (interactive "e")
  (mouse-track event)
  (cond
   ((null primary-selection-extent)
    nil)
   ((consp primary-selection-extent)
    (save-excursion
      (set-buffer (extent-object (car primary-selection-extent)))
      (x-store-cutbuffer
       (mapconcat
	#'identity
	(extract-rectangle
	 (extent-start-position (car primary-selection-extent))
	 (extent-end-position (car (reverse primary-selection-extent))))
	"\n"))))
   (t
    (save-excursion
      (set-buffer (extent-object primary-selection-extent))
      (x-store-cutbuffer
       (buffer-substring (extent-start-position primary-selection-extent)
			 (extent-end-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
      nil
    (set-glyph-image text-pointer-glyph
	  (or (x-get-resource "textPointer" "Cursor" 'string device nil 'warn)
	      [cursor-font :data "xterm"]))
    (set-glyph-image selection-pointer-glyph
	  (or (x-get-resource "selectionPointer" "Cursor" 'string device
			      nil 'warn)
	      [cursor-font :data "top_left_arrow"]))
    (set-glyph-image nontext-pointer-glyph
	  (or (x-get-resource "spacePointer" "Cursor" 'string device nil 'warn)
	      [cursor-font :data "xterm"])) ; was "crosshair"
    (set-glyph-image modeline-pointer-glyph
	  (or (x-get-resource "modeLinePointer" "Cursor" 'string device
			      nil 'warn)
;;	      "fleur"))
	      [cursor-font :data "sb_v_double_arrow"]))
    (set-glyph-image gc-pointer-glyph
	  (or (x-get-resource "gcPointer" "Cursor" 'string device nil 'warn)
	      [cursor-font :data "watch"]))
    (when (featurep 'scrollbar)
      (set-glyph-image
       scrollbar-pointer-glyph
       (or (x-get-resource "scrollbarPointer" "Cursor" 'string device
			   nil 'warn)
	   ;; bizarrely if we don't specify the specific locale (x) this
	   ;; gets instantiated on the stream device. Bad puppy.
	   [cursor-font :data "top_left_arrow"]) 'global '(default x)))
    (set-glyph-image busy-pointer-glyph
	  (or (x-get-resource "busyPointer" "Cursor" 'string device nil 'warn)
	      [cursor-font :data "watch"]))
    (set-glyph-image toolbar-pointer-glyph
	  (or (x-get-resource "toolBarPointer" "Cursor" 'string device
			      nil 'warn)
	      [cursor-font :data "left_ptr"]))
    (set-glyph-image divider-pointer-glyph
	  (or (x-get-resource "dividerPointer" "Cursor" 'string device
			      nil 'warn)
	      [cursor-font :data "sb_h_double_arrow"]))
    (let ((fg
	   (x-get-resource "pointerColor" "Foreground" 'string device
			   nil 'warn)))
      (and fg
	   (set-face-foreground 'pointer fg)))
    (let ((bg
	   (x-get-resource "pointerBackground" "Background" 'string device
			   nil 'warn)))
      (and bg
	   (set-face-background 'pointer bg)))
    (setq x-pointers-initialized t))
  nil)

;;; x-mouse.el ends here