comparison lisp/emulation/viper-util.el @ 42602:633233bf2bbf

2002-01-07 Michael Kifer <[e-mail]> * viper-init.el (viper-cond-compile-for-xemacs-or-emacs): new macro that replaces viper-emacs-p and viper-xemacs-p in many cases. Used to reduce the number of warnings. * viper-cmd.el: use viper-cond-compile-for-xemacs-or-emacs. (viper-standard-value): moved here from viper.el. (viper-set-unread-command-events): moved to viper-util.el (viper-check-minibuffer-overlay): make sure viper-minibuffer-overlay is moved to cover the entire input field. * viper-util.el: use viper-cond-compile-for-xemacs-or-emacs. (viper-read-key-sequence, viper-set-unread-command-events, viper-char-symbol-sequence-p, viper-char-array-p): moved here. * viper-ex.el: use viper-cond-compile-for-xemacs-or-emacs. * viper-keym.el: use viper-cond-compile-for-xemacs-or-emacs. * viper-mous.el: use viper-cond-compile-for-xemacs-or-emacs. * viper-macs.el (viper-char-array-p, viper-char-symbol-sequence-p, viper-event-vector-p): moved to viper-util.el * viper.el (viper-standard-value): moved to viper-cmd.el. Use viper-cond-compile-for-xemacs-or-emacs. * ediff-help.el: use ediff-cond-compile-for-xemacs-or-emacs. * ediff-hook.el: use ediff-cond-compile-for-xemacs-or-emacs. * ediff-init.el (ediff-cond-compile-for-xemacs-or-emacs): new macro designed to be used in many places where ediff-emacs-p or ediff-xemacs-p was previously used. Reduces the number of warnings. Use ediff-cond-compile-for-xemacs-or-emacs in many places in lieue of ediff-xemacs-p. (ediff-make-current-diff-overlay, ediff-highlight-diff-in-one-buffer, ediff-convert-fine-diffs-to-overlays, ediff-empty-diff-region-p, ediff-whitespace-diff-region-p, ediff-get-region-contents): moved to ediff-util.el. (ediff-event-key): moved here. * ediff-merge.el: got rid of unreferenced variables. * ediff-mult.el: use ediff-cond-compile-for-xemacs-or-emacs. * ediff-util.el: use ediff-cond-compile-for-xemacs-or-emacs. (ediff-cleanup-mess): improved the way windows are set up after quitting ediff. (ediff-janitor): use ediff-dispose-of-variant-according-to-user. (ediff-dispose-of-variant-according-to-user): new function designed to be smarter and also understands indirect buffers. (ediff-highlight-diff-in-one-buffer, ediff-unhighlight-diff-in-one-buffer, ediff-unhighlight-diffs-totally-in-one-buffer, ediff-highlight-diff, ediff-highlight-diff, ediff-unhighlight-diff, ediff-unhighlight-diffs-totally, ediff-empty-diff-region-p, ediff-whitespace-diff-region-p, ediff-get-region-contents, ediff-make-current-diff-overlay): moved here. (ediff-format-bindings-of): new function by Hannu Koivisto <[e-mail]>. (ediff-setup): make sure the merge buffer is always widened and modifiable. (ediff-write-merge-buffer-and-maybe-kill): refuse to write the result of a merge into a file visited by another buffer. (ediff-arrange-autosave-in-merge-jobs): check if the merge file is visited by another buffer and ask to save/delete that buffer. (ediff-verify-file-merge-buffer): new function to do the above. * ediff-vers.el: load ediff-init.el at compile time. * ediff-wind.el: use ediff-cond-compile-for-xemacs-or-emacs. * ediff.el (ediff-windows, ediff-regions-wordwise, ediff-regions-linewise): use indirect buffers to improve robustness and make it possible to compare regions of the same buffer (even overlapping regions). (ediff-clone-buffer-for-region-comparison, ediff-clone-buffer-for-window-comparison): new functions. (ediff-files-internal): refuse to compare identical files. (ediff-regions-internal): get rid of the warning about comparing regions of the same buffer. * ediff-diff.el (ediff-convert-fine-diffs-to-overlays): moved here. Plus the following fixes courtesy of Dave Love: Doc fixes. (ediff-word-1): Use word class and move - to the front per regexp documentation. (ediff-wordify): Bind forward-word-function outside loop. (ediff-copy-to-buffer): Use insert-buffer-substring rather than consing buffer contents. (ediff-goto-word): Move syntax table setting outside loop.

