;;; mouse.el --- window system-independent mouse support
-;; Copyright (C) 1993, 94, 95, 1999, 2000, 01, 2004
+;; Copyright (C) 1993, 94, 95, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Maintainer: FSF
(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.
(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)))
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))
(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)))))
"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)
Prefix arguments are interpreted as with \\[yank].
If `mouse-yank-at-point' is non-nil, insert at point
regardless of where you click."
- (interactive "*e\nP")
+ (interactive "e\nP")
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(or mouse-yank-at-point (mouse-set-point 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))
Move point to the end of the inserted text.
If `mouse-yank-at-point' is non-nil, insert at point
regardless of where you click."
- (interactive "*e")
+ (interactive "e")
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(or mouse-yank-at-point (mouse-set-point click))
(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
HCoop / bpt / emacs.git / blobdiff