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

Glenn Morris's avatar
Glenn Morris committed
3
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 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
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
;; functions with them.

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

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

;; Key     Word oriented command      Subword oriented command
;; ============================================================
53 54 55 56 57 58 59 60 61
;; 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'
62 63 64 65 66 67 68 69 70
;;
;; 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:
;;
;; (add-hook 'c-mode-common-hook
71
;; 	  (lambda () (subword-mode 1)))
72 73 74 75 76 77 78 79 80 81 82
;;

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

;; TODO: ispell-word and subword oriented C-w in isearch.

;;; Code:

83
(defvar subword-mode-map
84
  (let ((map (make-sparse-keymap)))
85 86
    (dolist (cmd '(forward-word backward-word mark-word kill-word
				backward-kill-word transpose-words
87 88
                                capitalize-word upcase-word downcase-word))
      (let ((othercmd (let ((name (symbol-name cmd)))
89 90
                        (string-match "\\([[:alpha:]-]+\\)-word[s]?" name)
                        (intern (concat "subword-" (match-string 1 name))))))
91
        (define-key map (vector 'remap cmd) othercmd)))
92
    map)
93
  "Keymap used in `subword-mode' minor mode.")
94 95

;;;###autoload
96
(define-minor-mode subword-mode
97
  "Mode enabling subword movement and editing keys.
98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114
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 activated in this minor mode recognize
subwords in a nomenclature to move between subwords and to edit them
as words.

115
\\{subword-mode-map}"
116 117
    nil
    nil
118 119 120
    subword-mode-map)

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

122 123 124 125
;;;###autoload
(define-global-minor-mode global-subword-mode subword-mode
  (lambda () (subword-mode 1)))

126
(defun subword-forward (&optional arg)
127
  "Do the same as `forward-word' but on subwords.
128
See the command `subword-mode' for a description of subwords.
129 130 131 132 133 134
Optional argument ARG is the same as for `forward-word'."
  (interactive "p")
  (unless arg (setq arg 1))
  (cond
   ((< 0 arg)
    (dotimes (i arg (point))
135
      (subword-forward-internal)))
136 137
   ((> 0 arg)
    (dotimes (i (- arg) (point))
138
      (subword-backward-internal)))
139 140 141
   (t
    (point))))

142
(put 'subword-forward 'CUA 'move)
143

144
(defun subword-backward (&optional arg)
145
  "Do the same as `backward-word' but on subwords.
146
See the command `subword-mode' for a description of subwords.
147 148
Optional argument ARG is the same as for `backward-word'."
  (interactive "p")
149
  (subword-forward (- (or arg 1))))
150

151
(defun subword-mark (arg)
152
  "Do the same as `mark-word' but on subwords.
153
See the command `subword-mode' for a description of subwords.
154 155 156 157 158 159 160
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))
161
	    (subword-forward arg)
162 163 164 165
	    (point))))
	(t
	 (push-mark
	  (save-excursion
166
	    (subword-forward arg)
167 168 169
	    (point))
	  nil t))))

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

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

179
(defun subword-backward-kill (arg)
180
  "Do the same as `backward-kill-word' but on subwords.
181
See the command `subword-mode' for a description of subwords.
182 183
Optional argument ARG is the same as for `backward-kill-word'."
  (interactive "p")
184
  (subword-kill (- arg)))
185

186
(defun subword-transpose (arg)
187
  "Do the same as `transpose-words' but on subwords.
188
See the command `subword-mode' for a description of subwords.
189 190
Optional argument ARG is the same as for `transpose-words'."
  (interactive "*p")
191
  (transpose-subr 'subword-forward arg))
192

193
(defun subword-downcase (arg)
194
  "Do the same as `downcase-word' but on subwords.
195
See the command `subword-mode' for a description of subwords.
196 197 198
Optional argument ARG is the same as for `downcase-word'."
  (interactive "p")
  (let ((start (point)))
199
    (downcase-region (point) (subword-forward arg))
200
    (when (< arg 0)
201 202
      (goto-char start))))

203
(defun subword-upcase (arg)
204
  "Do the same as `upcase-word' but on subwords.
205
See the command `subword-mode' for a description of subwords.
206 207 208
Optional argument ARG is the same as for `upcase-word'."
  (interactive "p")
  (let ((start (point)))
209
    (upcase-region (point) (subword-forward arg))
210
    (when (< arg 0)
211 212
      (goto-char start))))

213
(defun subword-capitalize (arg)
214
  "Do the same as `capitalize-word' but on subwords.
215
See the command `subword-mode' for a description of subwords.
216 217 218
Optional argument ARG is the same as for `capitalize-word'."
  (interactive "p")
  (let ((count (abs arg))
219 220
	(start (point))
	(advance (if (< arg 0) nil t)))
221
    (dotimes (i count)
222 223
      (if advance
	  (progn (re-search-forward
224
		  (concat "[[:alpha:]]")
225 226
		  nil t)
		 (goto-char (match-beginning 0)))
227
	(subword-backward))
228 229
      (let* ((p (point))
	     (pp (1+ p))
230
	     (np (subword-forward)))
231 232
	(upcase-region p pp)
	(downcase-region pp np)
233 234 235
	(goto-char (if advance np p))))
    (unless advance
      (goto-char start))))
236 237 238 239 240 241



;;
;; Internal functions
;;
242
(defun subword-forward-internal ()
243
  (if (and
244
       (save-excursion
245
	 (let ((case-fold-search nil))
246
	   (re-search-forward
247
	    (concat "\\W*\\(\\([[:upper:]]*\\W?\\)[[:lower:][:digit:]]*\\)")
248
	    nil t)))
249
       (> (match-end 0) (point)))
250
      (goto-char
251 252 253 254 255 256 257 258
       (cond
	((< 1 (- (match-end 2) (match-beginning 2)))
	 (1- (match-end 2)))
	(t
	 (match-end 0))))
    (forward-word 1)))


259
(defun subword-backward-internal ()
260 261
  (if (save-excursion
	(let ((case-fold-search nil))
262 263
	  (re-search-backward
	   (concat
264
	    "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)"
265
	    "\\|\\W\\w+\\)")
266
	   nil t)))
267 268
      (goto-char
       (cond
269 270 271 272 273 274 275 276 277
	((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)))


278
(provide 'subword)
279

280
;;; subword.el ends here