42601:ddd4802ff361

;;; viper-util.el --- Utilities used by viper.el

;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.

;; Author: Michael Kifer <[e-mail]>

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

(defvar viper-fast-keyseq-timeout)
(defvar ex-unix-type-shell)
(defvar ex-unix-type-shell-options)
(defvar viper-ex-tmp-buf-name)
(defvar viper-syntax-preference)

(require 'cl)
(require 'ring)

(if noninteractive


;;; XEmacs support


(if viper-xemacs-p
    (progn
      (fset 'viper-read-event (symbol-function 'next-command-event))
      (fset 'viper-make-overlay (symbol-function 'make-extent))
      (fset 'viper-overlay-start (symbol-function 'extent-start-position))
      (fset 'viper-overlay-end (symbol-function 'extent-end-position))
      (fset 'viper-overlay-put (symbol-function 'set-extent-property))
      (fset 'viper-overlay-p (symbol-function 'extentp))
      (fset 'viper-overlay-get (symbol-function 'extent-property))
      (fset 'viper-move-overlay (symbol-function 'set-extent-endpoints))
      (fset 'viper-overlay-live-p (symbol-function 'extent-live-p))
      (if (viper-window-display-p)
	  (fset 'viper-iconify (symbol-function 'iconify-frame)))
      (cond ((viper-has-face-support-p)
	     (fset 'viper-get-face (symbol-function 'get-face))
	     (fset 'viper-color-defined-p
		   (symbol-function 'valid-color-name-p))
	     )))
  (fset 'viper-read-event (symbol-function 'read-event))
  (fset 'viper-make-overlay (symbol-function 'make-overlay))
  (fset 'viper-overlay-start (symbol-function 'overlay-start))
  (fset 'viper-overlay-end (symbol-function 'overlay-end))
  (fset 'viper-overlay-put (symbol-function 'overlay-put))
  (fset 'viper-overlay-p (symbol-function 'overlayp))
  (fset 'viper-overlay-get (symbol-function 'overlay-get))
  (fset 'viper-move-overlay (symbol-function 'move-overlay))
  (fset 'viper-overlay-live-p (symbol-function 'overlayp))
  (if (viper-window-display-p)
      (fset 'viper-iconify (symbol-function 'iconify-or-deiconify-frame)))
  (cond ((viper-has-face-support-p)
	 (fset 'viper-get-face (symbol-function 'internal-get-face))
	 (fset 'viper-color-defined-p (symbol-function 'x-color-defined-p))
	 )))


(fset 'viper-characterp
      (symbol-function
       (if viper-xemacs-p 'characterp 'integerp)))

(fset 'viper-int-to-char
      (symbol-function
       (if viper-xemacs-p 'int-to-char 'identity)))

;; CHAR is supposed to be a char or an integer (positive or negative)
;; LIST is a list of chars, nil, and negative numbers
;; Check if CHAR is a member by trying to convert in characters, if necessary.
;; Introduced for compatibility with XEmacs, where integers are not the same as

	((and (viper-characterp char) (viper-characterp char1))
	 (= char char1))
	(t nil)))

