mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-17 10:06:13 +00:00
300 lines
10 KiB
EmacsLisp
300 lines
10 KiB
EmacsLisp
;;; cc-subword.el --- Handling capitalized subwords in a nomenclature
|
||
|
||
;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
|
||
|
||
;; Author: Masatake YAMATO
|
||
|
||
;; This program is free software; you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation; either version 2, or (at your option)
|
||
;; any later version.
|
||
|
||
;; This program is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with this program; see the file COPYING. If not, write to
|
||
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||
;; Boston, MA 02110-1301, USA.
|
||
|
||
;;; Commentary:
|
||
|
||
;; This package provides `subword' oriented commands and a minor mode
|
||
;; (`c-subword-mode') that substitutes the common word handling
|
||
;; functions with them.
|
||
|
||
;; In spite of GNU Coding Standards, it is popular to name a symbol by
|
||
;; mixing uppercase and lowercase letters, e.g. "GtkWidget",
|
||
;; "EmacsFrameClass", "NSGraphicsContext", etc. Here we call these
|
||
;; mixed case symbols `nomenclatures'. Also, each capitalized (or
|
||
;; completely uppercase) part of a nomenclature is called a `subword'.
|
||
;; Here are some examples:
|
||
|
||
;; Nomenclature Subwords
|
||
;; ===========================================================
|
||
;; GtkWindow => "Gtk" and "Window"
|
||
;; EmacsFrameClass => "Emacs", "Frame" and "Class"
|
||
;; NSGraphicsContext => "NS", "Graphics" and "Context"
|
||
|
||
;; 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' `c-forward-subword'
|
||
;; M-b `backward-word' `c-backward-subword'
|
||
;; M-@ `mark-word' `c-mark-subword'
|
||
;; M-d `kill-word' `c-kill-subword'
|
||
;; M-DEL `backward-kill-word' `c-backward-kill-subword'
|
||
;; M-t `transpose-words' `c-transpose-subwords'
|
||
;; M-c `capitalize-word' `c-capitalize-subword'
|
||
;; M-u `upcase-word' `c-upcase-subword'
|
||
;; M-l `downcase-word' `c-downcase-subword'
|
||
;;
|
||
;; 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.
|
||
|
||
;; To make the mode turn on automatically, put the following code in
|
||
;; your .emacs:
|
||
;;
|
||
;; (add-hook 'c-mode-common-hook
|
||
;; (lambda () (c-subword-mode 1)))
|
||
;;
|
||
|
||
;; Acknowledgment:
|
||
;; The regular expressions to detect subwords are mostly based on
|
||
;; the old `c-forward-into-nomenclature' originally contributed by
|
||
;; Terry_Glanfield dot Southern at rxuk dot xerox dot com.
|
||
|
||
;; TODO: ispell-word and subword oriented C-w in isearch.
|
||
|
||
;;; Code:
|
||
|
||
(eval-when-compile
|
||
(let ((load-path
|
||
(if (and (boundp 'byte-compile-dest-file)
|
||
(stringp byte-compile-dest-file))
|
||
(cons (file-name-directory byte-compile-dest-file) load-path)
|
||
load-path)))
|
||
(load "cc-bytecomp" nil t)))
|
||
|
||
(cc-require 'cc-defs)
|
||
(cc-require 'cc-cmds)
|
||
|
||
;; Don't complain about the `define-minor-mode' form if it isn't defined.
|
||
(cc-bytecomp-defvar c-subword-mode)
|
||
|
||
;; Autoload directives must be on the top level, so we construct an
|
||
;; autoload form instead.
|
||
;;;###autoload (autoload 'c-subword-mode "cc-subword" "Mode enabling subword movement and editing keys." t)
|
||
|
||
(if (not (fboundp 'define-minor-mode))
|
||
(defun c-subword-mode ()
|
||
"(Missing) mode enabling subword movement and editing keys.
|
||
This mode is not (yet) available in this version of (X)Emacs. Sorry! If
|
||
you really want it, please send a request to <bug-gnu-emacs@gnu.org>,
|
||
telling us which (X)Emacs version you're using."
|
||
(interactive)
|
||
(error
|
||
"c-subword-mode is not (yet) available in this version of (X)Emacs. Sorry!"))
|
||
|
||
(defvar c-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 "\\(.*-\\)\\(word.*\\)" name)
|
||
(intern (concat "c-"
|
||
(match-string 1 name)
|
||
"sub"
|
||
(match-string 2 name))))))
|
||
(if (fboundp 'command-remapping)
|
||
(define-key map (vector 'remap cmd) othercmd)
|
||
(substitute-key-definition cmd othercmd map global-map))))
|
||
map)
|
||
"Keymap used in command `c-subword-mode' minor mode.")
|
||
|
||
(define-minor-mode c-subword-mode
|
||
"Mode enabling subword movement and editing keys.
|
||
In spite of GNU Coding Standards, it is popular to name a symbol by
|
||
mixing uppercase and lowercase letters, e.g. \"GtkWidget\",
|
||
\"EmacsFrameClass\", \"NSGraphicsContext\", etc. Here we call these
|
||
mixed case symbols `nomenclatures'. Also, each capitalized (or
|
||
completely uppercase) part of a nomenclature is called a `subword'.
|
||
Here are some examples:
|
||
|
||
Nomenclature Subwords
|
||
===========================================================
|
||
GtkWindow => \"Gtk\" and \"Window\"
|
||
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.
|
||
|
||
\\{c-subword-mode-map}"
|
||
nil
|
||
nil
|
||
c-subword-mode-map
|
||
(c-update-modeline))
|
||
|
||
)
|
||
|
||
(defun c-forward-subword (&optional arg)
|
||
"Do the same as `forward-word' but on subwords.
|
||
See the command `c-subword-mode' for a description of subwords.
|
||
Optional argument ARG is the same as for `forward-word'."
|
||
(interactive "p")
|
||
(unless arg (setq arg 1))
|
||
(c-keep-region-active)
|
||
(cond
|
||
((< 0 arg)
|
||
(dotimes (i arg (point))
|
||
(c-forward-subword-internal)))
|
||
((> 0 arg)
|
||
(dotimes (i (- arg) (point))
|
||
(c-backward-subword-internal)))
|
||
(t
|
||
(point))))
|
||
|
||
(put 'c-forward-subword 'CUA 'move)
|
||
|
||
(defun c-backward-subword (&optional arg)
|
||
"Do the same as `backward-word' but on subwords.
|
||
See the command `c-subword-mode' for a description of subwords.
|
||
Optional argument ARG is the same as for `backward-word'."
|
||
(interactive "p")
|
||
(c-forward-subword (- (or arg 1))))
|
||
|
||
(defun c-mark-subword (arg)
|
||
"Do the same as `mark-word' but on subwords.
|
||
See the command `c-subword-mode' for a description of subwords.
|
||
Optional argument ARG is the same as for `mark-word'."
|
||
;; This code is almost copied from `mark-word' in GNU Emacs.
|
||
(interactive "p")
|
||
(cond ((and (eq last-command this-command) (mark t))
|
||
(set-mark
|
||
(save-excursion
|
||
(goto-char (mark))
|
||
(c-forward-subword arg)
|
||
(point))))
|
||
(t
|
||
(push-mark
|
||
(save-excursion
|
||
(c-forward-subword arg)
|
||
(point))
|
||
nil t))))
|
||
|
||
(put 'c-backward-subword 'CUA 'move)
|
||
|
||
(defun c-kill-subword (arg)
|
||
"Do the same as `kill-word' but on subwords.
|
||
See the command `c-subword-mode' for a description of subwords.
|
||
Optional argument ARG is the same as for `kill-word'."
|
||
(interactive "p")
|
||
(kill-region (point) (c-forward-subword arg)))
|
||
|
||
(defun c-backward-kill-subword (arg)
|
||
"Do the same as `backward-kill-word' but on subwords.
|
||
See the command `c-subword-mode' for a description of subwords.
|
||
Optional argument ARG is the same as for `backward-kill-word'."
|
||
(interactive "p")
|
||
(c-kill-subword (- arg)))
|
||
|
||
(defun c-transpose-subwords (arg)
|
||
"Do the same as `transpose-words' but on subwords.
|
||
See the command `c-subword-mode' for a description of subwords.
|
||
Optional argument ARG is the same as for `transpose-words'."
|
||
(interactive "*p")
|
||
(transpose-subr 'c-forward-subword arg))
|
||
|
||
(defun c-capitalize-subword (arg)
|
||
"Do the same as `capitalize-word' but on subwords.
|
||
See the command `c-subword-mode' for a description of subwords.
|
||
Optional argument ARG is the same as for `capitalize-word'."
|
||
(interactive "p")
|
||
(let ((count (abs arg))
|
||
(direction (if (< 0 arg) 1 -1)))
|
||
(dotimes (i count)
|
||
(when (re-search-forward
|
||
(concat "[" c-alpha "]")
|
||
nil t)
|
||
(goto-char (match-beginning 0)))
|
||
(let* ((p (point))
|
||
(pp (1+ p))
|
||
(np (c-forward-subword direction)))
|
||
(upcase-region p pp)
|
||
(downcase-region pp np)
|
||
(goto-char np)))))
|
||
|
||
(defun c-downcase-subword (arg)
|
||
"Do the same as `downcase-word' but on subwords.
|
||
See the command `c-subword-mode' for a description of subwords.
|
||
Optional argument ARG is the same as for `downcase-word'."
|
||
(interactive "p")
|
||
(downcase-region (point) (c-forward-subword arg)))
|
||
|
||
(defun c-upcase-subword (arg)
|
||
"Do the same as `upcase-word' but on subwords.
|
||
See the command `c-subword-mode' for a description of subwords.
|
||
Optional argument ARG is the same as for `upcase-word'."
|
||
(interactive "p")
|
||
(upcase-region (point) (c-forward-subword arg)))
|
||
|
||
|
||
;;
|
||
;; Internal functions
|
||
;;
|
||
(defun c-forward-subword-internal ()
|
||
(if (and
|
||
(save-excursion
|
||
(let ((case-fold-search nil))
|
||
(re-search-forward
|
||
(concat "\\W*\\(\\([" c-upper "]*\\W?\\)[" c-lower c-digit "]*\\)")
|
||
nil t)))
|
||
(> (match-end 0) (point))) ; So we don't get stuck at a
|
||
; "word-constituent" which isn't c-upper,
|
||
; c-lower or c-digit
|
||
(goto-char
|
||
(cond
|
||
((< 1 (- (match-end 2) (match-beginning 2)))
|
||
(1- (match-end 2)))
|
||
(t
|
||
(match-end 0))))
|
||
(forward-word 1)))
|
||
|
||
|
||
(defun c-backward-subword-internal ()
|
||
(if (save-excursion
|
||
(let ((case-fold-search nil))
|
||
(re-search-backward
|
||
(concat
|
||
"\\(\\(\\W\\|[" c-lower c-digit "]\\)\\([" c-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)))
|
||
|
||
|
||
(cc-provide 'cc-subword)
|
||
|
||
;; arch-tag: 2be9d294-7f30-4626-95e6-9964bb93c7a3
|
||
;;; cc-subword.el ends here
|