Mercurial > hg > xemacs-beta

comparison lisp/mouse.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 74fd4e045ea6
children da8ed4261e83
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
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."
90 (interactive) 87 (interactive)
91 (if (and (not (console-on-window-system-p)) 88 (case (device-type)
92 (and (featurep 'gpm) 89 (x (x-yank-function))
93 (not gpm-minor-mode))) 90 (tty (yank))
94 (yank) 91 (otherwise (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 ))
135 92
136 93
137 (defun mouse-select () 94 (defun mouse-select ()
138 "Select Emacs window the mouse is on." 95 "Select Emacs window the mouse is on."
139 (interactive "@")) 96 (interactive "@"))
226 ;; by Oliver Graf <ograf@fga.de> 183 ;; by Oliver Graf <ograf@fga.de>
227 (interactive "e") 184 (interactive "e")
228 (if (click-inside-extent-p event zmacs-region-extent) 185 (if (click-inside-extent-p event zmacs-region-extent)
229 ;; okay, this is a drag 186 ;; okay, this is a drag
230 (cond ((featurep 'offix) 187 (cond ((featurep 'offix)
231 (offix-start-drag-region 188 (offix-start-drag-region event
232 event 189 (extent-start-position zmacs-region-extent)
233 (extent-start-position zmacs-region-extent) 190 (extent-end-position zmacs-region-extent)))
234 (extent-end-position zmacs-region-extent)))
235 ((featurep 'cde) 191 ((featurep 'cde)
236 ;; should also work with CDE 192 ;; should also work with CDE
237 (cde-start-drag-region event 193 (cde-start-drag-region event
238 (extent-start-position zmacs-region-extent) 194 (extent-start-position zmacs-region-extent)
239 (extent-end-position zmacs-region-extent))) 195 (extent-end-position zmacs-region-extent)))
1381 (extent-at modeline-point modeline-string 1337 (extent-at modeline-point modeline-string
1382 'help-echo)))) 1338 'help-echo))))
1383 ;; vars is a list of glyph variables to check for a pointer 1339 ;; vars is a list of glyph variables to check for a pointer
1384 ;; value. 1340 ;; value.
1385 (vars (cond 1341 (vars (cond
1386 ;; Checking if button is non-nil is not sufficient 1342 ;; Checking if button is non-nil is not sufficent
1387 ;; since the pointer could be over a blank portion 1343 ;; since the pointer could be over a blank portion
1388 ;; of the toolbar. 1344 ;; of the toolbar.
1389 ((event-over-toolbar-p event) 1345 ((event-over-toolbar-p event)
1390 '(toolbar-pointer-glyph nontext-pointer-glyph 1346 '(toolbar-pointer-glyph nontext-pointer-glyph
1391 text-pointer-glyph)) 1347 text-pointer-glyph))
1523 drag-divider-event-lag)) 1479 drag-divider-event-lag))
1524 (t 1480 (t
1525 (setq last-timestamp (event-timestamp event)) 1481 (setq last-timestamp (event-timestamp event))
1526 ;; Enlarge the window, calculating change in characters 1482 ;; Enlarge the window, calculating change in characters
1527 ;; of default font. Do not let the window to become 1483 ;; of default font. Do not let the window to become
1528 ;; less than allowed minimum (not because that's critical 1484 ;; less than alolwed minimum (not because that's critical
1529 ;; for the code performance, just the visual effect is 1485 ;; for the code performance, just the visual effect is
1530 ;; better: when cursor goes to the left of the next left 1486 ;; better: when cursor goes to the left of the next left
1531 ;; divider, the window being resized shrinks to minimal 1487 ;; divider, the vindow being resized shrinks to minimal
1532 ;; size. 1488 ;; size.
1533 (enlarge-window (max (- window-min-width (window-width window)) 1489 (enlarge-window (max (- window-min-width (window-width window))
1534 (/ (- (event-x-pixel event) old-right) 1490 (/ (- (event-x-pixel event) old-right)
1535 (face-width 'default window))) 1491 (face-width 'default window)))
1536 t window) 1492 t window)
1537 ;; Backout the change if some windows got deleted, or 1493 ;; Backout the change if some windows got deleted, or
1538 ;; if the change caused more than two windows to resize 1494 ;; if the change caused more than two windows to resize
1539 ;; (shifting the whole stack right is ugly), or if the 1495 ;; (shifting the whole stack right is ugly), or if the
1540 ;; left window side has slipped (right side cannot be 1496 ;; left window side has slipped (right side cannot be
1541 ;; moved any further to the right, so enlarge-window 1497 ;; moved any funrther to the right, so enlarge-window
1542 ;; plays bad games with the left edge. 1498 ;; plays bad games with the left edge.
1543 (if (or (/= (count-windows) (length old-edges-all-windows)) 1499 (if (or (/= (count-windows) (length old-edges-all-windows))
1544 (/= old-left (car (window-pixel-edges window))) 1500 (/= old-left (car (window-pixel-edges window)))
1545 ;; This check is very hairy. We allow any number 1501 ;; This check is very hairy. We allow any number
1546 ;; of left edges to change, but only to the same 1502 ;; of left edges to change, but only to the same