Commit | Line | Data |
---|---|---|
0386b551 AM |
1 | ;;; cc-subword.el --- Handling capitalized subwords in a nomenclature |
2 | ||
4e643dd2 | 3 | ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
0386b551 AM |
4 | |
5 | ;; Author: Masatake YAMATO | |
6 | ||
b1fc2b50 GM |
7 | ;; This file is part of GNU Emacs. |
8 | ||
9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
0386b551 | 10 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
11 | ;; the Free Software Foundation, either version 3 of the License, or |
12 | ;; (at your option) any later version. | |
0386b551 | 13 | |
b1fc2b50 | 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
0386b551 AM |
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 | |
b1fc2b50 | 20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
0386b551 AM |
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 | ||
27558c0d GM |
91 | (defvar c-subword-mode-map |
92 | (let ((map (make-sparse-keymap))) | |
93 | (dolist (cmd '(forward-word backward-word mark-word | |
94 | kill-word backward-kill-word | |
95 | transpose-words | |
96 | capitalize-word upcase-word downcase-word)) | |
97 | (let ((othercmd (let ((name (symbol-name cmd))) | |
98 | (string-match "\\(.*-\\)\\(word.*\\)" name) | |
99 | (intern (concat "c-" | |
100 | (match-string 1 name) | |
101 | "sub" | |
102 | (match-string 2 name)))))) | |
103 | (if (fboundp 'command-remapping) | |
104 | (define-key map (vector 'remap cmd) othercmd) | |
105 | (substitute-key-definition cmd othercmd map global-map)))) | |
106 | map) | |
107 | "Keymap used in command `c-subword-mode' minor mode.") | |
108 | ||
109 | ;;;###autoload | |
110 | (define-minor-mode c-subword-mode | |
111 | "Mode enabling subword movement and editing keys. | |
0386b551 AM |
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 | ||
0386b551 AM |
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 | ||
5e8c9892 KS |
152 | (put 'c-forward-subword 'CUA 'move) |
153 | ||
0386b551 AM |
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 | ||
5e8c9892 KS |
180 | (put 'c-backward-subword 'CUA 'move) |
181 | ||
0386b551 AM |
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 | ||
287787ee MY |
203 | |
204 | ||
205 | (defun c-downcase-subword (arg) | |
206 | "Do the same as `downcase-word' but on subwords. | |
207 | See the command `c-subword-mode' for a description of subwords. | |
208 | Optional argument ARG is the same as for `downcase-word'." | |
209 | (interactive "p") | |
210 | (let ((start (point))) | |
211 | (downcase-region (point) (c-forward-subword arg)) | |
212 | (when (< arg 0) | |
213 | (goto-char start)))) | |
214 | ||
215 | (defun c-upcase-subword (arg) | |
216 | "Do the same as `upcase-word' but on subwords. | |
217 | See the command `c-subword-mode' for a description of subwords. | |
218 | Optional argument ARG is the same as for `upcase-word'." | |
219 | (interactive "p") | |
220 | (let ((start (point))) | |
221 | (upcase-region (point) (c-forward-subword arg)) | |
222 | (when (< arg 0) | |
223 | (goto-char start)))) | |
224 | ||
0386b551 AM |
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)) | |
11d13e96 MY |
231 | (start (point)) |
232 | (advance (if (< arg 0) nil t))) | |
0386b551 | 233 | (dotimes (i count) |
11d13e96 MY |
234 | (if advance |
235 | (progn (re-search-forward | |
236 | (concat "[" c-alpha "]") | |
237 | nil t) | |
238 | (goto-char (match-beginning 0))) | |
239 | (c-backward-subword)) | |
0386b551 AM |
240 | (let* ((p (point)) |
241 | (pp (1+ p)) | |
11d13e96 | 242 | (np (c-forward-subword))) |
0386b551 AM |
243 | (upcase-region p pp) |
244 | (downcase-region pp np) | |
11d13e96 MY |
245 | (goto-char (if advance np p)))) |
246 | (unless advance | |
247 | (goto-char start)))) | |
0386b551 | 248 | |
0386b551 AM |
249 | |
250 | \f | |
251 | ;; | |
252 | ;; Internal functions | |
253 | ;; | |
254 | (defun c-forward-subword-internal () | |
255 | (if (and | |
5e8c9892 | 256 | (save-excursion |
0386b551 | 257 | (let ((case-fold-search nil)) |
5e8c9892 | 258 | (re-search-forward |
0386b551 AM |
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 | |
5e8c9892 | 264 | (goto-char |
0386b551 AM |
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 () | |
5e8c9892 KS |
274 | (if (save-excursion |
275 | (let ((case-fold-search nil)) | |
0386b551 AM |
276 | (re-search-backward |
277 | (concat | |
278 | "\\(\\(\\W\\|[" c-lower c-digit "]\\)\\([" c-upper "]+\\W*\\)" | |
5e8c9892 | 279 | "\\|\\W\\w+\\)") |
0386b551 | 280 | nil t))) |
5e8c9892 KS |
281 | (goto-char |
282 | (cond | |
0386b551 AM |
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 | \f | |
292 | (cc-provide 'cc-subword) | |
293 | ||
be12bc57 | 294 | ;; arch-tag: 2be9d294-7f30-4626-95e6-9964bb93c7a3 |
0386b551 | 295 | ;;; cc-subword.el ends here |