--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/viper/viper-util.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,1242 @@
+;;; viper-util.el --- Utilities used by viper.el
+
+;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;; Code
+
+(require 'ring)
+
+;; Compiler pacifier
+(defvar vip-overriding-map)
+(defvar pm-color-alist)
+(defvar zmacs-region-stays)
+(defvar vip-search-face)
+(defvar vip-minibuffer-current-face)
+(defvar vip-minibuffer-insert-face)
+(defvar vip-minibuffer-vi-face)
+(defvar vip-minibuffer-emacs-face)
+(defvar vip-replace-overlay-face)
+(defvar vip-minibuffer-overlay)
+(defvar vip-replace-overlay)
+(defvar vip-search-overlay)
+(defvar vip-replace-overlay-cursor-color)
+(defvar vip-intermediate-command)
+(defvar vip-use-replace-region-delimiters)
+(defvar vip-fast-keyseq-timeout)
+(defvar vip-related-files-and-buffers-ring)
+;; end compiler pacifier
+
+;; Is it XEmacs?
+(defconst vip-xemacs-p (string-match "\\(Lucid\\|XEmacs\\)" emacs-version))
+;; Is it Emacs?
+(defconst vip-emacs-p (not vip-xemacs-p))
+;; Tell whether we are running as a window application or on a TTY
+(defsubst vip-device-type ()
+  (if vip-emacs-p
+      window-system
+    (device-type (selected-device))))
+;; in XEmacs: device-type is tty on tty and stream in batch.
+(defun vip-window-display-p ()
+  (and (vip-device-type) (not (memq (vip-device-type) '(tty stream)))))
+
+(defvar vip-force-faces nil
+  "If t, Viper will think that it is running on a display that supports faces.
+This is provided as a temporary relief for users of face-capable displays
+that Viper doesn't know about.")
+
+(defun vip-has-face-support-p ()
+  (cond ((vip-window-display-p))
+	(vip-force-faces)
+	(vip-emacs-p (memq (vip-device-type) '(pc)))
+	(vip-xemacs-p (memq (vip-device-type) '(tty pc)))))
+
+
+;;; Macros
+
+(defmacro vip-deflocalvar (var default-value &optional documentation)
+  (` (progn
+       (defvar (, var) (, default-value)
+	       (, (format "%s\n\(buffer local\)" documentation)))
+       (make-variable-buffer-local '(, var))
+     )))
+
+(defmacro vip-loop (count body)
+  "(vip-loop COUNT BODY) Execute BODY COUNT times."
+  (list 'let (list (list 'count count))
+	(list 'while '(> count 0)
+	      body
+	      '(setq count (1- count))
+	      )))
+
+(defmacro vip-buffer-live-p (buf)
+  (` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf))))))
+  
+;; return buffer-specific macro definition, given a full macro definition
+(defmacro vip-kbd-buf-alist (macro-elt)
+  (` (nth 1 (, macro-elt))))
+;; get a pair: (curr-buffer . macro-definition)
+(defmacro vip-kbd-buf-pair (macro-elt)
+  (` (assoc (buffer-name) (vip-kbd-buf-alist (, macro-elt)))))
+;; get macro definition for current buffer
+(defmacro vip-kbd-buf-definition (macro-elt)
+  (` (cdr (vip-kbd-buf-pair (, macro-elt)))))
+  
+;; return mode-specific macro definitions, given a full macro definition
+(defmacro vip-kbd-mode-alist (macro-elt)
+  (` (nth 2 (, macro-elt))))
+;; get a pair: (major-mode . macro-definition)
+(defmacro vip-kbd-mode-pair (macro-elt)
+  (` (assoc major-mode (vip-kbd-mode-alist (, macro-elt)))))
+;; get macro definition for the current major mode
+(defmacro vip-kbd-mode-definition (macro-elt)
+  (` (cdr (vip-kbd-mode-pair (, macro-elt)))))
+  
+;; return global macro definition, given a full macro definition
+(defmacro vip-kbd-global-pair (macro-elt)
+  (` (nth 3 (, macro-elt))))
+;; get global macro definition from an elt of macro-alist
+(defmacro vip-kbd-global-definition (macro-elt)
+  (` (cdr (vip-kbd-global-pair (, macro-elt)))))
+  
+;; last elt of a sequence
+(defsubst vip-seq-last-elt (seq)
+  (elt seq (1- (length seq))))
+  
+;; Check if arg is a valid character for register
+;; TYPE is a list that can contain `letter', `Letter', and `digit'.
+;; Letter means lowercase letters, Letter means uppercase letters, and
+;; digit means digits from 1 to 9.
+;; If TYPE is nil, then down/uppercase letters and digits are allowed.
+(defun vip-valid-register (reg &optional type)
+  (or type (setq type '(letter Letter digit)))
+  (or (if (memq 'letter type)
+	  (and (<= ?a reg) (<= reg ?z)))
+      (if (memq 'digit type)
+	  (and (<= ?1 reg) (<= reg ?9)))
+      (if (memq 'Letter type)
+	  (and (<= ?A reg) (<= reg ?Z)))
+      ))
+      
+;; checks if object is a marker, has a buffer, and points to within that buffer
+(defun vip-valid-marker (marker)
+  (if (and (markerp marker) (marker-buffer marker))
+      (let ((buf (marker-buffer marker))
+	    (pos (marker-position marker)))
+	(save-excursion
+	  (set-buffer buf)
+	  (and (<= pos (point-max)) (<= (point-min) pos))))))
+  
+
+(defvar vip-minibuffer-overlay-priority 300)
+(defvar vip-replace-overlay-priority 400)
+(defvar vip-search-overlay-priority 500)
+  
+
+;;; XEmacs support
+
+(if vip-xemacs-p
+    (progn
+      (fset 'vip-read-event (symbol-function 'next-command-event))
+      (fset 'vip-make-overlay (symbol-function 'make-extent))
+      (fset 'vip-overlay-start (symbol-function 'extent-start-position))
+      (fset 'vip-overlay-end (symbol-function 'extent-end-position))
+      (fset 'vip-overlay-put (symbol-function 'set-extent-property))
+      (fset 'vip-overlay-p (symbol-function 'extentp))
+      (fset 'vip-overlay-get (symbol-function 'extent-property))
+      (fset 'vip-move-overlay (symbol-function 'set-extent-endpoints))
+      (if (vip-window-display-p)
+	  (fset 'vip-iconify (symbol-function 'iconify-frame)))
+      (cond ((vip-has-face-support-p)
+	     (fset 'vip-get-face (symbol-function 'get-face))
+	     (fset 'vip-color-defined-p
+		   (symbol-function 'valid-color-name-p))
+	     )))
+  (fset 'vip-read-event (symbol-function 'read-event))
+  (fset 'vip-make-overlay (symbol-function 'make-overlay))
+  (fset 'vip-overlay-start (symbol-function 'overlay-start))
+  (fset 'vip-overlay-end (symbol-function 'overlay-end))
+  (fset 'vip-overlay-put (symbol-function 'overlay-put))
+  (fset 'vip-overlay-p (symbol-function 'overlayp))
+  (fset 'vip-overlay-get (symbol-function 'overlay-get))
+  (fset 'vip-move-overlay (symbol-function 'move-overlay))
+  (if (vip-window-display-p)
+      (fset 'vip-iconify (symbol-function 'iconify-or-deiconify-frame)))
+  (cond ((vip-has-face-support-p)
+	 (fset 'vip-get-face (symbol-function 'internal-get-face))
+	 (fset 'vip-color-defined-p (symbol-function 'x-color-defined-p))
+	 )))
+
+(fset 'vip-characterp
+      (symbol-function
+       (if vip-xemacs-p 'characterp 'integerp)))
+
+(defsubst vip-color-display-p ()
+  (if vip-emacs-p
+      (x-display-color-p)
+    (eq (device-class (selected-device)) 'color)))
+   
+(defsubst vip-get-cursor-color ()
+  (cdr (assoc 'cursor-color (frame-parameters))))
+  
+;; OS/2
+(cond ((eq (vip-device-type) 'pm)
+       (fset 'vip-color-defined-p
+	     (function (lambda (color) (assoc color pm-color-alist))))))
+    
+;; needed to smooth out the difference between Emacs and XEmacs
+(defsubst vip-italicize-face (face)
+  (if vip-xemacs-p
+      (make-face-italic face)
+    (make-face-italic face nil 'noerror)))
+    
+;; test if display is color and the colors are defined
+(defsubst vip-can-use-colors (&rest colors)
+  (if (vip-color-display-p)
+      (not (memq nil (mapcar 'vip-color-defined-p colors)))
+    ))
+
+(defun vip-hide-face (face)
+  (if (and (vip-has-face-support-p) vip-emacs-p)
+      (add-to-list 'facemenu-unlisted-faces face)))
+
+;; cursor colors
+(defun vip-change-cursor-color (new-color)
+  (if (and (vip-window-display-p)  (vip-color-display-p)
+	   (stringp new-color) (vip-color-defined-p new-color)
+	   (not (string= new-color (vip-get-cursor-color))))
+      (modify-frame-parameters
+       (selected-frame) (list (cons 'cursor-color new-color)))))
+	 
+(defsubst vip-save-cursor-color ()
+  (if (and (vip-window-display-p) (vip-color-display-p))
+      (let ((color (vip-get-cursor-color)))
+	(if (and (stringp color) (vip-color-defined-p color)
+		 (not (string= color vip-replace-overlay-cursor-color)))
+	    (vip-overlay-put vip-replace-overlay 'vip-cursor-color color)))))
+	
+(defsubst vip-restore-cursor-color ()
+  (vip-change-cursor-color
+   (vip-overlay-get vip-replace-overlay 'vip-cursor-color)))
+	 
+
+;; Check the current version against the major and minor version numbers
+;; using op: cur-vers op major.minor If emacs-major-version or
+;; emacs-minor-version are not defined, we assume that the current version
+;; is hopelessly outdated.  We assume that emacs-major-version and
+;; emacs-minor-version are defined.  Otherwise, for Emacs/XEmacs 19, if the
+;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value
+;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be
+;; incorrect. However, this gives correct result in our cases, since we are
+;; testing for sufficiently high Emacs versions.
+(defun vip-check-version (op major minor &optional type-of-emacs)
+  (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version))
+      (and (cond ((eq type-of-emacs 'xemacs) vip-xemacs-p)
+		 ((eq type-of-emacs 'emacs) vip-emacs-p)
+		 (t t))
+	   (cond ((eq op '=) (and (= emacs-minor-version minor)
+				  (= emacs-major-version major)))
+		 ((memq op '(> >= < <=))
+		  (and (or (funcall op emacs-major-version major)
+			   (= emacs-major-version major))
+		       (if (= emacs-major-version major)
+			   (funcall op emacs-minor-version minor)
+			 t)))
+		 (t
+		  (error "%S: Invalid op in vip-check-version" op))))
+    (cond ((memq op '(= > >=)) nil)
+	  ((memq op '(< <=)) t))))
+	  
+;;;; warn if it is a wrong version of emacs
+;;(if (or (vip-check-version '< 19 29 'emacs)
+;;	(vip-check-version '< 19 12 'xemacs))
+;;    (progn
+;;      (with-output-to-temp-buffer " *vip-info*"
+;;	(switch-to-buffer " *vip-info*")
+;;	(insert
+;;	 (format "
+;;
+;;This version of Viper requires 
+;;
+;;\t Emacs 19.29 and higher
+;;\t OR
+;;\t XEmacs 19.12 and higher
+;;
+;;It is unlikely to work under Emacs version %s
+;;that you are using... " emacs-version))
+;;
+;;	(if noninteractive
+;;	    ()
+;;	  (beep 1)
+;;	  (beep 1)
+;;	  (insert "\n\nType any key to continue... ")
+;;	  (vip-read-event)))
+;;      (kill-buffer " *vip-info*")))
+  
+
+(defun vip-get-visible-buffer-window (wind)
+  (if vip-xemacs-p
+      (get-buffer-window wind t)
+    (get-buffer-window wind 'visible)))
+    
+    
+;; Return line position.
+;; If pos is 'start then returns position of line start.
+;; If pos is 'end, returns line end. If pos is 'mid, returns line center.
+;; Pos = 'indent returns beginning of indentation.
+;; Otherwise, returns point. Current point is not moved in any case."
+(defun vip-line-pos (pos)
+  (let ((cur-pos (point))
+        (result))
+    (cond
+     ((equal pos 'start)
+      (beginning-of-line))
+     ((equal pos 'end)
+      (end-of-line))
+     ((equal pos 'mid)
+      (goto-char (+ (vip-line-pos 'start) (vip-line-pos 'end) 2)))
+     ((equal pos 'indent)
+      (back-to-indentation))
+     (t   nil))
+    (setq result (point))
+    (goto-char cur-pos)
+    result))
+
+
+;; Like move-marker but creates a virgin marker if arg isn't already a marker.
+;; The first argument must eval to a variable name.
+;; Arguments: (var-name position &optional buffer).
+;; 
+;; This is useful for moving markers that are supposed to be local.
+;; For this, VAR-NAME should be made buffer-local with nil as a default.
+;; Then, each time this var is used in `vip-move-marker-locally' in a new
+;; buffer, a new marker will be created.
+(defun vip-move-marker-locally (var pos &optional buffer)
+  (if (markerp (eval var))
+      ()
+    (set var (make-marker)))
+  (move-marker (eval var) pos buffer))
+
+
+;; Print CONDITIONS as a message.
+(defun vip-message-conditions (conditions)
+  (let ((case (car conditions)) (msg (cdr conditions)))
+    (if (null msg)
+	(message "%s" case)
+      (message "%s: %s" case (mapconcat 'prin1-to-string msg " ")))
+    (beep 1)))
+
+
+
+;;; List/alist utilities
+	
+;; Convert LIST to an alist
+(defun vip-list-to-alist (lst)
+  (let ((alist))
+    (while lst
+      (setq alist (cons (list (car lst)) alist))
+      (setq lst (cdr lst)))
+    alist))	
+
+;; Convert ALIST to a list.
+(defun vip-alist-to-list (alst)
+  (let ((lst))
+    (while alst
+      (setq lst (cons (car (car alst)) lst))
+      (setq alst (cdr alst)))
+    lst))
+
+;; Filter ALIST using REGEXP. Return alist whose elements match the regexp.
+(defun vip-filter-alist (regexp alst)
+  (interactive "s x")
+  (let ((outalst) (inalst alst))
+    (while (car inalst)
+      (if (string-match regexp (car (car inalst)))
+	  (setq outalst (cons (car inalst) outalst)))
+      (setq inalst (cdr inalst)))
+    outalst))    
+       
+;; Filter LIST using REGEXP. Return list whose elements match the regexp.
+(defun vip-filter-list (regexp lst)
+  (interactive "s x")
+  (let ((outlst) (inlst lst))
+    (while (car inlst)
+      (if (string-match regexp (car inlst))
+	  (setq outlst (cons (car inlst) outlst)))
+      (setq inlst (cdr inlst)))
+    outlst))    
+
+   
+;; Append LIS2 to LIS1, both alists, by side-effect and returns LIS1
+;; LIS2 is modified by filtering it: deleting its members of the form
+;; \(car elt\) such that (car elt') is in LIS1.
+(defun vip-append-filter-alist (lis1 lis2)
+  (let ((temp lis1)
+	elt)
+  
+    ;;filter-append the second list
+    (while temp
+      ;; delete all occurrences
+      (while (setq elt (assoc (car (car temp)) lis2))
+	(setq lis2 (delq elt lis2)))
+      (setq temp (cdr temp)))
+    
+    (nconc lis1 lis2)))
+
+
+;;; Support for :e and file globbing
+
+(defun vip-ex-nontrivial-find-file-unix (filespec)
+  "Glob the file spec and visit all files matching the spec.
+This function is designed to work under Unix. It may also work under VMS.
+
+Users who prefer other types of shells should write their own version of this
+function and set the variable `ex-nontrivial-find-file-function'
+appropriately." 
+  (let ((gshell
+	 (cond (ex-unix-type-shell shell-file-name)
+	       ((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VAX VMS
+	       (t "sh"))) ; probably Unix anyway
+	(gshell-options
+	 ;; using cond in anticipation of further additions
+	 (cond (ex-unix-type-shell-options)
+	       ))
+	(command (cond (vip-ms-style-os-p (format "\"ls -1 %s\"" filespec))
+		       (t (format "ls -1 %s" filespec))))
+	file-list)
+    (save-excursion 
+      (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name)))
+      (erase-buffer)
+      (setq status
+	    (if gshell-options
+		(call-process gshell nil t nil
+			      gshell-options
+			      "-c"
+			      command)
+	      (call-process gshell nil t nil
+			    "-c"
+			    command)))
+      (goto-char (point-min))
+      ;; Issue an error, if no match.
+      (if (> status 0)
+	  (save-excursion
+	    (skip-chars-forward " \t\n\j")
+	    (if (looking-at "ls:")
+		(vip-forward-Word 1))
+	    (error "%s: %s"
+		   (if (stringp  gshell)
+		       gshell
+		     "shell")
+		   (buffer-substring (point) (vip-line-pos 'end)))
+	    ))
+      (goto-char (point-min))
+      (setq file-list (vip-get-filenames-from-buffer 'one-per-line)))
+
+    (mapcar 'find-file file-list)
+    ))
+
+(defun vip-ex-nontrivial-find-file-ms (filespec)
+  "Glob the file spec and visit all files matching the spec.
+This function is designed to work under MS type systems, such as NT, W95, and
+DOS. It may also work under OS/2.
+
+The users of Unix-type shells should be able to use
+`vip-ex-nontrivial-find-file-unix', making it into the value of the variable 
+`ex-nontrivial-find-file-function'. If this doesn't work, the user may have
+to write a custom function, similar to `vip-ex-nontrivial-find-file-unix'."
+  (save-excursion 
+    (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name)))
+    (erase-buffer)
+    (insert filespec)
+    (goto-char (point-min))
+    (mapcar 'find-file
+	    (vip-glob-ms-windows-files (vip-get-filenames-from-buffer)))
+    ))
+
+
+;; Interpret the stuff in the buffer as a list of file names
+;; return a list of file names listed in the buffer beginning at point
+;; If optional arg is supplied, assume each filename is listed on a separate
+;; line
+(defun vip-get-filenames-from-buffer (one-per-line)
+  (let ((skip-chars (if one-per-line "\t\n" " \t\n"))
+	 result fname delim)
+    (skip-chars-forward skip-chars)
+    (while (not (eobp))
+      (if (cond ((looking-at "\"")
+		 (setq delim ?\")
+		 (re-search-forward "[^\"]+" nil t)) ; noerror
+		((looking-at "'")
+		 (setq delim ?')
+		 (re-search-forward "[^']+" nil t)) ; noerror
+		(t 
+		 (re-search-forward
+		  (concat "[^" skip-chars "]+") nil t))) ;noerror
+	  (setq fname
+		(buffer-substring (match-beginning 0) (match-end 0))))
+      (if delim
+	  (forward-char 1))
+      (skip-chars-forward " \t\n")
+      (setq result (cons fname result)))
+    result))
+
+;; convert MS-DOS wildcards to regexp
+(defun vip-wildcard-to-regexp (wcard)
+  (save-excursion
+    (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name)))
+    (erase-buffer)
+    (insert wcard)
+    (goto-char (point-min))
+    (while (not (eobp))
+      (skip-chars-forward "^*?.\\\\")
+      (cond ((eq (char-after (point)) ?*) (insert ".")(forward-char 1))
+	    ((eq (char-after (point)) ?.) (insert "\\")(forward-char 1))
+	    ((eq (char-after (point)) ?\\) (insert "\\")(forward-char 1))
+	    ((eq (char-after (point)) ??) (delete-char 1)(insert ".")))
+      )
+    (buffer-string)
+    ))
+
+
+;; glob windows files
+;; LIST is expected to be in reverse order
+(defun vip-glob-ms-windows-files (list)
+  (let ((tmp list)
+	(case-fold-search t)
+	tmp2)
+    (while tmp
+      (setq tmp2 (cons (directory-files 
+			;; the directory part
+			(or (file-name-directory (car tmp))
+			    "")
+			t  ; return full names
+			;; the regexp part: globs the file names
+			(concat "^"
+				(vip-wildcard-to-regexp
+				 (file-name-nondirectory (car tmp)))
+				"$"))
+		       tmp2))
+      (setq tmp (cdr tmp)))
+    (reverse (apply 'append tmp2))))
+
+      
+
+
+
+;;; Insertion ring
+
+;; Rotate RING's index. DIRection can be positive or negative.
+(defun vip-ring-rotate1 (ring dir)
+  (if (and (ring-p ring) (> (ring-length ring) 0))
+      (progn
+	(setcar ring (cond ((> dir 0)
+			    (ring-plus1 (car ring) (ring-length ring)))
+			   ((< dir 0)
+			    (ring-minus1 (car ring) (ring-length ring)))
+			   ;; don't rotate if dir = 0
+			   (t (car ring))))
+	(vip-current-ring-item ring)
+	)))
+	
+(defun vip-special-ring-rotate1 (ring dir)
+  (if (memq vip-intermediate-command
+	    '(repeating-display-destructive-command
+	      repeating-insertion-from-ring))
+      (vip-ring-rotate1 ring dir)
+    ;; don't rotate otherwise
+    (vip-ring-rotate1 ring 0)))
+    
+;; current ring item; if N is given, then so many items back from the
+;; current
+(defun vip-current-ring-item (ring &optional n)
+  (setq n (or n 0))
+  (if (and (ring-p ring) (> (ring-length ring) 0))
+      (aref (cdr (cdr ring)) (mod (- (car ring) 1 n) (ring-length ring)))))
+    
+;; push item onto ring. the second argument is a ring-variable, not value.
+(defun vip-push-onto-ring (item ring-var)
+  (or (ring-p (eval ring-var))
+      (set ring-var (make-ring (eval (intern (format "%S-size" ring-var))))))
+  (or (null item) ; don't push nil
+      (and (stringp item) (string= item "")) ; or empty strings
+      (equal item (vip-current-ring-item (eval ring-var))) ; or old stuff
+      ;; Since vip-set-destructive-command checks if we are inside vip-repeat,
+      ;;    we don't check whether this-command-keys is a `.'.
+      ;;    The cmd vip-repeat makes a call to the current function only if
+      ;;    `.' is executing a command from the command history. It doesn't
+      ;;    call the push-onto-ring function if `.' is simply repeating the
+      ;;    last destructive command.
+      ;; We only check for ESC (which happens when we do insert with a
+      ;;    prefix argument, or if this-command-keys doesn't give anything
+      ;;    meaningful (in that case we don't know what to show to the user).
+      (and (eq ring-var 'vip-command-ring)
+	   (string-match "\\([0-9]*\e\\|^[ \t]*$\\|escape\\)"
+			 (vip-array-to-string (this-command-keys))))
+      (vip-ring-insert (eval ring-var) item))
+  )
+  
+
+;; removing elts from ring seems to break it
+(defun vip-cleanup-ring (ring)
+  (or (< (ring-length ring) 2)
+      (null (vip-current-ring-item ring))
+      ;; last and previous equal
+      (if (equal (vip-current-ring-item ring) (vip-current-ring-item ring 1))
+	  (vip-ring-pop ring))))
+	  
+;; ring-remove seems to be buggy, so we concocted this for our purposes.
+(defun vip-ring-pop (ring)
+  (let* ((ln (ring-length ring))
+	 (vec (cdr (cdr ring)))
+	 (veclen (length vec))
+	 (hd (car ring))
+	 (idx (max 0 (ring-minus1 hd ln)))
+	 (top-elt (aref vec idx)))
+	
+	;; shift elements
+	(while (< (1+ idx) veclen)
+	  (aset vec idx (aref vec (1+ idx)))
+	  (setq idx (1+ idx)))
+	(aset vec idx nil)
+	
+	(setq hd (max 0 (ring-minus1 hd ln)))
+	(if (= hd (1- ln)) (setq hd 0))
+	(setcar ring hd) ; move head
+	(setcar (cdr ring) (max 0 (1- ln))) ; adjust length
+	top-elt
+	))
+	
+(defun vip-ring-insert (ring item)
+  (let* ((ln (ring-length ring))
+	 (vec (cdr (cdr ring)))
+	 (veclen (length vec))
+	 (hd (car ring))
+	 (vecpos-after-hd (if (= hd 0) ln hd))
+	 (idx ln))
+	 
+    (if (= ln veclen)
+	(progn
+	  (aset vec hd item) ; hd is always 1+ the actual head index in vec
+	  (setcar ring (ring-plus1 hd ln)))
+      (setcar (cdr ring) (1+ ln))
+      (setcar ring (ring-plus1 vecpos-after-hd (1+ ln)))
+      (while (and (>= idx vecpos-after-hd) (> ln 0))
+	(aset vec idx (aref vec (1- idx)))
+	(setq idx (1- idx)))
+      (aset vec vecpos-after-hd item))
+    item))
+	
+
+;;; String utilities
+
+;; If STRING is longer than MAX-LEN, truncate it and print ...... instead
+;; PRE-STRING is a string to prepend to the abbrev string.
+;; POST-STRING is a string to append to the abbrev string.
+;; ABBREV_SIGN is a string to be inserted before POST-STRING
+;; if the orig string was truncated. 
+(defun vip-abbreviate-string (string max-len
+				     pre-string post-string abbrev-sign)
+  (let (truncated-str)
+    (setq truncated-str
+	  (if (stringp string) 
+	      (substring string 0 (min max-len (length string)))))
+    (cond ((null truncated-str) "")
+	  ((> (length string) max-len)
+	   (format "%s%s%s%s"
+		   pre-string truncated-str abbrev-sign post-string))
+	  (t (format "%s%s%s" pre-string truncated-str post-string)))))
+
+;; tells if we are over a whitespace-only line
+(defsubst vip-over-whitespace-line ()
+  (save-excursion
+    (beginning-of-line)
+    (looking-at "^[ \t]*$")))
+	  
+
+;;; Saving settings in custom file
+
+;; Save the current setting of VAR in CUSTOM-FILE.
+;; If given, MESSAGE is a message to be displayed after that.
+;; This message is erased after 2 secs, if erase-msg is non-nil.
+;; Arguments: var message custom-file &optional erase-message
+(defun vip-save-setting (var message custom-file &optional erase-msg)
+  (let* ((var-name (symbol-name var))
+	 (var-val (if (boundp var) (eval var)))
+	 (regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z---_']*[ \t\n)]" var-name))
+	 (buf (find-file-noselect (substitute-in-file-name custom-file)))
+	)
+    (message message)
+    (save-excursion
+      (set-buffer buf)
+      (goto-char (point-min))
+      (if (re-search-forward regexp nil t)
+	  (let ((reg-end (1- (match-end 0))))
+	    (search-backward var-name)
+	    (delete-region (match-beginning 0) reg-end)
+	    (goto-char (match-beginning 0))
+	    (insert (format "%s  '%S" var-name var-val)))
+	(goto-char (point-max))
+	(if (not (bolp)) (insert "\n"))
+	(insert (format "(setq %s '%S)\n" var-name var-val)))
+      (save-buffer))
+      (kill-buffer buf)
+      (if erase-msg
+	  (progn
+	    (sit-for 2)
+	    (message "")))
+      ))
+      
+;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that
+;; match this pattern.
+(defun vip-save-string-in-file (string custom-file &optional pattern)
+  (let ((buf (find-file-noselect (substitute-in-file-name custom-file))))
+    (save-excursion
+      (set-buffer buf)
+      (goto-char (point-min))
+      (if pattern (delete-matching-lines pattern))
+      (goto-char (point-max))
+      (if string (insert string))
+      (save-buffer))
+    (kill-buffer buf)
+    ))
+    
+
+;;; Overlays
+
+;; Search
+
+(defun vip-flash-search-pattern ()
+  (if (vip-overlay-p vip-search-overlay)
+      (vip-move-overlay vip-search-overlay (match-beginning 0) (match-end 0))
+    (setq vip-search-overlay
+	  (vip-make-overlay
+	   (match-beginning 0) (match-end 0) (current-buffer))))
+  
+  (vip-overlay-put vip-search-overlay 'priority vip-search-overlay-priority)
+  (if (vip-has-face-support-p)
+      (progn
+	(vip-overlay-put vip-search-overlay 'face vip-search-face)
+	(sit-for 2)
+	(vip-overlay-put vip-search-overlay 'face nil))))
+
+;; Replace state
+
+(defsubst vip-move-replace-overlay (beg end)
+  (vip-move-overlay vip-replace-overlay beg end))
+  
+(defun vip-set-replace-overlay (beg end)
+  (if (vip-overlay-p vip-replace-overlay)
+      (vip-move-replace-overlay beg end)
+    (setq vip-replace-overlay (vip-make-overlay beg end (current-buffer)))
+    ;; never detach
+    (vip-overlay-put
+     vip-replace-overlay (if vip-emacs-p 'evaporate 'detachable) nil)
+    (vip-overlay-put 
+     vip-replace-overlay 'priority vip-replace-overlay-priority)) 
+  (if (vip-has-face-support-p)
+      (vip-overlay-put vip-replace-overlay 'face vip-replace-overlay-face))
+  (vip-save-cursor-color)
+  (vip-change-cursor-color vip-replace-overlay-cursor-color)
+  )
+  
+      
+(defsubst vip-set-replace-overlay-glyphs (before-glyph after-glyph)
+  (if (or (not (vip-has-face-support-p))
+	  vip-use-replace-region-delimiters)
+      (let ((before-name (if vip-xemacs-p 'begin-glyph 'before-string))
+	    (after-name (if vip-xemacs-p 'end-glyph 'after-string)))
+	(vip-overlay-put vip-replace-overlay before-name before-glyph)
+	(vip-overlay-put vip-replace-overlay after-name after-glyph))))
+  
+(defsubst vip-hide-replace-overlay ()
+  (vip-set-replace-overlay-glyphs nil nil)
+  (vip-restore-cursor-color)
+  (if (vip-has-face-support-p)
+      (vip-overlay-put vip-replace-overlay 'face nil)))
+
+    
+(defsubst vip-replace-start ()
+  (vip-overlay-start vip-replace-overlay))
+(defsubst vip-replace-end ()
+  (vip-overlay-end vip-replace-overlay))
+ 
+
+;; Minibuffer
+
+(defun vip-set-minibuffer-overlay ()
+  (vip-check-minibuffer-overlay)
+  (if (vip-has-face-support-p)
+      (progn
+	(vip-overlay-put
+	 vip-minibuffer-overlay 'face vip-minibuffer-current-face)
+	(vip-overlay-put 
+	 vip-minibuffer-overlay 'priority vip-minibuffer-overlay-priority)
+	;; never detach
+	(vip-overlay-put
+	 vip-minibuffer-overlay (if vip-emacs-p 'evaporate 'detachable) nil)
+	;; make vip-minibuffer-overlay open-ended
+	;; In emacs, it is made open ended at creation time
+	(if vip-xemacs-p
+	    (progn
+	      (vip-overlay-put vip-minibuffer-overlay 'start-open nil)
+	      (vip-overlay-put vip-minibuffer-overlay 'end-open nil)))
+	)))
+       
+(defun vip-check-minibuffer-overlay ()
+  (or (vip-overlay-p vip-minibuffer-overlay)
+      (setq vip-minibuffer-overlay
+	    (if vip-xemacs-p
+		(vip-make-overlay 1 (1+ (buffer-size)) (current-buffer))
+	      ;; make overlay open-ended
+	      (vip-make-overlay
+	       1 (1+ (buffer-size)) (current-buffer) nil 'rear-advance)))
+      ))
+
+
+(defsubst vip-is-in-minibuffer ()
+  (string-match "\*Minibuf-" (buffer-name)))
+  
+
+
+;;; XEmacs compatibility
+
+(defun vip-abbreviate-file-name (file)
+  (if vip-emacs-p
+      (abbreviate-file-name file)
+    ;; XEmacs requires addl argument
+    (abbreviate-file-name file t)))
+    
+;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg 
+;; in sit-for, so this function smoothes out the differences.
+(defsubst vip-sit-for-short (val &optional nodisp)
+  (if vip-xemacs-p
+      (sit-for (/ val 1000.0) nodisp)
+    (sit-for 0 val nodisp)))
+
+;; EVENT may be a single event of a sequence of events
+(defsubst vip-ESC-event-p (event)
+  (let ((ESC-keys '(?\e (control \[) escape))
+	(key (vip-event-key event)))
+    (member key ESC-keys)))
+	
+  
+(defsubst vip-mark-marker ()
+  (if vip-xemacs-p
+      (mark-marker t)
+    (mark-marker)))
+
+;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring)
+;; is the same as (mark t).
+(defsubst vip-set-mark-if-necessary ()
+  (setq mark-ring (delete (vip-mark-marker) mark-ring))
+  (set-mark-command nil))
+       
+;; In transient mark mode (zmacs mode), it is annoying when regions become
+;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless
+;; the user explicitly wants highlighting, e.g., by hitting '' or ``
+(defun vip-deactivate-mark ()
+  (if vip-xemacs-p
+      (zmacs-deactivate-region)
+    (deactivate-mark)))
+
+(defsubst vip-leave-region-active ()
+  (if vip-xemacs-p
+      (setq zmacs-region-stays t)))
+
+    
+(defsubst vip-events-to-keys (events)
+  (cond (vip-xemacs-p (events-to-keys events))
+	(t events)))
+		  
+	
+(defun vip-eval-after-load (file form)
+  (if vip-emacs-p
+      (eval-after-load file form)
+    (or (assoc file after-load-alist)
+	(setq after-load-alist (cons (list file) after-load-alist)))
+    (let ((elt (assoc file after-load-alist)))
+      (or (member form (cdr elt))
+	  (setq elt (nconc elt (list form)))))
+    form
+    ))
+
+;; This is here because Emacs changed the way local hooks work.
+;;
+;;Add to the value of HOOK the function FUNCTION.
+;;FUNCTION is not added if already present.
+;;FUNCTION is added (if necessary) at the beginning of the hook list
+;;unless the optional argument APPEND is non-nil, in which case
+;;FUNCTION is added at the end.
+;;
+;;HOOK should be a symbol, and FUNCTION may be any valid function.  If
+;;HOOK is void, it is first set to nil.  If HOOK's value is a single
+;;function, it is changed to a list of functions."
+(defun vip-add-hook (hook function &optional append)
+  (if (not (boundp hook)) (set hook nil))
+  ;; If the hook value is a single function, turn it into a list.
+  (let ((old (symbol-value hook)))
+    (if (or (not (listp old)) (eq (car old) 'lambda))
+	(setq old (list old)))
+    (if (member function old)
+	nil
+      (set hook (if append
+		    (append old (list function)) ; don't nconc
+		  (cons function old))))))
+
+;; This is here because of Emacs's changes in the semantics of add/remove-hooks
+;; and due to the bugs they introduced.
+;;
+;; Remove from the value of HOOK the function FUNCTION.
+;; HOOK should be a symbol, and FUNCTION may be any valid function.  If
+;; FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
+;; list of hooks to run in HOOK, then nothing is done.  See `vip-add-hook'."
+(defun vip-remove-hook (hook function)
+  (if (or (not (boundp hook))		;unbound symbol, or
+	  (null (symbol-value hook))	;value is nil, or
+	  (null function))		;function is nil, then
+      nil				;Do nothing.
+    (let ((hook-value (symbol-value hook)))
+      (if (consp hook-value)
+	  ;; don't side-effect the list
+	  (setq hook-value (delete function (copy-sequence hook-value)))
+	(if (equal hook-value function)
+	    (setq hook-value nil)))
+      (set hook hook-value))))
+
+    
+    
+;; like read-event, but in XEmacs also try to convert to char, if possible
+(defun vip-read-event-convert-to-char ()
+  (let (event)
+    (if vip-emacs-p
+	(read-event)
+      (setq event (next-command-event))
+      (or (event-to-character event)
+	  event))
+    ))
+
+;; This function lets function-key-map convert key sequences into logical
+;; keys. This does a better job than vip-read-event when it comes to kbd
+;; macros, since it enables certain macros to be shared between X and TTY
+;; modes.
+(defun vip-read-key () 
+  (let ((overriding-local-map vip-overriding-map) 
+        key) 
+    (use-global-map vip-overriding-map) 
+    (setq key (elt (read-key-sequence nil) 0)) 
+    (use-global-map global-map) 
+    key)) 
+
+
+;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil)
+;; instead of nil, if '(nil) was previously inadvertently assigned to
+;; unread-command-events
+(defun vip-event-key (event)
+  (or (and event (eventp event))
+      (error "vip-event-key: Wrong type argument, eventp, %S" event))
+  (let ((mod (event-modifiers event))
+	basis)
+    (setq basis
+	  (cond
+	   (vip-xemacs-p
+	    (cond ((key-press-event-p event)
+		   (event-key event))
+		  ((button-event-p event)
+		   (concat "mouse-" (prin1-to-string (event-button event))))
+		  (t 
+		   (error "vip-event-key: Unknown event, %S" event))))
+	   (t 
+	    ;; Emacs doesn't handle capital letters correctly, since
+	    ;; \S-a isn't considered the same as A (it behaves as
+	    ;; plain `a' instead). So we take care of this here
+	    (cond ((and (vip-characterp event) (<= ?A event) (<= event ?Z))
+		   (setq mod nil
+			 event event))
+		  ;; Emacs has the oddity whereby characters 128+char
+		  ;; represent M-char *if* this appears inside a string.
+		  ;; So, we convert them manually to (meta char).
+		  ((and (vip-characterp event) (< ?\C-? event) (<= event 255))
+		   (setq mod '(meta)
+			 event (- event ?\C-? 1)))
+		  (t (event-basic-type event)))
+	    )))
+    (if (vip-characterp basis)
+	(setq basis
+	      (if (= basis ?\C-?)
+		  (list 'control '\?) ; taking care of an emacs bug
+		(intern (char-to-string basis)))))
+    (if mod
+	(append mod (list basis))
+      basis)))
+    
+(defun vip-key-to-emacs-key (key)
+  (let (key-name char-p modifiers mod-char-list base-key base-key-name)
+    (cond (vip-xemacs-p key)
+	  ((symbolp key)
+	   (setq key-name (symbol-name key))
+	   (if (= (length key-name) 1) ; character event
+	       (string-to-char key-name)
+	     key))
+	  ((listp key)
+	   (setq modifiers (subseq key 0 (1- (length key)))
+		 base-key (vip-seq-last-elt key)
+		 base-key-name (symbol-name base-key)
+		 char-p (= (length base-key-name) 1))
+	   (setq mod-char-list
+		 (mapcar
+		  '(lambda (elt) (upcase (substring (symbol-name elt) 0 1)))
+		  modifiers))
+	   (if char-p
+	       (setq key-name
+		     (car (read-from-string
+			   (concat
+			    "?\\"
+			    (mapconcat 'identity mod-char-list "-\\")
+			    "-"
+			    base-key-name))))
+	     (setq key-name
+		   (intern
+		    (concat
+		     (mapconcat 'identity mod-char-list "-")
+		     "-"
+		     base-key-name))))))
+    ))
+
+
+;; Args can be a sequence of events, a string, or a Viper macro.  Will try to
+;; convert events to keys and, if all keys are regular printable
+;; characters, will return a string. Otherwise, will return a string
+;; representing a vector of converted events. If the input was a Viper macro,
+;; will return a string that represents this macro as a vector.
+(defun vip-array-to-string (event-seq)
+  (let (temp temp2)
+    (cond ((stringp event-seq) event-seq)
+	  ((vip-event-vector-p event-seq)
+	    (setq temp (mapcar 'vip-event-key event-seq))
+	    (cond ((vip-char-symbol-sequence-p temp)
+		   (mapconcat 'symbol-name temp ""))
+		  ((and (vip-char-array-p
+			 (setq temp2 (mapcar 'vip-key-to-character temp))))
+		   (mapconcat 'char-to-string temp2 ""))
+		  (t (prin1-to-string (vconcat temp)))))
+	  ((vip-char-symbol-sequence-p event-seq)
+	   (mapconcat 'symbol-name event-seq ""))
+	  ((and (vectorp event-seq) 
+		(vip-char-array-p
+		 (setq temp (mapcar 'vip-key-to-character event-seq))))
+	   (mapconcat 'char-to-string temp ""))
+	  (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 ()
+  (not (vip-sit-for-short vip-fast-keyseq-timeout t)))
+    
+(defun vip-read-char-exclusive ()
+  (let (char
+	(echo-keystrokes 1))
+    (while (null char)
+      (condition-case nil
+	  (setq char (read-char))
+	(error
+	 ;; skip event if not char
+	 (vip-read-event))))
+    char))
+
+;; key is supposed to be in viper's representation, e.g., (control l), a
+;; character, etc.
+(defun vip-key-to-character (key)
+  (cond ((eq key 'space) ?\ )
+	((eq key 'delete) ?\C-?)
+	((eq key 'backspace) ?\C-h)
+	((and (symbolp key)
+	      (= 1 (length (symbol-name key))))
+	 (string-to-char (symbol-name key)))
+	((and (listp key)
+	      (eq (car key) 'control)
+	      (symbol-name (nth 1 key))
+	      (= 1 (length (symbol-name (nth 1 key)))))
+	 (read (format "?\\C-%s" (symbol-name (nth 1 key)))))
+	(t key)))
+    
+      
+(defun vip-setup-master-buffer (&rest other-files-or-buffers)
+  "Set up the current buffer as a master buffer.
+Arguments become related buffers. This function should normally be used in
+the `Local variables' section of a file."
+  (setq vip-related-files-and-buffers-ring 
+	(make-ring (1+ (length other-files-or-buffers))))
+  (mapcar '(lambda (elt)
+	     (vip-ring-insert vip-related-files-and-buffers-ring elt))
+	  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)
+
+;;;  viper-util.el ends here