--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/packages/mode-motion+.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,2214 @@
+;;   -*- Syntax: Emacs-Lisp; Mode: emacs-lisp -*-
+;;
+;; Per mode and per buffer mouse tracking with highlighting
+;;
+;; Copyright (C) 1992, 1993 by Guido Bosch <Guido.Bosch@loria.fr>
+
+;; This file is written in GNU Emacs Lisp, It is a part of XEmacs.
+
+;; The software contained in this file 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.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;;; Synched up with: Not in FSF.
+
+;; Please send bugs and comments to Russell.Ritchie@gssec.bt.co.uk or
+;;                                  tlp00@spg.amdahl.com.
+;;
+;; <DISCLAIMER>
+;; This program is still under development.  Neither the author nor any
+;; of the maintainers accepts responsibility to anyone for the consequences of
+;; using it or for whether it serves any particular purpose or works
+;; at all.
+
+; Change History
+; Revision 3.15 Thu Feb 15 14:26:34 GMT 1996 Russell.Ritchie@gssec.bt.co.uk
+; lisp-interaction-popup-menu => lisp-interaction-mode-popup-menu,
+; emacs-lisp-popup-menu => emacs-lisp-mode-popup-menu.
+
+; Revision 3.14 Tue Nov 14 11:14:38 GMT 1995 Russell.Ritchie@gssec.bt.co.uk
+; Made nil the default value for mode-motion-focus-on-window.  Too many people
+; hate it when the cursor warps into Dired and GNUS buffers because some
+; window managers auto-raise the window with keyboard focus with predictably
+; nauseous results.
+
+; Revision 3.13 Thu Sep 14 10:30:04 1995 Russell.Ritchie@gssec.bt.co.uk
+; Fix the `spontaneous scrolling' problem (at last).  It's funny how
+; easy things are once you actually understand the issues involved.
+; As ever, what we sought was the right question...
+
+; Revision 3.12 Wed Jul 12 11:30:43 1995 Russell.Ritchie@gssec.bt.co.uk
+; Track `don't highlight non-file lines in dired buffers' functionality (in a
+; pretty tasteless manner if I say so myself :-)).
+
+; Revision 3.11 Fri Jul  7 16:26:56 1995 Russell.Ritchie@gssec.bt.co.uk
+; Minor extent detaching bug fix.
+
+; Revision 3.10 Thu Jun 15 11:36:56 1995 Russell.Ritchie@gssec.bt.co.uk
+; Quiet, faster, non-interactive initialistion, mild list-motion-handlers
+; chrome and minor formatting clean-ups.
+
+; Revision 3.9 Thu Jun 15 11:36:56 1995 Russell.Ritchie@gssec.bt.co.uk
+; Fixed the `mouse-motion whilst reading filename in minibuffer auto-ftp' bug.
+
+; Revision 3.8 Thus Mar 23 1995 tlp00@spg.amdahl.com
+; added in menu controls from paquette@atomas.crim.ca
+; re-added minibuffer support (from 3.5)
+;
+; Revision 3.7 Tue Feb 21 11:06:38 1995 Russell.Ritchie@gssec.bt.co.uk
+; Extended mode-motion+-religion and made the defaulting frame-buffer aware.
+; Reworked and added new mode-motion-handlers.
+; Doc string clean up.
+; Fixed unintentional frame/screen reversion.
+
+; Revision 3.6 Mon Feb 20 11:46:32 1995 Russell.Ritchie@gssec.bt.co.uk
+; Made mouse tracking use mode-motion-hook for better integration with
+; the default mouse-motion system (help-echo and friends now work).
+
+; Revision 3.5 1995/02/16 13:40:00 tlp00@spg.amdahl.com
+; fixed sporatic scroll bug
+; added M-button2 binding for mode-motion-copy
+;
+; Revision 3.4 1995/02/14 14:30:15 Russell.Ritchie@gssec.bt.co.uk
+; Small code cleanups: let* -> let, duplicate defvars.
+; Chromed list-motion-handlers a little.
+; Added variable mode-motion+-religion for easy choice twixt underline & bold.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;tlp00 changes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; tlp00@spg.amdahl.com 2/11/93
+; modified mode-motion-track-pointer to move cursor cross windows
+;          renamed mode-motion-delete to mode-motion-kill to follow kill
+;            convention
+;          mode-motion-highlight-with-handler to put cursor at beginning of line 
+;            follow operations.
+;          mode-motion-copy/delete and mode-motion-kill to position cursor at 
+;            delete point start.  Also set this-command to avoid appends
+; set mode-motion-extent priority to 1, so it will override font-lock
+; changed default handlers for buffer-mode, c-mode, dired-mode, added occur 
+;   and compilation mode.
+; fixed bug in minibuffer-selection-boundaries where C-g was leaving the wrong
+;   syntax table.
+; added support for pending-delete.
+; adds the copy/delete motion-extent to the clipboard even if kill-hooks is nil.
+;
+; Revision 3.3 1995/02/13 tlp00@spg.amdahl.com
+; merged Russell.Ritchie@gssec.bt.co.uk versions with molli/bosch versions
+; renamed versioning 3.0+ for molli/bosch versions.  
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Russell Ritchie changes;;;;;;;;;;;;;;;;;;;;;;;;
+; !Log: mode-motion+.el,v !
+; Revision 2.14.R  1994/09/09  10:19:18  rieke@darmstadt.gmd.de
+; Merged in my changes to support motion-gray. This needs a file
+; named "gray1.xbm" in your data-directory (etc) like the following.
+; -------------------------------snip--------------------------
+; #define bg2_width 16
+; #define bg2_height 16
+; static char bg2_bits[] = {
+;   0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00,
+;   0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00,
+;   0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00};
+; -------------------------------snip--------------------------
+; This one looks good on SUN 19'' screens with 10x20 font, 
+; black foreground and khaki background. 
+; To use the gray-handlers instead of the underline-handlers
+; include the following into your .emacs:
+; (set-mode-motion-handler 'emacs-lisp-mode 'gray-thing)
+; (set-mode-motion-handler 'lisp-interaction-mode 'gray-thing)
+; (set-mode-motion-handler 'c++-mode 'gray-c)
+; (set-mode-motion-handler 'c-mode 'gray-c)
+; (set-mode-motion-handler 'tcl-mode 'gray-tcl)
+; (set-mode-motion-handler 'dired-mode 'gray-line@)
+; (set-mode-motion-handler 'gnus-group-mode 'gray-vline@)
+; (set-mode-motion-handler 'gnus-summary-mode 'gray-vline@)
+; (set-mode-motion-handler 'texinfo-mode 'gray-Texinfo)
+; (setq default-motion-handler (find-motion-handler 'gray-thing))
+;
+;
+; Revision 2.13.R  1994/08/08  19:47:34  Russell.Ritchie@gssec.bt.co.uk
+; Made default handler be underline-thing, as most bold fonts seem to
+; be greater in height than their corresponding normal versions,
+; causing irritating screen flicker.
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Molli/bosch changes;;;;;;;;;;;;;;;;;;;;;;;;
+;
+; Revision 3.2  1994/09/28  15:14:29  molli
+; add   "(set-mode-motion-handler 'latex-mode   'raise-LaTeX)".    Barry
+; Waraw's C/C++ mode is now changed to cc-mode ...
+;
+; Revision 3.1  1994/09/28  15:10:36  molli
+; Initial revision
+;
+; Revision 2.15  1993/11/18  08:13:28  bosch
+; Constant `mode-motion+-version' added.
+; Minor bug fix in `tcl-forward-sexp1'.
+;
+; Revision 2.14  1993/10/29  20:04:59  bosch
+; Minibuffer name matching improved.  Made `tcl-boundaries' smarter by
+; use of new function `tcl-forward-sexp1'. `tcl-commands' list updated
+; -- should be complete now.  A message is printed if the syntax scanner
+; matched or failed for known tcl/tk commands.  Seperated `tcl-commands'
+; from `tk-commands' -- `tk-commands' not yet complete.  New motion
+; handler `raise-LaTeX' added, for tex-mode.
+;
+; Revision 2.13  1993/10/08  09:43:00  bosch
+; New user option `mode-motion-setup-cut-and-paste-bindings'.  Function
+; `mode-motion-copy/delete' now takes into account the primary and the
+; motion selection.
+;
+; Revision 2.12  1993/10/08  09:08:46  bosch
+; Avoid highlighting empty lines, even if
+; `mode-motion-highlight-lines-when-behind' is non-nil.
+
+; Revision 2.12  1994/07/07  18:33:38  Russell.Ritchie@gssec.bt.co.uk
+; Made list-motion-handlers and mode-motion-set-handler work in lemacs-19.10.
+; 
+; Revision 2.11  1993/09/20  08:29:15  bosch
+; Code reorganized: variables declared before used.
+; Compatibility hack patched again.
+;
+; Revision 2.10  1993/09/17  18:50:33  bosch
+; Bug in the compatibility hack fixed. Call to `make-cursor' replaced by
+; `x-pointer-cache'. Compatibility hack for Lemacs 19.8 removed.  Tcl
+; motion handler improved (needs still some work).
+;
+; Revision 2.9  1993/09/15  17:52:53  bosch
+; Compatibility patch for Lucid Emacs 19.8. tcl motion handler added.
+;
+; Revision 2.8  1993/08/27  15:17:07  bosch
+; Select window conflict between motion handlers and process filters
+; resolved by using `enqueue-eval-event' for selecting a different
+; window (functions `mode-motion-track-pointer' and
+; `mode-motion-highlight-with-handler' modified). This fixes the nasty
+; bug that made GNUS hanging during NNTP activity while the mouse was
+; moved.
+;
+; Revision 2.7  1993/08/27  12:50:10  bosch
+; TeX and LaTeX motion handler generalized.  Motion handler
+; `highlight-Texinfo' added.
+;
+; Revision 2.6  1993/06/24  11:58:52  bosch
+; Mode motion+ support for pcl-cvs added. #undef syntax for C added.
+;
+; Revision 2.5  1993/06/09  12:04:31  bosch
+; Delivery motion handlers for `c++-c-mode', `gnus-group-mode', and
+; `gnus-summary-mode' added. Mode motion commands bound to copy/cut/past
+; keys for Sun keyboards (f16, f18, f20). Comment added.
+;
+; Revision 2.4  1993/02/15  12:59:47  bosch
+; Modifications sent by Tibor Polgar integrated:
+; Optional parameter added to `mode-motion-copy/delete'.  User option
+; `mode-motion-focus-on-window' added. It controls window selection for
+; the motion handlers. Minor changes of the delivery motion handlers.
+;
+; Revision 2.3  1993/02/04  18:10:09  bosch
+; User option `mode-motion-minibuffer-completion' added. It controls
+; the minibuffer completion highlighting.
+;
+; Revision 2.2  1993/01/27  13:08:12  bosch
+; Improved clearing of `sticky' mode-motion-extents when leaving screen
+; or buffer.  Function `mode-motion-clear-extent' added.
+; Highlight line mouse cursor is behind.
+; `mode-motion-highlight-with-handler' now takes an event as argument.
+; Cut and paste functions renamed and rewritten. Now they are called:
+; `mode-motion-move', `mode-motion-delete', `mode-motion-copy',
+; `mode-motion-copy-as-kill'.  Bug fixes in the C scanner stuff.
+; Motion handler `underline-c' added.
+;
+; Revision 2.1  1993/01/19  18:29:58  bosch
+; Scanner and motion handler for C syntax added.
+; Function `set-default-motion-handler' added.
+; Minor improvements on the `list-motion-handlers' interface done.
+; Minor bug fixes.
+;
+; Revision 2.0 1993/01/14   19:17:29  bosch
+; Lot of things rewritten and reorganized. This version fits in only
+; one file (beside the required package thing.el).
+;
+; New basic features are:
+;  - buffer, mode and default motion handlers
+;  - easy composition of own motion handlers
+;  - listing of motion handlers in tabular form
+;  - menu interface for changing motion handlers
+;  - only two  elisp files: mode-motion+.el, thing.el
+; 
+
+(require 'thing)
+(require 'mode-motion)
+(defconst mode-motion+-version "3.15")
+
+;;; This file defines a set of mouse motion handlers that do some
+;;; highlighting of the text when the mouse moves over.
+;;; An exhaustive list of the motion handlers defined in this file may be
+;;; obtained with M-x list-motion-handlers.
+;;; User Options and their Custommisation
+;;;
+;;; Mode-motion+ provides four user options, defined beyond. See their
+;;; documentation string to know what they are good for. If you want
+;;; to modify their default values, just setq them in your ~/.emacs.
+
+(defvar mode-motion+-religion nil ; Initialised in mode-motion-init.
+  "*Default highlight religion: one of bold, gray, highlight, invert or underline.
+
+Unless you setq this otherwise, it defaults to underline when
+(x-display-color-p) is non-nil and invert otherwise.
+Setting it to 'highlight should cause mode-motion+ extents to be
+indistinguishable from any other type of highlighted extent which may or may
+not be advisable, depending on your point of view.")
+
+(defvar mode-motion-highlight-lines-when-behind t
+  "*If non-nil highlight the whole line if the mouse is past the end.")
+
+(defvar mode-motion-focus-on-window nil
+  "*Controls whether moving the mouse into another window selects this window.
+The following values are possible:
+ 
+nil	  - Window selection isn't influenced at all by mode motion.
+
+t	  - Window selection always follows the mouse cursor. Copying motion
+            active regions doesn't work any longer between different buffers.
+	    
+any other - window selection follows the mouse cursor if the motion handler
+	    of the buffer under the mouse has the follow-point property set.
+	    Useful for selecting line mode buffers just by moving the mouse
+	    inside in order to execute commands there (VM summary,
+	    GNUS Group and Subject, DIRED, Buffer menu etc.)")
+
+(defvar mode-motion-setup-cut-and-paste-bindings t
+  "*If non-nil, bind commands to the Copy, Paste and Cut keys.")
+
+;;  Options sub-menu for mode-motion+
+(defvar mode-motion+-options-menu 
+  '("Motion Highlighting"
+    "For Current Buffer"
+    "---"
+    ["None"
+     (progn
+       (set-buffer-motion-handler (current-buffer) 'no-thing)
+       (mode-motion-clear-extent))
+     :style radio
+     :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
+		   'no)
+     :active (mode-motion+-active-p)]
+    ["Bold"
+     (progn
+       (modify-buffer-motion-handler (current-buffer) 'bold))
+     :style radio
+     :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
+		   'bold)
+     :active (mode-motion+-active-p)]
+    ["Underline"
+     (progn
+       (modify-buffer-motion-handler (current-buffer) 'underline))
+     :style radio
+     :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
+		   'underline)
+     :active (mode-motion+-active-p)]
+    ["Gray"
+     (progn
+       (modify-buffer-motion-handler (current-buffer) 'gray))
+     :style radio
+     :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
+		   'gray)
+     :active (mode-motion+-active-p)]
+    ["Highlight"
+     (progn
+       (modify-buffer-motion-handler (current-buffer) 'highlight))
+     :style radio
+     :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
+		   'highlight)
+     :active (mode-motion+-active-p)]
+    ["Invert"
+     (progn
+       (modify-buffer-motion-handler (current-buffer) 'invert))
+     :style radio
+     :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
+		   'invert)
+     :active (mode-motion+-active-p)]
+    "---"
+    "For Current Mode"
+    "---"
+    ["None"
+     (progn
+       (set-mode-motion-handler major-mode 'no-thing)
+       (mode-motion-clear-extent))
+     :style radio
+     :selected (eq (mode-motion+-mode-handler-religion major-mode) 'no)
+     :active (mode-motion+-active-p)]
+    ["Bold"
+     (progn
+       (modify-mode-motion-handler major-mode 'bold))
+     :style radio
+     :selected (eq (mode-motion+-mode-handler-religion major-mode) 'bold)
+     :active (mode-motion+-active-p)]
+    ["Underline"
+     (progn
+       (modify-mode-motion-handler major-mode 'underline))
+     :style radio
+     :selected (eq (mode-motion+-mode-handler-religion major-mode) 'underline)
+     :active (mode-motion+-active-p)]
+    ["Gray"
+     (progn
+       (modify-mode-motion-handler major-mode 'gray))
+     :style radio
+     :selected (eq (mode-motion+-mode-handler-religion major-mode) 'gray)
+     :active (mode-motion+-active-p)]
+    ["Highlight"
+     (progn
+       (modify-mode-motion-handler major-mode 'highlight))
+     :style radio
+     :selected (eq (mode-motion+-mode-handler-religion major-mode) 'highlight)
+     :active (mode-motion+-active-p)]
+    ["Invert"
+     (progn
+       (modify-mode-motion-handler major-mode 'invert))
+     :style radio
+     :selected (eq (mode-motion+-mode-handler-religion major-mode) 'invert)
+     :active (mode-motion+-active-p)]
+    "---"
+    "For All"
+    "---"
+    ["None"
+     (progn
+       (setq mode-motion+-religion 'no)
+       (mode-motion-init-handlers-according-to-religion 'force)
+       (mode-motion-clear-extent))
+     :style radio
+     :selected (eq mode-motion+-religion 'no)
+     :active (mode-motion+-active-p)]
+    ["Bold"
+     (progn
+       (setq mode-motion+-religion 'bold)
+       (mode-motion-init-handlers-according-to-religion 'force))
+     :style radio
+     :selected (eq mode-motion+-religion 'bold)
+     :active (mode-motion+-active-p)]
+    ["Underline"
+     (progn
+       (setq mode-motion+-religion 'underline)
+       (mode-motion-init-handlers-according-to-religion 'force))
+     :style radio
+     :selected (eq mode-motion+-religion 'underline)
+     :active (mode-motion+-active-p)]
+    ["Gray"
+     (progn
+       (setq mode-motion+-religion 'gray)
+       (mode-motion-init-handlers-according-to-religion 'force))
+     :style radio
+     :selected (eq mode-motion+-religion 'gray)
+     :active (mode-motion+-active-p)]
+    ["Highlight"
+     (progn
+       (setq mode-motion+-religion 'highlight)
+       (mode-motion-init-handlers-according-to-religion 'force))
+     :style radio
+     :selected (eq mode-motion+-religion 'highlight)
+     :active (mode-motion+-active-p)]
+    ["Invert"
+     (progn
+       (setq mode-motion+-religion 'invert)
+       (mode-motion-init-handlers-according-to-religion 'force))
+     :style radio
+     :selected (eq mode-motion+-religion 'invert)
+     :active (mode-motion+-active-p)]
+    "---"
+    ["Minibuffer highlighting" (setq mode-motion-use-minibuffer-motion-handler
+				     (not mode-motion-use-minibuffer-motion-handler))
+     :style toggle :selected mode-motion-use-minibuffer-motion-handler]
+     
+    ["Customize..."
+     (list-motion-handlers)
+     t
+     ;;     nil
+     ]
+     ["Revert Customization"
+     (call-interactively 'mode-motion+-motion-hook-revert)
+     (and (boundp 'mode-motion+-previous-hook) mode-motion+-previous-hook)
+     ])
+  "Menu for changing mode-motion+ religion and other things.")
+
+(defun mode-motion+-active-p ()
+  (cond ((symbolp mode-motion-hook)
+	 (eq mode-motion-hook 'mode-motion+-highlight))
+	((listp mode-motion-hook)
+	 (memq 'mode-motion+-highlight mode-motion-hook))
+	(t nil)))
+     
+(defun mode-motion+-buffer-handler-religion (buffer)
+  (let* ((current-handler-name (symbol-name (motion-handler-name
+					     (get-current-motion-handler))))
+	 (religion-name (substring current-handler-name
+				   0
+				   (string-match "-" current-handler-name))))
+    (intern-soft religion-name)))
+
+(defun mode-motion+-mode-handler-religion (buffer)
+  (let* ((mode-handler (or (get major-mode 'mode-motion-handler)
+			   default-motion-handler))
+	 (current-handler (symbol-name (motion-handler-name mode-handler)))
+	 (religion (substring current-handler
+			      0
+			      (string-match "-" current-handler))))
+    (intern-soft religion)))
+
+(defun modify-buffer-motion-handler (buffer religion)
+  (let* ((current-handler (symbol-name (motion-handler-name
+					     (get-current-motion-handler))))
+	 (suffix (substring current-handler
+			    (string-match "-" current-handler))))
+    (set-buffer-motion-handler buffer
+			       (intern-soft (concat (symbol-name religion)
+						    suffix)))))
+
+(defun modify-mode-motion-handler (mode religion)
+  (let* ((mode-handler (or (get major-mode 'mode-motion-handler)
+			   default-motion-handler))
+	 (current-handler (symbol-name (motion-handler-name mode-handler)))
+	 (suffix (substring current-handler
+			    (string-match "-" current-handler))))
+    (set-mode-motion-handler mode (intern-soft (concat (symbol-name
+							religion)
+						       suffix)))))
+
+;;;; This does not work.  I would like to be able to modify in-place
+;;;; the non-selectable items, but I don't know how.
+;;;; --paquette, Wed Mar  8 23:32:32 1995 (Marc Paquette) 
+;;; Sensitize the mode motion+ options submenu, a la
+;;; sensitize-file-and-edit-menus-hook.
+(defun mode-motion+-sensitize-options-menu-hook ()
+  "Hook function that will adjust title items in the mode-motion+ submenu in Options"
+  (let* ((mm+-menu (cdr (car (find-menu-item
+			      current-menubar
+			      '("Options" "Motion Highlighting")))))
+	 (buffer-item (find-menu-item mm+-menu '("For Current Buffer")))
+	 (mode-item (find-menu-item mm+-menu '("For Current Mode"))))
+    (setcar buffer-item (format "For Buffer `%s'" (buffer-name nil)))
+    (setcar mode-item (format "For Mode `%s'" major-mode))
+    nil))
+
+;;(add-hook 'activate-menubar-hook 'mode-motion+-sensitize-options-menu-hook)
+  
+
+;;  Motion Handler Format:
+;;      
+;; A motion handler is vector with the following format 
+;; [<name> 		       	- a symbol
+;;  <region computing function> - a function or name of function 
+;;				  that returns (<startpos> . <endpos>) 
+;;				  or nil.
+;;  <face or face name>		- as it says ...
+;;  <highlight-p>		- non-nil means that the motion extent
+;;				  will be highlighted using the function 
+;;				  `highlight-extent'
+;;  <follow-point-p>		- non-nil means that point will follow the
+;;				  mouse motion. 
+;; ]
+
+;; accessor functions
+(defsubst motion-handler-name (handler) (aref handler 0))
+(defsubst motion-handler-boundary-function (handler) (aref handler 1))
+(defsubst motion-handler-face (handler) (aref handler 2))
+(defsubst motion-handler-highlight (handler) (aref handler 3))
+(defsubst motion-handler-follow-point (handler) (aref handler 4))
+
+;; modifier functions
+(defsubst set-motion-handler-boundary-function (handler x) (aset handler 1 x))
+(defsubst set-motion-handler-face (handler x) (aset handler 2 x))
+(defsubst set-motion-handler-highlight (handler x) (aset handler 3 x))
+(defsubst set-motion-handler-follow-point (handler x) (aset handler 4 x))
+
+;; Internal global variables 
+(defvar motion-handler-alist ()
+  "Alist with entries of the form \(<name> . <handler>\).")
+
+;; Minibuffer motion handler
+(defvar mode-motion-use-minibuffer-motion-handler t
+  "*Enable mousable highlighting when the minibuffer is active. When false only extents with the
+highlight property are selectable (*Completion*)")
+
+(defvar mode-motion-extent nil)
+(make-variable-buffer-local 'mode-motion-extent)
+(defvar buffer-motion-handler nil)
+(make-variable-buffer-local 'buffer-motion-handler)
+(defvar mode-motion-last-extent nil "The last used mode motion extent.")
+(defvar default-motion-handler nil)	; Initialised in mode-motion-init.
+
+;; Creation of motion handlers
+
+(defun find-motion-handler (name)
+  (or (symbolp name)
+      (setq name (intern-soft name)))
+  (cdr (assq name motion-handler-alist)))
+
+;; internal motion handler creator
+(defsubst make-motion-handler-internal 
+  (name boundary-function face highlight follow-cursor)
+  (vector name boundary-function (get-face face) highlight follow-cursor))
+
+(defun make-motion-handler 
+  (name boundary-function &optional face highlight follow-cursor)
+  "Create a motion handler named NAME (a symbol or string) using REGION-FUNCTION.
+
+REGION-FUNCTION is the function that computes the region to be highlighted. 
+Optional arguments are: 
+
+FACE: A face or face name to be used to highlight the region computed
+      by REGION-FUNCTION.  'default is the default.
+      
+HIGHLIGHT: Flag that indicates whether the highlight attribute of the
+      mode-motion-extent should be set or not. If FACE is the default face, 
+      HIGHLIGHT defaults to t, otherwise to nil.
+
+FOLLOW-CURSOR: Flag that indicates whether the cursor should follow
+      the mouse motion. Default is nil."
+
+  ;; required arguments
+  (or name (error "motion handler name required."))
+  (or (symbolp name) 
+      (stringp name)
+      (error "motion handler name must be a string or symbol: %s" name))
+  (or boundary-function 
+      (error "motion handler region function required."))
+  (or (fboundp boundary-function)
+      (error "not a function: %s." boundary-function))
+  ;; defaults
+  (or face (setq face 'default))
+  
+  ;; store the mode motion handler on the 'mode-motion-handler property of
+  ;; its name symbol
+  (let ((old-handler (cdr (assq name motion-handler-alist)))
+	new-handler)
+    (if old-handler
+	(progn 
+	  (set-motion-handler-boundary-function old-handler boundary-function)
+	  (set-motion-handler-face old-handler (get-face face))
+	  (set-motion-handler-highlight old-handler highlight)
+	  (set-motion-handler-follow-point old-handler follow-cursor))
+      (setq motion-handler-alist 
+	    (cons (cons name 
+			(setq new-handler (make-motion-handler-internal
+					   name
+					   boundary-function
+					   (get-face face)
+					   highlight
+					   follow-cursor)))
+		  motion-handler-alist)))
+    (or old-handler new-handler)))
+
+(defvar list-motion-handlers-buffer-to-customize nil
+  "Name of buffer from where list-motion-handlers was called.")
+(make-variable-buffer-local 'list-motion-handlers-buffer-to-customize)
+(defvar list-motion-handlers-buffer-mode nil
+  "Name of mode of buffer from where list-motion-handlers was called.")
+(make-variable-buffer-local 'list-motion-handlers-buffer-mode)
+;; Listing available motion handlers in tabular form. 
+      
+(defvar basic-motion-handlers (list 'mode-motion-highlight-line
+				    'mode-motion-highlight-word
+				    'mode-motion-highlight-symbol
+				    'mode-motion-highlight-sexp)
+  "The basic motion handlers provided by the underlying XEmacs.")
+
+(defun list-motion-handlers ()
+  "Display a list of available motion handlers.
+The listing is in tabular form and contains the following columns:
+NAME: the motion handlers name,
+BOUNDARY FUNCTION: the name of the funtion used to compute the text  
+   highlighted by the motion handler,
+FACE: the face used to highlight the text.
+
+Additionally, the following flags are used at the beginning of each line:
+`*' Marks the motion handler current to the buffer this functions was called 
+    from.
+`H' Force highlighting of the selected text.
+`F' Make point follow the mouse cursor as it moves."
+  (interactive)
+  (let ((current-handler (get-current-motion-handler))
+	(buffer (current-buffer))
+	(buffer-mode major-mode)
+	(bmmh (if (symbolp mode-motion-hook)
+		  (car (memq mode-motion-hook basic-motion-handlers))
+		(if (and (listp mode-motion-hook) 
+			 (equal 1 (length mode-motion-hook)))
+		    (car (memq (car mode-motion-hook)
+			       basic-motion-handlers))))))
+    (save-excursion
+      (with-output-to-temp-buffer "*Mouse Motion Handlers*"
+	(let ((truncate-lines t))
+	  (set-buffer "*Mouse Motion Handlers*")
+	  (setq list-motion-handlers-buffer-to-customize buffer)
+	  (setq list-motion-handlers-buffer-mode buffer-mode)
+	  (let ((pos1 5)
+		(pos2 25)
+		(pos3 50)
+		(handlers 
+		 (sort 
+		  (mapcar 'cdr motion-handler-alist)
+		  '(lambda (x y)
+		     (string<
+		      (symbol-name (motion-handler-boundary-function x))
+		      (symbol-name (motion-handler-boundary-function y)))))))
+	    (if bmmh
+		(let ((i 1)
+		      (fw (frame-width)))
+		  (while (< i fw)
+		    (princ "*")
+		    (setq i (1+ i)))
+		  (princ "\nNote: this buffer is not using mode-motion+.\n\n")
+		  (princ "It's using the `")
+		  (princ bmmh)
+		  (princ "' motion handler which claims it's:\n")
+		  (insert (documentation bmmh))
+		  (princ "\nSetting this motion handler will be irrevocable from this interface\n(but only for duration of this XEmacs session).\n")
+		  (setq i 1)
+		  (while (< i fw)
+		    (princ "*")
+		    (setq i (1+ i)))
+		  (terpri)))
+	    (princ "     NAME                BOUNDARY FUNCTION        FACE\n")
+	    (princ "     ----                -----------------        ----\n")
+	    (mapcar 
+	     #'(lambda (handler)
+		 (let ((line-start (point)))
+		   (princ (if (and (not bmmh) (eq handler current-handler))
+			      "*" " "))
+		   (princ (if (eq handler default-motion-handler) "D" " "))
+		   (princ (if (motion-handler-highlight handler) "H" " "))
+		   (princ (if (motion-handler-follow-point handler) "F" " "))
+		   (indent-to-column pos1 1)
+		   (princ (motion-handler-name handler))
+		   (indent-to-column pos2 1)
+		   (princ (motion-handler-boundary-function handler))
+		   (indent-to-column pos3)
+		   (let ((face-start (point)))
+		     (princ (face-name (motion-handler-face handler)))
+		     (let ((line-extent (make-extent line-start face-start))
+			   (face-extent (make-extent face-start (point))))
+		     (set-extent-face face-extent
+				      (motion-handler-face handler))
+		     (set-extent-property
+		      face-extent
+		      'mode-motion-handler (motion-handler-name handler))
+		     (set-extent-property
+		      line-extent
+		      'mode-motion-handler (motion-handler-name handler))
+		     (set-extent-property line-extent 'highlight t)))
+		 (terpri)))
+	     handlers)
+	    (princ (format "
+Flags:	`D' the default motion handler
+       	`H' handler with highlighting
+	`F' handler with `following' property
+	`*' the motion handler of buffer \"%s\""
+			   list-motion-handlers-buffer-to-customize))))
+	(local-set-key 'button3 'mode-motion-set-handler)
+	(setq buffer-read-only t)))))
+
+(defun mode-motion-set-handler (event)
+  (interactive "@e")
+  (let* ((handler (or (extent-property
+		       (extent-at (event-point event) (current-buffer)
+				  'mode-motion-handler)
+		       'mode-motion-handler)
+		      (error "Click on highlighted line to select a handler")))
+	 (menu (list
+		(format "Make `%s' the Motion Handler of :" handler)
+		(vector (format "Buffer %s"
+				list-motion-handlers-buffer-to-customize)
+			(` (set-buffer-motion-handler
+			    '(, list-motion-handlers-buffer-to-customize)
+			    '(, handler))) t)
+		(vector "Another Buffer..."
+			(` (motion-handler-list-set-buffer-handler
+			    '(, handler))) t)
+		"---"
+		(vector (format "Mode %s"
+				list-motion-handlers-buffer-mode)
+			(` (progn
+			     (set-mode-motion-handler
+			      '(, list-motion-handlers-buffer-mode)
+			      '(, handler))
+			     (save-excursion
+			       (mapcar
+				(function
+				 (lambda (buf)
+				   (set-buffer buf)
+				   (and (eq
+					 '(, list-motion-handlers-buffer-mode)
+					 major-mode)
+					(mode-motion+-hook-install buf t))))
+				       (buffer-list))))) t)
+		(vector "Another Mode..."
+			(` (motion-handler-list-set-mode-handler
+			    '(, handler))) t)
+		"---"
+		(vector "Default Motion Handler"
+			(` (set-default-motion-handler '(, handler))) t))))
+    (popup-menu menu)))
+
+(defun motion-handler-list-set-buffer-handler (handler)
+  (let ((buffer (read-buffer-name 
+		 (format "Make `%s' the motion handler of buffer: " handler)
+		 (buffer-name list-motion-handlers-buffer-to-customize))))
+    (set-buffer-motion-handler buffer handler)
+    (save-excursion
+      (set-buffer buffer)
+      (and (not (cond ((listp mode-motion-hook)
+		       (memq 'mode-motion+-highlight mode-motion-hook))
+		      ((symbolp mode-motion-hook)
+		       (eq 'mode-motion+-highlight mode-motion-hook))
+		      (t t)))
+	   (y-or-n-p (format "Augment the default mode motion hook for `%s'? "
+			     (buffer-name nil)))
+	   (mode-motion+-hook-install buffer t)))))
+
+(defvar mode-motion+-previous-hook nil
+  "Value of previous `mode-motion-hook' in current buffer.")
+(make-variable-buffer-local 'mode-motion+-previous-hook)
+
+(defun motion-handler-list-set-mode-handler (handler)
+  (let ((mode (intern (completing-read
+	    (format "Make `%s' the motion handler of mode: " handler)
+	    obarray
+	    'fboundp
+	    t	
+	    (symbol-name list-motion-handlers-buffer-mode)))))
+    (set-mode-motion-handler mode handler)
+  (save-excursion
+    (mapcar (function
+	     (lambda (buf)
+	       (set-buffer buf)
+	       (and (eq mode major-mode)
+		    (mode-motion+-hook-install buf t))))
+	    (buffer-list)))))
+
+(defun mode-motion+-hook-install (&optional buffer remove-highlight-line-p)
+  "Add `mode-motion+-highlight' to the BUFFER `mode-motion-hook'.
+If the optional second arg REMOVE-HIGHLIGHT-LINE-P is t, remove
+`mode-motion-highlight-line' from `mode-motion-hook'.
+See `mode-motion+-hook-uninstall' for reverting this operation."
+  (interactive "bInstall mode-motion+ hook for buffer :
+XRemove highlight-line from hook ? :")
+  ;; Check for the mode-motion-hook value to make sure it's under
+  ;; the control of mode-motion+.
+  ;; The reasonning here is that if the user went trough the hassles
+  ;; of list-motion-handlers (or if he's calling this directly from
+  ;; his .emacs) , he is prepared to give up on the current
+  ;; mode-motion-hook.
+  ;; However, we keep the previous hook value in a buffer-local
+  ;; variable: it will be then possible to revert to the old motion
+  ;; handling behavior with `mode-motion+-hook-uninstall'.
+  ;; --paquette, Mon Feb 27 08:54:30 1995 (Marc Paquette)
+  (setq buffer (or buffer (current-buffer)))
+  ;; force the uninstall of mode-motion-highlight since if its second
+  ;; you'll never see ours.
+  (setq remove-highlight-line-p t)
+  (save-excursion
+    (set-buffer buffer)
+    (if (boundp 'mode-motion-hook)
+	(progn
+	  (setq mode-motion+-previous-hook
+		(cond ((sequencep mode-motion-hook)
+		       (copy-sequence mode-motion-hook))
+		      (t mode-motion-hook)))
+	  ;; Make sure that the mode-motion+-highlight is not saved in
+	  ;; the variable, otherwise, we could not revert back to the
+	  ;; "factory settings" after having played with different
+	  ;; handlers
+	  ;; --paquette, Mon Feb 27 08:54:21 1995 (Marc Paquette)
+	  (remove-hook 'mode-motion+-previous-hook 'mode-motion+-highlight)))
+    (add-hook 'mode-motion-hook 'mode-motion+-highlight)
+    (and remove-highlight-line-p
+	 ;; Remove the standard mode-motion-highlight hook because we
+	 ;; provide an alternative to this.  I don't use setq here because
+	 ;; something else could be hooked to mode-motion-hook.
+	 ;; --paquette, Mon Feb 27 08:53:51 1995 (Marc Paquette)
+	 (remove-hook 'mode-motion-hook 'mode-motion-highlight-line))
+    (and mode-motion-extent
+	 (delete-extent mode-motion-extent)
+	 (setq mode-motion-extent nil))
+    ;; Try to make this installed for any buffer of this mode
+    (let ((this-mode-hook (intern-soft (concat (symbol-name major-mode)
+					       "-hook"))))
+      (and (boundp this-mode-hook)
+	   (if remove-highlight-line-p
+	       (add-hook this-mode-hook
+			 #'(lambda () (mode-motion+-hook-install nil t))
+			 'append)
+	     (add-hook this-mode-hook 'mode-motion+-hook-install 'append)))))
+  mode-motion-hook)
+
+(defun mode-motion+-hook-uninstall (buffer)
+  "Restore the value of `mode-motion-hook' in BUFFER to what it was at the time `mode-motion+-hook-install' was called.
+See also `mode-motion+-hook-install'."
+  (interactive "bRestore `mode-motion-hook' of buffer :")
+  ;; Check for the mode-motion-hook value to make sure it's under
+  ;; the control of mode-motion+.
+  ;; The reasonning here is that if the user went trough the hassles
+  ;; of list-motion-handlers (or if he's calling this directly from
+  ;; his .emacs) , he is prepared to give up on the current
+  ;; mode-motion-hook.
+  ;; However, we keep the previous hook value in a buffer-local
+  ;; variable: it will be then possible to revert to the old motion
+  ;; handling behavior with `mode-motion+-hook-uninstall'.
+  ;; --paquette, Mon Feb 27 08:54:30 1995 (Marc Paquette)
+  (save-excursion
+    (set-buffer buffer)
+    (and mode-motion-extent
+	 (delete-extent mode-motion-extent)
+	 (setq mode-motion-extent nil))
+    (if (boundp 'mode-motion+-previous-hook)
+	(progn
+	  (setq mode-motion-hook mode-motion+-previous-hook)
+	  (setq mode-motion+-previous-hook nil)
+	  (let ((this-mode-hook (intern-soft (concat (symbol-name major-mode)
+						     "-hook"))))
+	    (and (boundp this-mode-hook)
+		 (remove-hook this-mode-hook 'mode-motion+-hook-install))))
+      (error "No previous value for mode-motion-hook")))
+  mode-motion-hook)
+
+(defun mode-motion+-motion-hook-revert (&optional buffer-only-p buffer mode)
+  "Revert the `mode-motion-hook' to its original value.
+With optional arg BUFFER-ONLY-P non-nil, only revert in BUFFER
+\(defaults to `\(current-buffer\)'\); otherwise, revert for all existing
+buffers of MODE \(defaults to `major-mode' of BUFFER\)."
+  (interactive
+    (let* ((buffer-only-p
+	   (y-or-n-p "Revert mode-motion-hook only for current buffer ? "))
+	   (buffer (if buffer-only-p
+		       (current-buffer)
+		     (get-buffer (read-buffer-name
+				  "Revert mode-motion-hook of buffer : "
+				  (buffer-name (current-buffer))))))
+	   (mode (if buffer-only-p
+		     (save-excursion
+		       (set-buffer buffer)
+		       major-mode)
+		   (intern-soft (completing-read "Major mode: "
+						 obarray
+						 'fboundp	
+						 nil 
+						 (symbol-name major-mode))))))
+      (list buffer-only-p buffer mode)))
+  (if buffer-only-p
+      (mode-motion+-hook-uninstall buffer)
+    (save-excursion
+      (mapcar (function
+	       (lambda (buf)
+		 (set-buffer buf)
+		 (and (eq mode major-mode)
+		      (mode-motion+-hook-uninstall buf))))
+	      (buffer-list)))))
+  
+
+;; Setting buffer, mode and default motion handlers
+
+(defun set-buffer-motion-handler (buffer handler-name)
+  "Make the motion handler named HANDLER-NAME (a symbol) the buffer
+motion handler of BUFFER.  If HANDLER-NAME is nil, the corresponding
+buffer motion handler is removed.  If HANDLER-NAME isn't the name of a
+known motion handler, an error is signaled. When called interactively,
+completion is provided for available buffers and motion handlers.
+
+	1.\) buffer motion handler
+	2.\) mode motion handler
+	3.\) default motion handler"
+  (interactive (list (read-buffer-name "Set motion handler of buffer: "
+				       (buffer-name (current-buffer)))
+		     (read-motion-handler-name)))
+
+  ;; kill old mode motion extent, because the new handler
+  ;; might want to initialize it differently
+  (if mode-motion-extent 
+      (progn 
+	(detach-extent mode-motion-extent)
+	(setq mode-motion-extent nil)))
+  (or buffer (setq buffer (current-buffer)))
+  (or (get-buffer buffer)
+      (error "No such buffer: %s" buffer))
+  (save-excursion 
+    (set-buffer buffer)
+    (setq buffer-motion-handler
+	  ;; remove it if `nil'
+	  (and handler-name
+	       ;; set the handler if known
+	       (or (find-motion-handler handler-name)
+		   ;; error otherwise
+		   (error "Not a known motion handler: %s"
+			  handler-name)))))
+  (if (interactive-p)
+      (if handler-name
+	  (message "Motion handler for buffer %s is `%s'." 
+		   (current-buffer) handler-name)
+	  (message "Motion handler removed for buffer %s." 
+		   (current-buffer))))
+  handler-name)
+
+(defun read-buffer-name (prompt &optional initial-input)
+  (completing-read prompt
+		   (mapcar #'(lambda (buf) (list (buffer-name buf)))
+			   (buffer-list))
+		   ;; don't take buffers that start with a blank
+		   #'(lambda (list) (not (eq (aref (car list) 0) ? )))
+		   t
+		   initial-input))
+
+(defun set-mode-motion-handler (mode handler-name)
+  "Make the motion handler named HANDLER-NAME (a symbol) the mode motion
+handler for all buffers with major-mode MODE.  If HANDLER-NAME is nil,
+the corresponding mode motion handler is removed.  If HANDLER-NAME
+isn't the name of a known motion handler, an error is signaled. When
+called interactively, completion is provided for available motion
+handlers.
+
+	1.\) buffer motion handler
+	2.\) mode motion handler
+	3.\) default motion handler"
+  (interactive (list (intern (completing-read "Major mode: "
+					      obarray
+					      'fboundp	
+					      nil 
+					      (symbol-name major-mode)))
+		     (read-motion-handler-name)))
+  ;; kill old mode motion extent, because the new handler
+  ;; might want to initialize it differently
+  (if mode-motion-extent 
+      (progn 
+	(detach-extent mode-motion-extent)
+	(setq mode-motion-extent nil)))
+  (put mode 'mode-motion-handler 
+	;; remove it if `nil'
+	(and handler-name
+	     ;; set the handler if known
+	     (or (find-motion-handler handler-name)
+		 ;; error otherwise
+		 (error "Not a known mode motion handler: %s" handler-name))))
+  (if (interactive-p)
+      (if handler-name
+	  (message "Motion handler for %s is `%s'." mode handler-name)
+	  (message "Mode motion handler for %s removed." mode)))
+  handler-name)
+
+(defun set-default-motion-handler (handler-name)
+  "Make the motion handler named HANDLER-NAME (a symbol) the default.
+
+If HANDLER-NAME is nil, the current default motion handler is removed.  If
+HANDLER-NAME isn't the name of a known motion handler, an error is
+signalled. When called interactively, completion is provided for available
+motion handlers.
+
+The motion handler used in a given buffer is determined by the following
+most-specific first list: buffer motion handler, mode motion handler, default
+motion handler." 
+  (interactive (list (read-motion-handler-name)))
+  ;; kill old mode motion extent, because the new handler
+  ;; might want to initialize it differently
+  (if mode-motion-extent 
+      (progn 
+	(detach-extent mode-motion-extent)
+	(setq mode-motion-extent nil)))
+  (setq default-motion-handler
+	;; remove it if `nil'
+	(and handler-name
+	     ;; set the handler if known
+	     (or (find-motion-handler handler-name)
+		 ;; error otherwise
+		 (error "Not a known motion handler: %s" handler-name))))
+  (if (interactive-p)
+      (if handler-name
+	  (message "Default motion handler is `%s'." handler-name)
+	  (message "Default motion handler removed.")))
+  handler-name)
+
+(defun read-motion-handler-name ()
+  (intern-soft (completing-read "Motion handler: "
+				(mapcar #'(lambda (entry)
+					    (list (symbol-name (car entry))))
+					motion-handler-alist)
+				nil t)))
+
+;; clear the last active motion extent when leaving a frame.
+(defun mode-motion-clear-extent (&optional extent)
+  "Clear EXTENT, i.e. make it have no visible effects on the frame.
+EXTENT defaults to the current buffer's mode-motion-extent."
+  (or extent (setq extent mode-motion-extent))
+  (and extent 
+       (extent-live-p extent)
+       (not (extent-detached-p extent))
+       (extent-buffer extent)
+       (buffer-name (extent-buffer extent))
+       (progn 
+	 ;; unhighlight it 
+	 (highlight-extent extent nil)
+	 ;; make it span a region that isn't visible and selectable
+	 ;; Can this be done more elegantly? 
+	 (detach-extent extent))))
+
+(defun mode-motion-clear-last-extent (&optional frame)
+  "Clear the mode-motion-last-extent."
+  (or (popup-menu-up-p) (mode-motion-clear-extent mode-motion-last-extent)))
+
+(defun mode-motion+-highlight (event)
+  "Highlight the thing under the mouse using a mode-specfic motion handler.
+See list-motion-handlers for more details."
+  (mode-motion-clear-last-extent)
+  (and (event-buffer event)
+       (cond ((and mouse-grabbed-buffer
+		   ;; first try to do minibuffer specific highlighting
+		   (find-motion-handler 'minibuffer)
+		   (let ((mode-motion-highlight-lines-when-behind nil))
+		     (and (event-point event)
+			  (or (extent-at (event-point event)
+					 (event-buffer event) 'highlight)
+			      (mode-motion-highlight-with-handler
+			       (find-motion-handler 'minibuffer) event))))))
+	     (t (mode-motion-highlight-with-handler
+		 (get-current-motion-handler) event))))
+  ;; Return nil since now this is used as a hook, and we want to let
+  ;; any other hook run after us.
+  nil)
+
+(defun get-current-motion-handler ()
+  (or (and (boundp 'buffer-motion-handler) buffer-motion-handler)
+      (get major-mode 'mode-motion-handler)
+      default-motion-handler))
+
+(defun mode-motion-highlight-with-handler (handler event)
+  ;; Perform motion highlighting using HANDLER. Information about the
+  ;; current mouse position is taken form EVENT. 
+  (and handler
+       (let ((point (event-point event))
+	     (buffer (event-buffer event))
+	     (window (event-window event))
+	     (window-config (current-window-configuration))
+	     (buffer-save (current-buffer))
+	     (point-save (point))
+	     region)
+	 ;; save-window-excursion and restore buffer
+	 (unwind-protect
+	     (progn
+	       (and buffer
+		    (set-buffer buffer)
+		    (select-window window))
+	   
+	       ;; kludge: if point = end-of-window, then probably the mouse
+	       ;; is actually between the last line and the modeline.  In
+	       ;; this case move point to back one
+	       (and point
+		    (not (< point (window-end window)))
+		    (setq point (1- point)))
+	       ;; Create a new mode-motion-extent if there isn't one 
+	       ;; (or a destroyed one)
+	       (if (and (extent-live-p mode-motion-extent)
+			(extent-buffer mode-motion-extent))
+		   ()
+		 (setq mode-motion-extent (make-extent nil nil buffer))
+		 (set-extent-priority mode-motion-extent 1))
+	       (if (and 
+		    ;; compute the region to be highlighted
+		    (setq region
+			  (if point
+			      ;; compute the mode-motion region using the 
+			      ;; handlers boundary function
+			      (condition-case nil;; c
+				  (funcall
+				   (motion-handler-boundary-function handler)
+				   point)
+				;; Messages that appear during computing the
+				;; region may be displayed not done
+				;; here because it's rather disturbing
+				(error
+				 ;; (setq message (format "%s" (car (cdr c))))
+				 nil))
+			    ;; otherwise highlight the whole line mouse is
+			    ;; behind but only if the line isn't empty
+			    (if mode-motion-highlight-lines-when-behind
+				(unwind-protect
+				    (progn 
+				      ;; (message "%s" (event-window event))
+				      (move-to-window-line
+				       (if (< emacs-minor-version 12)
+					   (- (event-y event) 
+					      (nth 1 (window-edges window)))
+					 (event-y event)))
+				      (beginning-of-line)
+				      (if (= (following-char) ?\n)
+					  ;; empty line 
+					  ()
+					(thing-region
+					 (point)
+					 (progn 
+					   (end-of-line)
+					   ;; for `follow-point' behavoir
+					   (setq point (point))
+					   ;; fetch also the newline, if any
+					   ;; -- handy for copying >1 line
+					   (if (eobp) point (1+ point))))))
+				  (goto-char point-save)))))
+		    ;; (message "region: %s" region)
+		    ;; the region might be in reverse order. Stop in this case
+		    (<= (car region) (cdr region)))
+		   (if (or (not (motion-handler-follow-point handler))
+			   (pos-visible-in-window-p point))
+		       (progn
+			 ;; set the extent face
+			 (set-extent-face
+			  mode-motion-extent (motion-handler-face handler))
+			 ;; set the new boundary
+			 (set-extent-endpoints 
+			  mode-motion-extent (car region) (cdr region))
+			 ;; highlight if required
+			 (set-extent-property
+			  mode-motion-extent 'highlight
+			  (motion-handler-highlight handler))
+			 (highlight-extent mode-motion-extent
+					   (motion-handler-highlight handler))
+			 ;; make point follow the mouse or point to
+			 ;; the beginning of the line do not move the
+			 ;; cursor if a mark is set.
+			 (cond ((and (motion-handler-follow-point handler)
+				     (not (mark)))
+				(goto-char point)
+				;; kludge to keep the cursor out the way
+				(if (or (eq (motion-handler-boundary-function
+					     handler)
+					    'line-boundaries)
+					(eq (motion-handler-boundary-function
+					     handler)
+					    'visible-line-boundaries))
+				    (beginning-of-line))))
+			 (if (and mode-motion-focus-on-window
+				  (or (eq mode-motion-focus-on-window t)
+				      (motion-handler-follow-point handler)))
+			     ;; Select the current window FROM OUTSIDE the
+			     ;; `save-window-excursion' that surrounds the call
+			     ;; to the current function. This also avoids
+			     ;; conflicts with running process filters.
+			     (enqueue-eval-event 'select-window
+						 (selected-window)))
+			 ;; snap in effect, but it ain't yet workin'
+			 ;; (message "X: %sl; Y: %s"(event-x event)(event-y event))
+			 ;; (and motion-handler-snap-in
+			 ;;    (set-mouse-position
+			 ;;    (window-frame (event-window event))
+			 ;;    (event-x event)
+			 ;;    (event-y event)))
+			 (setq mode-motion-last-extent mode-motion-extent)
+			 ;; signal success
+			 t))
+		 ;; signal failiure
+		 nil))
+	   (set-window-configuration window-config)
+	   (set-buffer buffer-save)))))
+
+;; Motion Event debugging
+;;
+;; Useful to see what information is available from motion events
+
+(defun debug-motion-handler (event)
+   (let* ((window (event-window event))
+	  (frame (or (event-frame event) (selected-frame)))
+	  (buffer (and window (event-buffer event)))
+	  (point  (and buffer (event-point event))))
+     (with-output-to-temp-buffer "*Debug Motion Handler Output*"
+       (princ 
+	(format "\
+ Window: %s
+ Frame: %s
+ Buffer: %s
+ (event-x, event-y): (%s, %s)
+ (event-x-pixel, event-y-pixel): (%s, %s)
+ Point: %s
+ Timestamp: %s"
+	window 
+        frame 
+        buffer 
+        (event-x event) (event-y event) 
+        (event-x-pixel event) (event-y-pixel event)
+        point 
+        (event-timestamp event))))))
+
+;(let ((mouse-motion-handler 'debug-motion-handler)
+;      (temp-buffer-show-function nil))
+;  (read-char))
+
+;; Set of copy/kill/move functions for usage with highlighted regions
+
+(put 'mode-motion-move 'pending-delete t)
+(put 'mode-motion-copy 'pending-delete t)
+
+(defun mode-motion-move ()
+  "Move the motion active region to point." 
+  (interactive)
+  (mode-motion-insert-text (mode-motion-copy/delete t)))
+
+(defun mode-motion-kill ()
+  "Kill the motion active region and push it onto the kill ring."
+  (interactive)
+  (mode-motion-copy/delete t t t))
+
+(defun mode-motion-copy ()
+  "Copy the motion active region to point."
+  (interactive)
+  (mode-motion-insert-text (mode-motion-copy/delete)))
+
+(defun mode-motion-copy-as-kill ()
+  "Delete the motion active region and push it onto the kill ring.
+Set point to the place where deletion happened."
+  (interactive)
+  (mode-motion-copy/delete nil t)
+  (message "Text copied to the to ring and cut buffer."))
+
+(defun mode-motion-copy/delete (&optional delete copy-as-kill set-point)
+  "Return the string that is designated by the current motion active region. 
+Arguments are:
+           EVENT - a mouse click event used to identify the buffer and window 
+&optional DELETE - delete the motion active text region
+    COPY-AS-KILL - copy the string to the kill ring
+       SET-POINT - set point to the start of the motion active region."
+  (let ((old-buf (current-buffer))
+	(old-window (selected-window)))
+    (unwind-protect 
+	(let ((extent (or primary-selection-extent
+			  (and (extentp mode-motion-last-extent)
+			       (not (extent-property mode-motion-last-extent
+						     'detached))
+			       mode-motion-last-extent))))
+
+	  (if (and (extentp extent)
+		   (set-buffer (extent-buffer extent))
+		   (not 
+		    ;; zero length extents
+		    (= (extent-start-position extent)
+		       (extent-end-position extent))))
+
+	      (let* ((start (extent-start-position extent))
+		     (end (extent-end-position extent))
+		     (text 
+		      (buffer-substring
+		       (extent-start-position extent)
+		       (extent-end-position extent))))
+
+		(cond (copy-as-kill
+		       (copy-region-as-kill start end)
+		       (if (or (not kill-hooks)
+				(eq kill-hooks 'ignore))
+			   (progn 
+			     (x-own-selection-internal 'PRIMARY text)
+			     (x-own-clipboard text)))))
+
+		(cond (delete 
+		       (kill-region start end)
+		       (x-own-selection-internal 'PRIMARY text)
+		       ;; (select-window window)
+		       (if set-point 
+			   (goto-char start))))
+
+		(setq this-command 'mode-motion+)
+		text)
+	    (error "No current primary or motion selection.")
+	    ))
+      (set-buffer old-buf)
+      (select-window old-window))))
+
+(defun mode-motion-insert-text (text)
+  "Insert TEXT at point. Also insert one space if the 
+preceeding character is a word constituent or a closing paren."
+  (or text (error "No highlighted text to copy."))
+  (let ((prec-char-syntax (char-syntax (preceding-char))))
+    (if (memq  prec-char-syntax '(?w ?\))) (insert " "))
+    (insert text)))
+
+;; Boundary functions
+;;
+;; The following  functions are already provided by the thing package:
+;; thing-boundaries
+;; thing-symbol
+;; thing-word
+
+(defun char-boundaries (point) (thing-region point (1+ point)))
+      
+(defun visible-line-boundaries (point)
+  (save-excursion
+    (goto-char point)
+    (beginning-of-line)
+    (skip-chars-forward " \t")
+    (if (and (eq major-mode 'dired-mode)
+	     (save-excursion (dired-move-to-filename)))
+	(let ((start (point)))
+	  (end-of-line)
+	  (skip-chars-backward " \t")
+	  (thing-region start (point))))))
+
+(defun line-boundaries (point)
+  (save-excursion
+    (goto-char point)
+    (beginning-of-line)
+    (if (and (eq major-mode 'dired-mode)
+	     (save-excursion (dired-move-to-filename)))
+	(let ((start (point)))
+	  (end-of-line)
+	  (thing-region start (point))))))
+
+(defun cvs-line-boundaries (point)
+    (save-excursion
+      (goto-char point)
+      (beginning-of-line)
+      (if (looking-at "^[* ] ")
+	  (thing-region  (point) (progn (end-of-line) (point))))))
+      
+(defun latex-boundaries (here)
+  (setq *last-thing* 'sexp)
+  (tex-boundaries 
+   here ?\\ "a-zA-Z"
+   ;; begin-fwd-regexp
+   "\\\\begin *{ *\\([a-z]*\\) *}"
+   ;; end-fwd-regexp
+   "\\(\\\\end *{ *%s *}\\)\\|\\(\\\\begin *{ *%s *}\\)"
+   ;; begin-bwd-regexp
+   "\\\\end *{ *\\([a-z]*\\) *}"
+   ;; begin-bwd-regexp
+   "\\(\\\\end *{ *%s *}\\)\\|\\(\\\\begin *{ *%s *}\\)"
+   ;; param-cmd-regexp
+   "\\\\[a-zA-Z]+[ \n\t]*{"))
+
+(defvar texinfo-paired-commands 
+  (mapconcat 
+   'identity 
+   '(
+     "enumerate"
+     "example"
+     "group"
+     "ifinfo" 
+     "iftex" 
+     "ignore" 
+     "itemize"
+     "menu"
+     "quotation"
+     "table"
+     "tex"
+     "titlepage"
+     ) 
+   "\\|"))
+
+(defvar texinfo-begin-fwd-regexp 
+  (format "@\\(%s\\)" texinfo-paired-commands))
+(defvar texinfo-end-bwd-regexp
+  (format "@end *\\(%s\\)" texinfo-paired-commands))
+
+(defun texinfo-boundaries (here)
+  (tex-boundaries 
+   here ?@ "a-z"
+   texinfo-begin-fwd-regexp
+   ;; end-fwd-regexp
+   "\\(@end *%s\\)\\|\\(@%s\\)"
+   ;; end-bwd-regexp
+   texinfo-end-bwd-regexp
+   ;; begin-bwd-regexp
+   "\\(@end *%s\\)\\|\\(@%s\\)"
+   ;; param-cmd-regexp
+   "@\\(TeX\\|[a-zA]+\\)[ \n\t]*{"))
+
+(defun tex-boundaries 
+  (here cmd-start-character cmd-word-character
+	begin-fwd-regexp end-fwd-regexp
+	end-bwd-regexp begin-bwd-regexp
+	param-cmd-regexp)
+  "Generic TeX dialect scanner.
+Parameters: 
+cmd-start-character: character that starts a command 
+	(`\' in (La)TeX, `@' in Texinfo)
+cmd-word-character:  regexpression to be used by the function
+	`skip-chars-backward' allowing to skip over command 
+	characters other than `cmd-start-character'
+begin-fwd-regexp: regexpression matching the begin part of a 
+	text stretch, used in forward search. 
+end-fwd-regexp: regexpression matching the end part of a 
+	text stretch, used in forward search
+end-bwd-regexp: regexpression matching the end part of a 
+	text stretch, used in backward search.
+begin-bwd-regexp: regexpression matching the begin part of a 
+	text stretch, used in backward search.
+param-cmd-regexp: regexpression matching a parameterized command 
+        \(including the open parenthesis\)"
+  (save-excursion
+    (goto-char here)
+    (cond ((= (following-char) cmd-start-character)
+	   (forward-char 1))
+	  ((= (char-syntax (following-char)) ?w)
+	   (skip-chars-backward cmd-word-character)))
+    (if (/= (preceding-char) cmd-start-character)
+	(thing-boundaries here)
+      (forward-char -1)
+      (catch 'return 
+	(cond ((looking-at begin-fwd-regexp)
+	       (let* ((start (point))
+		      (env (buffer-substring 
+			    (match-beginning 1) (match-end 1)))
+		      (regexp (format end-fwd-regexp env env))
+		      (count 0))
+		 (while (re-search-forward regexp nil t)
+		   (cond ((match-beginning 2) ; \begin
+			  (setq count (1+ count)))
+			 ((match-beginning 1) ; \end
+			  (setq count (1- count))
+			  (if (= count 0) 
+			      (throw 'return 
+				     (thing-region start (point)))))))))
+	      ((looking-at end-bwd-regexp)
+	       (let* ((end (match-end 0))
+		      (env (buffer-substring 
+			    (match-beginning 1) (match-end 1)))
+		      (regexp 
+		       (format begin-bwd-regexp env env))
+		      (count 1))
+		 (while (re-search-backward regexp nil t)
+		   (cond ((match-beginning 1) ; \end
+			  (setq count (1+ count)))
+			 ((match-beginning 2) ; \begin
+			  (setq count (1- count))
+			  (if (= count 0) 
+			      (throw 'return (thing-region (point) end))))
+			 ))))
+	      ;; tex macros of the form \cmd {...}
+	      ((looking-at param-cmd-regexp)
+	       (thing-region 
+		(point)
+		(progn 
+		  (goto-char (1- (match-end 0)))
+		  (forward-sexp 1)
+		  (point))))
+	      ;; fetch the current macro (with backslash)
+	      (t (thing-region (point) (progn (forward-word 1) (point)))))))))
+
+;; special parse of buffer for valid selectable info
+(defun minibuffer-selection-boundaries (point)
+  (let ((old-syntax (syntax-table)))
+    (unwind-protect
+	(progn 
+	  ;; best syntax table for recognizing symbols
+	  (set-syntax-table emacs-lisp-mode-syntax-table)
+	  (let ((file-completion (eq minibuffer-completion-table
+				     'read-file-name-internal))
+		region
+		minibuf-string		;contents of minibuffer
+		buffer-string		;string to be highlighted (or not)
+		prefix			;prefix calculated from minibuf-string
+		string			;string to be verified in the
+					;completion table 
+		)
+	    (and
+
+	     (setq region (if file-completion
+			      (thing-filename point)
+			    (thing-symbol point)))
+
+	     (setq
+	      minibuf-string		; contents of minibuffer
+	      (save-excursion
+		(set-buffer mouse-grabbed-buffer)
+		(buffer-string))
+
+	      buffer-string		; string to be highlighted (or not)
+	      (buffer-substring (car region) (cdr region))
+		       
+	      prefix
+	      (if file-completion
+		  (file-name-nondirectory minibuf-string)
+		minibuf-string)
+
+	      string
+	      (if file-completion
+		  (concat (file-name-directory minibuf-string) buffer-string)
+		buffer-string))
+	     
+	     (if (or (and (fboundp 'ange-ftp-ftp-path)
+			  (or (ange-ftp-ftp-path buffer-string)
+			      (ange-ftp-ftp-path string)))
+		     (and (fboundp 'efs-ftp-path)
+			  (or (efs-ftp-path buffer-string)
+			      (efs-ftp-path string))))
+		 ;; #### Like our counterpart in mode-motion: evil evil evil
+		 t
+	       (if file-completion
+		   (try-completion string
+				   minibuffer-completion-table
+				   minibuffer-completion-predicate)
+		 (eq 't (try-completion string
+					minibuffer-completion-table
+					minibuffer-completion-predicate))))
+
+	     ;; the result is the region to be highlighted
+	     region)))
+      (set-syntax-table old-syntax))))
+
+;; C source code scanner 
+(defvar c-statement-starting-keyword-regexpr
+  "\\(if\\|for\\|while\\|do\\|switch\\|break\\|continue\\)\\b")
+
+(defun c-boundaries (here)
+  (setq *last-thing* 'sexp)
+  (save-excursion
+    (goto-char here)
+    (let ((following-char (following-char))
+	  (preceding-char (preceding-char))
+	  aux)
+      (if (= (char-syntax following-char) ?w)
+	  (progn 
+	    (skip-chars-backward "a-zA-Z")
+	    (setq aux (point))
+	    (skip-chars-backward "\n\t ")
+	    (if (= (preceding-char) ?#)
+		(forward-char -1)
+	      (goto-char aux))))
+      (if (and (= following-char ?*)
+	       (= preceding-char ?/))
+	  (forward-char -1))
+      (if (and (= following-char ?/)
+	       (= preceding-char ?*))
+	  (forward-char -1))
+      (cond
+       ((= (following-char) ?#) (c-scan-preproc-macros))
+       ((looking-at "/\\*")	; begin comment
+	(let ((start (match-beginning 0)))
+	  (if (search-forward "*/" nil t)
+	      (thing-region start (match-end 0)))))
+       ((looking-at "\\*/")	; end comment
+	(let ((end (match-end 0)))
+	  (if (search-backward "/*" nil t)
+	      (thing-region (match-beginning 0) end))))
+       ((looking-at c-statement-starting-keyword-regexpr) ; if for while do etc
+	(thing-region (match-beginning 0)
+		      (c-forward-statement 
+		       (buffer-substring (match-beginning 1) (match-end 1)))))
+       ((looking-at "else\\b")
+	(thing-region (match-beginning 0) (c-forward-else)))
+       (t (if (= (char-syntax (following-char)) ?.)
+	      (thing-region here  (1+ here))
+	    (thing-boundaries here)))))))
+
+
+(defun c-scan-preproc-macros ()
+  (cond 
+   ((looking-at "^#[ \n\t]*include[ \n\t]*[<\"][^>\"]*[>\"]")   ; #include
+    (thing-region (match-beginning 0) (match-end 0)))
+   ((looking-at "^#[ \n\t]*\\(define\\|undef\\)") ; #define, #undef
+    (thing-region
+     (match-beginning 0) 
+     (progn 
+       (end-of-line)
+       (while (= (preceding-char) ?\\)
+	 (forward-line 1)
+	 (end-of-line))
+       (point))))
+   ;; #if, #ifdef, #ifndef, #else, #elif
+   ((looking-at "^#[ \n\t]*\\(if\\|ifdef\\|ifndef\\|else\\|elif\\)\\b")
+    (let ((start (match-beginning 0))
+	  (counter 1)
+	  match)
+      (goto-char (match-end 0))
+      (while (and (>= counter 1)
+		  (re-search-forward 
+		   "^#[ \n\t]*\\(if\\|ifdef\\|ifndef\\|endif\\)\\b"
+		   nil t))
+	(setq match 
+	      (buffer-substring (match-beginning 1) (match-end 1)))
+	(setq counter 
+	      (if (string= match "endif")
+		  (1- counter)
+		(1+ counter))))
+      (if (= counter 0)
+	  (thing-region start (match-end 0)))))
+   ((looking-at "^#[ \n\t]*endif\\b")   ; #endif
+    (let ((end (match-end 0))
+	  (counter 1)
+	  match)
+      (goto-char (match-beginning 0))
+      (while (and (>= counter 1)
+		  (re-search-backward
+		   "^#[ \n\t]*\\(if\\|ifdef\\|ifndef\\|endif\\)\\b"
+		   nil t))
+	(setq match 
+	      (buffer-substring (match-beginning 1) (match-end 1)))
+	(setq counter 
+	      (if (string= match "endif")
+		  (1+ counter)
+		(1- counter))))
+      (if (= counter 0)
+	  (thing-region (match-beginning 0) end))))))
+
+(defun c-skip-over-comment ()
+  (let ((aux (point)))
+    (skip-chars-forward "\n\t ")
+    (or (and (= (following-char) ?/)
+	     (= (char-after (1+ (point))) ?*)
+	     (search-forward "*/" nil t)
+	     (point))
+	(goto-char aux))))
+
+(defun c-forward-statement (&optional keyword)
+  (c-skip-over-comment)
+  (skip-chars-forward " \n\t")
+  (or keyword (setq keyword 
+		    (if (looking-at c-statement-starting-keyword-regexpr)
+			(buffer-substring 
+			 (match-beginning 1)
+			 (match-end 1)))))
+  (if keyword
+      (cond ((string= keyword "if")
+	     (c-forward-if))
+	    ((string= keyword "do")
+	     (c-forward-do-while))
+	    ((member keyword '("for" "while" "switch"))
+	     (c-forward-for/while/switch))
+	    ((member keyword '("break" "continue"))
+	     (c-forward-break/continue)))
+    (cond ((= (following-char) ?\{)
+	   (forward-list 1)
+	   (point))
+	  (t
+	   ;; Here I use that each C statement other then 
+	   ;; a bloc, if, while, for, do ... ends in a `;'
+	   (let (char)
+	     (catch 'exit
+	       (while t
+		 (if (eobp) (throw 'exit nil))
+		 (setq char (following-char))
+		 (cond ((= (char-syntax char) ?.) 
+			(forward-char 1)
+			(if (= char ?\;) (throw 'exit (point))))
+		       (t (forward-sexp 1)
+			  (skip-chars-forward " \n\t"))))))))))
+
+(defun c-forward-if ()
+  (let (aux)
+    (forward-word 1) ; if
+    (forward-list 1) 
+    (c-forward-statement)
+    (setq aux (point))
+    (skip-chars-forward "\n\t ")
+    (if (looking-at "else\\b")
+	(c-forward-else)
+	(goto-char aux))))
+
+(defun c-forward-else ()
+  (forward-word 1) ; else
+  (c-forward-statement))
+
+(defun c-forward-for/while/switch ()
+  (forward-word 1) ; for
+  (forward-list 1)
+  (c-forward-statement))
+
+(defun c-forward-do-while ()
+  (forward-word 1) ; do ... while
+  (c-forward-statement)
+  (c-forward-for/while/switch))
+
+(defun c-forward-switch ()
+  (forward-word 1) ; switch
+  (forward-list 2)
+  (point))
+
+(defun c-forward-break/continue ()
+  (forward-word 1) ; keyword
+  (c-skip-over-comment)
+  (skip-chars-forward "\n\t ")
+  (if (= (following-char) ?\;)
+      (goto-char (1+ (point)))))
+
+;; Tcl syntax scanner
+(defvar tcl-builtin-commands nil
+  "Alist of information about tcl syntax for the tcl-boundaries function.  
+An entry has the form 
+	\(<command-string> . <syntax description>\) 
+where 
+	<command-string>     is the name of a tcl command
+	<syntax description> is one of 
+            list of integers: the number of possible arguments
+	    t:		      any number of arguments")
+
+(defconst tcl-commands
+  '(
+    ("append"	. (2 . nil))
+    ("array"	. (2 . 3))
+    ("break"	. 0)
+    ("case" 	. 3)
+    ("catch"	. 1)
+    ("cd"	. 1)
+    ("close"	. 1)
+    ("concat"	. t)
+    ("continue"	. 0)
+    ("else" 	. (1 . nil))
+    ("elseif"	. (1 . nil))
+    ("eof"	. 1)
+    ("error"	. t)
+    ("eval"     . t)
+    ("exec"     . t)
+    ("exit"	. (0 . 1))
+    ("expr" 	. 1)
+    ("file"	. (2 . nil))
+    ("flush"	. 1)
+    ("for" 	. 4)
+    ("foreach" 	. 3)
+    ("format"	. (1 . nil))
+    ("gets"	. (1 . 2))
+    ("glob"	. t)
+    ("global" 	. (1 . nil))
+    ("history"	. t)
+    ("if" 	. (2 . nil))
+    ("incr" 	. (1 . 2))
+    ("info"	. (1 . 4))
+    ("join"	. (1 . 2))
+    ("lappend"	. (2 . nil))
+    ("lindex" 	. 2)
+    ("linsert"	. (3 . nil))
+    ("list"	. t)
+    ("llength" 	. 1)
+    ("lrange" 	. 3)
+    ("lreplace"	. (3 . nil))
+    ("lsearch" 	. 2)
+    ("lsort"	. 1)
+    ("open"	. (1 . 2))
+    ("proc" 	. 3)
+    ("puts"	. (1 . 3))
+    ("pwd"	. 0)
+    ("read"	. (1 . 2))
+    ("regexp"	. (2 . nil))
+    ("regsub"	. (4 . 6))
+    ("rename"	. 2)
+    ("return"	. (0 .1))
+    ("scan"	. (3 . nil))
+    ("seek"	. (2 . 3))
+    ("set" 	. (1 . 2))
+    ("source"	. 1)
+    ("split"	. (1 . 2))
+    ("string"	. (2 . 4))
+    ("tell"	. 1)
+    ("time"	. (1 .2))
+    ("trace"	. (1 . nil))
+    ("unknown"	. (1 . nil))
+    ("unset"	. (1 . nil))
+    ("uplevel"	. (1 . nil))
+    ("upvar"	. (2 . nil))
+    ("while" 	. 2)
+    ))
+
+(defconst tk-commands
+  '(("bind"	. 3)
+    ("button"	. t)
+    ("canvas"	. t)
+    ("frame"	. t)
+    ("label"	. t)
+    ("listbox"	. t)
+    ("menu"	. t)
+    ("menubutton"	. t)
+    ("pack"	. t)
+    ("scrollbar"	. t)
+    ("tree"	. t)
+    ("wm"		. t)
+    ))
+
+(defconst tcl-tk-commands
+  (nconc tcl-commands tk-commands))
+  
+(defconst tcl-tk-commands-regexp
+  (format "\\(%s\\\)\\W" (mapconcat 'car tcl-tk-commands "\\|")))
+
+(defun tcl-boundaries (here)
+  (save-excursion
+    (goto-char here)
+    (skip-chars-backward "a-z")
+    (if (looking-at 
+	 tcl-tk-commands-regexp)
+	(let* ((count 0) 
+	      (start (point))
+	      (keyword (buffer-substring
+			(match-beginning 1)
+			(match-end 1)))
+	      (syntax-description 
+	       (cdr (assoc keyword tcl-tk-commands))))
+	  (goto-char (match-end 0))
+	  (while (not (looking-at "[ \t]*[]\n;}]"))
+	    (setq count (1+ count))
+	    (tcl-forward-sexp1)
+	    ;; skipping over the parentheses of array expressions:
+	    (while (not (or (looking-at "[ \t]*[]\n;}]")
+			    (= (char-syntax (following-char)) ? )))
+	      (tcl-forward-sexp1)))
+
+	  (if (cond ((eq syntax-description t))
+		    ((integerp syntax-description) 
+		     (= syntax-description count))
+		    ((consp syntax-description)
+		     (and (<= (car syntax-description) count)
+			  (or (null (cdr syntax-description))
+			      (<= count (cdr syntax-description))))))
+	      (progn 
+		(message "`%s' matched."  keyword)
+		(thing-region start (point)))
+	    (progn 
+	      (message "wrong syntax: `%s'."  keyword)
+	      nil)))
+      (message "")
+      (thing-boundaries here))))
+
+(defun tcl-forward-sexp (&optional arg)
+  "Move forward across one balanced tcl expression.
+With argument, do it that many times."
+  (interactive "p")
+  (if (< arg 0) (error "negative argument not allowed"))
+  (or arg (setq arg 1))
+  (while (> arg 0)
+    (tcl-forward-sexp1)
+    (setq arg (1- arg))))
+
+(defun tcl-forward-sexp1 ()
+  (interactive "")  
+  (let ((start (point))
+	next-char syntax (first-scan t))
+    (setq next-char (following-char)
+	  syntax (char-syntax next-char))
+
+    (while (or (= next-char ?\;)
+	       (memq syntax '(? ?>)))
+      (forward-char 1)
+      (setq next-char (following-char)
+	    syntax (char-syntax next-char)))
+
+    (condition-case var
+	(catch 'exit 
+	  (while t
+	    (setq next-char (following-char)
+		  syntax (char-syntax next-char))
+	    (cond ((= next-char ?\;)
+		   (throw 'exit nil))
+		  ((memq syntax (if first-scan '(? ?>) '(? ?> ?\))))
+		   (throw 'exit nil))
+		  (t 
+		   (goto-char (or (scan-sexps (point) 1) 
+				  (point-max)))))
+	    (setq first-scan nil)))
+      (error (goto-char start)
+	     (error (car (cdr var)))))))
+
+;; (define-key tcl-mode-map "\M-\C-f" 'tcl-forward-sexp)
+
+(defun mode-motion-eval-func (eval-func)
+  (let ((old-buf (current-buffer))
+	(old-window (selected-window)))
+    (unwind-protect 
+	(let ((extent (or primary-selection-extent
+			  (and (extentp mode-motion-last-extent)
+			       (not (extent-property mode-motion-last-extent
+						     'detached))
+			       mode-motion-last-extent))))
+
+	  (if (and (extentp extent)
+		   (set-buffer (extent-buffer extent))
+		   (not 
+		    ;; zero length extents
+		    (= (extent-start-position extent)
+		       (extent-end-position extent))))
+
+	      (let* ((start (extent-start-position extent))
+		     (end (extent-end-position extent)))
+
+		(funcall eval-func start end))
+
+	    (error "No current primary or motion selection.")
+	    ))
+      (set-buffer old-buf)
+      (select-window old-window))))
+
+(defun mode-motion-eval-region ()
+  (interactive)
+  (mode-motion-eval-func 'eval-region))
+
+
+;; Motion highlight faces and initialization.
+
+(defun sect-handler (string)
+  "Return the symbol corresponding to the foo-STRING handler for this sect."
+  (intern-soft (concat (symbol-name mode-motion+-religion) string)))
+
+(defun mode-motion-init-handlers-according-to-religion (&optional forcep)
+  (interactive)
+  ;; Initialise default motion handlers depending on religious sect!
+  (let ((foo-thing (sect-handler "-thing"))
+	(foo-c (sect-handler "-c"))
+	(foo-LaTeX (sect-handler "-laTeX"))
+	(foo-line@ (sect-handler "-line@"))
+	(foo-vline@ (sect-handler "-vline@")))
+    (if forcep
+	(progn
+	  (setq default-motion-handler (find-motion-handler foo-thing))
+	  (set-mode-motion-handler 'emacs-lisp-mode foo-thing)
+	  (set-mode-motion-handler 'lisp-interaction-mode foo-thing)
+	  (set-mode-motion-handler 'c-mode foo-c)
+	  (set-mode-motion-handler 'c++-mode foo-c)
+	  (set-mode-motion-handler 'c++-c-mode foo-c)
+	  (set-mode-motion-handler 'tex-mode foo-LaTeX)
+	  (set-mode-motion-handler 'latex-mode foo-LaTeX)
+	  (set-mode-motion-handler 'Buffer-menu-mode foo-vline@)
+	  (set-mode-motion-handler 'Electric-Buffer-menu-mode foo-vline@)
+	  (set-mode-motion-handler 'gnus-Group-mode foo-vline@)
+	  (set-mode-motion-handler 'gnus-Subject-mode foo-vline@)
+	  (set-mode-motion-handler 'gnus-group-mode foo-vline@)
+	  (set-mode-motion-handler 'gnus-subject-mode foo-vline@)
+	  (set-mode-motion-handler 'gnus-summary-mode foo-vline@)
+	  (set-mode-motion-handler 'dired-mode foo-line@)
+	  (set-mode-motion-handler 'compilation-mode foo-line@)
+	  (set-mode-motion-handler 'occur-mode foo-line@)
+	  (set-mode-motion-handler 'tar-mode foo-vline@)
+	  (set-mode-motion-handler 'rmail-summary-mode foo-vline@)
+	  (set-mode-motion-handler 'vm-summary-mode (sect-handler "-line"))
+	  (set-mode-motion-handler 'tcl-mode (sect-handler "-tcl"))
+	  (set-mode-motion-handler 'texinfo-mode (sect-handler "-TeXinfo"))
+	  (set-mode-motion-handler 'cvs-mode (sect-handler "-cvs-line")))
+      (setq default-motion-handler
+	    (or default-motion-handler (find-motion-handler foo-thing)))
+      (or (get 'emacs-lisp-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'emacs-lisp-mode foo-thing))
+      (or (get 'lisp-interaction-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'lisp-interaction-mode foo-thing))
+      (or (get 'c-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'c-mode foo-c))
+      (or (get 'c++-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'c++-mode foo-c))
+      (or (get 'c++-c-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'c++-c-mode foo-c))
+      (or (get 'tex-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'tex-mode foo-LaTeX))
+      (or (get 'latex-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'latex-mode foo-LaTeX))
+      (or (get 'Buffer-menu-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'Buffer-menu-mode foo-vline@))
+      (or (get 'Electric-Buffer-menu-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'Electric-Buffer-menu-mode foo-vline@))
+      (or (get 'gnus-Group-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'gnus-Group-mode foo-vline@))
+      (or (get 'gnus-Subject-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'gnus-Subject-mode foo-vline@))
+      (or (get 'gnus-group-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'gnus-group-mode foo-vline@))
+      (or (get 'gnus-subject-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'gnus-subject-mode foo-vline@))
+      (or (get 'gnus-summary-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'gnus-summary-mode foo-vline@))
+      (or (get 'dired-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'dired-mode foo-line@))
+      (or (get 'compilation-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'compilation-mode foo-line@))
+      (or (get 'occur-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'occur-mode foo-line@))
+      (or (get 'tar-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'tar-mode foo-vline@))
+      (or (get 'rmail-summary-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'rmail-summary-mode foo-vline@))
+      (or (get 'vm-summary-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'vm-summary-mode (sect-handler "-line")))
+      (or (get 'tcl-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'tcl-mode (sect-handler "-tcl")))
+      (or (get 'texinfo-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'texinfo-mode (sect-handler "-TeXinfo")))
+      (or (get 'cvs-mode 'mode-motion-handler)
+	  (set-mode-motion-handler 'cvs-mode (sect-handler "-cvs-line"))))))
+
+;; Null Handlers (for disabling motion highlighting)
+(defun thing-null (here) nil)
+(make-motion-handler 'no-thing 'thing-null)
+(make-motion-handler 'no-c 'thing-null)
+(make-motion-handler 'no-laTeX 'thing-null)
+(make-motion-handler 'no-line 'thing-null)
+(make-motion-handler 'no-line@ 'thing-null)
+(make-motion-handler 'no-vline 'thing-null)
+(make-motion-handler 'no-vline@ 'thing-null)
+(make-motion-handler 'no-tcl 'thing-null)
+(make-motion-handler 'no-TeXinfo 'thing-null)
+(make-motion-handler 'no-cvs-line 'thing-null)
+
+(defun mode-motion-init ()
+  "enable mode-motion+ package"
+  (interactive)
+
+(setq mode-motion-last-extent nil)
+  
+(global-set-key '(meta button2) 'mode-motion-copy)
+(global-set-key '(meta shift button2) 'mode-motion-move)
+(global-set-key '(meta control button2) 'mode-motion-kill)
+(global-set-key '(meta control shift button2) 'mode-motion-copy-as-kill)
+(global-set-key '(meta control symbol button2) 'mode-motion-copy-as-kill)
+
+(if mode-motion-setup-cut-and-paste-bindings
+    (progn 
+      (global-set-key 'f16 'mode-motion-copy-as-kill) ; Copy
+      (global-set-key 'f18 'yank)	              ; Paste
+      (global-set-key 'f20 'mode-motion-kill)))       ; Cut
+
+;; I don't want the thing-boundaries function select whitespaces 
+(setq thing-report-whitespace nil thing-report-char-p nil)
+
+;; bold motion face (bold, if this is not the default, unbold otherwise)
+(if (find-face 'motion-bold)
+    ()
+  (make-face 'motion-bold)
+  (make-face-bold 'motion-bold)
+  (or (face-differs-from-default-p 'motion-bold)
+      (make-face-unbold 'motion-bold)))
+
+;; an underline face
+(if (find-face 'motion-underline)
+    ()
+  (make-face 'motion-underline)
+  (set-face-underline-p 'motion-underline t))
+
+;; an inverted face
+(if (find-face 'motion-inverted)
+    ()
+  (make-face 'motion-inverted)
+  (make-face-bold 'motion-inverted)
+  (invert-face 'motion-inverted))
+
+(if (find-face 'motion-gray)
+    ()
+  (make-face 'motion-gray)
+  (set-face-background-pixmap 'motion-gray "gray1.xbm"))
+ 
+;; Motion Handlers
+
+;; Special Minibuffer handler
+
+(make-motion-handler 'minibuffer 'minibuffer-selection-boundaries 'highlight t nil)
+
+;; Things
+(make-motion-handler 'bold-thing 'thing-boundaries 'motion-bold)
+(make-motion-handler 'gray-thing 'thing-boundaries 'motion-gray)
+(make-motion-handler 'highlight-thing 'thing-boundaries 'highlight)
+(make-motion-handler 'invert-thing 'thing-boundaries 'motion-inverted)
+(make-motion-handler 'underline-thing 'thing-boundaries 'motion-underline)
+
+;; Lines
+(make-motion-handler 'bold-line 'line-boundaries 'motion-bold)
+(make-motion-handler 'gray-line 'line-boundaries 'motion-gray)
+(make-motion-handler 'highlight-line 'line-boundaries 'highlight)
+(make-motion-handler 'invert-line 'line-boundaries 'motion-inverted)
+(make-motion-handler 'underline-line 'line-boundaries 'motion-underline)
+(make-motion-handler 'bold-line@ 'line-boundaries 'motion-bold t t)
+(make-motion-handler 'gray-line@ 'line-boundaries 'motion-gray nil t)
+(make-motion-handler 'highlight-line@ 'line-boundaries 'highlight nil t)
+(make-motion-handler 'invert-line@ 'line-boundaries 'motion-inverted nil t)
+(make-motion-handler 'underline-line@ 'line-boundaries 'motion-underline nil t)
+
+;; Visible text of line
+(make-motion-handler 'bold-vline 'visible-line-boundaries 'motion-bold)
+(make-motion-handler 'gray-vline 'visible-line-boundaries 'motion-gray)
+(make-motion-handler 'highlight-vline 'visible-line-boundaries 'highlight)
+(make-motion-handler 'invert-vline 'visible-line-boundaries 'motion-inverted)
+(make-motion-handler 'underline-vline 'visible-line-boundaries 'motion-underline)
+(make-motion-handler 'bold-vline@ 'visible-line-boundaries 'motion-bold t t)
+(make-motion-handler 'gray-vline@ 'visible-line-boundaries 'motion-gray nil t)
+(make-motion-handler 'highlight-vline@ 'visible-line-boundaries 'highlight nil t)
+(make-motion-handler 'invert-vline@ 'visible-line-boundaries 'motion-inverted nil t)
+(make-motion-handler 'underline-vline@ 'visible-line-boundaries 'motion-underline nil t)
+
+;; CVS lines
+(make-motion-handler 'bold-cvs-line 'cvs-line-boundaries 'motion-bold)
+(make-motion-handler 'gray-cvs-line 'cvs-line-boundaries 'motion-gray)
+(make-motion-handler 'highlight-cvs-line 'cvs-line-boundaries 'highlight)
+(make-motion-handler 'invert-cvs-line 'cvs-line-boundaries 'motion-inverted)
+(make-motion-handler
+ 'underline-cvs-line 'cvs-line-boundaries 'motion-underline)
+
+;; (La)TeX 
+(make-motion-handler 'bold-LaTeX 'latex-boundaries 'motion-bold)
+(make-motion-handler 'gray-LaTeX 'latex-boundaries 'motion-gray)
+(make-motion-handler 'highlight-LaTeX 'latex-boundaries 'highlight)
+(make-motion-handler 'invert-LaTeX 'latex-boundaries 'motion-inverted)
+(make-motion-handler 'underline-LaTeX 'latex-boundaries 'motion-underline)
+
+;; TeXinfo
+(make-motion-handler 'bold-TeXinfo 'texinfo-boundaries 'motion-bold)
+(make-motion-handler 'gray-TeXinfo 'texinfo-boundaries 'motion-gray)
+(make-motion-handler 'highlight-TeXinfo 'texinfo-boundaries 'highlight)
+(make-motion-handler 'invert-TeXinfo 'texinfo-boundaries 'motion-inverted)
+(make-motion-handler 'underline-TeXinfo 'texinfo-boundaries 'motion-underline)
+
+;; C and C++
+(make-motion-handler 'bold-c 'c-boundaries 'motion-bold)
+(make-motion-handler 'gray-c 'c-boundaries 'motion-gray)
+(make-motion-handler 'highlight-c 'c-boundaries 'highlight)
+(make-motion-handler 'invert-c 'c-boundaries 'motion-inverted)
+(make-motion-handler 'underline-c 'c-boundaries 'motion-underline)
+
+;; Tcl/Tk
+(make-motion-handler 'bold-tcl 'tcl-boundaries 'motion-bold)
+(make-motion-handler 'gray-tcl 'tcl-boundaries 'motion-gray)
+(make-motion-handler 'highlight-tcl 'tcl-boundaries 'highlight)
+(make-motion-handler 'invert-tcl 'tcl-boundaries 'motion-inverted)
+(make-motion-handler 'underline-tcl 'tcl-boundaries 'motion-underline)
+
+;; mouse tracker
+(make-motion-handler 'track-mouse@ 'char-boundaries nil nil t)
+(make-motion-handler 'highlight-char 'char-boundaries 'highlight)
+
+;; augment the basic mouse motion handler (if any)
+(setq-default mode-motion-hook 
+	      (if (listp mode-motion-hook)
+		  (if (memq #'mode-motion+-highlight mode-motion-hook)
+		      mode-motion-hook
+		    (append mode-motion-hook (list #'mode-motion+-highlight)))
+		(list mode-motion-hook #'mode-motion+-highlight)))
+
+(or mode-motion+-religion 
+    (setq mode-motion+-religion (if (x-display-color-p) 'underline 'invert)))
+
+(add-menu '("Options") (car mode-motion+-options-menu)
+	  (cdr mode-motion+-options-menu)
+	  "Paren Highlighting")
+
+;; shut your eyes, this is a kludge. I didn't have time to find/write
+;; a function to do this.
+(or (member ["Eval Motion Region" mode-motion-eval-region t]
+	    lisp-interaction-mode-popup-menu)
+    (and (setq lisp-interaction-mode-popup-menu
+	       (copy-sequence lisp-interaction-mode-popup-menu))
+	 (setcdr (nthcdr 1 lisp-interaction-mode-popup-menu)
+		 (cons ["Eval Motion Region" mode-motion-eval-region t]
+		       (nthcdr 2 lisp-interaction-mode-popup-menu)))))
+
+(or (member ["Eval Motion Region" mode-motion-eval-region t]
+	    emacs-lisp-mode-popup-menu)
+    (and (setq emacs-lisp-mode-popup-menu
+	       (copy-sequence emacs-lisp-mode-popup-menu))
+	 (setcdr (nthcdr 3 emacs-lisp-mode-popup-menu)
+		 (cons ["Eval Motion Region" mode-motion-eval-region t]
+		       (nthcdr 4 emacs-lisp-mode-popup-menu)))))
+
+;; Clear the last active motion extent when leaving a frame.
+(if (boundp 'mouse-leave-frame-hook)
+    (add-hook 'mouse-leave-frame-hook 'mode-motion-clear-last-extent)
+  (add-hook 'mouse-leave-screen-hook 'mode-motion-clear-last-extent))
+	       
+(run-hooks 'mode-motion+-load-hook)
+(mode-motion-init-handlers-according-to-religion)
+
+(if (interactive-p) (message "mode-motion+ enabled")))
+
+(if (and (not purify-flag)
+	 (or (not (boundp 'opt-mode-motion+)) opt-mode-motion+))
+    (mode-motion-init))
+
+(provide 'mode-motion+)
+;; end mode-motion+