diff lisp/viper/viper-util.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 441bb1e64a06
children c7528f8e288d
line wrap: on
line diff
--- a/lisp/viper/viper-util.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/viper/viper-util.el	Mon Aug 13 09:02:59 2007 +0200
@@ -1,6 +1,6 @@
 ;;; viper-util.el --- Utilities used by viper.el
 
-;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
 
 ;; This file is part of GNU Emacs.
 
@@ -22,44 +22,135 @@
 
 ;; Code
 
+(require 'ring)
+
 ;; Compiler pacifier
 (defvar vip-overriding-map)
 (defvar pm-color-alist)
 (defvar zmacs-region-stays)
+(defvar vip-search-face)
 (defvar vip-minibuffer-current-face)
 (defvar vip-minibuffer-insert-face)
 (defvar vip-minibuffer-vi-face)
 (defvar vip-minibuffer-emacs-face)
 (defvar vip-replace-overlay-face)
+(defvar vip-minibuffer-overlay)
+(defvar vip-replace-overlay)
+(defvar vip-search-overlay)
+(defvar vip-replace-overlay-cursor-color)
+(defvar vip-intermediate-command)
+(defvar vip-use-replace-region-delimiters)
 (defvar vip-fast-keyseq-timeout)
-(defvar ex-unix-type-shell)
-(defvar ex-unix-type-shell-options)
-(defvar vip-ex-tmp-buf-name)
-
-(require 'cl)
-(require 'ring)
+(defvar vip-related-files-and-buffers-ring)
+;; end compiler pacifier
 
-(and noninteractive
-     (eval-when-compile
-       (let ((load-path (cons (expand-file-name ".") load-path)))
-	 (or (featurep 'viper-init)
-	     (load "viper-init.el" nil nil 'nosuffix))
-	 )))
-;; end pacifier
+;; Is it XEmacs?
+(defconst vip-xemacs-p (string-match "\\(Lucid\\|XEmacs\\)" emacs-version))
+;; Is it Emacs?
+(defconst vip-emacs-p (not vip-xemacs-p))
+;; Tell whether we are running as a window application or on a TTY
+(defsubst vip-device-type ()
+  (if vip-emacs-p
+      window-system
+    (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)))))
 
-(require 'viper-init)
+(defvar vip-force-faces nil
+  "If t, Viper will think that it is running on a display that supports faces.
+This is provided as a temporary relief for users of face-capable displays
+that Viper doesn't know about.")
 
+(defun vip-has-face-support-p ()
+  (cond ((vip-window-display-p))
+	(vip-force-faces)
+	(vip-emacs-p (memq (vip-device-type) '(pc)))
+	(vip-xemacs-p (memq (vip-device-type) '(tty pc)))))
 
 
-;;; XEmacs support
+;;; Macros
+
+(defmacro vip-deflocalvar (var default-value &optional documentation)
+  (` (progn
+       (defvar (, var) (, default-value)
+	       (, (format "%s\n\(buffer local\)" documentation)))
+       (make-variable-buffer-local '(, var))
+     )))
+
+(defmacro vip-loop (count body)
+  "(vip-loop COUNT BODY) Execute BODY COUNT times."
+  (list 'let (list (list 'count count))
+	(list 'while '(> count 0)
+	      body
+	      '(setq count (1- count))
+	      )))
 
-;; A fix for NeXT Step
-;; Should probably be eliminated in later versions.
-(if (and (vip-window-display-p) (eq (vip-device-type) 'ns))
-    (progn
-      (fset 'x-display-color-p (symbol-function 'ns-display-color-p))
-      (fset 'x-color-defined-p (symbol-function 'ns-color-defined-p))
+(defmacro vip-buffer-live-p (buf)
+  (` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf))))))
+  
+;; return buffer-specific macro definition, given a full macro definition
+(defmacro vip-kbd-buf-alist (macro-elt)
+  (` (nth 1 (, macro-elt))))
+;; get a pair: (curr-buffer . macro-definition)
+(defmacro vip-kbd-buf-pair (macro-elt)
+  (` (assoc (buffer-name) (vip-kbd-buf-alist (, macro-elt)))))
+;; get macro definition for current buffer
+(defmacro vip-kbd-buf-definition (macro-elt)
+  (` (cdr (vip-kbd-buf-pair (, macro-elt)))))
+  
+;; return mode-specific macro definitions, given a full macro definition
+(defmacro vip-kbd-mode-alist (macro-elt)
+  (` (nth 2 (, macro-elt))))
+;; get a pair: (major-mode . macro-definition)
+(defmacro vip-kbd-mode-pair (macro-elt)
+  (` (assoc major-mode (vip-kbd-mode-alist (, macro-elt)))))
+;; get macro definition for the current major mode
+(defmacro vip-kbd-mode-definition (macro-elt)
+  (` (cdr (vip-kbd-mode-pair (, macro-elt)))))
+  
+;; return global macro definition, given a full macro definition
+(defmacro vip-kbd-global-pair (macro-elt)
+  (` (nth 3 (, macro-elt))))
+;; get global macro definition from an elt of macro-alist
+(defmacro vip-kbd-global-definition (macro-elt)
+  (` (cdr (vip-kbd-global-pair (, macro-elt)))))
+  
+;; last elt of a sequence
+(defsubst vip-seq-last-elt (seq)
+  (elt seq (1- (length seq))))
+  
+;; Check if arg is a valid character for register
+;; TYPE is a list that can contain `letter', `Letter', and `digit'.
+;; Letter means lowercase letters, Letter means uppercase letters, and
+;; digit means digits from 1 to 9.
+;; If TYPE is nil, then down/uppercase letters and digits are allowed.
+(defun vip-valid-register (reg &optional type)
+  (or type (setq type '(letter Letter digit)))
+  (or (if (memq 'letter type)
+	  (and (<= ?a reg) (<= reg ?z)))
+      (if (memq 'digit type)
+	  (and (<= ?1 reg) (<= reg ?9)))
+      (if (memq 'Letter type)
+	  (and (<= ?A reg) (<= reg ?Z)))
       ))
+      
+;; checks if object is a marker, has a buffer, and points to within that buffer
+(defun vip-valid-marker (marker)
+  (if (and (markerp marker) (marker-buffer marker))
+      (let ((buf (marker-buffer marker))
+	    (pos (marker-position marker)))
+	(save-excursion
+	  (set-buffer buf)
+	  (and (<= pos (point-max)) (<= (point-min) pos))))))
+  
+
+(defvar vip-minibuffer-overlay-priority 300)
+(defvar vip-replace-overlay-priority 400)
+(defvar vip-search-overlay-priority 500)
+  
+
+;;; XEmacs support
 
 (if vip-xemacs-p
     (progn
@@ -93,7 +184,6 @@
 	 (fset 'vip-color-defined-p (symbol-function 'x-color-defined-p))
 	 )))
 
-
 (fset 'vip-characterp
       (symbol-function
        (if vip-xemacs-p 'characterp 'integerp)))
@@ -104,19 +194,7 @@
     (eq (device-class (selected-device)) 'color)))
    
 (defsubst vip-get-cursor-color ()
-  (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)))))
-
+  (cdr (assoc 'cursor-color (frame-parameters))))
   
 ;; OS/2
 (cond ((eq (vip-device-type) 'pm)
@@ -147,130 +225,18 @@
       (modify-frame-parameters
        (selected-frame) (list (cons 'cursor-color new-color)))))
 	 
-(defun vip-save-cursor-color ()
+(defsubst vip-save-cursor-color ()
   (if (and (vip-window-display-p) (vip-color-display-p))
       (let ((color (vip-get-cursor-color)))
 	(if (and (stringp color) (vip-color-defined-p color)
 		 (not (string= color vip-replace-overlay-cursor-color)))
 	    (vip-overlay-put vip-replace-overlay 'vip-cursor-color color)))))
 	
-;; restore cursor color from replace overlay
-(defsubst vip-restore-cursor-color-after-replace ()
+(defsubst vip-restore-cursor-color ()
   (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))
 	 
 
-;; Face-saving tricks
-
-(defvar vip-search-face
-  (if (vip-has-face-support-p)
-      (progn
-	(make-face 'vip-search-face)
-	(vip-hide-face 'vip-search-face)
-	(or (face-differs-from-default-p 'vip-search-face)
-	    ;; face wasn't set in .vip or .Xdefaults
-	    (if (vip-can-use-colors "Black" "khaki")
-		(progn
-		  (set-face-background 'vip-search-face "khaki")
-		  (set-face-foreground 'vip-search-face "Black"))
-	      (set-face-underline-p 'vip-search-face t)
-	      (vip-set-face-pixmap 'vip-search-face vip-search-face-pixmap)))
-	'vip-search-face))
-  "*Face used to flash out the search pattern.")
-  
-(defvar vip-replace-overlay-face
-  (if (vip-has-face-support-p)
-      (progn
-	(make-face 'vip-replace-overlay-face)
-	(vip-hide-face 'vip-replace-overlay-face)
-	(or (face-differs-from-default-p 'vip-replace-overlay-face)
-	    (progn
-	      (if (vip-can-use-colors "darkseagreen2" "Black")
-		  (progn
-		    (set-face-background
-		     'vip-replace-overlay-face "darkseagreen2")
-		    (set-face-foreground 'vip-replace-overlay-face "Black")))
-	      (set-face-underline-p 'vip-replace-overlay-face t)
-	      (vip-set-face-pixmap
-	       'vip-replace-overlay-face vip-replace-overlay-pixmap)))
-	'vip-replace-overlay-face))
-  "*Face for highlighting replace regions on a window display.")
-
-(defvar vip-minibuffer-emacs-face
-  (if (vip-has-face-support-p)
-      (progn
-	(make-face 'vip-minibuffer-emacs-face)
-	(vip-hide-face 'vip-minibuffer-emacs-face)
-	(or (face-differs-from-default-p 'vip-minibuffer-emacs-face)
-	    ;; face wasn't set in .vip or .Xdefaults
-	    (if vip-vi-style-in-minibuffer
-		;; emacs state is an exception in the minibuffer
-		(if (vip-can-use-colors "darkseagreen2" "Black")
-		    (progn
-		      (set-face-background
-		       'vip-minibuffer-emacs-face "darkseagreen2")
-		      (set-face-foreground
-		       'vip-minibuffer-emacs-face "Black"))
-		  (copy-face 'modeline 'vip-minibuffer-emacs-face))
-	      ;; emacs state is the main state in the minibuffer
-	      (if (vip-can-use-colors "Black" "pink")
-		  (progn
-		    (set-face-background 'vip-minibuffer-emacs-face "pink") 
-		    (set-face-foreground
-		     'vip-minibuffer-emacs-face "Black"))
-		(copy-face 'italic 'vip-minibuffer-emacs-face))
-	      ))
-	'vip-minibuffer-emacs-face))
-  "Face used in the Minibuffer when it is in Emacs state.")
-    
-(defvar vip-minibuffer-insert-face
-  (if (vip-has-face-support-p)
-      (progn
-	(make-face 'vip-minibuffer-insert-face)
-	(vip-hide-face 'vip-minibuffer-insert-face)
-	(or (face-differs-from-default-p 'vip-minibuffer-insert-face)
-	    (if vip-vi-style-in-minibuffer
-		(if (vip-can-use-colors "Black" "pink")
-		    (progn
-		      (set-face-background 'vip-minibuffer-insert-face "pink") 
-		      (set-face-foreground
-		       'vip-minibuffer-insert-face "Black"))
-		  (copy-face 'italic 'vip-minibuffer-insert-face))
-	      ;; If Insert state is an exception
-	      (if (vip-can-use-colors "darkseagreen2" "Black")
-		  (progn
-		    (set-face-background
-		     'vip-minibuffer-insert-face "darkseagreen2")
-		    (set-face-foreground
-		     'vip-minibuffer-insert-face "Black"))
-		(copy-face 'modeline 'vip-minibuffer-insert-face))
-	      (vip-italicize-face 'vip-minibuffer-insert-face)))
-	'vip-minibuffer-insert-face))
-  "Face used in the Minibuffer when it is in Insert state.")
-    
-(defvar vip-minibuffer-vi-face
-  (if (vip-has-face-support-p)
-      (progn
-	(make-face 'vip-minibuffer-vi-face)
-	(vip-hide-face 'vip-minibuffer-vi-face)
-	(or (face-differs-from-default-p 'vip-minibuffer-vi-face)
-	    (if vip-vi-style-in-minibuffer
-		(if (vip-can-use-colors "Black" "grey")
-		    (progn
-		      (set-face-background 'vip-minibuffer-vi-face "grey")
-		      (set-face-foreground 'vip-minibuffer-vi-face "Black"))
-		  (copy-face 'bold 'vip-minibuffer-vi-face))
-	      (copy-face 'bold 'vip-minibuffer-vi-face)
-	      (invert-face 'vip-minibuffer-vi-face)))
-	'vip-minibuffer-vi-face))
-  "Face used in the Minibuffer when it is in Vi state.")
-    
-;; the current face to be used in the minibuffer
-(vip-deflocalvar vip-minibuffer-current-face vip-minibuffer-emacs-face "")
-   
-
 ;; Check the current version against the major and minor version numbers
 ;; using op: cur-vers op major.minor If emacs-major-version or
 ;; emacs-minor-version are not defined, we assume that the current version
@@ -299,8 +265,8 @@
 	  ((memq op '(< <=)) t))))
 	  
 ;;;; warn if it is a wrong version of emacs
-;;(if (or (vip-check-version '< 19 35 'emacs)
-;;	(vip-check-version '< 19 15 'xemacs))
+;;(if (or (vip-check-version '< 19 29 'emacs)
+;;	(vip-check-version '< 19 12 'xemacs))
 ;;    (progn
 ;;      (with-output-to-temp-buffer " *vip-info*"
 ;;	(switch-to-buffer " *vip-info*")
@@ -309,9 +275,9 @@
 ;;
 ;;This version of Viper requires 
 ;;
-;;\t Emacs 19.35 and higher
+;;\t Emacs 19.29 and higher
 ;;\t OR
-;;\t XEmacs 19.15 and higher
+;;\t XEmacs 19.12 and higher
 ;;
 ;;It is unlikely to work under Emacs version %s
 ;;that you are using... " emacs-version))
@@ -452,11 +418,11 @@
 	 ;; using cond in anticipation of further additions
 	 (cond (ex-unix-type-shell-options)
 	       ))
-	(command (cond (vip-ms-style-os-p (format "\"ls -1 -d %s\"" filespec))
-		       (t (format "ls -1 -d %s" filespec))))
-	file-list status)
+	(command (cond (vip-ms-style-os-p (format "\"ls -1 %s\"" filespec))
+		       (t (format "ls -1 %s" filespec))))
+	file-list)
     (save-excursion 
-      (set-buffer (get-buffer-create vip-ex-tmp-buf-name))
+      (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name)))
       (erase-buffer)
       (setq status
 	    (if gshell-options
@@ -496,7 +462,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 (get-buffer-create vip-ex-tmp-buf-name))
+    (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name)))
     (erase-buffer)
     (insert filespec)
     (goto-char (point-min))
@@ -509,7 +475,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 (&optional one-per-line)
+(defun vip-get-filenames-from-buffer (one-per-line)
   (let ((skip-chars (if one-per-line "\t\n" " \t\n"))
 	 result fname delim)
     (skip-chars-forward skip-chars)
@@ -534,7 +500,7 @@
 ;; convert MS-DOS wildcards to regexp
 (defun vip-wildcard-to-regexp (wcard)
   (save-excursion
-    (set-buffer (get-buffer-create vip-ex-tmp-buf-name))
+    (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name)))
     (erase-buffer)
     (insert wcard)
     (goto-char (point-min))
@@ -570,6 +536,9 @@
       (setq tmp (cdr tmp)))
     (reverse (apply 'append tmp2))))
 
+      
+
+
 
 ;;; Insertion ring
 
@@ -767,7 +736,6 @@
 	(sit-for 2)
 	(vip-overlay-put vip-search-overlay 'face nil))))
 
-
 ;; Replace state
 
 (defsubst vip-move-replace-overlay (beg end)
@@ -781,15 +749,7 @@
     (vip-overlay-put
      vip-replace-overlay (if vip-emacs-p 'evaporate 'detachable) nil)
     (vip-overlay-put 
-     vip-replace-overlay 'priority vip-replace-overlay-priority)
-    ;; If Emacs will start supporting overlay maps, as it currently supports
-    ;; text-property maps, we could do away with vip-replace-minor-mode and
-    ;; just have keymap attached to replace overlay.
-    ;;(vip-overlay-put
-    ;; vip-replace-overlay
-    ;; (if vip-xemacs-p 'keymap 'local-map)
-    ;; vip-replace-map)
-    ) 
+     vip-replace-overlay 'priority vip-replace-overlay-priority)) 
   (if (vip-has-face-support-p)
       (vip-overlay-put vip-replace-overlay 'face vip-replace-overlay-face))
   (vip-save-cursor-color)
@@ -797,7 +757,7 @@
   )
   
       
-(defun vip-set-replace-overlay-glyphs (before-glyph after-glyph)
+(defsubst vip-set-replace-overlay-glyphs (before-glyph after-glyph)
   (if (or (not (vip-has-face-support-p))
 	  vip-use-replace-region-delimiters)
       (let ((before-name (if vip-xemacs-p 'begin-glyph 'before-string))
@@ -805,10 +765,9 @@
 	(vip-overlay-put vip-replace-overlay before-name before-glyph)
 	(vip-overlay-put vip-replace-overlay after-name after-glyph))))
   
-(defun vip-hide-replace-overlay ()
+(defsubst vip-hide-replace-overlay ()
   (vip-set-replace-overlay-glyphs nil nil)
-  (vip-restore-cursor-color-after-replace)
-  (vip-restore-cursor-color-after-insert)
+  (vip-restore-cursor-color)
   (if (vip-has-face-support-p)
       (vip-overlay-put vip-replace-overlay 'face nil)))
 
@@ -876,15 +835,7 @@
   (let ((ESC-keys '(?\e (control \[) escape))
 	(key (vip-event-key event)))
     (member key ESC-keys)))
-
-;; checks if object is a marker, has a buffer, and points to within that buffer
-(defun vip-valid-marker (marker)
-  (if (and (markerp marker) (marker-buffer marker))
-      (let ((buf (marker-buffer marker))
-	    (pos (marker-position marker)))
-	(save-excursion
-	  (set-buffer buf)
-	  (and (<= pos (point-max)) (<= (point-min) pos))))))
+	
   
 (defsubst vip-mark-marker ()
   (if vip-xemacs-p
@@ -909,21 +860,6 @@
   (if vip-xemacs-p
       (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'.
-;; Letter means lowercase letters, Letter means uppercase letters, and
-;; digit means digits from 1 to 9.
-;; If TYPE is nil, then down/uppercase letters and digits are allowed.
-(defun vip-valid-register (reg &optional type)
-  (or type (setq type '(letter Letter digit)))
-  (or (if (memq 'letter type)
-	  (and (<= ?a reg) (<= reg ?z)))
-      (if (memq 'digit type)
-	  (and (<= ?1 reg) (<= reg ?9)))
-      (if (memq 'Letter type)
-	  (and (<= ?A reg) (<= reg ?Z)))
-      ))
-
     
 (defsubst vip-events-to-keys (events)
   (cond (vip-xemacs-p (events-to-keys events))
@@ -985,12 +921,6 @@
       (set hook hook-value))))
 
     
-;; it is suggested that an event must be copied before it is assigned to
-;; last-command-event in XEmacs
-(defun vip-copy-event (event)
-  (if vip-xemacs-p
-      (copy-event event)
-    event))
     
 ;; like read-event, but in XEmacs also try to convert to char, if possible
 (defun vip-read-event-convert-to-char ()
@@ -1004,17 +934,15 @@
 
 ;; 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
-;; by correctly mapping key sequences for Left/Right/... (one an ascii
-;; terminal) into logical keys left, right, etc.
+;; macros, since it enables certain macros to be shared between X and TTY
+;; modes.
 (defun vip-read-key () 
   (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)
@@ -1023,44 +951,40 @@
 (defun vip-event-key (event)
   (or (and event (eventp event))
       (error "vip-event-key: Wrong type argument, eventp, %S" event))
-  (when (cond (vip-xemacs-p (or (key-press-event-p event)
-				(mouse-event-p event)))
-	      (t t))
-    (let ((mod (event-modifiers event))
-	  basis)
-      (setq basis
-	    (cond
-	     (vip-xemacs-p
-	      (cond ((key-press-event-p event)
-		     (event-key event))
-		    ((button-event-p event)
-		     (concat "mouse-" (prin1-to-string (event-button event))))
-		    (t 
-		     (error "vip-event-key: Unknown event, %S" event))))
-	     (t 
-	      ;; Emacs doesn't handle capital letters correctly, since
-	      ;; \S-a isn't considered the same as A (it behaves as
-	      ;; plain `a' instead). So we take care of this here
-	      (cond ((and (vip-characterp event) (<= ?A event) (<= event ?Z))
-		     (setq mod nil
-			   event event))
-		    ;; Emacs has the oddity whereby characters 128+char
-		    ;; represent M-char *if* this appears inside a string.
-		    ;; So, we convert them manually to (meta char).
-		    ((and (vip-characterp event)
-			  (< ?\C-? event) (<= event 255))
-		     (setq mod '(meta)
-			   event (- event ?\C-? 1)))
-		    (t (event-basic-type event)))
-	      )))
-      (if (vip-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))))
+  (let ((mod (event-modifiers event))
+	basis)
+    (setq basis
+	  (cond
+	   (vip-xemacs-p
+	    (cond ((key-press-event-p event)
+		   (event-key event))
+		  ((button-event-p event)
+		   (concat "mouse-" (prin1-to-string (event-button event))))
+		  (t 
+		   (error "vip-event-key: Unknown event, %S" event))))
+	   (t 
+	    ;; Emacs doesn't handle capital letters correctly, since
+	    ;; \S-a isn't considered the same as A (it behaves as
+	    ;; plain `a' instead). So we take care of this here
+	    (cond ((and (vip-characterp event) (<= ?A event) (<= event ?Z))
+		   (setq mod nil
+			 event event))
+		  ;; Emacs has the oddity whereby characters 128+char
+		  ;; represent M-char *if* this appears inside a string.
+		  ;; So, we convert them manually to (meta char).
+		  ((and (vip-characterp event) (< ?\C-? event) (<= event 255))
+		   (setq mod '(meta)
+			 event (- event ?\C-? 1)))
+		  (t (event-basic-type event)))
+	    )))
+    (if (vip-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)))
     
 (defun vip-key-to-emacs-key (key)
   (let (key-name char-p modifiers mod-char-list base-key base-key-name)
@@ -1202,8 +1126,9 @@
 Usually contains ` ', linefeed, TAB or formfeed.")
 
 (defun vip-update-alphanumeric-class ()
-  "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."
+  "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."
   (interactive)
   (setq-default
    vip-ALPHA-char-class
@@ -1227,7 +1152,7 @@
 		    (append (vconcat vip-ALPHA-char-class) nil)))))
     ))
 
-(defun vip-looking-at-separator ()
+(defsubst vip-looking-at-separator ()
   (let ((char (char-after (point))))
     (if char
 	(or (eq char ?\n) ; RET is always a separator in Vi
@@ -1237,7 +1162,7 @@
 (defsubst vip-looking-at-alphasep (&optional addl-chars)
   (or (vip-looking-at-separator) (vip-looking-at-alpha addl-chars)))
 
-(defun vip-skip-alpha-forward (&optional addl-chars)
+(defsubst vip-skip-alpha-forward (&optional addl-chars)
   (or (stringp addl-chars) (setq addl-chars ""))
   (vip-skip-syntax
    'forward 
@@ -1248,7 +1173,7 @@
 	  (concat vip-strict-ALPHA-chars addl-chars))
 	 (t addl-chars))))
 
-(defun vip-skip-alpha-backward (&optional addl-chars)
+(defsubst vip-skip-alpha-backward (&optional addl-chars)
   (or (stringp addl-chars) (setq addl-chars ""))
   (vip-skip-syntax
    'backward 
@@ -1275,14 +1200,14 @@
     (funcall func (concat "^" vip-SEP-char-class)
 	     (vip-line-pos (if (eq direction 'forward) 'end 'start)))))
 
-(defun vip-skip-nonalphasep-forward ()
+(defsubst vip-skip-nonalphasep-forward ()
   (if (eq vip-syntax-preference 'strict-vi)
       (skip-chars-forward
        (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars))
     (skip-syntax-forward
      (concat
       "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'end))))
-(defun vip-skip-nonalphasep-backward ()
+(defsubst vip-skip-nonalphasep-backward ()
   (if (eq vip-syntax-preference 'strict-vi)
       (skip-chars-backward
        (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars))