]> code.delx.au - gnu-emacs/blobdiff - lisp/mouse.el
*** empty log message ***
[gnu-emacs] / lisp / mouse.el
index 833b254049e1c55544e2b7f8557299f1dc7c82ee..70fee40b53e574a55e7054ee88c268bcaad61265 100644 (file)
@@ -90,7 +90,9 @@ PREFIX is the prefix argument (if any) to pass to the command."
       (message "")
       ;; Maybe try again but with the submap.
       (setq map (if (keymapp cmd) cmd)))
-    (when (functionp cmd)
+    ;; 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))
       (setq prefix-arg prefix)
       ;; `setup-specified-language-environment', for instance,
       ;; expects this to be set from a menu keymap.
@@ -164,7 +166,7 @@ Default to the Edit menu if the major mode doesn't define a menu."
          (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.
+  "Pops up a menu equivalent 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")
@@ -300,10 +302,40 @@ This command must be bound to a mouse click."
        (split-window-horizontally
         (min (max new-width first-col) last-col))))))
 
+(defun mouse-drag-window-above (window)
+  "Return the (or a) window directly above WINDOW.
+That means one whose bottom edge is at the same height as WINDOW's top edge."
+  (let ((top (nth 1 (window-edges window)))
+       (start-window window)
+       above-window)
+    (setq window (previous-window window 0))
+    (while (and (not above-window) (not (eq window start-window)))
+      (if (= (+ (window-height window) (nth 1 (window-edges window)))
+            top)
+         (setq above-window window))
+      (setq window (previous-window window)))
+    above-window))
+
+(defun mouse-drag-move-window-bottom (window growth)
+  "Move the bottom of WINDOW up or down by GROWTH lines.
+Move it down if GROWTH is positive, or up if GROWTH is negative.
+If this would make WINDOW too short,
+shrink the window or windows above it to make room."
+  (let ((excess (- window-min-height (+ (window-height window) growth))))
+    ;; EXCESS is the number of lines we need to take from windows above.
+    (if (> excess 0)
+       ;; This can recursively shrink windows all the way up.
+       (let ((window-above (mouse-drag-window-above window)))
+         (if window-above
+             (mouse-drag-move-window-bottom window-above (- excess))))))
+  (save-selected-window
+    (select-window window)
+    (enlarge-window growth nil (> growth 0))))
+
 (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."
+MODE-LINE-P non-nil means dragging a mode line; nil means a header line."
   ;; Give temporary modes such as isearch a chance to turn off.
   (run-hooks 'mouse-leave-buffer-hook)
   (let* ((done nil)
@@ -373,10 +405,6 @@ MODE-LINE-P non-nil means a mode line is dragged."
 
                 ;; compute size change needed
                 (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       ; header line
                        (when (< (- bot y) window-min-height)
@@ -410,7 +438,7 @@ MODE-LINE-P non-nil means a mode line is dragged."
                       (select-window start-event-window))
                   ;; no.  grow/shrink the selected window
                   ;(message "growth = %d" growth)
-                  (enlarge-window growth))
+                  (mouse-drag-move-window-bottom start-event-window growth))
 
                 ;; if this window's growth caused another
                 ;; window to be deleted because it was too
@@ -424,6 +452,7 @@ MODE-LINE-P non-nil means a mode line is dragged."
                 ;; around it.
                 (when (or (/= start-nwindows (count-windows t))
                           (and (not should-enlarge-minibuffer)
+                               (> growth 0)
                                mode-line-p
                                (/= top (nth 1 (window-edges)))))
                   (set-window-configuration wconfig)))))))))
@@ -668,13 +697,29 @@ Upon exit, point is at the far edge of the newly visible text."
 Highlight the drag area as you move the mouse.
 This must be bound to a button-down mouse event.
 In Transient Mark mode, the highlighting remains as long as the mark
-remains active.  Otherwise, it remains until the next input event."
+remains active.  Otherwise, it remains until the next input event.
+
+If the click is in the echo area, display the `*Messages*' buffer."
   (interactive "e")
