diff options
author | Michael Kifer <kifer@cs.stonybrook.edu> | 2002-01-08 04:36:01 +0000 |
---|---|---|
committer | Michael Kifer <kifer@cs.stonybrook.edu> | 2002-01-08 04:36:01 +0000 |
commit | 50a07e18565cc4dd7162908197ac71e85c1781d7 (patch) | |
tree | 6f0a68647e226b1c14cf00b75444e9c9d54ad847 /lisp/emulation | |
parent | fbb70ad9e6e00f3f146b50d3bf433a6ec6ce26c9 (diff) | |
download | emacs-50a07e18565cc4dd7162908197ac71e85c1781d7.tar.gz |
2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
* viper-init.el (viper-cond-compile-for-xemacs-or-emacs):
new macro that replaces viper-emacs-p and viper-xemacs-p in many
cases. Used to reduce the number of warnings.
* viper-cmd.el: use viper-cond-compile-for-xemacs-or-emacs.
(viper-standard-value): moved here from viper.el.
(viper-set-unread-command-events): moved to viper-util.el
(viper-check-minibuffer-overlay): make sure
viper-minibuffer-overlay is moved to cover the entire input field.
* viper-util.el: use viper-cond-compile-for-xemacs-or-emacs.
(viper-read-key-sequence, viper-set-unread-command-events,
viper-char-symbol-sequence-p, viper-char-array-p): moved here.
* viper-ex.el: use viper-cond-compile-for-xemacs-or-emacs.
* viper-keym.el: use viper-cond-compile-for-xemacs-or-emacs.
* viper-mous.el: use viper-cond-compile-for-xemacs-or-emacs.
* viper-macs.el (viper-char-array-p, viper-char-symbol-sequence-p,
viper-event-vector-p): moved to viper-util.el
* viper.el (viper-standard-value): moved to viper-cmd.el.
Use viper-cond-compile-for-xemacs-or-emacs.
* ediff-help.el: use ediff-cond-compile-for-xemacs-or-emacs.
* ediff-hook.el: use ediff-cond-compile-for-xemacs-or-emacs.
* ediff-init.el (ediff-cond-compile-for-xemacs-or-emacs): new
macro designed to be used in many places where ediff-emacs-p or
ediff-xemacs-p was previously used. Reduces the number of
warnings.
Use ediff-cond-compile-for-xemacs-or-emacs in many places in lieue
of ediff-xemacs-p.
(ediff-make-current-diff-overlay, ediff-highlight-diff-in-one-buffer,
ediff-convert-fine-diffs-to-overlays, ediff-empty-diff-region-p,
ediff-whitespace-diff-region-p, ediff-get-region-contents):
moved to ediff-util.el.
(ediff-event-key): moved here.
* ediff-merge.el: got rid of unreferenced variables.
* ediff-mult.el: use ediff-cond-compile-for-xemacs-or-emacs.
* ediff-util.el: use ediff-cond-compile-for-xemacs-or-emacs.
(ediff-cleanup-mess): improved the way windows are set up after
quitting ediff.
(ediff-janitor): use ediff-dispose-of-variant-according-to-user.
(ediff-dispose-of-variant-according-to-user): new function
designed to be smarter and also understands indirect buffers.
(ediff-highlight-diff-in-one-buffer,
ediff-unhighlight-diff-in-one-buffer,
ediff-unhighlight-diffs-totally-in-one-buffer,
ediff-highlight-diff, ediff-highlight-diff,
ediff-unhighlight-diff, ediff-unhighlight-diffs-totally,
ediff-empty-diff-region-p, ediff-whitespace-diff-region-p,
ediff-get-region-contents, ediff-make-current-diff-overlay):
moved here.
(ediff-format-bindings-of): new function by Hannu Koivisto
<azure@iki.fi>.
(ediff-setup): make sure the merge buffer is always widened and
modifiable.
(ediff-write-merge-buffer-and-maybe-kill): refuse to write the
result of a merge into a file visited by another buffer.
(ediff-arrange-autosave-in-merge-jobs): check if the merge file
is visited by another buffer and ask to save/delete that buffer.
(ediff-verify-file-merge-buffer): new function to do the above.
* ediff-vers.el: load ediff-init.el at compile time.
* ediff-wind.el: use ediff-cond-compile-for-xemacs-or-emacs.
* ediff.el (ediff-windows, ediff-regions-wordwise,
ediff-regions-linewise): use indirect buffers to improve
robustness and make it possible to compare regions of the same
buffer (even overlapping regions).
(ediff-clone-buffer-for-region-comparison,
ediff-clone-buffer-for-window-comparison): new functions.
(ediff-files-internal): refuse to compare identical files.
(ediff-regions-internal): get rid of the warning about comparing
regions of the same buffer.
* ediff-diff.el (ediff-convert-fine-diffs-to-overlays): moved here.
Plus the following fixes courtesy of Dave Love:
Doc fixes.
(ediff-word-1): Use word class and move - to the
front per regexp documentation.
(ediff-wordify): Bind forward-word-function outside loop.
(ediff-copy-to-buffer): Use insert-buffer-substring rather than
consing buffer contents.
(ediff-goto-word): Move syntax table setting outside loop.
Diffstat (limited to 'lisp/emulation')
-rw-r--r-- | lisp/emulation/viper-cmd.el | 142 | ||||
-rw-r--r-- | lisp/emulation/viper-ex.el | 18 | ||||
-rw-r--r-- | lisp/emulation/viper-init.el | 49 | ||||
-rw-r--r-- | lisp/emulation/viper-keym.el | 17 | ||||
-rw-r--r-- | lisp/emulation/viper-macs.el | 24 | ||||
-rw-r--r-- | lisp/emulation/viper-mous.el | 62 | ||||
-rw-r--r-- | lisp/emulation/viper-util.el | 376 | ||||
-rw-r--r-- | lisp/emulation/viper.el | 37 |
8 files changed, 397 insertions, 328 deletions
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 70347ce2aee..e92359eb2df 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -1,8 +1,8 @@ ;;; viper-cmd.el --- Vi command support for Viper -;; Copyright (C) 1997 Free Software Foundation, Inc. +;; Copyright (C) 1997, 98, 99, 2000, 01, 02 Free Software Foundation, Inc. -;; Author: Michael Kifer <kifer@cs.sunysb.edu> +;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; This file is part of GNU Emacs. @@ -41,6 +41,8 @@ (defvar quail-current-str) (defvar zmacs-region-stays) (defvar mark-even-if-inactive) +(defvar init-message) +(defvar initial) ;; loading happens only in non-interactive compilation ;; in order to spare non-viperized emacs from being viperized @@ -145,6 +147,10 @@ ;; Where viper saves mark. This mark is resurrected by m^ (defvar viper-saved-mark nil) +;; Contains user settings for vars affected by viper-set-expert-level function. +;; Not a user option. +(defvar viper-saved-user-settings nil) + ;;; CODE @@ -298,12 +304,15 @@ ;; desirable that viper-pre-command-sentinel is the last hook and ;; viper-post-command-sentinel is the first hook. - (if viper-xemacs-p - (progn - (make-local-hook 'viper-after-change-functions) - (make-local-hook 'viper-before-change-functions) - (make-local-hook 'viper-post-command-hooks) - (make-local-hook 'viper-pre-command-hooks))) + (viper-cond-compile-for-xemacs-or-emacs + ;; xemacs + (progn + (make-local-hook 'viper-after-change-functions) + (make-local-hook 'viper-before-change-functions) + (make-local-hook 'viper-post-command-hooks) + (make-local-hook 'viper-pre-command-hooks)) + nil ; emacs + ) (remove-hook 'post-command-hook 'viper-post-command-sentinel) (add-hook 'post-command-hook 'viper-post-command-sentinel) @@ -744,14 +753,16 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to ;; this-command, last-command-char, last-command-event (setq this-command com) - (if viper-xemacs-p ; XEmacs represents key sequences as vectors - (setq last-command-event - (viper-copy-event (viper-seq-last-elt key)) - last-command-char (event-to-character last-command-event)) - ;; Emacs represents them as sequences (str or vec) - (setq last-command-event - (viper-copy-event (viper-seq-last-elt key)) - last-command-char last-command-event)) + (viper-cond-compile-for-xemacs-or-emacs + ;; XEmacs represents key sequences as vectors + (setq last-command-event + (viper-copy-event (viper-seq-last-elt key)) + last-command-char (event-to-character last-command-event)) + ;; Emacs represents them as sequences (str or vec) + (setq last-command-event + (viper-copy-event (viper-seq-last-elt key)) + last-command-char last-command-event) + ) (if (commandp com) (progn @@ -850,7 +861,7 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to (viper-copy-event (if viper-xemacs-p (character-to-event ch) ch))) ) ; let - (error) + (error nil) ) ; condition-case (viper-set-input-method nil) @@ -1766,13 +1777,14 @@ invokes the command before that, etc." (message " `.' runs %s%s" (concat "`" (viper-array-to-string keys) "'") (viper-abbreviate-string - (if viper-xemacs-p - (replace-in-string - (cond ((characterp text) (char-to-string text)) - ((stringp text) text) - (t "")) - "\n" "^J") - text) + (viper-cond-compile-for-xemacs-or-emacs + (replace-in-string ; xemacs + (cond ((characterp text) (char-to-string text)) + ((stringp text) text) + (t "")) + "\n" "^J") + text ; emacs + ) max-text-len " inserting `" "'" " .......")) )) @@ -2059,9 +2071,10 @@ To turn this feature off, set this variable to nil." (setq cmd (key-binding (setq key (read-key-sequence nil)))) (cond ((eq cmd 'self-insert-command) - (if viper-xemacs-p - (insert (events-to-keys key)) - (insert key))) + (viper-cond-compile-for-xemacs-or-emacs + (insert (events-to-keys key)) ; xemacs + (insert key) ; emacs + )) ((memq cmd '(exit-minibuffer viper-exit-minibuffer)) nil) (t (command-execute cmd))) @@ -2642,7 +2655,7 @@ On reaching beginning of line, stop and signal error." (let ((pt (point))) (condition-case nil (forward-char arg) - (error)) + (error nil)) (if (< (point) pt) ; arg was negative (- (viper-chars-in-region pt (point))) (viper-chars-in-region pt (point))))) @@ -2656,7 +2669,7 @@ On reaching beginning of line, stop and signal error." (let ((pt (point))) (condition-case nil (backward-char arg) - (error)) + (error nil)) (if (> (point) pt) ; arg was negative (viper-chars-in-region pt (point)) (- (viper-chars-in-region pt (point)))))) @@ -3323,9 +3336,11 @@ controlled by the sign of prefix numeric value." ;; (which is called from viper-search-forward/backward/next). If the value of ;; viper-search-scroll-threshold is negative - don't scroll. (defun viper-adjust-window () - (let ((win-height (if viper-emacs-p - (1- (window-height)) ; adjust for modeline - (window-displayed-height))) + (let ((win-height (viper-cond-compile-for-xemacs-or-emacs + (window-displayed-height) ; xemacs + ;; emacs + (1- (window-height)) ; adjust for modeline + )) (pt (point)) at-top-p at-bottom-p min-scroll direction) @@ -4575,8 +4590,6 @@ One can use `` and '' to temporarily jump 1 step back." (t (error viper-InvalidTextmarker reg))))) - -;; commands in insertion mode (defun viper-delete-backward-word (arg) "Delete previous word." @@ -4587,6 +4600,17 @@ One can use `` and '' to temporarily jump 1 step back." (delete-region (point) (mark t)) (pop-mark))) + + +;; Get viper standard value of SYMBOL. If symbol is customized, get its +;; standard value. Otherwise, get the value saved in the alist STORAGE. If +;; STORAGE is nil, use viper-saved-user-settings. +(defun viper-standard-value (symbol &optional storage) + (or (eval (car (get symbol 'customized-value))) + (eval (car (get symbol 'saved-value))) + (nth 1 (assoc symbol (or storage viper-saved-user-settings))))) + + (defun viper-set-expert-level (&optional dont-change-unless) "Sets the expert level for a Viper user. @@ -4913,7 +4937,7 @@ Mail anyway (y or n)? ") (require 'reporter) (set-window-configuration window-config) - (reporter-submit-bug-report "kifer@cs.sunysb.edu" + (reporter-submit-bug-report "kifer@cs.stonybrook.edu" (viper-version) varlist nil 'delete-other-windows @@ -4921,54 +4945,6 @@ Mail anyway (y or n)? ") )) - -;; Smoothes out the difference between Emacs' unread-command-events -;; and XEmacs unread-command-event. Arg is a character, an event, a list of -;; events or a sequence of keys. -;; -;; Due to the way unread-command-events in Emacs (not XEmacs), a non-event -;; symbol in unread-command-events list may cause Emacs to turn this symbol -;; into an event. Below, we delete nil from event lists, since nil is the most -;; common symbol that might appear in this wrong context. -(defun viper-set-unread-command-events (arg) - (if viper-emacs-p - (setq - unread-command-events - (let ((new-events - (cond ((eventp arg) (list arg)) - ((listp arg) arg) - ((sequencep arg) - (listify-key-sequence arg)) - (t (error - "viper-set-unread-command-events: Invalid argument, %S" - arg))))) - (if (not (eventp nil)) - (setq new-events (delq nil new-events))) - (append new-events unread-command-events))) - ;; XEmacs - (setq - unread-command-events - (append - (cond ((viper-characterp arg) (list (character-to-event arg))) - ((eventp arg) (list arg)) - ((stringp arg) (mapcar 'character-to-event arg)) - ((vectorp arg) (append arg nil)) ; turn into list - ((listp arg) (viper-eventify-list-xemacs arg)) - (t (error - "viper-set-unread-command-events: Invalid argument, %S" arg))) - unread-command-events)))) - -;; list is assumed to be a list of events of characters -(defun viper-eventify-list-xemacs (lis) - (mapcar - (lambda (elt) - (cond ((viper-characterp elt) (character-to-event elt)) - ((eventp elt) elt) - (t (error - "viper-eventify-list-xemacs: can't convert to event, %S" - elt)))) - lis)) - ;;; viper-cmd.el ends here diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index 9b26f468600..cb2f472af5e 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el @@ -1,8 +1,8 @@ ;;; viper-ex.el --- functions implementing the Ex commands for Viper -;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc. +;; Copyright (C) 1994, 95, 96, 97, 98, 2000, 01, 02 Free Software Foundation, Inc. -;; Author: Michael Kifer <kifer@cs.sunysb.edu> +;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; This file is part of GNU Emacs. @@ -39,6 +39,7 @@ (defvar viper-custom-file-name) (defvar viper-case-fold-search) (defvar explicit-shell-file-name) +(defvar compile-command) ;; loading happens only in non-interactive compilation ;; in order to spare non-viperized emacs from being viperized @@ -2016,9 +2017,9 @@ Please contact your system administrator. " (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) (orig-buf (current-buffer)) - (orig-buf-file-name (buffer-file-name)) - (orig-buf-name (buffer-name)) - (buff-changed-p (buffer-modified-p)) + ;;(orig-buf-file-name (buffer-file-name)) + ;;(orig-buf-name (buffer-name)) + ;;(buff-changed-p (buffer-modified-p)) temp-buf writing-same-file region file-exists writing-whole-file) (if (> beg end) (error viper-FirstAddrExceedsSecond)) @@ -2072,9 +2073,10 @@ Please contact your system administrator. " ;; create temp buffer for the region (setq temp-buf (get-buffer-create " *ex-write*")) (set-buffer temp-buf) - (if viper-xemacs-p - (set-visited-file-name ex-file) - (set-visited-file-name ex-file 'noquerry)) + (viper-cond-compile-for-xemacs-or-emacs + (set-visited-file-name ex-file) ; xemacs + (set-visited-file-name ex-file 'noquerry) ; emacs + ) (erase-buffer) (if (and file-exists ex-append) (insert-file-contents ex-file)) diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index babb5083076..889bb61b4d4 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -1,8 +1,8 @@ ;;; viper-init.el --- some common definitions for Viper -;; Copyright (C) 1997 Free Software Foundation, Inc. +;; Copyright (C) 1997, 98, 99, 2000, 01, 02 Free Software Foundation, Inc. -;; Author: Michael Kifer <kifer@cs.sunysb.edu> +;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; This file is part of GNU Emacs. @@ -37,6 +37,9 @@ (defvar current-input-method) (defvar default-input-method) (defvar describe-current-input-method-function) +(defvar bar-cursor) +(defvar default-cursor-type) +(defvar cursor-type) ;; end pacifier @@ -50,10 +53,23 @@ ;; Is it Emacs? (defconst viper-emacs-p (not viper-xemacs-p)) ;; Tell whether we are running as a window application or on a TTY + +;; This is used to avoid compilation warnings. When emacs/xemacs forms can +;; generate compile time warnings, we use this macro. +;; In this case, the macro will expand into the form that is appropriate to the +;; compiler at hand. +;; Suggested by rms. +(defmacro viper-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form) + (if (string-match "XEmacs" emacs-version) + xemacs-form emacs-form)) + + (defsubst viper-device-type () - (if viper-emacs-p - window-system - (device-type (selected-device)))) + (viper-cond-compile-for-xemacs-or-emacs + (device-type (selected-device)) + window-system + )) + ;; in XEmacs: device-type is tty on tty and stream in batch. (defun viper-window-display-p () (and (viper-device-type) (not (memq (viper-device-type) '(tty stream pc))))) @@ -434,15 +450,18 @@ color displays. By default, the delimiters are used only on TTYs." :group 'viper) ;; XEmacs requires glyphs -(if viper-xemacs-p - (progn - (or (glyphp viper-replace-region-end-delimiter) - (setq viper-replace-region-end-delimiter - (make-glyph viper-replace-region-end-delimiter))) - (or (glyphp viper-replace-region-start-delimiter) - (setq viper-replace-region-start-delimiter - (make-glyph viper-replace-region-start-delimiter))) - )) +(viper-cond-compile-for-xemacs-or-emacs + (progn ; xemacs + (or (glyphp viper-replace-region-end-delimiter) + (setq viper-replace-region-end-delimiter + (make-glyph viper-replace-region-end-delimiter))) + (or (glyphp viper-replace-region-start-delimiter) + (setq viper-replace-region-start-delimiter + (make-glyph viper-replace-region-start-delimiter))) + ) + nil ; emacs + ) + ;; These are local marker that must be initialized to nil and moved with @@ -978,7 +997,7 @@ Should be set in `~/.viper' file." (if viper-xemacs-p (setq bar-cursor nil) (setq cursor-type default-cursor-type)) - (error))) + (error nil))) (defun viper-set-insert-cursor-type () (if viper-xemacs-p diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index cad5f34389f..0b978d97e8f 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -1,8 +1,8 @@ ;;; viper-keym.el --- Viper keymaps -;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1994, 95, 96, 97, 2000, 01, 02 Free Software Foundation, Inc. -;; Author: Michael Kifer <kifer@cs.sunysb.edu> +;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; This file is part of GNU Emacs. @@ -616,11 +616,14 @@ Arguments: (major-mode viper-state keymap)" (defun viper-add-keymap (mapsrc mapdst) "Add contents of mapsrc to mapdst. It is assumed that mapsrc is sparse." - (if viper-xemacs-p - (map-keymap (lambda (key binding) (define-key mapdst key binding)) - mapsrc) - (mapcar (lambda (p) (define-key mapdst (vector (car p)) (cdr p))) - (cdr mapsrc)))) + (viper-cond-compile-for-xemacs-or-emacs + ;; xemacs + (map-keymap (lambda (key binding) (define-key mapdst key binding)) + mapsrc) + ;; emacs + (mapcar (lambda (p) (define-key mapdst (vector (car p)) (cdr p))) + (cdr mapsrc)) + )) (defun viper-modify-keymap (map alist) "Modifies MAP with bindings specified in the ALIST. The alist has the diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el index f438dc0613b..69d1a42b2eb 100644 --- a/lisp/emulation/viper-macs.el +++ b/lisp/emulation/viper-macs.el @@ -1,8 +1,8 @@ ;;; viper-macs.el --- functions implementing keyboard macros for Viper -;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1994, 95, 96, 97, 2000, 01, 02 Free Software Foundation, Inc. -;; Author: Michael Kifer <kifer@cs.sunysb.edu> +;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; This file is part of GNU Emacs. @@ -855,30 +855,10 @@ name from there." (error "Wrong type macro component, symbol-or-listp, %S" elt) macro))) -(defun viper-char-array-p (array) - (eval (cons 'and (mapcar 'viper-characterp array)))) - (defun viper-macro-to-events (macro-body) (vconcat (mapcar 'viper-key-to-emacs-key macro-body))) - -;; check if vec is a vector of character symbols -(defun viper-char-symbol-sequence-p (vec) - (and - (sequencep vec) - (eval - (cons 'and - (mapcar (lambda (elt) - (and (symbolp elt) (= (length (symbol-name elt)) 1))) - vec))))) - -;; Check if vec is a vector of key-press events representing characters -;; XEmacs only -(defun viper-event-vector-p (vec) - (and (vectorp vec) - (eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec))))) - ;;; Reading fast key sequences diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index cb9ad3ee8d9..330f93fc49f 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -1,8 +1,8 @@ ;;; viper-mous.el --- mouse support for Viper -;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1994, 95, 96, 97, 2001, 02 Free Software Foundation, Inc. -;; Author: Michael Kifer <kifer@cs.sunysb.edu> +;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; This file is part of GNU Emacs. @@ -121,9 +121,10 @@ considered related." ;; Returns window where click occurs (defun viper-mouse-click-window (click) - (let ((win (if viper-xemacs-p - (event-window click) - (posn-window (event-start click))))) + (let ((win (viper-cond-compile-for-xemacs-or-emacs + (event-window click) ; xemacs + (posn-window (event-start click)) ; emacs + ))) (if (window-live-p win) win (error "Click was not over a live window")))) @@ -142,9 +143,10 @@ considered related." ;; Returns position of a click (defsubst viper-mouse-click-posn (click) - (if viper-xemacs-p - (event-point click) - (posn-point (event-start click)))) + (viper-cond-compile-for-xemacs-or-emacs + (event-point click) ; xemacs + (posn-point (event-start click)) ; emacs + )) (defun viper-surrounding-word (count click-count) @@ -317,29 +319,33 @@ See `viper-surrounding-word' for the definition of a word in this case." ;; XEmacs has no double-click events. So, we must simulate. ;; So, we have to simulate event-click-count. (defun viper-event-click-count (click) - (if viper-xemacs-p - (viper-event-click-count-xemacs click) - (event-click-count click))) + (viper-cond-compile-for-xemacs-or-emacs + (viper-event-click-count-xemacs click) ; xemacs + (event-click-count click) ; emacs + )) ;; kind of semaphore for updating viper-current-click-count (defvar viper-counting-clicks-p nil) -(defun viper-event-click-count-xemacs (click) - (let ((time-delta (- (event-timestamp click) - viper-last-click-event-timestamp)) - inhibit-quit) - (while viper-counting-clicks-p - (ignore)) - (setq viper-counting-clicks-p t) - (if (> time-delta viper-multiclick-timeout) - (setq viper-current-click-count 0)) - (discard-input) - (setq viper-current-click-count (1+ viper-current-click-count) - viper-last-click-event-timestamp (event-timestamp click)) - (setq viper-counting-clicks-p nil) - (if (viper-sit-for-short viper-multiclick-timeout t) - viper-current-click-count - 0) - )) +(viper-cond-compile-for-xemacs-or-emacs + (defun viper-event-click-count-xemacs (click) + (let ((time-delta (- (event-timestamp click) + viper-last-click-event-timestamp)) + inhibit-quit) + (while viper-counting-clicks-p + (ignore)) + (setq viper-counting-clicks-p t) + (if (> time-delta viper-multiclick-timeout) + (setq viper-current-click-count 0)) + (discard-input) + (setq viper-current-click-count (1+ viper-current-click-count) + viper-last-click-event-timestamp (event-timestamp click)) + (setq viper-counting-clicks-p nil) + (if (viper-sit-for-short viper-multiclick-timeout t) + viper-current-click-count + 0) + )) + nil ; emacs + ) (defun viper-mouse-click-search-word (click arg) diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index ab63232d849..817db016ef4 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -1,8 +1,8 @@ ;;; viper-util.el --- Utilities used by viper.el -;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1994, 95, 96, 97, 99, 2000, 01, 02 Free Software Foundation, Inc. -;; Author: Michael Kifer <kifer@cs.sunysb.edu> +;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; This file is part of GNU Emacs. @@ -39,6 +39,7 @@ (defvar ex-unix-type-shell-options) (defvar viper-ex-tmp-buf-name) (defvar viper-syntax-preference) +(defvar viper-saved-mark) (require 'cl) (require 'ring) @@ -66,48 +67,46 @@ ;;; XEmacs support -(if viper-xemacs-p - (progn - (fset 'viper-read-event (symbol-function 'next-command-event)) - (fset 'viper-make-overlay (symbol-function 'make-extent)) - (fset 'viper-overlay-start (symbol-function 'extent-start-position)) - (fset 'viper-overlay-end (symbol-function 'extent-end-position)) - (fset 'viper-overlay-put (symbol-function 'set-extent-property)) - (fset 'viper-overlay-p (symbol-function 'extentp)) - (fset 'viper-overlay-get (symbol-function 'extent-property)) - (fset 'viper-move-overlay (symbol-function 'set-extent-endpoints)) - (fset 'viper-overlay-live-p (symbol-function 'extent-live-p)) - (if (viper-window-display-p) - (fset 'viper-iconify (symbol-function 'iconify-frame))) - (cond ((viper-has-face-support-p) - (fset 'viper-get-face (symbol-function 'get-face)) - (fset 'viper-color-defined-p - (symbol-function 'valid-color-name-p)) - ))) - (fset 'viper-read-event (symbol-function 'read-event)) - (fset 'viper-make-overlay (symbol-function 'make-overlay)) - (fset 'viper-overlay-start (symbol-function 'overlay-start)) - (fset 'viper-overlay-end (symbol-function 'overlay-end)) - (fset 'viper-overlay-put (symbol-function 'overlay-put)) - (fset 'viper-overlay-p (symbol-function 'overlayp)) - (fset 'viper-overlay-get (symbol-function 'overlay-get)) - (fset 'viper-move-overlay (symbol-function 'move-overlay)) - (fset 'viper-overlay-live-p (symbol-function 'overlayp)) - (if (viper-window-display-p) - (fset 'viper-iconify (symbol-function 'iconify-or-deiconify-frame))) - (cond ((viper-has-face-support-p) - (fset 'viper-get-face (symbol-function 'internal-get-face)) - (fset 'viper-color-defined-p (symbol-function 'x-color-defined-p)) - ))) - - -(fset 'viper-characterp - (symbol-function - (if viper-xemacs-p 'characterp 'integerp))) - -(fset 'viper-int-to-char - (symbol-function - (if viper-xemacs-p 'int-to-char 'identity))) +(viper-cond-compile-for-xemacs-or-emacs + (progn ; xemacs + (fset 'viper-overlay-p (symbol-function 'extentp)) + (fset 'viper-make-overlay (symbol-function 'make-extent)) + (fset 'viper-overlay-live-p (symbol-function 'extent-live-p)) + (fset 'viper-move-overlay (symbol-function 'set-extent-endpoints)) + (fset 'viper-overlay-start (symbol-function 'extent-start-position)) + (fset 'viper-overlay-end (symbol-function 'extent-end-position)) + (fset 'viper-overlay-get (symbol-function 'extent-property)) + (fset 'viper-overlay-put (symbol-function 'set-extent-property)) + (fset 'viper-read-event (symbol-function 'next-command-event)) + (fset 'viper-characterp (symbol-function 'characterp)) + (fset 'viper-int-to-char (symbol-function 'int-to-char)) + (if (viper-window-display-p) + (fset 'viper-iconify (symbol-function 'iconify-frame))) + (cond ((viper-has-face-support-p) + (fset 'viper-get-face (symbol-function 'get-face)) + (fset 'viper-color-defined-p (symbol-function 'valid-color-name-p)) + ))) + (progn ; emacs + (fset 'viper-overlay-p (symbol-function 'overlayp)) + (fset 'viper-make-overlay (symbol-function 'make-overlay)) + (fset 'viper-overlay-live-p (symbol-function 'overlayp)) + (fset 'viper-move-overlay (symbol-function 'move-overlay)) + (fset 'viper-overlay-start (symbol-function 'overlay-start)) + (fset 'viper-overlay-end (symbol-function 'overlay-end)) + (fset 'viper-overlay-get (symbol-function 'overlay-get)) + (fset 'viper-overlay-put (symbol-function 'overlay-put)) + (fset 'viper-read-event (symbol-function 'read-event)) + (fset 'viper-characterp (symbol-function 'integerp)) + (fset 'viper-int-to-char (symbol-function 'identity)) + (if (viper-window-display-p) + (fset 'viper-iconify (symbol-function 'iconify-or-deiconify-frame))) + (cond ((viper-has-face-support-p) + (fset 'viper-get-face (symbol-function 'internal-get-face)) + (fset 'viper-color-defined-p (symbol-function 'x-color-defined-p)) + ))) + ) + + ;; CHAR is supposed to be a char or an integer (positive or negative) ;; LIST is a list of chars, nil, and negative numbers @@ -133,14 +132,17 @@ (t nil))) (defsubst viper-color-display-p () - (if viper-emacs-p - (x-display-color-p) - (eq (device-class (selected-device)) 'color))) + (viper-cond-compile-for-xemacs-or-emacs + (eq (device-class (selected-device)) 'color) ; xemacs + (x-display-color-p) ; emacs + )) (defsubst viper-get-cursor-color () - (if viper-emacs-p - (cdr (assoc 'cursor-color (frame-parameters))) - (color-instance-name (frame-property (selected-frame) 'cursor-color)))) + (viper-cond-compile-for-xemacs-or-emacs + ;; xemacs + (color-instance-name (frame-property (selected-frame) 'cursor-color)) + (cdr (assoc 'cursor-color (frame-parameters))) ; emacs + )) ;; OS/2 @@ -154,11 +156,12 @@ (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))) + (viper-cond-compile-for-xemacs-or-emacs + (set-frame-property + (selected-frame) 'cursor-color (make-color-instance new-color)) + (modify-frame-parameters + (selected-frame) (list (cons 'cursor-color new-color))) + ) )) ;; By default, saves current frame cursor color in the @@ -824,14 +827,20 @@ ))) (defun viper-check-minibuffer-overlay () - (or (viper-overlay-p viper-minibuffer-overlay) - (setq viper-minibuffer-overlay - (if viper-xemacs-p - (viper-make-overlay 1 (1+ (buffer-size)) (current-buffer)) - ;; make overlay open-ended - (viper-make-overlay - 1 (1+ (buffer-size)) (current-buffer) nil 'rear-advance))) - )) + (if (viper-overlay-live-p viper-minibuffer-overlay) + (viper-move-overlay + viper-minibuffer-overlay + (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1) + (1+ (buffer-size))) + (setq viper-minibuffer-overlay + (if viper-xemacs-p + (viper-make-overlay 1 (1+ (buffer-size)) (current-buffer)) + ;; make overlay open-ended + (viper-make-overlay + (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1) + (1+ (buffer-size)) + (current-buffer) nil 'rear-advance))) + )) (defsubst viper-is-in-minibuffer () @@ -843,10 +852,12 @@ ;;; XEmacs compatibility (defun viper-abbreviate-file-name (file) - (if viper-emacs-p - (abbreviate-file-name file) - ;; XEmacs requires addl argument - (abbreviate-file-name file t))) + (viper-cond-compile-for-xemacs-or-emacs + ;; XEmacs requires addl argument + (abbreviate-file-name file t) + ;; emacs + (abbreviate-file-name file) + )) ;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg ;; in sit-for, so this function smoothes out the differences. @@ -871,9 +882,10 @@ (and (<= pos (point-max)) (<= (point-min) pos)))))) (defsubst viper-mark-marker () - (if viper-xemacs-p - (mark-marker t) - (mark-marker))) + (viper-cond-compile-for-xemacs-or-emacs + (mark-marker t) ; xemacs + (mark-marker) ; emacs + )) ;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring) ;; is the same as (mark t). @@ -886,13 +898,16 @@ ;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless ;; the user explicitly wants highlighting, e.g., by hitting '' or `` (defun viper-deactivate-mark () - (if viper-xemacs-p - (zmacs-deactivate-region) - (deactivate-mark))) + (viper-cond-compile-for-xemacs-or-emacs + (zmacs-deactivate-region) + (deactivate-mark) + )) (defsubst viper-leave-region-active () - (if viper-xemacs-p - (setq zmacs-region-stays t))) + (viper-cond-compile-for-xemacs-or-emacs + (setq zmacs-region-stays t) + nil + )) ;; Check if arg is a valid character for register ;; TYPE is a list that can contain `letter', `Letter', and `digit'. @@ -911,27 +926,61 @@ (defsubst viper-events-to-keys (events) - (cond (viper-xemacs-p (events-to-keys events)) - (t events))) + (viper-cond-compile-for-xemacs-or-emacs + (events-to-keys events) ; xemacs + events ; emacs + )) ;; it is suggested that an event must be copied before it is assigned to ;; last-command-event in XEmacs (defun viper-copy-event (event) - (if viper-xemacs-p - (copy-event event) - event)) + (viper-cond-compile-for-xemacs-or-emacs + (copy-event event) ; xemacs + event ; emacs + )) + +;; Uses different timeouts for ESC-sequences and others +(defsubst viper-fast-keysequence-p () + (not (viper-sit-for-short + (if (viper-ESC-event-p last-input-event) + viper-ESC-keyseq-timeout + viper-fast-keyseq-timeout) + t))) ;; like read-event, but in XEmacs also try to convert to char, if possible (defun viper-read-event-convert-to-char () (let (event) - (if viper-emacs-p - (read-event) - (setq event (next-command-event)) - (or (event-to-character event) - event)) + (viper-cond-compile-for-xemacs-or-emacs + (progn + (setq event (next-command-event)) + (or (event-to-character event) + event)) + (read-event) + ) )) +;; Viperized read-key-sequence +(defun viper-read-key-sequence (prompt &optional continue-echo) + (let (inhibit-quit event keyseq) + (setq keyseq (read-key-sequence prompt continue-echo)) + (setq event (if viper-xemacs-p + (elt keyseq 0) ; XEmacs returns vector of events + (elt (listify-key-sequence keyseq) 0))) + (if (viper-ESC-event-p event) + (let (unread-command-events) + (viper-set-unread-command-events keyseq) + (if (viper-fast-keysequence-p) + (let ((viper-vi-global-user-minor-mode nil) + (viper-vi-local-user-minor-mode nil) + (viper-replace-minor-mode nil) ; actually unnecessary + (viper-insert-global-user-minor-mode nil) + (viper-insert-local-user-minor-mode nil)) + (setq keyseq (read-key-sequence prompt continue-echo))) + (setq keyseq (read-key-sequence prompt continue-echo))))) + keyseq)) + + ;; This function lets function-key-map convert key sequences into logical ;; keys. This does a better job than viper-read-event when it comes to kbd ;; macros, since it enables certain macros to be shared between X and TTY modes @@ -954,44 +1003,45 @@ (defun viper-event-key (event) (or (and event (eventp event)) (error "viper-event-key: Wrong type argument, eventp, %S" event)) - (when (cond (viper-xemacs-p (or (key-press-event-p event) - (mouse-event-p event))) - (t t)) + (when (viper-cond-compile-for-xemacs-or-emacs + (or (key-press-event-p event) (mouse-event-p event)) ; xemacs + t ; emacs + ) (let ((mod (event-modifiers event)) basis) (setq basis - (cond - (viper-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 "viper-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 (viper-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 (viper-characterp event) - (< ?\C-? event) (<= event 255)) - (setq mod '(meta) - event (- event ?\C-? 1))) - ((and (null mod) (eq event 'return)) - (setq event ?\C-m)) - ((and (null mod) (eq event 'space)) - (setq event ?\ )) - ((and (null mod) (eq event 'delete)) - (setq event ?\C-?)) - ((and (null mod) (eq event 'backspace)) - (setq event ?\C-h)) - (t (event-basic-type event))) - ))) + (viper-cond-compile-for-xemacs-or-emacs + ;; XEmacs + (cond ((key-press-event-p event) + (event-key event)) + ((button-event-p event) + (concat "mouse-" (prin1-to-string (event-button event)))) + (t + (error "viper-event-key: Unknown event, %S" event))) + ;; 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 (viper-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 (viper-characterp event) + (< ?\C-? event) (<= event 255)) + (setq mod '(meta) + event (- event ?\C-? 1))) + ((and (null mod) (eq event 'return)) + (setq event ?\C-m)) + ((and (null mod) (eq event 'space)) + (setq event ?\ )) + ((and (null mod) (eq event 'delete)) + (setq event ?\C-?)) + ((and (null mod) (eq event 'backspace)) + (setq event ?\C-h)) + (t (event-basic-type event))) + ) ; viper-cond-compile-for-xemacs-or-emacs + ) (if (viper-characterp basis) (setq basis (if (viper= basis ?\C-?) @@ -1046,6 +1096,77 @@ )) +;; LIS is assumed to be a list of events of characters +(defun viper-eventify-list-xemacs (lis) + (mapcar + (lambda (elt) + (cond ((viper-characterp elt) (character-to-event elt)) + ((eventp elt) elt) + (t (error + "viper-eventify-list-xemacs: can't convert to event, %S" + elt)))) + lis)) + + +;; Smoothes out the difference between Emacs' unread-command-events +;; and XEmacs unread-command-event. Arg is a character, an event, a list of +;; events or a sequence of keys. +;; +;; Due to the way unread-command-events in Emacs (not XEmacs), a non-event +;; symbol in unread-command-events list may cause Emacs to turn this symbol +;; into an event. Below, we delete nil from event lists, since nil is the most +;; common symbol that might appear in this wrong context. +(defun viper-set-unread-command-events (arg) + (if viper-emacs-p + (setq + unread-command-events + (let ((new-events + (cond ((eventp arg) (list arg)) + ((listp arg) arg) + ((sequencep arg) + (listify-key-sequence arg)) + (t (error + "viper-set-unread-command-events: Invalid argument, %S" + arg))))) + (if (not (eventp nil)) + (setq new-events (delq nil new-events))) + (append new-events unread-command-events))) + ;; XEmacs + (setq + unread-command-events + (append + (cond ((viper-characterp arg) (list (character-to-event arg))) + ((eventp arg) (list arg)) + ((stringp arg) (mapcar 'character-to-event arg)) + ((vectorp arg) (append arg nil)) ; turn into list + ((listp arg) (viper-eventify-list-xemacs arg)) + (t (error + "viper-set-unread-command-events: Invalid argument, %S" arg))) + unread-command-events)))) + + +;; Check if vec is a vector of key-press events representing characters +;; XEmacs only +(defun viper-event-vector-p (vec) + (and (vectorp vec) + (eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec))))) + + +;; check if vec is a vector of character symbols +(defun viper-char-symbol-sequence-p (vec) + (and + (sequencep vec) + (eval + (cons 'and + (mapcar (lambda (elt) + (and (symbolp elt) (= (length (symbol-name elt)) 1))) + vec))))) + + +(defun viper-char-array-p (array) + (eval (cons 'and (mapcar 'viper-characterp array)))) + + ;; Args can be a sequence of events, a string, or a Viper macro. Will try to ;; convert events to keys and, if all keys are regular printable ;; characters, will return a string. Otherwise, will return a string @@ -1071,21 +1192,14 @@ (t (prin1-to-string event-seq))))) (defun viper-key-press-events-to-chars (events) - (mapconcat (if viper-emacs-p - 'char-to-string - (lambda (elt) (char-to-string (event-to-character elt)))) + (mapconcat (viper-cond-compile-for-xemacs-or-emacs + (lambda (elt) (char-to-string (event-to-character elt))) ; xemacs + 'char-to-string ; emacs + ) events "")) -;; Uses different timeouts for ESC-sequences and others -(defsubst viper-fast-keysequence-p () - (not (viper-sit-for-short - (if (viper-ESC-event-p last-input-event) - viper-ESC-keyseq-timeout - viper-fast-keyseq-timeout) - t))) - (defun viper-read-char-exclusive () (let (char (echo-keystrokes 1)) diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index a76dedd3f08..7e1f47d3728 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -3,12 +3,12 @@ ;; and a venomous VI PERil. ;; Viper Is also a Package for Emacs Rebels. -;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 01 Free Software Foundation, Inc. +;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 01, 02 Free Software Foundation, Inc. -;; Author: Michael Kifer <kifer@cs.sunysb.edu> +;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; Keywords: emulations -(defconst viper-version "3.11.1 of September 9, 2001" +(defconst viper-version "3.11.2 of January 4, 2002" "The current version of Viper") ;; This file is part of GNU Emacs. @@ -353,9 +353,6 @@ user decide when to invoke Viper in a major mode." ;; Non-viper variables that need to be saved in case the user decides to ;; de-viperize emacs. (defvar viper-saved-non-viper-variables nil) -;; Contains user settings for vars affected by viper-set-expert-level function. -;; Not a user option. -(defvar viper-saved-user-settings nil) (defcustom viper-mode (cond (noninteractive nil) (t 'ask)) @@ -1056,26 +1053,6 @@ remains buffer-local." ) ; end viper-non-hook-settings -;; Viperized read-key-sequence -(defun viper-read-key-sequence (prompt &optional continue-echo) - (let (inhibit-quit event keyseq) - (setq keyseq (read-key-sequence prompt continue-echo)) - (setq event (if viper-xemacs-p - (elt keyseq 0) ; XEmacs returns vector of events - (elt (listify-key-sequence keyseq) 0))) - (if (viper-ESC-event-p event) - (let (unread-command-events) - (viper-set-unread-command-events keyseq) - (if (viper-fast-keysequence-p) - (let ((viper-vi-global-user-minor-mode nil) - (viper-vi-local-user-minor-mode nil) - (viper-replace-minor-mode nil) ; actually unnecessary - (viper-insert-global-user-minor-mode nil) - (viper-insert-local-user-minor-mode nil)) - (setq keyseq (read-key-sequence prompt continue-echo))) - (setq keyseq (read-key-sequence prompt continue-echo))))) - keyseq)) - ;; Ask only if this-command/last-command are nil, i.e., when loading @@ -1122,14 +1099,6 @@ These two lines must come in the order given. -;; Get viper standard value of SYMBOL. If symbol is customized, get its -;; standard value. Otherwise, get the value saved in the alist STORAGE. If -;; STORAGE is nil, use viper-saved-user-settings. -(defun viper-standard-value (symbol &optional storage) - (or (eval (car (get symbol 'customized-value))) - (eval (car (get symbol 'saved-value))) - (nth 1 (assoc symbol (or storage viper-saved-user-settings))))) - ;; save non-viper vars that Viper might change |