changeset 13213:68b3f6d9156f

(vip-leave-region-active): new function.

--- 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)