aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/mouse.el
diff options
context:
space:
mode:
authorKenichi Handa2010-08-25 14:15:20 +0900
committerKenichi Handa2010-08-25 14:15:20 +0900
commit4e603db3429957e6b26953c177f00a9c9d1c8766 (patch)
tree8206240e3006468bff9dfda5fb3696f80fbcb9f0 /lisp/mouse.el
parentb60f961f6cdc1095e778ad624657bb57788512af (diff)
parentf6aa6ec68ed936800ef2c3aefa42102e60b654cb (diff)
downloademacs-4e603db3429957e6b26953c177f00a9c9d1c8766.tar.gz
emacs-4e603db3429957e6b26953c177f00a9c9d1c8766.zip
merge trunk
Diffstat (limited to 'lisp/mouse.el')
-rw-r--r--lisp/mouse.el716
1 files changed, 165 insertions, 551 deletions
diff --git a/lisp/mouse.el b/lisp/mouse.el
index f404de98ce3..a2a0191ce79 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1268,10 +1268,11 @@ regardless of where you click."
1268 (interactive "e") 1268 (interactive "e")
1269 ;; Give temporary modes such as isearch a chance to turn off. 1269 ;; Give temporary modes such as isearch a chance to turn off.
1270 (run-hooks 'mouse-leave-buffer-hook) 1270 (run-hooks 'mouse-leave-buffer-hook)
1271 ;; Without this, confusing things happen upon e.g. inserting into
1272 ;; the middle of an active region.
1271 (when select-active-regions 1273 (when select-active-regions
1272 ;; Without this, confusing things happen upon e.g. inserting into 1274 (let (select-active-regions)
1273 ;; the middle of an active region. 1275 (deactivate-mark)))
1274 (deactivate-mark))
1275 (or mouse-yank-at-point (mouse-set-point click)) 1276 (or mouse-yank-at-point (mouse-set-point click))
1276 (let ((primary 1277 (let ((primary
1277 (cond 1278 (cond
@@ -1297,8 +1298,7 @@ This does not delete the region; it acts like \\[kill-ring-save]."
1297;; whenever it was equal to the front of the kill ring, but some 1298;; whenever it was equal to the front of the kill ring, but some
1298;; people found that confusing. 1299;; people found that confusing.
1299 1300
1300;; A list (TEXT START END), describing the text and position of the last 1301;; The position of the last invocation of `mouse-save-then-kill'.
1301;; invocation of mouse-save-then-kill.
1302(defvar mouse-save-then-kill-posn nil) 1302(defvar mouse-save-then-kill-posn nil)
1303 1303
1304(defun mouse-save-then-kill-delete-region (beg end) 1304(defun mouse-save-then-kill-delete-region (beg end)
@@ -1336,111 +1336,76 @@ This does not delete the region; it acts like \\[kill-ring-save]."
1336 (undo-boundary)) 1336 (undo-boundary))
1337 1337
1338(defun mouse-save-then-kill (click) 1338(defun mouse-save-then-kill (click)
1339 "Set the region according to CLICK; the second time, kill the region. 1339 "Set the region according to CLICK; the second time, kill it.
1340Assuming this command is bound to a mouse button, CLICK is the 1340CLICK should be a mouse click event.
1341corresponding input event. 1341
1342 1342If the region is inactive, activate it temporarily. Set mark at
1343If the region is already active, adjust it. Normally, this 1343the original point, and move point to the position of CLICK.
1344happens by moving either point or mark, whichever is closer, to 1344
1345the position of CLICK. But if you have selected words or lines, 1345If the region is already active, adjust it. Normally, do this by
1346the region is adjusted by moving point or mark to the word or 1346moving point or mark, whichever is closer, to CLICK. But if you
1347line boundary closest to CLICK. 1347have selected whole words or lines, move point or mark to the
1348 1348word or line boundary closest to CLICK instead.
1349If the region is inactive, activate it temporarily; set mark at 1349
1350the original point, and move click to the position of CLICK. 1350If this command is called a second consecutive time with the same
1351 1351CLICK position, kill the region."
1352However, if this command is being called a second time (i.e. the
1353value of `last-command' is `mouse-save-then-kill'), kill the
1354region instead. If the text in the region is the same as the
1355text in the front of the kill ring, just delete it."
1356 (interactive "e") 1352 (interactive "e")
1357 (let ((before-scroll 1353 (mouse-minibuffer-check click)
1358 (with-current-buffer (window-buffer (posn-window (event-start click))) 1354 (let* ((posn (event-start click))
1359 point-before-scroll))) 1355 (click-pt (posn-point posn))
1360 (mouse-minibuffer-check click) 1356 (window (posn-window posn))
1361 (let ((click-posn (posn-point (event-start click))) 1357 (buf (window-buffer window))
1362 ;; Don't let a subsequent kill command append to this one: 1358 ;; Don't let a subsequent kill command append to this one.
1363 ;; prevent setting this-command to kill-region. 1359 (this-command this-command)
1364 (this-command this-command)) 1360 ;; Check if the user has multi-clicked to select words/lines.
1365 (if (and (with-current-buffer 1361 (click-count
1366 (window-buffer (posn-window (event-start click))) 1362 (if (and (eq mouse-selection-click-count-buffer buf)
1367 (and (mark t) 1363 (with-current-buffer buf (mark t)))
1368 (> (mod mouse-selection-click-count 3) 0) 1364 mouse-selection-click-count
1369 ;; Don't be fooled by a recent click in some other buffer. 1365 0)))
1370 (eq mouse-selection-click-count-buffer 1366 (cond
1371 (current-buffer))))) 1367 ((not (numberp click-pt)) nil)
1372 (if (and (eq last-command 'mouse-save-then-kill) 1368 ;; If the user clicked without moving point, kill the region.
1373 (equal click-posn (nth 2 mouse-save-then-kill-posn))) 1369 ;; This also resets `mouse-selection-click-count'.
1374 ;; If we click this button again without moving it, kill. 1370 ((and (eq last-command 'mouse-save-then-kill)
1375 (progn 1371 (eq click-pt mouse-save-then-kill-posn)
1376 ;; Call `deactivate-mark' to save the primary selection. 1372 (eq window (selected-window)))
1377 (deactivate-mark) 1373 (kill-region (mark t) (point))
1378 (mouse-save-then-kill-delete-region (mark) (point)) 1374 (setq mouse-selection-click-count 0)
1379 (setq mouse-selection-click-count 0) 1375 (setq mouse-save-then-kill-posn nil))
1380 (setq mouse-save-then-kill-posn nil)) 1376
1381 ;; Find both ends of the object selected by this click. 1377 ;; Otherwise, if there is a suitable region, adjust it by moving
1382 (let* ((range 1378 ;; one end (whichever is closer) to CLICK-PT.
1383 (mouse-start-end click-posn click-posn 1379 ((or (with-current-buffer buf (region-active-p))
1384 mouse-selection-click-count))) 1380 (and (eq window (selected-window))
1385 ;; Move whichever end is closer to the click. 1381 (mark t)
1386 ;; That's what xterm does, and it seems reasonable. 1382 (or (and (eq last-command 'mouse-save-then-kill)
1387 (if (< (abs (- click-posn (mark t))) 1383 mouse-save-then-kill-posn)
1388 (abs (- click-posn (point)))) 1384 (and (memq last-command '(mouse-drag-region
1389 (set-mark (car range)) 1385 mouse-set-region))
1390 (goto-char (nth 1 range))) 1386 (or mark-even-if-inactive
1391 ;; We have already put the old region in the kill ring. 1387 (not transient-mark-mode))))))
1392 ;; Replace it with the extended region. 1388 (select-window window)
1393 ;; (It would be annoying to make a separate entry.) 1389 (let* ((range (mouse-start-end click-pt click-pt click-count)))
1394 (kill-new (buffer-substring (point) (mark t)) t) 1390 (if (< (abs (- click-pt (mark t)))
1395 (mouse-set-region-1) 1391 (abs (- click-pt (point))))
1396 ;; Arrange for a repeated mouse-3 to kill this region. 1392 (set-mark (car range))
1397 (setq mouse-save-then-kill-posn 1393 (goto-char (nth 1 range)))
1398 (list (car kill-ring) (point) click-posn)))) 1394 (setq deactivate-mark nil)
1399 1395 (mouse-set-region-1)
1400 (if (and (eq last-command 'mouse-save-then-kill) 1396 ;; Arrange for a repeated mouse-3 to kill the region.
1401 mouse-save-then-kill-posn 1397 (setq mouse-save-then-kill-posn click-pt)))
1402 (eq (car mouse-save-then-kill-posn) (car kill-ring)) 1398
1403 (equal (cdr mouse-save-then-kill-posn) 1399 ;; Otherwise, set the mark where point is and move to CLICK-PT.
1404 (list (point) click-posn))) 1400 (t
1405 ;; If this is the second time we've called 1401 (select-window window)
1406 ;; mouse-save-then-kill, delete the text from the buffer. 1402 (mouse-set-mark-fast click)
1407 (progn 1403 (let ((before-scroll (with-current-buffer buf point-before-scroll)))
1408 ;; Call `deactivate-mark' to save the primary selection. 1404 (if before-scroll (goto-char before-scroll)))
1409 (deactivate-mark) 1405 (exchange-point-and-mark)
1410 (mouse-save-then-kill-delete-region (point) (mark t)) 1406 (mouse-set-region-1)
1411 ;; After we kill, another click counts as "the first time". 1407 (setq mouse-save-then-kill-posn click-pt)))))
1412 (setq mouse-save-then-kill-posn nil)) 1408
1413 ;; This is not a repetition.
1414 ;; We are adjusting an old selection or creating a new one.
1415 (if (or (and (eq last-command 'mouse-save-then-kill)
1416 mouse-save-then-kill-posn)
1417 (and mark-active transient-mark-mode)
1418 (and (memq last-command
1419 '(mouse-drag-region mouse-set-region))
1420 (or mark-even-if-inactive
1421 (not transient-mark-mode))))
1422 ;; We have a selection or suitable region, so adjust it.
1423 (let* ((posn (event-start click))
1424 (new (posn-point posn)))
1425 (select-window (posn-window posn))
1426 (if (numberp new)
1427 (progn
1428 ;; Move whichever end of the region is closer to the click.
1429 ;; That is what xterm does, and it seems reasonable.
1430 (if (<= (abs (- new (point))) (abs (- new (mark t))))
1431 (goto-char new)
1432 (set-mark new))
1433 (setq deactivate-mark nil)))
1434 (kill-new (buffer-substring (point) (mark t)) t))
1435 ;; Set the mark where point is, then move where clicked.
1436 (mouse-set-mark-fast click)
1437 (if before-scroll
1438 (goto-char before-scroll))
1439 (exchange-point-and-mark) ;Why??? --Stef
1440 (kill-new (buffer-substring (point) (mark t))))
1441 (mouse-set-region-1)
1442 (setq mouse-save-then-kill-posn
1443 (list (car kill-ring) (point) click-posn)))))))
1444 1409
1445(global-set-key [M-mouse-1] 'mouse-start-secondary) 1410(global-set-key [M-mouse-1] 'mouse-start-secondary)
1446(global-set-key [M-drag-mouse-1] 'mouse-set-secondary) 1411(global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
@@ -1520,9 +1485,6 @@ The function returns a non-nil value if it creates a secondary selection."
1520 ;; of one word or line. 1485 ;; of one word or line.
1521 (let ((range (mouse-start-end start-point start-point click-count))) 1486 (let ((range (mouse-start-end start-point start-point click-count)))
1522 (set-marker mouse-secondary-start nil) 1487 (set-marker mouse-secondary-start nil)
1523 ;; Why the double move? --Stef
1524 ;; (move-overlay mouse-secondary-overlay 1 1
1525 ;; (window-buffer start-window))
1526 (move-overlay mouse-secondary-overlay (car range) (nth 1 range) 1488 (move-overlay mouse-secondary-overlay (car range) (nth 1 range)
1527 (window-buffer start-window))) 1489 (window-buffer start-window)))
1528 ;; Single-press: cancel any preexisting secondary selection. 1490 ;; Single-press: cancel any preexisting secondary selection.
@@ -1616,117 +1578,99 @@ is to prevent accidents."
1616 (delete-overlay mouse-secondary-overlay)) 1578 (delete-overlay mouse-secondary-overlay))
1617 1579
1618(defun mouse-secondary-save-then-kill (click) 1580(defun mouse-secondary-save-then-kill (click)
1619 "Save text to point in kill ring; the second time, kill the text. 1581 "Set the secondary selection and save it to the kill ring.
1620You must use this in a buffer where you have recently done \\[mouse-start-secondary]. 1582The second time, kill it. CLICK should be a mouse click event.
1621If the text between where you did \\[mouse-start-secondary] and where 1583
1622you use this command matches the text at the front of the kill ring, 1584If you have not called `mouse-start-secondary' in the clicked
1623this command deletes the text. 1585buffer, activate the secondary selection and set it between point
1624Otherwise, it adds the text to the kill ring, like \\[kill-ring-save], 1586and the click position CLICK.
1625which prepares for a second click with this command to delete the text. 1587
1626 1588Otherwise, adjust the bounds of the secondary selection.
1627If you have already made a secondary selection in that buffer, 1589Normally, do this by moving its beginning or end, whichever is
1628this command extends or retracts the selection to where you click. 1590closer, to CLICK. But if you have selected whole words or lines,
1629If you do this again in a different position, it extends or retracts 1591adjust to the word or line boundary closest to CLICK instead.
1630again. If you do this twice in the same position, it kills the selection." 1592
1593If this command is called a second consecutive time with the same
1594CLICK position, kill the secondary selection."
1631 (interactive "e") 1595 (interactive "e")
1632 (mouse-minibuffer-check click) 1596 (mouse-minibuffer-check click)
1633 (let ((posn (event-start click)) 1597 (let* ((posn (event-start click))
1634 (click-posn (posn-point (event-start click))) 1598 (click-pt (posn-point posn))
1635 ;; Don't let a subsequent kill command append to this one: 1599 (window (posn-window posn))
1636 ;; prevent setting this-command to kill-region. 1600 (buf (window-buffer window))
1637 (this-command this-command)) 1601 ;; Don't let a subsequent kill command append to this one.
1638 (or (eq (window-buffer (posn-window posn)) 1602 (this-command this-command)
1639 (or (overlay-buffer mouse-secondary-overlay) 1603 ;; Check if the user has multi-clicked to select words/lines.
1640 (if mouse-secondary-start 1604 (click-count
1641 (marker-buffer mouse-secondary-start)))) 1605 (if (eq (overlay-buffer mouse-secondary-overlay) buf)
1642 (error "Wrong buffer")) 1606 mouse-secondary-click-count
1643 (with-current-buffer (window-buffer (posn-window posn)) 1607 0))
1644 (if (> (mod mouse-secondary-click-count 3) 0) 1608 (beg (overlay-start mouse-secondary-overlay))
1645 (if (not (and (eq last-command 'mouse-secondary-save-then-kill) 1609 (end (overlay-end mouse-secondary-overlay)))
1646 (equal click-posn 1610
1647 (car (cdr-safe (cdr-safe mouse-save-then-kill-posn)))))) 1611 (cond
1648 ;; Find both ends of the object selected by this click. 1612 ((not (numberp click-pt)) nil)
1649 (let* ((range 1613
1650 (mouse-start-end click-posn click-posn 1614 ;; If the secondary selection is not active in BUF, activate it.
1651 mouse-secondary-click-count))) 1615 ((not (eq buf (or (overlay-buffer mouse-secondary-overlay)
1652 ;; Move whichever end is closer to the click. 1616 (if mouse-secondary-start
1653 ;; That's what xterm does, and it seems reasonable. 1617 (marker-buffer mouse-secondary-start)))))
1654 (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay))) 1618 (select-window window)
1655 (abs (- click-posn (overlay-end mouse-secondary-overlay)))) 1619 (setq mouse-secondary-start (make-marker))
1656 (move-overlay mouse-secondary-overlay (car range) 1620 (move-marker mouse-secondary-start (point))
1657 (overlay-end mouse-secondary-overlay)) 1621 (move-overlay mouse-secondary-overlay (point) click-pt buf)
1658 (move-overlay mouse-secondary-overlay 1622 (kill-ring-save (point) click-pt))
1659 (overlay-start mouse-secondary-overlay) 1623
1660 (nth 1 range))) 1624 ;; If the user clicked without moving point, delete the secondary
1661 ;; We have already put the old region in the kill ring. 1625 ;; selection. This also resets `mouse-secondary-click-count'.
1662 ;; Replace it with the extended region. 1626 ((and (eq last-command 'mouse-secondary-save-then-kill)
1663 ;; (It would be annoying to make a separate entry.) 1627 (eq click-pt mouse-save-then-kill-posn)
1664 (kill-new (buffer-substring 1628 (eq window (selected-window)))
1665 (overlay-start mouse-secondary-overlay) 1629 (mouse-save-then-kill-delete-region beg end)
1666 (overlay-end mouse-secondary-overlay)) t) 1630 (delete-overlay mouse-secondary-overlay)
1667 ;; Arrange for a repeated mouse-3 to kill this region. 1631 (setq mouse-secondary-click-count 0)
1668 (setq mouse-save-then-kill-posn 1632 (setq mouse-save-then-kill-posn nil))
1669 (list (car kill-ring) (point) click-posn))) 1633
1670 ;; If we click this button again without moving it, 1634 ;; Otherwise, if there is a suitable secondary selection overlay,
1671 ;; that time kill. 1635 ;; adjust it by moving one end (whichever is closer) to CLICK-PT.
1672 (progn 1636 ((and beg (eq buf (overlay-buffer mouse-secondary-overlay)))
1673 (mouse-save-then-kill-delete-region 1637 (let* ((range (mouse-start-end click-pt click-pt click-count)))
1674 (overlay-start mouse-secondary-overlay) 1638 (if (< (abs (- click-pt beg))
1675 (overlay-end mouse-secondary-overlay)) 1639 (abs (- click-pt end)))
1676 (setq mouse-save-then-kill-posn nil) 1640 (move-overlay mouse-secondary-overlay (car range) end)
1677 (setq mouse-secondary-click-count 0) 1641 (move-overlay mouse-secondary-overlay beg (nth 1 range))))
1678 (delete-overlay mouse-secondary-overlay))) 1642 (setq deactivate-mark nil)
1679 (if (and (eq last-command 'mouse-secondary-save-then-kill) 1643 (if (eq last-command 'mouse-secondary-save-then-kill)
1680 mouse-save-then-kill-posn 1644 ;; If the front of the kill ring comes from an immediately
1681 (eq (car mouse-save-then-kill-posn) (car kill-ring)) 1645 ;; previous use of this command, replace the entry.
1682 (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn))) 1646 (kill-new
1683 ;; If this is the second time we've called 1647 (buffer-substring (overlay-start mouse-secondary-overlay)
1684 ;; mouse-secondary-save-then-kill, delete the text from the buffer. 1648 (overlay-end mouse-secondary-overlay))
1685 (progn 1649 t)
1686 (mouse-save-then-kill-delete-region 1650 (let (deactivate-mark)
1687 (overlay-start mouse-secondary-overlay) 1651 (copy-region-as-kill (overlay-start mouse-secondary-overlay)
1688 (overlay-end mouse-secondary-overlay)) 1652 (overlay-end mouse-secondary-overlay))))
1689 (setq mouse-save-then-kill-posn nil) 1653 (setq mouse-save-then-kill-posn click-pt))
1690 (delete-overlay mouse-secondary-overlay)) 1654
1691 (if (overlay-start mouse-secondary-overlay) 1655 ;; Otherwise, set the secondary selection overlay.
1692 ;; We have a selection, so adjust it. 1656 (t
1693 (progn 1657 (select-window window)
1694 (if (numberp click-posn) 1658 (if mouse-secondary-start
1695 (progn 1659 ;; All we have is one end of a selection, so put the other
1696 ;; Move whichever end of the region is closer to the click. 1660 ;; end here.
1697 ;; That is what xterm does, and it seems reasonable. 1661 (let ((start (+ 0 mouse-secondary-start)))
1698 (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay))) 1662 (kill-ring-save start click-pt)
1699 (abs (- click-posn (overlay-end mouse-secondary-overlay)))) 1663 (move-overlay mouse-secondary-overlay start click-pt)))
1700 (move-overlay mouse-secondary-overlay click-posn 1664 (setq mouse-save-then-kill-posn click-pt))))
1701 (overlay-end mouse-secondary-overlay)) 1665
1702 (move-overlay mouse-secondary-overlay 1666 ;; Finally, set the window system's secondary selection.
1703 (overlay-start mouse-secondary-overlay) 1667 (let (str)
1704 click-posn)) 1668 (and (overlay-buffer mouse-secondary-overlay)
1705 (setq deactivate-mark nil))) 1669 (setq str (buffer-substring (overlay-start mouse-secondary-overlay)
1706 (if (eq last-command 'mouse-secondary-save-then-kill) 1670 (overlay-end mouse-secondary-overlay)))
1707 ;; If the front of the kill ring comes from 1671 (> (length str) 0)
1708 ;; an immediately previous use of this command, 1672 (x-set-selection 'SECONDARY str))))
1709 ;; replace it with the extended region. 1673
1710 ;; (It would be annoying to make a separate entry.)
1711 (kill-new (buffer-substring
1712 (overlay-start mouse-secondary-overlay)
1713 (overlay-end mouse-secondary-overlay)) t)
1714 (let (deactivate-mark)
1715 (copy-region-as-kill (overlay-start mouse-secondary-overlay)
1716 (overlay-end mouse-secondary-overlay)))))
1717 (if mouse-secondary-start
1718 ;; All we have is one end of a selection,
1719 ;; so put the other end here.
1720 (let ((start (+ 0 mouse-secondary-start)))
1721 (kill-ring-save start click-posn)
1722 (move-overlay mouse-secondary-overlay start click-posn))))
1723 (setq mouse-save-then-kill-posn
1724 (list (car kill-ring) (point) click-posn))))
1725 (if (overlay-buffer mouse-secondary-overlay)
1726 (x-set-selection 'SECONDARY
1727 (buffer-substring
1728 (overlay-start mouse-secondary-overlay)
1729 (overlay-end mouse-secondary-overlay)))))))
1730 1674
1731(defcustom mouse-buffer-menu-maxlen 20 1675(defcustom mouse-buffer-menu-maxlen 20
1732 "Number of buffers in one pane (submenu) of the buffer menu. 1676 "Number of buffers in one pane (submenu) of the buffer menu.
@@ -1907,332 +1851,6 @@ and selects that window."
1907 ;; Few buffers--put them all in one pane. 1851 ;; Few buffers--put them all in one pane.
1908 (list (cons title alist)))) 1852 (list (cons title alist))))
1909 1853
1910;; These need to be rewritten for the new scroll bar implementation.
1911
1912;;!! ;; Commands for the scroll bar.
1913;;!!
1914;;!! (defun mouse-scroll-down (click)
1915;;!! (interactive "@e")
1916;;!! (scroll-down (1+ (cdr (mouse-coords click)))))
1917;;!!
1918;;!! (defun mouse-scroll-up (click)
1919;;!! (interactive "@e")
1920;;!! (scroll-up (1+ (cdr (mouse-coords click)))))
1921;;!!
1922;;!! (defun mouse-scroll-down-full ()
1923;;!! (interactive "@")
1924;;!! (scroll-down nil))
1925;;!!
1926;;!! (defun mouse-scroll-up-full ()
1927;;!! (interactive "@")
1928;;!! (scroll-up nil))
1929;;!!
1930;;!! (defun mouse-scroll-move-cursor (click)
1931;;!! (interactive "@e")
1932;;!! (move-to-window-line (1+ (cdr (mouse-coords click)))))
1933;;!!
1934;;!! (defun mouse-scroll-absolute (event)
1935;;!! (interactive "@e")
1936;;!! (let* ((pos (car event))
1937;;!! (position (car pos))
1938;;!! (length (car (cdr pos))))
1939;;!! (if (<= length 0) (setq length 1))
1940;;!! (let* ((scale-factor (max 1 (/ length (/ 8000000 (buffer-size)))))
1941;;!! (newpos (* (/ (* (/ (buffer-size) scale-factor)
1942;;!! position)
1943;;!! length)
1944;;!! scale-factor)))
1945;;!! (goto-char newpos)
1946;;!! (recenter '(4)))))
1947;;!!
1948;;!! (defun mouse-scroll-left (click)
1949;;!! (interactive "@e")
1950;;!! (scroll-left (1+ (car (mouse-coords click)))))
1951;;!!
1952;;!! (defun mouse-scroll-right (click)
1953;;!! (interactive "@e")
1954;;!! (scroll-right (1+ (car (mouse-coords click)))))
1955;;!!
1956;;!! (defun mouse-scroll-left-full ()
1957;;!! (interactive "@")
1958;;!! (scroll-left nil))
1959;;!!
1960;;!! (defun mouse-scroll-right-full ()
1961;;!! (interactive "@")
1962;;!! (scroll-right nil))
1963;;!!
1964;;!! (defun mouse-scroll-move-cursor-horizontally (click)
1965;;!! (interactive "@e")
1966;;!! (move-to-column (1+ (car (mouse-coords click)))))
1967;;!!
1968;;!! (defun mouse-scroll-absolute-horizontally (event)
1969;;!! (interactive "@e")
1970;;!! (let* ((pos (car event))
1971;;!! (position (car pos))
1972;;!! (length (car (cdr pos))))
1973;;!! (set-window-hscroll (selected-window) 33)))
1974;;!!
1975;;!! (global-set-key [scroll-bar mouse-1] 'mouse-scroll-up)
1976;;!! (global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute)
1977;;!! (global-set-key [scroll-bar mouse-3] 'mouse-scroll-down)
1978;;!!
1979;;!! (global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor)
1980;;!! (global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor)
1981;;!! (global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor)
1982;;!!
1983;;!! (global-set-key [thumbup mouse-1] 'mouse-scroll-up-full)
1984;;!! (global-set-key [thumbup mouse-2] 'mouse-scroll-up-full)
1985;;!! (global-set-key [thumbup mouse-3] 'mouse-scroll-up-full)
1986;;!!
1987;;!! (global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full)
1988;;!! (global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full)
1989;;!! (global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full)
1990;;!!
1991;;!! (global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left)
1992;;!! (global-set-key [horizontal-scroll-bar mouse-2]
1993;;!! 'mouse-scroll-absolute-horizontally)
1994;;!! (global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right)
1995;;!!
1996;;!! (global-set-key [horizontal-slider mouse-1]
1997;;!! 'mouse-scroll-move-cursor-horizontally)
1998;;!! (global-set-key [horizontal-slider mouse-2]
1999;;!! 'mouse-scroll-move-cursor-horizontally)
2000;;!! (global-set-key [horizontal-slider mouse-3]
2001;;!! 'mouse-scroll-move-cursor-horizontally)
2002;;!!
2003;;!! (global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full)
2004;;!! (global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full)
2005;;!! (global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full)
2006;;!!
2007;;!! (global-set-key [thumbright mouse-1] 'mouse-scroll-right-full)
2008;;!! (global-set-key [thumbright mouse-2] 'mouse-scroll-right-full)
2009;;!! (global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
2010;;!!
2011;;!! (global-set-key [horizontal-scroll-bar S-mouse-2]
2012;;!! 'mouse-split-window-horizontally)
2013;;!! (global-set-key [mode-line S-mouse-2]
2014;;!! 'mouse-split-window-horizontally)
2015;;!! (global-set-key [vertical-scroll-bar S-mouse-2]
2016;;!! 'mouse-split-window)
2017
2018;;!! ;;;;
2019;;!! ;;;; Here are experimental things being tested. Mouse events
2020;;!! ;;;; are of the form:
2021;;!! ;;;; ((x y) window screen-part key-sequence timestamp)
2022;;!! ;;
2023;;!! ;;;;
2024;;!! ;;;; Dynamically track mouse coordinates
2025;;!! ;;;;
2026;;!! ;;
2027;;!! ;;(defun track-mouse (event)
2028;;!! ;; "Track the coordinates, absolute and relative, of the mouse."
2029;;!! ;; (interactive "@e")
2030;;!! ;; (while mouse-grabbed
2031;;!! ;; (let* ((pos (read-mouse-position (selected-screen)))
2032;;!! ;; (abs-x (car pos))
2033;;!! ;; (abs-y (cdr pos))
2034;;!! ;; (relative-coordinate (coordinates-in-window-p
2035;;!! ;; (list (car pos) (cdr pos))
2036;;!! ;; (selected-window))))
2037;;!! ;; (if (consp relative-coordinate)
2038;;!! ;; (message "mouse: [%d %d], (%d %d)" abs-x abs-y
2039;;!! ;; (car relative-coordinate)
2040;;!! ;; (car (cdr relative-coordinate)))
2041;;!! ;; (message "mouse: [%d %d]" abs-x abs-y)))))
2042;;!!
2043;;!! ;;
2044;;!! ;; Dynamically put a box around the line indicated by point
2045;;!! ;;
2046;;!! ;;
2047;;!! ;;(require 'backquote)
2048;;!! ;;
2049;;!! ;;(defun mouse-select-buffer-line (event)
2050;;!! ;; (interactive "@e")
2051;;!! ;; (let ((relative-coordinate
2052;;!! ;; (coordinates-in-window-p (car event) (selected-window)))
2053;;!! ;; (abs-y (car (cdr (car event)))))
2054;;!! ;; (if (consp relative-coordinate)
2055;;!! ;; (progn
2056;;!! ;; (save-excursion
2057;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
2058;;!! ;; (x-draw-rectangle
2059;;!! ;; (selected-screen)
2060;;!! ;; abs-y 0
2061;;!! ;; (save-excursion
2062;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
2063;;!! ;; (end-of-line)
2064;;!! ;; (push-mark nil t)
2065;;!! ;; (beginning-of-line)
2066;;!! ;; (- (region-end) (region-beginning))) 1))
2067;;!! ;; (sit-for 1)
2068;;!! ;; (x-erase-rectangle (selected-screen))))))
2069;;!! ;;
2070;;!! ;;(defvar last-line-drawn nil)
2071;;!! ;;(defvar begin-delim "[^ \t]")
2072;;!! ;;(defvar end-delim "[^ \t]")
2073;;!! ;;
2074;;!! ;;(defun mouse-boxing (event)
2075;;!! ;; (interactive "@e")
2076;;!! ;; (save-excursion
2077;;!! ;; (let ((screen (selected-screen)))
2078;;!! ;; (while (= (x-mouse-events) 0)
2079;;!! ;; (let* ((pos (read-mouse-position screen))
2080;;!! ;; (abs-x (car pos))
2081;;!! ;; (abs-y (cdr pos))
2082;;!! ;; (relative-coordinate
2083;;!! ;; (coordinates-in-window-p `(,abs-x ,abs-y)
2084;;!! ;; (selected-window)))
2085;;!! ;; (begin-reg nil)
2086;;!! ;; (end-reg nil)
2087;;!! ;; (end-column nil)
2088;;!! ;; (begin-column nil))
2089;;!! ;; (if (and (consp relative-coordinate)
2090;;!! ;; (or (not last-line-drawn)
2091;;!! ;; (not (= last-line-drawn abs-y))))
2092;;!! ;; (progn
2093;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
2094;;!! ;; (if (= (following-char) 10)
2095;;!! ;; ()
2096;;!! ;; (progn
2097;;!! ;; (setq begin-reg (1- (re-search-forward end-delim)))
2098;;!! ;; (setq begin-column (1- (current-column)))
2099;;!! ;; (end-of-line)
2100;;!! ;; (setq end-reg (1+ (re-search-backward begin-delim)))
2101;;!! ;; (setq end-column (1+ (current-column)))
2102;;!! ;; (message "%s" (buffer-substring begin-reg end-reg))
2103;;!! ;; (x-draw-rectangle screen
2104;;!! ;; (setq last-line-drawn abs-y)
2105;;!! ;; begin-column
2106;;!! ;; (- end-column begin-column) 1))))))))))
2107;;!! ;;
2108;;!! ;;(defun mouse-erase-box ()
2109;;!! ;; (interactive)
2110;;!! ;; (if last-line-drawn
2111;;!! ;; (progn
2112;;!! ;; (x-erase-rectangle (selected-screen))
2113;;!! ;; (setq last-line-drawn nil))))
2114;;!!
2115;;!! ;;; (defun test-x-rectangle ()
2116;;!! ;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
2117;;!! ;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
2118;;!! ;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
2119;;!!
2120;;!! ;;
2121;;!! ;; Here is how to do double clicking in lisp. About to change.
2122;;!! ;;
2123;;!!
2124;;!! (defvar double-start nil)
2125;;!! (defconst double-click-interval 300
2126;;!! "Max ticks between clicks")
2127;;!!
2128;;!! (defun double-down (event)
2129;;!! (interactive "@e")
2130;;!! (if double-start
2131;;!! (let ((interval (- (nth 4 event) double-start)))
2132;;!! (if (< interval double-click-interval)
2133;;!! (progn
2134;;!! (backward-up-list 1)
2135;;!! ;; (message "Interval %d" interval)
2136;;!! (sleep-for 1)))
2137;;!! (setq double-start nil))
2138;;!! (setq double-start (nth 4 event))))
2139;;!!
2140;;!! (defun double-up (event)
2141;;!! (interactive "@e")
2142;;!! (and double-start
2143;;!! (> (- (nth 4 event ) double-start) double-click-interval)
2144;;!! (setq double-start nil)))
2145;;!!
2146;;!! ;;; (defun x-test-doubleclick ()
2147;;!! ;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
2148;;!! ;;; (define-key doubleclick-test-map mouse-button-left 'double-down)
2149;;!! ;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up))
2150;;!!
2151;;!! ;;
2152;;!! ;; This scrolls while button is depressed. Use preferable in scroll bar.
2153;;!! ;;
2154;;!!
2155;;!! (defvar scrolled-lines 0)
2156;;!! (defconst scroll-speed 1)
2157;;!!
2158;;!! (defun incr-scroll-down (event)
2159;;!! (interactive "@e")
2160;;!! (setq scrolled-lines 0)
2161;;!! (incremental-scroll scroll-speed))
2162;;!!
2163;;!! (defun incr-scroll-up (event)
2164;;!! (interactive "@e")
2165;;!! (setq scrolled-lines 0)
2166;;!! (incremental-scroll (- scroll-speed)))
2167;;!!
2168;;!! (defun incremental-scroll (n)
2169;;!! (while (= (x-mouse-events) 0)
2170;;!! (setq scrolled-lines (1+ (* scroll-speed scrolled-lines)))
2171;;!! (scroll-down n)
2172;;!! (sit-for 300 t)))
2173;;!!
2174;;!! (defun incr-scroll-stop (event)
2175;;!! (interactive "@e")
2176;;!! (message "Scrolled %d lines" scrolled-lines)
2177;;!! (setq scrolled-lines 0)
2178;;!! (sleep-for 1))
2179;;!!
2180;;!! ;;; (defun x-testing-scroll ()
2181;;!! ;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
2182;;!! ;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down)
2183;;!! ;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up)
2184;;!! ;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
2185;;!! ;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
2186;;!!
2187;;!! ;;
2188;;!! ;; Some playthings suitable for picture mode? They need work.
2189;;!! ;;
2190;;!!
2191;;!! (defun mouse-kill-rectangle (event)
2192;;!! "Kill the rectangle between point and the mouse cursor."
2193;;!! (interactive "@e")
2194;;!! (let ((point-save (point)))
2195;;!! (save-excursion
2196;;!! (mouse-set-point event)
2197;;!! (push-mark nil t)
2198;;!! (if (> point-save (point))
2199;;!! (kill-rectangle (point) point-save)
2200;;!! (kill-rectangle point-save (point))))))
2201;;!!
2202;;!! (defun mouse-open-rectangle (event)
2203;;!! "Kill the rectangle between point and the mouse cursor."
2204;;!! (interactive "@e")
2205;;!! (let ((point-save (point)))
2206;;!! (save-excursion
2207;;!! (mouse-set-point event)
2208;;!! (push-mark nil t)
2209;;!! (if (> point-save (point))
2210;;!! (open-rectangle (point) point-save)
2211;;!! (open-rectangle point-save (point))))))
2212;;!!
2213;;!! ;; Must be a better way to do this.
2214;;!!
2215;;!! (defun mouse-multiple-insert (n char)
2216;;!! (while (> n 0)
2217;;!! (insert char)
2218;;!! (setq n (1- n))))
2219;;!!
2220;;!! ;; What this could do is not finalize until button was released.
2221;;!!
2222;;!! (defun mouse-move-text (event)
2223;;!! "Move text from point to cursor position, inserting spaces."
2224;;!! (interactive "@e")
2225;;!! (let* ((relative-coordinate
2226;;!! (coordinates-in-window-p (car event) (selected-window))))
2227;;!! (if (consp relative-coordinate)
2228;;!! (cond ((> (current-column) (car relative-coordinate))
2229;;!! (delete-char
2230;;!! (- (car relative-coordinate) (current-column))))
2231;;!! ((< (current-column) (car relative-coordinate))
2232;;!! (mouse-multiple-insert
2233;;!! (- (car relative-coordinate) (current-column)) " "))
2234;;!! ((= (current-column) (car relative-coordinate)) (ding))))))
2235
2236(define-obsolete-function-alias 1854(define-obsolete-function-alias
2237 'mouse-choose-completion 'choose-completion "23.2") 1855 'mouse-choose-completion 'choose-completion "23.2")
2238 1856
@@ -2475,10 +2093,6 @@ choose a font."
2475 (mouse-menu-bar-map) 2093 (mouse-menu-bar-map)
2476 (mouse-menu-major-mode-map))))) 2094 (mouse-menu-major-mode-map)))))
2477 2095
2478
2479;; Replaced with dragging mouse-1
2480;; (global-set-key [S-mouse-1] 'mouse-set-mark)
2481
2482;; Binding mouse-1 to mouse-select-window when on mode-, header-, or 2096;; Binding mouse-1 to mouse-select-window when on mode-, header-, or
2483;; vertical-line prevents Emacs from signaling an error when the mouse 2097;; vertical-line prevents Emacs from signaling an error when the mouse
2484;; button is released after dragging these lines, on non-toolkit 2098;; button is released after dragging these lines, on non-toolkit