X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmouse.el;h=7141595ea87472ff92a2fe3784dc4bf558346109;hb=528ca5c9afc87d2d698ce64b29cc9b069d09894f;hp=a401d3b1a17d02b9d8064b0e7deadaf4c3ad0c1b;hpb=b267e52aa03bee2c488c8a78824d96cf2d9a6ccc;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/mouse.el b/lisp/mouse.el index a401d3b..7141595 100644 --- 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) 1995, 1996 Ben Wing. +;; Copyright (C) 1995, 1996, 2000 Ben Wing. ;; Maintainer: XEmacs Development Team ;; Keywords: mouse, dumped @@ -30,6 +30,15 @@ ;; 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) @@ -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) - -;; 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." @@ -68,13 +68,13 @@ text is inserted." :group 'mouse) (defcustom mouse-highlight-text 'context - "*Choose the default double-click highlighting behaviour. + "*Choose the default double-click highlighting behavior. If set to `context', double-click will highlight words when the mouse is at a word character, or a symbol if the mouse is at a symbol character. If set to `word', double-click will always attempt to highlight a word. If set to `symbol', double-click will always attempt to highlight a - symbol (the default behaviour in previous XEmacs versions)." + symbol (the default behavior in previous XEmacs versions)." :type '(choice (const context) (const word) (const symbol)) @@ -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 () + "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) - (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) + )) (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." - ;; stig@hackvan.com (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." - ;; stig@hackvan.com (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 () - ;; by Stig@hackvan.com (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 - (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, -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 @@ -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." - ;; by Stig@hackvan.com (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) - "Narrow window to region between point and last mark" + "Narrow window to region between point and last mark." (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 -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. @@ -459,6 +495,36 @@ A value of nil disables the timeout feature." :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 @@ -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'. -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) @@ -495,7 +561,18 @@ produce a number.") '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 @@ -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. - (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, @@ -540,10 +624,10 @@ produce a number.") ;; 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 @@ -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'. +\(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 @@ -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.")) - (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 @@ -608,14 +696,17 @@ at the initial click position." (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 - (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)) @@ -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 - event mouse-track-click-count) + overriding-hooks + event mouse-track-click-count) (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 - 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))) @@ -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) - (and buffer + (and (buffer-live-p 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)))))))) ;;;;;;;;;;;; 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)) - (text-end (+ (nth 3 edges)))) + (text-end (nth 3 edges))) (if (or (< row text-start) (> row text-end)) nil ;; Scroll @@ -960,33 +1061,37 @@ at the initial click position." ;; always sufficient but it seems to give something ;; approaching a 99% success rate. Making it higher yet ;; would help guarantee success with the price that the - ;; delay would start to become noticable. + ;; delay would start to become noticeable. ;; (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) + ;; #### do we need this? we don't do it when zmacs-regions = t (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? - (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)) @@ -1066,9 +1171,26 @@ at the initial click position." (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) - (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) @@ -1089,7 +1211,8 @@ at the initial click position." (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 @@ -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) - (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) @@ -1166,15 +1292,45 @@ at the initial click position." 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) - (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) @@ -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") - (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." @@ -1225,37 +1383,37 @@ custom mouse-track handlers that the user may have installed." (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") - (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. @@ -1339,7 +1497,7 @@ and `mode-motion-hook'." ;; 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) @@ -1385,6 +1543,7 @@ and `mode-motion-hook'." (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) @@ -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 + (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))) - (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)) @@ -1425,7 +1585,7 @@ and `mode-motion-hook'." ;; (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") @@ -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 - ;; 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 - ;; 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) @@ -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 - ;; 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)))