X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f9c8b7ae61365bbe5e6fc1d9ea8e9245325519bd..b0c9a334c2f0eb881eff47f590997e746cc3bdb3:/lisp/mouse.el

diff --git a/lisp/mouse.el b/lisp/mouse.el
index 0a6499e5c0..c928e04f8e 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1,7 +1,7 @@
 ;;; mouse.el --- window system-independent mouse support
 
-;; Copyright (C) 1993, 94, 95, 1999, 2000, 01, 2004
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
+;;   2004, 2005 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: hardware, mouse
@@ -20,8 +20,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -46,8 +46,53 @@
 (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 450
+  "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 behavior.
+
+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)
+
+
 
 ;; Provide a mode-specific menu on a mouse button.
 
@@ -338,6 +383,17 @@ shrink the window or windows above it to make room."
     (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.
@@ -389,7 +445,7 @@ MODE-LINE-P non-nil means dragging a mode line; nil means a header line."
 	  (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)))
@@ -444,7 +500,9 @@ MODE-LINE-P non-nil means dragging a mode line; nil means a header line."
 		       (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
@@ -534,7 +592,7 @@ resized by dragging their header-line."
 	  ;;     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)))
@@ -707,9 +765,10 @@ remains active.  Otherwise, it remains until the next input event.
 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))
@@ -718,6 +777,89 @@ If the click is in the echo area, display the `*Messages*' buffer."
       (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, 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-fixup-help-message (msg)
+  "Fix help message MSG for `mouse-1-click-follows-link'."
+  (let (mp pos)
+    (if (and mouse-1-click-follows-link
+	     (stringp msg)
+	     (save-match-data
+	       (string-match "^mouse-2" msg))
+	     (setq mp (mouse-pixel-position))
+	     (consp (setq pos (cdr mp)))
+	     (car pos) (>= (car pos) 0)
+	     (cdr pos) (>= (cdr pos) 0)
+	     (setq pos (posn-at-x-y (car pos) (cdr pos) (car mp)))
+	     (windowp (posn-window pos)))
+	(with-current-buffer (window-buffer (posn-window pos))
+	  (if (mouse-on-link-p pos)
+	      (setq msg (concat
+		    (cond
+		     ((eq mouse-1-click-follows-link 'double) "double-")
+		     ((and (integerp mouse-1-click-follows-link)
+			   (< mouse-1-click-follows-link 0)) "Long ")
+		     (t ""))
+		    "mouse-1" (substring msg 7)))))))
+  msg)
+
 (defun mouse-drag-region-1 (start-event)
   (mouse-minibuffer-check start-event)
   (let* ((echo-keystrokes 0)
@@ -728,11 +870,16 @@ If the click is in the echo area, display the `*Messages*' buffer."
 	 (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))
@@ -742,6 +889,13 @@ If the click is in the echo area, display the `*Messages*' 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))
@@ -755,8 +909,8 @@ If the click is in the echo area, display the `*Messages*' buffer."
 	(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))
@@ -864,6 +1018,28 @@ If the click is in the echo area, display the `*Messages*' buffer."
 			 (or end-point
 			     (= (window-start start-window)
 				start-window-start)))
+		(if (and on-link
+			 (or (not end-point) (= end-point start-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)))))
@@ -1012,54 +1188,56 @@ If MODE is 2 then do the same for lines."
   "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)
@@ -1097,7 +1275,7 @@ and set mark at the beginning.
 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))
@@ -1350,9 +1528,9 @@ The function returns a non-nil value if it creates a secondary selection."
 	  (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))
@@ -1399,7 +1577,7 @@ The function returns a non-nil value if it creates a secondary selection."
 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))
@@ -1679,7 +1857,7 @@ and selects that window."
 			    (string< (buffer-name elt1) (buffer-name elt2))))))
     (setq tail buffers)
     (while tail
-      (or (eq ?\ (aref (buffer-name (car tail)) 0))
+      (or (eq ?\s (aref (buffer-name (car tail)) 0))
 	  (setq maxlen
 		(max maxlen
 		     (length (buffer-name (car tail))))))
@@ -2184,7 +2362,9 @@ and selects that window."
    (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