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