lisp/progmodes/subword.el

   1 ;;; subword.el --- Handling capitalized subwords in a nomenclature -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2004-2016 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 provides the `subword' minor mode, which merges the
  25 ;; old remap-based subword.el (derived from cc-mode code) and
  26 ;; cap-words.el, which takes advantage of core Emacs
  27 ;; word-motion-customization functionality.
  28
  29 ;; In spite of GNU Coding Standards, it is popular to name a symbol by
  30 ;; mixing uppercase and lowercase letters, e.g. "GtkWidget",
  31 ;; "EmacsFrameClass", "NSGraphicsContext", etc.  Here we call these
  32 ;; mixed case symbols `nomenclatures'.  Also, each capitalized (or
  33 ;; completely uppercase) part of a nomenclature is called a `subword'.
  34 ;; Here are some examples:
  35
  36 ;;  Nomenclature           Subwords
  37 ;;  ===========================================================
  38 ;;  GtkWindow          =>  "Gtk" and "Window"
  39 ;;  EmacsFrameClass    =>  "Emacs", "Frame" and "Class"
  40 ;;  NSGraphicsContext  =>  "NS", "Graphics" and "Context"
  41
  42 ;; The subword oriented commands defined in this package recognize
  43 ;; subwords in a nomenclature to move between them and to edit them as
  44 ;; words.  You also get a mode to treat symbols as words instead,
  45 ;; called `superword-mode' (the opposite of `subword-mode').
  46
  47 ;; To make the mode turn on automatically, put the following code in
  48 ;; your .emacs:
  49 ;;
  50 ;; (add-hook 'c-mode-common-hook 'subword-mode)
  51 ;;
  52
  53 ;; To make the mode turn `superword-mode' on automatically for
  54 ;; only some modes, put the following code in your .emacs:
  55 ;;
  56 ;; (add-hook 'c-mode-common-hook 'superword-mode)
  57 ;;
  58
  59 ;; Acknowledgment:
  60 ;; The regular expressions to detect subwords are mostly based on
  61 ;; the old `c-forward-into-nomenclature' originally contributed by
  62 ;; Terry_Glanfield dot Southern at rxuk dot xerox dot com.
  63
  64 ;; TODO: ispell-word.
  65
  66 ;;; Code:
  67
  68 (defvar subword-forward-function 'subword-forward-internal
  69   "Function to call for forward subword movement.")
  70
  71 (defvar subword-backward-function 'subword-backward-internal
  72   "Function to call for backward subword movement.")
  73
  74 (defvar subword-forward-regexp
  75   "\\W*\\(\\([[:upper:]]*\\(\\W\\)?\\)[[:lower:][:digit:]]*\\)"
  76   "Regexp used by `subword-forward-internal'.")
  77
  78 (defvar subword-backward-regexp
  79   "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)\\|\\W\\w+\\)"
  80   "Regexp used by `subword-backward-internal'.")
  81
  82 (defvar subword-mode-map
  83   ;; We originally remapped motion keys here, but now use Emacs core
  84   ;; hooks.  Leave this keymap around so that user additions to it
  85   ;; keep working.
  86   (make-sparse-keymap)
  87   "Keymap used in `subword-mode' minor mode.")
  88
  89 ;;;###autoload
  90 (define-obsolete-function-alias
  91   'capitalized-words-mode 'subword-mode "25.1")
  92
  93 ;;;###autoload
  94 (define-minor-mode subword-mode
  95   "Toggle subword movement and editing (Subword mode).
  96 With a prefix argument ARG, enable Subword mode if ARG is
  97 positive, and disable it otherwise.  If called from Lisp, enable
  98 the mode if ARG is omitted or nil.
  99
 100 Subword mode is a buffer-local minor mode.  Enabling it changes
 101 the definition of a word so that word-based commands stop inside
 102 symbols with mixed uppercase and lowercase letters,
 103 e.g. \"GtkWidget\", \"EmacsFrameClass\", \"NSGraphicsContext\".
 104
 105 Here we call these mixed case symbols `nomenclatures'.  Each
 106 capitalized (or completely uppercase) part of a nomenclature is
 107 called a `subword'.  Here are some examples:
 108
 109   Nomenclature           Subwords
 110   ===========================================================
 111   GtkWindow          =>  \"Gtk\" and \"Window\"
 112   EmacsFrameClass    =>  \"Emacs\", \"Frame\" and \"Class\"
 113   NSGraphicsContext  =>  \"NS\", \"Graphics\" and \"Context\"
 114
 115 This mode changes the definition of a word so that word commands
 116 treat nomenclature boundaries as word boundaries.
 117
 118 \\{subword-mode-map}"
 119     :lighter " ,"
 120     (when subword-mode (superword-mode -1))
 121     (subword-setup-buffer))
 122
 123 (define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2")
 124
 125 ;;;###autoload
 126 (define-global-minor-mode global-subword-mode subword-mode
 127   (lambda () (subword-mode 1))
 128   :group 'convenience)
 129
 130 ;; N.B. These commands aren't used unless explicitly invoked; they're
 131 ;; here for compatibility.  Today, subword-mode leaves motion commands
 132 ;; alone and uses `find-word-boundary-function-table' to change how
 133 ;; `forward-word' and other low-level commands detect word boundaries.
 134 ;; This way, all word-related activities, not just the images we
 135 ;; imagine here, get subword treatment.
 136
 137 (defun subword-forward (&optional arg)
 138   "Do the same as `forward-word' but on subwords.
 139 See the command `subword-mode' for a description of subwords.
 140 Optional argument ARG is the same as for `forward-word'."
 141   (interactive "^p")
 142   (unless arg (setq arg 1))
 143   (cond
 144    ((< 0 arg)
 145     (dotimes (_i arg (point))
 146       (funcall subword-forward-function)))
 147    ((> 0 arg)
 148     (dotimes (_i (- arg) (point))
 149       (funcall subword-backward-function)))
 150    (t
 151     (point))))
 152
 153 (put 'subword-forward 'CUA 'move)
 154
 155 (defun subword-backward (&optional arg)
 156   "Do the same as `backward-word' but on subwords.
 157 See the command `subword-mode' for a description of subwords.
 158 Optional argument ARG is the same as for `backward-word'."
 159   (interactive "^p")
 160   (subword-forward (- (or arg 1))))
 161
 162 (defun subword-right (&optional arg)
 163   "Do the same as `right-word' but on subwords."
 164   (interactive "^p")
 165   (if (eq (current-bidi-paragraph-direction) 'left-to-right)
 166       (subword-forward arg)
 167     (subword-backward arg)))
 168
 169 (defun subword-left (&optional arg)
 170   "Do the same as `left-word' but on subwords."
 171   (interactive "^p")
 172   (if (eq (current-bidi-paragraph-direction) 'left-to-right)
 173       (subword-backward arg)
 174     (subword-forward arg)))
 175
 176 (defun subword-mark (arg)
 177   "Do the same as `mark-word' but on subwords.
 178 See the command `subword-mode' for a description of subwords.
 179 Optional argument ARG is the same as for `mark-word'."
 180   ;; This code is almost copied from `mark-word' in GNU Emacs.
 181   (interactive "p")
 182   (cond ((and (eq last-command this-command) (mark t))
 183          (set-mark
 184           (save-excursion
 185             (goto-char (mark))
 186             (subword-forward arg)
 187             (point))))
 188         (t
 189          (push-mark
 190           (save-excursion
 191             (subword-forward arg)
 192             (point))
 193           nil t))))
 194
 195 (put 'subword-backward 'CUA 'move)
 196
 197 (defun subword-kill (arg)
 198   "Do the same as `kill-word' but on subwords.
 199 See the command `subword-mode' for a description of subwords.
 200 Optional argument ARG is the same as for `kill-word'."
 201   (interactive "p")
 202   (kill-region (point) (subword-forward arg)))
 203
 204 (defun subword-backward-kill (arg)
 205   "Do the same as `backward-kill-word' but on subwords.
 206 See the command `subword-mode' for a description of subwords.
 207 Optional argument ARG is the same as for `backward-kill-word'."
 208   (interactive "p")
 209   (subword-kill (- arg)))
 210
 211 (defun subword-transpose (arg)
 212   "Do the same as `transpose-words' but on subwords.
 213 See the command `subword-mode' for a description of subwords.
 214 Optional argument ARG is the same as for `transpose-words'."
 215   (interactive "*p")
 216   (transpose-subr 'subword-forward arg))
 217
 218 (defun subword-downcase (arg)
 219   "Do the same as `downcase-word' but on subwords.
 220 See the command `subword-mode' for a description of subwords.
 221 Optional argument ARG is the same as for `downcase-word'."
 222   (interactive "p")
 223   (let ((start (point)))
 224     (downcase-region (point) (subword-forward arg))
 225     (when (< arg 0)
 226       (goto-char start))))
 227
 228 (defun subword-upcase (arg)
 229   "Do the same as `upcase-word' but on subwords.
 230 See the command `subword-mode' for a description of subwords.
 231 Optional argument ARG is the same as for `upcase-word'."
 232   (interactive "p")
 233   (let ((start (point)))
 234     (upcase-region (point) (subword-forward arg))
 235     (when (< arg 0)
 236       (goto-char start))))
 237
 238 (defun subword-capitalize (arg)
 239   "Do the same as `capitalize-word' but on subwords.
 240 See the command `subword-mode' for a description of subwords.
 241 Optional argument ARG is the same as for `capitalize-word'."
 242   (interactive "p")
 243   (condition-case nil
 244       (let ((count (abs arg))
 245             (start (point))
 246             (advance (>= arg 0)))
 247
 248         (dotimes (_i count)
 249           (if advance
 250               (progn
 251                 (re-search-forward "[[:alpha:]]")
 252                 (goto-char (match-beginning 0)))
 253             (subword-backward))
 254           (let* ((p (point))
 255                  (pp (1+ p))
 256                  (np (subword-forward)))
 257             (upcase-region p pp)
 258             (downcase-region pp np)
 259             (goto-char (if advance np p))))
 260         (unless advance
 261           (goto-char start)))
 262     (search-failed nil)))
 263
 264 \f
 265
 266 (defvar superword-mode-map subword-mode-map
 267   "Keymap used in `superword-mode' minor mode.")
 268
 269 ;;;###autoload
 270 (define-minor-mode superword-mode
 271   "Toggle superword movement and editing (Superword mode).
 272 With a prefix argument ARG, enable Superword mode if ARG is
 273 positive, and disable it otherwise.  If called from Lisp, enable
 274 the mode if ARG is omitted or nil.
 275
 276 Superword mode is a buffer-local minor mode.  Enabling it changes
 277 the definition of words such that symbols characters are treated
 278 as parts of words: e.g., in `superword-mode',
 279 \"this_is_a_symbol\" counts as one word.
 280
 281 \\{superword-mode-map}"
 282     :lighter " ²"
 283     (when superword-mode (subword-mode -1))
 284     (subword-setup-buffer))
 285
 286 ;;;###autoload
 287 (define-global-minor-mode global-superword-mode superword-mode
 288   (lambda () (superword-mode 1))
 289   :group 'convenience)
 290
 291 \f
 292 ;;
 293 ;; Internal functions
 294 ;;
 295 (defun subword-forward-internal ()
 296   (if superword-mode
 297       (forward-symbol 1)
 298     (if (and
 299          (save-excursion
 300            (let ((case-fold-search nil))
 301              (re-search-forward subword-forward-regexp nil t)))
 302          (> (match-end 0) (point)))
 303         (goto-char
 304          (cond
 305           ((and (< 1 (- (match-end 2) (match-beginning 2)))
 306                 ;; If we have an all-caps word with no following lower-case or
 307                 ;; non-word letter, don't leave the last char (bug#13758).
 308                 (not (and (null (match-beginning 3))
 309                           (eq (match-end 2) (match-end 1)))))
 310            (1- (match-end 2)))
 311           (t
 312            (match-end 0))))
 313       (forward-word 1))))
 314
 315 (defun subword-backward-internal ()
 316   (if superword-mode
 317       (forward-symbol -1)
 318     (if (save-excursion
 319           (let ((case-fold-search nil))
 320             (re-search-backward subword-backward-regexp nil t)))
 321         (goto-char
 322          (cond
 323           ((and (match-end 3)
 324                 (< 1 (- (match-end 3) (match-beginning 3)))
 325                 (not (eq (point) (match-end 3))))
 326            (1- (match-end 3)))
 327           (t
 328            (1+ (match-beginning 0)))))
 329       (backward-word 1))))
 330
 331 (defconst subword-find-word-boundary-function-table
 332   (let ((tab (make-char-table nil)))
 333     (set-char-table-range tab t #'subword-find-word-boundary)
 334     tab)
 335   "Assigned to `find-word-boundary-function-table' in
 336 `subword-mode' and `superword-mode'; defers to
 337 `subword-find-word-boundary'.")
 338
 339 (defconst subword-empty-char-table
 340   (make-char-table nil)
 341   "Assigned to `find-word-boundary-function-table' while we're
 342 searching subwords in order to avoid unwanted reentrancy.")
 343
 344 (defun subword-setup-buffer ()
 345   (set (make-local-variable 'find-word-boundary-function-table)
 346        (if (or subword-mode superword-mode)
 347            subword-find-word-boundary-function-table
 348          subword-empty-char-table)))
 349
 350 (defun subword-find-word-boundary (pos limit)
 351   "Catch-all handler in `subword-find-word-boundary-function-table'."
 352   (let ((find-word-boundary-function-table subword-empty-char-table))
 353     (save-match-data
 354       (save-excursion
 355         (save-restriction
 356           (if (< pos limit)
 357               (progn
 358                 (goto-char pos)
 359                 (narrow-to-region (point-min) limit)
 360                 (funcall subword-forward-function))
 361             (goto-char (1+ pos))
 362             (narrow-to-region limit (point-max))
 363             (funcall subword-backward-function))
 364           (point))))))
 365
 366 \f
 367
 368 (provide 'subword)
 369 (provide 'superword)
 370 (provide 'cap-words) ; Obsolete alias
 371
 372 ;;; subword.el ends here