(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
;; 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-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
(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.