aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2012-08-10 10:47:12 -0400
committerStefan Monnier2012-08-10 10:47:12 -0400
commite18941095a56075d6eb908a65aafcd1697fea2ae (patch)
tree8d19e753be6174e4b2195391898bca167ebdbdae
parenta3095f422d5a1ba89b7e5f0c3a8826cb9195fb36 (diff)
downloademacs-e18941095a56075d6eb908a65aafcd1697fea2ae.tar.gz
emacs-e18941095a56075d6eb908a65aafcd1697fea2ae.zip
* 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.
-rw-r--r--etc/NEWS2
-rw-r--r--lisp/ChangeLog9
-rw-r--r--lisp/mouse.el29
-rw-r--r--lisp/subr.el26
-rw-r--r--lisp/term/x-win.el7
5 files changed, 40 insertions, 33 deletions
diff --git a/etc/NEWS b/etc/NEWS
index e802340608e..10dfe408813 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -556,6 +556,8 @@ are deprecated and will be removed eventually.
556 556
557** New functions `autoloadp' and `autoload-do-load'. 557** New functions `autoloadp' and `autoload-do-load'.
558 558
559** New function `posnp' to test if an object is a `posn'.
560
559** `function-get' fetches the property of a function, following aliases. 561** `function-get' fetches the property of a function, following aliases.
560 562
561** `toggle-read-only' accepts a second argument specifying whether to 563** `toggle-read-only' accepts a second argument specifying whether to
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index dc0efcf7563..347f7b666f6 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
12012-08-10 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * term/x-win.el (x-menu-bar-open): Always pass last-nonmenu-event.
4 * subr.el (eventp): `nil' is not an event, and eventp is not hot.
5 (event-start, event-end): Use posn-at-point to return a more
6 informative posn.
7 (posnp): New function.
8 * mouse.el (popup-menu-normalize-position): Use it.
9
12012-08-10 Masatake YAMATO <yamato@redhat.com> 102012-08-10 Masatake YAMATO <yamato@redhat.com>
2 11
3 * mouse.el (popup-menu-normalize-position): New function. 12 * mouse.el (popup-menu-normalize-position): New function.
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 1506c3f5a84..589bbd67b1b 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1,4 +1,4 @@
1;;; mouse.el --- window system-independent mouse support 1;;; mouse.el --- window system-independent mouse support -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1993-1995, 1999-2012 Free Software Foundation, Inc. 3;; Copyright (C) 1993-1995, 1999-2012 Free Software Foundation, Inc.
4 4
@@ -151,35 +151,24 @@ PREFIX is the prefix argument (if any) to pass to the command."
151 (call-interactively cmd)))) 151 (call-interactively cmd))))
152 152
153(defun popup-menu-normalize-position (position) 153(defun popup-menu-normalize-position (position)
154 "Converts the POSITION to the form which `popup-menu' expects internally. 154 "Convert the POSITION to the form which `popup-menu' expects internally.
155POSITION can be nil, an click event, a posn- value, or a value having 155POSITION can an event, a posn- value, a value having
156form ((XOFFSET YOFFSET) WINDOW). 156form ((XOFFSET YOFFSET) WINDOW), or nil.
157If nil, the current mouse position is used. 157If nil, the current mouse position is used."
158If an click event, the value returend from `event-end' is used."
159 (pcase position 158 (pcase position
160 ;; nil -> mouse cursor position 159 ;; nil -> mouse cursor position
161 ;; this pattern must be before `eventp' because
162 ;; nil is an event.
163 (`nil 160 (`nil
164 (let ((mp (mouse-pixel-position))) 161 (let ((mp (mouse-pixel-position)))
165 (list (list (cadr mp) (cddr mp)) (car mp)))) 162 (list (list (cadr mp) (cddr mp)) (car mp))))
166 ;; value returned from (event-end (read-event)) or (posn-at-point) 163 ;; Value returned from `event-end' or `posn-at-point'.
167 ((or `(,window ,area-or-pos (,x . ,y) 164 ((pred posnp)
168 ,timestamp ,object ,pos (,col . ,row)
169 ,image (,dx . ,dy) (,width . ,height))
170 `(,window ,pos (0 . 0) 0))
171 (let ((xy (posn-x-y position))) 165 (let ((xy (posn-x-y position)))
172 (list (list (car xy) (cdr xy)) 166 (list (list (car xy) (cdr xy))
173 (posn-window position)))) 167 (posn-window position))))
174 ;; pattern expected by popup-menu 168 ;; Event.
175 (`((,xoffset ,yoffset) ,window)
176 position)
177 ;; event
178 ((pred eventp) 169 ((pred eventp)
179 (popup-menu-normalize-position (event-end position))) 170 (popup-menu-normalize-position (event-end position)))
180 ;; rejects 171 (t position)))
181 (t
182 (error "Unexpected position form"))))
183 172
184(defun minor-mode-menu-from-indicator (indicator) 173(defun minor-mode-menu-from-indicator (indicator)
185 "Show menu for minor mode specified by INDICATOR. 174 "Show menu for minor mode specified by INDICATOR.
diff --git a/lisp/subr.el b/lisp/subr.el
index 73bc1d99e05..860d1b2a108 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -907,11 +907,12 @@ The normal global definition of the character C-x indirects to this keymap.")
907 c))) 907 c)))
908 key))) 908 key)))
909 909
910(defsubst eventp (obj) 910(defun eventp (obj)
911 "True if the argument is an event object." 911 "True if the argument is an event object."
912 (or (integerp obj) 912 (when obj
913 (and (symbolp obj) obj (not (keywordp obj))) 913 (or (integerp obj)
914 (and (consp obj) (symbolp (car obj))))) 914 (and (symbolp obj) obj (not (keywordp obj)))
915 (and (consp obj) (symbolp (car obj))))))
915 916
916(defun event-modifiers (event) 917(defun event-modifiers (event)
917 "Return a list of symbols representing the modifier keys in event EVENT. 918 "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."
975 ;; is this really correct? maybe remove mouse-movement? 976 ;; is this really correct? maybe remove mouse-movement?
976 (memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement))) 977 (memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement)))
977 978
978(defsubst event-start (event) 979(defun event-start (event)
979 "Return the starting position of EVENT. 980 "Return the starting position of EVENT.
980EVENT should be a click, drag, or key press event. 981EVENT should be a click, drag, or key press event.
981If it is a key press event, the return value has the form 982If 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
990position of the event. If EVENT is a drag, this is the starting 991position of the event. If EVENT is a drag, this is the starting
991position of the drag." 992position of the drag."
992 (if (consp event) (nth 1 event) 993 (if (consp event) (nth 1 event)
993 (list (selected-window) (point) '(0 . 0) 0))) 994 (or (posn-at-point)
995 (list (selected-window) (point) '(0 . 0) 0))))
994 996
995(defsubst event-end (event) 997(defun event-end (event)
996 "Return the ending location of EVENT. 998 "Return the ending location of EVENT.
997EVENT should be a click, drag, or key press event. 999EVENT should be a click, drag, or key press event.
998If EVENT is a key press event, the return value has the form 1000If 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
1009position of the event. If EVENT is a drag, this is the starting 1011position of the event. If EVENT is a drag, this is the starting
1010position of the drag." 1012position of the drag."
1011 (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event) 1013 (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
1012 (list (selected-window) (point) '(0 . 0) 0))) 1014 (or (posn-at-point)
1015 (list (selected-window) (point) '(0 . 0) 0))))
1013 1016
1014(defsubst event-click-count (event) 1017(defsubst event-click-count (event)
1015 "Return the multi-click count of EVENT, a click or drag event. 1018 "Return the multi-click count of EVENT, a click or drag event.
@@ -1018,6 +1021,13 @@ The return value is a positive integer."
1018 1021
1019;;;; Extracting fields of the positions in an event. 1022;;;; Extracting fields of the positions in an event.
1020 1023
1024(defun posnp (obj)
1025 "Return non-nil if OBJ appears to be a valid `posn' object."
1026 (and (windowp (car-safe obj))
1027 (atom (car-safe (setq obj (cdr obj)))) ;AREA-OR-POS.
1028 (integerp (car-safe (car-safe (setq obj (cdr obj))))) ;XOFFSET.
1029 (integerp (car-safe (cdr obj))))) ;TIMESTAMP.
1030
1021(defsubst posn-window (position) 1031(defsubst posn-window (position)
1022 "Return the window in POSITION. 1032 "Return the window in POSITION.
1023POSITION should be a list of the form returned by the `event-start' 1033POSITION should be a list of the form returned by the `event-start'
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 3f58614eb64..9b7254cd132 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -1306,17 +1306,14 @@ Request data types in the order specified by `x-select-request-type'."
1306 1306
1307(defun x-menu-bar-open (&optional frame) 1307(defun x-menu-bar-open (&optional frame)
1308 "Open the menu bar if it is shown. 1308 "Open the menu bar if it is shown.
1309`popup-menu' is used if it is off " 1309`popup-menu' is used if it is off."
1310 (interactive "i") 1310 (interactive "i")
1311 (cond 1311 (cond
1312 ((and (not (zerop (or (frame-parameter nil 'menu-bar-lines) 0))) 1312 ((and (not (zerop (or (frame-parameter nil 'menu-bar-lines) 0)))
1313 (fboundp 'accelerate-menu)) 1313 (fboundp 'accelerate-menu))
1314 (accelerate-menu frame)) 1314 (accelerate-menu frame))
1315 (t 1315 (t
1316 (popup-menu (mouse-menu-bar-map) 1316 (popup-menu (mouse-menu-bar-map) last-nonmenu-event))))
1317 (if (listp last-nonmenu-event)
1318 nil
1319 (posn-at-point))))))
1320 1317
1321 1318
1322;;; Window system initialization. 1319;;; Window system initialization.