Mercurial > emacs

comparison lisp/mouse.el @ 109904:bb6ea55bfdc0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Cleanups and fixes for mouse-save-then-kill and mouse-secondary-save-then-kill. * mouse.el (mouse-save-then-kill): Don't save region to kill ring when extending it. Before killing on the second click, check if the buffer is the correct one. Doc fix. (mouse-secondary-save-then-kill): Allow usage without first calling mouse-start-secondary, by defaulting to point. Don't save an empty secondary selection. Doc fix.
author Chong Yidong <cyd@stupidchicken.com>
date Sat, 21 Aug 2010 00:46:23 -0400
parents f4192807d8a6
children aa6b00b4471c
comparison
equal deleted inserted replaced
109903:3ea5c230ba38 109904:bb6ea55bfdc0
1295 1295
1296 ;; This function used to delete the text between point and the mouse 1296 ;; This function used to delete the text between point and the mouse
1297 ;; whenever it was equal to the front of the kill ring, but some 1297 ;; whenever it was equal to the front of the kill ring, but some
1298 ;; people found that confusing. 1298 ;; people found that confusing.
1299 1299
1300 ;; A list (TEXT START END), describing the text and position of the last 1300 ;; 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) 1301 (defvar mouse-save-then-kill-posn nil)
1303 1302
1304 (defun mouse-save-then-kill-delete-region (beg end) 1303 (defun mouse-save-then-kill-delete-region (beg end)
1305 ;; We must make our own undo boundaries 1304 ;; We must make our own undo boundaries
1306 ;; because they happen automatically only for the current buffer. 1305 ;; because they happen automatically only for the current buffer.
1334 (and tail 1333 (and tail
1335 (setcar tail (cons (car kill-ring) (min beg end)))))) 1334 (setcar tail (cons (car kill-ring) (min beg end))))))
1336 (undo-boundary)) 1335 (undo-boundary))
1337 1336
1338 (defun mouse-save-then-kill (click) 1337 (defun mouse-save-then-kill (click)
1339 "Set the region according to CLICK; the second time, kill the region. 1338 "Set the region according to CLICK; the second time, kill it.
1340 Assuming this command is bound to a mouse button, CLICK is the 1339 CLICK should be a mouse click event.
1341 corresponding input event. 1340
1342 1341 If the region is inactive, activate it temporarily. Set mark at
1343 If the region is already active, adjust it. Normally, this 1342 the original point, and move point to the position of CLICK.
1344 happens by moving either point or mark, whichever is closer, to 1343
1345 the position of CLICK. But if you have selected words or lines, 1344 If the region is already active, adjust it. Normally, do this by
1346 the region is adjusted by moving point or mark to the word or 1345 moving point or mark, whichever is closer, to CLICK. But if you
1347 line boundary closest to CLICK. 1346 have selected whole words or lines, move point or mark to the
1348 1347 word or line boundary closest to CLICK instead.
1349 If the region is inactive, activate it temporarily; set mark at 1348
1350 the original point, and move click to the position of CLICK. 1349 If this command is called a second consecutive time with the same
1351 1350 CLICK position, kill the region."
1352 However, if this command is being called a second time (i.e. the
1353 value of `last-command' is `mouse-save-then-kill'), kill the
1354 region instead. If the text in the region is the same as the
1355 text in the front of the kill ring, just delete it."
1356 (interactive "e") 1351 (interactive "e")
1357 (let ((before-scroll 1352 (mouse-minibuffer-check click)
1358 (with-current-buffer (window-buffer (posn-window (event-start click))) 1353 (let* ((posn (event-start click))
1359 point-before-scroll))) 1354 (click-pt (posn-point posn))
1360 (mouse-minibuffer-check click) 1355 (window (posn-window posn))
1361 (let ((click-posn (posn-point (event-start click))) 1356 (buf (window-buffer window))
1362 ;; Don't let a subsequent kill command append to this one: 1357 ;; Don't let a subsequent kill command append to this one.
1363 ;; prevent setting this-command to kill-region. 1358 (this-command this-command)
1364 (this-command this-command)) 1359 ;; Check if the user has multi-clicked to select words/lines.
1365 (if (and (with-current-buffer 1360 (click-count
1366 (window-buffer (posn-window (event-start click))) 1361 (if (and (eq mouse-selection-click-count-buffer buf)
1367 (and (mark t) 1362 (with-current-buffer buf (mark t)))
1368 (> (mod mouse-selection-click-count 3) 0) 1363 mouse-selection-click-count
1369 ;; Don't be fooled by a recent click in some other buffer. 1364 0)))
1370 (eq mouse-selection-click-count-buffer 1365 (cond
1371 (current-buffer))))) 1366 ((not (numberp click-pt)) nil)
1372 (if (and (eq last-command 'mouse-save-then-kill) 1367 ;; If the user clicked without moving point, kill the region.
1373 (equal click-posn (nth 2 mouse-save-then-kill-posn))) 1368 ;; This also resets `mouse-selection-click-count'.
1374 ;; If we click this button again without moving it, kill. 1369 ((and (eq last-command 'mouse-save-then-kill)
1375 (progn 1370 (eq click-pt mouse-save-then-kill-posn)
1376 ;; Call `deactivate-mark' to save the primary selection. 1371 (eq window (selected-window)))
1377 (deactivate-mark) 1372 (kill-region (mark t) (point))
1378 (mouse-save-then-kill-delete-region (mark) (point)) 1373 (setq mouse-selection-click-count 0)
1379 (setq mouse-selection-click-count 0) 1374 (setq mouse-save-then-kill-posn nil))
1380 (setq mouse-save-then-kill-posn nil)) 1375
1381 ;; Find both ends of the object selected by this click. 1376 ;; Otherwise, if there is a suitable region, adjust it by moving
1382 (let* ((range 1377 ;; one end (whichever is closer) to CLICK-PT.
1383 (mouse-start-end click-posn click-posn 1378 ((or (with-current-buffer buf (region-active-p))
1384 mouse-selection-click-count))) 1379 (and (eq window (selected-window))
1385 ;; Move whichever end is closer to the click. 1380 (mark t)
1386 ;; That's what xterm does, and it seems reasonable. 1381 (or (and (eq last-command 'mouse-save-then-kill)
1387 (if (< (abs (- click-posn (mark t))) 1382 mouse-save-then-kill-posn)
1388 (abs (- click-posn (point)))) 1383 (and (memq last-command '(mouse-drag-region
1389 (set-mark (car range)) 1384 mouse-set-region))
1390 (goto-char (nth 1 range))) 1385 (or mark-even-if-inactive
1391 ;; We have already put the old region in the kill ring. 1386 (not transient-mark-mode))))))
1392 ;; Replace it with the extended region. 1387 (select-window window)
1393 ;; (It would be annoying to make a separate entry.) 1388 (let* ((range (mouse-start-end click-pt click-pt click-count)))
1394 (kill-new (buffer-substring (point) (mark t)) t) 1389 (if (< (abs (- click-pt (mark t)))
1395 (mouse-set-region-1) 1390 (abs (- click-pt (point))))
1396 ;; Arrange for a repeated mouse-3 to kill this region. 1391 (set-mark (car range))
1397 (setq mouse-save-then-kill-posn 1392 (goto-char (nth 1 range)))
1398 (list (car kill-ring) (point) click-posn)))) 1393 (setq deactivate-mark nil)
1399 1394 (mouse-set-region-1)
1400 (if (and (eq last-command 'mouse-save-then-kill) 1395 ;; Arrange for a repeated mouse-3 to kill the region.
1401 mouse-save-then-kill-posn 1396 (setq mouse-save-then-kill-posn click-pt)))
1402 (eq (car mouse-save-then-kill-posn) (car kill-ring)) 1397
1403 (equal (cdr mouse-save-then-kill-posn) 1398 ;; Otherwise, set the mark where point is and move to CLICK-PT.
1404 (list (point) click-posn))) 1399 (t
1405 ;; If this is the second time we've called 1400 (select-window window)
1406 ;; mouse-save-then-kill, delete the text from the buffer. 1401 (mouse-set-mark-fast click)
1407 (progn 1402 (let ((before-scroll (with-current-buffer buf point-before-scroll)))
1408 ;; Call `deactivate-mark' to save the primary selection. 1403 (if before-scroll (goto-char before-scroll)))
1409 (deactivate-mark) 1404 (exchange-point-and-mark)
1410 (mouse-save-then-kill-delete-region (point) (mark t)) 1405 (mouse-set-region-1)
1411 ;; After we kill, another click counts as "the first time". 1406 (setq mouse-save-then-kill-posn click-pt)))))
1412 (setq mouse-save-then-kill-posn nil)) 1407
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 1408
1445 (global-set-key [M-mouse-1] 'mouse-start-secondary) 1409 (global-set-key [M-mouse-1] 'mouse-start-secondary)
1446 (global-set-key [M-drag-mouse-1] 'mouse-set-secondary) 1410 (global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
1447 (global-set-key [M-down-mouse-1] 'mouse-drag-secondary) 1411 (global-set-key [M-down-mouse-1] 'mouse-drag-secondary)
1448 (global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill) 1412 (global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill)
1518 (if (> (mod click-count 3) 0) 1482 (if (> (mod click-count 3) 0)
1519 ;; Double or triple press: make an initial selection 1483 ;; Double or triple press: make an initial selection
1520 ;; of one word or line. 1484 ;; of one word or line.
1521 (let ((range (mouse-start-end start-point start-point click-count))) 1485 (let ((range (mouse-start-end start-point start-point click-count)))
1522 (set-marker mouse-secondary-start nil) 1486 (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) 1487 (move-overlay mouse-secondary-overlay (car range) (nth 1 range)
1527 (window-buffer start-window))) 1488 (window-buffer start-window)))
1528 ;; Single-press: cancel any preexisting secondary selection. 1489 ;; Single-press: cancel any preexisting secondary selection.
1529 (or mouse-secondary-start 1490 (or mouse-secondary-start
1530 (setq mouse-secondary-start (make-marker))) 1491 (setq mouse-secondary-start (make-marker)))
1614 (kill-region (overlay-start mouse-secondary-overlay) 1575 (kill-region (overlay-start mouse-secondary-overlay)
1615 (overlay-end mouse-secondary-overlay)))) 1576 (overlay-end mouse-secondary-overlay))))
1616 (delete-overlay mouse-secondary-overlay)) 1577 (delete-overlay mouse-secondary-overlay))
1617 1578
1618 (defun mouse-secondary-save-then-kill (click) 1579 (defun mouse-secondary-save-then-kill (click)
1619 "Save text to point in kill ring; the second time, kill the text. 1580 "Set the secondary selection and save it to the kill ring.
1620 You must use this in a buffer where you have recently done \\[mouse-start-secondary]. 1581 The second time, kill it. CLICK should be a mouse click event.
1621 If the text between where you did \\[mouse-start-secondary] and where 1582
1622 you use this command matches the text at the front of the kill ring, 1583 If you have not called `mouse-start-secondary' in the clicked
1623 this command deletes the text. 1584 buffer, activate the secondary selection and set it between point
1624 Otherwise, it adds the text to the kill ring, like \\[kill-ring-save], 1585 and the click position CLICK.
1625 which prepares for a second click with this command to delete the text. 1586
1626 1587 Otherwise, adjust the bounds of the secondary selection.
1627 If you have already made a secondary selection in that buffer, 1588 Normally, do this by moving its beginning or end, whichever is
1628 this command extends or retracts the selection to where you click. 1589 closer, to CLICK. But if you have selected whole words or lines,
1629 If you do this again in a different position, it extends or retracts 1590 adjust to the word or line boundary closest to CLICK instead.
1630 again. If you do this twice in the same position, it kills the selection." 1591
1592 If this command is called a second consecutive time with the same
1593 CLICK position, kill the secondary selection."
1631 (interactive "e") 1594 (interactive "e")
1632 (mouse-minibuffer-check click) 1595 (mouse-minibuffer-check click)
1633 (let ((posn (event-start click)) 1596 (let* ((posn (event-start click))
1634 (click-posn (posn-point (event-start click))) 1597 (click-pt (posn-point posn))
1635 ;; Don't let a subsequent kill command append to this one: 1598 (window (posn-window posn))
1636 ;; prevent setting this-command to kill-region. 1599 (buf (window-buffer window))
1637 (this-command this-command)) 1600 ;; Don't let a subsequent kill command append to this one.
1638 (or (eq (window-buffer (posn-window posn)) 1601 (this-command this-command)
1639 (or (overlay-buffer mouse-secondary-overlay) 1602 ;; Check if the user has multi-clicked to select words/lines.
1640 (if mouse-secondary-start 1603 (click-count
1641 (marker-buffer mouse-secondary-start)))) 1604 (if (eq (overlay-buffer mouse-secondary-overlay) buf)
1642 (error "Wrong buffer")) 1605 mouse-secondary-click-count
1643 (with-current-buffer (window-buffer (posn-window posn)) 1606 0))
1644 (if (> (mod mouse-secondary-click-count 3) 0) 1607 (beg (overlay-start mouse-secondary-overlay))
1645 (if (not (and (eq last-command 'mouse-secondary-save-then-kill) 1608 (end (overlay-end mouse-secondary-overlay)))
1646 (equal click-posn 1609
1647 (car (cdr-safe (cdr-safe mouse-save-then-kill-posn)))))) 1610 (cond
1648 ;; Find both ends of the object selected by this click. 1611 ((not (numberp click-pt)) nil)
1649 (let* ((range 1612
1650 (mouse-start-end click-posn click-posn 1613 ;; If the secondary selection is not active in BUF, activate it.
1651 mouse-secondary-click-count))) 1614 ((not (eq buf (or (overlay-buffer mouse-secondary-overlay)
1652 ;; Move whichever end is closer to the click. 1615 (if mouse-secondary-start
1653 ;; That's what xterm does, and it seems reasonable. 1616 (marker-buffer mouse-secondary-start)))))
1654 (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay))) 1617 (select-window window)
1655 (abs (- click-posn (overlay-end mouse-secondary-overlay)))) 1618 (setq mouse-secondary-start (make-marker))
1656 (move-overlay mouse-secondary-overlay (car range) 1619 (move-marker mouse-secondary-start (point))
1657 (overlay-end mouse-secondary-overlay)) 1620 (move-overlay mouse-secondary-overlay (point) click-pt buf)
1658 (move-overlay mouse-secondary-overlay 1621 (kill-ring-save (point) click-pt))
1659 (overlay-start mouse-secondary-overlay) 1622
1660 (nth 1 range))) 1623 ;; If the user clicked without moving point, delete the secondary
1661 ;; We have already put the old region in the kill ring. 1624 ;; selection. This also resets `mouse-secondary-click-count'.
1662 ;; Replace it with the extended region. 1625 ((and (eq last-command 'mouse-secondary-save-then-kill)
1663 ;; (It would be annoying to make a separate entry.) 1626 (eq click-pt mouse-save-then-kill-posn)
1664 (kill-new (buffer-substring 1627 (eq window (selected-window)))
1665 (overlay-start mouse-secondary-overlay) 1628 (mouse-save-then-kill-delete-region beg end)
1666 (overlay-end mouse-secondary-overlay)) t) 1629 (delete-overlay mouse-secondary-overlay)
1667 ;; Arrange for a repeated mouse-3 to kill this region. 1630 (setq mouse-secondary-click-count 0)
1668 (setq mouse-save-then-kill-posn 1631 (setq mouse-save-then-kill-posn nil))
1669 (list (car kill-ring) (point) click-posn))) 1632
1670 ;; If we click this button again without moving it, 1633 ;; Otherwise, if there is a suitable secondary selection overlay,
1671 ;; that time kill. 1634 ;; adjust it by moving one end (whichever is closer) to CLICK-PT.
1672 (progn 1635 ((and beg (eq buf (overlay-buffer mouse-secondary-overlay)))
1673 (mouse-save-then-kill-delete-region 1636 (let* ((range (mouse-start-end click-pt click-pt click-count)))
1674 (overlay-start mouse-secondary-overlay) 1637 (if (< (abs (- click-pt beg))
1675 (overlay-end mouse-secondary-overlay)) 1638 (abs (- click-pt end)))
1676 (setq mouse-save-then-kill-posn nil) 1639 (move-overlay mouse-secondary-overlay (car range) end)
1677 (setq mouse-secondary-click-count 0) 1640 (move-overlay mouse-secondary-overlay beg (nth 1 range))))
1678 (delete-overlay mouse-secondary-overlay))) 1641 (setq deactivate-mark nil)
1679 (if (and (eq last-command 'mouse-secondary-save-then-kill) 1642 (if (eq last-command 'mouse-secondary-save-then-kill)
1680 mouse-save-then-kill-posn 1643 ;; If the front of the kill ring comes from an immediately
1681 (eq (car mouse-save-then-kill-posn) (car kill-ring)) 1644 ;; previous use of this command, replace the entry.
1682 (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn))) 1645 (kill-new
1683 ;; If this is the second time we've called 1646 (buffer-substring (overlay-start mouse-secondary-overlay)
1684 ;; mouse-secondary-save-then-kill, delete the text from the buffer. 1647 (overlay-end mouse-secondary-overlay))
1685 (progn 1648 t)
1686 (mouse-save-then-kill-delete-region 1649 (let (deactivate-mark)
1687 (overlay-start mouse-secondary-overlay) 1650 (copy-region-as-kill (overlay-start mouse-secondary-overlay)
1688 (overlay-end mouse-secondary-overlay)) 1651 (overlay-end mouse-secondary-overlay))))
1689 (setq mouse-save-then-kill-posn nil) 1652 (setq mouse-save-then-kill-posn click-pt))
1690 (delete-overlay mouse-secondary-overlay)) 1653
1691 (if (overlay-start mouse-secondary-overlay) 1654 ;; Otherwise, set the secondary selection overlay.
1692 ;; We have a selection, so adjust it. 1655 (t
1693 (progn 1656 (select-window window)
1694 (if (numberp click-posn) 1657 (if mouse-secondary-start
1695 (progn 1658 ;; 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. 1659 ;; end here.
1697 ;; That is what xterm does, and it seems reasonable. 1660 (let ((start (+ 0 mouse-secondary-start)))
1698 (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay))) 1661 (kill-ring-save start click-pt)
1699 (abs (- click-posn (overlay-end mouse-secondary-overlay)))) 1662 (move-overlay mouse-secondary-overlay start click-pt)))
1700 (move-overlay mouse-secondary-overlay click-posn 1663 (setq mouse-save-then-kill-posn click-pt))))
1701 (overlay-end mouse-secondary-overlay)) 1664
1702 (move-overlay mouse-secondary-overlay 1665 ;; Finally, set the window system's secondary selection.
1703 (overlay-start mouse-secondary-overlay) 1666 (let (str)
1704 click-posn)) 1667 (and (overlay-buffer mouse-secondary-overlay)
1705 (setq deactivate-mark nil))) 1668 (setq str (buffer-substring (overlay-start mouse-secondary-overlay)
1706 (if (eq last-command 'mouse-secondary-save-then-kill) 1669 (overlay-end mouse-secondary-overlay)))
1707 ;; If the front of the kill ring comes from 1670 (> (length str) 0)
1708 ;; an immediately previous use of this command, 1671 (x-set-selection 'SECONDARY str))))
1709 ;; replace it with the extended region. 1672
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 1673
1731 (defcustom mouse-buffer-menu-maxlen 20 1674 (defcustom mouse-buffer-menu-maxlen 20
1732 "Number of buffers in one pane (submenu) of the buffer menu. 1675 "Number of buffers in one pane (submenu) of the buffer menu.
1733 If we have lots of buffers, divide them into groups of 1676 If we have lots of buffers, divide them into groups of
1734 `mouse-buffer-menu-maxlen' and make a pane (or submenu) for each one." 1677 `mouse-buffer-menu-maxlen' and make a pane (or submenu) for each one."
1905 (setq alist next)) 1848 (setq alist next))
1906 (nreverse sublists)) 1849 (nreverse sublists))
1907 ;; Few buffers--put them all in one pane. 1850 ;; Few buffers--put them all in one pane.
1908 (list (cons title alist)))) 1851 (list (cons title alist))))
1909 1852
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 1853 (define-obsolete-function-alias
2237 'mouse-choose-completion 'choose-completion "23.2") 1854 'mouse-choose-completion 'choose-completion "23.2")
2238 1855
2239 ;; Font selection. 1856 ;; Font selection.
2240 1857
2473 :filter (lambda (_) 2090 :filter (lambda (_)
2474 (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0)) 2091 (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))
2475 (mouse-menu-bar-map) 2092 (mouse-menu-bar-map)
2476 (mouse-menu-major-mode-map))))) 2093 (mouse-menu-major-mode-map)))))
2477 2094
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 2095 ;; Binding mouse-1 to mouse-select-window when on mode-, header-, or
2483 ;; vertical-line prevents Emacs from signaling an error when the mouse 2096 ;; vertical-line prevents Emacs from signaling an error when the mouse
2484 ;; button is released after dragging these lines, on non-toolkit 2097 ;; button is released after dragging these lines, on non-toolkit
2485 ;; versions. 2098 ;; versions.
2486 (global-set-key [mode-line mouse-1] 'mouse-select-window) 2099 (global-set-key [mode-line mouse-1] 'mouse-select-window)