Commit | Line | Data |
---|---|---|
6ddc4422 | 1 | ;;; subword.el --- Handling capitalized subwords in a nomenclature -*- lexical-binding: t -*- |
0386b551 | 2 | |
ba318903 | 3 | ;; Copyright (C) 2004-2014 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 | ||
6ddc4422 DC |
24 | ;; This package provides the `subword' minor mode, which merges the |
25 | ;; old remap-based subword.el (derived from cc-mode code) and | |
26 | ;; cap-words.el, which takes advantage of core Emacs | |
27 | ;; word-motion-customization functionality. | |
0386b551 AM |
28 | |
29 | ;; In spite of GNU Coding Standards, it is popular to name a symbol by | |
30 | ;; mixing uppercase and lowercase letters, e.g. "GtkWidget", | |
31 | ;; "EmacsFrameClass", "NSGraphicsContext", etc. Here we call these | |
32 | ;; mixed case symbols `nomenclatures'. Also, each capitalized (or | |
33 | ;; completely uppercase) part of a nomenclature is called a `subword'. | |
34 | ;; Here are some examples: | |
35 | ||
36 | ;; Nomenclature Subwords | |
37 | ;; =========================================================== | |
38 | ;; GtkWindow => "Gtk" and "Window" | |
39 | ;; EmacsFrameClass => "Emacs", "Frame" and "Class" | |
40 | ;; NSGraphicsContext => "NS", "Graphics" and "Context" | |
41 | ||
42 | ;; The subword oriented commands defined in this package recognize | |
43 | ;; subwords in a nomenclature to move between them and to edit them as | |
002668e1 TZ |
44 | ;; words. You also get a mode to treat symbols as words instead, |
45 | ;; called `superword-mode' (the opposite of `subword-mode'). | |
0386b551 | 46 | |
0386b551 AM |
47 | ;; To make the mode turn on automatically, put the following code in |
48 | ;; your .emacs: | |
49 | ;; | |
002668e1 TZ |
50 | ;; (add-hook 'c-mode-common-hook 'subword-mode) |
51 | ;; | |
52 | ||
53 | ;; To make the mode turn `superword-mode' on automatically for | |
54 | ;; only some modes, put the following code in your .emacs: | |
55 | ;; | |
56 | ;; (add-hook 'c-mode-common-hook 'superword-mode) | |
0386b551 AM |
57 | ;; |
58 | ||
59 | ;; Acknowledgment: | |
60 | ;; The regular expressions to detect subwords are mostly based on | |
61 | ;; the old `c-forward-into-nomenclature' originally contributed by | |
62 | ;; Terry_Glanfield dot Southern at rxuk dot xerox dot com. | |
63 | ||
1ddb2ea0 | 64 | ;; TODO: ispell-word. |
0386b551 AM |
65 | |
66 | ;;; Code: | |
67 | ||
1c308380 PS |
68 | (defvar subword-forward-function 'subword-forward-internal |
69 | "Function to call for forward subword movement.") | |
70 | ||
71 | (defvar subword-backward-function 'subword-backward-internal | |
72 | "Function to call for backward subword movement.") | |
73 | ||
4e619754 | 74 | (defvar subword-forward-regexp |
0ac26976 | 75 | "\\W*\\(\\([[:upper:]]*\\(\\W\\)?\\)[[:lower:][:digit:]]*\\)" |
1c308380 PS |
76 | "Regexp used by `subword-forward-internal'.") |
77 | ||
4e619754 | 78 | (defvar subword-backward-regexp |
1c308380 PS |
79 | "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)\\|\\W\\w+\\)" |
80 | "Regexp used by `subword-backward-internal'.") | |
81 | ||
653d1554 | 82 | (defvar subword-mode-map |
6ddc4422 DC |
83 | ;; We originally remapped motion keys here, but now use Emacs core |
84 | ;; hooks. Leave this keymap around so that user additions to it | |
85 | ;; keep working. | |
86 | (make-sparse-keymap) | |
653d1554 | 87 | "Keymap used in `subword-mode' minor mode.") |
27558c0d | 88 | |
6ddc4422 DC |
89 | ;;;###autoload |
90 | (define-obsolete-function-alias | |
91 | 'capitalized-words-mode 'subword-mode "24.5") | |
92 | ||
27558c0d | 93 | ;;;###autoload |
653d1554 | 94 | (define-minor-mode subword-mode |
ac6c8639 CY |
95 | "Toggle subword movement and editing (Subword mode). |
96 | With a prefix argument ARG, enable Subword mode if ARG is | |
97 | positive, and disable it otherwise. If called from Lisp, enable | |
98 | the mode if ARG is omitted or nil. | |
99 | ||
6ddc4422 DC |
100 | Subword mode is a buffer-local minor mode. Enabling it changes |
101 | the definition of a word so that word-based commands stop inside | |
ac6c8639 CY |
102 | symbols with mixed uppercase and lowercase letters, |
103 | e.g. \"GtkWidget\", \"EmacsFrameClass\", \"NSGraphicsContext\". | |
104 | ||
105 | Here we call these mixed case symbols `nomenclatures'. Each | |
106 | capitalized (or completely uppercase) part of a nomenclature is | |
107 | called a `subword'. Here are some examples: | |
0386b551 AM |
108 | |
109 | Nomenclature Subwords | |
110 | =========================================================== | |
111 | GtkWindow => \"Gtk\" and \"Window\" | |
112 | EmacsFrameClass => \"Emacs\", \"Frame\" and \"Class\" | |
113 | NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\" | |
114 | ||
6ddc4422 DC |
115 | This mode changes the definition of a word so that word commands |
116 | treat nomenclature boundaries as word bounaries. | |
0386b551 | 117 | |
653d1554 | 118 | \\{subword-mode-map}" |
002668e1 | 119 | :lighter " ," |
6ddc4422 DC |
120 | (when subword-mode (superword-mode -1)) |
121 | (subword-setup-buffer)) | |
653d1554 TH |
122 | |
123 | (define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2") | |
0386b551 | 124 | |
653d1554 TH |
125 | ;;;###autoload |
126 | (define-global-minor-mode global-subword-mode subword-mode | |
a21ba35d GM |
127 | (lambda () (subword-mode 1)) |
128 | :group 'convenience) | |
653d1554 | 129 | |
6ddc4422 DC |
130 | ;; N.B. These commands aren't used unless explicitly invoked; they're |
131 | ;; here for compatibility. Today, subword-mode leaves motion commands | |
132 | ;; alone and uses `find-word-boundary-function-table' to change how | |
133 | ;; `forward-word' and other low-level commands detect word bounaries. | |
134 | ;; This way, all word-related activities, not just the images we | |
135 | ;; imagine here, get subword treatment. | |
136 | ||
a9b76eec | 137 | (defun subword-forward (&optional arg) |
0386b551 | 138 | "Do the same as `forward-word' but on subwords. |
653d1554 | 139 | See the command `subword-mode' for a description of subwords. |
0386b551 | 140 | Optional argument ARG is the same as for `forward-word'." |
75a2f981 | 141 | (interactive "^p") |
0386b551 | 142 | (unless arg (setq arg 1)) |
0386b551 AM |
143 | (cond |
144 | ((< 0 arg) | |
6ddc4422 | 145 | (dotimes (_i arg (point)) |
1c308380 | 146 | (funcall subword-forward-function))) |
0386b551 | 147 | ((> 0 arg) |
6ddc4422 | 148 | (dotimes (_i (- arg) (point)) |
1c308380 | 149 | (funcall subword-backward-function))) |
0386b551 AM |
150 | (t |
151 | (point)))) | |
152 | ||
a9b76eec | 153 | (put 'subword-forward 'CUA 'move) |
5e8c9892 | 154 | |
a9b76eec | 155 | (defun subword-backward (&optional arg) |
0386b551 | 156 | "Do the same as `backward-word' but on subwords. |
653d1554 | 157 | See the command `subword-mode' for a description of subwords. |
0386b551 | 158 | Optional argument ARG is the same as for `backward-word'." |
75a2f981 | 159 | (interactive "^p") |
a9b76eec | 160 | (subword-forward (- (or arg 1)))) |
0386b551 | 161 | |
75a2f981 TZ |
162 | (defun subword-right (&optional arg) |
163 | "Do the same as `right-word' but on subwords." | |
164 | (interactive "^p") | |
165 | (if (eq (current-bidi-paragraph-direction) 'left-to-right) | |
166 | (subword-forward arg) | |
167 | (subword-backward arg))) | |
168 | ||
169 | (defun subword-left (&optional arg) | |
170 | "Do the same as `left-word' but on subwords." | |
171 | (interactive "^p") | |
172 | (if (eq (current-bidi-paragraph-direction) 'left-to-right) | |
173 | (subword-backward arg) | |
174 | (subword-forward arg))) | |
002668e1 | 175 | |
a9b76eec | 176 | (defun subword-mark (arg) |
0386b551 | 177 | "Do the same as `mark-word' but on subwords. |
653d1554 | 178 | See the command `subword-mode' for a description of subwords. |
0386b551 AM |
179 | Optional argument ARG is the same as for `mark-word'." |
180 | ;; This code is almost copied from `mark-word' in GNU Emacs. | |
181 | (interactive "p") | |
182 | (cond ((and (eq last-command this-command) (mark t)) | |
183 | (set-mark | |
184 | (save-excursion | |
185 | (goto-char (mark)) | |
a9b76eec | 186 | (subword-forward arg) |
0386b551 AM |
187 | (point)))) |
188 | (t | |
189 | (push-mark | |
190 | (save-excursion | |
a9b76eec | 191 | (subword-forward arg) |
0386b551 AM |
192 | (point)) |
193 | nil t)))) | |
194 | ||
a9b76eec | 195 | (put 'subword-backward 'CUA 'move) |
5e8c9892 | 196 | |
a9b76eec | 197 | (defun subword-kill (arg) |
0386b551 | 198 | "Do the same as `kill-word' but on subwords. |
653d1554 | 199 | See the command `subword-mode' for a description of subwords. |
0386b551 AM |
200 | Optional argument ARG is the same as for `kill-word'." |
201 | (interactive "p") | |
a9b76eec | 202 | (kill-region (point) (subword-forward arg))) |
0386b551 | 203 | |
a9b76eec | 204 | (defun subword-backward-kill (arg) |
0386b551 | 205 | "Do the same as `backward-kill-word' but on subwords. |
653d1554 | 206 | See the command `subword-mode' for a description of subwords. |
0386b551 AM |
207 | Optional argument ARG is the same as for `backward-kill-word'." |
208 | (interactive "p") | |
a9b76eec | 209 | (subword-kill (- arg))) |
0386b551 | 210 | |
a9b76eec | 211 | (defun subword-transpose (arg) |
0386b551 | 212 | "Do the same as `transpose-words' but on subwords. |
653d1554 | 213 | See the command `subword-mode' for a description of subwords. |
0386b551 AM |
214 | Optional argument ARG is the same as for `transpose-words'." |
215 | (interactive "*p") | |
a9b76eec | 216 | (transpose-subr 'subword-forward arg)) |
287787ee | 217 | |
a9b76eec | 218 | (defun subword-downcase (arg) |
287787ee | 219 | "Do the same as `downcase-word' but on subwords. |
653d1554 | 220 | See the command `subword-mode' for a description of subwords. |
287787ee MY |
221 | Optional argument ARG is the same as for `downcase-word'." |
222 | (interactive "p") | |
223 | (let ((start (point))) | |
a9b76eec | 224 | (downcase-region (point) (subword-forward arg)) |
653d1554 | 225 | (when (< arg 0) |
287787ee MY |
226 | (goto-char start)))) |
227 | ||
a9b76eec | 228 | (defun subword-upcase (arg) |
287787ee | 229 | "Do the same as `upcase-word' but on subwords. |
653d1554 | 230 | See the command `subword-mode' for a description of subwords. |
287787ee MY |
231 | Optional argument ARG is the same as for `upcase-word'." |
232 | (interactive "p") | |
233 | (let ((start (point))) | |
a9b76eec | 234 | (upcase-region (point) (subword-forward arg)) |
653d1554 | 235 | (when (< arg 0) |
287787ee MY |
236 | (goto-char start)))) |
237 | ||
a9b76eec | 238 | (defun subword-capitalize (arg) |
0386b551 | 239 | "Do the same as `capitalize-word' but on subwords. |
653d1554 | 240 | See the command `subword-mode' for a description of subwords. |
0386b551 AM |
241 | Optional argument ARG is the same as for `capitalize-word'." |
242 | (interactive "p") | |
a24b9961 DK |
243 | (condition-case nil |
244 | (let ((count (abs arg)) | |
245 | (start (point)) | |
246 | (advance (>= arg 0))) | |
247 | ||
6ddc4422 | 248 | (dotimes (_i count) |
a24b9961 DK |
249 | (if advance |
250 | (progn | |
251 | (re-search-forward "[[:alpha:]]") | |
252 | (goto-char (match-beginning 0))) | |
253 | (subword-backward)) | |
254 | (let* ((p (point)) | |
255 | (pp (1+ p)) | |
256 | (np (subword-forward))) | |
257 | (upcase-region p pp) | |
258 | (downcase-region pp np) | |
259 | (goto-char (if advance np p)))) | |
260 | (unless advance | |
261 | (goto-char start))) | |
262 | (search-failed nil))) | |
0386b551 | 263 | |
002668e1 TZ |
264 | \f |
265 | ||
266 | (defvar superword-mode-map subword-mode-map | |
267 | "Keymap used in `superword-mode' minor mode.") | |
268 | ||
269 | ;;;###autoload | |
270 | (define-minor-mode superword-mode | |
271 | "Toggle superword movement and editing (Superword mode). | |
272 | With a prefix argument ARG, enable Superword mode if ARG is | |
273 | positive, and disable it otherwise. If called from Lisp, enable | |
274 | the mode if ARG is omitted or nil. | |
275 | ||
6ddc4422 DC |
276 | Superword mode is a buffer-local minor mode. Enabling it changes |
277 | the definition of words such that symbols characters are treated | |
278 | as parts of words: e.g., in `superword-mode', | |
279 | \"this_is_a_symbol\" counts as one word. | |
002668e1 TZ |
280 | |
281 | \\{superword-mode-map}" | |
282 | :lighter " ²" | |
6ddc4422 DC |
283 | (when superword-mode (subword-mode -1)) |
284 | (subword-setup-buffer)) | |
002668e1 TZ |
285 | |
286 | ;;;###autoload | |
287 | (define-global-minor-mode global-superword-mode superword-mode | |
a21ba35d GM |
288 | (lambda () (superword-mode 1)) |
289 | :group 'convenience) | |
0386b551 AM |
290 | |
291 | \f | |
292 | ;; | |
293 | ;; Internal functions | |
294 | ;; | |
a9b76eec | 295 | (defun subword-forward-internal () |
002668e1 | 296 | (if superword-mode |
0b938190 | 297 | (forward-symbol 1) |
002668e1 TZ |
298 | (if (and |
299 | (save-excursion | |
300 | (let ((case-fold-search nil)) | |
301 | (re-search-forward subword-forward-regexp nil t))) | |
302 | (> (match-end 0) (point))) | |
303 | (goto-char | |
304 | (cond | |
0ac26976 SM |
305 | ((and (< 1 (- (match-end 2) (match-beginning 2))) |
306 | ;; If we have an all-caps word with no following lower-case or | |
307 | ;; non-word letter, don't leave the last char (bug#13758). | |
308 | (not (and (null (match-beginning 3)) | |
309 | (eq (match-end 2) (match-end 1))))) | |
002668e1 TZ |
310 | (1- (match-end 2))) |
311 | (t | |
312 | (match-end 0)))) | |
313 | (forward-word 1)))) | |
0386b551 | 314 | |
a9b76eec | 315 | (defun subword-backward-internal () |
002668e1 | 316 | (if superword-mode |
0b938190 | 317 | (forward-symbol -1) |
002668e1 TZ |
318 | (if (save-excursion |
319 | (let ((case-fold-search nil)) | |
320 | (re-search-backward subword-backward-regexp nil t))) | |
321 | (goto-char | |
322 | (cond | |
323 | ((and (match-end 3) | |
324 | (< 1 (- (match-end 3) (match-beginning 3))) | |
325 | (not (eq (point) (match-end 3)))) | |
326 | (1- (match-end 3))) | |
327 | (t | |
328 | (1+ (match-beginning 0))))) | |
329 | (backward-word 1)))) | |
0386b551 | 330 | |
6ddc4422 DC |
331 | (defconst subword-find-word-boundary-function-table |
332 | (let ((tab (make-char-table nil))) | |
333 | (set-char-table-range tab t #'subword-find-word-boundary) | |
334 | tab) | |
335 | "Assigned to `find-word-boundary-function-table' in | |
336 | `subword-mode' and `superword-mode'; defers to | |
337 | `subword-find-word-bounary'.") | |
338 | ||
339 | (defconst subword-empty-char-table | |
340 | (make-char-table nil) | |
341 | "Assigned to `find-word-boundary-function-table' while we're | |
342 | searching subwords in order to avoid unwanted reentrancy.") | |
343 | ||
344 | (defun subword-setup-buffer () | |
345 | (set (make-local-variable 'find-word-boundary-function-table) | |
346 | (if (or subword-mode superword-mode) | |
347 | subword-find-word-boundary-function-table | |
348 | subword-empty-char-table))) | |
349 | ||
350 | (defun subword-find-word-boundary (pos limit) | |
351 | "Catch-all handler in `subword-find-word-boundary-function-table'." | |
352 | (let ((find-word-boundary-function-table subword-empty-char-table)) | |
353 | (save-match-data | |
354 | (save-excursion | |
355 | (save-restriction | |
356 | (if (< pos limit) | |
357 | (progn | |
166aaa37 | 358 | (goto-char pos) |
6ddc4422 DC |
359 | (narrow-to-region (point-min) limit) |
360 | (funcall subword-forward-function)) | |
166aaa37 | 361 | (goto-char (1+ pos)) |
6ddc4422 DC |
362 | (narrow-to-region limit (point-max)) |
363 | (funcall subword-backward-function)) | |
364 | (point)))))) | |
365 | ||
0386b551 | 366 | \f |
002668e1 | 367 | |
653d1554 | 368 | (provide 'subword) |
002668e1 | 369 | (provide 'superword) |
6ddc4422 | 370 | (provide 'cap-words) ; Obsolete alias |
0386b551 | 371 | |
653d1554 | 372 | ;;; subword.el ends here |