X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6eabc4c2f76441f11cc344891d3849ad3631ab15..d1d6801eb4badab97416d0b6294e1920d0f90c3e:/lisp/emulation/viper-mous.el diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index 59a83a076b..9bea921e16 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -1,16 +1,17 @@ ;;; viper-mous.el --- mouse support for Viper ;; Copyright (C) 1994, 1995, 1996, 1997, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer +;; Package: viper ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -18,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -41,12 +40,8 @@ ;; in order to spare non-viperized emacs from being viperized (if noninteractive (eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (or (featurep 'viper-util) - (load "viper-util.el" nil nil 'nosuffix)) - (or (featurep 'viper-cmd) - (load "viper-cmd.el" nil nil 'nosuffix)) - ))) + (require 'viper-cmd) + )) ;; end pacifier (require 'viper-util) @@ -79,7 +74,7 @@ or a tripple-click." ;; time interval in millisecond within which successive clicks are ;; considered related (defcustom viper-multiclick-timeout (if (viper-window-display-p) - (if viper-xemacs-p + (if (featurep 'xemacs) mouse-track-multi-click-time double-click-time) 500) @@ -122,10 +117,8 @@ considered related." ;; Returns window where click occurs (defun viper-mouse-click-window (click) - (let ((win (viper-cond-compile-for-xemacs-or-emacs - (event-window click) ; xemacs - (posn-window (event-start click)) ; emacs - ))) + (let ((win (if (featurep 'xemacs) (event-window click) + (posn-window (event-start click))))) (if (window-live-p win) win (error "Click was not over a live window")))) @@ -144,10 +137,8 @@ considered related." ;; Returns position of a click (defsubst viper-mouse-click-posn (click) - (viper-cond-compile-for-xemacs-or-emacs - (event-point click) ; xemacs - (posn-point (event-start click)) ; emacs - )) + (if (featurep 'xemacs) (event-point click) + (posn-point (event-start click)))) (defun viper-surrounding-word (count click-count) @@ -227,7 +218,7 @@ is ignored." ) ; if ;; XEmacs doesn't have set-text-properties, but there buffer-substring ;; doesn't return properties together with the string, so it's not needed. - (if viper-emacs-p + (if (featurep 'emacs) (set-text-properties 0 (length result) nil result)) result )) @@ -273,7 +264,7 @@ See `viper-surrounding-word' for the definition of a word in this case." 'viper-mouse-catch-frame-switch)) (not (eq (key-binding viper-mouse-up-insert-key-parsed) 'viper-mouse-click-insert-word)) - (and viper-xemacs-p (not (event-over-text-area-p click))))) + (and (featurep 'xemacs) (not (event-over-text-area-p click))))) () ; do nothing, if binding isn't right or not over text ;; turn arg into a number (cond ((integerp arg) nil) @@ -320,33 +311,30 @@ See `viper-surrounding-word' for the definition of a word in this case." ;; XEmacs has no double-click events. So, we must simulate. ;; So, we have to simulate event-click-count. (defun viper-event-click-count (click) - (viper-cond-compile-for-xemacs-or-emacs - (viper-event-click-count-xemacs click) ; xemacs - (event-click-count click) ; emacs - )) - -;; kind of semaphore for updating viper-current-click-count -(defvar viper-counting-clicks-p nil) -(viper-cond-compile-for-xemacs-or-emacs - (defun viper-event-click-count-xemacs (click) - (let ((time-delta (- (event-timestamp click) - viper-last-click-event-timestamp)) - inhibit-quit) - (while viper-counting-clicks-p - (ignore)) - (setq viper-counting-clicks-p t) - (if (> time-delta viper-multiclick-timeout) - (setq viper-current-click-count 0)) - (discard-input) - (setq viper-current-click-count (1+ viper-current-click-count) - viper-last-click-event-timestamp (event-timestamp click)) - (setq viper-counting-clicks-p nil) - (if (viper-sit-for-short viper-multiclick-timeout t) - viper-current-click-count - 0) - )) - nil ; emacs - ) + (if (featurep 'xemacs) (viper-event-click-count-xemacs click) + (event-click-count click))) + +(when (featurep 'xemacs) + + ;; kind of semaphore for updating viper-current-click-count + (defvar viper-counting-clicks-p nil) + + (defun viper-event-click-count-xemacs (click) + (let ((time-delta (- (event-timestamp click) + viper-last-click-event-timestamp)) + inhibit-quit) + (while viper-counting-clicks-p + (ignore)) + (setq viper-counting-clicks-p t) + (if (> time-delta viper-multiclick-timeout) + (setq viper-current-click-count 0)) + (discard-input) + (setq viper-current-click-count (1+ viper-current-click-count) + viper-last-click-event-timestamp (event-timestamp click)) + (setq viper-counting-clicks-p nil) + (if (viper-sit-for-short viper-multiclick-timeout t) + viper-current-click-count + 0)))) (defun viper-mouse-click-search-word (click arg) @@ -364,7 +352,7 @@ this command." 'viper-mouse-catch-frame-switch)) (not (eq (key-binding viper-mouse-up-search-key-parsed) 'viper-mouse-click-search-word)) - (and viper-xemacs-p (not (event-over-text-area-p click))))) + (and (featurep 'xemacs) (not (event-over-text-area-p click))))) () ; do nothing, if binding isn't right or not over text (let ((previous-search-string viper-s-string) click-word click-count) @@ -507,19 +495,19 @@ bindings in the Viper manual." () (setq button-spec (cond ((memq 1 key) - (if viper-emacs-p + (if (featurep 'emacs) (if (eq 'up event-type) "mouse-1" "down-mouse-1") (if (eq 'up event-type) 'button1up 'button1))) ((memq 2 key) - (if viper-emacs-p + (if (featurep 'emacs) (if (eq 'up event-type) "mouse-2" "down-mouse-2") (if (eq 'up event-type) 'button2up 'button2))) ((memq 3 key) - (if viper-emacs-p + (if (featurep 'emacs) (if (eq 'up event-type) "mouse-3" "down-mouse-3") (if (eq 'up event-type) @@ -528,18 +516,18 @@ bindings in the Viper manual." "%S: invalid button number, %S" key-var key))) meta-spec (if (memq 'meta key) - (if viper-emacs-p "M-" 'meta) - (if viper-emacs-p "" nil)) + (if (featurep 'emacs) "M-" 'meta) + (if (featurep 'emacs) "" nil)) shift-spec (if (memq 'shift key) - (if viper-emacs-p "S-" 'shift) - (if viper-emacs-p "" nil)) + (if (featurep 'emacs) "S-" 'shift) + (if (featurep 'emacs) "" nil)) control-spec (if (memq 'control key) - (if viper-emacs-p "C-" 'control) - (if viper-emacs-p "" nil))) + (if (featurep 'emacs) "C-" 'control) + (if (featurep 'emacs) "" nil))) - (setq key-spec (if viper-emacs-p + (setq key-spec (if (featurep 'emacs) (vector (intern (concat @@ -670,10 +658,10 @@ This buffer may be different from the one where the click occurred." -;;; Local Variables: -;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) -;;; End: +;; Local Variables: +;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) +;; End: -;;; arch-tag: e56b2390-06c4-4dd1-96f5-c7876e2d8c2f +;; arch-tag: e56b2390-06c4-4dd1-96f5-c7876e2d8c2f ;;; viper-mous.el ends here