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

[Glenn Morris]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Glenn Morris <gm>       08/03/01 20:19:23

Index: viper-util.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/emulation/viper-util.el,v
retrieving revision 1.75
retrieving revision 1.76
diff -u -b -r1.75 -r1.76
--- viper-util.el       10 Jan 2008 06:54:11 -0000      1.75
+++ viper-util.el       1 Mar 2008 20:19:23 -0000       1.76
@@ -29,7 +29,6 @@
 ;; Compiler pacifier
 (defvar viper-overriding-map)
 (defvar pm-color-alist)
-(defvar zmacs-region-stays)
 (defvar viper-minibuffer-current-face)
 (defvar viper-minibuffer-insert-face)
 (defvar viper-minibuffer-vi-face)
@@ -115,18 +114,27 @@
        (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
-   ))
+  (if (featurep 'xemacs) (eq (device-class (selected-device)) 'color)
+    (x-display-color-p)))
 
 (defun viper-get-cursor-color (&optional frame)
-  (viper-cond-compile-for-xemacs-or-emacs
+  (if (featurep 'xemacs)
    (color-instance-name
-    (frame-property (or frame (selected-frame)) 'cursor-color)) ; xemacs
-   (cdr (assoc 'cursor-color (frame-parameters))) ; emacs
-   ))
+       (frame-property (or frame (selected-frame)) 'cursor-color))
+    (cdr (assoc 'cursor-color (frame-parameters)))))
 
+(defmacro viper-frame-value (variable)
+  "Return the value of VARIABLE local to the current frame, if there is one.
+Otherwise return the normal value."
+  `(if (featurep 'xemacs)
+       ,variable
+     ;; Frame-local variables are obsolete from Emacs 22.2 onwards,
+     ;; so we do it by hand instead.
+     ;; Distinguish between no frame parameter and a frame parameter
+     ;; with a value of nil.
+     (let ((fp (assoc ',variable (frame-parameters))))
+       (if fp (cdr fp)
+        ,variable))))
 
 ;; OS/2
 (cond ((eq (viper-device-type) 'pm)
@@ -139,26 +147,36 @@
   (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
+      (if (featurep 'xemacs)
        (set-frame-property
        (or frame (selected-frame))
        'cursor-color (make-color-instance new-color))
        (modify-frame-parameters
        (or frame (selected-frame))
-       (list (cons 'cursor-color new-color)))
-       )
-    ))
+         (list (cons 'cursor-color new-color))))))
 
+;; Note that the colors this function uses might not be those
+;; associated with FRAME, if there are frame-local values.
+;; This was equally true before the advent of viper-frame-value.
+;; Now it could be changed by passing frame to v-f-v.
 (defun viper-set-cursor-color-according-to-state (&optional frame)
   (cond ((eq viper-current-state 'replace-state)
-        (viper-change-cursor-color viper-replace-overlay-cursor-color frame))
+        (viper-change-cursor-color
+         (viper-frame-value viper-replace-overlay-cursor-color)
+         frame))
        ((and (eq viper-current-state 'emacs-state)
-             viper-emacs-state-cursor-color)
-        (viper-change-cursor-color viper-emacs-state-cursor-color frame))
+             (viper-frame-value viper-emacs-state-cursor-color))
+        (viper-change-cursor-color
+         (viper-frame-value viper-emacs-state-cursor-color)
+         frame))
        ((eq viper-current-state 'insert-state)
-        (viper-change-cursor-color viper-insert-state-cursor-color frame))
+        (viper-change-cursor-color
+         (viper-frame-value viper-insert-state-cursor-color)
+         frame))
        (t
-        (viper-change-cursor-color viper-vi-state-cursor-color frame))))
+        (viper-change-cursor-color
+         (viper-frame-value viper-vi-state-cursor-color)
+         frame))))
 
 ;; By default, saves current frame cursor color in the
 ;; viper-saved-cursor-color-in-replace-mode property of viper-replace-overlay
@@ -166,7 +184,9 @@
   (if (and (viper-window-display-p) (viper-color-display-p))
       (let ((color (viper-get-cursor-color)))
        (if (and (stringp color) (viper-color-defined-p color)
-                (not (string= color viper-replace-overlay-cursor-color)))
+                (not (string= color
+                              (viper-frame-value
+                               viper-replace-overlay-cursor-color))))
            (modify-frame-parameters
             (selected-frame)
             (list
@@ -177,8 +197,7 @@
                      'viper-saved-cursor-color-in-emacs-mode)
                     (t
                      'viper-saved-cursor-color-in-insert-mode))
-              color)))
-         ))))
+              color)))))))
 
 
 (defsubst viper-get-saved-cursor-color-in-replace-mode ()
@@ -187,9 +206,10 @@
     (if (featurep 'emacs) 'frame-parameter 'frame-property)
     (selected-frame)
     'viper-saved-cursor-color-in-replace-mode)
-   (if (and (eq viper-current-state 'emacs-mode) 
viper-emacs-state-cursor-color)
-       viper-emacs-state-cursor-color
-     viper-vi-state-cursor-color)))
+   (let ((ecolor (viper-frame-value viper-emacs-state-cursor-color)))
+     (or (and (eq viper-current-state 'emacs-mode)
+             ecolor)
+        (viper-frame-value viper-vi-state-cursor-color)))))
 
 (defsubst viper-get-saved-cursor-color-in-insert-mode ()
   (or
@@ -197,9 +217,10 @@
     (if (featurep 'emacs) 'frame-parameter 'frame-property)
     (selected-frame)
     'viper-saved-cursor-color-in-insert-mode)
-   (if (and (eq viper-current-state 'emacs-mode) 
viper-emacs-state-cursor-color)
-       viper-emacs-state-cursor-color
-     viper-vi-state-cursor-color)))
+   (let ((ecolor (viper-frame-value viper-emacs-state-cursor-color)))
+     (or (and (eq viper-current-state 'emacs-mode)
+             ecolor)
+        (viper-frame-value viper-vi-state-cursor-color)))))
 
 (defsubst viper-get-saved-cursor-color-in-emacs-mode ()
   (or
@@ -207,7 +228,7 @@
     (if (featurep 'emacs) 'frame-parameter 'frame-property)
     (selected-frame)
     'viper-saved-cursor-color-in-emacs-mode)
-   viper-vi-state-cursor-color))
+   (viper-frame-value viper-vi-state-cursor-color)))
 
 ;; restore cursor color from replace overlay
 (defun viper-restore-cursor-color(after-which-mode)
@@ -716,8 +737,7 @@
             (not (memq (vc-state file) '(edited needs-merge)))
             (not (stringp (vc-state file))))
         ;; XEmacs has no vc-state
-        (if (featurep 'xemacs) (not (vc-locking-user file))))
-       ))
+        (if (featurep 'xemacs) (not (vc-locking-user file))))))
 
 ;; checkout if visited file is checked in
 (defun viper-maybe-checkout (buf)
@@ -788,8 +808,8 @@
       (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)
-  )
+  (viper-change-cursor-color
+   (viper-frame-value viper-replace-overlay-cursor-color)))
 
 
 (defun viper-set-replace-overlay-glyphs (before-glyph after-glyph)
@@ -820,8 +840,7 @@
 
 (defun viper-set-minibuffer-overlay ()
   (viper-check-minibuffer-overlay)
-  (if (viper-has-face-support-p)
-      (progn
+  (when (viper-has-face-support-p)
        (viper-overlay-put
         viper-minibuffer-overlay 'face viper-minibuffer-current-face)
        (viper-overlay-put
@@ -833,11 +852,9 @@
         nil)
        ;; make viper-minibuffer-overlay open-ended
        ;; In emacs, it is made open ended at creation time
-       (if (featurep 'xemacs)
-           (progn
+    (when (featurep 'xemacs)
              (viper-overlay-put viper-minibuffer-overlay 'start-open nil)
-             (viper-overlay-put viper-minibuffer-overlay 'end-open nil)))
-       )))
+      (viper-overlay-put viper-minibuffer-overlay 'end-open nil))))
 
 (defun viper-check-minibuffer-overlay ()
   (if (viper-overlay-live-p viper-minibuffer-overlay)
@@ -852,8 +869,7 @@
            (viper-make-overlay
             (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)
             (1+ (buffer-size))
-            (current-buffer) nil 'rear-advance)))
-    ))
+            (current-buffer) nil 'rear-advance)))))
 
 
 (defsubst viper-is-in-minibuffer ()
@@ -865,12 +881,9 @@
 ;;; 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)
-   ))
+  (if (featurep 'xemacs)
+      (abbreviate-file-name file t)    ; XEmacs requires addl argument
+    (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.
@@ -893,10 +906,8 @@
          (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
-   ))
+  (if (featurep 'xemacs) (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).
@@ -909,16 +920,12 @@
 ;; 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
+  (if (featurep 'xemacs)
    (zmacs-deactivate-region)
-   (deactivate-mark)
-   ))
+    (deactivate-mark)))
 
 (defsubst viper-leave-region-active ()
-  (viper-cond-compile-for-xemacs-or-emacs
-   (setq zmacs-region-stays t)
-   nil
-   ))
+  (if (featurep 'xemacs) (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'.
@@ -940,10 +947,8 @@
 ;; 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
-   ))
+  (if (featurep 'xemacs) (copy-event event)
+    event))
 
 ;; Uses different timeouts for ESC-sequences and others
 (defsubst viper-fast-keysequence-p ()
@@ -956,14 +961,12 @@
 ;; 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
+    (if (featurep 'xemacs)
      (progn
        (setq event (next-command-event))
        (or (event-to-character event)
           event))
-     (read-event)
-     )
-    ))
+      (read-event))))
 
 ;; Viperized read-key-sequence
 (defun viper-read-key-sequence (prompt &optional continue-echo)
@@ -1014,14 +1017,14 @@
 (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
+  (when (if (featurep 'xemacs)
         (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
+           (if (featurep 'xemacs)
             ;; XEmacs
             (cond ((key-press-event-p event)
                    (event-key event))
@@ -1051,7 +1054,7 @@
                   ((and (null mod) (eq event 'backspace))
                    (setq event ?\C-h))
                   (t (event-basic-type event)))
-            ) ; viper-cond-compile-for-xemacs-or-emacs
+            ) ; (featurep 'xemacs)
            )
       (if (viper-characterp basis)
          (setq basis
@@ -1204,7 +1207,7 @@
          (t (prin1-to-string event-seq)))))
 
 (defun viper-key-press-events-to-chars (events)
-  (mapconcat (viper-cond-compile-for-xemacs-or-emacs
+  (mapconcat (if (featurep 'xemacs)
              (lambda (elt) (char-to-string (event-to-character elt))) ; xemacs
              'char-to-string ; emacs
              )