Commit e1894109 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/term/x-win.el (x-menu-bar-open): Always pass last-nonmenu-event.

* lisp/subr.el (eventp): `nil' is not an event, and eventp is not hot.
(event-start, event-end): Use posn-at-point to return a more
informative posn.
(posnp): New function.
* lisp/mouse.el (popup-menu-normalize-position): Use it.
parent a3095f42
......@@ -556,6 +556,8 @@ are deprecated and will be removed eventually.
** New functions `autoloadp' and `autoload-do-load'.
** New function `posnp' to test if an object is a `posn'.
** `function-get' fetches the property of a function, following aliases.
** `toggle-read-only' accepts a second argument specifying whether to
......
2012-08-10 Stefan Monnier <monnier@iro.umontreal.ca>
* term/x-win.el (x-menu-bar-open): Always pass last-nonmenu-event.
* subr.el (eventp): `nil' is not an event, and eventp is not hot.
(event-start, event-end): Use posn-at-point to return a more
informative posn.
(posnp): New function.
* mouse.el (popup-menu-normalize-position): Use it.
2012-08-10 Masatake YAMATO <yamato@redhat.com>
* mouse.el (popup-menu-normalize-position): New function.
......
;;; mouse.el --- window system-independent mouse support
;;; mouse.el --- window system-independent mouse support -*- lexical-binding: t -*-
;; Copyright (C) 1993-1995, 1999-2012 Free Software Foundation, Inc.
......@@ -151,35 +151,24 @@ PREFIX is the prefix argument (if any) to pass to the command."
(call-interactively cmd))))
(defun popup-menu-normalize-position (position)
"Converts the POSITION to the form which `popup-menu' expects internally.
POSITION can be nil, an click event, a posn- value, or a value having
form ((XOFFSET YOFFSET) WINDOW).
If nil, the current mouse position is used.
If an click event, the value returend from `event-end' is used."
"Convert the POSITION to the form which `popup-menu' expects internally.
POSITION can an event, a posn- value, a value having
form ((XOFFSET YOFFSET) WINDOW), or nil.
If nil, the current mouse position is used."
(pcase position
;; nil -> mouse cursor position
;; this pattern must be before `eventp' because
;; nil is an event.
(`nil
(let ((mp (mouse-pixel-position)))
(list (list (cadr mp) (cddr mp)) (car mp))))
;; value returned from (event-end (read-event)) or (posn-at-point)
((or `(,window ,area-or-pos (,x . ,y)
,timestamp ,object ,pos (,col . ,row)
,image (,dx . ,dy) (,width . ,height))
`(,window ,pos (0 . 0) 0))
;; Value returned from `event-end' or `posn-at-point'.
((pred posnp)
(let ((xy (posn-x-y position)))
(list (list (car xy) (cdr xy))
(posn-window position))))
;; pattern expected by popup-menu
(`((,xoffset ,yoffset) ,window)
position)
;; event
;; Event.
((pred eventp)
(popup-menu-normalize-position (event-end position)))
;; rejects
(t
(error "Unexpected position form"))))
(t position)))
(defun minor-mode-menu-from-indicator (indicator)
"Show menu for minor mode specified by INDICATOR.
......
......@@ -907,11 +907,12 @@ The normal global definition of the character C-x indirects to this keymap.")
c)))
key)))
(defsubst eventp (obj)
(defun eventp (obj)
"True if the argument is an event object."
(or (integerp obj)
(and (symbolp obj) obj (not (keywordp obj)))
(and (consp obj) (symbolp (car obj)))))
(when obj
(or (integerp obj)
(and (symbolp obj) obj (not (keywordp obj)))
(and (consp obj) (symbolp (car obj))))))
(defun event-modifiers (event)
"Return a list of symbols representing the modifier keys in event EVENT.
......@@ -975,7 +976,7 @@ in the current Emacs session, then this function may return nil."
;; is this really correct? maybe remove mouse-movement?
(memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement)))
(defsubst event-start (event)
(defun event-start (event)
"Return the starting position of EVENT.
EVENT should be a click, drag, or key press event.
If it is a key press event, the return value has the form
......@@ -990,9 +991,10 @@ If EVENT is a mouse or key press or a mouse click, this is the
position of the event. If EVENT is a drag, this is the starting
position of the drag."
(if (consp event) (nth 1 event)
(list (selected-window) (point) '(0 . 0) 0)))
(or (posn-at-point)
(list (selected-window) (point) '(0 . 0) 0))))
(defsubst event-end (event)
(defun event-end (event)
"Return the ending location of EVENT.
EVENT should be a click, drag, or key press event.
If EVENT is a key press event, the return value has the form
......@@ -1009,7 +1011,8 @@ If EVENT is a mouse or key press or a mouse click, this is the
position of the event. If EVENT is a drag, this is the starting
position of the drag."
(if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
(list (selected-window) (point) '(0 . 0) 0)))
(or (posn-at-point)
(list (selected-window) (point) '(0 . 0) 0))))
(defsubst event-click-count (event)
"Return the multi-click count of EVENT, a click or drag event.
......@@ -1018,6 +1021,13 @@ The return value is a positive integer."
;;;; Extracting fields of the positions in an event.
(defun posnp (obj)
"Return non-nil if OBJ appears to be a valid `posn' object."
(and (windowp (car-safe obj))
(atom (car-safe (setq obj (cdr obj)))) ;AREA-OR-POS.
(integerp (car-safe (car-safe (setq obj (cdr obj))))) ;XOFFSET.
(integerp (car-safe (cdr obj))))) ;TIMESTAMP.
(defsubst posn-window (position)
"Return the window in POSITION.
POSITION should be a list of the form returned by the `event-start'
......
......@@ -1306,17 +1306,14 @@ Request data types in the order specified by `x-select-request-type'."
(defun x-menu-bar-open (&optional frame)
"Open the menu bar if it is shown.
`popup-menu' is used if it is off "
`popup-menu' is used if it is off."
(interactive "i")
(cond
((and (not (zerop (or (frame-parameter nil 'menu-bar-lines) 0)))
(fboundp 'accelerate-menu))
(accelerate-menu frame))
(t
(popup-menu (mouse-menu-bar-map)
(if (listp last-nonmenu-event)
nil
(posn-at-point))))))
(popup-menu (mouse-menu-bar-map) last-nonmenu-event))))
;;; Window system initialization.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment