Mercurial > hg > xemacs-beta

comparison lisp/mode-motion.el @ 209:41ff10fd062f r20-4b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b3
author cvs
date Mon, 13 Aug 2007 10:04:58 +0200
parents
children 084402c475ba
comparison
equal deleted inserted replaced
208:f427b8ec4379 209:41ff10fd062f
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 You should normally use this rather than `mouse-motion-handler', which
36 does some additional window-system-dependent things. This hook is local
37 to every buffer, and should normally be set up by major-modes which want
38 to use special highlighting. Every time the mouse moves over a window,
39 the mode-motion-hook of the buffer of that window is run.")
40
41 (make-variable-buffer-local 'mode-motion-hook)
42
43 (defvar mode-motion-extent nil)
44 (make-variable-buffer-local 'mode-motion-extent)
45
46 (defvar mode-motion-help-echo-string nil
47 "String to be added as the 'help-echo property of the mode-motion extent.
48 In order for this to work, you need to add the hook function
49 `mode-motion-add-help-echo' to the mode-motion hook. If this is a function,
50 it will be called with one argument (the event) and should return a string
51 to be added. This variable is local to every buffer.")
52 (make-variable-buffer-local 'mode-motion-help-echo-string)
53
54 (defun mode-motion-ensure-extent-ok (event)
55 (let ((buffer (event-buffer event)))
56 (if (and (extent-live-p mode-motion-extent)
57 (eq buffer (extent-object mode-motion-extent)))
58 nil
59 (setq mode-motion-extent (make-extent nil nil buffer))
60 (set-extent-property mode-motion-extent 'mouse-face 'highlight))))
61
62 (defun mode-motion-highlight-internal (event backward forward)
63 (let* ((buffer (event-buffer event))
64 (point (and buffer (event-point event))))
65 (if (and buffer
66 (not (eq buffer mouse-grabbed-buffer)))
67 ;; #### ack!! Too many calls to save-window-excursion /
68 ;; save-excursion (x-track-pointer calls, so does
69 ;; minibuf-mouse-tracker ...) This needs to be looked
70 ;; into. It's complicated by the fact that sometimes
71 ;; a mode-motion-hook might really want to change
72 ;; the point.
73 ;;
74 ;; #### The save-excursion must come before the
75 ;; save-window-excursion in order to function properly. I
76 ;; haven't given this much thought. Is it a bug that this
77 ;; ordering is necessary or is it correct behavior?
78 (save-excursion
79 (save-window-excursion
80 (set-buffer buffer)
81 (mode-motion-ensure-extent-ok event)
82 (if point
83 (progn
84 (goto-char point)
85 (condition-case nil (funcall backward) (error nil))
86 (setq point (point))
87 (condition-case nil (funcall forward) (error nil))
88 (if (eq point (point))
89 (detach-extent mode-motion-extent)
90 (set-extent-endpoints mode-motion-extent point (point))))
91 ;; not over text; zero the extent.
92 (detach-extent mode-motion-extent)))))))
93
94 (defun mode-motion-highlight-line (event)
95 "For use as the value of `mode-motion-hook' -- highlight line under mouse."
96 (mode-motion-highlight-internal event 'beginning-of-line 'end-of-line))
97
98 (defun mode-motion-highlight-word (event)
99 "For use as the value of `mode-motion-hook' -- highlight word under mouse."
100 (mode-motion-highlight-internal
101 event
102 #'(lambda () (default-mouse-track-beginning-of-word nil))
103 #'(lambda () (default-mouse-track-end-of-word nil))))
104
105 (defun mode-motion-highlight-symbol (event)
106 "For use as the value of `mode-motion-hook' -- highlight symbol under mouse."
107 (mode-motion-highlight-internal
108 event
109 #'(lambda () (default-mouse-track-beginning-of-word t))
110 #'(lambda () (default-mouse-track-end-of-word t))))
111
112 (defun mode-motion-highlight-sexp (event)
113 "For use as the value of `mode-motion-hook' -- highlight form under mouse."
114 (mode-motion-highlight-internal
115 event
116 #'(lambda ()
117 (if (= (char-syntax (following-char)) ?\()
118 nil
119 (goto-char (scan-sexps (point) -1))))
120 #'(lambda ()
121 (if (= (char-syntax (following-char)) ?\))
122 (forward-char 1))
123 (goto-char (scan-sexps (point) 1)))))
124
125 (defun mode-motion-add-help-echo (event)
126 "For use as the value of `mode-motion-hook' -- add a 'help-echo property.
127 This causes the string in the 'help-echo property to be displayed when the
128 mouse moves over the extent. See `mode-motion-help-echo-string' for
129 documentation on how to control the string that is added."
130 (mode-motion-ensure-extent-ok event)
131 (let ((string (cond ((null mode-motion-help-echo-string) nil)
132 ((stringp mode-motion-help-echo-string)
133 mode-motion-help-echo-string)
134 (t (funcall mode-motion-help-echo-string event)))))
135 (if (stringp string)
136 (set-extent-property mode-motion-extent 'help-echo string))))
137
138
139 (provide 'mode-motion)
140
141 ;;; mode-motion.el ends here