]> code.delx.au - gnu-emacs/blobdiff - lisp/mouse.el
(widget-button-click): Wrap with save-excursion
[gnu-emacs] / lisp / mouse.el
index b0044a4a991f562cd51c6d623d6e6ef83e7f1cea..f59890c1913c90019ff50596fbe6742f52e9be18 100644 (file)
@@ -1,6 +1,6 @@
 ;;; mouse.el --- window system-independent mouse support
 
-;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1999 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: hardware
 ;; Provide a mode-specific menu on a mouse button.
 
 (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 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)
-       ;; 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]))))
+  (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))
     (setq result (x-popup-menu t (list newmap)))
     (if result
        (let ((command (key-binding
@@ -191,9 +197,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)
@@ -216,6 +223,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)))))
@@ -254,18 +262,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
@@ -284,7 +300,9 @@ 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.
@@ -297,8 +315,20 @@ This command must be bound to a mouse click."
                 ;; 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."
@@ -317,12 +347,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
@@ -363,10 +393,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))
@@ -585,7 +615,7 @@ remains active.  Otherwise, it remains until the next input event."
                  (setq end-of-range (overlay-start mouse-drag-overlay)))
                 ((>= mouse-row bottom)
                  (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
-a                                   mouse-drag-overlay start-point)
+                                    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
@@ -1887,8 +1917,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
@@ -1922,15 +1951,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")
@@ -2008,6 +2039,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)
@@ -2018,4 +2050,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)
+(make-obsolete 'mldrag-drag-vertical-line 'mouse-drag-vertical-line)
+(provide 'mldrag)
+
 ;;; mouse.el ends here