]> code.delx.au - gnu-emacs/blobdiff - lisp/mouse.el
Merged in changes from CVS trunk.
[gnu-emacs] / lisp / mouse.el
index ba60c7b8a924d4b3cd04e60fc5656dbc98ab3cab..b73967b99dccf2abef8956c348da81dcfd9534e4 100644 (file)
@@ -1,6 +1,6 @@
 ;;; mouse.el --- window system-independent mouse support
 
-;; Copyright (C) 1993, 1994, 1995, 1999, 2000, 2001
+;; Copyright (C) 1993, 94, 95, 1999, 2000, 01, 2004
 ;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
   "*If non-nil, mouse yank commands yank at point instead of at click."
   :type 'boolean
   :group 'mouse)
+
+(defcustom mouse-drag-copy-region t
+  "*If non-nil, mouse drag copies region to kill-ring."
+  :type 'boolean
+  :group 'mouse)
+
 \f
 ;; Provide a mode-specific menu on a mouse button.
 
@@ -166,7 +172,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 equivalent to the menu bar a keyboard EVENT with 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."
   (interactive "@e \nP")
@@ -577,12 +583,7 @@ This should be bound to a mouse click event type."
   (mouse-minibuffer-check event)
   ;; Use event-end in case called from mouse-drag-region.
   ;; If EVENT is a click, event-end and event-start give same value.
-  (let ((posn (event-end event)))
-    (if (not (windowp (posn-window posn)))
-       (error "Cursor not in text area of window"))
-    (select-window (posn-window posn))
-    (if (numberp (posn-point posn))
-       (goto-char (posn-point posn)))))
+  (posn-set-point (event-end event)))
 
 (defvar mouse-last-region-beg nil)
 (defvar mouse-last-region-end nil)
@@ -617,11 +618,15 @@ This should be bound to a mouse drag event."
     ;; 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 deactivate-mark)
-      (copy-region-as-kill (mark) (point)))
+    (when mouse-drag-copy-region
+      (let (this-command last-command deactivate-mark)
+       (copy-region-as-kill (mark) (point))))
     (mouse-set-region-1)))
 
 (defun mouse-set-region-1 ()
+  ;; Set transient-mark-mode for a little while.
+  (if (memq transient-mark-mode '(nil identity))
+      (setq transient-mark-mode 'only))
   (setq mouse-last-region-beg (region-beginning))
   (setq mouse-last-region-end (region-end))
   (setq mouse-last-region-tick (buffer-modified-tick)))
@@ -697,8 +702,23 @@ 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))
@@ -724,7 +744,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
@@ -816,8 +837,9 @@ remains active.  Otherwise, it remains until the next input event."
                  (push-mark region-commencement t t)
                  (goto-char region-termination)
                  ;; Don't let copy-region-as-kill set deactivate-mark.
-                 (let (deactivate-mark)
-                   (copy-region-as-kill (point) (mark t)))
+                 (when mouse-drag-copy-region
+                   (let (deactivate-mark)
+                     (copy-region-as-kill (point) (mark t))))
                  (let ((buffer (current-buffer)))
                    (mouse-show-mark)
                    ;; mouse-show-mark can call read-event,
@@ -879,12 +901,12 @@ If DIR is positive skip forward; if negative, skip backward."
           (while (and (not (eobp)) (= (following-char) char))
             (forward-char 1))))))
 
-;; Return a list of region bounds based on START and END according to MODE.
-;; 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.
 (defun mouse-start-end (start end mode)
+"Return a list of region bounds based on START and END according to MODE.
+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."
   (if (> start end)
       (let ((temp start))
         (setq start end
@@ -986,63 +1008,59 @@ 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 ()
   (if transient-mark-mode
       (delete-overlay mouse-drag-overlay)
-    (if (not (display-graphic-p))
-       (save-excursion
-         (goto-char (mark t))
-         (sit-for 1))
-      (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)))))
+    (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))))
 
 (defun mouse-set-mark (click)
   "Set mark at the position clicked on with the mouse.
@@ -2163,11 +2181,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
-   (and (display-multi-font-p)
-       (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
@@ -2179,8 +2198,7 @@ and selects that window."
            (error
             (setq fonts (cdr fonts)))))
        (if (null font)
-           (error "Font not found")))
-    (message "Cannot change fonts on this display")))
+           (error "Font not found")))))
 \f
 ;;; Bindings for mouse commands.
 
@@ -2192,6 +2210,10 @@ and selects that window."
 (global-set-key [double-mouse-1] 'mouse-set-point)
 (global-set-key [triple-mouse-1] 'mouse-set-point)
 
+;; Clicking on the fringes causes hscrolling:
+(global-set-key [left-fringe mouse-1]  'mouse-set-point)
+(global-set-key [right-fringe mouse-1] 'mouse-set-point)
+
 (global-set-key [mouse-2]      'mouse-yank-at-click)
 (global-set-key [mouse-3]      'mouse-save-then-kill)
 
@@ -2233,4 +2255,5 @@ and selects that window."
 (make-obsolete 'mldrag-drag-vertical-line 'mouse-drag-vertical-line "21.1")
 (provide 'mldrag)
 
+;;; arch-tag: 9a710ce1-914a-4923-9b81-697f7bf82ab3
 ;;; mouse.el ends here