+  (let ((w (posn-window (event-start start-event))))
+    (if (not (or (not (window-minibuffer-p w))
+                (minibuffer-window-active-p w)))
+       (save-excursion
+         (read-event)
+         (set-buffer "*Messages*")
+         (goto-char (point-max))
+         (display-buffer (current-buffer)))
+      ;; Give temporary modes such as isearch a chance to turn off.
+      (run-hooks 'mouse-leave-buffer-hook)
+      (mouse-drag-region-1 start-event))))
+
+(defun mouse-drag-region-1 (start-event)
   (mouse-minibuffer-check start-event)
   (let* ((echo-keystrokes 0)
         (start-posn (event-start start-event))
         (start-point (posn-point start-posn))
         (start-window (posn-window start-posn))
+        (start-window-start (window-start start-window))
         (start-frame (window-frame start-window))
         (start-hscroll (window-hscroll start-window))
         (bounds (window-edges start-window))
@@ -694,7 +739,8 @@ remains active.  Otherwise, it remains until the next input event."
     (setq start-point (point))
     (let ((range (mouse-start-end start-point start-point click-count)))
       (move-overlay mouse-drag-overlay (car range) (nth 1 range)
-                   (window-buffer start-window)))
+                   (window-buffer start-window))
+      (overlay-put mouse-drag-overlay 'window (selected-window)))
     (deactivate-mark)
     ;; end-of-range is used only in the single-click case.
     ;; It is the place where the drag has reached so far
@@ -740,6 +786,7 @@ 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.
@@ -748,7 +795,6 @@ remains active.  Otherwise, it remains until the next input 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.
@@ -800,7 +846,18 @@ remains active.  Otherwise, it remains until the next input event."
              (delete-overlay mouse-drag-overlay)
              ;; Run the binding of the terminating up-event.
              (when (and (functionp fun)
-                        (= start-hscroll (window-hscroll start-window)))
+                        (= 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 will contain a different
+                        ;; position due to the new window contents,
+                        ;; and point is set again.
+                        (or end-point
+                            (= (window-start start-window)
+                               start-window-start)))
                (setq unread-command-events
                      (cons event unread-command-events)))))
        (delete-overlay mouse-drag-overlay)))))
@@ -945,7 +1002,7 @@ If DIR is positive skip forward; if negative, skip backward."
 
 ;; Momentarily show where the mark is, if highlighting doesn't show it.
 
-(defvar mouse-region-delete-keys '([delete])
+(defvar mouse-region-delete-keys '([delete] [deletechar])
   "List of keys which shall cause the mouse region to be deleted.")
 
 (defun mouse-show-mark ()
@@ -997,10 +1054,7 @@ If DIR is positive skip forward; if negative, skip backward."
          (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))))
 
 (defun mouse-set-mark (click)
   "Set mark at the position clicked on with the mouse.
@@ -1033,7 +1087,7 @@ 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),
-and set mark at the beginning..
+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."
@@ -1514,7 +1568,8 @@ a large number if you prefer a mixed multitude.  The default is 4."
     ("ObjC" . "C")
     ("Text" . "Text")
     ("Outline" . "Text")
-    ("\\(log\\|diff\\|vc\\|cvs\\)" . "Version Control") ; "Change Management"?
+    ("\\(HT\\|SG\\|X\\|XHT\\)ML" . "SGML")
+    ("log\\|diff\\|vc\\|cvs" . "Version Control") ; "Change Management"?
     ("Lisp" . "Lisp"))
   "How to group various major modes together in \\[mouse-buffer-menu].
 Each element has the form (REGEXP . GROUPNAME).
@@ -1603,7 +1658,9 @@ and selects that window."
     (let ((buf (x-popup-menu event menu))
          (window (posn-window (event-start event))))
       (when buf
-           (or (framep window) (select-window window))
+       (select-window
+        (if (framep window) (frame-selected-window window)
+          window))
        (switch-to-buffer buf)))))
 
 (defun mouse-buffer-menu-alist (buffers)
@@ -1842,7 +1899,7 @@ and selects that window."
 ;;;!! ;;              (abs-x (car pos))
 ;;;!! ;;              (abs-y (cdr pos))
 ;;;!! ;;              (relative-coordinate
-;;;!! ;;               (coordinates-in-window-p (` ((, abs-x) (, abs-y)))
+;;;!! ;;               (coordinates-in-window-p `(,abs-x ,abs-y)
 ;;;!! ;;                                        (selected-window)))
 ;;;!! ;;              (begin-reg nil)
 ;;;!! ;;              (end-reg nil)
@@ -2118,10 +2175,12 @@ and selects that window."
 (defun mouse-set-font (&rest fonts)
   "Select an emacs font from a list of known good fonts and fontsets."
   (interactive
-   (x-popup-menu
-    last-nonmenu-event
-    ;; Append list of fontsets currently defined.
-    (append x-fixed-font-alist (list (generate-fontset-menu)))))
+   (progn (unless (display-multi-font-p)
+           (error "Cannot change fonts on this display"))
+         (x-popup-menu
+          last-nonmenu-event
+          ;; Append list of fontsets currently defined.
+          (append x-fixed-font-alist (list (generate-fontset-menu))))))
   (if fonts
       (let (font)
        (while fonts