diff lisp/viper/viper-util.el @ 12:bcdc7deadc19 r19-15b7

Import from CVS: tag r19-15b7
author cvs
date Mon, 13 Aug 2007 08:48:16 +0200
parents 376386a54a3c
children 9ee227acff29
line wrap: on
line diff
--- a/lisp/viper/viper-util.el	Mon Aug 13 08:47:56 2007 +0200
+++ b/lisp/viper/viper-util.el	Mon Aug 13 08:48:16 2007 +0200
@@ -55,7 +55,12 @@
     (device-type (selected-device))))
 ;; in XEmacs: device-type is tty on tty and stream in batch.
 (defun vip-window-display-p ()
-  (and (vip-device-type) (not (memq (vip-device-type) '(tty stream)))))
+  (and (vip-device-type) (not (memq (vip-device-type) '(tty stream pc)))))
+
+(defvar vip-ms-style-os-p (memq system-type '(ms-dos windows-nt windows-95))
+  "Tells if Emacs is running under an MS-style OS: ms-dos, windows-nt, W95.")
+(defvar vip-vms-os-p (memq system-type '(vax-vms axp-vms))
+  "Tells if Emacs is running under VMS.")
 
 (defvar vip-force-faces nil
   "If t, Viper will think that it is running on a display that supports faces.
@@ -194,7 +199,19 @@
     (eq (device-class (selected-device)) 'color)))
    
 (defsubst vip-get-cursor-color ()
-  (cdr (assoc 'cursor-color (frame-parameters))))
+  (if vip-emacs-p
+      (cdr (assoc 'cursor-color (frame-parameters)))
+    (color-instance-name (frame-property (selected-frame) 'cursor-color))))
+  
+(defun vip-set-face-pixmap (face pixmap)
+  "Set face pixmap on a monochrome display."
+  (if (and (vip-window-display-p) (not (vip-color-display-p)))
+      (condition-case nil
+	  (set-face-background-pixmap face pixmap)
+	(error
+	 (message "Pixmap not found for %S: %s" (face-name face) pixmap)
+	 (sit-for 1)))))
+
   
 ;; OS/2
 (cond ((eq (vip-device-type) 'pm)
@@ -232,10 +249,13 @@
 		 (not (string= color vip-replace-overlay-cursor-color)))
 	    (vip-overlay-put vip-replace-overlay 'vip-cursor-color color)))))
 	
-(defsubst vip-restore-cursor-color ()
+;; restore cursor color from replace overlay
+(defsubst vip-restore-cursor-color-after-replace ()
   (vip-change-cursor-color
    (vip-overlay-get vip-replace-overlay 'vip-cursor-color)))
-	 
+(defsubst vip-restore-cursor-color-after-insert ()
+  (vip-change-cursor-color vip-saved-cursor-color))
+
 
 ;; Check the current version against the major and minor version numbers
 ;; using op: cur-vers op major.minor If emacs-major-version or
@@ -418,11 +438,11 @@
 	 ;; using cond in anticipation of further additions
 	 (cond (ex-unix-type-shell-options)
 	       ))
-	(command (cond (vip-ms-style-os-p (format "\"ls -1 %s\"" filespec))
-		       (t (format "ls -1 %s" filespec))))
-	file-list)
+	(command (cond (vip-ms-style-os-p (format "\"ls -1 -d %s\"" filespec))
+		       (t (format "ls -1 -d %s" filespec))))
+	file-list status)
     (save-excursion 
-      (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name)))
+      (set-buffer (get-buffer-create vip-ex-tmp-buf-name))
       (erase-buffer)
       (setq status
 	    (if gshell-options
@@ -462,7 +482,7 @@
 `ex-nontrivial-find-file-function'. If this doesn't work, the user may have
 to write a custom function, similar to `vip-ex-nontrivial-find-file-unix'."
   (save-excursion 
-    (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name)))
+    (set-buffer (get-buffer-create vip-ex-tmp-buf-name))
     (erase-buffer)
     (insert filespec)
     (goto-char (point-min))
@@ -475,7 +495,7 @@
 ;; return a list of file names listed in the buffer beginning at point
 ;; If optional arg is supplied, assume each filename is listed on a separate
 ;; line
-(defun vip-get-filenames-from-buffer (one-per-line)
+(defun vip-get-filenames-from-buffer (&optional one-per-line)
   (let ((skip-chars (if one-per-line "\t\n" " \t\n"))
 	 result fname delim)
     (skip-chars-forward skip-chars)
@@ -500,7 +520,7 @@
 ;; convert MS-DOS wildcards to regexp
 (defun vip-wildcard-to-regexp (wcard)
   (save-excursion
-    (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name)))
+    (set-buffer (get-buffer-create vip-ex-tmp-buf-name))
     (erase-buffer)
     (insert wcard)
     (goto-char (point-min))
@@ -536,7 +556,11 @@
       (setq tmp (cdr tmp)))
     (reverse (apply 'append tmp2))))
 
-      
+(defun vip-convert-standard-file-name (fname)
+  (if vip-emacs-p
+      (convert-standard-filename fname)
+    ;; hopefully, XEmacs adds this functionality
+    fname))
 
 
 
@@ -736,6 +760,7 @@
 	(sit-for 2)
 	(vip-overlay-put vip-search-overlay 'face nil))))
 
+
 ;; Replace state
 
 (defsubst vip-move-replace-overlay (beg end)
@@ -767,7 +792,8 @@
   
 (defsubst vip-hide-replace-overlay ()
   (vip-set-replace-overlay-glyphs nil nil)
-  (vip-restore-cursor-color)
+  (vip-restore-cursor-color-after-replace)
+  (vip-restore-cursor-color-after-insert)
   (if (vip-has-face-support-p)
       (vip-overlay-put vip-replace-overlay 'face nil)))
 
@@ -934,15 +960,17 @@
 
 ;; This function lets function-key-map convert key sequences into logical
 ;; keys. This does a better job than vip-read-event when it comes to kbd
-;; macros, since it enables certain macros to be shared between X and TTY
-;; modes.
+;; 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
+;; terminal) into logical keys left, right, etc.
 (defun vip-read-key () 
-  (let ((overriding-local-map vip-overriding-map) 
+  (let ((overriding-local-map vip-overriding-map)
+	(inhibit-quit t)
         key) 
     (use-global-map vip-overriding-map) 
     (setq key (elt (read-key-sequence nil) 0)) 
     (use-global-map global-map) 
-    key)) 
+    key))
 
 
 ;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil)
@@ -1126,9 +1154,8 @@
 Usually contains ` ', linefeed, TAB or formfeed.")
 
 (defun vip-update-alphanumeric-class ()
-  "Set the syntactic class of Viper alphanumeric symbols according to
-the variable `vip-ALPHA-char-class'. Should be called in order for changes to
-`vip-ALPHA-char-class' to take effect."
+  "Set the syntax class of Viper alphanumerals according to `vip-syntax-preference'.
+Must be called in order for changes to `vip-syntax-preference' to take effect."
   (interactive)
   (setq-default
    vip-ALPHA-char-class