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

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