;;; mouse.el --- window system-independent mouse support.
-;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+;;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: hardware
(define-key newmap (vector (car event))
(nconc (make-sparse-keymap "Menu")
(mouse-major-mode-menu-1
- (lookup-key (current-local-map) [menu-bar]))))
+ (and (current-local-map)
+ (lookup-key (current-local-map) [menu-bar])))))
(mouse-major-mode-menu-compute-equiv-keys newmap)
- (command-execute
- ;; Make NEWMAP override the usual definition
- ;; of the mouse button that got us here.
- ;; Then read the user's menu choice.
- (let ((minor-mode-map-alist
- (cons (cons t newmap) minor-mode-map-alist)))
- (lookup-key newmap (read-key-sequence ""))))))
+ ;; Make NEWMAP override the usual definition
+ ;; of the mouse button that got us here.
+ ;; Then read the user's menu choice.
+ (let* ((minor-mode-map-alist
+ (cons (cons t newmap) minor-mode-map-alist))
+ ;; read-key-sequence quits if the user aborts the menu.
+ ;; If that happens, do nothing silently.
+ (keyseq (condition-case nil
+ (read-key-sequence "")
+ (quit nil)))
+ (command (if keyseq (lookup-key newmap keyseq))))
+ (if command
+ (command-execute command)))))
;; Compute and cache the equivalent keys in MENU and all its submenus.
(defun mouse-major-mode-menu-compute-equiv-keys (menu)
(if (numberp (posn-point posn))
(goto-char (posn-point posn)))))
+(defvar mouse-last-region-beg nil)
+(defvar mouse-last-region-end nil)
+(defvar mouse-last-region-tick nil)
+
+(defun mouse-region-match ()
+ "Return non-nil if there's an active region that was set with the mouse."
+ (and (mark t) mark-active
+ (eq mouse-last-region-beg (region-beginning))
+ (eq mouse-last-region-end (region-end))
+ (eq mouse-last-region-tick (buffer-modified-tick))))
+
(defun mouse-set-region (click)
"Set the region to the text dragged over, and copy to kill ring.
This should be bound to a mouse drag event."
(if (numberp (posn-point posn))
(goto-char (posn-point posn)))
;; If mark is highlighted, no need to bounce the cursor.
- (or (and transient-mark-mode
- (framep (selected-frame)))
+ ;; On X, we highlight while dragging, thus once again no need to bounce.
+ (or transient-mark-mode
+ (eq (framep (selected-frame)) 'x)
(sit-for 1))
(push-mark)
(set-mark (point))
(goto-char (posn-point end)))
;; Don't set this-command to kill-region, so that a following
;; C-w will not double the text in the kill ring.
- (let (this-command)
- (copy-region-as-kill (mark) (point)))))
+ ;; Ignore last-command so we don't append to a preceding kill.
+ (let (this-command last-command)
+ (copy-region-as-kill (mark) (point)))
+ (mouse-set-region-1)))
+
+(defun mouse-set-region-1 ()
+ (setq mouse-last-region-beg (region-beginning))
+ (setq mouse-last-region-end (region-end))
+ (setq mouse-last-region-tick (buffer-modified-tick)))
(defvar mouse-scroll-delay 0.25
"*The pause between scroll steps caused by mouse drags, in seconds.
(or (eq window (selected-window))
(goto-char opoint))))
+;; Create an overlay and immediately delete it, to get "overlay in no buffer".
(defvar mouse-drag-overlay (make-overlay 1 1))
+(delete-overlay mouse-drag-overlay)
(overlay-put mouse-drag-overlay 'face 'region)
(defvar mouse-selection-click-count 0)
+(defvar mouse-selection-click-count-buffer nil)
+
(defun mouse-drag-region (start-event)
"Set the region to the text that the mouse is dragged over.
Highlight the drag area as you move the mouse.
(1- (nth 3 bounds))))
(click-count (1- (event-click-count start-event))))
(setq mouse-selection-click-count click-count)
+ (setq mouse-selection-click-count-buffer (current-buffer))
(mouse-set-point start-event)
(let ((range (mouse-start-end start-point start-point click-count)))
(move-overlay mouse-drag-overlay (car range) (nth 1 range)
(mouse-scroll-subr start-window (1+ (- mouse-row bottom))
mouse-drag-overlay start-point)))))))))
(if (consp event)
-;;; When we scroll into the mode line or menu bar, or out of the window,
-;;; we get events that don't fit these criteria.
-;;; (eq (get (event-basic-type event) 'event-kind) 'mouse-click)
-;;; (eq (posn-window (event-end event)) start-window)
-;;; (numberp (posn-point (event-end event)))
(let ((fun (key-binding (vector (car event)))))
- (if (not (= (overlay-start mouse-drag-overlay)
- (overlay-end mouse-drag-overlay)))
- (let (last-command this-command)
- (push-mark (overlay-start mouse-drag-overlay) t t)
- (goto-char (overlay-end mouse-drag-overlay))
- (copy-region-as-kill (point) (mark t)))
- (goto-char (overlay-end mouse-drag-overlay))
- (setq this-command 'mouse-set-point))))
- (delete-overlay mouse-drag-overlay))))
+ ;; Run the binding of the terminating up-event, if possible.
+ ;; In the case of a multiple click, it gives the wrong results,
+ ;; because it would fail to set up a region.
+ (if (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
+ ;; In this case, we can just let the up-event execute normally.
+ (progn
+ ;; Delete the overlay before calling the function,
+ ;; because delete-overlay increases buffer-modified-tick.
+ (delete-overlay mouse-drag-overlay)
+ (setq unread-command-events
+ (cons event unread-command-events)))
+ (if (not (= (overlay-start mouse-drag-overlay)
+ (overlay-end mouse-drag-overlay)))
+ (let (last-command this-command)
+ (push-mark (overlay-start mouse-drag-overlay) t t)
+ (goto-char (overlay-end mouse-drag-overlay))
+ (delete-overlay mouse-drag-overlay)
+ (copy-region-as-kill (point) (mark t))
+ (mouse-set-region-1))
+ (goto-char (overlay-end mouse-drag-overlay))
+ (setq this-command 'mouse-set-point)
+ (delete-overlay mouse-drag-overlay))))
+ (delete-overlay mouse-drag-overlay)))))
\f
;; Commands to handle xterm-style multiple clicks.
(run-hooks 'mouse-leave-buffer-hook)
(or mouse-yank-at-point (mouse-set-point click))
(setq this-command 'yank)
+ (setq mouse-selection-click-count 0)
(yank arg))
(defun mouse-kill-ring-save (click)
again in a different position, it extends the selection again.
If you do this twice in the same position, the selection is killed."
(interactive "e")
- (mouse-minibuffer-check click)
- (let ((click-posn (posn-point (event-start click)))
- ;; Don't let a subsequent kill command append to this one:
- ;; prevent setting this-command to kill-region.
- (this-command this-command))
- (if (> (mod mouse-selection-click-count 3) 0)
- (if (not (and (eq last-command 'mouse-save-then-kill)
- (equal click-posn
- (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
- ;; Find both ends of the object selected by this click.
- (let* ((range
- (mouse-start-end click-posn click-posn
- mouse-selection-click-count)))
- ;; Move whichever end is closer to the click.
- ;; That's what xterm does, and it seems reasonable.
- (if (< (abs (- click-posn (mark t)))
- (abs (- click-posn (point))))
- (set-mark (car range))
- (goto-char (nth 1 range)))
- ;; We have already put the old region in the kill ring.
- ;; Replace it with the extended region.
- ;; (It would be annoying to make a separate entry.)
- (kill-new (buffer-substring (point) (mark t)) t)
- ;; Arrange for a repeated mouse-3 to kill this region.
- (setq mouse-save-then-kill-posn
- (list (car kill-ring) (point) click-posn))
- (mouse-show-mark))
- ;; If we click this button again without moving it,
- ;; that time kill.
- (mouse-save-then-kill-delete-region (point) (mark))
- (setq mouse-selection-click-count 0)
- (setq mouse-save-then-kill-posn nil))
- (if (and (eq last-command 'mouse-save-then-kill)
- mouse-save-then-kill-posn
- (eq (car mouse-save-then-kill-posn) (car kill-ring))
- (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
- ;; If this is the second time we've called
- ;; mouse-save-then-kill, delete the text from the buffer.
- (progn
- (mouse-save-then-kill-delete-region (point) (mark))
- ;; After we kill, another click counts as "the first time".
+ (let ((before-scroll point-before-scroll))
+ (mouse-minibuffer-check click)
+ (let ((click-posn (posn-point (event-start click)))
+ ;; Don't let a subsequent kill command append to this one:
+ ;; prevent setting this-command to kill-region.
+ (this-command this-command))
+ (if (and (save-excursion
+ (set-buffer (window-buffer (posn-window (event-start click))))
+ (and (mark t) (> (mod mouse-selection-click-count 3) 0)
+ ;; Don't be fooled by a recent click in some other buffer.
+ (eq mouse-selection-click-count-buffer
+ (current-buffer)))))
+ (if (not (and (eq last-command 'mouse-save-then-kill)
+ (equal click-posn
+ (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
+ ;; Find both ends of the object selected by this click.
+ (let* ((range
+ (mouse-start-end click-posn click-posn
+ mouse-selection-click-count)))
+ ;; Move whichever end is closer to the click.
+ ;; That's what xterm does, and it seems reasonable.
+ (if (< (abs (- click-posn (mark t)))
+ (abs (- click-posn (point))))
+ (set-mark (car range))
+ (goto-char (nth 1 range)))
+ ;; We have already put the old region in the kill ring.
+ ;; Replace it with the extended region.
+ ;; (It would be annoying to make a separate entry.)
+ (kill-new (buffer-substring (point) (mark t)) t)
+ (mouse-set-region-1)
+ ;; Arrange for a repeated mouse-3 to kill this region.
+ (setq mouse-save-then-kill-posn
+ (list (car kill-ring) (point) click-posn))
+ (mouse-show-mark))
+ ;; If we click this button again without moving it,
+ ;; that time kill.
+ (mouse-save-then-kill-delete-region (mark) (point))
+ (setq mouse-selection-click-count 0)
(setq mouse-save-then-kill-posn nil))
- (if (or (and (eq last-command 'mouse-save-then-kill)
- mouse-save-then-kill-posn)
- (and mark-active transient-mark-mode)
- (and (eq last-command 'mouse-drag-region)
- (or mark-even-if-inactive
- (not transient-mark-mode))))
- ;; We have a selection or suitable region, so adjust it.
- (let* ((posn (event-start click))
- (new (posn-point posn)))
- (select-window (posn-window posn))
- (if (numberp new)
- (progn
- ;; Move whichever end of the region is closer to the click.
- ;; That is what xterm does, and it seems reasonable.
- (if (< (abs (- new (point))) (abs (- new (mark t))))
- (goto-char new)
- (set-mark new))
- (setq deactivate-mark nil)))
- (kill-new (buffer-substring (point) (mark t)) t))
- ;; We just have point, so set mark here.
- (mouse-set-mark-fast click)
- (kill-ring-save (point) (mark t)))
- (mouse-show-mark)
- (setq mouse-save-then-kill-posn
- (list (car kill-ring) (point) click-posn))))))
+ (if (and (eq last-command 'mouse-save-then-kill)
+ mouse-save-then-kill-posn
+ (eq (car mouse-save-then-kill-posn) (car kill-ring))
+ (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
+ ;; If this is the second time we've called
+ ;; mouse-save-then-kill, delete the text from the buffer.
+ (progn
+ (mouse-save-then-kill-delete-region (point) (mark))
+ ;; After we kill, another click counts as "the first time".
+ (setq mouse-save-then-kill-posn nil))
+ (if (or (and (eq last-command 'mouse-save-then-kill)
+ mouse-save-then-kill-posn)
+ (and mark-active transient-mark-mode)
+ (and (memq last-command
+ '(mouse-drag-region mouse-set-region))
+ (or mark-even-if-inactive
+ (not transient-mark-mode))))
+ ;; We have a selection or suitable region, so adjust it.
+ (let* ((posn (event-start click))
+ (new (posn-point posn)))
+ (select-window (posn-window posn))
+ (if (numberp new)
+ (progn
+ ;; Move whichever end of the region is closer to the click.
+ ;; That is what xterm does, and it seems reasonable.
+ (if (< (abs (- new (point))) (abs (- new (mark t))))
+ (goto-char new)
+ (set-mark new))
+ (setq deactivate-mark nil)))
+ (kill-new (buffer-substring (point) (mark t)) t)
+ (mouse-show-mark))
+ ;; Set the mark where point is, then move where clicked.
+ (mouse-set-mark-fast click)
+ (if before-scroll
+ (goto-char before-scroll))
+ (exchange-point-and-mark)
+ (kill-new (buffer-substring (point) (mark t))))
+ (mouse-set-region-1)
+ (setq mouse-save-then-kill-posn
+ (list (car kill-ring) (point) click-posn)))))))
\f
(global-set-key [M-mouse-1] 'mouse-start-secondary)
(global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
(window-buffer (posn-window (event-start click)))
(current-buffer)))
(error "Select or click on the buffer where the secondary selection is")))
- (save-excursion
- (set-buffer (overlay-buffer mouse-secondary-overlay))
- (kill-region (overlay-start mouse-secondary-overlay)
- (overlay-end mouse-secondary-overlay)))
+ (let (this-command)
+ (save-excursion
+ (set-buffer (overlay-buffer mouse-secondary-overlay))
+ (kill-region (overlay-start mouse-secondary-overlay)
+ (overlay-end mouse-secondary-overlay))))
(delete-overlay mouse-secondary-overlay)
- (x-set-selection 'SECONDARY nil)
+;;; (x-set-selection 'SECONDARY nil)
(setq mouse-secondary-overlay nil))
(defun mouse-secondary-save-then-kill (click)
(overlay-put mouse-secondary-overlay 'face 'secondary-selection))))
(setq mouse-save-then-kill-posn
(list (car kill-ring) (point) click-posn))))
- (x-set-selection 'SECONDARY
- (if (overlay-buffer mouse-secondary-overlay)
+ (if (overlay-buffer mouse-secondary-overlay)
+ (x-set-selection 'SECONDARY
(buffer-substring
(overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay)))))))
(let ((elt (car tail)))
(if (not (string-match "^ "
(buffer-name elt)))
- (setq head (cons
- (cons
- (format
- (format "%%%ds %%s%%s %%s"
- maxbuf)
- (buffer-name elt)
- (if (buffer-modified-p elt)
- "*" " ")
- (save-excursion
- (set-buffer elt)
- (if buffer-read-only "%" " "))
- (or (buffer-file-name elt) ""))
- elt)
- head))))
+ (setq head
+ (cons
+ (cons
+ (format
+ (format "%%%ds %%s%%s %%s" maxbuf)
+ (buffer-name elt)
+ (if (buffer-modified-p elt) "*" " ")
+ (save-excursion
+ (set-buffer elt)
+ (if buffer-read-only "%" " "))
+ (or (buffer-file-name elt)
+ (save-excursion
+ (set-buffer elt)
+ (if list-buffers-directory
+ (expand-file-name
+ list-buffers-directory)))
+ ""))
+ elt)
+ head))))
(setq tail (cdr tail)))
(reverse head))))))
(let ((buf (x-popup-menu event menu))
HCoop / bpt / emacs.git / blobdiff