annotate lisp/mode-motion.el @ 255:084402c475ba r20-5b26

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