lisp/progmodes/subword.el

   1 ;;; subword.el --- Handling capitalized subwords in a nomenclature
   2
   3 ;; Copyright (C) 2004-2012 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 was cc-submode.el before it was recognized being
  25 ;; useful in general and not tied to C and c-mode at all.
  26
  27 ;; This package provides `subword' oriented commands and a minor mode
  28 ;; (`subword-mode') that substitutes the common word handling
  29 ;; functions with them.
  30
  31 ;; In spite of GNU Coding Standards, it is popular to name a symbol by
  32 ;; mixing uppercase and lowercase letters, e.g. "GtkWidget",
  33 ;; "EmacsFrameClass", "NSGraphicsContext", etc.  Here we call these
  34 ;; mixed case symbols `nomenclatures'.  Also, each capitalized (or
  35 ;; completely uppercase) part of a nomenclature is called a `subword'.
  36 ;; Here are some examples:
  37
  38 ;;  Nomenclature           Subwords
  39 ;;  ===========================================================
  40 ;;  GtkWindow          =>  "Gtk" and "Window"
  41 ;;  EmacsFrameClass    =>  "Emacs", "Frame" and "Class"
  42 ;;  NSGraphicsContext  =>  "NS", "Graphics" and "Context"
  43
  44 ;; The subword oriented commands defined in this package recognize
  45 ;; subwords in a nomenclature to move between them and to edit them as
  46 ;; words.
  47
  48 ;; In the minor mode, all common key bindings for word oriented
  49 ;; commands are overridden by the subword oriented commands:
  50
  51 ;; Key     Word oriented command      Subword oriented command
  52 ;; ============================================================
  53 ;; M-f     `forward-word'             `subword-forward'
  54 ;; M-b     `backward-word'            `subword-backward'
  55 ;; M-@     `mark-word'                `subword-mark'
  56 ;; M-d     `kill-word'                `subword-kill'
  57 ;; M-DEL   `backward-kill-word'       `subword-backward-kill'
  58 ;; M-t     `transpose-words'          `subword-transpose'
  59 ;; M-c     `capitalize-word'          `subword-capitalize'
  60 ;; M-u     `upcase-word'              `subword-upcase'
  61 ;; M-l     `downcase-word'            `subword-downcase'
  62 ;;
  63 ;; Note: If you have changed the key bindings for the word oriented
  64 ;; commands in your .emacs or a similar place, the keys you've changed
  65 ;; to are also used for the corresponding subword oriented commands.
  66
  67 ;; To make the mode turn on automatically, put the following code in
  68 ;; your .emacs:
  69 ;;
  70 ;; (add-hook 'c-mode-common-hook
  71 ;;        (lambda () (subword-mode 1)))
  72 ;;
  73
  74 ;; Acknowledgment:
  75 ;; The regular expressions to detect subwords are mostly based on
  76 ;; the old `c-forward-into-nomenclature' originally contributed by
  77 ;; Terry_Glanfield dot Southern at rxuk dot xerox dot com.
  78
  79 ;; TODO: ispell-word.
  80
  81 ;;; Code:
  82
  83 (defvar subword-forward-function 'subword-forward-internal
  84   "Function to call for forward subword movement.")
  85
  86 (defvar subword-backward-function 'subword-backward-internal
  87   "Function to call for backward subword movement.")
  88
  89 (defvar subword-forward-regexp
  90   "\\W*\\(\\([[:upper:]]*\\W?\\)[[:lower:][:digit:]]*\\)"
  91   "Regexp used by `subword-forward-internal'.")
  92
  93 (defvar subword-backward-regexp
  94   "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)\\|\\W\\w+\\)"
  95   "Regexp used by `subword-backward-internal'.")
  96
  97 (defvar subword-mode-map
  98   (let ((map (make-sparse-keymap)))
  99     (dolist (cmd '(forward-word backward-word mark-word kill-word
 100                                 backward-kill-word transpose-words
 101                                 capitalize-word upcase-word downcase-word))
 102       (let ((othercmd (let ((name (symbol-name cmd)))
 103                         (string-match "\\([[:alpha:]-]+\\)-word[s]?" name)
 104                         (intern (concat "subword-" (match-string 1 name))))))
 105         (define-key map (vector 'remap cmd) othercmd)))
 106     map)
 107   "Keymap used in `subword-mode' minor mode.")
 108
 109 ;;;###autoload
 110 (define-minor-mode subword-mode
 111   "Toggle subword movement and editing (Subword mode).
 112 With a prefix argument ARG, enable Subword mode if ARG is
 113 positive, and disable it otherwise.  If called from Lisp, enable
 114 the mode if ARG is omitted or nil.
 115
 116 Subword mode is a buffer-local minor mode.  Enabling it remaps
 117 word-based editing commands to subword-based commands that handle
 118 symbols with mixed uppercase and lowercase letters,
 119 e.g. \"GtkWidget\", \"EmacsFrameClass\", \"NSGraphicsContext\".
 120
 121 Here we call these mixed case symbols `nomenclatures'.  Each
 122 capitalized (or completely uppercase) part of a nomenclature is
 123 called a `subword'.  Here are some examples:
 124
 125   Nomenclature           Subwords
 126   ===========================================================
 127   GtkWindow          =>  \"Gtk\" and \"Window\"
 128   EmacsFrameClass    =>  \"Emacs\", \"Frame\" and \"Class\"
 129   NSGraphicsContext  =>  \"NS\", \"Graphics\" and \"Context\"
 130
 131 The subword oriented commands activated in this minor mode recognize
 132 subwords in a nomenclature to move between subwords and to edit them
 133 as words.
 134
 135 \\{subword-mode-map}"
 136     nil
 137     nil
 138     subword-mode-map)
 139
 140 (define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2")
 141
 142 ;;;###autoload
 143 (define-global-minor-mode global-subword-mode subword-mode
 144   (lambda () (subword-mode 1)))
 145
 146 (defun subword-forward (&optional arg)
 147   "Do the same as `forward-word' but on subwords.
 148 See the command `subword-mode' for a description of subwords.
 149 Optional argument ARG is the same as for `forward-word'."
 150   (interactive "p")
 151   (unless arg (setq arg 1))
 152   (cond
 153    ((< 0 arg)
 154     (dotimes (i arg (point))
 155       (funcall subword-forward-function)))
 156    ((> 0 arg)
 157     (dotimes (i (- arg) (point))
 158       (funcall subword-backward-function)))
 159    (t
 160     (point))))
 161
 162 (put 'subword-forward 'CUA 'move)
 163
 164 (defun subword-backward (&optional arg)
 165   "Do the same as `backward-word' but on subwords.
 166 See the command `subword-mode' for a description of subwords.
 167 Optional argument ARG is the same as for `backward-word'."
 168   (interactive "p")
 169   (subword-forward (- (or arg 1))))
 170
 171 (defun subword-mark (arg)
 172   "Do the same as `mark-word' but on subwords.
 173 See the command `subword-mode' for a description of subwords.
 174 Optional argument ARG is the same as for `mark-word'."
 175   ;; This code is almost copied from `mark-word' in GNU Emacs.
 176   (interactive "p")
 177   (cond ((and (eq last-command this-command) (mark t))
 178          (set-mark
 179           (save-excursion
 180             (goto-char (mark))
 181             (subword-forward arg)
 182             (point))))
 183         (t
 184          (push-mark
 185           (save-excursion
 186             (subword-forward arg)
 187             (point))
 188           nil t))))
 189
 190 (put 'subword-backward 'CUA 'move)
 191
 192 (defun subword-kill (arg)
 193   "Do the same as `kill-word' but on subwords.
 194 See the command `subword-mode' for a description of subwords.
 195 Optional argument ARG is the same as for `kill-word'."
 196   (interactive "p")
 197   (kill-region (point) (subword-forward arg)))
 198
 199 (defun subword-backward-kill (arg)
 200   "Do the same as `backward-kill-word' but on subwords.
 201 See the command `subword-mode' for a description of subwords.
 202 Optional argument ARG is the same as for `backward-kill-word'."
 203   (interactive "p")
 204   (subword-kill (- arg)))
 205
 206 (defun subword-transpose (arg)
 207   "Do the same as `transpose-words' but on subwords.
 208 See the command `subword-mode' for a description of subwords.
 209 Optional argument ARG is the same as for `transpose-words'."
 210   (interactive "*p")
 211   (transpose-subr 'subword-forward arg))
 212
 213 (defun subword-downcase (arg)
 214   "Do the same as `downcase-word' but on subwords.
 215 See the command `subword-mode' for a description of subwords.
 216 Optional argument ARG is the same as for `downcase-word'."
 217   (interactive "p")
 218   (let ((start (point)))
 219     (downcase-region (point) (subword-forward arg))
 220     (when (< arg 0)
 221       (goto-char start))))
 222
 223 (defun subword-upcase (arg)
 224   "Do the same as `upcase-word' but on subwords.
 225 See the command `subword-mode' for a description of subwords.
 226 Optional argument ARG is the same as for `upcase-word'."
 227   (interactive "p")
 228   (let ((start (point)))
 229     (upcase-region (point) (subword-forward arg))
 230     (when (< arg 0)
 231       (goto-char start))))
 232
 233 (defun subword-capitalize (arg)
 234   "Do the same as `capitalize-word' but on subwords.
 235 See the command `subword-mode' for a description of subwords.
 236 Optional argument ARG is the same as for `capitalize-word'."
 237   (interactive "p")
 238   (let ((count (abs arg))
 239         (start (point))
 240         (advance (if (< arg 0) nil t)))
 241     (dotimes (i count)
 242       (if advance
 243           (progn (re-search-forward
 244                   (concat "[[:alpha:]]")
 245                   nil t)
 246                  (goto-char (match-beginning 0)))
 247         (subword-backward))
 248       (let* ((p (point))
 249              (pp (1+ p))
 250              (np (subword-forward)))
 251         (upcase-region p pp)
 252         (downcase-region pp np)
 253         (goto-char (if advance np p))))
 254     (unless advance
 255       (goto-char start))))
 256
 257
 258 \f
 259 ;;
 260 ;; Internal functions
 261 ;;
 262 (defun subword-forward-internal ()
 263   (if (and
 264        (save-excursion
 265          (let ((case-fold-search nil))
 266            (re-search-forward subword-forward-regexp nil t)))
 267        (> (match-end 0) (point)))
 268       (goto-char
 269        (cond
 270         ((< 1 (- (match-end 2) (match-beginning 2)))
 271          (1- (match-end 2)))
 272         (t
 273          (match-end 0))))
 274     (forward-word 1)))
 275
 276
 277 (defun subword-backward-internal ()
 278   (if (save-excursion
 279         (let ((case-fold-search nil))
 280           (re-search-backward subword-backward-regexp 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 (provide 'subword)
 293
 294 ;;; subword.el ends here