Commit 34317da2 authored by Michael Kifer's avatar Michael Kifer
Browse files

new version

parent d0388eac
......@@ -136,6 +136,7 @@
(defgroup ediff nil
"A comprehensive visual interface to diff & patch"
:tag "Ediff"
:group 'tools)
......
This diff is collapsed.
......@@ -25,6 +25,9 @@
;; 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)
;; end pacifier
......@@ -83,13 +86,15 @@ In all likelihood, you don't need to bother with this setting."
(make-variable-buffer-local '(, var))
)))
(defmacro viper-loop (count body)
"(viper-loop COUNT BODY) Execute BODY COUNT times."
(list 'let (list (list 'count count))
(list 'while '(> count 0)
body
'(setq count (1- count))
)))
;; (viper-loop COUNT BODY) Execute BODY COUNT times.
(defmacro viper-loop (count &rest body)
(` (let ((count (, count)))
(while (> count 0)
(progn
(,@ body)
(setq count (1- count))
))
)))
(defmacro viper-buffer-live-p (buf)
(` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf))))))
......@@ -124,6 +129,19 @@ In all likelihood, you don't need to bother with this setting."
;; last elt of a sequence
(defsubst viper-seq-last-elt (seq)
(elt seq (1- (length seq))))
(defsubst viper-string-to-list (string)
(append (vconcat string) nil))
(defsubst viper-charlist-to-string (list)
(mapconcat 'char-to-string list ""))
;; like char-after/before, but saves typing
(defun viper-char-at-pos (direction &optional offset)
(or (integerp offset) (setq offset 0))
(if (eq direction 'forward)
(char-after (+ (point) offset))
(char-before (- (point) offset))))
(defvar viper-minibuffer-overlay-priority 300)
......@@ -251,16 +269,81 @@ Use `M-x viper-set-expert-level' to change this.")
(defconst viper-max-expert-level 5)
;;; ISO characters
;;; ISO characters and MULE
;; If non-nil, ISO accents will be turned on in insert/replace emacs states and
;; turned off in vi-state. For some users, this behavior may be too
;; primitive. In this case, use insert/emacs/vi state hooks.
(viper-deflocalvar viper-automatic-iso-accents nil "")
(defcustom viper-automatic-iso-accents nil
"*If non-nil, ISO accents will be turned on in insert/replace emacs states and turned off in vi-state.
For some users, this behavior may be too primitive. In this case, use
insert/emacs/vi state hooks."
:type 'boolean
:group 'viper)
;; Set iso-accents-mode to ARG. Check if it is bound first
(defsubst viper-set-iso-accents-mode (arg)
(if (boundp 'iso-accents-mode)
(setq iso-accents-mode arg)))
;; Internal flag used to control when viper mule hooks are run.
;; Don't change this!
(defvar viper-mule-hook-flag t)
;; If non-nil, the default intl. input method is turned on.
(viper-deflocalvar viper-special-input-method nil "")
;; viper hook to run on input-method activation
(defun viper-activate-input-method-action ()
(if (null viper-mule-hook-flag)
()
(setq viper-special-input-method t)
;; turn off special input methods in vi-state
(if (eq viper-current-state 'vi-state)
(viper-set-input-method nil))
(if (memq viper-current-state '(vi-state insert-state replace-state))
(message "Viper special input method%s: on"
(if (or current-input-method default-input-method)
(format " %S"
(or current-input-method default-input-method))
"")))
))
;; viper hook to run on input-method deactivation
(defun viper-inactivate-input-method-action ()
(if (null viper-mule-hook-flag)
()
(setq viper-special-input-method nil)
(if (memq viper-current-state '(vi-state insert-state replace-state))
(message "Viper special input method%s: off"
(if (or current-input-method default-input-method)
(format " %S"
(or current-input-method default-input-method))
"")))))
(defun viper-inactivate-input-method ()
(cond ((and viper-emacs-p (fboundp 'inactivate-input-method))
(inactivate-input-method))
((and viper-xemacs-p (boundp 'current-input-method))
;; XEmacs had broken quil-mode for some time, so we are working around
;; it here
(setq quail-mode nil)
(if (featurep 'quail)
(quail-delete-overlays))
(setq describe-current-input-method-function nil)
(setq current-input-method nil)
(run-hooks 'input-method-inactivate-hook)
(force-mode-line-update))
))
(defun viper-activate-input-method ()
(cond ((and viper-emacs-p (fboundp 'activate-input-method))
(activate-input-method default-input-method))
((and viper-xemacs-p (fboundp 'quail-mode))
(quail-mode 1))))
;; Set quail-mode to ARG
(defun viper-set-input-method (arg)
(setq viper-mule-hook-flag t) ; just a precaution
(let (viper-mule-hook-flag) ; temporarily inactivate viper mule hooks
(cond ((and arg (> (prefix-numeric-value arg) 0) default-input-method)
;; activate input method
(viper-activate-input-method))
(t ; deactivate input method
(viper-inactivate-input-method)))
))
;; VI-style Undo
......@@ -372,7 +455,12 @@ color displays. By default, the delimiters are used only on TTYs."
;; Remember the number of characters that have to be deleted in replace
;; mode to compensate for the inserted characters.
(viper-deflocalvar viper-replace-chars-to-delete 0 "")
(viper-deflocalvar viper-replace-chars-deleted 0 "")
;; This variable is used internally by the before/after changed functions to
;; determine how many chars were deleted by the change. This can't be
;; determined inside after-change-functions because those get the length of the
;; deleted region, not the number of chars deleted (which are two different
;; things under MULE).
(viper-deflocalvar viper-replace-region-chars-deleted 0 "")
;; Insertion ring and command ring
(defcustom viper-insertion-ring-size 14
......@@ -520,8 +608,7 @@ to a new place after repeating previous Vi command."
(defvar viper-use-register nil)
;; Variables for Moves and Searches
;;; Variables for Moves and Searches
;; For use by `;' command.
(defvar viper-f-char nil)
......@@ -589,18 +676,22 @@ If nil, these commands cross line boundaries."
:type 'boolean
:group 'viper)
(viper-deflocalvar viper-ex-style-editing-in-insert t "")
(defcustom viper-ex-style-editing-in-insert t
"*If t, `Backspace' and `Delete' don't cross line boundaries in insert, etc.
(viper-deflocalvar viper-ex-style-editing t "")
(defcustom viper-ex-style-editing t
"*If t, Ex-style behavior while editing in Vi command and insert states.
`Backspace' and `Delete' don't cross line boundaries in insert.
`X' and `x' can't delete characters across line boundary in Vi, etc.
Note: this doesn't preclude `Backspace' and `Delete' from deleting characters
by moving past the insertion point. This is a feature, not a bug."
by moving past the insertion point. This is a feature, not a bug.
If nil, the above commands can work across lines."
:type 'boolean
:group 'viper)
(viper-deflocalvar viper-ESC-moves-cursor-back viper-ex-style-editing-in-insert "")
(viper-deflocalvar viper-ESC-moves-cursor-back viper-ex-style-editing "")
(defcustom viper-ESC-moves-cursor-back nil
"*If t, ESC moves cursor back when changing from insert to vi state.
If nil, the cursor stays where it was."
If nil, the cursor stays where it was when ESC was hit."
:type 'boolean
:group 'viper)
......
......@@ -28,7 +28,7 @@
(defvar viper-current-state)
(defvar viper-mode-string)
(defvar viper-expert-level)
(defvar viper-ex-style-editing-in-insert)
(defvar viper-ex-style-editing)
(defvar viper-ex-style-motion)
;; loading happens only in non-interactive compilation
......@@ -597,8 +597,8 @@ Arguments: (major-mode viper-state keymap)"
(princ (format "viper-always %S\n" viper-always))
(princ (format "viper-ex-style-motion %S\n"
viper-ex-style-motion))
(princ (format "viper-ex-style-editing-in-insert %S\n"
viper-ex-style-editing-in-insert))
(princ (format "viper-ex-style-editing %S\n"
viper-ex-style-editing))
(princ (format "viper-want-emacs-keys-in-vi %S\n"
viper-want-emacs-keys-in-vi))
(princ (format "viper-want-emacs-keys-in-insert %S\n"
......
......@@ -35,6 +35,7 @@
(defvar ex-unix-type-shell)
(defvar ex-unix-type-shell-options)
(defvar viper-ex-tmp-buf-name)
(defvar viper-syntax-preference)
(require 'cl)
(require 'ring)
......@@ -216,6 +217,21 @@
(goto-char cur-pos)
result))
;; Emacs counts each multibyte character as several positions in the buffer, so
;; we use Emacs' chars-in-region. XEmacs is counting each char as just one pos,
;; so we can simply subtract.
(defun viper-chars-in-region (beg end &optional preserve-sign)
(let ((count (abs (if (fboundp 'chars-in-region)
(chars-in-region beg end)
(- end beg)))))
(if (and (< end beg) preserve-sign)
(- count)
count)))
;; Test if POS is between BEG and END
(defsubst viper-pos-within-region (pos beg end)
(and (>= pos (min beg end)) (>= (max beg end) pos)))
;; Like move-marker but creates a virgin marker if arg isn't already a marker.
;; The first argument must eval to a variable name.
......@@ -1058,45 +1074,104 @@ the `Local variables' section of a file."
;;; Movement utilities
(defcustom viper-syntax-preference 'strict-vi
"*Syntax type characterizing Viper's alphanumeric symbols.
`emacs' means only word constituents are considered to be alphanumeric.
Word constituents are symbols specified as word constituents by the current
syntax table.
`extended' means word and symbol constituents.
`reformed-vi' means Vi-ish behavior: word constituents and the symbol `_'.
However, word constituents are determined according to Emacs syntax tables,
which may be different from Vi in some major modes.
`strict-vi' means Viper words are exactly as in Vi."
:type '(radio (const strict-vi) (const reformed-vi)
(const extended) (const emacs))
:group 'viper)
;; Characters that should not be considered as part of the word, in reformed-vi
;; syntax mode.
(defconst viper-non-word-characters-reformed-vi
"!@#$%^&*()-+=|\\~`{}[];:'\",<.>/?")
;; These are characters that are not to be considered as parts of a word in
;; Viper.
;; Set each time state changes and at loading time
(viper-deflocalvar viper-non-word-characters nil)
;; must be buffer-local
(viper-deflocalvar viper-ALPHA-char-class "w"
"String of syntax classes characterizing Viper's alphanumeric symbols.
In addition, the symbol `_' may be considered alphanumeric if
`viper-syntax-preference'is `reformed-vi'.")
`viper-syntax-preference' is `strict-vi' or `reformed-vi'.")
(viper-deflocalvar viper-strict-ALPHA-chars "a-zA-Z0-9_"
(defconst viper-strict-ALPHA-chars "a-zA-Z0-9_"
"Regexp matching the set of alphanumeric characters acceptable to strict
Vi.")
(defconst viper-strict-SEP-chars " \t\n"
"Regexp matching the set of alphanumeric characters acceptable to strict
Vi.")
(viper-deflocalvar viper-strict-SEP-chars " \t\n"
(defconst viper-strict-SEP-chars-sans-newline " \t"
"Regexp matching the set of alphanumeric characters acceptable to strict
Vi.")
(viper-deflocalvar viper-SEP-char-class " -"
(defconst viper-SEP-char-class " -"
"String of syntax classes for Vi separators.
Usually contains ` ', linefeed, TAB or formfeed.")
(defun viper-update-alphanumeric-class ()
"Set the syntax class of Viper alphanumerals according to `viper-syntax-preference'.
Must be called in order for changes to `viper-syntax-preference' to take effect."
;; Set Viper syntax classes and related variables according to
;; `viper-syntax-preference'.
(defun viper-update-syntax-classes (&optional set-default)
(let ((preference (cond ((eq viper-syntax-preference 'emacs)
"w") ; Viper words have only Emacs word chars
((eq viper-syntax-preference 'extended)
"w_") ; Viper words have Emacs word & symbol chars
(t "w"))) ; Viper words are Emacs words plus `_'
(non-word-chars (cond ((eq viper-syntax-preference 'reformed-vi)
(viper-string-to-list
viper-non-word-characters-reformed-vi))
(t nil))))
(if set-default
(setq-default viper-ALPHA-char-class preference
viper-non-word-characters non-word-chars)
(setq viper-ALPHA-char-class preference
viper-non-word-characters non-word-chars))
))
;; SYMBOL is used because customize requires it, but it is ignored, unless it
;; is `nil'. If nil, use setq.
(defun viper-set-syntax-preference (&optional symbol value)
"Set Viper syntax preference.
If called interactively or if SYMBOL is nil, sets syntax preference in current
buffer. If called non-interactively, preferably via the customization widget,
sets the default value."
(interactive)
(setq-default
viper-ALPHA-char-class
(cond ((eq viper-syntax-preference 'emacs) "w") ; only word constituents
((eq viper-syntax-preference 'extended) "w_") ; word & symbol chars
(t "w")))) ; vi syntax: word constituents and the symbol `_'
(or value
(setq value
(completing-read
"Viper syntax preference: "
'(("strict-vi") ("reformed-vi") ("extended") ("emacs"))
nil 'require-match)))
(if (stringp value) (setq value (intern value)))
(or (memq value '(strict-vi reformed-vi extended emacs))
(error "Invalid Viper syntax preference, %S" value))
(if symbol
(setq-default viper-syntax-preference value)
(setq viper-syntax-preference value))
(viper-update-syntax-classes))
(defcustom viper-syntax-preference 'reformed-vi
"*Syntax type characterizing Viper's alphanumeric symbols.
Affects movement and change commands that deal with Vi-style words.
Works best when set in the hooks to various major modes.
`strict-vi' means Viper words are (hopefully) exactly as in Vi.
`reformed-vi' means Viper words are like Emacs words \(as determined using
Emacs syntax tables, which are different for different major modes\) with two
exceptions: the symbol `_' is always part of a word and typical Vi non-word
symbols, such as `,',:,\",),{, etc., are excluded.
This behaves very close to `strict-vi', but also works well with non-ASCII
characters from various alphabets.
`extended' means Viper word constituents are symbols that are marked as being
parts of words OR symbols in Emacs syntax tables.
This is most appropriate for major modes intended for editing programs.
`emacs' means Viper words are the same as Emacs words as specified by Emacs
syntax tables.
This option is appropriate if you like Emacs-style words."
:type '(radio (const strict-vi) (const reformed-vi)
(const extended) (const emacs))
:set 'viper-set-syntax-preference
:group 'viper)
(make-variable-buffer-local 'viper-syntax-preference)
;; addl-chars are characters to be temporarily considered as alphanumerical
(defun viper-looking-at-alpha (&optional addl-chars)
......@@ -1107,19 +1182,26 @@ Must be called in order for changes to `viper-syntax-preference' to take effect.
(if char
(if (eq viper-syntax-preference 'strict-vi)
(looking-at (concat "[" viper-strict-ALPHA-chars addl-chars "]"))
(or (memq char
;; convert string to list
(append (vconcat addl-chars) nil))
(memq (char-syntax char)
(append (vconcat viper-ALPHA-char-class) nil)))))
(or
;; or one of the additional chars being asked to include
(memq char (viper-string-to-list addl-chars))
(and
;; not one of the excluded word chars
(not (memq char viper-non-word-characters))
;; char of the Viper-word syntax 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
(or (eq char ?\n) ; RET is always a separator in Vi
(memq (char-syntax char)
(append (vconcat viper-SEP-char-class) nil))))))
(if (eq viper-syntax-preference 'strict-vi)
(memq char (viper-string-to-list viper-strict-SEP-chars))
(or (eq char ?\n) ; RET is always a separator in Vi
(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)))
......@@ -1148,51 +1230,102 @@ Must be called in order for changes to `viper-syntax-preference' to take effect.
;; weird syntax tables may confuse strict-vi style
(defsubst viper-skip-all-separators-forward (&optional within-line)
(viper-skip-syntax 'forward
viper-SEP-char-class
(or within-line "\n")
(if within-line (viper-line-pos 'end))))
(if (eq viper-syntax-preference 'strict-vi)
(if within-line
(skip-chars-forward viper-strict-SEP-chars-sans-newline)
(skip-chars-forward viper-strict-SEP-chars))
(viper-skip-syntax 'forward
viper-SEP-char-class
(or within-line "\n")
(if within-line (viper-line-pos 'end)))))
(defsubst viper-skip-all-separators-backward (&optional within-line)
(viper-skip-syntax 'backward
viper-SEP-char-class
(or within-line "\n")
(if within-line (viper-line-pos 'start))))
(if (eq viper-syntax-preference 'strict-vi)
(if within-line
(skip-chars-backward viper-strict-SEP-chars-sans-newline)
(skip-chars-backward viper-strict-SEP-chars))
(viper-skip-syntax 'backward
viper-SEP-char-class
(or within-line "\n")
(if within-line (viper-line-pos 'start)))))
(defun viper-skip-nonseparators (direction)
(let ((func (intern (format "skip-syntax-%S" direction))))
(funcall func (concat "^" viper-SEP-char-class)
(viper-line-pos (if (eq direction 'forward) 'end 'start)))))
(viper-skip-syntax
direction
(concat "^" viper-SEP-char-class)
nil
(viper-line-pos (if (eq direction 'forward) 'end 'start))))
;; skip over non-word constituents and non-separators
(defun viper-skip-nonalphasep-forward ()
(if (eq viper-syntax-preference 'strict-vi)
(skip-chars-forward
(concat "^" viper-strict-SEP-chars viper-strict-ALPHA-chars))
(skip-syntax-forward
(concat
"^" viper-ALPHA-char-class viper-SEP-char-class) (viper-line-pos 'end))))
(viper-skip-syntax
'forward
(concat "^" viper-ALPHA-char-class viper-SEP-char-class)
;; Emacs may consider some of these as words, but we don't want them
viper-non-word-characters
(viper-line-pos 'end))))
(defun viper-skip-nonalphasep-backward ()
(if (eq viper-syntax-preference 'strict-vi)
(skip-chars-backward
(concat "^" viper-strict-SEP-chars viper-strict-ALPHA-chars))
(skip-syntax-backward
(concat
"^"
viper-ALPHA-char-class viper-SEP-char-class)
(viper-skip-syntax
'backward
(concat "^" viper-ALPHA-char-class viper-SEP-char-class)
;; Emacs may consider some of these as words, but we don't want them
viper-non-word-characters
(viper-line-pos 'start))))
;; Skip SYNTAX like skip-syntax-* and ADDL-CHARS like skip-chars-*
;; Return the number of chars traveled.
;; Either SYNTAX or ADDL-CHARS can be nil, in which case they are interpreted
;; as an empty string.
;; Both SYNTAX or ADDL-CHARS can be strings or lists of characters.
;; When SYNTAX is "w", then viper-non-word-characters are not considered to be
;; words, even if Emacs syntax table says they are.
(defun viper-skip-syntax (direction syntax addl-chars &optional limit)
(let ((total 0)
(local 1)
(skip-chars-func (intern (format "skip-chars-%S" direction)))
(skip-syntax-func (intern (format "skip-syntax-%S" direction))))
(or (stringp addl-chars) (setq addl-chars ""))
(or (stringp syntax) (setq syntax ""))
(skip-chars-func
(if (eq direction 'forward)
'skip-chars-forward 'skip-chars-backward))
(skip-syntax-func
(if (eq direction 'forward)
'viper-forward-char-carefully 'viper-backward-char-carefully))
char-looked-at syntax-of-char-looked-at negated-syntax)
(setq addl-chars
(cond ((listp addl-chars) (viper-charlist-to-string addl-chars))
((stringp addl-chars) addl-chars)
(t "")))
(setq syntax
(cond ((listp syntax) syntax)
((stringp syntax) (viper-string-to-list syntax))
(t nil)))
(if (memq ?^ syntax) (setq negated-syntax t))
(while (and (not (= local 0)) (not (eobp)))
(setq char-looked-at (viper-char-at-pos direction)
;; if outside the range, set to nil
syntax-of-char-looked-at (if char-looked-at
(char-syntax char-looked-at)))
(setq local
(+ (funcall skip-syntax-func syntax limit)
(+ (if (and
(cond ((and limit (eq direction 'forward))
(< (point) limit))
(limit ; backward & limit
(> (point) limit))
(t t)) ; no limit
;; char under/before cursor has appropriate syntax
(if negated-syntax
(not (memq syntax-of-char-looked-at syntax))
(memq syntax-of-char-looked-at syntax))
;; if char-syntax class is "word", make sure it is not one
;; of the excluded characters
(if (and (eq syntax-of-char-looked-at ?w)
(not negated-syntax))
(not (memq char-looked-at viper-non-word-characters))
t))
(funcall skip-syntax-func 1)
0)
(funcall skip-chars-func addl-chars limit)))
(setq total (+ total local)))
total
......
......@@ -8,7 +8,7 @@
;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
(defconst viper-version "2.96 of August 7, 1997"
(defconst viper-version "3.00 (Polyglot) of August 18, 1997"
"The current version of Viper")
;; This file is part of GNU Emacs.
......@@ -302,6 +302,7 @@
;; compiler pacifier
(defvar mark-even-if-inactive)
(defvar quail-mode)
(defvar viper-expert-level)
(defvar viper-expert-level)
......@@ -469,7 +470,7 @@ This startup message appears whenever you load Viper, unless you type `y' now."
;; This hook designed to enable Vi-style editing in comint-based modes."
(defun viper-comint-mode-hook ()
(setq require-final-newline nil
viper-ex-style-editing-in-insert nil
viper-ex-style-editing nil
viper-ex-style-motion nil)
(viper-change-state-to-insert))
......@@ -828,6 +829,62 @@ remains buffer-local."
(defadvice rmail-cease-edit (after viper-rmail-advice activate)
"Switch to emacs state when done editing message."
(viper-change-state-to-emacs))
;; ISO accents
;; Need to do it after loading iso-acc, or else this loading will wipe out
;; the advice.
(eval-after-load
"iso-acc"
(defadvice iso-accents-mode (around viper-iso-accents-advice activate)
"Set viper-automatic-iso-accents to iso-accents-mode."
(let ((arg (ad-get-arg 0)))
ad-do-it
(setq viper-automatic-iso-accents
(if (eq viper-current-state 'vi-state)
(if arg
;; if iso-accents-mode was called with positive arg, turn
;; accents on
(> (prefix-numeric-value arg) 0)
;; else: toggle viper-automatic-iso-accents
(not viper-automatic-iso-accents))
;; other states: accept what iso-accents-mode has done
iso-accents-mode))
;; turn off ISO accents in vi-state
(if (eq viper-current-state 'vi-state)
(viper-set-iso-accents-mode nil))
(if (memq viper-current-state '(vi-state insert-state replace-state))
(message "Viper ISO accents mode: %s"
(if viper-automatic-iso-accents "on" "off")))
)))
;; International input methods
(if viper-emacs-p
(eval-after-load "mule-cmds"
(progn
(defadvice inactivate-input-method (after viper-mule-advice activate)
"Set viper-special-input-method to disable intl. input methods."
(viper-inactivate-input-method-action))
(defadvice activate-input-method (after viper-mule-advice activate)
"Set viper-special-input-method to enable intl. input methods."
(viper-activate-input-method-action))
))
;; XEmacs Although these hooks exist in Emacs, they don't seem to be always
;; called on input-method activation/deactivation, so we the above advise
;; functions instead.
(eval-after-load "mule-cmds"
(progn