subword.el 12.2 KB
Newer Older
1
;;; subword.el --- Handling capitalized subwords in a nomenclature
2

3
;; Copyright (C) 2004-2013 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
;; This package was cc-submode.el before it was recognized being
;; useful in general and not tied to C and c-mode at all.

27
;; This package provides `subword' oriented commands and a minor mode
28
;; (`subword-mode') that substitutes the common word handling
Ted Zlatanov's avatar
Ted Zlatanov committed
29 30
;; functions with them.  It also provides the `superword-mode' minor
;; mode that treats symbols as words, the opposite of `subword-mode'.
31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46

;; 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
47 48
;; words.  You also get a mode to treat symbols as words instead,
;; called `superword-mode' (the opposite of `subword-mode').
49 50 51 52

;; In the minor mode, all common key bindings for word oriented
;; commands are overridden by the subword oriented commands:

Ted Zlatanov's avatar
Ted Zlatanov committed
53
;; Key     Word oriented command      Subword oriented command (also superword)
54
;; ============================================================
55 56 57 58 59 60 61 62 63
;; M-f     `forward-word'             `subword-forward'
;; M-b     `backward-word'            `subword-backward'
;; M-@     `mark-word'                `subword-mark'
;; M-d     `kill-word'                `subword-kill'
;; M-DEL   `backward-kill-word'       `subword-backward-kill'
;; M-t     `transpose-words'          `subword-transpose'
;; M-c     `capitalize-word'          `subword-capitalize'
;; M-u     `upcase-word'              `subword-upcase'
;; M-l     `downcase-word'            `subword-downcase'
64 65 66 67 68 69 70 71
;;
;; Note: If you have changed the key bindings for the word oriented
;; commands in your .emacs or a similar place, the keys you've changed
;; to are also used for the corresponding subword oriented commands.

;; To make the mode turn on automatically, put the following code in
;; your .emacs:
;;
Ted Zlatanov's avatar
Ted Zlatanov committed
72 73 74 75 76 77 78
;; (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)
79 80 81 82 83 84 85
;;

;; 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.

86
;; TODO: ispell-word.
87 88 89

;;; Code:

90 91 92 93 94 95
(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.")

96 97
(defconst subword-forward-regexp
  "\\W*\\(\\([[:upper:]]*\\(\\W\\)?\\)[[:lower:][:digit:]]*\\)"
98 99
  "Regexp used by `subword-forward-internal'.")

100
(defconst subword-backward-regexp
101 102 103
  "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)\\|\\W\\w+\\)"
  "Regexp used by `subword-backward-internal'.")

104
(defvar subword-mode-map
105
  (let ((map (make-sparse-keymap)))
106 107
    (dolist (cmd '(forward-word backward-word mark-word kill-word
				backward-kill-word transpose-words
Ted Zlatanov's avatar
Ted Zlatanov committed
108 109
                                capitalize-word upcase-word downcase-word
                                left-word right-word))
110
      (let ((othercmd (let ((name (symbol-name cmd)))
111 112
                        (string-match "\\([[:alpha:]-]+\\)-word[s]?" name)
                        (intern (concat "subword-" (match-string 1 name))))))
113
        (define-key map (vector 'remap cmd) othercmd)))
114
    map)
115
  "Keymap used in `subword-mode' minor mode.")
116 117

;;;###autoload
118
(define-minor-mode subword-mode
Chong Yidong's avatar
Chong Yidong committed
119 120 121 122 123 124 125 126 127 128 129 130 131
  "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.

Subword mode is a buffer-local minor mode.  Enabling it remaps
word-based editing commands to subword-based commands that handle
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:
132 133 134 135 136 137 138 139 140 141 142

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

The subword oriented commands activated in this minor mode recognize
subwords in a nomenclature to move between subwords and to edit them
as words.

143
\\{subword-mode-map}"
Ted Zlatanov's avatar
Ted Zlatanov committed
144 145
    :lighter " ,"
    (when subword-mode (superword-mode -1)))
146 147

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

149 150
;;;###autoload
(define-global-minor-mode global-subword-mode subword-mode
151 152
  (lambda () (subword-mode 1))
  :group 'convenience)
153

154
(defun subword-forward (&optional arg)
155
  "Do the same as `forward-word' but on subwords.
156
See the command `subword-mode' for a description of subwords.
157
Optional argument ARG is the same as for `forward-word'."
158
  (interactive "^p")
159 160 161 162
  (unless arg (setq arg 1))
  (cond
   ((< 0 arg)
    (dotimes (i arg (point))
163
      (funcall subword-forward-function)))
164 165
   ((> 0 arg)
    (dotimes (i (- arg) (point))
166
      (funcall subword-backward-function)))
167 168 169
   (t
    (point))))

170
(put 'subword-forward 'CUA 'move)
171

172
(defun subword-backward (&optional arg)
173
  "Do the same as `backward-word' but on subwords.
174
See the command `subword-mode' for a description of subwords.
175
Optional argument ARG is the same as for `backward-word'."
176
  (interactive "^p")
177
  (subword-forward (- (or arg 1))))
178

179 180 181 182 183 184 185 186 187 188 189 190 191
(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
192

193
(defun subword-mark (arg)
194
  "Do the same as `mark-word' but on subwords.
195
See the command `subword-mode' for a description of subwords.
196 197 198 199 200 201 202
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))
203
	    (subword-forward arg)
204 205 206 207
	    (point))))
	(t
	 (push-mark
	  (save-excursion
208
	    (subword-forward arg)
209 210 211
	    (point))
	  nil t))))

212
(put 'subword-backward 'CUA 'move)
213

214
(defun subword-kill (arg)
215
  "Do the same as `kill-word' but on subwords.
216
See the command `subword-mode' for a description of subwords.
217 218
Optional argument ARG is the same as for `kill-word'."
  (interactive "p")
219
  (kill-region (point) (subword-forward arg)))
220

221
(defun subword-backward-kill (arg)
222
  "Do the same as `backward-kill-word' but on subwords.
223
See the command `subword-mode' for a description of subwords.
224 225
Optional argument ARG is the same as for `backward-kill-word'."
  (interactive "p")
226
  (subword-kill (- arg)))
227

228
(defun subword-transpose (arg)
229
  "Do the same as `transpose-words' but on subwords.
230
See the command `subword-mode' for a description of subwords.
231 232
Optional argument ARG is the same as for `transpose-words'."
  (interactive "*p")
233
  (transpose-subr 'subword-forward arg))
234

235
(defun subword-downcase (arg)
236
  "Do the same as `downcase-word' but on subwords.
237
See the command `subword-mode' for a description of subwords.
238 239 240
Optional argument ARG is the same as for `downcase-word'."
  (interactive "p")
  (let ((start (point)))
241
    (downcase-region (point) (subword-forward arg))
242
    (when (< arg 0)
243 244
      (goto-char start))))

245
(defun subword-upcase (arg)
246
  "Do the same as `upcase-word' but on subwords.
247
See the command `subword-mode' for a description of subwords.
248 249 250
Optional argument ARG is the same as for `upcase-word'."
  (interactive "p")
  (let ((start (point)))
251
    (upcase-region (point) (subword-forward arg))
252
    (when (< arg 0)
253 254
      (goto-char start))))

255
(defun subword-capitalize (arg)
256
  "Do the same as `capitalize-word' but on subwords.
257
See the command `subword-mode' for a description of subwords.
258 259
Optional argument ARG is the same as for `capitalize-word'."
  (interactive "p")
260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279
  (condition-case nil
      (let ((count (abs arg))
            (start (point))
            (advance (>= arg 0)))

        (dotimes (i count)
          (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)))
280

Ted Zlatanov's avatar
Ted Zlatanov committed
281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306


(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.

Superword mode is a buffer-local minor mode.  Enabling it remaps
word-based editing commands to superword-based commands that
treat symbols as words, e.g. \"this_is_a_symbol\".

The superword oriented commands activated in this minor mode
recognize symbols as superwords to move between superwords and to
edit them as words.

\\{superword-mode-map}"
    :lighter " ²"
    (when superword-mode (subword-mode -1)))

;;;###autoload
(define-global-minor-mode global-superword-mode superword-mode
307 308
  (lambda () (superword-mode 1))
  :group 'convenience)
309 310 311 312 313


;;
;; Internal functions
;;
314
(defun subword-forward-internal ()
Ted Zlatanov's avatar
Ted Zlatanov committed
315
  (if superword-mode
316
      (forward-symbol 1)
Ted Zlatanov's avatar
Ted Zlatanov committed
317 318 319 320 321 322 323
    (if (and
         (save-excursion
           (let ((case-fold-search nil))
             (re-search-forward subword-forward-regexp nil t)))
         (> (match-end 0) (point)))
        (goto-char
         (cond
324 325 326 327 328
          ((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
329 330 331 332
           (1- (match-end 2)))
          (t
           (match-end 0))))
      (forward-word 1))))
333

334
(defun subword-backward-internal ()
Ted Zlatanov's avatar
Ted Zlatanov committed
335
  (if superword-mode
336
      (forward-symbol -1)
Ted Zlatanov's avatar
Ted Zlatanov committed
337 338 339 340 341 342 343 344 345 346 347 348
    (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))))
349 350


Ted Zlatanov's avatar
Ted Zlatanov committed
351

352
(provide 'subword)
Ted Zlatanov's avatar
Ted Zlatanov committed
353
(provide 'superword)
354

355
;;; subword.el ends here