Mercurial > hg > xemacs-beta

comparison lisp/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 aabb7f5b1c81
children 697ef44129c6
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
82 82
83 (defvar mouse-yank-function 'mouse-consolidated-yank 83 (defvar mouse-yank-function 'mouse-consolidated-yank
84 "Function that is called upon by `mouse-yank' to actually insert text.") 84 "Function that is called upon by `mouse-yank' to actually insert text.")
85 85
86 (defun mouse-consolidated-yank () 86 (defun mouse-consolidated-yank ()
87 "Insert the current selection or, if there is none under X insert
88 the X cutbuffer. A mark is pushed, so that the inserted text lies
89 between point and mark."
87 (interactive) 90 (interactive)
88 (case (device-type) 91 (if (and (not (console-on-window-system-p))
89 (x (x-yank-function)) 92 (and (featurep 'gpm)
90 (tty (yank)) 93 (not gpm-minor-mode)))
91 (otherwise (yank)))) 94 (yank)
95 (push-mark)
96 (if (region-active-p)
97 (if (consp zmacs-region-extent)
98 ;; pirated code from insert-rectangle in rect.el
99 ;; perhaps that code should be modified to handle a list of extents
100 ;; as the rectangle to be inserted?
101 (let ((lines zmacs-region-extent)
102 (insertcolumn (current-column))
103 (first t))
104 (push-mark)
105 (while lines
106 (or first
107 (progn
108 (forward-line 1)
109 (or (bolp) (insert ?\n))
110 (move-to-column insertcolumn t)))
111 (setq first nil)
112 (insert (extent-string (car lines)))
113 (setq lines (cdr lines))))
114 (insert (extent-string zmacs-region-extent)))
115 (insert-selection t))))
116
117 (defun insert-selection (&optional check-cutbuffer-p move-point-event)
118 "Insert the current selection into buffer at point."
119 (interactive "P")
120 ;; we fallback to the clipboard if the current selection is not existent
121 (let ((text (if check-cutbuffer-p
122 (or (get-selection-no-error)
123 (get-cutbuffer)
124 (get-selection-no-error 'CLIPBOARD)
125 (error "No selection, clipboard or cut buffer available"))
126 (or (get-selection-no-error)
127 (get-selection 'CLIPBOARD)))))
128 (cond (move-point-event
129 (mouse-set-point move-point-event)
130 (push-mark (point)))
131 ((interactive-p)
132 (push-mark (point))))
133 (insert text)
134 ))
92 135
93 136
94 (defun mouse-select () 137 (defun mouse-select ()
95 "Select Emacs window the mouse is on." 138 "Select Emacs window the mouse is on."
96 (interactive "@")) 139 (interactive "@"))
183 ;; by Oliver Graf <ograf@fga.de> 226 ;; by Oliver Graf <ograf@fga.de>
184 (interactive "e") 227 (interactive "e")
185 (if (click-inside-extent-p event zmacs-region-extent) 228 (if (click-inside-extent-p event zmacs-region-extent)
186 ;; okay, this is a drag 229 ;; okay, this is a drag
187 (cond ((featurep 'offix) 230 (cond ((featurep 'offix)
188 (offix-start-drag-region event 231 (offix-start-drag-region
189 (extent-start-position zmacs-region-extent) 232 event
190 (extent-end-position zmacs-region-extent))) 233 (extent-start-position zmacs-region-extent)
234 (extent-end-position zmacs-region-extent)))
191 ((featurep 'cde) 235 ((featurep 'cde)
192 ;; should also work with CDE 236 ;; should also work with CDE
193 (cde-start-drag-region event 237 (cde-start-drag-region event
194 (extent-start-position zmacs-region-extent) 238 (extent-start-position zmacs-region-extent)
195 (extent-end-position zmacs-region-extent))) 239 (extent-end-position zmacs-region-extent)))
1337 (extent-at modeline-point modeline-string 1381 (extent-at modeline-point modeline-string
1338 'help-echo)))) 1382 'help-echo))))
1339 ;; vars is a list of glyph variables to check for a pointer 1383 ;; vars is a list of glyph variables to check for a pointer
1340 ;; value. 1384 ;; value.
1341 (vars (cond 1385 (vars (cond
1342 ;; Checking if button is non-nil is not sufficent 1386 ;; Checking if button is non-nil is not sufficient
1343 ;; since the pointer could be over a blank portion 1387 ;; since the pointer could be over a blank portion
1344 ;; of the toolbar. 1388 ;; of the toolbar.
1345 ((event-over-toolbar-p event) 1389 ((event-over-toolbar-p event)
1346 '(toolbar-pointer-glyph nontext-pointer-glyph 1390 '(toolbar-pointer-glyph nontext-pointer-glyph
1347 text-pointer-glyph)) 1391 text-pointer-glyph))
1479 drag-divider-event-lag)) 1523 drag-divider-event-lag))
1480 (t 1524 (t
1481 (setq last-timestamp (event-timestamp event)) 1525 (setq last-timestamp (event-timestamp event))
1482 ;; Enlarge the window, calculating change in characters 1526 ;; Enlarge the window, calculating change in characters
1483 ;; of default font. Do not let the window to become 1527 ;; of default font. Do not let the window to become
1484 ;; less than alolwed minimum (not because that's critical 1528 ;; less than allowed minimum (not because that's critical
1485 ;; for the code performance, just the visual effect is 1529 ;; for the code performance, just the visual effect is
1486 ;; better: when cursor goes to the left of the next left 1530 ;; better: when cursor goes to the left of the next left
1487 ;; divider, the vindow being resized shrinks to minimal 1531 ;; divider, the window being resized shrinks to minimal
1488 ;; size. 1532 ;; size.
1489 (enlarge-window (max (- window-min-width (window-width window)) 1533 (enlarge-window (max (- window-min-width (window-width window))
1490 (/ (- (event-x-pixel event) old-right) 1534 (/ (- (event-x-pixel event) old-right)
1491 (face-width 'default window))) 1535 (face-width 'default window)))
1492 t window) 1536 t window)
1493 ;; Backout the change if some windows got deleted, or 1537 ;; Backout the change if some windows got deleted, or
1494 ;; if the change caused more than two windows to resize 1538 ;; if the change caused more than two windows to resize
1495 ;; (shifting the whole stack right is ugly), or if the 1539 ;; (shifting the whole stack right is ugly), or if the
1496 ;; left window side has slipped (right side cannot be 1540 ;; left window side has slipped (right side cannot be
1497 ;; moved any funrther to the right, so enlarge-window 1541 ;; moved any further to the right, so enlarge-window
1498 ;; plays bad games with the left edge. 1542 ;; plays bad games with the left edge.
1499 (if (or (/= (count-windows) (length old-edges-all-windows)) 1543 (if (or (/= (count-windows) (length old-edges-all-windows))
1500 (/= old-left (car (window-pixel-edges window))) 1544 (/= old-left (car (window-pixel-edges window)))
1501 ;; This check is very hairy. We allow any number 1545 ;; This check is very hairy. We allow any number
1502 ;; of left edges to change, but only to the same 1546 ;; of left edges to change, but only to the same