|
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
|
