]> code.delx.au - gnu-emacs/blobdiff - lisp/emulation/viper-util.el
Merge.
[gnu-emacs] / lisp / emulation / viper-util.el
index e4db47018285b1d9e13aa1d6b8d7c12c8272f5d3..24a38236176c78e1ecb5b54e459a3256d20719a2 100644 (file)
@@ -1,9 +1,9 @@
 ;;; viper-util.el --- Utilities used by viper.el
 
-;; Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 1999-2011  Free Software Foundation, Inc.
 
 ;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
+;; Package: viper
 
 ;; This file is part of GNU Emacs.
 
 (require 'viper-init)
 
 
-;; A fix for NeXT Step
-;; Should go away, when NS people fix the design flaw, which leaves the
-;; two x-* functions undefined.
-(if (and (not (fboundp 'x-display-color-p)) (fboundp 'ns-display-color-p))
-    (fset 'x-display-color-p (symbol-function 'ns-display-color-p)))
-(if (and (not (fboundp 'x-color-defined-p)) (fboundp 'ns-color-defined-p))
-      (fset 'x-color-defined-p (symbol-function 'ns-color-defined-p)))
-
 \f
 (defalias 'viper-overlay-p
   (if (featurep 'xemacs) 'extentp 'overlayp))
@@ -84,7 +76,7 @@
 (defalias 'viper-int-to-char
   (if (featurep 'xemacs) 'int-to-char 'identity))
 (defalias 'viper-get-face
-  (if (featurep 'xemacs) 'get-face 'internal-get-face))
+  (if (featurep 'xemacs) 'get-face 'facep))
 (defalias 'viper-color-defined-p
   (if (featurep 'xemacs) 'valid-color-name-p 'x-color-defined-p))
 (defalias 'viper-iconify
@@ -182,12 +174,14 @@ Otherwise return the normal value."
          (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
+;; By default, saves current frame cursor color before changing viper state
 (defun viper-save-cursor-color (before-which-mode)
   (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)
+                ;; there is something fishy in that the color is not saved if
+                ;; it is the same as frames default cursor color. need to be
+                ;; checked.
                 (not (string= color
                               (viper-frame-value
                                viper-replace-overlay-cursor-color))))
@@ -204,7 +198,7 @@ Otherwise return the normal value."
               color)))))))
 
 
-(defsubst viper-get-saved-cursor-color-in-replace-mode ()
+(defun viper-get-saved-cursor-color-in-replace-mode ()
   (or
    (funcall
     (if (featurep 'emacs) 'frame-parameter 'frame-property)
@@ -214,7 +208,7 @@ Otherwise return the normal value."
            (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 ()
+(defun viper-get-saved-cursor-color-in-insert-mode ()
   (or
    (funcall
     (if (featurep 'emacs) 'frame-parameter 'frame-property)
@@ -224,7 +218,7 @@ Otherwise return the normal value."
            (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 ()
+(defun viper-get-saved-cursor-color-in-emacs-mode ()
   (or
    (funcall
     (if (featurep 'emacs) 'frame-parameter 'frame-property)
@@ -405,11 +399,10 @@ Otherwise return the normal value."
 ;;; Support for :e, :r, :w file globbing
 
 ;; Glob the file spec.
-;; This function is designed to work under Unix.  It might also work under VMS.
+;; This function is designed to work under Unix.
 (defun viper-glob-unix-files (filespec)
   (let ((gshell
         (cond (ex-unix-type-shell shell-file-name)
-              ((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VAX VMS
               (t "sh"))) ; probably Unix anyway
        (gshell-options
         ;; using cond in anticipation of further additions
@@ -418,8 +411,7 @@ Otherwise return the normal value."
        (command (cond (viper-ms-style-os-p (format "\"ls -1 -d %s\"" filespec))
                       (t (format "ls -1 -d %s" filespec))))
        status)
-    (save-excursion
-      (set-buffer (get-buffer-create viper-ex-tmp-buf-name))
+    (with-current-buffer (get-buffer-create viper-ex-tmp-buf-name)
       (erase-buffer)
       (setq status
            (if gshell-options
@@ -476,8 +468,7 @@ Otherwise return the normal value."
 
 ;; convert MS-DOS wildcards to regexp
 (defun viper-wildcard-to-regexp (wcard)
-  (save-excursion
-    (set-buffer (get-buffer-create viper-ex-tmp-buf-name))
+  (with-current-buffer (get-buffer-create viper-ex-tmp-buf-name)
     (erase-buffer)
     (insert wcard)
     (goto-char (point-min))
@@ -497,8 +488,7 @@ Otherwise return the normal value."
 (defun viper-glob-mswindows-files (filespec)
   (let ((case-fold-search t)
        tmp tmp2)
-    (save-excursion
-      (set-buffer (get-buffer-create viper-ex-tmp-buf-name))
+    (with-current-buffer (get-buffer-create viper-ex-tmp-buf-name)
       (erase-buffer)
       (insert filespec)
       (goto-char (point-min))
@@ -663,8 +653,7 @@ Otherwise return the normal value."
         (buf (find-file-noselect (substitute-in-file-name custom-file)))
        )
     (message "%s" (or message ""))
-    (save-excursion
-      (set-buffer buf)
+    (with-current-buffer buf
       (goto-char (point-min))
       (if (re-search-forward regexp nil t)
          (let ((reg-end (1- (match-end 0))))
@@ -687,8 +676,7 @@ Otherwise return the normal value."
 ;; match this pattern.
 (defun viper-save-string-in-file (string custom-file &optional pattern)
   (let ((buf (find-file-noselect (substitute-in-file-name custom-file))))
-    (save-excursion
-      (set-buffer buf)
+    (with-current-buffer buf
       (let (buffer-read-only)
        (goto-char (point-min))
        (if pattern (delete-matching-lines pattern))
@@ -898,8 +886,7 @@ Otherwise return the normal value."
   (if (and (markerp marker) (marker-buffer marker))
       (let ((buf (marker-buffer marker))
            (pos (marker-position marker)))
-       (save-excursion
-         (set-buffer buf)
+       (with-current-buffer buf
          (and (<= pos (point-max)) (<= (point-min) pos))))))
 
 (defsubst viper-mark-marker ()
@@ -948,10 +935,10 @@ Otherwise return the normal value."
     event))
 
 ;; Uses different timeouts for ESC-sequences and others
-(defsubst viper-fast-keysequence-p ()
+(defun viper-fast-keysequence-p ()
   (not (viper-sit-for-short
        (if (viper-ESC-event-p last-input-event)
-           viper-ESC-keyseq-timeout
+           (viper-ESC-keyseq-timeout)
          viper-fast-keyseq-timeout)
        t)))
 
@@ -1062,6 +1049,11 @@ Otherwise return the normal value."
          (append mod (list basis))
        basis))))
 
+(defun viper-last-command-char ()
+  (if (featurep 'xemacs)
+      (event-to-character last-command-event)
+    last-command-event))
+
 (defun viper-key-to-emacs-key (key)
   (let (key-name char-p modifiers mod-char-list base-key base-key-name)
     (cond ((featurep 'xemacs) key)
@@ -1088,7 +1080,7 @@ Otherwise return the normal value."
                 char-p (= (length base-key-name) 1))
           (setq mod-char-list
                 (mapcar
-                 '(lambda (elt) (upcase (substring (symbol-name elt) 0 1)))
+                 (lambda (elt) (upcase (substring (symbol-name elt) 0 1)))
                  modifiers))
           (if char-p
               (setq key-name
@@ -1161,7 +1153,7 @@ Otherwise return the normal value."
 ;; XEmacs only
 (defun viper-event-vector-p (vec)
   (and (vectorp vec)
-       (eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec)))))
+       (eval (cons 'and (mapcar (lambda (elt) (if (eventp elt) t)) vec)))))
 
 
 ;; check if vec is a vector of character symbols
@@ -1247,7 +1239,7 @@ Arguments become related buffers.  This function should normally be used in
 the `Local variables' section of a file."
   (setq viper-related-files-and-buffers-ring
        (make-ring (1+ (length other-files-or-buffers))))
-  (mapc '(lambda (elt)
+  (mapc (lambda (elt)
          (viper-ring-insert viper-related-files-and-buffers-ring elt))
        other-files-or-buffers)
   (viper-ring-insert viper-related-files-and-buffers-ring (buffer-name))
@@ -1558,9 +1550,8 @@ This option is appropriate if you like Emacs-style words."
 
 
 
-;;; Local Variables:
-;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
-;;; End:
+;; Local Variables:
+;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
+;; End:
 
-;; arch-tag: 7f023fd5-dd9e-4378-a397-9c179553b0e3
 ;;; viper-util.el ends here