subword.el 12.5 KB
Newer Older
1
;;; subword.el --- Handling capitalized subwords in a nomenclature -*- lexical-binding: t -*-
2

3
;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
4 5 6

;; Author: Masatake YAMATO

7 8 9
;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
10
;; it under the terms of the GNU General Public License as published by
11 12
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
13

14
;; GNU Emacs is distributed in the hope that it will be useful,
15 16 17 18 19
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
20
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
21 22 23

;;; Commentary:

24 25 26 27
;; This package provides the `subword' minor mode, which merges the
;; old remap-based subword.el (derived from cc-mode code) and
;; cap-words.el, which takes advantage of core Emacs
;; word-motion-customization functionality.
28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43

;; In spite of GNU Coding Standards, it is popular to name a symbol by
;; mixing uppercase and lowercase letters, e.g. "GtkWidget",
;; "EmacsFrameClass", "NSGraphicsContext", etc.  Here we call these
;; mixed case symbols `nomenclatures'.  Also, each capitalized (or
;; completely uppercase) part of a nomenclature is called a `subword'.
;; Here are some examples:

;;  Nomenclature           Subwords
;;  ===========================================================
;;  GtkWindow          =>  "Gtk" and "Window"
;;  EmacsFrameClass    =>  "Emacs", "Frame" and "Class"
;;  NSGraphicsContext  =>  "NS", "Graphics" and "Context"

;; The subword oriented commands defined in this package recognize
;; subwords in a nomenclature to move between them and to edit them as
Ted Zlatanov's avatar
Ted Zlatanov committed
44 45
;; words.  You also get a mode to treat symbols as words instead,
;; called `superword-mode' (the opposite of `subword-mode').
46 47 48 49

;; To make the mode turn on automatically, put the following code in
;; your .emacs:
;;
Ted Zlatanov's avatar
Ted Zlatanov committed
50 51 52 53 54 55 56
;; (add-hook 'c-mode-common-hook 'subword-mode)
;;

;; To make the mode turn `superword-mode' on automatically for
;; only some modes, put the following code in your .emacs:
;;
;; (add-hook 'c-mode-common-hook 'superword-mode)
57 58 59 60 61 62 63
;;

;; Acknowledgment:
;; The regular expressions to detect subwords are mostly based on
;; the old `c-forward-into-nomenclature' originally contributed by
;; Terry_Glanfield dot Southern at rxuk dot xerox dot com.

64
;; TODO: ispell-word.
65 66 67

;;; Code:

68 69 70 71 72 73
(defvar subword-forward-function 'subword-forward-internal
  "Function to call for forward subword movement.")

(defvar subword-backward-function 'subword-backward-internal
  "Function to call for backward subword movement.")

74
(defvar subword-forward-regexp
75
  "\\W*\\(\\([[:upper:]]*\\(\\W\\)?\\)[[:lower:][:digit:]]*\\)"
76 77
  "Regexp used by `subword-forward-internal'.")

78
(defvar subword-backward-regexp
79 80 81
  "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)\\|\\W\\w+\\)"
  "Regexp used by `subword-backward-internal'.")

82
(defvar subword-mode-map
83 84 85 86
  ;; We originally remapped motion keys here, but now use Emacs core
  ;; hooks.  Leave this keymap around so that user additions to it
  ;; keep working.
  (make-sparse-keymap)
87
  "Keymap used in `subword-mode' minor mode.")
88

89 90
;;;###autoload
(define-obsolete-function-alias
Stefan Monnier's avatar
Stefan Monnier committed
91
  'capitalized-words-mode 'subword-mode "25.1")
92

93
;;;###autoload
94
(define-minor-mode subword-mode
Chong Yidong's avatar
Chong Yidong committed
95 96 97 98 99
  "Toggle subword movement and editing (Subword mode).
With a prefix argument ARG, enable Subword mode if ARG is
positive, and disable it otherwise.  If called from Lisp, enable
the mode if ARG is omitted or nil.

100 101
Subword mode is a buffer-local minor mode.  Enabling it changes
the definition of a word so that word-based commands stop inside
Chong Yidong's avatar
Chong Yidong committed
102 103 104 105 106 107
symbols with mixed uppercase and lowercase letters,
e.g. \"GtkWidget\", \"EmacsFrameClass\", \"NSGraphicsContext\".

Here we call these mixed case symbols `nomenclatures'.  Each
capitalized (or completely uppercase) part of a nomenclature is
called a `subword'.  Here are some examples:
108 109 110 111 112 113 114

  Nomenclature           Subwords
  ===========================================================
  GtkWindow          =>  \"Gtk\" and \"Window\"
  EmacsFrameClass    =>  \"Emacs\", \"Frame\" and \"Class\"
  NSGraphicsContext  =>  \"NS\", \"Graphics\" and \"Context\"

115
This mode changes the definition of a word so that word commands
Paul Eggert's avatar
Paul Eggert committed
116
treat nomenclature boundaries as word boundaries.
117

118
\\{subword-mode-map}"
Ted Zlatanov's avatar
Ted Zlatanov committed
119
    :lighter " ,"
120 121
    (when subword-mode (superword-mode -1))
    (subword-setup-buffer))
122 123

(define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2")
124

125 126
;;;###autoload
(define-global-minor-mode global-subword-mode subword-mode
127 128
  (lambda () (subword-mode 1))
  :group 'convenience)
129

130 131 132
;; N.B. These commands aren't used unless explicitly invoked; they're
;; here for compatibility.  Today, subword-mode leaves motion commands
;; alone and uses `find-word-boundary-function-table' to change how
Paul Eggert's avatar
Paul Eggert committed
133
;; `forward-word' and other low-level commands detect word boundaries.
134 135 136
;; This way, all word-related activities, not just the images we
;; imagine here, get subword treatment.

137
(defun subword-forward (&optional arg)
138
  "Do the same as `forward-word' but on subwords.
139
See the command `subword-mode' for a description of subwords.
140
Optional argument ARG is the same as for `forward-word'."
141
  (interactive "^p")
142 143 144
  (unless arg (setq arg 1))
  (cond
   ((< 0 arg)
145
    (dotimes (_i arg (point))
146
      (funcall subword-forward-function)))
147
   ((> 0 arg)
148
    (dotimes (_i (- arg) (point))
149
      (funcall subword-backward-function)))
150 151 152
   (t
    (point))))

153
(put 'subword-forward 'CUA 'move)
154

155
(defun subword-backward (&optional arg)
156
  "Do the same as `backward-word' but on subwords.
157
See the command `subword-mode' for a description of subwords.
158
Optional argument ARG is the same as for `backward-word'."
159
  (interactive "^p")
160
  (subword-forward (- (or arg 1))))
161

162 163 164 165 166 167 168 169 170 171 172 173 174
(defun subword-right (&optional arg)
  "Do the same as `right-word' but on subwords."
  (interactive "^p")
  (if (eq (current-bidi-paragraph-direction) 'left-to-right)
      (subword-forward arg)
    (subword-backward arg)))

(defun subword-left (&optional arg)
  "Do the same as `left-word' but on subwords."
  (interactive "^p")
  (if (eq (current-bidi-paragraph-direction) 'left-to-right)
      (subword-backward arg)
    (subword-forward arg)))
Ted Zlatanov's avatar
Ted Zlatanov committed
175

176
(defun subword-mark (arg)
177
  "Do the same as `mark-word' but on subwords.
178
See the command `subword-mode' for a description of subwords.
179 180 181 182 183 184 185
Optional argument ARG is the same as for `mark-word'."
  ;; This code is almost copied from `mark-word' in GNU Emacs.
  (interactive "p")
  (cond ((and (eq last-command this-command) (mark t))
	 (set-mark
	  (save-excursion
	    (goto-char (mark))
186
	    (subword-forward arg)
187 188 189 190
	    (point))))
	(t
	 (push-mark
	  (save-excursion
191
	    (subword-forward arg)
192 193 194
	    (point))
	  nil t))))

195
(put 'subword-backward 'CUA 'move)
196

197
(defun subword-kill (arg)
198
  "Do the same as `kill-word' but on subwords.
199
See the command `subword-mode' for a description of subwords.
200 201
Optional argument ARG is the same as for `kill-word'."
  (interactive "p")
202
  (kill-region (point) (subword-forward arg)))
203

204
(defun subword-backward-kill (arg)
205
  "Do the same as `backward-kill-word' but on subwords.
206
See the command `subword-mode' for a description of subwords.
207 208
Optional argument ARG is the same as for `backward-kill-word'."
  (interactive "p")
209
  (subword-kill (- arg)))
210

211
(defun subword-transpose (arg)
212
  "Do the same as `transpose-words' but on subwords.
213
See the command `subword-mode' for a description of subwords.
214 215
Optional argument ARG is the same as for `transpose-words'."
  (interactive "*p")
216
  (transpose-subr 'subword-forward arg))
217

218
(defun subword-downcase (arg)
219
  "Do the same as `downcase-word' but on subwords.
220
See the command `subword-mode' for a description of subwords.
221 222 223
Optional argument ARG is the same as for `downcase-word'."
  (interactive "p")
  (let ((start (point)))
224
    (downcase-region (point) (subword-forward arg))
225
    (when (< arg 0)
226 227
      (goto-char start))))

228
(defun subword-upcase (arg)
229
  "Do the same as `upcase-word' but on subwords.
230
See the command `subword-mode' for a description of subwords.
231 232 233
Optional argument ARG is the same as for `upcase-word'."
  (interactive "p")
  (let ((start (point)))
234
    (upcase-region (point) (subword-forward arg))
235
    (when (< arg 0)
236 237
      (goto-char start))))

238
(defun subword-capitalize (arg)
239
  "Do the same as `capitalize-word' but on subwords.
240
See the command `subword-mode' for a description of subwords.
241 242
Optional argument ARG is the same as for `capitalize-word'."
  (interactive "p")
243 244 245 246 247
  (condition-case nil
      (let ((count (abs arg))
            (start (point))
            (advance (>= arg 0)))

248
        (dotimes (_i count)
249 250 251 252 253 254 255 256 257 258 259 260 261 262
          (if advance
              (progn
                (re-search-forward "[[:alpha:]]")
                (goto-char (match-beginning 0)))
            (subword-backward))
          (let* ((p (point))
                 (pp (1+ p))
                 (np (subword-forward)))
            (upcase-region p pp)
            (downcase-region pp np)
            (goto-char (if advance np p))))
        (unless advance
          (goto-char start)))
    (search-failed nil)))
263

Ted Zlatanov's avatar
Ted Zlatanov committed
264 265 266 267 268 269 270 271 272 273 274 275


(defvar superword-mode-map subword-mode-map
  "Keymap used in `superword-mode' minor mode.")

;;;###autoload
(define-minor-mode superword-mode
  "Toggle superword movement and editing (Superword mode).
With a prefix argument ARG, enable Superword mode if ARG is
positive, and disable it otherwise.  If called from Lisp, enable
the mode if ARG is omitted or nil.

276 277 278 279
Superword mode is a buffer-local minor mode.  Enabling it changes
the definition of words such that symbols characters are treated
as parts of words: e.g., in `superword-mode',
\"this_is_a_symbol\" counts as one word.
Ted Zlatanov's avatar
Ted Zlatanov committed
280 281 282

\\{superword-mode-map}"
    :lighter " ²"
283 284
    (when superword-mode (subword-mode -1))
    (subword-setup-buffer))
Ted Zlatanov's avatar
Ted Zlatanov committed
285 286 287

;;;###autoload
(define-global-minor-mode global-superword-mode superword-mode
288 289
  (lambda () (superword-mode 1))
  :group 'convenience)
290 291 292 293 294


;;
;; Internal functions
;;
295
(defun subword-forward-internal ()
Ted Zlatanov's avatar
Ted Zlatanov committed
296
  (if superword-mode
297
      (forward-symbol 1)
Ted Zlatanov's avatar
Ted Zlatanov committed
298 299 300 301 302 303 304
    (if (and
         (save-excursion
           (let ((case-fold-search nil))
             (re-search-forward subword-forward-regexp nil t)))
         (> (match-end 0) (point)))
        (goto-char
         (cond
305 306 307 308 309
          ((and (< 1 (- (match-end 2) (match-beginning 2)))
                ;; If we have an all-caps word with no following lower-case or
                ;; non-word letter, don't leave the last char (bug#13758).
                (not (and (null (match-beginning 3))
                          (eq (match-end 2) (match-end 1)))))
Ted Zlatanov's avatar
Ted Zlatanov committed
310 311 312 313
           (1- (match-end 2)))
          (t
           (match-end 0))))
      (forward-word 1))))
314

315
(defun subword-backward-internal ()
Ted Zlatanov's avatar
Ted Zlatanov committed
316
  (if superword-mode
317
      (forward-symbol -1)
Ted Zlatanov's avatar
Ted Zlatanov committed
318 319 320 321 322 323 324 325 326 327 328 329
    (if (save-excursion
          (let ((case-fold-search nil))
            (re-search-backward subword-backward-regexp nil t)))
        (goto-char
         (cond
          ((and (match-end 3)
                (< 1 (- (match-end 3) (match-beginning 3)))
                (not (eq (point) (match-end 3))))
           (1- (match-end 3)))
          (t
           (1+ (match-beginning 0)))))
      (backward-word 1))))
330

331 332 333 334 335 336
(defconst subword-find-word-boundary-function-table
  (let ((tab (make-char-table nil)))
    (set-char-table-range tab t #'subword-find-word-boundary)
    tab)
  "Assigned to `find-word-boundary-function-table' in
`subword-mode' and `superword-mode'; defers to
Paul Eggert's avatar
Paul Eggert committed
337
`subword-find-word-boundary'.")
338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357

(defconst subword-empty-char-table
  (make-char-table nil)
  "Assigned to `find-word-boundary-function-table' while we're
searching subwords in order to avoid unwanted reentrancy.")

(defun subword-setup-buffer ()
  (set (make-local-variable 'find-word-boundary-function-table)
       (if (or subword-mode superword-mode)
           subword-find-word-boundary-function-table
         subword-empty-char-table)))

(defun subword-find-word-boundary (pos limit)
  "Catch-all handler in `subword-find-word-boundary-function-table'."
  (let ((find-word-boundary-function-table subword-empty-char-table))
    (save-match-data
      (save-excursion
        (save-restriction
          (if (< pos limit)
              (progn
Daniel Colascione's avatar
Daniel Colascione committed
358
                (goto-char pos)
359 360
                (narrow-to-region (point-min) limit)
                (funcall subword-forward-function))
Daniel Colascione's avatar
Daniel Colascione committed
361
            (goto-char (1+ pos))
362 363 364 365
            (narrow-to-region limit (point-max))
            (funcall subword-backward-function))
          (point))))))

366

Ted Zlatanov's avatar
Ted Zlatanov committed
367

368
(provide 'subword)
Ted Zlatanov's avatar
Ted Zlatanov committed
369
(provide 'superword)
370
(provide 'cap-words) ; Obsolete alias
371

372
;;; subword.el ends here