2012-08-10 14:47:12 +00:00
|
|
|
|
;;; mouse.el --- window system-independent mouse support -*- lexical-binding: t -*-
|
1992-07-16 04:23:17 +00:00
|
|
|
|
|
2013-01-01 09:11:05 +00:00
|
|
|
|
;; Copyright (C) 1993-1995, 1999-2013 Free Software Foundation, Inc.
|
1992-07-22 02:58:21 +00:00
|
|
|
|
|
1992-07-16 04:23:17 +00:00
|
|
|
|
;; Maintainer: FSF
|
2000-07-19 15:52:02 +00:00
|
|
|
|
;; Keywords: hardware, mouse
|
2010-08-29 16:17:13 +00:00
|
|
|
|
;; Package: emacs
|
1992-07-16 04:23:17 +00:00
|
|
|
|
|
1995-10-30 17:35:01 +00:00
|
|
|
|
;; This file is part of GNU Emacs.
|
1990-06-19 20:28:34 +00:00
|
|
|
|
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
1995-10-30 17:35:01 +00:00
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
|
;; (at your option) any later version.
|
1990-06-19 20:28:34 +00:00
|
|
|
|
|
1995-10-30 17:35:01 +00:00
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
|
;; GNU General Public License for more details.
|
1990-06-19 20:28:34 +00:00
|
|
|
|
|
1995-10-30 17:35:01 +00:00
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
1990-06-19 20:28:34 +00:00
|
|
|
|
|
1993-03-22 05:42:35 +00:00
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
|
|
;; This package provides various useful commands (including help
|
|
|
|
|
|
;; system access) through the mouse. All this code assumes that mouse
|
|
|
|
|
|
;; interpretation has been abstracted into Emacs input events.
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; The code is rather X-dependent.
|
|
|
|
|
|
|
1993-03-17 16:56:02 +00:00
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
1991-12-20 07:15:37 +00:00
|
|
|
|
;;; Utility functions.
|
1990-06-19 20:28:34 +00:00
|
|
|
|
|
2008-04-01 08:35:58 +00:00
|
|
|
|
;; Indent track-mouse like progn.
|
1991-12-20 07:15:37 +00:00
|
|
|
|
(put 'track-mouse 'lisp-indent-function 0)
|
1990-06-19 20:28:34 +00:00
|
|
|
|
|
1997-05-03 22:19:10 +00:00
|
|
|
|
(defcustom mouse-yank-at-point nil
|
2008-12-03 05:48:14 +00:00
|
|
|
|
"If non-nil, mouse yank commands yank at point instead of at click."
|
1997-05-03 22:19:10 +00:00
|
|
|
|
:type 'boolean
|
|
|
|
|
|
:group 'mouse)
|
2004-04-30 21:37:43 +00:00
|
|
|
|
|
2010-07-14 18:03:39 +00:00
|
|
|
|
(defcustom mouse-drag-copy-region nil
|
2010-09-05 22:40:57 +00:00
|
|
|
|
"If non-nil, copy to kill-ring upon mouse adjustments of the region.
|
|
|
|
|
|
|
|
|
|
|
|
This affects `mouse-save-then-kill' (\\[mouse-save-then-kill]) in
|
|
|
|
|
|
addition to mouse drags."
|
2004-04-30 21:37:43 +00:00
|
|
|
|
:type 'boolean
|
2010-07-17 02:49:48 +00:00
|
|
|
|
:version "24.1"
|
2004-04-30 21:37:43 +00:00
|
|
|
|
:group 'mouse)
|
|
|
|
|
|
|
2005-03-31 10:10:25 +00:00
|
|
|
|
(defcustom mouse-1-click-follows-link 450
|
2004-12-19 00:50:51 +00:00
|
|
|
|
"Non-nil means that clicking Mouse-1 on a link follows the link.
|
2004-12-17 15:16:18 +00:00
|
|
|
|
|
2004-12-19 00:50:51 +00:00
|
|
|
|
With the default setting, an ordinary Mouse-1 click on a link
|
|
|
|
|
|
performs the same action as Mouse-2 on that link, while a longer
|
2005-10-16 16:50:00 +00:00
|
|
|
|
Mouse-1 click \(hold down the Mouse-1 button for more than 450
|
2004-12-19 00:50:51 +00:00
|
|
|
|
milliseconds) performs the original Mouse-1 binding \(which
|
2004-12-17 15:16:18 +00:00
|
|
|
|
typically sets point where you click the mouse).
|
|
|
|
|
|
|
|
|
|
|
|
If value is an integer, the time elapsed between pressing and
|
|
|
|
|
|
releasing the mouse button determines whether to follow the link
|
2004-12-19 00:50:51 +00:00
|
|
|
|
or perform the normal Mouse-1 action (typically set point).
|
2011-12-31 01:27:15 +00:00
|
|
|
|
The absolute numeric value specifies the maximum duration of a
|
2004-12-17 15:16:18 +00:00
|
|
|
|
\"short click\" in milliseconds. A positive value means that a
|
|
|
|
|
|
short click follows the link, and a longer click performs the
|
2005-06-10 14:05:55 +00:00
|
|
|
|
normal action. A negative value gives the opposite behavior.
|
2004-12-17 15:16:18 +00:00
|
|
|
|
|
|
|
|
|
|
If value is `double', a double click follows the link.
|
|
|
|
|
|
|
2004-12-19 00:50:51 +00:00
|
|
|
|
Otherwise, a single Mouse-1 click unconditionally follows the link.
|
2004-12-17 15:16:18 +00:00
|
|
|
|
|
|
|
|
|
|
Note that dragging the mouse never follows the link.
|
|
|
|
|
|
|
|
|
|
|
|
This feature only works in modes that specifically identify
|
|
|
|
|
|
clickable text as links, so it may not work with some external
|
|
|
|
|
|
packages. See `mouse-on-link-p' for details."
|
2005-02-09 15:50:47 +00:00
|
|
|
|
:version "22.1"
|
2004-12-17 15:16:18 +00:00
|
|
|
|
:type '(choice (const :tag "Disabled" nil)
|
|
|
|
|
|
(const :tag "Double click" double)
|
2005-10-16 16:50:00 +00:00
|
|
|
|
(number :tag "Single click time limit" :value 450)
|
2004-12-17 15:16:18 +00:00
|
|
|
|
(other :tag "Single click" t))
|
|
|
|
|
|
:group 'mouse)
|
|
|
|
|
|
|
2005-02-25 23:30:59 +00:00
|
|
|
|
(defcustom mouse-1-click-in-non-selected-windows t
|
2008-12-03 05:48:14 +00:00
|
|
|
|
"If non-nil, a Mouse-1 click also follows links in non-selected windows.
|
2005-02-25 23:30:59 +00:00
|
|
|
|
|
|
|
|
|
|
If nil, a Mouse-1 click on a link in a non-selected window performs
|
|
|
|
|
|
the normal mouse-1 binding, typically selects the window and sets
|
|
|
|
|
|
point at the click position."
|
|
|
|
|
|
:type 'boolean
|
|
|
|
|
|
:version "22.1"
|
|
|
|
|
|
:group 'mouse)
|
|
|
|
|
|
|
2013-03-09 04:15:53 +00:00
|
|
|
|
(defun mouse--down-1-maybe-follows-link (&optional _prompt)
|
|
|
|
|
|
"Turn `mouse-1' events into `mouse-2' events if follows-link.
|
|
|
|
|
|
Expects to be bound to `down-mouse-1' in `key-translation-map'."
|
|
|
|
|
|
(if (or (null mouse-1-click-follows-link)
|
|
|
|
|
|
(not (eq (if (eq mouse-1-click-follows-link 'double)
|
|
|
|
|
|
'double-down-mouse-1 'down-mouse-1)
|
|
|
|
|
|
(car-safe last-input-event)))
|
|
|
|
|
|
(not (mouse-on-link-p (event-start last-input-event)))
|
|
|
|
|
|
(and (not mouse-1-click-in-non-selected-windows)
|
|
|
|
|
|
(not (eq (selected-window)
|
|
|
|
|
|
(posn-window (event-start last-input-event))))))
|
|
|
|
|
|
nil
|
|
|
|
|
|
(let ((this-event last-input-event)
|
|
|
|
|
|
(timedout
|
|
|
|
|
|
(sit-for (if (numberp mouse-1-click-follows-link)
|
|
|
|
|
|
(/ (abs mouse-1-click-follows-link) 1000.0)
|
|
|
|
|
|
0))))
|
|
|
|
|
|
(if (if (and (numberp mouse-1-click-follows-link)
|
|
|
|
|
|
(>= mouse-1-click-follows-link 0))
|
|
|
|
|
|
timedout (not timedout))
|
|
|
|
|
|
nil
|
|
|
|
|
|
|
|
|
|
|
|
(let ((event (read-event)))
|
|
|
|
|
|
(if (eq (car-safe event) (if (eq mouse-1-click-follows-link 'double)
|
|
|
|
|
|
'double-mouse-1 'mouse-1))
|
|
|
|
|
|
;; Turn the mouse-1 into a mouse-2 to follow links.
|
|
|
|
|
|
(let ((newup (if (eq mouse-1-click-follows-link 'double)
|
|
|
|
|
|
'double-mouse-2 'mouse-2))
|
|
|
|
|
|
(newdown (if (eq mouse-1-click-follows-link 'double)
|
|
|
|
|
|
'double-down-mouse-2 'down-mouse-2)))
|
|
|
|
|
|
;; If mouse-2 has never been done by the user, it doesn't have
|
|
|
|
|
|
;; the necessary property to be interpreted correctly.
|
|
|
|
|
|
(put newup 'event-kind (get (car event) 'event-kind))
|
|
|
|
|
|
(put newdown 'event-kind (get (car this-event) 'event-kind))
|
|
|
|
|
|
(push (cons newup (cdr event)) unread-command-events)
|
|
|
|
|
|
(vector (cons newdown (cdr this-event))))
|
|
|
|
|
|
(push event unread-command-events)
|
|
|
|
|
|
nil))))))
|
|
|
|
|
|
|
|
|
|
|
|
(define-key key-translation-map [down-mouse-1]
|
|
|
|
|
|
#'mouse--down-1-maybe-follows-link)
|
|
|
|
|
|
(define-key key-translation-map [double-down-mouse-1]
|
|
|
|
|
|
#'mouse--down-1-maybe-follows-link)
|
2005-02-25 23:30:59 +00:00
|
|
|
|
|
1991-12-20 07:15:37 +00:00
|
|
|
|
|
1994-10-12 09:27:49 +00:00
|
|
|
|
;; Provide a mode-specific menu on a mouse button.
|
|
|
|
|
|
|
2000-07-18 23:43:41 +00:00
|
|
|
|
(defun popup-menu (menu &optional position prefix)
|
|
|
|
|
|
"Popup the given menu and call the selected option.
|
2000-07-19 15:52:02 +00:00
|
|
|
|
MENU can be a keymap, an easymenu-style menu or a list of keymaps as for
|
|
|
|
|
|
`x-popup-menu'.
|
2012-08-10 12:44:06 +00:00
|
|
|
|
The menu is shown at the place where POSITION specifies. About
|
|
|
|
|
|
the form of POSITION, see `popup-menu-normalize-position'.
|
2000-07-18 23:43:41 +00:00
|
|
|
|
PREFIX is the prefix argument (if any) to pass to the command."
|
2000-07-19 15:52:02 +00:00
|
|
|
|
(let* ((map (cond
|
|
|
|
|
|
((keymapp menu) menu)
|
|
|
|
|
|
((and (listp menu) (keymapp (car menu))) menu)
|
|
|
|
|
|
(t (let* ((map (easy-menu-create-menu (car menu) (cdr menu)))
|
2000-11-22 16:46:52 +00:00
|
|
|
|
(filter (when (symbolp map)
|
|
|
|
|
|
(plist-get (get map 'menu-prop) :filter))))
|
|
|
|
|
|
(if filter (funcall filter (symbol-function map)) map)))))
|
2012-08-10 12:44:06 +00:00
|
|
|
|
event cmd
|
|
|
|
|
|
(position (popup-menu-normalize-position position)))
|
2000-07-18 23:43:41 +00:00
|
|
|
|
;; The looping behavior was taken from lmenu's popup-menu-popup
|
2000-07-24 15:19:02 +00:00
|
|
|
|
(while (and map (setq event
|
|
|
|
|
|
;; map could be a prefix key, in which case
|
|
|
|
|
|
;; we need to get its function cell
|
|
|
|
|
|
;; definition.
|
2000-09-27 08:59:33 +00:00
|
|
|
|
(x-popup-menu position (indirect-function map))))
|
2000-07-18 23:43:41 +00:00
|
|
|
|
;; Strangely x-popup-menu returns a list.
|
|
|
|
|
|
;; mouse-major-mode-menu was using a weird:
|
|
|
|
|
|
;; (key-binding (apply 'vector (append '(menu-bar) menu-prefix events)))
|
2000-10-08 20:16:56 +00:00
|
|
|
|
(setq cmd
|
|
|
|
|
|
(if (and (not (keymapp map)) (listp map))
|
|
|
|
|
|
;; We were given a list of keymaps. Search them all
|
|
|
|
|
|
;; in sequence until a first binding is found.
|
|
|
|
|
|
(let ((mouse-click (apply 'vector event))
|
|
|
|
|
|
binding)
|
|
|
|
|
|
(while (and map (null binding))
|
|
|
|
|
|
(setq binding (lookup-key (car map) mouse-click))
|
2012-07-26 08:32:25 +00:00
|
|
|
|
(if (numberp binding) ; `too long'
|
2000-10-08 20:16:56 +00:00
|
|
|
|
(setq binding nil))
|
|
|
|
|
|
(setq map (cdr map)))
|
|
|
|
|
|
binding)
|
|
|
|
|
|
;; We were given a single keymap.
|
|
|
|
|
|
(lookup-key map (apply 'vector event))))
|
|
|
|
|
|
;; Clear out echoing, which perhaps shows a prefix arg.
|
|
|
|
|
|
(message "")
|
|
|
|
|
|
;; Maybe try again but with the submap.
|
|
|
|
|
|
(setq map (if (keymapp cmd) cmd)))
|
2001-11-02 07:14:16 +00:00
|
|
|
|
;; If the user did not cancel by refusing to select,
|
|
|
|
|
|
;; and if the result is a command, run it.
|
|
|
|
|
|
(when (and (null map) (commandp cmd))
|
2000-10-08 20:16:56 +00:00
|
|
|
|
(setq prefix-arg prefix)
|
|
|
|
|
|
;; `setup-specified-language-environment', for instance,
|
|
|
|
|
|
;; expects this to be set from a menu keymap.
|
|
|
|
|
|
(setq last-command-event (car (last event)))
|
|
|
|
|
|
;; mouse-major-mode-menu was using `command-execute' instead.
|
2000-10-09 00:27:48 +00:00
|
|
|
|
(call-interactively cmd))))
|
2000-07-24 17:58:32 +00:00
|
|
|
|
|
2012-08-10 12:44:06 +00:00
|
|
|
|
(defun popup-menu-normalize-position (position)
|
2012-08-10 14:47:12 +00:00
|
|
|
|
"Convert the POSITION to the form which `popup-menu' expects internally.
|
|
|
|
|
|
POSITION can an event, a posn- value, a value having
|
|
|
|
|
|
form ((XOFFSET YOFFSET) WINDOW), or nil.
|
|
|
|
|
|
If nil, the current mouse position is used."
|
2012-08-10 12:44:06 +00:00
|
|
|
|
(pcase position
|
|
|
|
|
|
;; nil -> mouse cursor position
|
|
|
|
|
|
(`nil
|
|
|
|
|
|
(let ((mp (mouse-pixel-position)))
|
|
|
|
|
|
(list (list (cadr mp) (cddr mp)) (car mp))))
|
2012-08-10 14:47:12 +00:00
|
|
|
|
;; Value returned from `event-end' or `posn-at-point'.
|
|
|
|
|
|
((pred posnp)
|
2012-08-10 12:44:06 +00:00
|
|
|
|
(let ((xy (posn-x-y position)))
|
|
|
|
|
|
(list (list (car xy) (cdr xy))
|
|
|
|
|
|
(posn-window position))))
|
2012-08-10 14:47:12 +00:00
|
|
|
|
;; Event.
|
2012-08-10 12:44:06 +00:00
|
|
|
|
((pred eventp)
|
|
|
|
|
|
(popup-menu-normalize-position (event-end position)))
|
2012-08-10 14:47:12 +00:00
|
|
|
|
(t position)))
|
2012-08-10 12:44:06 +00:00
|
|
|
|
|
2007-10-19 02:14:58 +00:00
|
|
|
|
(defun minor-mode-menu-from-indicator (indicator)
|
2008-02-21 09:15:32 +00:00
|
|
|
|
"Show menu for minor mode specified by INDICATOR.
|
|
|
|
|
|
Interactively, INDICATOR is read using completion.
|
|
|
|
|
|
If there is no menu defined for the minor mode, then create one with
|
|
|
|
|
|
items `Turn Off' and `Help'."
|
|
|
|
|
|
(interactive
|
2008-04-18 10:30:18 +00:00
|
|
|
|
(list (completing-read
|
2008-02-21 09:15:32 +00:00
|
|
|
|
"Minor mode indicator: "
|
|
|
|
|
|
(describe-minor-mode-completion-table-for-indicator))))
|
2009-09-17 01:32:56 +00:00
|
|
|
|
(let* ((minor-mode (lookup-minor-mode-from-indicator indicator))
|
|
|
|
|
|
(mm-fun (or (get minor-mode :minor-mode-function) minor-mode)))
|
2008-02-21 09:15:32 +00:00
|
|
|
|
(unless minor-mode (error "Cannot find minor mode for `%s'" indicator))
|
|
|
|
|
|
(let* ((map (cdr-safe (assq minor-mode minor-mode-map-alist)))
|
|
|
|
|
|
(menu (and (keymapp map) (lookup-key map [menu-bar]))))
|
2008-04-01 08:35:58 +00:00
|
|
|
|
(setq menu
|
|
|
|
|
|
(if menu
|
|
|
|
|
|
(mouse-menu-non-singleton menu)
|
2008-02-21 09:15:32 +00:00
|
|
|
|
`(keymap
|
2008-04-01 08:35:58 +00:00
|
|
|
|
,indicator
|
2009-09-17 01:32:56 +00:00
|
|
|
|
(turn-off menu-item "Turn Off minor mode" ,mm-fun)
|
2008-04-01 08:35:58 +00:00
|
|
|
|
(help menu-item "Help for minor mode"
|
2008-04-18 10:30:18 +00:00
|
|
|
|
(lambda () (interactive)
|
2009-09-17 01:32:56 +00:00
|
|
|
|
(describe-function ',mm-fun))))))
|
2008-02-21 09:15:32 +00:00
|
|
|
|
(popup-menu menu))))
|
2007-10-19 02:14:58 +00:00
|
|
|
|
|
|
|
|
|
|
(defun mouse-minor-mode-menu (event)
|
|
|
|
|
|
"Show minor-mode menu for EVENT on minor modes area of the mode line."
|
|
|
|
|
|
(interactive "@e")
|
|
|
|
|
|
(let ((indicator (car (nth 4 (car (cdr event))))))
|
|
|
|
|
|
(minor-mode-menu-from-indicator indicator)))
|
|
|
|
|
|
|
2008-04-09 03:53:48 +00:00
|
|
|
|
(defun mouse-menu-major-mode-map ()
|
2010-12-08 03:32:31 +00:00
|
|
|
|
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
|
2008-04-01 08:35:58 +00:00
|
|
|
|
(let* (;; Keymap from which to inherit; may be null.
|
|
|
|
|
|
(ancestor (mouse-menu-non-singleton
|
1999-07-19 21:49:13 +00:00
|
|
|
|
(and (current-local-map)
|
2000-08-29 11:10:48 +00:00
|
|
|
|
(local-key-binding [menu-bar]))))
|
1999-07-19 21:49:13 +00:00
|
|
|
|
;; Make a keymap in which our last command leads to a menu or
|
|
|
|
|
|
;; default to the edit menu.
|
|
|
|
|
|
(newmap (if ancestor
|
2008-01-04 06:29:12 +00:00
|
|
|
|
(make-sparse-keymap (concat (format-mode-line mode-name)
|
|
|
|
|
|
" Mode"))
|
lisp/*: Add declarations, remove unused bindings, mark unused args.
* lisp/avoid.el (mouse-avoidance-mode): Mark unused arg.
(mouse-avoidance-nudge-mouse): Remove unused binding.
* lisp/imenu.el (imenu-default-goto-function): Mark unused args.
(imenu-progress-message): Remove obsolete macro; all callers changed.
* lisp/mouse.el (mouse-menu-major-mode-map):
* lisp/emacs-lisp/authors.el (authors-scan-change-log)
(authors-add-to-author-list):
* lisp/emacs-lisp/avl-tree.el (avl-tree--enter-balance):
* lisp/emacs-lisp/smie.el (smie-auto-fill):
* lisp/mail/sendmail.el (mail-bury):
* lisp/mail/unrmail.el (unrmail):
* lisp/net/tls.el (open-tls-stream):
* lisp/textmodes/picture.el (picture-mouse-set-point):
Remove unused bindings.
* lisp/subr.el (keymap-canonicalize): Remove unused binding.
(read-passwd): Mark unused arg.
* lisp/tutorial.el (tutorial--display-changes): Remove unused binding.
(tutorial--save-tutorial-to): Remove unused variable.
* lisp/emacs-lisp/package.el (define-package, package-menu-mark-delete)
(package-menu-mark-install, package-menu-mark-unmark): Mark unused args.
(package-generate-autoloads, package-menu--generate)
(package-menu--find-upgrades): Remove unused bindings.
* lisp/emulation/cua-rect.el (cua-restrict-regexp-rectangle)
(cua-restrict-prefix-rectangle): Doc fixes. Remove unused bindings.
(cua--mouse-ignore, cua--delete-rectangle, cua--extract-rectangle)
(cua--indent-rectangle, cua-open-rectangle, cua-close-rectangle)
(cua-blank-rectangle, cua-string-rectangle, cua-replace-in-rectangle)
(cua-incr-rectangle, cua-sequence-rectangle, cua--convert-rectangle-as)
(cua--rectangle-aux-replace, cua--left-fill-rectangle)
(cua-scroll-rectangle-up, cua-scroll-rectangle-down)
(cua-delete-char-rectangle): Mark unused args.
(cua-align-rectangle): Remove unused binding.
* lisp/mail/rmail.el (compilation--message->loc)
(epa--find-coding-system-for-mime-charset): Declare.
* lisp/net/dbus.el (dbus-register-service): Declare.
(dbus-name-owner-changed-handler): Remove unused binding.
* lisp/nxml/nxml-mode.el (nxml-electric-slash, nxml-in-mixed-content-p)
(nxml-compute-indent-from-matching-start-tag): Remove unused variables.
(nxml-scan-backward-within): Mark unused arg.
(nxml-dynamic-markup-word): Remove unused binding.
2012-04-19 17:20:26 +00:00
|
|
|
|
menu-bar-edit-menu)))
|
1999-07-19 21:49:13 +00:00
|
|
|
|
(if ancestor
|
2008-04-04 17:31:20 +00:00
|
|
|
|
(set-keymap-parent newmap ancestor))
|
2008-04-09 03:53:48 +00:00
|
|
|
|
newmap))
|
1994-10-12 09:27:49 +00:00
|
|
|
|
|
2008-04-01 08:35:58 +00:00
|
|
|
|
(defun mouse-menu-non-singleton (menubar)
|
2011-01-28 17:18:54 +00:00
|
|
|
|
"Return menu keybar MENUBAR, or a lone submenu inside it.
|
|
|
|
|
|
If MENUBAR defines exactly one submenu, return just that submenu.
|
|
|
|
|
|
Otherwise, return MENUBAR."
|
1994-10-12 09:27:49 +00:00
|
|
|
|
(if menubar
|
2008-04-01 08:35:58 +00:00
|
|
|
|
(let (submap)
|
|
|
|
|
|
(map-keymap
|
|
|
|
|
|
(lambda (k v) (setq submap (if submap t (cons k v))))
|
2008-04-04 17:31:20 +00:00
|
|
|
|
(keymap-canonicalize menubar))
|
2008-04-01 08:35:58 +00:00
|
|
|
|
(if (eq submap t)
|
|
|
|
|
|
menubar
|
|
|
|
|
|
(lookup-key menubar (vector (car submap)))))))
|
2000-07-19 15:52:02 +00:00
|
|
|
|
|
2008-04-09 03:53:48 +00:00
|
|
|
|
(defun mouse-menu-bar-map ()
|
|
|
|
|
|
"Return a keymap equivalent to the menu bar.
|
2000-07-19 15:52:02 +00:00
|
|
|
|
The contents are the items that would be in the menu bar whether or
|
|
|
|
|
|
not it is actually displayed."
|
2010-12-08 03:32:31 +00:00
|
|
|
|
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
|
2000-07-24 15:19:02 +00:00
|
|
|
|
(let* ((local-menu (and (current-local-map)
|
|
|
|
|
|
(lookup-key (current-local-map) [menu-bar])))
|
|
|
|
|
|
(global-menu (lookup-key global-map [menu-bar]))
|
2000-09-02 11:19:55 +00:00
|
|
|
|
;; If a keymap doesn't have a prompt string (a lazy
|
|
|
|
|
|
;; programmer didn't bother to provide one), create it and
|
|
|
|
|
|
;; insert it into the keymap; each keymap gets its own
|
|
|
|
|
|
;; prompt. This is required for non-toolkit versions to
|
|
|
|
|
|
;; display non-empty menu pane names.
|
|
|
|
|
|
(minor-mode-menus
|
|
|
|
|
|
(mapcar
|
2008-04-04 17:31:20 +00:00
|
|
|
|
(lambda (menu)
|
|
|
|
|
|
(let* ((minor-mode (car menu))
|
|
|
|
|
|
(menu (cdr menu))
|
|
|
|
|
|
(title-or-map (cadr menu)))
|
|
|
|
|
|
(or (stringp title-or-map)
|
|
|
|
|
|
(setq menu
|
|
|
|
|
|
(cons 'keymap
|
|
|
|
|
|
(cons (concat
|
|
|
|
|
|
(capitalize (subst-char-in-string
|
|
|
|
|
|
?- ?\s (symbol-name
|
|
|
|
|
|
minor-mode)))
|
|
|
|
|
|
" Menu")
|
|
|
|
|
|
(cdr menu)))))
|
|
|
|
|
|
menu))
|
2000-09-02 11:19:55 +00:00
|
|
|
|
(minor-mode-key-binding [menu-bar])))
|
2000-07-24 15:19:02 +00:00
|
|
|
|
(local-title-or-map (and local-menu (cadr local-menu)))
|
|
|
|
|
|
(global-title-or-map (cadr global-menu)))
|
|
|
|
|
|
(or (null local-menu)
|
|
|
|
|
|
(stringp local-title-or-map)
|
|
|
|
|
|
(setq local-menu (cons 'keymap
|
2008-01-04 08:34:15 +00:00
|
|
|
|
(cons (concat (format-mode-line mode-name)
|
2008-01-04 06:29:12 +00:00
|
|
|
|
" Mode Menu")
|
2000-07-24 15:19:02 +00:00
|
|
|
|
(cdr local-menu)))))
|
|
|
|
|
|
(or (stringp global-title-or-map)
|
|
|
|
|
|
(setq global-menu (cons 'keymap
|
|
|
|
|
|
(cons "Global Menu"
|
|
|
|
|
|
(cdr global-menu)))))
|
2000-07-19 15:52:02 +00:00
|
|
|
|
;; Supplying the list is faster than making a new map.
|
2008-04-09 03:53:48 +00:00
|
|
|
|
;; FIXME: We have a problem here: we have to use the global/local/minor
|
|
|
|
|
|
;; so they're displayed in the expected order, but later on in the command
|
|
|
|
|
|
;; loop, they're actually looked up in the opposite order.
|
|
|
|
|
|
(apply 'append
|
|
|
|
|
|
global-menu
|
|
|
|
|
|
local-menu
|
|
|
|
|
|
minor-mode-menus)))
|
|
|
|
|
|
|
|
|
|
|
|
(defun mouse-major-mode-menu (event &optional prefix)
|
|
|
|
|
|
"Pop up a mode-specific menu of mouse commands.
|
|
|
|
|
|
Default to the Edit menu if the major mode doesn't define a menu."
|
Use declare forms, where possible, to mark obsolete functions.
* lisp/allout.el (allout-passphrase-hint-string): Likewise.
(allout-init): Use a declare form to mark obsolete.
* lisp/calendar/calendar.el (calendar-version):
* lisp/calendar/icalendar.el (icalendar-extract-ical-from-buffer)
(icalendar-convert-diary-to-ical):
* lisp/cus-edit.el (custom-mode):
* lisp/ansi-color.el (ansi-color-unfontify-region):
* lisp/international/latin1-disp.el (latin1-char-displayable-p):
* lisp/progmodes/cwarn.el (turn-on-cwarn-mode):
* lisp/progmodes/which-func.el (which-func-update-1): Use
define-obsolete-function-alias.
* lisp/bookmark.el (bookmark-jump-noselect): Use a declare form to mark
this function obsolete.
* lisp/calendar/cal-x.el (calendar-two-frame-setup)
(calendar-only-one-frame-setup, calendar-one-frame-setup):
* lisp/calendar/calendar.el (american-calendar, european-calendar)
(calendar-for-loop):
* lisp/comint.el (comint-dynamic-simple-complete)
(comint-dynamic-complete-as-filename, comint-unquote-filename):
* lisp/desktop.el (desktop-load-default):
* lisp/dired-x.el (dired-omit-here-always)
(dired-hack-local-variables, dired-default-directory):
* lisp/emacs-lisp/derived.el (derived-mode-class):
* lisp/emacs-lisp/timer.el (timer-set-time-with-usecs):
* lisp/emacs-lock.el (toggle-emacs-lock):
* lisp/epa.el (epa-display-verify-result):
* lisp/epg.el (epg-sign-keys, epg-start-sign-keys)
(epg-passphrase-callback-function):
* lisp/eshell/esh-util.el (eshell-for):
* lisp/eshell/eshell.el (eshell-remove-from-window-buffer-names)
(eshell-add-to-window-buffer-names):
* lisp/files.el (locate-file-completion):
* lisp/imenu.el (imenu-example--create-c-index)
(imenu-example--create-lisp-index)
(imenu-example--lisp-extract-index-name)
(imenu-example--name-and-position):
* lisp/international/mule-cmds.el (princ-list):
* lisp/international/mule-diag.el (decode-codepage-char):
* lisp/international/mule-util.el (detect-coding-with-priority):
* lisp/iswitchb.el (iswitchb-read-buffer):
* lisp/mail/mailalias.el (mail-complete):
* lisp/mail/sendmail.el (mail-sent-via):
* lisp/mouse.el (mouse-popup-menubar-stuff, mouse-popup-menubar)
(mouse-major-mode-menu):
* lisp/password-cache.el (password-read-and-add):
* lisp/pcomplete.el (pcomplete-parse-comint-arguments):
* lisp/progmodes/sh-script.el (sh-maybe-here-document):
* lisp/replace.el (query-replace-regexp-eval):
* lisp/savehist.el (savehist-load):
* lisp/simple.el (choose-completion-delete-max-match):
* lisp/term.el (term-dynamic-simple-complete):
* lisp/vc/ediff-init.el (ediff-check-version):
* lisp/vc/ediff-wind.el (ediff-choose-window-setup-function-automatically):
* lisp/vc/vc.el (vc-diff-switches-list):
* lisp/view.el (view-return-to-alist-update): Likewise.
* lisp/iswitchb.el (iswitchb-read-buffer): Move code of
iswitchb-define-mode-map here, and delete that obsolete function.
* lisp/subr.el (eval-next-after-load, makehash, insert-string)
(assoc-ignore-representation, assoc-ignore-case): Use declare to
mark obsolete.
(mode-line-inverse-video): Variable deleted.
* lisp/emacs-lisp/byte-run.el (make-obsolete): Doc fix; emphasize that
this applies to functions.
* lisp/erc/erc.el (erc-send-command): Use define-obsolete-function-alias.
* lisp/international/mule-util.el (string-to-sequence): Remove.
* lisp/net/newst-backend.el (newsticker-cache-filename):
* lisp/net/newst-treeview.el (newsticker-groups-filename): Fix
incorrect obsolescence declaration.
* lisp/net/snmp-mode.el (snmp-font-lock-keywords-3): Don't use obsolete
font-lock-reference-face.
* lisp/url/url-parse.el (url-recreate-url-attributes):
* lisp/url/url-util.el (url-generate-unique-filename): Use declare to mark
obsolete.
* src/xdisp.c (mode_line_inverse_video): Delete obsolete variable.
2012-09-25 04:13:02 +00:00
|
|
|
|
(declare (obsolete mouse-menu-major-mode-map "23.1"))
|
2008-04-09 03:53:48 +00:00
|
|
|
|
(interactive "@e\nP")
|
|
|
|
|
|
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
|
|
|
|
|
|
(popup-menu (mouse-menu-major-mode-map) event prefix))
|
|
|
|
|
|
|
|
|
|
|
|
(defun mouse-popup-menubar (event prefix)
|
|
|
|
|
|
"Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX.
|
|
|
|
|
|
The contents are the items that would be in the menu bar whether or
|
|
|
|
|
|
not it is actually displayed."
|
Use declare forms, where possible, to mark obsolete functions.
* lisp/allout.el (allout-passphrase-hint-string): Likewise.
(allout-init): Use a declare form to mark obsolete.
* lisp/calendar/calendar.el (calendar-version):
* lisp/calendar/icalendar.el (icalendar-extract-ical-from-buffer)
(icalendar-convert-diary-to-ical):
* lisp/cus-edit.el (custom-mode):
* lisp/ansi-color.el (ansi-color-unfontify-region):
* lisp/international/latin1-disp.el (latin1-char-displayable-p):
* lisp/progmodes/cwarn.el (turn-on-cwarn-mode):
* lisp/progmodes/which-func.el (which-func-update-1): Use
define-obsolete-function-alias.
* lisp/bookmark.el (bookmark-jump-noselect): Use a declare form to mark
this function obsolete.
* lisp/calendar/cal-x.el (calendar-two-frame-setup)
(calendar-only-one-frame-setup, calendar-one-frame-setup):
* lisp/calendar/calendar.el (american-calendar, european-calendar)
(calendar-for-loop):
* lisp/comint.el (comint-dynamic-simple-complete)
(comint-dynamic-complete-as-filename, comint-unquote-filename):
* lisp/desktop.el (desktop-load-default):
* lisp/dired-x.el (dired-omit-here-always)
(dired-hack-local-variables, dired-default-directory):
* lisp/emacs-lisp/derived.el (derived-mode-class):
* lisp/emacs-lisp/timer.el (timer-set-time-with-usecs):
* lisp/emacs-lock.el (toggle-emacs-lock):
* lisp/epa.el (epa-display-verify-result):
* lisp/epg.el (epg-sign-keys, epg-start-sign-keys)
(epg-passphrase-callback-function):
* lisp/eshell/esh-util.el (eshell-for):
* lisp/eshell/eshell.el (eshell-remove-from-window-buffer-names)
(eshell-add-to-window-buffer-names):
* lisp/files.el (locate-file-completion):
* lisp/imenu.el (imenu-example--create-c-index)
(imenu-example--create-lisp-index)
(imenu-example--lisp-extract-index-name)
(imenu-example--name-and-position):
* lisp/international/mule-cmds.el (princ-list):
* lisp/international/mule-diag.el (decode-codepage-char):
* lisp/international/mule-util.el (detect-coding-with-priority):
* lisp/iswitchb.el (iswitchb-read-buffer):
* lisp/mail/mailalias.el (mail-complete):
* lisp/mail/sendmail.el (mail-sent-via):
* lisp/mouse.el (mouse-popup-menubar-stuff, mouse-popup-menubar)
(mouse-major-mode-menu):
* lisp/password-cache.el (password-read-and-add):
* lisp/pcomplete.el (pcomplete-parse-comint-arguments):
* lisp/progmodes/sh-script.el (sh-maybe-here-document):
* lisp/replace.el (query-replace-regexp-eval):
* lisp/savehist.el (savehist-load):
* lisp/simple.el (choose-completion-delete-max-match):
* lisp/term.el (term-dynamic-simple-complete):
* lisp/vc/ediff-init.el (ediff-check-version):
* lisp/vc/ediff-wind.el (ediff-choose-window-setup-function-automatically):
* lisp/vc/vc.el (vc-diff-switches-list):
* lisp/view.el (view-return-to-alist-update): Likewise.
* lisp/iswitchb.el (iswitchb-read-buffer): Move code of
iswitchb-define-mode-map here, and delete that obsolete function.
* lisp/subr.el (eval-next-after-load, makehash, insert-string)
(assoc-ignore-representation, assoc-ignore-case): Use declare to
mark obsolete.
(mode-line-inverse-video): Variable deleted.
* lisp/emacs-lisp/byte-run.el (make-obsolete): Doc fix; emphasize that
this applies to functions.
* lisp/erc/erc.el (erc-send-command): Use define-obsolete-function-alias.
* lisp/international/mule-util.el (string-to-sequence): Remove.
* lisp/net/newst-backend.el (newsticker-cache-filename):
* lisp/net/newst-treeview.el (newsticker-groups-filename): Fix
incorrect obsolescence declaration.
* lisp/net/snmp-mode.el (snmp-font-lock-keywords-3): Don't use obsolete
font-lock-reference-face.
* lisp/url/url-parse.el (url-recreate-url-attributes):
* lisp/url/url-util.el (url-generate-unique-filename): Use declare to mark
obsolete.
* src/xdisp.c (mode_line_inverse_video): Delete obsolete variable.
2012-09-25 04:13:02 +00:00
|
|
|
|
(declare (obsolete mouse-menu-bar-map "23.1"))
|
2008-04-09 03:53:48 +00:00
|
|
|
|
(interactive "@e \nP")
|
|
|
|
|
|
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
|
2011-06-01 15:34:41 +00:00
|
|
|
|
(popup-menu (mouse-menu-bar-map) (unless (integerp event) event) prefix))
|
2000-07-19 15:52:02 +00:00
|
|
|
|
|
|
|
|
|
|
(defun mouse-popup-menubar-stuff (event prefix)
|
|
|
|
|
|
"Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'.
|
|
|
|
|
|
Use the former if the menu bar is showing, otherwise the latter."
|
Use declare forms, where possible, to mark obsolete functions.
* lisp/allout.el (allout-passphrase-hint-string): Likewise.
(allout-init): Use a declare form to mark obsolete.
* lisp/calendar/calendar.el (calendar-version):
* lisp/calendar/icalendar.el (icalendar-extract-ical-from-buffer)
(icalendar-convert-diary-to-ical):
* lisp/cus-edit.el (custom-mode):
* lisp/ansi-color.el (ansi-color-unfontify-region):
* lisp/international/latin1-disp.el (latin1-char-displayable-p):
* lisp/progmodes/cwarn.el (turn-on-cwarn-mode):
* lisp/progmodes/which-func.el (which-func-update-1): Use
define-obsolete-function-alias.
* lisp/bookmark.el (bookmark-jump-noselect): Use a declare form to mark
this function obsolete.
* lisp/calendar/cal-x.el (calendar-two-frame-setup)
(calendar-only-one-frame-setup, calendar-one-frame-setup):
* lisp/calendar/calendar.el (american-calendar, european-calendar)
(calendar-for-loop):
* lisp/comint.el (comint-dynamic-simple-complete)
(comint-dynamic-complete-as-filename, comint-unquote-filename):
* lisp/desktop.el (desktop-load-default):
* lisp/dired-x.el (dired-omit-here-always)
(dired-hack-local-variables, dired-default-directory):
* lisp/emacs-lisp/derived.el (derived-mode-class):
* lisp/emacs-lisp/timer.el (timer-set-time-with-usecs):
* lisp/emacs-lock.el (toggle-emacs-lock):
* lisp/epa.el (epa-display-verify-result):
* lisp/epg.el (epg-sign-keys, epg-start-sign-keys)
(epg-passphrase-callback-function):
* lisp/eshell/esh-util.el (eshell-for):
* lisp/eshell/eshell.el (eshell-remove-from-window-buffer-names)
(eshell-add-to-window-buffer-names):
* lisp/files.el (locate-file-completion):
* lisp/imenu.el (imenu-example--create-c-index)
(imenu-example--create-lisp-index)
(imenu-example--lisp-extract-index-name)
(imenu-example--name-and-position):
* lisp/international/mule-cmds.el (princ-list):
* lisp/international/mule-diag.el (decode-codepage-char):
* lisp/international/mule-util.el (detect-coding-with-priority):
* lisp/iswitchb.el (iswitchb-read-buffer):
* lisp/mail/mailalias.el (mail-complete):
* lisp/mail/sendmail.el (mail-sent-via):
* lisp/mouse.el (mouse-popup-menubar-stuff, mouse-popup-menubar)
(mouse-major-mode-menu):
* lisp/password-cache.el (password-read-and-add):
* lisp/pcomplete.el (pcomplete-parse-comint-arguments):
* lisp/progmodes/sh-script.el (sh-maybe-here-document):
* lisp/replace.el (query-replace-regexp-eval):
* lisp/savehist.el (savehist-load):
* lisp/simple.el (choose-completion-delete-max-match):
* lisp/term.el (term-dynamic-simple-complete):
* lisp/vc/ediff-init.el (ediff-check-version):
* lisp/vc/ediff-wind.el (ediff-choose-window-setup-function-automatically):
* lisp/vc/vc.el (vc-diff-switches-list):
* lisp/view.el (view-return-to-alist-update): Likewise.
* lisp/iswitchb.el (iswitchb-read-buffer): Move code of
iswitchb-define-mode-map here, and delete that obsolete function.
* lisp/subr.el (eval-next-after-load, makehash, insert-string)
(assoc-ignore-representation, assoc-ignore-case): Use declare to
mark obsolete.
(mode-line-inverse-video): Variable deleted.
* lisp/emacs-lisp/byte-run.el (make-obsolete): Doc fix; emphasize that
this applies to functions.
* lisp/erc/erc.el (erc-send-command): Use define-obsolete-function-alias.
* lisp/international/mule-util.el (string-to-sequence): Remove.
* lisp/net/newst-backend.el (newsticker-cache-filename):
* lisp/net/newst-treeview.el (newsticker-groups-filename): Fix
incorrect obsolescence declaration.
* lisp/net/snmp-mode.el (snmp-font-lock-keywords-3): Don't use obsolete
font-lock-reference-face.
* lisp/url/url-parse.el (url-recreate-url-attributes):
* lisp/url/url-util.el (url-generate-unique-filename): Use declare to mark
obsolete.
* src/xdisp.c (mode_line_inverse_video): Delete obsolete variable.
2012-09-25 04:13:02 +00:00
|
|
|
|
(declare (obsolete nil "23.1"))
|
2008-04-09 03:53:48 +00:00
|
|
|
|
(interactive "@e\nP")
|
|
|
|
|
|
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
|
|
|
|
|
|
(popup-menu
|
|
|
|
|
|
(if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))
|
|
|
|
|
|
(mouse-menu-bar-map)
|
|
|
|
|
|
(mouse-menu-major-mode-map))
|
|
|
|
|
|
event prefix))
|
1994-10-12 09:27:49 +00:00
|
|
|
|
|
1994-08-11 20:35:31 +00:00
|
|
|
|
;; Commands that operate on windows.
|
|
|
|
|
|
|
1994-03-09 04:00:12 +00:00
|
|
|
|
(defun mouse-minibuffer-check (event)
|
|
|
|
|
|
(let ((w (posn-window (event-start event))))
|
|
|
|
|
|
(and (window-minibuffer-p w)
|
|
|
|
|
|
(not (minibuffer-window-active-p w))
|
Add new error and function `user-error'.
* lisp/subr.el (user-error): New function.
* lisp/window.el (switch-to-buffer):
* lisp/vc/smerge-mode.el (smerge-resolve-function, smerge-resolve)
(smerge-match-conflict):
* lisp/simple.el (previous-matching-history-element)
(next-matching-history-element, goto-history-element, undo-more)
(undo-start):
* lisp/progmodes/etags.el (visit-tags-table-buffer, find-tag-tag)
(find-tag-noselect, find-tag-in-order, etags-goto-tag-location)
(next-file, tags-loop-scan, list-tags, complete-tag):
* lisp/progmodes/compile.el (compilation-loop):
* lisp/mouse.el (mouse-minibuffer-check):
* lisp/man.el (Man-bgproc-sentinel, Man-goto-page):
* lisp/info.el (Info-find-node-2, Info-extract-pointer, Info-history-back)
(Info-history-forward, Info-follow-reference, Info-menu)
(Info-extract-menu-item, Info-extract-menu-counting)
(Info-forward-node, Info-backward-node, Info-next-menu-item)
(Info-last-menu-item, Info-next-preorder, Info-last-preorder)
(Info-next-reference, Info-prev-reference, Info-index)
(Info-index-next, Info-follow-nearest-node)
(Info-copy-current-node-name):
* lisp/imenu.el (imenu--make-index-alist)
(imenu-default-create-index-function, imenu-add-to-menubar):
* lisp/files.el (basic-save-buffer, recover-file):
* lisp/emacs-lisp/easy-mmode.el (easy-mmode-define-navigation):
* lisp/emacs-lisp/checkdoc.el (checkdoc-continue, checkdoc-comments)
(checkdoc-message-text, checkdoc-defun):
* lisp/dabbrev.el (dabbrev-completion, dabbrev--abbrev-at-point):
* lisp/cus-edit.el (customize-changed-options, customize-rogue)
(customize-saved, custom-variable-set, custom-variable-mark-to-save)
(custom-variable-mark-to-reset-standard)
(custom-variable-reset-backup, custom-face-mark-to-reset-standard)
(custom-file):
* lisp/completion.el (check-completion-length):
* lisp/comint.el (comint-search-arg)
(comint-previous-matching-input-string-position)
(comint-previous-matching-input)
(comint-replace-by-expanded-history-before-point, comint-send-input)
(comint-copy-old-input, comint-backward-matching-input)
(comint-goto-process-mark, comint-set-process-mark):
* lisp/calendar/calendar.el (calendar-cursor-to-date): Use it.
* lisp/bindings.el (debug-ignored-errors): Remove regexps, add `user-error'.
* src/data.c (PUT_ERROR): New macro.
(syms_of_data): Use it. Add new error type `user-error'.
* src/undo.c (user_error): New function.
(Fprimitive_undo): Use it.
* src/print.c (print_error_message): Adjust print style for `user-error'.
* src/keyboard.c (user_error): New function.
(Fexit_recursive_edit, Fabort_recursive_edit): Use it.
2012-05-04 23:16:47 +00:00
|
|
|
|
(user-error "Minibuffer window is not active")))
|
1994-12-26 05:09:41 +00:00
|
|
|
|
;; Give temporary modes such as isearch a chance to turn off.
|
|
|
|
|
|
(run-hooks 'mouse-leave-buffer-hook))
|
1994-03-09 04:00:12 +00:00
|
|
|
|
|
1991-12-20 07:15:37 +00:00
|
|
|
|
(defun mouse-delete-window (click)
|
1992-09-26 08:15:35 +00:00
|
|
|
|
"Delete the window you click on.
|
2001-08-09 14:57:30 +00:00
|
|
|
|
Do nothing if the frame has just one window.
|
1998-07-29 05:41:04 +00:00
|
|
|
|
This command must be bound to a mouse click."
|
1992-09-13 11:44:06 +00:00
|
|
|
|
(interactive "e")
|
2001-08-09 14:57:30 +00:00
|
|
|
|
(unless (one-window-p t)
|
1998-07-29 05:41:04 +00:00
|
|
|
|
(mouse-minibuffer-check click)
|
|
|
|
|
|
(delete-window (posn-window (event-start click)))))
|
1991-12-20 07:15:37 +00:00
|
|
|
|
|
1994-02-25 19:35:58 +00:00
|
|
|
|
(defun mouse-select-window (click)
|
|
|
|
|
|
"Select the window clicked on; don't move point."
|
|
|
|
|
|
(interactive "e")
|
1994-03-09 04:00:12 +00:00
|
|
|
|
(mouse-minibuffer-check click)
|
1994-02-25 19:35:58 +00:00
|
|
|
|
(let ((oframe (selected-frame))
|
|
|
|
|
|
(frame (window-frame (posn-window (event-start click)))))
|
|
|
|
|
|
(select-window (posn-window (event-start click)))
|
|
|
|
|
|
(raise-frame frame)
|
|
|
|
|
|
(select-frame frame)
|
|
|
|
|
|
(or (eq frame oframe)
|
1996-09-03 21:37:35 +00:00
|
|
|
|
(set-mouse-position (selected-frame) (1- (frame-width)) 0))))
|
1994-02-25 19:35:58 +00:00
|
|
|
|
|
1992-10-17 21:57:45 +00:00
|
|
|
|
(defun mouse-tear-off-window (click)
|
|
|
|
|
|
"Delete the window clicked on, and create a new frame displaying its buffer."
|
|
|
|
|
|
(interactive "e")
|
1994-03-09 04:00:12 +00:00
|
|
|
|
(mouse-minibuffer-check click)
|
1992-10-17 21:57:45 +00:00
|
|
|
|
(let* ((window (posn-window (event-start click)))
|
|
|
|
|
|
(buf (window-buffer window))
|
1994-05-06 20:27:25 +00:00
|
|
|
|
(frame (make-frame)))
|
1992-10-17 21:57:45 +00:00
|
|
|
|
(select-frame frame)
|
|
|
|
|
|
(switch-to-buffer buf)
|
|
|
|
|
|
(delete-window window)))
|
|
|
|
|
|
|
* mouse.el: Begin adapting this to the new event format.
(event-window, event-point, mouse-coords, mouse-timestamp):
Removed.
(event-start, event-end, posn-window, posn-point, posn-col-row,
posn-timestamp): New accessors; these are defsubsts.
(mouse-delete-window, mouse-delete-other-windows,
mouse-split-window-vertically, mouse-set-point): Rewritten to use
the new accessors.
* mouse.el: Remove hack of binding down-mouse-1.
* mouse.el (mouse-movement-p): Add docstring for this.
1992-10-07 20:46:31 +00:00
|
|
|
|
(defun mouse-delete-other-windows ()
|
2001-05-15 13:16:59 +00:00
|
|
|
|
"Delete all windows except the one you click on."
|
* mouse.el: Begin adapting this to the new event format.
(event-window, event-point, mouse-coords, mouse-timestamp):
Removed.
(event-start, event-end, posn-window, posn-point, posn-col-row,
posn-timestamp): New accessors; these are defsubsts.
(mouse-delete-window, mouse-delete-other-windows,
mouse-split-window-vertically, mouse-set-point): Rewritten to use
the new accessors.
* mouse.el: Remove hack of binding down-mouse-1.
* mouse.el (mouse-movement-p): Add docstring for this.
1992-10-07 20:46:31 +00:00
|
|
|
|
(interactive "@")
|
1991-12-20 07:15:37 +00:00
|
|
|
|
(delete-other-windows))
|
1990-06-19 20:28:34 +00:00
|
|
|
|
|
1991-12-20 07:15:37 +00:00
|
|
|
|
(defun mouse-split-window-vertically (click)
|
|
|
|
|
|
"Select Emacs window mouse is on, then split it vertically in half.
|
|
|
|
|
|
The window is split at the line clicked on.
|
|
|
|
|
|
This command must be bound to a mouse click."
|
1992-09-26 08:15:35 +00:00
|
|
|
|
(interactive "@e")
|
1994-03-09 04:00:12 +00:00
|
|
|
|
(mouse-minibuffer-check click)
|
* mouse.el: Begin adapting this to the new event format.
(event-window, event-point, mouse-coords, mouse-timestamp):
Removed.
(event-start, event-end, posn-window, posn-point, posn-col-row,
posn-timestamp): New accessors; these are defsubsts.
(mouse-delete-window, mouse-delete-other-windows,
mouse-split-window-vertically, mouse-set-point): Rewritten to use
the new accessors.
* mouse.el: Remove hack of binding down-mouse-1.
* mouse.el (mouse-movement-p): Add docstring for this.
1992-10-07 20:46:31 +00:00
|
|
|
|
(let ((start (event-start click)))
|
|
|
|
|
|
(select-window (posn-window start))
|
1994-05-22 20:56:11 +00:00
|
|
|
|
(let ((new-height (1+ (cdr (posn-col-row (event-end click)))))
|
1993-03-02 07:29:05 +00:00
|
|
|
|
(first-line window-min-height)
|
|
|
|
|
|
(last-line (- (window-height) window-min-height)))
|
|
|
|
|
|
(if (< last-line first-line)
|
1994-08-02 21:59:19 +00:00
|
|
|
|
(error "Window too short to split")
|
1993-03-02 07:29:05 +00:00
|
|
|
|
(split-window-vertically
|
|
|
|
|
|
(min (max new-height first-line) last-line))))))
|
1991-12-20 07:15:37 +00:00
|
|
|
|
|
1992-09-26 08:15:35 +00:00
|
|
|
|
(defun mouse-split-window-horizontally (click)
|
|
|
|
|
|
"Select Emacs window mouse is on, then split it horizontally in half.
|
|
|
|
|
|
The window is split at the column clicked on.
|
|
|
|
|
|
This command must be bound to a mouse click."
|
|
|
|
|
|
(interactive "@e")
|
1994-03-09 04:00:12 +00:00
|
|
|
|
(mouse-minibuffer-check click)
|
1993-03-02 07:29:05 +00:00
|
|
|
|
(let ((start (event-start click)))
|
|
|
|
|
|
(select-window (posn-window start))
|
|
|
|
|
|
(let ((new-width (1+ (car (posn-col-row (event-end click)))))
|
|
|
|
|
|
(first-col window-min-width)
|
|
|
|
|
|
(last-col (- (window-width) window-min-width)))
|
|
|
|
|
|
(if (< last-col first-col)
|
1994-08-02 21:59:19 +00:00
|
|
|
|
(error "Window too narrow to split")
|
1993-03-02 07:29:05 +00:00
|
|
|
|
(split-window-horizontally
|
|
|
|
|
|
(min (max new-width first-col) last-col))))))
|
1992-09-26 08:15:35 +00:00
|
|
|
|
|
2011-10-21 09:15:32 +00:00
|
|
|
|
;; `mouse-drag-line' is now the common routine for handling all line
|
|
|
|
|
|
;; dragging events combining the earlier `mouse-drag-mode-line-1' and
|
|
|
|
|
|
;; `mouse-drag-vertical-line'. It should improve the behavior of line
|
|
|
|
|
|
;; dragging wrt Emacs 23 as follows:
|
|
|
|
|
|
|
|
|
|
|
|
;; (1) Gratuitous error messages and restrictions have been (hopefully)
|
|
|
|
|
|
;; removed. (The help-echo that dragging the mode-line can resize a
|
|
|
|
|
|
;; one-window-frame's window will still show through via bindings.el.)
|
|
|
|
|
|
|
|
|
|
|
|
;; (2) No gratuitous selection of other windows should happen. (This
|
|
|
|
|
|
;; has not been completely fixed for mouse-autoselected windows yet.)
|
|
|
|
|
|
|
|
|
|
|
|
;; (3) Mouse clicks below a scroll-bar should pass through via unread
|
|
|
|
|
|
;; command events.
|
|
|
|
|
|
|
|
|
|
|
|
;; Note that `window-in-direction' replaces `mouse-drag-window-above'
|
|
|
|
|
|
;; and `mouse-drag-vertical-line-rightward-window' with Emacs 24.1.
|
2012-07-08 08:26:21 +00:00
|
|
|
|
|
2011-10-21 09:15:32 +00:00
|
|
|
|
(defun mouse-drag-line (start-event line)
|
2012-07-08 08:26:21 +00:00
|
|
|
|
"Drag a mode line, header line, or vertical line with the mouse.
|
2011-10-21 09:15:32 +00:00
|
|
|
|
START-EVENT is the starting mouse-event of the drag action. LINE
|
2012-07-08 08:26:21 +00:00
|
|
|
|
must be one of the symbols `header', `mode', or `vertical'."
|
1994-12-26 05:09:41 +00:00
|
|
|
|
;; Give temporary modes such as isearch a chance to turn off.
|
|
|
|
|
|
(run-hooks 'mouse-leave-buffer-hook)
|
2011-10-21 09:15:32 +00:00
|
|
|
|
(let* ((echo-keystrokes 0)
|
2000-10-06 11:43:39 +00:00
|
|
|
|
(start (event-start start-event))
|
2011-10-21 09:15:32 +00:00
|
|
|
|
(window (posn-window start))
|
|
|
|
|
|
(frame (window-frame window))
|
|
|
|
|
|
(minibuffer-window (minibuffer-window frame))
|
2012-07-08 08:26:21 +00:00
|
|
|
|
(side (and (eq line 'vertical)
|
|
|
|
|
|
(or (cdr (assq 'vertical-scroll-bars
|
|
|
|
|
|
(frame-parameters frame)))
|
|
|
|
|
|
'right)))
|
|
|
|
|
|
(draggable t)
|
2013-01-30 17:14:24 +00:00
|
|
|
|
event position growth dragged)
|
2011-10-21 09:15:32 +00:00
|
|
|
|
(cond
|
|
|
|
|
|
((eq line 'header)
|
|
|
|
|
|
;; Check whether header-line can be dragged at all.
|
2011-10-22 17:06:13 +00:00
|
|
|
|
(if (window-at-side-p window 'top)
|
2012-07-08 08:26:21 +00:00
|
|
|
|
(setq draggable nil)
|
2011-10-22 17:06:13 +00:00
|
|
|
|
(setq window (window-in-direction 'above window t))))
|
2011-10-21 09:15:32 +00:00
|
|
|
|
((eq line 'mode)
|
|
|
|
|
|
;; Check whether mode-line can be dragged at all.
|
2012-07-08 08:26:21 +00:00
|
|
|
|
(and (window-at-side-p window 'bottom)
|
|
|
|
|
|
;; Allow resizing the minibuffer window if it's on the same
|
|
|
|
|
|
;; frame as and immediately below the clicked window, and
|
|
|
|
|
|
;; it's active or `resize-mini-windows' is nil.
|
|
|
|
|
|
(not (and (eq (window-frame minibuffer-window) frame)
|
|
|
|
|
|
(= (nth 1 (window-edges minibuffer-window))
|
|
|
|
|
|
(nth 3 (window-edges window)))
|
|
|
|
|
|
(or (not resize-mini-windows)
|
|
|
|
|
|
(eq minibuffer-window
|
|
|
|
|
|
(active-minibuffer-window)))))
|
|
|
|
|
|
(setq draggable nil)))
|
2011-10-21 09:15:32 +00:00
|
|
|
|
((eq line 'vertical)
|
2012-07-08 08:26:21 +00:00
|
|
|
|
;; Get the window to adjust for the vertical case. If the
|
|
|
|
|
|
;; scroll bar is on the window's right or there's no scroll bar
|
|
|
|
|
|
;; at all, adjust the window where the start-event occurred. If
|
|
|
|
|
|
;; the scroll bar is on the start-event window's left, adjust
|
|
|
|
|
|
;; the window on the left of it.
|
|
|
|
|
|
(unless (eq side 'right)
|
|
|
|
|
|
(setq window (window-in-direction 'left window t)))))
|
2011-10-21 09:15:32 +00:00
|
|
|
|
|
|
|
|
|
|
;; Start tracking.
|
1994-08-11 20:35:31 +00:00
|
|
|
|
(track-mouse
|
2013-01-30 17:14:24 +00:00
|
|
|
|
;; Loop reading events and sampling the position of the mouse,
|
|
|
|
|
|
;; until there is a non-mouse-movement event. Also,
|
|
|
|
|
|
;; scroll-bar-movement events are the same as mouse movement for
|
|
|
|
|
|
;; our purposes. (Why? -- cyd)
|
|
|
|
|
|
;; If you change this, check that all of the following still work:
|
|
|
|
|
|
;; Resizing windows by dragging mode-lines and header lines,
|
|
|
|
|
|
;; and vertical lines (in windows without scroll bars).
|
|
|
|
|
|
;; Doing this should not select another window, even if
|
|
|
|
|
|
;; mouse-autoselect-window is non-nil.
|
|
|
|
|
|
;; Mouse-1 clicks in Info header lines should advance position
|
|
|
|
|
|
;; by one node at a time if mouse-1-click-follows-link is non-nil,
|
|
|
|
|
|
;; otherwise they should just select the window.
|
|
|
|
|
|
(while (progn
|
|
|
|
|
|
(setq event (read-event))
|
|
|
|
|
|
(memq (car-safe event)
|
|
|
|
|
|
'(mouse-movement scroll-bar-movement
|
|
|
|
|
|
switch-frame select-window)))
|
2012-07-08 08:26:21 +00:00
|
|
|
|
(setq position (mouse-position))
|
2012-07-26 08:32:25 +00:00
|
|
|
|
;; Do nothing if
|
|
|
|
|
|
;; - there is a switch-frame event.
|
|
|
|
|
|
;; - the mouse isn't in the frame that we started in
|
|
|
|
|
|
;; - the mouse isn't in any Emacs frame
|
2011-10-21 09:15:32 +00:00
|
|
|
|
(cond
|
2012-07-26 08:32:25 +00:00
|
|
|
|
((memq (car event) '(switch-frame select-window))
|
|
|
|
|
|
nil)
|
2013-01-30 17:14:24 +00:00
|
|
|
|
((not (and (eq (car position) frame)
|
|
|
|
|
|
(cadr position)))
|
2011-10-21 09:15:32 +00:00
|
|
|
|
nil)
|
|
|
|
|
|
((eq line 'vertical)
|
2012-07-08 08:26:21 +00:00
|
|
|
|
;; Drag vertical divider.
|
|
|
|
|
|
(setq growth (- (cadr position)
|
|
|
|
|
|
(if (eq side 'right) 0 2)
|
|
|
|
|
|
(nth 2 (window-edges window))
|
|
|
|
|
|
-1))
|
2011-10-21 09:15:32 +00:00
|
|
|
|
(unless (zerop growth)
|
|
|
|
|
|
(setq dragged t))
|
|
|
|
|
|
(adjust-window-trailing-edge window growth t))
|
2012-07-08 08:26:21 +00:00
|
|
|
|
(draggable
|
|
|
|
|
|
;; Drag horizontal divider.
|
2011-10-21 09:15:32 +00:00
|
|
|
|
(setq growth
|
|
|
|
|
|
(if (eq line 'mode)
|
2012-07-08 08:26:21 +00:00
|
|
|
|
(- (cddr position) (nth 3 (window-edges window)) -1)
|
2011-10-21 09:15:32 +00:00
|
|
|
|
;; The window's top includes the header line!
|
2012-07-08 08:26:21 +00:00
|
|
|
|
(- (nth 3 (window-edges window)) (cddr position))))
|
2011-10-21 09:15:32 +00:00
|
|
|
|
(unless (zerop growth)
|
|
|
|
|
|
(setq dragged t))
|
2012-07-08 08:26:21 +00:00
|
|
|
|
(adjust-window-trailing-edge window (if (eq line 'mode)
|
|
|
|
|
|
growth
|
|
|
|
|
|
(- growth)))))))
|
|
|
|
|
|
;; Process the terminating event.
|
2013-01-30 17:14:24 +00:00
|
|
|
|
(unless dragged
|
2012-10-26 09:11:24 +00:00
|
|
|
|
(push event unread-command-events))))
|
2011-10-21 09:15:32 +00:00
|
|
|
|
|
1999-09-09 14:54:25 +00:00
|
|
|
|
(defun mouse-drag-mode-line (start-event)
|
|
|
|
|
|
"Change the height of a window by dragging on the mode line."
|
|
|
|
|
|
(interactive "e")
|
2011-10-21 09:15:32 +00:00
|
|
|
|
(mouse-drag-line start-event 'mode))
|
1999-09-09 14:54:25 +00:00
|
|
|
|
|
|
|
|
|
|
(defun mouse-drag-header-line (start-event)
|
2011-10-21 09:15:32 +00:00
|
|
|
|
"Change the height of a window by dragging on the header line."
|
1999-09-09 14:54:25 +00:00
|
|
|
|
(interactive "e")
|
2011-10-21 09:15:32 +00:00
|
|
|
|
(mouse-drag-line start-event 'header))
|
2006-06-19 21:47:23 +00:00
|
|
|
|
|
1995-09-18 14:15:22 +00:00
|
|
|
|
(defun mouse-drag-vertical-line (start-event)
|
|
|
|
|
|
"Change the width of a window by dragging on the vertical line."
|
|
|
|
|
|
(interactive "e")
|
2011-10-21 09:15:32 +00:00
|
|
|
|
(mouse-drag-line start-event 'vertical))
|
1995-09-18 14:15:22 +00:00
|
|
|
|
|
1993-08-11 06:17:43 +00:00
|
|
|
|
(defun mouse-set-point (event)
|
1991-12-20 07:15:37 +00:00
|
|
|
|
"Move point to the position clicked on with the mouse.
|
1993-08-11 06:17:43 +00:00
|
|
|
|
This should be bound to a mouse click event type."
|
1992-09-13 11:44:06 +00:00
|
|
|
|
(interactive "e")
|
1994-03-09 04:00:12 +00:00
|
|
|
|
(mouse-minibuffer-check event)
|
1993-08-11 06:17:43 +00:00
|
|
|
|
;; Use event-end in case called from mouse-drag-region.
|
|
|
|
|
|
;; If EVENT is a click, event-end and event-start give same value.
|
2004-04-14 17:30:17 +00:00
|
|
|
|
(posn-set-point (event-end event)))
|
1991-12-20 07:15:37 +00:00
|
|
|
|
|
1995-02-12 04:51:42 +00:00
|
|
|
|
(defvar mouse-last-region-beg nil)
|
|
|
|
|
|
(defvar mouse-last-region-end nil)
|
|
|
|
|
|
(defvar mouse-last-region-tick nil)
|
|
|
|
|
|
|
|
|
|
|
|
(defun mouse-region-match ()
|
|
|
|
|
|
"Return non-nil if there's an active region that was set with the mouse."
|
|
|
|
|
|
(and (mark t) mark-active
|
|
|
|
|
|
(eq mouse-last-region-beg (region-beginning))
|
|
|
|
|
|
(eq mouse-last-region-end (region-end))
|
|
|
|
|
|
(eq mouse-last-region-tick (buffer-modified-tick))))
|
|
|
|
|
|
|
1992-10-17 07:07:39 +00:00
|
|
|
|
(defun mouse-set-region (click)
|
1993-09-17 21:26:18 +00:00
|
|
|
|
"Set the region to the text dragged over, and copy to kill ring.
|
2011-07-14 14:01:16 +00:00
|
|
|
|
This should be bound to a mouse drag event.
|
|
|
|
|
|
See the `mouse-drag-copy-region' variable to control whether this
|
|
|
|
|
|
command alters the kill ring or not."
|
1992-10-17 07:07:39 +00:00
|
|
|
|
(interactive "e")
|
1994-03-09 04:00:12 +00:00
|
|
|
|
(mouse-minibuffer-check click)
|
2009-07-15 01:25:32 +00:00
|
|
|
|
(select-window (posn-window (event-start click)))
|
|
|
|
|
|
(let ((beg (posn-point (event-start click)))
|
|
|
|
|
|
(end (posn-point (event-end click))))
|
|
|
|
|
|
(and mouse-drag-copy-region (integerp beg) (integerp end)
|
|
|
|
|
|
;; Don't set this-command to `kill-region', so a following
|
|
|
|
|
|
;; C-w won't double the text in the kill ring. Ignore
|
|
|
|
|
|
;; `last-command' so we don't append to a preceding kill.
|
|
|
|
|
|
(let (this-command last-command deactivate-mark)
|
|
|
|
|
|
(copy-region-as-kill beg end)))
|
|
|
|
|
|
(if (numberp beg) (goto-char beg))
|
|
|
|
|
|
;; On a text terminal, bounce the cursor.
|
1995-06-05 17:36:29 +00:00
|
|
|
|
(or transient-mark-mode
|
2009-07-15 01:25:32 +00:00
|
|
|
|
(window-system)
|
1993-05-15 19:52:01 +00:00
|
|
|
|
(sit-for 1))
|
1992-10-17 07:07:39 +00:00
|
|
|
|
(push-mark)
|
1993-05-15 20:32:23 +00:00
|
|
|
|
(set-mark (point))
|
2009-07-15 01:25:32 +00:00
|
|
|
|
(if (numberp end) (goto-char end))
|
1995-02-12 04:51:42 +00:00
|
|
|
|
(mouse-set-region-1)))
|
|
|
|
|
|
|
|
|
|
|
|
(defun mouse-set-region-1 ()
|
2004-05-28 21:06:26 +00:00
|
|
|
|
;; Set transient-mark-mode for a little while.
|
2008-04-02 20:16:33 +00:00
|
|
|
|
(unless (eq (car-safe transient-mark-mode) 'only)
|
|
|
|
|
|
(setq transient-mark-mode
|
|
|
|
|
|
(cons 'only
|
|
|
|
|
|
(unless (eq transient-mark-mode 'lambda)
|
|
|
|
|
|
transient-mark-mode))))
|
1995-02-12 04:51:42 +00:00
|
|
|
|
(setq mouse-last-region-beg (region-beginning))
|
|
|
|
|
|
(setq mouse-last-region-end (region-end))
|
|
|
|
|
|
(setq mouse-last-region-tick (buffer-modified-tick)))
|
1992-10-17 07:07:39 +00:00
|
|
|
|
|
1997-05-03 22:19:10 +00:00
|
|
|
|
(defcustom mouse-scroll-delay 0.25
|
2008-12-03 05:48:14 +00:00
|
|
|
|
"The pause between scroll steps caused by mouse drags, in seconds.
|
1993-06-30 04:47:37 +00:00
|
|
|
|
If you drag the mouse beyond the edge of a window, Emacs scrolls the
|
|
|
|
|
|
window to bring the text beyond that edge into view, with a delay of
|
|
|
|
|
|
this many seconds between scroll steps. Scrolling stops when you move
|
|
|
|
|
|
the mouse back into the window, or release the button.
|
|
|
|
|
|
This variable's value may be non-integral.
|
1997-05-03 22:19:10 +00:00
|
|
|
|
Setting this to zero causes Emacs to scroll as fast as it can."
|
|
|
|
|
|
:type 'number
|
|
|
|
|
|
:group 'mouse)
|
1993-06-30 04:47:37 +00:00
|
|
|
|
|
1997-05-03 22:19:10 +00:00
|
|
|
|
(defcustom mouse-scroll-min-lines 1
|
2008-12-03 05:48:14 +00:00
|
|
|
|
"The minimum number of lines scrolled by dragging mouse out of window.
|
1995-09-24 23:20:39 +00:00
|
|
|
|
Moving the mouse out the top or bottom edge of the window begins
|
|
|
|
|
|
scrolling repeatedly. The number of lines scrolled per repetition
|
|
|
|
|
|
is normally equal to the number of lines beyond the window edge that
|
|
|
|
|
|
the mouse has moved. However, it always scrolls at least the number
|
1997-05-03 22:19:10 +00:00
|
|
|
|
of lines specified by this variable."
|
|
|
|
|
|
:type 'integer
|
|
|
|
|
|
:group 'mouse)
|
1995-09-18 14:15:22 +00:00
|
|
|
|
|
1994-06-17 00:51:33 +00:00
|
|
|
|
(defun mouse-scroll-subr (window jump &optional overlay start)
|
|
|
|
|
|
"Scroll the window WINDOW, JUMP lines at a time, until new input arrives.
|
1993-06-30 04:47:37 +00:00
|
|
|
|
If OVERLAY is an overlay, let it stretch from START to the far edge of
|
|
|
|
|
|
the newly visible text.
|
|
|
|
|
|
Upon exit, point is at the far edge of the newly visible text."
|
1995-09-18 14:15:22 +00:00
|
|
|
|
(cond
|
|
|
|
|
|
((and (> jump 0) (< jump mouse-scroll-min-lines))
|
|
|
|
|
|
(setq jump mouse-scroll-min-lines))
|
|
|
|
|
|
((and (< jump 0) (< (- jump) mouse-scroll-min-lines))
|
|
|
|
|
|
(setq jump (- mouse-scroll-min-lines))))
|
1994-06-19 18:04:35 +00:00
|
|
|
|
(let ((opoint (point)))
|
|
|
|
|
|
(while (progn
|
|
|
|
|
|
(goto-char (window-start window))
|
|
|
|
|
|
(if (not (zerop (vertical-motion jump window)))
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(set-window-start window (point))
|
|
|
|
|
|
(if (natnump jump)
|
1998-03-14 08:20:37 +00:00
|
|
|
|
(if (window-end window)
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(goto-char (window-end window))
|
|
|
|
|
|
;; window-end doesn't reflect the window's new
|
|
|
|
|
|
;; start position until the next redisplay.
|
|
|
|
|
|
(vertical-motion (1- jump) window))
|
|
|
|
|
|
(vertical-motion (- (window-height window) 2)))
|
1994-06-19 18:04:35 +00:00
|
|
|
|
(goto-char (window-start window)))
|
|
|
|
|
|
(if overlay
|
|
|
|
|
|
(move-overlay overlay start (point)))
|
|
|
|
|
|
;; Now that we have scrolled WINDOW properly,
|
|
|
|
|
|
;; put point back where it was for the redisplay
|
|
|
|
|
|
;; so that we don't mess up the selected window.
|
|
|
|
|
|
(or (eq window (selected-window))
|
|
|
|
|
|
(goto-char opoint))
|
1994-06-25 23:48:04 +00:00
|
|
|
|
(sit-for mouse-scroll-delay)))))
|
1994-06-19 18:04:35 +00:00
|
|
|
|
(or (eq window (selected-window))
|
|
|
|
|
|
(goto-char opoint))))
|
1993-05-15 19:52:01 +00:00
|
|
|
|
|
1993-11-15 09:56:05 +00:00
|
|
|
|
(defvar mouse-selection-click-count 0)
|
1993-09-20 17:36:49 +00:00
|
|
|
|
|
1995-06-29 22:19:13 +00:00
|
|
|
|
(defvar mouse-selection-click-count-buffer nil)
|
|
|
|
|
|
|
1993-06-30 04:47:37 +00:00
|
|
|
|
(defun mouse-drag-region (start-event)
|
1993-06-08 05:16:47 +00:00
|
|
|
|
"Set the region to the text that the mouse is dragged over.
|
1993-08-10 17:03:06 +00:00
|
|
|
|
Highlight the drag area as you move the mouse.
|
|
|
|
|
|
This must be bound to a button-down mouse event.
|
1996-04-30 16:11:53 +00:00
|
|
|
|
In Transient Mark mode, the highlighting remains as long as the mark
|
2002-01-17 02:07:54 +00:00
|
|
|
|
remains active. Otherwise, it remains until the next input event.
|
|
|
|
|
|
|
|
|
|
|
|
If the click is in the echo area, display the `*Messages*' buffer."
|
1993-06-08 05:16:47 +00:00
|
|
|
|
(interactive "e")
|
2011-06-01 15:34:41 +00:00
|
|
|
|
;; Give temporary modes such as isearch a chance to turn off.
|
|
|
|
|
|
(run-hooks 'mouse-leave-buffer-hook)
|
|
|
|
|
|
(mouse-drag-track start-event t))
|
2002-01-17 02:07:54 +00:00
|
|
|
|
|
2004-12-17 15:16:18 +00:00
|
|
|
|
|
2006-09-15 08:53:18 +00:00
|
|
|
|
(defun mouse-posn-property (pos property)
|
2006-09-20 04:56:58 +00:00
|
|
|
|
"Look for a property at click position.
|
|
|
|
|
|
POS may be either a buffer position or a click position like
|
2006-09-21 18:02:47 +00:00
|
|
|
|
those returned from `event-start'. If the click position is on
|
2006-09-20 04:56:58 +00:00
|
|
|
|
a string, the text property PROPERTY is examined.
|
|
|
|
|
|
If this is nil or the click is not on a string, then
|
|
|
|
|
|
the corresponding buffer position is searched for PROPERTY.
|
|
|
|
|
|
If PROPERTY is encountered in one of those places,
|
|
|
|
|
|
its value is returned."
|
2006-09-15 08:53:18 +00:00
|
|
|
|
(if (consp pos)
|
|
|
|
|
|
(let ((w (posn-window pos)) (pt (posn-point pos))
|
|
|
|
|
|
(str (posn-string pos)))
|
|
|
|
|
|
(or (and str
|
|
|
|
|
|
(get-text-property (cdr str) property (car str)))
|
|
|
|
|
|
(and pt
|
|
|
|
|
|
(get-char-property pt property w))))
|
|
|
|
|
|
(get-char-property pos property)))
|
|
|
|
|
|
|
2004-12-17 15:16:18 +00:00
|
|
|
|
(defun mouse-on-link-p (pos)
|
|
|
|
|
|
"Return non-nil if POS is on a link in the current buffer.
|
2006-07-23 21:13:13 +00:00
|
|
|
|
POS must be a buffer position in the current buffer or a mouse
|
|
|
|
|
|
event location in the selected window (see `event-start').
|
2005-02-25 23:30:59 +00:00
|
|
|
|
However, if `mouse-1-click-in-non-selected-windows' is non-nil,
|
|
|
|
|
|
POS may be a mouse event location in any window.
|
2004-12-17 15:16:18 +00:00
|
|
|
|
|
|
|
|
|
|
A clickable link is identified by one of the following methods:
|
|
|
|
|
|
|
2005-01-12 10:54:02 +00:00
|
|
|
|
- If the character at POS has a non-nil `follow-link' text or
|
2005-04-08 09:24:25 +00:00
|
|
|
|
overlay property, the value of that property determines what to do.
|
2004-12-17 15:16:18 +00:00
|
|
|
|
|
2005-01-12 10:54:02 +00:00
|
|
|
|
- If there is a local key-binding or a keybinding at position POS
|
|
|
|
|
|
for the `follow-link' event, the binding of that event determines
|
|
|
|
|
|
what to do.
|
2004-12-17 15:16:18 +00:00
|
|
|
|
|
2005-01-12 10:54:02 +00:00
|
|
|
|
The resulting value determine whether POS is inside a link:
|
|
|
|
|
|
|
|
|
|
|
|
- If the value is `mouse-face', POS is inside a link if there
|
2004-12-17 15:16:18 +00:00
|
|
|
|
is a non-nil `mouse-face' property at POS. Return t in this case.
|
|
|
|
|
|
|
2005-01-12 10:54:02 +00:00
|
|
|
|
- If the value is a function, FUNC, POS is inside a link if
|
2004-12-17 15:16:18 +00:00
|
|
|
|
the call \(FUNC POS) returns non-nil. Return the return value
|
2006-07-23 21:13:13 +00:00
|
|
|
|
from that call. Arg is \(posn-point POS) if POS is a mouse event.
|
2004-12-17 15:16:18 +00:00
|
|
|
|
|
2005-01-12 10:54:02 +00:00
|
|
|
|
- Otherwise, return the value itself.
|
2004-12-17 15:16:18 +00:00
|
|
|
|
|
|
|
|
|
|
The return value is interpreted as follows:
|
|
|
|
|
|
|
|
|
|
|
|
- If it is a string, the mouse-1 event is translated into the
|
|
|
|
|
|
first character of the string, i.e. the action of the mouse-1
|
|
|
|
|
|
click is the local or global binding of that character.
|
|
|
|
|
|
|
|
|
|
|
|
- If it is a vector, the mouse-1 event is translated into the
|
|
|
|
|
|
first element of that vector, i.e. the action of the mouse-1
|
|
|
|
|
|
click is the local or global binding of that event.
|
|
|
|
|
|
|
|
|
|
|
|
- Otherwise, the mouse-1 event is translated into a mouse-2 event
|
|
|
|
|
|
at the same position."
|
2006-09-15 08:53:18 +00:00
|
|
|
|
(let ((action
|
|
|
|
|
|
(and (or (not (consp pos))
|
|
|
|
|
|
mouse-1-click-in-non-selected-windows
|
|
|
|
|
|
(eq (selected-window) (posn-window pos)))
|
|
|
|
|
|
(or (mouse-posn-property pos 'follow-link)
|
|
|
|
|
|
(key-binding [follow-link] nil t pos)))))
|
|
|
|
|
|
(cond
|
|
|
|
|
|
((eq action 'mouse-face)
|
|
|
|
|
|
(and (mouse-posn-property pos 'mouse-face) t))
|
|
|
|
|
|
((functionp action)
|
2006-09-20 04:56:58 +00:00
|
|
|
|
;; FIXME: This seems questionable if the click is not in a buffer.
|
2006-09-19 16:33:30 +00:00
|
|
|
|
;; Should we instead decide that `action' takes a `posn'?
|
2006-09-20 04:56:58 +00:00
|
|
|
|
(if (consp pos)
|
|
|
|
|
|
(with-current-buffer (window-buffer (posn-window pos))
|
2006-11-06 02:43:53 +00:00
|
|
|
|
(funcall action (posn-point pos)))
|
2006-09-20 04:56:58 +00:00
|
|
|
|
(funcall action pos)))
|
2006-09-15 08:53:18 +00:00
|
|
|
|
(t action))))
|
2005-02-22 09:42:06 +00:00
|
|
|
|
|
2005-03-31 10:10:25 +00:00
|
|
|
|
(defun mouse-fixup-help-message (msg)
|
|
|
|
|
|
"Fix help message MSG for `mouse-1-click-follows-link'."
|
|
|
|
|
|
(let (mp pos)
|
|
|
|
|
|
(if (and mouse-1-click-follows-link
|
|
|
|
|
|
(stringp msg)
|
2010-08-01 16:48:15 +00:00
|
|
|
|
(string-match-p "\\`mouse-2" msg)
|
2005-03-31 10:10:25 +00:00
|
|
|
|
(setq mp (mouse-pixel-position))
|
|
|
|
|
|
(consp (setq pos (cdr mp)))
|
|
|
|
|
|
(car pos) (>= (car pos) 0)
|
|
|
|
|
|
(cdr pos) (>= (cdr pos) 0)
|
|
|
|
|
|
(setq pos (posn-at-x-y (car pos) (cdr pos) (car mp)))
|
|
|
|
|
|
(windowp (posn-window pos)))
|
|
|
|
|
|
(with-current-buffer (window-buffer (posn-window pos))
|
|
|
|
|
|
(if (mouse-on-link-p pos)
|
|
|
|
|
|
(setq msg (concat
|
|
|
|
|
|
(cond
|
|
|
|
|
|
((eq mouse-1-click-follows-link 'double) "double-")
|
|
|
|
|
|
((and (integerp mouse-1-click-follows-link)
|
|
|
|
|
|
(< mouse-1-click-follows-link 0)) "Long ")
|
|
|
|
|
|
(t ""))
|
|
|
|
|
|
"mouse-1" (substring msg 7)))))))
|
|
|
|
|
|
msg)
|
2004-12-17 15:16:18 +00:00
|
|
|
|
|
2006-11-06 02:43:53 +00:00
|
|
|
|
(defun mouse-drag-track (start-event &optional
|
2006-01-03 17:08:51 +00:00
|
|
|
|
do-mouse-drag-region-post-process)
|
|
|
|
|
|
"Track mouse drags by highlighting area between point and cursor.
|
2010-07-03 03:07:48 +00:00
|
|
|
|
The region will be defined with mark and point.
|
|
|
|
|
|
DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
|
|
|
|
|
|
`mouse-drag-region'."
|
1994-03-09 04:00:12 +00:00
|
|
|
|
(mouse-minibuffer-check start-event)
|
2005-09-21 20:26:49 +00:00
|
|
|
|
(setq mouse-selection-click-count-buffer (current-buffer))
|
2009-07-17 15:45:08 +00:00
|
|
|
|
(deactivate-mark)
|
2011-09-24 18:38:20 +00:00
|
|
|
|
(let* ((scroll-margin 0) ; Avoid margin scrolling (Bug#9541).
|
2005-09-21 20:26:49 +00:00
|
|
|
|
;; We've recorded what we needed from the current buffer and
|
|
|
|
|
|
;; window, now let's jump to the place of the event, where things
|
|
|
|
|
|
;; are happening.
|
|
|
|
|
|
(_ (mouse-set-point start-event))
|
|
|
|
|
|
(echo-keystrokes 0)
|
1996-01-15 05:12:49 +00:00
|
|
|
|
(start-posn (event-start start-event))
|
1993-06-30 04:47:37 +00:00
|
|
|
|
(start-point (posn-point start-posn))
|
|
|
|
|
|
(start-window (posn-window start-posn))
|
2001-11-14 02:49:26 +00:00
|
|
|
|
(start-window-start (window-start start-window))
|
2000-03-09 20:08:49 +00:00
|
|
|
|
(start-hscroll (window-hscroll start-window))
|
1993-06-30 04:47:37 +00:00
|
|
|
|
(bounds (window-edges start-window))
|
2004-11-13 01:29:45 +00:00
|
|
|
|
(make-cursor-line-fully-visible nil)
|
1993-06-30 04:47:37 +00:00
|
|
|
|
(top (nth 1 bounds))
|
|
|
|
|
|
(bottom (if (window-minibuffer-p start-window)
|
|
|
|
|
|
(nth 3 bounds)
|
|
|
|
|
|
;; Don't count the mode line.
|
1993-09-17 21:26:18 +00:00
|
|
|
|
(1- (nth 3 bounds))))
|
2010-07-05 16:42:50 +00:00
|
|
|
|
(click-count (1- (event-click-count start-event)))
|
2006-12-02 21:47:02 +00:00
|
|
|
|
;; Suppress automatic hscrolling, because that is a nuisance
|
|
|
|
|
|
;; when setting point near the right fringe (but see below).
|
2012-04-17 00:04:53 +00:00
|
|
|
|
(auto-hscroll-mode-saved auto-hscroll-mode)
|
|
|
|
|
|
(auto-hscroll-mode nil)
|
2012-06-13 15:28:10 +00:00
|
|
|
|
moved-off-start event end end-point)
|
2010-07-03 03:07:48 +00:00
|
|
|
|
|
2010-07-05 16:42:50 +00:00
|
|
|
|
(setq mouse-selection-click-count click-count)
|
1995-09-18 14:15:22 +00:00
|
|
|
|
;; In case the down click is in the middle of some intangible text,
|
|
|
|
|
|
;; use the end of that text, and put it in START-POINT.
|
|
|
|
|
|
(if (< (point) start-point)
|
|
|
|
|
|
(goto-char start-point))
|
|
|
|
|
|
(setq start-point (point))
|
2010-07-03 03:07:48 +00:00
|
|
|
|
|
2010-07-05 16:42:50 +00:00
|
|
|
|
;; Activate the region, using `mouse-start-end' to determine where
|
|
|
|
|
|
;; to put point and mark (e.g., double-click will select a word).
|
2010-07-03 03:07:48 +00:00
|
|
|
|
(setq transient-mark-mode
|
|
|
|
|
|
(if (eq transient-mark-mode 'lambda)
|
|
|
|
|
|
'(only)
|
|
|
|
|
|
(cons 'only transient-mark-mode)))
|
2010-08-07 19:39:04 +00:00
|
|
|
|
(let ((range (mouse-start-end start-point start-point click-count)))
|
2010-08-16 02:08:01 +00:00
|
|
|
|
(push-mark (nth 0 range) t t)
|
2010-07-05 16:42:50 +00:00
|
|
|
|
(goto-char (nth 1 range)))
|
2010-07-03 03:07:48 +00:00
|
|
|
|
|
|
|
|
|
|
;; Track the mouse until we get a non-movement event.
|
|
|
|
|
|
(track-mouse
|
|
|
|
|
|
(while (progn
|
|
|
|
|
|
(setq event (read-event))
|
|
|
|
|
|
(or (mouse-movement-p event)
|
|
|
|
|
|
(memq (car-safe event) '(switch-frame select-window))))
|
|
|
|
|
|
(unless (memq (car-safe event) '(switch-frame select-window))
|
|
|
|
|
|
;; Automatic hscrolling did not occur during the call to
|
|
|
|
|
|
;; `read-event'; but if the user subsequently drags the
|
|
|
|
|
|
;; mouse, go ahead and hscroll.
|
2012-04-17 00:04:53 +00:00
|
|
|
|
(let ((auto-hscroll-mode auto-hscroll-mode-saved))
|
2010-07-03 03:07:48 +00:00
|
|
|
|
(redisplay))
|
|
|
|
|
|
(setq end (event-end event)
|
|
|
|
|
|
end-point (posn-point end))
|
2012-06-13 15:28:10 +00:00
|
|
|
|
;; Note whether the mouse has left the starting position.
|
|
|
|
|
|
(unless (eq end-point start-point)
|
|
|
|
|
|
(setq moved-off-start t))
|
2010-07-03 03:07:48 +00:00
|
|
|
|
(if (and (eq (posn-window end) start-window)
|
1993-07-02 23:05:25 +00:00
|
|
|
|
(integer-or-marker-p end-point))
|
2010-08-16 02:08:01 +00:00
|
|
|
|
(mouse--drag-set-mark-and-point start-point
|
|
|
|
|
|
end-point click-count)
|
2010-07-03 03:07:48 +00:00
|
|
|
|
(let ((mouse-row (cdr (cdr (mouse-position)))))
|
|
|
|
|
|
(cond
|
|
|
|
|
|
((null mouse-row))
|
|
|
|
|
|
((< mouse-row top)
|
|
|
|
|
|
(mouse-scroll-subr start-window (- mouse-row top)
|
|
|
|
|
|
nil start-point))
|
|
|
|
|
|
((>= mouse-row bottom)
|
|
|
|
|
|
(mouse-scroll-subr start-window (1+ (- mouse-row bottom))
|
|
|
|
|
|
nil start-point))))))))
|
|
|
|
|
|
|
|
|
|
|
|
;; Handle the terminating event if possible.
|
|
|
|
|
|
(when (consp event)
|
|
|
|
|
|
;; Ensure that point is on the end of the last event.
|
|
|
|
|
|
(when (and (setq end-point (posn-point (event-end event)))
|
1998-11-01 18:17:40 +00:00
|
|
|
|
(eq (posn-window end) start-window)
|
2010-07-03 03:07:48 +00:00
|
|
|
|
(integer-or-marker-p end-point)
|
|
|
|
|
|
(/= start-point end-point))
|
2010-08-16 02:08:01 +00:00
|
|
|
|
(mouse--drag-set-mark-and-point start-point
|
|
|
|
|
|
end-point click-count))
|
|
|
|
|
|
|
2010-07-03 03:07:48 +00:00
|
|
|
|
;; Find its binding.
|
|
|
|
|
|
(let* ((fun (key-binding (vector (car event))))
|
2013-02-07 01:54:50 +00:00
|
|
|
|
;; FIXME This doesn't make sense, because
|
|
|
|
|
|
;; event-click-count always returns something >= 1.
|
2010-07-03 03:07:48 +00:00
|
|
|
|
(do-multi-click (and (> (event-click-count event) 0)
|
|
|
|
|
|
(functionp fun)
|
|
|
|
|
|
(not (memq fun '(mouse-set-point
|
|
|
|
|
|
mouse-set-region))))))
|
|
|
|
|
|
(if (and (/= (mark) (point))
|
|
|
|
|
|
(not do-multi-click))
|
2010-07-11 22:14:53 +00:00
|
|
|
|
|
2010-07-03 03:07:48 +00:00
|
|
|
|
;; If point has moved, finish the drag.
|
|
|
|
|
|
(let* (last-command this-command)
|
|
|
|
|
|
(and mouse-drag-copy-region
|
|
|
|
|
|
do-mouse-drag-region-post-process
|
|
|
|
|
|
(let (deactivate-mark)
|
2010-08-07 19:39:04 +00:00
|
|
|
|
(copy-region-as-kill (mark) (point)))))
|
2010-07-11 22:14:53 +00:00
|
|
|
|
|
2012-06-13 15:28:10 +00:00
|
|
|
|
;; Otherwise, run binding of terminating up-event.
|
2013-02-01 23:40:55 +00:00
|
|
|
|
(deactivate-mark)
|
2012-06-23 12:48:24 +00:00
|
|
|
|
(if do-multi-click
|
|
|
|
|
|
(goto-char start-point)
|
|
|
|
|
|
(unless moved-off-start
|
|
|
|
|
|
(pop-mark)))
|
|
|
|
|
|
|
2010-07-03 03:07:48 +00:00
|
|
|
|
(when (and (functionp fun)
|
|
|
|
|
|
(= start-hscroll (window-hscroll start-window))
|
|
|
|
|
|
;; Don't run the up-event handler if the window
|
|
|
|
|
|
;; start changed in a redisplay after the
|
|
|
|
|
|
;; mouse-set-point for the down-mouse event at
|
|
|
|
|
|
;; the beginning of this function. When the
|
|
|
|
|
|
;; window start has changed, the up-mouse event
|
|
|
|
|
|
;; contains a different position due to the new
|
|
|
|
|
|
;; window contents, and point is set again.
|
|
|
|
|
|
(or end-point
|
|
|
|
|
|
(= (window-start start-window)
|
|
|
|
|
|
start-window-start)))
|
|
|
|
|
|
(push event unread-command-events)))))))
|
|
|
|
|
|
|
2010-08-16 02:08:01 +00:00
|
|
|
|
(defun mouse--drag-set-mark-and-point (start click click-count)
|
|
|
|
|
|
(let* ((range (mouse-start-end start click click-count))
|
|
|
|
|
|
(beg (nth 0 range))
|
|
|
|
|
|
(end (nth 1 range)))
|
|
|
|
|
|
(cond ((eq (mark) beg)
|
|
|
|
|
|
(goto-char end))
|
|
|
|
|
|
((eq (mark) end)
|
|
|
|
|
|
(goto-char beg))
|
|
|
|
|
|
((< click (mark))
|
|
|
|
|
|
(set-mark end)
|
|
|
|
|
|
(goto-char beg))
|
|
|
|
|
|
(t
|
|
|
|
|
|
(set-mark beg)
|
|
|
|
|
|
(goto-char end)))))
|
|
|
|
|
|
|
1993-09-17 21:26:18 +00:00
|
|
|
|
;; Commands to handle xterm-style multiple clicks.
|
|
|
|
|
|
(defun mouse-skip-word (dir)
|
|
|
|
|
|
"Skip over word, over whitespace, or over identical punctuation.
|
|
|
|
|
|
If DIR is positive skip forward; if negative, skip backward."
|
|
|
|
|
|
(let* ((char (following-char))
|
|
|
|
|
|
(syntax (char-to-string (char-syntax char))))
|
1998-07-30 01:34:38 +00:00
|
|
|
|
(cond ((string= syntax "w")
|
|
|
|
|
|
;; Here, we can't use skip-syntax-forward/backward because
|
|
|
|
|
|
;; they don't pay attention to word-separating-categories,
|
|
|
|
|
|
;; and thus they will skip over a true word boundary. So,
|
2008-06-27 07:34:53 +00:00
|
|
|
|
;; we simulate the original behavior by using forward-word.
|
1998-07-30 01:34:38 +00:00
|
|
|
|
(if (< dir 0)
|
|
|
|
|
|
(if (not (looking-at "\\<"))
|
|
|
|
|
|
(forward-word -1))
|
|
|
|
|
|
(if (or (looking-at "\\<") (not (looking-at "\\>")))
|
|
|
|
|
|
(forward-word 1))))
|
|
|
|
|
|
((string= syntax " ")
|
1995-09-18 14:15:22 +00:00
|
|
|
|
(if (< dir 0)
|
|
|
|
|
|
(skip-syntax-backward syntax)
|
|
|
|
|
|
(skip-syntax-forward syntax)))
|
|
|
|
|
|
((string= syntax "_")
|
|
|
|
|
|
(if (< dir 0)
|
|
|
|
|
|
(skip-syntax-backward "w_")
|
|
|
|
|
|
(skip-syntax-forward "w_")))
|
|
|
|
|
|
((< dir 0)
|
|
|
|
|
|
(while (and (not (bobp)) (= (preceding-char) char))
|
|
|
|
|
|
(forward-char -1)))
|
|
|
|
|
|
(t
|
|
|
|
|
|
(while (and (not (eobp)) (= (following-char) char))
|
|
|
|
|
|
(forward-char 1))))))
|
1993-09-17 21:26:18 +00:00
|
|
|
|
|
1993-09-20 17:36:49 +00:00
|
|
|
|
(defun mouse-start-end (start end mode)
|
2005-11-03 21:37:21 +00:00
|
|
|
|
"Return a list of region bounds based on START and END according to MODE.
|
2003-09-01 18:47:29 +00:00
|
|
|
|
If MODE is 0 then set point to (min START END), mark to (max START END).
|
|
|
|
|
|
If MODE is 1 then set point to start of word at (min START END),
|
|
|
|
|
|
mark to end of word at (max START END).
|
|
|
|
|
|
If MODE is 2 then do the same for lines."
|
1993-09-17 21:26:18 +00:00
|
|
|
|
(if (> start end)
|
|
|
|
|
|
(let ((temp start))
|
|
|
|
|
|
(setq start end
|
|
|
|
|
|
end temp)))
|
1993-11-24 06:35:03 +00:00
|
|
|
|
(setq mode (mod mode 3))
|
1993-09-17 21:26:18 +00:00
|
|
|
|
(cond ((= mode 0)
|
|
|
|
|
|
(list start end))
|
|
|
|
|
|
((and (= mode 1)
|
|
|
|
|
|
(= start end)
|
1994-02-09 22:21:47 +00:00
|
|
|
|
(char-after start)
|
1993-09-17 21:26:18 +00:00
|
|
|
|
(= (char-syntax (char-after start)) ?\())
|
1994-02-10 07:39:09 +00:00
|
|
|
|
(list start
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(goto-char start)
|
|
|
|
|
|
(forward-sexp 1)
|
|
|
|
|
|
(point))))
|
1993-09-17 21:26:18 +00:00
|
|
|
|
((and (= mode 1)
|
|
|
|
|
|
(= start end)
|
1994-02-09 22:21:47 +00:00
|
|
|
|
(char-after start)
|
1993-09-17 21:26:18 +00:00
|
|
|
|
(= (char-syntax (char-after start)) ?\)))
|
2001-10-24 20:02:16 +00:00
|
|
|
|
(list (save-excursion
|
1993-09-17 21:26:18 +00:00
|
|
|
|
(goto-char (1+ start))
|
1993-09-27 01:02:43 +00:00
|
|
|
|
(backward-sexp 1)
|
|
|
|
|
|
(point))
|
1993-09-17 21:26:18 +00:00
|
|
|
|
(1+ start)))
|
1996-06-29 01:02:59 +00:00
|
|
|
|
((and (= mode 1)
|
|
|
|
|
|
(= start end)
|
|
|
|
|
|
(char-after start)
|
|
|
|
|
|
(= (char-syntax (char-after start)) ?\"))
|
|
|
|
|
|
(let ((open (or (eq start (point-min))
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(goto-char (- start 1))
|
|
|
|
|
|
(looking-at "\\s(\\|\\s \\|\\s>")))))
|
|
|
|
|
|
(if open
|
|
|
|
|
|
(list start
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(condition-case nil
|
2001-10-24 20:02:16 +00:00
|
|
|
|
(progn
|
1996-06-29 01:02:59 +00:00
|
|
|
|
(goto-char start)
|
|
|
|
|
|
(forward-sexp 1)
|
|
|
|
|
|
(point))
|
|
|
|
|
|
(error end))))
|
1996-12-26 20:48:46 +00:00
|
|
|
|
(list (save-excursion
|
1996-06-29 01:02:59 +00:00
|
|
|
|
(condition-case nil
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(goto-char (1+ start))
|
|
|
|
|
|
(backward-sexp 1)
|
|
|
|
|
|
(point))
|
1996-12-26 20:48:46 +00:00
|
|
|
|
(error end)))
|
|
|
|
|
|
(1+ start)))))
|
1993-09-17 21:26:18 +00:00
|
|
|
|
((= mode 1)
|
|
|
|
|
|
(list (save-excursion
|
|
|
|
|
|
(goto-char start)
|
|
|
|
|
|
(mouse-skip-word -1)
|
|
|
|
|
|
(point))
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(goto-char end)
|
|
|
|
|
|
(mouse-skip-word 1)
|
|
|
|
|
|
(point))))
|
|
|
|
|
|
((= mode 2)
|
|
|
|
|
|
(list (save-excursion
|
|
|
|
|
|
(goto-char start)
|
2010-08-16 02:08:01 +00:00
|
|
|
|
(line-beginning-position 1))
|
1993-09-17 21:26:18 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
|
(goto-char end)
|
|
|
|
|
|
(forward-line 1)
|
|
|
|
|
|
(point))))))
|
1993-06-17 18:17:32 +00:00
|
|
|
|
|
1993-06-13 04:18:43 +00:00
|
|
|
|
;; Subroutine: set the mark where CLICK happened,
|
|
|
|
|
|
;; but don't do anything else.
|
|
|
|
|
|
(defun mouse-set-mark-fast (click)
|
1994-03-09 04:00:12 +00:00
|
|
|
|
(mouse-minibuffer-check click)
|
1993-06-13 04:18:43 +00:00
|
|
|
|
(let ((posn (event-start click)))
|
|
|
|
|
|
(select-window (posn-window posn))
|
|
|
|
|
|
(if (numberp (posn-point posn))
|
|
|
|
|
|
(push-mark (posn-point posn) t t))))
|
|
|
|
|
|
|
1996-07-07 01:59:10 +00:00
|
|
|
|
(defun mouse-undouble-last-event (events)
|
|
|
|
|
|
(let* ((index (1- (length events)))
|
|
|
|
|
|
(last (nthcdr index events))
|
|
|
|
|
|
(event (car last))
|
|
|
|
|
|
(basic (event-basic-type event))
|
1997-05-27 22:52:31 +00:00
|
|
|
|
(old-modifiers (event-modifiers event))
|
|
|
|
|
|
(modifiers (delq 'double (delq 'triple (copy-sequence old-modifiers))))
|
1996-07-07 01:59:10 +00:00
|
|
|
|
(new
|
|
|
|
|
|
(if (consp event)
|
1997-07-01 04:33:22 +00:00
|
|
|
|
;; Use reverse, not nreverse, since event-modifiers
|
|
|
|
|
|
;; does not copy the list it returns.
|
1997-07-09 02:47:07 +00:00
|
|
|
|
(cons (event-convert-list (reverse (cons basic modifiers)))
|
1996-07-07 01:59:10 +00:00
|
|
|
|
(cdr event))
|
|
|
|
|
|
event)))
|
|
|
|
|
|
(setcar last new)
|
1997-05-27 22:52:31 +00:00
|
|
|
|
(if (and (not (equal modifiers old-modifiers))
|
|
|
|
|
|
(key-binding (apply 'vector events)))
|
1996-07-07 01:59:10 +00:00
|
|
|
|
t
|
|
|
|
|
|
(setcar last event)
|
|
|
|
|
|
nil)))
|
|
|
|
|
|
|
2001-10-24 20:02:16 +00:00
|
|
|
|
;; Momentarily show where the mark is, if highlighting doesn't show it.
|
1996-08-27 01:03:35 +00:00
|
|
|
|
|
1991-12-20 07:15:37 +00:00
|
|
|
|
(defun mouse-set-mark (click)
|
|
|
|
|
|
"Set mark at the position clicked on with the mouse.
|
|
|
|
|
|
Display cursor at that position for a second.
|
|
|
|
|
|
This must be bound to a mouse click."
|
1992-09-13 11:44:06 +00:00
|
|
|
|
(interactive "e")
|
1994-08-13 20:29:54 +00:00
|
|
|
|
(mouse-minibuffer-check click)
|
|
|
|
|
|
(select-window (posn-window (event-start click)))
|
|
|
|
|
|
;; We don't use save-excursion because that preserves the mark too.
|
1990-06-19 20:28:34 +00:00
|
|
|
|
(let ((point-save (point)))
|
|
|
|
|
|
(unwind-protect
|
1991-12-20 07:15:37 +00:00
|
|
|
|
(progn (mouse-set-point click)
|
1993-05-26 18:09:52 +00:00
|
|
|
|
(push-mark nil t t)
|
|
|
|
|
|
(or transient-mark-mode
|
|
|
|
|
|
(sit-for 1)))
|
1990-06-19 20:28:34 +00:00
|
|
|
|
(goto-char point-save))))
|
|
|
|
|
|
|
1991-12-20 07:15:37 +00:00
|
|
|
|
(defun mouse-kill (click)
|
|
|
|
|
|
"Kill the region between point and the mouse click.
|
|
|
|
|
|
The text is saved in the kill ring, as with \\[kill-region]."
|
1992-09-13 11:44:06 +00:00
|
|
|
|
(interactive "e")
|
1994-03-09 04:00:12 +00:00
|
|
|
|
(mouse-minibuffer-check click)
|
1994-03-11 04:13:50 +00:00
|
|
|
|
(let* ((posn (event-start click))
|
|
|
|
|
|
(click-posn (posn-point posn)))
|
|
|
|
|
|
(select-window (posn-window posn))
|
1992-08-29 02:14:58 +00:00
|
|
|
|
(if (numberp click-posn)
|
|
|
|
|
|
(kill-region (min (point) click-posn)
|
|
|
|
|
|
(max (point) click-posn)))))
|
1990-06-19 20:28:34 +00:00
|
|
|
|
|
1992-06-10 01:34:51 +00:00
|
|
|
|
(defun mouse-yank-at-click (click arg)
|
|
|
|
|
|
"Insert the last stretch of killed text at the position clicked on.
|
2000-05-15 20:13:54 +00:00
|
|
|
|
Also move point to one end of the text thus inserted (normally the end),
|
2001-12-18 17:43:09 +00:00
|
|
|
|
and set mark at the beginning.
|
1994-02-06 02:53:16 +00:00
|
|
|
|
Prefix arguments are interpreted as with \\[yank].
|
|
|
|
|
|
If `mouse-yank-at-point' is non-nil, insert at point
|
2010-08-07 19:39:04 +00:00
|
|
|
|
regardless of where you click."
|
2004-11-01 13:50:49 +00:00
|
|
|
|
(interactive "e\nP")
|
1994-12-26 05:09:41 +00:00
|
|
|
|
;; Give temporary modes such as isearch a chance to turn off.
|
|
|
|
|
|
(run-hooks 'mouse-leave-buffer-hook)
|
2009-07-17 15:45:08 +00:00
|
|
|
|
(when select-active-regions
|
|
|
|
|
|
;; Without this, confusing things happen upon e.g. inserting into
|
|
|
|
|
|
;; the middle of an active region.
|
2009-07-17 23:27:28 +00:00
|
|
|
|
(deactivate-mark))
|
1994-02-06 02:53:16 +00:00
|
|
|
|
(or mouse-yank-at-point (mouse-set-point click))
|
1993-09-27 01:02:43 +00:00
|
|
|
|
(setq this-command 'yank)
|
1995-06-22 04:37:38 +00:00
|
|
|
|
(setq mouse-selection-click-count 0)
|
1992-06-10 01:34:51 +00:00
|
|
|
|
(yank arg))
|
|
|
|
|
|
|
2007-12-25 20:09:05 +00:00
|
|
|
|
(defun mouse-yank-primary (click)
|
|
|
|
|
|
"Insert the primary selection at the position clicked on.
|
2011-10-29 06:09:02 +00:00
|
|
|
|
Move point to the end of the inserted text, and set mark at
|
|
|
|
|
|
beginning. If `mouse-yank-at-point' is non-nil, insert at point
|
2007-12-25 20:09:05 +00:00
|
|
|
|
regardless of where you click."
|
|
|
|
|
|
(interactive "e")
|
|
|
|
|
|
;; Give temporary modes such as isearch a chance to turn off.
|
|
|
|
|
|
(run-hooks 'mouse-leave-buffer-hook)
|
2010-08-24 15:48:14 +00:00
|
|
|
|
;; Without this, confusing things happen upon e.g. inserting into
|
|
|
|
|
|
;; the middle of an active region.
|
2009-07-17 23:24:54 +00:00
|
|
|
|
(when select-active-regions
|
2010-08-24 15:48:14 +00:00
|
|
|
|
(let (select-active-regions)
|
|
|
|
|
|
(deactivate-mark)))
|
2007-12-25 20:09:05 +00:00
|
|
|
|
(or mouse-yank-at-point (mouse-set-point click))
|
2010-08-14 15:41:22 +00:00
|
|
|
|
(let ((primary
|
|
|
|
|
|
(cond
|
2012-09-17 11:55:02 +00:00
|
|
|
|
((eq (framep (selected-frame)) 'w32)
|
2010-12-25 10:57:02 +00:00
|
|
|
|
;; MS-Windows emulates PRIMARY in x-get-selection, but not
|
|
|
|
|
|
;; in x-get-selection-value (the latter only accesses the
|
|
|
|
|
|
;; clipboard). So try PRIMARY first, in case they selected
|
|
|
|
|
|
;; something with the mouse in the current Emacs session.
|
|
|
|
|
|
(or (x-get-selection 'PRIMARY)
|
|
|
|
|
|
(x-get-selection-value)))
|
|
|
|
|
|
((fboundp 'x-get-selection-value) ; MS-DOS and X.
|
|
|
|
|
|
;; On X, x-get-selection-value supports more formats and
|
|
|
|
|
|
;; encodings, so use it in preference to x-get-selection.
|
2010-08-14 15:41:22 +00:00
|
|
|
|
(or (x-get-selection-value)
|
|
|
|
|
|
(x-get-selection 'PRIMARY)))
|
|
|
|
|
|
;; FIXME: What about xterm-mouse-mode etc.?
|
|
|
|
|
|
(t
|
|
|
|
|
|
(x-get-selection 'PRIMARY)))))
|
2011-10-29 06:09:02 +00:00
|
|
|
|
(unless primary
|
|
|
|
|
|
(error "No selection is available"))
|
|
|
|
|
|
(push-mark (point))
|
|
|
|
|
|
(insert primary)))
|
2007-12-25 20:09:05 +00:00
|
|
|
|
|
1992-06-10 01:34:51 +00:00
|
|
|
|
(defun mouse-kill-ring-save (click)
|
1991-12-20 07:15:37 +00:00
|
|
|
|
"Copy the region between point and the mouse click in the kill ring.
|
|
|
|
|
|
This does not delete the region; it acts like \\[kill-ring-save]."
|
1992-09-13 11:44:06 +00:00
|
|
|
|
(interactive "e")
|
1993-06-13 04:18:43 +00:00
|
|
|
|
(mouse-set-mark-fast click)
|
1994-07-04 00:49:37 +00:00
|
|
|
|
(let (this-command last-command)
|
2010-07-03 03:07:48 +00:00
|
|
|
|
(kill-ring-save (point) (mark t))))
|
1990-06-19 20:28:34 +00:00
|
|
|
|
|
2008-04-01 08:35:58 +00:00
|
|
|
|
;; This function used to delete the text between point and the mouse
|
|
|
|
|
|
;; whenever it was equal to the front of the kill ring, but some
|
|
|
|
|
|
;; people found that confusing.
|
1993-01-26 01:58:16 +00:00
|
|
|
|
|
2010-08-21 04:46:23 +00:00
|
|
|
|
;; The position of the last invocation of `mouse-save-then-kill'.
|
1993-01-26 01:58:16 +00:00
|
|
|
|
(defvar mouse-save-then-kill-posn nil)
|
|
|
|
|
|
|
1993-11-14 06:26:02 +00:00
|
|
|
|
(defun mouse-save-then-kill-delete-region (beg end)
|
1993-11-24 06:35:03 +00:00
|
|
|
|
;; We must make our own undo boundaries
|
|
|
|
|
|
;; because they happen automatically only for the current buffer.
|
|
|
|
|
|
(undo-boundary)
|
1993-11-15 09:56:05 +00:00
|
|
|
|
(if (or (= beg end) (eq buffer-undo-list t))
|
|
|
|
|
|
;; If we have no undo list in this buffer,
|
|
|
|
|
|
;; just delete.
|
|
|
|
|
|
(delete-region beg end)
|
|
|
|
|
|
;; Delete, but make the undo-list entry share with the kill ring.
|
|
|
|
|
|
;; First, delete just one char, so in case buffer is being modified
|
|
|
|
|
|
;; for the first time, the undo list records that fact.
|
2000-05-31 22:48:20 +00:00
|
|
|
|
(let (before-change-functions after-change-functions)
|
1994-06-13 19:35:07 +00:00
|
|
|
|
(delete-region beg
|
|
|
|
|
|
(+ beg (if (> end beg) 1 -1))))
|
1993-11-15 09:56:05 +00:00
|
|
|
|
(let ((buffer-undo-list buffer-undo-list))
|
|
|
|
|
|
;; Undo that deletion--but don't change the undo list!
|
2000-05-31 22:48:20 +00:00
|
|
|
|
(let (before-change-functions after-change-functions)
|
1994-06-13 19:35:07 +00:00
|
|
|
|
(primitive-undo 1 buffer-undo-list))
|
1993-11-15 09:56:05 +00:00
|
|
|
|
;; Now delete the rest of the specified region,
|
|
|
|
|
|
;; but don't record it.
|
|
|
|
|
|
(setq buffer-undo-list t)
|
1993-11-24 06:35:03 +00:00
|
|
|
|
(if (/= (length (car kill-ring)) (- (max end beg) (min end beg)))
|
|
|
|
|
|
(error "Lossage in mouse-save-then-kill-delete-region"))
|
1993-11-15 09:56:05 +00:00
|
|
|
|
(delete-region beg end))
|
|
|
|
|
|
(let ((tail buffer-undo-list))
|
|
|
|
|
|
;; Search back in buffer-undo-list for the string
|
|
|
|
|
|
;; that came from deleting one character.
|
|
|
|
|
|
(while (and tail (not (stringp (car (car tail)))))
|
|
|
|
|
|
(setq tail (cdr tail)))
|
|
|
|
|
|
;; Replace it with an entry for the entire deleted text.
|
|
|
|
|
|
(and tail
|
1993-11-24 06:35:03 +00:00
|
|
|
|
(setcar tail (cons (car kill-ring) (min beg end))))))
|
|
|
|
|
|
(undo-boundary))
|
1993-09-20 17:36:49 +00:00
|
|
|
|
|
1992-09-26 08:15:35 +00:00
|
|
|
|
(defun mouse-save-then-kill (click)
|
2010-08-21 04:46:23 +00:00
|
|
|
|
"Set the region according to CLICK; the second time, kill it.
|
|
|
|
|
|
CLICK should be a mouse click event.
|
|
|
|
|
|
|
|
|
|
|
|
If the region is inactive, activate it temporarily. Set mark at
|
|
|
|
|
|
the original point, and move point to the position of CLICK.
|
|
|
|
|
|
|
|
|
|
|
|
If the region is already active, adjust it. Normally, do this by
|
|
|
|
|
|
moving point or mark, whichever is closer, to CLICK. But if you
|
|
|
|
|
|
have selected whole words or lines, move point or mark to the
|
|
|
|
|
|
word or line boundary closest to CLICK instead.
|
|
|
|
|
|
|
2010-09-05 22:40:57 +00:00
|
|
|
|
If `mouse-drag-copy-region' is non-nil, this command also saves the
|
|
|
|
|
|
new region to the kill ring (replacing the previous kill if the
|
|
|
|
|
|
previous region was just saved to the kill ring).
|
|
|
|
|
|
|
2010-08-21 04:46:23 +00:00
|
|
|
|
If this command is called a second consecutive time with the same
|
2010-09-05 22:40:57 +00:00
|
|
|
|
CLICK position, kill the region (or delete it
|
|
|
|
|
|
if `mouse-drag-copy-region' is non-nil)"
|
1992-09-26 08:15:35 +00:00
|
|
|
|
(interactive "e")
|
2010-08-21 04:46:23 +00:00
|
|
|
|
(mouse-minibuffer-check click)
|
|
|
|
|
|
(let* ((posn (event-start click))
|
|
|
|
|
|
(click-pt (posn-point posn))
|
|
|
|
|
|
(window (posn-window posn))
|
|
|
|
|
|
(buf (window-buffer window))
|
|
|
|
|
|
;; Don't let a subsequent kill command append to this one.
|
|
|
|
|
|
(this-command this-command)
|
|
|
|
|
|
;; Check if the user has multi-clicked to select words/lines.
|
|
|
|
|
|
(click-count
|
|
|
|
|
|
(if (and (eq mouse-selection-click-count-buffer buf)
|
|
|
|
|
|
(with-current-buffer buf (mark t)))
|
|
|
|
|
|
mouse-selection-click-count
|
|
|
|
|
|
0)))
|
|
|
|
|
|
(cond
|
|
|
|
|
|
((not (numberp click-pt)) nil)
|
|
|
|
|
|
;; If the user clicked without moving point, kill the region.
|
|
|
|
|
|
;; This also resets `mouse-selection-click-count'.
|
|
|
|
|
|
((and (eq last-command 'mouse-save-then-kill)
|
|
|
|
|
|
(eq click-pt mouse-save-then-kill-posn)
|
|
|
|
|
|
(eq window (selected-window)))
|
2010-09-05 22:40:57 +00:00
|
|
|
|
(if mouse-drag-copy-region
|
|
|
|
|
|
;; Region already saved in the previous click;
|
|
|
|
|
|
;; don't make a duplicate entry, just delete.
|
|
|
|
|
|
(delete-region (mark t) (point))
|
|
|
|
|
|
(kill-region (mark t) (point)))
|
2010-08-21 04:46:23 +00:00
|
|
|
|
(setq mouse-selection-click-count 0)
|
|
|
|
|
|
(setq mouse-save-then-kill-posn nil))
|
|
|
|
|
|
|
|
|
|
|
|
;; Otherwise, if there is a suitable region, adjust it by moving
|
|
|
|
|
|
;; one end (whichever is closer) to CLICK-PT.
|
|
|
|
|
|
((or (with-current-buffer buf (region-active-p))
|
|
|
|
|
|
(and (eq window (selected-window))
|
|
|
|
|
|
(mark t)
|
|
|
|
|
|
(or (and (eq last-command 'mouse-save-then-kill)
|
|
|
|
|
|
mouse-save-then-kill-posn)
|
|
|
|
|
|
(and (memq last-command '(mouse-drag-region
|
|
|
|
|
|
mouse-set-region))
|
|
|
|
|
|
(or mark-even-if-inactive
|
|
|
|
|
|
(not transient-mark-mode))))))
|
|
|
|
|
|
(select-window window)
|
|
|
|
|
|
(let* ((range (mouse-start-end click-pt click-pt click-count)))
|
|
|
|
|
|
(if (< (abs (- click-pt (mark t)))
|
|
|
|
|
|
(abs (- click-pt (point))))
|
|
|
|
|
|
(set-mark (car range))
|
|
|
|
|
|
(goto-char (nth 1 range)))
|
|
|
|
|
|
(setq deactivate-mark nil)
|
|
|
|
|
|
(mouse-set-region-1)
|
2010-09-05 22:40:57 +00:00
|
|
|
|
(when mouse-drag-copy-region
|
|
|
|
|
|
;; Region already copied to kill-ring once, so replace.
|
|
|
|
|
|
(kill-new (filter-buffer-substring (mark t) (point)) t))
|
2010-08-21 04:46:23 +00:00
|
|
|
|
;; Arrange for a repeated mouse-3 to kill the region.
|
|
|
|
|
|
(setq mouse-save-then-kill-posn click-pt)))
|
|
|
|
|
|
|
|
|
|
|
|
;; Otherwise, set the mark where point is and move to CLICK-PT.
|
|
|
|
|
|
(t
|
|
|
|
|
|
(select-window window)
|
|
|
|
|
|
(mouse-set-mark-fast click)
|
|
|
|
|
|
(let ((before-scroll (with-current-buffer buf point-before-scroll)))
|
|
|
|
|
|
(if before-scroll (goto-char before-scroll)))
|
|
|
|
|
|
(exchange-point-and-mark)
|
|
|
|
|
|
(mouse-set-region-1)
|
2010-09-05 22:40:57 +00:00
|
|
|
|
(when mouse-drag-copy-region
|
|
|
|
|
|
(kill-new (filter-buffer-substring (mark t) (point))))
|
2010-08-21 04:46:23 +00:00
|
|
|
|
(setq mouse-save-then-kill-posn click-pt)))))
|
|
|
|
|
|
|
1993-06-17 18:17:32 +00:00
|
|
|
|
|
|
|
|
|
|
(global-set-key [M-mouse-1] 'mouse-start-secondary)
|
|
|
|
|
|
(global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
|
|
|
|
|
|
(global-set-key [M-down-mouse-1] 'mouse-drag-secondary)
|
|
|
|
|
|
(global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill)
|
1993-11-24 06:35:03 +00:00
|
|
|
|
(global-set-key [M-mouse-2] 'mouse-yank-secondary)
|
1993-06-17 18:17:32 +00:00
|
|
|
|
|
2005-09-21 20:26:49 +00:00
|
|
|
|
(defconst mouse-secondary-overlay
|
|
|
|
|
|
(let ((ol (make-overlay (point-min) (point-min))))
|
|
|
|
|
|
(delete-overlay ol)
|
|
|
|
|
|
(overlay-put ol 'face 'secondary-selection)
|
|
|
|
|
|
ol)
|
|
|
|
|
|
"An overlay which records the current secondary selection.
|
|
|
|
|
|
It is deleted when there is no secondary selection.")
|
1993-06-17 18:17:32 +00:00
|
|
|
|
|
1994-10-01 07:30:18 +00:00
|
|
|
|
(defvar mouse-secondary-click-count 0)
|
|
|
|
|
|
|
1993-06-17 18:17:32 +00:00
|
|
|
|
;; A marker which records the specified first end for a secondary selection.
|
|
|
|
|
|
;; May be nil.
|
|
|
|
|
|
(defvar mouse-secondary-start nil)
|
|
|
|
|
|
|
|
|
|
|
|
(defun mouse-start-secondary (click)
|
|
|
|
|
|
"Set one end of the secondary selection to the position clicked on.
|
|
|
|
|
|
Use \\[mouse-secondary-save-then-kill] to set the other end
|
|
|
|
|
|
and complete the secondary selection."
|
|
|
|
|
|
(interactive "e")
|
1994-03-09 04:00:12 +00:00
|
|
|
|
(mouse-minibuffer-check click)
|
1993-06-17 18:17:32 +00:00
|
|
|
|
(let ((posn (event-start click)))
|
2005-09-21 20:26:49 +00:00
|
|
|
|
(with-current-buffer (window-buffer (posn-window posn))
|
1993-06-18 17:59:02 +00:00
|
|
|
|
;; Cancel any preexisting secondary selection.
|
2005-09-21 20:26:49 +00:00
|
|
|
|
(delete-overlay mouse-secondary-overlay)
|
1993-06-18 17:59:02 +00:00
|
|
|
|
(if (numberp (posn-point posn))
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(or mouse-secondary-start
|
|
|
|
|
|
(setq mouse-secondary-start (make-marker)))
|
|
|
|
|
|
(move-marker mouse-secondary-start (posn-point posn)))))))
|
1993-06-17 18:17:32 +00:00
|
|
|
|
|
|
|
|
|
|
(defun mouse-set-secondary (click)
|
|
|
|
|
|
"Set the secondary selection to the text that the mouse is dragged over.
|
|
|
|
|
|
This must be bound to a mouse drag event."
|
|
|
|
|
|
(interactive "e")
|
1994-03-09 04:00:12 +00:00
|
|
|
|
(mouse-minibuffer-check click)
|
1993-06-17 18:17:32 +00:00
|
|
|
|
(let ((posn (event-start click))
|
|
|
|
|
|
beg
|
|
|
|
|
|
(end (event-end click)))
|
2005-09-21 20:26:49 +00:00
|
|
|
|
(with-current-buffer (window-buffer (posn-window posn))
|
1993-06-18 17:59:02 +00:00
|
|
|
|
(if (numberp (posn-point posn))
|
|
|
|
|
|
(setq beg (posn-point posn)))
|
2007-04-01 17:45:20 +00:00
|
|
|
|
(move-overlay mouse-secondary-overlay beg (posn-point end))
|
|
|
|
|
|
(x-set-selection
|
|
|
|
|
|
'SECONDARY
|
|
|
|
|
|
(buffer-substring (overlay-start mouse-secondary-overlay)
|
|
|
|
|
|
(overlay-end mouse-secondary-overlay))))))
|
1992-09-26 08:15:35 +00:00
|
|
|
|
|
1993-09-27 01:02:43 +00:00
|
|
|
|
(defun mouse-drag-secondary (start-event)
|
1993-06-17 18:17:32 +00:00
|
|
|
|
"Set the secondary selection to the text that the mouse is dragged over.
|
1993-09-27 01:02:43 +00:00
|
|
|
|
Highlight the drag area as you move the mouse.
|
1996-09-25 03:27:04 +00:00
|
|
|
|
This must be bound to a button-down mouse event.
|
|
|
|
|
|
The function returns a non-nil value if it creates a secondary selection."
|
1993-06-17 18:17:32 +00:00
|
|
|
|
(interactive "e")
|
1994-03-09 04:00:12 +00:00
|
|
|
|
(mouse-minibuffer-check start-event)
|
1996-01-15 05:12:49 +00:00
|
|
|
|
(let* ((echo-keystrokes 0)
|
|
|
|
|
|
(start-posn (event-start start-event))
|
1993-09-27 01:02:43 +00:00
|
|
|
|
(start-point (posn-point start-posn))
|
|
|
|
|
|
(start-window (posn-window start-posn))
|
|
|
|
|
|
(bounds (window-edges start-window))
|
|
|
|
|
|
(top (nth 1 bounds))
|
|
|
|
|
|
(bottom (if (window-minibuffer-p start-window)
|
|
|
|
|
|
(nth 3 bounds)
|
|
|
|
|
|
;; Don't count the mode line.
|
|
|
|
|
|
(1- (nth 3 bounds))))
|
|
|
|
|
|
(click-count (1- (event-click-count start-event))))
|
2005-09-21 20:26:49 +00:00
|
|
|
|
(with-current-buffer (window-buffer start-window)
|
1994-10-01 07:30:18 +00:00
|
|
|
|
(setq mouse-secondary-click-count click-count)
|
1993-11-24 06:35:03 +00:00
|
|
|
|
(if (> (mod click-count 3) 0)
|
1993-11-14 06:26:02 +00:00
|
|
|
|
;; Double or triple press: make an initial selection
|
|
|
|
|
|
;; of one word or line.
|
1993-09-27 01:02:43 +00:00
|
|
|
|
(let ((range (mouse-start-end start-point start-point click-count)))
|
|
|
|
|
|
(set-marker mouse-secondary-start nil)
|
|
|
|
|
|
(move-overlay mouse-secondary-overlay (car range) (nth 1 range)
|
|
|
|
|
|
(window-buffer start-window)))
|
1993-11-14 06:26:02 +00:00
|
|
|
|
;; Single-press: cancel any preexisting secondary selection.
|
1993-09-27 01:02:43 +00:00
|
|
|
|
(or mouse-secondary-start
|
|
|
|
|
|
(setq mouse-secondary-start (make-marker)))
|
|
|
|
|
|
(set-marker mouse-secondary-start start-point)
|
|
|
|
|
|
(delete-overlay mouse-secondary-overlay))
|
|
|
|
|
|
(let (event end end-point)
|
|
|
|
|
|
(track-mouse
|
|
|
|
|
|
(while (progn
|
|
|
|
|
|
(setq event (read-event))
|
|
|
|
|
|
(or (mouse-movement-p event)
|
2005-01-11 15:36:57 +00:00
|
|
|
|
(memq (car-safe event) '(switch-frame select-window))))
|
1993-09-27 01:02:43 +00:00
|
|
|
|
|
2005-01-11 15:36:57 +00:00
|
|
|
|
(if (memq (car-safe event) '(switch-frame select-window))
|
1993-09-27 01:02:43 +00:00
|
|
|
|
nil
|
|
|
|
|
|
(setq end (event-end event)
|
|
|
|
|
|
end-point (posn-point end))
|
|
|
|
|
|
(cond
|
|
|
|
|
|
;; Are we moving within the original window?
|
|
|
|
|
|
((and (eq (posn-window end) start-window)
|
|
|
|
|
|
(integer-or-marker-p end-point))
|
|
|
|
|
|
(let ((range (mouse-start-end start-point end-point
|
|
|
|
|
|
click-count)))
|
1994-07-12 17:03:13 +00:00
|
|
|
|
(if (or (/= start-point end-point)
|
|
|
|
|
|
(null (marker-position mouse-secondary-start)))
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(set-marker mouse-secondary-start nil)
|
|
|
|
|
|
(move-overlay mouse-secondary-overlay
|
|
|
|
|
|
(car range) (nth 1 range))))))
|
1994-05-20 08:46:20 +00:00
|
|
|
|
(t
|
|
|
|
|
|
(let ((mouse-row (cdr (cdr (mouse-position)))))
|
|
|
|
|
|
(cond
|
|
|
|
|
|
((null mouse-row))
|
|
|
|
|
|
((< mouse-row top)
|
1994-06-17 00:51:33 +00:00
|
|
|
|
(mouse-scroll-subr start-window (- mouse-row top)
|
|
|
|
|
|
mouse-secondary-overlay start-point))
|
1994-06-25 23:48:04 +00:00
|
|
|
|
((>= mouse-row bottom)
|
1994-06-17 00:51:33 +00:00
|
|
|
|
(mouse-scroll-subr start-window (1+ (- mouse-row bottom))
|
1994-05-20 08:46:20 +00:00
|
|
|
|
mouse-secondary-overlay start-point)))))))))
|
1993-09-27 01:02:43 +00:00
|
|
|
|
|
1994-06-19 18:04:35 +00:00
|
|
|
|
(if (consp event)
|
1993-09-27 01:02:43 +00:00
|
|
|
|
(if (marker-position mouse-secondary-start)
|
|
|
|
|
|
(save-window-excursion
|
|
|
|
|
|
(delete-overlay mouse-secondary-overlay)
|
1993-11-24 06:35:03 +00:00
|
|
|
|
(x-set-selection 'SECONDARY nil)
|
1993-09-27 01:02:43 +00:00
|
|
|
|
(select-window start-window)
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(goto-char mouse-secondary-start)
|
1996-09-25 03:27:04 +00:00
|
|
|
|
(sit-for 1)
|
|
|
|
|
|
nil))
|
1993-11-24 06:35:03 +00:00
|
|
|
|
(x-set-selection
|
|
|
|
|
|
'SECONDARY
|
|
|
|
|
|
(buffer-substring (overlay-start mouse-secondary-overlay)
|
|
|
|
|
|
(overlay-end mouse-secondary-overlay)))))))))
|
1993-06-17 18:17:32 +00:00
|
|
|
|
|
1993-11-24 06:35:03 +00:00
|
|
|
|
(defun mouse-yank-secondary (click)
|
1994-02-06 02:53:16 +00:00
|
|
|
|
"Insert the secondary selection at the position clicked on.
|
|
|
|
|
|
Move point to the end of the inserted text.
|
|
|
|
|
|
If `mouse-yank-at-point' is non-nil, insert at point
|
|
|
|
|
|
regardless of where you click."
|
2004-11-01 13:50:49 +00:00
|
|
|
|
(interactive "e")
|
1994-12-26 05:09:41 +00:00
|
|
|
|
;; Give temporary modes such as isearch a chance to turn off.
|
|
|
|
|
|
(run-hooks 'mouse-leave-buffer-hook)
|
1994-02-06 02:53:16 +00:00
|
|
|
|
(or mouse-yank-at-point (mouse-set-point click))
|
2007-07-16 04:42:24 +00:00
|
|
|
|
(let ((secondary (x-get-selection 'SECONDARY)))
|
|
|
|
|
|
(if secondary
|
2010-07-26 19:05:47 +00:00
|
|
|
|
(insert secondary)
|
2007-07-16 04:42:24 +00:00
|
|
|
|
(error "No secondary selection"))))
|
1993-11-24 06:35:03 +00:00
|
|
|
|
|
1993-12-23 03:33:34 +00:00
|
|
|
|
(defun mouse-kill-secondary ()
|
1993-11-24 06:35:03 +00:00
|
|
|
|
"Kill the text in the secondary selection.
|
|
|
|
|
|
This is intended more as a keyboard command than as a mouse command
|
|
|
|
|
|
but it can work as either one.
|
|
|
|
|
|
|
|
|
|
|
|
The current buffer (in case of keyboard use), or the buffer clicked on,
|
|
|
|
|
|
must be the one that the secondary selection is in. This requirement
|
|
|
|
|
|
is to prevent accidents."
|
1993-12-23 03:33:34 +00:00
|
|
|
|
(interactive)
|
|
|
|
|
|
(let* ((keys (this-command-keys))
|
|
|
|
|
|
(click (elt keys (1- (length keys)))))
|
|
|
|
|
|
(or (eq (overlay-buffer mouse-secondary-overlay)
|
|
|
|
|
|
(if (listp click)
|
|
|
|
|
|
(window-buffer (posn-window (event-start click)))
|
|
|
|
|
|
(current-buffer)))
|
|
|
|
|
|
(error "Select or click on the buffer where the secondary selection is")))
|
1995-02-26 04:17:42 +00:00
|
|
|
|
(let (this-command)
|
2005-09-21 20:26:49 +00:00
|
|
|
|
(with-current-buffer (overlay-buffer mouse-secondary-overlay)
|
1995-02-26 04:17:42 +00:00
|
|
|
|
(kill-region (overlay-start mouse-secondary-overlay)
|
|
|
|
|
|
(overlay-end mouse-secondary-overlay))))
|
2009-07-15 01:25:32 +00:00
|
|
|
|
(delete-overlay mouse-secondary-overlay))
|
1993-06-17 18:17:32 +00:00
|
|
|
|
|
|
|
|
|
|
(defun mouse-secondary-save-then-kill (click)
|
2010-08-21 04:46:23 +00:00
|
|
|
|
"Set the secondary selection and save it to the kill ring.
|
|
|
|
|
|
The second time, kill it. CLICK should be a mouse click event.
|
|
|
|
|
|
|
|
|
|
|
|
If you have not called `mouse-start-secondary' in the clicked
|
|
|
|
|
|
buffer, activate the secondary selection and set it between point
|
|
|
|
|
|
and the click position CLICK.
|
|
|
|
|
|
|
|
|
|
|
|
Otherwise, adjust the bounds of the secondary selection.
|
|
|
|
|
|
Normally, do this by moving its beginning or end, whichever is
|
|
|
|
|
|
closer, to CLICK. But if you have selected whole words or lines,
|
|
|
|
|
|
adjust to the word or line boundary closest to CLICK instead.
|
|
|
|
|
|
|
|
|
|
|
|
If this command is called a second consecutive time with the same
|
|
|
|
|
|
CLICK position, kill the secondary selection."
|
1993-06-17 18:17:32 +00:00
|
|
|
|
(interactive "e")
|
1994-03-09 04:00:12 +00:00
|
|
|
|
(mouse-minibuffer-check click)
|
2010-08-21 04:46:23 +00:00
|
|
|
|
(let* ((posn (event-start click))
|
|
|
|
|
|
(click-pt (posn-point posn))
|
|
|
|
|
|
(window (posn-window posn))
|
|
|
|
|
|
(buf (window-buffer window))
|
|
|
|
|
|
;; Don't let a subsequent kill command append to this one.
|
|
|
|
|
|
(this-command this-command)
|
|
|
|
|
|
;; Check if the user has multi-clicked to select words/lines.
|
|
|
|
|
|
(click-count
|
|
|
|
|
|
(if (eq (overlay-buffer mouse-secondary-overlay) buf)
|
|
|
|
|
|
mouse-secondary-click-count
|
|
|
|
|
|
0))
|
|
|
|
|
|
(beg (overlay-start mouse-secondary-overlay))
|
|
|
|
|
|
(end (overlay-end mouse-secondary-overlay)))
|
|
|
|
|
|
|
|
|
|
|
|
(cond
|
|
|
|
|
|
((not (numberp click-pt)) nil)
|
|
|
|
|
|
|
|
|
|
|
|
;; If the secondary selection is not active in BUF, activate it.
|
|
|
|
|
|
((not (eq buf (or (overlay-buffer mouse-secondary-overlay)
|
|
|
|
|
|
(if mouse-secondary-start
|
|
|
|
|
|
(marker-buffer mouse-secondary-start)))))
|
|
|
|
|
|
(select-window window)
|
|
|
|
|
|
(setq mouse-secondary-start (make-marker))
|
|
|
|
|
|
(move-marker mouse-secondary-start (point))
|
|
|
|
|
|
(move-overlay mouse-secondary-overlay (point) click-pt buf)
|
|
|
|
|
|
(kill-ring-save (point) click-pt))
|
|
|
|
|
|
|
|
|
|
|
|
;; If the user clicked without moving point, delete the secondary
|
|
|
|
|
|
;; selection. This also resets `mouse-secondary-click-count'.
|
|
|
|
|
|
((and (eq last-command 'mouse-secondary-save-then-kill)
|
|
|
|
|
|
(eq click-pt mouse-save-then-kill-posn)
|
|
|
|
|
|
(eq window (selected-window)))
|
|
|
|
|
|
(mouse-save-then-kill-delete-region beg end)
|
|
|
|
|
|
(delete-overlay mouse-secondary-overlay)
|
|
|
|
|
|
(setq mouse-secondary-click-count 0)
|
|
|
|
|
|
(setq mouse-save-then-kill-posn nil))
|
|
|
|
|
|
|
|
|
|
|
|
;; Otherwise, if there is a suitable secondary selection overlay,
|
|
|
|
|
|
;; adjust it by moving one end (whichever is closer) to CLICK-PT.
|
|
|
|
|
|
((and beg (eq buf (overlay-buffer mouse-secondary-overlay)))
|
|
|
|
|
|
(let* ((range (mouse-start-end click-pt click-pt click-count)))
|
|
|
|
|
|
(if (< (abs (- click-pt beg))
|
|
|
|
|
|
(abs (- click-pt end)))
|
|
|
|
|
|
(move-overlay mouse-secondary-overlay (car range) end)
|
|
|
|
|
|
(move-overlay mouse-secondary-overlay beg (nth 1 range))))
|
|
|
|
|
|
(setq deactivate-mark nil)
|
|
|
|
|
|
(if (eq last-command 'mouse-secondary-save-then-kill)
|
|
|
|
|
|
;; If the front of the kill ring comes from an immediately
|
|
|
|
|
|
;; previous use of this command, replace the entry.
|
|
|
|
|
|
(kill-new
|
|
|
|
|
|
(buffer-substring (overlay-start mouse-secondary-overlay)
|
|
|
|
|
|
(overlay-end mouse-secondary-overlay))
|
|
|
|
|
|
t)
|
|
|
|
|
|
(let (deactivate-mark)
|
|
|
|
|
|
(copy-region-as-kill (overlay-start mouse-secondary-overlay)
|
|
|
|
|
|
(overlay-end mouse-secondary-overlay))))
|
|
|
|
|
|
(setq mouse-save-then-kill-posn click-pt))
|
|
|
|
|
|
|
|
|
|
|
|
;; Otherwise, set the secondary selection overlay.
|
|
|
|
|
|
(t
|
|
|
|
|
|
(select-window window)
|
|
|
|
|
|
(if mouse-secondary-start
|
|
|
|
|
|
;; All we have is one end of a selection, so put the other
|
|
|
|
|
|
;; end here.
|
|
|
|
|
|
(let ((start (+ 0 mouse-secondary-start)))
|
|
|
|
|
|
(kill-ring-save start click-pt)
|
|
|
|
|
|
(move-overlay mouse-secondary-overlay start click-pt)))
|
|
|
|
|
|
(setq mouse-save-then-kill-posn click-pt))))
|
|
|
|
|
|
|
|
|
|
|
|
;; Finally, set the window system's secondary selection.
|
|
|
|
|
|
(let (str)
|
|
|
|
|
|
(and (overlay-buffer mouse-secondary-overlay)
|
|
|
|
|
|
(setq str (buffer-substring (overlay-start mouse-secondary-overlay)
|
|
|
|
|
|
(overlay-end mouse-secondary-overlay)))
|
|
|
|
|
|
(> (length str) 0)
|
|
|
|
|
|
(x-set-selection 'SECONDARY str))))
|
|
|
|
|
|
|
1993-06-17 18:17:32 +00:00
|
|
|
|
|
1998-03-12 23:11:57 +00:00
|
|
|
|
(defcustom mouse-buffer-menu-maxlen 20
|
2008-12-03 05:48:14 +00:00
|
|
|
|
"Number of buffers in one pane (submenu) of the buffer menu.
|
1995-12-26 19:43:51 +00:00
|
|
|
|
If we have lots of buffers, divide them into groups of
|
1998-03-12 23:11:57 +00:00
|
|
|
|
`mouse-buffer-menu-maxlen' and make a pane (or submenu) for each one."
|
1997-05-03 22:19:10 +00:00
|
|
|
|
:type 'integer
|
|
|
|
|
|
:group 'mouse)
|
1995-12-26 19:43:51 +00:00
|
|
|
|
|
1998-04-20 20:45:25 +00:00
|
|
|
|
(defcustom mouse-buffer-menu-mode-mult 4
|
2008-12-03 05:48:14 +00:00
|
|
|
|
"Group the buffers by the major mode groups on \\[mouse-buffer-menu]?
|
1998-04-20 20:45:25 +00:00
|
|
|
|
This number which determines (in a hairy way) whether \\[mouse-buffer-menu]
|
|
|
|
|
|
will split the buffer menu by the major modes (see
|
|
|
|
|
|
`mouse-buffer-menu-mode-groups') or just by menu length.
|
|
|
|
|
|
Set to 1 (or even 0!) if you want to group by major mode always, and to
|
|
|
|
|
|
a large number if you prefer a mixed multitude. The default is 4."
|
|
|
|
|
|
:type 'integer
|
|
|
|
|
|
:group 'mouse
|
|
|
|
|
|
:version "20.3")
|
|
|
|
|
|
|
1997-02-10 00:10:16 +00:00
|
|
|
|
(defvar mouse-buffer-menu-mode-groups
|
2011-02-01 21:37:12 +00:00
|
|
|
|
(mapcar (lambda (arg) (cons (purecopy (car arg)) (purecopy (cdr arg))))
|
1997-02-10 00:10:16 +00:00
|
|
|
|
'(("Info\\|Help\\|Apropos\\|Man" . "Help")
|
|
|
|
|
|
("\\bVM\\b\\|\\bMH\\b\\|Message\\|Mail\\|Group\\|Score\\|Summary\\|Article"
|
|
|
|
|
|
. "Mail/News")
|
|
|
|
|
|
("\\<C\\>" . "C")
|
|
|
|
|
|
("ObjC" . "C")
|
|
|
|
|
|
("Text" . "Text")
|
|
|
|
|
|
("Outline" . "Text")
|
2001-10-27 16:32:35 +00:00
|
|
|
|
("\\(HT\\|SG\\|X\\|XHT\\)ML" . "SGML")
|
2008-11-11 17:20:06 +00:00
|
|
|
|
("log\\|diff\\|vc\\|cvs\\|Annotate" . "Version Control") ; "Change Management"?
|
2011-02-04 14:54:13 +00:00
|
|
|
|
("Threads\\|Memory\\|Disassembly\\|Breakpoints\\|Frames\\|Locals\\|Registers\\|Inferior I/O\\|Debugger"
|
|
|
|
|
|
. "GDB")
|
2009-10-26 06:43:36 +00:00
|
|
|
|
("Lisp" . "Lisp")))
|
1997-02-10 00:10:16 +00:00
|
|
|
|
"How to group various major modes together in \\[mouse-buffer-menu].
|
|
|
|
|
|
Each element has the form (REGEXP . GROUPNAME).
|
|
|
|
|
|
If the major mode's name string matches REGEXP, use GROUPNAME instead.")
|
|
|
|
|
|
|
1992-08-31 05:06:54 +00:00
|
|
|
|
(defun mouse-buffer-menu (event)
|
1992-12-29 21:06:51 +00:00
|
|
|
|
"Pop up a menu of buffers for selection with the mouse.
|
|
|
|
|
|
This switches buffers in the window that you clicked on,
|
|
|
|
|
|
and selects that window."
|
1992-09-13 11:44:06 +00:00
|
|
|
|
(interactive "e")
|
1994-03-09 04:00:12 +00:00
|
|
|
|
(mouse-minibuffer-check event)
|
1998-04-20 20:45:25 +00:00
|
|
|
|
(let ((buffers (buffer-list)) alist menu split-by-major-mode sum-of-squares)
|
1997-02-10 00:10:16 +00:00
|
|
|
|
;; Make an alist of elements that look like (MENU-ITEM . BUFFER).
|
2007-08-06 17:19:26 +00:00
|
|
|
|
(dolist (buf buffers)
|
|
|
|
|
|
;; Divide all buffers into buckets for various major modes.
|
|
|
|
|
|
;; Each bucket looks like (MODE NAMESTRING BUFFERS...).
|
|
|
|
|
|
(with-current-buffer buf
|
|
|
|
|
|
(let* ((adjusted-major-mode major-mode) elt)
|
|
|
|
|
|
(dolist (group mouse-buffer-menu-mode-groups)
|
|
|
|
|
|
(when (string-match (car group) (format-mode-line mode-name))
|
|
|
|
|
|
(setq adjusted-major-mode (cdr group))))
|
|
|
|
|
|
(setq elt (assoc adjusted-major-mode split-by-major-mode))
|
|
|
|
|
|
(unless elt
|
|
|
|
|
|
(setq elt (list adjusted-major-mode
|
|
|
|
|
|
(if (stringp adjusted-major-mode)
|
|
|
|
|
|
adjusted-major-mode
|
2008-01-04 06:29:12 +00:00
|
|
|
|
(format-mode-line mode-name nil nil buf)))
|
2007-08-06 17:19:26 +00:00
|
|
|
|
split-by-major-mode (cons elt split-by-major-mode)))
|
|
|
|
|
|
(or (memq buf (cdr (cdr elt)))
|
|
|
|
|
|
(setcdr (cdr elt) (cons buf (cdr (cdr elt))))))))
|
1997-02-10 00:10:16 +00:00
|
|
|
|
;; Compute the sum of squares of sizes of the major-mode buckets.
|
|
|
|
|
|
(let ((tail split-by-major-mode))
|
|
|
|
|
|
(setq sum-of-squares 0)
|
|
|
|
|
|
(while tail
|
|
|
|
|
|
(setq sum-of-squares
|
|
|
|
|
|
(+ sum-of-squares
|
1998-04-20 20:45:25 +00:00
|
|
|
|
(let ((len (length (cdr (cdr (car tail)))))) (* len len))))
|
1997-02-10 00:10:16 +00:00
|
|
|
|
(setq tail (cdr tail))))
|
1998-04-20 20:45:25 +00:00
|
|
|
|
(if (< (* sum-of-squares mouse-buffer-menu-mode-mult)
|
|
|
|
|
|
(* (length buffers) (length buffers)))
|
1997-02-10 00:10:16 +00:00
|
|
|
|
;; Subdividing by major modes really helps, so let's do it.
|
|
|
|
|
|
(let (subdivided-menus (buffers-left (length buffers)))
|
|
|
|
|
|
;; Sort the list to put the most popular major modes first.
|
|
|
|
|
|
(setq split-by-major-mode
|
|
|
|
|
|
(sort split-by-major-mode
|
|
|
|
|
|
(function (lambda (elt1 elt2)
|
|
|
|
|
|
(> (length elt1) (length elt2))))))
|
|
|
|
|
|
;; Make a separate submenu for each major mode
|
|
|
|
|
|
;; that has more than one buffer,
|
|
|
|
|
|
;; unless all the remaining buffers are less than 1/10 of them.
|
|
|
|
|
|
(while (and split-by-major-mode
|
|
|
|
|
|
(and (> (length (car split-by-major-mode)) 3)
|
|
|
|
|
|
(> (* buffers-left 10) (length buffers))))
|
2001-08-28 06:35:00 +00:00
|
|
|
|
(let ((this-mode-list (mouse-buffer-menu-alist
|
|
|
|
|
|
(cdr (cdr (car split-by-major-mode))))))
|
|
|
|
|
|
(and this-mode-list
|
|
|
|
|
|
(setq subdivided-menus
|
|
|
|
|
|
(cons (cons
|
|
|
|
|
|
(nth 1 (car split-by-major-mode))
|
|
|
|
|
|
this-mode-list)
|
|
|
|
|
|
subdivided-menus))))
|
1997-02-10 00:10:16 +00:00
|
|
|
|
(setq buffers-left
|
|
|
|
|
|
(- buffers-left (length (cdr (car split-by-major-mode)))))
|
|
|
|
|
|
(setq split-by-major-mode (cdr split-by-major-mode)))
|
|
|
|
|
|
;; If any major modes are left over,
|
|
|
|
|
|
;; make a single submenu for them.
|
|
|
|
|
|
(if split-by-major-mode
|
2001-08-28 06:35:00 +00:00
|
|
|
|
(let ((others-list
|
|
|
|
|
|
(mouse-buffer-menu-alist
|
|
|
|
|
|
;; we don't need split-by-major-mode any more,
|
|
|
|
|
|
;; so we can ditch it with nconc.
|
|
|
|
|
|
(apply 'nconc (mapcar 'cddr split-by-major-mode)))))
|
|
|
|
|
|
(and others-list
|
|
|
|
|
|
(setq subdivided-menus
|
|
|
|
|
|
(cons (cons "Others" others-list)
|
|
|
|
|
|
subdivided-menus)))))
|
1998-04-20 20:45:25 +00:00
|
|
|
|
(setq menu (cons "Buffer Menu" (nreverse subdivided-menus))))
|
1997-02-10 00:10:16 +00:00
|
|
|
|
(progn
|
|
|
|
|
|
(setq alist (mouse-buffer-menu-alist buffers))
|
|
|
|
|
|
(setq menu (cons "Buffer Menu"
|
|
|
|
|
|
(mouse-buffer-menu-split "Select Buffer" alist)))))
|
1992-12-29 21:06:51 +00:00
|
|
|
|
(let ((buf (x-popup-menu event menu))
|
|
|
|
|
|
(window (posn-window (event-start event))))
|
1998-04-20 20:45:25 +00:00
|
|
|
|
(when buf
|
2001-11-14 02:48:17 +00:00
|
|
|
|
(select-window
|
|
|
|
|
|
(if (framep window) (frame-selected-window window)
|
|
|
|
|
|
window))
|
1998-04-20 20:45:25 +00:00
|
|
|
|
(switch-to-buffer buf)))))
|
1997-02-10 00:10:16 +00:00
|
|
|
|
|
|
|
|
|
|
(defun mouse-buffer-menu-alist (buffers)
|
|
|
|
|
|
(let (tail
|
|
|
|
|
|
(maxlen 0)
|
|
|
|
|
|
head)
|
|
|
|
|
|
(setq buffers
|
|
|
|
|
|
(sort buffers
|
|
|
|
|
|
(function (lambda (elt1 elt2)
|
|
|
|
|
|
(string< (buffer-name elt1) (buffer-name elt2))))))
|
|
|
|
|
|
(setq tail buffers)
|
|
|
|
|
|
(while tail
|
2005-06-29 13:50:02 +00:00
|
|
|
|
(or (eq ?\s (aref (buffer-name (car tail)) 0))
|
1997-02-10 00:10:16 +00:00
|
|
|
|
(setq maxlen
|
|
|
|
|
|
(max maxlen
|
|
|
|
|
|
(length (buffer-name (car tail))))))
|
|
|
|
|
|
(setq tail (cdr tail)))
|
|
|
|
|
|
(setq tail buffers)
|
|
|
|
|
|
(while tail
|
|
|
|
|
|
(let ((elt (car tail)))
|
2006-11-27 14:00:53 +00:00
|
|
|
|
(if (/= (aref (buffer-name elt) 0) ?\s)
|
1997-02-10 00:10:16 +00:00
|
|
|
|
(setq head
|
|
|
|
|
|
(cons
|
|
|
|
|
|
(cons
|
|
|
|
|
|
(format
|
2007-12-06 17:58:08 +00:00
|
|
|
|
(format "%%-%ds %%s%%s %%s" maxlen)
|
1997-02-10 00:10:16 +00:00
|
|
|
|
(buffer-name elt)
|
|
|
|
|
|
(if (buffer-modified-p elt) "*" " ")
|
* x-dnd.el (x-dnd-maybe-call-test-function):
* window.el (split-window-vertically):
* whitespace.el (whitespace-help-on):
* vc-rcs.el (vc-rcs-consult-headers):
* userlock.el (ask-user-about-lock-help)
(ask-user-about-supersession-help):
* type-break.el (type-break-force-mode-line-update):
* time-stamp.el (time-stamp-conv-warn):
* terminal.el (te-set-output-log, te-more-break, te-filter)
(te-sentinel,terminal-emulator):
* term.el (make-term, term-exec, term-sentinel, term-read-input-ring)
(term-write-input-ring, term-check-source, term-start-output-log):
(term-display-buffer-line, term-dynamic-list-completions):
(term-ansi-make-term, serial-term):
* subr.el (selective-display):
* strokes.el (strokes-xpm-to-compressed-string, strokes-decode-buffer)
(strokes-encode-buffer, strokes-xpm-for-compressed-string):
* speedbar.el (speedbar-buffers-tail-notes, speedbar-buffers-item-info)
(speedbar-reconfigure-keymaps, speedbar-add-localized-speedbar-support)
(speedbar-remove-localized-speedbar-support)
(speedbar-set-mode-line-format, speedbar-create-tag-hierarchy)
(speedbar-update-special-contents, speedbar-buffer-buttons-engine)
(speedbar-buffers-line-directory):
* simple.el (shell-command-on-region, append-to-buffer)
(prepend-to-buffer):
* shadowfile.el (shadow-save-todo-file):
* scroll-bar.el (scroll-bar-set-window-start, scroll-bar-drag-1)
(scroll-bar-maybe-set-window-start):
* sb-image.el (speedbar-image-dump):
* saveplace.el (save-place-alist-to-file, save-places-to-alist)
(load-save-place-alist-from-file):
* ps-samp.el (ps-print-message-from-summary):
* ps-print.el (ps-flush-output, ps-insert-file, ps-get-boundingbox)
(ps-background-image, ps-begin-job, ps-do-despool):
* ps-bdf.el (bdf-find-file, bdf-read-font-info):
* printing.el (pr-interface, pr-ps-file-print, pr-find-buffer-visiting)
(pr-ps-message-from-summary, pr-lpr-message-from-summary):
(pr-call-process, pr-file-list, pr-interface-save):
* novice.el (disabled-command-function)
(enable-command, disable-command):
* mouse.el (mouse-buffer-menu-alist):
* mouse-copy.el (mouse-kill-preserving-secondary):
* macros.el (kbd-macro-query):
* ledit.el (ledit-go-to-lisp, ledit-go-to-liszt):
* informat.el (batch-info-validate):
* ido.el (ido-copy-current-word, ido-initiate-auto-merge):
* hippie-exp.el (try-expand-dabbrev-visible):
* help-mode.el (help-make-xrefs):
* help-fns.el (describe-variable):
* generic-x.el (bat-generic-mode-run-as-comint):
* finder.el (finder-mouse-select):
* find-dired.el (find-dired-sentinel):
* filesets.el (filesets-file-close):
* files.el (list-directory):
* faces.el (list-faces-display, describe-face):
* facemenu.el (list-colors-display):
* ezimage.el (ezimage-image-association-dump, ezimage-image-dump):
* epg.el (epg--process-filter, epg-cancel):
* epa.el (epa--marked-keys, epa--select-keys, epa-display-info)
(epa--read-signature-type):
* emerge.el (emerge-copy-as-kill-A, emerge-copy-as-kill-B)
(emerge-file-names):
* ehelp.el (electric-helpify):
* ediff.el (ediff-regions-wordwise, ediff-regions-linewise):
* ediff-vers.el (rcs-ediff-view-revision):
* ediff-util.el (ediff-setup):
* ediff-mult.el (ediff-append-custom-diff):
* ediff-diff.el (ediff-exec-process, ediff-process-sentinel)
(ediff-wordify):
* echistory.el (Electric-command-history-redo-expression):
* dos-w32.el (find-file-not-found-set-buffer-file-coding-system):
* disp-table.el (describe-display-table):
* dired.el (dired-find-buffer-nocreate):
* dired-aux.el (dired-rename-subdir, dired-dwim-target-directory):
* dabbrev.el (dabbrev--same-major-mode-p):
* chistory.el (list-command-history):
* apropos.el (apropos-documentation):
* allout.el (allout-obtain-passphrase):
(allout-copy-exposed-to-buffer):
(allout-verify-passphrase): Use with-current-buffer.
2009-11-13 22:19:45 +00:00
|
|
|
|
(with-current-buffer elt
|
1997-02-10 00:10:16 +00:00
|
|
|
|
(if buffer-read-only "%" " "))
|
2001-10-24 20:02:16 +00:00
|
|
|
|
(or (buffer-file-name elt)
|
* x-dnd.el (x-dnd-maybe-call-test-function):
* window.el (split-window-vertically):
* whitespace.el (whitespace-help-on):
* vc-rcs.el (vc-rcs-consult-headers):
* userlock.el (ask-user-about-lock-help)
(ask-user-about-supersession-help):
* type-break.el (type-break-force-mode-line-update):
* time-stamp.el (time-stamp-conv-warn):
* terminal.el (te-set-output-log, te-more-break, te-filter)
(te-sentinel,terminal-emulator):
* term.el (make-term, term-exec, term-sentinel, term-read-input-ring)
(term-write-input-ring, term-check-source, term-start-output-log):
(term-display-buffer-line, term-dynamic-list-completions):
(term-ansi-make-term, serial-term):
* subr.el (selective-display):
* strokes.el (strokes-xpm-to-compressed-string, strokes-decode-buffer)
(strokes-encode-buffer, strokes-xpm-for-compressed-string):
* speedbar.el (speedbar-buffers-tail-notes, speedbar-buffers-item-info)
(speedbar-reconfigure-keymaps, speedbar-add-localized-speedbar-support)
(speedbar-remove-localized-speedbar-support)
(speedbar-set-mode-line-format, speedbar-create-tag-hierarchy)
(speedbar-update-special-contents, speedbar-buffer-buttons-engine)
(speedbar-buffers-line-directory):
* simple.el (shell-command-on-region, append-to-buffer)
(prepend-to-buffer):
* shadowfile.el (shadow-save-todo-file):
* scroll-bar.el (scroll-bar-set-window-start, scroll-bar-drag-1)
(scroll-bar-maybe-set-window-start):
* sb-image.el (speedbar-image-dump):
* saveplace.el (save-place-alist-to-file, save-places-to-alist)
(load-save-place-alist-from-file):
* ps-samp.el (ps-print-message-from-summary):
* ps-print.el (ps-flush-output, ps-insert-file, ps-get-boundingbox)
(ps-background-image, ps-begin-job, ps-do-despool):
* ps-bdf.el (bdf-find-file, bdf-read-font-info):
* printing.el (pr-interface, pr-ps-file-print, pr-find-buffer-visiting)
(pr-ps-message-from-summary, pr-lpr-message-from-summary):
(pr-call-process, pr-file-list, pr-interface-save):
* novice.el (disabled-command-function)
(enable-command, disable-command):
* mouse.el (mouse-buffer-menu-alist):
* mouse-copy.el (mouse-kill-preserving-secondary):
* macros.el (kbd-macro-query):
* ledit.el (ledit-go-to-lisp, ledit-go-to-liszt):
* informat.el (batch-info-validate):
* ido.el (ido-copy-current-word, ido-initiate-auto-merge):
* hippie-exp.el (try-expand-dabbrev-visible):
* help-mode.el (help-make-xrefs):
* help-fns.el (describe-variable):
* generic-x.el (bat-generic-mode-run-as-comint):
* finder.el (finder-mouse-select):
* find-dired.el (find-dired-sentinel):
* filesets.el (filesets-file-close):
* files.el (list-directory):
* faces.el (list-faces-display, describe-face):
* facemenu.el (list-colors-display):
* ezimage.el (ezimage-image-association-dump, ezimage-image-dump):
* epg.el (epg--process-filter, epg-cancel):
* epa.el (epa--marked-keys, epa--select-keys, epa-display-info)
(epa--read-signature-type):
* emerge.el (emerge-copy-as-kill-A, emerge-copy-as-kill-B)
(emerge-file-names):
* ehelp.el (electric-helpify):
* ediff.el (ediff-regions-wordwise, ediff-regions-linewise):
* ediff-vers.el (rcs-ediff-view-revision):
* ediff-util.el (ediff-setup):
* ediff-mult.el (ediff-append-custom-diff):
* ediff-diff.el (ediff-exec-process, ediff-process-sentinel)
(ediff-wordify):
* echistory.el (Electric-command-history-redo-expression):
* dos-w32.el (find-file-not-found-set-buffer-file-coding-system):
* disp-table.el (describe-display-table):
* dired.el (dired-find-buffer-nocreate):
* dired-aux.el (dired-rename-subdir, dired-dwim-target-directory):
* dabbrev.el (dabbrev--same-major-mode-p):
* chistory.el (list-command-history):
* apropos.el (apropos-documentation):
* allout.el (allout-obtain-passphrase):
(allout-copy-exposed-to-buffer):
(allout-verify-passphrase): Use with-current-buffer.
2009-11-13 22:19:45 +00:00
|
|
|
|
(with-current-buffer elt
|
1997-02-10 00:10:16 +00:00
|
|
|
|
(if list-buffers-directory
|
|
|
|
|
|
(expand-file-name
|
|
|
|
|
|
list-buffers-directory)))
|
|
|
|
|
|
""))
|
|
|
|
|
|
elt)
|
|
|
|
|
|
head))))
|
|
|
|
|
|
(setq tail (cdr tail)))
|
|
|
|
|
|
;; Compensate for the reversal that the above loop does.
|
|
|
|
|
|
(nreverse head)))
|
|
|
|
|
|
|
|
|
|
|
|
(defun mouse-buffer-menu-split (title alist)
|
|
|
|
|
|
;; If we have lots of buffers, divide them into groups of 20
|
|
|
|
|
|
;; and make a pane (or submenu) for each one.
|
1998-03-12 23:11:57 +00:00
|
|
|
|
(if (> (length alist) (/ (* mouse-buffer-menu-maxlen 3) 2))
|
1997-02-10 00:10:16 +00:00
|
|
|
|
(let ((alist alist) sublists next
|
|
|
|
|
|
(i 1))
|
|
|
|
|
|
(while alist
|
1998-03-12 23:11:57 +00:00
|
|
|
|
;; Pull off the next mouse-buffer-menu-maxlen buffers
|
1997-02-10 00:10:16 +00:00
|
|
|
|
;; and make them the next element of sublist.
|
1998-03-12 23:11:57 +00:00
|
|
|
|
(setq next (nthcdr mouse-buffer-menu-maxlen alist))
|
1997-02-10 00:10:16 +00:00
|
|
|
|
(if next
|
1998-03-12 23:11:57 +00:00
|
|
|
|
(setcdr (nthcdr (1- mouse-buffer-menu-maxlen) alist)
|
1997-02-10 00:10:16 +00:00
|
|
|
|
nil))
|
|
|
|
|
|
(setq sublists (cons (cons (format "Buffers %d" i) alist)
|
|
|
|
|
|
sublists))
|
|
|
|
|
|
(setq i (1+ i))
|
|
|
|
|
|
(setq alist next))
|
|
|
|
|
|
(nreverse sublists))
|
|
|
|
|
|
;; Few buffers--put them all in one pane.
|
|
|
|
|
|
(list (cons title alist))))
|
1990-06-19 20:28:34 +00:00
|
|
|
|
|
2009-10-15 01:50:17 +00:00
|
|
|
|
(define-obsolete-function-alias
|
|
|
|
|
|
'mouse-choose-completion 'choose-completion "23.2")
|
1993-07-13 21:33:17 +00:00
|
|
|
|
|
1992-09-12 01:37:46 +00:00
|
|
|
|
;; Font selection.
|
|
|
|
|
|
|
1993-07-26 20:04:19 +00:00
|
|
|
|
(defun font-menu-add-default ()
|
|
|
|
|
|
(let* ((default (cdr (assq 'font (frame-parameters (selected-frame)))))
|
|
|
|
|
|
(font-alist x-fixed-font-alist)
|
1993-08-11 19:22:35 +00:00
|
|
|
|
(elt (or (assoc "Misc" font-alist) (nth 1 font-alist))))
|
1993-07-26 20:04:19 +00:00
|
|
|
|
(if (assoc "Default" elt)
|
|
|
|
|
|
(delete (assoc "Default" elt) elt))
|
|
|
|
|
|
(setcdr elt
|
1999-09-05 19:44:45 +00:00
|
|
|
|
(cons (list "Default" default)
|
1993-07-26 20:04:19 +00:00
|
|
|
|
(cdr elt)))))
|
|
|
|
|
|
|
1992-09-12 01:37:46 +00:00
|
|
|
|
(defvar x-fixed-font-alist
|
2009-10-26 06:43:36 +00:00
|
|
|
|
(list
|
|
|
|
|
|
(purecopy "Font Menu")
|
|
|
|
|
|
(cons
|
|
|
|
|
|
(purecopy "Misc")
|
|
|
|
|
|
(mapcar
|
|
|
|
|
|
(lambda (arg) (cons (purecopy (car arg)) (purecopy (cdr arg))))
|
1994-08-05 19:31:42 +00:00
|
|
|
|
;; For these, we specify the pixel height and width.
|
2009-10-26 06:43:36 +00:00
|
|
|
|
'(("fixed" "fixed")
|
1994-08-05 19:31:42 +00:00
|
|
|
|
("6x10" "-misc-fixed-medium-r-normal--10-*-*-*-c-60-iso8859-1" "6x10")
|
|
|
|
|
|
("6x12"
|
|
|
|
|
|
"-misc-fixed-medium-r-semicondensed--12-*-*-*-c-60-iso8859-1" "6x12")
|
|
|
|
|
|
("6x13"
|
|
|
|
|
|
"-misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1" "6x13")
|
|
|
|
|
|
("7x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-70-iso8859-1" "7x13")
|
|
|
|
|
|
("7x14" "-misc-fixed-medium-r-normal--14-*-*-*-c-70-iso8859-1" "7x14")
|
|
|
|
|
|
("8x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-80-iso8859-1" "8x13")
|
|
|
|
|
|
("9x15" "-misc-fixed-medium-r-normal--15-*-*-*-c-90-iso8859-1" "9x15")
|
|
|
|
|
|
("10x20" "-misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1" "10x20")
|
|
|
|
|
|
("11x18" "-misc-fixed-medium-r-normal--18-*-*-*-c-110-iso8859-1" "11x18")
|
|
|
|
|
|
("12x24" "-misc-fixed-medium-r-normal--24-*-*-*-c-120-iso8859-1" "12x24")
|
1993-07-25 20:46:18 +00:00
|
|
|
|
("")
|
1994-08-08 10:16:47 +00:00
|
|
|
|
("clean 5x8"
|
|
|
|
|
|
"-schumacher-clean-medium-r-normal--8-*-*-*-c-50-iso8859-1")
|
|
|
|
|
|
("clean 6x8"
|
|
|
|
|
|
"-schumacher-clean-medium-r-normal--8-*-*-*-c-60-iso8859-1")
|
1994-08-05 19:31:42 +00:00
|
|
|
|
("clean 8x8"
|
|
|
|
|
|
"-schumacher-clean-medium-r-normal--8-*-*-*-c-80-iso8859-1")
|
|
|
|
|
|
("clean 8x10"
|
|
|
|
|
|
"-schumacher-clean-medium-r-normal--10-*-*-*-c-80-iso8859-1")
|
|
|
|
|
|
("clean 8x14"
|
|
|
|
|
|
"-schumacher-clean-medium-r-normal--14-*-*-*-c-80-iso8859-1")
|
|
|
|
|
|
("clean 8x16"
|
|
|
|
|
|
"-schumacher-clean-medium-r-normal--16-*-*-*-c-80-iso8859-1")
|
1993-07-25 20:46:18 +00:00
|
|
|
|
("")
|
1999-07-28 18:27:35 +00:00
|
|
|
|
("sony 8x16" "-sony-fixed-medium-r-normal--16-*-*-*-c-80-iso8859-1")
|
2008-04-01 08:35:58 +00:00
|
|
|
|
;; We don't seem to have these; who knows what they are.
|
|
|
|
|
|
;; ("fg-18" "fg-18")
|
|
|
|
|
|
;; ("fg-25" "fg-25")
|
1999-07-28 18:27:35 +00:00
|
|
|
|
("lucidasanstypewriter-12" "-b&h-lucidatypewriter-medium-r-normal-sans-*-120-*-*-*-*-iso8859-1")
|
|
|
|
|
|
("lucidasanstypewriter-bold-14" "-b&h-lucidatypewriter-bold-r-normal-sans-*-140-*-*-*-*-iso8859-1")
|
|
|
|
|
|
("lucidasanstypewriter-bold-24"
|
|
|
|
|
|
"-b&h-lucidatypewriter-bold-r-normal-sans-*-240-*-*-*-*-iso8859-1")
|
2008-04-01 08:35:58 +00:00
|
|
|
|
;; ("lucidatypewriter-bold-r-24" "-b&h-lucidatypewriter-bold-r-normal-sans-24-240-75-75-m-140-iso8859-1")
|
|
|
|
|
|
;; ("fixed-medium-20" "-misc-fixed-medium-*-*-*-20-*-*-*-*-*-*-*")
|
2009-10-26 06:43:36 +00:00
|
|
|
|
)))
|
|
|
|
|
|
|
|
|
|
|
|
(cons
|
|
|
|
|
|
(purecopy "Courier")
|
|
|
|
|
|
(mapcar
|
|
|
|
|
|
(lambda (arg) (cons (purecopy (car arg)) (purecopy (cdr arg))))
|
1994-08-05 19:31:42 +00:00
|
|
|
|
;; For these, we specify the point height.
|
2009-10-26 06:43:36 +00:00
|
|
|
|
'(("8" "-adobe-courier-medium-r-normal--*-80-*-*-m-*-iso8859-1")
|
1993-05-29 04:34:00 +00:00
|
|
|
|
("10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("24" "-adobe-courier-medium-r-normal--*-240-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("8 bold" "-adobe-courier-bold-r-normal--*-80-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("10 bold" "-adobe-courier-bold-r-normal--*-100-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("12 bold" "-adobe-courier-bold-r-normal--*-120-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("14 bold" "-adobe-courier-bold-r-normal--*-140-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("18 bold" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("24 bold" "-adobe-courier-bold-r-normal--*-240-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("8 slant" "-adobe-courier-medium-o-normal--*-80-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("10 slant" "-adobe-courier-medium-o-normal--*-100-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("12 slant" "-adobe-courier-medium-o-normal--*-120-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("14 slant" "-adobe-courier-medium-o-normal--*-140-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("18 slant" "-adobe-courier-medium-o-normal--*-180-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("24 slant" "-adobe-courier-medium-o-normal--*-240-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("8 bold slant" "-adobe-courier-bold-o-normal--*-80-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("10 bold slant" "-adobe-courier-bold-o-normal--*-100-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("12 bold slant" "-adobe-courier-bold-o-normal--*-120-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("14 bold slant" "-adobe-courier-bold-o-normal--*-140-*-*-m-*-iso8859-1")
|
|
|
|
|
|
("18 bold slant" "-adobe-courier-bold-o-normal--*-180-*-*-m-*-iso8859-1")
|
2009-10-26 06:43:36 +00:00
|
|
|
|
("24 bold slant" "-adobe-courier-bold-o-normal--*-240-*-*-m-*-iso8859-1")
|
|
|
|
|
|
))))
|
1992-09-12 01:37:46 +00:00
|
|
|
|
"X fonts suitable for use in Emacs.")
|
|
|
|
|
|
|
2008-06-12 03:56:20 +00:00
|
|
|
|
(declare-function generate-fontset-menu "fontset" ())
|
|
|
|
|
|
|
2008-06-10 19:57:09 +00:00
|
|
|
|
(defun mouse-select-font ()
|
|
|
|
|
|
"Prompt for a font name, using `x-popup-menu', and return it."
|
|
|
|
|
|
(interactive)
|
|
|
|
|
|
(unless (display-multi-font-p)
|
|
|
|
|
|
(error "Cannot change fonts on this display"))
|
2009-01-27 20:43:27 +00:00
|
|
|
|
(car
|
|
|
|
|
|
(x-popup-menu
|
|
|
|
|
|
(if (listp last-nonmenu-event)
|
|
|
|
|
|
last-nonmenu-event
|
|
|
|
|
|
(list '(0 0) (selected-window)))
|
|
|
|
|
|
(append x-fixed-font-alist
|
|
|
|
|
|
(list (generate-fontset-menu))))))
|
2008-06-10 19:57:09 +00:00
|
|
|
|
|
2008-06-15 20:04:33 +00:00
|
|
|
|
(declare-function text-scale-mode "face-remap")
|
|
|
|
|
|
|
1994-04-14 02:55:13 +00:00
|
|
|
|
(defun mouse-set-font (&rest fonts)
|
2008-06-10 19:57:09 +00:00
|
|
|
|
"Set the default font for the selected frame.
|
|
|
|
|
|
The argument FONTS is a list of font names; the first valid font
|
|
|
|
|
|
in this list is used.
|
|
|
|
|
|
|
|
|
|
|
|
When called interactively, pop up a menu and allow the user to
|
|
|
|
|
|
choose a font."
|
1992-09-12 01:37:46 +00:00
|
|
|
|
(interactive
|
2002-05-29 16:36:55 +00:00
|
|
|
|
(progn (unless (display-multi-font-p)
|
|
|
|
|
|
(error "Cannot change fonts on this display"))
|
|
|
|
|
|
(x-popup-menu
|
2004-12-08 01:14:10 +00:00
|
|
|
|
(if (listp last-nonmenu-event)
|
|
|
|
|
|
last-nonmenu-event
|
|
|
|
|
|
(list '(0 0) (selected-window)))
|
2002-05-29 16:36:55 +00:00
|
|
|
|
;; Append list of fontsets currently defined.
|
|
|
|
|
|
(append x-fixed-font-alist (list (generate-fontset-menu))))))
|
1994-04-16 04:07:43 +00:00
|
|
|
|
(if fonts
|
|
|
|
|
|
(let (font)
|
|
|
|
|
|
(while fonts
|
|
|
|
|
|
(condition-case nil
|
|
|
|
|
|
(progn
|
2008-10-03 07:47:06 +00:00
|
|
|
|
(set-frame-font (car fonts))
|
1994-04-16 04:07:43 +00:00
|
|
|
|
(setq font (car fonts))
|
|
|
|
|
|
(setq fonts nil))
|
1994-04-22 08:49:57 +00:00
|
|
|
|
(error
|
|
|
|
|
|
(setq fonts (cdr fonts)))))
|
1994-04-16 04:07:43 +00:00
|
|
|
|
(if (null font)
|
2002-05-29 16:36:55 +00:00
|
|
|
|
(error "Font not found")))))
|
2008-06-15 20:04:33 +00:00
|
|
|
|
|
|
|
|
|
|
(defvar mouse-appearance-menu-map nil)
|
2008-06-17 05:57:29 +00:00
|
|
|
|
(declare-function x-select-font "xfns.c" (&optional frame ignored)) ; USE_GTK
|
2008-06-18 02:53:20 +00:00
|
|
|
|
(declare-function buffer-face-mode-invoke "face-remap"
|
|
|
|
|
|
(face arg &optional interactive))
|
2008-08-11 01:23:07 +00:00
|
|
|
|
(declare-function font-face-attributes "font.c" (font &optional frame))
|
2008-06-15 20:04:33 +00:00
|
|
|
|
|
|
|
|
|
|
(defun mouse-appearance-menu (event)
|
2010-07-06 19:42:46 +00:00
|
|
|
|
"Show a menu for changing the default face in the current buffer."
|
2008-06-15 20:04:33 +00:00
|
|
|
|
(interactive "@e")
|
|
|
|
|
|
(require 'face-remap)
|
|
|
|
|
|
(when (display-multi-font-p)
|
|
|
|
|
|
(with-selected-window (car (event-start event))
|
|
|
|
|
|
(if mouse-appearance-menu-map
|
|
|
|
|
|
nil ; regenerate new fonts
|
|
|
|
|
|
;; Initialize mouse-appearance-menu-map
|
|
|
|
|
|
(setq mouse-appearance-menu-map
|
|
|
|
|
|
(make-sparse-keymap "Change Default Buffer Face"))
|
|
|
|
|
|
(define-key mouse-appearance-menu-map [face-remap-reset-base]
|
|
|
|
|
|
'(menu-item "Reset to Default" face-remap-reset-base))
|
|
|
|
|
|
(define-key mouse-appearance-menu-map [text-scale-decrease]
|
|
|
|
|
|
'(menu-item "Decrease Buffer Text Size" text-scale-decrease))
|
|
|
|
|
|
(define-key mouse-appearance-menu-map [text-scale-increase]
|
|
|
|
|
|
'(menu-item "Increase Buffer Text Size" text-scale-increase))
|
|
|
|
|
|
;; Font selector
|
|
|
|
|
|
(if (functionp 'x-select-font)
|
|
|
|
|
|
(define-key mouse-appearance-menu-map [x-select-font]
|
|
|
|
|
|
'(menu-item "Change Buffer Font..." x-select-font))
|
|
|
|
|
|
;; If the select-font is unavailable, construct a menu.
|
|
|
|
|
|
(let ((font-submenu (make-sparse-keymap "Change Text Font"))
|
|
|
|
|
|
(font-alist (cdr (append x-fixed-font-alist
|
|
|
|
|
|
(list (generate-fontset-menu))))))
|
|
|
|
|
|
(dolist (family font-alist)
|
|
|
|
|
|
(let* ((submenu-name (car family))
|
|
|
|
|
|
(submenu-map (make-sparse-keymap submenu-name)))
|
|
|
|
|
|
(dolist (font (cdr family))
|
|
|
|
|
|
(let ((font-name (car font))
|
|
|
|
|
|
font-symbol)
|
|
|
|
|
|
(if (string= font-name "")
|
|
|
|
|
|
(define-key submenu-map [space]
|
|
|
|
|
|
'("--"))
|
|
|
|
|
|
(setq font-symbol (intern (cadr font)))
|
|
|
|
|
|
(define-key submenu-map (vector font-symbol)
|
|
|
|
|
|
(list 'menu-item (car font) font-symbol)))))
|
|
|
|
|
|
(define-key font-submenu (vector (intern submenu-name))
|
|
|
|
|
|
(list 'menu-item submenu-name submenu-map))))
|
|
|
|
|
|
(define-key mouse-appearance-menu-map [font-submenu]
|
|
|
|
|
|
(list 'menu-item "Change Text Font" font-submenu)))))
|
|
|
|
|
|
(let ((choice (x-popup-menu event mouse-appearance-menu-map)))
|
|
|
|
|
|
(setq choice (nth (1- (length choice)) choice))
|
|
|
|
|
|
(cond ((eq choice 'text-scale-increase)
|
|
|
|
|
|
(text-scale-increase 1))
|
|
|
|
|
|
((eq choice 'text-scale-decrease)
|
|
|
|
|
|
(text-scale-increase -1))
|
|
|
|
|
|
((eq choice 'face-remap-reset-base)
|
|
|
|
|
|
(text-scale-mode 0)
|
2008-06-17 11:28:06 +00:00
|
|
|
|
(buffer-face-mode 0))
|
2008-06-24 04:52:51 +00:00
|
|
|
|
(choice
|
2008-06-15 20:04:33 +00:00
|
|
|
|
;; Either choice == 'x-select-font, or choice is a
|
|
|
|
|
|
;; symbol whose name is a font.
|
2012-08-17 09:10:31 +00:00
|
|
|
|
(let ((font (if (eq choice 'x-select-font)
|
|
|
|
|
|
(x-select-font)
|
|
|
|
|
|
(symbol-name choice))))
|
|
|
|
|
|
(buffer-face-mode-invoke
|
|
|
|
|
|
(if (fontp font 'font-spec)
|
|
|
|
|
|
(list :font font)
|
|
|
|
|
|
(font-face-attributes font))
|
|
|
|
|
|
t (called-interactively-p 'interactive)))))))))
|
2008-06-15 20:04:33 +00:00
|
|
|
|
|
1991-12-20 07:15:37 +00:00
|
|
|
|
|
|
|
|
|
|
;;; Bindings for mouse commands.
|
|
|
|
|
|
|
1993-05-15 19:52:01 +00:00
|
|
|
|
(define-key global-map [down-mouse-1] 'mouse-drag-region)
|
1993-01-26 01:58:16 +00:00
|
|
|
|
(global-set-key [mouse-1] 'mouse-set-point)
|
|
|
|
|
|
(global-set-key [drag-mouse-1] 'mouse-set-region)
|
1993-05-15 19:52:01 +00:00
|
|
|
|
|
1993-09-17 21:26:18 +00:00
|
|
|
|
;; These are tested for in mouse-drag-region.
|
|
|
|
|
|
(global-set-key [double-mouse-1] 'mouse-set-point)
|
|
|
|
|
|
(global-set-key [triple-mouse-1] 'mouse-set-point)
|
|
|
|
|
|
|
2011-07-01 17:58:14 +00:00
|
|
|
|
(defun mouse--strip-first-event (_prompt)
|
|
|
|
|
|
(substring (this-single-command-raw-keys) 1))
|
|
|
|
|
|
|
|
|
|
|
|
(define-key function-key-map [left-fringe mouse-1] 'mouse--strip-first-event)
|
|
|
|
|
|
(define-key function-key-map [right-fringe mouse-1] 'mouse--strip-first-event)
|
2003-11-23 00:27:27 +00:00
|
|
|
|
|
2010-07-14 18:03:39 +00:00
|
|
|
|
(global-set-key [mouse-2] 'mouse-yank-primary)
|
2006-08-17 03:36:17 +00:00
|
|
|
|
;; Allow yanking also when the corresponding cursor is "in the fringe".
|
2011-07-01 17:58:14 +00:00
|
|
|
|
(define-key function-key-map [right-fringe mouse-2] 'mouse--strip-first-event)
|
|
|
|
|
|
(define-key function-key-map [left-fringe mouse-2] 'mouse--strip-first-event)
|
1993-01-26 01:58:16 +00:00
|
|
|
|
(global-set-key [mouse-3] 'mouse-save-then-kill)
|
2011-07-01 17:58:14 +00:00
|
|
|
|
(define-key function-key-map [right-fringe mouse-3] 'mouse--strip-first-event)
|
|
|
|
|
|
(define-key function-key-map [left-fringe mouse-3] 'mouse--strip-first-event)
|
1992-08-31 05:06:54 +00:00
|
|
|
|
|
1993-01-26 01:58:16 +00:00
|
|
|
|
;; By binding these to down-going events, we let the user use the up-going
|
|
|
|
|
|
;; event to make the selection, saving a click.
|
1995-09-18 14:15:22 +00:00
|
|
|
|
(global-set-key [C-down-mouse-1] 'mouse-buffer-menu)
|
|
|
|
|
|
(if (not (eq system-type 'ms-dos))
|
2008-06-15 20:04:33 +00:00
|
|
|
|
(global-set-key [S-down-mouse-1] 'mouse-appearance-menu))
|
1994-10-30 10:41:03 +00:00
|
|
|
|
;; C-down-mouse-2 is bound in facemenu.el.
|
2008-04-09 03:53:48 +00:00
|
|
|
|
(global-set-key [C-down-mouse-3]
|
* textmodes/tex-mode.el (tex-alt-dvi-print-command)
(tex-dvi-print-command, tex-bibtex-command, tex-start-commands)
(tex-start-options, slitex-run-command, latex-run-command)
(tex-run-command, tex-directory):
* textmodes/ispell.el (ispell-html-skip-alists)
(ispell-tex-skip-alists, ispell-tex-skip-alists):
* textmodes/fill.el (adaptive-fill-first-line-regexp):
(adaptive-fill-regexp):
* textmodes/dns-mode.el (auto-mode-alist):
* progmodes/python.el (interpreter-mode-alist):
* progmodes/etags.el (tags-compression-info-list):
* progmodes/etags.el (tags-file-name):
* net/browse-url.el (browse-url-galeon-program)
(browse-url-firefox-program):
* mail/sendmail.el (mail-signature-file)
(mail-citation-prefix-regexp):
* international/mule-conf.el (eight-bit):
* international/latexenc.el (latex-inputenc-coding-alist):
* international/fontset.el (x-pixel-size-width-font-regexp):
* emacs-lisp/warnings.el (warning-type-format):
* emacs-lisp/trace.el (trace-buffer):
* emacs-lisp/lisp-mode.el (lisp-interaction-mode-map)
(emacs-lisp-mode-map):
* calendar/holidays.el (holiday-solar-holidays)
(holiday-bahai-holidays, holiday-islamic-holidays)
(holiday-christian-holidays, holiday-hebrew-holidays)
(hebrew-holidays-4, hebrew-holidays-3, hebrew-holidays-2)
(hebrew-holidays-1, holiday-oriental-holidays)
(holiday-general-holidays):
* x-dnd.el (x-dnd-known-types):
* tool-bar.el (tool-bar):
* startup.el (site-run-file):
* shell.el (shell-dumb-shell-regexp):
* rfn-eshadow.el (file-name-shadow-tty-properties)
(file-name-shadow-properties):
* paths.el (remote-shell-program, news-directory):
* mouse.el ([C-down-mouse-3]):
* menu-bar.el (menu-bar-tools-menu):
* jka-cmpr-hook.el (jka-compr-load-suffixes)
(jka-compr-mode-alist-additions, jka-compr-compression-info-list)
(jka-compr-compression-info-list):
* isearch.el (search-whitespace-regexp):
* image-file.el (image-file-name-extensions):
* find-dired.el (find-ls-option):
* files.el (directory-listing-before-filename-regexp)
(directory-free-space-args, insert-directory-program)
(list-directory-brief-switches, magic-fallback-mode-alist)
(magic-fallback-mode-alist, auto-mode-interpreter-regexp)
(automount-dir-prefix):
* faces.el (face-x-resources, x-font-regexp, x-font-regexp-head)
(x-font-regexp-slant, x-font-regexp-weight, face-x-resources)
(face-font-registry-alternatives, face-font-registry-alternatives)
(face-font-family-alternatives):
* facemenu.el (facemenu-add-new-face, facemenu-background-menu)
(facemenu-foreground-menu, facemenu-face-menu):
* epa-hook.el (epa-file-name-regexp):
* dnd.el (dnd-protocol-alist):
* textmodes/rst.el (auto-mode-alist):
* button.el (default-button): Purecopy strings.
2009-11-06 05:16:23 +00:00
|
|
|
|
`(menu-item ,(purecopy "Menu Bar") ignore
|
2008-04-09 03:53:48 +00:00
|
|
|
|
:filter (lambda (_)
|
|
|
|
|
|
(if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))
|
|
|
|
|
|
(mouse-menu-bar-map)
|
|
|
|
|
|
(mouse-menu-major-mode-map)))))
|
1994-10-12 09:27:49 +00:00
|
|
|
|
|
2000-10-09 10:23:49 +00:00
|
|
|
|
;; Binding mouse-1 to mouse-select-window when on mode-, header-, or
|
|
|
|
|
|
;; vertical-line prevents Emacs from signaling an error when the mouse
|
|
|
|
|
|
;; button is released after dragging these lines, on non-toolkit
|
|
|
|
|
|
;; versions.
|
1994-02-25 19:35:58 +00:00
|
|
|
|
(global-set-key [mode-line mouse-1] 'mouse-select-window)
|
1994-08-11 20:35:31 +00:00
|
|
|
|
(global-set-key [mode-line drag-mouse-1] 'mouse-select-window)
|
|
|
|
|
|
(global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line)
|
1999-09-09 14:54:25 +00:00
|
|
|
|
(global-set-key [header-line down-mouse-1] 'mouse-drag-header-line)
|
2000-10-09 10:23:49 +00:00
|
|
|
|
(global-set-key [header-line mouse-1] 'mouse-select-window)
|
1994-02-25 19:35:58 +00:00
|
|
|
|
(global-set-key [mode-line mouse-2] 'mouse-delete-other-windows)
|
1993-01-26 01:58:16 +00:00
|
|
|
|
(global-set-key [mode-line mouse-3] 'mouse-delete-window)
|
1994-02-25 19:35:58 +00:00
|
|
|
|
(global-set-key [mode-line C-mouse-2] 'mouse-split-window-horizontally)
|
1994-07-07 18:39:02 +00:00
|
|
|
|
(global-set-key [vertical-scroll-bar C-mouse-2] 'mouse-split-window-vertically)
|
1994-07-16 22:37:18 +00:00
|
|
|
|
(global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically)
|
1995-09-18 14:15:22 +00:00
|
|
|
|
(global-set-key [vertical-line down-mouse-1] 'mouse-drag-vertical-line)
|
|
|
|
|
|
(global-set-key [vertical-line mouse-1] 'mouse-select-window)
|
1992-03-16 20:39:07 +00:00
|
|
|
|
|
|
|
|
|
|
(provide 'mouse)
|
|
|
|
|
|
|
1992-05-30 22:12:04 +00:00
|
|
|
|
;;; mouse.el ends here
|