Mercurial > hg > xemacs-beta
diff lisp/x-mouse.el @ 412:697ef44129c6 r21-2-14
Import from CVS: tag r21-2-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:20:41 +0200 |
parents | de805c49cfc1 |
children | da8ed4261e83 |
line wrap: on
line diff
--- a/lisp/x-mouse.el Mon Aug 13 11:19:22 2007 +0200 +++ b/lisp/x-mouse.el Mon Aug 13 11:20:41 2007 +0200 @@ -36,8 +36,6 @@ ;;(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" @@ -45,10 +43,51 @@ (let ((old-point (point))) (mouse-set-point event) (let ((s (buffer-substring old-point (point)))) - (own-clipboard s) + (x-own-clipboard s) (x-store-cutbuffer s)) (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." + (push-mark) + (if (region-active-p) + (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) + (insertcolumn (current-column)) + (first t)) + (push-mark) + (while lines + (or first + (progn + (forward-line 1) + (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))) + (x-insert-selection t))) + +(defun x-insert-selection (&optional check-cutbuffer-p move-point-event) + "Insert the current selection into buffer at point." + (interactive "P") + (let ((text (if check-cutbuffer-p + (or (condition-case () (x-get-selection) (error ())) + (x-get-cutbuffer) + (error "No selection or cut buffer available")) + (x-get-selection)))) + (cond (move-point-event + (mouse-set-point move-point-event) + (push-mark (point))) + ((interactive-p) + (push-mark (point)))) + (insert text) + )) + (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." @@ -63,9 +102,9 @@ ;; 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) + (and (x-selection-owner-p) primary-selection-extent - (insert-selection t event)) + (x-insert-selection t event)) (kill-primary-selection)) (defun mouse-track-and-copy-to-cutbuffer (event) @@ -100,48 +139,41 @@ (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) + (or (x-get-resource "textPointer" "Cursor" 'string device) "xterm")) (set-glyph-image selection-pointer-glyph - (or (x-get-resource "selectionPointer" "Cursor" 'string device - nil 'warn) + (or (x-get-resource "selectionPointer" "Cursor" 'string device) "top_left_arrow")) (set-glyph-image nontext-pointer-glyph - (or (x-get-resource "spacePointer" "Cursor" 'string device nil 'warn) + (or (x-get-resource "spacePointer" "Cursor" 'string device) "xterm")) ; was "crosshair" (set-glyph-image modeline-pointer-glyph - (or (x-get-resource "modeLinePointer" "Cursor" 'string device - nil 'warn) + (or (x-get-resource "modeLinePointer" "Cursor" 'string device) ;; "fleur")) "sb_v_double_arrow")) (set-glyph-image gc-pointer-glyph - (or (x-get-resource "gcPointer" "Cursor" 'string device nil 'warn) + (or (x-get-resource "gcPointer" "Cursor" 'string device) "watch")) (when (featurep 'scrollbar) (set-glyph-image scrollbar-pointer-glyph - (or (x-get-resource "scrollbarPointer" "Cursor" 'string device - nil 'warn) + (or (x-get-resource "scrollbarPointer" "Cursor" 'string device) "top_left_arrow"))) (set-glyph-image busy-pointer-glyph - (or (x-get-resource "busyPointer" "Cursor" 'string device nil 'warn) + (or (x-get-resource "busyPointer" "Cursor" 'string device) "watch")) (set-glyph-image toolbar-pointer-glyph - (or (x-get-resource "toolBarPointer" "Cursor" 'string device - nil 'warn) + (or (x-get-resource "toolBarPointer" "Cursor" 'string device) "left_ptr")) (set-glyph-image divider-pointer-glyph - (or (x-get-resource "dividerPointer" "Cursor" 'string device - nil 'warn) + (or (x-get-resource "dividerPointer" "Cursor" 'string device) "sb_h_double_arrow")) (let ((fg - (x-get-resource "pointerColor" "Foreground" 'string device - nil 'warn))) + (x-get-resource "pointerColor" "Foreground" 'string device))) (and fg (set-face-foreground 'pointer fg))) (let ((bg - (x-get-resource "pointerBackground" "Background" 'string device - nil 'warn))) + (x-get-resource "pointerBackground" "Background" 'string device))) (and bg (set-face-background 'pointer bg))) (setq x-pointers-initialized t))