(filter (when (symbolp map)
(plist-get (get map 'menu-pro) :filter))))
(if filter (funcall filter (symbol-function map)) map)))))
- event)
+ event cmd)
+ (unless position
+ (let ((mp (mouse-pixel-position)))
+ (setq position (list (list (cadr mp) (cddr mp)) (car mp)))))
;; The looping behavior was taken from lmenu's popup-menu-popup
(while (and map (setq event
;; map could be a prefix key, in which case
;; Strangely x-popup-menu returns a list.
;; mouse-major-mode-menu was using a weird:
;; (key-binding (apply 'vector (append '(menu-bar) menu-prefix events)))
- (let ((cmd
- (if (and (not (keymapp map)) (listp map))
- ;; We were given a list of keymaps. Search them all
- ;; in sequence until a first binding is found.
- (let ((mouse-click (apply 'vector event))
- binding)
- (while (and map (null binding))
- (setq binding (lookup-key (car map) mouse-click))
- (if (numberp binding) ; `too long'
- (setq binding nil))
- (setq map (cdr map)))
- binding)
- ;; We were given a single keymap.
- (lookup-key map (apply 'vector event)))))
- (setq map nil)
- ;; Clear out echoing, which perhaps shows a prefix arg.
- (message "")
- (when cmd
- (if (keymapp cmd)
- ;; Try again but with the submap.
- (setq map cmd)
- (setq prefix-arg prefix)
- ;; `setup-specified-language-environment', for instance,
- ;; expects this to be set from a menu keymap.
- (setq last-command-event (car (last event)))
- ;; mouse-major-mode-menu was using `command-execute' instead.
- (call-interactively cmd)))))))
+ (setq cmd
+ (if (and (not (keymapp map)) (listp map))
+ ;; We were given a list of keymaps. Search them all
+ ;; in sequence until a first binding is found.
+ (let ((mouse-click (apply 'vector event))
+ binding)
+ (while (and map (null binding))
+ (setq binding (lookup-key (car map) mouse-click))
+ (if (numberp binding) ; `too long'
+ (setq binding nil))
+ (setq map (cdr map)))
+ binding)
+ ;; We were given a single keymap.
+ (lookup-key map (apply 'vector event))))
+ ;; Clear out echoing, which perhaps shows a prefix arg.
+ (message "")
+ ;; Maybe try again but with the submap.
+ (setq map (if (keymapp cmd) cmd)))
+ (when (functionp cmd)
+ (setq prefix-arg prefix)
+ ;; `setup-specified-language-environment', for instance,
+ ;; expects this to be set from a menu keymap.
+ (setq last-command-event (car (last event)))
+ ;; mouse-major-mode-menu was using `command-execute' instead.
+ (call-interactively cmd))))
(defvar mouse-major-mode-menu-prefix) ; dynamically bound
;; the mode's commands may not make sense.
(interactive "@e\nP")
;; Let the mode update its menus first.
- (run-hooks 'activate-menubar-hook)
+ (run-hooks 'activate-menubar-hook 'menu-bar-update-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).
The contents are the items that would be in the menu bar whether or
not it is actually displayed."
(interactive "@e \nP")
- (run-hooks 'activate-menubar-hook)
+ (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
(let* ((local-menu (and (current-local-map)
(lookup-key (current-local-map) [menu-bar])))
(global-menu (lookup-key global-map [menu-bar]))
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)
- (echo-keystrokes 0)
- (start-event-frame (window-frame (car (car (cdr start-event)))))
- (start-event-window (car (car (cdr start-event))))
- (start-nwindows (count-windows t))
- (old-selected-window (selected-window))
- should-enlarge-minibuffer
- event mouse minibuffer y top bot edges wconfig params growth)
- (setq params (frame-parameters))
- (setq minibuffer (cdr (assq 'minibuffer params)))
+ (let* ((done nil)
+ (echo-keystrokes 0)
+ (start (event-start start-event))
+ (start-event-window (posn-window start))
+ (start-event-frame (window-frame start-event-window))
+ (start-nwindows (count-windows t))
+ (old-selected-window (selected-window))
+ (minibuffer (frame-parameter nil 'minibuffer))
+ should-enlarge-minibuffer event mouse y top bot edges wconfig growth)
(track-mouse
(progn
;; enlarge-window only works on the selected window, so
;; we must select the window where the start event originated.
;; unwind-protect will restore the old selected window later.
(select-window start-event-window)
+
;; if this is the bottommost ordinary window, then to
;; move its modeline the minibuffer must be enlarged.
(setq should-enlarge-minibuffer
(not (one-window-p t))
(= (nth 1 (window-edges minibuffer))
(nth 3 (window-edges)))))
+
;; loop reading events and sampling the position of
;; the mouse.
(while (not done)
(setq event (read-event)
mouse (mouse-position))
+
;; do nothing if
;; - there is a switch-frame event.
;; - the mouse isn't in the frame that we started in
;; unknown event.
(cond ((integerp event)
(setq done t))
+
((eq (car event) 'switch-frame)
nil)
- ((not (memq (car event)
- '(mouse-movement scroll-bar-movement)))
- (if (consp event)
- (setq unread-command-events
- (cons event unread-command-events)))
+
+ ((not (memq (car event) '(mouse-movement scroll-bar-movement)))
+ (when (consp event)
+ (push event unread-command-events))
(setq done t))
+
((not (eq (car mouse) start-event-frame))
nil)
+
((null (car (cdr mouse)))
nil)
+
(t
(setq y (cdr (cdr mouse))
edges (window-edges)
(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))))
+ (t ; header line
+ (when (< (- bot y) window-min-height)
+ (setq y (- bot window-min-height)))
+ ;; The window's top includes the header line!
+ (setq growth (- top y))))
(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"))
+ (when (and (/= growth 0)
+ (not minibuffer)
+ (one-window-p t))
+ (error "Attempt to resize sole window"))
;; grow/shrink minibuffer?
(if should-enlarge-minibuffer
(enlarge-window (- growth))
(select-window start-event-window))
;; no. grow/shrink the selected window
- ;; (message "growth = %d" growth)
+ ;(message "growth = %d" growth)
(enlarge-window growth))
;; if this window's growth caused another
;; the minibuffer. minibuffer size changes
;; can cause all windows to shrink... no way
;; 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)))))))))
+ (when (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."
(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."
+ "Change the height of a window by dragging on the header line.
+Windows whose header-lines are at the top of the frame cannot be
+resized by dragging their header-line."
(interactive "e")
- (mouse-drag-mode-line-1 start-event nil))
+ ;; Changing the window's size by dragging its header-line when the
+ ;; header-line is at the top of the frame is somewhat strange,
+ ;; because the header-line doesn't move, so don't do it.
+ (let* ((start (event-start start-event))
+ (window (posn-window start))
+ (frame (window-frame window))
+ (first-window (frame-first-window frame)))
+ (when (or (eq window first-window)
+ (= (nth 1 (window-edges window))
+ (nth 1 (window-edges first-window))))
+ (error "Cannot move header-line at the top of the frame"))
+ (mouse-drag-mode-line-1 start-event nil)))
\f
(defun mouse-drag-vertical-line (start-event)
;; Replaced with dragging mouse-1
;; (global-set-key [S-mouse-1] 'mouse-set-mark)
+;; Binding mouse-1 to mouse-select-window when on mode-, header-, or
+;; vertical-line prevents Emacs from signaling an error when the mouse
+;; button is released after dragging these lines, on non-toolkit
+;; versions.
(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 [header-line mouse-1] 'mouse-select-window)
(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)
HCoop / bpt / emacs.git / blobdiff