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