X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/397a88f3c99cadf431c9c9218359f71b4434af31..ae2777b77ab61c109b92e0b7fd00fc56f9afb61f:/lisp/mouse.el diff --git a/lisp/mouse.el b/lisp/mouse.el index 410a9ff6b1..be76012649 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -49,6 +49,8 @@ ;; Switch to the window clicked on, because otherwise ;; the mode's commands may not make sense. (interactive "@e\nP") + ;; Let the mode update its menus first. + (run-hooks 'activate-menubar-hook) (let (;; This is where mouse-major-mode-menu-prefix ;; returns the prefix we should use (after menu-bar). ;; It is either nil or (SOME-SYMBOL). @@ -121,10 +123,13 @@ (defun mouse-delete-window (click) "Delete the window you click on. -This must be bound to a mouse click." +If the frame has just one window, bury the current buffer instead. +This command must be bound to a mouse click." (interactive "e") - (mouse-minibuffer-check click) - (delete-window (posn-window (event-start click)))) + (if (one-window-p t) + (bury-buffer) + (mouse-minibuffer-check click) + (delete-window (posn-window (event-start click))))) (defun mouse-select-window (click) "Select the window clicked on; don't move point." @@ -300,18 +305,24 @@ This command must be bound to a mouse click." (interactive "e") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) - (let ((done nil) - (echo-keystrokes 0) - (start-event-frame (window-frame (car (car (cdr start-event))))) - (start-event-window (car (car (cdr start-event)))) - (start-nwindows (count-windows t)) - (old-selected-window (selected-window)) - event mouse x left right edges wconfig growth) + (let* ((done nil) + (echo-keystrokes 0) + (start-event-frame (window-frame (car (car (cdr start-event))))) + (start-event-window (car (car (cdr start-event)))) + (start-nwindows (count-windows t)) + (old-selected-window (selected-window)) + event mouse x left right edges wconfig growth + (which-side + (or (cdr (assq 'vertical-scroll-bars (frame-parameters start-event-frame))) + 'right))) (if (one-window-p t) (error "Attempt to resize sole ordinary window")) - (if (= (nth 2 (window-edges start-event-window)) - (frame-width start-event-frame)) - (error "Attempt to drag rightmost scrollbar")) + (if (eq which-side 'left) + (if (= (nth 0 (window-edges start-event-window)) 0) + (error "Attempt to drag leftmost scrollbar")) + (if (= (nth 2 (window-edges start-event-window)) + (frame-width start-event-frame)) + (error "Attempt to drag rightmost scrollbar"))) (track-mouse (progn ;; enlarge-window only works on the selected window, so @@ -349,28 +360,34 @@ This command must be bound to a mouse click." ((null (car (cdr mouse))) nil) (t - (setq x (car (cdr mouse)) - edges (window-edges) - left (nth 0 edges) - right (nth 2 edges)) - ;; scale back a move that would make the - ;; window too thin. - (cond ((< (- x left -1) window-min-width) - (setq x (+ left window-min-width -1)))) - ;; compute size change needed - (setq growth (- x right -1) - wconfig (current-window-configuration)) - (enlarge-window growth t) - ;; if this window's growth caused another - ;; window to be deleted because it was too - ;; thin, rescind the change. - ;; - ;; if size change caused space to be stolen - ;; from a window to the left of this one, - ;; rescind the change. - (if (or (/= start-nwindows (count-windows t)) - (/= left (nth 0 (window-edges)))) - (set-window-configuration wconfig))))))))) + (save-selected-window + ;; If the scroll bar is on the window's left, + ;; adjust the window on the left. + (if (eq which-side 'left) + (select-window (previous-window))) + (setq x (- (car (cdr mouse)) + (if (eq which-side 'left) 2 0)) + edges (window-edges) + left (nth 0 edges) + right (nth 2 edges)) + ;; scale back a move that would make the + ;; window too thin. + (if (< (- x left -1) window-min-width) + (setq x (+ left window-min-width -1))) + ;; compute size change needed + (setq growth (- x right -1) + wconfig (current-window-configuration)) + (enlarge-window growth t) + ;; if this window's growth caused another + ;; window to be deleted because it was too + ;; thin, rescind the change. + ;; + ;; if size change caused space to be stolen + ;; from a window to the left of this one, + ;; rescind the change. + (if (or (/= start-nwindows (count-windows t)) + (/= left (nth 0 (window-edges)))) + (set-window-configuration wconfig)))))))))) (defun mouse-set-point (event) "Move point to the position clicked on with the mouse. @@ -419,7 +436,7 @@ This should be bound to a mouse drag event." ;; Don't set this-command to kill-region, so that a following ;; C-w will not double the text in the kill ring. ;; Ignore last-command so we don't append to a preceding kill. - (let (this-command last-command) + (let (this-command last-command deactivate-mark) (copy-region-as-kill (mark) (point))) (mouse-set-region-1))) @@ -466,11 +483,13 @@ Upon exit, point is at the far edge of the newly visible text." (progn (set-window-start window (point)) (if (natnump jump) - (progn - (goto-char (window-end window)) - ;; window-end doesn't reflect the window's new - ;; start position until the next redisplay. Hurrah. - (vertical-motion (1- jump) window)) + (if (window-end window) + (progn + (goto-char (window-end window)) + ;; window-end doesn't reflect the window's new + ;; start position until the next redisplay. + (vertical-motion (1- jump) window)) + (vertical-motion (- (window-height window) 2))) (goto-char (window-start window))) (if overlay (move-overlay overlay start (point))) @@ -573,52 +592,44 @@ remains active. Otherwise, it remains until the next input event." ;; Run the binding of the terminating up-event, if possible. ;; In the case of a multiple click, it gives the wrong results, ;; because it would fail to set up a region. - (if nil ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun)) - ;; In this case, we can just let the up-event execute normally. - (let ((end (event-end event))) - ;; Set the position in the event before we replay it, - ;; because otherwise it may have a position in the wrong - ;; buffer. - (setcar (cdr end) end-of-range) - ;; Delete the overlay before calling the function, - ;; because delete-overlay increases buffer-modified-tick. - (delete-overlay mouse-drag-overlay) - (setq unread-command-events - (cons event unread-command-events))) - (if (not (= (overlay-start mouse-drag-overlay) + (if (not (= (overlay-start mouse-drag-overlay) + (overlay-end mouse-drag-overlay))) + (let* ((stop-point + (if (numberp (posn-point (event-end event))) + (posn-point (event-end event)) + last-end-point)) + ;; The end that comes from where we ended the drag. + ;; Point goes here. + (region-termination + (if (and stop-point (< stop-point start-point)) + (overlay-start mouse-drag-overlay) (overlay-end mouse-drag-overlay))) - (let* ((stop-point - (if (numberp (posn-point (event-end event))) - (posn-point (event-end event)) - last-end-point)) - ;; The end that comes from where we ended the drag. - ;; Point goes here. - (region-termination - (if (and stop-point (< stop-point start-point)) - (overlay-start mouse-drag-overlay) - (overlay-end mouse-drag-overlay))) - ;; The end that comes from where we started the drag. - ;; Mark goes there. - (region-commencement - (- (+ (overlay-end mouse-drag-overlay) - (overlay-start mouse-drag-overlay)) - region-termination)) - last-command this-command) - (push-mark region-commencement t t) - (goto-char region-termination) - (copy-region-as-kill (point) (mark t)) - (let ((buffer (current-buffer))) - (mouse-show-mark) - ;; mouse-show-mark can call read-event, - ;; and that means the Emacs server could switch buffers - ;; under us. If that happened, - ;; avoid trying to use the region. - (and (mark t) mark-active - (eq buffer (current-buffer)) - (mouse-set-region-1)))) - (goto-char (overlay-end mouse-drag-overlay)) - (setq this-command 'mouse-set-point) - (delete-overlay mouse-drag-overlay)))) + ;; The end that comes from where we started the drag. + ;; Mark goes there. + (region-commencement + (- (+ (overlay-end mouse-drag-overlay) + (overlay-start mouse-drag-overlay)) + region-termination)) + last-command this-command) + (push-mark region-commencement t t) + (goto-char region-termination) + ;; Don't let copy-region-as-kill set deactivate-mark. + (let (deactivate-mark) + (copy-region-as-kill (point) (mark t))) + (let ((buffer (current-buffer))) + (mouse-show-mark) + ;; mouse-show-mark can call read-event, + ;; and that means the Emacs server could switch buffers + ;; under us. If that happened, + ;; avoid trying to use the region. + (and (mark t) mark-active + (eq buffer (current-buffer)) + (mouse-set-region-1)))) + (delete-overlay mouse-drag-overlay) + ;; Run the binding of the terminating up-event. + (if (fboundp fun) + (setq unread-command-events + (cons event unread-command-events))))) (delete-overlay mouse-drag-overlay))))) ;; Commands to handle xterm-style multiple clicks. @@ -628,7 +639,18 @@ remains active. Otherwise, it remains until the next input event." If DIR is positive skip forward; if negative, skip backward." (let* ((char (following-char)) (syntax (char-to-string (char-syntax char)))) - (cond ((or (string= syntax "w") (string= syntax " ")) + (cond ((string= syntax "w") + ;; Here, we can't use skip-syntax-forward/backward because + ;; they don't pay attention to word-separating-categories, + ;; and thus they will skip over a true word boundary. So, + ;; we simularte the original behaviour by using + ;; forward-word. + (if (< dir 0) + (if (not (looking-at "\\<")) + (forward-word -1)) + (if (or (looking-at "\\<") (not (looking-at "\\>"))) + (forward-word 1)))) + ((string= syntax " ") (if (< dir 0) (skip-syntax-backward syntax) (skip-syntax-forward syntax))) @@ -736,7 +758,9 @@ If DIR is positive skip forward; if negative, skip backward." (modifiers (delq 'double (delq 'triple (copy-sequence old-modifiers)))) (new (if (consp event) - (cons (event-convert-list (nreverse (cons basic old-modifiers))) + ;; Use reverse, not nreverse, since event-modifiers + ;; does not copy the list it returns. + (cons (event-convert-list (reverse (cons basic modifiers))) (cdr event)) event))) (setcar last new) @@ -767,12 +791,14 @@ If DIR is positive skip forward; if negative, skip backward." (throw 'mouse-show-mark t))))) (move-overlay mouse-drag-overlay (point) (mark t)) (catch 'mouse-show-mark - ;; In this loop, read and execute scroll bar events. - ;; Otherwise, if we + ;; 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)) @@ -780,8 +806,9 @@ If DIR is positive skip forward; if negative, skip backward." (not (mouse-undouble-last-event events)) (not (member key mouse-region-delete-keys))))) (and (consp event) - (eq (posn-point (event-end event)) - 'vertical-scroll-bar) + (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 @@ -911,7 +938,9 @@ selection through the word or line clicked on. If you do this again in a different position, it extends the selection again. If you do this twice in the same position, the selection is killed." (interactive "e") - (let ((before-scroll point-before-scroll)) + (let ((before-scroll + (with-current-buffer (window-buffer (posn-window (event-start click))) + point-before-scroll))) (mouse-minibuffer-check click) (let ((click-posn (posn-point (event-start click))) ;; Don't let a subsequent kill command append to this one: @@ -1270,8 +1299,9 @@ again. If you do this twice in the same position, it kills the selection." (kill-new (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay)) t) - (copy-region-as-kill (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay)))) + (let (deactivate-mark) + (copy-region-as-kill (overlay-start mouse-secondary-overlay) + (overlay-end mouse-secondary-overlay))))) (if mouse-secondary-start ;; All we have is one end of a selection, ;; so put the other end here. @@ -1289,13 +1319,24 @@ again. If you do this twice in the same position, it kills the selection." (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay))))))) -(defcustom mouse-menu-buffer-maxlen 20 +(defcustom mouse-buffer-menu-maxlen 20 "*Number of buffers in one pane (submenu) of the buffer menu. If we have lots of buffers, divide them into groups of -`mouse-menu-buffer-maxlen' and make a pane (or submenu) for each one." +`mouse-buffer-menu-maxlen' and make a pane (or submenu) for each one." :type 'integer :group 'mouse) +(defcustom mouse-buffer-menu-mode-mult 4 + "*Group the buffers by the major mode groups on \\[mouse-buffer-menu]? +This number which determines (in a hairy way) whether \\[mouse-buffer-menu] +will split the buffer menu by the major modes (see +`mouse-buffer-menu-mode-groups') or just by menu length. +Set to 1 (or even 0!) if you want to group by major mode always, and to +a large number if you prefer a mixed multitude. The default is 4." + :type 'integer + :group 'mouse + :version "20.3") + (defvar mouse-buffer-menu-mode-groups '(("Info\\|Help\\|Apropos\\|Man" . "Help") ("\\bVM\\b\\|\\bMH\\b\\|Message\\|Mail\\|Group\\|Score\\|Summary\\|Article" @@ -1315,8 +1356,7 @@ This switches buffers in the window that you clicked on, and selects that window." (interactive "e") (mouse-minibuffer-check event) - (let (buffers alist menu split-by-major-mode sum-of-squares) - (setq buffers (buffer-list)) + (let ((buffers (buffer-list)) alist menu split-by-major-mode sum-of-squares) ;; Make an alist of elements that look like (MENU-ITEM . BUFFER). (let ((tail buffers)) (while tail @@ -1345,10 +1385,10 @@ and selects that window." (while tail (setq sum-of-squares (+ sum-of-squares - (* (length (cdr (cdr (car tail)))) - (length (cdr (cdr (car tail))))))) + (let ((len (length (cdr (cdr (car tail)))))) (* len len)))) (setq tail (cdr tail)))) - (if (< (* sum-of-squares 4) (* (length buffers) (length buffers))) + (if (< (* sum-of-squares mouse-buffer-menu-mode-mult) + (* (length buffers) (length buffers))) ;; Subdividing by major modes really helps, so let's do it. (let (subdivided-menus (buffers-left (length buffers))) ;; Sort the list to put the most popular major modes first. @@ -1378,23 +1418,20 @@ and selects that window." (cons (cons "Others" (mouse-buffer-menu-alist - (apply 'append - (mapcar 'cdr - (mapcar 'cdr split-by-major-mode))))) + ;; we don't need split-by-major-mode any + ;; more, so we can ditch it with nconc. + (apply 'nconc (mapcar 'cddr split-by-major-mode)))) subdivided-menus))) - (setq subdivided-menus - (nreverse subdivided-menus)) - (setq menu (cons "Buffer Menu" subdivided-menus))) + (setq menu (cons "Buffer Menu" (nreverse subdivided-menus)))) (progn (setq alist (mouse-buffer-menu-alist buffers)) (setq menu (cons "Buffer Menu" (mouse-buffer-menu-split "Select Buffer" alist))))) (let ((buf (x-popup-menu event menu)) (window (posn-window (event-start event)))) - (if buf - (progn + (when buf (or (framep window) (select-window window)) - (switch-to-buffer buf)))))) + (switch-to-buffer buf))))) (defun mouse-buffer-menu-alist (buffers) (let (tail @@ -1441,15 +1478,15 @@ and selects that window." (defun mouse-buffer-menu-split (title alist) ;; If we have lots of buffers, divide them into groups of 20 ;; and make a pane (or submenu) for each one. - (if (> (length alist) (/ (* mouse-menu-buffer-maxlen 3) 2)) + (if (> (length alist) (/ (* mouse-buffer-menu-maxlen 3) 2)) (let ((alist alist) sublists next (i 1)) (while alist - ;; Pull off the next mouse-menu-buffer-maxlen buffers + ;; Pull off the next mouse-buffer-menu-maxlen buffers ;; and make them the next element of sublist. - (setq next (nthcdr mouse-menu-buffer-maxlen alist)) + (setq next (nthcdr mouse-buffer-menu-maxlen alist)) (if next - (setcdr (nthcdr (1- mouse-menu-buffer-maxlen) alist) + (setcdr (nthcdr (1- mouse-buffer-menu-maxlen) alist) nil)) (setq sublists (cons (cons (format "Buffers %d" i) alist) sublists))