-;;; subword.el --- Handling capitalized subwords in a nomenclature
+;;; subword.el --- Handling capitalized subwords in a nomenclature -*- lexical-binding: t -*-
-;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
;; Author: Masatake YAMATO
;;; Commentary:
-;; This package was cc-submode.el before it was recognized being
-;; useful in general and not tied to C and c-mode at all.
-
-;; This package provides `subword' oriented commands and a minor mode
-;; (`subword-mode') that substitutes the common word handling
-;; functions with them.
+;; This package provides the `subword' minor mode, which merges the
+;; old remap-based subword.el (derived from cc-mode code) and
+;; cap-words.el, which takes advantage of core Emacs
+;; word-motion-customization functionality.
;; In spite of GNU Coding Standards, it is popular to name a symbol by
;; mixing uppercase and lowercase letters, e.g. "GtkWidget",
;; The subword oriented commands defined in this package recognize
;; subwords in a nomenclature to move between them and to edit them as
-;; words.
-
-;; In the minor mode, all common key bindings for word oriented
-;; commands are overridden by the subword oriented commands:
-
-;; Key Word oriented command Subword oriented command
-;; ============================================================
-;; M-f `forward-word' `subword-forward'
-;; M-b `backward-word' `subword-backward'
-;; M-@ `mark-word' `subword-mark'
-;; M-d `kill-word' `subword-kill'
-;; M-DEL `backward-kill-word' `subword-backward-kill'
-;; M-t `transpose-words' `subword-transpose'
-;; M-c `capitalize-word' `subword-capitalize'
-;; M-u `upcase-word' `subword-upcase'
-;; M-l `downcase-word' `subword-downcase'
-;;
-;; Note: If you have changed the key bindings for the word oriented
-;; commands in your .emacs or a similar place, the keys you've changed
-;; to are also used for the corresponding subword oriented commands.
+;; words. You also get a mode to treat symbols as words instead,
+;; called `superword-mode' (the opposite of `subword-mode').
;; To make the mode turn on automatically, put the following code in
;; your .emacs:
;;
-;; (add-hook 'c-mode-common-hook
-;; (lambda () (subword-mode 1)))
+;; (add-hook 'c-mode-common-hook 'subword-mode)
+;;
+
+;; To make the mode turn `superword-mode' on automatically for
+;; only some modes, put the following code in your .emacs:
+;;
+;; (add-hook 'c-mode-common-hook 'superword-mode)
;;
;; Acknowledgment:
;;; Code:
+(defvar subword-forward-function 'subword-forward-internal
+ "Function to call for forward subword movement.")
+
+(defvar subword-backward-function 'subword-backward-internal
+ "Function to call for backward subword movement.")
+
+(defvar subword-forward-regexp
+ "\\W*\\(\\([[:upper:]]*\\(\\W\\)?\\)[[:lower:][:digit:]]*\\)"
+ "Regexp used by `subword-forward-internal'.")
+
+(defvar subword-backward-regexp
+ "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)\\|\\W\\w+\\)"
+ "Regexp used by `subword-backward-internal'.")
+
(defvar subword-mode-map
- (let ((map (make-sparse-keymap)))
- (dolist (cmd '(forward-word backward-word mark-word kill-word
- backward-kill-word transpose-words
- capitalize-word upcase-word downcase-word))
- (let ((othercmd (let ((name (symbol-name cmd)))
- (string-match "\\([[:alpha:]-]+\\)-word[s]?" name)
- (intern (concat "subword-" (match-string 1 name))))))
- (define-key map (vector 'remap cmd) othercmd)))
- map)
+ ;; We originally remapped motion keys here, but now use Emacs core
+ ;; hooks. Leave this keymap around so that user additions to it
+ ;; keep working.
+ (make-sparse-keymap)
"Keymap used in `subword-mode' minor mode.")
+;;;###autoload
+(define-obsolete-function-alias
+ 'capitalized-words-mode 'subword-mode "24.5")
+
;;;###autoload
(define-minor-mode subword-mode
"Toggle subword movement and editing (Subword mode).
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-Subword mode is a buffer-local minor mode. Enabling it remaps
-word-based editing commands to subword-based commands that handle
+Subword mode is a buffer-local minor mode. Enabling it changes
+the definition of a word so that word-based commands stop inside
symbols with mixed uppercase and lowercase letters,
e.g. \"GtkWidget\", \"EmacsFrameClass\", \"NSGraphicsContext\".
EmacsFrameClass => \"Emacs\", \"Frame\" and \"Class\"
NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\"
-The subword oriented commands activated in this minor mode recognize
-subwords in a nomenclature to move between subwords and to edit them
-as words.
+This mode changes the definition of a word so that word commands
+treat nomenclature boundaries as word bounaries.
\\{subword-mode-map}"
- nil
- nil
- subword-mode-map)
+ :lighter " ,"
+ (when subword-mode (superword-mode -1))
+ (subword-setup-buffer))
(define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2")
;;;###autoload
(define-global-minor-mode global-subword-mode subword-mode
- (lambda () (subword-mode 1)))
+ (lambda () (subword-mode 1))
+ :group 'convenience)
+
+;; N.B. These commands aren't used unless explicitly invoked; they're
+;; here for compatibility. Today, subword-mode leaves motion commands
+;; alone and uses `find-word-boundary-function-table' to change how
+;; `forward-word' and other low-level commands detect word bounaries.
+;; This way, all word-related activities, not just the images we
+;; imagine here, get subword treatment.
(defun subword-forward (&optional arg)
"Do the same as `forward-word' but on subwords.
See the command `subword-mode' for a description of subwords.
Optional argument ARG is the same as for `forward-word'."
- (interactive "p")
+ (interactive "^p")
(unless arg (setq arg 1))
(cond
((< 0 arg)
- (dotimes (i arg (point))
- (subword-forward-internal)))
+ (dotimes (_i arg (point))
+ (funcall subword-forward-function)))
((> 0 arg)
- (dotimes (i (- arg) (point))
- (subword-backward-internal)))
+ (dotimes (_i (- arg) (point))
+ (funcall subword-backward-function)))
(t
(point))))
"Do the same as `backward-word' but on subwords.
See the command `subword-mode' for a description of subwords.
Optional argument ARG is the same as for `backward-word'."
- (interactive "p")
+ (interactive "^p")
(subword-forward (- (or arg 1))))
+(defun subword-right (&optional arg)
+ "Do the same as `right-word' but on subwords."
+ (interactive "^p")
+ (if (eq (current-bidi-paragraph-direction) 'left-to-right)
+ (subword-forward arg)
+ (subword-backward arg)))
+
+(defun subword-left (&optional arg)
+ "Do the same as `left-word' but on subwords."
+ (interactive "^p")
+ (if (eq (current-bidi-paragraph-direction) 'left-to-right)
+ (subword-backward arg)
+ (subword-forward arg)))
+
(defun subword-mark (arg)
"Do the same as `mark-word' but on subwords.
See the command `subword-mode' for a description of subwords.
See the command `subword-mode' for a description of subwords.
Optional argument ARG is the same as for `capitalize-word'."
(interactive "p")
- (let ((count (abs arg))
- (start (point))
- (advance (if (< arg 0) nil t)))
- (dotimes (i count)
- (if advance
- (progn (re-search-forward
- (concat "[[:alpha:]]")
- nil t)
- (goto-char (match-beginning 0)))
- (subword-backward))
- (let* ((p (point))
- (pp (1+ p))
- (np (subword-forward)))
- (upcase-region p pp)
- (downcase-region pp np)
- (goto-char (if advance np p))))
- (unless advance
- (goto-char start))))
+ (condition-case nil
+ (let ((count (abs arg))
+ (start (point))
+ (advance (>= arg 0)))
+
+ (dotimes (_i count)
+ (if advance
+ (progn
+ (re-search-forward "[[:alpha:]]")
+ (goto-char (match-beginning 0)))
+ (subword-backward))
+ (let* ((p (point))
+ (pp (1+ p))
+ (np (subword-forward)))
+ (upcase-region p pp)
+ (downcase-region pp np)
+ (goto-char (if advance np p))))
+ (unless advance
+ (goto-char start)))
+ (search-failed nil)))
+
+\f
+
+(defvar superword-mode-map subword-mode-map
+ "Keymap used in `superword-mode' minor mode.")
+
+;;;###autoload
+(define-minor-mode superword-mode
+ "Toggle superword movement and editing (Superword mode).
+With a prefix argument ARG, enable Superword mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+Superword mode is a buffer-local minor mode. Enabling it changes
+the definition of words such that symbols characters are treated
+as parts of words: e.g., in `superword-mode',
+\"this_is_a_symbol\" counts as one word.
+
+\\{superword-mode-map}"
+ :lighter " ²"
+ (when superword-mode (subword-mode -1))
+ (subword-setup-buffer))
+
+;;;###autoload
+(define-global-minor-mode global-superword-mode superword-mode
+ (lambda () (superword-mode 1))
+ :group 'convenience)
\f
;;
;; Internal functions
;;
(defun subword-forward-internal ()
- (if (and
- (save-excursion
- (let ((case-fold-search nil))
- (re-search-forward
- (concat "\\W*\\(\\([[:upper:]]*\\W?\\)[[:lower:][:digit:]]*\\)")
- nil t)))
- (> (match-end 0) (point)))
- (goto-char
- (cond
- ((< 1 (- (match-end 2) (match-beginning 2)))
- (1- (match-end 2)))
- (t
- (match-end 0))))
- (forward-word 1)))
-
+ (if superword-mode
+ (forward-symbol 1)
+ (if (and
+ (save-excursion
+ (let ((case-fold-search nil))
+ (re-search-forward subword-forward-regexp nil t)))
+ (> (match-end 0) (point)))
+ (goto-char
+ (cond
+ ((and (< 1 (- (match-end 2) (match-beginning 2)))
+ ;; If we have an all-caps word with no following lower-case or
+ ;; non-word letter, don't leave the last char (bug#13758).
+ (not (and (null (match-beginning 3))
+ (eq (match-end 2) (match-end 1)))))
+ (1- (match-end 2)))
+ (t
+ (match-end 0))))
+ (forward-word 1))))
(defun subword-backward-internal ()
- (if (save-excursion
- (let ((case-fold-search nil))
- (re-search-backward
- (concat
- "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)"
- "\\|\\W\\w+\\)")
- nil t)))
- (goto-char
- (cond
- ((and (match-end 3)
- (< 1 (- (match-end 3) (match-beginning 3)))
- (not (eq (point) (match-end 3))))
- (1- (match-end 3)))
- (t
- (1+ (match-beginning 0)))))
- (backward-word 1)))
+ (if superword-mode
+ (forward-symbol -1)
+ (if (save-excursion
+ (let ((case-fold-search nil))
+ (re-search-backward subword-backward-regexp nil t)))
+ (goto-char
+ (cond
+ ((and (match-end 3)
+ (< 1 (- (match-end 3) (match-beginning 3)))
+ (not (eq (point) (match-end 3))))
+ (1- (match-end 3)))
+ (t
+ (1+ (match-beginning 0)))))
+ (backward-word 1))))
+
+(defconst subword-find-word-boundary-function-table
+ (let ((tab (make-char-table nil)))
+ (set-char-table-range tab t #'subword-find-word-boundary)
+ tab)
+ "Assigned to `find-word-boundary-function-table' in
+`subword-mode' and `superword-mode'; defers to
+`subword-find-word-bounary'.")
+
+(defconst subword-empty-char-table
+ (make-char-table nil)
+ "Assigned to `find-word-boundary-function-table' while we're
+searching subwords in order to avoid unwanted reentrancy.")
+
+(defun subword-setup-buffer ()
+ (set (make-local-variable 'find-word-boundary-function-table)
+ (if (or subword-mode superword-mode)
+ subword-find-word-boundary-function-table
+ subword-empty-char-table)))
+
+(defun subword-find-word-boundary (pos limit)
+ "Catch-all handler in `subword-find-word-boundary-function-table'."
+ (let ((find-word-boundary-function-table subword-empty-char-table))
+ (save-match-data
+ (save-excursion
+ (save-restriction
+ (if (< pos limit)
+ (progn
+ (goto-char pos)
+ (narrow-to-region (point-min) limit)
+ (funcall subword-forward-function))
+ (goto-char (1+ pos))
+ (narrow-to-region limit (point-max))
+ (funcall subword-backward-function))
+ (point))))))
\f
+
(provide 'subword)
+(provide 'superword)
+(provide 'cap-words) ; Obsolete alias
;;; subword.el ends here
HCoop / bpt / emacs.git / blobdiff