Mercurial > emacs
annotate lisp/progmodes/cc-subword.el @ 78258:6aba169c4b1f
Switch license to GPLv3 or later.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Wed, 25 Jul 2007 05:07:12 +0000 |
parents | c1ec1c8a8d2e |
children | a1342e6e097a 5405672da978 |
rev | line source |
---|---|
67252 | 1 ;;; cc-subword.el --- Handling capitalized subwords in a nomenclature |
2 | |
75347 | 3 ;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc. |
67252 | 4 |
5 ;; Author: Masatake YAMATO | |
6 | |
7 ;; This program is free software; you can redistribute it and/or modify | |
8 ;; it under the terms of the GNU General Public License as published by | |
78234
c1ec1c8a8d2e
Switch license to GPLv3 or later.
Glenn Morris <rgm@gnu.org>
parents:
77083
diff
changeset
|
9 ;; the Free Software Foundation; either version 3, or (at your option) |
67252 | 10 ;; any later version. |
11 | |
12 ;; This program is distributed in the hope that it will be useful, | |
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 ;; GNU General Public License for more details. | |
16 | |
17 ;; You should have received a copy of the GNU General Public License | |
18 ;; along with this program; see the file COPYING. If not, write to | |
19 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
20 ;; Boston, MA 02110-1301, USA. | |
21 | |
22 ;;; Commentary: | |
23 | |
24 ;; This package provides `subword' oriented commands and a minor mode | |
25 ;; (`c-subword-mode') that substitutes the common word handling | |
26 ;; functions with them. | |
27 | |
28 ;; In spite of GNU Coding Standards, it is popular to name a symbol by | |
29 ;; mixing uppercase and lowercase letters, e.g. "GtkWidget", | |
30 ;; "EmacsFrameClass", "NSGraphicsContext", etc. Here we call these | |
31 ;; mixed case symbols `nomenclatures'. Also, each capitalized (or | |
32 ;; completely uppercase) part of a nomenclature is called a `subword'. | |
33 ;; Here are some examples: | |
34 | |
35 ;; Nomenclature Subwords | |
36 ;; =========================================================== | |
37 ;; GtkWindow => "Gtk" and "Window" | |
38 ;; EmacsFrameClass => "Emacs", "Frame" and "Class" | |
39 ;; NSGraphicsContext => "NS", "Graphics" and "Context" | |
40 | |
41 ;; The subword oriented commands defined in this package recognize | |
42 ;; subwords in a nomenclature to move between them and to edit them as | |
43 ;; words. | |
44 | |
45 ;; In the minor mode, all common key bindings for word oriented | |
46 ;; commands are overridden by the subword oriented commands: | |
47 | |
48 ;; Key Word oriented command Subword oriented command | |
49 ;; ============================================================ | |
50 ;; M-f `forward-word' `c-forward-subword' | |
51 ;; M-b `backward-word' `c-backward-subword' | |
52 ;; M-@ `mark-word' `c-mark-subword' | |
53 ;; M-d `kill-word' `c-kill-subword' | |
54 ;; M-DEL `backward-kill-word' `c-backward-kill-subword' | |
55 ;; M-t `transpose-words' `c-transpose-subwords' | |
56 ;; M-c `capitalize-word' `c-capitalize-subword' | |
57 ;; M-u `upcase-word' `c-upcase-subword' | |
58 ;; M-l `downcase-word' `c-downcase-subword' | |
59 ;; | |
60 ;; Note: If you have changed the key bindings for the word oriented | |
61 ;; commands in your .emacs or a similar place, the keys you've changed | |
62 ;; to are also used for the corresponding subword oriented commands. | |
63 | |
64 ;; To make the mode turn on automatically, put the following code in | |
65 ;; your .emacs: | |
66 ;; | |
67 ;; (add-hook 'c-mode-common-hook | |
68 ;; (lambda () (c-subword-mode 1))) | |
69 ;; | |
70 | |
71 ;; Acknowledgment: | |
72 ;; The regular expressions to detect subwords are mostly based on | |
73 ;; the old `c-forward-into-nomenclature' originally contributed by | |
74 ;; Terry_Glanfield dot Southern at rxuk dot xerox dot com. | |
75 | |
76 ;; TODO: ispell-word and subword oriented C-w in isearch. | |
77 | |
78 ;;; Code: | |
79 | |
80 (eval-when-compile | |
81 (let ((load-path | |
82 (if (and (boundp 'byte-compile-dest-file) | |
83 (stringp byte-compile-dest-file)) | |
84 (cons (file-name-directory byte-compile-dest-file) load-path) | |
85 load-path))) | |
86 (load "cc-bytecomp" nil t))) | |
87 | |
88 (cc-require 'cc-defs) | |
89 (cc-require 'cc-cmds) | |
90 | |
91 ;; Don't complain about the `define-minor-mode' form if it isn't defined. | |
92 (cc-bytecomp-defvar c-subword-mode) | |
93 | |
70239
ad23aa667a59
Fixup commenting convention.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70238
diff
changeset
|
94 ;; Autoload directives must be on the top level, so we construct an |
ad23aa667a59
Fixup commenting convention.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70238
diff
changeset
|
95 ;; autoload form instead. |
67252 | 96 ;;;###autoload (autoload 'c-subword-mode "cc-subword" "Mode enabling subword movement and editing keys." t) |
97 | |
98 (if (not (fboundp 'define-minor-mode)) | |
99 (defun c-subword-mode () | |
100 "(Missing) mode enabling subword movement and editing keys. | |
101 This mode is not (yet) available in this version of (X)Emacs. Sorry! If | |
102 you really want it, please send a request to <bug-gnu-emacs@gnu.org>, | |
103 telling us which (X)Emacs version you're using." | |
104 (interactive) | |
105 (error | |
106 "c-subword-mode is not (yet) available in this version of (X)Emacs. Sorry!")) | |
107 | |
108 (defvar c-subword-mode-map | |
109 (let ((map (make-sparse-keymap))) | |
70238
1be7d556ba69
(c-subword-mode-map): Use command remapping.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68773
diff
changeset
|
110 (dolist (cmd '(forward-word backward-word mark-word |
1be7d556ba69
(c-subword-mode-map): Use command remapping.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68773
diff
changeset
|
111 kill-word backward-kill-word |
1be7d556ba69
(c-subword-mode-map): Use command remapping.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68773
diff
changeset
|
112 transpose-words |
1be7d556ba69
(c-subword-mode-map): Use command remapping.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68773
diff
changeset
|
113 capitalize-word upcase-word downcase-word)) |
1be7d556ba69
(c-subword-mode-map): Use command remapping.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68773
diff
changeset
|
114 (let ((othercmd (let ((name (symbol-name cmd))) |
1be7d556ba69
(c-subword-mode-map): Use command remapping.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68773
diff
changeset
|
115 (string-match "\\(.*-\\)\\(word.*\\)" name) |
1be7d556ba69
(c-subword-mode-map): Use command remapping.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68773
diff
changeset
|
116 (intern (concat "c-" |
1be7d556ba69
(c-subword-mode-map): Use command remapping.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68773
diff
changeset
|
117 (match-string 1 name) |
1be7d556ba69
(c-subword-mode-map): Use command remapping.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68773
diff
changeset
|
118 "sub" |
1be7d556ba69
(c-subword-mode-map): Use command remapping.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68773
diff
changeset
|
119 (match-string 2 name)))))) |
1be7d556ba69
(c-subword-mode-map): Use command remapping.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68773
diff
changeset
|
120 (if (fboundp 'command-remapping) |
1be7d556ba69
(c-subword-mode-map): Use command remapping.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68773
diff
changeset
|
121 (define-key map (vector 'remap cmd) othercmd) |
1be7d556ba69
(c-subword-mode-map): Use command remapping.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68773
diff
changeset
|
122 (substitute-key-definition cmd othercmd map global-map)))) |
67252 | 123 map) |
124 "Keymap used in command `c-subword-mode' minor mode.") | |
125 | |
126 (define-minor-mode c-subword-mode | |
127 "Mode enabling subword movement and editing keys. | |
128 In spite of GNU Coding Standards, it is popular to name a symbol by | |
129 mixing uppercase and lowercase letters, e.g. \"GtkWidget\", | |
130 \"EmacsFrameClass\", \"NSGraphicsContext\", etc. Here we call these | |
131 mixed case symbols `nomenclatures'. Also, each capitalized (or | |
132 completely uppercase) part of a nomenclature is called a `subword'. | |
133 Here are some examples: | |
134 | |
135 Nomenclature Subwords | |
136 =========================================================== | |
137 GtkWindow => \"Gtk\" and \"Window\" | |
138 EmacsFrameClass => \"Emacs\", \"Frame\" and \"Class\" | |
139 NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\" | |
140 | |
141 The subword oriented commands activated in this minor mode recognize | |
142 subwords in a nomenclature to move between subwords and to edit them | |
143 as words. | |
144 | |
145 \\{c-subword-mode-map}" | |
146 nil | |
147 nil | |
148 c-subword-mode-map | |
149 (c-update-modeline)) | |
150 | |
151 ) | |
152 | |
153 (defun c-forward-subword (&optional arg) | |
154 "Do the same as `forward-word' but on subwords. | |
155 See the command `c-subword-mode' for a description of subwords. | |
156 Optional argument ARG is the same as for `forward-word'." | |
157 (interactive "p") | |
158 (unless arg (setq arg 1)) | |
159 (c-keep-region-active) | |
160 (cond | |
161 ((< 0 arg) | |
162 (dotimes (i arg (point)) | |
163 (c-forward-subword-internal))) | |
164 ((> 0 arg) | |
165 (dotimes (i (- arg) (point)) | |
166 (c-backward-subword-internal))) | |
167 (t | |
168 (point)))) | |
169 | |
70649
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
170 (put 'c-forward-subword 'CUA 'move) |
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
171 |
67252 | 172 (defun c-backward-subword (&optional arg) |
173 "Do the same as `backward-word' but on subwords. | |
174 See the command `c-subword-mode' for a description of subwords. | |
175 Optional argument ARG is the same as for `backward-word'." | |
176 (interactive "p") | |
177 (c-forward-subword (- (or arg 1)))) | |
178 | |
179 (defun c-mark-subword (arg) | |
180 "Do the same as `mark-word' but on subwords. | |
181 See the command `c-subword-mode' for a description of subwords. | |
182 Optional argument ARG is the same as for `mark-word'." | |
183 ;; This code is almost copied from `mark-word' in GNU Emacs. | |
184 (interactive "p") | |
185 (cond ((and (eq last-command this-command) (mark t)) | |
186 (set-mark | |
187 (save-excursion | |
188 (goto-char (mark)) | |
189 (c-forward-subword arg) | |
190 (point)))) | |
191 (t | |
192 (push-mark | |
193 (save-excursion | |
194 (c-forward-subword arg) | |
195 (point)) | |
196 nil t)))) | |
197 | |
70649
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
198 (put 'c-backward-subword 'CUA 'move) |
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
199 |
67252 | 200 (defun c-kill-subword (arg) |
201 "Do the same as `kill-word' but on subwords. | |
202 See the command `c-subword-mode' for a description of subwords. | |
203 Optional argument ARG is the same as for `kill-word'." | |
204 (interactive "p") | |
205 (kill-region (point) (c-forward-subword arg))) | |
206 | |
207 (defun c-backward-kill-subword (arg) | |
208 "Do the same as `backward-kill-word' but on subwords. | |
209 See the command `c-subword-mode' for a description of subwords. | |
210 Optional argument ARG is the same as for `backward-kill-word'." | |
211 (interactive "p") | |
212 (c-kill-subword (- arg))) | |
213 | |
214 (defun c-transpose-subwords (arg) | |
215 "Do the same as `transpose-words' but on subwords. | |
216 See the command `c-subword-mode' for a description of subwords. | |
217 Optional argument ARG is the same as for `transpose-words'." | |
218 (interactive "*p") | |
219 (transpose-subr 'c-forward-subword arg)) | |
220 | |
77082
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
221 |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
222 |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
223 (defun c-downcase-subword (arg) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
224 "Do the same as `downcase-word' but on subwords. |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
225 See the command `c-subword-mode' for a description of subwords. |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
226 Optional argument ARG is the same as for `downcase-word'." |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
227 (interactive "p") |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
228 (let ((start (point))) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
229 (downcase-region (point) (c-forward-subword arg)) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
230 (when (< arg 0) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
231 (goto-char start)))) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
232 |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
233 (defun c-upcase-subword (arg) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
234 "Do the same as `upcase-word' but on subwords. |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
235 See the command `c-subword-mode' for a description of subwords. |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
236 Optional argument ARG is the same as for `upcase-word'." |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
237 (interactive "p") |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
238 (let ((start (point))) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
239 (upcase-region (point) (c-forward-subword arg)) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
240 (when (< arg 0) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
241 (goto-char start)))) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
242 |
67252 | 243 (defun c-capitalize-subword (arg) |
244 "Do the same as `capitalize-word' but on subwords. | |
245 See the command `c-subword-mode' for a description of subwords. | |
246 Optional argument ARG is the same as for `capitalize-word'." | |
247 (interactive "p") | |
248 (let ((count (abs arg)) | |
77083
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
249 (start (point)) |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
250 (advance (if (< arg 0) nil t))) |
67252 | 251 (dotimes (i count) |
77083
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
252 (if advance |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
253 (progn (re-search-forward |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
254 (concat "[" c-alpha "]") |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
255 nil t) |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
256 (goto-char (match-beginning 0))) |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
257 (c-backward-subword)) |
67252 | 258 (let* ((p (point)) |
259 (pp (1+ p)) | |
77083
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
260 (np (c-forward-subword))) |
67252 | 261 (upcase-region p pp) |
262 (downcase-region pp np) | |
77083
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
263 (goto-char (if advance np p)))) |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
264 (unless advance |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
265 (goto-char start)))) |
67252 | 266 |
267 | |
268 | |
269 ;; | |
270 ;; Internal functions | |
271 ;; | |
272 (defun c-forward-subword-internal () | |
273 (if (and | |
70649
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
274 (save-excursion |
67252 | 275 (let ((case-fold-search nil)) |
70649
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
276 (re-search-forward |
67252 | 277 (concat "\\W*\\(\\([" c-upper "]*\\W?\\)[" c-lower c-digit "]*\\)") |
278 nil t))) | |
279 (> (match-end 0) (point))) ; So we don't get stuck at a | |
280 ; "word-constituent" which isn't c-upper, | |
281 ; c-lower or c-digit | |
70649
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
282 (goto-char |
67252 | 283 (cond |
284 ((< 1 (- (match-end 2) (match-beginning 2))) | |
285 (1- (match-end 2))) | |
286 (t | |
287 (match-end 0)))) | |
288 (forward-word 1))) | |
289 | |
290 | |
291 (defun c-backward-subword-internal () | |
70649
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
292 (if (save-excursion |
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
293 (let ((case-fold-search nil)) |
67252 | 294 (re-search-backward |
295 (concat | |
296 "\\(\\(\\W\\|[" c-lower c-digit "]\\)\\([" c-upper "]+\\W*\\)" | |
70649
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
297 "\\|\\W\\w+\\)") |
67252 | 298 nil t))) |
70649
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
299 (goto-char |
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
300 (cond |
67252 | 301 ((and (match-end 3) |
302 (< 1 (- (match-end 3) (match-beginning 3))) | |
303 (not (eq (point) (match-end 3)))) | |
304 (1- (match-end 3))) | |
305 (t | |
306 (1+ (match-beginning 0))))) | |
307 (backward-word 1))) | |
308 | |
309 | |
310 (cc-provide 'cc-subword) | |
311 | |
70238
1be7d556ba69
(c-subword-mode-map): Use command remapping.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68773
diff
changeset
|
312 ;; arch-tag: 2be9d294-7f30-4626-95e6-9964bb93c7a3 |
67252 | 313 ;;; cc-subword.el ends here |