Mercurial > hg > xemacs-beta

comparison lisp/x-mouse.el @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children de805c49cfc1
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
34 ;;(define-key global-map 'button2 'x-set-point-and-insert-selection) 34 ;;(define-key global-map 'button2 'x-set-point-and-insert-selection)
35 ;; This is reserved for use by Hyperbole. 35 ;; This is reserved for use by Hyperbole.
36 ;;(define-key global-map '(shift button2) 'x-mouse-kill) 36 ;;(define-key global-map '(shift button2) 'x-mouse-kill)
37 (define-key global-map '(control button2) 'x-set-point-and-move-selection) 37 (define-key global-map '(control button2) 'x-set-point-and-move-selection)
38 38
39 (define-obsolete-function-alias 'x-insert-selection 'insert-selection)
40
39 (defun x-mouse-kill (event) 41 (defun x-mouse-kill (event)
40 "Kill the text between the point and mouse and copy it to the clipboard and 42 "Kill the text between the point and mouse and copy it to the clipboard and
41 to the cut buffer" 43 to the cut buffer"
42 (interactive "@e") 44 (interactive "@e")
43 (let ((old-point (point))) 45 (let ((old-point (point)))
44 (mouse-set-point event) 46 (mouse-set-point event)
45 (let ((s (buffer-substring old-point (point)))) 47 (let ((s (buffer-substring old-point (point))))
46 (x-own-clipboard s) 48 (own-clipboard s)
47 (x-store-cutbuffer s)) 49 (x-store-cutbuffer s))
48 (kill-region old-point (point)))) 50 (kill-region old-point (point))))
49
50 (defun x-yank-function ()
51 "Insert the current X selection or, if there is none, insert the X cutbuffer.
52 A mark is pushed, so that the inserted text lies between point and mark."
53 (push-mark)
54 (if (region-active-p)
55 (if (consp zmacs-region-extent)
56 ;; pirated code from insert-rectangle in rect.el
57 ;; perhaps that code should be modified to handle a list of extents
58 ;; as the rectangle to be inserted?
59 (let ((lines zmacs-region-extent)
60 (insertcolumn (current-column))
61 (first t))
62 (push-mark)
63 (while lines
64 (or first
65 (progn
66 (forward-line 1)
67 (or (bolp) (insert ?\n))
68 (move-to-column insertcolumn t)))
69 (setq first nil)
70 (insert (extent-string (car lines)))
71 (setq lines (cdr lines))))
72 (insert (extent-string zmacs-region-extent)))
73 (x-insert-selection t)))
74
75 (defun x-insert-selection (&optional check-cutbuffer-p move-point-event)
76 "Insert the current selection into buffer at point."
77 (interactive "P")
78 (let ((text (if check-cutbuffer-p
79 (or (condition-case () (x-get-selection) (error ()))
80 (x-get-cutbuffer)
81 (error "No selection or cut buffer available"))
82 (x-get-selection))))
83 (cond (move-point-event
84 (mouse-set-point move-point-event)
85 (push-mark (point)))
86 ((interactive-p)
87 (push-mark (point))))
88 (insert text)
89 ))
90 51
91 (make-obsolete 'x-set-point-and-insert-selection 'mouse-yank) 52 (make-obsolete 'x-set-point-and-insert-selection 'mouse-yank)
92 (defun x-set-point-and-insert-selection (event) 53 (defun x-set-point-and-insert-selection (event)
93 "Set point where clicked and insert the primary selection or the cut buffer." 54 "Set point where clicked and insert the primary selection or the cut buffer."
94 (interactive "e") 55 (interactive "e")
100 (interactive "e") 61 (interactive "e")
101 ;; Don't try to move the selection if x-kill-primary-selection if going 62 ;; Don't try to move the selection if x-kill-primary-selection if going
102 ;; to fail; just let the appropriate error message get issued. (We need 63 ;; to fail; just let the appropriate error message get issued. (We need
103 ;; to insert the selection and set point first, or the selection may 64 ;; to insert the selection and set point first, or the selection may
104 ;; get inserted at the wrong place.) 65 ;; get inserted at the wrong place.)
105 (and (x-selection-owner-p) 66 (and (selection-owner-p)
106 primary-selection-extent 67 primary-selection-extent
107 (x-insert-selection t event)) 68 (insert-selection t event))
108 (kill-primary-selection)) 69 (kill-primary-selection))
109 70
110 (defun mouse-track-and-copy-to-cutbuffer (event) 71 (defun mouse-track-and-copy-to-cutbuffer (event)
111 "Make a selection like `mouse-track', but also copy it to the cutbuffer." 72 "Make a selection like `mouse-track', but also copy it to the cutbuffer."
112 (interactive "e") 73 (interactive "e")