code.delx.au - gnu-emacs/blob - lisp/progmodes/cc-subword.el

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