;;; mouse.el --- window system-independent mouse support
-;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1999, 2000 Free Software Foundation, Inc.
;; Maintainer: FSF
-;; Keywords: hardware
+;; Keywords: hardware, mouse
;; This file is part of GNU Emacs.
\f
;; Provide a mode-specific menu on a mouse button.
+(defun popup-menu (menu &optional position prefix)
+ "Popup the given menu and call the selected option.
+MENU can be a keymap, an easymenu-style menu or a list of keymaps as for
+`x-popup-menu'.
+POSITION can be a click event or ((XOFFSET YOFFSET) WINDOW) and defaults to
+ the current mouse position.
+PREFIX is the prefix argument (if any) to pass to the command."
+ (let* ((map (cond
+ ((keymapp menu) menu)
+ ((and (listp menu) (keymapp (car menu))) menu)
+ (t (let* ((map (easy-menu-create-menu (car menu) (cdr menu)))
+ (filter (when (symbolp map)
+ (plist-get (get map 'menu-pro) :filter))))
+ (if filter (funcall filter (symbol-function map)) map)))))
+ event)
+ ;; The looping behavior was taken from lmenu's popup-menu-popup
+ (while (and map (setq event
+ ;; map could be a prefix key, in which case
+ ;; we need to get its function cell
+ ;; definition.
+ (x-popup-menu position (indirect-function map))))
+ ;; 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)))
+ (let ((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))
+ (setq map (cdr map)))
+ binding)
+ ;; We were given a single keymap.
+ (lookup-key map (apply 'vector event)))))
+ (setq map nil)
+ ;; Clear out echoing, which perhaps shows a prefix arg.
+ (message "")
+ (when cmd
+ (if (keymapp cmd)
+ ;; Try again but with the submap.
+ (setq map cmd)
+ (setq prefix-arg prefix)
+ ;; mouse-major-mode-menu was using `command-execute' instead.
+ (call-interactively cmd)))))))
+
(defun mouse-major-mode-menu (event prefix)
- "Pop up a mode-specific menu of mouse commands."
+ "Pop up a mode-specific menu of mouse commands.
+Default to the Edit menu if the major mode doesn't define a menu."
;; Switch to the window clicked on, because otherwise
;; the mode's commands may not make sense.
(interactive "@e\nP")
- (let (;; This is where mouse-major-mode-menu-prefix
- ;; returns the prefix we should use (after menu-bar).
- ;; It is either nil or (SOME-SYMBOL).
- (mouse-major-mode-menu-prefix nil)
- ;; Make a keymap in which our last command leads to a menu
- (newmap (make-sparse-keymap (concat mode-name " Mode")))
- result)
- ;; Make our menu inherit from the desired keymap
- ;; which we want to display as the menu now.
- (set-keymap-parent newmap
- (mouse-major-mode-menu-1
- (and (current-local-map)
- (lookup-key (current-local-map) [menu-bar]))))
- (setq result (x-popup-menu t (list newmap)))
- (if result
- (let ((command (key-binding
- (apply 'vector (append '(menu-bar)
- mouse-major-mode-menu-prefix
- result)))))
- ;; Clear out echoing, which perhaps shows a prefix arg.
- (message "")
- (if command
- (progn
- (setq prefix-arg prefix)
- (command-execute command)))))))
+ ;; Let the mode update its menus first.
+ (run-hooks 'activate-menubar-hook)
+ (let* (;; This is where mouse-major-mode-menu-prefix
+ ;; returns the prefix we should use (after menu-bar).
+ ;; It is either nil or (SOME-SYMBOL).
+ (mouse-major-mode-menu-prefix nil)
+ ;; Keymap from which to inherit; may be null.
+ (ancestor (mouse-major-mode-menu-1
+ (and (current-local-map)
+ (lookup-key (current-local-map) [menu-bar]))))
+ ;; Make a keymap in which our last command leads to a menu or
+ ;; default to the edit menu.
+ (newmap (if ancestor
+ (make-sparse-keymap (concat mode-name " Mode"))
+ menu-bar-edit-menu))
+ result)
+ (if ancestor
+ ;; Make our menu inherit from the desired keymap which we want
+ ;; to display as the menu now.
+ (set-keymap-parent newmap ancestor))
+ (popup-menu newmap event prefix)))
+
;; Compute and cache the equivalent keys in MENU and all its submenus.
;;;(defun mouse-major-mode-menu-compute-equiv-keys (menu)
(if (eq submap t)
menubar
(setq mouse-major-mode-menu-prefix (list (car submap)))
- (cdr (cdr submap))))))
+ (lookup-key menubar (vector (car submap)))))))
+
+(defun mouse-popup-menubar (event prefix)
+ "Pops up a menu equiavlent to the menu bar a keyboard EVENT with PREFIX.
+The contents are the items that would be in the menu bar whether or
+not it is actually displayed."
+ (interactive "@e \nP")
+ (run-hooks 'activate-menubar-hook)
+ (let* ((local-menu (and (current-local-map)
+ (lookup-key (current-local-map) [menu-bar])))
+ (global-menu (lookup-key global-map [menu-bar]))
+ (local-title-or-map (and local-menu (cadr local-menu)))
+ (global-title-or-map (cadr global-menu)))
+ ;; If the keymaps don't have prompt string (a lazy programmer
+ ;; didn't bother to provide one), create it and insert it into the
+ ;; keymaps; each keymap gets its own prompt. This is required for
+ ;; non-toolkit versions to display non-empty menu pane names.
+ (or (null local-menu)
+ (stringp local-title-or-map)
+ (setq local-menu (cons 'keymap
+ (cons (concat mode-name " Mode Menu")
+ (cdr local-menu)))))
+ (or (stringp global-title-or-map)
+ (setq global-menu (cons 'keymap
+ (cons "Global Menu"
+ (cdr global-menu)))))
+ ;; Supplying the list is faster than making a new map.
+ (popup-menu (if local-menu
+ (list global-menu local-menu)
+ (list global-menu))
+ event prefix)))
+
+(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."
+ (interactive "@e \nP")
+ (if (zerop (assoc-default 'menu-bar-lines (frame-parameters) 'eq 0))
+ (mouse-popup-menubar event prefix)
+ (mouse-major-mode-menu event prefix)))
\f
;; Commands that operate on windows.
(defun mouse-delete-window (click)
"Delete the window you click on.
-This must be bound to a mouse click."
+If the frame has just one window, bury the current buffer instead.
+This command must be bound to a mouse click."
(interactive "e")
- (mouse-minibuffer-check click)
- (delete-window (posn-window (event-start click))))
+ (if (one-window-p t)
+ (bury-buffer)
+ (mouse-minibuffer-check click)
+ (delete-window (posn-window (event-start click)))))
(defun mouse-select-window (click)
"Select the window clicked on; don't move point."
(split-window-horizontally
(min (max new-width first-col) last-col))))))
-(defun mouse-drag-mode-line (start-event)
- "Change the height of a window by dragging on the mode line."
- (interactive "e")
+(defun mouse-drag-mode-line-1 (start-event mode-line-p)
+ "Change the height of a window by dragging on the mode or header line.
+START-EVENT is the starting mouse-event of the drag action.
+MODE-LINE-P non-nil means a mode line is dragged."
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(let ((done nil)
;; move its modeline the minibuffer must be enlarged.
(setq should-enlarge-minibuffer
(and minibuffer
+ mode-line-p
(not (one-window-p t))
(= (nth 1 (window-edges minibuffer))
(nth 3 (window-edges)))))
edges (window-edges)
top (nth 1 edges)
bot (nth 3 edges))
- ;; scale back a move that would make the
- ;; window too short.
- (cond ((< (- y top -1) window-min-height)
- (setq y (+ top window-min-height -1))))
+
;; compute size change needed
- (setq growth (- y bot -1)
- wconfig (current-window-configuration))
+ (cond (mode-line-p
+ ;; Scale back a move that would make the
+ ;; window too short.
+ (when (< (- y top -1) window-min-height)
+ (setq y (+ top window-min-height -1)))
+ (setq growth (- y bot -1)))
+ (t
+ (when (< (- bot y -1) window-min-height)
+ (setq y (- bot window-min-height -1)))
+ (setq growth (- top y -1))))
+ (setq wconfig (current-window-configuration))
+
;; Check for an error case.
(if (and (/= growth 0)
(not minibuffer)
(one-window-p t))
(error "Attempt to resize sole window"))
+
;; grow/shrink minibuffer?
(if should-enlarge-minibuffer
(progn
(enlarge-window (- growth))
(select-window start-event-window))
;; no. grow/shrink the selected window
+ ;; (message "growth = %d" growth)
(enlarge-window growth))
+
;; if this window's growth caused another
;; window to be deleted because it was too
;; short, rescind the change.
;;
;; if size change caused space to be stolen
;; from a window above this one, rescind the
- ;; change, but only if we didn't grow/srhink
+ ;; change, but only if we didn't grow/shrink
;; the minibuffer. minibuffer size changes
;; can cause all windows to shrink... no way
;; around it.
(if (or (/= start-nwindows (count-windows t))
(and (not should-enlarge-minibuffer)
+ mode-line-p
(/= top (nth 1 (window-edges)))))
(set-window-configuration wconfig)))))))))
+
+(defun mouse-drag-mode-line (start-event)
+ "Change the height of a window by dragging on the mode line."
+ (interactive "e")
+ (mouse-drag-mode-line-1 start-event t))
+
+(defun mouse-drag-header-line (start-event)
+ "Change the height of a window by dragging on the header line."
+ (interactive "e")
+ (mouse-drag-mode-line-1 start-event nil))
+
\f
(defun mouse-drag-vertical-line (start-event)
"Change the width of a window by dragging on the vertical line."
'right)))
(if (one-window-p t)
(error "Attempt to resize sole ordinary window"))
- (if (eq which-side 'left)
- (if (= (nth 0 (window-edges start-event-window)) 0)
- (error "Attempt to drag leftmost scrollbar"))
- (if (= (nth 2 (window-edges start-event-window))
- (frame-width start-event-frame))
- (error "Attempt to drag rightmost scrollbar")))
+ (if (eq which-side 'right)
+ (if (= (nth 2 (window-edges start-event-window))
+ (frame-width start-event-frame))
+ (error "Attempt to drag rightmost scrollbar"))
+ (if (= (nth 0 (window-edges start-event-window)) 0)
+ (error "Attempt to drag leftmost scrollbar")))
(track-mouse
(progn
;; enlarge-window only works on the selected window, so
(save-selected-window
;; If the scroll bar is on the window's left,
;; adjust the window on the left.
- (if (eq which-side 'left)
- (select-window (previous-window)))
+ (unless (eq which-side 'right)
+ (select-window (previous-window)))
(setq x (- (car (cdr mouse))
- (if (eq which-side 'left) 2 0))
+ (if (eq which-side 'right) 0 2))
edges (window-edges)
left (nth 0 edges)
right (nth 2 edges))
;; Don't set this-command to kill-region, so that a following
;; C-w will not double the text in the kill ring.
;; Ignore last-command so we don't append to a preceding kill.
- (let (this-command last-command)
+ (let (this-command last-command deactivate-mark)
(copy-region-as-kill (mark) (point)))
(mouse-set-region-1)))
(progn
(set-window-start window (point))
(if (natnump jump)
- (progn
- (goto-char (window-end window))
- ;; window-end doesn't reflect the window's new
- ;; start position until the next redisplay. Hurrah.
- (vertical-motion (1- jump) window))
+ (if (window-end window)
+ (progn
+ (goto-char (window-end window))
+ ;; window-end doesn't reflect the window's new
+ ;; start position until the next redisplay.
+ (vertical-motion (1- jump) window))
+ (vertical-motion (- (window-height window) 2)))
(goto-char (window-start window)))
(if overlay
(move-overlay overlay start (point)))
(start-point (posn-point start-posn))
(start-window (posn-window start-posn))
(start-frame (window-frame start-window))
+ (start-hscroll (window-hscroll start-window))
(bounds (window-edges start-window))
(top (nth 1 bounds))
(bottom (if (window-minibuffer-p start-window)
(mouse-scroll-subr start-window (1+ (- mouse-row bottom))
mouse-drag-overlay start-point)
(setq end-of-range (overlay-end mouse-drag-overlay))))))))))
+ ;; In case we did not get a mouse-motion event
+ ;; for the final move of the mouse before a drag event
+ ;; pretend that we did get one.
+ (when (and (memq 'drag (event-modifiers (car-safe event)))
+ (setq end (event-end event)
+ end-point (posn-point end))
+ (eq (posn-window end) start-window)
+ (integer-or-marker-p end-point))
+
+ ;; Go to START-POINT first, so that when we move to END-POINT,
+ ;; if it's in the middle of intangible text,
+ ;; point jumps in the direction away from START-POINT.
+ (goto-char start-point)
+ (goto-char end-point)
+ (if (zerop (% click-count 3))
+ (setq end-of-range (point)))
+ (let ((range (mouse-start-end start-point (point) click-count)))
+ (move-overlay mouse-drag-overlay (car range) (nth 1 range))))
+
(if (consp event)
(let ((fun (key-binding (vector (car event)))))
;; Run the binding of the terminating up-event, if possible.
last-command this-command)
(push-mark region-commencement t t)
(goto-char region-termination)
- (copy-region-as-kill (point) (mark t))
+ ;; Don't let copy-region-as-kill set deactivate-mark.
+ (let (deactivate-mark)
+ (copy-region-as-kill (point) (mark t)))
(let ((buffer (current-buffer)))
(mouse-show-mark)
;; mouse-show-mark can call read-event,
(mouse-set-region-1))))
(delete-overlay mouse-drag-overlay)
;; Run the binding of the terminating up-event.
- (if (fboundp fun)
- (setq unread-command-events
- (cons event unread-command-events)))))
+ (when (and (functionp fun)
+ (= start-hscroll (window-hscroll start-window)))
+ (setq unread-command-events
+ (cons event unread-command-events)))))
(delete-overlay mouse-drag-overlay)))))
\f
;; Commands to handle xterm-style multiple clicks.
If DIR is positive skip forward; if negative, skip backward."
(let* ((char (following-char))
(syntax (char-to-string (char-syntax char))))
- (cond ((or (string= syntax "w") (string= syntax " "))
+ (cond ((string= syntax "w")
+ ;; Here, we can't use skip-syntax-forward/backward because
+ ;; they don't pay attention to word-separating-categories,
+ ;; and thus they will skip over a true word boundary. So,
+ ;; we simularte the original behaviour by using
+ ;; forward-word.
+ (if (< dir 0)
+ (if (not (looking-at "\\<"))
+ (forward-word -1))
+ (if (or (looking-at "\\<") (not (looking-at "\\>")))
+ (forward-word 1))))
+ ((string= syntax " ")
(if (< dir 0)
(skip-syntax-backward syntax)
(skip-syntax-forward syntax)))
(defun mouse-show-mark ()
(if transient-mark-mode
- (if window-system
- (delete-overlay mouse-drag-overlay))
- (if window-system
- (let ((inhibit-quit t)
- (echo-keystrokes 0)
- event events key ignore
- x-lost-selection-hooks)
- (add-hook 'x-lost-selection-hooks
- '(lambda (seltype)
- (if (eq seltype 'PRIMARY)
- (progn (setq ignore t)
- (throw 'mouse-show-mark t)))))
- (move-overlay mouse-drag-overlay (point) (mark t))
- (catch 'mouse-show-mark
- ;; In this loop, execute scroll bar and switch-frame events.
- ;; Also ignore down-events that are undefined.
- (while (progn (setq event (read-event))
- (setq events (append events (list event)))
- (setq key (apply 'vector events))
- (or (and (consp event)
- (eq (car event) 'switch-frame))
- (and (consp event)
- (eq (posn-point (event-end event))
- 'vertical-scroll-bar))
- (and (memq 'down (event-modifiers event))
- (not (key-binding key))
- (not (mouse-undouble-last-event events))
- (not (member key mouse-region-delete-keys)))))
- (and (consp event)
- (or (eq (car event) 'switch-frame)
- (eq (posn-point (event-end event))
- 'vertical-scroll-bar))
- (let ((keys (vector 'vertical-scroll-bar event)))
- (and (key-binding keys)
- (progn
- (call-interactively (key-binding keys)
- nil keys)
- (setq events nil)))))))
- ;; If we lost the selection, just turn off the highlighting.
- (if ignore
- nil
- ;; For certain special keys, delete the region.
- (if (member key mouse-region-delete-keys)
- (delete-region (overlay-start mouse-drag-overlay)
- (overlay-end mouse-drag-overlay))
- ;; Otherwise, unread the key so it gets executed normally.
- (setq unread-command-events
- (nconc events unread-command-events))))
- (setq quit-flag nil)
- (delete-overlay mouse-drag-overlay))
- (save-excursion
- (goto-char (mark t))
- (sit-for 1)))))
+ (delete-overlay mouse-drag-overlay)
+ (let ((inhibit-quit t)
+ (echo-keystrokes 0)
+ event events key ignore
+ x-lost-selection-hooks)
+ (add-hook 'x-lost-selection-hooks
+ (lambda (seltype)
+ (if (eq seltype 'PRIMARY)
+ (progn (setq ignore t)
+ (throw 'mouse-show-mark t)))))
+ (move-overlay mouse-drag-overlay (point) (mark t))
+ (catch 'mouse-show-mark
+ ;; In this loop, execute scroll bar and switch-frame events.
+ ;; Also ignore down-events that are undefined.
+ (while (progn (setq event (read-event))
+ (setq events (append events (list event)))
+ (setq key (apply 'vector events))
+ (or (and (consp event)
+ (eq (car event) 'switch-frame))
+ (and (consp event)
+ (eq (posn-point (event-end event))
+ 'vertical-scroll-bar))
+ (and (memq 'down (event-modifiers event))
+ (not (key-binding key))
+ (not (mouse-undouble-last-event events))
+ (not (member key mouse-region-delete-keys)))))
+ (and (consp event)
+ (or (eq (car event) 'switch-frame)
+ (eq (posn-point (event-end event))
+ 'vertical-scroll-bar))
+ (let ((keys (vector 'vertical-scroll-bar event)))
+ (and (key-binding keys)
+ (progn
+ (call-interactively (key-binding keys)
+ nil keys)
+ (setq events nil)))))))
+ ;; If we lost the selection, just turn off the highlighting.
+ (if ignore
+ nil
+ ;; For certain special keys, delete the region.
+ (if (member key mouse-region-delete-keys)
+ (delete-region (overlay-start mouse-drag-overlay)
+ (overlay-end mouse-drag-overlay))
+ ;; Otherwise, unread the key so it gets executed normally.
+ (setq unread-command-events
+ (nconc events unread-command-events))))
+ (setq quit-flag nil)
+ (delete-overlay mouse-drag-overlay))
+ (save-excursion
+ (goto-char (mark t))
+ (sit-for 1))))
(defun mouse-set-mark (click)
"Set mark at the position clicked on with the mouse.
(defun mouse-yank-at-click (click arg)
"Insert the last stretch of killed text at the position clicked on.
-Also move point to one end of the text thus inserted (normally the end).
+Also move point to one end of the text thus inserted (normally the end),
+and set mark at the beginning..
Prefix arguments are interpreted as with \\[yank].
If `mouse-yank-at-point' is non-nil, insert at point
regardless of where you click."
;; 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.
- (let (before-change-function after-change-function
- before-change-functions after-change-functions)
+ (let (before-change-functions after-change-functions)
(delete-region beg
(+ beg (if (> end beg) 1 -1))))
(let ((buffer-undo-list buffer-undo-list))
;; Undo that deletion--but don't change the undo list!
- (let (before-change-function after-change-function
- before-change-functions after-change-functions)
+ (let (before-change-functions after-change-functions)
(primitive-undo 1 buffer-undo-list))
;; Now delete the rest of the specified region,
;; but don't record it.
again in a different position, it extends the selection again.
If you do this twice in the same position, the selection is killed."
(interactive "e")
- (let ((before-scroll point-before-scroll))
+ (let ((before-scroll
+ (with-current-buffer (window-buffer (posn-window (event-start click)))
+ point-before-scroll)))
(mouse-minibuffer-check click)
(let ((click-posn (posn-point (event-start click)))
;; Don't let a subsequent kill command append to this one:
(goto-char before-scroll))
(exchange-point-and-mark)
(kill-new (buffer-substring (point) (mark t)))
- (if window-system
- (mouse-show-mark)))
+ (mouse-show-mark))
(mouse-set-region-1)
(setq mouse-save-then-kill-posn
(list (car kill-ring) (point) click-posn)))))))
(kill-new (buffer-substring
(overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay)) t)
- (copy-region-as-kill (overlay-start mouse-secondary-overlay)
- (overlay-end mouse-secondary-overlay))))
+ (let (deactivate-mark)
+ (copy-region-as-kill (overlay-start mouse-secondary-overlay)
+ (overlay-end mouse-secondary-overlay)))))
(if mouse-secondary-start
;; All we have is one end of a selection,
;; so put the other end here.
(overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay)))))))
\f
-(defcustom mouse-menu-buffer-maxlen 20
+(defcustom mouse-buffer-menu-maxlen 20
"*Number of buffers in one pane (submenu) of the buffer menu.
If we have lots of buffers, divide them into groups of
-`mouse-menu-buffer-maxlen' and make a pane (or submenu) for each one."
+`mouse-buffer-menu-maxlen' and make a pane (or submenu) for each one."
:type 'integer
:group 'mouse)
+(defcustom mouse-buffer-menu-mode-mult 4
+ "*Group the buffers by the major mode groups on \\[mouse-buffer-menu]?
+This number which determines (in a hairy way) whether \\[mouse-buffer-menu]
+will split the buffer menu by the major modes (see
+`mouse-buffer-menu-mode-groups') or just by menu length.
+Set to 1 (or even 0!) if you want to group by major mode always, and to
+a large number if you prefer a mixed multitude. The default is 4."
+ :type 'integer
+ :group 'mouse
+ :version "20.3")
+
(defvar mouse-buffer-menu-mode-groups
'(("Info\\|Help\\|Apropos\\|Man" . "Help")
("\\bVM\\b\\|\\bMH\\b\\|Message\\|Mail\\|Group\\|Score\\|Summary\\|Article"
and selects that window."
(interactive "e")
(mouse-minibuffer-check event)
- (let (buffers alist menu split-by-major-mode sum-of-squares)
- (setq buffers (buffer-list))
+ (let ((buffers (buffer-list)) alist menu split-by-major-mode sum-of-squares)
;; Make an alist of elements that look like (MENU-ITEM . BUFFER).
(let ((tail buffers))
(while tail
(while tail
(setq sum-of-squares
(+ sum-of-squares
- (* (length (cdr (cdr (car tail))))
- (length (cdr (cdr (car tail)))))))
+ (let ((len (length (cdr (cdr (car tail)))))) (* len len))))
(setq tail (cdr tail))))
- (if (< (* sum-of-squares 4) (* (length buffers) (length buffers)))
+ (if (< (* sum-of-squares mouse-buffer-menu-mode-mult)
+ (* (length buffers) (length buffers)))
;; Subdividing by major modes really helps, so let's do it.
(let (subdivided-menus (buffers-left (length buffers)))
;; Sort the list to put the most popular major modes first.
(cons (cons
"Others"
(mouse-buffer-menu-alist
- (apply 'append
- (mapcar 'cdr
- (mapcar 'cdr split-by-major-mode)))))
+ ;; we don't need split-by-major-mode any
+ ;; more, so we can ditch it with nconc.
+ (apply 'nconc (mapcar 'cddr split-by-major-mode))))
subdivided-menus)))
- (setq subdivided-menus
- (nreverse subdivided-menus))
- (setq menu (cons "Buffer Menu" subdivided-menus)))
+ (setq menu (cons "Buffer Menu" (nreverse subdivided-menus))))
(progn
(setq alist (mouse-buffer-menu-alist buffers))
(setq menu (cons "Buffer Menu"
(mouse-buffer-menu-split "Select Buffer" alist)))))
(let ((buf (x-popup-menu event menu))
(window (posn-window (event-start event))))
- (if buf
- (progn
+ (when buf
(or (framep window) (select-window window))
- (switch-to-buffer buf))))))
+ (switch-to-buffer buf)))))
(defun mouse-buffer-menu-alist (buffers)
(let (tail
(defun mouse-buffer-menu-split (title alist)
;; If we have lots of buffers, divide them into groups of 20
;; and make a pane (or submenu) for each one.
- (if (> (length alist) (/ (* mouse-menu-buffer-maxlen 3) 2))
+ (if (> (length alist) (/ (* mouse-buffer-menu-maxlen 3) 2))
(let ((alist alist) sublists next
(i 1))
(while alist
- ;; Pull off the next mouse-menu-buffer-maxlen buffers
+ ;; Pull off the next mouse-buffer-menu-maxlen buffers
;; and make them the next element of sublist.
- (setq next (nthcdr mouse-menu-buffer-maxlen alist))
+ (setq next (nthcdr mouse-buffer-menu-maxlen alist))
(if next
- (setcdr (nthcdr (1- mouse-menu-buffer-maxlen) alist)
+ (setcdr (nthcdr (1- mouse-buffer-menu-maxlen) alist)
nil))
(setq sublists (cons (cons (format "Buffers %d" i) alist)
sublists))
(if (assoc "Default" elt)
(delete (assoc "Default" elt) elt))
(setcdr elt
- (cons (list "Default"
- (cdr (assq 'font (frame-parameters (selected-frame)))))
+ (cons (list "Default" default)
(cdr elt)))))
(defvar x-fixed-font-alist
("clean 8x16"
"-schumacher-clean-medium-r-normal--16-*-*-*-c-80-iso8859-1")
("")
- ("sony 8x16" "-sony-fixed-medium-r-normal--16-*-*-*-c-80-iso8859-1"))
+ ("sony 8x16" "-sony-fixed-medium-r-normal--16-*-*-*-c-80-iso8859-1")
;;; We don't seem to have these; who knows what they are.
;;; ("fg-18" "fg-18")
;;; ("fg-25" "fg-25")
-;;; ("lucidasanstypewriter-12" "lucidasanstypewriter-12")
-;;; ("lucidasanstypewriter-bold-14" "lucidasanstypewriter-bold-14")
-;;; ("lucidasanstypewriter-bold-24" "lucidasanstypewriter-bold-24")
+ ("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")
;;; ("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-*-*-*-*-*-*-*")
+ )
("Courier"
;; For these, we specify the point height.
("8" "-adobe-courier-medium-r-normal--*-80-*-*-m-*-iso8859-1")
(if (not (eq system-type 'ms-dos))
(global-set-key [S-down-mouse-1] 'mouse-set-font))
;; C-down-mouse-2 is bound in facemenu.el.
-(global-set-key [C-down-mouse-3] 'mouse-major-mode-menu)
+(global-set-key [C-down-mouse-3] 'mouse-popup-menubar-stuff)
;; Replaced with dragging mouse-1
(global-set-key [mode-line mouse-1] 'mouse-select-window)
(global-set-key [mode-line drag-mouse-1] 'mouse-select-window)
(global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line)
+(global-set-key [header-line down-mouse-1] 'mouse-drag-header-line)
(global-set-key [mode-line mouse-2] 'mouse-delete-other-windows)
(global-set-key [mode-line mouse-3] 'mouse-delete-window)
(global-set-key [mode-line C-mouse-2] 'mouse-split-window-horizontally)
(provide 'mouse)
+;; This file contains the functionality of the old mldrag.el.
+(defalias 'mldrag-drag-mode-line 'mouse-drag-mode-line)
+(defalias 'mldrag-drag-vertical-line 'mouse-drag-vertical-line)
+(make-obsolete 'mldrag-drag-mode-line 'mouse-drag-mode-line "21.1")
+(make-obsolete 'mldrag-drag-vertical-line 'mouse-drag-vertical-line "21.1")
+(provide 'mldrag)
+
;;; mouse.el ends here