comparison lisp/emulation/viper-util.el @ 33019:6306740f6938

2000-10-29 Michael Kifer <[e-mail]> * viper-cmd.el (viper-preserve-cursor-color): new test that avoids rewrawing the screen when changing cursor color. (viper-insert-state-pre-command-sentinel, viper-replace-state-pre-command-sentinel, viper-replace-state-post-command-sentinel): use viper-preserve-cursor-color. Many functions changed to use viper= instead of = when comparing characters. * viper-util.el (viper-memq-char,viper=): new functions for working with characters. (viper-change-cursor-color): fixed buglet. Many functions changed to use viper= instead of = when comparing characters. * viper.el (viper-insert-state-mode-list): added eshell. * ediff-init.el (ediff-before-setup-hook): new hook. Several typos fixed in various docstrings. * ediff-merg.el (ediff-show-clashes-only): docstring typo fixed. * ediff-nult.el (ediff-before-session-group-setup-hooks): new hook. (ediff-show-meta-buffer): run ediff-before-session-group-setup-hooks. * ediff-util.el (ediff-setup): run ediff-before-setup-hook. (ediff-other-buffer): use selected buffers if in Buffer-menu buffer. (ediff-get-selected-buffers): new function. * ediff-vers.el (ediff-vc-internal,ediff-rcs-internal, ediff-vc-merge-internal,ediff-rcs-merge-internal): use save-window-excursion. * ediff-wind.el (ediff-skip-unsuitable-frames): more robust termination check in while loop. * ediff.el (ediff-get-default-file-name): better defaults when in dired buffer. (ediff-files,ediff-merge-files,ediff-files3, ediff-merge-files-with-ancestor): use ediff-get-default-file-name.

33018:d9abb0441663

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

(defsubst viper-color-display-p ()
  (if viper-emacs-p
      (x-display-color-p)
    (eq (device-class (selected-device)) 'color)))
   

;; 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))))
      (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)
  (if (and (viper-window-display-p) (viper-color-display-p))

(defun viper-hide-search-overlay ()
  (if (not (viper-overlay-p viper-search-overlay))
      (progn
	(setq viper-search-overlay
	      (viper-make-overlay beg end (current-buffer)))
	(viper-overlay-put
	 viper-search-overlay 'priority viper-search-overlay-priority)))
  (viper-overlay-put viper-search-overlay 'face nil))

;; Replace state

		     (setq event ?\C-h))
		    (t (event-basic-type event)))
	      )))
      (if (viper-characterp basis)
	  (setq basis
		(if (= basis ?\C-?)
		    (list 'control '\?) ; taking care of an emacs bug
		  (intern (char-to-string basis)))))
      (if mod
	  (append mod (list basis))
	basis))))

    (if char
	(if (eq viper-syntax-preference 'strict-vi)
	    (looking-at (concat "[" viper-strict-ALPHA-chars addl-chars "]"))
	  (or
	   ;; or one of the additional chars being asked to include
	   (memq char (viper-string-to-list addl-chars))
	   (and
	    ;; not one of the excluded word chars
	    (not (memq char viper-non-word-characters))
	    ;; char of the Viper-word syntax class
	    (memq (char-syntax char)
		  (viper-string-to-list viper-ALPHA-char-class))))))
    ))

(defun viper-looking-at-separator ()
  (let ((char (char-after (point))))
    (if char
	(if (eq viper-syntax-preference 'strict-vi)
	    (memq char (viper-string-to-list viper-strict-SEP-chars))
	  (or (eq char ?\n) ; RET is always a separator in Vi
	      (memq (char-syntax char)
		    (viper-string-to-list viper-SEP-char-class)))))
    ))

(defsubst viper-looking-at-alphasep (&optional addl-chars)
  (or (viper-looking-at-separator) (viper-looking-at-alpha addl-chars)))

		      (memq syntax-of-char-looked-at syntax))
		    ;; if char-syntax class is "word", make sure it is not one
		    ;; of the excluded characters
		    (if (and (eq syntax-of-char-looked-at ?w)
			     (not negated-syntax))
			(not (memq char-looked-at viper-non-word-characters))
		      t))
		   (funcall skip-syntax-func 1)
		 0)
	       (funcall skip-chars-func addl-chars limit)))
      (setq total (+ total local)))

33019:6306740f6938

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

; CHAR is supposed to be a char or an integer; LIST is a list of chars, nil,
; and negative numbers
; Check if CHAR is a member by trying to convert into integers, if necessary.
; Introduced for compatibility with XEmacs, where integers are not the same as
; chars.
(defun viper-memq-char (char list)
  (cond (viper-emacs-p (memq char list))
	((null char) (memq char list))
	((characterp char) (memq char list))
	((integerp char) (memq (int-to-char char) list))
	(t nil)))

;; Like =, but accommodates null and also is t for eq-objects
(defun viper= (char char1)
  (cond ((eq char char1) t)
	((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)))
   

;; 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)
  (if (and (viper-window-display-p) (viper-color-display-p))

(defun viper-hide-search-overlay ()
  (if (not (viper-overlay-p viper-search-overlay))
      (progn
	(setq viper-search-overlay
	      (viper-make-overlay (point-min) (point-min) (current-buffer)))
	(viper-overlay-put
	 viper-search-overlay 'priority viper-search-overlay-priority)))
  (viper-overlay-put viper-search-overlay 'face nil))

;; Replace state

		     (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)))))
      (if mod
	  (append mod (list basis))
	basis))))

    (if char
	(if (eq viper-syntax-preference 'strict-vi)
	    (looking-at (concat "[" viper-strict-ALPHA-chars addl-chars "]"))
	  (or
	   ;; or one of the additional chars being asked to include
	   (viper-memq-char char (viper-string-to-list addl-chars))
	   (and
	    ;; not one of the excluded word chars (note:
	    ;; viper-non-word-characters is a list)
	    (not (viper-memq-char char viper-non-word-characters))
	    ;; char of the Viper-word syntax class
	    (viper-memq-char (char-syntax char)
			     (viper-string-to-list viper-ALPHA-char-class))))))
    ))

(defun viper-looking-at-separator ()
  (let ((char (char-after (point))))
    (if char
	(if (eq viper-syntax-preference 'strict-vi)
	    (viper-memq-char char (viper-string-to-list viper-strict-SEP-chars))
	  (or (eq char ?\n) ; RET is always a separator in Vi
	      (viper-memq-char (char-syntax char)
			       (viper-string-to-list viper-SEP-char-class)))))
    ))

(defsubst viper-looking-at-alphasep (&optional addl-chars)
  (or (viper-looking-at-separator) (viper-looking-at-alpha addl-chars)))

		      (memq syntax-of-char-looked-at syntax))
		    ;; if char-syntax class is "word", make sure it is not one
		    ;; of the excluded characters
		    (if (and (eq syntax-of-char-looked-at ?w)
			     (not negated-syntax))
			(not (viper-memq-char
			      char-looked-at viper-non-word-characters))
		      t))
		   (funcall skip-syntax-func 1)
		 0)
	       (funcall skip-chars-func addl-chars limit)))
      (setq total (+ total local)))