1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
;; Mode-specific mouse-highlighting of text.
;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
;; This file is part of XEmacs.
;; XEmacs 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.
;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the
;; Free Software Foundation, 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Synched up with: Not in FSF.
(defvar mode-motion-hook nil
"Function or functions which are called whenever the mouse moves.
You should normally use this rather than `mouse-motion-handler', which
does some additional window-system-dependent things. This hook is local
to every buffer, and should normally be set up by major-modes which want
to use special highlighting. Every time the mouse moves over a window,
the mode-motion-hook of the buffer of that window is run.")
(make-variable-buffer-local 'mode-motion-hook)
(defvar mode-motion-extent nil)
(make-variable-buffer-local 'mode-motion-extent)
(defvar mode-motion-help-echo-string nil
"String to be added as the 'help-echo property of the mode-motion extent.
In order for this to work, you need to add the hook function
`mode-motion-add-help-echo' to the mode-motion hook. If this is a function,
it will be called with one argument (the event) and should return a string
to be added. This variable is local to every buffer.")
(make-variable-buffer-local 'mode-motion-help-echo-string)
(defun mode-motion-ensure-extent-ok (event)
(let ((buffer (event-buffer event)))
(if (and (extent-live-p mode-motion-extent)
(eq buffer (extent-object mode-motion-extent)))
nil
(setq mode-motion-extent (make-extent nil nil buffer))
(set-extent-property mode-motion-extent 'mouse-face 'highlight))))
(defun mode-motion-highlight-internal (event backward forward)
(let* ((buffer (event-buffer event))
(point (and buffer (event-point event))))
(if (and buffer
(not (eq buffer mouse-grabbed-buffer)))
;; #### ack!! Too many calls to save-window-excursion /
;; save-excursion (x-track-pointer calls, so does
;; minibuf-mouse-tracker ...) This needs to be looked
;; into. It's complicated by the fact that sometimes
;; a mode-motion-hook might really want to change
;; the point.
;;
;; #### The save-excursion must come before the
;; save-window-excursion in order to function properly. I
;; haven't given this much thought. Is it a bug that this
;; ordering is necessary or is it correct behavior?
(save-excursion
(save-window-excursion
(set-buffer buffer)
(mode-motion-ensure-extent-ok event)
(if point
(progn
(goto-char point)
(condition-case nil (funcall backward) (error nil))
(setq point (point))
(condition-case nil (funcall forward) (error nil))
(if (eq point (point))
(detach-extent mode-motion-extent)
(set-extent-endpoints mode-motion-extent point (point))))
;; not over text; zero the extent.
(detach-extent mode-motion-extent)))))))
(defun mode-motion-highlight-line (event)
"For use as the value of `mode-motion-hook' -- highlight line under mouse."
(mode-motion-highlight-internal event 'beginning-of-line 'end-of-line))
(defun mode-motion-highlight-word (event)
"For use as the value of `mode-motion-hook' -- highlight word under mouse."
(mode-motion-highlight-internal
event
#'(lambda () (default-mouse-track-beginning-of-word nil))
#'(lambda () (default-mouse-track-end-of-word nil))))
(defun mode-motion-highlight-symbol (event)
"For use as the value of `mode-motion-hook' -- highlight symbol under mouse."
(mode-motion-highlight-internal
event
#'(lambda () (default-mouse-track-beginning-of-word t))
#'(lambda () (default-mouse-track-end-of-word t))))
(defun mode-motion-highlight-sexp (event)
"For use as the value of `mode-motion-hook' -- highlight form under mouse."
(mode-motion-highlight-internal
event
#'(lambda ()
(if (= (char-syntax (following-char)) ?\()
nil
(goto-char (scan-sexps (point) -1))))
#'(lambda ()
(if (= (char-syntax (following-char)) ?\))
(forward-char 1))
(goto-char (scan-sexps (point) 1)))))
(defun mode-motion-add-help-echo (event)
"For use as the value of `mode-motion-hook' -- add a 'help-echo property.
This causes the string in the 'help-echo property to be displayed when the
mouse moves over the extent. See `mode-motion-help-echo-string' for
documentation on how to control the string that is added."
(mode-motion-ensure-extent-ok event)
(let ((string (cond ((null mode-motion-help-echo-string) nil)
((stringp mode-motion-help-echo-string)
mode-motion-help-echo-string)
(t (funcall mode-motion-help-echo-string event)))))
(if (stringp string)
(set-extent-property mode-motion-extent 'help-echo string))))
(provide 'mode-motion)
|
