lisp/progmodes/cc-subword.el

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