LCOV - code coverage report
Current view: top level - lisp - mouse.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 0 1285 0.0 %
Date: 2017-08-30 10:12:24 Functions: 0 83 0.0 %

          Line data    Source code
       1             : ;;; mouse.el --- window system-independent mouse support  -*- lexical-binding: t -*-
       2             : 
       3             : ;; Copyright (C) 1993-1995, 1999-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Maintainer: emacs-devel@gnu.org
       6             : ;; Keywords: hardware, mouse
       7             : ;; Package: emacs
       8             : 
       9             : ;; This file is part of GNU Emacs.
      10             : 
      11             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      12             : ;; it under the terms of the GNU General Public License as published by
      13             : ;; the Free Software Foundation, either version 3 of the License, or
      14             : ;; (at your option) any later version.
      15             : 
      16             : ;; GNU Emacs is distributed in the hope that it will be useful,
      17             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      18             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      19             : ;; GNU General Public License for more details.
      20             : 
      21             : ;; You should have received a copy of the GNU General Public License
      22             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      23             : 
      24             : ;;; Commentary:
      25             : 
      26             : ;; This package provides various useful commands (including help
      27             : ;; system access) through the mouse.  All this code assumes that mouse
      28             : ;; interpretation has been abstracted into Emacs input events.
      29             : 
      30             : ;;; Code:
      31             : 
      32             : ;;; Utility functions.
      33             : 
      34             : ;; Indent track-mouse like progn.
      35             : (put 'track-mouse 'lisp-indent-function 0)
      36             : 
      37             : (defgroup mouse nil
      38             :   "Input from the mouse."  ;; "Mouse support."
      39             :   :group 'environment
      40             :   :group 'editing)
      41             : 
      42             : (defcustom mouse-yank-at-point nil
      43             :   "If non-nil, mouse yank commands yank at point instead of at click."
      44             :   :type 'boolean
      45             :   :group 'mouse)
      46             : 
      47             : (defcustom mouse-drag-copy-region nil
      48             :   "If non-nil, copy to kill-ring upon mouse adjustments of the region.
      49             : 
      50             : This affects `mouse-save-then-kill' (\\[mouse-save-then-kill]) in
      51             : addition to mouse drags."
      52             :   :type 'boolean
      53             :   :version "24.1"
      54             :   :group 'mouse)
      55             : 
      56             : (defcustom mouse-1-click-follows-link 450
      57             :   "Non-nil means that clicking Mouse-1 on a link follows the link.
      58             : 
      59             : With the default setting, an ordinary Mouse-1 click on a link
      60             : performs the same action as Mouse-2 on that link, while a longer
      61             : Mouse-1 click \(hold down the Mouse-1 button for more than 450
      62             : milliseconds) performs the original Mouse-1 binding \(which
      63             : typically sets point where you click the mouse).
      64             : 
      65             : If value is an integer, the time elapsed between pressing and
      66             : releasing the mouse button determines whether to follow the link
      67             : or perform the normal Mouse-1 action (typically set point).
      68             : The absolute numeric value specifies the maximum duration of a
      69             : \"short click\" in milliseconds.  A positive value means that a
      70             : short click follows the link, and a longer click performs the
      71             : normal action.  A negative value gives the opposite behavior.
      72             : 
      73             : If value is `double', a double click follows the link.
      74             : 
      75             : Otherwise, a single Mouse-1 click unconditionally follows the link.
      76             : 
      77             : Note that dragging the mouse never follows the link.
      78             : 
      79             : This feature only works in modes that specifically identify
      80             : clickable text as links, so it may not work with some external
      81             : packages.  See `mouse-on-link-p' for details."
      82             :   :version "22.1"
      83             :   :type '(choice (const :tag "Disabled" nil)
      84             :                  (const :tag "Double click" double)
      85             :                  (number :tag "Single click time limit" :value 450)
      86             :                  (other :tag "Single click" t))
      87             :   :group 'mouse)
      88             : 
      89             : (defcustom mouse-1-click-in-non-selected-windows t
      90             :   "If non-nil, a Mouse-1 click also follows links in non-selected windows.
      91             : 
      92             : If nil, a Mouse-1 click on a link in a non-selected window performs
      93             : the normal mouse-1 binding, typically selects the window and sets
      94             : point at the click position."
      95             :   :type 'boolean
      96             :   :version "22.1"
      97             :   :group 'mouse)
      98             : 
      99             : (defun mouse--down-1-maybe-follows-link (&optional _prompt)
     100             :   "Turn `mouse-1' events into `mouse-2' events if follows-link.
     101             : Expects to be bound to `down-mouse-1' in `key-translation-map'."
     102           0 :   (when (and mouse-1-click-follows-link
     103           0 :              (eq (if (eq mouse-1-click-follows-link 'double)
     104           0 :                      'double-down-mouse-1 'down-mouse-1)
     105           0 :                  (car-safe last-input-event)))
     106           0 :     (let ((action (mouse-on-link-p (event-start last-input-event))))
     107           0 :       (when (and action
     108           0 :                  (or mouse-1-click-in-non-selected-windows
     109           0 :                      (eq (selected-window)
     110           0 :                          (posn-window (event-start last-input-event)))))
     111           0 :         (let ((timedout
     112           0 :                (sit-for (if (numberp mouse-1-click-follows-link)
     113           0 :                             (/ (abs mouse-1-click-follows-link) 1000.0)
     114           0 :                           0))))
     115           0 :           (if (if (and (numberp mouse-1-click-follows-link)
     116           0 :                        (>= mouse-1-click-follows-link 0))
     117           0 :                   timedout (not timedout))
     118             :               nil
     119             :             ;; Use read-key so it works for xterm-mouse-mode!
     120           0 :             (let ((event (read-key)))
     121           0 :               (if (eq (car-safe event)
     122           0 :                       (if (eq mouse-1-click-follows-link 'double)
     123           0 :                           'double-mouse-1 'mouse-1))
     124           0 :                   (progn
     125             :                     ;; Turn the mouse-1 into a mouse-2 to follow links,
     126             :                     ;; but only if ‘mouse-on-link-p’ hasn’t returned a
     127             :                     ;; string or vector (see its docstring).
     128           0 :                     (if (or (stringp action) (vectorp action))
     129           0 :                         (push (aref action 0) unread-command-events)
     130           0 :                       (let ((newup (if (eq mouse-1-click-follows-link 'double)
     131           0 :                                        'double-mouse-2 'mouse-2)))
     132             :                         ;; If mouse-2 has never been done by the user, it
     133             :                         ;; doesn't have the necessary property to be
     134             :                         ;; interpreted correctly.
     135           0 :                         (unless (get newup 'event-kind)
     136           0 :                           (put newup 'event-kind (get (car event) 'event-kind)))
     137           0 :                         (push (cons newup (cdr event)) unread-command-events)))
     138             :                     ;; Don't change the down event, only the up-event
     139             :                     ;; (bug#18212).
     140           0 :                     nil)
     141           0 :                 (push event unread-command-events)
     142           0 :                 nil))))))))
     143             : 
     144             : (define-key key-translation-map [down-mouse-1]
     145             :   #'mouse--down-1-maybe-follows-link)
     146             : (define-key key-translation-map [double-down-mouse-1]
     147             :   #'mouse--down-1-maybe-follows-link)
     148             : 
     149             : 
     150             : ;; Provide a mode-specific menu on a mouse button.
     151             : 
     152             : (defun minor-mode-menu-from-indicator (indicator)
     153             :   "Show menu for minor mode specified by INDICATOR.
     154             : Interactively, INDICATOR is read using completion.
     155             : If there is no menu defined for the minor mode, then create one with
     156             : items `Turn Off' and `Help'."
     157             :   (interactive
     158           0 :    (list (completing-read
     159             :           "Minor mode indicator: "
     160           0 :           (describe-minor-mode-completion-table-for-indicator))))
     161           0 :   (let* ((minor-mode (lookup-minor-mode-from-indicator indicator))
     162           0 :          (mm-fun (or (get minor-mode :minor-mode-function) minor-mode)))
     163           0 :     (unless minor-mode (error "Cannot find minor mode for `%s'" indicator))
     164           0 :     (let* ((map (cdr-safe (assq minor-mode minor-mode-map-alist)))
     165           0 :            (menu (and (keymapp map) (lookup-key map [menu-bar]))))
     166           0 :       (setq menu
     167           0 :             (if menu
     168           0 :                 (mouse-menu-non-singleton menu)
     169           0 :               (if (fboundp mm-fun)      ; bug#20201
     170           0 :                   `(keymap
     171           0 :                     ,indicator
     172           0 :                     (turn-off menu-item "Turn off minor mode" ,mm-fun)
     173             :                     (help menu-item "Help for minor mode"
     174             :                           (lambda () (interactive)
     175           0 :                             (describe-function ',mm-fun)))))))
     176           0 :       (if menu
     177           0 :           (popup-menu menu)
     178           0 :         (message "No menu available")))))
     179             : 
     180             : (defun mouse-minor-mode-menu (event)
     181             :   "Show minor-mode menu for EVENT on minor modes area of the mode line."
     182             :   (interactive "@e")
     183           0 :   (let ((indicator (car (nth 4 (car (cdr event))))))
     184           0 :     (minor-mode-menu-from-indicator indicator)))
     185             : 
     186             : (defun mouse-menu-major-mode-map ()
     187           0 :   (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
     188           0 :   (let* (;; Keymap from which to inherit; may be null.
     189           0 :          (ancestor (mouse-menu-non-singleton
     190           0 :                     (and (current-local-map)
     191           0 :                          (local-key-binding [menu-bar]))))
     192             :          ;; Make a keymap in which our last command leads to a menu or
     193             :          ;; default to the edit menu.
     194           0 :          (newmap (if ancestor
     195           0 :                      (make-sparse-keymap (concat (format-mode-line mode-name)
     196           0 :                                                  " Mode"))
     197           0 :                    menu-bar-edit-menu)))
     198           0 :     (if ancestor
     199           0 :         (set-keymap-parent newmap ancestor))
     200           0 :     newmap))
     201             : 
     202             : (defun mouse-menu-non-singleton (menubar)
     203             :   "Return menu keybar MENUBAR, or a lone submenu inside it.
     204             : If MENUBAR defines exactly one submenu, return just that submenu.
     205             : Otherwise, return MENUBAR."
     206           0 :   (if menubar
     207           0 :       (let (submap)
     208           0 :         (map-keymap
     209           0 :          (lambda (k v) (setq submap (if submap t (cons k v))))
     210           0 :          (keymap-canonicalize menubar))
     211           0 :         (if (eq submap t)
     212           0 :             menubar
     213           0 :           (lookup-key menubar (vector (car submap)))))))
     214             : 
     215             : (defun mouse-menu-bar-map ()
     216             :   "Return a keymap equivalent to the menu bar.
     217             : The contents are the items that would be in the menu bar whether or
     218             : not it is actually displayed."
     219           0 :   (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
     220           0 :   (let* ((local-menu (and (current-local-map)
     221           0 :                           (lookup-key (current-local-map) [menu-bar])))
     222           0 :          (global-menu (lookup-key global-map [menu-bar]))
     223             :          ;; If a keymap doesn't have a prompt string (a lazy
     224             :          ;; programmer didn't bother to provide one), create it and
     225             :          ;; insert it into the keymap; each keymap gets its own
     226             :          ;; prompt.  This is required for non-toolkit versions to
     227             :          ;; display non-empty menu pane names.
     228             :          (minor-mode-menus
     229           0 :           (mapcar
     230             :            (lambda (menu)
     231           0 :              (let* ((minor-mode (car menu))
     232           0 :                     (menu (cdr menu))
     233           0 :                     (title-or-map (cadr menu)))
     234           0 :                (or (stringp title-or-map)
     235           0 :                    (setq menu
     236           0 :                          (cons 'keymap
     237           0 :                                (cons (concat
     238           0 :                                       (capitalize (subst-char-in-string
     239           0 :                                                    ?- ?\s (symbol-name
     240           0 :                                                            minor-mode)))
     241           0 :                                       " Menu")
     242           0 :                                      (cdr menu)))))
     243           0 :                menu))
     244           0 :            (minor-mode-key-binding [menu-bar])))
     245           0 :          (local-title-or-map (and local-menu (cadr local-menu)))
     246           0 :          (global-title-or-map (cadr global-menu)))
     247           0 :     (or (null local-menu)
     248           0 :         (stringp local-title-or-map)
     249           0 :         (setq local-menu (cons 'keymap
     250           0 :                                (cons (concat (format-mode-line mode-name)
     251           0 :                                              " Mode Menu")
     252           0 :                                      (cdr local-menu)))))
     253           0 :     (or (stringp global-title-or-map)
     254           0 :         (setq global-menu (cons 'keymap
     255           0 :                                 (cons "Global Menu"
     256           0 :                                       (cdr global-menu)))))
     257             :     ;; Supplying the list is faster than making a new map.
     258             :     ;; FIXME: We have a problem here: we have to use the global/local/minor
     259             :     ;; so they're displayed in the expected order, but later on in the command
     260             :     ;; loop, they're actually looked up in the opposite order.
     261           0 :     (apply 'append
     262           0 :            global-menu
     263           0 :            local-menu
     264           0 :            minor-mode-menus)))
     265             : 
     266             : (defun mouse-major-mode-menu (event &optional prefix)
     267             :   "Pop up a mode-specific menu of mouse commands.
     268             : Default to the Edit menu if the major mode doesn't define a menu."
     269             :   (declare (obsolete mouse-menu-major-mode-map "23.1"))
     270             :   (interactive "@e\nP")
     271           0 :   (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
     272           0 :   (popup-menu (mouse-menu-major-mode-map) event prefix))
     273             : 
     274             : (defun mouse-popup-menubar (event prefix)
     275             :   "Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX.
     276             : The contents are the items that would be in the menu bar whether or
     277             : not it is actually displayed."
     278             :   (declare (obsolete mouse-menu-bar-map "23.1"))
     279             :   (interactive "@e \nP")
     280           0 :   (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
     281           0 :   (popup-menu (mouse-menu-bar-map) (unless (integerp event) event) prefix))
     282             : 
     283             : (defun mouse-popup-menubar-stuff (event prefix)
     284             :   "Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'.
     285             : Use the former if the menu bar is showing, otherwise the latter."
     286             :   (declare (obsolete nil "23.1"))
     287             :   (interactive "@e\nP")
     288           0 :   (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
     289           0 :   (popup-menu
     290           0 :    (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))
     291           0 :        (mouse-menu-bar-map)
     292           0 :      (mouse-menu-major-mode-map))
     293           0 :    event prefix))
     294             : 
     295             : ;; Commands that operate on windows.
     296             : 
     297             : (defun mouse-minibuffer-check (event)
     298           0 :   (let ((w (posn-window (event-start event))))
     299           0 :     (and (window-minibuffer-p w)
     300           0 :          (not (minibuffer-window-active-p w))
     301           0 :          (user-error "Minibuffer window is not active")))
     302             :   ;; Give temporary modes such as isearch a chance to turn off.
     303           0 :   (run-hooks 'mouse-leave-buffer-hook))
     304             : 
     305             : (defun mouse-delete-window (click)
     306             :   "Delete the window you click on.
     307             : Do nothing if the frame has just one window.
     308             : This command must be bound to a mouse click."
     309             :   (interactive "e")
     310           0 :   (unless (one-window-p t)
     311           0 :     (mouse-minibuffer-check click)
     312           0 :     (delete-window (posn-window (event-start click)))))
     313             : 
     314             : (defun mouse-select-window (click)
     315             :   "Select the window clicked on; don't move point."
     316             :   (interactive "e")
     317           0 :   (mouse-minibuffer-check click)
     318           0 :   (let ((oframe (selected-frame))
     319           0 :         (frame (window-frame (posn-window (event-start click)))))
     320           0 :     (select-window (posn-window (event-start click)))
     321           0 :     (raise-frame frame)
     322           0 :     (select-frame frame)
     323           0 :     (or (eq frame oframe)
     324           0 :         (set-mouse-position (selected-frame) (1- (frame-width)) 0))))
     325             : 
     326             : (define-obsolete-function-alias 'mouse-tear-off-window 'tear-off-window "24.4")
     327             : (defun tear-off-window (click)
     328             :   "Delete the selected window, and create a new frame displaying its buffer."
     329             :   (interactive "e")
     330           0 :   (mouse-minibuffer-check click)
     331           0 :   (let* ((window (posn-window (event-start click)))
     332           0 :          (buf (window-buffer window))
     333           0 :          (frame (make-frame)))          ;FIXME: Use pop-to-buffer.
     334           0 :     (select-frame frame)
     335           0 :     (switch-to-buffer buf)
     336           0 :     (delete-window window)))
     337             : 
     338             : (defun mouse-delete-other-windows ()
     339             :   "Delete all windows except the one you click on."
     340             :   (interactive "@")
     341           0 :   (delete-other-windows))
     342             : 
     343             : (defun mouse-split-window-vertically (click)
     344             :   "Select Emacs window mouse is on, then split it vertically in half.
     345             : The window is split at the line clicked on.
     346             : This command must be bound to a mouse click."
     347             :   (interactive "@e")
     348           0 :   (mouse-minibuffer-check click)
     349           0 :   (let ((start (event-start click)))
     350           0 :     (select-window (posn-window start))
     351           0 :     (let ((new-height (1+ (cdr (posn-col-row (event-end click)))))
     352           0 :           (first-line window-min-height)
     353           0 :           (last-line (- (window-height) window-min-height)))
     354           0 :       (if (< last-line first-line)
     355           0 :           (user-error "Window too short to split")
     356             :         ;; Bind `window-combination-resize' to nil so we are sure to get
     357             :         ;; the split right at the line clicked on.
     358           0 :         (let (window-combination-resize)
     359           0 :           (split-window-vertically
     360           0 :            (min (max new-height first-line) last-line)))))))
     361             : 
     362             : (defun mouse-split-window-horizontally (click)
     363             :   "Select Emacs window mouse is on, then split it horizontally in half.
     364             : The window is split at the column clicked on.
     365             : This command must be bound to a mouse click."
     366             :   (interactive "@e")
     367           0 :   (mouse-minibuffer-check click)
     368           0 :   (let ((start (event-start click)))
     369           0 :     (select-window (posn-window start))
     370           0 :     (let ((new-width (1+ (car (posn-col-row (event-end click)))))
     371           0 :           (first-col window-min-width)
     372           0 :           (last-col (- (window-width) window-min-width)))
     373           0 :       (if (< last-col first-col)
     374           0 :           (user-error "Window too narrow to split")
     375             :         ;; Bind `window-combination-resize' to nil so we are sure to get
     376             :         ;; the split right at the column clicked on.
     377           0 :         (let (window-combination-resize)
     378           0 :           (split-window-horizontally
     379           0 :            (min (max new-width first-col) last-col)))))))
     380             : 
     381             : (defun mouse-drag-line (start-event line)
     382             :   "Drag a mode line, header line, or vertical line with the mouse.
     383             : START-EVENT is the starting mouse event of the drag action.  LINE
     384             : must be one of the symbols `header', `mode', or `vertical'."
     385             :   ;; Give temporary modes such as isearch a chance to turn off.
     386           0 :   (run-hooks 'mouse-leave-buffer-hook)
     387           0 :   (let* ((echo-keystrokes 0)
     388           0 :          (start (event-start start-event))
     389           0 :          (window (posn-window start))
     390           0 :          (frame (window-frame window))
     391             :          ;; `position' records the x- or y-coordinate of the last
     392             :          ;; sampled position.
     393           0 :          (position (if (eq line 'vertical)
     394           0 :                        (+ (window-pixel-left window)
     395           0 :                           (car (posn-x-y start)))
     396           0 :                      (+ (window-pixel-top window)
     397           0 :                         (cdr (posn-x-y start)))))
     398             :          ;; `last-position' records the x- or y-coordinate of the
     399             :          ;; previously sampled position.  The difference of `position'
     400             :          ;; and `last-position' determines the size change of WINDOW.
     401           0 :          (last-position position)
     402             :          (draggable t)
     403             :          posn-window growth dragged)
     404             :     ;; Decide on whether we are allowed to track at all and whose
     405             :     ;; window's edge we drag.
     406           0 :     (cond
     407           0 :      ((eq line 'header)
     408             :       ;; Drag bottom edge of window above the header line.
     409           0 :       (setq window (window-in-direction 'above window t)))
     410           0 :      ((eq line 'mode))
     411           0 :      ((eq line 'vertical)
     412           0 :       (let ((divider-width (frame-right-divider-width frame)))
     413           0 :         (when (and (or (not (numberp divider-width))
     414           0 :                        (zerop divider-width))
     415           0 :                    (eq (frame-parameter frame 'vertical-scroll-bars) 'left))
     416           0 :           (setq window (window-in-direction 'left window t))))))
     417           0 :     (let* ((exitfun nil)
     418             :            (move
     419             :             (lambda (event) (interactive "e")
     420           0 :               (cond
     421           0 :                ((not (consp event))
     422             :                 nil)
     423           0 :                ((eq line 'vertical)
     424             :                 ;; Drag right edge of `window'.
     425           0 :                 (setq start (event-start event))
     426           0 :                 (setq position (car (posn-x-y start)))
     427             :                 ;; Set `posn-window' to the window where `event' was recorded.
     428             :                 ;; This can be `window' or the window on the left or right of
     429             :                 ;; `window'.
     430           0 :                 (when (window-live-p (setq posn-window (posn-window start)))
     431             :                   ;; Add left edge of `posn-window' to `position'.
     432           0 :                   (setq position (+ (window-pixel-left posn-window) position))
     433           0 :                   (unless (nth 1 start)
     434             :                     ;; Add width of objects on the left of the text area to
     435             :                     ;; `position'.
     436           0 :                     (when (eq (window-current-scroll-bars posn-window) 'left)
     437           0 :                       (setq position (+ (window-scroll-bar-width posn-window)
     438           0 :                                         position)))
     439           0 :                     (setq position (+ (car (window-fringes posn-window))
     440           0 :                                       (or (car (window-margins posn-window)) 0)
     441           0 :                                       position))))
     442             :                 ;; When the cursor overshoots after shrinking a window to its
     443             :                 ;; minimum size and the dragging direction changes, have the
     444             :                 ;; cursor first catch up with the window edge.
     445           0 :                 (unless (or (zerop (setq growth (- position last-position)))
     446           0 :                             (and (> growth 0)
     447           0 :                                  (< position (+ (window-pixel-left window)
     448           0 :                                                 (window-pixel-width window))))
     449           0 :                             (and (< growth 0)
     450           0 :                                  (> position (+ (window-pixel-left window)
     451           0 :                                                 (window-pixel-width window)))))
     452           0 :                   (setq dragged t)
     453           0 :                   (adjust-window-trailing-edge window growth t t))
     454           0 :                 (setq last-position position))
     455           0 :                (draggable
     456             :                 ;; Drag bottom edge of `window'.
     457           0 :                 (setq start (event-start event))
     458             :                 ;; Set `posn-window' to the window where `event' was recorded.
     459             :                 ;; This can be either `window' or the window above or below of
     460             :                 ;; `window'.
     461           0 :                 (setq posn-window (posn-window start))
     462           0 :                 (setq position (cdr (posn-x-y start)))
     463           0 :                 (when (window-live-p posn-window)
     464             :                   ;; Add top edge of `posn-window' to `position'.
     465           0 :                   (setq position (+ (window-pixel-top posn-window) position))
     466             :                   ;; If necessary, add height of header line to `position'
     467           0 :                   (when (memq (posn-area start)
     468           0 :                               '(nil left-fringe right-fringe left-margin right-margin))
     469           0 :                     (setq position (+ (window-header-line-height posn-window) position))))
     470             :                 ;; When the cursor overshoots after shrinking a window to its
     471             :                 ;; minimum size and the dragging direction changes, have the
     472             :                 ;; cursor first catch up with the window edge.
     473           0 :                 (unless (or (zerop (setq growth (- position last-position)))
     474           0 :                             (and (> growth 0)
     475           0 :                                  (< position (+ (window-pixel-top window)
     476           0 :                                                 (window-pixel-height window))))
     477           0 :                             (and (< growth 0)
     478           0 :                                  (> position (+ (window-pixel-top window)
     479           0 :                                                 (window-pixel-height window)))))
     480           0 :                   (setq dragged t)
     481           0 :                   (adjust-window-trailing-edge window growth nil t))
     482           0 :                 (setq last-position position)))))
     483           0 :            (old-track-mouse track-mouse))
     484             :       ;; Start tracking.  The special value 'dragging' signals the
     485             :       ;; display engine to freeze the mouse pointer shape for as long
     486             :       ;; as we drag.
     487           0 :       (setq track-mouse 'dragging)
     488             :       ;; Loop reading events and sampling the position of the mouse.
     489           0 :       (setq exitfun
     490           0 :             (set-transient-map
     491           0 :              (let ((map (make-sparse-keymap)))
     492           0 :                (define-key map [switch-frame] #'ignore)
     493           0 :                (define-key map [select-window] #'ignore)
     494           0 :                (define-key map [scroll-bar-movement] #'ignore)
     495           0 :                (define-key map [mouse-movement] move)
     496             :                ;; Swallow drag-mouse-1 events to avoid selecting some other window.
     497           0 :                (define-key map [drag-mouse-1]
     498           0 :                  (lambda () (interactive) (funcall exitfun)))
     499             :                ;; For vertical line dragging swallow also a mouse-1
     500             :                ;; event (but only if we dragged at least once to allow mouse-1
     501             :                ;; clicks to get through).
     502           0 :                (when (eq line 'vertical)
     503           0 :                  (define-key map [mouse-1]
     504           0 :                    `(menu-item "" ,(lambda () (interactive) (funcall exitfun))
     505           0 :                                :filter ,(lambda (cmd) (if dragged cmd)))))
     506             :                ;; Some of the events will of course end up looked up
     507             :                ;; with a mode-line, header-line or vertical-line prefix ...
     508           0 :                (define-key map [mode-line] map)
     509           0 :                (define-key map [header-line] map)
     510           0 :                (define-key map [vertical-line] map)
     511             :                ;; ... and some maybe even with a right- or bottom-divider
     512             :                ;; prefix.
     513           0 :                (define-key map [right-divider] map)
     514           0 :                (define-key map [bottom-divider] map)
     515           0 :                map)
     516           0 :              t (lambda () (setq track-mouse old-track-mouse)))))))
     517             : 
     518             : (defun mouse-drag-mode-line (start-event)
     519             :   "Change the height of a window by dragging on its mode line.
     520             : START-EVENT is the starting mouse event of the drag action.
     521             : 
     522             : If the drag happens in a mode line on the bottom of a frame and
     523             : that frame's `drag-with-mode-line' parameter is non-nil, drag the
     524             : frame instead."
     525             :   (interactive "e")
     526           0 :   (let* ((start (event-start start-event))
     527           0 :          (window (posn-window start))
     528           0 :          (frame (window-frame window)))
     529           0 :     (cond
     530           0 :      ((not (window-live-p window)))
     531           0 :      ((or (not (window-at-side-p window 'bottom))
     532             :           ;; Allow resizing the minibuffer window if it's on the
     533             :           ;; same frame as and immediately below `window', and it's
     534             :           ;; either active or `resize-mini-windows' is nil.
     535           0 :           (let ((minibuffer-window (minibuffer-window frame)))
     536           0 :             (and (eq (window-frame minibuffer-window) frame)
     537           0 :                  (or (not resize-mini-windows)
     538           0 :                      (eq minibuffer-window
     539           0 :                          (active-minibuffer-window))))))
     540           0 :       (mouse-drag-line start-event 'mode))
     541           0 :      ((and (frame-parameter frame 'drag-with-mode-line)
     542           0 :            (window-at-side-p window 'bottom)
     543           0 :            (let ((minibuffer-window (minibuffer-window frame)))
     544           0 :              (not (eq (window-frame minibuffer-window) frame))))
     545             :       ;; Drag frame when the window is on the bottom of its frame and
     546             :       ;; there is no minibuffer window below.
     547           0 :       (mouse-drag-frame start-event 'move)))))
     548             : 
     549             : (defun mouse-drag-header-line (start-event)
     550             :   "Change the height of a window by dragging on its header line.
     551             : START-EVENT is the starting mouse event of the drag action.
     552             : 
     553             : If the drag happens in a header line on the top of a frame and
     554             : that frame's `drag-with-header-line' parameter is non-nil, drag
     555             : the frame instead."
     556             :   (interactive "e")
     557           0 :   (let* ((start (event-start start-event))
     558           0 :          (window (posn-window start)))
     559           0 :     (if (and (window-live-p window)
     560           0 :              (not (window-at-side-p window 'top)))
     561           0 :         (mouse-drag-line start-event 'header)
     562           0 :       (let ((frame (window-frame window)))
     563           0 :         (when (frame-parameter frame 'drag-with-header-line)
     564           0 :           (mouse-drag-frame start-event 'move))))))
     565             : 
     566             : (defun mouse-drag-vertical-line (start-event)
     567             :   "Change the width of a window by dragging on a vertical line.
     568             : START-EVENT is the starting mouse event of the drag action."
     569             :   (interactive "e")
     570           0 :   (mouse-drag-line start-event 'vertical))
     571             : 
     572             : (defun mouse-resize-frame (frame x-diff y-diff &optional x-move y-move)
     573             :   "Helper function for `mouse-drag-frame'."
     574           0 :   (let* ((frame-x-y (frame-position frame))
     575           0 :          (frame-x (car frame-x-y))
     576           0 :          (frame-y (cdr frame-x-y))
     577             :          alist)
     578           0 :     (if (> x-diff 0)
     579           0 :         (when x-move
     580           0 :           (setq x-diff (min x-diff frame-x))
     581           0 :           (setq x-move (- frame-x x-diff)))
     582           0 :       (let* ((min-width (frame-windows-min-size frame t nil t))
     583           0 :              (min-diff (max 0 (- (frame-inner-width frame) min-width))))
     584           0 :         (setq x-diff (max x-diff (- min-diff)))
     585           0 :         (when x-move
     586           0 :           (setq x-move (+ frame-x (- x-diff))))))
     587             : 
     588           0 :     (if (> y-diff 0)
     589           0 :         (when y-move
     590           0 :           (setq y-diff (min y-diff frame-y))
     591           0 :           (setq y-move (- frame-y y-diff)))
     592           0 :       (let* ((min-height (frame-windows-min-size frame nil nil t))
     593           0 :              (min-diff (max 0 (- (frame-inner-height frame) min-height))))
     594           0 :         (setq y-diff (max y-diff (- min-diff)))
     595           0 :         (when y-move
     596           0 :           (setq y-move (+ frame-y (- y-diff))))))
     597             : 
     598           0 :     (unless (zerop x-diff)
     599           0 :       (when x-move
     600           0 :         (push `(left . ,x-move) alist))
     601           0 :       (push `(width . (text-pixels . ,(+ (frame-text-width frame) x-diff)))
     602           0 :             alist))
     603           0 :     (unless (zerop y-diff)
     604           0 :       (when y-move
     605           0 :         (push `(top . ,y-move) alist))
     606           0 :       (push `(height . (text-pixels . ,(+ (frame-text-height frame) y-diff)))
     607           0 :             alist))
     608           0 :     (when alist
     609           0 :       (modify-frame-parameters frame alist))))
     610             : 
     611             : (defun mouse-drag-frame (start-event part)
     612             :   "Drag a frame or one of its edges with the mouse.
     613             : START-EVENT is the starting mouse event of the drag action.  Its
     614             : position window denotes the frame that will be dragged.
     615             : 
     616             : PART specifies the part that has been dragged and must be one of
     617             : the symbols 'left', 'top', 'right', 'bottom', 'top-left',
     618             : 'top-right', 'bottom-left', 'bottom-right' to drag an internal
     619             : border or edge.  If PART equals 'move', this means to move the
     620             : frame with the mouse."
     621             :   ;; Give temporary modes such as isearch a chance to turn off.
     622           0 :   (run-hooks 'mouse-leave-buffer-hook)
     623           0 :   (let* ((echo-keystrokes 0)
     624           0 :          (start (event-start start-event))
     625           0 :          (window (posn-window start))
     626             :          ;; FRAME is the frame to drag.
     627           0 :          (frame (if (window-live-p window)
     628           0 :                     (window-frame window)
     629           0 :                   window))
     630           0 :          (width (frame-native-width frame))
     631           0 :          (height (frame-native-height frame))
     632             :          ;; PARENT is the parent frame of FRAME or, if FRAME is a
     633             :          ;; top-level frame, FRAME's workarea.
     634           0 :          (parent (frame-parent frame))
     635             :          (parent-edges
     636           0 :           (if parent
     637           0 :               `(0 0 ,(frame-native-width parent) ,(frame-native-height parent))
     638           0 :             (let* ((attributes
     639           0 :                     (car (display-monitor-attributes-list)))
     640           0 :                    (workarea (assq 'workarea attributes)))
     641           0 :               (and workarea
     642           0 :                    `(,(nth 1 workarea) ,(nth 2 workarea)
     643           0 :                      ,(+ (nth 1 workarea) (nth 3 workarea))
     644           0 :                      ,(+ (nth 2 workarea) (nth 4 workarea)))))))
     645           0 :          (parent-left (and parent-edges (nth 0 parent-edges)))
     646           0 :          (parent-top (and parent-edges (nth 1 parent-edges)))
     647           0 :          (parent-right (and parent-edges (nth 2 parent-edges)))
     648           0 :          (parent-bottom (and parent-edges (nth 3 parent-edges)))
     649             :          ;; `pos-x' and `pos-y' record the x- and y-coordinates of the
     650             :          ;; last sampled mouse position.  Note that we sample absolute
     651             :          ;; mouse positions to avoid that moving the mouse from one
     652             :          ;; frame into another gets into our way.  `last-x' and `last-y'
     653             :          ;; records the x- and y-coordinates of the previously sampled
     654             :          ;; position.  The differences between `last-x' and `pos-x' as
     655             :          ;; well as `last-y' and `pos-y' determine the amount the mouse
     656             :          ;; has been dragged between the last two samples.
     657             :          pos-x-y pos-x pos-y
     658           0 :          (last-x-y (mouse-absolute-pixel-position))
     659           0 :          (last-x (car last-x-y))
     660           0 :          (last-y (cdr last-x-y))
     661             :          ;; `snap-x' and `snap-y' record the x- and y-coordinates of the
     662             :          ;; mouse position when FRAME snapped.  As soon as the
     663             :          ;; difference between `pos-x' and `snap-x' (or `pos-y' and
     664             :          ;; `snap-y') exceeds the value of FRAME's `snap-width'
     665             :          ;; parameter, unsnap FRAME (at the respective side).  `snap-x'
     666             :          ;; and `snap-y' nil mean FRAME is currently not snapped.
     667             :          snap-x snap-y
     668             :          (exitfun nil)
     669             :          (move
     670             :           (lambda (event)
     671             :             (interactive "e")
     672           0 :             (when (consp event)
     673           0 :               (setq pos-x-y (mouse-absolute-pixel-position))
     674           0 :               (setq pos-x (car pos-x-y))
     675           0 :               (setq pos-y (cdr pos-x-y))
     676           0 :               (cond
     677           0 :                ((eq part 'left)
     678           0 :                 (mouse-resize-frame frame (- last-x pos-x) 0 t))
     679           0 :                ((eq part 'top)
     680           0 :                 (mouse-resize-frame frame 0 (- last-y pos-y) nil t))
     681           0 :                ((eq part 'right)
     682           0 :                 (mouse-resize-frame frame (- pos-x last-x) 0))
     683           0 :                ((eq part 'bottom)
     684           0 :                 (mouse-resize-frame frame 0 (- pos-y last-y)))
     685           0 :                ((eq part 'top-left)
     686           0 :                 (mouse-resize-frame
     687           0 :                  frame (- last-x pos-x) (- last-y pos-y) t t))
     688           0 :                ((eq part 'top-right)
     689           0 :                 (mouse-resize-frame
     690           0 :                  frame (- pos-x last-x) (- last-y pos-y) nil t))
     691           0 :                ((eq part 'bottom-left)
     692           0 :                 (mouse-resize-frame
     693           0 :                  frame (- last-x pos-x) (- pos-y last-y) t))
     694           0 :                ((eq part 'bottom-right)
     695           0 :                 (mouse-resize-frame
     696           0 :                  frame (- pos-x last-x) (- pos-y last-y)))
     697           0 :                ((eq part 'move)
     698           0 :                 (let* ((old-position (frame-position frame))
     699           0 :                        (old-left (car old-position))
     700           0 :                        (old-top (cdr old-position))
     701           0 :                        (left (+ old-left (- pos-x last-x)))
     702           0 :                        (top (+ old-top (- pos-y last-y)))
     703             :                        right bottom
     704             :                        ;; `snap-width' (maybe also a yet to be provided
     705             :                        ;; `snap-height') could become floats to handle
     706             :                        ;; proportionality wrt PARENT.  We don't do any
     707             :                        ;; checks on this parameter so far.
     708           0 :                        (snap-width (frame-parameter frame 'snap-width)))
     709             :                   ;; Docking and constraining.
     710           0 :                   (when (and (numberp snap-width) parent-edges)
     711           0 :                     (cond
     712             :                      ;; Docking at the left parent edge.
     713           0 :                      ((< pos-x last-x)
     714           0 :                       (cond
     715           0 :                        ((and (> left parent-left)
     716           0 :                              (<= (- left parent-left) snap-width))
     717             :                         ;; Snap when the mouse moved leftward and
     718             :                         ;; FRAME's left edge would end up within
     719             :                         ;; `snap-width' pixels from PARENT's left edge.
     720           0 :                         (setq snap-x pos-x)
     721           0 :                         (setq left parent-left))
     722           0 :                        ((and (<= left parent-left)
     723           0 :                              (<= (- parent-left left) snap-width)
     724           0 :                              snap-x (<= (- snap-x pos-x) snap-width))
     725             :                         ;; Stay snapped when the mouse moved leftward
     726             :                         ;; but not more than `snap-width' pixels from
     727             :                         ;; the time FRAME snapped.
     728           0 :                         (setq left parent-left))
     729             :                        (t
     730             :                         ;; Unsnap when the mouse moved more than
     731             :                         ;; `snap-width' pixels leftward from the time
     732             :                         ;; FRAME snapped.
     733           0 :                         (setq snap-x nil))))
     734           0 :                      ((> pos-x last-x)
     735           0 :                       (setq right (+ left width))
     736           0 :                       (cond
     737           0 :                        ((and (< right parent-right)
     738           0 :                              (<= (- parent-right right) snap-width))
     739             :                         ;; Snap when the mouse moved rightward and
     740             :                         ;; FRAME's right edge would end up within
     741             :                         ;; `snap-width' pixels from PARENT's right edge.
     742           0 :                         (setq snap-x pos-x)
     743           0 :                         (setq left (- parent-right width)))
     744           0 :                        ((and (>= right parent-right)
     745           0 :                              (<= (- right parent-right) snap-width)
     746           0 :                              snap-x (<= (- pos-x snap-x) snap-width))
     747             :                         ;; Stay snapped when the mouse moved rightward
     748             :                         ;; but not more more than `snap-width' pixels
     749             :                         ;; from the time FRAME snapped.
     750           0 :                         (setq left (- parent-right width)))
     751             :                        (t
     752             :                         ;; Unsnap when the mouse moved rightward more
     753             :                         ;; than `snap-width' pixels from the time FRAME
     754             :                         ;; snapped.
     755           0 :                         (setq snap-x nil)))))
     756             : 
     757           0 :                     (cond
     758           0 :                      ((< pos-y last-y)
     759           0 :                       (cond
     760           0 :                        ((and (> top parent-top)
     761           0 :                              (<= (- top parent-top) snap-width))
     762             :                         ;; Snap when the mouse moved upward and FRAME's
     763             :                         ;; top edge would end up within `snap-width'
     764             :                         ;; pixels from PARENT's top edge.
     765           0 :                         (setq snap-y pos-y)
     766           0 :                         (setq top parent-top))
     767           0 :                        ((and (<= top parent-top)
     768           0 :                              (<= (- parent-top top) snap-width)
     769           0 :                              snap-y (<= (- snap-y pos-y) snap-width))
     770             :                         ;; Stay snapped when the mouse moved upward but
     771             :                         ;; not more more than `snap-width' pixels from
     772             :                         ;; the time FRAME snapped.
     773           0 :                         (setq top parent-top))
     774             :                        (t
     775             :                         ;; Unsnap when the mouse moved upward more than
     776             :                         ;; `snap-width' pixels from the time FRAME
     777             :                         ;; snapped.
     778           0 :                         (setq snap-y nil))))
     779           0 :                      ((> pos-y last-y)
     780           0 :                       (setq bottom (+ top height))
     781           0 :                       (cond
     782           0 :                        ((and (< bottom parent-bottom)
     783           0 :                              (<= (- parent-bottom bottom) snap-width))
     784             :                         ;; Snap when the mouse moved downward and
     785             :                         ;; FRAME's bottom edge would end up within
     786             :                         ;; `snap-width' pixels from PARENT's bottom
     787             :                         ;; edge.
     788           0 :                         (setq snap-y pos-y)
     789           0 :                         (setq top (- parent-bottom height)))
     790           0 :                        ((and (>= bottom parent-bottom)
     791           0 :                              (<= (- bottom parent-bottom) snap-width)
     792           0 :                              snap-y (<= (- pos-y snap-y) snap-width))
     793             :                         ;; Stay snapped when the mouse moved downward
     794             :                         ;; but not more more than `snap-width' pixels
     795             :                         ;; from the time FRAME snapped.
     796           0 :                         (setq top (- parent-bottom height)))
     797             :                        (t
     798             :                         ;; Unsnap when the mouse moved downward more
     799             :                         ;; than `snap-width' pixels from the time FRAME
     800             :                         ;; snapped.
     801           0 :                         (setq snap-y nil))))))
     802             : 
     803             :                   ;; If requested, constrain FRAME's draggable areas to
     804             :                   ;; PARENT's edges.  The `top-visible' parameter should
     805             :                   ;; be set when FRAME has a draggable header-line.  If
     806             :                   ;; set to a number, it ascertains that the top of
     807             :                   ;; FRAME is always constrained to the top of PARENT
     808             :                   ;; and that at least as many pixels of FRAME as
     809             :                   ;; specified by that number are visible on each of the
     810             :                   ;; three remaining sides of PARENT.
     811             :                   ;;
     812             :                   ;; The `bottom-visible' parameter should be set when
     813             :                   ;; FRAME has a draggable mode-line.  If set to a
     814             :                   ;; number, it ascertains that the bottom of FRAME is
     815             :                   ;; always constrained to the bottom of PARENT and that
     816             :                   ;; at least as many pixels of FRAME as specified by
     817             :                   ;; that number are visible on each of the three
     818             :                   ;; remaining sides of PARENT.
     819           0 :                   (let ((par (frame-parameter frame 'top-visible))
     820             :                         bottom-visible)
     821           0 :                     (unless par
     822           0 :                       (setq par (frame-parameter frame 'bottom-visible))
     823           0 :                       (setq bottom-visible t))
     824           0 :                     (when (and (numberp par) parent-edges)
     825           0 :                       (setq left
     826           0 :                             (max (min (- parent-right par) left)
     827           0 :                                  (+ (- parent-left width) par)))
     828           0 :                       (setq top
     829           0 :                             (if bottom-visible
     830           0 :                                 (min (max top (- parent-top (- height par)))
     831           0 :                                      (- parent-bottom height))
     832           0 :                               (min (max top parent-top)
     833           0 :                                    (- parent-bottom par))))))
     834             : 
     835             :                   ;; Use `modify-frame-parameters' since `left' and
     836             :                   ;; `top' may want to move FRAME out of its PARENT.
     837           0 :                   (modify-frame-parameters
     838           0 :                    frame
     839           0 :                    `((left . (+ ,left)) (top . (+ ,top)))))))
     840           0 :               (setq last-x pos-x)
     841           0 :               (setq last-y pos-y))))
     842           0 :          (old-track-mouse track-mouse))
     843             :     ;; Start tracking.  The special value 'dragging' signals the
     844             :     ;; display engine to freeze the mouse pointer shape for as long
     845             :     ;; as we drag.
     846           0 :     (setq track-mouse 'dragging)
     847             :     ;; Loop reading events and sampling the position of the mouse.
     848           0 :     (setq exitfun
     849           0 :           (set-transient-map
     850           0 :            (let ((map (make-sparse-keymap)))
     851           0 :              (define-key map [switch-frame] #'ignore)
     852           0 :              (define-key map [select-window] #'ignore)
     853           0 :              (define-key map [scroll-bar-movement] #'ignore)
     854           0 :              (define-key map [mouse-movement] move)
     855             :              ;; Swallow drag-mouse-1 events to avoid selecting some other window.
     856           0 :              (define-key map [drag-mouse-1]
     857           0 :                (lambda () (interactive) (funcall exitfun)))
     858             :              ;; Some of the events will of course end up looked up
     859             :              ;; with a mode-line, header-line or vertical-line prefix ...
     860           0 :              (define-key map [mode-line] map)
     861           0 :              (define-key map [header-line] map)
     862           0 :              (define-key map [vertical-line] map)
     863             :              ;; ... and some maybe even with a right- or bottom-divider
     864             :              ;; prefix.
     865           0 :              (define-key map [right-divider] map)
     866           0 :              (define-key map [bottom-divider] map)
     867           0 :              map)
     868           0 :            t (lambda () (setq track-mouse old-track-mouse))))))
     869             : 
     870             : (defun mouse-drag-left-edge (start-event)
     871             :   "Drag left edge of a frame with the mouse.
     872             : START-EVENT is the starting mouse event of the drag action."
     873             :   (interactive "e")
     874           0 :   (mouse-drag-frame start-event 'left))
     875             : 
     876             : (defun mouse-drag-top-left-corner (start-event)
     877             :   "Drag top left corner of a frame with the mouse.
     878             : START-EVENT is the starting mouse event of the drag action."
     879             :   (interactive "e")
     880           0 :   (mouse-drag-frame start-event 'top-left))
     881             : 
     882             : (defun mouse-drag-top-edge (start-event)
     883             :   "Drag top edge of a frame with the mouse.
     884             : START-EVENT is the starting mouse event of the drag action."
     885             :   (interactive "e")
     886           0 :   (mouse-drag-frame start-event 'top))
     887             : 
     888             : (defun mouse-drag-top-right-corner (start-event)
     889             :   "Drag top right corner of a frame with the mouse.
     890             : START-EVENT is the starting mouse event of the drag action."
     891             :   (interactive "e")
     892           0 :   (mouse-drag-frame start-event 'top-right))
     893             : 
     894             : (defun mouse-drag-right-edge (start-event)
     895             :   "Drag right edge of a frame with the mouse.
     896             : START-EVENT is the starting mouse event of the drag action."
     897             :   (interactive "e")
     898           0 :   (mouse-drag-frame start-event 'right))
     899             : 
     900             : (defun mouse-drag-bottom-right-corner (start-event)
     901             :   "Drag bottom right corner of a frame with the mouse.
     902             : START-EVENT is the starting mouse event of the drag action."
     903             :   (interactive "e")
     904           0 :   (mouse-drag-frame start-event 'bottom-right))
     905             : 
     906             : (defun mouse-drag-bottom-edge (start-event)
     907             :   "Drag bottom edge of a frame with the mouse.
     908             : START-EVENT is the starting mouse event of the drag action."
     909             :   (interactive "e")
     910           0 :   (mouse-drag-frame start-event 'bottom))
     911             : 
     912             : (defun mouse-drag-bottom-left-corner (start-event)
     913             :   "Drag bottom left corner of a frame with the mouse.
     914             : START-EVENT is the starting mouse event of the drag action."
     915             :   (interactive "e")
     916           0 :   (mouse-drag-frame start-event 'bottom-left))
     917             : 
     918             : (defcustom mouse-select-region-move-to-beginning nil
     919             :   "Effect of selecting a region extending backward from double click.
     920             : Nil means keep point at the position clicked (region end);
     921             : non-nil means move point to beginning of region."
     922             :   :type '(choice (const :tag "Don't move point" nil)
     923             :                  (const :tag "Move point to beginning of region" t))
     924             :   :group 'mouse
     925             :   :version "26.1")
     926             : 
     927             : (defun mouse-set-point (event &optional promote-to-region)
     928             :   "Move point to the position clicked on with the mouse.
     929             : This should be bound to a mouse click event type.
     930             : If PROMOTE-TO-REGION is non-nil and event is a multiple-click, select
     931             : the corresponding element around point, with the resulting position of
     932             : point determined by `mouse-select-region-move-to-beginning'."
     933             :   (interactive "e\np")
     934           0 :   (mouse-minibuffer-check event)
     935           0 :   (if (and promote-to-region (> (event-click-count event) 1))
     936           0 :       (progn
     937           0 :         (mouse-set-region event)
     938           0 :         (when mouse-select-region-move-to-beginning
     939           0 :           (when (> (posn-point (event-start event)) (region-beginning))
     940           0 :             (exchange-point-and-mark))))
     941             :     ;; Use event-end in case called from mouse-drag-region.
     942             :     ;; If EVENT is a click, event-end and event-start give same value.
     943           0 :     (posn-set-point (event-end event))))
     944             : 
     945             : (defvar mouse-last-region-beg nil)
     946             : (defvar mouse-last-region-end nil)
     947             : (defvar mouse-last-region-tick nil)
     948             : 
     949             : (defun mouse-region-match ()
     950             :   "Return non-nil if there's an active region that was set with the mouse."
     951           0 :   (and (mark t) mark-active
     952           0 :        (eq mouse-last-region-beg (region-beginning))
     953           0 :        (eq mouse-last-region-end (region-end))
     954           0 :        (eq mouse-last-region-tick (buffer-modified-tick))))
     955             : 
     956             : (defvar mouse--drag-start-event nil)
     957             : 
     958             : (defun mouse-set-region (click)
     959             :   "Set the region to the text dragged over, and copy to kill ring.
     960             : This should be bound to a mouse drag event.
     961             : See the `mouse-drag-copy-region' variable to control whether this
     962             : command alters the kill ring or not."
     963             :   (interactive "e")
     964           0 :   (mouse-minibuffer-check click)
     965           0 :   (select-window (posn-window (event-start click)))
     966           0 :   (let ((beg (posn-point (event-start click)))
     967             :         (end
     968           0 :          (if (eq (posn-window (event-end click)) (selected-window))
     969           0 :              (posn-point (event-end click))
     970             :            ;; If the mouse ends up in any other window or on the menu
     971             :            ;; bar, use `window-point' of selected window (Bug#23707).
     972           0 :            (window-point)))
     973           0 :         (click-count (event-click-count click)))
     974           0 :     (let ((drag-start (terminal-parameter nil 'mouse-drag-start)))
     975           0 :       (when drag-start
     976             :         ;; Drag events don't come with a click count, sadly, so we hack
     977             :         ;; our way around this problem by remembering the start-event in
     978             :         ;; `mouse-drag-start' and fetching the click-count from there.
     979           0 :         (when (and (<= click-count 1)
     980           0 :                    (equal beg (posn-point (event-start drag-start))))
     981           0 :           (setq click-count (event-click-count drag-start)))
     982             :         ;; Occasionally we get spurious drag events where the user hasn't
     983             :         ;; dragged his mouse, but instead Emacs has dragged the text under the
     984             :         ;; user's mouse.  Try to recover those cases (bug#17562).
     985           0 :         (when (and (equal (posn-x-y (event-start click))
     986           0 :                           (posn-x-y (event-end click)))
     987           0 :                    (not (eq (car drag-start) 'mouse-movement)))
     988           0 :           (setq end beg))
     989           0 :         (setf (terminal-parameter nil 'mouse-drag-start) nil)))
     990           0 :     (when (and (integerp beg) (integerp end))
     991           0 :       (let ((range (mouse-start-end beg end (1- click-count))))
     992           0 :         (if (< end beg)
     993           0 :             (setq end (nth 0 range) beg (nth 1 range))
     994           0 :           (setq beg (nth 0 range) end (nth 1 range)))))
     995           0 :     (and mouse-drag-copy-region (integerp beg) (integerp end)
     996             :          ;; Don't set this-command to `kill-region', so a following
     997             :          ;; C-w won't double the text in the kill ring.  Ignore
     998             :          ;; `last-command' so we don't append to a preceding kill.
     999           0 :          (let (this-command last-command deactivate-mark)
    1000           0 :            (copy-region-as-kill beg end)))
    1001           0 :     (if (numberp beg) (goto-char beg))
    1002             :     ;; On a text terminal, bounce the cursor.
    1003           0 :     (or transient-mark-mode
    1004           0 :         (window-system)
    1005           0 :         (sit-for 1))
    1006           0 :     (push-mark)
    1007           0 :     (set-mark (point))
    1008           0 :     (if (numberp end) (goto-char end))
    1009           0 :     (mouse-set-region-1)))
    1010             : 
    1011             : (defun mouse-set-region-1 ()
    1012             :   ;; Set transient-mark-mode for a little while.
    1013           0 :   (unless (eq (car-safe transient-mark-mode) 'only)
    1014           0 :     (setq-local transient-mark-mode
    1015           0 :                 (cons 'only
    1016           0 :                       (unless (eq transient-mark-mode 'lambda)
    1017           0 :                         transient-mark-mode))))
    1018           0 :   (setq mouse-last-region-beg (region-beginning))
    1019           0 :   (setq mouse-last-region-end (region-end))
    1020           0 :   (setq mouse-last-region-tick (buffer-modified-tick)))
    1021             : 
    1022             : (defcustom mouse-scroll-delay 0.25
    1023             :   "The pause between scroll steps caused by mouse drags, in seconds.
    1024             : If you drag the mouse beyond the edge of a window, Emacs scrolls the
    1025             : window to bring the text beyond that edge into view, with a delay of
    1026             : this many seconds between scroll steps.  Scrolling stops when you move
    1027             : the mouse back into the window, or release the button.
    1028             : This variable's value may be non-integral.
    1029             : Setting this to zero causes Emacs to scroll as fast as it can."
    1030             :   :type 'number
    1031             :   :group 'mouse)
    1032             : 
    1033             : (defcustom mouse-scroll-min-lines 1
    1034             :   "The minimum number of lines scrolled by dragging mouse out of window.
    1035             : Moving the mouse out the top or bottom edge of the window begins
    1036             : scrolling repeatedly.  The number of lines scrolled per repetition
    1037             : is normally equal to the number of lines beyond the window edge that
    1038             : the mouse has moved.  However, it always scrolls at least the number
    1039             : of lines specified by this variable."
    1040             :   :type 'integer
    1041             :   :group 'mouse)
    1042             : 
    1043             : (defun mouse-scroll-subr (window jump &optional overlay start)
    1044             :   "Scroll the window WINDOW, JUMP lines at a time, until new input arrives.
    1045             : If OVERLAY is an overlay, let it stretch from START to the far edge of
    1046             : the newly visible text.
    1047             : Upon exit, point is at the far edge of the newly visible text."
    1048           0 :   (cond
    1049           0 :    ((and (> jump 0) (< jump mouse-scroll-min-lines))
    1050           0 :     (setq jump mouse-scroll-min-lines))
    1051           0 :    ((and (< jump 0) (< (- jump) mouse-scroll-min-lines))
    1052           0 :     (setq jump (- mouse-scroll-min-lines))))
    1053           0 :   (let ((opoint (point)))
    1054           0 :     (while (progn
    1055           0 :              (goto-char (window-start window))
    1056           0 :              (if (not (zerop (vertical-motion jump window)))
    1057           0 :                  (progn
    1058           0 :                    (set-window-start window (point))
    1059           0 :                    (if (natnump jump)
    1060           0 :                        (if (window-end window)
    1061           0 :                            (progn
    1062           0 :                              (goto-char (window-end window))
    1063             :                              ;; window-end doesn't reflect the window's new
    1064             :                              ;; start position until the next redisplay.
    1065           0 :                              (vertical-motion (1- jump) window))
    1066           0 :                          (vertical-motion (- (window-height window) 2)))
    1067           0 :                      (goto-char (window-start window)))
    1068           0 :                    (if overlay
    1069           0 :                        (move-overlay overlay start (point)))
    1070             :                    ;; Now that we have scrolled WINDOW properly,
    1071             :                    ;; put point back where it was for the redisplay
    1072             :                    ;; so that we don't mess up the selected window.
    1073           0 :                    (or (eq window (selected-window))
    1074           0 :                        (goto-char opoint))
    1075           0 :                    (sit-for mouse-scroll-delay)))))
    1076           0 :     (or (eq window (selected-window))
    1077           0 :         (goto-char opoint))))
    1078             : 
    1079             : (defvar mouse-selection-click-count 0)
    1080             : 
    1081             : (defvar mouse-selection-click-count-buffer nil)
    1082             : 
    1083             : (defun mouse-drag-region (start-event)
    1084             :   "Set the region to the text that the mouse is dragged over.
    1085             : Highlight the drag area as you move the mouse.
    1086             : This must be bound to a button-down mouse event.
    1087             : In Transient Mark mode, the highlighting remains as long as the mark
    1088             : remains active.  Otherwise, it remains until the next input event.
    1089             : 
    1090             : When the region already exists and `mouse-drag-and-drop-region'
    1091             : is non-nil, this moves the entire region of text to where mouse
    1092             : is dragged over to."
    1093             :   (interactive "e")
    1094           0 :   (if (and mouse-drag-and-drop-region
    1095           0 :            (not (member 'triple (event-modifiers start-event)))
    1096           0 :            (equal (mouse-posn-property (event-start start-event) 'face) 'region))
    1097           0 :       (mouse-drag-and-drop-region start-event)
    1098             :     ;; Give temporary modes such as isearch a chance to turn off.
    1099           0 :     (run-hooks 'mouse-leave-buffer-hook)
    1100           0 :     (mouse-drag-track start-event)))
    1101             : 
    1102             : (defun mouse-posn-property (pos property)
    1103             :   "Look for a property at click position.
    1104             : POS may be either a buffer position or a click position like
    1105             : those returned from `event-start'.  If the click position is on
    1106             : a string, the text property PROPERTY is examined.
    1107             : If this is nil or the click is not on a string, then
    1108             : the corresponding buffer position is searched for PROPERTY.
    1109             : If PROPERTY is encountered in one of those places,
    1110             : its value is returned."
    1111           0 :   (if (consp pos)
    1112           0 :       (let ((w (posn-window pos)) (pt (posn-point pos))
    1113           0 :             (str (posn-string pos)))
    1114           0 :         (or (and str
    1115           0 :                  (get-text-property (cdr str) property (car str)))
    1116             :             ;; Mouse clicks in the fringe come with a position in
    1117             :             ;; (nth 5).  This is useful but is not exactly where we clicked, so
    1118             :             ;; don't look up that position's properties!
    1119           0 :             (and pt (not (memq (posn-area pos) '(left-fringe right-fringe
    1120           0 :                                                  left-margin right-margin)))
    1121           0 :                  (get-char-property pt property w))))
    1122           0 :     (get-char-property pos property)))
    1123             : 
    1124             : (defun mouse-on-link-p (pos)
    1125             :   "Return non-nil if POS is on a link in the current buffer.
    1126             : POS must specify a buffer position in the current buffer, as a list
    1127             : of the form returned by the `event-start' and `event-end' functions,
    1128             : or a mouse event location in the selected window (see `event-start').
    1129             : However, if `mouse-1-click-in-non-selected-windows' is non-nil,
    1130             : POS may be a mouse event location in any window.
    1131             : 
    1132             : A clickable link is identified by one of the following methods:
    1133             : 
    1134             : - If the character at POS has a non-nil `follow-link' text or
    1135             : overlay property, the value of that property determines what to do.
    1136             : 
    1137             : - If there is a local key-binding or a keybinding at position POS
    1138             : for the `follow-link' event, the binding of that event determines
    1139             : what to do.
    1140             : 
    1141             : The resulting value determine whether POS is inside a link:
    1142             : 
    1143             : - If the value is `mouse-face', POS is inside a link if there
    1144             : is a non-nil `mouse-face' property at POS.  Return t in this case.
    1145             : 
    1146             : - If the value is a function, FUNC, POS is inside a link if
    1147             : the call \(FUNC POS) returns non-nil.  Return the return value
    1148             : from that call.  Arg is \(posn-point POS) if POS is a mouse event.
    1149             : 
    1150             : - Otherwise, return the value itself.
    1151             : 
    1152             : The return value is interpreted as follows:
    1153             : 
    1154             : - If it is a string, the mouse-1 event is translated into the
    1155             : first character of the string, i.e. the action of the mouse-1
    1156             : click is the local or global binding of that character.
    1157             : 
    1158             : - If it is a vector, the mouse-1 event is translated into the
    1159             : first element of that vector, i.e. the action of the mouse-1
    1160             : click is the local or global binding of that event.
    1161             : 
    1162             : - Otherwise, the mouse-1 event is translated into a mouse-2 event
    1163             : at the same position."
    1164           0 :   (let ((action
    1165           0 :          (and (or (not (consp pos))
    1166           0 :                   mouse-1-click-in-non-selected-windows
    1167           0 :                   (eq (selected-window) (posn-window pos)))
    1168           0 :               (or (mouse-posn-property pos 'follow-link)
    1169           0 :                   (let ((area (posn-area pos)))
    1170           0 :                     (when area
    1171           0 :                       (key-binding (vector area 'follow-link) nil t pos)))
    1172           0 :                   (key-binding [follow-link] nil t pos)))))
    1173           0 :     (cond
    1174           0 :      ((eq action 'mouse-face)
    1175           0 :       (and (mouse-posn-property pos 'mouse-face) t))
    1176           0 :      ((functionp action)
    1177             :       ;; FIXME: This seems questionable if the click is not in a buffer.
    1178             :       ;; Should we instead decide that `action' takes a `posn'?
    1179           0 :       (if (consp pos)
    1180           0 :           (with-current-buffer (window-buffer (posn-window pos))
    1181           0 :             (funcall action (posn-point pos)))
    1182           0 :         (funcall action pos)))
    1183           0 :      (t action))))
    1184             : 
    1185             : (defun mouse-fixup-help-message (msg)
    1186             :   "Fix help message MSG for `mouse-1-click-follows-link'."
    1187           0 :   (let (mp pos)
    1188           0 :     (if (and mouse-1-click-follows-link
    1189           0 :              (stringp msg)
    1190           0 :              (string-match-p "\\`mouse-2" msg)
    1191           0 :              (setq mp (mouse-pixel-position))
    1192           0 :              (consp (setq pos (cdr mp)))
    1193           0 :              (car pos) (>= (car pos) 0)
    1194           0 :              (cdr pos) (>= (cdr pos) 0)
    1195           0 :              (setq pos (posn-at-x-y (car pos) (cdr pos) (car mp)))
    1196           0 :              (windowp (posn-window pos)))
    1197           0 :         (with-current-buffer (window-buffer (posn-window pos))
    1198           0 :           (if (mouse-on-link-p pos)
    1199           0 :               (setq msg (concat
    1200           0 :                     (cond
    1201           0 :                      ((eq mouse-1-click-follows-link 'double) "double-")
    1202           0 :                      ((and (integerp mouse-1-click-follows-link)
    1203           0 :                            (< mouse-1-click-follows-link 0)) "Long ")
    1204           0 :                      (t ""))
    1205           0 :                     "mouse-1" (substring msg 7)))))))
    1206           0 :   msg)
    1207             : 
    1208             : (defun mouse-drag-track (start-event)
    1209             :     "Track mouse drags by highlighting area between point and cursor.
    1210             : The region will be defined with mark and point."
    1211           0 :   (mouse-minibuffer-check start-event)
    1212           0 :   (setq mouse-selection-click-count-buffer (current-buffer))
    1213           0 :   (deactivate-mark)
    1214           0 :   (let* ((scroll-margin 0) ; Avoid margin scrolling (Bug#9541).
    1215           0 :          (start-posn (event-start start-event))
    1216           0 :          (start-point (posn-point start-posn))
    1217           0 :          (start-window (posn-window start-posn))
    1218           0 :          (_ (with-current-buffer (window-buffer start-window)
    1219           0 :               (setq deactivate-mark nil)))
    1220             :          ;; We've recorded what we needed from the current buffer and
    1221             :          ;; window, now let's jump to the place of the event, where things
    1222             :          ;; are happening.
    1223           0 :          (_ (mouse-set-point start-event))
    1224             :          (echo-keystrokes 0)
    1225           0 :          (bounds (window-edges start-window))
    1226             :          (make-cursor-line-fully-visible nil)
    1227           0 :          (top (nth 1 bounds))
    1228           0 :          (bottom (if (window-minibuffer-p start-window)
    1229           0 :                      (nth 3 bounds)
    1230             :                    ;; Don't count the mode line.
    1231           0 :                    (1- (nth 3 bounds))))
    1232           0 :          (click-count (1- (event-click-count start-event)))
    1233             :          ;; Suppress automatic hscrolling, because that is a nuisance
    1234             :          ;; when setting point near the right fringe (but see below).
    1235           0 :          (auto-hscroll-mode-saved auto-hscroll-mode)
    1236           0 :          (old-track-mouse track-mouse))
    1237             : 
    1238           0 :     (setq mouse-selection-click-count click-count)
    1239             :     ;; In case the down click is in the middle of some intangible text,
    1240             :     ;; use the end of that text, and put it in START-POINT.
    1241           0 :     (if (< (point) start-point)
    1242           0 :         (goto-char start-point))
    1243           0 :     (setq start-point (point))
    1244             : 
    1245             :     ;; Activate the region, using `mouse-start-end' to determine where
    1246             :     ;; to put point and mark (e.g., double-click will select a word).
    1247           0 :     (setq-local transient-mark-mode
    1248           0 :                 (if (eq transient-mark-mode 'lambda)
    1249             :                     '(only)
    1250           0 :                   (cons 'only transient-mark-mode)))
    1251           0 :     (let ((range (mouse-start-end start-point start-point click-count)))
    1252           0 :       (push-mark (nth 0 range) t t)
    1253           0 :       (goto-char (nth 1 range)))
    1254             : 
    1255           0 :     (setf (terminal-parameter nil 'mouse-drag-start) start-event)
    1256           0 :     (setq track-mouse t)
    1257           0 :     (setq auto-hscroll-mode nil)
    1258             : 
    1259           0 :     (set-transient-map
    1260           0 :      (let ((map (make-sparse-keymap)))
    1261           0 :        (define-key map [switch-frame] #'ignore)
    1262           0 :        (define-key map [select-window] #'ignore)
    1263           0 :        (define-key map [mouse-movement]
    1264             :          (lambda (event) (interactive "e")
    1265           0 :            (let* ((end (event-end event))
    1266           0 :                   (end-point (posn-point end)))
    1267           0 :              (unless (eq end-point start-point)
    1268             :                ;; As soon as the user moves, we can re-enable auto-hscroll.
    1269           0 :                (setq auto-hscroll-mode auto-hscroll-mode-saved)
    1270             :                ;; And remember that we have moved, so mouse-set-region can know
    1271             :                ;; its event is really a drag event.
    1272           0 :                (setcar start-event 'mouse-movement))
    1273           0 :              (if (and (eq (posn-window end) start-window)
    1274           0 :                       (integer-or-marker-p end-point))
    1275           0 :                  (mouse--drag-set-mark-and-point start-point
    1276           0 :                                                  end-point click-count)
    1277           0 :                (let ((mouse-row (cdr (cdr (mouse-position)))))
    1278           0 :                  (cond
    1279           0 :                   ((null mouse-row))
    1280           0 :                   ((< mouse-row top)
    1281           0 :                    (mouse-scroll-subr start-window (- mouse-row top)
    1282           0 :                                       nil start-point))
    1283           0 :                   ((>= mouse-row bottom)
    1284           0 :                    (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
    1285           0 :                                       nil start-point))))))))
    1286           0 :        map)
    1287             :      t (lambda ()
    1288           0 :          (setq track-mouse old-track-mouse)
    1289           0 :          (setq auto-hscroll-mode auto-hscroll-mode-saved)
    1290           0 :           (deactivate-mark)
    1291           0 :          (pop-mark)))))
    1292             : 
    1293             : (defun mouse--drag-set-mark-and-point (start click click-count)
    1294           0 :   (let* ((range (mouse-start-end start click click-count))
    1295           0 :          (beg (nth 0 range))
    1296           0 :          (end (nth 1 range)))
    1297           0 :     (cond ((eq (mark) beg)
    1298           0 :            (goto-char end))
    1299           0 :           ((eq (mark) end)
    1300           0 :            (goto-char beg))
    1301           0 :           ((< click (mark))
    1302           0 :            (set-mark end)
    1303           0 :            (goto-char beg))
    1304             :           (t
    1305           0 :            (set-mark beg)
    1306           0 :            (goto-char end)))))
    1307             : 
    1308             : ;; Commands to handle xterm-style multiple clicks.
    1309             : (defun mouse-skip-word (dir)
    1310             :   "Skip over word, over whitespace, or over identical punctuation.
    1311             : If DIR is positive skip forward; if negative, skip backward."
    1312           0 :   (let* ((char (following-char))
    1313           0 :          (syntax (char-to-string (char-syntax char))))
    1314           0 :     (cond ((string= syntax "w")
    1315             :            ;; Here, we can't use skip-syntax-forward/backward because
    1316             :            ;; they don't pay attention to word-separating-categories,
    1317             :            ;; and thus they will skip over a true word boundary.  So,
    1318             :            ;; we simulate the original behavior by using forward-word.
    1319           0 :            (if (< dir 0)
    1320           0 :                (if (not (looking-at "\\<"))
    1321           0 :                    (forward-word -1))
    1322           0 :              (if (or (looking-at "\\<") (not (looking-at "\\>")))
    1323           0 :                  (forward-word 1))))
    1324           0 :           ((string= syntax " ")
    1325           0 :            (if (< dir 0)
    1326           0 :                (skip-syntax-backward syntax)
    1327           0 :              (skip-syntax-forward syntax)))
    1328           0 :           ((string= syntax "_")
    1329           0 :            (if (< dir 0)
    1330           0 :                (skip-syntax-backward "w_")
    1331           0 :              (skip-syntax-forward "w_")))
    1332           0 :           ((< dir 0)
    1333           0 :            (while (and (not (bobp)) (= (preceding-char) char))
    1334           0 :              (forward-char -1)))
    1335             :           (t
    1336           0 :            (while (and (not (eobp)) (= (following-char) char))
    1337           0 :              (forward-char 1))))))
    1338             : 
    1339             : (defun mouse-start-end (start end mode)
    1340             :   "Return a list of region bounds based on START and END according to MODE.
    1341             : If MODE is 0 then set point to (min START END), mark to (max START END).
    1342             : If MODE is 1 then set point to start of word at (min START END),
    1343             : mark to end of word at (max START END).
    1344             : If MODE is 2 then do the same for lines."
    1345           0 :   (if (> start end)
    1346           0 :       (let ((temp start))
    1347           0 :         (setq start end
    1348           0 :               end temp)))
    1349           0 :   (setq mode (mod mode 3))
    1350           0 :   (cond ((= mode 0)
    1351           0 :          (list start end))
    1352           0 :         ((and (= mode 1)
    1353           0 :               (= start end)
    1354           0 :               (char-after start)
    1355           0 :               (= (char-syntax (char-after start)) ?\())
    1356           0 :          (if (/= (syntax-class (syntax-after start)) 4) ; raw syntax code for ?\(
    1357             :              ;; This happens in CC Mode when unbalanced parens in CPP
    1358             :              ;; constructs are given punctuation syntax with
    1359             :              ;; syntax-table text properties.  (2016-02-21).
    1360           0 :              (signal 'scan-error (list "Containing expression ends prematurely"
    1361           0 :                                        start start))
    1362           0 :            (list start
    1363           0 :                  (save-excursion
    1364           0 :                    (goto-char start)
    1365           0 :                    (forward-sexp 1)
    1366           0 :                    (point)))))
    1367           0 :         ((and (= mode 1)
    1368           0 :               (= start end)
    1369           0 :               (char-after start)
    1370           0 :               (= (char-syntax (char-after start)) ?\)))
    1371           0 :          (if (/= (syntax-class (syntax-after start)) 5) ; raw syntax code for ?\)
    1372             :              ;; See above comment about CC Mode.
    1373           0 :              (signal 'scan-error (list "Unbalanced parentheses" start start))
    1374           0 :            (list (save-excursion
    1375           0 :                    (goto-char (1+ start))
    1376           0 :                    (backward-sexp 1)
    1377           0 :                    (point))
    1378           0 :                  (1+ start))))
    1379           0 :         ((and (= mode 1)
    1380           0 :               (= start end)
    1381           0 :               (char-after start)
    1382           0 :               (= (char-syntax (char-after start)) ?\"))
    1383           0 :          (let ((open (or (eq start (point-min))
    1384           0 :                          (save-excursion
    1385           0 :                            (goto-char (- start 1))
    1386           0 :                            (looking-at "\\s(\\|\\s \\|\\s>")))))
    1387           0 :            (if open
    1388           0 :                (list start
    1389           0 :                      (save-excursion
    1390           0 :                        (condition-case nil
    1391           0 :                            (progn
    1392           0 :                              (goto-char start)
    1393           0 :                              (forward-sexp 1)
    1394           0 :                              (point))
    1395           0 :                          (error end))))
    1396           0 :              (list (save-excursion
    1397           0 :                      (condition-case nil
    1398           0 :                          (progn
    1399           0 :                            (goto-char (1+ start))
    1400           0 :                            (backward-sexp 1)
    1401           0 :                            (point))
    1402           0 :                        (error end)))
    1403           0 :                    (1+ start)))))
    1404           0 :         ((= mode 1)
    1405           0 :          (list (save-excursion
    1406           0 :                  (goto-char start)
    1407           0 :                  (mouse-skip-word -1)
    1408           0 :                  (point))
    1409           0 :                (save-excursion
    1410           0 :                  (goto-char end)
    1411           0 :                  (mouse-skip-word 1)
    1412           0 :                  (point))))
    1413           0 :         ((= mode 2)
    1414           0 :          (list (save-excursion
    1415           0 :                  (goto-char start)
    1416           0 :                  (line-beginning-position 1))
    1417           0 :                (save-excursion
    1418           0 :                  (goto-char end)
    1419           0 :                  (forward-line 1)
    1420           0 :                  (point))))))
    1421             : 
    1422             : ;; Subroutine: set the mark where CLICK happened,
    1423             : ;; but don't do anything else.
    1424             : (defun mouse-set-mark-fast (click)
    1425           0 :   (mouse-minibuffer-check click)
    1426           0 :   (let ((posn (event-start click)))
    1427           0 :     (select-window (posn-window posn))
    1428           0 :     (if (numberp (posn-point posn))
    1429           0 :         (push-mark (posn-point posn) t t))))
    1430             : 
    1431             : (defun mouse-undouble-last-event (events)
    1432           0 :   (let* ((index (1- (length events)))
    1433           0 :          (last (nthcdr index events))
    1434           0 :          (event (car last))
    1435           0 :          (basic (event-basic-type event))
    1436           0 :          (old-modifiers (event-modifiers event))
    1437           0 :          (modifiers (delq 'double (delq 'triple (copy-sequence old-modifiers))))
    1438             :          (new
    1439           0 :           (if (consp event)
    1440             :               ;; Use reverse, not nreverse, since event-modifiers
    1441             :               ;; does not copy the list it returns.
    1442           0 :               (cons (event-convert-list (reverse (cons basic modifiers)))
    1443           0 :                     (cdr event))
    1444           0 :             event)))
    1445           0 :     (setcar last new)
    1446           0 :     (if (and (not (equal modifiers old-modifiers))
    1447           0 :              (key-binding (apply 'vector events)))
    1448             :         t
    1449           0 :       (setcar last event)
    1450           0 :       nil)))
    1451             : 
    1452             : ;; Momentarily show where the mark is, if highlighting doesn't show it.
    1453             : 
    1454             : (defun mouse-set-mark (click)
    1455             :   "Set mark at the position clicked on with the mouse.
    1456             : Display cursor at that position for a second.
    1457             : This must be bound to a mouse click."
    1458             :   (interactive "e")
    1459           0 :   (mouse-minibuffer-check click)
    1460           0 :   (select-window (posn-window (event-start click)))
    1461             :   ;; FIXME: Use save-excursion
    1462           0 :   (let ((point-save (point)))
    1463           0 :     (unwind-protect
    1464           0 :         (progn (mouse-set-point click)
    1465           0 :                (push-mark nil t t)
    1466           0 :                (or transient-mark-mode
    1467           0 :                    (sit-for 1)))
    1468           0 :       (goto-char point-save))))
    1469             : 
    1470             : (defun mouse-kill (click)
    1471             :   "Kill the region between point and the mouse click.
    1472             : The text is saved in the kill ring, as with \\[kill-region]."
    1473             :   (interactive "e")
    1474           0 :   (mouse-minibuffer-check click)
    1475           0 :   (let* ((posn (event-start click))
    1476           0 :          (click-posn (posn-point posn)))
    1477           0 :     (select-window (posn-window posn))
    1478           0 :     (if (numberp click-posn)
    1479           0 :         (kill-region (min (point) click-posn)
    1480           0 :                      (max (point) click-posn)))))
    1481             : 
    1482             : (defun mouse-yank-at-click (click arg)
    1483             :   "Insert the last stretch of killed text at the position clicked on.
    1484             : Also move point to one end of the text thus inserted (normally the end),
    1485             : and set mark at the beginning.
    1486             : Prefix arguments are interpreted as with \\[yank].
    1487             : If `mouse-yank-at-point' is non-nil, insert at point
    1488             : regardless of where you click."
    1489             :   (interactive "e\nP")
    1490             :   ;; Give temporary modes such as isearch a chance to turn off.
    1491           0 :   (run-hooks 'mouse-leave-buffer-hook)
    1492           0 :   (when select-active-regions
    1493             :     ;; Without this, confusing things happen upon e.g. inserting into
    1494             :     ;; the middle of an active region.
    1495           0 :     (deactivate-mark))
    1496           0 :   (or mouse-yank-at-point (mouse-set-point click))
    1497           0 :   (setq this-command 'yank)
    1498           0 :   (setq mouse-selection-click-count 0)
    1499           0 :   (yank arg))
    1500             : 
    1501             : (defun mouse-yank-primary (click)
    1502             :   "Insert the primary selection at the position clicked on.
    1503             : Move point to the end of the inserted text, and set mark at
    1504             : beginning.  If `mouse-yank-at-point' is non-nil, insert at point
    1505             : regardless of where you click."
    1506             :   (interactive "e")
    1507             :   ;; Give temporary modes such as isearch a chance to turn off.
    1508           0 :   (run-hooks 'mouse-leave-buffer-hook)
    1509             :   ;; Without this, confusing things happen upon e.g. inserting into
    1510             :   ;; the middle of an active region.
    1511           0 :   (when select-active-regions
    1512           0 :     (let (select-active-regions)
    1513           0 :       (deactivate-mark)))
    1514           0 :   (or mouse-yank-at-point (mouse-set-point click))
    1515           0 :   (let ((primary (gui-get-primary-selection)))
    1516           0 :     (push-mark)
    1517           0 :     (insert-for-yank primary)))
    1518             : 
    1519             : (defun mouse-kill-ring-save (click)
    1520             :   "Copy the region between point and the mouse click in the kill ring.
    1521             : This does not delete the region; it acts like \\[kill-ring-save]."
    1522             :   (interactive "e")
    1523           0 :   (mouse-set-mark-fast click)
    1524           0 :   (let (this-command last-command)
    1525           0 :     (kill-ring-save (point) (mark t))))
    1526             : 
    1527             : ;; This function used to delete the text between point and the mouse
    1528             : ;; whenever it was equal to the front of the kill ring, but some
    1529             : ;; people found that confusing.
    1530             : 
    1531             : ;; The position of the last invocation of `mouse-save-then-kill'.
    1532             : (defvar mouse-save-then-kill-posn nil)
    1533             : 
    1534             : (defun mouse-save-then-kill-delete-region (beg end)
    1535             :   ;; We must make our own undo boundaries
    1536             :   ;; because they happen automatically only for the current buffer.
    1537           0 :   (undo-boundary)
    1538           0 :   (if (or (= beg end) (eq buffer-undo-list t))
    1539             :       ;; If we have no undo list in this buffer,
    1540             :       ;; just delete.
    1541           0 :       (delete-region beg end)
    1542             :     ;; Delete, but make the undo-list entry share with the kill ring.
    1543             :     ;; First, delete just one char, so in case buffer is being modified
    1544             :     ;; for the first time, the undo list records that fact.
    1545           0 :     (let ((inhibit-modification-hooks t))
    1546           0 :       (delete-region beg
    1547           0 :                      (+ beg (if (> end beg) 1 -1))))
    1548           0 :     (let ((buffer-undo-list buffer-undo-list))
    1549             :       ;; Undo that deletion--but don't change the undo list!
    1550           0 :       (let ((inhibit-modification-hooks t))
    1551           0 :         (primitive-undo 1 buffer-undo-list))
    1552             :       ;; Now delete the rest of the specified region,
    1553             :       ;; but don't record it.
    1554           0 :       (setq buffer-undo-list t)
    1555           0 :       (if (/= (length (car kill-ring)) (- (max end beg) (min end beg)))
    1556           0 :           (error "Lossage in mouse-save-then-kill-delete-region"))
    1557           0 :       (delete-region beg end))
    1558           0 :     (let ((tail buffer-undo-list))
    1559             :       ;; Search back in buffer-undo-list for the string
    1560             :       ;; that came from deleting one character.
    1561           0 :       (while (and tail (not (stringp (car (car tail)))))
    1562           0 :         (setq tail (cdr tail)))
    1563             :       ;; Replace it with an entry for the entire deleted text.
    1564           0 :       (and tail
    1565           0 :            (setcar tail (cons (car kill-ring) (min beg end))))))
    1566           0 :   (undo-boundary))
    1567             : 
    1568             : (defun mouse-save-then-kill (click)
    1569             :   "Set the region according to CLICK; the second time, kill it.
    1570             : CLICK should be a mouse click event.
    1571             : 
    1572             : If the region is inactive, activate it temporarily.  Set mark at
    1573             : the original point, and move point to the position of CLICK.
    1574             : 
    1575             : If the region is already active, adjust it.  Normally, do this by
    1576             : moving point or mark, whichever is closer, to CLICK.  But if you
    1577             : have selected whole words or lines, move point or mark to the
    1578             : word or line boundary closest to CLICK instead.
    1579             : 
    1580             : If `mouse-drag-copy-region' is non-nil, this command also saves the
    1581             : new region to the kill ring (replacing the previous kill if the
    1582             : previous region was just saved to the kill ring).
    1583             : 
    1584             : If this command is called a second consecutive time with the same
    1585             : CLICK position, kill the region (or delete it
    1586             : if `mouse-drag-copy-region' is non-nil)"
    1587             :   (interactive "e")
    1588           0 :   (mouse-minibuffer-check click)
    1589           0 :   (let* ((posn     (event-start click))
    1590           0 :          (click-pt (posn-point posn))
    1591           0 :          (window   (posn-window posn))
    1592           0 :          (buf      (window-buffer window))
    1593             :          ;; Don't let a subsequent kill command append to this one.
    1594           0 :          (this-command this-command)
    1595             :          ;; Check if the user has multi-clicked to select words/lines.
    1596             :          (click-count
    1597           0 :           (if (and (eq mouse-selection-click-count-buffer buf)
    1598           0 :                    (with-current-buffer buf (mark t)))
    1599           0 :               mouse-selection-click-count
    1600           0 :             0)))
    1601           0 :     (cond
    1602           0 :      ((not (numberp click-pt)) nil)
    1603             :      ;; If the user clicked without moving point, kill the region.
    1604             :      ;; This also resets `mouse-selection-click-count'.
    1605           0 :      ((and (eq last-command 'mouse-save-then-kill)
    1606           0 :            (eq click-pt mouse-save-then-kill-posn)
    1607           0 :            (eq window (selected-window)))
    1608           0 :       (if mouse-drag-copy-region
    1609             :           ;; Region already saved in the previous click;
    1610             :           ;; don't make a duplicate entry, just delete.
    1611           0 :           (delete-region (mark t) (point))
    1612           0 :         (kill-region (mark t) (point)))
    1613           0 :       (setq mouse-selection-click-count 0)
    1614           0 :       (setq mouse-save-then-kill-posn nil))
    1615             : 
    1616             :      ;; Otherwise, if there is a suitable region, adjust it by moving
    1617             :      ;; one end (whichever is closer) to CLICK-PT.
    1618           0 :      ((or (with-current-buffer buf (region-active-p))
    1619           0 :           (and (eq window (selected-window))
    1620           0 :                (mark t)
    1621           0 :                (or (and (eq last-command 'mouse-save-then-kill)
    1622           0 :                         mouse-save-then-kill-posn)
    1623           0 :                    (and (memq last-command '(mouse-drag-region
    1624           0 :                                              mouse-set-region))
    1625           0 :                         (or mark-even-if-inactive
    1626           0 :                             (not transient-mark-mode))))))
    1627           0 :       (select-window window)
    1628           0 :       (let* ((range (mouse-start-end click-pt click-pt click-count)))
    1629           0 :         (if (< (abs (- click-pt (mark t)))
    1630           0 :                (abs (- click-pt (point))))
    1631           0 :             (set-mark (car range))
    1632           0 :           (goto-char (nth 1 range)))
    1633           0 :         (setq deactivate-mark nil)
    1634           0 :         (mouse-set-region-1)
    1635           0 :         (when mouse-drag-copy-region
    1636             :           ;; Region already copied to kill-ring once, so replace.
    1637           0 :           (kill-new (filter-buffer-substring (mark t) (point)) t))
    1638             :         ;; Arrange for a repeated mouse-3 to kill the region.
    1639           0 :         (setq mouse-save-then-kill-posn click-pt)))
    1640             : 
    1641             :      ;; Otherwise, set the mark where point is and move to CLICK-PT.
    1642             :      (t
    1643           0 :       (select-window window)
    1644           0 :       (mouse-set-mark-fast click)
    1645           0 :       (let ((before-scroll (with-current-buffer buf point-before-scroll)))
    1646           0 :         (if before-scroll (goto-char before-scroll)))
    1647           0 :       (exchange-point-and-mark)
    1648           0 :       (mouse-set-region-1)
    1649           0 :       (when mouse-drag-copy-region
    1650           0 :         (kill-new (filter-buffer-substring (mark t) (point))))
    1651           0 :       (setq mouse-save-then-kill-posn click-pt)))))
    1652             : 
    1653             : 
    1654             : (global-set-key [M-mouse-1] 'mouse-start-secondary)
    1655             : (global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
    1656             : (global-set-key [M-down-mouse-1] 'mouse-drag-secondary)
    1657             : (global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill)
    1658             : (global-set-key [M-mouse-2] 'mouse-yank-secondary)
    1659             : 
    1660             : (defconst mouse-secondary-overlay
    1661             :   (let ((ol (make-overlay (point-min) (point-min))))
    1662             :     (delete-overlay ol)
    1663             :     (overlay-put ol 'face 'secondary-selection)
    1664             :     ol)
    1665             :   "An overlay which records the current secondary selection.
    1666             : It is deleted when there is no secondary selection.")
    1667             : 
    1668             : (defvar mouse-secondary-click-count 0)
    1669             : 
    1670             : ;; A marker which records the specified first end for a secondary selection.
    1671             : ;; May be nil.
    1672             : (defvar mouse-secondary-start nil)
    1673             : 
    1674             : (defun mouse-start-secondary (click)
    1675             :   "Set one end of the secondary selection to the position clicked on.
    1676             : Use \\[mouse-secondary-save-then-kill] to set the other end
    1677             : and complete the secondary selection."
    1678             :   (interactive "e")
    1679           0 :   (mouse-minibuffer-check click)
    1680           0 :   (let ((posn (event-start click)))
    1681           0 :     (with-current-buffer (window-buffer (posn-window posn))
    1682             :       ;; Cancel any preexisting secondary selection.
    1683           0 :       (delete-overlay mouse-secondary-overlay)
    1684           0 :       (if (numberp (posn-point posn))
    1685           0 :           (progn
    1686           0 :             (or mouse-secondary-start
    1687           0 :                 (setq mouse-secondary-start (make-marker)))
    1688           0 :             (move-marker mouse-secondary-start (posn-point posn)))))))
    1689             : 
    1690             : (defun mouse-set-secondary (click)
    1691             :   "Set the secondary selection to the text that the mouse is dragged over.
    1692             : This must be bound to a mouse drag event."
    1693             :   (interactive "e")
    1694           0 :   (mouse-minibuffer-check click)
    1695           0 :   (let ((posn (event-start click))
    1696             :         beg
    1697           0 :         (end (event-end click)))
    1698           0 :     (with-current-buffer (window-buffer (posn-window posn))
    1699           0 :       (if (numberp (posn-point posn))
    1700           0 :           (setq beg (posn-point posn)))
    1701           0 :       (move-overlay mouse-secondary-overlay beg (posn-point end))
    1702           0 :       (gui-set-selection
    1703             :        'SECONDARY
    1704           0 :        (buffer-substring (overlay-start mouse-secondary-overlay)
    1705           0 :                          (overlay-end mouse-secondary-overlay))))))
    1706             : 
    1707             : (defun mouse-drag-secondary (start-event)
    1708             :   "Set the secondary selection to the text that the mouse is dragged over.
    1709             : Highlight the drag area as you move the mouse.
    1710             : This must be bound to a button-down mouse event.
    1711             : The function returns a non-nil value if it creates a secondary selection."
    1712             :   (interactive "e")
    1713           0 :   (mouse-minibuffer-check start-event)
    1714           0 :   (let* ((echo-keystrokes 0)
    1715           0 :          (start-posn (event-start start-event))
    1716           0 :          (start-point (posn-point start-posn))
    1717           0 :          (start-window (posn-window start-posn))
    1718           0 :          (bounds (window-edges start-window))
    1719           0 :          (top (nth 1 bounds))
    1720           0 :          (bottom (if (window-minibuffer-p start-window)
    1721           0 :                      (nth 3 bounds)
    1722             :                    ;; Don't count the mode line.
    1723           0 :                    (1- (nth 3 bounds))))
    1724           0 :          (click-count (1- (event-click-count start-event))))
    1725           0 :     (with-current-buffer (window-buffer start-window)
    1726           0 :       (setq mouse-secondary-click-count click-count)
    1727           0 :       (if (> (mod click-count 3) 0)
    1728             :           ;; Double or triple press: make an initial selection
    1729             :           ;; of one word or line.
    1730           0 :           (let ((range (mouse-start-end start-point start-point click-count)))
    1731           0 :             (set-marker mouse-secondary-start nil)
    1732           0 :             (move-overlay mouse-secondary-overlay (car range) (nth 1 range)
    1733           0 :                           (window-buffer start-window)))
    1734             :         ;; Single-press: cancel any preexisting secondary selection.
    1735           0 :         (or mouse-secondary-start
    1736           0 :             (setq mouse-secondary-start (make-marker)))
    1737           0 :         (set-marker mouse-secondary-start start-point)
    1738           0 :         (delete-overlay mouse-secondary-overlay))
    1739             :       ;; FIXME: Use mouse-drag-track!
    1740           0 :       (let (event end end-point)
    1741           0 :         (track-mouse
    1742           0 :           (while (progn
    1743           0 :                    (setq event (read-event))
    1744           0 :                    (or (mouse-movement-p event)
    1745           0 :                        (memq (car-safe event) '(switch-frame select-window))))
    1746             : 
    1747           0 :             (if (memq (car-safe event) '(switch-frame select-window))
    1748             :                 nil
    1749           0 :               (setq end (event-end event)
    1750           0 :                     end-point (posn-point end))
    1751           0 :               (cond
    1752             :                ;; Are we moving within the original window?
    1753           0 :                ((and (eq (posn-window end) start-window)
    1754           0 :                      (integer-or-marker-p end-point))
    1755           0 :                 (let ((range (mouse-start-end start-point end-point
    1756           0 :                                               click-count)))
    1757           0 :                   (if (or (/= start-point end-point)
    1758           0 :                           (null (marker-position mouse-secondary-start)))
    1759           0 :                       (progn
    1760           0 :                         (set-marker mouse-secondary-start nil)
    1761           0 :                         (move-overlay mouse-secondary-overlay
    1762           0 :                                       (car range) (nth 1 range))))))
    1763             :                (t
    1764           0 :                 (let ((mouse-row (cdr (cdr (mouse-position)))))
    1765           0 :                   (cond
    1766           0 :                    ((null mouse-row))
    1767           0 :                    ((< mouse-row top)
    1768           0 :                     (mouse-scroll-subr start-window (- mouse-row top)
    1769           0 :                                        mouse-secondary-overlay start-point))
    1770           0 :                    ((>= mouse-row bottom)
    1771           0 :                     (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
    1772           0 :                                        mouse-secondary-overlay start-point)))))))))
    1773             : 
    1774           0 :         (if (consp event)
    1775           0 :             (if (marker-position mouse-secondary-start)
    1776           0 :                 (save-window-excursion
    1777           0 :                   (delete-overlay mouse-secondary-overlay)
    1778           0 :                   (gui-set-selection 'SECONDARY nil)
    1779           0 :                   (select-window start-window)
    1780           0 :                   (save-excursion
    1781           0 :                     (goto-char mouse-secondary-start)
    1782           0 :                     (sit-for 1)
    1783           0 :                     nil))
    1784           0 :               (gui-set-selection
    1785             :                'SECONDARY
    1786           0 :                (buffer-substring (overlay-start mouse-secondary-overlay)
    1787           0 :                                  (overlay-end mouse-secondary-overlay)))))))))
    1788             : 
    1789             : (defun mouse-yank-secondary (click)
    1790             :   "Insert the secondary selection at the position clicked on.
    1791             : Move point to the end of the inserted text.
    1792             : If `mouse-yank-at-point' is non-nil, insert at point
    1793             : regardless of where you click."
    1794             :   (interactive "e")
    1795             :   ;; Give temporary modes such as isearch a chance to turn off.
    1796           0 :   (run-hooks 'mouse-leave-buffer-hook)
    1797           0 :   (or mouse-yank-at-point (mouse-set-point click))
    1798           0 :   (let ((secondary (gui-get-selection 'SECONDARY)))
    1799           0 :     (if secondary
    1800           0 :         (insert-for-yank secondary)
    1801           0 :       (error "No secondary selection"))))
    1802             : 
    1803             : (defun mouse-kill-secondary ()
    1804             :   "Kill the text in the secondary selection.
    1805             : This is intended more as a keyboard command than as a mouse command
    1806             : but it can work as either one.
    1807             : 
    1808             : The current buffer (in case of keyboard use), or the buffer clicked on,
    1809             : must be the one that the secondary selection is in.  This requirement
    1810             : is to prevent accidents."
    1811             :   (interactive)
    1812           0 :   (let* ((keys (this-command-keys))
    1813           0 :          (click (elt keys (1- (length keys)))))
    1814           0 :     (or (eq (overlay-buffer mouse-secondary-overlay)
    1815           0 :             (if (listp click)
    1816           0 :                 (window-buffer (posn-window (event-start click)))
    1817           0 :               (current-buffer)))
    1818           0 :         (error "Select or click on the buffer where the secondary selection is")))
    1819           0 :   (let (this-command)
    1820           0 :     (with-current-buffer (overlay-buffer mouse-secondary-overlay)
    1821           0 :       (kill-region (overlay-start mouse-secondary-overlay)
    1822           0 :                    (overlay-end mouse-secondary-overlay))))
    1823           0 :   (delete-overlay mouse-secondary-overlay))
    1824             : 
    1825             : (defun mouse-secondary-save-then-kill (click)
    1826             :   "Set the secondary selection and save it to the kill ring.
    1827             : The second time, kill it.  CLICK should be a mouse click event.
    1828             : 
    1829             : If you have not called `mouse-start-secondary' in the clicked
    1830             : buffer, activate the secondary selection and set it between point
    1831             : and the click position CLICK.
    1832             : 
    1833             : Otherwise, adjust the bounds of the secondary selection.
    1834             : Normally, do this by moving its beginning or end, whichever is
    1835             : closer, to CLICK.  But if you have selected whole words or lines,
    1836             : adjust to the word or line boundary closest to CLICK instead.
    1837             : 
    1838             : If this command is called a second consecutive time with the same
    1839             : CLICK position, kill the secondary selection."
    1840             :   (interactive "e")
    1841           0 :   (mouse-minibuffer-check click)
    1842           0 :   (let* ((posn     (event-start click))
    1843           0 :          (click-pt (posn-point posn))
    1844           0 :          (window   (posn-window posn))
    1845           0 :          (buf      (window-buffer window))
    1846             :          ;; Don't let a subsequent kill command append to this one.
    1847           0 :          (this-command this-command)
    1848             :          ;; Check if the user has multi-clicked to select words/lines.
    1849             :          (click-count
    1850           0 :           (if (eq (overlay-buffer mouse-secondary-overlay) buf)
    1851           0 :               mouse-secondary-click-count
    1852           0 :             0))
    1853           0 :          (beg (overlay-start mouse-secondary-overlay))
    1854           0 :          (end (overlay-end mouse-secondary-overlay)))
    1855             : 
    1856           0 :     (cond
    1857           0 :      ((not (numberp click-pt)) nil)
    1858             : 
    1859             :      ;; If the secondary selection is not active in BUF, activate it.
    1860           0 :      ((not (eq buf (or (overlay-buffer mouse-secondary-overlay)
    1861           0 :                        (if mouse-secondary-start
    1862           0 :                            (marker-buffer mouse-secondary-start)))))
    1863           0 :       (select-window window)
    1864           0 :       (setq mouse-secondary-start (make-marker))
    1865           0 :       (move-marker mouse-secondary-start (point))
    1866           0 :       (move-overlay mouse-secondary-overlay (point) click-pt buf)
    1867           0 :       (kill-ring-save (point) click-pt))
    1868             : 
    1869             :      ;; If the user clicked without moving point, delete the secondary
    1870             :      ;; selection.  This also resets `mouse-secondary-click-count'.
    1871           0 :      ((and (eq last-command 'mouse-secondary-save-then-kill)
    1872           0 :            (eq click-pt mouse-save-then-kill-posn)
    1873           0 :            (eq window (selected-window)))
    1874           0 :       (mouse-save-then-kill-delete-region beg end)
    1875           0 :       (delete-overlay mouse-secondary-overlay)
    1876           0 :       (setq mouse-secondary-click-count 0)
    1877           0 :       (setq mouse-save-then-kill-posn nil))
    1878             : 
    1879             :      ;; Otherwise, if there is a suitable secondary selection overlay,
    1880             :      ;; adjust it by moving one end (whichever is closer) to CLICK-PT.
    1881           0 :      ((and beg (eq buf (overlay-buffer mouse-secondary-overlay)))
    1882           0 :       (let* ((range (mouse-start-end click-pt click-pt click-count)))
    1883           0 :         (if (< (abs (- click-pt beg))
    1884           0 :                (abs (- click-pt end)))
    1885           0 :             (move-overlay mouse-secondary-overlay (car range) end)
    1886           0 :           (move-overlay mouse-secondary-overlay beg (nth 1 range))))
    1887           0 :       (setq deactivate-mark nil)
    1888           0 :       (if (eq last-command 'mouse-secondary-save-then-kill)
    1889             :           ;; If the front of the kill ring comes from an immediately
    1890             :           ;; previous use of this command, replace the entry.
    1891           0 :           (kill-new
    1892           0 :            (buffer-substring (overlay-start mouse-secondary-overlay)
    1893           0 :                              (overlay-end mouse-secondary-overlay))
    1894           0 :            t)
    1895           0 :         (let (deactivate-mark)
    1896           0 :           (copy-region-as-kill (overlay-start mouse-secondary-overlay)
    1897           0 :                                (overlay-end mouse-secondary-overlay))))
    1898           0 :       (setq mouse-save-then-kill-posn click-pt))
    1899             : 
    1900             :      ;; Otherwise, set the secondary selection overlay.
    1901             :      (t
    1902           0 :       (select-window window)
    1903           0 :       (if mouse-secondary-start
    1904             :           ;; All we have is one end of a selection, so put the other
    1905             :           ;; end here.
    1906           0 :           (let ((start (+ 0 mouse-secondary-start)))
    1907           0 :             (kill-ring-save start click-pt)
    1908           0 :             (move-overlay mouse-secondary-overlay start click-pt)))
    1909           0 :       (setq mouse-save-then-kill-posn click-pt))))
    1910             : 
    1911             :   ;; Finally, set the window system's secondary selection.
    1912           0 :   (let (str)
    1913           0 :     (and (overlay-buffer mouse-secondary-overlay)
    1914           0 :          (setq str (buffer-substring (overlay-start mouse-secondary-overlay)
    1915           0 :                                      (overlay-end mouse-secondary-overlay)))
    1916           0 :          (> (length str) 0)
    1917           0 :          (gui-set-selection 'SECONDARY str))))
    1918             : 
    1919             : 
    1920             : (defcustom mouse-buffer-menu-maxlen 20
    1921             :   "Number of buffers in one pane (submenu) of the buffer menu.
    1922             : If we have lots of buffers, divide them into groups of
    1923             : `mouse-buffer-menu-maxlen' and make a pane (or submenu) for each one."
    1924             :   :type 'integer
    1925             :   :group 'mouse)
    1926             : 
    1927             : (defcustom mouse-buffer-menu-mode-mult 4
    1928             :   "Group the buffers by the major mode groups on \\[mouse-buffer-menu]?
    1929             : This number which determines (in a hairy way) whether \\[mouse-buffer-menu]
    1930             : will split the buffer menu by the major modes (see
    1931             : `mouse-buffer-menu-mode-groups') or just by menu length.
    1932             : Set to 1 (or even 0!) if you want to group by major mode always, and to
    1933             : a large number if you prefer a mixed multitude.  The default is 4."
    1934             :   :type 'integer
    1935             :   :group 'mouse
    1936             :   :version "20.3")
    1937             : 
    1938             : (defvar mouse-buffer-menu-mode-groups
    1939             :   (mapcar (lambda (arg) (cons  (purecopy (car arg)) (purecopy (cdr arg))))
    1940             :   '(("Info\\|Help\\|Apropos\\|Man" . "Help")
    1941             :     ("\\bVM\\b\\|\\bMH\\b\\|Message\\|Mail\\|Group\\|Score\\|Summary\\|Article"
    1942             :      . "Mail/News")
    1943             :     ("\\<C\\>" . "C")
    1944             :     ("ObjC" . "C")
    1945             :     ("Text" . "Text")
    1946             :     ("Outline" . "Text")
    1947             :     ("\\(HT\\|SG\\|X\\|XHT\\)ML" . "SGML")
    1948             :     ("log\\|diff\\|vc\\|cvs\\|Annotate" . "Version Control") ; "Change Management"?
    1949             :     ("Threads\\|Memory\\|Disassembly\\|Breakpoints\\|Frames\\|Locals\\|Registers\\|Inferior I/O\\|Debugger"
    1950             :      . "GDB")
    1951             :     ("Lisp" . "Lisp")))
    1952             :   "How to group various major modes together in \\[mouse-buffer-menu].
    1953             : Each element has the form (REGEXP . GROUPNAME).
    1954             : If the major mode's name string matches REGEXP, use GROUPNAME instead.")
    1955             : 
    1956             : (defun mouse-buffer-menu (event)
    1957             :   "Pop up a menu of buffers for selection with the mouse.
    1958             : This switches buffers in the window that you clicked on,
    1959             : and selects that window."
    1960             :   (interactive "e")
    1961           0 :   (mouse-minibuffer-check event)
    1962           0 :   (let ((buf (x-popup-menu event (mouse-buffer-menu-map)))
    1963           0 :         (window (posn-window (event-start event))))
    1964           0 :     (when buf
    1965           0 :       (select-window
    1966           0 :        (if (framep window) (frame-selected-window window)
    1967           0 :          window))
    1968           0 :       (switch-to-buffer buf))))
    1969             : 
    1970             : (defun mouse-buffer-menu-map ()
    1971             :   ;; Make an alist of elements that look like (MENU-ITEM . BUFFER).
    1972           0 :   (let ((buffers (buffer-list)) split-by-major-mode sum-of-squares)
    1973           0 :     (dolist (buf buffers)
    1974             :       ;; Divide all buffers into buckets for various major modes.
    1975             :       ;; Each bucket looks like (MODE NAMESTRING BUFFERS...).
    1976           0 :       (with-current-buffer buf
    1977           0 :         (let* ((adjusted-major-mode major-mode) elt)
    1978           0 :           (dolist (group mouse-buffer-menu-mode-groups)
    1979           0 :             (when (string-match (car group) (format-mode-line mode-name))
    1980           0 :               (setq adjusted-major-mode (cdr group))))
    1981           0 :           (setq elt (assoc adjusted-major-mode split-by-major-mode))
    1982           0 :           (unless elt
    1983           0 :             (setq elt (list adjusted-major-mode
    1984           0 :                             (if (stringp adjusted-major-mode)
    1985           0 :                                 adjusted-major-mode
    1986           0 :                               (format-mode-line mode-name nil nil buf)))
    1987           0 :                   split-by-major-mode (cons elt split-by-major-mode)))
    1988           0 :           (or (memq buf (cdr (cdr elt)))
    1989           0 :               (setcdr (cdr elt) (cons buf (cdr (cdr elt))))))))
    1990             :     ;; Compute the sum of squares of sizes of the major-mode buckets.
    1991           0 :     (let ((tail split-by-major-mode))
    1992           0 :       (setq sum-of-squares 0)
    1993           0 :       (while tail
    1994           0 :         (setq sum-of-squares
    1995           0 :               (+ sum-of-squares
    1996           0 :                  (let ((len (length (cdr (cdr (car tail)))))) (* len len))))
    1997           0 :         (setq tail (cdr tail))))
    1998           0 :     (if (< (* sum-of-squares mouse-buffer-menu-mode-mult)
    1999           0 :            (* (length buffers) (length buffers)))
    2000             :         ;; Subdividing by major modes really helps, so let's do it.
    2001           0 :         (let (subdivided-menus (buffers-left (length buffers)))
    2002             :           ;; Sort the list to put the most popular major modes first.
    2003           0 :           (setq split-by-major-mode
    2004           0 :                 (sort split-by-major-mode
    2005           0 :                       (function (lambda (elt1 elt2)
    2006           0 :                                   (> (length elt1) (length elt2))))))
    2007             :           ;; Make a separate submenu for each major mode
    2008             :           ;; that has more than one buffer,
    2009             :           ;; unless all the remaining buffers are less than 1/10 of them.
    2010           0 :           (while (and split-by-major-mode
    2011           0 :                       (and (> (length (car split-by-major-mode)) 3)
    2012           0 :                            (> (* buffers-left 10) (length buffers))))
    2013           0 :             (let ((this-mode-list (mouse-buffer-menu-alist
    2014           0 :                                    (cdr (cdr (car split-by-major-mode))))))
    2015           0 :               (and this-mode-list
    2016           0 :                    (setq subdivided-menus
    2017           0 :                          (cons (cons
    2018           0 :                                 (nth 1 (car split-by-major-mode))
    2019           0 :                                 this-mode-list)
    2020           0 :                                subdivided-menus))))
    2021           0 :             (setq buffers-left
    2022           0 :                   (- buffers-left (length (cdr (car split-by-major-mode)))))
    2023           0 :             (setq split-by-major-mode (cdr split-by-major-mode)))
    2024             :           ;; If any major modes are left over,
    2025             :           ;; make a single submenu for them.
    2026           0 :           (if split-by-major-mode
    2027           0 :               (let ((others-list
    2028           0 :                      (mouse-buffer-menu-alist
    2029             :                       ;; we don't need split-by-major-mode any more,
    2030             :                       ;; so we can ditch it with nconc (mapcan).
    2031           0 :                       (mapcan 'cddr split-by-major-mode))))
    2032           0 :                 (and others-list
    2033           0 :                      (setq subdivided-menus
    2034           0 :                            (cons (cons "Others" others-list)
    2035           0 :                                  subdivided-menus)))))
    2036           0 :           (cons "Buffer Menu" (nreverse subdivided-menus)))
    2037           0 :       (cons "Buffer Menu"
    2038           0 :             (mouse-buffer-menu-split "Select Buffer"
    2039           0 :                                      (mouse-buffer-menu-alist buffers))))))
    2040             : 
    2041             : (defun mouse-buffer-menu-alist (buffers)
    2042           0 :   (let (tail
    2043             :         (maxlen 0)
    2044             :         head)
    2045           0 :     (setq buffers
    2046           0 :           (sort buffers
    2047           0 :                 (function (lambda (elt1 elt2)
    2048           0 :                             (string< (buffer-name elt1) (buffer-name elt2))))))
    2049           0 :     (setq tail buffers)
    2050           0 :     (while tail
    2051           0 :       (or (eq ?\s (aref (buffer-name (car tail)) 0))
    2052           0 :           (setq maxlen
    2053           0 :                 (max maxlen
    2054           0 :                      (length (buffer-name (car tail))))))
    2055           0 :       (setq tail (cdr tail)))
    2056           0 :     (setq tail buffers)
    2057           0 :     (while tail
    2058           0 :       (let ((elt (car tail)))
    2059           0 :         (if (/= (aref (buffer-name elt) 0) ?\s)
    2060           0 :             (setq head
    2061           0 :                   (cons
    2062           0 :                    (cons
    2063           0 :                     (format
    2064           0 :                      (format "%%-%ds  %%s%%s  %%s" maxlen)
    2065           0 :                      (buffer-name elt)
    2066           0 :                      (if (buffer-modified-p elt) "*" " ")
    2067           0 :                      (with-current-buffer elt
    2068           0 :                        (if buffer-read-only "%" " "))
    2069           0 :                      (or (buffer-file-name elt)
    2070           0 :                          (with-current-buffer elt
    2071           0 :                            (if list-buffers-directory
    2072           0 :                                (expand-file-name
    2073           0 :                                 list-buffers-directory)))
    2074           0 :                          ""))
    2075           0 :                     elt)
    2076           0 :                    head))))
    2077           0 :       (setq tail (cdr tail)))
    2078             :     ;; Compensate for the reversal that the above loop does.
    2079           0 :     (nreverse head)))
    2080             : 
    2081             : (defun mouse-buffer-menu-split (title alist)
    2082             :   ;; If we have lots of buffers, divide them into groups of 20
    2083             :   ;; and make a pane (or submenu) for each one.
    2084           0 :   (if (> (length alist) (/ (* mouse-buffer-menu-maxlen 3) 2))
    2085           0 :       (let ((alist alist) sublists next
    2086             :             (i 1))
    2087           0 :         (while alist
    2088             :           ;; Pull off the next mouse-buffer-menu-maxlen buffers
    2089             :           ;; and make them the next element of sublist.
    2090           0 :           (setq next (nthcdr mouse-buffer-menu-maxlen alist))
    2091           0 :           (if next
    2092           0 :               (setcdr (nthcdr (1- mouse-buffer-menu-maxlen) alist)
    2093           0 :                       nil))
    2094           0 :           (setq sublists (cons (cons (format "Buffers %d" i) alist)
    2095           0 :                                sublists))
    2096           0 :           (setq i (1+ i))
    2097           0 :           (setq alist next))
    2098           0 :         (nreverse sublists))
    2099             :     ;; Few buffers--put them all in one pane.
    2100           0 :     (list (cons title alist))))
    2101             : 
    2102             : (define-obsolete-function-alias
    2103             :   'mouse-choose-completion 'choose-completion "23.2")
    2104             : 
    2105             : ;; Font selection.
    2106             : 
    2107             : (defun font-menu-add-default ()
    2108           0 :   (let* ((default (frame-parameter nil 'font))
    2109           0 :          (font-alist x-fixed-font-alist)
    2110           0 :          (elt (or (assoc "Misc" font-alist) (nth 1 font-alist))))
    2111           0 :     (if (assoc "Default" elt)
    2112           0 :         (delete (assoc "Default" elt) elt))
    2113           0 :     (setcdr elt
    2114           0 :             (cons (list "Default" default)
    2115           0 :                   (cdr elt)))))
    2116             : 
    2117             : (defvar x-fixed-font-alist
    2118             :   (list
    2119             :    (purecopy "Font Menu")
    2120             :    (cons
    2121             :     (purecopy "Misc")
    2122             :     (mapcar
    2123             :      (lambda (arg) (cons  (purecopy (car arg)) (purecopy (cdr arg))))
    2124             :      ;; For these, we specify the pixel height and width.
    2125             :     '(("fixed" "fixed")
    2126             :      ("6x10" "-misc-fixed-medium-r-normal--10-*-*-*-c-60-iso8859-1" "6x10")
    2127             :      ("6x12"
    2128             :       "-misc-fixed-medium-r-semicondensed--12-*-*-*-c-60-iso8859-1" "6x12")
    2129             :      ("6x13"
    2130             :       "-misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1" "6x13")
    2131             :      ("7x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-70-iso8859-1" "7x13")
    2132             :      ("7x14" "-misc-fixed-medium-r-normal--14-*-*-*-c-70-iso8859-1" "7x14")
    2133             :      ("8x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-80-iso8859-1" "8x13")
    2134             :      ("9x15" "-misc-fixed-medium-r-normal--15-*-*-*-c-90-iso8859-1" "9x15")
    2135             :      ("10x20" "-misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1" "10x20")
    2136             :      ("11x18" "-misc-fixed-medium-r-normal--18-*-*-*-c-110-iso8859-1" "11x18")
    2137             :      ("12x24" "-misc-fixed-medium-r-normal--24-*-*-*-c-120-iso8859-1" "12x24")
    2138             :      ("")
    2139             :      ("clean 5x8"
    2140             :       "-schumacher-clean-medium-r-normal--8-*-*-*-c-50-iso8859-1")
    2141             :      ("clean 6x8"
    2142             :       "-schumacher-clean-medium-r-normal--8-*-*-*-c-60-iso8859-1")
    2143             :      ("clean 8x8"
    2144             :       "-schumacher-clean-medium-r-normal--8-*-*-*-c-80-iso8859-1")
    2145             :      ("clean 8x10"
    2146             :       "-schumacher-clean-medium-r-normal--10-*-*-*-c-80-iso8859-1")
    2147             :      ("clean 8x14"
    2148             :       "-schumacher-clean-medium-r-normal--14-*-*-*-c-80-iso8859-1")
    2149             :      ("clean 8x16"
    2150             :       "-schumacher-clean-medium-r-normal--16-*-*-*-c-80-iso8859-1")
    2151             :      ("")
    2152             :      ("sony 8x16" "-sony-fixed-medium-r-normal--16-*-*-*-c-80-iso8859-1")
    2153             :      ;; We don't seem to have these; who knows what they are.
    2154             :      ;; ("fg-18" "fg-18")
    2155             :      ;; ("fg-25" "fg-25")
    2156             :      ("lucidasanstypewriter-12" "-b&h-lucidatypewriter-medium-r-normal-sans-*-120-*-*-*-*-iso8859-1")
    2157             :      ("lucidasanstypewriter-bold-14" "-b&h-lucidatypewriter-bold-r-normal-sans-*-140-*-*-*-*-iso8859-1")
    2158             :      ("lucidasanstypewriter-bold-24"
    2159             :       "-b&h-lucidatypewriter-bold-r-normal-sans-*-240-*-*-*-*-iso8859-1")
    2160             :      ;; ("lucidatypewriter-bold-r-24" "-b&h-lucidatypewriter-bold-r-normal-sans-24-240-75-75-m-140-iso8859-1")
    2161             :      ;; ("fixed-medium-20" "-misc-fixed-medium-*-*-*-20-*-*-*-*-*-*-*")
    2162             :      )))
    2163             : 
    2164             :    (cons
    2165             :     (purecopy "Courier")
    2166             :     (mapcar
    2167             :      (lambda (arg) (cons  (purecopy (car arg)) (purecopy (cdr arg))))
    2168             :      ;; For these, we specify the point height.
    2169             :      '(("8" "-adobe-courier-medium-r-normal--*-80-*-*-m-*-iso8859-1")
    2170             :      ("10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-iso8859-1")
    2171             :      ("12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-iso8859-1")
    2172             :      ("14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-iso8859-1")
    2173             :      ("18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-iso8859-1")
    2174             :      ("24" "-adobe-courier-medium-r-normal--*-240-*-*-m-*-iso8859-1")
    2175             :      ("8 bold" "-adobe-courier-bold-r-normal--*-80-*-*-m-*-iso8859-1")
    2176             :      ("10 bold" "-adobe-courier-bold-r-normal--*-100-*-*-m-*-iso8859-1")
    2177             :      ("12 bold" "-adobe-courier-bold-r-normal--*-120-*-*-m-*-iso8859-1")
    2178             :      ("14 bold" "-adobe-courier-bold-r-normal--*-140-*-*-m-*-iso8859-1")
    2179             :      ("18 bold" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-iso8859-1")
    2180             :      ("24 bold" "-adobe-courier-bold-r-normal--*-240-*-*-m-*-iso8859-1")
    2181             :      ("8 slant" "-adobe-courier-medium-o-normal--*-80-*-*-m-*-iso8859-1")
    2182             :      ("10 slant" "-adobe-courier-medium-o-normal--*-100-*-*-m-*-iso8859-1")
    2183             :      ("12 slant" "-adobe-courier-medium-o-normal--*-120-*-*-m-*-iso8859-1")
    2184             :      ("14 slant" "-adobe-courier-medium-o-normal--*-140-*-*-m-*-iso8859-1")
    2185             :      ("18 slant" "-adobe-courier-medium-o-normal--*-180-*-*-m-*-iso8859-1")
    2186             :      ("24 slant" "-adobe-courier-medium-o-normal--*-240-*-*-m-*-iso8859-1")
    2187             :      ("8 bold slant" "-adobe-courier-bold-o-normal--*-80-*-*-m-*-iso8859-1")
    2188             :      ("10 bold slant" "-adobe-courier-bold-o-normal--*-100-*-*-m-*-iso8859-1")
    2189             :      ("12 bold slant" "-adobe-courier-bold-o-normal--*-120-*-*-m-*-iso8859-1")
    2190             :      ("14 bold slant" "-adobe-courier-bold-o-normal--*-140-*-*-m-*-iso8859-1")
    2191             :      ("18 bold slant" "-adobe-courier-bold-o-normal--*-180-*-*-m-*-iso8859-1")
    2192             :      ("24 bold slant" "-adobe-courier-bold-o-normal--*-240-*-*-m-*-iso8859-1")
    2193             :     ))))
    2194             :   "X fonts suitable for use in Emacs.")
    2195             : 
    2196             : (declare-function generate-fontset-menu "fontset" ())
    2197             : 
    2198             : (defun mouse-select-font ()
    2199             :   "Prompt for a font name, using `x-popup-menu', and return it."
    2200             :   (interactive)
    2201           0 :   (unless (display-multi-font-p)
    2202           0 :     (error "Cannot change fonts on this display"))
    2203           0 :   (car
    2204           0 :    (x-popup-menu
    2205           0 :     (if (listp last-nonmenu-event)
    2206           0 :         last-nonmenu-event
    2207           0 :       (list '(0 0) (selected-window)))
    2208           0 :     (append x-fixed-font-alist
    2209           0 :             (list (generate-fontset-menu))))))
    2210             : 
    2211             : (declare-function text-scale-mode "face-remap")
    2212             : 
    2213             : (defun mouse-set-font (&rest fonts)
    2214             :   "Set the default font for the selected frame.
    2215             : The argument FONTS is a list of font names; the first valid font
    2216             : in this list is used.
    2217             : 
    2218             : When called interactively, pop up a menu and allow the user to
    2219             : choose a font."
    2220             :   (interactive
    2221           0 :    (progn (unless (display-multi-font-p)
    2222           0 :             (error "Cannot change fonts on this display"))
    2223           0 :           (x-popup-menu
    2224           0 :            (if (listp last-nonmenu-event)
    2225           0 :                last-nonmenu-event
    2226           0 :              (list '(0 0) (selected-window)))
    2227             :            ;; Append list of fontsets currently defined.
    2228           0 :            (append x-fixed-font-alist (list (generate-fontset-menu))))))
    2229           0 :   (if fonts
    2230           0 :       (let (font)
    2231           0 :         (while fonts
    2232           0 :           (condition-case nil
    2233           0 :               (progn
    2234           0 :                 (set-frame-font (car fonts))
    2235           0 :                 (setq font (car fonts))
    2236           0 :                 (setq fonts nil))
    2237             :             (error
    2238           0 :              (setq fonts (cdr fonts)))))
    2239           0 :         (if (null font)
    2240           0 :             (error "Font not found")))))
    2241             : 
    2242             : (defvar mouse-appearance-menu-map nil)
    2243             : (declare-function x-select-font "xfns.c" (&optional frame ignored)) ; USE_GTK
    2244             : (declare-function buffer-face-mode-invoke "face-remap"
    2245             :                   (face arg &optional interactive))
    2246             : (declare-function font-face-attributes "font.c" (font &optional frame))
    2247             : (defvar w32-use-w32-font-dialog)
    2248             : (defvar w32-fixed-font-alist)
    2249             : 
    2250             : (defun mouse-appearance-menu (event)
    2251             :   "Show a menu for changing the default face in the current buffer."
    2252             :   (interactive "@e")
    2253           0 :   (require 'face-remap)
    2254           0 :   (when (display-multi-font-p)
    2255           0 :     (with-selected-window (car (event-start event))
    2256           0 :       (if mouse-appearance-menu-map
    2257             :           nil ; regenerate new fonts
    2258             :         ;; Initialize mouse-appearance-menu-map
    2259           0 :         (setq mouse-appearance-menu-map
    2260           0 :               (make-sparse-keymap "Change Default Buffer Face"))
    2261           0 :         (define-key mouse-appearance-menu-map [face-remap-reset-base]
    2262           0 :           '(menu-item "Reset to Default" face-remap-reset-base))
    2263           0 :         (define-key mouse-appearance-menu-map [text-scale-decrease]
    2264           0 :           '(menu-item "Decrease Buffer Text Size" text-scale-decrease))
    2265           0 :         (define-key mouse-appearance-menu-map [text-scale-increase]
    2266           0 :           '(menu-item "Increase Buffer Text Size" text-scale-increase))
    2267             :         ;; Font selector
    2268           0 :         (if (and (functionp 'x-select-font)
    2269           0 :                  (or (not (boundp 'w32-use-w32-font-dialog))
    2270           0 :                      w32-use-w32-font-dialog))
    2271           0 :             (define-key mouse-appearance-menu-map [x-select-font]
    2272           0 :               '(menu-item "Change Buffer Font..." x-select-font))
    2273             :           ;; If the select-font is unavailable, construct a menu.
    2274           0 :           (let ((font-submenu (make-sparse-keymap "Change Text Font"))
    2275           0 :                 (font-alist (cdr (append
    2276           0 :                                   (if (eq system-type 'windows-nt)
    2277           0 :                                       w32-fixed-font-alist
    2278           0 :                                     x-fixed-font-alist)
    2279           0 :                                   (list (generate-fontset-menu))))))
    2280           0 :             (dolist (family font-alist)
    2281           0 :               (let* ((submenu-name (car family))
    2282           0 :                      (submenu-map (make-sparse-keymap submenu-name)))
    2283           0 :                 (dolist (font (cdr family))
    2284           0 :                   (let ((font-name (car font))
    2285             :                         font-symbol)
    2286           0 :                     (if (string= font-name "")
    2287           0 :                         (define-key submenu-map [space]
    2288           0 :                           '("--"))
    2289           0 :                       (setq font-symbol (intern (cadr font)))
    2290           0 :                       (define-key submenu-map (vector font-symbol)
    2291           0 :                         (list 'menu-item (car font) font-symbol)))))
    2292           0 :                 (define-key font-submenu (vector (intern submenu-name))
    2293           0 :                   (list 'menu-item submenu-name submenu-map))))
    2294           0 :             (define-key mouse-appearance-menu-map [font-submenu]
    2295           0 :               (list 'menu-item "Change Text Font" font-submenu)))))
    2296           0 :       (let ((choice (x-popup-menu event mouse-appearance-menu-map)))
    2297           0 :         (setq choice (nth (1- (length choice)) choice))
    2298           0 :         (cond ((eq choice 'text-scale-increase)
    2299           0 :                (text-scale-increase 1))
    2300           0 :               ((eq choice 'text-scale-decrease)
    2301           0 :                (text-scale-increase -1))
    2302           0 :               ((eq choice 'face-remap-reset-base)
    2303           0 :                (text-scale-mode 0)
    2304           0 :                (buffer-face-mode 0))
    2305           0 :               (choice
    2306             :                ;; Either choice == 'x-select-font, or choice is a
    2307             :                ;; symbol whose name is a font.
    2308           0 :                (let ((font (if (eq choice 'x-select-font)
    2309           0 :                                (x-select-font)
    2310           0 :                              (symbol-name choice))))
    2311           0 :                  (buffer-face-mode-invoke
    2312           0 :                   (if (fontp font 'font-spec)
    2313           0 :                       (list :font font)
    2314           0 :                     (font-face-attributes font))
    2315           0 :                   t (called-interactively-p 'interactive)))))))))
    2316             : 
    2317             : 
    2318             : ;; Drag and drop support.
    2319             : (defcustom mouse-drag-and-drop-region nil
    2320             :   "If non-nil, dragging the mouse drags the region, if that exists.
    2321             : If the value is a modifier, such as `control' or `shift' or `meta',
    2322             : then if that modifier key is pressed when dropping the region, region
    2323             : text is copied instead of being cut."
    2324             :   :type 'symbol
    2325             :   :version "26.1"
    2326             :   :group 'mouse)
    2327             : 
    2328             : (defun mouse-drag-and-drop-region (event)
    2329             :   "Move text in the region to point where mouse is dragged to.
    2330             : The transportation of text is also referred as `drag and drop'.
    2331             : When text is dragged over to a different buffer, or if a
    2332             : modifier key was pressed when dropping, and the value of the
    2333             : variable `mouse-drag-and-drop-region' is that modifier, the text
    2334             : is copied instead of being cut."
    2335             :   (interactive "e")
    2336           0 :   (require 'tooltip)
    2337           0 :   (let ((start (region-beginning))
    2338           0 :         (end (region-end))
    2339           0 :         (point (point))
    2340           0 :         (buffer (current-buffer))
    2341           0 :         (window (selected-window))
    2342             :         value-selection)
    2343           0 :     (track-mouse
    2344             :       ;; When event was click instead of drag, skip loop
    2345           0 :       (while (progn
    2346           0 :                (setq event (read-event))
    2347           0 :                (mouse-movement-p event))
    2348           0 :         (unless value-selection ; initialization
    2349           0 :           (delete-overlay mouse-secondary-overlay)
    2350           0 :           (setq value-selection (buffer-substring start end))
    2351           0 :           (move-overlay mouse-secondary-overlay start end)) ; (deactivate-mark)
    2352           0 :         (ignore-errors (deactivate-mark) ; care existing region in other window
    2353           0 :                        (mouse-set-point event)
    2354           0 :                        (tooltip-show value-selection)))
    2355           0 :       (tooltip-hide))
    2356             :     ;; Do not modify buffer under mouse when "event was click",
    2357             :     ;;                                       "drag negligible", or
    2358             :     ;;                                       "drag to read-only".
    2359           0 :     (if (or (equal (mouse-posn-property (event-end event) 'face) 'region) ; "event was click"
    2360           0 :             (member 'secondary-selection ; "drag negligible"
    2361           0 :                     (mapcar (lambda (xxx) (overlay-get xxx 'face))
    2362           0 :                             (overlays-at (posn-point (event-end event)))))
    2363           0 :             buffer-read-only)
    2364             :         ;; Do not modify buffer under mouse.
    2365           0 :         (cond
    2366             :          ;; "drag negligible" or "drag to read-only", restore region.
    2367           0 :          (value-selection
    2368           0 :           (select-window window) ; In case miss drag to other window
    2369           0 :           (goto-char point)
    2370           0 :           (setq deactivate-mark nil)
    2371           0 :           (activate-mark))
    2372             :          ;; "event was click"
    2373             :          (t
    2374           0 :           (deactivate-mark)
    2375           0 :           (mouse-set-point event)))
    2376             :       ;; Modify buffer under mouse by inserting text.
    2377           0 :       (push-mark)
    2378           0 :       (insert value-selection)
    2379           0 :       (when (not (equal (mark) (point))) ; on success insert
    2380           0 :         (setq deactivate-mark nil)
    2381           0 :         (activate-mark)) ; have region on destination
    2382             :       ;; Take care of initial region on source.
    2383           0 :       (if (equal (current-buffer) buffer) ; when same buffer
    2384           0 :           (let (deactivate-mark) ; remove text
    2385           0 :             (unless (member mouse-drag-and-drop-region (event-modifiers event))
    2386           0 :               (kill-region (overlay-start mouse-secondary-overlay)
    2387           0 :                            (overlay-end mouse-secondary-overlay))))
    2388           0 :         (let ((window1 (selected-window))) ; when beyond buffer
    2389           0 :           (select-window window)
    2390           0 :           (goto-char point) ; restore point on source window
    2391           0 :           (activate-mark) ; restore region
    2392           0 :           (select-window window1))))
    2393           0 :     (delete-overlay mouse-secondary-overlay)))
    2394             : 
    2395             : 
    2396             : ;;; Bindings for mouse commands.
    2397             : 
    2398             : (global-set-key [down-mouse-1]  'mouse-drag-region)
    2399             : (global-set-key [mouse-1]       'mouse-set-point)
    2400             : (global-set-key [drag-mouse-1]  'mouse-set-region)
    2401             : 
    2402             : (defun mouse--strip-first-event (_prompt)
    2403           0 :   (substring (this-single-command-raw-keys) 1))
    2404             : 
    2405             : (define-key function-key-map [left-fringe mouse-1] 'mouse--strip-first-event)
    2406             : (define-key function-key-map [right-fringe mouse-1] 'mouse--strip-first-event)
    2407             : 
    2408             : (global-set-key [mouse-2]       'mouse-yank-primary)
    2409             : ;; Allow yanking also when the corresponding cursor is "in the fringe".
    2410             : (define-key function-key-map [right-fringe mouse-2] 'mouse--strip-first-event)
    2411             : (define-key function-key-map [left-fringe mouse-2] 'mouse--strip-first-event)
    2412             : (global-set-key [mouse-3]       'mouse-save-then-kill)
    2413             : (define-key function-key-map [right-fringe mouse-3] 'mouse--strip-first-event)
    2414             : (define-key function-key-map [left-fringe mouse-3] 'mouse--strip-first-event)
    2415             : 
    2416             : ;; By binding these to down-going events, we let the user use the up-going
    2417             : ;; event to make the selection, saving a click.
    2418             : (global-set-key [C-down-mouse-1] 'mouse-buffer-menu)
    2419             : (if (not (eq system-type 'ms-dos))
    2420             :     (global-set-key [S-down-mouse-1] 'mouse-appearance-menu))
    2421             : ;; C-down-mouse-2 is bound in facemenu.el.
    2422             : (global-set-key [C-down-mouse-3]
    2423             :   `(menu-item ,(purecopy "Menu Bar") ignore
    2424             :     :filter (lambda (_)
    2425             :               (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))
    2426             :                   (mouse-menu-bar-map)
    2427             :                 (mouse-menu-major-mode-map)))))
    2428             : 
    2429             : ;; Binding mouse-1 to mouse-select-window when on mode-, header-, or
    2430             : ;; vertical-line prevents Emacs from signaling an error when the mouse
    2431             : ;; button is released after dragging these lines, on non-toolkit
    2432             : ;; versions.
    2433             : (global-set-key [header-line down-mouse-1] 'mouse-drag-header-line)
    2434             : (global-set-key [header-line mouse-1] 'mouse-select-window)
    2435             : ;; (global-set-key [mode-line drag-mouse-1] 'mouse-select-window)
    2436             : (global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line)
    2437             : (global-set-key [mode-line mouse-1] 'mouse-select-window)
    2438             : (global-set-key [mode-line mouse-2] 'mouse-delete-other-windows)
    2439             : (global-set-key [mode-line mouse-3] 'mouse-delete-window)
    2440             : (global-set-key [mode-line C-mouse-2] 'mouse-split-window-horizontally)
    2441             : (global-set-key [vertical-scroll-bar C-mouse-2] 'mouse-split-window-vertically)
    2442             : (global-set-key [horizontal-scroll-bar C-mouse-2] 'mouse-split-window-horizontally)
    2443             : (global-set-key [vertical-line down-mouse-1] 'mouse-drag-vertical-line)
    2444             : (global-set-key [vertical-line mouse-1] 'mouse-select-window)
    2445             : (global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically)
    2446             : (global-set-key [right-divider down-mouse-1] 'mouse-drag-vertical-line)
    2447             : (global-set-key [right-divider mouse-1] 'ignore)
    2448             : (global-set-key [right-divider C-mouse-2] 'mouse-split-window-vertically)
    2449             : (global-set-key [bottom-divider down-mouse-1] 'mouse-drag-mode-line)
    2450             : (global-set-key [bottom-divider mouse-1] 'ignore)
    2451             : (global-set-key [bottom-divider C-mouse-2] 'mouse-split-window-horizontally)
    2452             : (global-set-key [left-edge down-mouse-1] 'mouse-drag-left-edge)
    2453             : (global-set-key [left-edge mouse-1] 'ignore)
    2454             : (global-set-key [top-left-corner down-mouse-1] 'mouse-drag-top-left-corner)
    2455             : (global-set-key [top-left-corner mouse-1] 'ignore)
    2456             : (global-set-key [top-edge down-mouse-1] 'mouse-drag-top-edge)
    2457             : (global-set-key [top-edge mouse-1] 'ignore)
    2458             : (global-set-key [top-right-corner down-mouse-1] 'mouse-drag-top-right-corner)
    2459             : (global-set-key [top-right-corner mouse-1] 'ignore)
    2460             : (global-set-key [right-edge down-mouse-1] 'mouse-drag-right-edge)
    2461             : (global-set-key [right-edge mouse-1] 'ignore)
    2462             : (global-set-key [bottom-right-corner down-mouse-1] 'mouse-drag-bottom-right-corner)
    2463             : (global-set-key [bottom-right-corner mouse-1] 'ignore)
    2464             : (global-set-key [bottom-edge down-mouse-1] 'mouse-drag-bottom-edge)
    2465             : (global-set-key [bottom-edge mouse-1] 'ignore)
    2466             : (global-set-key [bottom-left-corner down-mouse-1] 'mouse-drag-bottom-left-corner)
    2467             : (global-set-key [bottom-left-corner mouse-1] 'ignore)
    2468             : 
    2469             : (provide 'mouse)
    2470             : 
    2471             : ;;; mouse.el ends here

Generated by: LCOV version 1.12