Mercurial > emacs
annotate lisp/progmodes/cc-subword.el @ 96910:a7596a078e92
*** empty log message ***
author | Juri Linkov <juri@jurta.org> |
---|---|
date | Wed, 23 Jul 2008 01:19:26 +0000 |
parents | 52b7a8c22af5 |
children | a9dc0e7c3f2b |
rev | line source |
---|---|
67252 | 1 ;;; cc-subword.el --- Handling capitalized subwords in a nomenclature |
2 | |
79717 | 3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
67252 | 4 |
5 ;; Author: Masatake YAMATO | |
6 | |
94673
52b7a8c22af5
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
7 ;; This file is part of GNU Emacs. |
52b7a8c22af5
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
8 |
52b7a8c22af5
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
9 ;; GNU Emacs is free software: you can redistribute it and/or modify |
67252 | 10 ;; it under the terms of the GNU General Public License as published by |
94673
52b7a8c22af5
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
11 ;; the Free Software Foundation, either version 3 of the License, or |
52b7a8c22af5
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
12 ;; (at your option) any later version. |
67252 | 13 |
94673
52b7a8c22af5
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
14 ;; GNU Emacs is distributed in the hope that it will be useful, |
67252 | 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 | |
94673
52b7a8c22af5
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
67252 | 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 | |
87314
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
91 (defvar c-subword-mode-map |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
92 (let ((map (make-sparse-keymap))) |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
93 (dolist (cmd '(forward-word backward-word mark-word |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
94 kill-word backward-kill-word |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
95 transpose-words |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
96 capitalize-word upcase-word downcase-word)) |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
97 (let ((othercmd (let ((name (symbol-name cmd))) |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
98 (string-match "\\(.*-\\)\\(word.*\\)" name) |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
99 (intern (concat "c-" |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
100 (match-string 1 name) |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
101 "sub" |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
102 (match-string 2 name)))))) |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
103 (if (fboundp 'command-remapping) |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
104 (define-key map (vector 'remap cmd) othercmd) |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
105 (substitute-key-definition cmd othercmd map global-map)))) |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
106 map) |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
107 "Keymap used in command `c-subword-mode' minor mode.") |
67252 | 108 |
87314
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
109 ;;;###autoload |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
110 (define-minor-mode c-subword-mode |
238289d30e93
(c-subword-mode): Drop support for systems without define-minor-mode.
Glenn Morris <rgm@gnu.org>
parents:
87023
diff
changeset
|
111 "Mode enabling subword movement and editing keys. |
67252 | 112 In spite of GNU Coding Standards, it is popular to name a symbol by |
113 mixing uppercase and lowercase letters, e.g. \"GtkWidget\", | |
114 \"EmacsFrameClass\", \"NSGraphicsContext\", etc. Here we call these | |
115 mixed case symbols `nomenclatures'. Also, each capitalized (or | |
116 completely uppercase) part of a nomenclature is called a `subword'. | |
117 Here are some examples: | |
118 | |
119 Nomenclature Subwords | |
120 =========================================================== | |
121 GtkWindow => \"Gtk\" and \"Window\" | |
122 EmacsFrameClass => \"Emacs\", \"Frame\" and \"Class\" | |
123 NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\" | |
124 | |
125 The subword oriented commands activated in this minor mode recognize | |
126 subwords in a nomenclature to move between subwords and to edit them | |
127 as words. | |
128 | |
129 \\{c-subword-mode-map}" | |
130 nil | |
131 nil | |
132 c-subword-mode-map | |
133 (c-update-modeline)) | |
134 | |
135 (defun c-forward-subword (&optional arg) | |
136 "Do the same as `forward-word' but on subwords. | |
137 See the command `c-subword-mode' for a description of subwords. | |
138 Optional argument ARG is the same as for `forward-word'." | |
139 (interactive "p") | |
140 (unless arg (setq arg 1)) | |
141 (c-keep-region-active) | |
142 (cond | |
143 ((< 0 arg) | |
144 (dotimes (i arg (point)) | |
145 (c-forward-subword-internal))) | |
146 ((> 0 arg) | |
147 (dotimes (i (- arg) (point)) | |
148 (c-backward-subword-internal))) | |
149 (t | |
150 (point)))) | |
151 | |
70649
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
152 (put 'c-forward-subword 'CUA 'move) |
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
153 |
67252 | 154 (defun c-backward-subword (&optional arg) |
155 "Do the same as `backward-word' but on subwords. | |
156 See the command `c-subword-mode' for a description of subwords. | |
157 Optional argument ARG is the same as for `backward-word'." | |
158 (interactive "p") | |
159 (c-forward-subword (- (or arg 1)))) | |
160 | |
161 (defun c-mark-subword (arg) | |
162 "Do the same as `mark-word' but on subwords. | |
163 See the command `c-subword-mode' for a description of subwords. | |
164 Optional argument ARG is the same as for `mark-word'." | |
165 ;; This code is almost copied from `mark-word' in GNU Emacs. | |
166 (interactive "p") | |
167 (cond ((and (eq last-command this-command) (mark t)) | |
168 (set-mark | |
169 (save-excursion | |
170 (goto-char (mark)) | |
171 (c-forward-subword arg) | |
172 (point)))) | |
173 (t | |
174 (push-mark | |
175 (save-excursion | |
176 (c-forward-subword arg) | |
177 (point)) | |
178 nil t)))) | |
179 | |
70649
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
180 (put 'c-backward-subword 'CUA 'move) |
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
181 |
67252 | 182 (defun c-kill-subword (arg) |
183 "Do the same as `kill-word' but on subwords. | |
184 See the command `c-subword-mode' for a description of subwords. | |
185 Optional argument ARG is the same as for `kill-word'." | |
186 (interactive "p") | |
187 (kill-region (point) (c-forward-subword arg))) | |
188 | |
189 (defun c-backward-kill-subword (arg) | |
190 "Do the same as `backward-kill-word' but on subwords. | |
191 See the command `c-subword-mode' for a description of subwords. | |
192 Optional argument ARG is the same as for `backward-kill-word'." | |
193 (interactive "p") | |
194 (c-kill-subword (- arg))) | |
195 | |
196 (defun c-transpose-subwords (arg) | |
197 "Do the same as `transpose-words' but on subwords. | |
198 See the command `c-subword-mode' for a description of subwords. | |
199 Optional argument ARG is the same as for `transpose-words'." | |
200 (interactive "*p") | |
201 (transpose-subr 'c-forward-subword arg)) | |
202 | |
77082
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
203 |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
204 |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
205 (defun c-downcase-subword (arg) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
206 "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
|
207 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
|
208 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
|
209 (interactive "p") |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
210 (let ((start (point))) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
211 (downcase-region (point) (c-forward-subword arg)) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
212 (when (< arg 0) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
213 (goto-char start)))) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
214 |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
215 (defun c-upcase-subword (arg) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
216 "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
|
217 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
|
218 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
|
219 (interactive "p") |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
220 (let ((start (point))) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
221 (upcase-region (point) (c-forward-subword arg)) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
222 (when (< arg 0) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
223 (goto-char start)))) |
c783ccac00cf
Install a patch from Paul Curry.
Masatake YAMATO <jet@gyve.org>
parents:
75347
diff
changeset
|
224 |
67252 | 225 (defun c-capitalize-subword (arg) |
226 "Do the same as `capitalize-word' but on subwords. | |
227 See the command `c-subword-mode' for a description of subwords. | |
228 Optional argument ARG is the same as for `capitalize-word'." | |
229 (interactive "p") | |
230 (let ((count (abs arg)) | |
77083
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
231 (start (point)) |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
232 (advance (if (< arg 0) nil t))) |
67252 | 233 (dotimes (i count) |
77083
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
234 (if advance |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
235 (progn (re-search-forward |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
236 (concat "[" c-alpha "]") |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
237 nil t) |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
238 (goto-char (match-beginning 0))) |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
239 (c-backward-subword)) |
67252 | 240 (let* ((p (point)) |
241 (pp (1+ p)) | |
77083
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
242 (np (c-forward-subword))) |
67252 | 243 (upcase-region p pp) |
244 (downcase-region pp np) | |
77083
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
245 (goto-char (if advance np p)))) |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
246 (unless advance |
304a180098d2
(c-capitalize-subword): Implement
Masatake YAMATO <jet@gyve.org>
parents:
77082
diff
changeset
|
247 (goto-char start)))) |
67252 | 248 |
249 | |
250 | |
251 ;; | |
252 ;; Internal functions | |
253 ;; | |
254 (defun c-forward-subword-internal () | |
255 (if (and | |
70649
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
256 (save-excursion |
67252 | 257 (let ((case-fold-search nil)) |
70649
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
258 (re-search-forward |
67252 | 259 (concat "\\W*\\(\\([" c-upper "]*\\W?\\)[" c-lower c-digit "]*\\)") |
260 nil t))) | |
261 (> (match-end 0) (point))) ; So we don't get stuck at a | |
262 ; "word-constituent" which isn't c-upper, | |
263 ; c-lower or c-digit | |
70649
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
264 (goto-char |
67252 | 265 (cond |
266 ((< 1 (- (match-end 2) (match-beginning 2))) | |
267 (1- (match-end 2))) | |
268 (t | |
269 (match-end 0)))) | |
270 (forward-word 1))) | |
271 | |
272 | |
273 (defun c-backward-subword-internal () | |
70649
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
274 (if (save-excursion |
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
275 (let ((case-fold-search nil)) |
67252 | 276 (re-search-backward |
277 (concat | |
278 "\\(\\(\\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
|
279 "\\|\\W\\w+\\)") |
67252 | 280 nil t))) |
70649
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
281 (goto-char |
4cc85f377783
(c-forward-subword, c-backward-subword):
Kim F. Storm <storm@cua.dk>
parents:
70239
diff
changeset
|
282 (cond |
67252 | 283 ((and (match-end 3) |
284 (< 1 (- (match-end 3) (match-beginning 3))) | |
285 (not (eq (point) (match-end 3)))) | |
286 (1- (match-end 3))) | |
287 (t | |
288 (1+ (match-beginning 0))))) | |
289 (backward-word 1))) | |
290 | |
291 | |
292 (cc-provide 'cc-subword) | |
293 | |
70238
1be7d556ba69
(c-subword-mode-map): Use command remapping.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68773
diff
changeset
|
294 ;; arch-tag: 2be9d294-7f30-4626-95e6-9964bb93c7a3 |
67252 | 295 ;;; cc-subword.el ends here |