(defsubst viper-color-display-p ()
  (if viper-emacs-p
      (x-display-color-p)
    (eq (device-class (selected-device)) 'color)))
   
(defsubst viper-get-cursor-color ()
  (if viper-emacs-p
      (cdr (assoc 'cursor-color (frame-parameters)))
    (color-instance-name (frame-property (selected-frame) 'cursor-color))))
  

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

;; 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)
	   (not (string= new-color (viper-get-cursor-color))))
      (if viper-emacs-p
	  (modify-frame-parameters
	   (selected-frame) (list (cons 'cursor-color new-color)))
	(set-frame-property
	 (selected-frame) 'cursor-color (make-color-instance 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)

	      (viper-overlay-put viper-minibuffer-overlay 'start-open nil)
	      (viper-overlay-put viper-minibuffer-overlay 'end-open nil)))
	)))
       
(defun viper-check-minibuffer-overlay ()
  (or (viper-overlay-p viper-minibuffer-overlay)
      (setq viper-minibuffer-overlay
	    (if viper-xemacs-p
		(viper-make-overlay 1 (1+ (buffer-size)) (current-buffer))
	      ;; make overlay open-ended
	      (viper-make-overlay
	       1 (1+ (buffer-size)) (current-buffer) nil 'rear-advance)))
      ))


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


;;; XEmacs compatibility

(defun viper-abbreviate-file-name (file)
  (if viper-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 viper-sit-for-short (val &optional nodisp)
  (if viper-xemacs-p

	(save-excursion
	  (set-buffer buf)
	  (and (<= pos (point-max)) (<= (point-min) pos))))))
  
(defsubst viper-mark-marker ()
  (if viper-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 viper-set-mark-if-necessary ()
  (setq mark-ring (delete (viper-mark-marker) mark-ring))

       
;; 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 ()
  (if viper-xemacs-p
      (zmacs-deactivate-region)
    (deactivate-mark)))

(defsubst viper-leave-region-active ()
  (if viper-xemacs-p
      (setq zmacs-region-stays t)))

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

	  (and (<= ?A reg) (<= reg ?Z)))
      ))

    
(defsubst viper-events-to-keys (events)
  (cond (viper-xemacs-p (events-to-keys events))
	(t events)))
		  
    
;; it is suggested that an event must be copied before it is assigned to
;; last-command-event in XEmacs
(defun viper-copy-event (event)
  (if viper-xemacs-p
      (copy-event event)
    event))
    
;; like read-event, but in XEmacs also try to convert to char, if possible
(defun viper-read-event-convert-to-char ()
  (let (event)
    (if viper-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 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

;; instead of nil, if '(nil) was previously inadvertently assigned to
;; unread-command-events
(defun viper-event-key (event)
  (or (and event (eventp event))
      (error "viper-event-key: Wrong type argument, eventp, %S" event))
  (when (cond (viper-xemacs-p (or (key-press-event-p event)
				  (mouse-event-p event)))
	      (t t))
    (let ((mod (event-modifiers event))
	  basis)
      (setq basis
	    (cond
	     (viper-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 "viper-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 (viper-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 (viper-characterp event)
			  (< ?\C-? event) (<= event 255))
		     (setq mod '(meta)
			   event (- event ?\C-? 1)))
		    ((and (null mod) (eq event 'return))
		     (setq event ?\C-m))
		    ((and (null mod) (eq event 'space))
		     (setq event ?\ ))
		    ((and (null mod) (eq event 'delete))
		     (setq event ?\C-?))
		    ((and (null mod) (eq event 'backspace))
		     (setq event ?\C-h))
		    (t (event-basic-type event)))
	      )))
      (if (viper-characterp basis)
	  (setq basis
		(if (viper= basis ?\C-?)
		    (list 'control '\?) ; taking care of an emacs bug
		  (intern (char-to-string basis)))))

		     "-"
		     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.

		 (setq temp (mapcar 'viper-key-to-character event-seq))))
	   (mapconcat 'char-to-string temp ""))
	  (t (prin1-to-string event-seq)))))

(defun viper-key-press-events-to-chars (events)
  (mapconcat (if viper-emacs-p
		 'char-to-string
	       (lambda (elt) (char-to-string (event-to-character elt))))
	     events
	     ""))
	   
    
;; 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)))
    
(defun viper-read-char-exclusive ()
  (let (char
	(echo-keystrokes 1))
    (while (null char)

42602:633233bf2bbf

;;; viper-util.el --- Utilities used by viper.el

;; Copyright (C) 1994, 95, 96, 97, 99, 2000, 01, 02 Free Software Foundation, Inc.

;; Author: Michael Kifer <[e-mail]>

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

(defvar viper-fast-keyseq-timeout)
(defvar ex-unix-type-shell)
(defvar ex-unix-type-shell-options)
(defvar viper-ex-tmp-buf-name)
(defvar viper-syntax-preference)
(defvar viper-saved-mark)

(require 'cl)
(require 'ring)

(if noninteractive


;;; XEmacs support


(viper-cond-compile-for-xemacs-or-emacs
 (progn ; xemacs
   (fset 'viper-overlay-p (symbol-function 'extentp))
   (fset 'viper-make-overlay (symbol-function 'make-extent))
   (fset 'viper-overlay-live-p (symbol-function 'extent-live-p))
   (fset 'viper-move-overlay (symbol-function 'set-extent-endpoints))
   (fset 'viper-overlay-start (symbol-function 'extent-start-position))
   (fset 'viper-overlay-end (symbol-function 'extent-end-position))
   (fset 'viper-overlay-get (symbol-function 'extent-property))
   (fset 'viper-overlay-put (symbol-function 'set-extent-property))
   (fset 'viper-read-event (symbol-function 'next-command-event))
   (fset 'viper-characterp (symbol-function 'characterp))
   (fset 'viper-int-to-char (symbol-function 'int-to-char))
   (if (viper-window-display-p)
       (fset 'viper-iconify (symbol-function 'iconify-frame)))
   (cond ((viper-has-face-support-p)
	  (fset 'viper-get-face (symbol-function 'get-face))
	  (fset 'viper-color-defined-p (symbol-function 'valid-color-name-p))
	  )))
 (progn ; emacs
   (fset 'viper-overlay-p (symbol-function 'overlayp))
   (fset 'viper-make-overlay (symbol-function 'make-overlay))
   (fset 'viper-overlay-live-p (symbol-function 'overlayp))
   (fset 'viper-move-overlay (symbol-function 'move-overlay))
   (fset 'viper-overlay-start (symbol-function 'overlay-start))
   (fset 'viper-overlay-end (symbol-function 'overlay-end))
   (fset 'viper-overlay-get (symbol-function 'overlay-get))
   (fset 'viper-overlay-put (symbol-function 'overlay-put))
   (fset 'viper-read-event (symbol-function 'read-event))
   (fset 'viper-characterp (symbol-function 'integerp))
   (fset 'viper-int-to-char (symbol-function 'identity))
   (if (viper-window-display-p)
       (fset 'viper-iconify (symbol-function 'iconify-or-deiconify-frame)))
   (cond ((viper-has-face-support-p)
	  (fset 'viper-get-face (symbol-function 'internal-get-face))
	  (fset 'viper-color-defined-p (symbol-function 'x-color-defined-p))
	  )))
 )



