Mercurial > emacs
comparison lisp/emulation/viper-util.el @ 19203:58c50205001d
new version
| author | Michael Kifer <kifer@cs.stonybrook.edu> |
|---|---|
| date | Thu, 07 Aug 1997 04:48:48 +0000 |
| parents | dfbef8117c6a |
| children | eb1cef5fa337 |
comparison
equal
deleted
inserted
replaced
| 19202:e32501a34d5c | 19203:58c50205001d |
|---|---|
| 48 ;; end pacifier | 48 ;; end pacifier |
| 49 | 49 |
| 50 (require 'viper-init) | 50 (require 'viper-init) |
| 51 | 51 |
| 52 | 52 |
| 53 ;; A fix for NeXT Step | |
| 54 ;; Should go away, when NS people fix the design flaw, which leaves the | |
| 55 ;; two x-* functions undefined. | |
| 56 (if (and (not (fboundp 'x-display-color-p)) (fboundp 'ns-display-color-p)) | |
| 57 (fset 'x-display-color-p (symbol-function 'ns-display-color-p))) | |
| 58 (if (and (not (fboundp 'x-color-defined-p)) (fboundp 'ns-color-defined-p)) | |
| 59 (fset 'x-color-defined-p (symbol-function 'ns-color-defined-p))) | |
| 60 | |
| 53 | 61 |
| 54 ;;; XEmacs support | 62 ;;; XEmacs support |
| 55 | 63 |
| 56 ;; A fix for NeXT Step | |
| 57 ;; Should probably be eliminated in later versions. | |
| 58 (if (and (viper-window-display-p) (eq (viper-device-type) 'ns)) | |
| 59 (progn | |
| 60 (fset 'x-display-color-p (symbol-function 'ns-display-color-p)) | |
| 61 (fset 'x-color-defined-p (symbol-function 'ns-color-defined-p)) | |
| 62 )) | |
| 63 | 64 |
| 64 (if viper-xemacs-p | 65 (if viper-xemacs-p |
| 65 (progn | 66 (progn |
| 66 (fset 'viper-read-event (symbol-function 'next-command-event)) | 67 (fset 'viper-read-event (symbol-function 'next-command-event)) |
| 67 (fset 'viper-make-overlay (symbol-function 'make-extent)) | 68 (fset 'viper-make-overlay (symbol-function 'make-extent)) |
| 106 (defsubst viper-get-cursor-color () | 107 (defsubst viper-get-cursor-color () |
| 107 (if viper-emacs-p | 108 (if viper-emacs-p |
| 108 (cdr (assoc 'cursor-color (frame-parameters))) | 109 (cdr (assoc 'cursor-color (frame-parameters))) |
| 109 (color-instance-name (frame-property (selected-frame) 'cursor-color)))) | 110 (color-instance-name (frame-property (selected-frame) 'cursor-color)))) |
| 110 | 111 |
| 111 (defun viper-set-face-pixmap (face pixmap) | 112 ;;(defun viper-set-face-pixmap (face pixmap) |
| 112 "Set face pixmap on a monochrome display." | 113 ;; "Set face pixmap on a monochrome display." |
| 113 (if (and (viper-window-display-p) (not (viper-color-display-p))) | 114 ;; (if (and (viper-window-display-p) (not (viper-color-display-p))) |
| 114 (condition-case nil | 115 ;; (condition-case nil |
| 115 (set-face-background-pixmap face pixmap) | 116 ;; (set-face-background-pixmap face pixmap) |
| 116 (error | 117 ;; (error |
| 117 (message "Pixmap not found for %S: %s" (face-name face) pixmap) | 118 ;; (message "Pixmap not found for %S: %s" (face-name face) pixmap) |
| 118 (sit-for 1))))) | 119 ;; (sit-for 1))))) |
| 119 | 120 |
| 120 | 121 |
| 121 ;; OS/2 | 122 ;; OS/2 |
| 122 (cond ((eq (viper-device-type) 'pm) | 123 (cond ((eq (viper-device-type) 'pm) |
| 123 (fset 'viper-color-defined-p | 124 (fset 'viper-color-defined-p |
| 124 (function (lambda (color) (assoc color pm-color-alist)))))) | 125 (function (lambda (color) (assoc color pm-color-alist)))))) |
| 125 | 126 |
| 126 ;; needed to smooth out the difference between Emacs and XEmacs | 127 ;; needed to smooth out the difference between Emacs and XEmacs |
| 127 (defsubst viper-italicize-face (face) | 128 ;;(defsubst viper-italicize-face (face) |
| 128 (if viper-xemacs-p | 129 ;; (if viper-xemacs-p |
| 129 (make-face-italic face) | 130 ;; (make-face-italic face) |
| 130 (make-face-italic face nil 'noerror))) | 131 ;; (make-face-italic face nil 'noerror))) |
| 131 | 132 |
| 132 ;; test if display is color and the colors are defined | 133 ;; test if display is color and the colors are defined |
| 133 (defsubst viper-can-use-colors (&rest colors) | 134 ;;(defsubst viper-can-use-colors (&rest colors) |
| 134 (if (viper-color-display-p) | 135 ;; (if (viper-color-display-p) |
| 135 (not (memq nil (mapcar 'viper-color-defined-p colors))) | 136 ;; (not (memq nil (mapcar 'viper-color-defined-p colors))) |
| 136 )) | 137 ;; )) |
| 137 | |
| 138 (defun viper-hide-face (face) | |
| 139 (if (and (viper-has-face-support-p) viper-emacs-p) | |
| 140 (add-to-list 'facemenu-unlisted-faces face))) | |
| 141 | 138 |
| 142 ;; cursor colors | 139 ;; cursor colors |
| 143 (defun viper-change-cursor-color (new-color) | 140 (defun viper-change-cursor-color (new-color) |
| 144 (if (and (viper-window-display-p) (viper-color-display-p) | 141 (if (and (viper-window-display-p) (viper-color-display-p) |
| 145 (stringp new-color) (viper-color-defined-p new-color) | 142 (stringp new-color) (viper-color-defined-p new-color) |
| 159 (viper-change-cursor-color | 156 (viper-change-cursor-color |
| 160 (viper-overlay-get viper-replace-overlay 'viper-cursor-color))) | 157 (viper-overlay-get viper-replace-overlay 'viper-cursor-color))) |
| 161 (defsubst viper-restore-cursor-color-after-insert () | 158 (defsubst viper-restore-cursor-color-after-insert () |
| 162 (viper-change-cursor-color viper-saved-cursor-color)) | 159 (viper-change-cursor-color viper-saved-cursor-color)) |
| 163 | 160 |
| 164 | |
| 165 ;; Face-saving tricks | |
| 166 | |
| 167 (defvar viper-search-face | |
| 168 (if (viper-has-face-support-p) | |
| 169 (progn | |
| 170 (make-face 'viper-search-face) | |
| 171 (viper-hide-face 'viper-search-face) | |
| 172 (or (face-differs-from-default-p 'viper-search-face) | |
| 173 ;; face wasn't set in .viper or .Xdefaults | |
| 174 (if (viper-can-use-colors "Black" "khaki") | |
| 175 (progn | |
| 176 (set-face-background 'viper-search-face "khaki") | |
| 177 (set-face-foreground 'viper-search-face "Black")) | |
| 178 (set-face-underline-p 'viper-search-face t) | |
| 179 (viper-set-face-pixmap 'viper-search-face viper-search-face-pixmap))) | |
| 180 'viper-search-face)) | |
| 181 "*Face used to flash out the search pattern.") | |
| 182 | |
| 183 (defvar viper-replace-overlay-face | |
| 184 (if (viper-has-face-support-p) | |
| 185 (progn | |
| 186 (make-face 'viper-replace-overlay-face) | |
| 187 (viper-hide-face 'viper-replace-overlay-face) | |
| 188 (or (face-differs-from-default-p 'viper-replace-overlay-face) | |
| 189 (progn | |
| 190 (if (viper-can-use-colors "darkseagreen2" "Black") | |
| 191 (progn | |
| 192 (set-face-background | |
| 193 'viper-replace-overlay-face "darkseagreen2") | |
| 194 (set-face-foreground 'viper-replace-overlay-face "Black"))) | |
| 195 (set-face-underline-p 'viper-replace-overlay-face t) | |
| 196 (viper-set-face-pixmap | |
| 197 'viper-replace-overlay-face viper-replace-overlay-pixmap))) | |
| 198 'viper-replace-overlay-face)) | |
| 199 "*Face for highlighting replace regions on a window display.") | |
| 200 | |
| 201 (defvar viper-minibuffer-emacs-face | |
| 202 (if (viper-has-face-support-p) | |
| 203 (progn | |
| 204 (make-face 'viper-minibuffer-emacs-face) | |
| 205 (viper-hide-face 'viper-minibuffer-emacs-face) | |
| 206 (or (face-differs-from-default-p 'viper-minibuffer-emacs-face) | |
| 207 ;; face wasn't set in .viper or .Xdefaults | |
| 208 (if viper-vi-style-in-minibuffer | |
| 209 ;; emacs state is an exception in the minibuffer | |
| 210 (if (viper-can-use-colors "darkseagreen2" "Black") | |
| 211 (progn | |
| 212 (set-face-background | |
| 213 'viper-minibuffer-emacs-face "darkseagreen2") | |
| 214 (set-face-foreground | |
| 215 'viper-minibuffer-emacs-face "Black")) | |
| 216 (copy-face 'modeline 'viper-minibuffer-emacs-face)) | |
| 217 ;; emacs state is the main state in the minibuffer | |
| 218 (if (viper-can-use-colors "Black" "pink") | |
| 219 (progn | |
| 220 (set-face-background 'viper-minibuffer-emacs-face "pink") | |
| 221 (set-face-foreground | |
| 222 'viper-minibuffer-emacs-face "Black")) | |
| 223 (copy-face 'italic 'viper-minibuffer-emacs-face)) | |
| 224 )) | |
| 225 'viper-minibuffer-emacs-face)) | |
| 226 "Face used in the Minibuffer when it is in Emacs state.") | |
| 227 | |
| 228 (defvar viper-minibuffer-insert-face | |
| 229 (if (viper-has-face-support-p) | |
| 230 (progn | |
| 231 (make-face 'viper-minibuffer-insert-face) | |
| 232 (viper-hide-face 'viper-minibuffer-insert-face) | |
| 233 (or (face-differs-from-default-p 'viper-minibuffer-insert-face) | |
| 234 (if viper-vi-style-in-minibuffer | |
| 235 (if (viper-can-use-colors "Black" "pink") | |
| 236 (progn | |
| 237 (set-face-background 'viper-minibuffer-insert-face "pink") | |
| 238 (set-face-foreground | |
| 239 'viper-minibuffer-insert-face "Black")) | |
| 240 (copy-face 'italic 'viper-minibuffer-insert-face)) | |
| 241 ;; If Insert state is an exception | |
| 242 (if (viper-can-use-colors "darkseagreen2" "Black") | |
| 243 (progn | |
| 244 (set-face-background | |
| 245 'viper-minibuffer-insert-face "darkseagreen2") | |
| 246 (set-face-foreground | |
| 247 'viper-minibuffer-insert-face "Black")) | |
| 248 (copy-face 'modeline 'viper-minibuffer-insert-face)) | |
| 249 (viper-italicize-face 'viper-minibuffer-insert-face))) | |
| 250 'viper-minibuffer-insert-face)) | |
| 251 "Face used in the Minibuffer when it is in Insert state.") | |
| 252 | |
| 253 (defvar viper-minibuffer-vi-face | |
| 254 (if (viper-has-face-support-p) | |
| 255 (progn | |
| 256 (make-face 'viper-minibuffer-vi-face) | |
| 257 (viper-hide-face 'viper-minibuffer-vi-face) | |
| 258 (or (face-differs-from-default-p 'viper-minibuffer-vi-face) | |
| 259 (if viper-vi-style-in-minibuffer | |
| 260 (if (viper-can-use-colors "Black" "grey") | |
| 261 (progn | |
| 262 (set-face-background 'viper-minibuffer-vi-face "grey") | |
| 263 (set-face-foreground 'viper-minibuffer-vi-face "Black")) | |
| 264 (copy-face 'bold 'viper-minibuffer-vi-face)) | |
| 265 (copy-face 'bold 'viper-minibuffer-vi-face) | |
| 266 (invert-face 'viper-minibuffer-vi-face))) | |
| 267 'viper-minibuffer-vi-face)) | |
| 268 "Face used in the Minibuffer when it is in Vi state.") | |
| 269 | |
| 270 ;; the current face to be used in the minibuffer | |
| 271 (viper-deflocalvar viper-minibuffer-current-face viper-minibuffer-emacs-face "") | |
| 272 | 161 |
| 273 | 162 |
| 274 ;; Check the current version against the major and minor version numbers | 163 ;; Check the current version against the major and minor version numbers |
| 275 ;; using op: cur-vers op major.minor If emacs-major-version or | 164 ;; using op: cur-vers op major.minor If emacs-major-version or |
| 276 ;; emacs-minor-version are not defined, we assume that the current version | 165 ;; emacs-minor-version are not defined, we assume that the current version |
| 977 ;; by correctly mapping key sequences for Left/Right/... (one an ascii | 866 ;; by correctly mapping key sequences for Left/Right/... (one an ascii |
| 978 ;; terminal) into logical keys left, right, etc. | 867 ;; terminal) into logical keys left, right, etc. |
| 979 (defun viper-read-key () | 868 (defun viper-read-key () |
| 980 (let ((overriding-local-map viper-overriding-map) | 869 (let ((overriding-local-map viper-overriding-map) |
| 981 (inhibit-quit t) | 870 (inhibit-quit t) |
| 982 key) | 871 help-char key) |
| 983 (use-global-map viper-overriding-map) | 872 (use-global-map viper-overriding-map) |
| 984 (setq key (elt (read-key-sequence nil) 0)) | 873 (unwind-protect |
| 985 (use-global-map global-map) | 874 (setq key (elt (read-key-sequence nil) 0)) |
| 875 (use-global-map global-map)) | |
| 986 key)) | 876 key)) |
| 987 | 877 |
| 988 | 878 |
| 989 ;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil) | 879 ;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil) |
| 990 ;; instead of nil, if '(nil) was previously inadvertently assigned to | 880 ;; instead of nil, if '(nil) was previously inadvertently assigned to |