lisp/progmodes/subword.el

   1 ;;; subword.el --- Handling capitalized subwords in a nomenclature
   2
   3 ;; Copyright (C) 2004-2014 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   :group 'convenience)
 153
 154 (defun subword-forward (&optional arg)
 155   "Do the same as `forward-word' but on subwords.
 156 See the command `subword-mode' for a description of subwords.
 157 Optional argument ARG is the same as for `forward-word'."
 158   (interactive "^p")
 159   (unless arg (setq arg 1))
 160   (cond
 161    ((< 0 arg)
 162     (dotimes (i arg (point))
 163       (funcall subword-forward-function)))
 164    ((> 0 arg)
 165     (dotimes (i (- arg) (point))
 166       (funcall subword-backward-function)))
 167    (t
 168     (point))))
 169
 170 (put 'subword-forward 'CUA 'move)
 171
 172 (defun subword-backward (&optional arg)
 173   "Do the same as `backward-word' but on subwords.
 174 See the command `subword-mode' for a description of subwords.
 175 Optional argument ARG is the same as for `backward-word'."
 176   (interactive "^p")
 177   (subword-forward (- (or arg 1))))
 178
 179 (defun subword-right (&optional arg)
 180   "Do the same as `right-word' but on subwords."
 181   (interactive "^p")
 182   (if (eq (current-bidi-paragraph-direction) 'left-to-right)
 183       (subword-forward arg)
 184     (subword-backward arg)))
 185
 186 (defun subword-left (&optional arg)
 187   "Do the same as `left-word' but on subwords."
 188   (interactive "^p")
 189   (if (eq (current-bidi-paragraph-direction) 'left-to-right)
 190       (subword-backward arg)
 191     (subword-forward arg)))
 192
 193 (defun subword-mark (arg)
 194   "Do the same as `mark-word' but on subwords.
 195 See the command `subword-mode' for a description of subwords.
 196 Optional argument ARG is the same as for `mark-word'."
 197   ;; This code is almost copied from `mark-word' in GNU Emacs.
 198   (interactive "p")
 199   (cond ((and (eq last-command this-command) (mark t))
 200          (set-mark
 201           (save-excursion
 202             (goto-char (mark))
 203             (subword-forward arg)
 204             (point))))
 205         (t
 206          (push-mark
 207           (save-excursion
 208             (subword-forward arg)
 209             (point))
 210           nil t))))
 211
 212 (put 'subword-backward 'CUA 'move)
 213
 214 (defun subword-kill (arg)
 215   "Do the same as `kill-word' but on subwords.
 216 See the command `subword-mode' for a description of subwords.
 217 Optional argument ARG is the same as for `kill-word'."
 218   (interactive "p")
 219   (kill-region (point) (subword-forward arg)))
 220
 221 (defun subword-backward-kill (arg)
 222   "Do the same as `backward-kill-word' but on subwords.
 223 See the command `subword-mode' for a description of subwords.
 224 Optional argument ARG is the same as for `backward-kill-word'."
 225   (interactive "p")
 226   (subword-kill (- arg)))
 227
 228 (defun subword-transpose (arg)
 229   "Do the same as `transpose-words' but on subwords.
 230 See the command `subword-mode' for a description of subwords.
 231 Optional argument ARG is the same as for `transpose-words'."
 232   (interactive "*p")
 233   (transpose-subr 'subword-forward arg))
 234
 235 (defun subword-downcase (arg)
 236   "Do the same as `downcase-word' but on subwords.
 237 See the command `subword-mode' for a description of subwords.
 238 Optional argument ARG is the same as for `downcase-word'."
 239   (interactive "p")
 240   (let ((start (point)))
 241     (downcase-region (point) (subword-forward arg))
 242     (when (< arg 0)
 243       (goto-char start))))
 244
 245 (defun subword-upcase (arg)
 246   "Do the same as `upcase-word' but on subwords.
 247 See the command `subword-mode' for a description of subwords.
 248 Optional argument ARG is the same as for `upcase-word'."
 249   (interactive "p")
 250   (let ((start (point)))
 251     (upcase-region (point) (subword-forward arg))
 252     (when (< arg 0)
 253       (goto-char start))))
 254
 255 (defun subword-capitalize (arg)
 256   "Do the same as `capitalize-word' but on subwords.
 257 See the command `subword-mode' for a description of subwords.
 258 Optional argument ARG is the same as for `capitalize-word'."
 259   (interactive "p")
 260   (condition-case nil
 261       (let ((count (abs arg))
 262             (start (point))
 263             (advance (>= arg 0)))
 264
 265         (dotimes (i count)
 266           (if advance
 267               (progn
 268                 (re-search-forward "[[:alpha:]]")
 269                 (goto-char (match-beginning 0)))
 270             (subword-backward))
 271           (let* ((p (point))
 272                  (pp (1+ p))
 273                  (np (subword-forward)))
 274             (upcase-region p pp)
 275             (downcase-region pp np)
 276             (goto-char (if advance np p))))
 277         (unless advance
 278           (goto-char start)))
 279     (search-failed nil)))
 280
 281 \f
 282
 283 (defvar superword-mode-map subword-mode-map
 284   "Keymap used in `superword-mode' minor mode.")
 285
 286 ;;;###autoload
 287 (define-minor-mode superword-mode
 288   "Toggle superword movement and editing (Superword mode).
 289 With a prefix argument ARG, enable Superword mode if ARG is
 290 positive, and disable it otherwise.  If called from Lisp, enable
 291 the mode if ARG is omitted or nil.
 292
 293 Superword mode is a buffer-local minor mode.  Enabling it remaps
 294 word-based editing commands to superword-based commands that
 295 treat symbols as words, e.g. \"this_is_a_symbol\".
 296
 297 The superword oriented commands activated in this minor mode
 298 recognize symbols as superwords to move between superwords and to
 299 edit them as words.
 300
 301 \\{superword-mode-map}"
 302     :lighter " ²"
 303     (when superword-mode (subword-mode -1)))
 304
 305 ;;;###autoload
 306 (define-global-minor-mode global-superword-mode superword-mode
 307   (lambda () (superword-mode 1))
 308   :group 'convenience)
 309
 310 \f
 311 ;;
 312 ;; Internal functions
 313 ;;
 314 (defun subword-forward-internal ()
 315   (if superword-mode
 316       (forward-symbol 1)
 317     (if (and
 318          (save-excursion
 319            (let ((case-fold-search nil))
 320              (re-search-forward subword-forward-regexp nil t)))
 321          (> (match-end 0) (point)))
 322         (goto-char
 323          (cond
 324           ((and (< 1 (- (match-end 2) (match-beginning 2)))
 325                 ;; If we have an all-caps word with no following lower-case or
 326                 ;; non-word letter, don't leave the last char (bug#13758).
 327                 (not (and (null (match-beginning 3))
 328                           (eq (match-end 2) (match-end 1)))))
 329            (1- (match-end 2)))
 330           (t
 331            (match-end 0))))
 332       (forward-word 1))))
 333
 334 (defun subword-backward-internal ()
 335   (if superword-mode
 336       (forward-symbol -1)
 337     (if (save-excursion
 338           (let ((case-fold-search nil))
 339             (re-search-backward subword-backward-regexp nil t)))
 340         (goto-char
 341          (cond
 342           ((and (match-end 3)
 343                 (< 1 (- (match-end 3) (match-beginning 3)))
 344                 (not (eq (point) (match-end 3))))
 345            (1- (match-end 3)))
 346           (t
 347            (1+ (match-beginning 0)))))
 348       (backward-word 1))))
 349
 350 \f
 351
 352 (provide 'subword)
 353 (provide 'superword)
 354
 355 ;;; subword.el ends here