|
0
|
1 ;; -*- Syntax: Emacs-Lisp; Mode: emacs-lisp -*-
|
|
|
2 ;;
|
|
|
3 ;; Per mode and per buffer mouse tracking with highlighting
|
|
|
4 ;;
|
|
|
5 ;; Copyright (C) 1992, 1993 by Guido Bosch <Guido.Bosch@loria.fr>
|
|
|
6
|
|
|
7 ;; This file is written in GNU Emacs Lisp, It is a part of XEmacs.
|
|
|
8
|
|
|
9 ;; The software contained in this file is free software; you can
|
|
|
10 ;; redistribute it and/or modify it under the terms of the GNU General
|
|
|
11 ;; Public License as published by the Free Software Foundation; either
|
|
|
12 ;; version 2, or (at your option) any later version.
|
|
|
13
|
|
|
14 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
17 ;; GNU General Public License for more details.
|
|
|
18
|
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
|
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
|
21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
22 ;;
|
|
|
23 ;;; Synched up with: Not in FSF.
|
|
|
24
|
|
|
25 ;; Please send bugs and comments to Russell.Ritchie@gssec.bt.co.uk or
|
|
|
26 ;; tlp00@spg.amdahl.com.
|
|
|
27 ;;
|
|
|
28 ;; <DISCLAIMER>
|
|
|
29 ;; This program is still under development. Neither the author nor any
|
|
|
30 ;; of the maintainers accepts responsibility to anyone for the consequences of
|
|
|
31 ;; using it or for whether it serves any particular purpose or works
|
|
|
32 ;; at all.
|
|
|
33
|
|
|
34 ; Change History
|
|
|
35 ; Revision 3.15 Thu Feb 15 14:26:34 GMT 1996 Russell.Ritchie@gssec.bt.co.uk
|
|
|
36 ; lisp-interaction-popup-menu => lisp-interaction-mode-popup-menu,
|
|
|
37 ; emacs-lisp-popup-menu => emacs-lisp-mode-popup-menu.
|
|
|
38
|
|
|
39 ; Revision 3.14 Tue Nov 14 11:14:38 GMT 1995 Russell.Ritchie@gssec.bt.co.uk
|
|
|
40 ; Made nil the default value for mode-motion-focus-on-window. Too many people
|
|
|
41 ; hate it when the cursor warps into Dired and GNUS buffers because some
|
|
|
42 ; window managers auto-raise the window with keyboard focus with predictably
|
|
|
43 ; nauseous results.
|
|
|
44
|
|
|
45 ; Revision 3.13 Thu Sep 14 10:30:04 1995 Russell.Ritchie@gssec.bt.co.uk
|
|
|
46 ; Fix the `spontaneous scrolling' problem (at last). It's funny how
|
|
|
47 ; easy things are once you actually understand the issues involved.
|
|
|
48 ; As ever, what we sought was the right question...
|
|
|
49
|
|
|
50 ; Revision 3.12 Wed Jul 12 11:30:43 1995 Russell.Ritchie@gssec.bt.co.uk
|
|
|
51 ; Track `don't highlight non-file lines in dired buffers' functionality (in a
|
|
|
52 ; pretty tasteless manner if I say so myself :-)).
|
|
|
53
|
|
|
54 ; Revision 3.11 Fri Jul 7 16:26:56 1995 Russell.Ritchie@gssec.bt.co.uk
|
|
|
55 ; Minor extent detaching bug fix.
|
|
|
56
|
|
|
57 ; Revision 3.10 Thu Jun 15 11:36:56 1995 Russell.Ritchie@gssec.bt.co.uk
|
|
|
58 ; Quiet, faster, non-interactive initialistion, mild list-motion-handlers
|
|
|
59 ; chrome and minor formatting clean-ups.
|
|
|
60
|
|
|
61 ; Revision 3.9 Thu Jun 15 11:36:56 1995 Russell.Ritchie@gssec.bt.co.uk
|
|
|
62 ; Fixed the `mouse-motion whilst reading filename in minibuffer auto-ftp' bug.
|
|
|
63
|
|
|
64 ; Revision 3.8 Thus Mar 23 1995 tlp00@spg.amdahl.com
|
|
|
65 ; added in menu controls from paquette@atomas.crim.ca
|
|
|
66 ; re-added minibuffer support (from 3.5)
|
|
|
67 ;
|
|
|
68 ; Revision 3.7 Tue Feb 21 11:06:38 1995 Russell.Ritchie@gssec.bt.co.uk
|
|
|
69 ; Extended mode-motion+-religion and made the defaulting frame-buffer aware.
|
|
|
70 ; Reworked and added new mode-motion-handlers.
|
|
|
71 ; Doc string clean up.
|
|
|
72 ; Fixed unintentional frame/screen reversion.
|
|
|
73
|
|
|
74 ; Revision 3.6 Mon Feb 20 11:46:32 1995 Russell.Ritchie@gssec.bt.co.uk
|
|
|
75 ; Made mouse tracking use mode-motion-hook for better integration with
|
|
|
76 ; the default mouse-motion system (help-echo and friends now work).
|
|
|
77
|
|
|
78 ; Revision 3.5 1995/02/16 13:40:00 tlp00@spg.amdahl.com
|
|
|
79 ; fixed sporatic scroll bug
|
|
|
80 ; added M-button2 binding for mode-motion-copy
|
|
|
81 ;
|
|
|
82 ; Revision 3.4 1995/02/14 14:30:15 Russell.Ritchie@gssec.bt.co.uk
|
|
|
83 ; Small code cleanups: let* -> let, duplicate defvars.
|
|
|
84 ; Chromed list-motion-handlers a little.
|
|
|
85 ; Added variable mode-motion+-religion for easy choice twixt underline & bold.
|
|
|
86
|
|
|
87 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;tlp00 changes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
88
|
|
|
89 ; tlp00@spg.amdahl.com 2/11/93
|
|
|
90 ; modified mode-motion-track-pointer to move cursor cross windows
|
|
|
91 ; renamed mode-motion-delete to mode-motion-kill to follow kill
|
|
|
92 ; convention
|
|
|
93 ; mode-motion-highlight-with-handler to put cursor at beginning of line
|
|
|
94 ; follow operations.
|
|
|
95 ; mode-motion-copy/delete and mode-motion-kill to position cursor at
|
|
|
96 ; delete point start. Also set this-command to avoid appends
|
|
|
97 ; set mode-motion-extent priority to 1, so it will override font-lock
|
|
|
98 ; changed default handlers for buffer-mode, c-mode, dired-mode, added occur
|
|
|
99 ; and compilation mode.
|
|
|
100 ; fixed bug in minibuffer-selection-boundaries where C-g was leaving the wrong
|
|
|
101 ; syntax table.
|
|
|
102 ; added support for pending-delete.
|
|
|
103 ; adds the copy/delete motion-extent to the clipboard even if kill-hooks is nil.
|
|
|
104 ;
|
|
|
105 ; Revision 3.3 1995/02/13 tlp00@spg.amdahl.com
|
|
|
106 ; merged Russell.Ritchie@gssec.bt.co.uk versions with molli/bosch versions
|
|
|
107 ; renamed versioning 3.0+ for molli/bosch versions.
|
|
|
108 ;
|
|
|
109 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Russell Ritchie changes;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
110 ; !Log: mode-motion+.el,v !
|
|
|
111 ; Revision 2.14.R 1994/09/09 10:19:18 rieke@darmstadt.gmd.de
|
|
|
112 ; Merged in my changes to support motion-gray. This needs a file
|
|
|
113 ; named "gray1.xbm" in your data-directory (etc) like the following.
|
|
|
114 ; -------------------------------snip--------------------------
|
|
|
115 ; #define bg2_width 16
|
|
|
116 ; #define bg2_height 16
|
|
|
117 ; static char bg2_bits[] = {
|
|
|
118 ; 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00,
|
|
|
119 ; 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00,
|
|
|
120 ; 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00};
|
|
|
121 ; -------------------------------snip--------------------------
|
|
|
122 ; This one looks good on SUN 19'' screens with 10x20 font,
|
|
|
123 ; black foreground and khaki background.
|
|
|
124 ; To use the gray-handlers instead of the underline-handlers
|
|
|
125 ; include the following into your .emacs:
|
|
|
126 ; (set-mode-motion-handler 'emacs-lisp-mode 'gray-thing)
|
|
|
127 ; (set-mode-motion-handler 'lisp-interaction-mode 'gray-thing)
|
|
|
128 ; (set-mode-motion-handler 'c++-mode 'gray-c)
|
|
|
129 ; (set-mode-motion-handler 'c-mode 'gray-c)
|
|
|
130 ; (set-mode-motion-handler 'tcl-mode 'gray-tcl)
|
|
|
131 ; (set-mode-motion-handler 'dired-mode 'gray-line@)
|
|
|
132 ; (set-mode-motion-handler 'gnus-group-mode 'gray-vline@)
|
|
|
133 ; (set-mode-motion-handler 'gnus-summary-mode 'gray-vline@)
|
|
|
134 ; (set-mode-motion-handler 'texinfo-mode 'gray-Texinfo)
|
|
|
135 ; (setq default-motion-handler (find-motion-handler 'gray-thing))
|
|
|
136 ;
|
|
|
137 ;
|
|
|
138 ; Revision 2.13.R 1994/08/08 19:47:34 Russell.Ritchie@gssec.bt.co.uk
|
|
|
139 ; Made default handler be underline-thing, as most bold fonts seem to
|
|
|
140 ; be greater in height than their corresponding normal versions,
|
|
|
141 ; causing irritating screen flicker.
|
|
|
142 ;
|
|
|
143 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Molli/bosch changes;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
144 ;
|
|
|
145 ; Revision 3.2 1994/09/28 15:14:29 molli
|
|
|
146 ; add "(set-mode-motion-handler 'latex-mode 'raise-LaTeX)". Barry
|
|
|
147 ; Waraw's C/C++ mode is now changed to cc-mode ...
|
|
|
148 ;
|
|
|
149 ; Revision 3.1 1994/09/28 15:10:36 molli
|
|
|
150 ; Initial revision
|
|
|
151 ;
|
|
|
152 ; Revision 2.15 1993/11/18 08:13:28 bosch
|
|
|
153 ; Constant `mode-motion+-version' added.
|
|
|
154 ; Minor bug fix in `tcl-forward-sexp1'.
|
|
|
155 ;
|
|
|
156 ; Revision 2.14 1993/10/29 20:04:59 bosch
|
|
|
157 ; Minibuffer name matching improved. Made `tcl-boundaries' smarter by
|
|
|
158 ; use of new function `tcl-forward-sexp1'. `tcl-commands' list updated
|
|
|
159 ; -- should be complete now. A message is printed if the syntax scanner
|
|
|
160 ; matched or failed for known tcl/tk commands. Seperated `tcl-commands'
|
|
|
161 ; from `tk-commands' -- `tk-commands' not yet complete. New motion
|
|
|
162 ; handler `raise-LaTeX' added, for tex-mode.
|
|
|
163 ;
|
|
|
164 ; Revision 2.13 1993/10/08 09:43:00 bosch
|
|
|
165 ; New user option `mode-motion-setup-cut-and-paste-bindings'. Function
|
|
|
166 ; `mode-motion-copy/delete' now takes into account the primary and the
|
|
|
167 ; motion selection.
|
|
|
168 ;
|
|
|
169 ; Revision 2.12 1993/10/08 09:08:46 bosch
|
|
|
170 ; Avoid highlighting empty lines, even if
|
|
|
171 ; `mode-motion-highlight-lines-when-behind' is non-nil.
|
|
|
172
|
|
|
173 ; Revision 2.12 1994/07/07 18:33:38 Russell.Ritchie@gssec.bt.co.uk
|
|
|
174 ; Made list-motion-handlers and mode-motion-set-handler work in lemacs-19.10.
|
|
|
175 ;
|
|
|
176 ; Revision 2.11 1993/09/20 08:29:15 bosch
|
|
|
177 ; Code reorganized: variables declared before used.
|
|
|
178 ; Compatibility hack patched again.
|
|
|
179 ;
|
|
|
180 ; Revision 2.10 1993/09/17 18:50:33 bosch
|
|
|
181 ; Bug in the compatibility hack fixed. Call to `make-cursor' replaced by
|
|
|
182 ; `x-pointer-cache'. Compatibility hack for Lemacs 19.8 removed. Tcl
|
|
|
183 ; motion handler improved (needs still some work).
|
|
|
184 ;
|
|
|
185 ; Revision 2.9 1993/09/15 17:52:53 bosch
|
|
|
186 ; Compatibility patch for Lucid Emacs 19.8. tcl motion handler added.
|
|
|
187 ;
|
|
|
188 ; Revision 2.8 1993/08/27 15:17:07 bosch
|
|
|
189 ; Select window conflict between motion handlers and process filters
|
|
|
190 ; resolved by using `enqueue-eval-event' for selecting a different
|
|
|
191 ; window (functions `mode-motion-track-pointer' and
|
|
|
192 ; `mode-motion-highlight-with-handler' modified). This fixes the nasty
|
|
|
193 ; bug that made GNUS hanging during NNTP activity while the mouse was
|
|
|
194 ; moved.
|
|
|
195 ;
|
|
|
196 ; Revision 2.7 1993/08/27 12:50:10 bosch
|
|
|
197 ; TeX and LaTeX motion handler generalized. Motion handler
|
|
|
198 ; `highlight-Texinfo' added.
|
|
|
199 ;
|
|
|
200 ; Revision 2.6 1993/06/24 11:58:52 bosch
|
|
|
201 ; Mode motion+ support for pcl-cvs added. #undef syntax for C added.
|
|
|
202 ;
|
|
|
203 ; Revision 2.5 1993/06/09 12:04:31 bosch
|
|
|
204 ; Delivery motion handlers for `c++-c-mode', `gnus-group-mode', and
|
|
|
205 ; `gnus-summary-mode' added. Mode motion commands bound to copy/cut/past
|
|
|
206 ; keys for Sun keyboards (f16, f18, f20). Comment added.
|
|
|
207 ;
|
|
|
208 ; Revision 2.4 1993/02/15 12:59:47 bosch
|
|
|
209 ; Modifications sent by Tibor Polgar integrated:
|
|
|
210 ; Optional parameter added to `mode-motion-copy/delete'. User option
|
|
|
211 ; `mode-motion-focus-on-window' added. It controls window selection for
|
|
|
212 ; the motion handlers. Minor changes of the delivery motion handlers.
|
|
|
213 ;
|
|
|
214 ; Revision 2.3 1993/02/04 18:10:09 bosch
|
|
|
215 ; User option `mode-motion-minibuffer-completion' added. It controls
|
|
|
216 ; the minibuffer completion highlighting.
|
|
|
217 ;
|
|
|
218 ; Revision 2.2 1993/01/27 13:08:12 bosch
|
|
|
219 ; Improved clearing of `sticky' mode-motion-extents when leaving screen
|
|
|
220 ; or buffer. Function `mode-motion-clear-extent' added.
|
|
|
221 ; Highlight line mouse cursor is behind.
|
|
|
222 ; `mode-motion-highlight-with-handler' now takes an event as argument.
|
|
|
223 ; Cut and paste functions renamed and rewritten. Now they are called:
|
|
|
224 ; `mode-motion-move', `mode-motion-delete', `mode-motion-copy',
|
|
|
225 ; `mode-motion-copy-as-kill'. Bug fixes in the C scanner stuff.
|
|
|
226 ; Motion handler `underline-c' added.
|
|
|
227 ;
|
|
|
228 ; Revision 2.1 1993/01/19 18:29:58 bosch
|
|
|
229 ; Scanner and motion handler for C syntax added.
|
|
|
230 ; Function `set-default-motion-handler' added.
|
|
|
231 ; Minor improvements on the `list-motion-handlers' interface done.
|
|
|
232 ; Minor bug fixes.
|
|
|
233 ;
|
|
|
234 ; Revision 2.0 1993/01/14 19:17:29 bosch
|
|
|
235 ; Lot of things rewritten and reorganized. This version fits in only
|
|
|
236 ; one file (beside the required package thing.el).
|
|
|
237 ;
|
|
|
238 ; New basic features are:
|
|
|
239 ; - buffer, mode and default motion handlers
|
|
|
240 ; - easy composition of own motion handlers
|
|
|
241 ; - listing of motion handlers in tabular form
|
|
|
242 ; - menu interface for changing motion handlers
|
|
|
243 ; - only two elisp files: mode-motion+.el, thing.el
|
|
|
244 ;
|
|
|
245
|
|
|
246 (require 'thing)
|
|
|
247 (require 'mode-motion)
|
|
|
248 (defconst mode-motion+-version "3.15")
|
|
|
249
|
|
|
250 ;;; This file defines a set of mouse motion handlers that do some
|
|
|
251 ;;; highlighting of the text when the mouse moves over.
|
|
|
252 ;;; An exhaustive list of the motion handlers defined in this file may be
|
|
|
253 ;;; obtained with M-x list-motion-handlers.
|
|
|
254 ;;; User Options and their Custommisation
|
|
|
255 ;;;
|
|
|
256 ;;; Mode-motion+ provides four user options, defined beyond. See their
|
|
|
257 ;;; documentation string to know what they are good for. If you want
|
|
|
258 ;;; to modify their default values, just setq them in your ~/.emacs.
|
|
|
259
|
|
|
260 (defvar mode-motion+-religion nil ; Initialised in mode-motion-init.
|
|
|
261 "*Default highlight religion: one of bold, gray, highlight, invert or underline.
|
|
|
262
|
|
|
263 Unless you setq this otherwise, it defaults to underline when
|
|
|
264 (x-display-color-p) is non-nil and invert otherwise.
|
|
|
265 Setting it to 'highlight should cause mode-motion+ extents to be
|
|
|
266 indistinguishable from any other type of highlighted extent which may or may
|
|
|
267 not be advisable, depending on your point of view.")
|
|
|
268
|
|
|
269 (defvar mode-motion-highlight-lines-when-behind t
|
|
|
270 "*If non-nil highlight the whole line if the mouse is past the end.")
|
|
|
271
|
|
|
272 (defvar mode-motion-focus-on-window nil
|
|
|
273 "*Controls whether moving the mouse into another window selects this window.
|
|
|
274 The following values are possible:
|
|
|
275
|
|
|
276 nil - Window selection isn't influenced at all by mode motion.
|
|
|
277
|
|
|
278 t - Window selection always follows the mouse cursor. Copying motion
|
|
|
279 active regions doesn't work any longer between different buffers.
|
|
|
280
|
|
|
281 any other - window selection follows the mouse cursor if the motion handler
|
|
|
282 of the buffer under the mouse has the follow-point property set.
|
|
|
283 Useful for selecting line mode buffers just by moving the mouse
|
|
|
284 inside in order to execute commands there (VM summary,
|
|
|
285 GNUS Group and Subject, DIRED, Buffer menu etc.)")
|
|
|
286
|
|
|
287 (defvar mode-motion-setup-cut-and-paste-bindings t
|
|
|
288 "*If non-nil, bind commands to the Copy, Paste and Cut keys.")
|
|
|
289
|
|
|
290 ;; Options sub-menu for mode-motion+
|
|
|
291 (defvar mode-motion+-options-menu
|
|
|
292 '("Motion Highlighting"
|
|
|
293 "For Current Buffer"
|
|
|
294 "---"
|
|
|
295 ["None"
|
|
|
296 (progn
|
|
|
297 (set-buffer-motion-handler (current-buffer) 'no-thing)
|
|
|
298 (mode-motion-clear-extent))
|
|
|
299 :style radio
|
|
|
300 :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
|
|
|
301 'no)
|
|
|
302 :active (mode-motion+-active-p)]
|
|
|
303 ["Bold"
|
|
|
304 (progn
|
|
|
305 (modify-buffer-motion-handler (current-buffer) 'bold))
|
|
|
306 :style radio
|
|
|
307 :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
|
|
|
308 'bold)
|
|
|
309 :active (mode-motion+-active-p)]
|
|
|
310 ["Underline"
|
|
|
311 (progn
|
|
|
312 (modify-buffer-motion-handler (current-buffer) 'underline))
|
|
|
313 :style radio
|
|
|
314 :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
|
|
|
315 'underline)
|
|
|
316 :active (mode-motion+-active-p)]
|
|
|
317 ["Gray"
|
|
|
318 (progn
|
|
|
319 (modify-buffer-motion-handler (current-buffer) 'gray))
|
|
|
320 :style radio
|
|
|
321 :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
|
|
|
322 'gray)
|
|
|
323 :active (mode-motion+-active-p)]
|
|
|
324 ["Highlight"
|
|
|
325 (progn
|
|
|
326 (modify-buffer-motion-handler (current-buffer) 'highlight))
|
|
|
327 :style radio
|
|
|
328 :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
|
|
|
329 'highlight)
|
|
|
330 :active (mode-motion+-active-p)]
|
|
|
331 ["Invert"
|
|
|
332 (progn
|
|
|
333 (modify-buffer-motion-handler (current-buffer) 'invert))
|
|
|
334 :style radio
|
|
|
335 :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
|
|
|
336 'invert)
|
|
|
337 :active (mode-motion+-active-p)]
|
|
|
338 "---"
|
|
|
339 "For Current Mode"
|
|
|
340 "---"
|
|
|
341 ["None"
|
|
|
342 (progn
|
|
|
343 (set-mode-motion-handler major-mode 'no-thing)
|
|
|
344 (mode-motion-clear-extent))
|
|
|
345 :style radio
|
|
|
346 :selected (eq (mode-motion+-mode-handler-religion major-mode) 'no)
|
|
|
347 :active (mode-motion+-active-p)]
|
|
|
348 ["Bold"
|
|
|
349 (progn
|
|
|
350 (modify-mode-motion-handler major-mode 'bold))
|
|
|
351 :style radio
|
|
|
352 :selected (eq (mode-motion+-mode-handler-religion major-mode) 'bold)
|
|
|
353 :active (mode-motion+-active-p)]
|
|
|
354 ["Underline"
|
|
|
355 (progn
|
|
|
356 (modify-mode-motion-handler major-mode 'underline))
|
|
|
357 :style radio
|
|
|
358 :selected (eq (mode-motion+-mode-handler-religion major-mode) 'underline)
|
|
|
359 :active (mode-motion+-active-p)]
|
|
|
360 ["Gray"
|
|
|
361 (progn
|
|
|
362 (modify-mode-motion-handler major-mode 'gray))
|
|
|
363 :style radio
|
|
|
364 :selected (eq (mode-motion+-mode-handler-religion major-mode) 'gray)
|
|
|
365 :active (mode-motion+-active-p)]
|
|
|
366 ["Highlight"
|
|
|
367 (progn
|
|
|
368 (modify-mode-motion-handler major-mode 'highlight))
|
|
|
369 :style radio
|
|
|
370 :selected (eq (mode-motion+-mode-handler-religion major-mode) 'highlight)
|
|
|
371 :active (mode-motion+-active-p)]
|
|
|
372 ["Invert"
|
|
|
373 (progn
|
|
|
374 (modify-mode-motion-handler major-mode 'invert))
|
|
|
375 :style radio
|
|
|
376 :selected (eq (mode-motion+-mode-handler-religion major-mode) 'invert)
|
|
|
377 :active (mode-motion+-active-p)]
|
|
|
378 "---"
|
|
|
379 "For All"
|
|
|
380 "---"
|
|
|
381 ["None"
|
|
|
382 (progn
|
|
|
383 (setq mode-motion+-religion 'no)
|
|
|
384 (mode-motion-init-handlers-according-to-religion 'force)
|
|
|
385 (mode-motion-clear-extent))
|
|
|
386 :style radio
|
|
|
387 :selected (eq mode-motion+-religion 'no)
|
|
|
388 :active (mode-motion+-active-p)]
|
|
|
389 ["Bold"
|
|
|
390 (progn
|
|
|
391 (setq mode-motion+-religion 'bold)
|
|
|
392 (mode-motion-init-handlers-according-to-religion 'force))
|
|
|
393 :style radio
|
|
|
394 :selected (eq mode-motion+-religion 'bold)
|
|
|
395 :active (mode-motion+-active-p)]
|
|
|
396 ["Underline"
|
|
|
397 (progn
|
|
|
398 (setq mode-motion+-religion 'underline)
|
|
|
399 (mode-motion-init-handlers-according-to-religion 'force))
|
|
|
400 :style radio
|
|
|
401 :selected (eq mode-motion+-religion 'underline)
|
|
|
402 :active (mode-motion+-active-p)]
|
|
|
403 ["Gray"
|
|
|
404 (progn
|
|
|
405 (setq mode-motion+-religion 'gray)
|
|
|
406 (mode-motion-init-handlers-according-to-religion 'force))
|
|
|
407 :style radio
|
|
|
408 :selected (eq mode-motion+-religion 'gray)
|
|
|
409 :active (mode-motion+-active-p)]
|
|
|
410 ["Highlight"
|
|
|
411 (progn
|
|
|
412 (setq mode-motion+-religion 'highlight)
|
|
|
413 (mode-motion-init-handlers-according-to-religion 'force))
|
|
|
414 :style radio
|
|
|
415 :selected (eq mode-motion+-religion 'highlight)
|
|
|
416 :active (mode-motion+-active-p)]
|
|
|
417 ["Invert"
|
|
|
418 (progn
|
|
|
419 (setq mode-motion+-religion 'invert)
|
|
|
420 (mode-motion-init-handlers-according-to-religion 'force))
|
|
|
421 :style radio
|
|
|
422 :selected (eq mode-motion+-religion 'invert)
|
|
|
423 :active (mode-motion+-active-p)]
|
|
|
424 "---"
|
|
|
425 ["Minibuffer highlighting" (setq mode-motion-use-minibuffer-motion-handler
|
|
|
426 (not mode-motion-use-minibuffer-motion-handler))
|
|
|
427 :style toggle :selected mode-motion-use-minibuffer-motion-handler]
|
|
|
428
|
|
|
429 ["Customize..."
|
|
|
430 (list-motion-handlers)
|
|
|
431 t
|
|
|
432 ;; nil
|
|
|
433 ]
|
|
|
434 ["Revert Customization"
|
|
|
435 (call-interactively 'mode-motion+-motion-hook-revert)
|
|
|
436 (and (boundp 'mode-motion+-previous-hook) mode-motion+-previous-hook)
|
|
|
437 ])
|
|
|
438 "Menu for changing mode-motion+ religion and other things.")
|
|
|
439
|
|
|
440 (defun mode-motion+-active-p ()
|
|
|
441 (cond ((symbolp mode-motion-hook)
|
|
|
442 (eq mode-motion-hook 'mode-motion+-highlight))
|
|
|
443 ((listp mode-motion-hook)
|
|
|
444 (memq 'mode-motion+-highlight mode-motion-hook))
|
|
|
445 (t nil)))
|
|
|
446
|
|
|
447 (defun mode-motion+-buffer-handler-religion (buffer)
|
|
|
448 (let* ((current-handler-name (symbol-name (motion-handler-name
|
|
|
449 (get-current-motion-handler))))
|
|
|
450 (religion-name (substring current-handler-name
|
|
|
451 0
|
|
|
452 (string-match "-" current-handler-name))))
|
|
|
453 (intern-soft religion-name)))
|
|
|
454
|
|
|
455 (defun mode-motion+-mode-handler-religion (buffer)
|
|
|
456 (let* ((mode-handler (or (get major-mode 'mode-motion-handler)
|
|
|
457 default-motion-handler))
|
|
|
458 (current-handler (symbol-name (motion-handler-name mode-handler)))
|
|
|
459 (religion (substring current-handler
|
|
|
460 0
|
|
|
461 (string-match "-" current-handler))))
|
|
|
462 (intern-soft religion)))
|
|
|
463
|
|
|
464 (defun modify-buffer-motion-handler (buffer religion)
|
|
|
465 (let* ((current-handler (symbol-name (motion-handler-name
|
|
|
466 (get-current-motion-handler))))
|
|
|
467 (suffix (substring current-handler
|
|
|
468 (string-match "-" current-handler))))
|
|
|
469 (set-buffer-motion-handler buffer
|
|
|
470 (intern-soft (concat (symbol-name religion)
|
|
|
471 suffix)))))
|
|
|
472
|
|
|
473 (defun modify-mode-motion-handler (mode religion)
|
|
|
474 (let* ((mode-handler (or (get major-mode 'mode-motion-handler)
|
|
|
475 default-motion-handler))
|
|
|
476 (current-handler (symbol-name (motion-handler-name mode-handler)))
|
|
|
477 (suffix (substring current-handler
|
|
|
478 (string-match "-" current-handler))))
|
|
|
479 (set-mode-motion-handler mode (intern-soft (concat (symbol-name
|
|
|
480 religion)
|
|
|
481 suffix)))))
|
|
|
482
|
|
|
483 ;;;; This does not work. I would like to be able to modify in-place
|
|
|
484 ;;;; the non-selectable items, but I don't know how.
|
|
|
485 ;;;; --paquette, Wed Mar 8 23:32:32 1995 (Marc Paquette)
|
|
|
486 ;;; Sensitize the mode motion+ options submenu, a la
|
|
|
487 ;;; sensitize-file-and-edit-menus-hook.
|
|
|
488 (defun mode-motion+-sensitize-options-menu-hook ()
|
|
|
489 "Hook function that will adjust title items in the mode-motion+ submenu in Options"
|
|
|
490 (let* ((mm+-menu (cdr (car (find-menu-item
|
|
|
491 current-menubar
|
|
|
492 '("Options" "Motion Highlighting")))))
|
|
|
493 (buffer-item (find-menu-item mm+-menu '("For Current Buffer")))
|
|
|
494 (mode-item (find-menu-item mm+-menu '("For Current Mode"))))
|
|
|
495 (setcar buffer-item (format "For Buffer `%s'" (buffer-name nil)))
|
|
|
496 (setcar mode-item (format "For Mode `%s'" major-mode))
|
|
|
497 nil))
|
|
|
498
|
|
|
499 ;;(add-hook 'activate-menubar-hook 'mode-motion+-sensitize-options-menu-hook)
|
|
|
500
|
|
|
501
|
|
|
502 ;; Motion Handler Format:
|
|
|
503 ;;
|
|
|
504 ;; A motion handler is vector with the following format
|
|
|
505 ;; [<name> - a symbol
|
|
|
506 ;; <region computing function> - a function or name of function
|
|
|
507 ;; that returns (<startpos> . <endpos>)
|
|
|
508 ;; or nil.
|
|
|
509 ;; <face or face name> - as it says ...
|
|
|
510 ;; <highlight-p> - non-nil means that the motion extent
|
|
|
511 ;; will be highlighted using the function
|
|
|
512 ;; `highlight-extent'
|
|
|
513 ;; <follow-point-p> - non-nil means that point will follow the
|
|
|
514 ;; mouse motion.
|
|
|
515 ;; ]
|
|
|
516
|
|
|
517 ;; accessor functions
|
|
|
518 (defsubst motion-handler-name (handler) (aref handler 0))
|
|
|
519 (defsubst motion-handler-boundary-function (handler) (aref handler 1))
|
|
|
520 (defsubst motion-handler-face (handler) (aref handler 2))
|
|
|
521 (defsubst motion-handler-highlight (handler) (aref handler 3))
|
|
|
522 (defsubst motion-handler-follow-point (handler) (aref handler 4))
|
|
|
523
|
|
|
524 ;; modifier functions
|
|
|
525 (defsubst set-motion-handler-boundary-function (handler x) (aset handler 1 x))
|
|
|
526 (defsubst set-motion-handler-face (handler x) (aset handler 2 x))
|
|
|
527 (defsubst set-motion-handler-highlight (handler x) (aset handler 3 x))
|
|
|
528 (defsubst set-motion-handler-follow-point (handler x) (aset handler 4 x))
|
|
|
529
|
|
|
530 ;; Internal global variables
|
|
|
531 (defvar motion-handler-alist ()
|
|
|
532 "Alist with entries of the form \(<name> . <handler>\).")
|
|
|
533
|
|
|
534 ;; Minibuffer motion handler
|
|
|
535 (defvar mode-motion-use-minibuffer-motion-handler t
|
|
|
536 "*Enable mousable highlighting when the minibuffer is active. When false only extents with the
|
|
|
537 highlight property are selectable (*Completion*)")
|
|
|
538
|
|
|
539 (defvar mode-motion-extent nil)
|
|
|
540 (make-variable-buffer-local 'mode-motion-extent)
|
|
|
541 (defvar buffer-motion-handler nil)
|
|
|
542 (make-variable-buffer-local 'buffer-motion-handler)
|
|
|
543 (defvar mode-motion-last-extent nil "The last used mode motion extent.")
|
|
|
544 (defvar default-motion-handler nil) ; Initialised in mode-motion-init.
|
|
|
545
|
|
|
546 ;; Creation of motion handlers
|
|
|
547
|
|
|
548 (defun find-motion-handler (name)
|
|
|
549 (or (symbolp name)
|
|
|
550 (setq name (intern-soft name)))
|
|
|
551 (cdr (assq name motion-handler-alist)))
|
|
|
552
|
|
|
553 ;; internal motion handler creator
|
|
|
554 (defsubst make-motion-handler-internal
|
|
|
555 (name boundary-function face highlight follow-cursor)
|
|
|
556 (vector name boundary-function (get-face face) highlight follow-cursor))
|
|
|
557
|
|
|
558 (defun make-motion-handler
|
|
|
559 (name boundary-function &optional face highlight follow-cursor)
|
|
|
560 "Create a motion handler named NAME (a symbol or string) using REGION-FUNCTION.
|
|
|
561
|
|
|
562 REGION-FUNCTION is the function that computes the region to be highlighted.
|
|
|
563 Optional arguments are:
|
|
|
564
|
|
|
565 FACE: A face or face name to be used to highlight the region computed
|
|
|
566 by REGION-FUNCTION. 'default is the default.
|
|
|
567
|
|
|
568 HIGHLIGHT: Flag that indicates whether the highlight attribute of the
|
|
|
569 mode-motion-extent should be set or not. If FACE is the default face,
|
|
|
570 HIGHLIGHT defaults to t, otherwise to nil.
|
|
|
571
|
|
|
572 FOLLOW-CURSOR: Flag that indicates whether the cursor should follow
|
|
|
573 the mouse motion. Default is nil."
|
|
|
574
|
|
|
575 ;; required arguments
|
|
|
576 (or name (error "motion handler name required."))
|
|
|
577 (or (symbolp name)
|
|
|
578 (stringp name)
|
|
|
579 (error "motion handler name must be a string or symbol: %s" name))
|
|
|
580 (or boundary-function
|
|
|
581 (error "motion handler region function required."))
|
|
|
582 (or (fboundp boundary-function)
|
|
|
583 (error "not a function: %s." boundary-function))
|
|
|
584 ;; defaults
|
|
|
585 (or face (setq face 'default))
|
|
|
586
|
|
|
587 ;; store the mode motion handler on the 'mode-motion-handler property of
|
|
|
588 ;; its name symbol
|
|
|
589 (let ((old-handler (cdr (assq name motion-handler-alist)))
|
|
|
590 new-handler)
|
|
|
591 (if old-handler
|
|
|
592 (progn
|
|
|
593 (set-motion-handler-boundary-function old-handler boundary-function)
|
|
|
594 (set-motion-handler-face old-handler (get-face face))
|
|
|
595 (set-motion-handler-highlight old-handler highlight)
|
|
|
596 (set-motion-handler-follow-point old-handler follow-cursor))
|
|
|
597 (setq motion-handler-alist
|
|
|
598 (cons (cons name
|
|
|
599 (setq new-handler (make-motion-handler-internal
|
|
|
600 name
|
|
|
601 boundary-function
|
|
|
602 (get-face face)
|
|
|
603 highlight
|
|
|
604 follow-cursor)))
|
|
|
605 motion-handler-alist)))
|
|
|
606 (or old-handler new-handler)))
|
|
|
607
|
|
|
608 (defvar list-motion-handlers-buffer-to-customize nil
|
|
|
609 "Name of buffer from where list-motion-handlers was called.")
|
|
|
610 (make-variable-buffer-local 'list-motion-handlers-buffer-to-customize)
|
|
|
611 (defvar list-motion-handlers-buffer-mode nil
|
|
|
612 "Name of mode of buffer from where list-motion-handlers was called.")
|
|
|
613 (make-variable-buffer-local 'list-motion-handlers-buffer-mode)
|
|
|
614 ;; Listing available motion handlers in tabular form.
|
|
|
615
|
|
|
616 (defvar basic-motion-handlers (list 'mode-motion-highlight-line
|
|
|
617 'mode-motion-highlight-word
|
|
|
618 'mode-motion-highlight-symbol
|
|
|
619 'mode-motion-highlight-sexp)
|
|
|
620 "The basic motion handlers provided by the underlying XEmacs.")
|
|
|
621
|
|
|
622 (defun list-motion-handlers ()
|
|
|
623 "Display a list of available motion handlers.
|
|
|
624 The listing is in tabular form and contains the following columns:
|
|
|
625 NAME: the motion handlers name,
|
|
|
626 BOUNDARY FUNCTION: the name of the funtion used to compute the text
|
|
|
627 highlighted by the motion handler,
|
|
|
628 FACE: the face used to highlight the text.
|
|
|
629
|
|
|
630 Additionally, the following flags are used at the beginning of each line:
|
|
|
631 `*' Marks the motion handler current to the buffer this functions was called
|
|
|
632 from.
|
|
|
633 `H' Force highlighting of the selected text.
|
|
|
634 `F' Make point follow the mouse cursor as it moves."
|
|
|
635 (interactive)
|
|
|
636 (let ((current-handler (get-current-motion-handler))
|
|
|
637 (buffer (current-buffer))
|
|
|
638 (buffer-mode major-mode)
|
|
|
639 (bmmh (if (symbolp mode-motion-hook)
|
|
|
640 (car (memq mode-motion-hook basic-motion-handlers))
|
|
|
641 (if (and (listp mode-motion-hook)
|
|
|
642 (equal 1 (length mode-motion-hook)))
|
|
|
643 (car (memq (car mode-motion-hook)
|
|
|
644 basic-motion-handlers))))))
|
|
|
645 (save-excursion
|
|
|
646 (with-output-to-temp-buffer "*Mouse Motion Handlers*"
|
|
|
647 (let ((truncate-lines t))
|
|
|
648 (set-buffer "*Mouse Motion Handlers*")
|
|
|
649 (setq list-motion-handlers-buffer-to-customize buffer)
|
|
|
650 (setq list-motion-handlers-buffer-mode buffer-mode)
|
|
|
651 (let ((pos1 5)
|
|
|
652 (pos2 25)
|
|
|
653 (pos3 50)
|
|
|
654 (handlers
|
|
|
655 (sort
|
|
|
656 (mapcar 'cdr motion-handler-alist)
|
|
|
657 '(lambda (x y)
|
|
|
658 (string<
|
|
|
659 (symbol-name (motion-handler-boundary-function x))
|
|
|
660 (symbol-name (motion-handler-boundary-function y)))))))
|
|
|
661 (if bmmh
|
|
|
662 (let ((i 1)
|
|
|
663 (fw (frame-width)))
|
|
|
664 (while (< i fw)
|
|
|
665 (princ "*")
|
|
|
666 (setq i (1+ i)))
|
|
|
667 (princ "\nNote: this buffer is not using mode-motion+.\n\n")
|
|
|
668 (princ "It's using the `")
|
|
|
669 (princ bmmh)
|
|
|
670 (princ "' motion handler which claims it's:\n")
|
|
|
671 (insert (documentation bmmh))
|
|
|
672 (princ "\nSetting this motion handler will be irrevocable from this interface\n(but only for duration of this XEmacs session).\n")
|
|
|
673 (setq i 1)
|
|
|
674 (while (< i fw)
|
|
|
675 (princ "*")
|
|
|
676 (setq i (1+ i)))
|
|
|
677 (terpri)))
|
|
|
678 (princ " NAME BOUNDARY FUNCTION FACE\n")
|
|
|
679 (princ " ---- ----------------- ----\n")
|
|
|
680 (mapcar
|
|
|
681 #'(lambda (handler)
|
|
|
682 (let ((line-start (point)))
|
|
|
683 (princ (if (and (not bmmh) (eq handler current-handler))
|
|
|
684 "*" " "))
|
|
|
685 (princ (if (eq handler default-motion-handler) "D" " "))
|
|
|
686 (princ (if (motion-handler-highlight handler) "H" " "))
|
|
|
687 (princ (if (motion-handler-follow-point handler) "F" " "))
|
|
|
688 (indent-to-column pos1 1)
|
|
|
689 (princ (motion-handler-name handler))
|
|
|
690 (indent-to-column pos2 1)
|
|
|
691 (princ (motion-handler-boundary-function handler))
|
|
|
692 (indent-to-column pos3)
|
|
|
693 (let ((face-start (point)))
|
|
|
694 (princ (face-name (motion-handler-face handler)))
|
|
|
695 (let ((line-extent (make-extent line-start face-start))
|
|
|
696 (face-extent (make-extent face-start (point))))
|
|
|
697 (set-extent-face face-extent
|
|
|
698 (motion-handler-face handler))
|
|
|
699 (set-extent-property
|
|
|
700 face-extent
|
|
|
701 'mode-motion-handler (motion-handler-name handler))
|
|
|
702 (set-extent-property
|
|
|
703 line-extent
|
|
|
704 'mode-motion-handler (motion-handler-name handler))
|
|
|
705 (set-extent-property line-extent 'highlight t)))
|
|
|
706 (terpri)))
|
|
|
707 handlers)
|
|
|
708 (princ (format "
|
|
|
709 Flags: `D' the default motion handler
|
|
|
710 `H' handler with highlighting
|
|
|
711 `F' handler with `following' property
|
|
|
712 `*' the motion handler of buffer \"%s\""
|
|
|
713 list-motion-handlers-buffer-to-customize))))
|
|
|
714 (local-set-key 'button3 'mode-motion-set-handler)
|
|
|
715 (setq buffer-read-only t)))))
|
|
|
716
|
|
|
717 (defun mode-motion-set-handler (event)
|
|
|
718 (interactive "@e")
|
|
|
719 (let* ((handler (or (extent-property
|
|
|
720 (extent-at (event-point event) (current-buffer)
|
|
|
721 'mode-motion-handler)
|
|
|
722 'mode-motion-handler)
|
|
|
723 (error "Click on highlighted line to select a handler")))
|
|
|
724 (menu (list
|
|
|
725 (format "Make `%s' the Motion Handler of :" handler)
|
|
|
726 (vector (format "Buffer %s"
|
|
|
727 list-motion-handlers-buffer-to-customize)
|
|
|
728 (` (set-buffer-motion-handler
|
|
|
729 '(, list-motion-handlers-buffer-to-customize)
|
|
|
730 '(, handler))) t)
|
|
|
731 (vector "Another Buffer..."
|
|
|
732 (` (motion-handler-list-set-buffer-handler
|
|
|
733 '(, handler))) t)
|
|
|
734 "---"
|
|
|
735 (vector (format "Mode %s"
|
|
|
736 list-motion-handlers-buffer-mode)
|
|
|
737 (` (progn
|
|
|
738 (set-mode-motion-handler
|
|
|
739 '(, list-motion-handlers-buffer-mode)
|
|
|
740 '(, handler))
|
|
|
741 (save-excursion
|
|
|
742 (mapcar
|
|
|
743 (function
|
|
|
744 (lambda (buf)
|
|
|
745 (set-buffer buf)
|
|
|
746 (and (eq
|
|
|
747 '(, list-motion-handlers-buffer-mode)
|
|
|
748 major-mode)
|
|
|
749 (mode-motion+-hook-install buf t))))
|
|
|
750 (buffer-list))))) t)
|
|
|
751 (vector "Another Mode..."
|
|
|
752 (` (motion-handler-list-set-mode-handler
|
|
|
753 '(, handler))) t)
|
|
|
754 "---"
|
|
|
755 (vector "Default Motion Handler"
|
|
|
756 (` (set-default-motion-handler '(, handler))) t))))
|
|
|
757 (popup-menu menu)))
|
|
|
758
|
|
|
759 (defun motion-handler-list-set-buffer-handler (handler)
|
|
|
760 (let ((buffer (read-buffer-name
|
|
|
761 (format "Make `%s' the motion handler of buffer: " handler)
|
|
|
762 (buffer-name list-motion-handlers-buffer-to-customize))))
|
|
|
763 (set-buffer-motion-handler buffer handler)
|
|
|
764 (save-excursion
|
|
|
765 (set-buffer buffer)
|
|
|
766 (and (not (cond ((listp mode-motion-hook)
|
|
|
767 (memq 'mode-motion+-highlight mode-motion-hook))
|
|
|
768 ((symbolp mode-motion-hook)
|
|
|
769 (eq 'mode-motion+-highlight mode-motion-hook))
|
|
|
770 (t t)))
|
|
|
771 (y-or-n-p (format "Augment the default mode motion hook for `%s'? "
|
|
|
772 (buffer-name nil)))
|
|
|
773 (mode-motion+-hook-install buffer t)))))
|
|
|
774
|
|
|
775 (defvar mode-motion+-previous-hook nil
|
|
|
776 "Value of previous `mode-motion-hook' in current buffer.")
|
|
|
777 (make-variable-buffer-local 'mode-motion+-previous-hook)
|
|
|
778
|
|
|
779 (defun motion-handler-list-set-mode-handler (handler)
|
|
|
780 (let ((mode (intern (completing-read
|
|
|
781 (format "Make `%s' the motion handler of mode: " handler)
|
|
|
782 obarray
|
|
|
783 'fboundp
|
|
|
784 t
|
|
|
785 (symbol-name list-motion-handlers-buffer-mode)))))
|
|
|
786 (set-mode-motion-handler mode handler)
|
|
|
787 (save-excursion
|
|
|
788 (mapcar (function
|
|
|
789 (lambda (buf)
|
|
|
790 (set-buffer buf)
|
|
|
791 (and (eq mode major-mode)
|
|
|
792 (mode-motion+-hook-install buf t))))
|
|
|
793 (buffer-list)))))
|
|
|
794
|
|
|
795 (defun mode-motion+-hook-install (&optional buffer remove-highlight-line-p)
|
|
|
796 "Add `mode-motion+-highlight' to the BUFFER `mode-motion-hook'.
|
|
|
797 If the optional second arg REMOVE-HIGHLIGHT-LINE-P is t, remove
|
|
|
798 `mode-motion-highlight-line' from `mode-motion-hook'.
|
|
|
799 See `mode-motion+-hook-uninstall' for reverting this operation."
|
|
|
800 (interactive "bInstall mode-motion+ hook for buffer :
|
|
|
801 XRemove highlight-line from hook ? :")
|
|
|
802 ;; Check for the mode-motion-hook value to make sure it's under
|
|
|
803 ;; the control of mode-motion+.
|
|
|
804 ;; The reasonning here is that if the user went trough the hassles
|
|
|
805 ;; of list-motion-handlers (or if he's calling this directly from
|
|
|
806 ;; his .emacs) , he is prepared to give up on the current
|
|
|
807 ;; mode-motion-hook.
|
|
|
808 ;; However, we keep the previous hook value in a buffer-local
|
|
|
809 ;; variable: it will be then possible to revert to the old motion
|
|
|
810 ;; handling behavior with `mode-motion+-hook-uninstall'.
|
|
|
811 ;; --paquette, Mon Feb 27 08:54:30 1995 (Marc Paquette)
|
|
|
812 (setq buffer (or buffer (current-buffer)))
|
|
|
813 ;; force the uninstall of mode-motion-highlight since if its second
|
|
|
814 ;; you'll never see ours.
|
|
|
815 (setq remove-highlight-line-p t)
|
|
|
816 (save-excursion
|
|
|
817 (set-buffer buffer)
|
|
|
818 (if (boundp 'mode-motion-hook)
|
|
|
819 (progn
|
|
|
820 (setq mode-motion+-previous-hook
|
|
|
821 (cond ((sequencep mode-motion-hook)
|
|
|
822 (copy-sequence mode-motion-hook))
|
|
|
823 (t mode-motion-hook)))
|
|
|
824 ;; Make sure that the mode-motion+-highlight is not saved in
|
|
|
825 ;; the variable, otherwise, we could not revert back to the
|
|
|
826 ;; "factory settings" after having played with different
|
|
|
827 ;; handlers
|
|
|
828 ;; --paquette, Mon Feb 27 08:54:21 1995 (Marc Paquette)
|
|
|
829 (remove-hook 'mode-motion+-previous-hook 'mode-motion+-highlight)))
|
|
|
830 (add-hook 'mode-motion-hook 'mode-motion+-highlight)
|
|
|
831 (and remove-highlight-line-p
|
|
|
832 ;; Remove the standard mode-motion-highlight hook because we
|
|
|
833 ;; provide an alternative to this. I don't use setq here because
|
|
|
834 ;; something else could be hooked to mode-motion-hook.
|
|
|
835 ;; --paquette, Mon Feb 27 08:53:51 1995 (Marc Paquette)
|
|
|
836 (remove-hook 'mode-motion-hook 'mode-motion-highlight-line))
|
|
|
837 (and mode-motion-extent
|
|
|
838 (delete-extent mode-motion-extent)
|
|
|
839 (setq mode-motion-extent nil))
|
|
|
840 ;; Try to make this installed for any buffer of this mode
|
|
|
841 (let ((this-mode-hook (intern-soft (concat (symbol-name major-mode)
|
|
|
842 "-hook"))))
|
|
|
843 (and (boundp this-mode-hook)
|
|
|
844 (if remove-highlight-line-p
|
|
|
845 (add-hook this-mode-hook
|
|
|
846 #'(lambda () (mode-motion+-hook-install nil t))
|
|
|
847 'append)
|
|
|
848 (add-hook this-mode-hook 'mode-motion+-hook-install 'append)))))
|
|
|
849 mode-motion-hook)
|
|
|
850
|
|
|
851 (defun mode-motion+-hook-uninstall (buffer)
|
|
|
852 "Restore the value of `mode-motion-hook' in BUFFER to what it was at the time `mode-motion+-hook-install' was called.
|
|
|
853 See also `mode-motion+-hook-install'."
|
|
|
854 (interactive "bRestore `mode-motion-hook' of buffer :")
|
|
|
855 ;; Check for the mode-motion-hook value to make sure it's under
|
|
|
856 ;; the control of mode-motion+.
|
|
|
857 ;; The reasonning here is that if the user went trough the hassles
|
|
|
858 ;; of list-motion-handlers (or if he's calling this directly from
|
|
|
859 ;; his .emacs) , he is prepared to give up on the current
|
|
|
860 ;; mode-motion-hook.
|
|
|
861 ;; However, we keep the previous hook value in a buffer-local
|
|
|
862 ;; variable: it will be then possible to revert to the old motion
|
|
|
863 ;; handling behavior with `mode-motion+-hook-uninstall'.
|
|
|
864 ;; --paquette, Mon Feb 27 08:54:30 1995 (Marc Paquette)
|
|
|
865 (save-excursion
|
|
|
866 (set-buffer buffer)
|
|
|
867 (and mode-motion-extent
|
|
|
868 (delete-extent mode-motion-extent)
|
|
|
869 (setq mode-motion-extent nil))
|
|
|
870 (if (boundp 'mode-motion+-previous-hook)
|
|
|
871 (progn
|
|
|
872 (setq mode-motion-hook mode-motion+-previous-hook)
|
|
|
873 (setq mode-motion+-previous-hook nil)
|
|
|
874 (let ((this-mode-hook (intern-soft (concat (symbol-name major-mode)
|
|
|
875 "-hook"))))
|
|
|
876 (and (boundp this-mode-hook)
|
|
|
877 (remove-hook this-mode-hook 'mode-motion+-hook-install))))
|
|
|
878 (error "No previous value for mode-motion-hook")))
|
|
|
879 mode-motion-hook)
|
|
|
880
|
|
|
881 (defun mode-motion+-motion-hook-revert (&optional buffer-only-p buffer mode)
|
|
|
882 "Revert the `mode-motion-hook' to its original value.
|
|
|
883 With optional arg BUFFER-ONLY-P non-nil, only revert in BUFFER
|
|
|
884 \(defaults to `\(current-buffer\)'\); otherwise, revert for all existing
|
|
|
885 buffers of MODE \(defaults to `major-mode' of BUFFER\)."
|
|
|
886 (interactive
|
|
|
887 (let* ((buffer-only-p
|
|
|
888 (y-or-n-p "Revert mode-motion-hook only for current buffer ? "))
|
|
|
889 (buffer (if buffer-only-p
|
|
|
890 (current-buffer)
|
|
|
891 (get-buffer (read-buffer-name
|
|
|
892 "Revert mode-motion-hook of buffer : "
|
|
|
893 (buffer-name (current-buffer))))))
|
|
|
894 (mode (if buffer-only-p
|
|
|
895 (save-excursion
|
|
|
896 (set-buffer buffer)
|
|
|
897 major-mode)
|
|
|
898 (intern-soft (completing-read "Major mode: "
|
|
|
899 obarray
|
|
|
900 'fboundp
|
|
|
901 nil
|
|
|
902 (symbol-name major-mode))))))
|
|
|
903 (list buffer-only-p buffer mode)))
|
|
|
904 (if buffer-only-p
|
|
|
905 (mode-motion+-hook-uninstall buffer)
|
|
|
906 (save-excursion
|
|
|
907 (mapcar (function
|
|
|
908 (lambda (buf)
|
|
|
909 (set-buffer buf)
|
|
|
910 (and (eq mode major-mode)
|
|
|
911 (mode-motion+-hook-uninstall buf))))
|
|
|
912 (buffer-list)))))
|
|
|
913
|
|
|
914
|
|
|
915 ;; Setting buffer, mode and default motion handlers
|
|
|
916
|
|
|
917 (defun set-buffer-motion-handler (buffer handler-name)
|
|
|
918 "Make the motion handler named HANDLER-NAME (a symbol) the buffer
|
|
|
919 motion handler of BUFFER. If HANDLER-NAME is nil, the corresponding
|
|
|
920 buffer motion handler is removed. If HANDLER-NAME isn't the name of a
|
|
|
921 known motion handler, an error is signaled. When called interactively,
|
|
|
922 completion is provided for available buffers and motion handlers.
|
|
|
923
|
|
|
924 1.\) buffer motion handler
|
|
|
925 2.\) mode motion handler
|
|
|
926 3.\) default motion handler"
|
|
|
927 (interactive (list (read-buffer-name "Set motion handler of buffer: "
|
|
|
928 (buffer-name (current-buffer)))
|
|
|
929 (read-motion-handler-name)))
|
|
|
930
|
|
|
931 ;; kill old mode motion extent, because the new handler
|
|
|
932 ;; might want to initialize it differently
|
|
|
933 (if mode-motion-extent
|
|
|
934 (progn
|
|
|
935 (detach-extent mode-motion-extent)
|
|
|
936 (setq mode-motion-extent nil)))
|
|
|
937 (or buffer (setq buffer (current-buffer)))
|
|
|
938 (or (get-buffer buffer)
|
|
|
939 (error "No such buffer: %s" buffer))
|
|
|
940 (save-excursion
|
|
|
941 (set-buffer buffer)
|
|
|
942 (setq buffer-motion-handler
|
|
|
943 ;; remove it if `nil'
|
|
|
944 (and handler-name
|
|
|
945 ;; set the handler if known
|
|
|
946 (or (find-motion-handler handler-name)
|
|
|
947 ;; error otherwise
|
|
|
948 (error "Not a known motion handler: %s"
|
|
|
949 handler-name)))))
|
|
|
950 (if (interactive-p)
|
|
|
951 (if handler-name
|
|
|
952 (message "Motion handler for buffer %s is `%s'."
|
|
|
953 (current-buffer) handler-name)
|
|
|
954 (message "Motion handler removed for buffer %s."
|
|
|
955 (current-buffer))))
|
|
|
956 handler-name)
|
|
|
957
|
|
|
958 (defun read-buffer-name (prompt &optional initial-input)
|
|
|
959 (completing-read prompt
|
|
|
960 (mapcar #'(lambda (buf) (list (buffer-name buf)))
|
|
|
961 (buffer-list))
|
|
|
962 ;; don't take buffers that start with a blank
|
|
|
963 #'(lambda (list) (not (eq (aref (car list) 0) ? )))
|
|
|
964 t
|
|
|
965 initial-input))
|
|
|
966
|
|
|
967 (defun set-mode-motion-handler (mode handler-name)
|
|
|
968 "Make the motion handler named HANDLER-NAME (a symbol) the mode motion
|
|
|
969 handler for all buffers with major-mode MODE. If HANDLER-NAME is nil,
|
|
|
970 the corresponding mode motion handler is removed. If HANDLER-NAME
|
|
|
971 isn't the name of a known motion handler, an error is signaled. When
|
|
|
972 called interactively, completion is provided for available motion
|
|
|
973 handlers.
|
|
|
974
|
|
|
975 1.\) buffer motion handler
|
|
|
976 2.\) mode motion handler
|
|
|
977 3.\) default motion handler"
|
|
|
978 (interactive (list (intern (completing-read "Major mode: "
|
|
|
979 obarray
|
|
|
980 'fboundp
|
|
|
981 nil
|
|
|
982 (symbol-name major-mode)))
|
|
|
983 (read-motion-handler-name)))
|
|
|
984 ;; kill old mode motion extent, because the new handler
|
|
|
985 ;; might want to initialize it differently
|
|
|
986 (if mode-motion-extent
|
|
|
987 (progn
|
|
|
988 (detach-extent mode-motion-extent)
|
|
|
989 (setq mode-motion-extent nil)))
|
|
|
990 (put mode 'mode-motion-handler
|
|
|
991 ;; remove it if `nil'
|
|
|
992 (and handler-name
|
|
|
993 ;; set the handler if known
|
|
|
994 (or (find-motion-handler handler-name)
|
|
|
995 ;; error otherwise
|
|
|
996 (error "Not a known mode motion handler: %s" handler-name))))
|
|
|
997 (if (interactive-p)
|
|
|
998 (if handler-name
|
|
|
999 (message "Motion handler for %s is `%s'." mode handler-name)
|
|
|
1000 (message "Mode motion handler for %s removed." mode)))
|
|
|
1001 handler-name)
|
|
|
1002
|
|
|
1003 (defun set-default-motion-handler (handler-name)
|
|
|
1004 "Make the motion handler named HANDLER-NAME (a symbol) the default.
|
|
|
1005
|
|
|
1006 If HANDLER-NAME is nil, the current default motion handler is removed. If
|
|
|
1007 HANDLER-NAME isn't the name of a known motion handler, an error is
|
|
|
1008 signalled. When called interactively, completion is provided for available
|
|
|
1009 motion handlers.
|
|
|
1010
|
|
|
1011 The motion handler used in a given buffer is determined by the following
|
|
|
1012 most-specific first list: buffer motion handler, mode motion handler, default
|
|
|
1013 motion handler."
|
|
|
1014 (interactive (list (read-motion-handler-name)))
|
|
|
1015 ;; kill old mode motion extent, because the new handler
|
|
|
1016 ;; might want to initialize it differently
|
|
|
1017 (if mode-motion-extent
|
|
|
1018 (progn
|
|
|
1019 (detach-extent mode-motion-extent)
|
|
|
1020 (setq mode-motion-extent nil)))
|
|
|
1021 (setq default-motion-handler
|
|
|
1022 ;; remove it if `nil'
|
|
|
1023 (and handler-name
|
|
|
1024 ;; set the handler if known
|
|
|
1025 (or (find-motion-handler handler-name)
|
|
|
1026 ;; error otherwise
|
|
|
1027 (error "Not a known motion handler: %s" handler-name))))
|
|
|
1028 (if (interactive-p)
|
|
|
1029 (if handler-name
|
|
|
1030 (message "Default motion handler is `%s'." handler-name)
|
|
|
1031 (message "Default motion handler removed.")))
|
|
|
1032 handler-name)
|
|
|
1033
|
|
|
1034 (defun read-motion-handler-name ()
|
|
|
1035 (intern-soft (completing-read "Motion handler: "
|
|
|
1036 (mapcar #'(lambda (entry)
|
|
|
1037 (list (symbol-name (car entry))))
|
|
|
1038 motion-handler-alist)
|
|
|
1039 nil t)))
|
|
|
1040
|
|
|
1041 ;; clear the last active motion extent when leaving a frame.
|
|
|
1042 (defun mode-motion-clear-extent (&optional extent)
|
|
|
1043 "Clear EXTENT, i.e. make it have no visible effects on the frame.
|
|
|
1044 EXTENT defaults to the current buffer's mode-motion-extent."
|
|
|
1045 (or extent (setq extent mode-motion-extent))
|
|
|
1046 (and extent
|
|
|
1047 (extent-live-p extent)
|
|
|
1048 (not (extent-detached-p extent))
|
|
|
1049 (extent-buffer extent)
|
|
|
1050 (buffer-name (extent-buffer extent))
|
|
|
1051 (progn
|
|
|
1052 ;; unhighlight it
|
|
|
1053 (highlight-extent extent nil)
|
|
|
1054 ;; make it span a region that isn't visible and selectable
|
|
|
1055 ;; Can this be done more elegantly?
|
|
|
1056 (detach-extent extent))))
|
|
|
1057
|
|
|
1058 (defun mode-motion-clear-last-extent (&optional frame)
|
|
|
1059 "Clear the mode-motion-last-extent."
|
|
|
1060 (or (popup-menu-up-p) (mode-motion-clear-extent mode-motion-last-extent)))
|
|
|
1061
|
|
|
1062 (defun mode-motion+-highlight (event)
|
|
|
1063 "Highlight the thing under the mouse using a mode-specfic motion handler.
|
|
|
1064 See list-motion-handlers for more details."
|
|
|
1065 (mode-motion-clear-last-extent)
|
|
|
1066 (and (event-buffer event)
|
|
|
1067 (cond ((and mouse-grabbed-buffer
|
|
|
1068 ;; first try to do minibuffer specific highlighting
|
|
|
1069 (find-motion-handler 'minibuffer)
|
|
|
1070 (let ((mode-motion-highlight-lines-when-behind nil))
|
|
|
1071 (and (event-point event)
|
|
|
1072 (or (extent-at (event-point event)
|
|
|
1073 (event-buffer event) 'highlight)
|
|
|
1074 (mode-motion-highlight-with-handler
|
|
|
1075 (find-motion-handler 'minibuffer) event))))))
|
|
|
1076 (t (mode-motion-highlight-with-handler
|
|
|
1077 (get-current-motion-handler) event))))
|
|
|
1078 ;; Return nil since now this is used as a hook, and we want to let
|
|
|
1079 ;; any other hook run after us.
|
|
|
1080 nil)
|
|
|
1081
|
|
|
1082 (defun get-current-motion-handler ()
|
|
|
1083 (or (and (boundp 'buffer-motion-handler) buffer-motion-handler)
|
|
|
1084 (get major-mode 'mode-motion-handler)
|
|
|
1085 default-motion-handler))
|
|
|
1086
|
|
|
1087 (defun mode-motion-highlight-with-handler (handler event)
|
|
|
1088 ;; Perform motion highlighting using HANDLER. Information about the
|
|
|
1089 ;; current mouse position is taken form EVENT.
|
|
|
1090 (and handler
|
|
|
1091 (let ((point (event-point event))
|
|
|
1092 (buffer (event-buffer event))
|
|
|
1093 (window (event-window event))
|
|
|
1094 (window-config (current-window-configuration))
|
|
|
1095 (buffer-save (current-buffer))
|
|
|
1096 (point-save (point))
|
|
|
1097 region)
|
|
|
1098 ;; save-window-excursion and restore buffer
|
|
|
1099 (unwind-protect
|
|
|
1100 (progn
|
|
|
1101 (and buffer
|
|
|
1102 (set-buffer buffer)
|
|
|
1103 (select-window window))
|
|
|
1104
|
|
|
1105 ;; kludge: if point = end-of-window, then probably the mouse
|
|
|
1106 ;; is actually between the last line and the modeline. In
|
|
|
1107 ;; this case move point to back one
|
|
|
1108 (and point
|
|
|
1109 (not (< point (window-end window)))
|
|
|
1110 (setq point (1- point)))
|
|
|
1111 ;; Create a new mode-motion-extent if there isn't one
|
|
|
1112 ;; (or a destroyed one)
|
|
|
1113 (if (and (extent-live-p mode-motion-extent)
|
|
|
1114 (extent-buffer mode-motion-extent))
|
|
|
1115 ()
|
|
|
1116 (setq mode-motion-extent (make-extent nil nil buffer))
|
|
|
1117 (set-extent-priority mode-motion-extent 1))
|
|
|
1118 (if (and
|
|
|
1119 ;; compute the region to be highlighted
|
|
|
1120 (setq region
|
|
|
1121 (if point
|
|
|
1122 ;; compute the mode-motion region using the
|
|
|
1123 ;; handlers boundary function
|
|
|
1124 (condition-case nil;; c
|
|
|
1125 (funcall
|
|
|
1126 (motion-handler-boundary-function handler)
|
|
|
1127 point)
|
|
|
1128 ;; Messages that appear during computing the
|
|
|
1129 ;; region may be displayed not done
|
|
|
1130 ;; here because it's rather disturbing
|
|
|
1131 (error
|
|
|
1132 ;; (setq message (format "%s" (car (cdr c))))
|
|
|
1133 nil))
|
|
|
1134 ;; otherwise highlight the whole line mouse is
|
|
|
1135 ;; behind but only if the line isn't empty
|
|
|
1136 (if mode-motion-highlight-lines-when-behind
|
|
|
1137 (unwind-protect
|
|
|
1138 (progn
|
|
|
1139 ;; (message "%s" (event-window event))
|
|
|
1140 (move-to-window-line
|
|
|
1141 (if (< emacs-minor-version 12)
|
|
|
1142 (- (event-y event)
|
|
|
1143 (nth 1 (window-edges window)))
|
|
|
1144 (event-y event)))
|
|
|
1145 (beginning-of-line)
|
|
|
1146 (if (= (following-char) ?\n)
|
|
|
1147 ;; empty line
|
|
|
1148 ()
|
|
|
1149 (thing-region
|
|
|
1150 (point)
|
|
|
1151 (progn
|
|
|
1152 (end-of-line)
|
|
|
1153 ;; for `follow-point' behavoir
|
|
|
1154 (setq point (point))
|
|
|
1155 ;; fetch also the newline, if any
|
|
|
1156 ;; -- handy for copying >1 line
|
|
|
1157 (if (eobp) point (1+ point))))))
|
|
|
1158 (goto-char point-save)))))
|
|
|
1159 ;; (message "region: %s" region)
|
|
|
1160 ;; the region might be in reverse order. Stop in this case
|
|
|
1161 (<= (car region) (cdr region)))
|
|
|
1162 (if (or (not (motion-handler-follow-point handler))
|
|
|
1163 (pos-visible-in-window-p point))
|
|
|
1164 (progn
|
|
|
1165 ;; set the extent face
|
|
|
1166 (set-extent-face
|
|
|
1167 mode-motion-extent (motion-handler-face handler))
|
|
|
1168 ;; set the new boundary
|
|
|
1169 (set-extent-endpoints
|
|
|
1170 mode-motion-extent (car region) (cdr region))
|
|
|
1171 ;; highlight if required
|
|
|
1172 (set-extent-property
|
|
|
1173 mode-motion-extent 'highlight
|
|
|
1174 (motion-handler-highlight handler))
|
|
|
1175 (highlight-extent mode-motion-extent
|
|
|
1176 (motion-handler-highlight handler))
|
|
|
1177 ;; make point follow the mouse or point to
|
|
|
1178 ;; the beginning of the line do not move the
|
|
|
1179 ;; cursor if a mark is set.
|
|
|
1180 (cond ((and (motion-handler-follow-point handler)
|
|
|
1181 (not (mark)))
|
|
|
1182 (goto-char point)
|
|
|
1183 ;; kludge to keep the cursor out the way
|
|
|
1184 (if (or (eq (motion-handler-boundary-function
|
|
|
1185 handler)
|
|
|
1186 'line-boundaries)
|
|
|
1187 (eq (motion-handler-boundary-function
|
|
|
1188 handler)
|
|
|
1189 'visible-line-boundaries))
|
|
|
1190 (beginning-of-line))))
|
|
|
1191 (if (and mode-motion-focus-on-window
|
|
|
1192 (or (eq mode-motion-focus-on-window t)
|
|
|
1193 (motion-handler-follow-point handler)))
|
|
|
1194 ;; Select the current window FROM OUTSIDE the
|
|
|
1195 ;; `save-window-excursion' that surrounds the call
|
|
|
1196 ;; to the current function. This also avoids
|
|
|
1197 ;; conflicts with running process filters.
|
|
|
1198 (enqueue-eval-event 'select-window
|
|
|
1199 (selected-window)))
|
|
|
1200 ;; snap in effect, but it ain't yet workin'
|
|
|
1201 ;; (message "X: %sl; Y: %s"(event-x event)(event-y event))
|
|
|
1202 ;; (and motion-handler-snap-in
|
|
|
1203 ;; (set-mouse-position
|
|
|
1204 ;; (window-frame (event-window event))
|
|
|
1205 ;; (event-x event)
|
|
|
1206 ;; (event-y event)))
|
|
|
1207 (setq mode-motion-last-extent mode-motion-extent)
|
|
|
1208 ;; signal success
|
|
|
1209 t))
|
|
|
1210 ;; signal failiure
|
|
|
1211 nil))
|
|
|
1212 (set-window-configuration window-config)
|
|
|
1213 (set-buffer buffer-save)))))
|
|
|
1214
|
|
|
1215 ;; Motion Event debugging
|
|
|
1216 ;;
|
|
|
1217 ;; Useful to see what information is available from motion events
|
|
|
1218
|
|
|
1219 (defun debug-motion-handler (event)
|
|
|
1220 (let* ((window (event-window event))
|
|
|
1221 (frame (or (event-frame event) (selected-frame)))
|
|
|
1222 (buffer (and window (event-buffer event)))
|
|
|
1223 (point (and buffer (event-point event))))
|
|
|
1224 (with-output-to-temp-buffer "*Debug Motion Handler Output*"
|
|
|
1225 (princ
|
|
|
1226 (format "\
|
|
|
1227 Window: %s
|
|
|
1228 Frame: %s
|
|
|
1229 Buffer: %s
|
|
|
1230 (event-x, event-y): (%s, %s)
|
|
|
1231 (event-x-pixel, event-y-pixel): (%s, %s)
|
|
|
1232 Point: %s
|
|
|
1233 Timestamp: %s"
|
|
|
1234 window
|
|
|
1235 frame
|
|
|
1236 buffer
|
|
|
1237 (event-x event) (event-y event)
|
|
|
1238 (event-x-pixel event) (event-y-pixel event)
|
|
|
1239 point
|
|
|
1240 (event-timestamp event))))))
|
|
|
1241
|
|
|
1242 ;(let ((mouse-motion-handler 'debug-motion-handler)
|
|
|
1243 ; (temp-buffer-show-function nil))
|
|
|
1244 ; (read-char))
|
|
|
1245
|
|
|
1246 ;; Set of copy/kill/move functions for usage with highlighted regions
|
|
|
1247
|
|
|
1248 (put 'mode-motion-move 'pending-delete t)
|
|
|
1249 (put 'mode-motion-copy 'pending-delete t)
|
|
|
1250
|
|
|
1251 (defun mode-motion-move ()
|
|
|
1252 "Move the motion active region to point."
|
|
|
1253 (interactive)
|
|
|
1254 (mode-motion-insert-text (mode-motion-copy/delete t)))
|
|
|
1255
|
|
|
1256 (defun mode-motion-kill ()
|
|
|
1257 "Kill the motion active region and push it onto the kill ring."
|
|
|
1258 (interactive)
|
|
|
1259 (mode-motion-copy/delete t t t))
|
|
|
1260
|
|
|
1261 (defun mode-motion-copy ()
|
|
|
1262 "Copy the motion active region to point."
|
|
|
1263 (interactive)
|
|
|
1264 (mode-motion-insert-text (mode-motion-copy/delete)))
|
|
|
1265
|
|
|
1266 (defun mode-motion-copy-as-kill ()
|
|
|
1267 "Delete the motion active region and push it onto the kill ring.
|
|
|
1268 Set point to the place where deletion happened."
|
|
|
1269 (interactive)
|
|
|
1270 (mode-motion-copy/delete nil t)
|
|
|
1271 (message "Text copied to the to ring and cut buffer."))
|
|
|
1272
|
|
|
1273 (defun mode-motion-copy/delete (&optional delete copy-as-kill set-point)
|
|
|
1274 "Return the string that is designated by the current motion active region.
|
|
|
1275 Arguments are:
|
|
|
1276 EVENT - a mouse click event used to identify the buffer and window
|
|
|
1277 &optional DELETE - delete the motion active text region
|
|
|
1278 COPY-AS-KILL - copy the string to the kill ring
|
|
|
1279 SET-POINT - set point to the start of the motion active region."
|
|
|
1280 (let ((old-buf (current-buffer))
|
|
|
1281 (old-window (selected-window)))
|
|
|
1282 (unwind-protect
|
|
|
1283 (let ((extent (or primary-selection-extent
|
|
|
1284 (and (extentp mode-motion-last-extent)
|
|
|
1285 (not (extent-property mode-motion-last-extent
|
|
|
1286 'detached))
|
|
|
1287 mode-motion-last-extent))))
|
|
|
1288
|
|
|
1289 (if (and (extentp extent)
|
|
|
1290 (set-buffer (extent-buffer extent))
|
|
|
1291 (not
|
|
|
1292 ;; zero length extents
|
|
|
1293 (= (extent-start-position extent)
|
|
|
1294 (extent-end-position extent))))
|
|
|
1295
|
|
|
1296 (let* ((start (extent-start-position extent))
|
|
|
1297 (end (extent-end-position extent))
|
|
|
1298 (text
|
|
|
1299 (buffer-substring
|
|
|
1300 (extent-start-position extent)
|
|
|
1301 (extent-end-position extent))))
|
|
|
1302
|
|
|
1303 (cond (copy-as-kill
|
|
|
1304 (copy-region-as-kill start end)
|
|
|
1305 (if (or (not kill-hooks)
|
|
|
1306 (eq kill-hooks 'ignore))
|
|
|
1307 (progn
|
|
|
1308 (x-own-selection-internal 'PRIMARY text)
|
|
|
1309 (x-own-clipboard text)))))
|
|
|
1310
|
|
|
1311 (cond (delete
|
|
|
1312 (kill-region start end)
|
|
|
1313 (x-own-selection-internal 'PRIMARY text)
|
|
|
1314 ;; (select-window window)
|
|
|
1315 (if set-point
|
|
|
1316 (goto-char start))))
|
|
|
1317
|
|
|
1318 (setq this-command 'mode-motion+)
|
|
|
1319 text)
|
|
|
1320 (error "No current primary or motion selection.")
|
|
|
1321 ))
|
|
|
1322 (set-buffer old-buf)
|
|
|
1323 (select-window old-window))))
|
|
|
1324
|
|
|
1325 (defun mode-motion-insert-text (text)
|
|
|
1326 "Insert TEXT at point. Also insert one space if the
|
|
|
1327 preceeding character is a word constituent or a closing paren."
|
|
|
1328 (or text (error "No highlighted text to copy."))
|
|
|
1329 (let ((prec-char-syntax (char-syntax (preceding-char))))
|
|
|
1330 (if (memq prec-char-syntax '(?w ?\))) (insert " "))
|
|
|
1331 (insert text)))
|
|
|
1332
|
|
|
1333 ;; Boundary functions
|
|
|
1334 ;;
|
|
|
1335 ;; The following functions are already provided by the thing package:
|
|
|
1336 ;; thing-boundaries
|
|
|
1337 ;; thing-symbol
|
|
|
1338 ;; thing-word
|
|
|
1339
|
|
|
1340 (defun char-boundaries (point) (thing-region point (1+ point)))
|
|
|
1341
|
|
|
1342 (defun visible-line-boundaries (point)
|
|
|
1343 (save-excursion
|
|
|
1344 (goto-char point)
|
|
|
1345 (beginning-of-line)
|
|
|
1346 (skip-chars-forward " \t")
|
|
|
1347 (if (and (eq major-mode 'dired-mode)
|
|
|
1348 (save-excursion (dired-move-to-filename)))
|
|
|
1349 (let ((start (point)))
|
|
|
1350 (end-of-line)
|
|
|
1351 (skip-chars-backward " \t")
|
|
|
1352 (thing-region start (point))))))
|
|
|
1353
|
|
|
1354 (defun line-boundaries (point)
|
|
|
1355 (save-excursion
|
|
|
1356 (goto-char point)
|
|
|
1357 (beginning-of-line)
|
|
|
1358 (if (and (eq major-mode 'dired-mode)
|
|
|
1359 (save-excursion (dired-move-to-filename)))
|
|
|
1360 (let ((start (point)))
|
|
|
1361 (end-of-line)
|
|
|
1362 (thing-region start (point))))))
|
|
|
1363
|
|
|
1364 (defun cvs-line-boundaries (point)
|
|
|
1365 (save-excursion
|
|
|
1366 (goto-char point)
|
|
|
1367 (beginning-of-line)
|
|
|
1368 (if (looking-at "^[* ] ")
|
|
|
1369 (thing-region (point) (progn (end-of-line) (point))))))
|
|
|
1370
|
|
|
1371 (defun latex-boundaries (here)
|
|
|
1372 (setq *last-thing* 'sexp)
|
|
|
1373 (tex-boundaries
|
|
|
1374 here ?\\ "a-zA-Z"
|
|
|
1375 ;; begin-fwd-regexp
|
|
|
1376 "\\\\begin *{ *\\([a-z]*\\) *}"
|
|
|
1377 ;; end-fwd-regexp
|
|
|
1378 "\\(\\\\end *{ *%s *}\\)\\|\\(\\\\begin *{ *%s *}\\)"
|
|
|
1379 ;; begin-bwd-regexp
|
|
|
1380 "\\\\end *{ *\\([a-z]*\\) *}"
|
|
|
1381 ;; begin-bwd-regexp
|
|
|
1382 "\\(\\\\end *{ *%s *}\\)\\|\\(\\\\begin *{ *%s *}\\)"
|
|
|
1383 ;; param-cmd-regexp
|
|
|
1384 "\\\\[a-zA-Z]+[ \n\t]*{"))
|
|
|
1385
|
|
|
1386 (defvar texinfo-paired-commands
|
|
|
1387 (mapconcat
|
|
|
1388 'identity
|
|
|
1389 '(
|
|
|
1390 "enumerate"
|
|
|
1391 "example"
|
|
|
1392 "group"
|
|
|
1393 "ifinfo"
|
|
|
1394 "iftex"
|
|
|
1395 "ignore"
|
|
|
1396 "itemize"
|
|
|
1397 "menu"
|
|
|
1398 "quotation"
|
|
|
1399 "table"
|
|
|
1400 "tex"
|
|
|
1401 "titlepage"
|
|
|
1402 )
|
|
|
1403 "\\|"))
|
|
|
1404
|
|
|
1405 (defvar texinfo-begin-fwd-regexp
|
|
|
1406 (format "@\\(%s\\)" texinfo-paired-commands))
|
|
|
1407 (defvar texinfo-end-bwd-regexp
|
|
|
1408 (format "@end *\\(%s\\)" texinfo-paired-commands))
|
|
|
1409
|
|
|
1410 (defun texinfo-boundaries (here)
|
|
|
1411 (tex-boundaries
|
|
|
1412 here ?@ "a-z"
|
|
|
1413 texinfo-begin-fwd-regexp
|
|
|
1414 ;; end-fwd-regexp
|
|
|
1415 "\\(@end *%s\\)\\|\\(@%s\\)"
|
|
|
1416 ;; end-bwd-regexp
|
|
|
1417 texinfo-end-bwd-regexp
|
|
|
1418 ;; begin-bwd-regexp
|
|
|
1419 "\\(@end *%s\\)\\|\\(@%s\\)"
|
|
|
1420 ;; param-cmd-regexp
|
|
|
1421 "@\\(TeX\\|[a-zA]+\\)[ \n\t]*{"))
|
|
|
1422
|
|
|
1423 (defun tex-boundaries
|
|
|
1424 (here cmd-start-character cmd-word-character
|
|
|
1425 begin-fwd-regexp end-fwd-regexp
|
|
|
1426 end-bwd-regexp begin-bwd-regexp
|
|
|
1427 param-cmd-regexp)
|
|
|
1428 "Generic TeX dialect scanner.
|
|
|
1429 Parameters:
|
|
|
1430 cmd-start-character: character that starts a command
|
|
|
1431 (`\' in (La)TeX, `@' in Texinfo)
|
|
|
1432 cmd-word-character: regexpression to be used by the function
|
|
|
1433 `skip-chars-backward' allowing to skip over command
|
|
|
1434 characters other than `cmd-start-character'
|
|
|
1435 begin-fwd-regexp: regexpression matching the begin part of a
|
|
|
1436 text stretch, used in forward search.
|
|
|
1437 end-fwd-regexp: regexpression matching the end part of a
|
|
|
1438 text stretch, used in forward search
|
|
|
1439 end-bwd-regexp: regexpression matching the end part of a
|
|
|
1440 text stretch, used in backward search.
|
|
|
1441 begin-bwd-regexp: regexpression matching the begin part of a
|
|
|
1442 text stretch, used in backward search.
|
|
|
1443 param-cmd-regexp: regexpression matching a parameterized command
|
|
|
1444 \(including the open parenthesis\)"
|
|
|
1445 (save-excursion
|
|
|
1446 (goto-char here)
|
|
|
1447 (cond ((= (following-char) cmd-start-character)
|
|
|
1448 (forward-char 1))
|
|
|
1449 ((= (char-syntax (following-char)) ?w)
|
|
|
1450 (skip-chars-backward cmd-word-character)))
|
|
|
1451 (if (/= (preceding-char) cmd-start-character)
|
|
|
1452 (thing-boundaries here)
|
|
|
1453 (forward-char -1)
|
|
|
1454 (catch 'return
|
|
|
1455 (cond ((looking-at begin-fwd-regexp)
|
|
|
1456 (let* ((start (point))
|
|
|
1457 (env (buffer-substring
|
|
|
1458 (match-beginning 1) (match-end 1)))
|
|
|
1459 (regexp (format end-fwd-regexp env env))
|
|
|
1460 (count 0))
|
|
|
1461 (while (re-search-forward regexp nil t)
|
|
|
1462 (cond ((match-beginning 2) ; \begin
|
|
|
1463 (setq count (1+ count)))
|
|
|
1464 ((match-beginning 1) ; \end
|
|
|
1465 (setq count (1- count))
|
|
|
1466 (if (= count 0)
|
|
|
1467 (throw 'return
|
|
|
1468 (thing-region start (point)))))))))
|
|
|
1469 ((looking-at end-bwd-regexp)
|
|
|
1470 (let* ((end (match-end 0))
|
|
|
1471 (env (buffer-substring
|
|
|
1472 (match-beginning 1) (match-end 1)))
|
|
|
1473 (regexp
|
|
|
1474 (format begin-bwd-regexp env env))
|
|
|
1475 (count 1))
|
|
|
1476 (while (re-search-backward regexp nil t)
|
|
|
1477 (cond ((match-beginning 1) ; \end
|
|
|
1478 (setq count (1+ count)))
|
|
|
1479 ((match-beginning 2) ; \begin
|
|
|
1480 (setq count (1- count))
|
|
|
1481 (if (= count 0)
|
|
|
1482 (throw 'return (thing-region (point) end))))
|
|
|
1483 ))))
|
|
|
1484 ;; tex macros of the form \cmd {...}
|
|
|
1485 ((looking-at param-cmd-regexp)
|
|
|
1486 (thing-region
|
|
|
1487 (point)
|
|
|
1488 (progn
|
|
|
1489 (goto-char (1- (match-end 0)))
|
|
|
1490 (forward-sexp 1)
|
|
|
1491 (point))))
|
|
|
1492 ;; fetch the current macro (with backslash)
|
|
|
1493 (t (thing-region (point) (progn (forward-word 1) (point)))))))))
|
|
|
1494
|
|
|
1495 ;; special parse of buffer for valid selectable info
|
|
|
1496 (defun minibuffer-selection-boundaries (point)
|
|
|
1497 (let ((old-syntax (syntax-table)))
|
|
|
1498 (unwind-protect
|
|
|
1499 (progn
|
|
|
1500 ;; best syntax table for recognizing symbols
|
|
|
1501 (set-syntax-table emacs-lisp-mode-syntax-table)
|
|
|
1502 (let ((file-completion (eq minibuffer-completion-table
|
|
|
1503 'read-file-name-internal))
|
|
|
1504 region
|
|
|
1505 minibuf-string ;contents of minibuffer
|
|
|
1506 buffer-string ;string to be highlighted (or not)
|
|
|
1507 prefix ;prefix calculated from minibuf-string
|
|
|
1508 string ;string to be verified in the
|
|
|
1509 ;completion table
|
|
|
1510 )
|
|
|
1511 (and
|
|
|
1512
|
|
|
1513 (setq region (if file-completion
|
|
|
1514 (thing-filename point)
|
|
|
1515 (thing-symbol point)))
|
|
|
1516
|
|
|
1517 (setq
|
|
|
1518 minibuf-string ; contents of minibuffer
|
|
|
1519 (save-excursion
|
|
|
1520 (set-buffer mouse-grabbed-buffer)
|
|
|
1521 (buffer-string))
|
|
|
1522
|
|
|
1523 buffer-string ; string to be highlighted (or not)
|
|
|
1524 (buffer-substring (car region) (cdr region))
|
|
|
1525
|
|
|
1526 prefix
|
|
|
1527 (if file-completion
|
|
|
1528 (file-name-nondirectory minibuf-string)
|
|
|
1529 minibuf-string)
|
|
|
1530
|
|
|
1531 string
|
|
|
1532 (if file-completion
|
|
|
1533 (concat (file-name-directory minibuf-string) buffer-string)
|
|
|
1534 buffer-string))
|
|
|
1535
|
|
|
1536 (if (or (and (fboundp 'ange-ftp-ftp-path)
|
|
|
1537 (or (ange-ftp-ftp-path buffer-string)
|
|
|
1538 (ange-ftp-ftp-path string)))
|
|
|
1539 (and (fboundp 'efs-ftp-path)
|
|
|
1540 (or (efs-ftp-path buffer-string)
|
|
|
1541 (efs-ftp-path string))))
|
|
|
1542 ;; #### Like our counterpart in mode-motion: evil evil evil
|
|
|
1543 t
|
|
|
1544 (if file-completion
|
|
|
1545 (try-completion string
|
|
|
1546 minibuffer-completion-table
|
|
|
1547 minibuffer-completion-predicate)
|
|
|
1548 (eq 't (try-completion string
|
|
|
1549 minibuffer-completion-table
|
|
|
1550 minibuffer-completion-predicate))))
|
|
|
1551
|
|
|
1552 ;; the result is the region to be highlighted
|
|
|
1553 region)))
|
|
|
1554 (set-syntax-table old-syntax))))
|
|
|
1555
|
|
|
1556 ;; C source code scanner
|
|
|
1557 (defvar c-statement-starting-keyword-regexpr
|
|
|
1558 "\\(if\\|for\\|while\\|do\\|switch\\|break\\|continue\\)\\b")
|
|
|
1559
|
|
|
1560 (defun c-boundaries (here)
|
|
|
1561 (setq *last-thing* 'sexp)
|
|
|
1562 (save-excursion
|
|
|
1563 (goto-char here)
|
|
|
1564 (let ((following-char (following-char))
|
|
|
1565 (preceding-char (preceding-char))
|
|
|
1566 aux)
|
|
|
1567 (if (= (char-syntax following-char) ?w)
|
|
|
1568 (progn
|
|
|
1569 (skip-chars-backward "a-zA-Z")
|
|
|
1570 (setq aux (point))
|
|
|
1571 (skip-chars-backward "\n\t ")
|
|
|
1572 (if (= (preceding-char) ?#)
|
|
|
1573 (forward-char -1)
|
|
|
1574 (goto-char aux))))
|
|
|
1575 (if (and (= following-char ?*)
|
|
|
1576 (= preceding-char ?/))
|
|
|
1577 (forward-char -1))
|
|
|
1578 (if (and (= following-char ?/)
|
|
|
1579 (= preceding-char ?*))
|
|
|
1580 (forward-char -1))
|
|
|
1581 (cond
|
|
|
1582 ((= (following-char) ?#) (c-scan-preproc-macros))
|
|
|
1583 ((looking-at "/\\*") ; begin comment
|
|
|
1584 (let ((start (match-beginning 0)))
|
|
|
1585 (if (search-forward "*/" nil t)
|
|
|
1586 (thing-region start (match-end 0)))))
|
|
|
1587 ((looking-at "\\*/") ; end comment
|
|
|
1588 (let ((end (match-end 0)))
|
|
|
1589 (if (search-backward "/*" nil t)
|
|
|
1590 (thing-region (match-beginning 0) end))))
|
|
|
1591 ((looking-at c-statement-starting-keyword-regexpr) ; if for while do etc
|
|
|
1592 (thing-region (match-beginning 0)
|
|
|
1593 (c-forward-statement
|
|
|
1594 (buffer-substring (match-beginning 1) (match-end 1)))))
|
|
|
1595 ((looking-at "else\\b")
|
|
|
1596 (thing-region (match-beginning 0) (c-forward-else)))
|
|
|
1597 (t (if (= (char-syntax (following-char)) ?.)
|
|
|
1598 (thing-region here (1+ here))
|
|
|
1599 (thing-boundaries here)))))))
|
|
|
1600
|
|
|
1601
|
|
|
1602 (defun c-scan-preproc-macros ()
|
|
|
1603 (cond
|
|
|
1604 ((looking-at "^#[ \n\t]*include[ \n\t]*[<\"][^>\"]*[>\"]") ; #include
|
|
|
1605 (thing-region (match-beginning 0) (match-end 0)))
|
|
|
1606 ((looking-at "^#[ \n\t]*\\(define\\|undef\\)") ; #define, #undef
|
|
|
1607 (thing-region
|
|
|
1608 (match-beginning 0)
|
|
|
1609 (progn
|
|
|
1610 (end-of-line)
|
|
|
1611 (while (= (preceding-char) ?\\)
|
|
|
1612 (forward-line 1)
|
|
|
1613 (end-of-line))
|
|
|
1614 (point))))
|
|
|
1615 ;; #if, #ifdef, #ifndef, #else, #elif
|
|
|
1616 ((looking-at "^#[ \n\t]*\\(if\\|ifdef\\|ifndef\\|else\\|elif\\)\\b")
|
|
|
1617 (let ((start (match-beginning 0))
|
|
|
1618 (counter 1)
|
|
|
1619 match)
|
|
|
1620 (goto-char (match-end 0))
|
|
|
1621 (while (and (>= counter 1)
|
|
|
1622 (re-search-forward
|
|
|
1623 "^#[ \n\t]*\\(if\\|ifdef\\|ifndef\\|endif\\)\\b"
|
|
|
1624 nil t))
|
|
|
1625 (setq match
|
|
|
1626 (buffer-substring (match-beginning 1) (match-end 1)))
|
|
|
1627 (setq counter
|
|
|
1628 (if (string= match "endif")
|
|
|
1629 (1- counter)
|
|
|
1630 (1+ counter))))
|
|
|
1631 (if (= counter 0)
|
|
|
1632 (thing-region start (match-end 0)))))
|
|
|
1633 ((looking-at "^#[ \n\t]*endif\\b") ; #endif
|
|
|
1634 (let ((end (match-end 0))
|
|
|
1635 (counter 1)
|
|
|
1636 match)
|
|
|
1637 (goto-char (match-beginning 0))
|
|
|
1638 (while (and (>= counter 1)
|
|
|
1639 (re-search-backward
|
|
|
1640 "^#[ \n\t]*\\(if\\|ifdef\\|ifndef\\|endif\\)\\b"
|
|
|
1641 nil t))
|
|
|
1642 (setq match
|
|
|
1643 (buffer-substring (match-beginning 1) (match-end 1)))
|
|
|
1644 (setq counter
|
|
|
1645 (if (string= match "endif")
|
|
|
1646 (1+ counter)
|
|
|
1647 (1- counter))))
|
|
|
1648 (if (= counter 0)
|
|
|
1649 (thing-region (match-beginning 0) end))))))
|
|
|
1650
|
|
|
1651 (defun c-skip-over-comment ()
|
|
|
1652 (let ((aux (point)))
|
|
|
1653 (skip-chars-forward "\n\t ")
|
|
|
1654 (or (and (= (following-char) ?/)
|
|
|
1655 (= (char-after (1+ (point))) ?*)
|
|
|
1656 (search-forward "*/" nil t)
|
|
|
1657 (point))
|
|
|
1658 (goto-char aux))))
|
|
|
1659
|
|
|
1660 (defun c-forward-statement (&optional keyword)
|
|
|
1661 (c-skip-over-comment)
|
|
|
1662 (skip-chars-forward " \n\t")
|
|
|
1663 (or keyword (setq keyword
|
|
|
1664 (if (looking-at c-statement-starting-keyword-regexpr)
|
|
|
1665 (buffer-substring
|
|
|
1666 (match-beginning 1)
|
|
|
1667 (match-end 1)))))
|
|
|
1668 (if keyword
|
|
|
1669 (cond ((string= keyword "if")
|
|
|
1670 (c-forward-if))
|
|
|
1671 ((string= keyword "do")
|
|
|
1672 (c-forward-do-while))
|
|
|
1673 ((member keyword '("for" "while" "switch"))
|
|
|
1674 (c-forward-for/while/switch))
|
|
|
1675 ((member keyword '("break" "continue"))
|
|
|
1676 (c-forward-break/continue)))
|
|
|
1677 (cond ((= (following-char) ?\{)
|
|
|
1678 (forward-list 1)
|
|
|
1679 (point))
|
|
|
1680 (t
|
|
|
1681 ;; Here I use that each C statement other then
|
|
|
1682 ;; a bloc, if, while, for, do ... ends in a `;'
|
|
|
1683 (let (char)
|
|
|
1684 (catch 'exit
|
|
|
1685 (while t
|
|
|
1686 (if (eobp) (throw 'exit nil))
|
|
|
1687 (setq char (following-char))
|
|
|
1688 (cond ((= (char-syntax char) ?.)
|
|
|
1689 (forward-char 1)
|
|
|
1690 (if (= char ?\;) (throw 'exit (point))))
|
|
|
1691 (t (forward-sexp 1)
|
|
|
1692 (skip-chars-forward " \n\t"))))))))))
|
|
|
1693
|
|
|
1694 (defun c-forward-if ()
|
|
|
1695 (let (aux)
|
|
|
1696 (forward-word 1) ; if
|
|
|
1697 (forward-list 1)
|
|
|
1698 (c-forward-statement)
|
|
|
1699 (setq aux (point))
|
|
|
1700 (skip-chars-forward "\n\t ")
|
|
|
1701 (if (looking-at "else\\b")
|
|
|
1702 (c-forward-else)
|
|
|
1703 (goto-char aux))))
|
|
|
1704
|
|
|
1705 (defun c-forward-else ()
|
|
|
1706 (forward-word 1) ; else
|
|
|
1707 (c-forward-statement))
|
|
|
1708
|
|
|
1709 (defun c-forward-for/while/switch ()
|
|
|
1710 (forward-word 1) ; for
|
|
|
1711 (forward-list 1)
|
|
|
1712 (c-forward-statement))
|
|
|
1713
|
|
|
1714 (defun c-forward-do-while ()
|
|
|
1715 (forward-word 1) ; do ... while
|
|
|
1716 (c-forward-statement)
|
|
|
1717 (c-forward-for/while/switch))
|
|
|
1718
|
|
|
1719 (defun c-forward-switch ()
|
|
|
1720 (forward-word 1) ; switch
|
|
|
1721 (forward-list 2)
|
|
|
1722 (point))
|
|
|
1723
|
|
|
1724 (defun c-forward-break/continue ()
|
|
|
1725 (forward-word 1) ; keyword
|
|
|
1726 (c-skip-over-comment)
|
|
|
1727 (skip-chars-forward "\n\t ")
|
|
|
1728 (if (= (following-char) ?\;)
|
|
|
1729 (goto-char (1+ (point)))))
|
|
|
1730
|
|
|
1731 ;; Tcl syntax scanner
|
|
|
1732 (defvar tcl-builtin-commands nil
|
|
|
1733 "Alist of information about tcl syntax for the tcl-boundaries function.
|
|
|
1734 An entry has the form
|
|
|
1735 \(<command-string> . <syntax description>\)
|
|
|
1736 where
|
|
|
1737 <command-string> is the name of a tcl command
|
|
|
1738 <syntax description> is one of
|
|
|
1739 list of integers: the number of possible arguments
|
|
|
1740 t: any number of arguments")
|
|
|
1741
|
|
|
1742 (defconst tcl-commands
|
|
|
1743 '(
|
|
|
1744 ("append" . (2 . nil))
|
|
|
1745 ("array" . (2 . 3))
|
|
|
1746 ("break" . 0)
|
|
|
1747 ("case" . 3)
|
|
|
1748 ("catch" . 1)
|
|
|
1749 ("cd" . 1)
|
|
|
1750 ("close" . 1)
|
|
|
1751 ("concat" . t)
|
|
|
1752 ("continue" . 0)
|
|
|
1753 ("else" . (1 . nil))
|
|
|
1754 ("elseif" . (1 . nil))
|
|
|
1755 ("eof" . 1)
|
|
|
1756 ("error" . t)
|
|
|
1757 ("eval" . t)
|
|
|
1758 ("exec" . t)
|
|
|
1759 ("exit" . (0 . 1))
|
|
|
1760 ("expr" . 1)
|
|
|
1761 ("file" . (2 . nil))
|
|
|
1762 ("flush" . 1)
|
|
|
1763 ("for" . 4)
|
|
|
1764 ("foreach" . 3)
|
|
|
1765 ("format" . (1 . nil))
|
|
|
1766 ("gets" . (1 . 2))
|
|
|
1767 ("glob" . t)
|
|
|
1768 ("global" . (1 . nil))
|
|
|
1769 ("history" . t)
|
|
|
1770 ("if" . (2 . nil))
|
|
|
1771 ("incr" . (1 . 2))
|
|
|
1772 ("info" . (1 . 4))
|
|
|
1773 ("join" . (1 . 2))
|
|
|
1774 ("lappend" . (2 . nil))
|
|
|
1775 ("lindex" . 2)
|
|
|
1776 ("linsert" . (3 . nil))
|
|
|
1777 ("list" . t)
|
|
|
1778 ("llength" . 1)
|
|
|
1779 ("lrange" . 3)
|
|
|
1780 ("lreplace" . (3 . nil))
|
|
|
1781 ("lsearch" . 2)
|
|
|
1782 ("lsort" . 1)
|
|
|
1783 ("open" . (1 . 2))
|
|
|
1784 ("proc" . 3)
|
|
|
1785 ("puts" . (1 . 3))
|
|
|
1786 ("pwd" . 0)
|
|
|
1787 ("read" . (1 . 2))
|
|
|
1788 ("regexp" . (2 . nil))
|
|
|
1789 ("regsub" . (4 . 6))
|
|
|
1790 ("rename" . 2)
|
|
|
1791 ("return" . (0 .1))
|
|
|
1792 ("scan" . (3 . nil))
|
|
|
1793 ("seek" . (2 . 3))
|
|
|
1794 ("set" . (1 . 2))
|
|
|
1795 ("source" . 1)
|
|
|
1796 ("split" . (1 . 2))
|
|
|
1797 ("string" . (2 . 4))
|
|
|
1798 ("tell" . 1)
|
|
|
1799 ("time" . (1 .2))
|
|
|
1800 ("trace" . (1 . nil))
|
|
|
1801 ("unknown" . (1 . nil))
|
|
|
1802 ("unset" . (1 . nil))
|
|
|
1803 ("uplevel" . (1 . nil))
|
|
|
1804 ("upvar" . (2 . nil))
|
|
|
1805 ("while" . 2)
|
|
|
1806 ))
|
|
|
1807
|
|
|
1808 (defconst tk-commands
|
|
|
1809 '(("bind" . 3)
|
|
|
1810 ("button" . t)
|
|
|
1811 ("canvas" . t)
|
|
|
1812 ("frame" . t)
|
|
|
1813 ("label" . t)
|
|
|
1814 ("listbox" . t)
|
|
|
1815 ("menu" . t)
|
|
|
1816 ("menubutton" . t)
|
|
|
1817 ("pack" . t)
|
|
|
1818 ("scrollbar" . t)
|
|
|
1819 ("tree" . t)
|
|
|
1820 ("wm" . t)
|
|
|
1821 ))
|
|
|
1822
|
|
|
1823 (defconst tcl-tk-commands
|
|
|
1824 (nconc tcl-commands tk-commands))
|
|
|
1825
|
|
|
1826 (defconst tcl-tk-commands-regexp
|
|
|
1827 (format "\\(%s\\\)\\W" (mapconcat 'car tcl-tk-commands "\\|")))
|
|
|
1828
|
|
|
1829 (defun tcl-boundaries (here)
|
|
|
1830 (save-excursion
|
|
|
1831 (goto-char here)
|
|
|
1832 (skip-chars-backward "a-z")
|
|
|
1833 (if (looking-at
|
|
|
1834 tcl-tk-commands-regexp)
|
|
|
1835 (let* ((count 0)
|
|
|
1836 (start (point))
|
|
|
1837 (keyword (buffer-substring
|
|
|
1838 (match-beginning 1)
|
|
|
1839 (match-end 1)))
|
|
|
1840 (syntax-description
|
|
|
1841 (cdr (assoc keyword tcl-tk-commands))))
|
|
|
1842 (goto-char (match-end 0))
|
|
|
1843 (while (not (looking-at "[ \t]*[]\n;}]"))
|
|
|
1844 (setq count (1+ count))
|
|
|
1845 (tcl-forward-sexp1)
|
|
|
1846 ;; skipping over the parentheses of array expressions:
|
|
|
1847 (while (not (or (looking-at "[ \t]*[]\n;}]")
|
|
|
1848 (= (char-syntax (following-char)) ? )))
|
|
|
1849 (tcl-forward-sexp1)))
|
|
|
1850
|
|
|
1851 (if (cond ((eq syntax-description t))
|
|
|
1852 ((integerp syntax-description)
|
|
|
1853 (= syntax-description count))
|
|
|
1854 ((consp syntax-description)
|
|
|
1855 (and (<= (car syntax-description) count)
|
|
|
1856 (or (null (cdr syntax-description))
|
|
|
1857 (<= count (cdr syntax-description))))))
|
|
|
1858 (progn
|
|
|
1859 (message "`%s' matched." keyword)
|
|
|
1860 (thing-region start (point)))
|
|
|
1861 (progn
|
|
|
1862 (message "wrong syntax: `%s'." keyword)
|
|
|
1863 nil)))
|
|
|
1864 (message "")
|
|
|
1865 (thing-boundaries here))))
|
|
|
1866
|
|
|
1867 (defun tcl-forward-sexp (&optional arg)
|
|
|
1868 "Move forward across one balanced tcl expression.
|
|
|
1869 With argument, do it that many times."
|
|
|
1870 (interactive "p")
|
|
|
1871 (if (< arg 0) (error "negative argument not allowed"))
|
|
|
1872 (or arg (setq arg 1))
|
|
|
1873 (while (> arg 0)
|
|
|
1874 (tcl-forward-sexp1)
|
|
|
1875 (setq arg (1- arg))))
|
|
|
1876
|
|
|
1877 (defun tcl-forward-sexp1 ()
|
|
|
1878 (interactive "")
|
|
|
1879 (let ((start (point))
|
|
|
1880 next-char syntax (first-scan t))
|
|
|
1881 (setq next-char (following-char)
|
|
|
1882 syntax (char-syntax next-char))
|
|
|
1883
|
|
|
1884 (while (or (= next-char ?\;)
|
|
|
1885 (memq syntax '(? ?>)))
|
|
|
1886 (forward-char 1)
|
|
|
1887 (setq next-char (following-char)
|
|
|
1888 syntax (char-syntax next-char)))
|
|
|
1889
|
|
|
1890 (condition-case var
|
|
|
1891 (catch 'exit
|
|
|
1892 (while t
|
|
|
1893 (setq next-char (following-char)
|
|
|
1894 syntax (char-syntax next-char))
|
|
|
1895 (cond ((= next-char ?\;)
|
|
|
1896 (throw 'exit nil))
|
|
|
1897 ((memq syntax (if first-scan '(? ?>) '(? ?> ?\))))
|
|
|
1898 (throw 'exit nil))
|
|
|
1899 (t
|
|
|
1900 (goto-char (or (scan-sexps (point) 1)
|
|
|
1901 (point-max)))))
|
|
|
1902 (setq first-scan nil)))
|
|
|
1903 (error (goto-char start)
|
|
|
1904 (error (car (cdr var)))))))
|
|
|
1905
|
|
|
1906 ;; (define-key tcl-mode-map "\M-\C-f" 'tcl-forward-sexp)
|
|
|
1907
|
|
|
1908 (defun mode-motion-eval-func (eval-func)
|
|
|
1909 (let ((old-buf (current-buffer))
|
|
|
1910 (old-window (selected-window)))
|
|
|
1911 (unwind-protect
|
|
|
1912 (let ((extent (or primary-selection-extent
|
|
|
1913 (and (extentp mode-motion-last-extent)
|
|
|
1914 (not (extent-property mode-motion-last-extent
|
|
|
1915 'detached))
|
|
|
1916 mode-motion-last-extent))))
|
|
|
1917
|
|
|
1918 (if (and (extentp extent)
|
|
|
1919 (set-buffer (extent-buffer extent))
|
|
|
1920 (not
|
|
|
1921 ;; zero length extents
|
|
|
1922 (= (extent-start-position extent)
|
|
|
1923 (extent-end-position extent))))
|
|
|
1924
|
|
|
1925 (let* ((start (extent-start-position extent))
|
|
|
1926 (end (extent-end-position extent)))
|
|
|
1927
|
|
|
1928 (funcall eval-func start end))
|
|
|
1929
|
|
|
1930 (error "No current primary or motion selection.")
|
|
|
1931 ))
|
|
|
1932 (set-buffer old-buf)
|
|
|
1933 (select-window old-window))))
|
|
|
1934
|
|
|
1935 (defun mode-motion-eval-region ()
|
|
|
1936 (interactive)
|
|
|
1937 (mode-motion-eval-func 'eval-region))
|
|
|
1938
|
|
|
1939
|
|
|
1940 ;; Motion highlight faces and initialization.
|
|
|
1941
|
|
|
1942 (defun sect-handler (string)
|
|
|
1943 "Return the symbol corresponding to the foo-STRING handler for this sect."
|
|
|
1944 (intern-soft (concat (symbol-name mode-motion+-religion) string)))
|
|
|
1945
|
|
|
1946 (defun mode-motion-init-handlers-according-to-religion (&optional forcep)
|
|
|
1947 (interactive)
|
|
|
1948 ;; Initialise default motion handlers depending on religious sect!
|
|
|
1949 (let ((foo-thing (sect-handler "-thing"))
|
|
|
1950 (foo-c (sect-handler "-c"))
|
|
|
1951 (foo-LaTeX (sect-handler "-laTeX"))
|
|
|
1952 (foo-line@ (sect-handler "-line@"))
|
|
|
1953 (foo-vline@ (sect-handler "-vline@")))
|
|
|
1954 (if forcep
|
|
|
1955 (progn
|
|
|
1956 (setq default-motion-handler (find-motion-handler foo-thing))
|
|
|
1957 (set-mode-motion-handler 'emacs-lisp-mode foo-thing)
|
|
|
1958 (set-mode-motion-handler 'lisp-interaction-mode foo-thing)
|
|
|
1959 (set-mode-motion-handler 'c-mode foo-c)
|
|
|
1960 (set-mode-motion-handler 'c++-mode foo-c)
|
|
|
1961 (set-mode-motion-handler 'c++-c-mode foo-c)
|
|
|
1962 (set-mode-motion-handler 'tex-mode foo-LaTeX)
|
|
|
1963 (set-mode-motion-handler 'latex-mode foo-LaTeX)
|
|
|
1964 (set-mode-motion-handler 'Buffer-menu-mode foo-vline@)
|
|
|
1965 (set-mode-motion-handler 'Electric-Buffer-menu-mode foo-vline@)
|
|
|
1966 (set-mode-motion-handler 'gnus-Group-mode foo-vline@)
|
|
|
1967 (set-mode-motion-handler 'gnus-Subject-mode foo-vline@)
|
|
|
1968 (set-mode-motion-handler 'gnus-group-mode foo-vline@)
|
|
|
1969 (set-mode-motion-handler 'gnus-subject-mode foo-vline@)
|
|
|
1970 (set-mode-motion-handler 'gnus-summary-mode foo-vline@)
|
|
|
1971 (set-mode-motion-handler 'dired-mode foo-line@)
|
|
|
1972 (set-mode-motion-handler 'compilation-mode foo-line@)
|
|
|
1973 (set-mode-motion-handler 'occur-mode foo-line@)
|
|
|
1974 (set-mode-motion-handler 'tar-mode foo-vline@)
|
|
|
1975 (set-mode-motion-handler 'rmail-summary-mode foo-vline@)
|
|
|
1976 (set-mode-motion-handler 'vm-summary-mode (sect-handler "-line"))
|
|
|
1977 (set-mode-motion-handler 'tcl-mode (sect-handler "-tcl"))
|
|
|
1978 (set-mode-motion-handler 'texinfo-mode (sect-handler "-TeXinfo"))
|
|
|
1979 (set-mode-motion-handler 'cvs-mode (sect-handler "-cvs-line")))
|
|
|
1980 (setq default-motion-handler
|
|
|
1981 (or default-motion-handler (find-motion-handler foo-thing)))
|
|
|
1982 (or (get 'emacs-lisp-mode 'mode-motion-handler)
|
|
|
1983 (set-mode-motion-handler 'emacs-lisp-mode foo-thing))
|
|
|
1984 (or (get 'lisp-interaction-mode 'mode-motion-handler)
|
|
|
1985 (set-mode-motion-handler 'lisp-interaction-mode foo-thing))
|
|
|
1986 (or (get 'c-mode 'mode-motion-handler)
|
|
|
1987 (set-mode-motion-handler 'c-mode foo-c))
|
|
|
1988 (or (get 'c++-mode 'mode-motion-handler)
|
|
|
1989 (set-mode-motion-handler 'c++-mode foo-c))
|
|
|
1990 (or (get 'c++-c-mode 'mode-motion-handler)
|
|
|
1991 (set-mode-motion-handler 'c++-c-mode foo-c))
|
|
|
1992 (or (get 'tex-mode 'mode-motion-handler)
|
|
|
1993 (set-mode-motion-handler 'tex-mode foo-LaTeX))
|
|
|
1994 (or (get 'latex-mode 'mode-motion-handler)
|
|
|
1995 (set-mode-motion-handler 'latex-mode foo-LaTeX))
|
|
|
1996 (or (get 'Buffer-menu-mode 'mode-motion-handler)
|
|
|
1997 (set-mode-motion-handler 'Buffer-menu-mode foo-vline@))
|
|
|
1998 (or (get 'Electric-Buffer-menu-mode 'mode-motion-handler)
|
|
|
1999 (set-mode-motion-handler 'Electric-Buffer-menu-mode foo-vline@))
|
|
|
2000 (or (get 'gnus-Group-mode 'mode-motion-handler)
|
|
|
2001 (set-mode-motion-handler 'gnus-Group-mode foo-vline@))
|
|
|
2002 (or (get 'gnus-Subject-mode 'mode-motion-handler)
|
|
|
2003 (set-mode-motion-handler 'gnus-Subject-mode foo-vline@))
|
|
|
2004 (or (get 'gnus-group-mode 'mode-motion-handler)
|
|
|
2005 (set-mode-motion-handler 'gnus-group-mode foo-vline@))
|
|
|
2006 (or (get 'gnus-subject-mode 'mode-motion-handler)
|
|
|
2007 (set-mode-motion-handler 'gnus-subject-mode foo-vline@))
|
|
|
2008 (or (get 'gnus-summary-mode 'mode-motion-handler)
|
|
|
2009 (set-mode-motion-handler 'gnus-summary-mode foo-vline@))
|
|
|
2010 (or (get 'dired-mode 'mode-motion-handler)
|
|
|
2011 (set-mode-motion-handler 'dired-mode foo-line@))
|
|
|
2012 (or (get 'compilation-mode 'mode-motion-handler)
|
|
|
2013 (set-mode-motion-handler 'compilation-mode foo-line@))
|
|
|
2014 (or (get 'occur-mode 'mode-motion-handler)
|
|
|
2015 (set-mode-motion-handler 'occur-mode foo-line@))
|
|
|
2016 (or (get 'tar-mode 'mode-motion-handler)
|
|
|
2017 (set-mode-motion-handler 'tar-mode foo-vline@))
|
|
|
2018 (or (get 'rmail-summary-mode 'mode-motion-handler)
|
|
|
2019 (set-mode-motion-handler 'rmail-summary-mode foo-vline@))
|
|
|
2020 (or (get 'vm-summary-mode 'mode-motion-handler)
|
|
|
2021 (set-mode-motion-handler 'vm-summary-mode (sect-handler "-line")))
|
|
|
2022 (or (get 'tcl-mode 'mode-motion-handler)
|
|
|
2023 (set-mode-motion-handler 'tcl-mode (sect-handler "-tcl")))
|
|
|
2024 (or (get 'texinfo-mode 'mode-motion-handler)
|
|
|
2025 (set-mode-motion-handler 'texinfo-mode (sect-handler "-TeXinfo")))
|
|
|
2026 (or (get 'cvs-mode 'mode-motion-handler)
|
|
|
2027 (set-mode-motion-handler 'cvs-mode (sect-handler "-cvs-line"))))))
|
|
|
2028
|
|
|
2029 ;; Null Handlers (for disabling motion highlighting)
|
|
|
2030 (defun thing-null (here) nil)
|
|
|
2031 (make-motion-handler 'no-thing 'thing-null)
|
|
|
2032 (make-motion-handler 'no-c 'thing-null)
|
|
|
2033 (make-motion-handler 'no-laTeX 'thing-null)
|
|
|
2034 (make-motion-handler 'no-line 'thing-null)
|
|
|
2035 (make-motion-handler 'no-line@ 'thing-null)
|
|
|
2036 (make-motion-handler 'no-vline 'thing-null)
|
|
|
2037 (make-motion-handler 'no-vline@ 'thing-null)
|
|
|
2038 (make-motion-handler 'no-tcl 'thing-null)
|
|
|
2039 (make-motion-handler 'no-TeXinfo 'thing-null)
|
|
|
2040 (make-motion-handler 'no-cvs-line 'thing-null)
|
|
|
2041
|
|
|
2042 (defun mode-motion-init ()
|
|
|
2043 "enable mode-motion+ package"
|
|
|
2044 (interactive)
|
|
|
2045
|
|
|
2046 (setq mode-motion-last-extent nil)
|
|
|
2047
|
|
|
2048 (global-set-key '(meta button2) 'mode-motion-copy)
|
|
|
2049 (global-set-key '(meta shift button2) 'mode-motion-move)
|
|
|
2050 (global-set-key '(meta control button2) 'mode-motion-kill)
|
|
|
2051 (global-set-key '(meta control shift button2) 'mode-motion-copy-as-kill)
|
|
|
2052 (global-set-key '(meta control symbol button2) 'mode-motion-copy-as-kill)
|
|
|
2053
|
|
|
2054 (if mode-motion-setup-cut-and-paste-bindings
|
|
|
2055 (progn
|
|
|
2056 (global-set-key 'f16 'mode-motion-copy-as-kill) ; Copy
|
|
|
2057 (global-set-key 'f18 'yank) ; Paste
|
|
|
2058 (global-set-key 'f20 'mode-motion-kill))) ; Cut
|
|
|
2059
|
|
|
2060 ;; I don't want the thing-boundaries function select whitespaces
|
|
|
2061 (setq thing-report-whitespace nil thing-report-char-p nil)
|
|
|
2062
|
|
|
2063 ;; bold motion face (bold, if this is not the default, unbold otherwise)
|
|
|
2064 (if (find-face 'motion-bold)
|
|
|
2065 ()
|
|
|
2066 (make-face 'motion-bold)
|
|
|
2067 (make-face-bold 'motion-bold)
|
|
|
2068 (or (face-differs-from-default-p 'motion-bold)
|
|
|
2069 (make-face-unbold 'motion-bold)))
|
|
|
2070
|
|
|
2071 ;; an underline face
|
|
|
2072 (if (find-face 'motion-underline)
|
|
|
2073 ()
|
|
|
2074 (make-face 'motion-underline)
|
|
|
2075 (set-face-underline-p 'motion-underline t))
|
|
|
2076
|
|
|
2077 ;; an inverted face
|
|
|
2078 (if (find-face 'motion-inverted)
|
|
|
2079 ()
|
|
|
2080 (make-face 'motion-inverted)
|
|
|
2081 (make-face-bold 'motion-inverted)
|
|
|
2082 (invert-face 'motion-inverted))
|
|
|
2083
|
|
|
2084 (if (find-face 'motion-gray)
|
|
|
2085 ()
|
|
|
2086 (make-face 'motion-gray)
|
|
|
2087 (set-face-background-pixmap 'motion-gray "gray1.xbm"))
|
|
|
2088
|
|
|
2089 ;; Motion Handlers
|
|
|
2090
|
|
|
2091 ;; Special Minibuffer handler
|
|
|
2092
|
|
|
2093 (make-motion-handler 'minibuffer 'minibuffer-selection-boundaries 'highlight t nil)
|
|
|
2094
|
|
|
2095 ;; Things
|
|
|
2096 (make-motion-handler 'bold-thing 'thing-boundaries 'motion-bold)
|
|
|
2097 (make-motion-handler 'gray-thing 'thing-boundaries 'motion-gray)
|
|
|
2098 (make-motion-handler 'highlight-thing 'thing-boundaries 'highlight)
|
|
|
2099 (make-motion-handler 'invert-thing 'thing-boundaries 'motion-inverted)
|
|
|
2100 (make-motion-handler 'underline-thing 'thing-boundaries 'motion-underline)
|
|
|
2101
|
|
|
2102 ;; Lines
|
|
|
2103 (make-motion-handler 'bold-line 'line-boundaries 'motion-bold)
|
|
|
2104 (make-motion-handler 'gray-line 'line-boundaries 'motion-gray)
|
|
|
2105 (make-motion-handler 'highlight-line 'line-boundaries 'highlight)
|
|
|
2106 (make-motion-handler 'invert-line 'line-boundaries 'motion-inverted)
|
|
|
2107 (make-motion-handler 'underline-line 'line-boundaries 'motion-underline)
|
|
|
2108 (make-motion-handler 'bold-line@ 'line-boundaries 'motion-bold t t)
|
|
|
2109 (make-motion-handler 'gray-line@ 'line-boundaries 'motion-gray nil t)
|
|
|
2110 (make-motion-handler 'highlight-line@ 'line-boundaries 'highlight nil t)
|
|
|
2111 (make-motion-handler 'invert-line@ 'line-boundaries 'motion-inverted nil t)
|
|
|
2112 (make-motion-handler 'underline-line@ 'line-boundaries 'motion-underline nil t)
|
|
|
2113
|
|
|
2114 ;; Visible text of line
|
|
|
2115 (make-motion-handler 'bold-vline 'visible-line-boundaries 'motion-bold)
|
|
|
2116 (make-motion-handler 'gray-vline 'visible-line-boundaries 'motion-gray)
|
|
|
2117 (make-motion-handler 'highlight-vline 'visible-line-boundaries 'highlight)
|
|
|
2118 (make-motion-handler 'invert-vline 'visible-line-boundaries 'motion-inverted)
|
|
|
2119 (make-motion-handler 'underline-vline 'visible-line-boundaries 'motion-underline)
|
|
|
2120 (make-motion-handler 'bold-vline@ 'visible-line-boundaries 'motion-bold t t)
|
|
|
2121 (make-motion-handler 'gray-vline@ 'visible-line-boundaries 'motion-gray nil t)
|
|
|
2122 (make-motion-handler 'highlight-vline@ 'visible-line-boundaries 'highlight nil t)
|
|
|
2123 (make-motion-handler 'invert-vline@ 'visible-line-boundaries 'motion-inverted nil t)
|
|
|
2124 (make-motion-handler 'underline-vline@ 'visible-line-boundaries 'motion-underline nil t)
|
|
|
2125
|
|
|
2126 ;; CVS lines
|
|
|
2127 (make-motion-handler 'bold-cvs-line 'cvs-line-boundaries 'motion-bold)
|
|
|
2128 (make-motion-handler 'gray-cvs-line 'cvs-line-boundaries 'motion-gray)
|
|
|
2129 (make-motion-handler 'highlight-cvs-line 'cvs-line-boundaries 'highlight)
|
|
|
2130 (make-motion-handler 'invert-cvs-line 'cvs-line-boundaries 'motion-inverted)
|
|
|
2131 (make-motion-handler
|
|
|
2132 'underline-cvs-line 'cvs-line-boundaries 'motion-underline)
|
|
|
2133
|
|
|
2134 ;; (La)TeX
|
|
|
2135 (make-motion-handler 'bold-LaTeX 'latex-boundaries 'motion-bold)
|
|
|
2136 (make-motion-handler 'gray-LaTeX 'latex-boundaries 'motion-gray)
|
|
|
2137 (make-motion-handler 'highlight-LaTeX 'latex-boundaries 'highlight)
|
|
|
2138 (make-motion-handler 'invert-LaTeX 'latex-boundaries 'motion-inverted)
|
|
|
2139 (make-motion-handler 'underline-LaTeX 'latex-boundaries 'motion-underline)
|
|
|
2140
|
|
|
2141 ;; TeXinfo
|
|
|
2142 (make-motion-handler 'bold-TeXinfo 'texinfo-boundaries 'motion-bold)
|
|
|
2143 (make-motion-handler 'gray-TeXinfo 'texinfo-boundaries 'motion-gray)
|
|
|
2144 (make-motion-handler 'highlight-TeXinfo 'texinfo-boundaries 'highlight)
|
|
|
2145 (make-motion-handler 'invert-TeXinfo 'texinfo-boundaries 'motion-inverted)
|
|
|
2146 (make-motion-handler 'underline-TeXinfo 'texinfo-boundaries 'motion-underline)
|
|
|
2147
|
|
|
2148 ;; C and C++
|
|
|
2149 (make-motion-handler 'bold-c 'c-boundaries 'motion-bold)
|
|
|
2150 (make-motion-handler 'gray-c 'c-boundaries 'motion-gray)
|
|
|
2151 (make-motion-handler 'highlight-c 'c-boundaries 'highlight)
|
|
|
2152 (make-motion-handler 'invert-c 'c-boundaries 'motion-inverted)
|
|
|
2153 (make-motion-handler 'underline-c 'c-boundaries 'motion-underline)
|
|
|
2154
|
|
|
2155 ;; Tcl/Tk
|
|
|
2156 (make-motion-handler 'bold-tcl 'tcl-boundaries 'motion-bold)
|
|
|
2157 (make-motion-handler 'gray-tcl 'tcl-boundaries 'motion-gray)
|
|
|
2158 (make-motion-handler 'highlight-tcl 'tcl-boundaries 'highlight)
|
|
|
2159 (make-motion-handler 'invert-tcl 'tcl-boundaries 'motion-inverted)
|
|
|
2160 (make-motion-handler 'underline-tcl 'tcl-boundaries 'motion-underline)
|
|
|
2161
|
|
|
2162 ;; mouse tracker
|
|
|
2163 (make-motion-handler 'track-mouse@ 'char-boundaries nil nil t)
|
|
|
2164 (make-motion-handler 'highlight-char 'char-boundaries 'highlight)
|
|
|
2165
|
|
|
2166 ;; augment the basic mouse motion handler (if any)
|
|
|
2167 (setq-default mode-motion-hook
|
|
|
2168 (if (listp mode-motion-hook)
|
|
|
2169 (if (memq #'mode-motion+-highlight mode-motion-hook)
|
|
|
2170 mode-motion-hook
|
|
|
2171 (append mode-motion-hook (list #'mode-motion+-highlight)))
|
|
|
2172 (list mode-motion-hook #'mode-motion+-highlight)))
|
|
|
2173
|
|
|
2174 (or mode-motion+-religion
|
|
|
2175 (setq mode-motion+-religion (if (x-display-color-p) 'underline 'invert)))
|
|
|
2176
|
|
|
2177 (add-menu '("Options") (car mode-motion+-options-menu)
|
|
|
2178 (cdr mode-motion+-options-menu)
|
|
|
2179 "Paren Highlighting")
|
|
|
2180
|
|
|
2181 ;; shut your eyes, this is a kludge. I didn't have time to find/write
|
|
|
2182 ;; a function to do this.
|
|
|
2183 (or (member ["Eval Motion Region" mode-motion-eval-region t]
|
|
|
2184 lisp-interaction-mode-popup-menu)
|
|
|
2185 (and (setq lisp-interaction-mode-popup-menu
|
|
|
2186 (copy-sequence lisp-interaction-mode-popup-menu))
|
|
|
2187 (setcdr (nthcdr 1 lisp-interaction-mode-popup-menu)
|
|
|
2188 (cons ["Eval Motion Region" mode-motion-eval-region t]
|
|
|
2189 (nthcdr 2 lisp-interaction-mode-popup-menu)))))
|
|
|
2190
|
|
|
2191 (or (member ["Eval Motion Region" mode-motion-eval-region t]
|
|
|
2192 emacs-lisp-mode-popup-menu)
|
|
|
2193 (and (setq emacs-lisp-mode-popup-menu
|
|
|
2194 (copy-sequence emacs-lisp-mode-popup-menu))
|
|
|
2195 (setcdr (nthcdr 3 emacs-lisp-mode-popup-menu)
|
|
|
2196 (cons ["Eval Motion Region" mode-motion-eval-region t]
|
|
|
2197 (nthcdr 4 emacs-lisp-mode-popup-menu)))))
|
|
|
2198
|
|
|
2199 ;; Clear the last active motion extent when leaving a frame.
|
|
|
2200 (if (boundp 'mouse-leave-frame-hook)
|
|
|
2201 (add-hook 'mouse-leave-frame-hook 'mode-motion-clear-last-extent)
|
|
|
2202 (add-hook 'mouse-leave-screen-hook 'mode-motion-clear-last-extent))
|
|
|
2203
|
|
|
2204 (run-hooks 'mode-motion+-load-hook)
|
|
|
2205 (mode-motion-init-handlers-according-to-religion)
|
|
|
2206
|
|
|
2207 (if (interactive-p) (message "mode-motion+ enabled")))
|
|
|
2208
|
|
|
2209 (if (and (not purify-flag)
|
|
|
2210 (or (not (boundp 'opt-mode-motion+)) opt-mode-motion+))
|
|
|
2211 (mode-motion-init))
|
|
|
2212
|
|
|
2213 (provide 'mode-motion+)
|
|
|
2214 ;; end mode-motion+
|
