428
+ − 1 ;;; mode-motion.el --- Mode-specific mouse-highlighting of text.
+ − 2
+ − 3 ;; Copyright (C) 1992, 1993, 1997 Free Software Foundation, Inc.
+ − 4
+ − 5 ;; Maintainer: XEmacs Development Team
+ − 6 ;; Keywords: internal, mouse, dumped
+ − 7
+ − 8 ;; This file is part of XEmacs.
+ − 9
+ − 10 ;; XEmacs is free software; you can redistribute it and/or modify it
+ − 11 ;; under the terms of the GNU General Public License as published by
+ − 12 ;; the Free Software Foundation; either version 2, or (at your option)
+ − 13 ;; any later version.
+ − 14
+ − 15 ;; XEmacs is distributed in the hope that it will be useful, but
+ − 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
+ − 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ − 18 ;; General Public License for more details.
+ − 19
+ − 20 ;; You should have received a copy of the GNU General Public License
+ − 21 ;; along with XEmacs; see the file COPYING. If not, write to the
+ − 22 ;; Free Software Foundation, 59 Temple Place - Suite 330,
+ − 23 ;; Boston, MA 02111-1307, USA.
+ − 24
+ − 25 ;;; Synched up with: Not in FSF.
+ − 26
+ − 27 ;;; Commentary:
+ − 28
+ − 29 ;; This file is dumped with XEmacs (when window system support is compiled in).
+ − 30
+ − 31 ;;; Code:
+ − 32
+ − 33 (defvar mode-motion-hook nil
+ − 34 "Function or functions which are called whenever the mouse moves.
+ − 35 Each function must take a single argument of the motion event.
+ − 36 You should normally use this rather than `mouse-motion-handler', which
+ − 37 does some additional window-system-dependent things. This hook is local
+ − 38 to every buffer, and should normally be set up by major-modes which want
+ − 39 to use special highlighting. Every time the mouse moves over a window,
+ − 40 the mode-motion-hook of the buffer of that window is run.")
+ − 41
+ − 42 (make-variable-buffer-local 'mode-motion-hook)
+ − 43
+ − 44 (defvar mode-motion-extent nil)
+ − 45 (make-variable-buffer-local 'mode-motion-extent)
+ − 46
+ − 47 (defvar mode-motion-help-echo-string nil
+ − 48 "String to be added as the 'help-echo property of the mode-motion extent.
+ − 49 In order for this to work, you need to add the hook function
+ − 50 `mode-motion-add-help-echo' to the mode-motion hook. If this is a function,
+ − 51 it will be called with one argument (the event) and should return a string
+ − 52 to be added. This variable is local to every buffer.")
+ − 53 (make-variable-buffer-local 'mode-motion-help-echo-string)
+ − 54
+ − 55 (defun mode-motion-ensure-extent-ok (event)
+ − 56 (let ((buffer (event-buffer event)))
+ − 57 (if (and (extent-live-p mode-motion-extent)
+ − 58 (eq buffer (extent-object mode-motion-extent)))
+ − 59 nil
+ − 60 (setq mode-motion-extent (make-extent nil nil buffer))
+ − 61 (set-extent-property mode-motion-extent 'mouse-face 'highlight))))
+ − 62
+ − 63 (defun mode-motion-highlight-internal (event backward forward)
+ − 64 (let* ((buffer (event-buffer event))
+ − 65 (point (and buffer (event-point event))))
+ − 66 (if (and buffer
+ − 67 (not (eq buffer mouse-grabbed-buffer)))
+ − 68 ;; #### ack!! Too many calls to save-window-excursion /
+ − 69 ;; save-excursion (x-track-pointer calls, so does
+ − 70 ;; minibuf-mouse-tracker ...) This needs to be looked
+ − 71 ;; into. It's complicated by the fact that sometimes
+ − 72 ;; a mode-motion-hook might really want to change
+ − 73 ;; the point.
+ − 74 ;;
+ − 75 ;; #### The save-excursion must come before the
+ − 76 ;; save-window-excursion in order to function properly. I
+ − 77 ;; haven't given this much thought. Is it a bug that this
+ − 78 ;; ordering is necessary or is it correct behavior?
+ − 79 (save-excursion
+ − 80 (save-window-excursion
+ − 81 (set-buffer buffer)
+ − 82 (mode-motion-ensure-extent-ok event)
+ − 83 (if point
+ − 84 ;; Use save-excursion here to avoid
+ − 85 ;; save-window-excursion seeing a change in
+ − 86 ;; window point's value which would make the
+ − 87 ;; display code do a whole lot of useless work
+ − 88 ;; and making the display flicker horribly.
+ − 89 (save-excursion
+ − 90 (goto-char point)
+ − 91 (condition-case nil (funcall backward) (error nil))
+ − 92 (setq point (point))
+ − 93 (condition-case nil (funcall forward) (error nil))
+ − 94 (if (eq point (point))
+ − 95 (detach-extent mode-motion-extent)
+ − 96 (set-extent-endpoints mode-motion-extent point (point))))
+ − 97 ;; not over text; zero the extent.
+ − 98 (detach-extent mode-motion-extent)))))))
+ − 99
+ − 100 (defun mode-motion-highlight-line (event)
+ − 101 "For use as the value of `mode-motion-hook' -- highlight line under mouse."
+ − 102 (mode-motion-highlight-internal event 'beginning-of-line 'end-of-line))
+ − 103
+ − 104 (defun mode-motion-highlight-word (event)
+ − 105 "For use as the value of `mode-motion-hook' -- highlight word under mouse."
+ − 106 (mode-motion-highlight-internal
+ − 107 event
+ − 108 #'(lambda () (default-mouse-track-beginning-of-word nil))
+ − 109 #'(lambda () (default-mouse-track-end-of-word nil))))
+ − 110
+ − 111 (defun mode-motion-highlight-symbol (event)
+ − 112 "For use as the value of `mode-motion-hook' -- highlight symbol under mouse."
+ − 113 (mode-motion-highlight-internal
+ − 114 event
+ − 115 #'(lambda () (default-mouse-track-beginning-of-word t))
+ − 116 #'(lambda () (default-mouse-track-end-of-word t))))
+ − 117
+ − 118 (defun mode-motion-highlight-sexp (event)
+ − 119 "For use as the value of `mode-motion-hook' -- highlight form under mouse."
+ − 120 (mode-motion-highlight-internal
+ − 121 event
+ − 122 #'(lambda ()
+ − 123 (if (= (char-syntax (following-char)) ?\()
+ − 124 nil
+ − 125 (goto-char (scan-sexps (point) -1))))
+ − 126 #'(lambda ()
+ − 127 (if (= (char-syntax (following-char)) ?\))
+ − 128 (forward-char 1))
+ − 129 (goto-char (scan-sexps (point) 1)))))
+ − 130
+ − 131 (defun mode-motion-add-help-echo (event)
+ − 132 "For use as the value of `mode-motion-hook' -- add a 'help-echo property.
+ − 133 This causes the string in the 'help-echo property to be displayed when the
+ − 134 mouse moves over the extent. See `mode-motion-help-echo-string' for
+ − 135 documentation on how to control the string that is added."
+ − 136 (mode-motion-ensure-extent-ok event)
+ − 137 (let ((string (cond ((null mode-motion-help-echo-string) nil)
+ − 138 ((stringp mode-motion-help-echo-string)
+ − 139 mode-motion-help-echo-string)
+ − 140 (t (funcall mode-motion-help-echo-string event)))))
+ − 141 (if (stringp string)
+ − 142 (set-extent-property mode-motion-extent 'help-echo string))))
+ − 143
+ − 144
+ − 145 (provide 'mode-motion)
+ − 146
+ − 147 ;;; mode-motion.el ends here
