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