Mercurial > hg > xemacs-beta

comparison lisp/mouse.el @ 2504:e17beacca645

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-01-26 04:47:13 by ben] Redo mouse activation mouse.el: Redo mouse-track activation to separate out a "conservative" activation that is only triggered by button2 or button1 double-click and a regular activation also triggered by button1.
author ben
date Wed, 26 Jan 2005 04:47:14 +0000
parents e38acbeb1cae
children fd1acd2f457a
comparison
equal deleted inserted replaced
2503:9db2c524b815 2504:e17beacca645
1 ;;; mouse.el --- window system-independent mouse support. 1 ;;; mouse.el --- window system-independent mouse support.
2 2
3 ;; Copyright (C) 1988, 1992-4, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1988, 1992-4, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Tinker Systems 4 ;; Copyright (C) 1995 Tinker Systems
5 ;; Copyright (C) 1995, 1996, 2000, 2002 Ben Wing. 5 ;; Copyright (C) 1995, 1996, 2000, 2002, 2004, 2005 Ben Wing.
6 6
7 ;; Maintainer: XEmacs Development Team 7 ;; Maintainer: XEmacs Development Team
8 ;; Keywords: mouse, dumped 8 ;; Keywords: mouse, dumped
9 9
10 ;; This file is part of XEmacs. 10 ;; This file is part of XEmacs.
505 505
506 A value of nil disables the timeout feature." 506 A value of nil disables the timeout feature."
507 :type '(choice integer (const :tag "Disabled" nil)) 507 :type '(choice integer (const :tag "Disabled" nil))
508 :group 'mouse) 508 :group 'mouse)
509 509
510 (defcustom mouse-track-activate-strokes '(button1-double-click button2-click) 510 (defcustom mouse-track-activate-strokes '(button1-click button1-double-click
511 "List of mouse strokes that can cause \"activation\" of the text extent 511 button2-click)
512 under the mouse. The exact meaning of \"activation\" is dependent on the 512 "Mouse strokes causing \"activation\" of the text extent under the mouse.
513 text clicked on and the mode of the buffer, but typically entails actions 513 The exact meaning of \"activation\" is dependent on the text clicked on and
514 such as following a hyperlink or selecting an entry in a completion buffer. 514 the mode of the buffer, but typically entails actions such as following a
515 hyperlink or selecting an entry in a completion buffer.
516
517 See also `mouse-track-conservative-activate-strokes'.
515 518
516 Possible list entries are 519 Possible list entries are
517 520
518 button1-click 521 button1-click
519 button1-double-click 522 button1-double-click
535 button2-double-click 538 button2-double-click
536 button2-triple-click 539 button2-triple-click
537 button2-down) 540 button2-down)
538 :group 'mouse) 541 :group 'mouse)
539 542
543 (defcustom mouse-track-conservative-activate-strokes
544 '(button1-double-click button2-click)
545 "Mouse strokes causing \"conservative activation\" of text extent under mouse.
546 The exact meaning of \"activation\" is dependent on the text clicked on and
547 the mode of the buffer, but typically entails actions such as following a
548 hyperlink or selecting an entry in a completion buffer.
549
550 \"Conservative activation\" differs from regular activation in that it is
551 not meant to be triggered by a button1 click, and thus is suitable for larger
552 regions of text where the user might want to position the cursor inside of
553 the region.
554
555 See also `mouse-track-activate-strokes'.
556
557 Possible list entries are
558
559 button1-click
560 button1-double-click
561 button1-triple-click
562 button1-down
563 button2-click
564 button2-double-click
565 button2-triple-click
566 button2-down
567
568 As a general rule, you should not use the \"-down\" values, because this
569 makes it impossible to have other simultaneous actions, such as selection."
570 :type '(set
571 button1-click
572 button1-double-click
573 button1-triple-click
574 button1-down
575 button2-click
576 button2-double-click
577 button2-triple-click
578 button2-down)
579 :group 'mouse)
580
540 (defvar mouse-track-x-threshold '(face-width 'default) 581 (defvar mouse-track-x-threshold '(face-width 'default)
541 "Minimum number of pixels in the X direction for a drag to be initiated. 582 "Minimum number of pixels in the X direction for a drag to be initiated.
542 If the mouse is moved more than either the X or Y threshold while the 583 If the mouse is moved more than either the X or Y threshold while the
543 button is held down (see also `mouse-track-y-threshold'), then a drag 584 button is held down (see also `mouse-track-y-threshold'), then a drag
544 is initiated; otherwise the gesture is considered to be a click. 585 is initiated; otherwise the gesture is considered to be a click.
570 (if mouse-track-scroll-delay 611 (if mouse-track-scroll-delay
571 (setq mouse-track-timeout-id 612 (setq mouse-track-timeout-id
572 (add-timeout (/ mouse-track-scroll-delay 1000.0) 613 (add-timeout (/ mouse-track-scroll-delay 1000.0)
573 'mouse-track-scroll-undefined 614 'mouse-track-scroll-undefined
574 (copy-event event))))) 615 (copy-event event)))))
575
576 (defun mouse-track-do-activate (event)
577 "Execute the activate function under EVENT, if any.
578 Return true if the function was activated."
579 (let ((ex (extent-at-event event 'activate-function)))
580 (when ex
581 (funcall (extent-property ex 'activate-function)
582 event ex)
583 t)))
584 616
585 (defvar Mouse-track-gensym (gensym)) 617 (defvar Mouse-track-gensym (gensym))
586 618
587 (defun mouse-track-run-hook (hook override event &rest args) 619 (defun mouse-track-run-hook (hook override event &rest args)
588 ;; ugh, can't use run-hook-with-args-until-success because we have 620 ;; ugh, can't use run-hook-with-args-until-success because we have
1208 (memq (cdr 1240 (memq (cdr
1209 (assq n '((1 . button1) (2 . button2) (3 . button3) 1241 (assq n '((1 . button1) (2 . button2) (3 . button3)
1210 (4 . button4) (5 . button5)))) 1242 (4 . button4) (5 . button5))))
1211 (event-modifiers event))))) 1243 (event-modifiers event)))))
1212 1244
1245 ;; return t if an activation function was called. This checks to see
1246 ;; if the appropriate stroke for the click count and the button that
1247 ;; was pressed is present in `mouse-track-activate-strokes'; if so, it
1248 ;; looks for an extent under the mouse with an `activate-function'
1249 ;; property, calls it and returns t. Else, it repeats the whole
1250 ;; process with `mouse-track-conservative-activate-strokes' and
1251 ;; `conservative-activate-function'.
1252 (defun default-mouse-track-check-for-activation (event click-count
1253 count-list button-list)
1254 (flet ((do-activate (event property)
1255 (let ((ex (extent-at-event event property)))
1256 (when ex
1257 (funcall (extent-property ex property) event ex)
1258 t))))
1259 (or
1260 (and (some #'(lambda (count button)
1261 (and (= click-count count)
1262 (memq button
1263 mouse-track-activate-strokes)))
1264 count-list button-list)
1265 (do-activate event 'activate-function))
1266 (and (some #'(lambda (count button)
1267 (and (= click-count count)
1268 (memq button
1269 mouse-track-conservative-activate-strokes)))
1270 count-list button-list)
1271 (do-activate event 'conservative-activate-function)))))
1272
1213 (defun default-mouse-track-down-hook (event click-count) 1273 (defun default-mouse-track-down-hook (event click-count)
1214 (cond ((default-mouse-track-event-is-with-button event 1) 1274 (cond ((default-mouse-track-event-is-with-button event 1)
1215 (if (and (memq 'button1-down mouse-track-activate-strokes) 1275 (if (default-mouse-track-check-for-activation
1216 (mouse-track-do-activate event)) 1276 event 1 '(1) '(button1-down))
1217 t 1277 t
1218 (setq default-mouse-track-down-event (copy-event event)) 1278 (setq default-mouse-track-down-event (copy-event event))
1219 nil)) 1279 nil))
1220 ((default-mouse-track-event-is-with-button event 2) 1280 ((default-mouse-track-event-is-with-button event 2)
1221 (and (memq 'button2-down mouse-track-activate-strokes) 1281 (default-mouse-track-check-for-activation
1222 (mouse-track-do-activate event))))) 1282 event 1 '(1) '(button2-down)))))
1283
1284 (defun default-mouse-track-click-hook (event click-count)
1285 (cond ((default-mouse-track-event-is-with-button event 1)
1286 (if (default-mouse-track-check-for-activation
1287 event click-count '(1 2 3) '(button1-click button1-double-click
1288 button1-triple-click))
1289 t
1290 (default-mouse-track-drag-hook event click-count nil)
1291 (default-mouse-track-drag-up-hook event click-count)
1292 t))
1293 ((default-mouse-track-event-is-with-button event 2)
1294 (if (default-mouse-track-check-for-activation
1295 event click-count '(1 2 3) '(button2-click button2-double-click
1296 button2-triple-click))
1297 t
1298 (mouse-yank event)
1299 t))))
1223 1300
1224 (defun default-mouse-track-cleanup-extents-hook () 1301 (defun default-mouse-track-cleanup-extents-hook ()
1225 (remove-hook 'pre-command-hook 'default-mouse-track-cleanup-extents-hook) 1302 (remove-hook 'pre-command-hook 'default-mouse-track-cleanup-extents-hook)
1226 (let ((extent default-mouse-track-extent)) 1303 (let ((extent default-mouse-track-extent))
1227 (if (consp extent) ; rectangle-p 1304 (if (consp extent) ; rectangle-p
1327 (let ((result (default-mouse-track-return-dragged-selection event))) 1404 (let ((result (default-mouse-track-return-dragged-selection event)))
1328 (if result 1405 (if result
1329 (default-mouse-track-maybe-own-selection result 'PRIMARY))) 1406 (default-mouse-track-maybe-own-selection result 'PRIMARY)))
1330 t)) 1407 t))
1331 1408
1332 (defun default-mouse-track-click-hook (event click-count)
1333 (cond ((default-mouse-track-event-is-with-button event 1)
1334 (if (and
1335 (or (and (= click-count 1)
1336 (memq 'button1-click
1337 mouse-track-activate-strokes))
1338 (and (= click-count 2)
1339 (memq 'button1-double-click
1340 mouse-track-activate-strokes))
1341 (and (= click-count 3)
1342 (memq 'button1-triple-click
1343 mouse-track-activate-strokes)))
1344 (mouse-track-do-activate event))
1345 t
1346 (default-mouse-track-drag-hook event click-count nil)
1347 (default-mouse-track-drag-up-hook event click-count)
1348 t))
1349 ((default-mouse-track-event-is-with-button event 2)
1350 (if (and
1351 (or (and (= click-count 1)
1352 (memq 'button2-click
1353 mouse-track-activate-strokes))
1354 (and (= click-count 2)
1355 (memq 'button2-double-click
1356 mouse-track-activate-strokes))
1357 (and (= click-count 3)
1358 (memq 'button2-triple-click
1359 mouse-track-activate-strokes)))
1360 (mouse-track-do-activate event))
1361 t
1362 (mouse-yank event)
1363 t))))
1364
1365
1366 (add-hook 'mouse-track-down-hook 'default-mouse-track-down-hook) 1409 (add-hook 'mouse-track-down-hook 'default-mouse-track-down-hook)
1410 (add-hook 'mouse-track-click-hook 'default-mouse-track-click-hook)
1367 (add-hook 'mouse-track-drag-hook 'default-mouse-track-drag-hook) 1411 (add-hook 'mouse-track-drag-hook 'default-mouse-track-drag-hook)
1368 (add-hook 'mouse-track-drag-up-hook 'default-mouse-track-drag-up-hook) 1412 (add-hook 'mouse-track-drag-up-hook 'default-mouse-track-drag-up-hook)
1369 (add-hook 'mouse-track-click-hook 'default-mouse-track-click-hook)
1370 (add-hook 'mouse-track-cleanup-hook 'default-mouse-track-cleanup-hook) 1413 (add-hook 'mouse-track-cleanup-hook 'default-mouse-track-cleanup-hook)
1371 1414
1372 1415
1373 ;;;;;;;;;;;; other mouse-track stuff (mostly associated with the 1416 ;;;;;;;;;;;; other mouse-track stuff (mostly associated with the
1374 ;;;;;;;;;;;; default handlers) 1417 ;;;;;;;;;;;; default handlers)