(U-00024182): Apply new conventions for glyph granularity.

[chise/xemacs-chise.git.1] / lisp / mouse.el

diff --git a/lisp/mouse.el b/lisp/mouse.el
index 7c07a20..7141595 100644 (file)
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 1988, 1992-4, 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Tinker Systems
 
 ;; Copyright (C) 1988, 1992-4, 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Tinker Systems

-;; Copyright (C) 1995, 1996 Ben Wing.
+;; Copyright (C) 1995, 1996, 2000 Ben Wing.

 
 ;; Maintainer: XEmacs Development Team
 ;; Keywords: mouse, dumped
 
 ;; Maintainer: XEmacs Development Team
 ;; Keywords: mouse, dumped

@@ -30,6 +30,15 @@
 
 ;; This file is dumped with XEmacs (when window system support is compiled in).
 
 
 ;; This file is dumped with XEmacs (when window system support is compiled in).
 

+;;; Authorship:
+
+;; Probably originally derived from FSF 19 pre-release.
+;; much hacked upon by Jamie Zawinski and crew, pre-1994.
+;;   (only mouse-motion stuff currently remains from that era)
+;; all mouse-track stuff completely rewritten by Ben Wing, 1995-1996.
+;; mouse-eval-sexp and *-inside-extent-p from Stig, 1995.
+;; vertical divider code c. 1998 from ?.
+

 ;;; Code:
 
 (provide 'mouse)
 ;;; Code:
 
 (provide 'mouse)

@@ -39,16 +48,7 @@
 (global-set-key '(control button1) 'mouse-track-insert)
 (global-set-key '(control shift button1) 'mouse-track-delete-and-insert)
 (global-set-key '(meta button1) 'mouse-track-do-rectangle)
 (global-set-key '(control button1) 'mouse-track-insert)
 (global-set-key '(control shift button1) 'mouse-track-delete-and-insert)
 (global-set-key '(meta button1) 'mouse-track-do-rectangle)

-
-;; drops are now handled in dragdrop.el (ograf@fga.de)
-
-;; enable drag regions (ograf@fga.de)
-;; if button2 is dragged from within a region, this becomes a drop
-;;
-;; this must be changed to the new api
-(if (featurep '(or offix cde mswindows))
-    (global-set-key 'button2 'mouse-drag-or-yank)
-  (global-set-key 'button2 'mouse-yank))
+(global-set-key 'button2 'mouse-track)

 
 (defgroup mouse nil
   "Window system-independent mouse support."
 
 (defgroup mouse nil
   "Window system-independent mouse support."

@@ -84,11 +84,54 @@ If set to `symbol', double-click will always attempt to highlight a
   "Function that is called upon by `mouse-yank' to actually insert text.")
 
 (defun mouse-consolidated-yank ()
   "Function that is called upon by `mouse-yank' to actually insert text.")
 
 (defun mouse-consolidated-yank ()

+  "Insert the current selection or, if there is none under X insert
+the X cutbuffer.  A mark is pushed, so that the inserted text lies
+between point and mark."

   (interactive)
   (interactive)

-  (case (device-type)
-    (x (x-yank-function))
-    (tty (yank))
-    (otherwise (yank))))
+  (if (and (not (console-on-window-system-p))
+          (and (featurep 'gpm)
+               (not gpm-minor-mode)))
+      (yank)
+    (push-mark)
+    (if (region-active-p)
+       (if (consp zmacs-region-extent)
+           ;; pirated code from insert-rectangle in rect.el
+           ;; perhaps that code should be modified to handle a list of extents
+           ;; as the rectangle to be inserted?
+           (let ((lines zmacs-region-extent)
+                 (insertcolumn (current-column))
+                 (first t))
+             (push-mark)
+             (while lines
+               (or first
+                   (progn
+                     (forward-line 1)
+                     (or (bolp) (insert ?\n))
+                     (move-to-column insertcolumn t)))
+               (setq first nil)
+               (insert (extent-string (car lines)))
+               (setq lines (cdr lines))))
+         (insert (extent-string zmacs-region-extent)))
+      (insert-selection t))))
+
+(defun insert-selection (&optional check-cutbuffer-p move-point-event)
+  "Insert the current selection into buffer at point."
+  (interactive "P")
+  ;; we fallback to the clipboard if the current selection is not existent
+  (let ((text (if check-cutbuffer-p
+                 (or (get-selection-no-error)
+                     (get-cutbuffer)
+                     (get-selection-no-error 'CLIPBOARD)
+                     (error "No selection, clipboard or cut buffer available"))
+               (or (get-selection-no-error)
+                   (get-selection 'CLIPBOARD)))))
+    (cond (move-point-event
+          (mouse-set-point move-point-event)
+          (push-mark (point)))
+         ((interactive-p)
+          (push-mark (point))))
+    (insert text)
+    ))

 
 \f
 (defun mouse-select ()
 
 \f
 (defun mouse-select ()

@@ -142,7 +185,6 @@ location."
 (defun click-inside-extent-p (click extent)
   "Return non-nil if the button event is within the primary selection-extent.
 Return nil otherwise."
 (defun click-inside-extent-p (click extent)
   "Return non-nil if the button event is within the primary selection-extent.
 Return nil otherwise."

-  ;; stig@hackvan.com

   (let ((ewin (event-window click))
        (epnt (event-point click)))
     (and ewin
   (let ((ewin (event-window click))
        (epnt (event-point click)))
     (and ewin

@@ -163,7 +205,6 @@ Return nil otherwise."
   "Return t if point is within the bounds of the primary selection extent.
 Return t is point is at the end position of the extent.
 Return nil otherwise."
   "Return t if point is within the bounds of the primary selection extent.
 Return t is point is at the end position of the extent.
 Return nil otherwise."

-  ;; stig@hackvan.com

   (and extent
        (eq (current-buffer)
           (extent-object extent))
   (and extent
        (eq (current-buffer)
           (extent-object extent))

@@ -171,40 +212,33 @@ Return nil otherwise."
        (>= (extent-end-position extent) (point))))
 
 (defun point-inside-selection-p ()
        (>= (extent-end-position extent) (point))))
 
 (defun point-inside-selection-p ()

-  ;; by Stig@hackvan.com

   (or (point-inside-extent-p primary-selection-extent)
       (point-inside-extent-p zmacs-region-extent)))
 
   (or (point-inside-extent-p primary-selection-extent)
       (point-inside-extent-p zmacs-region-extent)))
 

-(defun mouse-drag-or-yank (event)
-  "Either drag or paste the current selection.
-If the variable `mouse-yank-at-point' is non-nil,
-move the cursor to the location of the click before pasting.
-This functions has to be improved.  Currently it is just a (working) test."
-  ;; by Oliver Graf <ograf@fga.de>
-  (interactive "e")
-  (if (click-inside-extent-p event zmacs-region-extent)
-      ;; okay, this is a drag
-      (cond ((featurep 'offix)
-            (offix-start-drag-region event
-                                     (extent-start-position zmacs-region-extent)
-                                     (extent-end-position zmacs-region-extent)))
-           ((featurep 'cde)
-            ;; should also work with CDE
-            (cde-start-drag-region event
-                                   (extent-start-position zmacs-region-extent)
-                                   (extent-end-position zmacs-region-extent)))
-           (t (error "No offix or CDE support compiled in")))
-    ;; no drag, call region-funct
-    (and (not mouse-yank-at-point)
-        (mouse-set-point event))
-    (funcall mouse-yank-function))
-  )
+(defun mouse-begin-drag-n-drop (event)
+  "Begin a drag-n-drop operation.
+EVENT should be the button event that initiated the drag.
+Returns whether a drag was begun."
+  ;; #### barely implemented.
+  (when (click-inside-selection-p event)
+    (cond ((featurep 'offix)
+          (offix-start-drag-region
+           event
+           (extent-start-position zmacs-region-extent)
+           (extent-end-position zmacs-region-extent))
+          t)
+         ((featurep 'cde)
+          ;; should also work with CDE
+          (cde-start-drag-region event
+                                 (extent-start-position zmacs-region-extent)
+                                 (extent-end-position zmacs-region-extent))
+          t))))

 
 (defun mouse-eval-sexp (click force-window)
   "Evaluate the sexp under the mouse.  Usually, this is the last sexp before
 the click, but if you click on a left paren, then it is the sexp beginning
 with the paren that is evaluated.  Also, since strings evaluate to themselves,
 
 (defun mouse-eval-sexp (click force-window)
   "Evaluate the sexp under the mouse.  Usually, this is the last sexp before
 the click, but if you click on a left paren, then it is the sexp beginning
 with the paren that is evaluated.  Also, since strings evaluate to themselves,

-they're fed to re-search-forward and the matched region is highlighted until
+they're fed to `re-search-forward' and the matched region is highlighted until

 the mouse button is released.
 
 Perhaps the most useful thing about this function is that the evaluation of
 the mouse button is released.
 
 Perhaps the most useful thing about this function is that the evaluation of

@@ -213,7 +247,6 @@ click, but to the current window and the current position of point.  Thus,
 you can use `mouse-eval-sexp' to interactively test code that acts upon a
 buffer...something you cannot do with the standard `eval-last-sexp' function.
 It's also fantastic for debugging regular expressions."
 you can use `mouse-eval-sexp' to interactively test code that acts upon a
 buffer...something you cannot do with the standard `eval-last-sexp' function.
 It's also fantastic for debugging regular expressions."

-  ;; by Stig@hackvan.com

   (interactive "e\nP")
   (let (exp val result-str)
     (setq exp (save-window-excursion
   (interactive "e\nP")
   (let (exp val result-str)
     (setq exp (save-window-excursion

@@ -310,7 +343,7 @@ Display cursor at that position for a second."
       (switch-to-buffer val))))
 
 (defun narrow-window-to-region (m n)
       (switch-to-buffer val))))
 
 (defun narrow-window-to-region (m n)

-  "Narrow window to region between point and last mark"
+  "Narrow window to region between point and last mark."

   (interactive "r")
   (save-excursion
     (save-restriction
   (interactive "r")
   (save-excursion
     (save-restriction

@@ -438,7 +471,10 @@ been created during the operation of `mouse-track'.
 Unlike all of the other mouse-track hooks, this is a \"normal\"
 hook: the hook functions are called with no arguments, and
 all hook functions are called regardless of their return
 Unlike all of the other mouse-track hooks, this is a \"normal\"
 hook: the hook functions are called with no arguments, and
 all hook functions are called regardless of their return

-values.")
+values.
+
+This function is called with the buffer where the mouse was clicked
+set to the current buffer, unless that buffer was killed.")

 
 (defcustom mouse-track-multi-click-time 400
   "*Maximum number of milliseconds allowed between clicks for a multi-click.
 
 (defcustom mouse-track-multi-click-time 400
   "*Maximum number of milliseconds allowed between clicks for a multi-click.

@@ -459,6 +495,36 @@ A value of nil disables the timeout feature."
   :type '(choice integer (const :tag "Disabled" nil))
   :group 'mouse)
 
   :type '(choice integer (const :tag "Disabled" nil))
   :group 'mouse)
 

+(defcustom mouse-track-activate-strokes '(button1-double-click button2-click)
+  "List of mouse strokes that can cause \"activation\" of the text extent
+under the mouse.  The exact meaning of \"activation\" is dependent on the
+text clicked on and the mode of the buffer, but typically entails actions
+such as following a hyperlink or selecting an entry in a completion buffer.
+
+Possible list entries are
+
+button1-click
+button1-double-click
+button1-triple-click
+button1-down
+button2-click
+button2-double-click
+button2-triple-click
+button2-down
+
+As a general rule, you should not use the \"-down\" values, because this
+makes it impossible to have other simultaneous actions, such as selection."
+  :type '(set
+         button1-click
+         button1-double-click
+         button1-triple-click
+         button1-down
+         button2-click
+         button2-double-click
+         button2-triple-click
+         button2-down)
+  :group 'mouse)
+

 (defvar mouse-track-x-threshold '(face-width 'default)
   "Minimum number of pixels in the X direction for a drag to be initiated.
 If the mouse is moved more than either the X or Y threshold while the
 (defvar mouse-track-x-threshold '(face-width 'default)
   "Minimum number of pixels in the X direction for a drag to be initiated.
 If the mouse is moved more than either the X or Y threshold while the

@@ -466,7 +532,7 @@ button is held down (see also `mouse-track-y-threshold'), then a drag
 is initiated; otherwise the gesture is considered to be a click.
 See `mouse-track'.
 
 is initiated; otherwise the gesture is considered to be a click.
 See `mouse-track'.
 

-The value should be either a number of a form to be evaluated to
+The value should be either a number or a form to be evaluated to

 produce a number.")
 
 (defvar mouse-track-y-threshold '(face-height 'default)
 produce a number.")
 
 (defvar mouse-track-y-threshold '(face-height 'default)

@@ -495,7 +561,18 @@ produce a number.")
                         'mouse-track-scroll-undefined
                         (copy-event event)))))
 
                         'mouse-track-scroll-undefined
                         (copy-event event)))))
 

-(defun mouse-track-run-hook (hook event &rest args)
+(defun mouse-track-do-activate (event)
+  "Execute the activate function under EVENT, if any.
+Return true if the function was activated."
+  (let ((ex (extent-at-event event 'activate-function)))
+    (when ex
+      (funcall (extent-property ex 'activate-function)
+              event ex)
+      t)))
+
+(defvar Mouse-track-gensym (gensym))
+
+(defun mouse-track-run-hook (hook override event &rest args)

   ;; ugh, can't use run-hook-with-args-until-success because we have
   ;; to get the value using symbol-value-in-buffer.  Doing a
   ;; save-excursion/set-buffer is wrong because the hook might want to
   ;; ugh, can't use run-hook-with-args-until-success because we have
   ;; to get the value using symbol-value-in-buffer.  Doing a
   ;; save-excursion/set-buffer is wrong because the hook might want to

@@ -503,33 +580,40 @@ produce a number.")
   ;; the hook might not want to change the buffer.
   ;; #### What we need here is a Lisp interface to
   ;; run_hook_with_args_in_buffer.  Here is a poor man's version.
   ;; the hook might not want to change the buffer.
   ;; #### What we need here is a Lisp interface to
   ;; run_hook_with_args_in_buffer.  Here is a poor man's version.

-  (let ((buffer (event-buffer event)))
-    (and mouse-grabbed-buffer (setq buffer mouse-grabbed-buffer))
-    (when buffer
-      (let ((value (symbol-value-in-buffer hook buffer nil)))
-       (if (and (listp value) (not (eq (car value) 'lambda)))
-           ;; List of functions.
-           (let (retval)
-             (while (and value (null retval))
-               ;; Found `t': should process default value.  We could
-               ;; splice it into the buffer-local value, but that
-               ;; would cons, which is not a good thing for
-               ;; mouse-track hooks.
-               (if (eq (car value) t)
-                   (let ((global (default-value hook)))
-                     (if (and (listp global) (not (eq (car global) 'lambda)))
-                         ;; List of functions.
-                         (while (and global
-                                     (null (setq retval
-                                                 (apply (car global) event args))))
-                           (pop global))
-                       ;; lambda
-                       (setq retval (apply (car global) event args))))
-                 (setq retval (apply (car value) event args)))
-               (pop value))
-             retval)
-         ;; lambda
-         (apply value event args))))))
+  (let ((overridden (plist-get override hook Mouse-track-gensym)))
+    (if (not (eq overridden Mouse-track-gensym))
+       (if (and (listp overridden) (not (eq (car overridden) 'lambda)))
+           (some #'(lambda (val) (apply val event args)) overridden)
+         (apply overridden event args))
+      (let ((buffer (event-buffer event)))
+       (and mouse-grabbed-buffer (setq buffer mouse-grabbed-buffer))
+       (when buffer
+         (let ((value (symbol-value-in-buffer hook buffer nil)))
+           (if (and (listp value) (not (eq (car value) 'lambda)))
+               ;; List of functions.
+               (let (retval)
+                 (while (and value (null retval))
+                   ;; Found `t': should process default value.  We could
+                   ;; splice it into the buffer-local value, but that
+                   ;; would cons, which is not a good thing for
+                   ;; mouse-track hooks.
+                   (if (eq (car value) t)
+                       (let ((global (default-value hook)))
+                         (if (and (listp global) (not (eq (car global)
+                                                          'lambda)))
+                             ;; List of functions.
+                             (while (and global
+                                         (null (setq retval
+                                                     (apply (car global)
+                                                            event args))))
+                               (pop global))
+                           ;; lambda
+                           (setq retval (apply (car global) event args))))
+                     (setq retval (apply (car value) event args)))
+                   (pop value))
+                 retval)
+             ;; lambda
+             (apply value event args))))))))

 
 (defun mouse-track-scroll-undefined (random)
   ;; the old implementation didn't actually define this function,
 
 (defun mouse-track-scroll-undefined (random)
   ;; the old implementation didn't actually define this function,

@@ -540,10 +624,10 @@ produce a number.")
   ;; difficult to do), this function may get called.
 )
 
   ;; difficult to do), this function may get called.
 )
 

-(defun mouse-track (event)
-  "Make a selection with the mouse.  This should be bound to a mouse button.
-The behavior of XEmacs during mouse selection is customizable using various
-hooks and variables: see `mouse-track-click-hook', `mouse-track-drag-hook',
+(defun mouse-track (event &optional overriding-hooks)
+  "Generalized mouse-button handler.  This should be bound to a mouse button.
+The behavior of this function is customizable using various hooks and
+variables: see `mouse-track-click-hook', `mouse-track-drag-hook',

 `mouse-track-drag-up-hook', `mouse-track-down-hook', `mouse-track-up-hook',
 `mouse-track-cleanup-hook', `mouse-track-multi-click-time',
 `mouse-track-scroll-delay', `mouse-track-x-threshold', and
 `mouse-track-drag-up-hook', `mouse-track-down-hook', `mouse-track-up-hook',
 `mouse-track-cleanup-hook', `mouse-track-multi-click-time',
 `mouse-track-scroll-delay', `mouse-track-x-threshold', and

@@ -554,6 +638,10 @@ behavior.  You can explicitly request this default behavior, and override
 any custom-supplied handlers, by using the function `mouse-track-default'
 instead of `mouse-track'.
 
 any custom-supplied handlers, by using the function `mouse-track-default'
 instead of `mouse-track'.
 

+\(In general, you can override specific hooks by using the argument
+OVERRIDING-HOOKS, which should be a plist of alternating hook names
+and values.)
+

 Default behavior is as follows:
 
 If you click-and-drag, the selection will be set to the region between the
 Default behavior is as follows:
 
 If you click-and-drag, the selection will be set to the region between the

@@ -594,7 +682,7 @@ at the initial click position."
       (setq mouse-track-click-count (1+ mouse-track-click-count)))
     (if (not (event-window event))
        (error "Not over a window."))
       (setq mouse-track-click-count (1+ mouse-track-click-count)))
     (if (not (event-window event))
        (error "Not over a window."))

-    (mouse-track-run-hook 'mouse-track-down-hook
+    (mouse-track-run-hook 'mouse-track-down-hook overriding-hooks

                          event mouse-track-click-count)
     (unwind-protect
        (while mouse-down
                          event mouse-track-click-count)
     (unwind-protect
        (while mouse-down

@@ -608,14 +696,17 @@ at the initial click position."
                     (setq mouse-moved t))
                 (if mouse-moved
                     (mouse-track-run-hook 'mouse-track-drag-hook
                     (setq mouse-moved t))
                 (if mouse-moved
                     (mouse-track-run-hook 'mouse-track-drag-hook

-                     event mouse-track-click-count nil))
+                                          overriding-hooks
+                                          event mouse-track-click-count nil))

                 (mouse-track-set-timeout event))
                ((and (timeout-event-p event)
                      (eq (event-function event)
                          'mouse-track-scroll-undefined))
                 (if mouse-moved
                     (mouse-track-run-hook 'mouse-track-drag-hook
                 (mouse-track-set-timeout event))
                ((and (timeout-event-p event)
                      (eq (event-function event)
                          'mouse-track-scroll-undefined))
                 (if mouse-moved
                     (mouse-track-run-hook 'mouse-track-drag-hook

-                     (event-object event) mouse-track-click-count t))
+                                          overriding-hooks
+                                          (event-object event)
+                                          mouse-track-click-count t))

                 (mouse-track-set-timeout (event-object event)))
                ((button-release-event-p event)
                 (setq mouse-track-up-time (event-timestamp event))
                 (mouse-track-set-timeout (event-object event)))
                ((button-release-event-p event)
                 (setq mouse-track-up-time (event-timestamp event))

@@ -623,12 +714,15 @@ at the initial click position."
                 (setq mouse-track-up-y (event-y-pixel event))
                 (setq mouse-down nil)
                 (mouse-track-run-hook 'mouse-track-up-hook
                 (setq mouse-track-up-y (event-y-pixel event))
                 (setq mouse-down nil)
                 (mouse-track-run-hook 'mouse-track-up-hook

-                 event mouse-track-click-count)
+                                      overriding-hooks
+                                      event mouse-track-click-count)

                 (if mouse-moved
                     (mouse-track-run-hook 'mouse-track-drag-up-hook
                 (if mouse-moved
                     (mouse-track-run-hook 'mouse-track-drag-up-hook

-                     event mouse-track-click-count)
+                                          overriding-hooks
+                                          event mouse-track-click-count)

                   (mouse-track-run-hook 'mouse-track-click-hook
                   (mouse-track-run-hook 'mouse-track-click-hook

-                   event mouse-track-click-count)))
+                                        overriding-hooks
+                                        event mouse-track-click-count)))

                ((or (key-press-event-p event)
                     (and (misc-user-event-p event)
                          (eq (event-function event) 'cancel-mode-internal)))
                ((or (key-press-event-p event)
                     (and (misc-user-event-p event)
                          (eq (event-function event) 'cancel-mode-internal)))

@@ -639,10 +733,17 @@ at the initial click position."
       (if mouse-track-timeout-id
          (disable-timeout mouse-track-timeout-id))
       (setq mouse-track-timeout-id nil)
       (if mouse-track-timeout-id
          (disable-timeout mouse-track-timeout-id))
       (setq mouse-track-timeout-id nil)

-      (and buffer
+      (and (buffer-live-p buffer)

           (save-excursion
             (set-buffer buffer)
           (save-excursion
             (set-buffer buffer)

-            (run-hooks 'mouse-track-cleanup-hook))))))
+            (let ((override (plist-get overriding-hooks
+                                       'mouse-track-cleanup-hook
+                                       Mouse-track-gensym)))
+              (if (not (eq override Mouse-track-gensym))
+                  (if (and (listp override) (not (eq (car override) 'lambda)))
+                      (mapc #'funcall override)
+                    (funcall override))
+                (run-hooks 'mouse-track-cleanup-hook))))))))

 
 \f
 ;;;;;;;;;;;; default handlers: new version of mouse-track
 
 \f
 ;;;;;;;;;;;; default handlers: new version of mouse-track

@@ -676,7 +777,7 @@ at the initial click position."
       (let* ((edges (window-pixel-edges window))
             (row (event-y-pixel event))
             (text-start (nth 1 edges))
       (let* ((edges (window-pixel-edges window))
             (row (event-y-pixel event))
             (text-start (nth 1 edges))

-            (text-end (+ (nth 3 edges))))
+            (text-end (nth 3 edges)))

        (if (or (< row text-start)
                (> row text-end))
            nil ;; Scroll
        (if (or (< row text-start)
                (> row text-end))
            nil ;; Scroll

@@ -964,29 +1065,33 @@ at the initial click position."
             ;;
             (and (eq (console-type) 'x)
                  (sit-for 0.15 t))
             ;;
             (and (eq (console-type) 'x)
                  (sit-for 0.15 t))

+            ;; zmacs-activate-region -> zmacs-activate-region-hook ->
+            ;; activate-region-as-selection -> either own-selection or
+            ;; mouse-track-activate-rectangular-selection

             (zmacs-activate-region)))
          ((console-on-window-system-p)
             (zmacs-activate-region)))
          ((console-on-window-system-p)

+          ;; #### do we need this?  we don't do it when zmacs-regions = t

           (if (= start end)
               (disown-selection type)
           (if (= start end)
               (disown-selection type)

-            (if (consp default-mouse-track-extent)
-                ;; own the rectangular region
-                ;; this is a hack
-                (let ((r default-mouse-track-extent))
-                  (save-excursion
-                    (set-buffer (get-buffer-create " *rect yank temp buf*"))
-                    (while r
-                      (insert (extent-string (car r)) "\n")
-                      (setq r (cdr r)))
-                    (own-selection (buffer-substring (point-min) (point-max)))
-                    (kill-buffer (current-buffer))))
-              (own-selection (cons (set-marker (make-marker) start)
-                                   (set-marker (make-marker) end))
-                             type)))))
+            (activate-region-as-selection))))

     (if (and (eq 'x (console-type))
             (not (= start end)))
        ;; I guess cutbuffers should do something with rectangles too.
        ;; does anybody use them?
     (if (and (eq 'x (console-type))
             (not (= start end)))
        ;; I guess cutbuffers should do something with rectangles too.
        ;; does anybody use them?

-       (x-store-cutbuffer (buffer-substring start end)))))
+        (x-store-cutbuffer (buffer-substring start end)))))
+
+(defun mouse-track-activate-rectangular-selection ()
+  (if (consp default-mouse-track-extent)
+      ;; own the rectangular region
+      ;; this is a hack
+      (let ((r default-mouse-track-extent))
+       (save-excursion
+         (set-buffer (get-buffer-create " *rect yank temp buf*"))
+         (erase-buffer)
+         (while r
+           (insert (extent-string (car r)) "\n")
+           (setq r (cdr r)))
+         (own-selection (buffer-substring (point-min) (point-max)))))))

 
 (defun default-mouse-track-deal-with-down-event (click-count)
   (let ((event default-mouse-track-down-event))
 
 (defun default-mouse-track-deal-with-down-event (click-count)
   (let ((event default-mouse-track-down-event))

@@ -1066,9 +1171,26 @@ at the initial click position."
                   (disown-selection)))))
       (setq default-mouse-track-down-event nil))))
 
                   (disown-selection)))))
       (setq default-mouse-track-down-event nil))))
 

+;; return t if the button or motion event involved the specified button.
+(defun default-mouse-track-event-is-with-button (event n)
+  (cond ((button-event-p event)
+        (= n (event-button event)))
+       ((motion-event-p event)
+        (memq (cdr
+               (assq n '((1 . button1) (2 . button2) (3 . button3)
+                         (4 . button4) (5 . button5))))
+              (event-modifiers event)))))
+

 (defun default-mouse-track-down-hook (event click-count)
 (defun default-mouse-track-down-hook (event click-count)

-  (setq default-mouse-track-down-event (copy-event event))
-  nil)
+  (cond ((default-mouse-track-event-is-with-button event 1)
+        (if (and (memq 'button1-down mouse-track-activate-strokes)
+                 (mouse-track-do-activate event))
+            t
+          (setq default-mouse-track-down-event (copy-event event))
+          nil))
+       ((default-mouse-track-event-is-with-button event 2)
+        (and (memq 'button2-down mouse-track-activate-strokes)
+             (mouse-track-do-activate event)))))

 
 (defun default-mouse-track-cleanup-extents-hook ()
   (remove-hook 'pre-command-hook 'default-mouse-track-cleanup-extents-hook)
 
 (defun default-mouse-track-cleanup-extents-hook ()
   (remove-hook 'pre-command-hook 'default-mouse-track-cleanup-extents-hook)

@@ -1089,7 +1211,8 @@ at the initial click position."
       (if (consp extent)               ; rectangle-p
          (mapcar func extent)
        (if extent
       (if (consp extent)               ; rectangle-p
          (mapcar func extent)
        (if extent

-           (funcall func extent))))))
+           (funcall func extent)))))
+  t)

 
 (defun default-mouse-track-cleanup-extent ()
   (let ((dead-func
 
 (defun default-mouse-track-cleanup-extent ()
   (let ((dead-func

@@ -1109,13 +1232,16 @@ at the initial click position."
          (setq default-mouse-track-extent nil)))))
 
 (defun default-mouse-track-drag-hook (event click-count was-timeout)
          (setq default-mouse-track-extent nil)))))
 
 (defun default-mouse-track-drag-hook (event click-count was-timeout)

-  (default-mouse-track-deal-with-down-event click-count)
-  (default-mouse-track-set-point event default-mouse-track-window)
-  (default-mouse-track-cleanup-extent)
-  (default-mouse-track-next-move default-mouse-track-min-anchor
-    default-mouse-track-max-anchor
-    default-mouse-track-extent)
-  t)
+  (cond ((default-mouse-track-event-is-with-button event 1)
+        (default-mouse-track-deal-with-down-event click-count)
+        (default-mouse-track-set-point event default-mouse-track-window)
+        (default-mouse-track-cleanup-extent)
+        (default-mouse-track-next-move default-mouse-track-min-anchor
+          default-mouse-track-max-anchor
+          default-mouse-track-extent)
+        t)
+       ((default-mouse-track-event-is-with-button event 2)
+        (mouse-begin-drag-n-drop event))))

 
 (defun default-mouse-track-return-dragged-selection (event)
   (default-mouse-track-cleanup-extent)
 
 (defun default-mouse-track-return-dragged-selection (event)
   (default-mouse-track-cleanup-extent)

@@ -1166,15 +1292,45 @@ at the initial click position."
     result))
 
 (defun default-mouse-track-drag-up-hook (event click-count)
     result))
 
 (defun default-mouse-track-drag-up-hook (event click-count)

-  (let ((result (default-mouse-track-return-dragged-selection event)))
-    (if result
-       (default-mouse-track-maybe-own-selection result 'PRIMARY)))
-  t)
+  (when (default-mouse-track-event-is-with-button event 1)
+    (let ((result (default-mouse-track-return-dragged-selection event)))
+      (if result
+         (default-mouse-track-maybe-own-selection result 'PRIMARY)))
+    t))

 
 (defun default-mouse-track-click-hook (event click-count)
 
 (defun default-mouse-track-click-hook (event click-count)

-  (default-mouse-track-drag-hook event click-count nil)
-  (default-mouse-track-drag-up-hook event click-count)
-  t)
+  (cond ((default-mouse-track-event-is-with-button event 1)
+        (if (and
+             (or (and (= click-count 1)
+                      (memq 'button1-click
+                            mouse-track-activate-strokes))
+                 (and (= click-count 2)
+                      (memq 'button1-double-click
+                            mouse-track-activate-strokes))
+                 (and (= click-count 3)
+                      (memq 'button1-triple-click
+                            mouse-track-activate-strokes)))
+             (mouse-track-do-activate event))
+            t
+          (default-mouse-track-drag-hook event click-count nil)
+          (default-mouse-track-drag-up-hook event click-count)
+          t))
+       ((default-mouse-track-event-is-with-button event 2)
+        (if (and
+             (or (and (= click-count 1)
+                      (memq 'button2-click
+                            mouse-track-activate-strokes))
+                 (and (= click-count 2)
+                      (memq 'button2-double-click
+                            mouse-track-activate-strokes))
+                 (and (= click-count 3)
+                      (memq 'button2-triple-click
+                            mouse-track-activate-strokes)))
+             (mouse-track-do-activate event))
+            t
+          (mouse-yank event)
+          t))))
+

 
 (add-hook 'mouse-track-down-hook 'default-mouse-track-down-hook)
 (add-hook 'mouse-track-drag-hook 'default-mouse-track-drag-hook)
 
 (add-hook 'mouse-track-down-hook 'default-mouse-track-down-hook)
 (add-hook 'mouse-track-drag-hook 'default-mouse-track-drag-hook)

@@ -1189,12 +1345,14 @@ at the initial click position."
 (defun mouse-track-default (event)
   "Invoke `mouse-track' with only the default handlers active."
   (interactive "e")
 (defun mouse-track-default (event)
   "Invoke `mouse-track' with only the default handlers active."
   (interactive "e")

-  (let ((mouse-track-down-hook 'default-mouse-track-down-hook)
-       (mouse-track-drag-hook 'default-mouse-track-drag-hook)
-       (mouse-track-drag-up-hook 'default-mouse-track-drag-up-hook)
-       (mouse-track-click-hook 'default-mouse-track-click-hook)
-       (mouse-track-cleanup-hook 'default-mouse-track-cleanup-hook))
-    (mouse-track event)))
+  (mouse-track event
+              '(mouse-track-down-hook
+                default-mouse-track-down-hook
+                mouse-track-up-hook nil
+                mouse-track-drag-hook default-mouse-track-drag-hook
+                mouse-track-drag-up-hook default-mouse-track-drag-up-hook
+                mouse-track-click-hook default-mouse-track-click-hook
+                mouse-track-cleanup-hook default-mouse-track-cleanup-hook)))

 
 (defun mouse-track-do-rectangle (event)
   "Like `mouse-track' but selects rectangles instead of regions."
 
 (defun mouse-track-do-rectangle (event)
   "Like `mouse-track' but selects rectangles instead of regions."

@@ -1225,37 +1383,37 @@ custom mouse-track handlers that the user may have installed."
   (let ((default-mouse-track-adjust t))
     (mouse-track-default event)))
 
   (let ((default-mouse-track-adjust t))
     (mouse-track-default event)))
 

-(defvar mouse-track-insert-selected-region nil)
-
-(defun mouse-track-insert-drag-up-hook (event click-count)
-  (setq mouse-track-insert-selected-region
-       (default-mouse-track-return-dragged-selection event)))
-

 (defun mouse-track-insert (event &optional delete)
   "Make a selection with the mouse and insert it at point.
 This is exactly the same as the `mouse-track' command on \\[mouse-track],
 except that point is not moved; the selected text is immediately inserted
 after being selected\; and the selection is immediately disowned afterwards."
   (interactive "*e")
 (defun mouse-track-insert (event &optional delete)
   "Make a selection with the mouse and insert it at point.
 This is exactly the same as the `mouse-track' command on \\[mouse-track],
 except that point is not moved; the selected text is immediately inserted
 after being selected\; and the selection is immediately disowned afterwards."
   (interactive "*e")

-  (setq mouse-track-insert-selected-region nil)
-  (let ((mouse-track-drag-up-hook 'mouse-track-insert-drag-up-hook)
-       (mouse-track-click-hook 'mouse-track-insert-click-hook)
-       s)
-    (save-excursion
-      (save-window-excursion
-       (mouse-track event)
-       (if (consp mouse-track-insert-selected-region)
-           (let ((pair mouse-track-insert-selected-region))
-             (setq s (prog1
-                         (buffer-substring (car pair) (cdr pair))
-                       (if delete
-                           (kill-region (car pair) (cdr pair)))))))))
-       (or (null s) (equal s "") (insert s))))
-
-(defun mouse-track-insert-click-hook (event click-count)
-  (default-mouse-track-drag-hook event click-count nil)
-  (mouse-track-insert-drag-up-hook event click-count)
-  t)
+  (let (s selreg)
+    (flet ((Mouse-track-insert-drag-up-hook (event count)
+            (setq selreg
+                  (default-mouse-track-return-dragged-selection event))
+            t)
+          (Mouse-track-insert-click-hook (event count)
+            (default-mouse-track-drag-hook event count nil)
+            (setq selreg
+                  (default-mouse-track-return-dragged-selection event))
+            t))
+      (save-excursion
+       (save-window-excursion
+         (mouse-track
+          event
+          '(mouse-track-drag-up-hook
+            Mouse-track-insert-drag-up-hook
+            mouse-track-click-hook
+            Mouse-track-insert-click-hook))
+         (if (consp selreg)
+             (let ((pair selreg))
+               (setq s (prog1
+                           (buffer-substring (car pair) (cdr pair))
+                         (if delete
+                             (kill-region (car pair) (cdr pair))))))))))
+    (or (null s) (equal s "") (insert s))))

 
 (defun mouse-track-delete-and-insert (event)
   "Make a selection with the mouse and insert it at point.
 
 (defun mouse-track-delete-and-insert (event)
   "Make a selection with the mouse and insert it at point.

@@ -1339,7 +1497,7 @@ and `mode-motion-hook'."
         ;; vars is a list of glyph variables to check for a pointer
         ;; value.
         (vars (cond
         ;; vars is a list of glyph variables to check for a pointer
         ;; value.
         (vars (cond

-               ;; Checking if button is non-nil is not sufficent
+               ;; Checking if button is non-nil is not sufficient

                ;; since the pointer could be over a blank portion
                ;; of the toolbar.
                ((event-over-toolbar-p event)
                ;; since the pointer could be over a blank portion
                ;; of the toolbar.
                ((event-over-toolbar-p event)

@@ -1385,6 +1543,7 @@ and `mode-motion-hook'."
     (cond ((extentp help)
            (or inhibit-help-echo
                (eq help last-help-echo-object) ;save some time
     (cond ((extentp help)
            (or inhibit-help-echo
                (eq help last-help-echo-object) ;save some time

+              (eq (selected-window) (minibuffer-window))

                (let ((hprop (extent-property help 'help-echo)))
                  (setq last-help-echo-object help)
                  (or (stringp hprop)
                (let ((hprop (extent-property help 'help-echo)))
                  (setq last-help-echo-object help)
                  (or (stringp hprop)

@@ -1395,11 +1554,12 @@ and `mode-motion-hook'."
                 (toolbar-button-enabled-p help))
           (or (not toolbar-help-enabled)
               (eq help last-help-echo-object) ;save some time
                 (toolbar-button-enabled-p help))
           (or (not toolbar-help-enabled)
               (eq help last-help-echo-object) ;save some time

+              (eq (selected-window) (minibuffer-window))

               (let ((hstring (toolbar-button-help-string button)))
                 (setq last-help-echo-object help)
                 (or (stringp hstring)
                     (setq hstring (funcall hstring help)))
               (let ((hstring (toolbar-button-help-string button)))
                 (setq last-help-echo-object help)
                 (or (stringp hstring)
                     (setq hstring (funcall hstring help)))

-                (show-help-echo hstring))))
+                (and hstring (show-help-echo hstring)))))

           (last-help-echo-object
           (clear-help-echo)))
     (if mouse-grabbed-buffer (setq buffer mouse-grabbed-buffer))
           (last-help-echo-object
           (clear-help-echo)))
     (if mouse-grabbed-buffer (setq buffer mouse-grabbed-buffer))

@@ -1425,7 +1585,7 @@ and `mode-motion-hook'."
 ;;
 (defun drag-window-divider (event)
   "Handle resizing windows by dragging window dividers.
 ;;
 (defun drag-window-divider (event)
   "Handle resizing windows by dragging window dividers.

-This is an intenal function, normally bound to button1 event in
+This is an internal function, normally bound to button1 event in

 window-divider-map. You would not call it, but you may bind it to
 other mouse buttons."
   (interactive "e")
 window-divider-map. You would not call it, but you may bind it to
 other mouse buttons."
   (interactive "e")

@@ -1479,10 +1639,10 @@ other mouse buttons."
                 (setq last-timestamp (event-timestamp event))
                 ;; Enlarge the window, calculating change in characters
                 ;; of default font. Do not let the window to become
                 (setq last-timestamp (event-timestamp event))
                 ;; Enlarge the window, calculating change in characters
                 ;; of default font. Do not let the window to become

-                ;; less than alolwed minimum (not because that's critical
+                ;; less than allowed minimum (not because that's critical

                 ;; for the code performance, just the visual effect is
                 ;; better: when cursor goes to the left of the next left
                 ;; for the code performance, just the visual effect is
                 ;; better: when cursor goes to the left of the next left

-                ;; divider, the vindow being resized shrinks to minimal
+                ;; divider, the window being resized shrinks to minimal

                 ;; size.
                 (enlarge-window (max (- window-min-width (window-width window))
                                      (/ (- (event-x-pixel event) old-right)
                 ;; size.
                 (enlarge-window (max (- window-min-width (window-width window))
                                      (/ (- (event-x-pixel event) old-right)

@@ -1492,7 +1652,7 @@ other mouse buttons."
                 ;; if the change caused more than two windows to resize
                 ;; (shifting the whole stack right is ugly), or if the
                 ;; left window side has slipped (right side cannot be
                 ;; if the change caused more than two windows to resize
                 ;; (shifting the whole stack right is ugly), or if the
                 ;; left window side has slipped (right side cannot be

-                ;; moved any funrther to the right, so enlarge-window
+                ;; moved any further to the right, so enlarge-window

                 ;; plays bad games with the left edge.
                 (if (or (/= (count-windows) (length old-edges-all-windows))
                         (/= old-left (car (window-pixel-edges window)))
                 ;; plays bad games with the left edge.
                 (if (or (/= (count-windows) (length old-edges-all-windows))
                         (/= old-left (car (window-pixel-edges window)))