[bpt/emacs.git] / lisp / progmodes / cc-subword.el

;;; cc-subword.el --- Handling capitalized subwords in a nomenclature

;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.

;; Author: Masatake YAMATO

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; 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
;; along with this program; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; This package provides `subword' oriented commands and a minor mode
;; (`c-subword-mode') that substitutes the common word handling
;; 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
;; ============================================================
;; M-f     `forward-word'             `c-forward-subword'
;; M-b     `backward-word'            `c-backward-subword'
;; M-@     `mark-word'                `c-mark-subword'
;; M-d     `kill-word'                `c-kill-subword'
;; M-DEL   `backward-kill-word'       `c-backward-kill-subword'
;; M-t     `transpose-words'          `c-transpose-subwords'
;; M-c     `capitalize-word'          `c-capitalize-subword'
;; M-u     `upcase-word'              `c-upcase-subword'
;; M-l     `downcase-word'            `c-downcase-subword'
;;
;; 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
;; 	  (lambda () (c-subword-mode 1)))
;;

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

(eval-when-compile
  (let ((load-path
	 (if (and (boundp 'byte-compile-dest-file)
		  (stringp byte-compile-dest-file))
	     (cons (file-name-directory byte-compile-dest-file) load-path)
	   load-path)))
    (load "cc-bytecomp" nil t)))

(cc-require 'cc-defs)
(cc-require 'cc-cmds)

;; Don't complain about the `define-minor-mode' form if it isn't defined.
(cc-bytecomp-defvar c-subword-mode)

;;; Autoload directives must be on the top level, so we construct an
;;; autoload form instead.
;;;###autoload (autoload 'c-subword-mode "cc-subword" "Mode enabling subword movement and editing keys." t)

(if (not (fboundp 'define-minor-mode))
    (defun c-subword-mode ()
      "(Missing) mode enabling subword movement and editing keys.
This mode is not (yet) available in this version of (X)Emacs.  Sorry!  If
you really want it, please send a request to <bug-gnu-emacs@gnu.org>,
telling us which (X)Emacs version you're using."
      (interactive)
      (error
       "c-subword-mode is not (yet) available in this version of (X)Emacs.  Sorry!"))

  (defvar c-subword-mode-map
    (let ((map (make-sparse-keymap)))
      (substitute-key-definition 'forward-word
				 'c-forward-subword
				 map global-map)
      (substitute-key-definition 'backward-word
				 'c-backward-subword
				 map global-map)
      (substitute-key-definition 'mark-word
				 'c-mark-subword
				 map global-map)
    
      (substitute-key-definition 'kill-word
				 'c-kill-subword
				 map global-map)
      (substitute-key-definition 'backward-kill-word
				 'c-backward-kill-subword
				 map global-map)
    
      (substitute-key-definition 'transpose-words
				 'c-transpose-subwords
				 map global-map)
    
      (substitute-key-definition 'capitalize-word
				 'c-capitalize-subword
				 map global-map)
      (substitute-key-definition 'upcase-word
				 'c-upcase-subword
				 map global-map)
      (substitute-key-definition 'downcase-word
				 'c-downcase-subword
				 map global-map)
      map)
    "Keymap used in command `c-subword-mode' minor mode.")

  (define-minor-mode c-subword-mode
    "Mode enabling subword movement and editing keys.
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.

\\{c-subword-mode-map}"
    nil
    nil
    c-subword-mode-map
    (c-update-modeline))

  )

(defun c-forward-subword (&optional arg)
  "Do the same as `forward-word' but on subwords.
See the command `c-subword-mode' for a description of subwords.
Optional argument ARG is the same as for `forward-word'."
  (interactive "p")
  (unless arg (setq arg 1))
  (c-keep-region-active)
  (cond
   ((< 0 arg)
    (dotimes (i arg (point))
      (c-forward-subword-internal)))
   ((> 0 arg)
    (dotimes (i (- arg) (point))
      (c-backward-subword-internal)))
   (t
    (point))))

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

(defun c-mark-subword (arg)
  "Do the same as `mark-word' but on subwords.
See the command `c-subword-mode' for a description of subwords.
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))
	    (c-forward-subword arg)
	    (point))))
	(t
	 (push-mark
	  (save-excursion
	    (c-forward-subword arg)
	    (point))
	  nil t))))

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

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

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

(defun c-capitalize-subword (arg)
  "Do the same as `capitalize-word' but on subwords.
See the command `c-subword-mode' for a description of subwords.
Optional argument ARG is the same as for `capitalize-word'."
  (interactive "p")
  (let ((count (abs arg))
	(direction (if (< 0 arg) 1 -1)))
    (dotimes (i count)
      (when (re-search-forward 
	     (concat "[" c-alpha "]")
	     nil t)
	(goto-char (match-beginning 0)))
      (let* ((p (point))
	     (pp (1+ p))
	     (np (c-forward-subword direction)))
	(upcase-region p pp)
	(downcase-region pp np)
	(goto-char np)))))

(defun c-downcase-subword (arg)
  "Do the same as `downcase-word' but on subwords.
See the command `c-subword-mode' for a description of subwords.
Optional argument ARG is the same as for `downcase-word'."
  (interactive "p")
  (downcase-region (point) (c-forward-subword arg)))

(defun c-upcase-subword (arg)
  "Do the same as `upcase-word' but on subwords.
See the command `c-subword-mode' for a description of subwords.
Optional argument ARG is the same as for `upcase-word'."
  (interactive "p")
  (upcase-region (point) (c-forward-subword arg)))

\f
;;
;; Internal functions
;;
(defun c-forward-subword-internal ()
  (if (and
       (save-excursion 
	 (let ((case-fold-search nil))
	   (re-search-forward 
	    (concat "\\W*\\(\\([" c-upper "]*\\W?\\)[" c-lower c-digit "]*\\)")
	    nil t)))
       (> (match-end 0) (point))) ; So we don't get stuck at a
				  ; "word-constituent" which isn't c-upper,
				  ; c-lower or c-digit
      (goto-char 
       (cond
	((< 1 (- (match-end 2) (match-beginning 2)))
	 (1- (match-end 2)))
	(t
	 (match-end 0))))
    (forward-word 1)))


(defun c-backward-subword-internal ()
  (if (save-excursion 
	(let ((case-fold-search nil)) 
	  (re-search-backward
	   (concat
	    "\\(\\(\\W\\|[" c-lower c-digit "]\\)\\([" c-upper "]+\\W*\\)"
	    "\\|\\W\\w+\\)") 
	   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)))

\f
(cc-provide 'cc-subword)

;;; arch-tag: 2be9d294-7f30-4626-95e6-9964bb93c7a3
;;; cc-subword.el ends here
Commit	Line	Data
0386b551 AM	1	;;; cc-subword.el --- Handling capitalized subwords in a nomenclature
	2
	3	;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
	4
	5	;; Author: Masatake YAMATO
	6
	7	;; This program is free software; you can redistribute it and/or modify
	8	;; it under the terms of the GNU General Public License as published by
	9	;; the Free Software Foundation; either version 2, or (at your option)
	10	;; any later version.
	11
	12	;; This program is distributed in the hope that it will be useful,
	13	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	14	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	;; GNU General Public License for more details.
	16
	17	;; You should have received a copy of the GNU General Public License
	18	;; along with this program; see the file COPYING. If not, write to
	19	;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
	20	;; Boston, MA 02110-1301, USA.
	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
91	;; Don't complain about the `define-minor-mode' form if it isn't defined.
92	(cc-bytecomp-defvar c-subword-mode)
93
94	;;; Autoload directives must be on the top level, so we construct an
95	;;; autoload form instead.
96	;;;###autoload (autoload 'c-subword-mode "cc-subword" "Mode enabling subword movement and editing keys." t)
97
98	(if (not (fboundp 'define-minor-mode))
99	(defun c-subword-mode ()
100	"(Missing) mode enabling subword movement and editing keys.
101	This mode is not (yet) available in this version of (X)Emacs. Sorry! If
102	you really want it, please send a request to <bug-gnu-emacs@gnu.org>,
103	telling us which (X)Emacs version you're using."
104	(interactive)
105	(error
106	"c-subword-mode is not (yet) available in this version of (X)Emacs. Sorry!"))
107
108	(defvar c-subword-mode-map
109	(let ((map (make-sparse-keymap)))
110	(substitute-key-definition 'forward-word
111	'c-forward-subword
112	map global-map)
113	(substitute-key-definition 'backward-word
114	'c-backward-subword
115	map global-map)
116	(substitute-key-definition 'mark-word
117	'c-mark-subword
118	map global-map)
119
120	(substitute-key-definition 'kill-word
121	'c-kill-subword
122	map global-map)
123	(substitute-key-definition 'backward-kill-word
124	'c-backward-kill-subword
125	map global-map)
126
127	(substitute-key-definition 'transpose-words
128	'c-transpose-subwords
129	map global-map)
130
131	(substitute-key-definition 'capitalize-word
132	'c-capitalize-subword
133	map global-map)
134	(substitute-key-definition 'upcase-word
135	'c-upcase-subword
136	map global-map)
137	(substitute-key-definition 'downcase-word
138	'c-downcase-subword
139	map global-map)
140	map)
141	"Keymap used in command `c-subword-mode' minor mode.")
142
143	(define-minor-mode c-subword-mode
144	"Mode enabling subword movement and editing keys.
145	In spite of GNU Coding Standards, it is popular to name a symbol by
146	mixing uppercase and lowercase letters, e.g. \"GtkWidget\",
147	\"EmacsFrameClass\", \"NSGraphicsContext\", etc. Here we call these
148	mixed case symbols `nomenclatures'. Also, each capitalized (or
149	completely uppercase) part of a nomenclature is called a `subword'.
150	Here are some examples:
151
152	Nomenclature Subwords
153	===========================================================
154	GtkWindow => \"Gtk\" and \"Window\"
155	EmacsFrameClass => \"Emacs\", \"Frame\" and \"Class\"
156	NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\"
157
158	The subword oriented commands activated in this minor mode recognize
159	subwords in a nomenclature to move between subwords and to edit them
160	as words.
161
162	\\{c-subword-mode-map}"
163	nil
164	nil
165	c-subword-mode-map
166	(c-update-modeline))
167
168	)
169
170	(defun c-forward-subword (&optional arg)
171	"Do the same as `forward-word' but on subwords.
172	See the command `c-subword-mode' for a description of subwords.
173	Optional argument ARG is the same as for `forward-word'."
174	(interactive "p")
175	(unless arg (setq arg 1))
176	(c-keep-region-active)
177	(cond
178	((< 0 arg)
179	(dotimes (i arg (point))
180	(c-forward-subword-internal)))
181	((> 0 arg)
182	(dotimes (i (- arg) (point))
183	(c-backward-subword-internal)))
184	(t
185	(point))))
186
187	(defun c-backward-subword (&optional arg)
188	"Do the same as `backward-word' but on subwords.
189	See the command `c-subword-mode' for a description of subwords.
190	Optional argument ARG is the same as for `backward-word'."
191	(interactive "p")
192	(c-forward-subword (- (or arg 1))))
193
194	(defun c-mark-subword (arg)
195	"Do the same as `mark-word' but on subwords.
196	See the command `c-subword-mode' for a description of subwords.
197	Optional argument ARG is the same as for `mark-word'."
198	;; This code is almost copied from `mark-word' in GNU Emacs.
199	(interactive "p")
200	(cond ((and (eq last-command this-command) (mark t))
201	(set-mark
202	(save-excursion
203	(goto-char (mark))
204	(c-forward-subword arg)
205	(point))))
206	(t
207	(push-mark
208	(save-excursion
209	(c-forward-subword arg)
210	(point))
211	nil t))))
212
213	(defun c-kill-subword (arg)
214	"Do the same as `kill-word' but on subwords.
215	See the command `c-subword-mode' for a description of subwords.
216	Optional argument ARG is the same as for `kill-word'."
217	(interactive "p")
218	(kill-region (point) (c-forward-subword arg)))
219
220	(defun c-backward-kill-subword (arg)
221	"Do the same as `backward-kill-word' but on subwords.
222	See the command `c-subword-mode' for a description of subwords.
223	Optional argument ARG is the same as for `backward-kill-word'."
224	(interactive "p")
225	(c-kill-subword (- arg)))
226
227	(defun c-transpose-subwords (arg)
228	"Do the same as `transpose-words' but on subwords.
229	See the command `c-subword-mode' for a description of subwords.
230	Optional argument ARG is the same as for `transpose-words'."
231	(interactive "*p")
232	(transpose-subr 'c-forward-subword arg))
233
234	(defun c-capitalize-subword (arg)
235	"Do the same as `capitalize-word' but on subwords.
236	See the command `c-subword-mode' for a description of subwords.
237	Optional argument ARG is the same as for `capitalize-word'."
238	(interactive "p")
239	(let ((count (abs arg))
240	(direction (if (< 0 arg) 1 -1)))
241	(dotimes (i count)
242	(when (re-search-forward
243	(concat "[" c-alpha "]")
244	nil t)
245	(goto-char (match-beginning 0)))
246	(let* ((p (point))
247	(pp (1+ p))
248	(np (c-forward-subword direction)))
249	(upcase-region p pp)
250	(downcase-region pp np)
251	(goto-char np)))))
252
253	(defun c-downcase-subword (arg)
254	"Do the same as `downcase-word' but on subwords.
255	See the command `c-subword-mode' for a description of subwords.
256	Optional argument ARG is the same as for `downcase-word'."
257	(interactive "p")
258	(downcase-region (point) (c-forward-subword arg)))
259
260	(defun c-upcase-subword (arg)
261	"Do the same as `upcase-word' but on subwords.
262	See the command `c-subword-mode' for a description of subwords.
263	Optional argument ARG is the same as for `upcase-word'."
264	(interactive "p")
265	(upcase-region (point) (c-forward-subword arg)))
266
267	\f
268	;;
269	;; Internal functions
270	;;
271	(defun c-forward-subword-internal ()
272	(if (and
273	(save-excursion
274	(let ((case-fold-search nil))
275	(re-search-forward
276	(concat "\\W\\(\\([" c-upper "]\\W?\\)[" c-lower c-digit "]*\\)")
277	nil t)))
278	(> (match-end 0) (point))) ; So we don't get stuck at a
279	; "word-constituent" which isn't c-upper,
280	; c-lower or c-digit
281	(goto-char
282	(cond
283	((< 1 (- (match-end 2) (match-beginning 2)))
284	(1- (match-end 2)))
285	(t
286	(match-end 0))))
287	(forward-word 1)))
288
289
290	(defun c-backward-subword-internal ()
291	(if (save-excursion
292	(let ((case-fold-search nil))
293	(re-search-backward
294	(concat
295	"\\(\\(\\W\\\|[" c-lower c-digit "]\\)\\([" c-upper "]+\\W*\\)"
296	"\\\|\\W\\w+\\)")
297	nil t)))
298	(goto-char
299	(cond
300	((and (match-end 3)
301	(< 1 (- (match-end 3) (match-beginning 3)))
302	(not (eq (point) (match-end 3))))
303	(1- (match-end 3)))
304	(t
305	(1+ (match-beginning 0)))))
306	(backward-word 1)))
307
308	\f
309	(cc-provide 'cc-subword)
310
311	;;; arch-tag: 2be9d294-7f30-4626-95e6-9964bb93c7a3
312	;;; cc-subword.el ends here