(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.
+ "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")
(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)
;; 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)
(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
;; 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)))))))))
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))
(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
(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
;; 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.
(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."
(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
(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)
(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