cgit.sxemacs.org Git - packages/blob - xemacs-packages/cc-mode/cc-subword.el

   1 ;;; cc-subword.el --- Handling capitalized subwords in a nomenclature
   2
   3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012,
   4 ;; 2013 Free Software Foundation, Inc.
   5
   6 ;; Author: Masatake YAMATO
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 3, or (at your option)
  11 ;; any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program; see the file COPYING.  If not, see
  20 ;; <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 ;; 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
 235
 236 (defun c-downcase-subword (arg)
 237   "Do the same as `downcase-word' but on subwords.
 238 See the command `c-subword-mode' for a description of subwords.
 239 Optional argument ARG is the same as for `downcase-word'."
 240   (interactive "p")
 241   (let ((start (point)))
 242     (downcase-region (point) (c-forward-subword arg))
 243     (when (< arg 0)
 244       (goto-char start))))
 245
 246 (defun c-upcase-subword (arg)
 247   "Do the same as `upcase-word' but on subwords.
 248 See the command `c-subword-mode' for a description of subwords.
 249 Optional argument ARG is the same as for `upcase-word'."
 250   (interactive "p")
 251   (let ((start (point)))
 252     (upcase-region (point) (c-forward-subword arg))
 253     (when (< arg 0)
 254       (goto-char start))))
 255
 256 (defun c-capitalize-subword (arg)
 257   "Do the same as `capitalize-word' but on subwords.
 258 See the command `c-subword-mode' for a description of subwords.
 259 Optional argument ARG is the same as for `capitalize-word'."
 260   (interactive "p")
 261   (let ((count (abs arg))
 262         (start (point))
 263         (advance (if (< arg 0) nil t)))
 264     (dotimes (i count)
 265       (if advance
 266           (progn (re-search-forward
 267                   (concat "[" c-alpha "]")
 268                   nil t)
 269                  (goto-char (match-beginning 0)))
 270         (c-backward-subword))
 271       (let* ((p (point))
 272              (pp (1+ p))
 273              (np (c-forward-subword)))
 274         (upcase-region p pp)
 275         (downcase-region pp np)
 276         (goto-char (if advance np p))))
 277     (unless advance
 278       (goto-char start))))
 279
 280
 281 \f
 282 ;;
 283 ;; Internal functions
 284 ;;
 285 (defun c-forward-subword-internal ()
 286   (if (and
 287        (save-excursion
 288          (let ((case-fold-search nil))
 289            (re-search-forward
 290             (concat "\\W*\\(\\([" c-upper "]*\\W?\\)[" c-lower c-digit "]*\\)")
 291             nil t)))
 292        (> (match-end 0) (point))) ; So we don't get stuck at a
 293                                   ; "word-constituent" which isn't c-upper,
 294                                   ; c-lower or c-digit
 295       (goto-char
 296        (cond
 297         ((< 1 (- (match-end 2) (match-beginning 2)))
 298          (1- (match-end 2)))
 299         (t
 300          (match-end 0))))
 301     (forward-word 1)))
 302
 303
 304 (defun c-backward-subword-internal ()
 305   (if (save-excursion
 306         (let ((case-fold-search nil))
 307           (re-search-backward
 308            (concat
 309             "\\(\\(\\W\\|[" c-lower c-digit "]\\)\\([" c-upper "]+\\W*\\)"
 310             "\\|\\W\\w+\\)")
 311            nil t)))
 312       (goto-char
 313        (cond
 314         ((and (match-end 3)
 315               (< 1 (- (match-end 3) (match-beginning 3)))
 316               (not (eq (point) (match-end 3))))
 317          (1- (match-end 3)))
 318         (t
 319          (1+ (match-beginning 0)))))
 320     (backward-word 1)))
 321
 322 \f
 323 (cc-provide 'cc-subword)
 324
 325 ;;; Local Variables:
 326 ;;; indent-tabs-mode: t
 327 ;;; tab-width: 8
 328 ;;; End:
 329 ;;; cc-subword.el ends here