# HG changeset patch # User Michael Kifer # Date 813637662 0 # Node ID 68b3f6d9156f0a444d6a8ba403b6307366a37f44 # Parent 73b3decace33c395f4810cfe28142ebc537720d4 (vip-leave-region-active): new function. diff -r 73b3decace33 -r 68b3f6d9156f lisp/emulation/viper-util.el --- a/lisp/emulation/viper-util.el Sat Oct 14 02:26:46 1995 +0000 +++ b/lisp/emulation/viper-util.el Sat Oct 14 02:27:42 1995 +0000 @@ -859,6 +859,14 @@ ((vip-char-symbol-sequence-p event-seq) (mapconcat 'symbol-name event-seq "")) (t (prin1-to-string event-seq))))) + +(defun vip-key-press-events-to-chars (events) + (mapconcat (if vip-emacs-p + 'char-to-string + (function + (lambda (elt) (char-to-string (event-to-character elt))))) + events + "")) (defsubst vip-fast-keysequence-p () @@ -888,6 +896,146 @@ other-files-or-buffers) (vip-ring-insert vip-related-files-and-buffers-ring (buffer-name)) ) + +;;; Movement utilities + +(defvar vip-syntax-preference 'strict-vi + "*Syntax type characterizing Viper's alphanumeric symbols. +`emacs' means only word constituents are considered to be alphanumeric. +Word constituents are symbols specified as word constituents by the current +syntax table. +`extended' means word and symbol constituents. +`reformed-vi' means Vi-ish behavior: word constituents and the symbol `_'. +However, word constituents are determined according to Emacs syntax tables, +which may be different from Vi in some major modes. +`strict-vi' means Viper words are exactly as in Vi.") + +(vip-deflocalvar vip-ALPHA-char-class "w" + "String of syntax classes characterizing Viper's alphanumeric symbols. +In addition, the symbol `_' may be considered alphanumeric if +`vip-syntax-preference'is `reformed-vi'.") + +(vip-deflocalvar vip-strict-ALPHA-chars "a-zA-Z0-9_" + "Regexp matching the set of alphanumeric characters acceptable to strict +Vi.") +(vip-deflocalvar vip-strict-SEP-chars " \t\n" + "Regexp matching the set of alphanumeric characters acceptable to strict +Vi.") + +(vip-deflocalvar vip-SEP-char-class " -" + "String of syntax classes for Vi separators. +Usually contains ` ', linefeed, TAB or formfeed.") + +(defun vip-update-alphanumeric-class () + "Set the syntactic class of Viper alphanumeric symbols according to +the variable `vip-ALPHA-char-class'. Should be called in order for changes to +`vip-ALPHA-char-class' to take effect." + (interactive) + (setq-default + vip-ALPHA-char-class + (cond ((eq vip-syntax-preference 'emacs) "w") ; only word constituents + ((eq vip-syntax-preference 'extended) "w_") ; word & symbol chars + (t "w")))) ; vi syntax: word constituents and the symbol `_' + +;; addl-chars are characters to be temporarily considered as alphanumerical +(defun vip-looking-at-alpha (&optional addl-chars) + (or (stringp addl-chars) (setq addl-chars "")) + (if (eq vip-syntax-preference 'reformed-vi) + (setq addl-chars (concat addl-chars "_"))) + (let ((char (char-after (point)))) + (if char + (if (eq vip-syntax-preference 'strict-vi) + (looking-at (concat "[" vip-strict-ALPHA-chars addl-chars "]")) + (or (memq char + ;; convert string to list + (append (vconcat addl-chars) nil)) + (memq (char-syntax char) + (append (vconcat vip-ALPHA-char-class) nil))))) + )) + +(defsubst vip-looking-at-separator () + (let ((char (char-after (point)))) + (if char + (or (eq char ?\n) ; RET is always a separator in Vi + (memq (char-syntax char) + (append (vconcat vip-SEP-char-class) nil)))))) + +(defsubst vip-looking-at-alphasep (&optional addl-chars) + (or (vip-looking-at-separator) (vip-looking-at-alpha addl-chars))) + +(defsubst vip-skip-alpha-forward (&optional addl-chars) + (or (stringp addl-chars) (setq addl-chars "")) + (vip-skip-syntax + 'forward + (cond ((eq vip-syntax-preference 'strict-vi) + "") + (t vip-ALPHA-char-class )) + (cond ((eq vip-syntax-preference 'strict-vi) + (concat vip-strict-ALPHA-chars addl-chars)) + (t addl-chars)))) + +(defsubst vip-skip-alpha-backward (&optional addl-chars) + (or (stringp addl-chars) (setq addl-chars "")) + (vip-skip-syntax + 'backward + (cond ((eq vip-syntax-preference 'strict-vi) + "") + (t vip-ALPHA-char-class )) + (cond ((eq vip-syntax-preference 'strict-vi) + (concat vip-strict-ALPHA-chars addl-chars)) + (t addl-chars)))) + +;; weird syntax tables may confuse strict-vi style +(defsubst vip-skip-all-separators-forward (&optional within-line) + (vip-skip-syntax 'forward + vip-SEP-char-class + (or within-line "\n") + (if within-line (vip-line-pos 'end)))) +(defsubst vip-skip-all-separators-backward (&optional within-line) + (vip-skip-syntax 'backward + vip-SEP-char-class + (or within-line "\n") + (if within-line (vip-line-pos 'start)))) +(defun vip-skip-nonseparators (direction) + (let ((func (intern (format "skip-syntax-%S" direction)))) + (funcall func (concat "^" vip-SEP-char-class) + (vip-line-pos (if (eq direction 'forward) 'end 'start))))) + +(defsubst vip-skip-nonalphasep-forward () + (if (eq vip-syntax-preference 'strict-vi) + (skip-chars-forward + (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars)) + (skip-syntax-forward + (concat + "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'end)))) +(defsubst vip-skip-nonalphasep-backward () + (if (eq vip-syntax-preference 'strict-vi) + (skip-chars-backward + (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars)) + (skip-syntax-backward + (concat + "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'start)))) + +;; Skip SYNTAX like skip-syntax-* and ADDL-CHARS like skip-chars-* +;; Return the number of chars traveled. +;; Either SYNTAX or ADDL-CHARS can be nil, in which case they are interpreted +;; as an empty string. +(defun vip-skip-syntax (direction syntax addl-chars &optional limit) + (let ((total 0) + (local 1) + (skip-chars-func (intern (format "skip-chars-%S" direction))) + (skip-syntax-func (intern (format "skip-syntax-%S" direction)))) + (or (stringp addl-chars) (setq addl-chars "")) + (or (stringp syntax) (setq syntax "")) + (while (and (not (= local 0)) (not (eobp))) + (setq local + (+ (funcall skip-syntax-func syntax limit) + (funcall skip-chars-func addl-chars limit))) + (setq total (+ total local))) + total + )) + + (provide 'viper-util)