comparison lisp/emulation/viper-util.el @ 49598:0d8b17d428b5

Trailing whitepace deleted.

49597:e88404e8f2cf

(defsubst viper-color-display-p ()
  (viper-cond-compile-for-xemacs-or-emacs
   (eq (device-class (selected-device)) 'color) ; xemacs
   (x-display-color-p)  ; emacs
   ))
   
(defsubst viper-get-cursor-color ()
  (viper-cond-compile-for-xemacs-or-emacs
   ;; xemacs
   (color-instance-name (frame-property (selected-frame) 'cursor-color))
   (cdr (assoc 'cursor-color (frame-parameters))) ; emacs
   ))
  

;; OS/2
(cond ((eq (viper-device-type) 'pm)
       (fset 'viper-color-defined-p
	     (lambda (color) (assoc color pm-color-alist)))))
    

;; cursor colors
(defun viper-change-cursor-color (new-color)
  (if (and (viper-window-display-p)  (viper-color-display-p)
	   (stringp new-color) (viper-color-defined-p new-color)

	(selected-frame) 'cursor-color (make-color-instance new-color))
       (modify-frame-parameters
	(selected-frame) (list (cons 'cursor-color new-color)))
       )
    ))
	 
;; By default, saves current frame cursor color in the
;; viper-saved-cursor-color-in-replace-mode property of viper-replace-overlay
(defun viper-save-cursor-color (before-which-mode)
  (if (and (viper-window-display-p) (viper-color-display-p))
      (let ((color (viper-get-cursor-color)))

	       (if (eq before-which-mode 'before-replace-mode)
		   'viper-saved-cursor-color-in-replace-mode
		 'viper-saved-cursor-color-in-insert-mode)
	       color)))
	  ))))
	

(defsubst viper-get-saved-cursor-color-in-replace-mode ()
  (or
   (funcall
    (if viper-emacs-p 'frame-parameter 'frame-property)

   (funcall
    (if viper-emacs-p 'frame-parameter 'frame-property)
    (selected-frame)
    'viper-saved-cursor-color-in-insert-mode)
   viper-vi-state-cursor-color))
	 
;; restore cursor color from replace overlay
(defun viper-restore-cursor-color(after-which-mode)
  (if (viper-overlay-p viper-replace-overlay)
      (viper-change-cursor-color
       (if (eq after-which-mode 'after-replace-mode)
	   (viper-get-saved-cursor-color-in-replace-mode)
	 (viper-get-saved-cursor-color-in-insert-mode))
       )))
   

;; 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

			 t)))
		 (t
		  (error "%S: Invalid op in viper-check-version" op))))
    (cond ((memq op '(= > >=)) nil)
	  ((memq op '(< <=)) t))))
	  

(defun viper-get-visible-buffer-window (wind)
  (if viper-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."

;; 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 `viper-move-marker-locally' in a new
;; buffer, a new marker will be created.
(defun viper-move-marker-locally (var pos &optional buffer)

    (beep 1)))



;;; List/alist utilities
	
;; Convert LIST to an alist
(defun viper-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 viper-alist-to-list (alst)
  (let ((lst))
    (while alst

  (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 viper-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 viper-append-filter-alist (lis1 lis2)
  (let ((temp lis1)

    (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, :r, :w file globbing

	 (cond (ex-unix-type-shell-options)
	       ))
	(command (cond (viper-ms-style-os-p (format "\"ls -1 -d %s\"" filespec))
		       (t (format "ls -1 -d %s" filespec))))
	status)
    (save-excursion 
      (set-buffer (get-buffer-create viper-ex-tmp-buf-name))
      (erase-buffer)
      (setq status
	    (if gshell-options
		(call-process gshell nil t nil

		 (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

;; glob windows files
;; LIST is expected to be in reverse order
(defun viper-glob-mswindows-files (filespec)
  (let ((case-fold-search t)
	tmp tmp2)
    (save-excursion 
      (set-buffer (get-buffer-create viper-ex-tmp-buf-name))
      (erase-buffer)
      (insert filespec)
      (goto-char (point-min))
      (setq tmp (viper-get-filenames-from-buffer))
      (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

			    (ring-minus1 (car ring) (ring-length ring)))
			   ;; don't rotate if dir = 0
			   (t (car ring))))
	(viper-current-ring-item ring)
	)))
	
(defun viper-special-ring-rotate1 (ring dir)
  (if (memq viper-intermediate-command
	    '(repeating-display-destructive-command
	      repeating-insertion-from-ring))
      (viper-ring-rotate1 ring dir)
    ;; don't rotate otherwise
    (viper-ring-rotate1 ring 0)))
    
;; current ring item; if N is given, then so many items back from the
;; current
(defun viper-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 viper-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 (eq ring-var 'viper-command-ring)
	   (string-match "\\([0-9]*\e\\|^[ \t]*$\\|escape\\)"
			 (viper-array-to-string (this-command-keys))))
      (viper-ring-insert (eval ring-var) item))
  )
  

;; removing elts from ring seems to break it
(defun viper-cleanup-ring (ring)
  (or (< (ring-length ring) 2)
      (null (viper-current-ring-item ring))
      ;; last and previous equal
      (if (equal (viper-current-ring-item ring)
		 (viper-current-ring-item ring 1))
	  (viper-ring-pop ring))))
	  
;; ring-remove seems to be buggy, so we concocted this for our purposes.
(defun viper-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 viper-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))

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

;; tells if we are over a whitespace-only line
(defsubst viper-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.

      (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 viper-save-string-in-file (string custom-file &optional pattern)
  (let ((buf (find-file-noselect (substitute-in-file-name custom-file))))
    (save-excursion

		 ((fboundp 'file-remote-p) (file-remote-p file-name))
		 (t (require 'ange-ftp)
		    ;; Can happen only in Emacs, since XEmacs has file-remote-p
		    (ange-ftp-ftp-name file-name))))))

    

;; This is a simple-minded check for whether a file is under version control.
;; If file,v exists but file doesn't, this file is considered to be not checked
;; in and not checked out for the purpose of patching (since patch won't be
;; able to read such a file anyway).

	      (format
	       "File %s is checked in.  Check it out? "
	       (viper-abbreviate-file-name file))))
	(with-current-buffer buf
	  (command-execute checkout-function)))))
	 

    

;;; Overlays
(defun viper-put-on-search-overlay (beg end)
  (if (viper-overlay-p viper-search-overlay)
      (viper-move-overlay viper-search-overlay beg end)

;; Replace state

(defsubst viper-move-replace-overlay (beg end)
  (viper-move-overlay viper-replace-overlay beg end))
  
(defun viper-set-replace-overlay (beg end)
  (if (viper-overlay-live-p viper-replace-overlay)
      (viper-move-replace-overlay beg end)
    (setq viper-replace-overlay (viper-make-overlay beg end (current-buffer)))
    ;; never detach
    (viper-overlay-put
     viper-replace-overlay (if viper-emacs-p 'evaporate 'detachable) nil)
    (viper-overlay-put 
     viper-replace-overlay 'priority viper-replace-overlay-priority)
    ;; If Emacs will start supporting overlay maps, as it currently supports
    ;; text-property maps, we could do away with viper-replace-minor-mode and
    ;; just have keymap attached to replace overlay.
    ;;(viper-overlay-put
    ;; viper-replace-overlay
    ;; (if viper-xemacs-p 'keymap 'local-map)
    ;; viper-replace-map)
    ) 
  (if (viper-has-face-support-p)
      (viper-overlay-put
       viper-replace-overlay 'face viper-replace-overlay-face))
  (viper-save-cursor-color 'before-replace-mode)
  (viper-change-cursor-color viper-replace-overlay-cursor-color)
  )
  
      
(defun viper-set-replace-overlay-glyphs (before-glyph after-glyph)
  (or (viper-overlay-live-p viper-replace-overlay)
      (viper-set-replace-overlay (point-min) (point-min)))
  (if (or (not (viper-has-face-support-p))
	  viper-use-replace-region-delimiters)
      (let ((before-name (if viper-xemacs-p 'begin-glyph 'before-string))
	    (after-name (if viper-xemacs-p 'end-glyph 'after-string)))
	(viper-overlay-put viper-replace-overlay before-name before-glyph)
	(viper-overlay-put viper-replace-overlay after-name after-glyph))))
  
(defun viper-hide-replace-overlay ()
  (viper-set-replace-overlay-glyphs nil nil)
  (viper-restore-cursor-color 'after-replace-mode)
  (viper-restore-cursor-color 'after-insert-mode)
  (if (viper-has-face-support-p)
      (viper-overlay-put viper-replace-overlay 'face nil)))

    
(defsubst viper-replace-start ()
  (viper-overlay-start viper-replace-overlay))
(defsubst viper-replace-end ()
  (viper-overlay-end viper-replace-overlay))
 

;; Minibuffer

(defun viper-set-minibuffer-overlay ()
  (viper-check-minibuffer-overlay)
  (if (viper-has-face-support-p)
      (progn
	(viper-overlay-put
	 viper-minibuffer-overlay 'face viper-minibuffer-current-face)
	(viper-overlay-put 
	 viper-minibuffer-overlay 'priority viper-minibuffer-overlay-priority)
	;; never detach
	(viper-overlay-put
	 viper-minibuffer-overlay
	 (if viper-emacs-p 'evaporate 'detachable)

	(if viper-xemacs-p
	    (progn
	      (viper-overlay-put viper-minibuffer-overlay 'start-open nil)
	      (viper-overlay-put viper-minibuffer-overlay 'end-open nil)))
	)))
       
(defun viper-check-minibuffer-overlay ()
  (if (viper-overlay-live-p viper-minibuffer-overlay)
      (viper-move-overlay
       viper-minibuffer-overlay
       (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)

(defsubst viper-is-in-minibuffer ()
  (save-match-data
    (string-match "\*Minibuf-" (buffer-name))))
  


;;; XEmacs compatibility

(defun viper-abbreviate-file-name (file)

   ;; XEmacs requires addl argument
   (abbreviate-file-name file t)
   ;; emacs
   (abbreviate-file-name file)
   ))
    
;; Sit for VAL milliseconds.  XEmacs doesn't support the millisecond arg 
;; in sit-for, so this function smoothes out the differences.
(defsubst viper-sit-for-short (val &optional nodisp)
  (if viper-xemacs-p
      (sit-for (/ val 1000.0) nodisp)
    (sit-for 0 val nodisp)))

      (let ((buf (marker-buffer marker))
	    (pos (marker-position marker)))
	(save-excursion
	  (set-buffer buf)
	  (and (<= pos (point-max)) (<= (point-min) pos))))))
  
(defsubst viper-mark-marker ()
  (viper-cond-compile-for-xemacs-or-emacs
   (mark-marker t) ; xemacs
   (mark-marker) ; emacs
   ))

;; is the same as (mark t).
(defsubst viper-set-mark-if-necessary ()
  (setq mark-ring (delete (viper-mark-marker) mark-ring))
  (set-mark-command nil)
  (setq viper-saved-mark (point)))
       
;; 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 viper-deactivate-mark ()
  (viper-cond-compile-for-xemacs-or-emacs

	  (and (<= ?1 reg) (<= reg ?9)))
      (if (memq 'Letter type)
	  (and (<= ?A reg) (<= reg ?Z)))
      ))

    
    
;; it is suggested that an event must be copied before it is assigned to
;; last-command-event in XEmacs
(defun viper-copy-event (event)
  (viper-cond-compile-for-xemacs-or-emacs
   (copy-event event) ; xemacs
   event ; emacs
   ))
    
;; Uses different timeouts for ESC-sequences and others
(defsubst viper-fast-keysequence-p ()
  (not (viper-sit-for-short 
	(if (viper-ESC-event-p last-input-event)
	    viper-ESC-keyseq-timeout
	  viper-fast-keyseq-timeout)
	t)))
    
;; like read-event, but in XEmacs also try to convert to char, if possible
(defun viper-read-event-convert-to-char ()
  (let (event)
    (viper-cond-compile-for-xemacs-or-emacs
     (progn

		    (viper-insert-local-user-minor-mode  nil))
		;; Note: set unread-command-events only after testing for fast
		;; keysequence. Otherwise, viper-fast-keysequence-p will be
		;; always t -- whether there is anything after ESC or not
		(viper-set-unread-command-events keyseq)
		(setq keyseq (read-key-sequence nil))) 
	    (viper-set-unread-command-events keyseq)
	    (setq keyseq (read-key-sequence nil)))))
    keyseq))


;; This function lets function-key-map convert key sequences into logical
;; keys.  This does a better job than viper-read-event when it comes to kbd
;; macros, since it enables certain macros to be shared between X and TTY modes
;; by correctly mapping key sequences for Left/Right/... (one an ascii
;; terminal) into logical keys left, right, etc.
(defun viper-read-key () 
  (let ((overriding-local-map viper-overriding-map) 
	(inhibit-quit t)
	help-char key) 
    (use-global-map viper-overriding-map) 
    (unwind-protect
	(setq key (elt (viper-read-key-sequence nil) 0)) 
      (use-global-map global-map))
    key))


;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil)

	     ;; XEmacs
	     (cond ((key-press-event-p event)
		    (event-key event))
		   ((button-event-p event)
		    (concat "mouse-" (prin1-to-string (event-button event))))
		   (t 
		    (error "viper-event-key: Unknown event, %S" event)))
	     ;; 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 (viper-characterp event) (<= ?A event) (<= event ?Z))

		    (list 'control '\?) ; taking care of an emacs bug
		  (intern (char-to-string basis)))))
      (if mod
	  (append mod (list basis))
	basis))))
    
(defun viper-key-to-emacs-key (key)
  (let (key-name char-p modifiers mod-char-list base-key base-key-name)
    (cond (viper-xemacs-p key)

	  ((symbolp key)

	   ((eventp elt)  elt)
	   (t (error
	       "viper-eventify-list-xemacs: can't convert to event, %S"
	       elt))))
   lis))
  

;; Smoothes out the difference between Emacs' unread-command-events
;; and XEmacs unread-command-event.  Arg is a character, an event, a list of
;; events or a sequence of keys.
;;

;; XEmacs only
(defun viper-event-vector-p (vec)
  (and (vectorp vec)
       (eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec)))))

			 
;; check if vec is a vector of character symbols
(defun viper-char-symbol-sequence-p (vec)
  (and
   (sequencep vec)
   (eval
    (cons 'and
	  (mapcar (lambda (elt)
		    (and (symbolp elt) (= (length (symbol-name elt)) 1)))
		  vec)))))
    
  
(defun viper-char-array-p (array)
  (eval (cons 'and (mapcar 'viper-characterp array))))


;; Args can be a sequence of events, a string, or a Viper macro.  Will try to

			 (setq temp2 (mapcar 'viper-key-to-character temp))))
		   (mapconcat 'char-to-string temp2 ""))
		  (t (prin1-to-string (vconcat temp)))))
	  ((viper-char-symbol-sequence-p event-seq)
	   (mapconcat 'symbol-name event-seq ""))
	  ((and (vectorp event-seq) 
		(viper-char-array-p
		 (setq temp (mapcar 'viper-key-to-character event-seq))))
	   (mapconcat 'char-to-string temp ""))
	  (t (prin1-to-string event-seq)))))

	      (lambda (elt) (char-to-string (event-to-character elt))) ; xemacs
	      'char-to-string ; emacs
	      )
	     events
	     ""))
	   
    
(defun viper-read-char-exclusive ()
  (let (char
	(echo-keystrokes 1))
    (while (null char)
      (condition-case nil

	      (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 viper-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 viper-related-files-and-buffers-ring 
	(make-ring (1+ (length other-files-or-buffers))))
  (mapcar '(lambda (elt)
	     (viper-ring-insert viper-related-files-and-buffers-ring elt))
	  other-files-or-buffers)
  (viper-ring-insert viper-related-files-and-buffers-ring (buffer-name))

  "String of syntax classes for Vi separators.
Usually contains ` ', linefeed, TAB or formfeed.")


;; Set Viper syntax classes and related variables according to
;; `viper-syntax-preference'.  
(defun viper-update-syntax-classes (&optional set-default)
  (let ((preference (cond ((eq viper-syntax-preference 'emacs)
			   "w")   ; Viper words have only Emacs word chars
			  ((eq viper-syntax-preference 'extended)
			   "w_")  ; Viper words have Emacs word & symbol chars

This is most appropriate for major modes intended for editing programs.

`emacs' means Viper words are the same as Emacs words as specified by Emacs
syntax tables.
This option is appropriate if you like Emacs-style words."
  :type '(radio (const strict-vi) (const reformed-vi) 
		 (const extended) (const emacs))
  :set 'viper-set-syntax-preference
  :group 'viper)
(make-variable-buffer-local 'viper-syntax-preference)

  (or (viper-looking-at-separator) (viper-looking-at-alpha addl-chars)))

(defun viper-skip-alpha-forward (&optional addl-chars)
  (or (stringp addl-chars) (setq addl-chars ""))
  (viper-skip-syntax
   'forward 
   (cond ((eq viper-syntax-preference 'strict-vi)
	  "")
	 (t viper-ALPHA-char-class))
   (cond ((eq viper-syntax-preference 'strict-vi)
	  (concat viper-strict-ALPHA-chars addl-chars))
	 (t addl-chars))))

(defun viper-skip-alpha-backward (&optional addl-chars)
  (or (stringp addl-chars) (setq addl-chars ""))
  (viper-skip-syntax
   'backward 
   (cond ((eq viper-syntax-preference 'strict-vi)
	  "")
	 (t viper-ALPHA-char-class))
   (cond ((eq viper-syntax-preference 'strict-vi)
	  (concat viper-strict-ALPHA-chars addl-chars))
	 (t addl-chars))))

;; weird syntax tables may confuse strict-vi style
(defsubst viper-skip-all-separators-forward (&optional within-line)
  (if (eq viper-syntax-preference 'strict-vi)
      (if within-line 
	  (skip-chars-forward viper-strict-SEP-chars-sans-newline)
	(skip-chars-forward viper-strict-SEP-chars))
    (viper-skip-syntax 'forward
		       viper-SEP-char-class
		       (or within-line "\n")
		       (if within-line (viper-line-pos 'end)))))
(defsubst viper-skip-all-separators-backward (&optional within-line)
  (if (eq viper-syntax-preference 'strict-vi)
      (if within-line 
	  (skip-chars-backward viper-strict-SEP-chars-sans-newline)
	(skip-chars-backward viper-strict-SEP-chars))
    (viper-skip-syntax 'backward
		       viper-SEP-char-class
		       (or within-line "\n")

       (concat "^" viper-strict-SEP-chars viper-strict-ALPHA-chars))
    (viper-skip-syntax
     'forward
     (concat "^" viper-ALPHA-char-class viper-SEP-char-class)
     ;; Emacs may consider some of these as words, but we don't want them
     viper-non-word-characters 
     (viper-line-pos 'end))))
(defun viper-skip-nonalphasep-backward ()
  (if (eq viper-syntax-preference 'strict-vi)
      (skip-chars-backward
       (concat "^" viper-strict-SEP-chars viper-strict-ALPHA-chars))

	  (cond ((listp syntax) syntax)
		((stringp syntax) (viper-string-to-list syntax))
		(t nil)))
    (if (memq ?^ syntax) (setq negated-syntax t))

    (while (and (not (= local 0)) 
		(cond ((eq direction 'forward) 
		       (not (eobp)))
		      (t (not (bobp)))))
      (setq char-looked-at (viper-char-at-pos direction)
	    ;; if outside the range, set to nil
	    syntax-of-char-looked-at (if char-looked-at

		 0)
	       (funcall skip-chars-func addl-chars limit)))
      (setq total (+ total local)))
    total
    ))
  

  
(provide 'viper-util)
  

;;; Local Variables:
;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
;;; End:

49598:0d8b17d428b5

(defsubst viper-color-display-p ()
  (viper-cond-compile-for-xemacs-or-emacs
   (eq (device-class (selected-device)) 'color) ; xemacs
   (x-display-color-p)  ; emacs
   ))

(defsubst viper-get-cursor-color ()
  (viper-cond-compile-for-xemacs-or-emacs
   ;; xemacs
   (color-instance-name (frame-property (selected-frame) 'cursor-color))
   (cdr (assoc 'cursor-color (frame-parameters))) ; emacs
   ))


;; OS/2
(cond ((eq (viper-device-type) 'pm)
       (fset 'viper-color-defined-p
	     (lambda (color) (assoc color pm-color-alist)))))


;; cursor colors
(defun viper-change-cursor-color (new-color)
  (if (and (viper-window-display-p)  (viper-color-display-p)
	   (stringp new-color) (viper-color-defined-p new-color)

	(selected-frame) 'cursor-color (make-color-instance new-color))
       (modify-frame-parameters
	(selected-frame) (list (cons 'cursor-color new-color)))
       )
    ))

;; By default, saves current frame cursor color in the
;; viper-saved-cursor-color-in-replace-mode property of viper-replace-overlay
(defun viper-save-cursor-color (before-which-mode)
  (if (and (viper-window-display-p) (viper-color-display-p))
      (let ((color (viper-get-cursor-color)))

	       (if (eq before-which-mode 'before-replace-mode)
		   'viper-saved-cursor-color-in-replace-mode
		 'viper-saved-cursor-color-in-insert-mode)
	       color)))
	  ))))


(defsubst viper-get-saved-cursor-color-in-replace-mode ()
  (or
   (funcall
    (if viper-emacs-p 'frame-parameter 'frame-property)

   (funcall
    (if viper-emacs-p 'frame-parameter 'frame-property)
    (selected-frame)
    'viper-saved-cursor-color-in-insert-mode)
   viper-vi-state-cursor-color))

;; restore cursor color from replace overlay
(defun viper-restore-cursor-color(after-which-mode)
  (if (viper-overlay-p viper-replace-overlay)
      (viper-change-cursor-color
       (if (eq after-which-mode 'after-replace-mode)
	   (viper-get-saved-cursor-color-in-replace-mode)
	 (viper-get-saved-cursor-color-in-insert-mode))
       )))

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

			 t)))
		 (t
		  (error "%S: Invalid op in viper-check-version" op))))
    (cond ((memq op '(= > >=)) nil)
	  ((memq op '(< <=)) t))))


(defun viper-get-visible-buffer-window (wind)
  (if viper-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."

;; 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 `viper-move-marker-locally' in a new
;; buffer, a new marker will be created.
(defun viper-move-marker-locally (var pos &optional buffer)

    (beep 1)))



;;; List/alist utilities

;; Convert LIST to an alist
(defun viper-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 viper-alist-to-list (alst)
  (let ((lst))
    (while alst

  (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 viper-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 viper-append-filter-alist (lis1 lis2)
  (let ((temp lis1)

    (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, :r, :w file globbing

	 (cond (ex-unix-type-shell-options)
	       ))
	(command (cond (viper-ms-style-os-p (format "\"ls -1 -d %s\"" filespec))
		       (t (format "ls -1 -d %s" filespec))))
	status)
    (save-excursion
      (set-buffer (get-buffer-create viper-ex-tmp-buf-name))
      (erase-buffer)
      (setq status
	    (if gshell-options
		(call-process gshell nil t nil

		 (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

;; glob windows files
;; LIST is expected to be in reverse order
(defun viper-glob-mswindows-files (filespec)
  (let ((case-fold-search t)
	tmp tmp2)
    (save-excursion
      (set-buffer (get-buffer-create viper-ex-tmp-buf-name))
      (erase-buffer)
      (insert filespec)
      (goto-char (point-min))
      (setq tmp (viper-get-filenames-from-buffer))
      (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

			    (ring-minus1 (car ring) (ring-length ring)))
			   ;; don't rotate if dir = 0
			   (t (car ring))))
	(viper-current-ring-item ring)
	)))

(defun viper-special-ring-rotate1 (ring dir)
  (if (memq viper-intermediate-command
	    '(repeating-display-destructive-command
	      repeating-insertion-from-ring))
      (viper-ring-rotate1 ring dir)
    ;; don't rotate otherwise
    (viper-ring-rotate1 ring 0)))

;; current ring item; if N is given, then so many items back from the
;; current
(defun viper-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 viper-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 (eq ring-var 'viper-command-ring)
	   (string-match "\\([0-9]*\e\\|^[ \t]*$\\|escape\\)"
			 (viper-array-to-string (this-command-keys))))
      (viper-ring-insert (eval ring-var) item))
  )


;; removing elts from ring seems to break it
(defun viper-cleanup-ring (ring)
  (or (< (ring-length ring) 2)
      (null (viper-current-ring-item ring))
      ;; last and previous equal
      (if (equal (viper-current-ring-item ring)
		 (viper-current-ring-item ring 1))
	  (viper-ring-pop ring))))

;; ring-remove seems to be buggy, so we concocted this for our purposes.
(defun viper-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 viper-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))

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

;; tells if we are over a whitespace-only line
(defsubst viper-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.

      (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 viper-save-string-in-file (string custom-file &optional pattern)
  (let ((buf (find-file-noselect (substitute-in-file-name custom-file))))
    (save-excursion

		 ((fboundp 'file-remote-p) (file-remote-p file-name))
		 (t (require 'ange-ftp)
		    ;; Can happen only in Emacs, since XEmacs has file-remote-p
		    (ange-ftp-ftp-name file-name))))))



;; This is a simple-minded check for whether a file is under version control.
;; If file,v exists but file doesn't, this file is considered to be not checked
;; in and not checked out for the purpose of patching (since patch won't be
;; able to read such a file anyway).

	      (format
	       "File %s is checked in.  Check it out? "
	       (viper-abbreviate-file-name file))))
	(with-current-buffer buf
	  (command-execute checkout-function)))))




;;; Overlays
(defun viper-put-on-search-overlay (beg end)
  (if (viper-overlay-p viper-search-overlay)
      (viper-move-overlay viper-search-overlay beg end)

;; Replace state

(defsubst viper-move-replace-overlay (beg end)
  (viper-move-overlay viper-replace-overlay beg end))

(defun viper-set-replace-overlay (beg end)
  (if (viper-overlay-live-p viper-replace-overlay)
      (viper-move-replace-overlay beg end)
    (setq viper-replace-overlay (viper-make-overlay beg end (current-buffer)))
    ;; never detach
    (viper-overlay-put
     viper-replace-overlay (if viper-emacs-p 'evaporate 'detachable) nil)
    (viper-overlay-put
     viper-replace-overlay 'priority viper-replace-overlay-priority)
    ;; If Emacs will start supporting overlay maps, as it currently supports
    ;; text-property maps, we could do away with viper-replace-minor-mode and
    ;; just have keymap attached to replace overlay.
    ;;(viper-overlay-put
    ;; viper-replace-overlay
    ;; (if viper-xemacs-p 'keymap 'local-map)
    ;; viper-replace-map)
    )
  (if (viper-has-face-support-p)
      (viper-overlay-put
       viper-replace-overlay 'face viper-replace-overlay-face))
  (viper-save-cursor-color 'before-replace-mode)
  (viper-change-cursor-color viper-replace-overlay-cursor-color)
  )


(defun viper-set-replace-overlay-glyphs (before-glyph after-glyph)
  (or (viper-overlay-live-p viper-replace-overlay)
      (viper-set-replace-overlay (point-min) (point-min)))
  (if (or (not (viper-has-face-support-p))
	  viper-use-replace-region-delimiters)
      (let ((before-name (if viper-xemacs-p 'begin-glyph 'before-string))
	    (after-name (if viper-xemacs-p 'end-glyph 'after-string)))
	(viper-overlay-put viper-replace-overlay before-name before-glyph)
	(viper-overlay-put viper-replace-overlay after-name after-glyph))))

(defun viper-hide-replace-overlay ()
  (viper-set-replace-overlay-glyphs nil nil)
  (viper-restore-cursor-color 'after-replace-mode)
  (viper-restore-cursor-color 'after-insert-mode)
  (if (viper-has-face-support-p)
      (viper-overlay-put viper-replace-overlay 'face nil)))


(defsubst viper-replace-start ()
  (viper-overlay-start viper-replace-overlay))
(defsubst viper-replace-end ()
  (viper-overlay-end viper-replace-overlay))


;; Minibuffer

(defun viper-set-minibuffer-overlay ()
  (viper-check-minibuffer-overlay)
  (if (viper-has-face-support-p)
      (progn
	(viper-overlay-put
	 viper-minibuffer-overlay 'face viper-minibuffer-current-face)
	(viper-overlay-put
	 viper-minibuffer-overlay 'priority viper-minibuffer-overlay-priority)
	;; never detach
	(viper-overlay-put
	 viper-minibuffer-overlay
	 (if viper-emacs-p 'evaporate 'detachable)

	(if viper-xemacs-p
	    (progn
	      (viper-overlay-put viper-minibuffer-overlay 'start-open nil)
	      (viper-overlay-put viper-minibuffer-overlay 'end-open nil)))
	)))

(defun viper-check-minibuffer-overlay ()
  (if (viper-overlay-live-p viper-minibuffer-overlay)
      (viper-move-overlay
       viper-minibuffer-overlay
       (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)

(defsubst viper-is-in-minibuffer ()
  (save-match-data
    (string-match "\*Minibuf-" (buffer-name))))



;;; XEmacs compatibility

(defun viper-abbreviate-file-name (file)

   ;; XEmacs requires addl argument
   (abbreviate-file-name file t)
   ;; emacs
   (abbreviate-file-name file)
   ))

;; Sit for VAL milliseconds.  XEmacs doesn't support the millisecond arg
;; in sit-for, so this function smoothes out the differences.
(defsubst viper-sit-for-short (val &optional nodisp)
  (if viper-xemacs-p
      (sit-for (/ val 1000.0) nodisp)
    (sit-for 0 val nodisp)))

      (let ((buf (marker-buffer marker))
	    (pos (marker-position marker)))
	(save-excursion
	  (set-buffer buf)
	  (and (<= pos (point-max)) (<= (point-min) pos))))))

(defsubst viper-mark-marker ()
  (viper-cond-compile-for-xemacs-or-emacs
   (mark-marker t) ; xemacs
   (mark-marker) ; emacs
   ))

;; is the same as (mark t).
(defsubst viper-set-mark-if-necessary ()
  (setq mark-ring (delete (viper-mark-marker) mark-ring))
  (set-mark-command nil)
  (setq viper-saved-mark (point)))

;; 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 viper-deactivate-mark ()
  (viper-cond-compile-for-xemacs-or-emacs

	  (and (<= ?1 reg) (<= reg ?9)))
      (if (memq 'Letter type)
	  (and (<= ?A reg) (<= reg ?Z)))
      ))



;; it is suggested that an event must be copied before it is assigned to
;; last-command-event in XEmacs
(defun viper-copy-event (event)
  (viper-cond-compile-for-xemacs-or-emacs
   (copy-event event) ; xemacs
   event ; emacs
   ))

;; Uses different timeouts for ESC-sequences and others
(defsubst viper-fast-keysequence-p ()
  (not (viper-sit-for-short
	(if (viper-ESC-event-p last-input-event)
	    viper-ESC-keyseq-timeout
	  viper-fast-keyseq-timeout)
	t)))

;; like read-event, but in XEmacs also try to convert to char, if possible
(defun viper-read-event-convert-to-char ()
  (let (event)
    (viper-cond-compile-for-xemacs-or-emacs
     (progn

		    (viper-insert-local-user-minor-mode  nil))
		;; Note: set unread-command-events only after testing for fast
		;; keysequence. Otherwise, viper-fast-keysequence-p will be
		;; always t -- whether there is anything after ESC or not
		(viper-set-unread-command-events keyseq)
		(setq keyseq (read-key-sequence nil)))
	    (viper-set-unread-command-events keyseq)
	    (setq keyseq (read-key-sequence nil)))))
    keyseq))


;; This function lets function-key-map convert key sequences into logical
;; keys.  This does a better job than viper-read-event when it comes to kbd
;; macros, since it enables certain macros to be shared between X and TTY modes
;; by correctly mapping key sequences for Left/Right/... (one an ascii
;; terminal) into logical keys left, right, etc.
(defun viper-read-key ()
  (let ((overriding-local-map viper-overriding-map)
	(inhibit-quit t)
	help-char key)
    (use-global-map viper-overriding-map)
    (unwind-protect
	(setq key (elt (viper-read-key-sequence nil) 0))
      (use-global-map global-map))
    key))


;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil)

	     ;; XEmacs
	     (cond ((key-press-event-p event)
		    (event-key event))
		   ((button-event-p event)
		    (concat "mouse-" (prin1-to-string (event-button event))))
		   (t
		    (error "viper-event-key: Unknown event, %S" event)))
	     ;; 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 (viper-characterp event) (<= ?A event) (<= event ?Z))

		    (list 'control '\?) ; taking care of an emacs bug
		  (intern (char-to-string basis)))))
      (if mod
	  (append mod (list basis))
	basis))))

(defun viper-key-to-emacs-key (key)
  (let (key-name char-p modifiers mod-char-list base-key base-key-name)
    (cond (viper-xemacs-p key)

	  ((symbolp key)

	   ((eventp elt)  elt)
	   (t (error
	       "viper-eventify-list-xemacs: can't convert to event, %S"
	       elt))))
   lis))


;; Smoothes out the difference between Emacs' unread-command-events
;; and XEmacs unread-command-event.  Arg is a character, an event, a list of
;; events or a sequence of keys.
;;

;; XEmacs only
(defun viper-event-vector-p (vec)
  (and (vectorp vec)
       (eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec)))))


;; check if vec is a vector of character symbols
(defun viper-char-symbol-sequence-p (vec)
  (and
   (sequencep vec)
   (eval
    (cons 'and
	  (mapcar (lambda (elt)
		    (and (symbolp elt) (= (length (symbol-name elt)) 1)))
		  vec)))))


(defun viper-char-array-p (array)
  (eval (cons 'and (mapcar 'viper-characterp array))))


;; Args can be a sequence of events, a string, or a Viper macro.  Will try to

			 (setq temp2 (mapcar 'viper-key-to-character temp))))
		   (mapconcat 'char-to-string temp2 ""))
		  (t (prin1-to-string (vconcat temp)))))
	  ((viper-char-symbol-sequence-p event-seq)
	   (mapconcat 'symbol-name event-seq ""))
	  ((and (vectorp event-seq)
		(viper-char-array-p
		 (setq temp (mapcar 'viper-key-to-character event-seq))))
	   (mapconcat 'char-to-string temp ""))
	  (t (prin1-to-string event-seq)))))

	      (lambda (elt) (char-to-string (event-to-character elt))) ; xemacs
	      'char-to-string ; emacs
	      )
	     events
	     ""))


(defun viper-read-char-exclusive ()
  (let (char
	(echo-keystrokes 1))
    (while (null char)
      (condition-case nil

	      (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 viper-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 viper-related-files-and-buffers-ring
	(make-ring (1+ (length other-files-or-buffers))))
  (mapcar '(lambda (elt)
	     (viper-ring-insert viper-related-files-and-buffers-ring elt))
	  other-files-or-buffers)
  (viper-ring-insert viper-related-files-and-buffers-ring (buffer-name))

  "String of syntax classes for Vi separators.
Usually contains ` ', linefeed, TAB or formfeed.")


;; Set Viper syntax classes and related variables according to
;; `viper-syntax-preference'.
(defun viper-update-syntax-classes (&optional set-default)
  (let ((preference (cond ((eq viper-syntax-preference 'emacs)
			   "w")   ; Viper words have only Emacs word chars
			  ((eq viper-syntax-preference 'extended)
			   "w_")  ; Viper words have Emacs word & symbol chars

This is most appropriate for major modes intended for editing programs.

`emacs' means Viper words are the same as Emacs words as specified by Emacs
syntax tables.
This option is appropriate if you like Emacs-style words."
  :type '(radio (const strict-vi) (const reformed-vi)
		 (const extended) (const emacs))
  :set 'viper-set-syntax-preference
  :group 'viper)
(make-variable-buffer-local 'viper-syntax-preference)

  (or (viper-looking-at-separator) (viper-looking-at-alpha addl-chars)))

(defun viper-skip-alpha-forward (&optional addl-chars)
  (or (stringp addl-chars) (setq addl-chars ""))
  (viper-skip-syntax
   'forward
   (cond ((eq viper-syntax-preference 'strict-vi)
	  "")
	 (t viper-ALPHA-char-class))
   (cond ((eq viper-syntax-preference 'strict-vi)
	  (concat viper-strict-ALPHA-chars addl-chars))
	 (t addl-chars))))

(defun viper-skip-alpha-backward (&optional addl-chars)
  (or (stringp addl-chars) (setq addl-chars ""))
  (viper-skip-syntax
   'backward
   (cond ((eq viper-syntax-preference 'strict-vi)
	  "")
	 (t viper-ALPHA-char-class))
   (cond ((eq viper-syntax-preference 'strict-vi)
	  (concat viper-strict-ALPHA-chars addl-chars))
	 (t addl-chars))))

;; weird syntax tables may confuse strict-vi style
(defsubst viper-skip-all-separators-forward (&optional within-line)
  (if (eq viper-syntax-preference 'strict-vi)
      (if within-line
	  (skip-chars-forward viper-strict-SEP-chars-sans-newline)
	(skip-chars-forward viper-strict-SEP-chars))
    (viper-skip-syntax 'forward
		       viper-SEP-char-class
		       (or within-line "\n")
		       (if within-line (viper-line-pos 'end)))))
(defsubst viper-skip-all-separators-backward (&optional within-line)
  (if (eq viper-syntax-preference 'strict-vi)
      (if within-line
	  (skip-chars-backward viper-strict-SEP-chars-sans-newline)
	(skip-chars-backward viper-strict-SEP-chars))
    (viper-skip-syntax 'backward
		       viper-SEP-char-class
		       (or within-line "\n")

       (concat "^" viper-strict-SEP-chars viper-strict-ALPHA-chars))
    (viper-skip-syntax
     'forward
     (concat "^" viper-ALPHA-char-class viper-SEP-char-class)
     ;; Emacs may consider some of these as words, but we don't want them
     viper-non-word-characters
     (viper-line-pos 'end))))
(defun viper-skip-nonalphasep-backward ()
  (if (eq viper-syntax-preference 'strict-vi)
      (skip-chars-backward
       (concat "^" viper-strict-SEP-chars viper-strict-ALPHA-chars))

	  (cond ((listp syntax) syntax)
		((stringp syntax) (viper-string-to-list syntax))
		(t nil)))
    (if (memq ?^ syntax) (setq negated-syntax t))

    (while (and (not (= local 0))
		(cond ((eq direction 'forward)
		       (not (eobp)))
		      (t (not (bobp)))))
      (setq char-looked-at (viper-char-at-pos direction)
	    ;; if outside the range, set to nil
	    syntax-of-char-looked-at (if char-looked-at

		 0)
	       (funcall skip-chars-func addl-chars limit)))
      (setq total (+ total local)))
    total
    ))



(provide 'viper-util)


;;; Local Variables:
;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
;;; End: