[Emacs-diffs] Changes to emacs/lisp/emulation/viper-util.el

[Michael Kifer]

Index: emacs/lisp/emulation/viper-util.el
diff -c emacs/lisp/emulation/viper-util.el:1.45 
emacs/lisp/emulation/viper-util.el:1.46
*** emacs/lisp/emulation/viper-util.el:1.45     Sun Sep  9 18:33:38 2001
--- emacs/lisp/emulation/viper-util.el  Mon Jan  7 23:36:00 2002
***************
*** 1,8 ****
  ;;; viper-util.el --- Utilities used by viper.el
  
! ;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
  
! ;; Author: Michael Kifer <address@hidden>
  
  ;; This file is part of GNU Emacs.
  
--- 1,8 ----
  ;;; 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 <address@hidden>
  
  ;; This file is part of GNU Emacs.
  
***************
*** 39,44 ****
--- 39,45 ----
  (defvar ex-unix-type-shell-options)
  (defvar viper-ex-tmp-buf-name)
  (defvar viper-syntax-preference)
+ (defvar viper-saved-mark)
  
  (require 'cl)
  (require 'ring)
***************
*** 66,113 ****
  ;;; 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
--- 67,112 ----
  ;;; 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
***************
*** 133,146 ****
        (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
--- 132,148 ----
        (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
***************
*** 154,164 ****
    (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
--- 156,167 ----
    (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
***************
*** 824,837 ****
        )))
         
  (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 ()
--- 827,846 ----
        )))
         
  (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 ()
***************
*** 843,852 ****
  ;;; 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.
--- 852,863 ----
  ;;; 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.
***************
*** 871,879 ****
          (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).
--- 882,891 ----
          (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).
***************
*** 886,898 ****
  ;; 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'.
--- 898,913 ----
  ;; 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'.
***************
*** 911,937 ****
  
      
  (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
--- 926,986 ----
  
      
  (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
***************
*** 954,997 ****
  (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-?)
--- 1003,1047 ----
  (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-?)
***************
*** 1046,1051 ****
--- 1096,1172 ----
      ))
  
  
+ ;; 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
***************
*** 1071,1090 ****
          (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
--- 1192,1204 ----
          (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