;;; mouse.el --- window system-independent mouse support
-;; Copyright (C) 1993, 1994, 1995, 1999, 2000, 2001
+;; Copyright (C) 1993, 94, 95, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Maintainer: FSF
"*If non-nil, mouse yank commands yank at point instead of at click."
:type 'boolean
:group 'mouse)
+
+(defcustom mouse-drag-copy-region t
+ "*If non-nil, mouse drag copies region to kill-ring."
+ :type 'boolean
+ :version "22.1"
+ :group 'mouse)
+
+(defcustom mouse-1-click-follows-link 350
+ "Non-nil means that clicking Mouse-1 on a link follows the link.
+
+With the default setting, an ordinary Mouse-1 click on a link
+performs the same action as Mouse-2 on that link, while a longer
+Mouse-1 click \(hold down the Mouse-1 button for more than 350
+milliseconds) performs the original Mouse-1 binding \(which
+typically sets point where you click the mouse).
+
+If value is an integer, the time elapsed between pressing and
+releasing the mouse button determines whether to follow the link
+or perform the normal Mouse-1 action (typically set point).
+The absolute numeric value specifices the maximum duration of a
+\"short click\" in milliseconds. A positive value means that a
+short click follows the link, and a longer click performs the
+normal action. A negative value gives the opposite behaviour.
+
+If value is `double', a double click follows the link.
+
+Otherwise, a single Mouse-1 click unconditionally follows the link.
+
+Note that dragging the mouse never follows the link.
+
+This feature only works in modes that specifically identify
+clickable text as links, so it may not work with some external
+packages. See `mouse-on-link-p' for details."
+ :version "22.1"
+ :type '(choice (const :tag "Disabled" nil)
+ (const :tag "Double click" double)
+ (number :tag "Single click time limit" :value 350)
+ (other :tag "Single click" t))
+ :group 'mouse)
+
+(defcustom mouse-1-click-in-non-selected-windows t
+ "*If non-nil, a Mouse-1 click also follows links in non-selected windows.
+
+If nil, a Mouse-1 click on a link in a non-selected window performs
+the normal mouse-1 binding, typically selects the window and sets
+point at the click position."
+ :type 'boolean
+ :version "22.1"
+ :group 'mouse)
+
+
\f
;; Provide a mode-specific menu on a mouse button.
(lookup-key menubar (vector (car submap)))))))
(defun mouse-popup-menubar (event prefix)
- "Pops up a menu equivalent to the menu bar a keyboard EVENT with PREFIX.
+ "Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX.
The contents are the items that would be in the menu bar whether or
not it is actually displayed."
(interactive "@e \nP")
(select-window window)
(enlarge-window growth nil (> growth 0))))
+(defsubst mouse-drag-move-window-top (window growth)
+ "Move the top of WINDOW up or down by GROWTH lines.
+Move it down if GROWTH is positive, or up if GROWTH is negative.
+If this would make WINDOW too short, shrink the window or windows
+above it to make room."
+ ;; Moving the top of WINDOW is actually moving the bottom of the
+ ;; window above.
+ (let ((window-above (mouse-drag-window-above window)))
+ (and window-above
+ (mouse-drag-move-window-bottom window-above (- growth)))))
+
(defun mouse-drag-mode-line-1 (start-event mode-line-p)
"Change the height of a window by dragging on the mode or header line.
START-EVENT is the starting mouse-event of the drag action.
(cond ((integerp event)
(setq done t))
- ((eq (car event) 'switch-frame)
+ ((memq (car event) '(switch-frame select-window))
nil)
((not (memq (car event) '(mouse-movement scroll-bar-movement)))
(select-window start-event-window))
;; no. grow/shrink the selected window
;(message "growth = %d" growth)
- (mouse-drag-move-window-bottom start-event-window growth))
+ (if mode-line-p
+ (mouse-drag-move-window-bottom start-event-window growth)
+ (mouse-drag-move-window-top start-event-window growth)))
;; if this window's growth caused another
;; window to be deleted because it was too
;; unknown event.
(cond ((integerp event)
(setq done t))
- ((eq (car event) 'switch-frame)
+ ((memq (car event) '(switch-frame select-window))
nil)
((not (memq (car event)
'(mouse-movement scroll-bar-movement)))
(mouse-minibuffer-check event)
;; Use event-end in case called from mouse-drag-region.
;; If EVENT is a click, event-end and event-start give same value.
- (let ((posn (event-end event)))
- (if (not (windowp (posn-window posn)))
- (error "Cursor not in text area of window"))
- (select-window (posn-window posn))
- (if (numberp (posn-point posn))
- (goto-char (posn-point posn)))))
+ (posn-set-point (event-end event)))
(defvar mouse-last-region-beg nil)
(defvar mouse-last-region-end nil)
;; Don't set this-command to kill-region, so that a following
;; C-w will not double the text in the kill ring.
;; Ignore last-command so we don't append to a preceding kill.
- (let (this-command last-command deactivate-mark)
- (copy-region-as-kill (mark) (point)))
+ (when mouse-drag-copy-region
+ (let (this-command last-command deactivate-mark)
+ (copy-region-as-kill (mark) (point))))
(mouse-set-region-1)))
(defun mouse-set-region-1 ()
+ ;; Set transient-mark-mode for a little while.
+ (if (memq transient-mark-mode '(nil identity))
+ (setq transient-mark-mode 'only))
(setq mouse-last-region-beg (region-beginning))
(setq mouse-last-region-end (region-end))
(setq mouse-last-region-tick (buffer-modified-tick)))
If the click is in the echo area, display the `*Messages*' buffer."
(interactive "e")
(let ((w (posn-window (event-start start-event))))
- (if (not (or (not (window-minibuffer-p w))
- (minibuffer-window-active-p w)))
+ (if (and (window-minibuffer-p w)
+ (not (minibuffer-window-active-p w)))
(save-excursion
+ ;; Swallow the up-event.
(read-event)
(set-buffer "*Messages*")
(goto-char (point-max))
(run-hooks 'mouse-leave-buffer-hook)
(mouse-drag-region-1 start-event))))
+
+(defun mouse-on-link-p (pos)
+ "Return non-nil if POS is on a link in the current buffer.
+POS must be a buffer position in the current buffer or an mouse
+event location in the selected window, see `event-start'.
+However, if `mouse-1-click-in-non-selected-windows' is non-nil,
+POS may be a mouse event location in any window.
+
+A clickable link is identified by one of the following methods:
+
+- If the character at POS has a non-nil `follow-link' text or
+overlay property, use the value of that property determines what
+to do.
+
+- If there is a local key-binding or a keybinding at position POS
+for the `follow-link' event, the binding of that event determines
+what to do.
+
+The resulting value determine whether POS is inside a link:
+
+- If the value is `mouse-face', POS is inside a link if there
+is a non-nil `mouse-face' property at POS. Return t in this case.
+
+- If the value is a function, FUNC, POS is inside a link if
+the call \(FUNC POS) returns non-nil. Return the return value
+from that call. Arg is \(posn-point POS) if POS is a mouse event,
+
+- Otherwise, return the value itself.
+
+The return value is interpreted as follows:
+
+- If it is a string, the mouse-1 event is translated into the
+first character of the string, i.e. the action of the mouse-1
+click is the local or global binding of that character.
+
+- If it is a vector, the mouse-1 event is translated into the
+first element of that vector, i.e. the action of the mouse-1
+click is the local or global binding of that event.
+
+- Otherwise, the mouse-1 event is translated into a mouse-2 event
+at the same position."
+ (let ((w (and (consp pos) (posn-window pos))))
+ (if (consp pos)
+ (setq pos (and (or mouse-1-click-in-non-selected-windows
+ (eq (selected-window) w))
+ (posn-point pos))))
+ (when pos
+ (with-current-buffer (window-buffer w)
+ (let ((action
+ (or (get-char-property pos 'follow-link)
+ (save-excursion
+ (goto-char pos)
+ (key-binding [follow-link] nil t)))))
+ (cond
+ ((eq action 'mouse-face)
+ (and (get-char-property pos 'mouse-face) t))
+ ((functionp action)
+ (funcall action pos))
+ (t action)))))))
+
+
(defun mouse-drag-region-1 (start-event)
(mouse-minibuffer-check start-event)
(let* ((echo-keystrokes 0)
(start-frame (window-frame start-window))
(start-hscroll (window-hscroll start-window))
(bounds (window-edges start-window))
+ (make-cursor-line-fully-visible nil)
(top (nth 1 bounds))
(bottom (if (window-minibuffer-p start-window)
(nth 3 bounds)
;; Don't count the mode line.
(1- (nth 3 bounds))))
+ (on-link (and mouse-1-click-follows-link
+ (or mouse-1-click-in-non-selected-windows
+ (eq start-window (selected-window)))))
+ remap-double-click
(click-count (1- (event-click-count start-event))))
(setq mouse-selection-click-count click-count)
(setq mouse-selection-click-count-buffer (current-buffer))
(if (< (point) start-point)
(goto-char start-point))
(setq start-point (point))
+ (setq on-link (and on-link
+ (mouse-on-link-p start-point)))
+ (setq remap-double-click (and on-link
+ (eq mouse-1-click-follows-link 'double)
+ (= click-count 1)))
+ (if remap-double-click ;; Don't expand mouse overlay in links
+ (setq click-count 0))
(let ((range (mouse-start-end start-point start-point click-count)))
(move-overlay mouse-drag-overlay (car range) (nth 1 range)
(window-buffer start-window))
(while (progn
(setq event (read-event))
(or (mouse-movement-p event)
- (eq (car-safe event) 'switch-frame)))
- (if (eq (car-safe event) 'switch-frame)
+ (memq (car-safe event) '(switch-frame select-window))))
+ (if (memq (car-safe event) '(switch-frame select-window))
nil
(setq end (event-end event)
end-point (posn-point end))
(push-mark region-commencement t t)
(goto-char region-termination)
;; Don't let copy-region-as-kill set deactivate-mark.
- (let (deactivate-mark)
- (copy-region-as-kill (point) (mark t)))
+ (when mouse-drag-copy-region
+ (let (deactivate-mark)
+ (copy-region-as-kill (point) (mark t))))
(let ((buffer (current-buffer)))
(mouse-show-mark)
;; mouse-show-mark can call read-event,
(or end-point
(= (window-start start-window)
start-window-start)))
+ (if (and on-link
+ (not end-point)
+ (consp event)
+ (or remap-double-click
+ (and
+ (not (eq mouse-1-click-follows-link 'double))
+ (= click-count 0)
+ (= (event-click-count event) 1)
+ (not (input-pending-p))
+ (or (not (integerp mouse-1-click-follows-link))
+ (let ((t0 (posn-timestamp (event-start start-event)))
+ (t1 (posn-timestamp (event-end event))))
+ (and (integerp t0) (integerp t1)
+ (if (> mouse-1-click-follows-link 0)
+ (<= (- t1 t0) mouse-1-click-follows-link)
+ (< (- t0 t1) mouse-1-click-follows-link)))))
+ (or (not double-click-time)
+ (sit-for 0 (if (integerp double-click-time)
+ double-click-time 500) t)))))
+ (if (or (vectorp on-link) (stringp on-link))
+ (setq event (aref on-link 0))
+ (setcar event 'mouse-2)))
(setq unread-command-events
(cons event unread-command-events)))))
(delete-overlay mouse-drag-overlay)))))
(while (and (not (eobp)) (= (following-char) char))
(forward-char 1))))))
-;; Return a list of region bounds based on START and END according to MODE.
-;; If MODE is 0 then set point to (min START END), mark to (max START END).
-;; If MODE is 1 then set point to start of word at (min START END),
-;; mark to end of word at (max START END).
-;; If MODE is 2 then do the same for lines.
(defun mouse-start-end (start end mode)
+"Return a list of region bounds based on START and END according to MODE.
+If MODE is 0 then set point to (min START END), mark to (max START END).
+If MODE is 1 then set point to start of word at (min START END),
+mark to end of word at (max START END).
+If MODE is 2 then do the same for lines."
(if (> start end)
(let ((temp start))
(setq start end
"List of keys which shall cause the mouse region to be deleted.")
(defun mouse-show-mark ()
- (if transient-mark-mode
- (delete-overlay mouse-drag-overlay)
- (let ((inhibit-quit t)
- (echo-keystrokes 0)
- event events key ignore
- x-lost-selection-hooks)
- (add-hook 'x-lost-selection-hooks
- (lambda (seltype)
- (if (eq seltype 'PRIMARY)
- (progn (setq ignore t)
- (throw 'mouse-show-mark t)))))
- (move-overlay mouse-drag-overlay (point) (mark t))
- (catch 'mouse-show-mark
- ;; In this loop, execute scroll bar and switch-frame events.
- ;; Also ignore down-events that are undefined.
- (while (progn (setq event (read-event))
- (setq events (append events (list event)))
- (setq key (apply 'vector events))
- (or (and (consp event)
- (eq (car event) 'switch-frame))
- (and (consp event)
- (eq (posn-point (event-end event))
- 'vertical-scroll-bar))
- (and (memq 'down (event-modifiers event))
- (not (key-binding key))
- (not (mouse-undouble-last-event events))
- (not (member key mouse-region-delete-keys)))))
- (and (consp event)
- (or (eq (car event) 'switch-frame)
- (eq (posn-point (event-end event))
- 'vertical-scroll-bar))
- (let ((keys (vector 'vertical-scroll-bar event)))
- (and (key-binding keys)
- (progn
- (call-interactively (key-binding keys)
- nil keys)
- (setq events nil)))))))
- ;; If we lost the selection, just turn off the highlighting.
- (if ignore
- nil
- ;; For certain special keys, delete the region.
- (if (member key mouse-region-delete-keys)
- (delete-region (overlay-start mouse-drag-overlay)
- (overlay-end mouse-drag-overlay))
- ;; Otherwise, unread the key so it gets executed normally.
- (setq unread-command-events
- (nconc events unread-command-events))))
- (setq quit-flag nil)
+ (let ((inhibit-quit t)
+ (echo-keystrokes 0)
+ event events key ignore
+ (x-lost-selection-functions
+ (when (boundp 'x-lost-selection-functions)
+ (copy-sequence x-lost-selection-functions))))
+ (add-hook 'x-lost-selection-functions
+ (lambda (seltype)
+ (when (eq seltype 'PRIMARY)
+ (setq ignore t)
+ (throw 'mouse-show-mark t))))
+ (if transient-mark-mode
+ (delete-overlay mouse-drag-overlay)
+ (move-overlay mouse-drag-overlay (point) (mark t)))
+ (catch 'mouse-show-mark
+ ;; In this loop, execute scroll bar and switch-frame events.
+ ;; Should we similarly handle `select-window' events? --Stef
+ ;; Also ignore down-events that are undefined.
+ (while (progn (setq event (read-event))
+ (setq events (append events (list event)))
+ (setq key (apply 'vector events))
+ (or (and (consp event)
+ (eq (car event) 'switch-frame))
+ (and (consp event)
+ (eq (posn-point (event-end event))
+ 'vertical-scroll-bar))
+ (and (memq 'down (event-modifiers event))
+ (not (key-binding key))
+ (not (mouse-undouble-last-event events))
+ (not (member key mouse-region-delete-keys)))))
+ (and (consp event)
+ (or (eq (car event) 'switch-frame)
+ (eq (posn-point (event-end event))
+ 'vertical-scroll-bar))
+ (let ((keys (vector 'vertical-scroll-bar event)))
+ (and (key-binding keys)
+ (progn
+ (call-interactively (key-binding keys)
+ nil keys)
+ (setq events nil)))))))
+ ;; If we lost the selection, just turn off the highlighting.
+ (unless ignore
+ ;; For certain special keys, delete the region.
+ (if (member key mouse-region-delete-keys)
+ (delete-region (mark t) (point))
+ ;; Otherwise, unread the key so it gets executed normally.
+ (setq unread-command-events
+ (nconc events unread-command-events))))
+ (setq quit-flag nil)
+ (unless transient-mark-mode
(delete-overlay mouse-drag-overlay))))
(defun mouse-set-mark (click)
(while (progn
(setq event (read-event))
(or (mouse-movement-p event)
- (eq (car-safe event) 'switch-frame)))
+ (memq (car-safe event) '(switch-frame select-window))))
- (if (eq (car-safe event) 'switch-frame)
+ (if (memq (car-safe event) '(switch-frame select-window))
nil
(setq end (event-end event)
end-point (posn-point end))
(progn (unless (display-multi-font-p)
(error "Cannot change fonts on this display"))
(x-popup-menu
- last-nonmenu-event
+ (if (listp last-nonmenu-event)
+ last-nonmenu-event
+ (list '(0 0) (selected-window)))
;; Append list of fontsets currently defined.
(append x-fixed-font-alist (list (generate-fontset-menu))))))
(if fonts
(global-set-key [double-mouse-1] 'mouse-set-point)
(global-set-key [triple-mouse-1] 'mouse-set-point)
+;; Clicking on the fringes causes hscrolling:
+(global-set-key [left-fringe mouse-1] 'mouse-set-point)
+(global-set-key [right-fringe mouse-1] 'mouse-set-point)
+
(global-set-key [mouse-2] 'mouse-yank-at-click)
(global-set-key [mouse-3] 'mouse-save-then-kill)
HCoop / bpt / emacs.git / blobdiff