;;; mouse.el --- window system-independent mouse support.
-;;; Copyright (C) 1988, 1992, 1993 Free Software Foundation, Inc.
+;;; Copyright (C) 1993 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: hardware
;;; along with GNU Emacs; see the file COPYING. If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-\f
-;;; Utility functions.
+;;; 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.
-(defsubst mouse-movement-p (object)
- "Return non-nil if OBJECT is a mouse movement event."
- (and (consp object)
- (eq (car object) 'mouse-movement)))
-
-(defsubst event-start (event)
- "Return the starting position of EVENT.
-If EVENT is a mouse press or a mouse click, this returns the location
-of the event.
-If EVENT is a drag, this returns the drag's starting position.
-The return value is of the form
- (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
-The `posn-' functions access elements of such lists."
- (nth 1 event))
-
-(defsubst event-end (event)
- "Return the ending location of EVENT. EVENT should be a click or drag event.
-If EVENT is a click event, this function is the same as `event-start'.
-The return value is of the form
- (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
-The `posn-' functions access elements of such lists."
- (nth (1- (length event)) event))
-
-(defsubst posn-window (position)
- "Return the window in POSITION.
-POSITION should be a list of the form
- (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions."
- (nth 0 position))
-
-(defsubst posn-point (position)
- "Return the buffer location in POSITION.
-POSITION should be a list of the form
- (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions."
- (nth 1 position))
-
-(defsubst posn-col-row (position)
- "Return the row and column in POSITION.
-POSITION should be a list of the form
- (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions."
- (nth 2 position))
-
-(defsubst posn-timestamp (position)
- "Return the timestamp of POSITION.
-POSITION should be a list of the form
- (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
-nas returned by the `event-start' and `event-end' functions."
- (nth 3 position))
+;;; Code:
+
+;;; Utility functions.
;;; Indent track-mouse like progn.
(put 'track-mouse 'lisp-indent-function 0)
(interactive "@e")
(let ((start (event-start click)))
(select-window (posn-window start))
- (split-window-vertically (1+ (cdr (posn-col-row click))))))
+ (let ((new-height (1+ (cdr (posn-col-row (event-end click)))))
+ (first-line window-min-height)
+ (last-line (- (window-height) window-min-height)))
+ (if (< last-line first-line)
+ (error "window too short to split")
+ (split-window-vertically
+ (min (max new-height first-line) last-line))))))
(defun mouse-split-window-horizontally (click)
"Select Emacs window mouse is on, then split it horizontally in half.
The window is split at the column clicked on.
This command must be bound to a mouse click."
(interactive "@e")
- (split-window-horizontally (1+ (car (posn-col-row (event-end click))))))
+ (let ((start (event-start click)))
+ (select-window (posn-window start))
+ (let ((new-width (1+ (car (posn-col-row (event-end click)))))
+ (first-col window-min-width)
+ (last-col (- (window-width) window-min-width)))
+ (if (< last-col first-col)
+ (error "window too narrow to split")
+ (split-window-horizontally
+ (min (max new-width first-col) last-col))))))
(defun mouse-set-point (click)
"Move point to the position clicked on with the mouse.
(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.
(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)
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
(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)))))
(setq head (cons
(cons
(format
- "%14s %s"
+ "%-14s %s"
(buffer-name elt)
(or (buffer-file-name elt) ""))
elt)
(select-window window)
(switch-to-buffer buf))))))
\f
-;;; These need to be rewritten for the new scrollbar implementation.
+;;; These need to be rewritten for the new scroll bar implementation.
;;;!! ;; Commands for the scroll bar.
;;;!!
;;;!! ;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up))
;;;!!
;;;!! ;;
-;;;!! ;; This scrolls while button is depressed. Use preferable in scrollbar.
+;;;!! ;; This scrolls while button is depressed. Use preferable in scroll bar.
;;;!! ;;
;;;!!
;;;!! (defvar scrolled-lines 0)
;;; ("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.")
\f
;;; 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)
HCoop / bpt / emacs.git / blobdiff