;; CHAR is supposed to be a char or an integer (positive or negative)
;; LIST is a list of chars, nil, and negative numbers
;; Check if CHAR is a member by trying to convert in characters, if necessary.
;; Introduced for compatibility with XEmacs, where integers are not the same as

	((and (viper-characterp char) (viper-characterp char1))
	 (= char char1))
	(t nil)))

(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

;; 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)
	   (not (string= new-color (viper-get-cursor-color))))
      (viper-cond-compile-for-xemacs-or-emacs
       (set-frame-property
	(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)

	      (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)
       (1+ (buffer-size)))
    (setq viper-minibuffer-overlay
	  (if viper-xemacs-p
	      (viper-make-overlay 1 (1+ (buffer-size)) (current-buffer))
	    ;; make overlay open-ended
	    (viper-make-overlay
	     (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)
	     (1+ (buffer-size))
	     (current-buffer) nil 'rear-advance)))
    ))


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


;;; XEmacs compatibility

(defun viper-abbreviate-file-name (file)
  (viper-cond-compile-for-xemacs-or-emacs
   ;; 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

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

;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring)
;; is the same as (mark t).
(defsubst viper-set-mark-if-necessary ()
  (setq mark-ring (delete (viper-mark-marker) mark-ring))

       
;; 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
   (zmacs-deactivate-region)
   (deactivate-mark)
   ))

(defsubst viper-leave-region-active ()
  (viper-cond-compile-for-xemacs-or-emacs
   (setq zmacs-region-stays t)
   nil
   ))

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

	  (and (<= ?A reg) (<= reg ?Z)))
      ))

    
(defsubst viper-events-to-keys (events)
  (viper-cond-compile-for-xemacs-or-emacs
   (events-to-keys events) ; xemacs
   events ; emacs
   ))
		  
    
;; 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
       (setq event (next-command-event))
       (or (event-to-character event)
	   event))
     (read-event)
     )
    ))

