Mercurial > hg > xemacs-beta

comparison lisp/prim/mode-motion.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;; Mode-specific mouse-highlighting of text.
2 ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
3
4 ;; This file is part of XEmacs.
5
6 ;; XEmacs is free software; you can redistribute it and/or modify it
7 ;; under the terms of the GNU General Public License as published by
8 ;; the Free Software Foundation; either version 2, or (at your option)
9 ;; any later version.
10
11 ;; XEmacs is distributed in the hope that it will be useful, but
12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;; General Public License for more details.
15
16 ;; You should have received a copy of the GNU General Public License
17 ;; along with XEmacs; see the file COPYING. If not, write to the Free
18 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19
20 ;;; Synched up with: Not in FSF.
21
22 (defvar mode-motion-hook nil
23 "Function or functions which are called whenever the mouse moves.
24 You should normally use this rather than `mouse-motion-handler', which
25 does some additional window-system-dependent things. This hook is local
26 to every buffer, and should normally be set up by major-modes which want
27 to use special highlighting. Every time the mouse moves over a window,
28 the mode-motion-hook of the buffer of that window is run.")
29
30 (make-variable-buffer-local 'mode-motion-hook)
31
32 (defvar mode-motion-extent nil)
33 (make-variable-buffer-local 'mode-motion-extent)
34
35 (defvar mode-motion-help-echo-string nil
36 "String to be added as the 'help-echo property of the mode-motion extent.
37 In order for this to work, you need to add the hook function
38 `mode-motion-add-help-echo' to the mode-motion hook. If this is a function,
39 it will be called with one argument (the event) and should return a string
40 to be added. This variable is local to every buffer.")
41 (make-variable-buffer-local 'mode-motion-help-echo-string)
42
43 (defun mode-motion-ensure-extent-ok (event)
44 (let ((buffer (event-buffer event)))
45 (if (and (extent-live-p mode-motion-extent)
46 (eq buffer (extent-object mode-motion-extent)))
47 nil
48 (setq mode-motion-extent (make-extent nil nil buffer))
49 (set-extent-property mode-motion-extent 'mouse-face 'highlight))))
50
51 (defun mode-motion-highlight-internal (event backward forward)
52 (let* ((buffer (event-buffer event))
53 (point (and buffer (event-point event))))
54 (if (and buffer
55 (not (eq buffer mouse-grabbed-buffer)))
56 ;; #### ack!! Too many calls to save-window-excursion /
57 ;; save-excursion (x-track-pointer calls, so does
58 ;; minibuf-mouse-tracker ...) This needs to be looked
59 ;; into. It's complicated by the fact that sometimes
60 ;; a mode-motion-hook might really want to change
61 ;; the point.
62 ;;
63 ;; #### The save-excursion must come before the
64 ;; save-window-excursion in order to function properly. I
65 ;; haven't given this much thought. Is it a bug that this
66 ;; ordering is necessary or is it correct behavior?
67 (save-excursion
68 (save-window-excursion
69 (set-buffer buffer)
70 (mode-motion-ensure-extent-ok event)
71 (if point
72 (progn
73 (goto-char point)
74 (condition-case nil (funcall backward) (error nil))
75 (setq point (point))
76 (condition-case nil (funcall forward) (error nil))
77 (if (eq point (point))
78 (detach-extent mode-motion-extent)
79 (set-extent-endpoints mode-motion-extent point (point))))
80 ;; not over text; zero the extent.
81 (detach-extent mode-motion-extent)))))))
82
83 (defun mode-motion-highlight-line (event)
84 "For use as the value of `mode-motion-hook' -- highlight line under mouse."
85 (mode-motion-highlight-internal event 'beginning-of-line 'end-of-line))
86
87 (defun mode-motion-highlight-word (event)
88 "For use as the value of `mode-motion-hook' -- highlight word under mouse."
89 (mode-motion-highlight-internal
90 event
91 #'(lambda () (default-mouse-track-beginning-of-word nil))
92 #'(lambda () (default-mouse-track-end-of-word nil))))
93
94 (defun mode-motion-highlight-symbol (event)
95 "For use as the value of `mode-motion-hook' -- highlight symbol under mouse."
96 (mode-motion-highlight-internal
97 event
98 #'(lambda () (default-mouse-track-beginning-of-word t))
99 #'(lambda () (default-mouse-track-end-of-word t))))
100
101 (defun mode-motion-highlight-sexp (event)
102 "For use as the value of `mode-motion-hook' -- highlight form under mouse."
103 (mode-motion-highlight-internal
104 event
105 #'(lambda ()
106 (if (= (char-syntax (following-char)) ?\()
107 nil
108 (goto-char (scan-sexps (point) -1))))
109 #'(lambda ()
110 (if (= (char-syntax (following-char)) ?\))
111 (forward-char 1))
112 (goto-char (scan-sexps (point) 1)))))
113
114 (defun mode-motion-add-help-echo (event)
115 "For use as the value of `mode-motion-hook' -- add a 'help-echo property.
116 This causes the string in the 'help-echo property to be displayed when the
117 mouse moves over the extent. See `mode-motion-help-echo-string' for
118 documentation on how to control the string that is added."
119 (mode-motion-ensure-extent-ok event)
120 (let ((string (cond ((null mode-motion-help-echo-string) nil)
121 ((stringp mode-motion-help-echo-string)
122 mode-motion-help-echo-string)
123 (t (funcall mode-motion-help-echo-string event)))))
124 (if (stringp string)
125 (set-extent-property mode-motion-extent 'help-echo string))))
126
127
128 (provide 'mode-motion)