CVS update by michaelk packages/xemacs-packages/viper, viper-mous.el,
viper-init.el ...
xemacs-cvs at xemacs.org
xemacs-cvs at xemacs.org
Thu Apr 3 17:14:03 EDT 2008
User: michaelk
Date: 08/04/03 23:14:03
Modified: packages/xemacs-packages/viper viper.el viper-util.el
viper-mous.el viper-macs.el viper-keym.el
viper-init.el viper-ex.el viper-cmd.el ChangeLog
Log:
* viper*.el: incorporated changes from the emacs tree.
* viper-macs.el (viper-read-fast-keysequence): use viper-read-event
instead of viper-read-key.
* viper.el (viper-mode): move the check for fundamental mode.
* viper-utils.el (viper-get-saved-cursor-color-in-replace-mode)
viper-get-saved-cursor-color-in-insert-mode): get rid of redundant
let-statements.
* viper*.el: replaced load with require in eval-when-compile.
Revision Changes Path
1.48 +64 -63 XEmacs/packages/xemacs-packages/viper/viper.el
Index: viper.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/viper/viper.el,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -p -r1.47 -r1.48
--- viper.el 2008/01/09 06:27:29 1.47
+++ viper.el 2008/04/03 21:14:00 1.48
@@ -403,7 +403,7 @@ widget."
:group 'viper-misc)
(defcustom viper-emacs-state-mode-list
- '(custom-mode
+ '(Custom-mode
dired-mode
efs-mode
@@ -597,13 +597,14 @@ This startup message appears whenever yo
))
(viper-set-expert-level 'dont-change-unless)))
- (if (eq major-mode 'viper-mode)
- (setq major-mode 'fundamental-mode))
-
(or (memq major-mode viper-emacs-state-mode-list) ; don't switch to Vi
(memq major-mode viper-insert-state-mode-list) ; don't switch
(viper-change-state-to-vi))
- )))
+ ))
+
+ (if (eq major-mode 'viper-mode)
+ (setq major-mode 'fundamental-mode))
+ )
;; Apply a little heuristic to invoke vi state on major-modes
@@ -1022,64 +1023,64 @@ It also can't undo some Viper settings."
(setq global-mode-string
(append '("" viper-mode-string) (cdr global-mode-string))))
- (viper-cond-compile-for-xemacs-or-emacs
- ;; XEmacs
- (defadvice describe-key (before viper-describe-key-ad protect activate)
- "Force to read key via `viper-read-key-sequence'."
- (interactive (list (viper-read-key-sequence "Describe key: "))))
- ;; Emacs
- (defadvice describe-key (before viper-describe-key-ad protect activate)
- "Force to read key via `viper-read-key-sequence'."
- (interactive (let (key)
- (setq key (viper-read-key-sequence
- "Describe key (or click or menu item): "))
- (list key
- (prefix-numeric-value current-prefix-arg)
- ;; If KEY is a down-event, read also the
- ;; corresponding up-event.
- (and (vectorp key)
- (let ((last-idx (1- (length key))))
- (and (eventp (aref key last-idx))
- (memq 'down (event-modifiers
- (aref key last-idx)))))
- (or (and (eventp (aref key 0))
- (memq 'down (event-modifiers
- (aref key 0)))
- ;; For the C-down-mouse-2 popup menu,
- ;; there is no subsequent up-event
- (= (length key) 1))
- (and (> (length key) 1)
- (eventp (aref key 1))
- (memq 'down (event-modifiers (aref key 1)))))
- (read-event))))))
- ) ; viper-cond-compile-for-xemacs-or-emacs
-
- (viper-cond-compile-for-xemacs-or-emacs
- ;; XEmacs
- (defadvice describe-key-briefly
- (before viper-describe-key-briefly-ad protect activate)
- "Force to read key via `viper-read-key-sequence'."
- (interactive (list (viper-read-key-sequence "Describe key briefly: "))))
- ;; Emacs
- (defadvice describe-key-briefly
- (before viper-describe-key-briefly-ad protect activate)
- "Force to read key via `viper-read-key-sequence'."
- (interactive (let (key)
- (setq key (viper-read-key-sequence
- "Describe key (or click or menu item): "))
- ;; If KEY is a down-event, read and discard the
- ;; corresponding up-event.
- (and (vectorp key)
- (let ((last-idx (1- (length key))))
- (and (eventp (aref key last-idx))
- (memq 'down (event-modifiers (aref key last-idx)))))
- (read-event))
- (list key
- (if current-prefix-arg
- (prefix-numeric-value current-prefix-arg))
- 1))))
- ) ;; viper-cond-compile-for-xemacs-or-emacs
-
+ (if (featurep 'xemacs)
+ ;; XEmacs
+ (defadvice describe-key (before viper-describe-key-ad protect activate)
+ "Force to read key via `viper-read-key-sequence'."
+ (interactive (list (viper-read-key-sequence "Describe key: "))))
+ ;; Emacs
+ (defadvice describe-key (before viper-describe-key-ad protect activate)
+ "Force to read key via `viper-read-key-sequence'."
+ (interactive (let (key)
+ (setq key (viper-read-key-sequence
+ "Describe key (or click or menu item): "))
+ (list key
+ (prefix-numeric-value current-prefix-arg)
+ ;; If KEY is a down-event, read also the
+ ;; corresponding up-event.
+ (and (vectorp key)
+ (let ((last-idx (1- (length key))))
+ (and (eventp (aref key last-idx))
+ (memq 'down (event-modifiers
+ (aref key last-idx)))))
+ (or (and (eventp (aref key 0))
+ (memq 'down (event-modifiers
+ (aref key 0)))
+ ;; For the C-down-mouse-2 popup menu,
+ ;; there is no subsequent up-event
+ (= (length key) 1))
+ (and (> (length key) 1)
+ (eventp (aref key 1))
+ (memq 'down (event-modifiers (aref key 1)))))
+ (read-event))))))
+ ) ; (if (featurep 'xemacs)
+
+ (if (featurep 'xemacs)
+ ;; XEmacs
+ (defadvice describe-key-briefly
+ (before viper-describe-key-briefly-ad protect activate)
+ "Force to read key via `viper-read-key-sequence'."
+ (interactive (list (viper-read-key-sequence "Describe key briefly: "))))
+ ;; Emacs
+ (defadvice describe-key-briefly
+ (before viper-describe-key-briefly-ad protect activate)
+ "Force to read key via `viper-read-key-sequence'."
+ (interactive (let (key)
+ (setq key (viper-read-key-sequence
+ "Describe key (or click or menu item): "))
+ ;; If KEY is a down-event, read and discard the
+ ;; corresponding up-event.
+ (and (vectorp key)
+ (let ((last-idx (1- (length key))))
+ (and (eventp (aref key last-idx))
+ (memq 'down (event-modifiers (aref key last-idx)))))
+ (read-event))
+ (list key
+ (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg))
+ 1))))
+ ) ; (if (featurep 'xemacs)
+
(defadvice find-file (before viper-add-suffix-advice activate)
"Use `read-file-name' for reading arguments."
(interactive (cons (read-file-name "Find file: " nil default-directory)
1.33 +115 -116 XEmacs/packages/xemacs-packages/viper/viper-util.el
Index: viper-util.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/viper/viper-util.el,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -p -r1.32 -r1.33
--- viper-util.el 2008/01/10 07:01:31 1.32
+++ viper-util.el 2008/04/03 21:14:00 1.33
@@ -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,30 @@
(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.
+ ;; Buffer-local values take precedence over frame-local ones.
+ (if (local-variable-p ',variable)
+ ,variable
+ ;; 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 +150,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 +187,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 +200,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 +209,9 @@
(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)))
+ (or (and (eq viper-current-state 'emacs-mode)
+ (viper-frame-value viper-emacs-state-cursor-color))
+ (viper-frame-value viper-vi-state-cursor-color))))
(defsubst viper-get-saved-cursor-color-in-insert-mode ()
(or
@@ -197,9 +219,9 @@
(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)))
+ (or (and (eq viper-current-state 'emacs-mode)
+ (viper-frame-value viper-emacs-state-cursor-color))
+ (viper-frame-value viper-vi-state-cursor-color))))
(defsubst viper-get-saved-cursor-color-in-emacs-mode ()
(or
@@ -207,7 +229,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)
@@ -676,11 +698,6 @@
))
-;; define remote file test
-(defun viper-file-remote-p (file-name)
- (file-remote-p 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
@@ -716,8 +733,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 +804,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 +836,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 +865,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 +877,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 +902,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 +916,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 +943,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 +957,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)
@@ -995,7 +994,7 @@
;; 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
+;; by correctly mapping key sequences for Left/Right/... (on an ascii
;; terminal) into logical keys left, right, etc.
(defun viper-read-key ()
(let ((overriding-local-map viper-overriding-map)
@@ -1014,14 +1013,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 +1050,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,10 +1203,10 @@
(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
- )
+ (mapconcat (if (featurep 'xemacs)
+ (lambda (elt) (char-to-string (event-to-character elt))) ; xemacs
+ 'char-to-string ; emacs
+ )
events
""))
1.14 +30 -39 XEmacs/packages/xemacs-packages/viper/viper-mous.el
Index: viper-mous.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/viper/viper-mous.el,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -p -r1.13 -r1.14
--- viper-mous.el 2008/01/09 06:27:30 1.13
+++ viper-mous.el 2008/04/03 21:14:00 1.14
@@ -41,10 +41,8 @@
;; in order to spare non-viperized emacs from being viperized
(if noninteractive
(eval-when-compile
- (let ((load-path (cons (expand-file-name ".") load-path)))
- (or (featurep 'viper-cmd)
- (load "viper-cmd.el" nil t 'nosuffix))
- )))
+ (require 'viper-cmd)
+ ))
;; end pacifier
(require 'viper-util)
@@ -120,10 +118,8 @@ considered related."
;; Returns window where click occurs
(defun viper-mouse-click-window (click)
- (let ((win (viper-cond-compile-for-xemacs-or-emacs
- (event-window click) ; xemacs
- (posn-window (event-start click)) ; emacs
- )))
+ (let ((win (if (featurep 'xemacs) (event-window click)
+ (posn-window (event-start click)))))
(if (window-live-p win)
win
(error "Click was not over a live window"))))
@@ -142,10 +138,8 @@ considered related."
;; Returns position of a click
(defsubst viper-mouse-click-posn (click)
- (viper-cond-compile-for-xemacs-or-emacs
- (event-point click) ; xemacs
- (posn-point (event-start click)) ; emacs
- ))
+ (if (featurep 'xemacs) (event-point click)
+ (posn-point (event-start click))))
(defun viper-surrounding-word (count click-count)
@@ -318,33 +312,30 @@ See `viper-surrounding-word' for the def
;; XEmacs has no double-click events. So, we must simulate.
;; So, we have to simulate event-click-count.
(defun viper-event-click-count (click)
- (viper-cond-compile-for-xemacs-or-emacs
- (viper-event-click-count-xemacs click) ; xemacs
- (event-click-count click) ; emacs
- ))
-
-;; kind of semaphore for updating viper-current-click-count
-(defvar viper-counting-clicks-p nil)
-(viper-cond-compile-for-xemacs-or-emacs
- (defun viper-event-click-count-xemacs (click)
- (let ((time-delta (- (event-timestamp click)
- viper-last-click-event-timestamp))
- inhibit-quit)
- (while viper-counting-clicks-p
- (ignore))
- (setq viper-counting-clicks-p t)
- (if (> time-delta viper-multiclick-timeout)
- (setq viper-current-click-count 0))
- (discard-input)
- (setq viper-current-click-count (1+ viper-current-click-count)
- viper-last-click-event-timestamp (event-timestamp click))
- (setq viper-counting-clicks-p nil)
- (if (viper-sit-for-short viper-multiclick-timeout t)
- viper-current-click-count
- 0)
- ))
- nil ; emacs
- )
+ (if (featurep 'xemacs) (viper-event-click-count-xemacs click)
+ (event-click-count click)))
+
+(when (featurep 'xemacs)
+
+ ;; kind of semaphore for updating viper-current-click-count
+ (defvar viper-counting-clicks-p nil)
+
+ (defun viper-event-click-count-xemacs (click)
+ (let ((time-delta (- (event-timestamp click)
+ viper-last-click-event-timestamp))
+ inhibit-quit)
+ (while viper-counting-clicks-p
+ (ignore))
+ (setq viper-counting-clicks-p t)
+ (if (> time-delta viper-multiclick-timeout)
+ (setq viper-current-click-count 0))
+ (discard-input)
+ (setq viper-current-click-count (1+ viper-current-click-count)
+ viper-last-click-event-timestamp (event-timestamp click))
+ (setq viper-counting-clicks-p nil)
+ (if (viper-sit-for-short viper-multiclick-timeout t)
+ viper-current-click-count
+ 0))))
(defun viper-mouse-click-search-word (click arg)
1.16 +9 -7 XEmacs/packages/xemacs-packages/viper/viper-macs.el
Index: viper-macs.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/viper/viper-macs.el,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -p -r1.15 -r1.16
--- viper-macs.el 2008/01/09 06:27:30 1.15
+++ viper-macs.el 2008/04/03 21:14:01 1.16
@@ -38,10 +38,8 @@
;; in order to spare non-viperized emacs from being viperized
(if noninteractive
(eval-when-compile
- (let ((load-path (cons (expand-file-name ".") load-path)))
- (or (featurep 'viper-cmd)
- (load "viper-cmd.el" nil t 'nosuffix))
- )))
+ (require 'viper-cmd)
+ ))
;; end pacifier
(require 'viper-util)
@@ -873,9 +871,13 @@ name from there."
(let ((lis (vector event))
next-event)
(while (and (viper-fast-keysequence-p)
- (viper-keyseq-is-a-possible-macro lis macro-alist))
- (setq next-event (viper-read-key))
- ;;(setq next-event (viper-read-event))
+ (viper-keyseq-is-a-possible-macro lis macro-alist))
+ ;; Seems that viper-read-event is more robust here. We need to be able to
+ ;; place these events on unread-command-events list. If we use
+ ;; viper-read-key then events will be converted to keys, and sometimes
+ ;; (e.g., (control \[)) those keys differ from the corresponding events.
+ ;; So, do not use (setq next-event (viper-read-key))
+ (setq next-event (viper-read-event))
(or (viper-mouse-event-p next-event)
(setq lis (vconcat lis (vector next-event)))))
lis))
1.21 +6 -8 XEmacs/packages/xemacs-packages/viper/viper-keym.el
Index: viper-keym.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/viper/viper-keym.el,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -p -r1.20 -r1.21
--- viper-keym.el 2008/01/10 07:01:31 1.20
+++ viper-keym.el 2008/04/03 21:14:01 1.21
@@ -681,14 +681,12 @@ Arguments: (major-mode viper-state keyma
(defun viper-add-keymap (mapsrc mapdst)
"Add contents of mapsrc to mapdst. It is assumed that mapsrc is sparse."
- (viper-cond-compile-for-xemacs-or-emacs
- ;; xemacs
- (map-keymap (lambda (key binding) (define-key mapdst key binding))
- mapsrc)
- ;; emacs
- (mapcar (lambda (p) (define-key mapdst (vector (car p)) (cdr p)))
- (cdr mapsrc))
- ))
+ (if (featurep 'xemacs)
+ ;; Emacs 22 has map-keymap.
+ (map-keymap (lambda (key binding) (define-key mapdst key binding))
+ mapsrc)
+ (mapc (lambda (p) (define-key mapdst (vector (car p)) (cdr p)))
+ (cdr mapsrc))))
(defun viper-modify-keymap (map alist)
"Modifies MAP with bindings specified in the ALIST. The alist has the
1.28 +22 -39 XEmacs/packages/xemacs-packages/viper/viper-init.el
Index: viper-init.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/viper/viper-init.el,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -p -r1.27 -r1.28
--- viper-init.el 2008/01/09 06:27:30 1.27
+++ viper-init.el 2008/04/03 21:14:01 1.28
@@ -49,30 +49,16 @@
;; Tell whether we are running as a window application or on a TTY
-;; This is used to avoid compilation warnings. When emacs/xemacs forms can
-;; generate compile time warnings, we use this macro.
-;; In this case, the macro will expand into the form that is appropriate to the
-;; compiler at hand.
-;; Suggested by rms.
-(defmacro viper-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form)
- (if (featurep 'xemacs)
- xemacs-form emacs-form))
-
-
(defsubst viper-device-type ()
- (viper-cond-compile-for-xemacs-or-emacs
- (device-type (selected-device))
- window-system
- ))
+ (if (featurep 'xemacs)
+ (device-type (selected-device))
+ window-system))
(defun viper-color-display-p ()
(condition-case nil
- (viper-cond-compile-for-xemacs-or-emacs
- (eq (device-class (selected-device)) 'color) ; xemacs form
- (if (fboundp 'display-color-p) ; emacs form
- (display-color-p)
- (x-display-color-p))
- )
+ (if (featurep 'xemacs)
+ (eq (device-class (selected-device)) 'color)
+ (display-color-p))
(error nil)))
;; in XEmacs: device-type is tty on tty and stream in batch.
@@ -353,7 +339,7 @@ Use `M-x viper-set-expert-level' to chan
(cond ((and (featurep 'emacs) (fboundp 'inactivate-input-method))
(inactivate-input-method))
((and (featurep 'xemacs) (boundp 'current-input-method))
- ;; XEmacs had broken quil-mode for some time, so we are working around
+ ;; XEmacs had broken quail-mode for some time, so we are working around
;; it here
(setq quail-mode nil)
(if (featurep 'quail)
@@ -444,11 +430,14 @@ delete the text being replaced, as in st
;; internal var, used to remember the default cursor color of emacs frames
(defvar viper-vi-state-cursor-color nil)
-(if (fboundp 'make-variable-frame-local)
- (dolist (v '(viper-replace-overlay-cursor-color
- viper-insert-state-cursor-color viper-emacs-state-cursor-color
- viper-vi-state-cursor-color))
- (make-variable-frame-local v)))
+;; Frame-local variables are obsolete from Emacs 22.2 onwards, so we
+;; do it by hand with viper-frame-value (qv).
+(when (and (featurep 'xemacs)
+ (fboundp 'make-variable-frame-local))
+ (make-variable-frame-local 'viper-replace-overlay-cursor-color)
+ (make-variable-frame-local 'viper-insert-state-cursor-color)
+ (make-variable-frame-local 'viper-emacs-state-cursor-color)
+ (make-variable-frame-local 'viper-vi-state-cursor-color))
(viper-deflocalvar viper-replace-overlay nil "")
(put 'viper-replace-overlay 'permanent-local t)
@@ -480,19 +469,13 @@ color displays. By default, the delimit
:group 'viper)
;; XEmacs requires glyphs
-(viper-cond-compile-for-xemacs-or-emacs
- (progn ; xemacs
- (or (glyphp viper-replace-region-end-delimiter)
- (setq viper-replace-region-end-delimiter
- (make-glyph viper-replace-region-end-delimiter)))
- (or (glyphp viper-replace-region-start-delimiter)
- (setq viper-replace-region-start-delimiter
- (make-glyph viper-replace-region-start-delimiter)))
- )
- nil ; emacs
- )
-
-
+(when (featurep 'xemacs)
+ (or (glyphp viper-replace-region-end-delimiter)
+ (setq viper-replace-region-end-delimiter
+ (make-glyph viper-replace-region-end-delimiter)))
+ (or (glyphp viper-replace-region-start-delimiter)
+ (setq viper-replace-region-start-delimiter
+ (make-glyph viper-replace-region-start-delimiter))))
;; These are local marker that must be initialized to nil and moved with
;; `viper-move-marker-locally'
1.32 +5 -8 XEmacs/packages/xemacs-packages/viper/viper-ex.el
Index: viper-ex.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/viper/viper-ex.el,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -p -r1.31 -r1.32
--- viper-ex.el 2008/01/09 06:27:30 1.31
+++ viper-ex.el 2008/04/03 21:14:01 1.32
@@ -46,10 +46,8 @@
;; in order to spare non-viperized emacs from being viperized
(if noninteractive
(eval-when-compile
- (let ((load-path (cons (expand-file-name ".") load-path)))
- (or (featurep 'viper-cmd)
- (load "viper-cmd.el" nil t 'nosuffix))
- )))
+ (require 'viper-cmd)
+ ))
;; end pacifier
(require 'viper-util)
@@ -2077,10 +2075,9 @@ Please contact your system administrator
;; create temp buffer for the region
(setq temp-buf (get-buffer-create " *ex-write*"))
(set-buffer temp-buf)
- (viper-cond-compile-for-xemacs-or-emacs
- (set-visited-file-name ex-file) ; xemacs
- (set-visited-file-name ex-file 'noquerry) ; emacs
- )
+ (if (featurep 'xemacs)
+ (set-visited-file-name ex-file)
+ (set-visited-file-name ex-file 'noquery))
(erase-buffer)
(if (and file-exists ex-append)
(insert-file-contents ex-file))
1.44 +63 -78 XEmacs/packages/xemacs-packages/viper/viper-cmd.el
Index: viper-cmd.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/viper/viper-cmd.el,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -p -r1.43 -r1.44
--- viper-cmd.el 2008/01/10 07:01:31 1.43
+++ viper-cmd.el 2008/04/03 21:14:01 1.44
@@ -41,7 +41,6 @@
(defvar iso-accents-mode)
(defvar quail-mode)
(defvar quail-current-str)
-(defvar zmacs-region-stays)
(defvar mark-even-if-inactive)
(defvar init-message)
(defvar initial)
@@ -177,31 +176,28 @@
(viper-set-replace-overlay (point-min) (point-min))
(viper-hide-replace-overlay)))
(if (eq viper-current-state 'insert-state)
- (let ((has-saved-cursor-color-in-insert-mode
- (stringp (viper-get-saved-cursor-color-in-insert-mode))))
- (or has-saved-cursor-color-in-insert-mode
- (string= (viper-get-cursor-color) viper-insert-state-cursor-color)
+ (let ((icolor (viper-frame-value viper-insert-state-cursor-color)))
+ (or (stringp (viper-get-saved-cursor-color-in-insert-mode))
+ (string= (viper-get-cursor-color) icolor)
;; save current color, if not already saved
(viper-save-cursor-color 'before-insert-mode))
;; set insert mode cursor color
- (viper-change-cursor-color viper-insert-state-cursor-color)))
- (if (and viper-emacs-state-cursor-color (eq viper-current-state 'emacs-state))
- (let ((has-saved-cursor-color-in-emacs-mode
- (stringp (viper-get-saved-cursor-color-in-emacs-mode))))
- (or has-saved-cursor-color-in-emacs-mode
- (string= (viper-get-cursor-color) viper-emacs-state-cursor-color)
- ;; save current color, if not already saved
- (viper-save-cursor-color 'before-emacs-mode))
- ;; set emacs mode cursor color
- (viper-change-cursor-color viper-emacs-state-cursor-color)))
+ (viper-change-cursor-color icolor)))
+ (let ((ecolor (viper-frame-value viper-emacs-state-cursor-color)))
+ (when (and ecolor (eq viper-current-state 'emacs-state))
+ (or (stringp (viper-get-saved-cursor-color-in-emacs-mode))
+ (string= (viper-get-cursor-color) ecolor)
+ ;; save current color, if not already saved
+ (viper-save-cursor-color 'before-emacs-mode))
+ ;; set emacs mode cursor color
+ (viper-change-cursor-color ecolor)))
(if (and (memq this-command '(dabbrev-expand hippie-expand))
(integerp viper-pre-command-point)
(markerp viper-insert-point)
(marker-position viper-insert-point)
(> viper-insert-point viper-pre-command-point))
- (viper-move-marker-locally viper-insert-point viper-pre-command-point))
- )
+ (viper-move-marker-locally viper-insert-point viper-pre-command-point)))
(defsubst viper-preserve-cursor-color ()
(or (memq this-command '(self-insert-command
@@ -231,9 +227,9 @@
;; will remain red. Restoring the default, below, prevents this.
(if (and (<= (viper-replace-start) (point))
(<= (point) (viper-replace-end)))
- (viper-change-cursor-color viper-replace-overlay-cursor-color)
- (viper-restore-cursor-color 'after-replace-mode)
- ))
+ (viper-change-cursor-color
+ (viper-frame-value viper-replace-overlay-cursor-color))
+ (viper-restore-cursor-color 'after-replace-mode)))
;; to speed up, don't change cursor color before self-insert
;; and common move commands
@@ -284,14 +280,13 @@
(if (= viper-last-posn-in-replace-region (viper-replace-end))
(viper-finish-change)))
- (if (viper-pos-within-region
- (point) (viper-replace-start) replace-boundary)
- (progn
- ;; the state may have changed in viper-finish-change above
- (if (eq viper-current-state 'replace-state)
- (viper-change-cursor-color viper-replace-overlay-cursor-color))
- (setq viper-last-posn-in-replace-region (point-marker))))
- ))
+ (when (viper-pos-within-region
+ (point) (viper-replace-start) replace-boundary)
+ ;; the state may have changed in viper-finish-change above
+ (if (eq viper-current-state 'replace-state)
+ (viper-change-cursor-color
+ (viper-frame-value viper-replace-overlay-cursor-color)))
+ (setq viper-last-posn-in-replace-region (point-marker)))))
;; terminate replace mode if changed Viper states.
(t (viper-finish-change))))
@@ -305,15 +300,11 @@
;; desirable that viper-pre-command-sentinel is the last hook and
;; viper-post-command-sentinel is the first hook.
- (viper-cond-compile-for-xemacs-or-emacs
- ;; xemacs
- (progn
- (make-local-hook 'viper-after-change-functions)
- (make-local-hook 'viper-before-change-functions)
- (make-local-hook 'viper-post-command-hooks)
- (make-local-hook 'viper-pre-command-hooks))
- nil ; emacs
- )
+ (when (featurep 'xemacs)
+ (make-local-hook 'viper-after-change-functions)
+ (make-local-hook 'viper-before-change-functions)
+ (make-local-hook 'viper-post-command-hooks)
+ (make-local-hook 'viper-pre-command-hooks))
(remove-hook 'post-command-hook 'viper-post-command-sentinel)
(add-hook 'post-command-hook 'viper-post-command-sentinel)
@@ -662,12 +653,11 @@
(viper-set-replace-overlay (point-min) (point-min)))
(viper-hide-replace-overlay)
- (let ((has-saved-cursor-color-in-insert-mode
- (stringp (viper-get-saved-cursor-color-in-insert-mode))))
- (or has-saved-cursor-color-in-insert-mode
- (string= (viper-get-cursor-color) viper-insert-state-cursor-color)
+ (let ((icolor (viper-frame-value viper-insert-state-cursor-color)))
+ (or (stringp (viper-get-saved-cursor-color-in-insert-mode))
+ (string= (viper-get-cursor-color) icolor)
(viper-save-cursor-color 'before-insert-mode))
- (viper-change-cursor-color viper-insert-state-cursor-color))
+ (viper-change-cursor-color icolor))
;; Protect against user errors in hooks
(condition-case conds
@@ -710,13 +700,12 @@
(viper-set-replace-overlay (point-min) (point-min)))
(viper-hide-replace-overlay)
- (if viper-emacs-state-cursor-color
- (let ((has-saved-cursor-color-in-emacs-mode
- (stringp (viper-get-saved-cursor-color-in-emacs-mode))))
- (or has-saved-cursor-color-in-emacs-mode
- (string= (viper-get-cursor-color) viper-emacs-state-cursor-color)
- (viper-save-cursor-color 'before-emacs-mode))
- (viper-change-cursor-color viper-emacs-state-cursor-color)))
+ (let ((ecolor (viper-frame-value viper-emacs-state-cursor-color)))
+ (when ecolor
+ (or (stringp (viper-get-saved-cursor-color-in-emacs-mode))
+ (string= (viper-get-cursor-color) ecolor)
+ (viper-save-cursor-color 'before-emacs-mode))
+ (viper-change-cursor-color ecolor)))
(viper-change-state 'emacs-state)
@@ -779,16 +768,15 @@ Vi's prefix argument will be used. Othe
;; this-command, last-command-char, last-command-event
(setq this-command com)
- (viper-cond-compile-for-xemacs-or-emacs
- ;; XEmacs represents key sequences as vectors
- (setq last-command-event
- (viper-copy-event (viper-seq-last-elt key))
- last-command-char (event-to-character last-command-event))
- ;; Emacs represents them as sequences (str or vec)
- (setq last-command-event
- (viper-copy-event (viper-seq-last-elt key))
- last-command-char last-command-event)
- )
+ (if (featurep 'xemacs)
+ ;; XEmacs represents key sequences as vectors
+ (setq last-command-event
+ (viper-copy-event (viper-seq-last-elt key))
+ last-command-char (event-to-character last-command-event))
+ ;; Emacs represents them as sequences (str or vec)
+ (setq last-command-event
+ (viper-copy-event (viper-seq-last-elt key))
+ last-command-char last-command-event))
(if (commandp com)
;; pretend that current state is the state we excaped to
@@ -1850,14 +1838,14 @@ invokes the command before that, etc."
(message " `.' runs %s%s"
(concat "`" (viper-array-to-string keys) "'")
(viper-abbreviate-string
- (viper-cond-compile-for-xemacs-or-emacs
- (replace-in-string ; xemacs
- (cond ((characterp text) (char-to-string text))
- ((stringp text) text)
- (t ""))
- "\n" "^J")
- text ; emacs
- )
+ (if (featurep 'xemacs)
+ (replace-in-string ; xemacs
+ (cond ((characterp text) (char-to-string text))
+ ((stringp text) text)
+ (t ""))
+ "\n" "^J")
+ text ; emacs
+ )
max-text-len
" inserting `" "'" " ......."))
))
@@ -2170,10 +2158,10 @@ To turn this feature off, set this varia
(setq cmd
(key-binding (setq key (read-key-sequence nil))))
(cond ((eq cmd 'self-insert-command)
- (viper-cond-compile-for-xemacs-or-emacs
- (insert (events-to-keys key)) ; xemacs
- (insert key) ; emacs
- ))
+ (if (featurep 'xemacs)
+ (insert (events-to-keys key)) ; xemacs
+ (insert key) ; emacs
+ ))
((memq cmd '(exit-minibuffer viper-exit-minibuffer))
nil)
(t (command-execute cmd)))
@@ -3462,11 +3450,9 @@ controlled by the sign of prefix numeric
;; (which is called from viper-search-forward/backward/next). If the value of
;; viper-search-scroll-threshold is negative - don't scroll.
(defun viper-adjust-window ()
- (let ((win-height (viper-cond-compile-for-xemacs-or-emacs
- (window-displayed-height) ; xemacs
- ;; emacs
- (1- (window-height)) ; adjust for modeline
- ))
+ (let ((win-height (if (featurep 'xemacs)
+ (window-displayed-height)
+ (1- (window-height)))) ; adjust for modeline
(pt (point))
at-top-p at-bottom-p
min-scroll direction)
@@ -3477,8 +3463,7 @@ controlled by the sign of prefix numeric
viper-search-scroll-threshold))
(move-to-window-line -1) ; bottom
(setq at-bottom-p
- (<= (count-lines pt (point)) viper-search-scroll-threshold))
- )
+ (<= (count-lines pt (point)) viper-search-scroll-threshold)))
(cond (at-top-p (setq min-scroll (1- viper-search-scroll-threshold)
direction 1))
(at-bottom-p (setq min-scroll (1+ viper-search-scroll-threshold)
1.100 +15 -0 XEmacs/packages/xemacs-packages/viper/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/viper/ChangeLog,v
retrieving revision 1.99
retrieving revision 1.100
diff -u -p -r1.99 -r1.100
--- ChangeLog 2008/01/10 08:15:14 1.99
+++ ChangeLog 2008/04/03 21:14:01 1.100
@@ -1,3 +1,18 @@
+2008-04-03 Michael Kifer <kifer at cs.stonybrook.edu>
+
+ * viper*.el: incorporated changes from the emacs tree.
+
+ * viper-macs.el (viper-read-fast-keysequence): use viper-read-event
+ instead of viper-read-key.
+
+ * viper.el (viper-mode): move the check for fundamental mode.
+
+ * viper-utils.el (viper-get-saved-cursor-color-in-replace-mode)
+ viper-get-saved-cursor-color-in-insert-mode): get rid of redundant
+ let-statements.
+
+ * viper*.el: replaced load with require in eval-when-compile.
+
2008-01-10 Norbert Koch <viteno at xemacs.org>
* Makefile (VERSION): XEmacs package 1.61 released.
More information about the XEmacs-CVS
mailing list