;; Viperized read-key-sequence
(defun viper-read-key-sequence (prompt &optional continue-echo)
  (let (inhibit-quit event keyseq)
    (setq keyseq (read-key-sequence prompt continue-echo))
    (setq event (if viper-xemacs-p
		    (elt keyseq 0) ; XEmacs returns vector of events
		  (elt (listify-key-sequence keyseq) 0)))
    (if (viper-ESC-event-p event)
	(let (unread-command-events)
	  (viper-set-unread-command-events keyseq)
	  (if (viper-fast-keysequence-p)
	      (let ((viper-vi-global-user-minor-mode  nil)
		    (viper-vi-local-user-minor-mode  nil)
		    (viper-replace-minor-mode nil) ; actually unnecessary
		    (viper-insert-global-user-minor-mode  nil)
		    (viper-insert-local-user-minor-mode  nil))
		(setq keyseq (read-key-sequence prompt continue-echo))) 
	    (setq keyseq (read-key-sequence prompt continue-echo)))))
    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

;; instead of nil, if '(nil) was previously inadvertently assigned to
;; unread-command-events
(defun viper-event-key (event)
  (or (and event (eventp event))
      (error "viper-event-key: Wrong type argument, eventp, %S" event))
  (when (viper-cond-compile-for-xemacs-or-emacs
	 (or (key-press-event-p event) (mouse-event-p event)) ; xemacs
	 t ; emacs
	 )
    (let ((mod (event-modifiers event))
	  basis)
      (setq basis
	    (viper-cond-compile-for-xemacs-or-emacs
	     ;; 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))
		    (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 (viper-characterp event)
			 (< ?\C-? event) (<= event 255))
		    (setq mod '(meta)
			  event (- event ?\C-? 1)))
		   ((and (null mod) (eq event 'return))
		    (setq event ?\C-m))
		   ((and (null mod) (eq event 'space))
		    (setq event ?\ ))
		   ((and (null mod) (eq event 'delete))
		    (setq event ?\C-?))
		   ((and (null mod) (eq event 'backspace))
		    (setq event ?\C-h))
		   (t (event-basic-type event)))
	     ) ; viper-cond-compile-for-xemacs-or-emacs
	    )
      (if (viper-characterp basis)
	  (setq basis
		(if (viper= basis ?\C-?)
		    (list 'control '\?) ; taking care of an emacs bug
		  (intern (char-to-string basis)))))

		     "-"
		     base-key-name))))))
    ))


;; LIS is assumed to be a list of events of characters
(defun viper-eventify-list-xemacs (lis)
  (mapcar
   (lambda (elt)
     (cond ((viper-characterp elt) (character-to-event elt))
	   ((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.
;;
;; Due to the way unread-command-events in Emacs (not XEmacs), a non-event
;; symbol in unread-command-events list may cause Emacs to turn this symbol
;; into an event.  Below, we delete nil from event lists, since nil is the most
;; common symbol that might appear in this wrong context.
(defun viper-set-unread-command-events (arg)
  (if viper-emacs-p
      (setq
       unread-command-events
       (let ((new-events
	      (cond ((eventp arg) (list arg))
		    ((listp arg) arg)
		    ((sequencep arg)
		     (listify-key-sequence arg))
		    (t (error
			"viper-set-unread-command-events: Invalid argument, %S"
			arg)))))
	 (if (not (eventp nil))
	     (setq new-events (delq nil new-events)))
	 (append new-events unread-command-events)))
    ;; XEmacs
    (setq
     unread-command-events
     (append
      (cond ((viper-characterp arg) (list (character-to-event arg)))
	    ((eventp arg)  (list arg))
	    ((stringp arg) (mapcar 'character-to-event arg))
	    ((vectorp arg) (append arg nil)) ; turn into list
	    ((listp arg) (viper-eventify-list-xemacs arg))
	    (t (error
		"viper-set-unread-command-events: Invalid argument, %S" arg)))
      unread-command-events))))


;; Check if vec is a vector of key-press events representing characters
;; 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
;; 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.

		 (setq temp (mapcar 'viper-key-to-character event-seq))))
	   (mapconcat 'char-to-string temp ""))
	  (t (prin1-to-string event-seq)))))

(defun viper-key-press-events-to-chars (events)
  (mapconcat (viper-cond-compile-for-xemacs-or-emacs
	      (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)