Mercurial > emacs

changeset 92380:8ee8aa679c74

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(zmacs-region-stays): No need to define for compiler. Expand all viper-cond-compile-for-xemacs-or-emacs calls to a featurep test. Replace obselete frame-local variables with frame-parameters. (viper-frame-value): New macro. (viper-set-cursor-color-according-to-state, viper-save-cursor-color) (viper-get-saved-cursor-color-in-replace-mode) (viper-get-saved-cursor-color-in-insert-mode) (viper-get-saved-cursor-color-in-emacs-mode, viper-set-replace-overlay): Use viper-frame-value for viper-replace-overlay-cursor-color, viper-emacs-state-cursor-color, viper-insert-state-cursor-color, and viper-vi-state-cursor-color values. (viper-set-minibuffer-overlay): Use when rather than if.
author Glenn Morris <rgm@gnu.org>
date Sat, 01 Mar 2008 20:19:23 +0000
parents 3b2c0edcb428
children edc3ba5b9670
files lisp/emulation/viper-util.el
diffstat 1 files changed, 108 insertions(+), 105 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/emulation/viper-util.el	Sat Mar 01 20:14:46 2008 +0000
+++ b/lisp/emulation/viper-util.el	Sat Mar 01 20:19:23 2008 +0000
@@ -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)
@@ -61,31 +60,31 @@
       (fset 'x-color-defined-p (symbol-function 'ns-color-defined-p)))
 
 
-(defalias 'viper-overlay-p 
+(defalias 'viper-overlay-p
   (if (featurep 'xemacs) 'extentp 'overlayp))
-(defalias 'viper-make-overlay 
+(defalias 'viper-make-overlay
   (if (featurep 'xemacs) 'make-extent 'make-overlay))
-(defalias 'viper-overlay-live-p 
+(defalias 'viper-overlay-live-p
   (if (featurep 'xemacs) 'extent-live-p 'overlayp))
-(defalias 'viper-move-overlay 
+(defalias 'viper-move-overlay
   (if (featurep 'xemacs) 'set-extent-endpoints 'move-overlay))
-(defalias 'viper-overlay-start 
+(defalias 'viper-overlay-start
   (if (featurep 'xemacs) 'extent-start-position 'overlay-start))
-(defalias 'viper-overlay-end 
+(defalias 'viper-overlay-end
   (if (featurep 'xemacs) 'extent-end-position 'overlay-end))
-(defalias 'viper-overlay-get 
+(defalias 'viper-overlay-get
   (if (featurep 'xemacs) 'extent-property 'overlay-get))
-(defalias 'viper-overlay-put 
+(defalias 'viper-overlay-put
   (if (featurep 'xemacs) 'set-extent-property 'overlay-put))
-(defalias 'viper-read-event 
+(defalias 'viper-read-event
   (if (featurep 'xemacs) 'next-command-event 'read-event))
-(defalias 'viper-characterp 
+(defalias 'viper-characterp
   (if (featurep 'xemacs) 'characterp 'integerp))
-(defalias 'viper-int-to-char 
+(defalias 'viper-int-to-char
   (if (featurep 'xemacs) 'int-to-char 'identity))
-(defalias 'viper-get-face 
+(defalias 'viper-get-face
   (if (featurep 'xemacs) 'get-face 'internal-get-face))
-(defalias 'viper-color-defined-p 
+(defalias 'viper-color-defined-p
   (if (featurep 'xemacs) 'valid-color-name-p 'x-color-defined-p))
 (defalias 'viper-iconify
   (if (featurep 'xemacs) 'iconify-frame 'iconify-or-deiconify-frame))
@@ -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
-   (color-instance-name
-    (frame-property (or frame (selected-frame)) 'cursor-color)) ; xemacs
-   (cdr (assoc 'cursor-color (frame-parameters))) ; emacs
-   ))
+  (if (featurep 'xemacs)
+      (color-instance-name
+       (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
-       (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)))
-       )
-    ))
+      (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))))))
 
+;; 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,24 +840,21 @@
 
 (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 (featurep 'emacs) 'evaporate 'detachable)
-	 nil)
-	;; make viper-minibuffer-overlay open-ended
-	;; In emacs, it is made open ended at creation time
-	(if (featurep 'xemacs)
-	    (progn
-	      (viper-overlay-put viper-minibuffer-overlay 'start-open nil)
-	      (viper-overlay-put viper-minibuffer-overlay 'end-open nil)))
-	)))
+  (when (viper-has-face-support-p)
+    (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 (featurep 'emacs) 'evaporate 'detachable)
+     nil)
+    ;; make viper-minibuffer-overlay open-ended
+    ;; In emacs, it is made open ended at creation time
+    (when (featurep 'xemacs)
+      (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)
@@ -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
-   (zmacs-deactivate-region)
-   (deactivate-mark)
-   ))
+  (if (featurep 'xemacs)
+      (zmacs-deactivate-region)
+    (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
-     (progn
-       (setq event (next-command-event))
-       (or (event-to-character event)
-	   event))
-     (read-event)
-     )
-    ))
+    (if (featurep 'xemacs)
+        (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)
@@ -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
 	      )