lisp/subword.el

   1 ;;; subword.el --- Handling capitalized subwords in a nomenclature
   2
   3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 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 and subword oriented C-w in isearch.
  80
  81 ;;; Code:
  82
  83 (defvar subword-mode-map
  84   (let ((map (make-sparse-keymap)))
  85     (dolist (cmd '(forward-word backward-word mark-word kill-word
  86                                 backward-kill-word transpose-words
  87                                 capitalize-word upcase-word downcase-word))
  88       (let ((othercmd (let ((name (symbol-name cmd)))
  89                         (string-match "\\(.*-\\)\\(word.*\\)" name)
  90                         (intern (concat (match-string 1 name)
  91                                         "sub"
  92                                         (match-string 2 name))))))
  93         (define-key map (vector 'remap cmd) othercmd)))
  94     map)
  95   "Keymap used in `subword-mode' minor mode.")
  96
  97 ;;;###autoload
  98 (define-minor-mode subword-mode
  99   "Mode enabling subword movement and editing keys.
 100 In spite of GNU Coding Standards, it is popular to name a symbol by
 101 mixing uppercase and lowercase letters, e.g. \"GtkWidget\",
 102 \"EmacsFrameClass\", \"NSGraphicsContext\", etc.  Here we call these
 103 mixed case symbols `nomenclatures'. Also, each capitalized (or
 104 completely uppercase) part of a nomenclature is called a `subword'.
 105 Here are some examples:
 106
 107   Nomenclature           Subwords
 108   ===========================================================
 109   GtkWindow          =>  \"Gtk\" and \"Window\"
 110   EmacsFrameClass    =>  \"Emacs\", \"Frame\" and \"Class\"
 111   NSGraphicsContext  =>  \"NS\", \"Graphics\" and \"Context\"
 112
 113 The subword oriented commands activated in this minor mode recognize
 114 subwords in a nomenclature to move between subwords and to edit them
 115 as words.
 116
 117 \\{subword-mode-map}"
 118     nil
 119     nil
 120     subword-mode-map)
 121
 122 (define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2")
 123
 124 ;;;###autoload
 125 (define-global-minor-mode global-subword-mode subword-mode
 126   (lambda () (subword-mode 1)))
 127
 128 (defun subword-forward (&optional arg)
 129   "Do the same as `forward-word' but on subwords.
 130 See the command `subword-mode' for a description of subwords.
 131 Optional argument ARG is the same as for `forward-word'."
 132   (interactive "p")
 133   (unless arg (setq arg 1))
 134   (cond
 135    ((< 0 arg)
 136     (dotimes (i arg (point))
 137       (subword-forward-internal)))
 138    ((> 0 arg)
 139     (dotimes (i (- arg) (point))
 140       (subword-backward-internal)))
 141    (t
 142     (point))))
 143
 144 (put 'subword-forward 'CUA 'move)
 145
 146 (defun subword-backward (&optional arg)
 147   "Do the same as `backward-word' but on subwords.
 148 See the command `subword-mode' for a description of subwords.
 149 Optional argument ARG is the same as for `backward-word'."
 150   (interactive "p")
 151   (subword-forward (- (or arg 1))))
 152
 153 (defun subword-mark (arg)
 154   "Do the same as `mark-word' but on subwords.
 155 See the command `subword-mode' for a description of subwords.
 156 Optional argument ARG is the same as for `mark-word'."
 157   ;; This code is almost copied from `mark-word' in GNU Emacs.
 158   (interactive "p")
 159   (cond ((and (eq last-command this-command) (mark t))
 160          (set-mark
 161           (save-excursion
 162             (goto-char (mark))
 163             (subword-forward arg)
 164             (point))))
 165         (t
 166          (push-mark
 167           (save-excursion
 168             (subword-forward arg)
 169             (point))
 170           nil t))))
 171
 172 (put 'subword-backward 'CUA 'move)
 173
 174 (defun subword-kill (arg)
 175   "Do the same as `kill-word' but on subwords.
 176 See the command `subword-mode' for a description of subwords.
 177 Optional argument ARG is the same as for `kill-word'."
 178   (interactive "p")
 179   (kill-region (point) (subword-forward arg)))
 180
 181 (defun subword-backward-kill (arg)
 182   "Do the same as `backward-kill-word' but on subwords.
 183 See the command `subword-mode' for a description of subwords.
 184 Optional argument ARG is the same as for `backward-kill-word'."
 185   (interactive "p")
 186   (subword-kill (- arg)))
 187
 188 (defun subword-transpose (arg)
 189   "Do the same as `transpose-words' but on subwords.
 190 See the command `subword-mode' for a description of subwords.
 191 Optional argument ARG is the same as for `transpose-words'."
 192   (interactive "*p")
 193   (transpose-subr 'subword-forward arg))
 194
 195 (defun subword-downcase (arg)
 196   "Do the same as `downcase-word' but on subwords.
 197 See the command `subword-mode' for a description of subwords.
 198 Optional argument ARG is the same as for `downcase-word'."
 199   (interactive "p")
 200   (let ((start (point)))
 201     (downcase-region (point) (subword-forward arg))
 202     (when (< arg 0)
 203       (goto-char start))))
 204
 205 (defun subword-upcase (arg)
 206   "Do the same as `upcase-word' but on subwords.
 207 See the command `subword-mode' for a description of subwords.
 208 Optional argument ARG is the same as for `upcase-word'."
 209   (interactive "p")
 210   (let ((start (point)))
 211     (upcase-region (point) (subword-forward arg))
 212     (when (< arg 0)
 213       (goto-char start))))
 214
 215 (defun subword-capitalize (arg)
 216   "Do the same as `capitalize-word' but on subwords.
 217 See the command `subword-mode' for a description of subwords.
 218 Optional argument ARG is the same as for `capitalize-word'."
 219   (interactive "p")
 220   (let ((count (abs arg))
 221         (start (point))
 222         (advance (if (< arg 0) nil t)))
 223     (dotimes (i count)
 224       (if advance
 225           (progn (re-search-forward
 226                   (concat "[[:alpha:]]")
 227                   nil t)
 228                  (goto-char (match-beginning 0)))
 229         (subword-backward))
 230       (let* ((p (point))
 231              (pp (1+ p))
 232              (np (subword-forward)))
 233         (upcase-region p pp)
 234         (downcase-region pp np)
 235         (goto-char (if advance np p))))
 236     (unless advance
 237       (goto-char start))))
 238
 239
 240 \f
 241 ;;
 242 ;; Internal functions
 243 ;;
 244 (defun subword-forward-internal ()
 245   (if (and
 246        (save-excursion
 247          (let ((case-fold-search nil))
 248            (re-search-forward
 249             (concat "\\W*\\(\\([[:upper:]]*\\W?\\)[[:lower:][:digit:]]*\\)")
 250             nil t)))
 251        (> (match-end 0) (point)))
 252       (goto-char
 253        (cond
 254         ((< 1 (- (match-end 2) (match-beginning 2)))
 255          (1- (match-end 2)))
 256         (t
 257          (match-end 0))))
 258     (forward-word 1)))
 259
 260
 261 (defun subword-backward-internal ()
 262   (if (save-excursion
 263         (let ((case-fold-search nil))
 264           (re-search-backward
 265            (concat
 266             "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)"
 267             "\\|\\W\\w+\\)")
 268            nil t)))
 269       (goto-char
 270        (cond
 271         ((and (match-end 3)
 272               (< 1 (- (match-end 3) (match-beginning 3)))
 273               (not (eq (point) (match-end 3))))
 274          (1- (match-end 3)))
 275         (t
 276          (1+ (match-beginning 0)))))
 277     (backward-word 1)))
 278
 279 \f
 280 (provide 'subword)
 281
 282 ;;; subword.el ends here