mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-18 08:51:45 -08:00
Remove most of the XEmacs compat code from viper*.el
* lisp/emulation/viper-cmd.el () (viper-insert-state-post-command-sentinel) (viper-change-state-to-vi, viper-change-state-to-insert) (viper-change-state-to-emacs, viper-escape-to-state) (viper-special-read-and-insert-char, viper-toggle-key-action) (viper-prefix-arg-value, viper-prefix-arg-com) (viper-digit-argument, viper-command-argument, ) (viper-exec-Yank, viper-repeat, viper-forward-char) (viper-backward-char, viper-forward-word, viper-forward-Word) (viper-end-of-word, viper-end-of-Word, viper-backward-word) (viper-backward-Word, viper-beginning-of-line) (viper-bol-and-skip-white, viper-goto-eol, viper-goto-col) (viper-next-line, viper-next-line-at-bol, viper-previous-line) (viper-previous-line-at-bol, viper-goto-line, ) (viper-repeat-find, viper-repeat-find-opposite) (viper-window-top, viper-window-middle, viper-window-bottom) (viper-paren-match, viper-search, viper-buffer-search-enable) (viper-put-back, viper-Put-back, viper-mark-point) (viper-cycle-through-mark-ring, viper-goto-mark-subr) (viper-brac-function, viper-register-to-point) (viper-submit-report): Remove some XEmacs compat code. * lisp/emulation/viper-ex.el (viper-get-ex-address-subr) (viper-handle-!, ex-edit, ex-mark, ex-next-related-buffer) (ex-help, ex-write, ex-write-info, viper-info-on-file): Ditto. * lisp/emulation/viper-keym.el (viper-add-keymap): Ditto. * lisp/emulation/viper-macs.el (viper-record-kbd-macro): Remove XEmacs compat code. * lisp/emulation/viper-mous.el (viper-mouse-click-insert-word) (viper-mouse-click-search-word): Remove some XEmacs compat code. * lisp/emulation/viper-util.el (viper-overlay-p) (viper-color-defined-p, viper-iconify, viper-memq-char) (viper-char-equal, viper=, viper-color-display-p) (viper-get-cursor-color, viper-frame-value) (viper-change-cursor-color, viper-save-cursor-color) (viper-restore-cursor-color, viper-get-visible-buffer-window) (viper-file-checked-in-p, viper-put-on-search-overlay) (viper-flash-search-pattern, viper-hide-search-overlay) (viper-move-replace-overlay, viper-set-replace-overlay) (viper-set-replace-overlay-glyphs, viper-hide-replace-overlay) (viper-replace-start, viper-replace-end) (viper-set-minibuffer-overlay, viper-check-minibuffer-overlay) (viper-abbreviate-file-name, viper-mark-marker) (viper-set-mark-if-necessary, viper-leave-region-active) (viper-copy-event, viper-read-event-convert-to-char) (viper-event-key, viper-last-command-char) (viper-key-to-emacs-key, viper-eventify-list-xemacs) (viper-set-unread-command-events, viper-char-array-p) (viper-key-press-events-to-chars, viper-read-char-exclusive): Remove most of the XEmacs compat code. * lisp/emulation/viper.el (viper-go-away, viper-set-hooks) (viper-non-hook-settings): Remove some XEmacs compat code.
This commit is contained in:
Lars Ingebrigtsen
parent
82aeaf1606
commit
dfec2bc785
7 changed files with 188 additions and 319 deletions
|
|
@ -164,7 +164,7 @@
|
|||
viper-insert-point
|
||||
(>= (point) viper-insert-point))
|
||||
(setq viper-last-posn-while-in-insert-state (point-marker)))
|
||||
(or (viper-overlay-p viper-replace-overlay)
|
||||
(or (overlayp viper-replace-overlay)
|
||||
(progn
|
||||
(viper-set-replace-overlay (point-min) (point-min))
|
||||
(viper-hide-replace-overlay)))
|
||||
|
|
@ -603,7 +603,7 @@
|
|||
(if (and viper-first-time (not (viper-is-in-minibuffer)))
|
||||
(viper-mode)
|
||||
(if overwrite-mode (overwrite-mode -1))
|
||||
(or (viper-overlay-p viper-replace-overlay)
|
||||
(or (overlayp viper-replace-overlay)
|
||||
(viper-set-replace-overlay (point-min) (point-min)))
|
||||
(viper-hide-replace-overlay)
|
||||
;; Expand abbrevs iff the previous character has word syntax.
|
||||
|
|
@ -639,7 +639,7 @@
|
|||
(interactive)
|
||||
(viper-change-state 'insert-state)
|
||||
|
||||
(or (viper-overlay-p viper-replace-overlay)
|
||||
(or (overlayp viper-replace-overlay)
|
||||
(viper-set-replace-overlay (point-min) (point-min)))
|
||||
(viper-hide-replace-overlay)
|
||||
|
||||
|
|
@ -686,7 +686,7 @@
|
|||
(defun viper-change-state-to-emacs (&rest _)
|
||||
"Change Viper state to Emacs."
|
||||
(interactive)
|
||||
(or (viper-overlay-p viper-replace-overlay)
|
||||
(or (overlayp viper-replace-overlay)
|
||||
(viper-set-replace-overlay (point-min) (point-min)))
|
||||
(viper-hide-replace-overlay)
|
||||
|
||||
|
|
@ -759,8 +759,7 @@ 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)
|
||||
;; Emacs represents key sequences as sequences (str or vec)
|
||||
(setq last-command-event
|
||||
(viper-copy-event (viper-seq-last-elt key)))
|
||||
(setq last-command-event (viper-seq-last-elt key))
|
||||
|
||||
(if (commandp com)
|
||||
;; pretend that current state is the state we escaped to
|
||||
|
|
@ -831,7 +830,7 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to
|
|||
(if (memq ch '(?\C-v ?\C-q))
|
||||
(setq ch (aref (read-key-sequence nil) 0)))
|
||||
(insert ch)))
|
||||
(setq last-command-event (viper-copy-event ch))
|
||||
(setq last-command-event ch)
|
||||
) ; let
|
||||
(error nil)
|
||||
) ; condition-case
|
||||
|
|
@ -941,7 +940,7 @@ as a Meta key and any number of multiple escapes are allowed."
|
|||
(interactive)
|
||||
(if (and (< viper-expert-level 2) (equal viper-toggle-key "\C-z"))
|
||||
(if (viper-window-display-p)
|
||||
(viper-iconify)
|
||||
(iconify-or-deiconify-frame)
|
||||
(suspend-emacs))
|
||||
(viper-change-state-to-emacs)))
|
||||
|
||||
|
|
@ -1016,20 +1015,20 @@ as a Meta key and any number of multiple escapes are allowed."
|
|||
(let ((viper-intermediate-command 'viper-digit-argument)
|
||||
value func)
|
||||
;; read while number
|
||||
(while (and (viper-characterp event-char)
|
||||
(while (and (characterp event-char)
|
||||
(>= event-char ?0) (<= event-char ?9))
|
||||
(setq value (+ (* (if (integerp value) value 0) 10) (- event-char ?0)))
|
||||
(setq event-char (viper-read-event-convert-to-char)))
|
||||
(setq event-char (read-event)))
|
||||
|
||||
(setq prefix-arg value)
|
||||
(if com (setq prefix-arg (cons prefix-arg com)))
|
||||
(while (eq event-char ?U)
|
||||
(viper-describe-arg prefix-arg)
|
||||
(setq event-char (viper-read-event-convert-to-char)))
|
||||
(setq event-char (read-event)))
|
||||
|
||||
(if (or com (and (not (eq viper-current-state 'vi-state))
|
||||
;; make sure it is a Vi command
|
||||
(viper-characterp event-char)
|
||||
(characterp event-char)
|
||||
(viper-vi-command-p event-char)
|
||||
))
|
||||
;; If appears to be one of the vi commands,
|
||||
|
|
@ -1154,7 +1153,7 @@ as a Meta key and any number of multiple escapes are allowed."
|
|||
|
||||
(if cmd-to-exec-at-end
|
||||
(progn
|
||||
(setq last-command-event (viper-copy-event char))
|
||||
(setq last-command-event char)
|
||||
(condition-case err
|
||||
(funcall cmd-to-exec-at-end cmd-info)
|
||||
(error
|
||||
|
|
@ -1176,7 +1175,6 @@ as a Meta key and any number of multiple escapes are allowed."
|
|||
(defun viper-digit-argument (arg)
|
||||
"Begin numeric argument for the next command."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(viper-prefix-arg-value
|
||||
(viper-last-command-char) (if (consp arg) (cdr arg) nil)))
|
||||
|
||||
|
|
@ -1197,7 +1195,7 @@ as a Meta key and any number of multiple escapes are allowed."
|
|||
(t (error viper-InvalidCommandArgument))))
|
||||
(quit (setq viper-use-register nil)
|
||||
(signal 'quit nil)))
|
||||
(viper-deactivate-mark)))
|
||||
(deactivate-mark)))
|
||||
|
||||
|
||||
;; repeat last destructive command
|
||||
|
|
@ -1381,7 +1379,7 @@ as a Meta key and any number of multiple escapes are allowed."
|
|||
(if (> lines-saved viper-change-notification-threshold)
|
||||
(unless (viper-is-in-minibuffer)
|
||||
(message "Saved %d lines" lines-saved)))))
|
||||
(viper-deactivate-mark)
|
||||
(deactivate-mark)
|
||||
(goto-char viper-com-point))
|
||||
|
||||
(defun viper-exec-bang (_m-com com)
|
||||
|
|
@ -1523,7 +1521,7 @@ If the prefix argument ARG is non-nil, it is used instead of `val'."
|
|||
;; executed by `.' is already on the ring.
|
||||
(if (eq last-command 'viper-display-current-destructive-command)
|
||||
(viper-push-onto-ring viper-d-com 'viper-command-ring))
|
||||
(viper-deactivate-mark)
|
||||
(deactivate-mark)
|
||||
))
|
||||
|
||||
(defun viper-repeat-from-history ()
|
||||
|
|
@ -2532,7 +2530,6 @@ These keys are ESC, RET, and LineFeed."
|
|||
"Move point right ARG characters (left if ARG negative).
|
||||
On reaching end of line, stop and signal error."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getcom arg)))
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
|
|
@ -2555,7 +2552,6 @@ On reaching end of line, stop and signal error."
|
|||
"Move point left ARG characters (right if ARG negative).
|
||||
On reaching beginning of line, stop and signal error."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getcom arg)))
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
|
|
@ -2688,7 +2684,6 @@ On reaching beginning of line, stop and signal error."
|
|||
(defun viper-forward-word (arg)
|
||||
"Forward word."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getcom arg)))
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
|
|
@ -2709,7 +2704,6 @@ On reaching beginning of line, stop and signal error."
|
|||
(defun viper-forward-Word (arg)
|
||||
"Forward word delimited by white characters."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getcom arg)))
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
|
|
@ -2752,7 +2746,6 @@ On reaching beginning of line, stop and signal error."
|
|||
(defun viper-end-of-word (arg &optional _careful)
|
||||
"Move point to end of current word."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getcom arg)))
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
|
|
@ -2765,7 +2758,6 @@ On reaching beginning of line, stop and signal error."
|
|||
(defun viper-end-of-Word (arg)
|
||||
"Forward to end of word delimited by white character."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getcom arg)))
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
|
|
@ -2800,7 +2792,6 @@ On reaching beginning of line, stop and signal error."
|
|||
(defun viper-backward-word (arg)
|
||||
"Backward word."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getcom arg)))
|
||||
(if com
|
||||
|
|
@ -2815,7 +2806,6 @@ On reaching beginning of line, stop and signal error."
|
|||
(defun viper-backward-Word (arg)
|
||||
"Backward word delimited by white character."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getcom arg)))
|
||||
(if com
|
||||
|
|
@ -2836,7 +2826,6 @@ On reaching beginning of line, stop and signal error."
|
|||
(defun viper-beginning-of-line (arg)
|
||||
"Go to beginning of line."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getcom arg)))
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
|
|
@ -2846,7 +2835,6 @@ On reaching beginning of line, stop and signal error."
|
|||
(defun viper-bol-and-skip-white (arg)
|
||||
"Beginning of line at first non-white character."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getcom arg)))
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
|
|
@ -2856,7 +2844,6 @@ On reaching beginning of line, stop and signal error."
|
|||
(defun viper-goto-eol (arg)
|
||||
"Go to end of line."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getcom arg)))
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
|
|
@ -2873,7 +2860,6 @@ On reaching beginning of line, stop and signal error."
|
|||
(defun viper-goto-col (arg)
|
||||
"Go to ARG's column."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getcom arg))
|
||||
line-len)
|
||||
|
|
@ -2895,7 +2881,6 @@ On reaching beginning of line, stop and signal error."
|
|||
(defun viper-next-line (arg)
|
||||
"Go to next line."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getCom arg)))
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
|
|
@ -2930,7 +2915,6 @@ If point is on a widget or a button, simulate clicking on that widget/button."
|
|||
(if (and (fboundp 'button-at) (fboundp 'push-button) (button-at (point)))
|
||||
(push-button)
|
||||
;; not a widget or a button
|
||||
(viper-leave-region-active)
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
(if (eobp) (error "Last line in buffer")))
|
||||
|
|
@ -2945,7 +2929,6 @@ If point is on a widget or a button, simulate clicking on that widget/button."
|
|||
(defun viper-previous-line (arg)
|
||||
"Go to previous line."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getCom arg)))
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
|
|
@ -2963,7 +2946,6 @@ If point is on a widget or a button, simulate clicking on that widget/button."
|
|||
(defun viper-previous-line-at-bol (arg)
|
||||
"Previous line at beginning of line."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(if (bobp) (error "First line in buffer")))
|
||||
|
|
@ -2998,7 +2980,7 @@ If point is on a widget or a button, simulate clicking on that widget/button."
|
|||
(let ((val (viper-P-val arg))
|
||||
(com (viper-getCom arg)))
|
||||
(viper-move-marker-locally 'viper-com-point (point))
|
||||
(viper-deactivate-mark)
|
||||
(deactivate-mark)
|
||||
(push-mark nil t)
|
||||
(if (null val)
|
||||
(goto-char (point-max))
|
||||
|
|
@ -3181,7 +3163,7 @@ controlled by the sign of prefix numeric value."
|
|||
(interactive "P")
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getcom arg)))
|
||||
(viper-deactivate-mark)
|
||||
(deactivate-mark)
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
(viper-find-char val viper-f-char viper-f-forward viper-f-offset)
|
||||
(if com
|
||||
|
|
@ -3194,7 +3176,7 @@ controlled by the sign of prefix numeric value."
|
|||
(interactive "P")
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getcom arg)))
|
||||
(viper-deactivate-mark)
|
||||
(deactivate-mark)
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
(viper-find-char val viper-f-char (not viper-f-forward) viper-f-offset)
|
||||
(if com
|
||||
|
|
@ -3210,7 +3192,6 @@ controlled by the sign of prefix numeric value."
|
|||
(interactive "P")
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getCom arg)))
|
||||
(viper-leave-region-active)
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
(push-mark nil t)
|
||||
(move-to-window-line (1- val))
|
||||
|
|
@ -3230,7 +3211,6 @@ controlled by the sign of prefix numeric value."
|
|||
(interactive "P")
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getCom arg)))
|
||||
(viper-leave-region-active)
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
(push-mark nil t)
|
||||
(move-to-window-line (+ (/ (1- (window-height)) 2) (1- val)))
|
||||
|
|
@ -3250,7 +3230,6 @@ controlled by the sign of prefix numeric value."
|
|||
(interactive "P")
|
||||
(let ((val (viper-p-val arg))
|
||||
(com (viper-getCom arg)))
|
||||
(viper-leave-region-active)
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
(push-mark nil t)
|
||||
(move-to-window-line (- val))
|
||||
|
|
@ -3316,7 +3295,6 @@ controlled by the sign of prefix numeric value."
|
|||
(defun viper-paren-match (arg)
|
||||
"Go to the matching parenthesis."
|
||||
(interactive "P")
|
||||
(viper-leave-region-active)
|
||||
(let ((com (viper-getcom arg))
|
||||
(parse-sexp-ignore-comments viper-parse-sexp-ignore-comments)
|
||||
anchor-point)
|
||||
|
|
@ -3723,7 +3701,7 @@ Null string will repeat previous search."
|
|||
(offset (not no-offset))
|
||||
(case-fold-search viper-case-fold-search)
|
||||
(start-point (or init-point (point))))
|
||||
(viper-deactivate-mark)
|
||||
(deactivate-mark)
|
||||
(if forward
|
||||
(condition-case nil
|
||||
(progn
|
||||
|
|
@ -3832,7 +3810,7 @@ Null string will repeat previous search."
|
|||
;; ?g acts as a default value for viper-buffer-search-char
|
||||
(setq viper-buffer-search-char ?g)))
|
||||
(define-key viper-vi-basic-map
|
||||
(cond ((viper-characterp viper-buffer-search-char)
|
||||
(cond ((characterp viper-buffer-search-char)
|
||||
(char-to-string viper-buffer-search-char))
|
||||
(t (error "viper-buffer-search-char: wrong value type, %S"
|
||||
viper-buffer-search-char)))
|
||||
|
|
@ -3938,7 +3916,7 @@ Null string will repeat previous search."
|
|||
(forward-line 1))
|
||||
(beginning-of-line))
|
||||
(if (not (eolp)) (viper-forward-char-carefully)))
|
||||
(set-marker (viper-mark-marker) (point) (current-buffer))
|
||||
(set-marker (mark-marker) (point) (current-buffer))
|
||||
(viper-set-destructive-command
|
||||
(list 'viper-put-back val nil viper-use-register nil nil))
|
||||
(setq sv-point (point))
|
||||
|
|
@ -3958,7 +3936,7 @@ Null string will repeat previous search."
|
|||
(exchange-point-and-mark)
|
||||
(if (bolp)
|
||||
(back-to-indentation)))
|
||||
(viper-deactivate-mark))
|
||||
(deactivate-mark))
|
||||
|
||||
(defun viper-Put-back (arg)
|
||||
"Put back at point/above line."
|
||||
|
|
@ -3983,7 +3961,7 @@ Null string will repeat previous search."
|
|||
(if (viper-end-with-a-newline-p text) (beginning-of-line))
|
||||
(viper-set-destructive-command
|
||||
(list 'viper-Put-back val nil viper-use-register nil nil))
|
||||
(set-marker (viper-mark-marker) (point) (current-buffer))
|
||||
(set-marker (mark-marker) (point) (current-buffer))
|
||||
(setq sv-point (point))
|
||||
(viper-loop val (viper-yank text))
|
||||
(setq chars-inserted (abs (- (point) sv-point))
|
||||
|
|
@ -4001,7 +3979,7 @@ Null string will repeat previous search."
|
|||
(exchange-point-and-mark)
|
||||
(if (bolp)
|
||||
(back-to-indentation)))
|
||||
(viper-deactivate-mark))
|
||||
(deactivate-mark))
|
||||
|
||||
|
||||
;; Copy region to kill-ring.
|
||||
|
|
@ -4286,7 +4264,7 @@ and regexp replace."
|
|||
(interactive)
|
||||
(let ((char (read-char)))
|
||||
(cond ((and (<= ?a char) (<= char ?z))
|
||||
(point-to-register (viper-int-to-char (1+ (- char ?a)))))
|
||||
(point-to-register (1+ (- char ?a))))
|
||||
((viper= char ?<) (viper-mark-beginning-of-buffer))
|
||||
((viper= char ?>) (viper-mark-end-of-buffer))
|
||||
((viper= char ?.) (viper-set-mark-if-necessary))
|
||||
|
|
@ -4322,15 +4300,15 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back."
|
|||
(if (eq last-command 'viper-cycle-through-mark-ring)
|
||||
()
|
||||
;; save current mark if the first iteration
|
||||
(setq mark-ring (delete (viper-mark-marker) mark-ring))
|
||||
(setq mark-ring (delete (mark-marker) mark-ring))
|
||||
(if (mark t)
|
||||
(push-mark (mark t) t)) )
|
||||
(pop-mark)
|
||||
(set-mark-command 1)
|
||||
;; don't duplicate mark on the ring
|
||||
(setq mark-ring (delete (viper-mark-marker) mark-ring))
|
||||
(setq mark-ring (delete (mark-marker) mark-ring))
|
||||
(push-mark sv-pt t)
|
||||
(viper-deactivate-mark)
|
||||
(deactivate-mark)
|
||||
(setq this-command 'viper-cycle-through-mark-ring)
|
||||
))
|
||||
|
||||
|
|
@ -4356,7 +4334,7 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back."
|
|||
(backward-char 1)))
|
||||
(cond ((viper-valid-register char '(letter))
|
||||
(let* ((buff (current-buffer))
|
||||
(reg (viper-int-to-char (1+ (- char ?a))))
|
||||
(reg (1+ (- char ?a)))
|
||||
(text-marker (get-register reg)))
|
||||
;; If marker points to file that had markers set (and those markers
|
||||
;; were saved (as e.g., in session.el), then restore those markers
|
||||
|
|
@ -4519,7 +4497,7 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back."
|
|||
((viper= ?\] reg)
|
||||
(viper-heading-end arg))
|
||||
((viper-valid-register reg '(letter))
|
||||
(let* ((val (get-register (viper-int-to-char (1+ (- reg ?a)))))
|
||||
(let* ((val (get-register (1+ (- reg ?a))))
|
||||
(buf (if (not (markerp val))
|
||||
(error viper-EmptyTextmarker reg)
|
||||
(marker-buffer val)))
|
||||
|
|
@ -4756,13 +4734,13 @@ Please, specify your level now: "))
|
|||
(if (and enforce-buffer
|
||||
(not (equal (current-buffer) (marker-buffer val))))
|
||||
(error (concat viper-EmptyTextmarker " in this buffer")
|
||||
(viper-int-to-char (1- (+ char ?a)))))
|
||||
(1- (+ char ?a))))
|
||||
(pop-to-buffer (marker-buffer val))
|
||||
(goto-char val))
|
||||
((and (consp val) (eq (car val) 'file))
|
||||
(find-file (cdr val)))
|
||||
(t
|
||||
(error viper-EmptyTextmarker (viper-int-to-char (1- (+ char ?a))))))))
|
||||
(error viper-EmptyTextmarker (1- (+ char ?a)))))))
|
||||
|
||||
|
||||
(defun viper-save-kill-buffer ()
|
||||
|
|
@ -4796,14 +4774,14 @@ Please, specify your level now: "))
|
|||
(viper-frame-parameters (if (fboundp 'frame-parameters)
|
||||
(frame-parameters (selected-frame))))
|
||||
(viper-minibuffer-emacs-face (if (viper-has-face-support-p)
|
||||
(viper-get-face
|
||||
(facep
|
||||
viper-minibuffer-emacs-face)
|
||||
'non-x))
|
||||
(viper-minibuffer-vi-face (if (viper-has-face-support-p)
|
||||
(viper-get-face viper-minibuffer-vi-face)
|
||||
(facep viper-minibuffer-vi-face)
|
||||
'non-x))
|
||||
(viper-minibuffer-insert-face (if (viper-has-face-support-p)
|
||||
(viper-get-face
|
||||
(facep
|
||||
viper-minibuffer-insert-face)
|
||||
'non-x))
|
||||
varlist salutation window-config)
|
||||
|
|
|
|||
|
|
@ -882,7 +882,8 @@ reversed."
|
|||
(exchange-point-and-mark)
|
||||
(goto-char
|
||||
(viper-register-to-point
|
||||
(viper-int-to-char (1+ (- ex-token ?a))) 'enforce-buffer)))
|
||||
(1+ (- ex-token ?a)))
|
||||
'enforce-buffer))
|
||||
(setq address (point-marker)))))
|
||||
address))
|
||||
|
||||
|
|
@ -1085,7 +1086,7 @@ reversed."
|
|||
(defun viper-handle-! ()
|
||||
(interactive)
|
||||
(if (and (string=
|
||||
(buffer-string) (viper-abbreviate-file-name default-directory))
|
||||
(buffer-string) (abbreviate-file-name default-directory))
|
||||
(member ex-token '("read" "write")))
|
||||
(erase-buffer))
|
||||
(insert "!"))
|
||||
|
|
@ -1263,7 +1264,7 @@ reversed."
|
|||
(if (not file)
|
||||
(viper-get-ex-file))
|
||||
(cond ((and (string= ex-file "") buffer-file-name)
|
||||
(setq ex-file (viper-abbreviate-file-name (buffer-file-name))))
|
||||
(setq ex-file (abbreviate-file-name (buffer-file-name))))
|
||||
((string= ex-file "")
|
||||
(error viper-NoFileSpecified)))
|
||||
|
||||
|
|
@ -1480,7 +1481,7 @@ reversed."
|
|||
(error "`%s' requires a following letter" ex-token))))
|
||||
(save-excursion
|
||||
(goto-char (car ex-addresses))
|
||||
(point-to-register (viper-int-to-char (1+ (- char ?a)))))))
|
||||
(point-to-register (1+ (- char ?a))))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -1547,7 +1548,7 @@ reversed."
|
|||
(if (not (viper-buffer-live-p buf))
|
||||
(error "Didn't find buffer %S or file %S"
|
||||
file-or-buffer-name
|
||||
(viper-abbreviate-file-name
|
||||
(abbreviate-file-name
|
||||
(expand-file-name file-or-buffer-name))))
|
||||
|
||||
(if (equal buf (current-buffer))
|
||||
|
|
@ -1562,7 +1563,7 @@ reversed."
|
|||
;; setup buffer
|
||||
(if (setq wind (viper-get-visible-buffer-window buf))
|
||||
()
|
||||
(setq wind (get-lru-window (if (featurep 'xemacs) nil 'visible)))
|
||||
(setq wind (get-lru-window 'visible))
|
||||
(set-window-buffer wind buf))
|
||||
|
||||
(if (viper-window-display-p)
|
||||
|
|
@ -1884,17 +1885,15 @@ reversed."
|
|||
(condition-case nil
|
||||
(progn
|
||||
(pop-to-buffer (get-buffer-create "*info*"))
|
||||
(info (if (featurep 'xemacs) "viper.info" "viper"))
|
||||
(info "viper")
|
||||
(message "Type `i' to search for a specific topic"))
|
||||
(error (beep 1)
|
||||
(with-output-to-temp-buffer " *viper-info*"
|
||||
(princ (format "
|
||||
The Info file for Viper does not seem to be installed.
|
||||
|
||||
This file is part of the standard distribution of %sEmacs.
|
||||
Please contact your system administrator. "
|
||||
(if (featurep 'xemacs) "X" "")
|
||||
))))))
|
||||
This file is part of the standard distribution of Emacs.
|
||||
Please contact your system administrator. "))))))
|
||||
|
||||
;; Ex source command.
|
||||
;; Loads the file specified as argument or viper-custom-file-name.
|
||||
|
|
@ -2089,9 +2088,7 @@ Please contact your system administrator. "
|
|||
;; create temp buffer for the region
|
||||
(setq temp-buf (get-buffer-create " *ex-write*"))
|
||||
(set-buffer temp-buf)
|
||||
(if (featurep 'xemacs)
|
||||
(set-visited-file-name ex-file)
|
||||
(set-visited-file-name ex-file 'noquery))
|
||||
(set-visited-file-name ex-file 'noquery)
|
||||
(erase-buffer)
|
||||
(if (and file-exists ex-append)
|
||||
(insert-file-contents ex-file))
|
||||
|
|
@ -2130,7 +2127,7 @@ Please contact your system administrator. "
|
|||
|
||||
(defun ex-write-info (exists file-name beg end)
|
||||
(message "`%s'%s %d lines, %d characters"
|
||||
(viper-abbreviate-file-name file-name)
|
||||
(abbreviate-file-name file-name)
|
||||
(if exists "" " [New file]")
|
||||
(count-lines beg (min (1+ end) (point-max)))
|
||||
(- end beg)))
|
||||
|
|
@ -2226,9 +2223,9 @@ Type `mak ' (including the space) to run make with no args."
|
|||
lines file info)
|
||||
(setq lines (count-lines (point-min) (viper-line-pos 'end))
|
||||
file (cond ((buffer-file-name)
|
||||
(concat (viper-abbreviate-file-name (buffer-file-name)) ":"))
|
||||
(concat (abbreviate-file-name (buffer-file-name)) ":"))
|
||||
((buffer-file-name (buffer-base-buffer))
|
||||
(concat (viper-abbreviate-file-name (buffer-file-name (buffer-base-buffer))) " (indirect buffer):"))
|
||||
(concat (abbreviate-file-name (buffer-file-name (buffer-base-buffer))) " (indirect buffer):"))
|
||||
(t (concat (buffer-name) " [Not visiting any file]:")))
|
||||
info (format "line=%d/%d pos=%d/%d col=%d %s"
|
||||
(if (= pos1 pos2)
|
||||
|
|
|
|||
|
|
@ -642,12 +642,8 @@ 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 (featurep 'xemacs)
|
||||
;; Emacs 22 has map-keymap.
|
||||
(map-keymap (lambda (key binding) (define-key mapdst key binding))
|
||||
mapsrc)
|
||||
(mapc (lambda (p) (define-key mapdst (vector (car p)) (cdr p)))
|
||||
(cdr mapsrc))))
|
||||
(mapc (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
|
||||
|
|
|
|||
|
|
@ -415,7 +415,7 @@ If SCOPE is nil, the user is asked to specify the scope."
|
|||
t)))
|
||||
(if (y-or-n-p
|
||||
(format "Save this macro in %s? "
|
||||
(viper-abbreviate-file-name viper-custom-file-name)))
|
||||
(abbreviate-file-name viper-custom-file-name)))
|
||||
(viper-save-string-in-file
|
||||
(format "\n(viper-record-kbd-macro %S '%S %s '%S)"
|
||||
(viper-display-macro macro-name)
|
||||
|
|
|
|||
|
|
@ -280,7 +280,7 @@ See `viper-surrounding-word' for the definition of a word in this case."
|
|||
;; the next pending event is not a mouse event, we execute the
|
||||
;; current mouse event
|
||||
(progn
|
||||
(setq interrupting-event (viper-read-event))
|
||||
(setq interrupting-event (read-event))
|
||||
(viper-mouse-event-p last-input-event)))
|
||||
(progn ; interrupted wait
|
||||
(setq viper-global-prefix-argument arg)
|
||||
|
|
@ -362,7 +362,7 @@ this command."
|
|||
;; pending event is not a mouse event, we execute the current mouse
|
||||
;; event
|
||||
(progn
|
||||
(viper-read-event)
|
||||
(read-event)
|
||||
(viper-mouse-event-p last-input-event)))
|
||||
(progn ; interrupted wait
|
||||
(setq viper-global-prefix-argument (or viper-global-prefix-argument
|
||||
|
|
@ -380,7 +380,7 @@ this command."
|
|||
viper-global-prefix-argument nil))
|
||||
(setq arg (or arg 1))
|
||||
|
||||
(viper-deactivate-mark)
|
||||
(deactivate-mark)
|
||||
(if (or (not (string= click-word viper-s-string))
|
||||
(not (markerp viper-search-start-marker))
|
||||
(not (equal (marker-buffer viper-search-start-marker)
|
||||
|
|
|
|||
|
|
@ -47,34 +47,22 @@
|
|||
|
||||
|
||||
|
||||
(defalias 'viper-overlay-p
|
||||
(if (featurep 'xemacs) 'extentp 'overlayp))
|
||||
(defalias 'viper-make-overlay
|
||||
(if (featurep 'xemacs) 'make-extent 'make-overlay))
|
||||
(defalias 'viper-overlay-live-p
|
||||
(if (featurep 'xemacs) 'extent-live-p 'overlayp))
|
||||
(defalias 'viper-move-overlay
|
||||
(if (featurep 'xemacs) 'set-extent-endpoints 'move-overlay))
|
||||
(defalias 'viper-overlay-start
|
||||
(if (featurep 'xemacs) 'extent-start-position 'overlay-start))
|
||||
(defalias 'viper-overlay-end
|
||||
(if (featurep 'xemacs) 'extent-end-position 'overlay-end))
|
||||
(defalias 'viper-overlay-get
|
||||
(if (featurep 'xemacs) 'extent-property 'overlay-get))
|
||||
(defalias 'viper-overlay-put
|
||||
(if (featurep 'xemacs) 'set-extent-property 'overlay-put))
|
||||
(defalias 'viper-read-event
|
||||
(if (featurep 'xemacs) 'next-command-event 'read-event))
|
||||
(defalias 'viper-characterp
|
||||
(if (featurep 'xemacs) 'characterp 'integerp))
|
||||
(defalias 'viper-int-to-char
|
||||
(if (featurep 'xemacs) 'int-to-char 'identity))
|
||||
(defalias 'viper-get-face
|
||||
(if (featurep 'xemacs) 'get-face 'facep))
|
||||
(defalias 'viper-color-defined-p
|
||||
(if (featurep 'xemacs) 'valid-color-name-p 'x-color-defined-p))
|
||||
(defalias 'viper-iconify
|
||||
(if (featurep 'xemacs) 'iconify-frame 'iconify-or-deiconify-frame))
|
||||
(define-obsolete-function-alias 'viper-overlay-p 'overlayp "27.1")
|
||||
(define-obsolete-function-alias 'viper-make-overlay 'make-overlay "27.1")
|
||||
(define-obsolete-function-alias 'viper-overlay-live-p 'overlayp "27.1")
|
||||
(define-obsolete-function-alias 'viper-move-overlay 'move-overlay "27.1")
|
||||
(define-obsolete-function-alias 'viper-overlay-start 'overlay-start "27.1")
|
||||
(define-obsolete-function-alias 'viper-overlay-end 'overlay-end "27.1")
|
||||
(define-obsolete-function-alias 'viper-overlay-get 'overlay-get "27.1")
|
||||
(define-obsolete-function-alias 'viper-overlay-put 'overlay-put "27.1")
|
||||
(define-obsolete-function-alias 'viper-read-event 'read-event "27.1")
|
||||
(define-obsolete-function-alias 'viper-characterp 'integerp "27.1")
|
||||
(define-obsolete-function-alias 'viper-int-to-char 'identity "27.1")
|
||||
(define-obsolete-function-alias 'viper-get-face 'facep "27.1")
|
||||
(define-obsolete-function-alias 'viper-color-defined-p
|
||||
'x-color-defined-p "27.1")
|
||||
(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)
|
||||
|
|
@ -84,60 +72,50 @@
|
|||
;; chars.
|
||||
(defun viper-memq-char (char list)
|
||||
(cond ((and (integerp char) (>= char 0))
|
||||
(memq (viper-int-to-char char) list))
|
||||
(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))
|
||||
(= (viper-int-to-char char-or-int) char))
|
||||
(= char-or-int char))
|
||||
((eq char-or-int char))))
|
||||
|
||||
;; Like =, but accommodates null and also is t for eq-objects
|
||||
(defun viper= (char char1)
|
||||
(cond ((eq char char1) t)
|
||||
((and (viper-characterp char) (viper-characterp char1))
|
||||
((and (characterp char) (characterp char1))
|
||||
(= char char1))
|
||||
(t nil)))
|
||||
|
||||
(defsubst viper-color-display-p ()
|
||||
(if (featurep 'xemacs) (eq (device-class (selected-device)) 'color)
|
||||
(x-display-color-p)))
|
||||
(x-display-color-p))
|
||||
|
||||
(defun viper-get-cursor-color (&optional frame)
|
||||
(if (featurep 'xemacs)
|
||||
(color-instance-name
|
||||
(frame-property (or frame (selected-frame)) 'cursor-color))
|
||||
(cdr (assoc 'cursor-color (frame-parameters)))))
|
||||
(defun viper-get-cursor-color (&optional _frame)
|
||||
(cdr (assoc 'cursor-color (frame-parameters))))
|
||||
|
||||
(defmacro viper-frame-value (variable)
|
||||
"Return the value of VARIABLE local to the current frame, if there is one.
|
||||
Otherwise return the normal value."
|
||||
`(if (featurep 'xemacs)
|
||||
;; 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
|
||||
;; 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
|
||||
;; with a value of nil.
|
||||
(let ((fp (assoc ',variable (frame-parameters))))
|
||||
(if fp (cdr fp)
|
||||
,variable)))))
|
||||
;; Distinguish between no frame parameter and a frame parameter
|
||||
;; with a value of nil.
|
||||
(let ((fp (assoc ',variable (frame-parameters))))
|
||||
(if fp (cdr fp)
|
||||
,variable))))
|
||||
|
||||
;; cursor colors
|
||||
(defun viper-change-cursor-color (new-color &optional frame)
|
||||
(if (and (viper-window-display-p) (viper-color-display-p)
|
||||
(stringp new-color) (viper-color-defined-p new-color)
|
||||
(if (and (viper-window-display-p) (viper-color-display-p)
|
||||
(stringp new-color) (x-color-defined-p new-color)
|
||||
(not (string= new-color (viper-get-cursor-color))))
|
||||
(if (featurep 'xemacs)
|
||||
(set-frame-property
|
||||
(or frame (selected-frame))
|
||||
'cursor-color (make-color-instance new-color))
|
||||
(modify-frame-parameters
|
||||
(or frame (selected-frame))
|
||||
(list (cons 'cursor-color new-color))))))
|
||||
(modify-frame-parameters
|
||||
(or frame (selected-frame))
|
||||
(list (cons 'cursor-color new-color)))))
|
||||
|
||||
;; Note that the colors this function uses might not be those
|
||||
;; associated with FRAME, if there are frame-local values.
|
||||
|
|
@ -166,7 +144,7 @@ Otherwise return the normal value."
|
|||
(defun viper-save-cursor-color (before-which-mode)
|
||||
(if (and (viper-window-display-p) (viper-color-display-p))
|
||||
(let ((color (viper-get-cursor-color)))
|
||||
(if (and (stringp color) (viper-color-defined-p color)
|
||||
(if (and (stringp color) (x-color-defined-p color)
|
||||
;; there is something fishy in that the color is not saved if
|
||||
;; it is the same as frames default cursor color. need to be
|
||||
;; checked.
|
||||
|
|
@ -216,7 +194,7 @@ Otherwise return the normal value."
|
|||
|
||||
;; restore cursor color from replace overlay
|
||||
(defun viper-restore-cursor-color(after-which-mode)
|
||||
(if (viper-overlay-p viper-replace-overlay)
|
||||
(if (overlayp viper-replace-overlay)
|
||||
(viper-change-cursor-color
|
||||
(cond ((eq after-which-mode 'after-replace-mode)
|
||||
(viper-get-saved-cursor-color-in-replace-mode))
|
||||
|
|
@ -255,10 +233,7 @@ Otherwise return the normal value."
|
|||
|
||||
|
||||
(defun viper-get-visible-buffer-window (wind)
|
||||
(if (featurep 'xemacs)
|
||||
(get-buffer-window wind t)
|
||||
(get-buffer-window wind 'visible)))
|
||||
|
||||
(get-buffer-window wind 'visible))
|
||||
|
||||
;; Return line position.
|
||||
;; If pos is 'start then returns position of line start.
|
||||
|
|
@ -708,9 +683,7 @@ Otherwise return the normal value."
|
|||
(if (fboundp 'vc-state)
|
||||
(and
|
||||
(not (memq (vc-state file) '(edited needs-merge)))
|
||||
(not (stringp (vc-state file))))
|
||||
;; XEmacs has no vc-state
|
||||
(if (featurep 'xemacs) (not (vc-locking-user file))))))
|
||||
(not (stringp (vc-state file)))))))
|
||||
|
||||
;; checkout if visited file is checked in
|
||||
(defun viper-maybe-checkout (buf)
|
||||
|
|
@ -730,12 +703,12 @@ Otherwise return the normal value."
|
|||
|
||||
;;; Overlays
|
||||
(defun viper-put-on-search-overlay (beg end)
|
||||
(if (viper-overlay-p viper-search-overlay)
|
||||
(viper-move-overlay viper-search-overlay beg end)
|
||||
(setq viper-search-overlay (viper-make-overlay beg end (current-buffer)))
|
||||
(viper-overlay-put
|
||||
(if (overlayp viper-search-overlay)
|
||||
(move-overlay viper-search-overlay beg end)
|
||||
(setq viper-search-overlay (make-overlay beg end (current-buffer)))
|
||||
(overlay-put
|
||||
viper-search-overlay 'priority viper-search-overlay-priority))
|
||||
(viper-overlay-put viper-search-overlay 'face viper-search-face))
|
||||
(overlay-put viper-search-overlay 'face viper-search-face))
|
||||
|
||||
;; Search
|
||||
|
||||
|
|
@ -744,41 +717,41 @@ Otherwise return the normal value."
|
|||
nil
|
||||
(viper-put-on-search-overlay (match-beginning 0) (match-end 0))
|
||||
(sit-for 2)
|
||||
(viper-overlay-put viper-search-overlay 'face nil)))
|
||||
(overlay-put viper-search-overlay 'face nil)))
|
||||
|
||||
(defun viper-hide-search-overlay ()
|
||||
(if (not (viper-overlay-p viper-search-overlay))
|
||||
(if (not (overlayp viper-search-overlay))
|
||||
(progn
|
||||
(setq viper-search-overlay
|
||||
(viper-make-overlay (point-min) (point-min) (current-buffer)))
|
||||
(viper-overlay-put
|
||||
(make-overlay (point-min) (point-min) (current-buffer)))
|
||||
(overlay-put
|
||||
viper-search-overlay 'priority viper-search-overlay-priority)))
|
||||
(viper-overlay-put viper-search-overlay 'face nil))
|
||||
(overlay-put viper-search-overlay 'face nil))
|
||||
|
||||
;; Replace state
|
||||
|
||||
(defsubst viper-move-replace-overlay (beg end)
|
||||
(viper-move-overlay viper-replace-overlay beg end))
|
||||
(move-overlay viper-replace-overlay beg end))
|
||||
|
||||
(defun viper-set-replace-overlay (beg end)
|
||||
(if (viper-overlay-live-p viper-replace-overlay)
|
||||
(if (overlayp viper-replace-overlay)
|
||||
(viper-move-replace-overlay beg end)
|
||||
(setq viper-replace-overlay (viper-make-overlay beg end (current-buffer)))
|
||||
(setq viper-replace-overlay (make-overlay beg end (current-buffer)))
|
||||
;; never detach
|
||||
(viper-overlay-put
|
||||
(overlay-put
|
||||
viper-replace-overlay (if (featurep 'emacs) 'evaporate 'detachable) nil)
|
||||
(viper-overlay-put
|
||||
(overlay-put
|
||||
viper-replace-overlay 'priority viper-replace-overlay-priority)
|
||||
;; If Emacs will start supporting overlay maps, as it currently supports
|
||||
;; text-property maps, we could do away with viper-replace-minor-mode and
|
||||
;; just have keymap attached to replace overlay.
|
||||
;;(viper-overlay-put
|
||||
;;(overlay-put
|
||||
;; viper-replace-overlay
|
||||
;; (if (featurep 'xemacs) 'keymap 'local-map)
|
||||
;; viper-replace-map)
|
||||
)
|
||||
(if (viper-has-face-support-p)
|
||||
(viper-overlay-put
|
||||
(overlay-put
|
||||
viper-replace-overlay 'face viper-replace-overlay-face))
|
||||
(viper-save-cursor-color 'before-replace-mode)
|
||||
(viper-change-cursor-color
|
||||
|
|
@ -786,27 +759,25 @@ Otherwise return the normal value."
|
|||
|
||||
|
||||
(defun viper-set-replace-overlay-glyphs (before-glyph after-glyph)
|
||||
(or (viper-overlay-live-p viper-replace-overlay)
|
||||
(or (overlayp viper-replace-overlay)
|
||||
(viper-set-replace-overlay (point-min) (point-min)))
|
||||
(if (or (not (viper-has-face-support-p))
|
||||
viper-use-replace-region-delimiters)
|
||||
(let ((before-name (if (featurep 'xemacs) 'begin-glyph 'before-string))
|
||||
(after-name (if (featurep 'xemacs) 'end-glyph 'after-string)))
|
||||
(viper-overlay-put viper-replace-overlay before-name before-glyph)
|
||||
(viper-overlay-put viper-replace-overlay after-name after-glyph))))
|
||||
(overlay-put viper-replace-overlay 'before-string before-glyph)
|
||||
(overlay-put viper-replace-overlay 'after-string after-glyph)))
|
||||
|
||||
(defun viper-hide-replace-overlay ()
|
||||
(viper-set-replace-overlay-glyphs nil nil)
|
||||
(viper-restore-cursor-color 'after-replace-mode)
|
||||
(viper-restore-cursor-color 'after-insert-mode)
|
||||
(if (viper-has-face-support-p)
|
||||
(viper-overlay-put viper-replace-overlay 'face nil)))
|
||||
(overlay-put viper-replace-overlay 'face nil)))
|
||||
|
||||
|
||||
(defsubst viper-replace-start ()
|
||||
(viper-overlay-start viper-replace-overlay))
|
||||
(overlay-start viper-replace-overlay))
|
||||
(defsubst viper-replace-end ()
|
||||
(viper-overlay-end viper-replace-overlay))
|
||||
(overlay-end viper-replace-overlay))
|
||||
|
||||
|
||||
;; Minibuffer
|
||||
|
|
@ -814,35 +785,25 @@ Otherwise return the normal value."
|
|||
(defun viper-set-minibuffer-overlay ()
|
||||
(viper-check-minibuffer-overlay)
|
||||
(when (viper-has-face-support-p)
|
||||
(viper-overlay-put
|
||||
(overlay-put
|
||||
viper-minibuffer-overlay 'face viper-minibuffer-current-face)
|
||||
(viper-overlay-put
|
||||
(overlay-put
|
||||
viper-minibuffer-overlay 'priority viper-minibuffer-overlay-priority)
|
||||
;; never detach
|
||||
(viper-overlay-put
|
||||
viper-minibuffer-overlay
|
||||
(if (featurep 'emacs) 'evaporate 'detachable)
|
||||
nil)
|
||||
;; make viper-minibuffer-overlay open-ended
|
||||
;; In emacs, it is made open ended at creation time
|
||||
(when (featurep 'xemacs)
|
||||
(viper-overlay-put viper-minibuffer-overlay 'start-open nil)
|
||||
(viper-overlay-put viper-minibuffer-overlay 'end-open nil))))
|
||||
(overlay-put viper-minibuffer-overlay 'evaporate nil)))
|
||||
|
||||
(defun viper-check-minibuffer-overlay ()
|
||||
(if (viper-overlay-live-p viper-minibuffer-overlay)
|
||||
(viper-move-overlay
|
||||
(if (overlayp viper-minibuffer-overlay)
|
||||
(move-overlay
|
||||
viper-minibuffer-overlay
|
||||
(if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)
|
||||
(1+ (buffer-size)))
|
||||
(setq viper-minibuffer-overlay
|
||||
(if (featurep 'xemacs)
|
||||
(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)))))
|
||||
;; make overlay open-ended
|
||||
(make-overlay
|
||||
(if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)
|
||||
(1+ (buffer-size))
|
||||
(current-buffer) nil 'rear-advance))))
|
||||
|
||||
|
||||
(defsubst viper-is-in-minibuffer ()
|
||||
|
|
@ -854,9 +815,7 @@ Otherwise return the normal value."
|
|||
;;; XEmacs compatibility
|
||||
|
||||
(defun viper-abbreviate-file-name (file)
|
||||
(if (featurep 'xemacs)
|
||||
(abbreviate-file-name file t) ; XEmacs requires addl argument
|
||||
(abbreviate-file-name file)))
|
||||
(abbreviate-file-name file))
|
||||
|
||||
;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg
|
||||
;; in sit-for, so this function smooths out the differences.
|
||||
|
|
@ -877,9 +836,7 @@ Otherwise return the normal value."
|
|||
(with-current-buffer buf
|
||||
(and (<= pos (point-max)) (<= (point-min) pos))))))
|
||||
|
||||
(defsubst viper-mark-marker ()
|
||||
(if (featurep 'xemacs) (mark-marker t)
|
||||
(mark-marker)))
|
||||
(define-obsolete-function-alias 'viper-mark-marker 'mark-marker "27.1")
|
||||
|
||||
(defvar viper-saved-mark nil
|
||||
"Where viper saves mark. This mark is resurrected by m^.")
|
||||
|
|
@ -887,20 +844,17 @@ Otherwise return the normal value."
|
|||
;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring)
|
||||
;; is the same as (mark t).
|
||||
(defsubst viper-set-mark-if-necessary ()
|
||||
(setq mark-ring (delete (viper-mark-marker) mark-ring))
|
||||
(setq mark-ring (delete (mark-marker) mark-ring))
|
||||
(set-mark-command nil)
|
||||
(setq viper-saved-mark (point)))
|
||||
|
||||
;; In transient mark mode (zmacs mode), it is annoying when regions become
|
||||
;; 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 (featurep 'xemacs)
|
||||
(zmacs-deactivate-region)
|
||||
(deactivate-mark)))
|
||||
;; In transient mark mode, it is annoying when regions become
|
||||
;; highlighted due to Viper's pushing marks. So, we deactivate marks,
|
||||
;; unless the user explicitly wants highlighting, e.g., by hitting ''
|
||||
;; or ``
|
||||
(define-obsolete-function-alias 'viper-deactivate-mark 'deactivate-mark "27.1")
|
||||
|
||||
(defsubst viper-leave-region-active ()
|
||||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||||
(define-obsolete-function-alias 'viper-leave-region-active 'ignore "27.1")
|
||||
|
||||
;; Check if arg is a valid character for register
|
||||
;; TYPE is a list that can contain `letter', `Letter', and `digit'.
|
||||
|
|
@ -919,11 +873,7 @@ Otherwise return the normal value."
|
|||
|
||||
|
||||
|
||||
;; 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 (featurep 'xemacs) (copy-event event)
|
||||
event))
|
||||
(define-obsolete-function-alias 'viper-copy-event 'identity "27.1")
|
||||
|
||||
;; Uses different timeouts for ESC-sequences and others
|
||||
(defun viper-fast-keysequence-p ()
|
||||
|
|
@ -933,15 +883,8 @@ Otherwise return the normal value."
|
|||
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 (featurep 'xemacs)
|
||||
(progn
|
||||
(setq event (next-command-event))
|
||||
(or (event-to-character event)
|
||||
event))
|
||||
(read-event))))
|
||||
(define-obsolete-function-alias 'viper-read-event-convert-to-char
|
||||
'read-event "27.1")
|
||||
|
||||
|
||||
;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil)
|
||||
|
|
@ -950,64 +893,47 @@ Otherwise return the normal value."
|
|||
(defun viper-event-key (event)
|
||||
(or (and event (eventp event))
|
||||
(error "viper-event-key: Wrong type argument, eventp, %S" event))
|
||||
(when (if (featurep 'xemacs)
|
||||
(or (key-press-event-p event) (mouse-event-p event)) ; xemacs
|
||||
t ; emacs
|
||||
)
|
||||
(let ((mod (event-modifiers event))
|
||||
basis)
|
||||
(setq basis
|
||||
(if (featurep 'xemacs)
|
||||
;; 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)))
|
||||
) ; (featurep 'xemacs)
|
||||
)
|
||||
(if (viper-characterp basis)
|
||||
(setq basis
|
||||
(if (viper= 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
|
||||
;; 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 (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 (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))))
|
||||
|
||||
(if (characterp basis)
|
||||
(setq basis
|
||||
(if (viper= basis ?\C-?)
|
||||
(list 'control '\?) ; taking care of an emacs bug
|
||||
(intern (char-to-string basis)))))
|
||||
(if mod
|
||||
(append mod (list basis))
|
||||
basis)))
|
||||
|
||||
(defun viper-last-command-char ()
|
||||
(if (featurep 'xemacs)
|
||||
(event-to-character last-command-event)
|
||||
last-command-event))
|
||||
last-command-event)
|
||||
|
||||
(defun viper-key-to-emacs-key (key)
|
||||
(let (key-name char-p modifiers mod-char-list base-key base-key-name)
|
||||
(cond ((featurep 'xemacs) key)
|
||||
|
||||
((symbolp key)
|
||||
(cond ((symbolp key)
|
||||
(setq key-name (symbol-name key))
|
||||
(cond ((= (length key-name) 1) ; character event
|
||||
(string-to-char key-name))
|
||||
|
|
@ -1049,16 +975,7 @@ Otherwise return the normal value."
|
|||
|
||||
|
||||
;; LIS is assumed to be a list of events of characters
|
||||
(defun viper-eventify-list-xemacs (lis)
|
||||
(if (featurep 'xemacs)
|
||||
(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)))
|
||||
(define-obsolete-function-alias 'viper-eventify-list-xemacs 'ignore "27.1")
|
||||
|
||||
|
||||
;; Smooths out the difference between Emacs's unread-command-events
|
||||
|
|
@ -1088,11 +1005,11 @@ Otherwise return the normal value."
|
|||
(setq
|
||||
unread-command-events
|
||||
(append
|
||||
(cond ((viper-characterp arg) (list (character-to-event arg)))
|
||||
(cond ((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))
|
||||
((listp arg) nil)
|
||||
(t (error
|
||||
"viper-set-unread-command-events: Invalid argument, %S" arg)))
|
||||
unread-command-events))))
|
||||
|
|
@ -1117,7 +1034,7 @@ Otherwise return the normal value."
|
|||
|
||||
|
||||
(defun viper-char-array-p (array)
|
||||
(eval (cons 'and (mapcar 'viper-characterp array))))
|
||||
(eval (cons 'and (mapcar 'characterp array))))
|
||||
|
||||
|
||||
;; Args can be a sequence of events, a string, or a Viper macro. Will try to
|
||||
|
|
@ -1145,12 +1062,7 @@ Otherwise return the normal value."
|
|||
(t (prin1-to-string event-seq)))))
|
||||
|
||||
(defun viper-key-press-events-to-chars (events)
|
||||
(mapconcat (if (featurep 'xemacs)
|
||||
(lambda (elt) (char-to-string (event-to-character elt))) ; xemacs
|
||||
'char-to-string ; emacs
|
||||
)
|
||||
events
|
||||
""))
|
||||
(mapconcat #'char-to-string events ""))
|
||||
|
||||
|
||||
(defun viper-read-char-exclusive ()
|
||||
|
|
@ -1161,7 +1073,7 @@ Otherwise return the normal value."
|
|||
(setq char (read-char))
|
||||
(error
|
||||
;; skip event if not char
|
||||
(viper-read-event))))
|
||||
(read-event))))
|
||||
char))
|
||||
|
||||
;; key is supposed to be in viper's representation, e.g., (control l), a
|
||||
|
|
|
|||
|
|
@ -700,8 +700,6 @@ It also can't undo some Viper settings."
|
|||
(and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
|
||||
(viper-delocalize-var 'minor-mode-map-alist))
|
||||
(viper-delocalize-var 'require-final-newline)
|
||||
(if (featurep 'xemacs) (viper-delocalize-var 'bar-cursor))
|
||||
|
||||
|
||||
;; deactivate all advices done by Viper.
|
||||
(viper--deactivate-advice-list)
|
||||
|
|
@ -787,8 +785,6 @@ It also can't undo some Viper settings."
|
|||
;; In emacs, we have to advice handle-switch-frame
|
||||
;; This advice is undone earlier, when all advices matching "viper-" are
|
||||
;; deactivated.
|
||||
(if (featurep 'xemacs)
|
||||
(remove-hook 'mouse-leave-frame-hook #'viper-remember-current-frame))
|
||||
) ; end viper-go-away
|
||||
|
||||
|
||||
|
|
@ -935,15 +931,7 @@ Two differences:
|
|||
(lambda (orig-fun &rest args)
|
||||
;; FIXME: Use remapping?
|
||||
(if (and (eq viper-current-state 'vi-state)
|
||||
;; Do not use called-interactively-p here. XEmacs does not have it
|
||||
;; and interactive-p is just fine.
|
||||
(if (featurep 'xemacs)
|
||||
(interactive-p)
|
||||
;; Respect the spirit of the above comment, though it
|
||||
;; seems pointless, since XE doesn't have advice-add or
|
||||
;; lexical binding or any other of the newer features
|
||||
;; this file uses.
|
||||
(called-interactively-p 'interactive)))
|
||||
(called-interactively-p 'interactive))
|
||||
(beep 1)
|
||||
(apply orig-fun args))))
|
||||
|
||||
|
|
@ -1083,13 +1071,11 @@ This may be needed if the previous `:map' command terminated abnormally."
|
|||
|
||||
;; catch frame switching event
|
||||
(if (viper-window-display-p)
|
||||
(if (featurep 'xemacs)
|
||||
(add-hook 'mouse-leave-frame-hook
|
||||
#'viper-remember-current-frame)
|
||||
(viper--advice-add 'handle-switch-frame :before
|
||||
(lambda (&rest _)
|
||||
"Remember the selected frame before the switch-frame event."
|
||||
(viper-remember-current-frame (selected-frame))))))
|
||||
(viper--advice-add
|
||||
'handle-switch-frame :before
|
||||
(lambda (&rest _)
|
||||
"Remember the selected frame before the switch-frame event."
|
||||
(viper-remember-current-frame (selected-frame)))))
|
||||
|
||||
) ; end viper-non-hook-settings
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue