(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)
(cc-bytecomp-defvar c-subword-mode)
(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)))
(dolist (cmd '(forward-word backward-word mark-word
kill-word backward-kill-word
transpose-words
capitalize-word upcase-word downcase-word))
(let ((othercmd (let ((name (symbol-name cmd)))
(string-match "\\(.*-\\)\\(word.*\\)" name)
(intern (concat "c-"
(match-string 1 name)
"sub"
(match-string 2 name))))))
(if (fboundp 'command-remapping)
(define-key map (vector 'remap cmd) othercmd)
(substitute-key-definition cmd othercmd 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))))
(put 'c-forward-subword 'CUA 'move)
(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'."
(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))))
(put 'c-backward-subword 'CUA 'move)
(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-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")
(let ((start (point)))
(downcase-region (point) (c-forward-subword arg))
(when (< arg 0)
(goto-char start))))
(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")
(let ((start (point)))
(upcase-region (point) (c-forward-subword arg))
(when (< arg 0)
(goto-char start))))
(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))
(start (point))
(advance (if (< arg 0) nil t)))
(dotimes (i count)
(if advance
(progn (re-search-forward
(concat "[" c-alpha "]")
nil t)
(goto-char (match-beginning 0)))
(c-backward-subword))
(let* ((p (point))
(pp (1+ p))
(np (c-forward-subword)))
(upcase-region p pp)
(downcase-region pp np)
(goto-char (if advance np p))))
(unless advance
(goto-char start))))
(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))) (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)))
(cc-provide 'cc-subword)