X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/aae56ea7ca8c74e7bb5595b828851aaa9f947792..cccd719e434f078dfc64891f6579564d84c24334:/lisp/mouse.el diff --git a/lisp/mouse.el b/lisp/mouse.el index aca35b3099..38a9a5a6d6 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -21,6 +21,14 @@ ;;; along with GNU Emacs; see the file COPYING. If not, write to ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; Commentary: + +;; This package provides various useful commands (including help +;; system access) through the mouse. All this code assumes that mouse +;; interpretation has been abstracted into Emacs input events. +;; +;; The code is rather X-dependent. + ;;; Code: ;;; Utility functions. @@ -91,18 +99,66 @@ This must be bound to a mouse click." (defun mouse-set-region (click) "Set the region to the text that the mouse is dragged over. -This must be bound to a mouse click." +This must be bound to a mouse drag event." (interactive "e") (let ((posn (event-start click)) (end (event-end click))) (select-window (posn-window posn)) (if (numberp (posn-point posn)) (goto-char (posn-point posn))) - (sit-for 1) + ;; If mark is highlighted, no need to bounce the cursor. + (or (and transient-mark-mode + (eq (framep (selected-frame)) 'x)) + (sit-for 1)) (push-mark) + (set-mark (point)) (if (numberp (posn-point end)) (goto-char (posn-point end))))) +(defun mouse-drag-region (click) + "Set the region to the text that the mouse is dragged over. +This must be bound to a button-down mouse event." + (interactive "e") + (let ((posn (event-start click)) + done event (mark-active nil)) + (select-window (posn-window posn)) + ;; Set point temporarily, so user sees where it is. + (if (numberp (posn-point posn)) + (goto-char (posn-point posn))) + ;; Turn off the old mark when we set up an empty region. + (setq deactivate-mark t))) + +;;;Nice hack, but too slow. +;;;(defun mouse-drag-region-1 (click) +;;; "Set the region to the text that the mouse is dragged over. +;;;This must be bound to a button-down mouse event." +;;; (interactive "e") +;;; (let (newmark) +;;; (let ((posn (event-start click)) +;;; done event omark (mark-active t)) +;;; (select-window (posn-window posn)) +;;; (setq omark (and mark-active (mark))) +;;; (if (numberp (posn-point posn)) +;;; (goto-char (posn-point posn))) +;;; ;; Set mark temporarily, so highlighting does what we want. +;;; (set-marker (mark-marker) (point)) +;;; (track-mouse +;;; (while (not done) +;;; (setq event (read-event)) +;;; (if (eq (car-safe event) 'mouse-movement) +;;; (goto-char (posn-point (event-start event))) +;;; ;; Exit when we get the drag event; ignore that event. +;;; (setq done t)))) +;;; (if (/= (mark) (point)) +;;; (setq newmark (mark))) +;;; ;; Restore previous mark status. +;;; (if omark (set-marker (mark-marker) omark))) +;;; ;; Now, if we dragged, set the mark at the proper place. +;;; (if newmark +;;; (push-mark newmark t) +;;; ;; Turn off the old mark when we set up an empty region. +;;; (setq deactivate-mark t)))) + (defun mouse-set-mark (click) "Set mark at the position clicked on with the mouse. Display cursor at that position for a second. @@ -111,8 +167,9 @@ This must be bound to a mouse click." (let ((point-save (point))) (unwind-protect (progn (mouse-set-point click) - (push-mark nil t) - (sit-for 1)) + (push-mark nil t t) + (or transient-mark-mode + (sit-for 1))) (goto-char point-save)))) (defun mouse-kill (click) @@ -136,7 +193,7 @@ Prefix arguments are interpreted as with \\[yank]." This does not delete the region; it acts like \\[kill-ring-save]." (interactive "e") (mouse-set-mark click) - (call-interactively 'kill-ring-save)) + (kill-ring-save (point) (mark t))) ;;; This function used to delete the text between point and the mouse ;;; whenever it was equal to the front of the kill ring, but some @@ -169,7 +226,7 @@ which prepares for a second click to delete the text." (cons (cons (car kill-ring) (point)) buffer-undo-list)))) ;; Otherwise, save this region. (mouse-set-mark click) - (call-interactively 'kill-ring-save) + (kill-ring-save (point) (mark t)) (setq mouse-save-then-kill-posn (list (car kill-ring) (point) click-posn))))) @@ -190,7 +247,7 @@ and selects that window." (setq head (cons (cons (format - "%14s %s" + "%-14s %s" (buffer-name elt) (or (buffer-file-name elt) "")) elt) @@ -558,30 +615,30 @@ and selects that window." ;;; ("lucidatypewriter-bold-r-24" "-b&h-lucidatypewriter-bold-r-normal-sans-24-240-75-75-m-140-iso8859-1") ;;; ("fixed-medium-20" "-misc-fixed-medium-*-*-*-20-*-*-*-*-*-*-*") ("Courier" - ("8" "-adobe-courier-medium-r-normal--8-*-*-*-m-*-iso8859-1") - ("10" "-adobe-courier-medium-r-normal--10-*-*-*-m-*-iso8859-1") - ("12" "-adobe-courier-medium-r-normal--12-*-*-*-m-*-iso8859-1") - ("14" "-adobe-courier-medium-r-normal--14-*-*-*-m-*-iso8859-1") - ("18" "-adobe-courier-medium-r-normal--18-*-*-*-m-*-iso8859-1") - ("24" "-adobe-courier-medium-r-normal--24-*-*-*-m-*-iso8859-1") - ("8 bold" "-adobe-courier-bold-r-normal--8-*-*-*-m-*-iso8859-1") - ("10 bold" "-adobe-courier-bold-r-normal--10-*-*-*-m-*-iso8859-1") - ("12 bold" "-adobe-courier-bold-r-normal--12-*-*-*-m-*-iso8859-1") - ("14 bold" "-adobe-courier-bold-r-normal--14-*-*-*-m-*-iso8859-1") - ("18 bold" "-adobe-courier-bold-r-normal--18-*-*-*-m-*-iso8859-1") - ("24 bold" "-adobe-courier-bold-r-normal--24-*-*-*-m-*-iso8859-1") - ("8 slant" "-adobe-courier-medium-o-normal--8-*-*-*-m-*-iso8859-1") - ("10 slant" "-adobe-courier-medium-o-normal--10-*-*-*-m-*-iso8859-1") - ("12 slant" "-adobe-courier-medium-o-normal--12-*-*-*-m-*-iso8859-1") - ("14 slant" "-adobe-courier-medium-o-normal--14-*-*-*-m-*-iso8859-1") - ("18 slant" "-adobe-courier-medium-o-normal--18-*-*-*-m-*-iso8859-1") - ("24 slant" "-adobe-courier-medium-o-normal--24-*-*-*-m-*-iso8859-1") - ("8 bold slant" "-adobe-courier-bold-o-normal--8-*-*-*-m-*-iso8859-1") - ("10 bold slant" "-adobe-courier-bold-o-normal--10-*-*-*-m-*-iso8859-1") - ("12 bold slant" "-adobe-courier-bold-o-normal--12-*-*-*-m-*-iso8859-1") - ("14 bold slant" "-adobe-courier-bold-o-normal--14-*-*-*-m-*-iso8859-1") - ("18 bold slant" "-adobe-courier-bold-o-normal--18-*-*-*-m-*-iso8859-1") - ("24 bold slant" "-adobe-courier-bold-o-normal--24-*-*-*-m-*-iso8859-1")) + ("8" "-adobe-courier-medium-r-normal--*-80-*-*-m-*-iso8859-1") + ("10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-iso8859-1") + ("12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-iso8859-1") + ("14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-iso8859-1") + ("18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-iso8859-1") + ("24" "-adobe-courier-medium-r-normal--*-240-*-*-m-*-iso8859-1") + ("8 bold" "-adobe-courier-bold-r-normal--*-80-*-*-m-*-iso8859-1") + ("10 bold" "-adobe-courier-bold-r-normal--*-100-*-*-m-*-iso8859-1") + ("12 bold" "-adobe-courier-bold-r-normal--*-120-*-*-m-*-iso8859-1") + ("14 bold" "-adobe-courier-bold-r-normal--*-140-*-*-m-*-iso8859-1") + ("18 bold" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-iso8859-1") + ("24 bold" "-adobe-courier-bold-r-normal--*-240-*-*-m-*-iso8859-1") + ("8 slant" "-adobe-courier-medium-o-normal--*-80-*-*-m-*-iso8859-1") + ("10 slant" "-adobe-courier-medium-o-normal--*-100-*-*-m-*-iso8859-1") + ("12 slant" "-adobe-courier-medium-o-normal--*-120-*-*-m-*-iso8859-1") + ("14 slant" "-adobe-courier-medium-o-normal--*-140-*-*-m-*-iso8859-1") + ("18 slant" "-adobe-courier-medium-o-normal--*-180-*-*-m-*-iso8859-1") + ("24 slant" "-adobe-courier-medium-o-normal--*-240-*-*-m-*-iso8859-1") + ("8 bold slant" "-adobe-courier-bold-o-normal--*-80-*-*-m-*-iso8859-1") + ("10 bold slant" "-adobe-courier-bold-o-normal--*-100-*-*-m-*-iso8859-1") + ("12 bold slant" "-adobe-courier-bold-o-normal--*-120-*-*-m-*-iso8859-1") + ("14 bold slant" "-adobe-courier-bold-o-normal--*-140-*-*-m-*-iso8859-1") + ("18 bold slant" "-adobe-courier-bold-o-normal--*-180-*-*-m-*-iso8859-1") + ("24 bold slant" "-adobe-courier-bold-o-normal--*-240-*-*-m-*-iso8859-1")) ) "X fonts suitable for use in Emacs.") @@ -595,11 +652,10 @@ and selects that window." ;;; Bindings for mouse commands. -;; This won't be needed once the drag and down events -;; are properly implemented. +(define-key global-map [down-mouse-1] 'mouse-drag-region) (global-set-key [mouse-1] 'mouse-set-point) - (global-set-key [drag-mouse-1] 'mouse-set-region) + (global-set-key [mouse-2] 'mouse-yank-at-click) (global-set-key [mouse-3] 'mouse-save-then-kill)