]> code.delx.au - gnu-emacs/blobdiff - lisp/mouse.el
(popup-menu): Run the keymap through indirect-function,
[gnu-emacs] / lisp / mouse.el
index e1b7e51e6a1b1e93004d57641864747095817b2b..ef78aff5a7ca35aa00103cdc08d59af37273f184 100644 (file)
@@ -1,9 +1,9 @@
 ;;; 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."
@@ -186,9 +272,10 @@ This command must be bound to a mouse click."
        (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)
@@ -211,6 +298,7 @@ This command must be bound to a mouse click."
        ;; 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)))))
@@ -249,18 +337,26 @@ This command must be bound to a mouse click."
                       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
@@ -279,21 +375,35 @@ This command must be bound to a mouse click."
                       (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."
@@ -312,12 +422,12 @@ This command must be bound to a mouse click."
              '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
@@ -358,10 +468,10 @@ This command must be bound to a mouse click."
                 (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))
@@ -519,6 +629,7 @@ remains active.  Otherwise, it remains until the next input event."
         (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)
@@ -582,6 +693,25 @@ remains active.  Otherwise, it remains until the next input event."
                  (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.
@@ -622,9 +752,10 @@ remains active.  Otherwise, it remains until the next input 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.
@@ -634,7 +765,18 @@ remains active.  Otherwise, it remains until the next input event."
 If DIR is positive skip forward; if negative, skip backward."
   (let* ((char (following-char))
         (syntax (char-to-string (char-syntax char))))
-    (cond ((or (string= syntax "w") (string= syntax " "))
+    (cond ((string= syntax "w")
+          ;; Here, we can't use skip-syntax-forward/backward because
+          ;; they don't pay attention to word-separating-categories,
+          ;; and thus they will skip over a true word boundary.  So,
+          ;; we simularte the original behaviour by using
+          ;; forward-word.
+          (if (< dir 0)
+              (if (not (looking-at "\\<"))
+                  (forward-word -1))
+            (if (or (looking-at "\\<") (not (looking-at "\\>")))
+                (forward-word 1))))
+         ((string= syntax " ")
           (if (< dir 0)
               (skip-syntax-backward syntax)
             (skip-syntax-forward syntax)))
@@ -761,59 +903,57 @@ If DIR is positive skip forward; if negative, skip backward."
 
 (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.
@@ -845,7 +985,8 @@ The text is saved in the kill ring, as with \\[kill-region]."
 
 (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."
@@ -885,14 +1026,12 @@ This does not delete the region; it acts like \\[kill-ring-save]."
     ;; 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.
@@ -922,7 +1061,9 @@ selection through the word or line clicked on.  If you do this
 again in a different position, it extends the selection again.
 If you do this twice in the same position, the selection is killed." 
   (interactive "e")
-  (let ((before-scroll point-before-scroll))
+  (let ((before-scroll
+        (with-current-buffer (window-buffer (posn-window (event-start click)))
+          point-before-scroll)))
     (mouse-minibuffer-check click)
     (let ((click-posn (posn-point (event-start click)))
          ;; Don't let a subsequent kill command append to this one:
@@ -1000,8 +1141,7 @@ If you do this twice in the same position, the selection is killed."
                (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)))))))
@@ -1308,6 +1448,17 @@ If we have lots of buffers, divide them into groups of
   :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"
@@ -1327,8 +1478,7 @@ This switches buffers in the window that you clicked on,
 and selects that window."
   (interactive "e")
   (mouse-minibuffer-check event)
-  (let (buffers alist menu split-by-major-mode sum-of-squares)
-    (setq buffers (buffer-list))
+  (let ((buffers (buffer-list))  alist menu split-by-major-mode sum-of-squares)
     ;; Make an alist of elements that look like (MENU-ITEM . BUFFER).
     (let ((tail buffers))
       (while tail
@@ -1357,10 +1507,10 @@ and selects that window."
       (while tail
        (setq sum-of-squares
              (+ sum-of-squares
-                (* (length (cdr (cdr (car tail))))
-                   (length (cdr (cdr (car tail)))))))
+                (let ((len (length (cdr (cdr (car tail)))))) (* len len))))
        (setq tail (cdr tail))))
-    (if (< (* sum-of-squares 4) (* (length buffers) (length buffers)))
+    (if (< (* sum-of-squares mouse-buffer-menu-mode-mult)
+          (* (length buffers) (length buffers)))
        ;; Subdividing by major modes really helps, so let's do it.
        (let (subdivided-menus (buffers-left (length buffers)))
          ;; Sort the list to put the most popular major modes first.
@@ -1390,23 +1540,20 @@ and selects that window."
                    (cons (cons
                           "Others"
                           (mouse-buffer-menu-alist
-                           (apply 'append
-                                  (mapcar 'cdr
-                                          (mapcar 'cdr split-by-major-mode)))))
+                           ;; we don't need split-by-major-mode any
+                           ;; more, so we can ditch it with nconc.
+                           (apply 'nconc (mapcar 'cddr split-by-major-mode))))
                          subdivided-menus)))
-         (setq subdivided-menus
-               (nreverse subdivided-menus))
-         (setq menu (cons "Buffer Menu" subdivided-menus)))
+         (setq menu (cons "Buffer Menu" (nreverse subdivided-menus))))
       (progn
        (setq alist (mouse-buffer-menu-alist buffers))
        (setq menu (cons "Buffer Menu"
                         (mouse-buffer-menu-split "Select Buffer" alist)))))
     (let ((buf (x-popup-menu event menu))
          (window (posn-window (event-start event))))
-      (if buf
-         (progn
+      (when buf
            (or (framep window) (select-window window))
-           (switch-to-buffer buf))))))
+       (switch-to-buffer buf)))))
 
 (defun mouse-buffer-menu-alist (buffers)
   (let (tail
@@ -1843,8 +1990,7 @@ and selects that window."
     (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
@@ -1878,15 +2024,17 @@ and selects that window."
      ("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")
@@ -1955,7 +2103,7 @@ and selects that window."
 (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
@@ -1964,6 +2112,7 @@ and selects that window."
 (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)
@@ -1974,4 +2123,11 @@ and selects that window."
 
 (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