diff options
Diffstat (limited to 'lisp/emulation')
| -rw-r--r-- | lisp/emulation/cua-base.el | 33 | ||||
| -rw-r--r-- | lisp/emulation/cua-rect.el | 8 | ||||
| -rw-r--r-- | lisp/emulation/viper-cmd.el | 48 | ||||
| -rw-r--r-- | lisp/emulation/viper-ex.el | 1 | ||||
| -rw-r--r-- | lisp/emulation/viper-init.el | 12 | ||||
| -rw-r--r-- | lisp/emulation/viper-mous.el | 12 | ||||
| -rw-r--r-- | lisp/emulation/viper-util.el | 50 | ||||
| -rw-r--r-- | lisp/emulation/viper.el | 1 |
8 files changed, 62 insertions, 103 deletions
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 6e10c36e77a..162d1bb641b 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -396,17 +396,17 @@ and after the region marked by the rectangle to search." (defcustom cua-rectangle-mark-key [(control return)] "Global key used to toggle the cua rectangle mark." - :set #'(lambda (symbol value) - (set symbol value) - (when (and (boundp 'cua--keymaps-initialized) - cua--keymaps-initialized) - (define-key cua-global-keymap value - #'cua-set-rectangle-mark) - (when (boundp 'cua--rectangle-keymap) - (define-key cua--rectangle-keymap value - #'cua-clear-rectangle-mark) - (define-key cua--region-keymap value - #'cua-toggle-rectangle-mark)))) + :set (lambda (symbol value) + (set symbol value) + (when (and (boundp 'cua--keymaps-initialized) + cua--keymaps-initialized) + (define-key cua-global-keymap value + #'cua-set-rectangle-mark) + (when (boundp 'cua--rectangle-keymap) + (define-key cua--rectangle-keymap value + #'cua-clear-rectangle-mark) + (define-key cua--region-keymap value + #'cua-toggle-rectangle-mark)))) :type 'key-sequence) (defcustom cua-rectangle-modifier-key 'meta @@ -699,6 +699,11 @@ Repeating prefix key when region is active works as a single prefix key." (interactive) (cua--prefix-override-replay 0)) +;; These aliases are so that we can look up the commands and find the +;; correct keys when generating menus. +(defalias 'cua-cut-handler #'cua--prefix-override-handler) +(defalias 'cua-copy-handler #'cua--prefix-override-handler) + (defun cua--prefix-repeat-handler () "Repeating prefix key when region is active works as a single prefix key." (interactive) @@ -1258,10 +1263,8 @@ If ARG is the atom `-', scroll upward by nearly full screen." (define-key cua--cua-keys-keymap [(meta v)] #'delete-selection-repeat-replace-region)) - (define-key cua--prefix-override-keymap [(control x)] - #'cua--prefix-override-handler) - (define-key cua--prefix-override-keymap [(control c)] - #'cua--prefix-override-handler) + (define-key cua--prefix-override-keymap [(control x)] #'cua-cut-handler) + (define-key cua--prefix-override-keymap [(control c)] #'cua-copy-handler) (define-key cua--prefix-repeat-keymap [(control x) (control x)] #'cua--prefix-repeat-handler) diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index 2d69ef9d246..a7f3d5fe14c 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -486,10 +486,8 @@ Activates the region if needed. Only lasts until the region is deactivated." (cua--deactivate t)) (setq cua--last-rectangle nil) (mouse-set-point event) - ;; FIX ME -- need to calculate virtual column. - (cua-set-rectangle-mark) - (setq cua--buffer-and-point-before-command nil) - (setq cua--mouse-last-pos nil)) + (activate-mark) + (cua-rectangle-mark-mode)) (defun cua-mouse-save-then-kill-rectangle (event arg) "Expand rectangle to mouse click position and copy rectangle. @@ -574,7 +572,7 @@ Only call fct for visible lines if VISIBLE==t. Set undo boundary if UNDO is non-nil. Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges) Perform auto-tabify after operation if TABIFY is non-nil. -Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear." +Mark is kept if keep-clear is `keep' and cleared if keep-clear is `clear'." (declare (indent 4)) (let* ((inhibit-field-text-motion t) (start (cua--rectangle-top)) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index e08d19c6115..ddb49609d40 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -35,9 +35,7 @@ (defvar viper--key-maps) (defvar viper--intercept-key-maps) (defvar iso-accents-mode) -(defvar quail-mode) (defvar quail-current-str) -(defvar mark-even-if-inactive) (defvar viper--init-message) (defvar viper-initial) (defvar undo-beg-posn) @@ -69,8 +67,7 @@ (nm-p (intern (concat snm "-p"))) (nms (intern (concat snm "s")))) `(defun ,nm-p (com) - (consp (viper-memq-char com ,nms) - )))) + (consp (memq com ,nms))))) ;; Variables for defining VI commands @@ -1035,23 +1032,23 @@ as a Meta key and any number of multiple escapes are allowed." cmd-info cmd-to-exec-at-end) (while (and cont - (viper-memq-char char - (list ?c ?d ?y ?! ?< ?> ?= ?# ?r ?R ?\" - viper-buffer-search-char))) + (memq char + (list ?c ?d ?y ?! ?< ?> ?= ?# ?r ?R ?\" + viper-buffer-search-char))) (if com ;; this means that we already have a command character, so we ;; construct a com list and exit while. however, if char is " ;; it is an error. (progn ;; new com is (CHAR . OLDCOM) - (if (viper-memq-char char '(?# ?\")) (user-error viper-ViperBell)) + (if (memq char '(?# ?\")) (user-error viper-ViperBell)) (setq com (cons char com)) (setq cont nil)) ;; If com is nil we set com as char, and read more. Again, if char is ;; ", we read the name of register and store it in viper-use-register. ;; if char is !, =, or #, a complete com is formed so we exit the while ;; loop. - (cond ((viper-memq-char char '(?! ?=)) + (cond ((memq char '(?! ?=)) (setq com char) (setq char (read-char)) (setq cont nil)) @@ -1091,7 +1088,7 @@ as a Meta key and any number of multiple escapes are allowed." `(key-binding (char-to-string ,char))))) ;; as com is non-nil, this means that we have a command to execute - (if (viper-memq-char (car com) '(?r ?R)) + (if (memq (car com) '(?r ?R)) ;; execute appropriate region command. (let ((char (car com)) (com (cdr com))) (setq prefix-arg (cons value com)) @@ -2321,7 +2318,6 @@ problems." (viper-downgrade-to-insert)) (defun viper-start-R-mode () - ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number (overwrite-mode 1) (add-hook 'viper-post-command-hooks #'viper-R-state-post-command-sentinel t 'local) @@ -2610,12 +2606,12 @@ On reaching beginning of line, stop and signal error." (let ((prev-char (viper-char-at-pos 'backward)) (saved-point (point))) ;; skip non-newline separators backward - (while (and (not (viper-memq-char prev-char '(nil \n))) + (while (and (not (memq prev-char '(nil \n))) (< lim (point)) ;; must be non-newline separator (if (eq viper-syntax-preference 'strict-vi) - (viper-memq-char prev-char '(?\ ?\t)) - (viper-memq-char (char-syntax prev-char) '(?\ ?-)))) + (memq prev-char '(?\ ?\t)) + (memq (char-syntax prev-char) '(?\ ?-)))) (viper-backward-char-carefully) (setq prev-char (viper-char-at-pos 'backward))) @@ -2629,12 +2625,12 @@ On reaching beginning of line, stop and signal error." ;; skip again, but make sure we don't overshoot the limit (if twice - (while (and (not (viper-memq-char prev-char '(nil \n))) + (while (and (not (memq prev-char '(nil \n))) (< lim (point)) ;; must be non-newline separator (if (eq viper-syntax-preference 'strict-vi) - (viper-memq-char prev-char '(?\ ?\t)) - (viper-memq-char (char-syntax prev-char) '(?\ ?-)))) + (memq prev-char '(?\ ?\t)) + (memq (char-syntax prev-char) '(?\ ?-)))) (viper-backward-char-carefully) (setq prev-char (viper-char-at-pos 'backward)))) @@ -2652,10 +2648,10 @@ On reaching beginning of line, stop and signal error." (viper-forward-word-kernel val) (if com (progn - (cond ((viper-char-equal com ?c) + (cond ((eq com ?c) (viper-separator-skipback-special 'twice viper-com-point)) ;; Yank words including the whitespace, but not newline - ((viper-char-equal com ?y) + ((eq com ?y) (viper-separator-skipback-special nil viper-com-point)) ((viper-dotable-command-p com) (viper-separator-skipback-special nil viper-com-point))) @@ -2673,10 +2669,10 @@ On reaching beginning of line, stop and signal error." (viper-skip-nonseparators 'forward) (viper-skip-separators t)) (if com (progn - (cond ((viper-char-equal com ?c) + (cond ((eq com ?c) (viper-separator-skipback-special 'twice viper-com-point)) ;; Yank words including the whitespace, but not newline - ((viper-char-equal com ?y) + ((eq com ?y) (viper-separator-skipback-special nil viper-com-point)) ((viper-dotable-command-p com) (viper-separator-skipback-special nil viper-com-point))) @@ -4726,15 +4722,15 @@ Please, specify your level now: ")) (defun viper-submit-report () "Submit bug report on Viper." (interactive) - (defvar viper-color-display-p) + (defvar x-display-color-p) (defvar viper-frame-parameters) (defvar viper-minibuffer-emacs-face) (defvar viper-minibuffer-vi-face) (defvar viper-minibuffer-insert-face) (let ((reporter-prompt-for-summary-p t) - (viper-color-display-p (if (viper-window-display-p) - (viper-color-display-p) - 'non-x)) + (x-display-color-p (if (viper-window-display-p) + (x-display-color-p) + 'non-x)) (viper-frame-parameters (frame-parameters (selected-frame))) (viper-minibuffer-emacs-face (if (viper-has-face-support-p) (facep @@ -4792,7 +4788,7 @@ Please, specify your level now: ")) 'viper-expert-level 'major-mode 'window-system - 'viper-color-display-p + 'x-display-color-p 'viper-frame-parameters 'viper-minibuffer-vi-face 'viper-minibuffer-insert-face diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index 0427e8ae774..d1bf5e38d53 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el @@ -25,7 +25,6 @@ ;;; Code: ;; Compiler pacifier -(defvar read-file-name-map) (defvar viper-use-register) (defvar viper-s-string) (defvar viper-shift-width) diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 7eac6a413ad..5430cd700bd 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -25,16 +25,12 @@ ;;; Code: ;; compiler pacifier -(defvar mark-even-if-inactive) -(defvar quail-mode) (defvar iso-accents-mode) (defvar viper-current-state) (defvar viper-version) (defvar viper-expert-level) (defvar current-input-method) (defvar default-input-method) -(defvar describe-current-input-method-function) -(defvar bar-cursor) (defvar cursor-type) ;; end pacifier @@ -48,12 +44,6 @@ (define-obsolete-function-alias 'viper-device-type #'window-system "27.1") -(defun viper-color-display-p () - (condition-case nil - (display-color-p) - (error nil))) - -;; in XEmacs: device-type is tty on tty and stream in batch. (defun viper-window-display-p () (and window-system (not (memq window-system '(tty stream pc))))) @@ -81,7 +71,7 @@ In all likelihood, you don't need to bother with this setting." (defun viper-has-face-support-p () (cond ((viper-window-display-p)) (viper-force-faces) - ((viper-color-display-p)) + ((x-display-color-p)) (t (memq window-system '(pc))))) diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index 21580996049..1a90cab7674 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -26,7 +26,6 @@ ;; compiler pacifier (defvar double-click-time) -(defvar mouse-track-multi-click-time) (defvar viper-search-start-marker) (defvar viper-local-search-start-marker) (defvar viper-search-history) @@ -63,8 +62,8 @@ or a triple-click." ;; time interval in millisecond within which successive clicks are ;; considered related (defcustom viper-multiclick-timeout (if (viper-window-display-p) - double-click-time - 500) + (mouse-double-click-time) + 500) "Time interval in milliseconds for mouse clicks to be considered related." :type 'integer) @@ -76,8 +75,8 @@ or a triple-click." ;; remembers prefix argument to pass along to commands invoked by second ;; click. -;; This is needed because in Emacs (not XEmacs), assigning to prefix-arg -;; causes Emacs to count the second click as if it was a single click +;; This is needed because assigning to prefix-arg causes Emacs to +;; count the second click as if it was a single click (defvar viper-global-prefix-argument nil) @@ -199,8 +198,7 @@ is ignored." (setq result (buffer-substring word-beg (point)))) ) ; if - ;; XEmacs doesn't have set-text-properties, but there buffer-substring - ;; doesn't return properties together with the string, so it's not needed. + ;; FIXME: Use `buffer-substring-no-properties' above instead? (set-text-properties 0 (length result) nil result) result)) diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index df33496fd8d..6d23ae9a0fd 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -29,9 +29,6 @@ ;; Compiler pacifier (defvar viper-minibuffer-current-face) -(defvar viper-minibuffer-insert-face) -(defvar viper-minibuffer-vi-face) -(defvar viper-minibuffer-emacs-face) (defvar viper-replace-overlay-face) (defvar viper-fast-keyseq-timeout) (defvar ex-unix-type-shell) @@ -64,22 +61,8 @@ (define-obsolete-function-alias 'viper-iconify #'iconify-or-deiconify-frame "27.1") - -;; CHAR is supposed to be a char or an integer (positive or negative) -;; LIST is a list of chars, nil, and negative numbers -;; Check if CHAR is a member by trying to convert in characters, if necessary. -;; Introduced for compatibility with XEmacs, where integers are not the same as -;; chars. -(defun viper-memq-char (char list) - (cond ((and (integerp char) (>= char 0)) - (memq char list)) - ((memq char list)))) - -;; Check if char-or-int and char are the same as characters -(defun viper-char-equal (char-or-int char) - (cond ((and (integerp char-or-int) (>= char-or-int 0)) - (= char-or-int char)) - ((eq char-or-int char)))) +(define-obsolete-function-alias 'viper-memq-char #'memq "29.1") +(define-obsolete-function-alias 'viper-char-equal #'eq "29.1") ;; Like =, but accommodates null and also is t for eq-objects (defun viper= (char char1) @@ -88,8 +71,7 @@ (= char char1)) (t nil))) -(defsubst viper-color-display-p () - (x-display-color-p)) +(define-obsolete-function-alias 'viper-color-display-p #'x-display-color-p "29.1") (defun viper-get-cursor-color (&optional _frame) (cdr (assoc 'cursor-color (frame-parameters)))) @@ -97,9 +79,6 @@ (defmacro viper-frame-value (variable) "Return the value of VARIABLE local to the current frame, if there is one. Otherwise return the normal value." - ;; Frame-local variables are obsolete from Emacs 22.2 onwards, - ;; so we do it by hand instead. - ;; Buffer-local values take precedence over frame-local ones. `(if (local-variable-p ',variable) ,variable ;; Distinguish between no frame parameter and a frame parameter @@ -110,7 +89,7 @@ Otherwise return the normal value." ;; cursor colors (defun viper-change-cursor-color (new-color &optional frame) - (if (and (viper-window-display-p) (viper-color-display-p) + (if (and (viper-window-display-p) (x-display-color-p) (stringp new-color) (x-color-defined-p new-color) (not (string= new-color (viper-get-cursor-color)))) (modify-frame-parameters @@ -142,7 +121,7 @@ Otherwise return the normal value." ;; 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)) + (if (and (viper-window-display-p) (x-display-color-p)) (let ((color (viper-get-cursor-color))) (if (and (stringp color) (x-color-defined-p color) ;; there is something fishy in that the color is not saved if @@ -1183,25 +1162,23 @@ This option is appropriate if you like Emacs-style words." (looking-at (concat "[" viper-strict-ALPHA-chars addl-chars "]")) (or ;; or one of the additional chars being asked to include - (viper-memq-char char (viper-string-to-list addl-chars)) + (memq char (viper-string-to-list addl-chars)) (and ;; not one of the excluded word chars (note: ;; viper-non-word-characters is a list) - (not (viper-memq-char char viper-non-word-characters)) + (not (memq char viper-non-word-characters)) ;; char of the Viper-word syntax class - (viper-memq-char (char-syntax char) - (viper-string-to-list viper-ALPHA-char-class)))))) - )) + (memq (char-syntax char) + (viper-string-to-list viper-ALPHA-char-class)))))))) (defun viper-looking-at-separator () (let ((char (char-after (point)))) (if char (if (eq viper-syntax-preference 'strict-vi) - (viper-memq-char char (viper-string-to-list viper-strict-SEP-chars)) + (memq char (viper-string-to-list viper-strict-SEP-chars)) (or (eq char ?\n) ; RET is always a separator in Vi - (viper-memq-char (char-syntax char) - (viper-string-to-list viper-SEP-char-class))))) - )) + (memq (char-syntax char) + (viper-string-to-list viper-SEP-char-class))))))) (defsubst viper-looking-at-alphasep (&optional addl-chars) (or (viper-looking-at-separator) (viper-looking-at-alpha addl-chars))) @@ -1327,8 +1304,7 @@ This option is appropriate if you like Emacs-style words." ;; of the excluded characters (if (and (eq syntax-of-char-looked-at ?w) (not negated-syntax)) - (not (viper-memq-char - char-looked-at viper-non-word-characters)) + (not (memq char-looked-at viper-non-word-characters)) t)) (funcall skip-syntax-func 1) 0) diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 51c1bf7d623..b1c361145ca 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -304,7 +304,6 @@ ;; compiler pacifier (defvar mark-even-if-inactive) -(defvar quail-mode) (defvar viper-expert-level) (defvar viper-mode-string) (defvar viper-major-mode-modifier-list) |