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

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