procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

*** empty log message ***

Browse source
This commit is contained in:
Michael Kifer 1999-11-01 07:16:15 +00:00
parent 93b7ac65fc
commit 3af0304a61
23 changed files with 1979 additions and 1483 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

54
lisp/ChangeLog
View file

@ -1,3 +1,57 @@
1999-11-01 Michael Kifer <kifer@cs.sunysb.edu>
* ediff.el: version change.
* ediff-util.el (ediff-cleanup-mess): fixed the case of dead windows.
make sure you are in a good frame before deleting other
windows.
(ediff-file-checked-in-p): don't consider CVS
files checked in.
(ediff-make-temp-file,ediff-make-empty-tmp-file): Make sure you
are writing to a newly created empty file.
* ediff-mult.el (ediff-show-session-group-hook): new default.
* ediff-vers.el (ediff-pcl-cvs-view-revision):
first cd to the file directory. reportedly works
better with remote files.
* ediff-vers.el (ediff-pcl-cvs-internal, ediff-pcl-cvs-merge-internal):
use file-name-nondirectory when passing files to CVS.
* ediff-diff.el (ediff-cmp-options): new var.
(ediff-same-file-contents): use ediff-cmp-options.
* ediff-ptch.el (ediff-prompt-for-patch-buffer,
ediff-get-patch-buffer): use current buffer if it appears to be a
patch.
* viper-keym.el: Fixed calls to viper-ex,
change key C-cg to C-cC-g
* viper-util.el (viper-nontrivial-find-file-function): deleted.
(viper-glob-unix-files, viper-glob-mswindows-files): new functions.
(viper-save-cursor-color,viper-restore-cursor-color):
improved cursor color handling.
(viper-get-saved-cursor-color-in-replace-mode,
viper-get-saved-cursor-color-in-insert-mode): new functions for
better cursor color handling.
* viper-ex.el (ex-read,ex-edit):
fixes for correct interpretation of #,%.
(viper-ex): now works correctly when called from other functions.
(viper-glob-function): new variable.
(viper-ex): save excursion before doing :global.
* viper-mous.el (viper-counting-clicks-p): bug fixes.
* viper-cmd.el (viper-post-command-sentinel,
viper-insert-state-post-command-sentinel,
viper-insert-state-pre-command-sentinel): takes better care of
cursor colors.
* viper.el: version change.
1999-10-31 Rajesh Vaidheeswarran <rv@dsmit.com>
* whitespace.el (whitespace-update-modeline): Bugfix to ensure

64
lisp/ediff-diff.el
View file

@ -65,6 +65,13 @@ It must return code 0, if its arguments are identical files."
:type 'string
:group 'ediff-diff)
(defcustom ediff-cmp-options nil
"*Options to pass to `ediff-cmp-program'. If GNUS diff is used as
`ediff-cmp-program', then the most useful options are `-I' RE, to
ignore changes whose lines all match RE."
:type '(repeat string)
:group 'ediff-diff)
(defcustom ediff-diff-program "diff"
"*Program to use for generating the differential of the two files."
:type 'string
@ -270,19 +277,19 @@ one optional arguments, diff-number to refine.")
;; fixup diff-list
(if diff3-job
(cond ((not file-A)
(mapcar (function (lambda (elt)
(aset elt 0 nil)
(aset elt 1 nil)))
(mapcar (lambda (elt)
(aset elt 0 nil)
(aset elt 1 nil))
(cdr diff-list)))
((not file-B)
(mapcar (function (lambda (elt)
(aset elt 2 nil)
(aset elt 3 nil)))
(mapcar (lambda (elt)
(aset elt 2 nil)
(aset elt 3 nil))
(cdr diff-list)))
((not file-C)
(mapcar (function (lambda (elt)
(aset elt 4 nil)
(aset elt 5 nil)))
(mapcar (lambda (elt)
(aset elt 4 nil)
(aset elt 5 nil))
(cdr diff-list)))
))
@ -475,13 +482,14 @@ one optional arguments, diff-number to refine.")
(if ediff-merge-job
(setq ediff-state-of-merge
(vconcat
(mapcar (function
(lambda (elt)
(let ((state-of-merge (aref elt 9))
(state-of-ancestor (aref elt 10)))
(vector
(if state-of-merge (format "%S" state-of-merge))
state-of-ancestor))))
(mapcar (lambda (elt)
(let ((state-of-merge (aref elt 9))
(state-of-ancestor (aref elt 10)))
(vector
;; state of merge: prefers/default-A/B or combined
(if state-of-merge (format "%S" state-of-merge))
;; whether the ancestor region is empty
state-of-ancestor)))
;; the first elt designates type of list
(cdr diff-list))
)))
@ -554,9 +562,11 @@ one optional arguments, diff-number to refine.")
(if (= 0 (mod current-diff 10))
(message "Buffer %S: Processing difference region %d of %d"
buf-type current-diff total-diffs))
;; record all overlays for this difference
;; the second elt, nil, is a place holder for the fine diff vector.
;; the third elt, nil, is a place holder for no-fine-diffs flag.
;; Record all overlays for this difference.
;; The 2-d elt, nil, is a place holder for the fine diff vector.
;; The 3-d elt, nil, is a place holder for no-fine-diffs flag.
;; The 4-th elt says which diff region is different from the other two
;; (3-way jobs only).
(setq diff-overlay-list
(nconc
diff-overlay-list
@ -646,7 +656,7 @@ one optional arguments, diff-number to refine.")
(or (ediff-get-fine-diff-vector n 'A)
(memq ediff-auto-refine '(off nix))
(ediff-message-if-verbose
"Region %d exceeds auto-refine limit. Type `%s' to refine"
"Region %d exceeds the auto-refinement limit. Type `%s' to refine"
(1+ n)
(substitute-command-keys
"\\[ediff-make-or-kill-fine-diffs]")
@ -784,11 +794,10 @@ one optional arguments, diff-number to refine.")
ediff-current-diff-overlay-alist))
'priority)
0)))))
(mapcar
(function (lambda (overl)
(ediff-set-overlay-face overl face)
(ediff-overlay-put overl 'priority priority)))
fine-diff-vector)))
(mapcar (lambda (overl)
(ediff-set-overlay-face overl face)
(ediff-overlay-put overl 'priority priority))
fine-diff-vector)))
;; This assumes buffer C and that the region looks like a combination of
;; regions in buffer A and C.
@ -1079,6 +1088,7 @@ one optional arguments, diff-number to refine.")
;; args.
(defun ediff-exec-process (program buffer synch options &rest files)
(let ((data (match-data))
(coding-system-for-read 'no-conversion)
args)
(setq args (append (split-string options) files))
(setq args (delete "" (delq nil args))) ; delete nil and "" from arguments
@ -1252,7 +1262,9 @@ argument to `skip-chars-forward'."
(defun ediff-same-file-contents (f1 f2)
"T if F1 and F2 have identical contents."
(let ((res (call-process ediff-cmp-program nil nil nil f1 f2)))
(let ((res
(apply 'call-process ediff-cmp-program nil nil nil
(append ediff-cmp-options (list f1 f2)))))
(and (numberp res) (eq res 0))))

40
lisp/ediff-help.el
View file

@ -65,7 +65,7 @@ n,SPC -next diff | h -hilighting | rx -restore buf X's old diff
~ -rotate buffers| m -wide display |
"
"Help message usually used for 3-way comparison.
Normally, not a user option. See `ediff-help-message' for details.")
Normally, not a user option. See `ediff-help-message' for details.")
(defconst ediff-long-help-message-compare2
"
@ -79,7 +79,7 @@ n,SPC -next diff | h -hilighting | rx -restore buf X's old diff
~ -swap variants | m -wide display |
"
"Help message usually used for 2-way comparison.
Normally, not a user option. See `ediff-help-message' for details.")
Normally, not a user option. See `ediff-help-message' for details.")
(defconst ediff-long-help-message-narrow2
"
@ -93,7 +93,7 @@ n,SPC -next diff | h -hilighting | rx -restore buf X's old diff
~ -swap variants | m -wide display |
"
"Help message when comparing windows or regions line-by-line.
Normally, not a user option. See `ediff-help-message' for details.")
Normally, not a user option. See `ediff-help-message' for details.")
(defconst ediff-long-help-message-word-mode
"
@ -107,7 +107,7 @@ n,SPC -next diff | h -hilighting | rx -restore buf X's old diff
~ -swap variants | m -wide display |
"
"Help message when comparing windows or regions word-by-word.
Normally, not a user option. See `ediff-help-message' for details.")
Normally, not a user option. See `ediff-help-message' for details.")
(defconst ediff-long-help-message-merge
"
@ -119,37 +119,38 @@ n,SPC -next diff | h -hilighting | r -restore buf C's old diff
v/V -scroll up/dn | X -read-only in buf X | wx -save buf X
</> -scroll lt/rt | m -wide display | wd -save diff output
~ -swap variants | s -shrink window C | / -show ancestor buff
| $ -show clashes only | & -merge w/new default
| $$ -show clashes only | & -merge w/new default
| $* -skip changed regions |
"
"Help message during merging.
Normally, not a user option. See `ediff-help-message' for details.")
"Help message for merge sessions.
Normally, not a user option. See `ediff-help-message' for details.")
;; The actual long help message.
(ediff-defvar-local ediff-long-help-message ""
"Normally, not a user option. See `ediff-help-message' for details.")
"Normally, not a user option. See `ediff-help-message' for details.")
(defconst ediff-brief-message-string
"? -quick help "
" ? -quick help "
"Contents of the brief help message.")
;; The actual brief help message
(ediff-defvar-local ediff-brief-help-message ""
"Normally, not a user option. See `ediff-help-message' for details.")
"Normally, not a user option. See `ediff-help-message' for details.")
(ediff-defvar-local ediff-brief-help-message-function nil
"The brief help message that the user can customize.
If the user sets this to a parameter-less function, Ediff will use it to
produce the brief help message. This function must return a string.")
produce the brief help message. This function must return a string.")
(ediff-defvar-local ediff-long-help-message-function nil
"The long help message that the user can customize.
See `ediff-brief-help-message-function' for more.")
(defvar ediff-use-long-help-message nil
"*If t, Ediff displays a long help message. Short help message otherwise.")
"*If t, Ediff displays a long help message. Short help message otherwise.")
;; The actual help message.
(ediff-defvar-local ediff-help-message ""
"The actual help message.
Normally, the user shouldn't touch this. However, if you want Ediff to
Normally, the user shouldn't touch this. However, if you want Ediff to
start up with different help messages for different jobs, you can change
the value of this variable and the variables `ediff-help-message-*' in
`ediff-startup-hook'.")
@ -188,12 +189,12 @@ the value of this variable and the variables `ediff-help-message-*' in
(if ediff-xemacs-p
(setq overl (extent-at pos (current-buffer) 'ediff-help-info)
cmd (ediff-overlay-get overl 'ediff-help-info))
(setq cmd (car (mapcar (function (lambda (elt)
(overlay-get elt 'ediff-help-info)))
(setq cmd (car (mapcar (lambda (elt)
(overlay-get elt 'ediff-help-info))
(overlays-at pos)))))
(if (not (stringp cmd))
(error "Hmm... I don't see an Ediff command around here..."))
(error "Hmm... I don't see an Ediff command around here..."))
(ediff-documentation "Quick Help Commands")
@ -231,7 +232,8 @@ the value of this variable and the variables `ediff-help-message-*' in
((string= cmd "z/q") (re-search-forward "^`z'"))
((string= cmd "%") (re-search-forward "^`%'"))
((string= cmd "C-l") (re-search-forward "^`C-l'"))
((string= cmd "$") (re-search-forward "^`\\$'"))
((string= cmd "$$") (re-search-forward "^`\\$\\$'"))
((string= cmd "$*") (re-search-forward "^`\\$\\*'"))
((string= cmd "/") (re-search-forward "^`/'"))
((string= cmd "&") (re-search-forward "^`&'"))
((string= cmd "s") (re-search-forward "^`s'"))
@ -309,5 +311,9 @@ the value of this variable and the variables `ediff-help-message-*' in
ediff-brief-help-message))
(run-hooks 'ediff-display-help-hook))
(defun ediff-customize ()
(interactive)
(customize-group "ediff"))
;;; ediff-help.el ends here

57
lisp/ediff-hook.el
View file

@ -42,27 +42,33 @@
;; end pacifier
;; allow menus to be set up without ediff-wind.el being loaded
;;;###autoload
(defvar ediff-window-setup-function)
(defun ediff-xemacs-init-menus ()
(if (featurep 'menubar)
(progn
(add-submenu
'("Tools") ediff-menu "OO-Browser...")
(add-submenu
'("Tools") ediff-merge-menu "OO-Browser...")
(add-submenu
'("Tools") epatch-menu "OO-Browser...")
(add-submenu
'("Tools") ediff-misc-menu "OO-Browser...")
(add-menu-button
'("Tools")
["-------" nil nil] "OO-Browser...")
)))
;; Note we wrap this in a progn so that we pick up the whole def
;; for auto-autoload. That way we do not load ediff-hook.el when defining
;; the menus.
;;;###autoload
(progn
(defun ediff-xemacs-init-menus ()
(if (featurep 'menubar)
(progn
(add-submenu
'("Tools") ediff-menu "OO-Browser...")
(add-submenu
'("Tools") ediff-merge-menu "OO-Browser...")
(add-submenu
'("Tools") epatch-menu "OO-Browser...")
(add-submenu
'("Tools") ediff-misc-menu "OO-Browser...")
(add-menu-button
'("Tools")
["-------" nil nil] "OO-Browser...")
))))
;; explicit string-match is needed: ediff-xemacs-p is not defined at build time
;;;###autoload
(cond ((string-match "XEmacs" emacs-version)
(defvar ediff-menu
'("Compare"
@ -110,6 +116,7 @@
(defvar ediff-misc-menu
'("Ediff Miscellanea"
["Ediff Manual..." ediff-documentation t]
["Customize Ediff..." ediff-customize t]
["List Ediff Sessions..." ediff-show-registry t]
["Use separate frame for Ediff control buffer..."
ediff-toggle-multiframe
@ -124,13 +131,15 @@
:selected (if (featurep 'ediff-tbar)
(ediff-use-toolbar-p))]
))
;; put these menus before Object-Oriented-Browser in Tools menu
;; (add-hook 'before-init-hook 'ediff-xemacs-init-menus)
;; (if (not purify-flag)
;; (ediff-xemacs-init-menus))
;; )
(ediff-xemacs-init-menus))
;;; (add-hook 'before-init-hook 'ediff-xemacs-init-menus)
;;; (if (not purify-flag)
;;; (ediff-xemacs-init-menus))
;;; )
(if (and (featurep 'menubar) (not (featurep 'infodock))
(not (featurep 'ediff-hook)))
(ediff-xemacs-init-menus)))
;; Emacs--only if menu-bar is loaded
((featurep 'menu-bar)
@ -224,6 +233,8 @@
. ediff-toggle-multiframe))
(define-key menu-bar-ediff-misc-menu [eregistry]
'("List Ediff Sessions..." . ediff-show-registry))
(define-key menu-bar-ediff-misc-menu [ediff-cust]
'("Customize Ediff..." . ediff-customize))
(define-key menu-bar-ediff-misc-menu [ediff-doc]
'("Ediff Manual..." . ediff-documentation))
)

221
lisp/ediff-init.el
View file

@ -98,7 +98,7 @@ that Ediff doesn't know about.")
(ediff-defvar-local ediff-buffer-A nil "")
;; The buffer in which the B variant is stored.
(ediff-defvar-local ediff-buffer-B nil "")
;; The buffer in which the C variant is stored.
;; The buffer in which the C variant is stored or where the merge buffer lives.
(ediff-defvar-local ediff-buffer-C nil "")
;; Ancestor buffer
(ediff-defvar-local ediff-ancestor-buffer nil "")
@ -142,8 +142,8 @@ that Ediff doesn't know about.")
;; A-list is supposed to be of the form (A . symb) (B . symb)...)
;; where the first part of any association is a buffer type and the second is
;; an appropriate symbol. Given buffer-type, this function returns the
;; symbol. This is used to avoid using `intern'
;; an appropriate symbol. Given buffer-type, this function returns the
;; symbol. This is used to avoid using `intern'
(defsubst ediff-get-symbol-from-alist (buf-type alist)
(cdr (assoc buf-type alist)))
@ -163,7 +163,7 @@ that Ediff doesn't know about.")
;; Tell if it has been previously determined that the region has
;; no diffs other than the white space and newlines
;; The argument, N, is the diff region number used by Ediff to index the
;; diff vector. It is 1 less than the number seen by the user.
;; diff vector. It is 1 less than the number seen by the user.
;; Returns:
;; t if the diffs are whitespace in all buffers
;; 'A (in 3-buf comparison only) if there are only whitespace
@ -173,11 +173,14 @@ that Ediff doesn't know about.")
;; 'C (in 3-buf comparison only) if there are only whitespace
;; diffs in bufs A and B
;;
;; A difference vector has the form:
;; A Difference Vector has the form:
;; [diff diff diff ...]
;; where each diff has the form:
;; [overlay fine-diff-vector no-fine-diffs-flag]
;; [overlay fine-diff-vector no-fine-diffs-flag state-of-difference]
;; fine-diff-vector is a vector [fine-diff fine-diff fine-diff ...]
;; no-fine-diffs-flag says if there are fine differences.
;; state-of-difference is A, B, C, or nil, indicating which buffer is
;; different from the other two (used only in 3-way jobs).
(defmacro ediff-no-fine-diffs-p (n)
(` (aref (ediff-get-difference (, n) 'A) 2)))
@ -199,18 +202,20 @@ that Ediff doesn't know about.")
(aref (ediff-get-difference (, n) (, buf-type)) 3))))
(defmacro ediff-set-state-of-diff (n buf-type val)
(` (aset (ediff-get-difference (, n) (, buf-type)) 3 (, val))))
(defmacro ediff-get-state-of-merge (n)
(` (if ediff-state-of-merge
(aref (aref ediff-state-of-merge (, n)) 0))))
(defmacro ediff-get-state-of-ancestor (n)
(` (if ediff-state-of-merge
(aref (aref ediff-state-of-merge (, n)) 1))))
(defmacro ediff-set-state-of-merge (n val)
(` (if ediff-state-of-merge
(aset (aref ediff-state-of-merge (, n)) 0 (, val)))))
(defmacro ediff-get-state-of-ancestor (n)
(` (if ediff-state-of-merge
(aref (aref ediff-state-of-merge (, n)) 1))))
;; if flag is t, puts a mark on diff region saying that
;; the differences are in white space only. If flag is nil,
;; the differences are in white space only. If flag is nil,
;; the region is marked as essential (i.e., differences are
;; not just in the white space and newlines.)
(defmacro ediff-mark-diff-as-space-only (n flag)
@ -416,7 +421,7 @@ Can be used to move the frame where it is desired."
(defcustom ediff-mode-hook nil
"*Hook run just after ediff-mode is set up in the control buffer.
This is done before any windows or frames are created. One can use it to
This is done before any windows or frames are created. One can use it to
set local variables that determine how the display looks like."
:type 'hook
:group 'ediff-hook)
@ -439,9 +444,7 @@ set local variables that determine how the display looks like."
:type 'hook
:group 'ediff-hook)
(defcustom ediff-cleanup-hook nil
"*Hooks to run on exiting Ediff but before killing the control buffer.
This is a place to do various cleanups, such as deleting the variant buffers.
Ediff provides a function, `ediff-janitor', as one such possible hook."
"*Hooks to run on exiting Ediff but before killing the control and variant buffers."
:type 'hook
:group 'ediff-hook)
@ -452,7 +455,7 @@ Ediff provides a function, `ediff-janitor', as one such possible hook."
"Sorry, comparison of identical variants is not what I am made for...")
(defconst ediff-BAD-DIFF-NUMBER
;; %S stands for this-command, %d - diff number, %d - max diff
"%S: Bad diff region number, %d. Valid numbers are 1 to %d")
"%S: Bad diff region number, %d. Valid numbers are 1 to %d")
(defconst ediff-BAD-INFO (format "
*** The Info file for Ediff, a part of the standard distribution
*** of %sEmacs, does not seem to be properly installed.
@ -465,8 +468,8 @@ Ediff provides a function, `ediff-janitor', as one such possible hook."
(ediff-defvar-local ediff-skip-diff-region-function 'ediff-show-all-diffs
"Function that determines the next/previous diff region to show.
Should return t for regions to be ignored and nil otherwise.
This function gets a region number as an argument. The region number
is the one used internally by Ediff. It is 1 less than the number seen
This function gets a region number as an argument. The region number
is the one used internally by Ediff. It is 1 less than the number seen
by the user.")
(ediff-defvar-local ediff-hide-regexp-matches-function
@ -560,7 +563,7 @@ highlighted using ASCII flags."
(ediff-defvar-local ediff-wide-bounds nil "")
;; Current visibility boundaries in buffers A, B, and C.
;; This is also a list of overlays. When the user toggles narrow/widen,
;; This is also a list of overlays. When the user toggles narrow/widen,
;; this list changes from ediff-wide-bounds to ediff-narrow-bounds.
;; and back.
(ediff-defvar-local ediff-visible-bounds nil "")
@ -624,17 +627,17 @@ shown in brighter colors."
;; represented by a vector of two overlays plus a vector of fine diffs,
;; plus a no-fine-diffs flag. The first overlay spans the
;; difference region in the A buffer and the second overlays the diff in
;; the B buffer. If a difference section is empty, the corresponding
;; the B buffer. If a difference section is empty, the corresponding
;; overlay's endpoints coincide.
;;
;; The precise form of a difference vector for one buffer is:
;; The precise form of a Difference Vector for one buffer is:
;; [diff diff diff ...]
;; where each diff has the form:
;; [diff-overlay fine-diff-vector no-fine-diffs-flag state-of-difference]
;; [diff-overlay fine-diff-vector no-fine-diffs-flag state-of-diff]
;; fine-diff-vector is a vector [fine-diff-overlay fine-diff-overlay ...]
;; no-fine-diffs-flag says if there are fine differences.
;; state-of-difference is A, B, C, or nil, indicating which buffer is
;; different from the other two (used only in 3-way jobs.
;; different from the other two (used only in 3-way jobs.
(ediff-defvar-local ediff-difference-vector-A nil "")
(ediff-defvar-local ediff-difference-vector-B nil "")
(ediff-defvar-local ediff-difference-vector-C nil "")
@ -648,7 +651,7 @@ shown in brighter colors."
;; [ status status status ...]
;; Each status: [state-of-merge state-of-ancestor]
;; state-of-merge is default-A, default-B, prefer-A, or prefer-B. It
;; state-of-merge is default-A, default-B, prefer-A, or prefer-B. It
;; indicates the way a diff region was created in buffer C.
;; state-of-ancestor says if the corresponding region in ancestor buffer is
;; empty.
@ -662,7 +665,7 @@ shown in brighter colors."
;; Buffer containing the output of diff, which is used by Ediff to step
;; through files.
(ediff-defvar-local ediff-diff-buffer nil "")
;; Like ediff-diff-buffer, but contains context diff. It is not used by
;; Like ediff-diff-buffer, but contains context diff. It is not used by
;; Ediff, but it is saved in a file, if user requests so.
(ediff-defvar-local ediff-custom-diff-buffer nil "")
;; Buffer used for diff-style fine differences between regions.
@ -689,9 +692,9 @@ shown in brighter colors."
(defcustom ediff-version-control-package 'vc
"Version control package used.
Currently, Ediff supports vc.el, rcs.el, pcl-cvs.el, and generic-sc.el. The
standard Emacs interface to RCS, CVS, SCCS, etc., is vc.el. However, some
people find the other two packages more convenient. Set this variable to the
Currently, Ediff supports vc.el, rcs.el, pcl-cvs.el, and generic-sc.el. The
standard Emacs interface to RCS, CVS, SCCS, etc., is vc.el. However, some
people find the other two packages more convenient. Set this variable to the
appropriate symbol: `rcs', `pcl-cvs', or `generic-sc' if you so desire."
:type 'symbol
:group 'ediff)
@ -715,7 +718,7 @@ appropriate symbol: `rcs', `pcl-cvs', or `generic-sc' if you so desire."
;; emacs-minor-version are defined. Otherwise, for Emacs/XEmacs 19, if the
;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value
;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be
;; incorrect. However, this gives correct result in our cases, since we are
;; incorrect. However, this gives correct result in our cases, since we are
;; testing for sufficiently high Emacs versions.
(defun ediff-check-version (op major minor &optional type-of-emacs)
(if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version))
@ -763,7 +766,7 @@ appropriate symbol: `rcs', `pcl-cvs', or `generic-sc' if you so desire."
;; pm-win.el in PM-Emacs should be fixed.
(if (eq (ediff-device-type) 'pm)
(fset 'ediff-valid-color-p
(function (lambda (color) (assoc color pm-color-alist))))
(lambda (color) (assoc color pm-color-alist)))
(fset 'ediff-valid-color-p (symbol-function 'x-color-defined-p)))
(fset 'ediff-get-face (symbol-function 'internal-get-face))))
@ -852,11 +855,11 @@ appropriate symbol: `rcs', `pcl-cvs', or `generic-sc' if you so desire."
(t (:inverse-video t)))
"Face for highlighting the selected difference in buffer A."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-current-diff-face-A 'ediff-current-diff-face-A
"Face for highlighting the selected difference in buffer A.
DO NOT CHANGE this variable. Instead, use the customization
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-current-diff-face-A'
this variable represents.")
(ediff-hide-face 'ediff-current-diff-face-A)
@ -874,11 +877,11 @@ this variable represents.")
(t (:inverse-video t)))
"Face for highlighting the selected difference in buffer B."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-current-diff-face-B 'ediff-current-diff-face-B
"Face for highlighting the selected difference in buffer B.
this variable. Instead, use the customization
this variable. Instead, use the customization
widget to customize the actual face `ediff-current-diff-face-B'
this variable represents.")
(ediff-hide-face 'ediff-current-diff-face-B)
@ -895,11 +898,11 @@ this variable represents.")
(t (:inverse-video t)))
"Face for highlighting the selected difference in buffer C."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-current-diff-face-C 'ediff-current-diff-face-C
"Face for highlighting the selected difference in buffer C.
DO NOT CHANGE this variable. Instead, use the customization
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-current-diff-face-C'
this variable represents.")
(ediff-hide-face 'ediff-current-diff-face-C)
@ -916,11 +919,11 @@ this variable represents.")
(t (:inverse-video t)))
"Face for highlighting the selected difference in buffer Ancestor."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-current-diff-face-Ancestor 'ediff-current-diff-face-Ancestor
"Face for highlighting the selected difference in buffer Ancestor.
DO NOT CHANGE this variable. Instead, use the customization
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-current-diff-face-Ancestor'
this variable represents.")
(ediff-hide-face 'ediff-current-diff-face-Ancestor)
@ -937,11 +940,11 @@ this variable represents.")
(t (:underline t :stipple "gray3")))
"Face for highlighting the refinement of the selected diff in buffer A."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-fine-diff-face-A 'ediff-fine-diff-face-A
"Face for highlighting the fine differences in buffer A.
DO NOT CHANGE this variable. Instead, use the customization
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-fine-diff-face-A'
this variable represents.")
(ediff-hide-face 'ediff-fine-diff-face-A)
@ -951,11 +954,11 @@ this variable represents.")
(t (:underline t :stipple "gray3")))
"Face for highlighting the refinement of the selected diff in buffer B."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-fine-diff-face-B 'ediff-fine-diff-face-B
"Face for highlighting the fine differences in buffer B.
DO NOT CHANGE this variable. Instead, use the customization
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-fine-diff-face-B'
this variable represents.")
(ediff-hide-face 'ediff-fine-diff-face-B)
@ -965,11 +968,11 @@ this variable represents.")
(t (:underline t :stipple "gray3")))
"Face for highlighting the refinement of the selected diff in buffer C."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-fine-diff-face-C 'ediff-fine-diff-face-C
"Face for highlighting the fine differences in buffer C.
DO NOT CHANGE this variable. Instead, use the customization
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-fine-diff-face-C'
this variable represents.")
(ediff-hide-face 'ediff-fine-diff-face-C)
@ -981,67 +984,76 @@ this variable represents.")
At present, this face is not used and no fine differences are computed for the
ancestor buffer."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-fine-diff-face-Ancestor 'ediff-fine-diff-face-Ancestor
"Face for highlighting the fine differences in buffer Ancestor.
DO NOT CHANGE this variable. Instead, use the customization
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-fine-diff-face-Ancestor'
this variable represents.")
(ediff-hide-face 'ediff-fine-diff-face-Ancestor)
;; Some installs don't have stipple or Stipple. So, try them in turn.
(defvar stipple-pixmap
(cond ((not (ediff-has-face-support-p)))
((and (boundp 'x-bitmap-file-path)
(locate-library "stipple" t x-bitmap-file-path)) "stipple")
((and (boundp 'mswindowsx-bitmap-file-path)
(locate-library "stipple" t mswindowsx-bitmap-file-path)) "stipple")
(t "Stipple")))
(defface ediff-even-diff-face-A
'((((class color)) (:foreground "Black" :background "light grey"))
(t (:italic t :stipple "stipple")))
(` ((((class color)) (:foreground "Black" :background "light grey"))
(t (:italic t :stipple (, stipple-pixmap)))))
"Face for highlighting even-numbered non-current differences in buffer A."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-even-diff-face-A 'ediff-even-diff-face-A
"Face for highlighting even-numbered non-current differences in buffer A.
DO NOT CHANGE this variable. Instead, use the customization
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-even-diff-face-A'
this variable represents.")
(ediff-hide-face 'ediff-even-diff-face-A)
(defface ediff-even-diff-face-B
'((((class color)) (:foreground "White" :background "Grey"))
(t (:italic t :stipple "stipple")))
(` ((((class color)) (:foreground "White" :background "Grey"))
(t (:italic t :stipple (, stipple-pixmap)))))
"Face for highlighting even-numbered non-current differences in buffer B."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-even-diff-face-B 'ediff-even-diff-face-B
"Face for highlighting even-numbered non-current differences in buffer B.
DO NOT CHANGE this variable. Instead, use the customization
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-even-diff-face-B'
this variable represents.")
(ediff-hide-face 'ediff-even-diff-face-B)
(defface ediff-even-diff-face-C
'((((class color)) (:foreground "Black" :background "light grey"))
(t (:italic t :stipple "stipple")))
(` ((((class color)) (:foreground "Black" :background "light grey"))
(t (:italic t :stipple (, stipple-pixmap)))))
"Face for highlighting even-numbered non-current differences in buffer C."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-even-diff-face-C 'ediff-even-diff-face-C
"Face for highlighting even-numbered non-current differences in buffer C.
DO NOT CHANGE this variable. Instead, use the customization
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-even-diff-face-C'
this variable represents.")
(ediff-hide-face 'ediff-even-diff-face-C)
(defface ediff-even-diff-face-Ancestor
'((((class color)) (:foreground "White" :background "Grey"))
(t (:italic t :stipple "stipple")))
(` ((((class color)) (:foreground "White" :background "Grey"))
(t (:italic t :stipple (, stipple-pixmap)))))
"Face for highlighting even-numbered non-current differences in the ancestor buffer."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-even-diff-face-Ancestor 'ediff-even-diff-face-Ancestor
"Face for highlighting even-numbered non-current differences in buffer Ancestor.
DO NOT CHANGE this variable. Instead, use the customization
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-even-diff-face-Ancestor'
this variable represents.")
(ediff-hide-face 'ediff-even-diff-face-Ancestor)
@ -1058,11 +1070,11 @@ this variable represents.")
(t (:italic t :stipple "gray1")))
"Face for highlighting odd-numbered non-current differences in buffer A."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-odd-diff-face-A 'ediff-odd-diff-face-A
"Face for highlighting odd-numbered non-current differences in buffer A.
DO NOT CHANGE this variable. Instead, use the customization
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-odd-diff-face-A'
this variable represents.")
(ediff-hide-face 'ediff-odd-diff-face-A)
@ -1073,11 +1085,11 @@ this variable represents.")
(t (:italic t :stipple "gray1")))
"Face for highlighting odd-numbered non-current differences in buffer B."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-odd-diff-face-B 'ediff-odd-diff-face-B
"Face for highlighting odd-numbered non-current differences in buffer B.
DO NOT CHANGE this variable. Instead, use the customization
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-odd-diff-face-B'
this variable represents.")
(ediff-hide-face 'ediff-odd-diff-face-B)
@ -1087,11 +1099,11 @@ this variable represents.")
(t (:italic t :stipple "gray1")))
"Face for highlighting odd-numbered non-current differences in buffer C."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-odd-diff-face-C 'ediff-odd-diff-face-C
"Face for highlighting odd-numbered non-current differences in buffer C.
DO NOT CHANGE this variable. Instead, use the customization
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-odd-diff-face-C'
this variable represents.")
(ediff-hide-face 'ediff-odd-diff-face-C)
@ -1101,11 +1113,11 @@ this variable represents.")
(t (:italic t :stipple "gray1")))
"Face for highlighting odd-numbered non-current differences in the ancestor buffer."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
(defvar ediff-odd-diff-face-Ancestor 'ediff-odd-diff-face-Ancestor
"Face for highlighting odd-numbered non-current differences in buffer Ancestor.
DO NOT CHANGE this variable. Instead, use the customization
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-odd-diff-face-Ancestor'
this variable represents.")
(ediff-hide-face 'ediff-odd-diff-face-Ancestor)
@ -1157,11 +1169,10 @@ this variable represents.")
(setq ovr-list (append (overlays-at pos) ovr-list))
(setq pos (next-overlay-change pos)))
(1+ (apply '+
(mapcar (function
(lambda (ovr)
(if ovr
(or (ediff-overlay-get ovr 'priority) 0)
0)))
(mapcar (lambda (ovr)
(if ovr
(or (ediff-overlay-get ovr 'priority) 0)
0))
ovr-list)
))
))))
@ -1187,15 +1198,14 @@ This property can be toggled interactively."
(defcustom ediff-autostore-merges 'group-jobs-only
"*Save the results of merge jobs automatically.
Nil means don't save automatically. t means always save. Anything but nil or t
Nil means don't save automatically. t means always save. Anything but nil or t
means save automatically only if the merge job is part of a group of jobs, such
as `ediff-merge-directory' or `ediff-merge-directory-revisions'."
:type '(choice (const nil) (const t)
(other :tag "group-jobs-only" group-jobs-only))
:type '(choice (const nil) (const t) (const group-jobs-only))
:group 'ediff-merge)
(make-variable-buffer-local 'ediff-autostore-merges)
;; file where the result of the merge is to be saved. used internally
;; file where the result of the merge is to be saved. used internally
(ediff-defvar-local ediff-merge-store-file nil "")
(defcustom ediff-no-emacs-help-in-control-buffer nil
@ -1204,9 +1214,20 @@ Instead, C-h would jump to previous difference."
:type 'boolean
:group 'ediff)
(defcustom ediff-temp-file-prefix
(file-name-as-directory
(or small-temporary-file-directory temporary-file-directory))
;; This is the same as temporary-file-directory from Emacs 20.3.
;; Copied over here because XEmacs doesn't have this variable.
(defcustom ediff-temp-file-prefix
(file-name-as-directory
(cond ((boundp 'temporary-file-directory) temporary-file-directory)
((fboundp 'temp-directory) (temp-directory))
(t "/tmp/")))
;;; (file-name-as-directory
;;; (cond ((memq system-type '(ms-dos windows-nt))
;;; (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
;;; ((memq system-type '(vax-vms axp-vms))
;;; (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
;;; (t
;;; (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
"*Prefix to put on Ediff temporary file names.
Do not start with `~/' or `~USERNAME/'."
:type 'string
@ -1279,17 +1300,16 @@ This default should work without changes."
(eval (ediff-get-symbol-from-alist
buf-type ediff-difference-vector-alist)))
overl diff-num)
(mapcar (function
(lambda (rec)
(setq overl (ediff-get-diff-overlay-from-diff-record rec)
diff-num (ediff-overlay-get overl 'ediff-diff-num))
(if (ediff-overlay-buffer overl)
;; only if overlay is alive
(ediff-set-overlay-face
overl
(if (not unhighlight)
(ediff-background-face buf-type diff-num))))
))
(mapcar (lambda (rec)
(setq overl (ediff-get-diff-overlay-from-diff-record rec)
diff-num (ediff-overlay-get overl 'ediff-diff-num))
(if (ediff-overlay-buffer overl)
;; only if overlay is alive
(ediff-set-overlay-face
overl
(if (not unhighlight)
(ediff-background-face buf-type diff-num))))
)
diff-vector)))
@ -1478,7 +1498,7 @@ This default should work without changes."
;; Don't grab on quit, if the user doesn't want to.
;; If ediff-grab-mouse = t, then mouse won't be grabbed for
;; sessions that are not part of a group (this is done in
;; ediff-recenter). The condition below affects only terminating
;; ediff-recenter). The condition below affects only terminating
;; sessions in session groups (in which case mouse is warped into
;; a meta buffer).
(and (eq ediff-grab-mouse 'maybe)
@ -1490,7 +1510,7 @@ This default should work without changes."
(setq ediff-mouse-pixel-position (mouse-pixel-position)))
;; It is not easy to find out when the user grabs the mouse, since emacs and
;; xemacs behave differently when mouse is not in any frame. Also, this is
;; xemacs behave differently when mouse is not in any frame. Also, this is
;; sensitive to when the user grabbed mouse. Not used for now.
(defun ediff-user-grabbed-mouse ()
(if ediff-mouse-pixel-position
@ -1530,15 +1550,15 @@ This default should work without changes."
(defsubst ediff-empty-overlay-p (overl)
(= (ediff-overlay-start overl) (ediff-overlay-end overl)))
;; like overlay-buffer in Emacs. In XEmacs, returns nil if the extent is
;; dead. Otherwise, works like extent-buffer
;; like overlay-buffer in Emacs. In XEmacs, returns nil if the extent is
;; dead. Otherwise, works like extent-buffer
(defun ediff-overlay-buffer (overl)
(if ediff-emacs-p
(overlay-buffer overl)
(and (extent-live-p overl) (extent-object overl))))
;; like overlay-get in Emacs. In XEmacs, returns nil if the extent is
;; dead. Otherwise, like extent-property
;; like overlay-get in Emacs. In XEmacs, returns nil if the extent is
;; dead. Otherwise, like extent-property
(defun ediff-overlay-get (overl property)
(if ediff-emacs-p
(overlay-get overl property)
@ -1605,7 +1625,7 @@ Checks if overlay's buffer exists."
(abbreviate-file-name file t))))
;; Takes a directory and returns the parent directory.
;; does nothing to `/'. If the ARG is a regular file,
;; does nothing to `/'. If the ARG is a regular file,
;; strip the file AND the last dir.
(defun ediff-strip-last-dir (dir)
(if (not (stringp dir)) (setq dir default-directory))
@ -1627,6 +1647,9 @@ Checks if overlay's buffer exists."
(setq substr (substring str (max 0 (- len 1 newlen))))
(concat "..." substr))))
(defsubst ediff-nonempty-string-p (string)
(and (stringp string) (not (string= string ""))))
(defun ediff-abbrev-jobname (jobname)
(cond ((eq jobname 'ediff-directories)
"Compare two directories")

83
lisp/ediff-merg.el
View file

@ -59,7 +59,7 @@ Valid values are the symbols `default-A', `default-B', and `combined'."
(defcustom ediff-combination-pattern
'("<<<<<<<<<<<<<< variant A" ">>>>>>>>>>>>>> variant B" "======= end of combination")
"*Pattern to be used for combining difference regions in buffers A and B.
The value is (STRING1 STRING2 STRING3). The combined text will look like this:
The value is (STRING1 STRING2 STRING3). The combined text will look like this:
STRING1
diff region from variant A
@ -70,10 +70,28 @@ STRING3
:type '(list string string string)
:group 'ediff-merge)
(ediff-defvar-local ediff-show-clashes-only nil
(defcustom ediff-show-clashes-only nil
"*If t, show only those diff regions where both buffers disagree with the ancestor.
This means that regions that have status prefer-A or prefer-B will be
skiped over. Nil means show all regions.")
skiped over. Nil means show all regions."
:type 'boolean
:group 'ediff-merge
)
(make-variable-buffer-local 'ediff-show-clashes-only)
(defcustom ediff-skip-merge-regions-that-differ-from-default nil
"*If t, show only the regions that have not been changed by the user.
A region is considered to have been changed if it is different from the current
default (`default-A', `default-B', `combined') and it hasn't been marked as
`prefer-A' or `prefer-B'.
A region is considered to have been changed also when it is marked as
as `prefer-A', but is different from the corresponding difference region in
Buffer A or if it is marked as `prefer-B' and is different from the region in
Buffer B."
:type 'boolean
:group 'ediff-merge
)
(make-variable-buffer-local 'ediff-skip-merge-regions-that-differ-from-default)
;; If ediff-show-clashes-only, check if there is no clash between the ancestor
;; and one of the variants.
@ -81,6 +99,15 @@ skiped over. Nil means show all regions.")
(and ediff-show-clashes-only
(string-match "prefer" (or (ediff-get-state-of-merge n) ""))))
;; If ediff-skip-changed-regions, check if the merge region differs from
;; the current default. If a region is different from the default, it means
;; that the user has made determination as to how to merge for this particular
;; region.
(defsubst ediff-skip-merge-region-if-changed-from-default-p (n)
(and ediff-skip-merge-regions-that-differ-from-default
(ediff-merge-changed-from-default-p n 'prefers-too)))
(defsubst ediff-get-combined-region (n)
(concat (nth 0 ediff-combination-pattern) "\n"
@ -166,17 +193,10 @@ skiped over. Nil means show all regions.")
(reg-C (ediff-get-region-contents n 'C ediff-control-buffer)))
;; if region was edited since it was first set by default
(if (or (and (string= state-of-merge "default-A")
(not (string= reg-A reg-C)))
;; was edited since first set by default
(and (string= state-of-merge "default-B")
(not (string= reg-B reg-C)))
;; was edited since first set by default
(and (string= state-of-merge "combined")
(not (string=
(ediff-make-combined-diff reg-A reg-B) reg-C)))
;; was preferred--ignore
(if (or (ediff-merge-changed-from-default-p n)
;; was preferred
(string-match "prefer" state-of-merge))
;; then ignore
(setq do-not-copy t))
;; change state of merge for this diff, if necessary
@ -203,7 +223,7 @@ skiped over. Nil means show all regions.")
(defun ediff-re-merge ()
"Remerge unmodified diff regions using a new default. Start with the current region."
"Remerge unmodified diff regions using a new default. Start with the current region."
(interactive)
(let* ((default-variant-alist
(list '("default-A") '("default-B") '("combined")))
@ -213,7 +233,7 @@ skiped over. Nil means show all regions.")
(setq ediff-default-variant
(intern
(completing-read
(format "Current merge default is `%S'. New default: "
(format "Current merge default is `%S'. New default: "
ediff-default-variant)
actual-alist nil 'must-match)))
(ediff-do-merge ediff-current-difference 'remerge)
@ -245,10 +265,10 @@ Used only for merging jobs."
(ediff-recenter 'no-rehighlight))))
;; N here is the user's region number. It is 1+ what Ediff uses internally.
;; N here is the user's region number. It is 1+ what Ediff uses internally.
(defun ediff-combine-diffs (n &optional batch-invocation)
"Combine Nth diff regions of buffers A and B and place the combination in C.
N is a prefix argument. If nil, combine the current difference regions.
N is a prefix argument. If nil, combine the current difference regions.
Combining is done according to the specifications in variable
`ediff-combination-pattern'."
(interactive "P")
@ -265,7 +285,7 @@ Combining is done according to the specifications in variable
;; Checks if the region in buff C looks like a combination of the regions
;; in buffers A and B. Returns a list (reg-a-beg reg-a-end reg-b-beg reg-b-end)
;; in buffers A and B. Return a list (reg-a-beg reg-a-end reg-b-beg reg-b-end)
;; These refer to where the copies of region A and B start and end in buffer C
(defun ediff-looks-like-combined-merge (region-num)
(if ediff-merge-job
@ -295,6 +315,33 @@ Combining is done according to the specifications in variable
(if (and reg-a-beg reg-a-end reg-b-beg reg-b-end)
(list reg-a-beg reg-a-end reg-b-beg reg-b-end reg-c-beg reg-c-end))
)))
;; Check if the non-preferred merge has been modified since originally set.
;; This affects only the regions that are marked as default-A/B or combined.
;; If PREFERS-TOO is non-nil, then look at the regions marked as prefers-A/B as
;; well.
(defun ediff-merge-changed-from-default-p (diff-num &optional prefers-too)
(let ((reg-A (ediff-get-region-contents diff-num 'A ediff-control-buffer))
(reg-B (ediff-get-region-contents diff-num 'B ediff-control-buffer))
(reg-C (ediff-get-region-contents diff-num 'C ediff-control-buffer)))
(setq state-of-merge (ediff-get-state-of-merge diff-num))
;; if region was edited since it was first set by default
(or (and (string= state-of-merge "default-A")
(not (string= reg-A reg-C)))
(and (string= state-of-merge "default-B")
(not (string= reg-B reg-C)))
(and (string= state-of-merge "combined")
(not (string= (ediff-make-combined-diff reg-A reg-B) reg-C)))
(and prefers-too
(string= state-of-merge "prefer-A")
(not (string= reg-A reg-C)))
(and prefers-too
(string= state-of-merge "prefer-B")
(not (string= reg-B reg-C)))
)))
;;; Local Variables:

348
lisp/ediff-mult.el
View file

@ -42,11 +42,11 @@
;; in the following format:
;; (descriptor (obj1 obj2 obj3) (...) ...)
;; Actually, the format of this list is pretty much up to the
;; developer. The only thing is that it must be a list of lists,
;; developer. The only thing is that it must be a list of lists,
;; and the first list must describe the meta session, and subsequent
;; elements must describe individual sessions.
;; This descriptor must be a list of two, three, or four elements (nil
;; or string). The function ediff-redraw-registry-buffer displays the
;; or string). The function ediff-redraw-registry-buffer displays the
;; second through last of these in the registry buffer.
;; Also, keep in mind that the function ediff-prepare-meta-buffer
;; (which see) prepends the session group buffer to the descriptor and
@ -61,11 +61,11 @@
;; See how this is done in ediff-filegroup-action.
;;
;; Session descriptions are of the form (obj1 obj2 obj3), which
;; describe objects relevant to the session. Usually they are names of
;; files, but sometimes they may be other things. For instance, obj3 is
;; nil for jobs that involve only two files. For patch jobs, obj2 and
;; obj3 are markers that specify the patch corresponding to the file
;; (whose name is obj1).
;; describe objects relevant to the session. Usually they are names of
;; files, but sometimes they may be other things. For instance, obj3
;; is nil for jobs that involve only two files. For patch jobs, obj2
;; and obj3 are markers that specify the patch corresponding to the
;; file (whose name is obj1).
;; 4. Write a function that makes a call to ediff-prepare-meta-buffer
;; passing all this info.
;; You may be able to use ediff-directories-internal as a template.
@ -78,14 +78,14 @@
;; ediff-directories-internal.
;;
;; A useful addition here could be session groups selected by patterns
;; (which are different in each directory). For instance, one may want to
;; (which are different in each directory). For instance, one may want to
;; compare files of the form abc{something}.c to files old{something}.d
;; which may be in the same or different directories. Or, one may want to
;; which may be in the same or different directories. Or, one may want to
;; compare all files of the form {something} to files of the form {something}~.
;;
;; Implementing this requires writing an collating function, which should pair
;; up appropriate files. It will also require a generalization of the functions
;; that do the layout of the meta- and differences buffers and of
;; up appropriate files. It will also require a generalization of the
;; functions that do the layout of the meta- and differences buffers and of
;; ediff-filegroup-action.
;;; Code:
@ -141,7 +141,7 @@ Useful commands:
directories.")
;; Variable specifying the action to take when the use invokes ediff in the
;; meta buffer. This is usually ediff-registry-action or ediff-filegroup-action
;; meta buffer. This is usually ediff-registry-action or ediff-filegroup-action
(ediff-defvar-local ediff-meta-action-function nil "")
;; Tells ediff-update-meta-buffer how to redraw it
(ediff-defvar-local ediff-meta-redraw-function nil "")
@ -161,8 +161,8 @@ directories.")
;; (ctl-buf session-status (file1 . eq-status) (file2 . eq-status) (file3
;; . eq-status)) (ctl-buf session-status (file1 . eq-status) (file2
;; . eq-status)) ...)
;; If ctl-buf is nil, the file-pair hasn't processed yet. If it is
;; killed-buffer object, the file pair has been processed. If it is a live
;; If ctl-buf is nil, the file-pair hasn't processed yet. If it is
;; killed-buffer object, the file pair has been processed. If it is a live
;; buffer, this means ediff is still working on the pair.
;; Eq-status of a file is t if the file equals some other file in the same
;; group.
@ -175,7 +175,7 @@ directories.")
(ediff-defvar-local ediff-dir-difference-list nil "")
(ediff-defvar-local ediff-dir-diffs-buffer nil "")
;; The registry of Ediff sessions. A list of control buffers.
;; The registry of Ediff sessions. A list of control buffers.
(defvar ediff-session-registry nil)
(defcustom ediff-meta-truncate-filenames t
@ -200,7 +200,7 @@ ediff-directories, is run."
"*Hooks run just after the registry buffer is shown."
:type 'hook
:group 'ediff-mult)
(defcustom ediff-show-session-group-hook nil
(defcustom ediff-show-session-group-hook '(delete-other-windows)
"*Hooks run just after a session group buffer is shown."
:type 'hook
:group 'ediff-mult)
@ -212,7 +212,7 @@ buffers."
:type 'hook
:group 'ediff-mult)
;; buffer holding the multi-file patch. local to the meta buffer
;; Buffer holding the multi-file patch. Local to the meta buffer
(ediff-defvar-local ediff-meta-patchbufer nil "")
;;; API for ediff-meta-list
@ -261,7 +261,7 @@ buffers."
;; The activity marker is either or + (active session, i.e., ediff is currently
;; run in it), or - (finished session, i.e., we've ran ediff in it and then
;; exited). Return nil, if session is neither active nor finished
;; exited). Return nil, if session is neither active nor finished
(defun ediff-get-session-activity-marker (session)
(let ((session-buf (ediff-get-session-buffer session)))
(cond ((null session-buf) nil) ; virgin session
@ -346,7 +346,7 @@ Commands:
(defun ediff-next-meta-item (count)
"Move to the next item in Ediff registry or session group buffer.
Moves in circular fashion. With numeric prefix arg, skip this many items."
Moves in circular fashion. With numeric prefix arg, skip this many items."
(interactive "p")
(or count (setq count 1))
(let (overl)
@ -374,7 +374,7 @@ Moves in circular fashion. With numeric prefix arg, skip this many items."
(defun ediff-previous-meta-item (count)
"Move to the previous item in Ediff registry or session group buffer.
Moves in circular fashion. With numeric prefix arg, skip this many items."
Moves in circular fashion. With numeric prefix arg, skip this many items."
(interactive "p")
(or count (setq count 1))
(let (overl)
@ -418,20 +418,20 @@ behavior."
(ediff-update-meta-buffer (current-buffer) 'must-redraw))
;; DIR1, DIR2, DIR3 are directories. DIR3 can be nil.
;; DIR1, DIR2, DIR3 are directories. DIR3 can be nil.
;; OUTPUT-DIR is a directory for auto-storing the results of merge jobs.
;; Can be nil.
;; REGEXP is a regexp used to filter out files in the directories.
;; If a file is a directory in dir1 but not dir2 (or vice versa), it is not
;; included in the intersection. However, a regular file that is a dir in dir3
;; included in the intersection. However, a regular file that is a dir in dir3
;; is included, since dir3 files are supposed to be ancestors for merging.
;; Returns a list of the form:
;; ((dir1 dir2 dir3) (f1 f2 f3) (f1 f2 f3) ...)
;; dir3, f3 can be nil if intersecting only 2 directories.
;; If COMPARISON-FUNC is given, use it. Otherwise, use string=
;; If COMPARISON-FUNC is given, use it. Otherwise, use string=
;; DIFF-VAR contains the name of the variable in which to return the
;; difference list (which represents the differences among the contents of
;; directories). The diff list is of the form:
;; directories). The diff list is of the form:
;; ((dir1 dir2 dir3) (file . num) (file . num)...)
;; where num encodes the set of dirs where the file is found:
;; 2 - only dir1; 3 - only dir2; 5 - only dir3; 6 - dir1&2; 10 - dir1&3; etc.
@ -447,26 +447,23 @@ behavior."
lis1 (delete "." lis1)
lis1 (delete ".." lis1)
lis1 (mapcar
(function
(lambda (elt)
(ediff-add-slash-if-directory auxdir1 elt)))
(lambda (elt)
(ediff-add-slash-if-directory auxdir1 elt))
lis1)
auxdir2 (file-name-as-directory dir2)
lis2 (mapcar
(function
(lambda (elt)
(ediff-add-slash-if-directory auxdir2 elt)))
(lambda (elt)
(ediff-add-slash-if-directory auxdir2 elt))
(directory-files auxdir2 nil regexp)))
(if (stringp dir3)
(setq auxdir3 (file-name-as-directory dir3)
lis3 (mapcar
(function
(lambda (elt)
(ediff-add-slash-if-directory auxdir3 elt)))
(lambda (elt)
(ediff-add-slash-if-directory auxdir3 elt))
(directory-files auxdir3 nil regexp))))
(if (stringp merge-autostore-dir)
(if (ediff-nonempty-string-p merge-autostore-dir)
(setq merge-autostore-dir
(file-name-as-directory merge-autostore-dir)))
(setq common (ediff-intersection lis1 lis2 comparison-func))
@ -492,17 +489,17 @@ behavior."
difflist (sort (ediff-copy-list (delete ".." difflist))
'string-lessp))
(setq difflist (mapcar (function (lambda (elt) (cons elt 1))) difflist))
(setq difflist (mapcar (lambda (elt) (cons elt 1)) difflist))
;; check for files belonging to lis1/2/3
(mapcar (function (lambda (elt)
(if (member (car elt) lis1)
(setcdr elt (* (cdr elt) 2)))
(if (member (car elt) lis2)
(setcdr elt (* (cdr elt) 3)))
(if (member (car elt) lis3)
(setcdr elt (* (cdr elt) 5)))
))
(mapcar (lambda (elt)
(if (member (car elt) lis1)
(setcdr elt (* (cdr elt) 2)))
(if (member (car elt) lis2)
(setcdr elt (* (cdr elt) 3)))
(if (member (car elt) lis3)
(setcdr elt (* (cdr elt) 5)))
)
difflist)
(setq difflist (cons (list regexp auxdir1 auxdir2 auxdir3) difflist))
@ -512,29 +509,28 @@ behavior."
;; return result
(cons (list regexp auxdir1 auxdir2 auxdir3 merge-autostore-dir)
(mapcar
(function
(lambda (elt)
(list (concat auxdir1 elt)
(concat auxdir2 elt)
(if lis3
(progn
;; The following is done because:
;; In merging with ancestor, we don't intersect
;; with lis3. So, it is possible that elt is a
;; file in auxdir1/2 but a directory in auxdir3
;; Or elt may not exist in auxdir3 at all.
;; In the first case, we add a slash at the end.
;; In the second case, we insert nil.
(setq elt (ediff-add-slash-if-directory auxdir3 elt))
(if (file-exists-p (concat auxdir3 elt))
(concat auxdir3 elt)))))))
(lambda (elt)
(list (concat auxdir1 elt)
(concat auxdir2 elt)
(if lis3
(progn
;; The following is done because:
;; In merging with ancestor, we don't intersect
;; with lis3. So, it is possible that elt is a
;; file in auxdir1/2 but a directory in auxdir3
;; Or elt may not exist in auxdir3 at all.
;; In the first case, we add a slash at the end.
;; In the second case, we insert nil.
(setq elt (ediff-add-slash-if-directory auxdir3 elt))
(if (file-exists-p (concat auxdir3 elt))
(concat auxdir3 elt))))))
common))
))
;; find directory files that are under revision. Include subdirectories, since
;; we may visit them recursively. DIR1 is the directory to inspect.
;; MERGE-AUTOSTORE-DIR is the directory where to auto-store the results of
;; merges. Can be nil.
;; merges. Can be nil.
(defun ediff-get-directory-files-under-revision (jobname
regexp dir1
&optional merge-autostore-dir)
@ -542,7 +538,7 @@ behavior."
(setq auxdir1 (file-name-as-directory dir1)
lis1 (directory-files auxdir1 nil regexp))
(if (stringp merge-autostore-dir)
(if (ediff-nonempty-string-p merge-autostore-dir)
(setq merge-autostore-dir
(file-name-as-directory merge-autostore-dir)))
@ -553,6 +549,10 @@ behavior."
(cond ((file-directory-p (concat auxdir1 elt))
(setq common
(cons (ediff-add-slash-if-directory auxdir1 elt) common)))
((and (featurep 'vc-hooks) (vc-backend (concat auxdir1 elt)))
(setq common (cons elt common)))
;; The following two are needed only if vc-hooks isn't loaded.
;; They won't recognize CVS files.
((file-exists-p (concat auxdir1 elt ",v"))
(setq common (cons elt common)))
((file-exists-p (concat auxdir1 "RCS/" elt ",v"))
@ -562,16 +562,16 @@ behavior."
(setq common (delete "./" common)
common (delete "../" common)
common (delete "RCS" common))
common (delete "RCS" common)
common (delete "CVS" common)
)
;; copying is needed because sort sorts via side effects
(setq common (sort (ediff-copy-list common) 'string-lessp))
;; return result
(cons (list regexp auxdir1 nil nil merge-autostore-dir)
(mapcar (function (lambda (elt)
(list (concat auxdir1 elt)
nil nil)))
(mapcar (lambda (elt) (list (concat auxdir1 elt) nil nil))
common))
))
@ -607,7 +607,7 @@ behavior."
;; Prepare meta-buffer in accordance with the argument-function and
;; redraw-function. Must return the created meta-buffer.
;; redraw-function. Must return the created meta-buffer.
(defun ediff-prepare-meta-buffer (action-func meta-list
meta-buffer-name redraw-function
jobname &optional startup-hooks)
@ -638,28 +638,26 @@ behavior."
;; Initialize the meta list -- don't do this for registry.
;;
;; We prepend '(nil nil) to all elts of meta-list, except the first.
;; The first nil will later be replaced by the session buffer. The
;; The first nil will later be replaced by the session buffer. The
;; second is reserved for session status.
;;
;; (car ediff-meta-list) gets cons'ed with the session group buffer.
;; Also, session objects A/B/C are turned into lists of the form
;; (obj eq-indicator). Eq-indicator is either nil or =. Initialized to
;; nil. If later it is discovered that this file is = to some other
;; (obj eq-indicator). Eq-indicator is either nil or =. Initialized to
;; nil. If later it is discovered that this file is = to some other
;; file in the same session, eq-indicator is changed to `='.
;; For now, the eq-indicator is used only for 2 and 3-file jobs.
(setq ediff-meta-list
(cons (cons meta-buffer (car meta-list))
(mapcar
(function
(lambda (elt)
(cons nil
(cons nil
;; convert each obj to (obj nil),
;; where nil is the initial value
;; for eq-indicator -- see above
(mapcar
(function (lambda (obj) (list obj nil)))
elt)))))
(lambda (elt)
(cons nil
(cons nil
;; convert each obj to (obj nil),
;; where nil is the initial value
;; for eq-indicator -- see above
(mapcar (lambda (obj) (list obj nil))
elt))))
(cdr meta-list)))))
(or (eq meta-buffer ediff-registry-buffer)
@ -722,7 +720,7 @@ behavior."
;; virgin session
(t " "))))
;; Insert session status at point. Status is either ?H (marked for hiding), or
;; Insert session status at point. Status is either ?H (marked for hiding), or
;; ?I (hidden or invalid), or ?* (meaning marked for an operation; currently,
;; such op can only be checking for equality)), or SPC (meaning neither marked
;; nor invalid)
@ -733,7 +731,7 @@ behavior."
(t " "))))
;; If NEW-MARKER is non-nil, use it to substitute the current activity marker
;; in the meta buffer. If nil, use SPC
;; in the meta buffer. If nil, use SPC
(defun ediff-replace-session-activity-marker-in-meta-buffer (point new-marker)
(let* ((overl (ediff-get-meta-overlay-at-pos point))
(session-info (ediff-overlay-get overl 'ediff-meta-info))
@ -748,7 +746,7 @@ behavior."
(set-buffer-modified-p nil))))
;; If NEW-STATUS is non-nil, use it to substitute the current status marker in
;; the meta buffer. If nil, use SPC
;; the meta buffer. If nil, use SPC
(defun ediff-replace-session-status-in-meta-buffer (point new-status)
(let* ((overl (ediff-get-meta-overlay-at-pos point))
(session-info (ediff-overlay-get overl 'ediff-meta-info))
@ -827,7 +825,7 @@ behavior."
(format "*** Filter-through regular expression: %s\n" regexp)))
(ediff-insert-dirs-in-meta-buffer meta-list)
(if (and ediff-autostore-merges (ediff-merge-metajob)
(stringp merge-autostore-dir))
(ediff-nonempty-string-p merge-autostore-dir))
(insert (format
"\nMerge results are automatically stored in:\n\t%s\n"
merge-autostore-dir)))
@ -900,13 +898,12 @@ behavior."
(setq overl
(if ediff-xemacs-p
(map-extents
(function
(lambda (ext maparg)
(if (and
(ediff-overlay-get ext 'ediff-meta-info)
(eq (ediff-overlay-get ext 'ediff-meta-session-number)
session-num))
ext))))
(lambda (ext maparg)
(if (and
(ediff-overlay-get ext 'ediff-meta-info)
(eq (ediff-overlay-get ext 'ediff-meta-session-number)
session-num))
ext)))
;; Emacs doesn't have map-extents, so try harder
;; Splice overlay lists to get all buffer overlays
(setq buffer-meta-overlays (overlay-lists)
@ -915,14 +912,13 @@ behavior."
(car
(delq nil
(mapcar
(function
(lambda (overl)
(if (and
(ediff-overlay-get overl 'ediff-meta-info)
(eq (ediff-overlay-get
overl 'ediff-meta-session-number)
session-num))
overl)))
(lambda (overl)
(if (and
(ediff-overlay-get overl 'ediff-meta-info)
(eq (ediff-overlay-get
overl 'ediff-meta-session-number)
session-num))
overl))
buffer-meta-overlays)))))
(or overl
(error
@ -941,7 +937,7 @@ behavior."
;; Check if this is a problematic session.
;; Return nil if not. Otherwise, return symbol representing the problem
;; Return nil if not. Otherwise, return symbol representing the problem
;; At present, problematic sessions occur only in -with-ancestor comparisons
;; when the ancestor is a directory rather than a file, or when there is no
;; suitable ancestor file in the ancestor directory
@ -1120,7 +1116,7 @@ Useful commands:
))
(defun ediff-bury-dir-diffs-buffer ()
"Bury the directory difference buffer. Display the meta buffer instead."
"Bury the directory difference buffer. Display the meta buffer instead."
(interactive)
(let ((buf ediff-meta-buffer)
wind)
@ -1182,10 +1178,10 @@ Useful commands:
")
;; purge registry list from dead buffers
(mapcar (function (lambda (elt)
(if (not (ediff-buffer-live-p elt))
(setq ediff-session-registry
(delq elt ediff-session-registry)))))
(mapcar (lambda (elt)
(if (not (ediff-buffer-live-p elt))
(setq ediff-session-registry
(delq elt ediff-session-registry))))
ediff-session-registry)
(if (null ediff-session-registry)
@ -1271,7 +1267,7 @@ Useful commands:
(ediff-overlay-put overl 'ediff-meta-session-number session-number))))
(defun ediff-mark-for-hiding-at-pos (unmark)
"Mark session for hiding. With prefix arg, unmark."
"Mark session for hiding. With prefix arg, unmark."
(interactive "P")
(let* ((pos (ediff-event-point last-command-event))
(meta-buf (ediff-event-buffer last-command-event))
@ -1301,7 +1297,7 @@ Useful commands:
(defun ediff-mark-for-operation-at-pos (unmark)
"Mark session for a group operation. With prefix arg, unmark."
"Mark session for a group operation. With prefix arg, unmark."
(interactive "P")
(let* ((pos (ediff-event-point last-command-event))
(meta-buf (ediff-event-buffer last-command-event))
@ -1330,7 +1326,7 @@ Useful commands:
(defun ediff-hide-marked-sessions (unhide)
"Hide marked sessions. With prefix arg, unhide."
"Hide marked sessions. With prefix arg, unhide."
(interactive "P")
(let ((grp-buf (ediff-get-group-buffer ediff-meta-list))
(meta-list (cdr ediff-meta-list))
@ -1351,7 +1347,7 @@ Useful commands:
(setq active-sessions-exist t)
(ediff-set-session-status elt to)))))
(if (> numMarked 0)
(ediff-update-meta-buffer grp-buf)
(ediff-update-meta-buffer grp-buf 'must-redraw)
(beep)
(if unhide
(message "Nothing to reveal...")
@ -1360,7 +1356,7 @@ Useful commands:
(message "Note: Ediff didn't hide active sessions!"))
))
;; Apply OPERATION to marked sessions. Operation expects one argument of type
;; Apply OPERATION to marked sessions. Operation expects one argument of type
;; meta-list member (not the first one), i.e., a regular session description.
;; Returns number of marked sessions on which operation was performed
(defun ediff-operate-on-marked-sessions (operation)
@ -1442,7 +1438,7 @@ Useful commands:
"Collect custom diffs of marked sessions in buffer `*Ediff Multifile Diffs*'.
This operation is defined only for `ediff-directories' and
`ediff-directory-revisions', since its intent is to produce
multifile patches. For `ediff-directory-revisions', we insist that
multifile patches. For `ediff-directory-revisions', we insist that
all marked sessions must be active."
(interactive)
(or (ediff-buffer-live-p ediff-meta-diff-buffer)
@ -1453,7 +1449,11 @@ all marked sessions must be active."
(erase-buffer))
(if (> (ediff-operate-on-marked-sessions 'ediff-append-custom-diff) 0)
;; did something
(display-buffer ediff-meta-diff-buffer 'not-this-window)
(progn
(display-buffer ediff-meta-diff-buffer 'not-this-window)
(ediff-with-current-buffer ediff-meta-diff-buffer
(set-buffer-modified-p nil)
(setq buffer-read-only t)))
(beep)
(message "No marked sessions found")))
@ -1480,7 +1480,7 @@ all marked sessions must be active."
(error "The patch buffer wasn't found"))))
;; This function executes in meta buffer. It knows where event happened.
;; This function executes in meta buffer. It knows where event happened.
(defun ediff-filegroup-action ()
"Execute appropriate action for the selected session."
(interactive)
@ -1524,7 +1524,7 @@ all marked sessions must be active."
file1 file2 file3 regexp
ediff-session-action-function
ediff-metajob-name
;; make it update car info after startup
;; make it update (car info) after startup
(` (list (lambda ()
;; child session group should know its parent
(setq ediff-parent-meta-buffer
@ -1545,7 +1545,7 @@ all marked sessions must be active."
(ediff-directory-revisions-internal
file1 regexp
ediff-session-action-function ediff-metajob-name
;; make it update car info after startup
;; make it update (car info) after startup
(` (list (lambda ()
;; child session group should know its parent and
;; its number
@ -1567,19 +1567,29 @@ all marked sessions must be active."
((ediff-problematic-session-p info)
(beep)
(if (y-or-n-p
"This session has no ancestor. Merge without the ancestor? ")
"This session has no ancestor. Merge without the ancestor? ")
(ediff-merge-files
file1 file2
;; provide startup hooks
(` (list (lambda ()
(add-hook
'ediff-after-quit-hook-internal
(lambda ()
(if (ediff-buffer-live-p (, (current-buffer)))
(ediff-show-meta-buffer
(, (current-buffer)) (, session-number))))
nil 'local)
(setq ediff-meta-buffer (, (current-buffer))
ediff-meta-session-number
(, session-number))
(setq ediff-merge-store-file
(, (concat
merge-autostore-dir
"merge_"
(file-name-nondirectory file1))))
(, (if (ediff-nonempty-string-p
merge-autostore-dir)
(concat
merge-autostore-dir
"merge_"
(file-name-nondirectory file1)))
))
;; make ediff-startup pass
;; ediff-control-buffer back to the meta
;; level; see below
@ -1591,14 +1601,26 @@ all marked sessions must be active."
file1
;; provide startup hooks
(` (list (lambda ()
(add-hook
'ediff-after-quit-hook-internal
(lambda ()
(if (ediff-buffer-live-p
(, (current-buffer)))
(ediff-show-meta-buffer
(, (current-buffer))
(, session-number))))
nil 'local)
(setq ediff-meta-buffer (, (current-buffer))
ediff-meta-session-number
(, session-number))
(setq ediff-merge-store-file
(, (concat
merge-autostore-dir
"merge_"
(file-name-nondirectory file1))))
(, (if (ediff-nonempty-string-p
merge-autostore-dir)
(concat
merge-autostore-dir
"merge_"
(file-name-nondirectory file1)))
))
;; make ediff-startup pass
;; ediff-control-buffer back to the meta
;; level; see below
@ -1609,14 +1631,26 @@ all marked sessions must be active."
file1 file2
;; provide startup hooks
(` (list (lambda ()
(add-hook
'ediff-after-quit-hook-internal
(lambda ()
(if (ediff-buffer-live-p
(, (current-buffer)))
(ediff-show-meta-buffer
(, (current-buffer))
(, session-number))))
nil 'local)
(setq ediff-meta-buffer (, (current-buffer))
ediff-meta-session-number
(, session-number))
(setq ediff-merge-store-file
(, (concat
merge-autostore-dir
"merge_"
(file-name-nondirectory file1))))
(, (if (ediff-nonempty-string-p
merge-autostore-dir)
(concat
merge-autostore-dir
"merge_"
(file-name-nondirectory file1)))
))
;; make ediff-startup pass
;; ediff-control-buffer back to the meta
;; level; see below
@ -1627,11 +1661,23 @@ all marked sessions must be active."
file1 file2 file3
;; arrange startup hooks
(` (list (lambda ()
(add-hook
'ediff-after-quit-hook-internal
(lambda ()
(if (ediff-buffer-live-p
(, (current-buffer)))
(ediff-show-meta-buffer
(, (current-buffer))
(, session-number))))
nil 'local)
(setq ediff-merge-store-file
(, (concat
merge-autostore-dir
"merge_"
(file-name-nondirectory file1))))
(, (if (ediff-nonempty-string-p
merge-autostore-dir)
(concat
merge-autostore-dir
"merge_"
(file-name-nondirectory file1)))
))
(setq ediff-meta-buffer (, (current-buffer))
ediff-meta-session-number
(, session-number))
@ -1791,23 +1837,30 @@ all marked sessions must be active."
;;;###autoload
(defalias 'eregistry 'ediff-show-registry)
;; If meta-buf doesn't exist, it is created. In that case, id doesn't have a
;; If meta-buf doesn't exist, it is created. In that case, id doesn't have a
;; parent meta-buf
;; Check if META-BUF exists before calling this function
;; Optional MUST-REDRAW, if non-nil, would force redrawal of the whole meta
;; buffer. Otherwise, it will just go over the buffer and update activity marks
;; buffer. Otherwise, it will just go over the buffer and update activity marks
;; and session status.
;; SESSION-NUMBER, if specified, says which session caused the update.
(defun ediff-update-meta-buffer (meta-buf &optional must-redraw session-number)
(if (ediff-buffer-live-p meta-buf)
(ediff-with-current-buffer meta-buf
(cond (must-redraw ; completely redraw the meta buffer
(funcall ediff-meta-redraw-function ediff-meta-list))
((numberp session-number) ; redraw only for the given session
(ediff-update-session-marker-in-dir-meta-buffer session-number))
(t ; update only what's changed, but scan the entire meta buffer
(ediff-update-markers-in-dir-meta-buffer ediff-meta-list)))
)))
(let (overl)
(cond (must-redraw ; completely redraw the meta buffer
(funcall ediff-meta-redraw-function ediff-meta-list))
((numberp session-number) ; redraw only for the given session
(ediff-update-session-marker-in-dir-meta-buffer
session-number))
(t ; update what changed only, but scan the entire meta buffer
(ediff-update-markers-in-dir-meta-buffer ediff-meta-list)))
(setq overl (ediff-get-meta-overlay-at-pos (point)))
;; skip the invisible sessions
(while (and overl (ediff-overlay-get overl 'invisible))
(ediff-next-meta-item1)
(setq overl (ediff-get-meta-overlay-at-pos (point))))
))))
(defun ediff-update-registry ()
(ediff-with-current-buffer (current-buffer)
@ -1905,8 +1958,7 @@ If this is a session registry buffer then just bury it."
(ediff-overlay-get tmp 'ediff-meta-info)))
(setq olist (overlays-at point))
(setq olist
(mapcar (function (lambda (elt)
(overlay-get elt 'ediff-meta-info)))
(mapcar (lambda (elt) (overlay-get elt 'ediff-meta-info))
olist))
(while (and olist (null (car olist))
(overlay-get (car olist) 'invisible))
@ -1979,7 +2031,7 @@ If this is a session registry buffer then just bury it."
(setq point (1- point)))
(setq point (previous-overlay-change point))
;; If we are not over an overlay after subtracting 1, it means we are
;; in the description area preceding session records. In this case,
;; in the description area preceding session records. In this case,
;; goto the top of the registry buffer.
(or (car (overlays-at point))
(setq point (point-min)))
@ -2016,7 +2068,8 @@ If this is a session registry buffer then just bury it."
(defun ediff-unmark-all-for-operation ()
"Unmark all sessions marked for operation."
(interactive)
(let ((list (cdr ediff-meta-list)))
(let ((list (cdr ediff-meta-list))
elt)
(while (setq elt (car list))
(ediff-mark-session-for-operation elt 'unmark)
(setq list (cdr list))))
@ -2025,7 +2078,8 @@ If this is a session registry buffer then just bury it."
(defun ediff-unmark-all-for-hiding ()
"Unmark all sessions marked for hiding."
(interactive)
(let ((list (cdr ediff-meta-list)))
(let ((list (cdr ediff-meta-list))
elt)
(while (setq elt (car list))
(ediff-mark-session-for-hiding elt 'unmark)
(setq list (cdr list))))
@ -2039,6 +2093,7 @@ This is used only for sessions that involve 2 or 3 files at the same time."
(let ((list (cdr ediff-meta-list))
marked1 marked2 marked3
fileinfo1 fileinfo2 fileinfo3 elt)
(message "Comparing files ...")
(while (setq elt (car list))
(setq fileinfo1 (ediff-get-session-objA elt)
fileinfo2 (ediff-get-session-objB elt)
@ -2064,7 +2119,8 @@ This is used only for sessions that involve 2 or 3 files at the same time."
((eq last-command-char ?m)
(ediff-mark-session-for-operation elt 'mark))
))
(setq list (cdr list))))
(setq list (cdr list)))
(message "Comparing files ... Done"))
(ediff-update-meta-buffer (current-buffer) 'must-redraw))
;; mark files 1 and 2 as equal, if they are.

297
lisp/ediff-ptch.el
View file

@ -61,7 +61,7 @@ It is recommended to use GNU-compatible versions."
Note: the `-b' option should be specified in `ediff-backup-specs'.
It is recommended to pass the `-f' option to the patch program, so it won't ask
questions. However, some implementations don't accept this option, in which
questions. However, some implementations don't accept this option, in which
case the default value for this variable should be changed."
:type 'string
:group 'ediff-ptch)
@ -103,23 +103,23 @@ See also `ediff-backup-specs'."
(format "-b %s" ediff-backup-extension))))
"*Backup directives to pass to the patch program.
Ediff requires that the old version of the file \(before applying the patch\)
be saved in a file named `the-patch-file.extension'. Usually `extension' is
be saved in a file named `the-patch-file.extension'. Usually `extension' is
`.orig', but this can be changed by the user and may depend on the system.
Therefore, Ediff needs to know the backup extension used by the patch program.
Some versions of the patch program let you specify `-b backup-extension'.
Other versions only permit `-b', which assumes the extension `.orig'
\(in which case ediff-backup-extension MUST be also `.orig'\). The latest
\(in which case ediff-backup-extension MUST be also `.orig'\). The latest
versions of GNU patch require `-b -z backup-extension'.
Note that both `ediff-backup-extension' and `ediff-backup-specs'
must be set properly. If your patch program takes the option `-b',
must be set properly. If your patch program takes the option `-b',
but not `-b extension', the variable `ediff-backup-extension' must
still be set so Ediff will know which extension to use.
Ediff tries to guess the appropriate value for this variables. It is believed
Ediff tries to guess the appropriate value for this variables. It is believed
to be working for `traditional' patch, all versions of GNU patch, and for POSIX
patch. So, don't change these variables, unless the default doesn't work."
patch. So, don't change these variables, unless the default doesn't work."
:type 'string
:group 'ediff-ptch)
@ -141,13 +141,13 @@ program."
:type 'regexp
:group 'ediff-ptch)
;; The buffer of the patch file. Local to control buffer.
;; The buffer of the patch file. Local to control buffer.
(ediff-defvar-local ediff-patchbufer nil "")
;; The buffer where patch displays its diagnostics.
(ediff-defvar-local ediff-patch-diagnostics nil "")
;; Map of patch buffer. Has the form:
;; Map of patch buffer. Has the form:
;; ((filename1 marker1 marker2) (filename2 marker1 marker2) ...)
;; where filenames are files to which patch would have applied the patch;
;; marker1 delimits the beginning of the corresponding patch and marker2 does
@ -183,7 +183,7 @@ program."
;; ((filename1 marker1 marker2) (filename2 marker1 marker2) ...)
;; where filenames are files to which patch would have applied the patch;
;; marker1 delimits the beginning of the corresponding patch and marker2 does
;; it for the end. This list is then assigned to ediff-patch-map.
;; it for the end. This list is then assigned to ediff-patch-map.
;; Returns the number of elements in the list ediff-patch-map
(defun ediff-map-patch-buffer (buf)
(ediff-with-current-buffer buf
@ -239,12 +239,12 @@ program."
;; Fix up the file names in the list using the argument FILENAME
;; Algorithm: find the first file's directory and cut it out from each file
;; name in the patch. Prepend the directory of FILENAME to each file in the
;; patch. In addition, the first file in the patch is replaced by FILENAME.
;; name in the patch. Prepend the directory of FILENAME to each file in the
;; patch. In addition, the first file in the patch is replaced by FILENAME.
;; Each file is actually a file-pair of files found in the context diff header
;; In the end, for each pair, we select the shortest existing file.
;; Note: Ediff doesn't recognize multi-file patches that are separated
;; with the `Index:' line. It treats them as a single-file patch.
;; with the `Index:' line. It treats them as a single-file patch.
;;
;; Executes inside the patch buffer
(defun ediff-fixup-patch-map (filename)
@ -259,16 +259,16 @@ program."
)
;; chop off base-dirs
(mapcar (function (lambda (triple)
(or (string= (car (car triple)) "/dev/null")
(setcar (car triple)
(ediff-file-name-sans-prefix
(car (car triple)) base-dir1)))
(or (string= (cdr (car triple)) "/dev/null")
(setcdr (car triple)
(ediff-file-name-sans-prefix
(cdr (car triple)) base-dir2)))
))
(mapcar (lambda (triple)
(or (string= (car (car triple)) "/dev/null")
(setcar (car triple)
(ediff-file-name-sans-prefix
(car (car triple)) base-dir1)))
(or (string= (cdr (car triple)) "/dev/null")
(setcdr (car triple)
(ediff-file-name-sans-prefix
(cdr (car triple)) base-dir2)))
)
ediff-patch-map)
;; take the given file name into account
@ -280,69 +280,69 @@ program."
(file-name-nondirectory filename)))))
;; prepend actual-dir
(mapcar (function (lambda (triple)
(if (and (string-match "^/null/" (car (car triple)))
(string-match "^/null/" (cdr (car triple))))
;; couldn't strip base-dir1 and base-dir2
;; hence, something wrong
(progn
(with-output-to-temp-buffer ediff-msg-buffer
(princ
(format "
(mapcar (lambda (triple)
(if (and (string-match "^/null/" (car (car triple)))
(string-match "^/null/" (cdr (car triple))))
;; couldn't strip base-dir1 and base-dir2
;; hence, something wrong
(progn
(with-output-to-temp-buffer ediff-msg-buffer
(princ
(format "
The patch file contains a context diff for
%s
%s
However, Ediff cannot infer the name of the actual file
to be patched on your system. If you know the correct file name,
to be patched on your system. If you know the correct file name,
please enter it now.
If you don't know and still would like to apply patches to
other files, enter /dev/null
"
(substring (car (car triple)) 6)
(substring (cdr (car triple)) 6))))
(let ((directory t)
user-file)
(while directory
(setq user-file
(read-file-name
"Please enter file name: "
actual-dir actual-dir t))
(if (not (file-directory-p user-file))
(setq directory nil)
(setq directory t)
(beep)
(message "%s is a directory" user-file)
(sit-for 2)))
(setcar triple (cons user-file user-file))))
(setcar (car triple)
(expand-file-name
(concat actual-dir (car (car triple)))))
(setcdr (car triple)
(expand-file-name
(concat actual-dir (cdr (car triple))))))
))
(substring (car (car triple)) 6)
(substring (cdr (car triple)) 6))))
(let ((directory t)
user-file)
(while directory
(setq user-file
(read-file-name
"Please enter file name: "
actual-dir actual-dir t))
(if (not (file-directory-p user-file))
(setq directory nil)
(setq directory t)
(beep)
(message "%s is a directory" user-file)
(sit-for 2)))
(setcar triple (cons user-file user-file))))
(setcar (car triple)
(expand-file-name
(concat actual-dir (car (car triple)))))
(setcdr (car triple)
(expand-file-name
(concat actual-dir (cdr (car triple))))))
)
ediff-patch-map)
;; check for the shorter existing file in each pair and discard the other
;; one
(mapcar (function (lambda (triple)
(let* ((file1 (car (car triple)))
(file2 (cdr (car triple)))
(f1-exists (file-exists-p file1))
(f2-exists (file-exists-p file2)))
(cond
((and (< (length file2) (length file1))
f2-exists)
(setcar triple file2))
((and (< (length file1) (length file2))
f1-exists)
(setcar triple file1))
((and f1-exists f2-exists
(string= file1 file2))
(setcar triple file1))
((and f1-exists f2-exists)
(with-output-to-temp-buffer ediff-msg-buffer
(princ (format "
(mapcar (lambda (triple)
(let* ((file1 (car (car triple)))
(file2 (cdr (car triple)))
(f1-exists (file-exists-p file1))
(f2-exists (file-exists-p file2)))
(cond
((and (< (length file2) (length file1))
f2-exists)
(setcar triple file2))
((and (< (length file1) (length file2))
f1-exists)
(setcar triple file1))
((and f1-exists f2-exists
(string= file1 file2))
(setcar triple file1))
((and f1-exists f2-exists)
(with-output-to-temp-buffer ediff-msg-buffer
(princ (format "
Ediff has inferred that
%s
%s
@ -353,39 +353,39 @@ Please advice:
Type `y' to use %s as the target;
Type `n' to use %s as the target.
"
file1 file2 file2 file1)))
(setcar triple
(if (y-or-n-p (format "Use %s ? " file2))
file2 file1)))
(f2-exists (setcar triple file2))
(f1-exists (setcar triple file1))
(t
(with-output-to-temp-buffer ediff-msg-buffer
(princ "\nEdiff has inferred that")
(if (string= file1 file2)
(princ (format "
file1 file2 file2 file1)))
(setcar triple
(if (y-or-n-p (format "Use %s ? " file2))
file2 file1)))
(f2-exists (setcar triple file2))
(f1-exists (setcar triple file1))
(t
(with-output-to-temp-buffer ediff-msg-buffer
(princ "\nEdiff has inferred that")
(if (string= file1 file2)
(princ (format "
%s
is the target for this patch. However, this file does not exist."
file1))
(princ (format "
is the target for this patch. However, this file does not exist."
file1))
(princ (format "
%s
%s
are two possible targets for this patch. However, these files do not exist."
file1 file2)))
(princ "
are two possible targets for this patch. However, these files do not exist."
file1 file2)))
(princ "
\nPlease enter an alternative patch target ...\n"))
(let ((directory t)
target)
(while directory
(setq target (read-file-name
"Please enter a patch target: "
actual-dir actual-dir t))
(if (not (file-directory-p target))
(setq directory nil)
(beep)
(message "%s is a directory" target)
(sit-for 2)))
(setcar triple target)))))))
(let ((directory t)
target)
(while directory
(setq target (read-file-name
"Please enter a patch target: "
actual-dir actual-dir t))
(if (not (file-directory-p target))
(setq directory nil)
(beep)
(message "%s is a directory" target)
(sit-for 2)))
(setcar triple target))))))
ediff-patch-map)
))
@ -397,32 +397,69 @@ are two possible targets for this patch. However, these files do not exist."
(set-window-buffer ediff-window-B ediff-patch-diagnostics))
(t (display-buffer ediff-patch-diagnostics 'not-this-window))))
(defun ediff-get-patch-buffer ()
"Obtain patch buffer. If patch is already in a buffer---use it.
Else, read patch file into a new buffer."
;; prompt for file, get the buffer
(defun ediff-prompt-for-patch-file ()
(let ((dir (cond (ediff-patch-default-directory) ; try patch default dir
(ediff-use-last-dir ediff-last-dir-patch)
(t default-directory)))
patch-buf)
(if (let ((last-nonmenu-event t) ; Emacs: don't use dialog box
last-command-event) ; XEmacs: don't use dialog box
(y-or-n-p "Is the patch already in a buffer? "))
(setq patch-buf
(get-buffer
(read-buffer
"Which buffer contains the patch? "
(ediff-other-buffer
(if (eq (next-window (selected-window)) (selected-window))
;; only one window in frame --- don't skip current buff
""
;; >1 window --- skip current buff, assuming this is the one
;; to patch, not the one that has the patch
(current-buffer)))
'must-match)))
(setq patch-buf
(find-file-noselect
(read-file-name "Which file contains the patch? "
dir nil 'must-match))))
(t default-directory))))
(find-file-noselect
(read-file-name
(format "Patch is in file:%s "
(cond ((and buffer-file-name
(equal (expand-file-name dir)
(file-name-directory buffer-file-name)))
(concat
" (default "
(file-name-nondirectory buffer-file-name)
")"))
(t "")))
dir buffer-file-name 'must-match))
))
;; Try current buffer, then the other window's buffer. Else, give up.
(defun ediff-prompt-for-patch-buffer ()
(get-buffer
(read-buffer
"Patch is in buffer: "
(cond ((save-excursion
(goto-char (point-min))
(re-search-forward ediff-context-diff-label-regexp nil t))
(current-buffer))
((save-window-excursion
(other-window 1)
(save-excursion
(goto-char (point-min))
(and (re-search-forward ediff-context-diff-label-regexp nil t)
(current-buffer)))))
((save-window-excursion
(other-window -1)
(save-excursion
(goto-char (point-min))
(and (re-search-forward ediff-context-diff-label-regexp nil t)
(current-buffer)))))
(t nil))
'must-match)))
(defun ediff-get-patch-buffer (&optional arg patch-buf)
"Obtain patch buffer. If patch is already in a buffer---use it.
Else, read patch file into a new buffer. If patch buffer is passed as an
optional argument, then use it."
(let ((last-nonmenu-event t) ; Emacs: don't use dialog box
last-command-event) ; XEmacs: don't use dialog box
(cond ((ediff-buffer-live-p patch-buf))
;; even prefix arg: patch in buffer
((and (integerp arg) (eq 0 (mod arg 2)))
(setq patch-buf (ediff-prompt-for-patch-buffer)))
;; odd prefix arg: get patch from a file
((and (integerp arg) (eq 1 (mod arg 2)))
(setq patch-buf (ediff-prompt-for-patch-file)))
(t (setq patch-buf
(if (y-or-n-p "Is the patch already in a buffer? ")
(ediff-prompt-for-patch-buffer)
(ediff-prompt-for-patch-file)))))
(ediff-with-current-buffer patch-buf
(goto-char (point-min))
@ -454,7 +491,7 @@ Else, read patch file into a new buffer."
))
;; When patching a buffer, never change the orig file. Instead, create a new
;; When patching a buffer, never change the orig file. Instead, create a new
;; buffer, ***_patched, even if the buff visits a file.
;; Users who want to actually patch the buffer should use
;; ediff-patch-file, not ediff-patch-buffer.
@ -469,7 +506,7 @@ Else, read patch file into a new buffer."
default-dir file-name ctl-buf)
(if multifile-patch-p
(error
"Can't apply multi-file patches to buffers that visit no files"))
"To apply multi-file patches, please use `ediff-patch-file'"))
;; create a temp file to patch
(ediff-with-current-buffer buf-to-patch
@ -624,9 +661,9 @@ you can still examine the changes via M-x ediff-files"
(error "Patch appears to have failed")))
;; If black magic is involved, apply patch to a temp copy of the
;; file. Otherwise, apply patch to the orig copy. If patch is applied
;; file. Otherwise, apply patch to the orig copy. If patch is applied
;; to temp copy, we name the result old-name_patched for local files
;; and temp-copy_patched for remote files. The orig file name isn't
;; and temp-copy_patched for remote files. The orig file name isn't
;; changed, and the temp copy of the original is later deleted.
;; Without magic, the original file is renamed (usually into
;; old-name_orig) and the result of patching will have the same name as

465
lisp/ediff-util.el
View file

@ -28,12 +28,15 @@
;; Compiler pacifier
(defvar ediff-patch-diagnostics)
(defvar ediff-patchbufer)
(defvar ediff-use-toolbar-p)
(defvar ediff-toolbar-height)
(defvar ediff-toolbar)
(defvar ediff-toolbar-3way)
(defvar bottom-toolbar)
(defvar bottom-toolbar-visible-p)
(defvar bottom-toolbar-height)
(defvar mark-active)
(defvar ediff-emacs-p)
(eval-when-compile
(let ((load-path (cons (expand-file-name ".") load-path)))
@ -190,7 +193,9 @@ to invocation.")
(define-key ediff-mode-map "r" 'ediff-restore-diff-in-merge-buffer)
(define-key ediff-mode-map "s" 'ediff-shrink-window-C)
(define-key ediff-mode-map "+" 'ediff-combine-diffs)
(define-key ediff-mode-map "$" 'ediff-toggle-show-clashes-only)
(define-key ediff-mode-map "$" nil)
(define-key ediff-mode-map "$$" 'ediff-toggle-show-clashes-only)
(define-key ediff-mode-map "$*" 'ediff-toggle-skip-changed-regions)
(define-key ediff-mode-map "&" 'ediff-re-merge))
(ediff-3way-comparison-job
(define-key ediff-mode-map "ab" 'ediff-copy-A-to-B)
@ -285,6 +290,8 @@ to invocation.")
(make-local-variable 'ediff-merge-window-share)
(make-local-variable 'ediff-window-setup-function)
(make-local-variable 'ediff-keep-variants)
(make-local-hook 'ediff-after-quit-hook-internal)
;; unwrap set up parameters passed as argument
(while setup-parameters
@ -318,7 +325,7 @@ to invocation.")
;; If default variant is `combined', the right stuff is
;; inserted by ediff-do-merge
;; Note: at some point, we tried to put ancestor buffer here
;; (which is currently buffer C. This didn't work right
;; (which is currently buffer C. This didn't work right
;; because the merge buffer will contain lossage: diff regions
;; in the ancestor, which correspond to revisions that agree
;; in both buf A and B.
@ -500,7 +507,7 @@ to invocation.")
(ediff-visible-region)
(run-hooks 'startup-hooks)
(ediff-arrange-auto-save-in-merge-jobs merge-buffer-file)
(ediff-arrange-autosave-in-merge-jobs merge-buffer-file)
(ediff-refresh-mode-lines)
(setq buffer-read-only t)
@ -552,7 +559,7 @@ to invocation.")
;; This executes in control buffer and sets auto-save, visited file name, etc,
;; in the merge buffer
(defun ediff-arrange-auto-save-in-merge-jobs (merge-buffer-file)
(defun ediff-arrange-autosave-in-merge-jobs (merge-buffer-file)
(if (not ediff-merge-job)
()
(if (stringp merge-buffer-file)
@ -583,7 +590,7 @@ if necessary."
(if (and (ediff-buffer-live-p ediff-ancestor-buffer)
(not
(y-or-n-p
"Ancestor buffer will not be used. Recompute diffs anyway? ")))
"Ancestor buffer will not be used. Recompute diffs anyway? ")))
(error "Recomputation of differences canceled"))
(let ((point-A (ediff-with-current-buffer ediff-buffer-A (point)))
@ -642,7 +649,7 @@ if necessary."
(ediff-clear-diff-vector 'ediff-difference-vector-C 'fine-diffs-also)
(ediff-clear-diff-vector
'ediff-difference-vector-Ancestor 'fine-diffs-also)
;; let them garbage collect. we can't use the ancestor after recomputing
;; let them garbage collect. we can't use the ancestor after recomputing
;; the diffs.
(setq ediff-difference-vector-Ancestor nil
ediff-ancestor-buffer nil
@ -678,9 +685,9 @@ if necessary."
(message "")
))
;; Not bound to any key---to dangerous. A user can do it if necessary.
;; Not bound to any key---to dangerous. A user can do it if necessary.
(defun ediff-revert-buffers-then-recompute-diffs (noconfirm)
"Revert buffers A, B and C. Then rerun Ediff on file A and file B."
"Revert buffers A, B and C. Then rerun Ediff on file A and file B."
(interactive "P")
(ediff-barf-if-not-control-buffer)
(let ((bufA ediff-buffer-A)
@ -947,7 +954,7 @@ On a dumb terminal, switches between ASCII highlighting and no highlighting."
(t (set-window-buffer ediff-window-C ediff-ancestor-buffer)))))
(defun ediff-make-or-kill-fine-diffs (arg)
"Compute fine diffs. With negative prefix arg, kill fine diffs.
"Compute fine diffs. With negative prefix arg, kill fine diffs.
In both cases, operates on the currrent difference region."
(interactive "P")
(ediff-barf-if-not-control-buffer)
@ -1001,8 +1008,8 @@ of the current buffer."
(file-writable 'toggle-read-only)
(t (key-binding "\C-x\C-q")))))
;; If the file is checked in, make sure we don't make buffer modifiable
;; without warning the user. The user can fool our checks by making the
;; buffer non-RO without checking the file out. We regard this as a
;; without warning the user. The user can fool our checks by making the
;; buffer non-RO without checking the file out. We regard this as a
;; user problem.
(if (and (ediff-file-checked-in-p file)
;; If ctl-buf is null, this means we called this
@ -1013,7 +1020,7 @@ of the current buffer."
((and (or (beep 1) t) ; always beep
(y-or-n-p
(format
"File %s is under version control. Check it out? "
"File %s is under version control. Check it out? "
(ediff-abbreviate-file-name file))))
;; if we checked the file out, we should also change the
;; original state of buffer-read-only to nil. If we don't
@ -1055,7 +1062,7 @@ of the current buffer."
(or (beep 1) t)
(y-or-n-p
(format
"File %s is under version control. Check it out? "
"File %s is under version control. Check it out? "
(ediff-abbreviate-file-name file))))
(ediff-with-current-buffer buf
(command-execute checkout-function)))))
@ -1092,7 +1099,8 @@ of the current buffer."
(vc-locking-user file))))
(defsubst ediff-file-checked-in-p (file)
(and (featurep 'vc-hooks)
(vc-backend file)
;; CVS files are considered not checked in
(not (memq (vc-backend file) '(nil CVS)))
(not (vc-locking-user file))))
(defun ediff-file-compressed-p (file)
@ -1162,7 +1170,7 @@ of the current buffer."
ediff-regexp-focus-B focus-regexp))
;; The following is needed for XEmacs, since there one can't move
;; overlay to another buffer. In Emacs, this swap is redundant.
;; overlay to another buffer. In Emacs, this swap is redundant.
(if (ediff-has-face-support-p)
(if ediff-3way-comparison-job
(setq ediff-current-diff-overlay-A ediff-current-diff-overlay-C
@ -1256,10 +1264,9 @@ which see."
;; change default
(setq-default ediff-window-setup-function window-setup-func)
;; change in all active ediff sessions
(mapcar (function (lambda(buf)
(ediff-with-current-buffer buf
(setq ediff-window-setup-function window-setup-func
ediff-window-B nil))))
(mapcar (lambda(buf) (ediff-with-current-buffer buf
(setq ediff-window-setup-function window-setup-func
ediff-window-B nil)))
ediff-session-registry)
(if (ediff-in-control-buffer-p)
(ediff-recenter 'no-rehighlight))))
@ -1281,11 +1288,11 @@ To change the default, set the variable `ediff-use-toolbar-p', which see."
;; do this only after killing the toolbar
(setq ediff-use-toolbar-p (not ediff-use-toolbar-p))
(mapcar (function (lambda(buf)
(ediff-with-current-buffer buf
;; force redisplay
(setq ediff-window-config-saved "")
)))
(mapcar (lambda(buf)
(ediff-with-current-buffer buf
;; force redisplay
(setq ediff-window-config-saved "")
))
ediff-session-registry)
(if (ediff-in-control-buffer-p)
(ediff-recenter 'no-rehighlight)))))
@ -1327,7 +1334,7 @@ To change the default, set the variable `ediff-use-toolbar-p', which see."
;; Merging
(defun ediff-toggle-show-clashes-only ()
"Toggle the mode where only the regions where both buffers differ with the ancestor are shown."
"Toggle the mode that shows only the merge regions where both variants differ from the ancestor."
(interactive)
(ediff-barf-if-not-control-buffer)
(if (not ediff-merge-with-ancestor-job)
@ -1336,6 +1343,18 @@ To change the default, set the variable `ediff-use-toolbar-p', which see."
(if ediff-show-clashes-only
(message "Focus on regions where both buffers differ from the ancestor")
(message "Canceling focus on regions where changes clash")))
(defun ediff-toggle-skip-changed-regions ()
"Toggle the mode that skips the merge regions that differ from the default."
(interactive)
(ediff-barf-if-not-control-buffer)
(setq ediff-skip-merge-regions-that-differ-from-default
(not ediff-skip-merge-regions-that-differ-from-default))
(if ediff-skip-merge-regions-that-differ-from-default
(message "Skipping regions that differ from default setting")
(message "Showing regions that differ from default setting")))
;; Widening/narrowing
@ -1350,7 +1369,7 @@ Used in ediff-windows/regions only."
(setq ediff-visible-bounds ediff-wide-bounds))
(ediff-recenter 'no-rehighlight))
;; Narrow bufs A/B/C to ediff-visible-bounds. If this is currently set to
;; Narrow bufs A/B/C to ediff-visible-bounds. If this is currently set to
;; ediff-wide-bounds, then this actually widens.
;; This function does nothing if job-name is not
;; ediff-regions-wordwise/linewise or ediff-windows-wordwise/linewise.
@ -1524,7 +1543,7 @@ the width of the A/B/C windows."
;;BEG, END show the region to be positioned.
;;JOB-NAME holds ediff-job-name. The ediff-windows job positions regions
;;JOB-NAME holds ediff-job-name. The ediff-windows job positions regions
;;differently.
(defun ediff-position-region (beg end pos job-name)
(if (> end (point-max))
@ -1632,30 +1651,40 @@ With a prefix argument, go forward that many differences."
(if (< ediff-current-difference ediff-number-of-differences)
(let ((n (min ediff-number-of-differences
(+ ediff-current-difference (or arg 1))))
non-clash-skip regexp-skip)
non-clash-skip skip-changed regexp-skip)
(ediff-visible-region)
(or (>= n ediff-number-of-differences)
(setq regexp-skip (funcall ediff-skip-diff-region-function n))
;; this won't exec if regexp-skip is t
(setq non-clash-skip (ediff-merge-region-is-non-clash n))
(setq non-clash-skip (ediff-merge-region-is-non-clash n)
skip-changed
(ediff-skip-merge-region-if-changed-from-default-p n))
(ediff-install-fine-diff-if-necessary n))
;; Skip loop
(while (and (< n ediff-number-of-differences)
(or
;; regexp skip
regexp-skip
;; skip clashes, if necessary
non-clash-skip
;; skip processed regions
skip-changed
;; skip difference regions that differ in white space
(and ediff-ignore-similar-regions
(eq (ediff-no-fine-diffs-p n) t))))
(or (eq (ediff-no-fine-diffs-p n) t)
(and (ediff-merge-job)
(eq (ediff-no-fine-diffs-p n) 'C)))
)))
(setq n (1+ n))
(if (= 0 (mod n 20))
(message "Skipped over region %d and counting ..." n))
(or (>= n ediff-number-of-differences)
(setq regexp-skip (funcall ediff-skip-diff-region-function n))
;; this won't exec if regexp-skip is t
(setq non-clash-skip (ediff-merge-region-is-non-clash n))
(setq non-clash-skip (ediff-merge-region-is-non-clash n)
skip-changed
(ediff-skip-merge-region-if-changed-from-default-p n))
(ediff-install-fine-diff-if-necessary n))
)
(message "")
@ -1671,13 +1700,15 @@ With a prefix argument, go back that many differences."
(ediff-barf-if-not-control-buffer)
(if (> ediff-current-difference -1)
(let ((n (max -1 (- ediff-current-difference (or arg 1))))
non-clash-skip regexp-skip)
non-clash-skip skip-changed regexp-skip)
(ediff-visible-region)
(or (< n 0)
(setq regexp-skip (funcall ediff-skip-diff-region-function n))
;; this won't exec if regexp-skip is t
(setq non-clash-skip (ediff-merge-region-is-non-clash n))
(setq non-clash-skip (ediff-merge-region-is-non-clash n)
skip-changed
(ediff-skip-merge-region-if-changed-from-default-p n))
(ediff-install-fine-diff-if-necessary n))
(while (and (> n -1)
(or
@ -1685,16 +1716,23 @@ With a prefix argument, go back that many differences."
regexp-skip
;; skip clashes, if necessary
non-clash-skip
;; skipp changed regions
skip-changed
;; skip difference regions that differ in white space
(and ediff-ignore-similar-regions
(eq (ediff-no-fine-diffs-p n) t))))
(or (eq (ediff-no-fine-diffs-p n) t)
(and (ediff-merge-job)
(eq (ediff-no-fine-diffs-p n) 'C)))
)))
(if (= 0 (mod (1+ n) 20))
(message "Skipped over region %d and counting ..." (1+ n)))
(setq n (1- n))
(or (< n 0)
(setq regexp-skip (funcall ediff-skip-diff-region-function n))
;; this won't exec if regexp-skip is t
(setq non-clash-skip (ediff-merge-region-is-non-clash n))
(setq non-clash-skip (ediff-merge-region-is-non-clash n)
skip-changed
(ediff-skip-merge-region-if-changed-from-default-p n))
(ediff-install-fine-diff-if-necessary n))
)
(message "")
@ -1726,8 +1764,8 @@ If the prefix is negative, count differences from the end."
(defun ediff-jump-to-difference-at-point (arg)
"Go to difference closest to the point in buffer A, B, or C.
The buffer depends on last command character \(a, b, or c\) that invoked this
command. For instance, if the command was `ga' then the point value in buffer A
is used.
command. For instance, if the command was `ga' then the point value in buffer
A is used.
With a prefix argument, synchronize all files around the current point position
in the specified buffer."
(interactive "P")
@ -1782,9 +1820,9 @@ in the specified buffer."
;; find region most related to the current point position (or POS, if given)
;; returns diff number as seen by the user (i.e., 1+ the internal
;; representation)
;; The optional argument WHICH-DIFF can be `after' or `before'. If `after',
;; find the diff after the point. If `before', find the diff before the
;; point. If the point is inside a diff, return that diff.
;; The optional argument WHICH-DIFF can be `after' or `before'. If `after',
;; find the diff after the point. If `before', find the diff before the
;; point. If the point is inside a diff, return that diff.
(defun ediff-diff-at-point (buf-type &optional pos which-diff)
(let ((buffer (ediff-get-buffer buf-type))
(ctl-buffer ediff-control-buffer)
@ -1829,7 +1867,7 @@ If numerical prefix argument, copy the difference specified in the arg.
Otherwise, copy the difference given by `ediff-current-difference'.
This command assumes it is bound to a 2-character key sequence, `ab', `ba',
`ac', etc., which is used to determine the types of buffers to be used for
copying difference regions. The first character in the sequence specifies
copying difference regions. The first character in the sequence specifies
the source buffer and the second specifies the target.
If the second optional argument, a 2-character string, is given, use it to
@ -1853,37 +1891,37 @@ determine the source and the target buffers instead of the command keys."
(defun ediff-copy-A-to-B (arg)
"Copy ARGth difference region from buffer A to B.
ARG is a prefix argument. If nil, copy the current difference region."
ARG is a prefix argument. If nil, copy the current difference region."
(interactive "P")
(ediff-diff-to-diff arg "ab"))
(defun ediff-copy-B-to-A (arg)
"Copy ARGth difference region from buffer B to A.
ARG is a prefix argument. If nil, copy the current difference region."
ARG is a prefix argument. If nil, copy the current difference region."
(interactive "P")
(ediff-diff-to-diff arg "ba"))
(defun ediff-copy-A-to-C (arg)
"Copy ARGth difference region from buffer A to buffer C.
ARG is a prefix argument. If nil, copy the current difference region."
ARG is a prefix argument. If nil, copy the current difference region."
(interactive "P")
(ediff-diff-to-diff arg "ac"))
(defun ediff-copy-B-to-C (arg)
"Copy ARGth difference region from buffer B to buffer C.
ARG is a prefix argument. If nil, copy the current difference region."
ARG is a prefix argument. If nil, copy the current difference region."
(interactive "P")
(ediff-diff-to-diff arg "bc"))
(defun ediff-copy-C-to-B (arg)
"Copy ARGth difference region from buffer C to B.
ARG is a prefix argument. If nil, copy the current difference region."
ARG is a prefix argument. If nil, copy the current difference region."
(interactive "P")
(ediff-diff-to-diff arg "cb"))
(defun ediff-copy-C-to-A (arg)
"Copy ARGth difference region from buffer C to A.
ARG is a prefix argument. If nil, copy the current difference region."
ARG is a prefix argument. If nil, copy the current difference region."
(interactive "P")
(ediff-diff-to-diff arg "ca"))
@ -1891,7 +1929,7 @@ ARG is a prefix argument. If nil, copy the current difference region."
;; Copy diff N from FROM-BUF-TYPE \(given as A, B or C\) to TO-BUF-TYPE.
;; If optional DO-NOT-SAVE is non-nil, do not save the old value of the
;; target diff. This is used in merging, when constructing the merged
;; target diff. This is used in merging, when constructing the merged
;; version.
(defun ediff-copy-diff (n from-buf-type to-buf-type
&optional batch-invocation reg-to-copy)
@ -1960,7 +1998,7 @@ ARG is a prefix argument. If nil, copy the current difference region."
(ediff-refresh-mode-lines)
;; For diff2 jobs, don't recompute fine diffs, since we know there
;; aren't any. So we clear diffs after ediff-recenter.
;; aren't any. So we clear diffs after ediff-recenter.
(if (and saved-p (not three-way))
(ediff-clear-fine-differences n))
;; Make sure that the message about saving and how to restore is seen
@ -1986,7 +2024,7 @@ ARG is a prefix argument. If nil, copy the current difference region."
(setq ediff-killed-diffs-alist ;; create record for n-th diff
(cons (list n (cons buf reg))
ediff-killed-diffs-alist))))
(message "Saving old diff region #%d of buffer %S. To recover, type `r%s'"
(message "Saving old diff region #%d of buffer %S. To recover, type `r%s'"
(1+ n) buf-type
(if ediff-merge-job
"" (downcase (symbol-name buf-type))))
@ -2001,7 +2039,7 @@ ARG is a prefix argument. If nil, copy the current difference region."
(if this-buf-n-th-diff-saved
(if (yes-or-no-p
(format
"You've previously copied diff region %d to buffer %S. Confirm "
"You've previously copied diff region %d to buffer %S. Confirm "
(1+ n) buf-type))
t
(error "Quit"))
@ -2044,7 +2082,7 @@ ARG is a prefix argument. If nil, copy the current difference region."
(beep 1)))
;; Clearing fine diffs is necessary for
;; ediff-unselect-and-select-difference to properly recompute them. We
;; ediff-unselect-and-select-difference to properly recompute them. We
;; can't rely on ediff-copy-diff to clear this vector, as the user might
;; have modified diff regions after copying and, thus, may have recomputed
;; fine diffs.
@ -2081,7 +2119,7 @@ determine the target buffer instead of last-command-char"
(defun ediff-restore-diff-in-merge-buffer (arg)
"Restore ARGth diff in the merge buffer.
ARG is a prefix argument. If nil, restore the current diff."
ARG is a prefix argument. If nil, restore the current diff."
(interactive "P")
(ediff-restore-diff arg ?c))
@ -2202,7 +2240,7 @@ doesn't match `ediff-regexp-focus-B'.
This function returns nil if the region number N (specified as
an argument) is not to be ignored and t if region N is to be ignored.
N is a region number used by Ediff internally. It is 1 less
N is a region number used by Ediff internally. It is 1 less
the number seen by the user."
(if (ediff-valid-difference-p n)
(let* ((ctl-buf ediff-control-buffer)
@ -2243,7 +2281,7 @@ Regions to be ignored are those where buf A region matches
This function returns nil if the region number N (specified as
an argument) is not to be ignored and t if region N is to be ignored.
N is a region number used by Ediff internally. It is 1 less
N is a region number used by Ediff internally. It is 1 less
the number seen by the user."
(if (ediff-valid-difference-p n)
(let* ((ctl-buf ediff-control-buffer)
@ -2290,7 +2328,7 @@ flags of the compared file buffers, kills Ediff buffers for this session
If `ediff-keep-variants' is nil, the user will be asked whether the buffers
containing the variants should be removed \(if they haven't been modified\).
If it is t, they will be preserved unconditionally. A prefix argument,
If it is t, they will be preserved unconditionally. A prefix argument,
temporarily reverses the meaning of this variable."
(interactive "P")
(ediff-barf-if-not-control-buffer)
@ -2315,7 +2353,7 @@ temporarily reverses the meaning of this variable."
(ediff-delete-temp-files)
;; Restore visibility range. This affects only ediff-*-regions/windows.
;; Restore visibility range. This affects only ediff-*-regions/windows.
;; Since for other job names ediff-visible-region sets
;; ediff-visible-bounds to ediff-wide-bounds, the settings below are
;; ignored for such jobs.
@ -2325,18 +2363,19 @@ temporarily reverses the meaning of this variable."
;; Apply selective display to narrow or widen
(ediff-visible-region)
(mapcar (function (lambda (overl)
(if (ediff-overlayp overl)
(ediff-delete-overlay overl))))
(mapcar (lambda (overl)
(if (ediff-overlayp overl)
(ediff-delete-overlay overl)))
ediff-wide-bounds)
(mapcar (function (lambda (overl)
(if (ediff-overlayp overl)
(ediff-delete-overlay overl))))
(mapcar (lambda (overl)
(if (ediff-overlayp overl)
(ediff-delete-overlay overl)))
ediff-narrow-bounds)
;; restore buffer mode line id's in buffer-A/B/C
(let ((control-buffer ediff-control-buffer)
(meta-buffer ediff-meta-buffer)
(after-quit-hook-internal ediff-after-quit-hook-internal)
(session-number ediff-meta-session-number)
;; suitable working frame
(warp-frame (if (and (ediff-window-display-p) (eq ediff-grab-mouse t))
@ -2394,13 +2433,17 @@ temporarily reverses the meaning of this variable."
(run-hooks 'ediff-quit-merge-hook))
(quit))
;; good place to kill buffers A/B/C
(run-hooks 'ediff-cleanup-hook)
;; now kill buffers A/B/C, if requested
(let ((ediff-keep-variants ediff-keep-variants))
(if reverse-default-keep-variants
(setq ediff-keep-variants (not ediff-keep-variants)))
(or ediff-keep-variants (ediff-janitor 'ask)))
;; one hook here is ediff-cleanup-mess, which kills the control buffer and
;; other auxiliary buffers. we made it into a hook to let the users do their
;; own cleanup, if needed.
(run-hooks 'ediff-quit-hook)
(ediff-update-meta-buffer meta-buffer nil session-number)
@ -2408,18 +2451,17 @@ temporarily reverses the meaning of this variable."
(setq warp-frame ; if mouse is over a reasonable frame, use it
(cond ((ediff-good-frame-under-mouse))
(t warp-frame)))
(if (frame-live-p warp-frame)
(if (and (ediff-window-display-p) (frame-live-p warp-frame) ediff-grab-mouse)
(set-mouse-position (if ediff-emacs-p
warp-frame
(frame-selected-window warp-frame))
2 1))
(if (ediff-buffer-live-p meta-buffer)
(ediff-show-meta-buffer meta-buffer session-number))
(run-hooks 'after-quit-hook-internal)
))
;; Returns frame under mouse, if this frame is not a minibuffer
;; frame. Otherwise: nil
;; frame. Otherwise: nil
(defun ediff-good-frame-under-mouse ()
(let ((frame-or-win (car (mouse-position)))
(buf-name "")
@ -2449,13 +2491,17 @@ temporarily reverses the meaning of this variable."
;; Kill control buffer, other auxiliary Ediff buffers.
;; Leave one of the frames split between buffers A/B/C
(defun ediff-cleanup-mess ()
(let ((buff-A ediff-buffer-A)
(buff-B ediff-buffer-B)
(buff-C ediff-buffer-C)
(ctl-buf ediff-control-buffer)
(ctl-frame ediff-control-frame)
(three-way-job ediff-3way-job))
(let* ((buff-A ediff-buffer-A)
(buff-B ediff-buffer-B)
(buff-C ediff-buffer-C)
(ctl-buf ediff-control-buffer)
(ctl-frame ediff-control-frame)
(three-way-job ediff-3way-job)
(main-frame (cond ((window-live-p ediff-window-A)
(window-frame ediff-window-A))
((window-live-p ediff-window-B)
(window-frame ediff-window-B)))))
(ediff-kill-buffer-carefully ediff-diff-buffer)
(ediff-kill-buffer-carefully ediff-custom-diff-buffer)
(ediff-kill-buffer-carefully ediff-fine-diff-buffer)
@ -2474,7 +2520,10 @@ temporarily reverses the meaning of this variable."
(ediff-kill-buffer-carefully ctl-buf)
(delete-other-windows)
(if (frame-live-p main-frame)
(progn
(select-frame main-frame)
(delete-other-windows)))
;; display only if not visible
(condition-case nil
@ -2537,10 +2586,10 @@ buffer in another session as well."
This can also be used to save merge buffer in the middle of an Ediff session.
If the optional SAVE-AND-CONTINUE argument is non-nil, save merge buffer and
continue. Otherwise:
continue. Otherwise:
If `ediff-autostore-merges' is nil, this does nothing.
If it is t, it saves the merge buffer in the file `ediff-merge-store-file'
or asks the user, if the latter is nil. It then asks the user whether to
or asks the user, if the latter is nil. It then asks the user whether to
delete the merge buffer.
If `ediff-autostore-merges' is neither nil nor t, the merge buffer is saved
only if this merge job is part of a group, i.e., was invoked from within
@ -2562,17 +2611,11 @@ only if this merge job is part of a group, i.e., was invoked from within
((and (ediff-buffer-live-p ediff-meta-buffer)
(ediff-with-current-buffer ediff-meta-buffer
(ediff-merge-metajob)))
;; This case shouldn't occur, as the parent metajob must pass on
;; a file name, ediff-merge-store-file, where to save the result
;; of the merge.
;; Ask where to save anyway--will decide what to do here later.
(setq merge-store-file
(read-file-name "Save the merge buffer in file: "))
(ediff-write-merge-buffer-and-maybe-kill
ediff-buffer-C merge-store-file nil save-and-continue))))
;; The parent metajob passed nil as the autostore file.
nil)))
))
;; write merge buffer. If the optional argument save-and-continue is non-nil,
;; write merge buffer. If the optional argument save-and-continue is non-nil,
;; then don't kill the merge buffer
(defun ediff-write-merge-buffer-and-maybe-kill (buf file
&optional
@ -2586,10 +2629,10 @@ only if this merge job is part of a group, i.e., was invoked from within
(progn
(message "Merge buffer saved in: %s" file)
(set-buffer-modified-p nil)
(sit-for 2)))
(sit-for 3)))
(if (and
(not save-and-continue)
(y-or-n-p "Merge buffer saved in file. Now kill the buffer? "))
(y-or-n-p "Merge buffer saved. Now kill the buffer? "))
(ediff-kill-buffer-carefully buf))))))
;; The default way of suspending Ediff.
@ -2728,6 +2771,9 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(if (and ediff-merge-job ediff-show-clashes-only)
(princ
"\nFocusing on regions where both buffers differ from the ancestor"))
(if (and ediff-skip-merge-regions-that-differ-from-default ediff-merge-job)
(princ
"\nSkipping merge regions that differ from default setting"))
(cond ((eq ediff-skip-diff-region-function 'ediff-show-all-diffs)
(princ "\nSelective browsing by regexp is off\n"))
@ -2851,14 +2897,13 @@ Hit \\[ediff-recenter] to reset the windows afterward."
)))
;; This is adapted from a similar function in `emerge.el'.
;; PROMPT should not have a trailing ': ', so that it can be modified
;; according to context.
;; If DEFAULT-FILE is set, it should be used as the default value.
;; If DEFAULT-DIR is non-nil, use it as the default directory.
;; Otherwise, use the value of Emacs' variable `default-directory.'
(defun ediff-read-file-name (prompt default-dir default-file)
; This is a modified version of a similar function in `emerge.el'.
; PROMPT should not have trailing ': ', so that it can be modified
; according to context.
; If default-file is set, it should be used as the default value.
; If default-dir is non-nil, use it as the default directory.
; Otherwise, use the value of Emacs' variable `default-directory.'
;; hack default-dir if it is not set
(setq default-dir
(file-name-as-directory
@ -2899,37 +2944,40 @@ Hit \\[ediff-recenter] to reset the windows afterward."
f))
;; If PREFIX is given, then it is used as a prefix for the temp file
;; name. Otherwise, `ediff' is used. If FILE is given, use this
;; name. Otherwise, `ediff' is used. If FILE is given, use this
;; file and don't create a new one.
;; On MS-DOS, make sure the prefix isn't too long, or else
;; In MS-DOS, make sure the prefix isn't too long, or else
;; `make-temp-name' isn't guaranteed to return a unique filename.
;; Also, save buffer from START to END in the file.
;; START defaults to (point-min), END to (point-max)
(defun ediff-make-temp-file (buff &optional prefix given-file start end)
(let* ((p (ediff-convert-standard-filename (or prefix "ediff")))
(short-p p)
(coding-system-for-write 'no-conversion)
f short-f)
(if (and (fboundp 'msdos-long-file-names)
(not (msdos-long-file-names))
(> (length p) 2))
(setq short-p (substring p 0 2)))
(setq f (concat ediff-temp-file-prefix p)
short-f (concat ediff-temp-file-prefix short-p)
f (cond (given-file)
f (cond (given-file)
((find-file-name-handler f 'find-file-noselect)
;; to thwart file handlers in write-region, e.g., if file
;; name ends with .Z or .gz
;; This is needed so that patches produced by ediff will
;; have more meaningful names
(make-temp-file short-f))
;; Prefix is most often the same as the file name for the
;; variant. Here we are trying to use the original file name
;; but in the temp directory.
((and prefix (not (file-exists-p f))) f)
;; If a file with the orig name exists, add some random stuff
;; to it.
(t (make-temp-file short-f))))
(ediff-make-empty-tmp-file short-f))
(prefix
;; Prefix is most often the same as the file name for the
;; variant. Here we are trying to use the original file
;; name but in the temp directory.
(ediff-make-empty-tmp-file f 'keep-name))
(t
;; If don't care about name, add some random stuff
;; to proposed file name.
(ediff-make-empty-tmp-file short-f))))
;; create the file
(ediff-with-current-buffer buff
@ -2941,6 +2989,28 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(set-file-modes f ediff-temp-file-mode)
(expand-file-name f))))
;; Create a temporary file.
;; The returned file name (created by appending some random characters at the
;; end of PROPOSED-NAME is guaranteed to point to a newly created empty file.
;; This is a replacement for make-temp-name, which eliminates a security hole.
;; If KEEP-PROPOSED-NAME isn't nil, try to keep PROPOSED-NAME, unless such file
;; already exists.
;; It is a modified version of make-temp-file in emacs 20.5
(defun ediff-make-empty-tmp-file (proposed-name &optional keep-proposed-name)
(let ((file proposed-name))
(while (condition-case ()
(progn
(if (or (file-exists-p file) (not keep-proposed-name))
(setq file (make-temp-name proposed-name)))
(write-region "" nil file nil 'silent nil 'excl)
nil)
(file-already-exists t))
;; the file was somehow created by someone else between
;; `make-temp-name' and `write-region', let's try again.
nil)
file))
;; Quote metacharacters (using \) when executing diff in Unix, but not in
;; EMX OS/2
;;(defun ediff-protect-metachars (str)
@ -2965,7 +3035,7 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(if (buffer-modified-p)
;; If buffer is not obsolete and is modified, offer to save
(if (yes-or-no-p
(format "Buffer out of sync with visited file. Save file %s? "
(format "Buffer out of sync with visited file. Save file %s? "
buffer-file-name))
(condition-case nil
(save-buffer)
@ -2977,7 +3047,7 @@ Hit \\[ediff-recenter] to reset the windows afterward."
nil)
;; If buffer is obsolete, offer to revert
(if (yes-or-no-p
(format "Buffer is out of sync with visited file. REVERT file %s? "
(format "Buffer is out of sync with visited file. REVERT file %s? "
buffer-file-name))
(progn
(if file-magic
@ -3191,7 +3261,7 @@ Ediff Control Panel to restore highlighting."
;; (sit-for 0)
;; At this point, possibilities contains either the window char A/B/C
;; that was not selected, or it is nil. We delete the window that is not
;; that was not selected, or it is nil. We delete the window that is not
;; selected.
(if possibilities
(ediff-with-current-buffer ctl-buf
@ -3204,7 +3274,7 @@ Ediff Control Panel to restore highlighting."
(select-frame frame)
(balance-windows))))
(or (y-or-n-p
"Please check regions selected for comparison. Continue? ")
"Please check regions selected for comparison. Continue? ")
(setq quit-now t))
(ediff-with-current-buffer bufA
@ -3215,7 +3285,7 @@ Ediff Control Panel to restore highlighting."
(ediff-with-current-buffer ctl-buf
(ediff-recenter)
(sit-for 0)
(error "All right. Make up your mind and come back...")))
(error "All right. Make up your mind and come back...")))
(ediff-regions-internal
bufA begA endA bufB begB endB
@ -3291,7 +3361,7 @@ Ediff Control Panel to restore highlighting."
;; the beginning of a difference or at the end.
;;
;; The optional argument N says which difference (default:
;; `ediff-current-difference'). N is the internal difference number (1- what
;; `ediff-current-difference'). N is the internal difference number (1- what
;; the user sees). The optional argument CONTROL-BUF says
;; which control buffer is in effect in case it is not the current
;; buffer.
@ -3333,13 +3403,12 @@ Ediff Control Panel to restore highlighting."
;; VEC is either a difference vector or a fine-diff vector
(defun ediff-clear-diff-vector (vec-var &optional fine-diffs-also)
(if (vectorp (symbol-value vec-var))
(mapcar (function
(lambda (elt)
(ediff-delete-overlay
(ediff-get-diff-overlay-from-diff-record elt))
(if fine-diffs-also
(ediff-clear-fine-diff-vector elt))
))
(mapcar (lambda (elt)
(ediff-delete-overlay
(ediff-get-diff-overlay-from-diff-record elt))
(if fine-diffs-also
(ediff-clear-fine-diff-vector elt))
)
(symbol-value vec-var)))
;; allow them to be garbage collected
(set vec-var nil))
@ -3348,10 +3417,10 @@ Ediff Control Panel to restore highlighting."
;;; Misc
;; In Emacs, this just makes overlay. In the future, when Emacs will start
;; In Emacs, this just makes overlay. In the future, when Emacs will start
;; supporting sticky overlays, this function will make a sticky overlay.
;; BEG and END are expressions telling where overlay starts.
;; If they are numbers or buffers, then all is well. Otherwise, they must
;; If they are numbers or buffers, then all is well. Otherwise, they must
;; be expressions to be evaluated in buffer BUF in order to get the overlay
;; bounds.
;; If BUFF is not a live buffer, then return nil; otherwise, return the
@ -3387,46 +3456,95 @@ Ediff Control Panel to restore highlighting."
;; other insignificant buffers (those beginning with "^[ *]").
;; Gets one arg--buffer name or a list of buffer names (it won't return
;; these buffers).
(defun ediff-other-buffer (buff-lst)
(or (listp buff-lst) (setq buff-lst (list buff-lst)))
(let* ((frame-buffers (buffer-list))
(buff-name-list
;; EXCL-BUFF-LIST is an exclusion list.
(defun ediff-other-buffer (excl-buff-lst)
(or (listp excl-buff-lst) (setq excl-buff-lst (list excl-buff-lst)))
(let* ((all-buffers (buffer-list))
(prefered-buffer (car all-buffers))
visible-dired-buffers
(excl-buff-name-list
(mapcar
(function (lambda (b)
(cond ((stringp b) b)
((bufferp b) (buffer-name b)))))
buff-lst))
(lambda (b) (cond ((stringp b) b)
((bufferp b) (buffer-name b))))
excl-buff-lst))
;; if at least one buffer on the exclusion list is dired, then force
;; all others to be dired. This is because this means that the user
;; has already chosen a dired buffer before
(use-dired-major-mode
(cond ((null (ediff-buffer-live-p (car excl-buff-lst))) 'unknown)
((eq (ediff-with-current-buffer (car excl-buff-lst) major-mode)
'dired-mode)
'yes)
(t 'no)))
;; significant-buffers must be visible and not belong
;; to the exclusion list `buff-list'
;; We also exclude temporary buffers, but keep mail and gnus buffers
;; Furthermore, we exclude dired buffers, unless they are the only
;; ones visible (and there are at least two of them).
;; Also, any visible window not on the exclusion list that is first in
;; the buffer list is chosen regardless. (This is because the user
;; clicked on it or did something to distinguish it).
(significant-buffers
(mapcar
(function (lambda (x)
(cond ((member (buffer-name x) buff-name-list) nil)
(lambda (x)
(cond ((member (buffer-name x) excl-buff-name-list) nil)
((not (ediff-get-visible-buffer-window x)) nil)
((string-match "^[ *]" (buffer-name x)) nil)
((memq (ediff-with-current-buffer x major-mode)
'(dired-mode))
((eq x prefered-buffer) x)
;; if prev selected buffer is dired, look only at
;; dired.
((eq use-dired-major-mode 'yes)
(if (eq (ediff-with-current-buffer x major-mode)
'dired-mode)
x nil))
((eq (ediff-with-current-buffer x major-mode)
'dired-mode)
(if (null use-dired-major-mode)
;; don't know if we must enforce dired.
;; Remember this buffer in case
;; dired buffs are the only ones visible.
(setq visible-dired-buffers
(cons x visible-dired-buffers)))
;; skip, if dired is not forced
nil)
(t x))))
frame-buffers))
(buffers (delq nil significant-buffers))
((memq (ediff-with-current-buffer x major-mode)
'(rmail-mode
vm-mode
gnus-article-mode
mh-show-mode))
x)
((string-match "^[ *]" (buffer-name x)) nil)
((string= "*scratch*" (buffer-name x)) nil)
(t x)))
all-buffers))
(clean-significant-buffers (delq nil significant-buffers))
less-significant-buffers)
(if (and (null clean-significant-buffers)
(> (length visible-dired-buffers) 0))
(setq clean-significant-buffers visible-dired-buffers))
(cond (buffers (car buffers))
(cond (clean-significant-buffers (car clean-significant-buffers))
;; try also buffers that are not displayed in windows
((setq less-significant-buffers
(delq nil
(mapcar
(function
(lambda (x)
(cond ((member (buffer-name x) buff-name-list) nil)
((string-match "^[ *]" (buffer-name x)) nil)
((memq
(ediff-with-current-buffer x major-mode)
'(dired-mode))
nil)
(t x))))
frame-buffers)))
(lambda (x)
(cond ((member (buffer-name x) excl-buff-name-list)
nil)
((eq use-dired-major-mode 'yes)
(if (eq (ediff-with-current-buffer
x major-mode)
'dired-mode)
x nil))
((eq (ediff-with-current-buffer x major-mode)
'dired-mode)
nil)
((string-match "^[ *]" (buffer-name x)) nil)
((string= "*scratch*" (buffer-name x)) nil)
(t x)))
all-buffers)))
(car less-significant-buffers))
(t (other-buffer (current-buffer))))
(t "*scratch*"))
))
@ -3469,7 +3587,7 @@ Ediff Control Panel to restore highlighting."
ediff-device-type
))
(setq salutation "
Congratulations! You may have unearthed a bug in Ediff!
Congratulations! You may have unearthed a bug in Ediff!
Please make a concise and accurate summary of what happened
and mail it to the address above.
@ -3486,16 +3604,16 @@ and mail it to the address above.
Please read this first:
----------------------
Some ``bugs'' may actually be no bugs at all. For instance, if you are
Some ``bugs'' may actually be no bugs at all. For instance, if you are
reporting that certain difference regions are not matched as you think they
should, this is most likely due to the way Unix diff program decides what
constitutes a difference region. Ediff is an Emacs interface to diff, and
constitutes a difference region. Ediff is an Emacs interface to diff, and
it has nothing to do with those decisions---it only takes the output from
diff and presents it in a way that is better suited for human browsing and
manipulation.
If Emacs happens to dump core, this is NOT an Ediff problem---it is
an Emacs bug. Report this to Emacs maintainers.
an Emacs bug. Report this to Emacs maintainers.
Another popular topic for reports is compilation messages. Because Ediff
interfaces to several other packages and runs under Emacs and XEmacs,
@ -3573,7 +3691,7 @@ Mail anyway? (y or n) ")
;; VARS must be a list of symbols
;; ediff-save-variables returns an association list: ((var . val) ...)
(defsubst ediff-save-variables (vars)
(mapcar (function (lambda (v) (cons v (symbol-value v))))
(mapcar (lambda (v) (cons v (symbol-value v)))
vars))
;; VARS is a list of variable symbols.
(defun ediff-restore-variables (vars assoc-list)
@ -3626,7 +3744,7 @@ Mail anyway? (y or n) ")
(ediff-restore-variables ediff-protected-variables values-Ancestor)))
))
;; save BUFFER in FILE. used in hooks.
;; save BUFFER in FILE. used in hooks.
(defun ediff-save-buffer-in-file (buffer file)
(ediff-with-current-buffer buffer
(write-file file)))
@ -3669,27 +3787,26 @@ Mail anyway? (y or n) ")
(defun ediff-print-diff-vector (diff-vector-var)
(princ (format "\n*** %S ***\n" diff-vector-var))
(mapcar (function
(lambda (overl-vec)
(princ
(format
"Diff %d: \tOverlay: %S
(mapcar (lambda (overl-vec)
(princ
(format
"Diff %d: \tOverlay: %S
\t\tFine diffs: %s
\t\tNo-fine-diff-flag: %S
\t\tState-of-diff:\t %S
\t\tState-of-merge:\t %S
"
(1+ (ediff-overlay-get (aref overl-vec 0) 'ediff-diff-num))
(aref overl-vec 0)
;; fine-diff-vector
(if (= (length (aref overl-vec 1)) 0)
"none\n"
(mapconcat 'prin1-to-string
(aref overl-vec 1) "\n\t\t\t "))
(aref overl-vec 2) ; no fine diff flag
(aref overl-vec 3) ; state-of-diff
(aref overl-vec 4) ; state-of-merge
))))
(1+ (ediff-overlay-get (aref overl-vec 0) 'ediff-diff-num))
(aref overl-vec 0)
;; fine-diff-vector
(if (= (length (aref overl-vec 1)) 0)
"none\n"
(mapconcat 'prin1-to-string
(aref overl-vec 1) "\n\t\t\t "))
(aref overl-vec 2) ; no fine diff flag
(aref overl-vec 3) ; state-of-diff
(aref overl-vec 4) ; state-of-merge
)))
(eval diff-vector-var)))
@ -3760,7 +3877,7 @@ Mail anyway? (y or n) ")
list (cdr list)))
(nreverse res))
(car list)))
;; don't report error if version control package wasn't found
;;(ediff-load-version-control 'silent)

103
lisp/ediff-vers.el
View file

@ -94,7 +94,7 @@
(defun ediff-rcs-get-output-buffer (file name)
;; Get a buffer for RCS output for FILE, make it writable and clean it up.
;; Optional NAME is name to use instead of `*RCS-output*'.
;; This is a modified version from rcs.el v1.1. I use it here to make
;; This is a modified version from rcs.el v1.1. I use it here to make
;; Ediff immune to changes in rcs.el
(let* ((default-major-mode 'fundamental-mode) ; no frills!
(buf (get-buffer-create name)))
@ -159,8 +159,9 @@
(setq buf2 (current-buffer)))
(if ancestor-rev
(save-excursion
(or (string= ancestor-rev "")
(vc-version-other-window ancestor-rev))
(if (string= ancestor-rev "")
(setq ancestor-rev (vc-workfile-version buffer-file-name)))
(vc-version-other-window ancestor-rev)
(setq ancestor-buf (current-buffer))))
(setq startup-hooks
(cons
@ -232,102 +233,6 @@
;; PCL-CVS.el support
(defun ediff-pcl-cvs-internal (rev1 rev2 &optional startup-hooks)
;; Run Ediff on a pair of revisions of the current buffer.
;; If REV1 is "", use the latest revision.
;; If REV2 is "", use the current buffer as the second file to compare.
(let ((orig-buf (current-buffer))
orig-file-name buf1 buf2 file1 file2)
(or (setq orig-file-name (buffer-file-name (current-buffer)))
(error "Current buffer is not visiting any file"))
(if (string= rev1 "") (setq rev1 nil)) ; latest revision
(setq buf1 (ediff-pcl-cvs-view-revision orig-file-name rev1)
buf2 (if (string= rev2 "")
orig-buf
(ediff-pcl-cvs-view-revision orig-file-name rev2))
file1 (buffer-file-name buf1)
file2 (buffer-file-name buf2))
(setq startup-hooks
(cons (` (lambda ()
(delete-file (, file1))
(or (, (string= rev2 "")) (delete-file (, file2)))
))
startup-hooks))
(ediff-buffers buf1 buf2 startup-hooks 'ediff-revision)))
;; This function is the standard Ediff's interface to pcl-cvs.
;; Works like with other interfaces: runs ediff on versions of the file in the
;; current buffer.
(defun ediff-pcl-cvs-merge-internal (rev1 rev2 ancestor-rev
&optional
startup-hooks merge-buffer-file)
;; Ediff-merge appropriate revisions of the selected file.
;; If REV1 is "" then use the latest revision.
;; If REV2 is "" then merge current buffer's file with REV1.
;; If ANCESTOR-REV is "" then use current buffer's file as ancestor.
;; If ANCESTOR-REV is nil, then merge without the ancestor.
(let ((orig-buf (current-buffer))
orig-file-name buf1 buf2 ancestor-buf)
(or (setq orig-file-name (buffer-file-name (current-buffer)))
(error "Current buffer is not visiting any file"))
(if (string= rev1 "") (setq rev1 nil)) ; latest revision
(setq buf1 (ediff-pcl-cvs-view-revision orig-file-name rev1))
(setq buf2 (if (string= rev2 "")
orig-buf
(ediff-pcl-cvs-view-revision orig-file-name rev2)))
(if (stringp ancestor-rev)
(setq ancestor-buf
(if (string= ancestor-rev "")
orig-buf
(ediff-pcl-cvs-view-revision orig-file-name ancestor-rev))))
(setq startup-hooks
(cons
(` (lambda ()
(delete-file (, (buffer-file-name buf1)))
(or (, (string= rev2 ""))
(delete-file (, (buffer-file-name buf2))))
(or (, (string= ancestor-rev ""))
(, (not ancestor-rev))
(delete-file (, (buffer-file-name ancestor-buf))))
))
startup-hooks))
(if ancestor-buf
(ediff-merge-buffers-with-ancestor
buf1 buf2 ancestor-buf startup-hooks
'ediff-merge-revisions-with-ancestor merge-buffer-file)
(ediff-merge-buffers
buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file))
))
(defun ediff-pcl-cvs-view-revision (file rev)
;; if rev = "", get the latest revision
(let ((temp-name (make-temp-file
(concat ediff-temp-file-prefix
"ediff_" rev))))
(cvs-kill-buffer-visiting temp-name)
(if rev
(message "Retrieving revision %s..." rev)
(message "Retrieving latest revision..."))
(let ((res (call-process cvs-shell nil nil nil "-c"
(concat cvs-program " update -p "
(if rev
(concat "-r " rev " ")
"")
file
" > " temp-name))))
(if (and res (not (and (integerp res) (zerop res))))
(error "Failed to retrieve revision: %s" res))
(if rev
(message "Retrieving revision %s... Done." rev)
(message "Retrieving latest revision... Done."))
(find-file-noselect temp-name))))
(defun cvs-run-ediff-on-file-descriptor (tin)
;; This is a replacement for cvs-emerge-mode

51
lisp/ediff-wind.el
View file

@ -36,6 +36,7 @@
(defvar default-menubar)
(defvar frame-icon-title-format)
(defvar ediff-diff-status)
(defvar ediff-emacs-p)
(eval-when-compile
(let ((load-path (cons (expand-file-name ".") load-path)))
@ -74,7 +75,7 @@
"*Function called to set up windows.
Ediff provides a choice of two functions: ediff-setup-windows-plain, for
doing everything in one frame, and ediff-setup-windows-multiframe,
which sets the control panel in a separate frame. Also, if the latter
which sets the control panel in a separate frame. Also, if the latter
function detects that one of the buffers A/B is seen in some other frame,
it will try to keep that buffer in that frame.
@ -153,6 +154,9 @@ In this case, Ediff will use those frames to display these buffers."
;; don't lower and auto-raise
'(auto-lower . nil)
'(auto-raise . t)
'(visibility . nil)
;; make initial frame small to avoid distraction
'(width . 1) '(height . 1)
;; this blocks queries from window manager as to where to put
;; ediff's control frame. we put the frame outside the display,
;; so the initial frame won't jump all over the screen
@ -164,7 +168,7 @@ In this case, Ediff will use those frames to display these buffers."
3000))
)
"Frame parameters for displaying Ediff Control Panel.
Do not specify width and height here. These are computed automatically.")
Used internally---not a user option.")
;; position of the mouse; used to decide whether to warp the mouse into ctl
;; frame
@ -177,7 +181,7 @@ Do not specify width and height here. These are computed automatically.")
(defcustom ediff-grab-mouse t
"*If t, Ediff will always grab the mouse and put it in the control frame.
If 'maybe, Ediff will do it sometimes, but not after operations that require
relatively long time. If nil, the mouse will be entirely user's
relatively long time. If nil, the mouse will be entirely user's
responsibility."
:type 'boolean
:group 'ediff-window)
@ -185,17 +189,17 @@ responsibility."
(defcustom ediff-control-frame-position-function 'ediff-make-frame-position
"Function to call to determine the desired location for the control panel.
Expects three parameters: the control buffer, the desired width and height
of the control frame. It returns an association list
of the control frame. It returns an association list
of the form \(\(top . <position>\) \(left . <position>\)\)"
:type 'function
:group 'ediff-window)
(defcustom ediff-control-frame-upward-shift (if ediff-xemacs-p 42 14)
(defcustom ediff-control-frame-upward-shift 42
"*The upward shift of control frame from the top of buffer A's frame.
Measured in pixels.
This is used by the default control frame positioning function,
`ediff-make-frame-position'. This variable is provided for easy
customization of the default."
`ediff-make-frame-position'. This variable is provided for easy
customization of the default control frame positioning."
:type 'integer
:group 'ediff-window)
@ -204,7 +208,7 @@ customization of the default."
Measured in characters.
This is used by the default control frame positioning function,
`ediff-make-frame-position' to adjust the position of the control frame
when it shows the short menu. This variable is provided for easy
when it shows the short menu. This variable is provided for easy
customization of the default."
:type 'integer
:group 'ediff-window)
@ -214,7 +218,7 @@ customization of the default."
Measured in characters.
This is used by the default control frame positioning function,
`ediff-make-frame-position' to adjust the position of the control frame
when it shows the full menu. This variable is provided for easy
when it shows the full menu. This variable is provided for easy
customization of the default."
:type 'integer
:group 'ediff-window)
@ -232,7 +236,7 @@ display off.")
"Frame to be used for wide display.")
(ediff-defvar-local ediff-make-wide-display-function 'ediff-make-wide-display
"The value is a function that is called to create a wide display.
The function is called without arguments. It should resize the frame in
The function is called without arguments. It should resize the frame in
which buffers A, B, and C are to be displayed, and it should save the old
frame parameters in `ediff-wide-display-orig-parameters'.
The variable `ediff-wide-display-frame' should be set to contain
@ -248,7 +252,7 @@ If t, hitting `?' to toggle control panel off iconifies it.
This is only useful in Emacs and only for certain kinds of window managers,
such as TWM and its derivatives, since the window manager must permit
keyboard input to go into icons. XEmacs completely ignores keyboard input
keyboard input to go into icons. XEmacs completely ignores keyboard input
into icons, regardless of the window manager."
:type 'boolean
:group 'ediff-window)
@ -258,7 +262,7 @@ into icons, regardless of the window manager."
(defun ediff-get-window-by-clicking (wind prev-wind wind-number)
(let (event)
(message
"Select windows by clicking. Please click on Window %d " wind-number)
"Select windows by clicking. Please click on Window %d " wind-number)
(while (not (ediff-mouse-event-p (setq event (ediff-read-event))))
(if (sit-for 1) ; if sequence of events, wait till the final word
(beep 1))
@ -652,7 +656,7 @@ into icons, regardless of the window manager."
;;; If it is not seen, use the current frame.
;;; If both buffers are not seen, they share the current frame. If one
;;; of the buffers is not seen, it is placed in the current frame (where
;;; ediff started). If that frame is displaying the other buffer, it is
;;; ediff started). If that frame is displaying the other buffer, it is
;;; shared between the two buffers.
;;; However, if we decide to put both buffers in one frame
;;; and the selected frame isn't splittable, we create a new frame and
@ -813,7 +817,7 @@ into icons, regardless of the window manager."
(window-frame (minibuffer-window frame-A))))
;; It is unlikely that we'll implement a version of ediff-windows that
;; would compare 3 windows at once. So, we don't use buffer C here.
;; would compare 3 windows at once. So, we don't use buffer C here.
(if ediff-windows-job
(progn
(set-window-start wind-A wind-A-start)
@ -831,8 +835,12 @@ into icons, regardless of the window manager."
(or
(ediff-frame-has-dedicated-windows (selected-frame))
(ediff-frame-iconified-p (selected-frame))
;; skip small frames
(< (frame-height (selected-frame))
(* 3 window-min-height))
;; skip small windows
(< (window-height (selected-window))
(* 3 window-min-height))
(if ok-unsplittable
nil
(ediff-frame-unsplittable-p (selected-frame)))))
@ -850,9 +858,8 @@ into icons, regardless of the window manager."
ans)
(select-frame frame)
(walk-windows
(function (lambda (wind)
(if (window-dedicated-p wind)
(setq ans t))))
(lambda (wind) (if (window-dedicated-p wind)
(setq ans t)))
'ignore-minibuffer
frame)
(select-frame cur-fr)
@ -944,9 +951,9 @@ into icons, regardless of the window manager."
))
;; Under OS/2 (emx) we have to call modify frame parameters twice, in order
;; to make sure that at least once we do it for non-iconified frame. If
;; to make sure that at least once we do it for non-iconified frame. If
;; appears that in the OS/2 port of Emacs, one can't modify frame
;; parameters of iconified frames. As a precaution, we do likewise for
;; parameters of iconified frames. As a precaution, we do likewise for
;; windows-nt.
(if (memq system-type '(emx windows-nt windows-95))
(modify-frame-parameters ctl-frame adjusted-parameters))
@ -959,7 +966,7 @@ into icons, regardless of the window manager."
(modify-frame-parameters ctl-frame adjusted-parameters)
(make-frame-visible ctl-frame)
;; This works around a bug in 19.25 and earlier. There, if frame gets
;; This works around a bug in 19.25 and earlier. There, if frame gets
;; iconified, the current buffer changes to that of the frame that
;; becomes exposed as a result of this iconification.
;; So, we make sure the current buffer doesn't change.
@ -974,7 +981,7 @@ into icons, regardless of the window manager."
(set-window-dedicated-p (selected-window) t)
;; Now move the frame. We must do it separately due to an obscure bug in
;; Now move the frame. We must do it separately due to an obscure bug in
;; XEmacs
(modify-frame-parameters
ctl-frame
@ -1033,7 +1040,7 @@ into icons, regardless of the window manager."
ctl-frame-top ctl-frame-left)
;; Multiple control frames are clipped based on the value of
;; ediff-control-buffer-number. This is done in order not to obscure
;; ediff-control-buffer-number. This is done in order not to obscure
;; other active control panels.
(setq horizontal-adjustment (* 2 ediff-control-buffer-number)
upward-adjustment (* -14 ediff-control-buffer-number))

198
lisp/ediff.el
View file

@ -1,13 +1,13 @@
;;; ediff.el --- a comprehensive visual interface to diff & patch
;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1994 -- 1999 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Created: February 2, 1994
;; Keywords: comparing, merging, patching, version control.
(defconst ediff-version "2.70.2" "The current version of Ediff")
(defconst ediff-date "May 21, 1998" "Date of last update")
(defconst ediff-version "2.74" "The current version of Ediff")
(defconst ediff-date "October 31, 1999" "Date of last update")
;; This file is part of GNU Emacs.
@ -42,7 +42,7 @@
;; another (and recover old differences if you change your mind).
;; Ediff also supports merging operations on files and buffers, including
;; merging using ancestor versions. Both comparison and merging operations can
;; merging using ancestor versions. Both comparison and merging operations can
;; be performed on directories, i.e., by pairwise comparison of files in those
;; directories.
@ -56,18 +56,18 @@
;; you don't like).
;; Ediff is aware of version control, which lets the user compare
;; files with their older versions. Ediff can also work with remote and
;; compressed files. Details are given below.
;; files with their older versions. Ediff can also work with remote and
;; compressed files. Details are given below.
;; Finally, Ediff supports directory-level comparison, merging and patching.
;; See the on-line manual for details.
;; This package builds upon the ideas borrowed from emerge.el and several
;; Ediff's functions are adaptations from emerge.el. Much of the functionality
;; Ediff's functions are adaptations from emerge.el. Much of the functionality
;; Ediff provides is also influenced by emerge.el.
;; The present version of Ediff supersedes Emerge. It provides a superior user
;; interface and has numerous major features not found in Emerge. In
;; The present version of Ediff supersedes Emerge. It provides a superior user
;; interface and has numerous major features not found in Emerge. In
;; particular, it can do patching, and 2-way and 3-way file comparison,
;; merging, and directory operations.
@ -75,7 +75,7 @@
;;; Bugs:
;; 1. The undo command doesn't restore deleted regions well. That is, if
;; 1. The undo command doesn't restore deleted regions well. That is, if
;; you delete all characters in a difference region and then invoke
;; `undo', the reinstated text will most likely be inserted outside of
;; what Ediff thinks is the current difference region. (This problem
@ -85,13 +85,13 @@
;; you can hit '!' to recompute the differences.
;; 2. On a monochrome display, the repertoire of faces with which to
;; highlight fine differences is limited. By default, Ediff is using
;; underlining. However, if the region is already underlined by some other
;; highlight fine differences is limited. By default, Ediff is using
;; underlining. However, if the region is already underlined by some other
;; overlays, there is no simple way to temporarily remove that residual
;; underlining. This problem occurs when a buffer is highlighted with
;; hilit19.el or font-lock.el packages. If this residual highlighting gets
;; in the way, you can do the following. Both font-lock.el and hilit19.el
;; provide commands for unhighlighting buffers. You can either place these
;; underlining. This problem occurs when a buffer is highlighted with
;; hilit19.el or font-lock.el packages. If this residual highlighting gets
;; in the way, you can do the following. Both font-lock.el and hilit19.el
;; provide commands for unhighlighting buffers. You can either place these
;; commands in `ediff-prepare-buffer-hook' (which will unhighlight every
;; buffer used by Ediff) or you can execute them interactively, at any time
;; and on any buffer.
@ -101,8 +101,8 @@
;; Ediff was inspired by Dale R. Worley's <drw@math.mit.edu> emerge.el.
;; Ediff would not have been possible without the help and encouragement of
;; its many users. See Ediff on-line Info for the full list of those who
;; helped. Improved defaults in Ediff file-name reading commands.
;; its many users. See Ediff on-line Info for the full list of those who
;; helped. Improved defaults in Ediff file-name reading commands.
;;; Code:
@ -269,7 +269,7 @@
;; BUFFER-NAME is a variable symbol, which will get the buffer object into
;; which FILE is read.
;; LAST-DIR is the directory variable symbol where FILE's
;; directory name should be returned. HOOKS-VAR is a variable symbol that will
;; directory name should be returned. HOOKS-VAR is a variable symbol that will
;; be assigned the hook to be executed after `ediff-startup' is finished.
;; `ediff-find-file' arranges that the temp files it might create will be
;; deleted.
@ -459,8 +459,8 @@
;;;###autoload
(defun ediff-directories (dir1 dir2 regexp)
"Run Ediff on a pair of directories, DIR1 and DIR2, comparing files that have
the same name in both. The third argument, REGEXP, is a regular expression that
can be used to filter out certain file names."
the same name in both. The third argument, REGEXP, is a regular expression
that can be used to filter out certain file names."
(interactive
(let ((dir-A (ediff-get-default-directory-name))
f)
@ -485,7 +485,7 @@ can be used to filter out certain file names."
(defun ediff-directory-revisions (dir1 regexp)
"Run Ediff on a directory, DIR1, comparing its files with their revisions.
The second argument, REGEXP, is a regular expression that filters the file
names. Only the files that are under revision control are taken into account."
names. Only the files that are under revision control are taken into account."
(interactive
(let ((dir-A (ediff-get-default-directory-name)))
(list (ediff-read-file-name
@ -504,7 +504,7 @@ names. Only the files that are under revision control are taken into account."
;;;###autoload
(defun ediff-directories3 (dir1 dir2 dir3 regexp)
"Run Ediff on three directories, DIR1, DIR2, and DIR3, comparing files that
have the same name in all three. The last argument, REGEXP, is a regular
have the same name in all three. The last argument, REGEXP, is a regular
expression that can be used to filter out certain file names."
(interactive
(let ((dir-A (ediff-get-default-directory-name))
@ -531,10 +531,10 @@ expression that can be used to filter out certain file names."
(defalias 'edirs3 'ediff-directories3)
;;;###autoload
(defun ediff-merge-directories (dir1 dir2 regexp)
(defun ediff-merge-directories (dir1 dir2 regexp &optional merge-autostore-dir)
"Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have
the same name in both. The third argument, REGEXP, is a regular expression that
can be used to filter out certain file names."
the same name in both. The third argument, REGEXP, is a regular expression
that can be used to filter out certain file names."
(interactive
(let ((dir-A (ediff-get-default-directory-name))
f)
@ -549,17 +549,20 @@ can be used to filter out certain file names."
)))
(ediff-directories-internal
dir1 dir2 nil regexp 'ediff-merge-files 'ediff-merge-directories
nil merge-autostore-dir
))
;;;###autoload
(defalias 'edirs-merge 'ediff-merge-directories)
;;;###autoload
(defun ediff-merge-directories-with-ancestor (dir1 dir2 ancestor-dir regexp)
(defun ediff-merge-directories-with-ancestor (dir1 dir2 ancestor-dir regexp
&optional
merge-autostore-dir)
"Merge files in directories DIR1 and DIR2 using files in ANCESTOR-DIR as ancestors.
Ediff merges files that have identical names in DIR1, DIR2. If a pair of files
Ediff merges files that have identical names in DIR1, DIR2. If a pair of files
in DIR1 and DIR2 doesn't have an ancestor in ANCESTOR-DIR, Ediff will merge
without ancestor. The fourth argument, REGEXP, is a regular expression that
without ancestor. The fourth argument, REGEXP, is a regular expression that
can be used to filter out certain file names."
(interactive
(let ((dir-A (ediff-get-default-directory-name))
@ -581,13 +584,15 @@ can be used to filter out certain file names."
(ediff-directories-internal
dir1 dir2 ancestor-dir regexp
'ediff-merge-files-with-ancestor 'ediff-merge-directories-with-ancestor
nil merge-autostore-dir
))
;;;###autoload
(defun ediff-merge-directory-revisions (dir1 regexp)
(defun ediff-merge-directory-revisions (dir1 regexp
&optional merge-autostore-dir)
"Run Ediff on a directory, DIR1, merging its files with their revisions.
The second argument, REGEXP, is a regular expression that filters the file
names. Only the files that are under revision control are taken into account."
names. Only the files that are under revision control are taken into account."
(interactive
(let ((dir-A (ediff-get-default-directory-name)))
(list (ediff-read-file-name
@ -597,16 +602,19 @@ names. Only the files that are under revision control are taken into account."
)))
(ediff-directory-revisions-internal
dir1 regexp 'ediff-merge-revisions 'ediff-merge-directory-revisions
nil merge-autostore-dir
))
;;;###autoload
(defalias 'edir-merge-revisions 'ediff-merge-directory-revisions)
;;;###autoload
(defun ediff-merge-directory-revisions-with-ancestor (dir1 regexp)
(defun ediff-merge-directory-revisions-with-ancestor (dir1 regexp
&optional
merge-autostore-dir)
"Run Ediff on a directory, DIR1, merging its files with their revisions and ancestors.
The second argument, REGEXP, is a regular expression that filters the file
names. Only the files that are under revision control are taken into account."
names. Only the files that are under revision control are taken into account."
(interactive
(let ((dir-A (ediff-get-default-directory-name)))
(list (ediff-read-file-name
@ -617,6 +625,7 @@ names. Only the files that are under revision control are taken into account."
(ediff-directory-revisions-internal
dir1 regexp 'ediff-merge-revisions-with-ancestor
'ediff-merge-directory-revisions-with-ancestor
nil merge-autostore-dir
))
;;;###autoload
@ -632,11 +641,12 @@ names. Only the files that are under revision control are taken into account."
;; The third argument, REGEXP, is a regular expression that can be used to
;; filter out certain file names.
;; JOBNAME is the symbol indicating the meta-job to be performed.
;; MERGE-DIR is the directory in which to store merged files.
;; MERGE-AUTOSTORE-DIR is the directory in which to store merged files.
(defun ediff-directories-internal (dir1 dir2 dir3 regexp action jobname
&optional startup-hooks)
&optional startup-hooks
merge-autostore-dir)
;; ediff-read-file-name is set to attach a previously entered file name if
;; the currently entered file is a directory. This code takes care of that.
;; the currently entered file is a directory. This code takes care of that.
(setq dir1 (if (file-directory-p dir1) dir1 (file-name-directory dir1))
dir2 (if (file-directory-p dir2) dir2 (file-name-directory dir2)))
@ -652,27 +662,35 @@ names. Only the files that are under revision control are taken into account."
(string= dir2 dir3))
(error "Directories B and C are the same: %s" dir1)))
(if merge-autostore-dir
(or (stringp merge-autostore-dir)
(error "%s: Directory for storing merged files must be a string"
jobname)))
(let (diffs ; var where ediff-intersect-directories returns the diff list
merge-autostore-dir
file-list meta-buf)
(if (and ediff-autostore-merges (ediff-merge-metajob jobname))
(if (and ediff-autostore-merges
(ediff-merge-metajob jobname)
(not merge-autostore-dir))
(setq merge-autostore-dir
(ediff-read-file-name "Directory to save merged files:"
(if ediff-use-last-dir
(read-file-name "Save merged files in directory: "
(if ediff-use-last-dir
ediff-last-merge-autostore-dir
(ediff-strip-last-dir dir1))
nil)))
nil
'must-match)))
;; verify we are not merging into an orig directory
(if (stringp merge-autostore-dir)
(if merge-autostore-dir
(cond ((and (stringp dir1) (string= merge-autostore-dir dir1))
(or (y-or-n-p "Merge directory same as directory A, sure? ")
(or (y-or-n-p
"Directory for saving merged files = Directory A. Sure? ")
(error "Directory merge aborted")))
((and (stringp dir2) (string= merge-autostore-dir dir2))
(or (y-or-n-p "Merge directory same as directory B, sure? ")
(or (y-or-n-p
"Directory for saving merged files = Directory B. Sure? ")
(error "Directory merge aborted")))
((and (stringp dir3) (string= merge-autostore-dir dir3))
(or (y-or-n-p
"Merge directory same as ancestor directory, sure? ")
"Directory for saving merged files = Ancestor Directory. Sure? ")
(error "Directory merge aborted")))))
(setq file-list (ediff-intersect-directories
@ -697,24 +715,34 @@ names. Only the files that are under revision control are taken into account."
(ediff-show-meta-buffer meta-buf)
))
;; MERGE-AUTOSTORE-DIR can be given to tell ediff where to store the merged
;; files
(defun ediff-directory-revisions-internal (dir1 regexp action jobname
&optional startup-hooks)
&optional startup-hooks
merge-autostore-dir)
(setq dir1 (if (file-directory-p dir1) dir1 (file-name-directory dir1)))
(let (file-list meta-buf merge-autostore-dir)
(if (and ediff-autostore-merges (ediff-merge-metajob jobname))
(if merge-autostore-dir
(or (stringp merge-autostore-dir)
(error "%S: Directory for storing merged files must be a string"
jobname)))
(let (file-list meta-buf)
(if (and ediff-autostore-merges
(ediff-merge-metajob jobname)
(not merge-autostore-dir))
(setq merge-autostore-dir
(ediff-read-file-name "Directory to save merged files:"
(if ediff-use-last-dir
ediff-last-merge-autostore-dir
(ediff-strip-last-dir dir1))
nil)))
(read-file-name "Save merged files in directory: "
(if ediff-use-last-dir
ediff-last-merge-autostore-dir
(ediff-strip-last-dir dir1))
nil
'must-match)))
;; verify merge-autostore-dir != dir1
(if (and (stringp merge-autostore-dir)
(if (and merge-autostore-dir
(stringp dir1)
(string= merge-autostore-dir dir1))
(or (y-or-n-p
"Directory for saving merges is the same as directory A. Sure? ")
"Directory for saving merged file = directory A. Sure? ")
(error "Merge of directory revisions aborted")))
(setq file-list
@ -797,7 +825,7 @@ If WIND-B is nil, use window next to WIND-A."
"Run Ediff on a pair of regions in two different buffers.
Regions \(i.e., point and mark\) are assumed to be set in advance.
This function is effective only for relatively small regions, up to 200
lines. For large regions, use `ediff-regions-linewise'."
lines. For large regions, use `ediff-regions-linewise'."
(interactive
(let (bf)
(list (setq bf (read-buffer "Region's A buffer: "
@ -835,7 +863,7 @@ lines. For large regions, use `ediff-regions-linewise'."
Regions \(i.e., point and mark\) are assumed to be set in advance.
Each region is enlarged to contain full lines.
This function is effective for large regions, over 100-200
lines. For small regions, use `ediff-regions-wordwise'."
lines. For small regions, use `ediff-regions-wordwise'."
(interactive
(let (bf)
(list (setq bf (read-buffer "Region A's buffer: "
@ -1171,7 +1199,7 @@ buffer."
ancestor-rev
(read-string
(format
"Ancestor version (default: %s): "
"Ancestor version (default: %s's base revision): "
(if (stringp file)
(file-name-nondirectory file) "current buffer"))))
(ediff-load-version-control)
@ -1182,7 +1210,7 @@ buffer."
;;;###autoload
(defun run-ediff-from-cvs-buffer (pos)
"Run Ediff-merge on appropriate revisions of the selected file.
First run after `M-x cvs-update'. Then place the cursor on a line describing a
First run after `M-x cvs-update'. Then place the cursor on a line describing a
file and then run `run-ediff-from-cvs-buffer'."
(interactive "d")
(ediff-load-version-control)
@ -1195,13 +1223,18 @@ file and then run `run-ediff-from-cvs-buffer'."
;;; Apply patch
;;;###autoload
(defun ediff-patch-file ()
"Run Ediff by patching SOURCE-FILENAME."
;; This now returns the control buffer
(interactive)
(let (source-dir source-file patch-buf)
(defun ediff-patch-file (&optional arg patch-buf)
"Run Ediff by patching SOURCE-FILENAME.
If optional PATCH-BUF is given, use the patch in that buffer
and don't ask the user.
If prefix argument, then: if even argument, assume that the patch is in a
buffer. If odd -- assume it is in a file."
(interactive "P")
(let (source-dir source-file)
(require 'ediff-ptch)
(setq patch-buf (ediff-get-patch-buffer))
(setq patch-buf
(ediff-get-patch-buffer
(if arg (prefix-numeric-value arg)) patch-buf))
(setq source-dir (cond (ediff-use-last-dir ediff-last-dir-patch)
((and (not ediff-patch-default-directory)
(buffer-file-name patch-buf))
@ -1211,25 +1244,26 @@ file and then run `run-ediff-from-cvs-buffer'."
(t default-directory)))
(setq source-file
;; the default is the directory, not the visited file name
(ediff-read-file-name
"Which file to patch? " source-dir (ediff-get-default-file-name)))
(read-file-name
"File to patch (directory, if multifile patch): "
source-dir (ediff-get-default-file-name)))
(ediff-dispatch-file-patching-job patch-buf source-file)))
;;;###autoload
(defun ediff-patch-buffer ()
(defun ediff-patch-buffer (&optional arg patch-buf)
"Run Ediff by patching BUFFER-NAME."
(interactive)
(let (patch-buf)
(require 'ediff-ptch)
(setq patch-buf (ediff-get-patch-buffer))
(ediff-patch-buffer-internal
patch-buf
(read-buffer "Which buffer to patch? "
(cond ((eq patch-buf (current-buffer))
(ediff-other-buffer (current-buffer)))
(t (current-buffer)))
'must-match))))
(interactive "P")
(require 'ediff-ptch)
(setq patch-buf
(ediff-get-patch-buffer
(if arg (prefix-numeric-value arg)) patch-buf))
(ediff-patch-buffer-internal
patch-buf
(read-buffer
"Which buffer to patch? "
(ediff-prompt-for-patch-buffer))))
;;;###autoload
(defalias 'epatch 'ediff-patch-file)
;;;###autoload
@ -1244,7 +1278,7 @@ file and then run `run-ediff-from-cvs-buffer'."
(defun ediff-revision (&optional file startup-hooks)
"Run Ediff by comparing versions of a file.
The file is an optional FILE argument or the file visited by the current
buffer. Use `vc.el' or `rcs.el' depending on `ediff-version-control-package'."
buffer. Use `vc.el' or `rcs.el' depending on `ediff-version-control-package'."
;; if buffer is non-nil, use that buffer instead of the current buffer
(interactive "P")
(if (stringp file) (find-file file))
@ -1280,7 +1314,7 @@ buffer. Use `vc.el' or `rcs.el' depending on `ediff-version-control-package'."
(message "") ; kill the message from `locate-library'
(require ediff-version-control-package))
(or silent
(error "Version control package %S.el not found. Use vc.el instead"
(error "Version control package %S.el not found. Use vc.el instead"
ediff-version-control-package)))))
@ -1330,4 +1364,6 @@ With optional NODE, goes to that node."
(require 'ediff-util)
(run-hooks 'ediff-load-hook)
;;; ediff.el ends here

457
lisp/emulation/viper-cmd.el
View file

@ -97,7 +97,7 @@
(defconst viper-movement-commands '(?b ?B ?e ?E ?f ?F ?G ?h ?H ?j ?k ?l
?H ?M ?L ?n ?t ?T ?w ?W ?$ ?%
?^ ?( ?) ?- ?+ ?| ?{ ?} ?[ ?] ?' ?`
?\; ?, ?0 ?? ?/ ?\C-m ?\
?\; ?, ?0 ?? ?/ ?\ ?\C-m
space return
delete backspace
)
@ -137,6 +137,10 @@
;; define viper-vi-command-p
(viper-test-com-defun viper-vi-command)
;; Where viper saves mark. This mark is resurrected by m^
(defvar viper-saved-mark nil)
;;; CODE
@ -151,7 +155,9 @@
(run-hook-with-args 'viper-before-change-functions beg end))
(defsubst viper-post-command-sentinel ()
(run-hooks 'viper-post-command-hooks))
(run-hooks 'viper-post-command-hooks)
(if (eq viper-current-state 'vi-state)
(viper-restore-cursor-color 'after-insert-mode)))
(defsubst viper-pre-command-sentinel ()
(run-hooks 'viper-pre-command-hooks))
@ -163,15 +169,21 @@
viper-insert-point
(>= (point) viper-insert-point))
(setq viper-last-posn-while-in-insert-state (point-marker)))
(if (eq viper-current-state 'insert-state)
(or (viper-overlay-p viper-replace-overlay)
(progn
(or (stringp viper-saved-cursor-color)
(viper-set-replace-overlay (point-min) (point-min))
(viper-hide-replace-overlay)))
(if (eq viper-current-state 'insert-state)
(let ((has-saved-cursor-color-in-insert-mode
(stringp (viper-get-saved-cursor-color-in-insert-mode))))
(or has-saved-cursor-color-in-insert-mode
(string= (viper-get-cursor-color) viper-insert-state-cursor-color)
(setq viper-saved-cursor-color (viper-get-cursor-color)))
(if (stringp viper-saved-cursor-color)
(viper-change-cursor-color viper-insert-state-cursor-color))
))
(if (and (eq this-command 'dabbrev-expand)
;; save current color, if not already saved
(viper-save-cursor-color 'before-insert-mode))
;; set insert mode cursor color
(viper-change-cursor-color viper-insert-state-cursor-color)))
(if (and (memq this-command '(dabbrev-expand hippie-expand))
(integerp viper-pre-command-point)
(markerp viper-insert-point)
(marker-position viper-insert-point)
@ -184,8 +196,8 @@
(memq (viper-event-key last-command-event)
'(up down left right (meta f) (meta b)
(control n) (control p) (control f) (control b)))
(viper-restore-cursor-color-after-insert))
(if (and (eq this-command 'dabbrev-expand)
(viper-restore-cursor-color 'after-insert-mode))
(if (and (memq this-command '(dabbrev-expand hippie-expand))
(markerp viper-insert-point)
(marker-position viper-insert-point))
(setq viper-pre-command-point (marker-position viper-insert-point))))
@ -196,11 +208,11 @@
;; in another frame, the pre-command hook won't change cursor color to
;; default in that other frame. So, if the second frame cursor was red and
;; we set the point outside the replacement region, then the cursor color
;; will remain red. Restoring the default, below, prevents this.
;; will remain red. Restoring the default, below, prevents this.
(if (and (<= (viper-replace-start) (point))
(<= (point) (viper-replace-end)))
(viper-change-cursor-color viper-replace-overlay-cursor-color)
(viper-restore-cursor-color-after-replace)
(viper-restore-cursor-color 'after-replace-mode)
))
;; to speed up, don't change cursor color before self-insert
@ -210,7 +222,7 @@
(memq (viper-event-key last-command-event)
'(up down left right (meta f) (meta b)
(control n) (control p) (control f) (control b)))
(viper-restore-cursor-color-after-replace)))
(viper-restore-cursor-color 'after-replace-mode)))
(defun viper-replace-state-post-command-sentinel ()
;; Restoring cursor color is needed despite
@ -218,13 +230,13 @@
;; in another frame, the pre-command hook won't change cursor color to
;; default in that other frame. So, if the second frame cursor was red and
;; we set the point outside the replacement region, then the cursor color
;; will remain red. Restoring the default, below, fixes this problem.
;; will remain red. Restoring the default, below, fixes this problem.
;;
;; We optimize for self-insert-command's here, since they either don't change
;; cursor color or, if they terminate replace mode, the color will be changed
;; in viper-finish-change
(or (memq this-command '(self-insert-command))
(viper-restore-cursor-color-after-replace))
(viper-restore-cursor-color 'after-replace-mode))
(cond
((eq viper-current-state 'replace-state)
;; delete characters to compensate for inserted chars.
@ -279,8 +291,8 @@
;; move viper-last-posn-while-in-insert-state
;; This is a normal hook that is executed in insert/replace
;; states after each command. In Vi/Emacs state, it does
;; nothing. We need to execute it here to make sure that
;; states after each command. In Vi/Emacs state, it does
;; nothing. We need to execute it here to make sure that
;; the last posn was recorded when we hit ESC.
;; It may be left unrecorded if the last thing done in
;; insert/repl state was dabbrev-expansion or abbrev
@ -564,6 +576,9 @@
(if (and viper-first-time (not (viper-is-in-minibuffer)))
(viper-mode)
(if overwrite-mode (overwrite-mode nil))
(or (viper-overlay-p viper-replace-overlay)
(viper-set-replace-overlay (point-min) (point-min)))
(viper-hide-replace-overlay)
(if abbrev-mode (expand-abbrev))
(if (and auto-fill-function (> (current-column) fill-column))
(funcall auto-fill-function))
@ -578,7 +593,7 @@
(viper-adjust-undo)
(viper-change-state 'vi-state)
(viper-restore-cursor-color-after-insert)
(viper-restore-cursor-color 'after-insert-mode)
;; Protect against user errors in hooks
(condition-case conds
@ -590,16 +605,18 @@
"Change Viper state to Insert."
(interactive)
(viper-change-state 'insert-state)
(or (stringp viper-saved-cursor-color)
(string= (viper-get-cursor-color) viper-insert-state-cursor-color)
(setq viper-saved-cursor-color (viper-get-cursor-color)))
;; Commented out, because if viper-change-state-to-insert is executed
;; non-interactively then the old cursor color may get lost. Same old Emacs
;; bug related to local variables?
;;;(if (stringp viper-saved-cursor-color)
;;; (viper-change-cursor-color viper-insert-state-cursor-color))
(or (viper-overlay-p viper-replace-overlay)
(viper-set-replace-overlay (point-min) (point-min)))
(viper-hide-replace-overlay)
(let ((has-saved-cursor-color-in-insert-mode
(stringp (viper-get-saved-cursor-color-in-insert-mode))))
(or has-saved-cursor-color-in-insert-mode
(string= (viper-get-cursor-color) viper-insert-state-cursor-color)
(viper-save-cursor-color 'before-insert-mode))
(viper-change-cursor-color viper-insert-state-cursor-color))
;; Protect against user errors in hooks
(condition-case conds
(run-hooks 'viper-insert-state-hook)
@ -612,7 +629,7 @@
;; Change to replace state. When the end of replacement region is reached,
;; Change to replace state. When the end of replacement region is reached,
;; replace state changes to insert state.
(defun viper-change-state-to-replace (&optional non-R-cmd)
(viper-change-state 'replace-state)
@ -632,6 +649,9 @@
(defun viper-change-state-to-emacs ()
"Change Viper state to Emacs."
(interactive)
(or (viper-overlay-p viper-replace-overlay)
(viper-set-replace-overlay (point-min) (point-min)))
(viper-hide-replace-overlay)
(viper-change-state 'emacs-state)
;; Protect agains user errors in hooks
@ -654,7 +674,7 @@ EVENTS is a list of events, which become the beginning of the command."
(defun viper-escape-to-vi (arg)
"Escape from Emacs state to Vi state for one Vi 1-character command.
If the Vi command that the user types has a prefix argument, e.g., `d2w', then
Vi's prefix argument will be used. Otherwise, the prefix argument passed to
Vi's prefix argument will be used. Otherwise, the prefix argument passed to
`viper-escape-to-vi' is used."
(interactive "P")
(message "Switched to VI state for the next command...")
@ -687,9 +707,9 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to
(while (vectorp com) (setq com (key-binding com))))
nil)
;; Execute command com in the original Viper state, not in state
;; `state'. Otherwise, if we switch buffers while executing the
;; `state'. Otherwise, if we switch buffers while executing the
;; escaped to command, Viper's mode vars will remain those of
;; `state'. When we return to the orig buffer, the bindings will be
;; `state'. When we return to the orig buffer, the bindings will be
;; screwed up.
(viper-set-mode-vars-for viper-current-state)
@ -750,7 +770,7 @@ Similar to viper-escape-to-emacs, but accepts forms rather than keystrokes."
;; This is needed because minor modes sometimes override essential Viper
;; bindings. By letting Viper know which files these modes are in, it will
;; bindings. By letting Viper know which files these modes are in, it will
;; arrange to reorganize minor-mode-map-alist so that things will work right.
(defun viper-harness-minor-mode (load-file)
"Familiarize Viper with a minor mode defined in LOAD_FILE.
@ -779,9 +799,9 @@ Suffixes such as .el or .elc should be stripped."
Prevents multiple escape keystrokes if viper-no-multiple-ESC is true.
If viper-no-multiple-ESC is 'twice double ESC would ding in vi-state.
Other ESC sequences are emulated via the current Emacs's major mode
keymap. This is more convenient on TTYs, since this won't block
function keys such as up,down, etc. ESC will also will also work as
a Meta key in this case. When viper-no-multiple-ESC is nil, ESC functions
keymap. This is more convenient on TTYs, since this won't block
function keys such as up,down, etc. ESC will also will also work as
a Meta key in this case. When viper-no-multiple-ESC is nil, ESC functions
as a Meta key and any number of multiple escapes is allowed."
(interactive "P")
(let (char)
@ -850,8 +870,8 @@ as a Meta key and any number of multiple escapes is allowed."
;;
;; If `first-key' is not an ESC event, we make it into the
;; last-command-event in order to pretend that this key was
;; pressed. This is needed to allow arrow keys to be bound to
;; macros. Otherwise, viper-exec-mapped-kbd-macro will think
;; pressed. This is needed to allow arrow keys to be bound to
;; macros. Otherwise, viper-exec-mapped-kbd-macro will think
;; that the last event was ESC and so it'll execute whatever is
;; bound to ESC. (Viper macros can't be bound to
;; ESC-sequences).
@ -957,7 +977,7 @@ as a Meta key and any number of multiple escapes is allowed."
;; Compute numeric prefix arg value.
;; Invoked by EVENT. COM is the command part obtained so far.
;; Invoked by EVENT. COM is the command part obtained so far.
(defun viper-prefix-arg-value (event-char com)
(let ((viper-intermediate-command 'viper-digit-argument)
value func)
@ -983,13 +1003,13 @@ as a Meta key and any number of multiple escapes is allowed."
;; confuse subsequent commands
(progn
;; last-command-char is the char we want emacs to think was typed
;; last. If com is not nil, the viper-digit-argument command was
;; last. If com is not nil, the viper-digit-argument command was
;; called from within viper-prefix-arg command, such as `d', `w',
;; etc., i.e., the user typed, say, d2. In this case, `com' would be
;; etc., i.e., the user typed, say, d2. In this case, `com' would be
;; `d', `w', etc. If viper-digit-argument was invoked by
;; viper-escape-to-vi (which is indicated by the fact that the
;; current state is not vi-state), then `event-char' represents the
;; vi command to be executed (e.g., `d', `w', etc). Again,
;; vi command to be executed (e.g., `d', `w', etc). Again,
;; last-command-char must make emacs believe that this is the command
;; we typed.
(cond ((eq event-char 'return) (setq event-char ?\C-m))
@ -1080,8 +1100,8 @@ as a Meta key and any number of multiple escapes is allowed."
(setq prefix-arg nil)
(cond
;; If we change ?C to ?c here, then cc will enter replacement mode
;; rather than deleting lines. However, it will affect 1 less line than
;; normal. We decided to not use replacement mode here and follow Vi,
;; rather than deleting lines. However, it will affect 1 less line than
;; normal. We decided to not use replacement mode here and follow Vi,
;; since replacement mode on n full lines can be achieved with nC.
((equal com '(?c . ?c)) (viper-line (cons value ?C)))
((equal com '(?d . ?d)) (viper-line (cons value ?D)))
@ -1228,86 +1248,98 @@ as a Meta key and any number of multiple escapes is allowed."
(defun viper-exec-delete (m-com com)
(or (and (markerp viper-com-point) (marker-position viper-com-point))
(set-marker viper-com-point (point) (current-buffer)))
(if viper-use-register
(progn
(cond ((viper-valid-register viper-use-register '(letter digit))
(copy-to-register
viper-use-register viper-com-point (point) nil))
((viper-valid-register viper-use-register '(Letter))
(viper-append-to-register
(downcase viper-use-register) viper-com-point (point)))
(t (setq viper-use-register nil)
(let (chars-deleted)
(if viper-use-register
(progn
(cond ((viper-valid-register viper-use-register '(letter digit))
(copy-to-register
viper-use-register viper-com-point (point) nil))
((viper-valid-register viper-use-register '(Letter))
(viper-append-to-register
(downcase viper-use-register) viper-com-point (point)))
(t (setq viper-use-register nil)
(error viper-InvalidRegister viper-use-register)))
(setq viper-use-register nil)))
(setq last-command
(if (eq last-command 'd-command) 'kill-region nil))
(message "Deleted %d characters" (abs (- (point) viper-com-point)))
(kill-region viper-com-point (point))
(setq this-command 'd-command)
(if viper-ex-style-motion
(if (and (eolp) (not (bolp))) (backward-char 1))))
(setq viper-use-register nil)))
(setq last-command
(if (eq last-command 'd-command) 'kill-region nil))
(setq chars-deleted (abs (- (point) viper-com-point)))
(if (> chars-deleted viper-change-notification-threshold)
(message "Deleted %d characters" chars-deleted))
(kill-region viper-com-point (point))
(setq this-command 'd-command)
(if viper-ex-style-motion
(if (and (eolp) (not (bolp))) (backward-char 1)))))
(defun viper-exec-Delete (m-com com)
(save-excursion
(set-mark viper-com-point)
(viper-enlarge-region (mark t) (point))
(if viper-use-register
(progn
(cond ((viper-valid-register viper-use-register '(letter digit))
(copy-to-register
viper-use-register (mark t) (point) nil))
((viper-valid-register viper-use-register '(Letter))
(viper-append-to-register
(downcase viper-use-register) (mark t) (point)))
(t (setq viper-use-register nil)
(error viper-InvalidRegister viper-use-register)))
(setq viper-use-register nil)))
(setq last-command
(if (eq last-command 'D-command) 'kill-region nil))
(message "Deleted %d lines" (count-lines (point) viper-com-point))
(kill-region (mark t) (point))
(if (eq m-com 'viper-line) (setq this-command 'D-command)))
(back-to-indentation))
(let (lines-deleted)
(if viper-use-register
(progn
(cond ((viper-valid-register viper-use-register '(letter digit))
(copy-to-register
viper-use-register (mark t) (point) nil))
((viper-valid-register viper-use-register '(Letter))
(viper-append-to-register
(downcase viper-use-register) (mark t) (point)))
(t (setq viper-use-register nil)
(error viper-InvalidRegister viper-use-register)))
(setq viper-use-register nil)))
(setq last-command
(if (eq last-command 'D-command) 'kill-region nil))
(setq lines-deleted (count-lines (point) viper-com-point))
(if (> lines-deleted viper-change-notification-threshold)
(message "Deleted %d lines" lines-deleted))
(kill-region (mark t) (point))
(if (eq m-com 'viper-line) (setq this-command 'D-command)))
(back-to-indentation)))
;; save region
(defun viper-exec-yank (m-com com)
(or (and (markerp viper-com-point) (marker-position viper-com-point))
(set-marker viper-com-point (point) (current-buffer)))
(if viper-use-register
(progn
(cond ((viper-valid-register viper-use-register '(letter digit))
(copy-to-register
viper-use-register viper-com-point (point) nil))
((viper-valid-register viper-use-register '(Letter))
(viper-append-to-register
(downcase viper-use-register) viper-com-point (point)))
(t (setq viper-use-register nil)
(error viper-InvalidRegister viper-use-register)))
(setq viper-use-register nil)))
(setq last-command nil)
(copy-region-as-kill viper-com-point (point))
(message "Saved %d characters" (abs (- (point) viper-com-point)))
(goto-char viper-com-point))
(let (chars-saved)
(if viper-use-register
(progn
(cond ((viper-valid-register viper-use-register '(letter digit))
(copy-to-register
viper-use-register viper-com-point (point) nil))
((viper-valid-register viper-use-register '(Letter))
(viper-append-to-register
(downcase viper-use-register) viper-com-point (point)))
(t (setq viper-use-register nil)
(error viper-InvalidRegister viper-use-register)))
(setq viper-use-register nil)))
(setq last-command nil)
(copy-region-as-kill viper-com-point (point))
(setq chars-saved (abs (- (point) viper-com-point)))
(if (> chars-saved viper-change-notification-threshold)
(message "Saved %d characters" chars-saved))
(goto-char viper-com-point)))
;; save lines
(defun viper-exec-Yank (m-com com)
(save-excursion
(set-mark viper-com-point)
(viper-enlarge-region (mark t) (point))
(if viper-use-register
(progn
(cond ((viper-valid-register viper-use-register '(letter digit))
(copy-to-register
viper-use-register (mark t) (point) nil))
((viper-valid-register viper-use-register '(Letter))
(viper-append-to-register
(downcase viper-use-register) (mark t) (point)))
(t (setq viper-use-register nil)
(error viper-InvalidRegister viper-use-register)))
(setq viper-use-register nil)))
(setq last-command nil)
(copy-region-as-kill (mark t) (point))
(message "Saved %d lines" (count-lines (mark t) (point))))
(let (lines-saved)
(if viper-use-register
(progn
(cond ((viper-valid-register viper-use-register '(letter digit))
(copy-to-register
viper-use-register (mark t) (point) nil))
((viper-valid-register viper-use-register '(Letter))
(viper-append-to-register
(downcase viper-use-register) (mark t) (point)))
(t (setq viper-use-register nil)
(error viper-InvalidRegister viper-use-register)))
(setq viper-use-register nil)))
(setq last-command nil)
(copy-region-as-kill (mark t) (point))
(setq lines-saved (count-lines (mark t) (point)))
(if (> lines-saved viper-change-notification-threshold)
(message "Saved %d lines" lines-saved))))
(viper-deactivate-mark)
(goto-char viper-com-point))
@ -1357,12 +1389,13 @@ as a Meta key and any number of multiple escapes is allowed."
(setq viper-s-string (buffer-substring (point) viper-com-point))
(setq viper-s-forward t)
(setq viper-search-history (cons viper-s-string viper-search-history))
(setq viper-intermediate-command 'viper-exec-buffer-search)
(viper-search viper-s-string viper-s-forward 1))
(defvar viper-exec-array (make-vector 128 nil))
;; Using a dispatch array allows adding functions like buffer search
;; without affecting other functions. Buffer search can now be bound
;; without affecting other functions. Buffer search can now be bound
;; to any character.
(aset viper-exec-array ?c 'viper-exec-change)
@ -1380,7 +1413,7 @@ as a Meta key and any number of multiple escapes is allowed."
;; This function is called by various movement commands to execute a
;; destructive command on the region specified by the movement command. For
;; destructive command on the region specified by the movement command. For
;; instance, if the user types cw, then the command viper-forward-word will
;; call viper-execute-com to execute viper-exec-change, which eventually will
;; call viper-change to invoke the replace mode on the region.
@ -1443,10 +1476,10 @@ If the prefix argument, ARG, is non-nil, it is used instead of `val'."
))
(viper-adjust-undo) ; take care of undo
;; If the prev cmd was rotating the command ring, this means that `.' has
;; just executed a command from that ring. So, push it on the ring again.
;; just executed a command from that ring. So, push it on the ring again.
;; If we are just executing previous command , then don't push viper-d-com
;; because viper-d-com is not fully constructed in this case (its keys and
;; the inserted text may be nil). Besides, in this case, the command
;; the inserted text may be nil). Besides, in this case, the command
;; 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))
@ -1458,7 +1491,7 @@ If the prefix argument, ARG, is non-nil, it is used instead of `val'."
Doesn't change viper-command-ring in any way, so `.' will work as before
executing this command.
This command is supposed to be bound to a two-character Vi macro where
the second character is a digit 0 to 9. The digit indicates which
the second character is a digit 0 to 9. The digit indicates which
history command to execute. `<char>0' is equivalent to `.', `<char>1'
invokes the command before that, etc."
(interactive)
@ -1486,7 +1519,7 @@ invokes the command before that, etc."
))
;; The hash-command. It is invoked interactively by the key sequence #<char>.
;; The hash-command. It is invoked interactively by the key sequence #<char>.
;; The chars that can follow `#' are determined by viper-hash-command-p
(defun viper-special-prefix-com (char)
(cond ((= char ?c)
@ -1819,16 +1852,16 @@ Undo previous insertion and inserts new."
(defcustom viper-smart-suffix-list
'("" "tex" "c" "cc" "C" "el" "java" "html" "htm" "pl" "P" "p")
'("" "tex" "c" "cc" "C" "el" "java" "html" "htm" "pl" "flr" "P" "p")
"*List of suffixes that Viper tries to append to filenames ending with a `.'.
This is useful when you the current directory contains files with the same
prefix and many different suffixes. Usually, only one of the suffixes
represents an editable file. However, file completion will stop at the `.'
prefix and many different suffixes. Usually, only one of the suffixes
represents an editable file. However, file completion will stop at the `.'
The smart suffix feature lets you hit RET in such a case, and Viper will
select the appropriate suffix.
Suffixes are tried in the order given and the first suffix for which a
corresponding file exists is selected. If no file exists for any of the
corresponding file exists is selected. If no file exists for any of the
suffixes, the user is asked to confirm.
To turn this feature off, set this variable to nil."
@ -1892,7 +1925,7 @@ problems."
history-var default keymap
init-message)
;; Read string, prompting with PROMPT and inserting the INITIAL
;; value. Uses HISTORY-VAR. DEFAULT is the default value to accept if the
;; value. Uses HISTORY-VAR. DEFAULT is the default value to accept if the
;; input is an empty string.
;; Default value is displayed until the user types something in the
;; minibuffer.
@ -1900,19 +1933,18 @@ problems."
;; INIT-MESSAGE is the message temporarily displayed after entering the
;; minibuffer.
(let ((minibuffer-setup-hook
(function
(lambda ()
(if (stringp init-message)
(viper-tmp-insert-at-eob init-message))
(if (stringp initial)
(progn
;; don't wait if we have unread events or in kbd macro
(or unread-command-events
executing-kbd-macro
(sit-for 840))
(erase-buffer)
(insert initial)))
(viper-minibuffer-setup-sentinel))))
(lambda ()
(if (stringp init-message)
(viper-tmp-insert-at-eob init-message))
(if (stringp initial)
(progn
;; don't wait if we have unread events or in kbd macro
(or unread-command-events
executing-kbd-macro
(sit-for 840))
(erase-buffer)
(insert initial)))
(viper-minibuffer-setup-sentinel)))
(val "")
(padding "")
temp-msg)
@ -1938,7 +1970,7 @@ problems."
(set history-var (cdr (eval history-var))))
;; If the user enters nothing but the prev cmd wasn't viper-ex,
;; viper-command-argument, or `! shell-command', this probably means
;; that the user typed something then erased. Return "" in this case, not
;; that the user typed something then erased. Return "" in this case, not
;; the default---the default is too confusing in this case.
(cond ((and (string= val "")
(not (string= prompt "!")) ; was a `! shell-command'
@ -2144,12 +2176,13 @@ problems."
)
;; Invoked as an after-change-function to calculate how many chars have to be
;; deleted. This function may be called several times within a single command,
;; if this command performs several separate buffer changes. Therefore, if adds
;; up the number of chars inserted and subtracts the number of chars deleted.
;; deleted. This function may be called several times within a single command,
;; if this command performs several separate buffer changes. Therefore, if
;; adds up the number of chars inserted and subtracts the number of chars
;; deleted.
(defun viper-replace-mode-spy-after (beg end length)
(if (memq viper-intermediate-command
'(dabbrev-expand repeating-insertion-from-ring))
'(dabbrev-expand hippie-expand repeating-insertion-from-ring))
;; Take special care of text insertion from insertion ring inside
;; replacement overlays.
(progn
@ -2174,11 +2207,12 @@ problems."
;; column-shift instead of the number of inserted chars
(max (viper-chars-in-region beg real-end)
;; This test accounts for Chinese/Japanese/... chars,
;; which occupy 2 columns instead of one. If we use
;; which occupy 2 columns instead of one. If we use
;; column-shift here, we may delete two chars instead of
;; one when the user types one Chinese character. Deleting
;; two would be OK, if they were European chars, but it is
;; not OK if they are Chinese chars. Since it is hard to
;; one when the user types one Chinese character.
;; Deleting two would be OK, if they were European chars,
;; but it is not OK if they are Chinese chars.
;; Since it is hard to
;; figure out which characters are being deleted in any
;; given region, we decided to treat Eastern and European
;; characters equally, even though Eastern chars may
@ -2227,7 +2261,7 @@ problems."
'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local)
(remove-hook
'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local)
(viper-restore-cursor-color-after-replace)
(viper-restore-cursor-color 'after-replace-mode)
(setq viper-sitting-in-replace nil) ; just in case we'll need to know it
(save-excursion
(if (and viper-replace-overlay
@ -2301,7 +2335,7 @@ These keys are ESC, RET, and LineFeed"
(interactive)
;; If Emacs 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. Then the "if part" of this
;; just have keymap attached to replace overlay. Then the "if part" of this
;; statement can be deleted.
(if (or (< (point) (viper-replace-start))
(> (point) (viper-replace-end)))
@ -2356,8 +2390,8 @@ These keys are ESC, RET, and LineFeed"
(viper-move-marker-locally 'viper-com-point (point))
(if (not (eobp))
(viper-next-line-carefully (1- val)))
;; this ensures that dd, cc, D, yy will do the right thing on the last
;; line of buffer when this line has no \n.
;; the following ensures that dd, cc, D, yy will do the right thing on the
;; last line of buffer when this line has no \n.
(viper-add-newline-at-eob-if-necessary)
(viper-execute-com 'viper-line val com))
(if (and (eobp) (not (bobp))) (forward-line -1))
@ -2535,9 +2569,9 @@ On reaching beginning of line, stop and signal error."
;;; Word command
;; Words are formed from alpha's and nonalphas - <sp>,\t\n are separators for
;; word movement. When executed with a destructive command, \n is usually left
;; word movement. When executed with a destructive command, \n is usually left
;; untouched for the last word. Viper uses syntax table to determine what is a
;; word and what is a separator. However, \n is always a separator. Also, if
;; word and what is a separator. However, \n is always a separator. Also, if
;; viper-syntax-preference is 'vi, then `_' is part of the word.
;; skip only one \n
@ -2549,7 +2583,7 @@ On reaching beginning of line, stop and signal error."
(progn
(forward-char)
(viper-skip-all-separators-forward 'within-line))))
;; check for eob and white space before it. move off of eob
;; check for eob and white space before it. move off of eob
(if (and (eobp) (save-excursion
(viper-backward-char-carefully)
(viper-looking-at-separator)))
@ -2572,7 +2606,7 @@ On reaching beginning of line, stop and signal error."
(viper-skip-separators t)))
(setq val (1- val))))
;; first skip non-newline separators backward, then skip \n. Then, if TWICE is
;; first skip non-newline separators backward, then skip \n. Then, if TWICE is
;; non-nil, skip non-\n back again, but don't overshoot the limit LIM.
(defun viper-separator-skipback-special (twice lim)
(let ((prev-char (viper-char-at-pos 'backward))
@ -3107,6 +3141,7 @@ 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))
@ -3125,14 +3160,11 @@ controlled by the sign of prefix numeric value."
"Go to middle window line."
(interactive "P")
(let ((val (viper-p-val arg))
(com (viper-getCom arg))
lines)
(com (viper-getCom arg)))
(viper-leave-region-active)
(if com (viper-move-marker-locally 'viper-com-point (point)))
(push-mark nil t)
(if (not (pos-visible-in-window-p (point-max)))
(move-to-window-line (+ (/ (1- (window-height)) 2) (1- val)))
(setq lines (count-lines (window-start) (point-max)))
(move-to-window-line (+ (/ lines 2) (1- val))))
(move-to-window-line (+ (/ (1- (window-height)) 2) (1- val)))
;; positioning is done twice: before and after command execution
(if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
@ -3149,6 +3181,7 @@ 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))
@ -3180,8 +3213,8 @@ controlled by the sign of prefix numeric value."
;; If point is within viper-search-scroll-threshold of window top or bottom,
;; scroll up or down 1/7 of window height, depending on whether we are at the
;; bottom or at the top of the window. This function is called by viper-search
;; (which is called from viper-search-forward/backward/next). If the value of
;; bottom or at the top of the window. This function is called by viper-search
;; (which is called from viper-search-forward/backward/next). If the value of
;; viper-search-scroll-threshold is negative - don't scroll.
(defun viper-adjust-window ()
(let ((win-height (if viper-emacs-p
@ -3210,7 +3243,7 @@ controlled by the sign of prefix numeric value."
;; paren match
;; must correct this to only match ( to ) etc. On the other hand
;; must correct this to only match ( to ) etc. On the other hand
;; it is good that paren match gets confused, because that way you
;; catch _all_ imbalances.
@ -3436,21 +3469,21 @@ controlled by the sign of prefix numeric value."
(defun viper-toggle-search-style (arg)
"Toggle the value of viper-case-fold-search/viper-re-search.
Without prefix argument, will ask which search style to toggle. With prefix
Without prefix argument, will ask which search style to toggle. With prefix
arg 1,toggles viper-case-fold-search; with arg 2 toggles viper-re-search.
Although this function is bound to \\[viper-toggle-search-style], the most
convenient way to use it is to bind `//' to the macro
`1 M-x viper-toggle-search-style' and `///' to
`2 M-x viper-toggle-search-style'. In this way, hitting `//' quickly will
`2 M-x viper-toggle-search-style'. In this way, hitting `//' quickly will
toggle case-fold-search and hitting `/' three times witth toggle regexp
search. Macros are more convenient in this case because they don't affect
search. Macros are more convenient in this case because they don't affect
the Emacs binding of `/'."
(interactive "P")
(let (msg)
(cond ((or (eq arg 1)
(and (null arg)
(y-or-n-p (format "Search style: '%s'. Want '%s'? "
(y-or-n-p (format "Search style: '%s'. Want '%s'? "
(if viper-case-fold-search
"case-insensitive" "case-sensitive")
(if viper-case-fold-search
@ -3462,7 +3495,7 @@ the Emacs binding of `/'."
(setq msg "Search becomes case-sensitive")))
((or (eq arg 2)
(and (null arg)
(y-or-n-p (format "Search style: '%s'. Want '%s'? "
(y-or-n-p (format "Search style: '%s'. Want '%s'? "
(if viper-re-search
"regexp-search" "vanilla-search")
(if viper-re-search
@ -3529,7 +3562,7 @@ The macro that toggles case sensitivity is bound to `//', and the one that
toggles regexp search is bound to `///'.
With a prefix argument, this function unsets the macros.
If the optional prefix argument is non-nil and specifies a valid major mode,
this sets the macros only in the macros in that major mode. Otherwise,
this sets the macros only in the macros in that major mode. Otherwise,
the macros are set in the current major mode.
\(When unsetting the macros, the second argument has no effect.\)"
(interactive "P")
@ -3715,7 +3748,11 @@ Null string will repeat previous search."
((null viper-buffer-search-char)
(setq viper-buffer-search-char ?g)))
(define-key viper-vi-basic-map
(char-to-string viper-buffer-search-char) 'viper-command-argument)
(cond ((viper-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)))
'viper-command-argument)
(aset viper-exec-array viper-buffer-search-char 'viper-exec-buffer-search)
(setq viper-prefix-commands
(cons viper-buffer-search-char viper-prefix-commands)))
@ -3745,7 +3782,8 @@ Null string will repeat previous search."
(let ((other-buffer (other-buffer (current-buffer)))
buffer)
(setq buffer
(read-buffer "Switch to buffer in this window: " other-buffer))
(funcall viper-read-buffer-function
"Switch to buffer in this window: " other-buffer))
(switch-to-buffer buffer)))
(defun viper-switch-to-buffer-other-window ()
@ -3754,7 +3792,8 @@ Null string will repeat previous search."
(let ((other-buffer (other-buffer (current-buffer)))
buffer)
(setq buffer
(read-buffer "Switch to buffer in another window: " other-buffer))
(funcall viper-read-buffer-function
"Switch to buffer in another window: " other-buffer))
(switch-to-buffer-other-window buffer)))
(defun viper-kill-buffer ()
@ -3762,9 +3801,9 @@ Null string will repeat previous search."
(interactive)
(let (buffer buffer-name)
(setq buffer-name
(read-buffer
(format "Kill buffer \(%s\): "
(buffer-name (current-buffer)))))
(funcall viper-read-buffer-function
(format "Kill buffer \(%s\): "
(buffer-name (current-buffer)))))
(setq buffer
(if (null buffer-name)
(current-buffer)
@ -3783,7 +3822,7 @@ Null string will repeat previous search."
;; yank and pop
(defsubst viper-yank (text)
"Yank TEXT silently. This works correctly with Emacs's yank-pop command."
"Yank TEXT silently. This works correctly with Emacs's yank-pop command."
(insert text)
(setq this-command 'yank))
@ -3799,7 +3838,7 @@ Null string will repeat previous search."
(get-register (downcase viper-use-register)))
(t (error viper-InvalidRegister viper-use-register)))
(current-kill 0)))
sv-point)
sv-point chars-inserted lines-inserted)
(if (null text)
(if viper-use-register
(let ((reg viper-use-register))
@ -3820,9 +3859,12 @@ Null string will repeat previous search."
(list 'viper-put-back val nil viper-use-register nil nil))
(setq sv-point (point))
(viper-loop val (viper-yank text))
(message "Inserted %d character(s), %d line(s)"
(abs (- (point) sv-point))
(abs (count-lines (point) sv-point))))
(setq chars-inserted (abs (- (point) sv-point))
lines-inserted (abs (count-lines (point) sv-point)))
(if (or (> chars-inserted viper-change-notification-threshold)
(> lines-inserted viper-change-notification-threshold))
(message "Inserted %d character(s), %d line(s)"
chars-inserted lines-inserted)))
;; Vi puts cursor on the last char when the yanked text doesn't contain a
;; newline; it leaves the cursor at the beginning when the text contains
;; a newline
@ -3844,7 +3886,8 @@ Null string will repeat previous search."
((viper-valid-register viper-use-register)
(get-register (downcase viper-use-register)))
(t (error viper-InvalidRegister viper-use-register)))
(current-kill 0))))
(current-kill 0)))
sv-point chars-inserted lines-inserted)
(if (null text)
(if viper-use-register
(let ((reg viper-use-register))
@ -3856,7 +3899,14 @@ Null string will repeat previous search."
(viper-set-destructive-command
(list 'viper-Put-back val nil viper-use-register nil nil))
(set-marker (viper-mark-marker) (point) (current-buffer))
(viper-loop val (viper-yank text)))
(setq sv-point (point))
(viper-loop val (viper-yank text))
(setq chars-inserted (abs (- (point) sv-point))
lines-inserted (abs (count-lines (point) sv-point)))
(if (or (> chars-inserted viper-change-notification-threshold)
(> lines-inserted viper-change-notification-threshold))
(message "Inserted %d character(s), %d line(s)"
chars-inserted lines-inserted)))
;; Vi puts cursor on the last char when the yanked text doesn't contain a
;; newline; it leaves the cursor at the beginning when the text contains
;; a newline
@ -3908,7 +3958,7 @@ Null string will repeat previous search."
))
(defun viper-delete-backward-char (arg)
"Delete previous character. On reaching beginning of line, stop and beep."
"Delete previous character. On reaching beginning of line, stop and beep."
(interactive "P")
(let ((val (viper-p-val arg))
end-del-pos)
@ -3945,8 +3995,8 @@ Null string will repeat previous search."
(defun viper-del-backward-char-in-replace ()
"Delete one character in replace mode.
If `viper-delete-backwards-in-replace' is t, then DEL key actually deletes
charecters. If it is nil, then the cursor just moves backwards, similarly
to Vi. The variable `viper-ex-style-editing', if t, doesn't let the
charecters. If it is nil, then the cursor just moves backwards, similarly
to Vi. The variable `viper-ex-style-editing', if t, doesn't let the
cursor move past the beginning of line."
(interactive)
(cond (viper-delete-backwards-in-replace
@ -4031,10 +4081,10 @@ cursor move past the beginning of line."
viper-replace-region-start-delimiter
viper-replace-region-end-delimiter)
;; this move takes care of the last posn in the overlay, which
;; has to be shifted because of insert. We can't simply insert
;; has to be shifted because of insert. We can't simply insert
;; "$" before-markers because then overlay-start will shift the
;; beginning of the overlay in case we are replacing a single
;; character. This fixes the bug with `s' and `cl' commands.
;; character. This fixes the bug with `s' and `cl' commands.
(viper-move-replace-overlay (viper-replace-start) (point))
(goto-char (viper-replace-start))
(viper-change-state-to-replace t))
@ -4145,6 +4195,7 @@ and regexp replace."
((= char ?>) (viper-mark-end-of-buffer))
((= char ?.) (viper-set-mark-if-necessary))
((= char ?,) (viper-cycle-through-mark-ring))
((= char ?^) (push-mark viper-saved-mark t t))
((= char ?D) (mark-defun))
(t (error ""))
)))
@ -4156,7 +4207,7 @@ and regexp replace."
;; So, if you hit '' or `` then you can return to p1.
;;
;; If repeated command, pop top elt from the ring into mark and
;; jump there. This forgets the position, p1, and puts M1 back into mark.
;; jump there. This forgets the position, p1, and puts M1 back into mark.
;; Then we save the current pos, which is M0, jump to M1 and pop M2 from
;; the ring into mark. Push M2 back on the ring and set mark to M0.
;; etc.
@ -4165,12 +4216,12 @@ and regexp replace."
One can use `` and '' to temporarily jump 1 step back."
(let* ((sv-pt (point)))
;; if repeated `m,' command, pop the previously saved mark.
;; Prev saved mark is actually prev saved point. It is used if the
;; Prev saved mark is actually prev saved point. It is used if the
;; user types `` or '' and is discarded
;; from the mark ring by the next `m,' command.
;; In any case, go to the previous or previously saved mark.
;; Then push the current mark (popped off the ring) and set current
;; point to be the mark. Current pt as mark is discarded by the next
;; point to be the mark. Current pt as mark is discarded by the next
;; m, command.
(if (eq last-command 'viper-cycle-through-mark-ring)
()
@ -4336,7 +4387,7 @@ One can use `` and '' to temporarily jump 1 step back."
;; Viewing registers
(defun viper-ket-function (arg)
"Function called by \], the ket. View registers and call \]\]."
"Function called by \], the ket. View registers and call \]\]."
(interactive "P")
(let ((reg (read-char)))
(cond ((viper-valid-register reg '(letter Letter))
@ -4353,7 +4404,7 @@ One can use `` and '' to temporarily jump 1 step back."
viper-InvalidRegister reg)))))
(defun viper-brac-function (arg)
"Function called by \[, the brac. View textmarkers and call \[\["
"Function called by \[, the brac. View textmarkers and call \[\["
(interactive "P")
(let ((reg (read-char)))
(cond ((= ?\[ reg)
@ -4532,7 +4583,7 @@ Please specify your level of familiarity with the venomous VI PERil
You can change it at any time by typing `M-x viper-set-expert-level RET'
1 -- BEGINNER: Almost all Emacs features are suppressed.
Feels almost like straight Vi. File name completion and
Feels almost like straight Vi. File name completion and
command history in the minibuffer are thrown in as a bonus.
To use Emacs productively, you must reach level 3 or higher.
2 -- MASTER: C-c now has its standard Emacs meaning in Vi command state,
@ -4542,10 +4593,10 @@ You can change it at any time by typing `M-x viper-set-expert-level RET'
in Viper's insert state.
4 -- GURU: Like 3, but user settings are respected for viper-no-multiple-ESC,
viper-ex-style-motion, viper-ex-style-editing, and
viper-re-search variables. Adjust these settings to your taste.
viper-re-search variables. Adjust these settings to your taste.
5 -- WIZARD: Like 4, but user settings are also respected for viper-always,
viper-electric-mode, viper-want-ctl-h-help, viper-want-emacs-keys-in-vi,
and viper-want-emacs-keys-in-insert. Adjust these to your taste.
and viper-want-emacs-keys-in-insert. Adjust these to your taste.
Please, specify your level now: ")
@ -4705,10 +4756,10 @@ Before reporting a bug, please verify that it is related to Viper, and is
not cause by other packages you are using.
Don't report compilation warnings, unless you are certain that there is a
problem. These warnings are normal and unavoidable.
problem. These warnings are normal and unavoidable.
Please note that users should not modify variables and keymaps other than
those advertised in the manual. Such `customization' is likely to crash
those advertised in the manual. Such `customization' is likely to crash
Viper, as it would any other improperly customized Emacs package.
If you are reporting an error message received while executing one of the
@ -4716,8 +4767,8 @@ Viper commands, type:
M-x set-variable <Return> debug-on-error <Return> t <Return>
Then reproduce the error. The above command will cause Emacs to produce a
back trace of the execution that leads to the error. Please include this
Then reproduce the error. The above command will cause Emacs to produce a
back trace of the execution that leads to the error. Please include this
trace in your bug report.
If you believe that one of Viper's commands goes into an infinite loop
@ -4725,8 +4776,8 @@ If you believe that one of Viper's commands goes into an infinite loop
M-x set-variable <Return> debug-on-quit <Return> t <Return>
Then reproduce the problem. Wait for a few seconds, then type C-g to abort
the current command. Include the resulting back trace in the bug report.
Then reproduce the problem. Wait for a few seconds, then type C-g to abort
the current command. Include the resulting back trace in the bug report.
Mail anyway (y or n)? ")
(if (y-or-n-p "Mail anyway? ")
@ -4748,12 +4799,12 @@ Mail anyway (y or n)? ")
;; Smoothes out the difference between Emacs' unread-command-events
;; and XEmacs unread-command-event. Arg is a character, an event, a list of
;; and XEmacs unread-command-event. Arg is a character, an event, a list of
;; events or a sequence of keys.
;;
;; Due to the way unread-command-events in Emacs (not XEmacs), a non-event
;; symbol in unread-command-events list may cause Emacs to turn this symbol
;; into an event. Below, we delete nil from event lists, since nil is the most
;; into an event. Below, we delete nil from event lists, since nil is the most
;; common symbol that might appear in this wrong context.
(defun viper-set-unread-command-events (arg)
(if viper-emacs-p
@ -4786,12 +4837,12 @@ Mail anyway (y or n)? ")
;; list is assumed to be a list of events of characters
(defun viper-eventify-list-xemacs (lis)
(mapcar
(function (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)))))
(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))

158
lisp/emulation/viper-ex.el
View file

@ -68,7 +68,7 @@
;;; Variable completion in :set command
;; The list of Ex commands. Used for completing command names.
;; The list of Ex commands. Used for completing command names.
(defconst ex-token-alist
'(("!") ("=") (">") ("&") ("~")
("yank") ("xit") ("WWrite") ("Write") ("write") ("wq") ("visual")
@ -77,8 +77,8 @@
("set") ("rewind") ("recover") ("read") ("quit") ("pwd")
("put") ("preserve") ("PreviousRelatedFile") ("RelatedFile")
("next") ("Next") ("move") ("mark") ("map") ("kmark") ("join")
("help") ("goto") ("global") ("file") ("edit") ("delete") ("copy")
("chdir") ("cd") ("Buffer") ("buffer") ("args")) )
("help") ("goto") ("global") ("file") ("edit") ("delete") ("customize")
("copy") ("chdir") ("cd") ("Buffer") ("buffer") ("args")) )
;; A-list of Ex variables that can be set using the :set command.
(defconst ex-variable-alist
@ -108,8 +108,8 @@
(defvar ex-addresses nil)
;; This flag is supposed to be set only by `#', `print', and `list',
;; none of which is implemented. So, it and the pices of the code it
;; controls are dead weight. We keep it just in case this might be
;; none of which is implemented. So, it and the pices of the code it
;; controls are dead weight. We keep it just in case this might be
;; needed in the future.
(defvar ex-flag nil)
@ -169,13 +169,23 @@ Don't put `-c' here, as it is added automatically."
:type 'string
:group 'viper-ex)
(defvar ex-nontrivial-find-file-function
(cond (ex-unix-type-shell 'viper-ex-nontrivial-find-file-unix)
((eq system-type 'emx) 'viper-ex-nontrivial-find-file-ms) ; OS/2
(viper-ms-style-os-p 'viper-ex-nontrivial-find-file-ms) ; Microsoft OS
(viper-vms-os-p 'viper-ex-nontrivial-find-file-unix) ; VMS
(t 'viper-ex-nontrivial-find-file-unix) ; presumably UNIX
))
(defcustom viper-glob-function
(cond (ex-unix-type-shell 'viper-glob-unix-files)
((eq system-type 'emx) 'viper-glob-mswindows-files) ; OS/2
(viper-ms-style-os-p 'viper-glob-mswindows-files) ; Microsoft OS
(viper-vms-os-p 'viper-glob-unix-files) ; VMS
(t 'viper-glob-unix-files) ; presumably UNIX
)
"Expand the file spec containing wildcard symbols.
The default tries to set this variable to work with Unix, Windows,
OS/2, and VMS.
However, if it doesn't work right for some types of Unix shells or some OS,
the user should supply the appropriate function and set this variable to the
corresponding function symbol."
:type 'symbol
:group 'viper-ex)
;; Remembers the previous Ex tag.
(defvar ex-tag nil)
@ -198,12 +208,12 @@ Don't put `-c' here, as it is added automatically."
(defvar ex-cmdfile-args "")
;; flag used in viper-ex-read-file-name to indicate that we may be reading
;; multiple file names. Used for :edit and :next
;; multiple file names. Used for :edit and :next
(defvar viper-keep-reading-filename nil)
(defcustom ex-cycle-other-window t
"*If t, :n and :b cycles through files and buffers in other window.
Then :N and :B cycles in the current window. If nil, this behavior is
Then :N and :B cycles in the current window. If nil, this behavior is
reversed."
:type 'boolean
:group 'viper-ex)
@ -250,6 +260,7 @@ reversed."
(cond ((looking-at "cd") (viper-check-sub "cd"))
((looking-at "ch") (viper-check-sub "chdir"))
((looking-at "co") (viper-check-sub "copy"))
((looking-at "cu") (viper-check-sub "customize"))
(t (viper-check-sub "change"))))
((looking-at "d") (viper-check-sub "delete"))
((looking-at "b") (viper-check-sub "buffer"))
@ -424,8 +435,8 @@ reversed."
(t
(error viper-BadExCommand))))))
;; Reads Ex command. Tries to determine if it has to exit because command
;; is complete or invalid. If not, keeps reading command.
;; Reads Ex command. Tries to determine if it has to exit because command
;; is complete or invalid. If not, keeps reading command.
(defun ex-cmd-read-exit ()
(interactive)
(setq viper-incomplete-ex-cmd t)
@ -490,10 +501,10 @@ reversed."
(if (or (= dist 0)
(viper-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
(viper-looking-back
"^[ \t]*[a-zA-Z!=>&~][ \t]*[/?]*+[ \t]+[a-zA-Z!=>&~]+"))
"^[ \t]*[a-zA-Z!=>&~][ \t]*[/?]*[ \t]+[a-zA-Z!=>&~]+"))
;; Preceding characters are not the ones allowed in an Ex command
;; or we have typed past command name.
;; Note: we didn't do parsing, so there may be surprises.
;; Note: we didn't do parsing, so there can be surprises.
(if (or (viper-looking-back "[a-zA-Z!=>&~][ \t]*[/?]*[ \t]*")
(viper-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
(looking-at "[^ \t\n\C-m]"))
@ -526,6 +537,10 @@ reversed."
;; Read Ex commands
;; ARG is a prefix argument. If given, the ex command runs on the region
;;(without the user having to specify the address :a,b
;; STRING is the command to execute. If nil, then Viper asks you to enter the
;; command.
(defun viper-ex (arg &optional string)
(interactive "P")
(or string
@ -590,17 +605,19 @@ reversed."
(setq cont nil))
(t
(viper-execute-ex-command)
(save-window-excursion
(setq viper-ex-work-buf
(get-buffer-create viper-ex-work-buf-name))
(set-buffer viper-ex-work-buf)
(skip-chars-forward " \t")
(cond ((looking-at "|")
(forward-char 1))
((looking-at "\n")
(setq cont nil))
(t (error "`%s': %s" ex-token viper-SpuriousText)))
))
(save-excursion
(save-window-excursion
(setq viper-ex-work-buf
(get-buffer-create viper-ex-work-buf-name))
(set-buffer viper-ex-work-buf)
(skip-chars-forward " \t")
(cond ((looking-at "|")
(forward-char 1))
((looking-at "\n")
(setq cont nil))
(t (error
"`%s': %s" ex-token viper-SpuriousText)))
)))
))
((eq ex-token-type 'non-command)
(error "`%s': %s" ex-token viper-BadExCommand))
@ -674,7 +691,7 @@ reversed."
(buffer-substring (1- (point)) (mark t))))
(backward-char 1)
;; if the user didn't insert the final pattern delimiter, we're
;; at newline now. In this case, insert the initial delimiter
;; at newline now. In this case, insert the initial delimiter
;; specified in variable c
(if (eolp)
(progn
@ -944,7 +961,7 @@ reversed."
(setq ex-file (buffer-substring (point) (1- (point-max))))
(setq ex-file
;; For :e, match multiple non-white strings separated
;; by white. For others, find the first non-white string
;; by white. For others, find the first non-white string
(if (string-match
(if (string= ex-token "edit")
"[^ \t\n]+\\([ \t]+[^ \t\n]+\\)*"
@ -979,7 +996,7 @@ reversed."
))
;; Completes file name or exits minibuffer. If Ex command accepts multiple
;; Completes file name or exits minibuffer. If Ex command accepts multiple
;; file names, arranges to re-enter the minibuffer.
(defun viper-complete-filename-or-exit ()
(interactive)
@ -1056,6 +1073,7 @@ reversed."
(cond ((string= ex-token "args") (ex-args))
((string= ex-token "copy") (ex-copy nil))
((string= ex-token "cd") (ex-cd))
((string= ex-token "customize") (customize-group "viper"))
((string= ex-token "chdir") (ex-cd))
((string= ex-token "delete") (ex-delete))
((string= ex-token "edit") (ex-edit))
@ -1118,7 +1136,7 @@ reversed."
((or (string= ex-token "abbreviate")
(string= ex-token "unabbreviate"))
(error
"`%s': Vi abbrevs are obsolete. Use the more powerful Emacs abbrevs"
"`%s': Vi abbrevs are obsolete. Use the more powerful Emacs abbrevs"
ex-token))
((or (string= ex-token "list")
(string= ex-token "print")
@ -1129,18 +1147,17 @@ reversed."
(defun viper-undisplayed-files ()
(mapcar
(function
(lambda (b)
(if (null (get-buffer-window b))
(let ((f (buffer-file-name b)))
(if f f
(if ex-cycle-through-non-files
(let ((s (buffer-name b)))
(if (string= " " (substring s 0 1))
nil
s))
nil)))
nil)))
(lambda (b)
(if (null (get-buffer-window b))
(let ((f (buffer-file-name b)))
(if f f
(if ex-cycle-through-non-files
(let ((s (buffer-name b)))
(if (string= " " (substring s 0 1))
nil
s))
nil)))
nil))
(buffer-list)))
@ -1166,7 +1183,7 @@ reversed."
(princ "\n\nPress any key to continue...\n\n"))
(viper-read-event))))))
;; Ex cd command. Default directory of this buffer changes
;; Ex cd command. Default directory of this buffer changes
(defun ex-cd ()
(viper-get-ex-file)
(if (string= ex-file "")
@ -1242,9 +1259,9 @@ reversed."
;; Ex edit command
;; In Viper, `e' and `e!' behave identically. In both cases, the user is
;; In Viper, `e' and `e!' behave identically. In both cases, the user is
;; asked if current buffer should really be discarded.
;; This command can take multiple file names. It replaces the current buffer
;; This command can take multiple file names. It replaces the current buffer
;; with the first file in its argument list
(defun ex-edit (&optional file)
(if (not file)
@ -1258,7 +1275,7 @@ reversed."
;;; (if buffer-file-name
;;; (cond ((buffer-modified-p)
;;; (setq msg
;;; (format "Buffer %s is modified. Discard changes? "
;;; (format "Buffer %s is modified. Discard changes? "
;;; (buffer-name))
;;; do-edit t))
;;; ((not (verify-visited-file-modtime (current-buffer)))
@ -1278,7 +1295,10 @@ reversed."
(if (null (setq file (get-file-buffer ex-file)))
(progn
(ex-find-file ex-file)
;; this also does shell-style globbing
(ex-find-file
;; replace # and % with the previous/current file
(ex-expand-filsyms ex-file (current-buffer)))
(or (eq major-mode 'dired-mode)
(viper-change-state-to-vi))
(goto-char (point-min)))
@ -1298,12 +1318,12 @@ reversed."
;; Find-file FILESPEC if it appears to specify a single file.
;; Otherwise, assume that FILESPEC is a wildcard.
;; In this case, split it into substrings separated by newlines.
;; Each line is assumed to be a file name. find-file's each file thus obtained.
;; Each line is assumed to be a file name.
(defun ex-find-file (filespec)
(let ((nonstandard-filename-chars "[^-a-zA-Z0-9_./,~$\\]"))
(cond ((file-exists-p filespec) (find-file filespec))
((string-match nonstandard-filename-chars filespec)
(funcall ex-nontrivial-find-file-function filespec))
(mapcar 'find-file (funcall viper-glob-function filespec)))
(t (find-file filespec)))
))
@ -1371,10 +1391,11 @@ reversed."
(save-window-excursion
(setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
(set-buffer viper-ex-work-buf)
;; com-str is the command string, i.e., g/pattern/ or v/pattern'
(setq com-str (buffer-substring (1+ (point)) (1- (point-max)))))
(while marks
(goto-char (car marks))
(viper-ex com-str)
(viper-ex nil com-str)
(setq mark-count (1- mark-count))
(setq marks (cdr marks)))))
@ -1384,7 +1405,8 @@ reversed."
(setq ex-addresses (cons (point) nil)))
(push-mark (point) t)
(goto-char (car ex-addresses))
(beginning-of-line))
(beginning-of-line)
)
;; Ex line commands. COM is join, shift-right or shift-left
(defun ex-line (com)
@ -1574,7 +1596,7 @@ reversed."
;; Ex quit command
(defun ex-quit ()
;; skip "!", if it is q!. In Viper q!, w!, etc., behave as q, w, etc.
;; skip "!", if it is q!. In Viper q!, w!, etc., behave as q, w, etc.
(save-excursion
(setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
(set-buffer viper-ex-work-buf)
@ -1585,6 +1607,9 @@ reversed."
;; Ex read command
;; ex-read doesn't support wildcards, because file completion is a better
;; mechanism. We also don't support # and % (except in :r <shell-command>
;; because file history is a better mechanism.
(defun ex-read ()
(viper-get-ex-file)
(let ((point (if (null ex-addresses) (point) (car ex-addresses)))
@ -1600,8 +1625,9 @@ reversed."
(if ex-cmdfile
(progn
(setq command
(concat (ex-expand-filsyms ex-file (current-buffer))
ex-cmdfile-args))
;; replace # and % with the previous/current file
(ex-expand-filsyms (concat ex-file ex-cmdfile-args)
(current-buffer)))
(shell-command command t))
(insert-file-contents ex-file)))
(ex-fixup-history viper-last-ex-prompt ex-file ex-cmdfile-args))
@ -1632,7 +1658,7 @@ reversed."
;; Tell that `rewind' is obsolete and to use `:next count' instead
(defun ex-rewind ()
(message
"Use `:n <count>' instead. Counts are obtained from the `:args' command"))
"Use `:n <count>' instead. Counts are obtained from the `:args' command"))
;; read variable name for ex-set
@ -1846,7 +1872,7 @@ reversed."
(defun ex-shell ()
(shell))
;; Viper help. Invokes Info
;; Viper help. Invokes Info
(defun ex-help ()
(condition-case nil
(progn
@ -1863,7 +1889,7 @@ Please contact your system administrator. "
(if viper-xemacs-p "X" "")
))))))
;; Ex source command. Loads the file specified as argument or `~/.viper'
;; Ex source command. Loads the file specified as argument or `~/.viper'
(defun ex-source ()
(viper-get-ex-file)
(if (string= ex-file "")
@ -1979,6 +2005,9 @@ Please contact your system administrator. "
(viper-message-conditions conds)))))
;; Ex write command
;; ex-write doesn't support wildcards, because file completion is a better
;; mechanism. We also don't support # and %
;; because file history is a better mechanism.
(defun ex-write (q-flag)
(viper-default-ex-addresses t)
(viper-get-ex-file)
@ -1999,7 +2028,7 @@ Please contact your system administrator. "
(if (and (string= ex-file "") (not (buffer-file-name)))
(setq ex-file
(read-file-name
(format "Buffer %s isn't visiting any file. File to save in: "
(format "Buffer %s isn't visiting any file. File to save in: "
(buffer-name)))))
(setq writing-whole-file (and (= (point-min) beg) (= (point-max) end))
@ -2031,7 +2060,7 @@ Please contact your system administrator. "
;; writing to non-visited file and it already exists
(if (and file-exists (not writing-same-file)
(not (yes-or-no-p
(format "File %s exists. Overwrite? " ex-file))))
(format "File %s exists. Overwrite? " ex-file))))
(error "Quit"))
;; writing a region or whole buffer to non-visited file
(unwind-protect
@ -2041,7 +2070,9 @@ Please contact your system administrator. "
;; create temp buffer for the region
(setq temp-buf (get-buffer-create " *ex-write*"))
(set-buffer temp-buf)
(set-visited-file-name ex-file 'noquerry)
(if viper-xemacs-p
(set-visited-file-name ex-file)
(set-visited-file-name ex-file 'noquerry))
(erase-buffer)
(if (and file-exists ex-append)
(insert-file-contents ex-file))
@ -2120,6 +2151,7 @@ Please contact your system administrator. "
(skip-chars-forward " \t")
(setq command (buffer-substring (point) (point-max)))
(end-of-line))
;; replace # and % with the previous/current file
(setq command (ex-expand-filsyms command (current-buffer)))
(if (and (> (length command) 0) (string= "!" (substring command 0 1)))
(if viper-ex-last-shell-com

101
lisp/emulation/viper-init.el
View file

@ -208,8 +208,8 @@ the Ex command :map!.")
"Minor mode in effect in replace state (cw, C, and the like commands).")
;; Mode for vital things like \C-z and \C-x) This is set to t, when viper-mode
;; is invoked. So, any new buffer will have C-z defined as switch to Vi, unless
;; we switched states in this buffer
;; is invoked. So, any new buffer will have C-z defined as switch to Vi,
;; unless we switched states in this buffer
(viper-deflocalvar viper-emacs-intercept-minor-mode nil)
(viper-deflocalvar viper-emacs-local-user-minor-mode nil
@ -225,7 +225,7 @@ state.")
(viper-deflocalvar viper-emacs-kbd-minor-mode nil
"Minor mode for Vi style macros in Emacs state.
The corresponding keymap stores key bindings of Vi macros defined with
`viper-record-kbd-macro' command. There is no Ex-level command to do this
`viper-record-kbd-macro' command. There is no Ex-level command to do this
interactively.")
(viper-deflocalvar viper-emacs-state-modifier-minor-mode nil
@ -268,7 +268,7 @@ The minor mode viper-insert-diehard-minor-mode is in effect when
viper-expert-level is 1 or 2 or if viper-want-emacs-keys-in-insert is t.
Use `M-x viper-set-expert-level' to change this.")
;; Max expert level supported by Viper. This is NOT a user option.
;; Max expert level supported by Viper. This is NOT a user option.
;; It is here to make it hard for the user from resetting it.
(defconst viper-max-expert-level 5)
@ -277,9 +277,9 @@ Use `M-x viper-set-expert-level' to change this.")
;; 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.
;; primitive. In this case, use insert/emacs/vi state hooks.
(viper-deflocalvar viper-automatic-iso-accents nil "")
;; Set iso-accents-mode to ARG. Check if it is bound first
;; 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)))
@ -287,7 +287,7 @@ Use `M-x viper-set-expert-level' to change this.")
;; 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.
;; 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
@ -357,13 +357,13 @@ Use `M-x viper-set-expert-level' to change this.")
(put 'viper-undo-needs-adjustment 'permanent-local t)
;; A mark that Viper puts on buffer-undo-list. Marks the beginning of a
;; complex command that must be undone atomically. If inserted, it is
;; complex command that must be undone atomically. If inserted, it is
;; erased by viper-change-state-to-vi and viper-repeat.
(defconst viper-buffer-undo-list-mark 'viper)
(defcustom viper-keep-point-on-undo nil
"*Non-nil means not to move point while undoing commands.
This style is different from Emacs and Vi. Try it to see if
This style is different from Emacs and Vi. Try it to see if
it better fits your working style."
:type 'boolean
:tag "Preserve Position of Point After Undo"
@ -376,8 +376,9 @@ it better fits your working style."
;; This is used to pass the right Vi command key sequence to
;; viper-set-destructive-command whenever (this-command-keys) doesn't give the
;; right result. For instance, in commands like c/bla<RET>, (this-command-keys)
;; will return ^M, which invoked exit-minibuffer, while we need "c/"
;; right result. For instance, in commands like c/bla<RET>,
;; (this-command-keys) will return ^M, which invoked exit-minibuffer, while we
;; need "c/"
(defconst viper-this-command-keys nil)
;; Indicates that the current destructive command has started in replace mode.
@ -400,8 +401,8 @@ delete the text being replaced, as in standard Vi."
:type 'string
:group 'viper)
;; place to save cursor colow when switching to insert mode
(viper-deflocalvar viper-saved-cursor-color nil "")
;; internal var, used to remember the default cursor color of emacs frames
(defvar viper-vi-state-cursor-color nil)
(viper-deflocalvar viper-replace-overlay nil "")
(put 'viper-replace-overlay 'permanent-local t)
@ -423,9 +424,14 @@ is non-nil."
(and viper-xemacs-p (eq (viper-device-type) 'tty)))
"*If non-nil, Viper will always use `viper-replace-region-end-delimiter' and
`viper-replace-region-start-delimiter' to delimit replacement regions, even on
color displays. By default, the delimiters are used only on TTYs."
color displays. By default, the delimiters are used only on TTYs."
:type 'boolean
:group 'viper)
(defcustom viper-read-buffer-function 'read-buffer
"Function to use for prompting the user for a buffer name."
:type 'symbol
:group 'viper)
;; XEmacs requires glyphs
(if viper-xemacs-p
@ -456,7 +462,7 @@ color displays. By default, the delimiters are used only on TTYs."
;; mode to compensate for the inserted characters.
(viper-deflocalvar viper-replace-chars-to-delete 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
;; 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).
@ -471,7 +477,7 @@ text."
:group 'viper-misc)
;; The insertion ring.
(defvar viper-insertion-ring nil)
;; This is temp insertion ring. Used to do rotation for display purposes.
;; This is temp insertion ring. Used to do rotation for display purposes.
;; When rotation just started, it is initialized to viper-insertion-ring.
(defvar viper-temp-insertion-ring nil)
(defvar viper-last-inserted-string-from-insertion-ring "")
@ -482,14 +488,14 @@ text."
:group 'viper-misc)
;; The command ring.
(defvar viper-command-ring nil)
;; This is temp command ring. Used to do rotation for display purposes.
;; This is temp command ring. Used to do rotation for display purposes.
;; When rotation just started, it is initialized to viper-command-ring.
(defvar viper-temp-command-ring nil)
;; Fast keyseq and ESC keyseq timeouts
(defcustom viper-fast-keyseq-timeout 200
"*Key sequence separated by no more than this many milliseconds is viewed as a Vi-style macro, if such a macro is defined.
Setting this too high may slow down your typing. Setting this value too low
Setting this too high may slow down your typing. Setting this value too low
will make it hard to use Vi-stile timeout macros."
:type 'integer
:group 'viper-misc)
@ -497,7 +503,7 @@ will make it hard to use Vi-stile timeout macros."
(defcustom viper-ESC-keyseq-timeout (if (viper-window-display-p)
0 viper-fast-keyseq-timeout)
"*Key sequence beginning with ESC and separated by no more than this many milliseconds is considered to be generated by a keyboard function key.
Setting this too high may slow down switching from insert to vi state. Setting
Setting this too high may slow down switching from insert to vi state. Setting
this value too low will make it impossible to use function keys in insert mode
on a dumb terminal."
:type 'integer
@ -533,7 +539,7 @@ This is a buffer-local variable."
Currently, this only electrifies auto-indentation, making it appropriate to the
mode of the buffer.
This means that auto-indentation will depart from standard Vi and will indent
appropriate to the mode of the buffer. This is especially useful for editing
appropriate to the mode of the buffer. This is especially useful for editing
programs and LaTeX documents."
:type 'boolean
:group 'viper)
@ -565,17 +571,17 @@ to a new place after repeating previous Vi command."
;; back to viper-pre-command-point.
;; The reason this is needed is because dabbrev-expand (and possibly
;; others) may jump to before the insertion point, delete something and
;; then reinsert a bigger piece. For instance: bla^blo
;; then reinsert a bigger piece. For instance: bla^blo
;; If dabbrev-expand is called after `blo' and ^ undicates viper-insert-point,
;; then point jumps to the beginning of `blo'. If expansion is found, `blablo'
;; is deleted, and we have |^, where | denotes point. Next, dabbrev-expand
;; then point jumps to the beginning of `blo'. If expansion is found, `blablo'
;; is deleted, and we have |^, where | denotes point. Next, dabbrev-expand
;; will insert the expansion, and we get: blablo^
;; Whatever we insert next goes before the ^, i.e., before the
;; viper-insert-point marker. So, Viper will think that nothing was
;; inserted. Remembering the orig position of the marker circumvents the
;; viper-insert-point marker. So, Viper will think that nothing was
;; inserted. Remembering the orig position of the marker circumvents the
;; problem.
;; We don't know of any command, except dabbrev-expand, that has the same
;; problem. However, the same trick can be used if such a command is
;; problem. However, the same trick can be used if such a command is
;; discovered later.
;;
(viper-deflocalvar viper-pre-command-point nil)
@ -588,7 +594,7 @@ to a new place after repeating previous Vi command."
(defvar viper-last-replace-region "")
;; Remember com point as a marker.
;; This is a local marker. Should be moved with `viper-move-marker-locally'
;; This is a local marker. Should be moved with `viper-move-marker-locally'
(viper-deflocalvar viper-com-point nil)
;; If non-nil, the value is a list (M-COM VAL COM REG inserted-text cmd-keys)
@ -666,7 +672,7 @@ negative number."
:group 'viper-search)
(defcustom viper-re-replace t
"*If t, do regexp replace. nil means do string replace."
"*If t, do regexp replace. nil means do string replace."
:type 'boolean
:tag "Regexp Replace"
:group 'viper-search)
@ -689,7 +695,7 @@ If nil, these commands cross line boundaries."
`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
@ -710,7 +716,7 @@ If nil, the cursor will move backwards without deleting anything."
:group 'viper)
(defcustom viper-buffer-search-char nil
"*Key used for buffer-searching. Must be a character type, e.g., ?g."
"*Key used for buffer-searching. Must be a character type, e.g., ?g."
:type '(choice (const nil) character)
:group 'viper-search)
@ -744,7 +750,7 @@ Related buffers can be cycled through via :R and :P commands."
"^\\\\[sb][a-z]*{.*}\\s-*$\\|" ; latex
"^@node\\|@table\\|^@m?enu\\|^@itemize\\|^@if\\|" ; texinfo
"^.+:-") ; prolog
"*Regexps for Headings. Used by \[\[ and \]\].")
"*Regexps for Headings. Used by \[\[ and \]\].")
(defvar viper-heading-end
(concat "^}\\|" ; C/C++
@ -752,7 +758,7 @@ Related buffers can be cycled through via :R and :P commands."
"^@end \\|" ; texinfo
")\n\n[ \t\n]*\\|" ; lisp
"\\.\\s-*$") ; prolog
"*Regexps to end Headings/Sections. Used by \[\].")
"*Regexps to end Headings/Sections. Used by \[\].")
;; These two vars control the interaction of jumps performed by ' and `.
@ -781,7 +787,7 @@ Related buffers can be cycled through via :R and :P commands."
(defvar viper-shell-history nil)
;; Last shell command. There are two of these, one for Ex (in viper-ex)
;; Last shell command. There are two of these, one for Ex (in viper-ex)
;; and one for Vi.
;; Last shell command executed with ! command.
@ -806,10 +812,10 @@ Related buffers can be cycled through via :R and :P commands."
(t (:underline t :stipple "gray3")))
"*Face used to flash out the search pattern."
:group 'viper-highlighting)
;; An internal variable. Viper takes the face from here.
;; An internal variable. Viper takes the face from here.
(defvar viper-search-face 'viper-search-face
"Face used to flash out the search pattern.
DO NOT CHANGE this variable. Instead, use the customization widget
DO NOT CHANGE this variable. Instead, use the customization widget
to customize the actual face object `viper-search-face'
this variable represents.")
(viper-hide-face 'viper-search-face)
@ -820,10 +826,10 @@ this variable represents.")
(t (:underline t :stipple "gray3")))
"*Face for highlighting replace regions on a window display."
:group 'viper-highlighting)
;; An internal variable. Viper takes the face from here.
;; An internal variable. Viper takes the face from here.
(defvar viper-replace-overlay-face 'viper-replace-overlay-face
"Face for highlighting replace regions on a window display.
DO NOT CHANGE this variable. Instead, use the customization widget
DO NOT CHANGE this variable. Instead, use the customization widget
to customize the actual face object `viper-replace-overlay-face'
this variable represents.")
(viper-hide-face 'viper-replace-overlay-face)
@ -834,10 +840,10 @@ this variable represents.")
(t (:bold t)))
"Face used in the Minibuffer when it is in Emacs state."
:group 'viper-highlighting)
;; An internal variable. Viper takes the face from here.
;; An internal variable. Viper takes the face from here.
(defvar viper-minibuffer-emacs-face 'viper-minibuffer-emacs-face
"Face used in the Minibuffer when it is in Emacs state.
DO NOT CHANGE this variable. Instead, use the customization widget
DO NOT CHANGE this variable. Instead, use the customization widget
to customize the actual face object `viper-minibuffer-emacs-face'
this variable represents.")
(viper-hide-face 'viper-minibuffer-emacs-face)
@ -848,10 +854,10 @@ this variable represents.")
(t (:italic t)))
"Face used in the Minibuffer when it is in Insert state."
:group 'viper-highlighting)
;; An internal variable. Viper takes the face from here.
;; An internal variable. Viper takes the face from here.
(defvar viper-minibuffer-insert-face 'viper-minibuffer-insert-face
"Face used in the Minibuffer when it is in Insert state.
DO NOT CHANGE this variable. Instead, use the customization widget
DO NOT CHANGE this variable. Instead, use the customization widget
to customize the actual face object `viper-minibuffer-insert-face'
this variable represents.")
(viper-hide-face 'viper-minibuffer-insert-face)
@ -862,10 +868,10 @@ this variable represents.")
(t (:inverse-video t)))
"Face used in the Minibuffer when it is in Vi state."
:group 'viper-highlighting)
;; An internal variable. Viper takes the face from here.
;; An internal variable. Viper takes the face from here.
(defvar viper-minibuffer-vi-face 'viper-minibuffer-vi-face
"Face used in the Minibuffer when it is in Vi state.
DO NOT CHANGE this variable. Instead, use the customization widget
DO NOT CHANGE this variable. Instead, use the customization widget
to customize the actual face object `viper-minibuffer-vi-face'
this variable represents.")
(viper-hide-face 'viper-minibuffer-vi-face)
@ -890,6 +896,14 @@ this variable represents.")
:type 'string
:group 'viper-misc)
(defcustom viper-change-notification-threshold 1
"Notify the user when this many lines or characters have been deleted/yanked.
For line-deleting/yanking commands (like `dd', `yy'), the value denotes the
number of lines. For character-based commands (such as `x', `dw', etc.), the
value refers to the number of characters affected."
:type 'integer
:group 'viper-misc)
;; Minibuffer
(defcustom viper-vi-style-in-minibuffer t
@ -900,6 +914,7 @@ Should be set in `~/.viper' file."
;; overlay used in the minibuffer to indicate which state it is in
(viper-deflocalvar viper-minibuffer-overlay nil)
(put 'viper-minibuffer-overlay 'permanent-local t)
;; Hook, specific to Viper, which is run just *before* exiting the minibuffer.
;; This is needed because beginning with Emacs 19.26, the standard

57
lisp/emulation/viper-keym.el
View file

@ -74,7 +74,7 @@ Full Vi compatibility is not recommended for power use of Viper."
(defcustom viper-no-multiple-ESC t
"*If true, multiple ESC in Vi mode will cause bell to ring.
This is set to t on a windowing terminal and to 'twice on a dumb
terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this
terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this
enables cursor keys and is generally more convenient, as terminals usually
don't have a convenient Meta key.
Setting viper-no-multiple-ESC to nil will allow as many multiple ESC,
@ -104,7 +104,7 @@ as is allowed by the major mode in effect."
"Keymap for user-defined local bindings.
Useful for changing bindings such as ZZ in certain major modes.
For instance, in letter-mode, one may want to bind ZZ to
mh-send-letter. In a newsreader such as gnus, tin, or rn, ZZ could be bound
mh-send-letter. In a newsreader such as gnus, tin, or rn, ZZ could be bound
to save-buffers-kill-emacs then post article, etc.")
(put 'viper-vi-local-user-map 'permanent-local t)
@ -121,7 +121,7 @@ This map is global, shared by all buffers.")
(defvar viper-vi-diehard-map (make-sparse-keymap)
"This keymap is in use when the user asks Viper to simulate Vi very closely.
This happens when viper-expert-level is 1 or 2. See viper-set-expert-level.")
This happens when viper-expert-level is 1 or 2. See viper-set-expert-level.")
(viper-deflocalvar viper-insert-local-user-map (make-sparse-keymap)
@ -136,8 +136,8 @@ This happens when viper-expert-level is 1 or 2. See viper-set-expert-level.")
(defvar viper-insert-diehard-map (make-keymap)
"Map used when user wants vi-style keys in insert mode.
Most of the Emacs keys are suppressed. This map overshadows
viper-insert-basic-map. Not recommended, except for novice users.")
Most of the Emacs keys are suppressed. This map overshadows
viper-insert-basic-map. Not recommended, except for novice users.")
(defvar viper-insert-kbd-map (make-sparse-keymap)
"This keymap keeps VI-style kbd macros for insert mode.")
@ -159,7 +159,7 @@ viper-insert-basic-map. Not recommended, except for novice users.")
(defvar viper-empty-keymap (make-sparse-keymap))
;; This was the main Vi mode in old versions of VIP which may have been
;; extensively used by VIP users. We declare it as a global var
;; extensively used by VIP users. We declare it as a global var
;; and, after .viper is loaded, we add this keymap to viper-vi-basic-map.
(defvar viper-mode-map (make-sparse-keymap))
@ -185,17 +185,17 @@ viper-insert-basic-map. Not recommended, except for novice users.")
(defvar viper-emacs-state-modifier-alist nil)
;; Tells viper-add-local-keys to create a new viper-vi-local-user-map for new
;; buffers. Not a user option.
;; buffers. Not a user option.
(viper-deflocalvar viper-need-new-vi-local-map t "")
(put 'viper-need-new-vi-local-map 'permanent-local t)
;; Tells viper-add-local-keys to create a new viper-insert-local-user-map for
;; new buffers. Not a user option.
;; new buffers. Not a user option.
(viper-deflocalvar viper-need-new-insert-local-map t "")
(put 'viper-need-new-insert-local-map 'permanent-local t)
;; Tells viper-add-local-keys to create a new viper-emacs-local-user-map for
;; new buffers. Not a user option.
;; new buffers. Not a user option.
(viper-deflocalvar viper-need-new-emacs-local-map t "")
(put 'viper-need-new-emacs-local-map 'permanent-local t)
@ -260,8 +260,8 @@ viper-insert-basic-map. Not recommended, except for novice users.")
;; Vi keymaps
(define-key viper-vi-basic-map "\C-^"
(function (lambda () (interactive) (viper-ex "e#"))))
(define-key viper-vi-basic-map "\C-^" (lambda ()
(interactive) (viper-ex nil "e#")))
(define-key viper-vi-basic-map "\C-b" 'viper-scroll-screen-back)
(define-key viper-vi-basic-map "\C-d" 'viper-scroll-up)
(define-key viper-vi-basic-map "\C-e" 'viper-scroll-up-one)
@ -272,7 +272,7 @@ viper-insert-basic-map. Not recommended, except for novice users.")
(define-key viper-vi-basic-map "\C-s" 'viper-isearch-forward)
(define-key viper-vi-basic-map "\C-r" 'viper-isearch-backward)
(define-key viper-vi-basic-map "\C-c/" 'viper-toggle-search-style)
(define-key viper-vi-basic-map "\C-cg" 'viper-info-on-file)
(define-key viper-vi-basic-map "\C-c\C-g" 'viper-info-on-file)
(define-key viper-vi-basic-map "\C-c\M-p" 'viper-prev-destructive-command)
(define-key viper-vi-basic-map "\C-c\M-n" 'viper-next-destructive-command)
@ -284,8 +284,8 @@ viper-insert-basic-map. Not recommended, except for novice users.")
(define-key viper-vi-basic-map "#" 'viper-command-argument)
(define-key viper-vi-basic-map "$" 'viper-goto-eol)
(define-key viper-vi-basic-map "%" 'viper-paren-match)
(define-key viper-vi-basic-map "&"
(function (lambda () (interactive) (viper-ex "&"))))
(define-key viper-vi-basic-map "&" (lambda ()
(interactive) (viper-ex nil "&")))
(define-key viper-vi-basic-map "'" 'viper-goto-mark-and-skip-white)
(define-key viper-vi-basic-map "(" 'viper-backward-sentence)
(define-key viper-vi-basic-map ")" 'viper-forward-sentence)
@ -390,7 +390,7 @@ viper-insert-basic-map. Not recommended, except for novice users.")
(define-key viper-vi-basic-map "\C-?" 'viper-backward-char)
(define-key viper-vi-basic-map "_" 'viper-nil)
;;; This is viper-vi-diehard-map. Used when viper-vi-diehard-minor-mode is on.
;;; This is viper-vi-diehard-map. Used when viper-vi-diehard-minor-mode is on.
(define-key viper-vi-diehard-map "\C-a" 'viper-nil)
(define-key viper-vi-diehard-map "\C-c" 'viper-nil)
@ -484,7 +484,7 @@ Usage:
map viper-emacs-local-user-map))
(t
(error
"Invalid state in viper-add-local-keys: %S. Valid states: vi-state, insert-state or emacs-state" state)))
"Invalid state in viper-add-local-keys: %S. Valid states: vi-state, insert-state or emacs-state" state)))
(viper-modify-keymap map alist)
(viper-normalize-minor-mode-map-alist)
@ -510,9 +510,9 @@ sanity."
If the default for a major mode is emacs-state, then modifications to this
major mode may not take effect until the buffer switches state to Vi,
Insert or Emacs. If this happens, add viper-change-state-to-emacs to this
major mode's hook. If no such hook exists, you may have to put an advice on
the function that invokes the major mode. See viper-set-hooks for hints.
Insert or Emacs. If this happens, add viper-change-state-to-emacs to this
major mode's hook. If no such hook exists, you may have to put an advice on
the function that invokes the major mode. See viper-set-hooks for hints.
The above needs not to be done for major modes that come up in Vi or Insert
state by default.
@ -529,7 +529,7 @@ Arguments: (major-mode viper-state keymap)"
;; Normalization usually doesn't help here, since one needs to
;; normalize in the actual buffer where changes to the keymap are
;; to take place. However, it doesn't hurt, and it helps whenever this
;; to take place. However, it doesn't hurt, and it helps whenever this
;; function is actually called from within the affected buffer.
(viper-normalize-minor-mode-map-alist)
@ -611,22 +611,17 @@ Arguments: (major-mode viper-state keymap)"
;;; Keymap utils
(defun viper-add-keymap (mapsrc mapdst)
"Add contents of mapsrc to mapdst. It is assumed that mapsrc is sparse."
"Add contents of mapsrc to mapdst. It is assumed that mapsrc is sparse."
(if viper-xemacs-p
(map-keymap (function (lambda (key binding)
(define-key mapdst key binding)))
(map-keymap (lambda (key binding) (define-key mapdst key binding))
mapsrc)
(mapcar
(function (lambda (p)
(define-key mapdst (vector (car p)) (cdr p))
))
(cdr mapsrc))))
(mapcar (lambda (p) (define-key mapdst (vector (car p)) (cdr p)))
(cdr mapsrc))))
(defun viper-modify-keymap (map alist)
"Modifies MAP with bindings specified in the ALIST. The alist has the
"Modifies MAP with bindings specified in the ALIST. The alist has the
form ((key . function) (key . function) ... )."
(mapcar (function (lambda (p)
(define-key map (eval (car p)) (cdr p))))
(mapcar (lambda (p) (define-key map (eval (car p)) (cdr p)))
alist))

89
lisp/emulation/viper-macs.el
View file

@ -75,10 +75,10 @@
(defcustom viper-repeat-from-history-key 'f12
"Prefix key for accessing previously typed Vi commands.
The previous command is accessible, as usual, via `.'. The command before this
The previous command is accessible, as usual, via `.'. The command before this
can be invoked as `<this key> 1', and the command before that, and the command
before that one is accessible as `<this key> 2'.
The notation for these keys is borrowed from XEmacs. Basically,
The notation for these keys is borrowed from XEmacs. Basically,
a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g.,
`(meta control f1)'."
:type 'sexp
@ -113,7 +113,7 @@ a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g.,
(define-key viper-vi-intercept-map "\C-x)" 'viper-end-mapping-kbd-macro)
(define-key viper-insert-intercept-map "\C-x)" 'viper-end-mapping-kbd-macro)
(define-key viper-emacs-intercept-map "\C-x)" 'viper-end-mapping-kbd-macro)
(message "Mapping %S in %s state. Hit `C-x )' to complete the mapping"
(message "Mapping %S in %s state. Hit `C-x )' to complete the mapping"
(viper-display-macro macro-name)
(if ins "Insert" "Vi")))
))
@ -159,7 +159,7 @@ a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g.,
;; We expect macro-name to be a vector, a string, or a quoted string.
;; In the second case, it will emerge as a symbol when read from
;; the above read-from-string. So we need to convert it into a string
;; the above read-from-string. So we need to convert it into a string
(if macro-name
(cond ((vectorp macro-name) nil)
((stringp macro-name)
@ -322,14 +322,14 @@ a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g.,
;;; Recording, unrecording, executing
;; accepts as macro names: strings and vectors.
;; Accepts as macro names: strings and vectors.
;; strings must be strings of characters; vectors must be vectors of keys
;; in canonic form. the canonic form is essentially the form used in XEmacs
;; in canonic form. The canonic form is essentially the form used in XEmacs
(defun viper-record-kbd-macro (macro-name state macro-body &optional scope)
"Record a Vi macro. Can be used in `.viper' file to define permanent macros.
MACRO-NAME is a string of characters or a vector of keys. STATE is
either `vi-state' or `insert-state'. It specifies the Viper state in which to
define the macro. MACRO-BODY is a string that represents the keyboard macro.
"Record a Vi macro. Can be used in `.viper' file to define permanent macros.
MACRO-NAME is a string of characters or a vector of keys. STATE is
either `vi-state' or `insert-state'. It specifies the Viper state in which to
define the macro. MACRO-BODY is a string that represents the keyboard macro.
Optional SCOPE says whether the macro should be global \(t\), mode-specific
\(a major-mode symbol\), or buffer-specific \(buffer name, a string\).
If SCOPE is nil, the user is asked to specify the scope."
@ -354,8 +354,9 @@ If SCOPE is nil, the user is asked to specify the scope."
(if (= (length macro-name) 0)
(error "Can't map an empty macro name"))
;; Macro-name is usually a vector. However, command history or macros
;; recorded in ~/.viper may be recorded as strings. So, convert to vectors.
;; Macro-name is usually a vector. However, command history or macros
;; recorded in ~/.viper may be recorded as strings. So, convert to
;; vectors.
(setq macro-name (viper-fixup-macro macro-name))
(if (viper-char-array-p macro-name)
(setq macro-name (viper-char-array-to-macro macro-name)))
@ -481,11 +482,11 @@ If SCOPE is nil, the user is asked to specify the scope."
;; macro name must be a vector of viper-style keys
(defun viper-unrecord-kbd-macro (macro-name state)
"Delete macro MACRO-NAME from Viper STATE.
MACRO-NAME must be a vector of viper-style keys. This command is used by Viper
MACRO-NAME must be a vector of viper-style keys. This command is used by Viper
internally, but the user can also use it in ~/.viper to delete pre-defined
macros supplied with Viper. The best way to avoid mistakes in macro names to be
passed to this function is to use viper-describe-kbd-macros and copy the name
from there."
macros supplied with Viper. The best way to avoid mistakes in macro names to
be passed to this function is to use viper-describe-kbd-macros and copy the
name from there."
(let* (state-name keymap
(macro-alist-var
(cond ((eq state 'vi-state)
@ -504,8 +505,8 @@ from there."
buf-mapping mode-mapping global-mapping
macro-pair macro-entry)
;; Macro-name is usually a vector. However, command history or macros
;; recorded in ~/.viper may appear as strings. So, convert to vectors.
;; Macro-name is usually a vector. However, command history or macros
;; recorded in ~/.viper may appear as strings. So, convert to vectors.
(setq macro-name (viper-fixup-macro macro-name))
(if (viper-char-array-p macro-name)
(setq macro-name (viper-char-array-to-macro macro-name)))
@ -564,7 +565,7 @@ from there."
))
;; Check if MACRO-ALIST has an entry for a macro name starting with
;; CHAR. If not, this indicates that the binding for this char
;; CHAR. If not, this indicates that the binding for this char
;; in viper-vi/insert-kbd-map can be released.
(defun viper-can-release-key (char macro-alist)
(let ((lis macro-alist)
@ -627,7 +628,7 @@ from there."
(viper-set-unread-command-events event-seq)
;; if the user typed arg, then use it if prefix arg is not set by
;; some other command (setting prefix arg can happen if we do, say,
;; 2dw and there is a macro starting with 2. Then control will go to
;; 2dw and there is a macro starting with 2. Then control will go to
;; this routine
(or prefix-arg (setq prefix-arg count))
(setq command (key-binding (read-key-sequence nil)))
@ -681,8 +682,7 @@ from there."
(let ((converted-seq (viper-events-to-macro seq)))
(eval (cons 'or
(mapcar
(function (lambda (elt)
(viper-prefix-subseq-p converted-seq elt)))
(lambda (elt) (viper-prefix-subseq-p converted-seq elt))
(viper-this-buffer-macros alist))))))
;; whether SEQ1 is a prefix of SEQ2
@ -704,9 +704,7 @@ from there."
(setq len (apply 'min (mapcar 'length seqs))))
(while (< idx len)
(if (eval (cons 'and
(mapcar (function (lambda (s)
(equal (elt first idx)
(elt s idx))))
(mapcar (lambda (s) (equal (elt first idx) (elt s idx)))
rest)))
(setq pref (vconcat pref (vector (elt first idx)))))
(setq idx (1+ idx)))
@ -714,9 +712,7 @@ from there."
;; get all sequences that match PREFIX from a given A-LIST
(defun viper-extract-matching-alist-members (pref alist)
(delq nil (mapcar (function (lambda (elt)
(if (viper-prefix-subseq-p pref elt)
elt)))
(delq nil (mapcar (lambda (elt) (if (viper-prefix-subseq-p pref elt) elt))
(viper-this-buffer-macros alist))))
(defun viper-do-sequence-completion (seq alist compl-message)
@ -781,18 +777,17 @@ from there."
(defun viper-this-buffer-macros (macro-alist)
(let (candidates)
(setq candidates
(mapcar (function
(lambda (elt)
(if (or (viper-kbd-buf-definition elt)
(viper-kbd-mode-definition elt)
(viper-kbd-global-definition elt))
(car elt))))
(mapcar (lambda (elt)
(if (or (viper-kbd-buf-definition elt)
(viper-kbd-mode-definition elt)
(viper-kbd-global-definition elt))
(car elt)))
macro-alist))
(setq candidates (delq nil candidates))))
;; if seq of Viper key symbols (representing a macro) can be converted to a
;; string--do so. Otherwise, do nothing.
;; string--do so. Otherwise, do nothing.
(defun viper-display-macro (macro-name-or-body)
(cond ((viper-char-symbol-sequence-p macro-name-or-body)
(mapconcat 'symbol-name macro-name-or-body ""))
@ -804,16 +799,15 @@ from there."
;; Viper's macro, which is a vector of the form
;; [ desc desc ... ]
;; Each desc is either a symbol of (meta symb), (shift symb), etc.
;; Here we purge events that happen to be lists. In most cases, these events
;; Here we purge events that happen to be lists. In most cases, these events
;; got into a macro definition unintentionally; say, when the user moves mouse
;; during a macro definition, then something like (switch-frame ...) might get
;; in. Another reason for purging lists-events is that we can't store them in
;; in. Another reason for purging lists-events is that we can't store them in
;; textual form (say, in .emacs) and then read them back.
(defun viper-events-to-macro (event-seq)
(vconcat (delq nil (mapcar (function (lambda (elt)
(if (consp elt)
nil
(viper-event-key elt))))
(vconcat (delq nil (mapcar (lambda (elt) (if (consp elt)
nil
(viper-event-key elt)))
event-seq))))
;; convert strings or arrays of characters to Viper macro form
@ -870,10 +864,9 @@ from there."
(sequencep vec)
(eval
(cons 'and
(mapcar
(function (lambda (elt)
(and (symbolp elt) (= (length (symbol-name elt)) 1))))
vec)))))
(mapcar (lambda (elt)
(and (symbolp elt) (= (length (symbol-name elt)) 1)))
vec)))))
;; Check if vec is a vector of key-press events representing characters
@ -886,7 +879,7 @@ from there."
;;; Reading fast key sequences
;; Assuming that CHAR was the first character in a fast succession of key
;; strokes, read the rest. Return the vector of keys that was entered in
;; strokes, read the rest. Return the vector of keys that was entered in
;; this fast succession of key strokes.
;; A fast keysequence is one that is terminated by a pause longer than
;; viper-fast-keyseq-timeout.
@ -907,10 +900,10 @@ from there."
;; sets register to last-kbd-macro carefully.
(defun viper-set-register-macro (reg)
(if (get-register reg)
(if (y-or-n-p "Register contains data. Overwrite? ")
(if (y-or-n-p "Register contains data. Overwrite? ")
()
(error
"Macro not saved in register. Can still be invoked via `C-x e'")))
"Macro not saved in register. Can still be invoked via `C-x e'")))
(set-register reg last-kbd-macro))
(defun viper-register-macro (count)

97
lisp/emulation/viper-mous.el
View file

@ -57,7 +57,7 @@
;; Variable used for catching the switch-frame event.
;; If non-nil, indicates that previous-frame should be the selected
;; one. Used by viper-mouse-click-get-word. Not a user option.
;; one. Used by viper-mouse-click-get-word. Not a user option.
(defvar viper-frame-of-focus nil)
;; Frame that was selected before the switch-frame event.
@ -68,7 +68,7 @@
Takes two parameters: a COUNT, indicating how many words to return,
and CLICK-COUNT, telling whether this is the first click, a double-click,
or a tripple-click."
:type 'boolean
:type 'symbol
:group 'viper-mouse)
;; time interval in millisecond within which successive clicks are
@ -150,13 +150,13 @@ If CLICK-COUNT is 1, `word' is a word in Vi sense.
If CLICK-COUNT is 2,then `word' is a Word in Vi sense.
If the character clicked on is a non-separator and is non-alphanumeric but
is adjacent to an alphanumeric symbol, then it is considered alphanumeric
for the purpose of this command. If this character has a matching
for the purpose of this command. If this character has a matching
character, such as `\(' is a match for `\)', then the matching character is
also considered alphanumeric.
For convenience, in Lisp modes, `-' is considered alphanumeric.
If CLICK-COUNT is 3 or more, returns the line clicked on with leading and
trailing space and tabs removed. In that case, the first argument, COUNT,
trailing space and tabs removed. In that case, the first argument, COUNT,
is ignored."
(let ((modifiers "_")
beg skip-flag result
@ -228,7 +228,7 @@ is ignored."
(defun viper-mouse-click-get-word (click count click-count)
"Returns word surrounding the position of a mouse click.
Click may be in another window. Current window and buffer isn't changed.
Click may be in another window. Current window and buffer isn't changed.
On single or double click, returns the word as determined by
`viper-surrounding-word-function'."
@ -261,11 +261,12 @@ See `viper-surrounding-word' for the definition of a word in this case."
(interactive "e\nP")
(if viper-frame-of-focus ;; to handle clicks in another frame
(select-frame viper-frame-of-focus))
(if (or (not (eq (key-binding viper-mouse-down-insert-key-parsed)
'viper-mouse-catch-frame-switch))
(not (eq (key-binding viper-mouse-up-insert-key-parsed)
'viper-mouse-click-insert-word))
(and viper-xemacs-p (not (event-over-text-area-p click))))
(if (save-excursion
(or (not (eq (key-binding viper-mouse-down-insert-key-parsed)
'viper-mouse-catch-frame-switch))
(not (eq (key-binding viper-mouse-up-insert-key-parsed)
'viper-mouse-click-insert-word))
(and viper-xemacs-p (not (event-over-text-area-p click)))))
() ; do nothing, if binding isn't right or not over text
;; turn arg into a number
(cond ((integerp arg) nil)
@ -303,42 +304,56 @@ See `viper-surrounding-word' for the definition of a word in this case."
(viper-set-unread-command-events interrupting-event))
)))))
;; arg is an event. accepts symbols and numbers, too
;; Arg is an event. Accepts symbols and numbers, too
(defun viper-mouse-event-p (event)
(if (eventp event)
(string-match "\\(mouse-\\|frame\\|screen\\|track\\)"
(prin1-to-string (viper-event-key event)))))
;; XEmacs has no double-click events. So, we must simulate.
;; XEmacs has no double-click events. So, we must simulate.
;; So, we have to simulate event-click-count.
(defun viper-event-click-count (click)
(if viper-xemacs-p
(progn
;; if more than 1 second
(if (> (- (event-timestamp click) viper-last-click-event-timestamp)
viper-multiclick-timeout)
(setq viper-current-click-count 0))
(setq viper-last-click-event-timestamp (event-timestamp click)
viper-current-click-count (1+ viper-current-click-count)))
(viper-event-click-count-xemacs click)
(event-click-count click)))
;; kind of semaphore for updating viper-current-click-count
(defvar viper-counting-clicks-p nil)
(defun viper-event-click-count-xemacs (click)
(let ((time-delta (- (event-timestamp click)
viper-last-click-event-timestamp))
inhibit-quit)
(while viper-counting-clicks-p
(ignore))
(setq viper-counting-clicks-p t)
(if (> time-delta viper-multiclick-timeout)
(setq viper-current-click-count 0))
(discard-input)
(setq viper-current-click-count (1+ viper-current-click-count)
viper-last-click-event-timestamp (event-timestamp click))
(setq viper-counting-clicks-p nil)
(if (viper-sit-for-short viper-multiclick-timeout t)
viper-current-click-count
0)
))
(defun viper-mouse-click-search-word (click arg)
"Find the word clicked or double-clicked on. Word may be in another window.
"Find the word clicked or double-clicked on. Word may be in another window.
With prefix argument, N, search for N-th occurrence.
This command must be bound to a mouse click. The double-click action of the
This command must be bound to a mouse click. The double-click action of the
same button must not be bound \(or it must be bound to the same function\).
See `viper-surrounding-word' for the details on what constitutes a word for
this command."
(interactive "e\nP")
(if viper-frame-of-focus ;; to handle clicks in another frame
(select-frame viper-frame-of-focus))
(if (or (not (eq (key-binding viper-mouse-down-search-key-parsed)
'viper-mouse-catch-frame-switch))
(not (eq (key-binding viper-mouse-up-search-key-parsed)
'viper-mouse-click-search-word))
(and viper-xemacs-p (not (event-over-text-area-p click))))
(if (save-excursion
(or (not (eq (key-binding viper-mouse-down-search-key-parsed)
'viper-mouse-catch-frame-switch))
(not (eq (key-binding viper-mouse-up-search-key-parsed)
'viper-mouse-click-search-word))
(and viper-xemacs-p (not (event-over-text-area-p click)))))
() ; do nothing, if binding isn't right or not over text
(let ((previous-search-string viper-s-string)
click-word click-count)
@ -353,10 +368,10 @@ this command."
(viper-read-event)
(viper-mouse-event-p last-input-event)))
(progn ; interrupted wait
(setq viper-global-prefix-argument
(or viper-global-prefix-argument arg))
;; remember command that was before the multiclick
(setq this-command last-command)
(setq viper-global-prefix-argument (or viper-global-prefix-argument
arg)
;; remember command that was before the multiclick
this-command last-command)
;; make sure we counted this event---needed for XEmacs only
(viper-event-click-count click))
;; uninterrupted wait
@ -423,7 +438,7 @@ this command."
(message "`%s': String not found in %s"
viper-s-string (buffer-name (current-buffer)))
(message
"`%s': Last occurrence in %s. Back to beginning of search"
"`%s': Last occurrence in %s. Back to beginning of search"
click-word (buffer-name (current-buffer)))
(setq arg 1) ;; to terminate the loop
(sit-for 2))
@ -437,7 +452,7 @@ this command."
(defun viper-mouse-catch-frame-switch (event arg)
"Catch the event of switching frame.
Usually is bound to a `down-mouse' event to work properly. See sample
Usually is bound to a `down-mouse' event to work properly. See sample
bindings in the Viper manual."
(interactive "e\nP")
(setq viper-frame-of-focus nil)
@ -448,19 +463,19 @@ bindings in the Viper manual."
;; make Emacs forget that it executed viper-mouse-catch-frame-switch
(setq this-command last-command))
;; Called just before switching frames. Saves the old selected frame.
;; Called just before switching frames. Saves the old selected frame.
;; Sets last-command to handle-switch-frame (this is done automatically in
;; Emacs.
;; The semantics of switching frames is different in Emacs and XEmacs.
;; In Emacs, if you select-frame A while mouse is over frame B and then
;; start typing, input goes to frame B, which becomes selected.
;; In XEmacs, input will go to frame A. This may be a bug in one of the
;; In XEmacs, input will go to frame A. This may be a bug in one of the
;; Emacsen, but also may be a design decision.
;; Also, in Emacs sending input to frame B generates handle-switch-frame
;; event, while in XEmacs it doesn't.
;; All this accounts for the difference in the behavior of
;; viper-mouse-click-* commands when you click in a frame other than the one
;; that was the last to receive input. In Emacs, focus will be in frame A
;; that was the last to receive input. In Emacs, focus will be in frame A
;; until you do something other than viper-mouse-click-* command.
;; In XEmacs, you have to manually select frame B (with the mouse click) in
;; order to shift focus to frame B.
@ -471,7 +486,7 @@ bindings in the Viper manual."
;; The key is of the form (MODIFIER ... BUTTON-NUMBER)
;; Converts into a valid mouse button spec for the appropriate version of
;; Emacs. EVENT-TYPE is either `up' or `down'. Up returns button-up key; down
;; Emacs. EVENT-TYPE is either `up' or `down'. Up returns button-up key; down
;; returns button-down key.
(defun viper-parse-mouse-key (key-var event-type)
(let ((key (eval key-var))
@ -555,14 +570,14 @@ bindings in the Viper manual."
(not (eq (key-binding viper-mouse-up-search-key-parsed)
'viper-mouse-click-search-word)))
(message
"%S already bound to a mouse event. Viper mouse-search feature disabled"
"%S already bound to a mouse event. Viper mouse-search feature disabled"
viper-mouse-up-search-key-parsed))
((and (null force)
(key-binding viper-mouse-down-search-key-parsed)
(not (eq (key-binding viper-mouse-down-search-key-parsed)
'viper-mouse-catch-frame-switch)))
(message
"%S already bound to a mouse event. Viper mouse-search feature disabled"
"%S already bound to a mouse event. Viper mouse-search feature disabled"
viper-mouse-down-search-key-parsed))
(t
(global-set-key viper-mouse-up-search-key-parsed
@ -584,14 +599,14 @@ bindings in the Viper manual."
(not (eq (key-binding viper-mouse-up-insert-key-parsed)
'viper-mouse-click-insert-word)))
(message
"%S already bound to a mouse event. Viper mouse-insert feature disabled"
"%S already bound to a mouse event. Viper mouse-insert feature disabled"
viper-mouse-up-insert-key-parsed))
((and (null force)
(key-binding viper-mouse-down-insert-key-parsed)
(not (eq (key-binding viper-mouse-down-insert-key-parsed)
'viper-mouse-catch-frame-switch)))
(message
"%S already bound to a mouse event. Viper mouse-insert feature disabled"
"%S already bound to a mouse event. Viper mouse-insert feature disabled"
viper-mouse-down-insert-key-parsed))
(t
(global-set-key viper-mouse-up-insert-key-parsed

180
lisp/emulation/viper-util.el
View file

@ -114,7 +114,7 @@
;; OS/2
(cond ((eq (viper-device-type) 'pm)
(fset 'viper-color-defined-p
(function (lambda (color) (assoc color pm-color-alist))))))
(lambda (color) (assoc color pm-color-alist)))))
;; cursor colors
@ -125,20 +125,48 @@
(modify-frame-parameters
(selected-frame) (list (cons 'cursor-color new-color)))))
(defun viper-save-cursor-color ()
;; By default, saves current frame cursor color in the
;; viper-saved-cursor-color-in-replace-mode property of viper-replace-overlay
(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)
(not (string= color viper-replace-overlay-cursor-color)))
(viper-overlay-put viper-replace-overlay 'viper-cursor-color color)))))
(modify-frame-parameters
(selected-frame)
(list
(cons
(if (eq before-which-mode 'before-replace-mode)
'viper-saved-cursor-color-in-replace-mode
'viper-saved-cursor-color-in-insert-mode)
color)))
))))
;; restore cursor color from replace overlay
(defsubst viper-restore-cursor-color-after-replace ()
(viper-change-cursor-color
(viper-overlay-get viper-replace-overlay 'viper-cursor-color)))
(defsubst viper-restore-cursor-color-after-insert ()
(viper-change-cursor-color viper-saved-cursor-color))
(defsubst viper-get-saved-cursor-color-in-replace-mode ()
(or
(funcall
(if viper-emacs-p 'frame-parameter 'frame-property)
(selected-frame)
'viper-saved-cursor-color-in-replace-mode)
viper-vi-state-cursor-color))
(defsubst viper-get-saved-cursor-color-in-insert-mode ()
(or
(funcall
(if viper-emacs-p 'frame-parameter 'frame-property)
(selected-frame)
'viper-saved-cursor-color-in-insert-mode)
viper-vi-state-cursor-color))
;; restore cursor color from replace overlay
(defun viper-restore-cursor-color(after-which-mode)
(if (viper-overlay-p viper-replace-overlay)
(viper-change-cursor-color
(if (eq after-which-mode 'after-replace-mode)
(viper-get-saved-cursor-color-in-replace-mode)
(viper-get-saved-cursor-color-in-insert-mode))
)))
;; Check the current version against the major and minor version numbers
@ -148,7 +176,7 @@
;; emacs-minor-version are defined. Otherwise, for Emacs/XEmacs 19, if the
;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value
;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be
;; incorrect. However, this gives correct result in our cases, since we are
;; incorrect. However, this gives correct result in our cases, since we are
;; testing for sufficiently high Emacs versions.
(defun viper-check-version (op major minor &optional type-of-emacs)
(if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version))
@ -177,9 +205,9 @@
;; Return line position.
;; If pos is 'start then returns position of line start.
;; If pos is 'end, returns line end. If pos is 'mid, returns line center.
;; If pos is 'end, returns line end. If pos is 'mid, returns line center.
;; Pos = 'indent returns beginning of indentation.
;; Otherwise, returns point. Current point is not moved in any case."
;; Otherwise, returns point. Current point is not moved in any case."
(defun viper-line-pos (pos)
(let ((cur-pos (point))
(result))
@ -198,7 +226,7 @@
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,
;; 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)
@ -256,7 +284,7 @@
(setq alst (cdr alst)))
lst))
;; Filter ALIST using REGEXP. Return alist whose elements match the regexp.
;; Filter ALIST using REGEXP. Return alist whose elements match the regexp.
(defun viper-filter-alist (regexp alst)
(interactive "s x")
(let ((outalst) (inalst alst))
@ -266,7 +294,7 @@
(setq inalst (cdr inalst)))
outalst))
;; Filter LIST using REGEXP. Return list whose elements match the regexp.
;; Filter LIST using REGEXP. Return list whose elements match the regexp.
(defun viper-filter-list (regexp lst)
(interactive "s x")
(let ((outlst) (inlst lst))
@ -294,15 +322,11 @@
(nconc lis1 lis2)))
;;; Support for :e and file globbing
;;; Support for :e, :r, :w file globbing
(defun viper-ex-nontrivial-find-file-unix (filespec)
"Glob the file spec and visit all files matching the spec.
This function is designed to work under Unix. It may also work under VMS.
Users who prefer other types of shells should write their own version of this
function and set the variable `ex-nontrivial-find-file-function'
appropriately."
;; Glob the file spec.
;; This function is designed to work under Unix. It might also work under VMS.
(defun viper-glob-unix-files (filespec)
(let ((gshell
(cond (ex-unix-type-shell shell-file-name)
((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VAX VMS
@ -313,7 +337,7 @@ appropriately."
))
(command (cond (viper-ms-style-os-p (format "\"ls -1 -d %s\"" filespec))
(t (format "ls -1 -d %s" filespec))))
file-list status)
status)
(save-excursion
(set-buffer (get-buffer-create viper-ex-tmp-buf-name))
(erase-buffer)
@ -340,27 +364,7 @@ appropriately."
(buffer-substring (point) (viper-line-pos 'end)))
))
(goto-char (point-min))
(setq file-list (viper-get-filenames-from-buffer 'one-per-line)))
(mapcar 'find-file file-list)
))
(defun viper-ex-nontrivial-find-file-ms (filespec)
"Glob the file spec and visit all files matching the spec.
This function is designed to work under MS type systems, such as NT, W95, and
DOS. It may also work under OS/2.
The users of Unix-type shells should be able to use
`viper-ex-nontrivial-find-file-unix', making it into the value of the variable
`ex-nontrivial-find-file-function'. If this doesn't work, the user may have
to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
(save-excursion
(set-buffer (get-buffer-create viper-ex-tmp-buf-name))
(erase-buffer)
(insert filespec)
(goto-char (point-min))
(mapcar 'find-file
(viper-glob-ms-windows-files (viper-get-filenames-from-buffer)))
(viper-get-filenames-from-buffer 'one-per-line))
))
@ -410,29 +414,34 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
;; glob windows files
;; LIST is expected to be in reverse order
(defun viper-glob-ms-windows-files (list)
(let ((tmp list)
(case-fold-search t)
tmp2)
(while tmp
(setq tmp2 (cons (directory-files
;; the directory part
(or (file-name-directory (car tmp))
"")
t ; return full names
;; the regexp part: globs the file names
(concat "^"
(viper-wildcard-to-regexp
(file-name-nondirectory (car tmp)))
"$"))
tmp2))
(setq tmp (cdr tmp)))
(reverse (apply 'append tmp2))))
(defun viper-glob-mswindows-files (filespec)
(let ((case-fold-search t)
tmp tmp2)
(save-excursion
(set-buffer (get-buffer-create viper-ex-tmp-buf-name))
(erase-buffer)
(insert filespec)
(goto-char (point-min))
(setq tmp (viper-get-filenames-from-buffer))
(while tmp
(setq tmp2 (cons (directory-files
;; the directory part
(or (file-name-directory (car tmp))
"")
t ; return full names
;; the regexp part: globs the file names
(concat "^"
(viper-wildcard-to-regexp
(file-name-nondirectory (car tmp)))
"$"))
tmp2))
(setq tmp (cdr tmp)))
(reverse (apply 'append tmp2)))))
;;; Insertion ring
;; Rotate RING's index. DIRection can be positive or negative.
;; Rotate RING's index. DIRection can be positive or negative.
(defun viper-ring-rotate1 (ring dir)
(if (and (ring-p ring) (> (ring-length ring) 0))
(progn
@ -460,7 +469,7 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
(if (and (ring-p ring) (> (ring-length ring) 0))
(aref (cdr (cdr ring)) (mod (- (car ring) 1 n) (ring-length ring)))))
;; push item onto ring. the second argument is a ring-variable, not value.
;; Push item onto ring. The second argument is a ring-variable, not value.
(defun viper-push-onto-ring (item ring-var)
(or (ring-p (eval ring-var))
(set ring-var (make-ring (eval (intern (format "%S-size" ring-var))))))
@ -470,7 +479,7 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
;; Since viper-set-destructive-command checks if we are inside
;; viper-repeat, we don't check whether this-command-keys is a `.'. The
;; cmd viper-repeat makes a call to the current function only if `.' is
;; executing a command from the command history. It doesn't call the
;; executing a command from the command history. It doesn't call the
;; push-onto-ring function if `.' is simply repeating the last
;; destructive command. We only check for ESC (which happens when we do
;; insert with a prefix argument, or if this-command-keys doesn't give
@ -594,7 +603,7 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
(message "")))
))
;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that
;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that
;; match this pattern.
(defun viper-save-string-in-file (string custom-file &optional pattern)
(let ((buf (find-file-noselect (substitute-in-file-name custom-file))))
@ -647,8 +656,11 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
(defsubst viper-file-checked-in-p (file)
(and (vc-backend file)
(and (featurep 'vc-hooks)
;; CVS files are considered not checked in
(not (memq (vc-backend file) '(nil CVS)))
(not (vc-locking-user file))))
;; checkout if visited file is checked in
(defun viper-maybe-checkout (buf)
(let ((file (expand-file-name (buffer-file-name buf)))
@ -657,7 +669,7 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
(or (beep 1) t)
(y-or-n-p
(format
"File %s is checked in. Check it out? "
"File %s is checked in. Check it out? "
(viper-abbreviate-file-name file))))
(with-current-buffer buf
(command-execute checkout-function)))))
@ -711,7 +723,7 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
(if (viper-has-face-support-p)
(viper-overlay-put
viper-replace-overlay 'face viper-replace-overlay-face))
(viper-save-cursor-color)
(viper-save-cursor-color 'before-replace-mode)
(viper-change-cursor-color viper-replace-overlay-cursor-color)
)
@ -726,8 +738,8 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
(defun viper-hide-replace-overlay ()
(viper-set-replace-overlay-glyphs nil nil)
(viper-restore-cursor-color-after-replace)
(viper-restore-cursor-color-after-insert)
(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)))
@ -786,7 +798,7 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
;; XEmacs requires addl argument
(abbreviate-file-name file t)))
;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg
;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg
;; in sit-for, so this function smoothes out the differences.
(defsubst viper-sit-for-short (val &optional nodisp)
(if viper-xemacs-p
@ -817,10 +829,11 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
;; is the same as (mark t).
(defsubst viper-set-mark-if-necessary ()
(setq mark-ring (delete (viper-mark-marker) mark-ring))
(set-mark-command nil))
(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
;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless
;; the user explicitly wants highlighting, e.g., by hitting '' or ``
(defun viper-deactivate-mark ()
(if viper-xemacs-p
@ -870,7 +883,7 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
))
;; This function lets function-key-map convert key sequences into logical
;; keys. This does a better job than viper-read-event when it comes to kbd
;; keys. This does a better job than viper-read-event when it comes to kbd
;; macros, since it enables certain macros to be shared between X and TTY modes
;; by correctly mapping key sequences for Left/Right/... (one an ascii
;; terminal) into logical keys left, right, etc.
@ -908,7 +921,7 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
(t
;; Emacs doesn't handle capital letters correctly, since
;; \S-a isn't considered the same as A (it behaves as
;; plain `a' instead). So we take care of this here
;; plain `a' instead). So we take care of this here
(cond ((and (viper-characterp event) (<= ?A event) (<= event ?Z))
(setq mod nil
event event))
@ -985,8 +998,8 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
;; Args can be a sequence of events, a string, or a Viper macro. Will try to
;; convert events to keys and, if all keys are regular printable
;; characters, will return a string. Otherwise, will return a string
;; representing a vector of converted events. If the input was a Viper macro,
;; characters, will return a string. Otherwise, will return a string
;; representing a vector of converted events. If the input was a Viper macro,
;; will return a string that represents this macro as a vector.
(defun viper-array-to-string (event-seq)
(let (temp temp2)
@ -1010,8 +1023,7 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
(defun viper-key-press-events-to-chars (events)
(mapconcat (if viper-emacs-p
'char-to-string
(function
(lambda (elt) (char-to-string (event-to-character elt)))))
(lambda (elt) (char-to-string (event-to-character elt))))
events
""))
@ -1055,7 +1067,7 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
(defun viper-setup-master-buffer (&rest other-files-or-buffers)
"Set up the current buffer as a master buffer.
Arguments become related buffers. This function should normally be used in
Arguments become related buffers. This function should normally be used in
the `Local variables' section of a file."
(setq viper-related-files-and-buffers-ring
(make-ring (1+ (length other-files-or-buffers))))
@ -1117,11 +1129,11 @@ Usually contains ` ', linefeed, TAB or formfeed.")
))
;; SYMBOL is used because customize requires it, but it is ignored, unless it
;; is `nil'. If nil, use setq.
;; 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,
buffer. If called non-interactively, preferably via the customization widget,
sets the default value."
(interactive)
(or value

192
lisp/emulation/viper.el
View file

@ -1,4 +1,4 @@
;;; viper.el --- A full-featured Vi emulator for Emacs.
;;; viper.el --- A full-featured Vi emulator for GNU Emacs and XEmacs,
;; a VI Plan for Emacs Rescue,
;; and a venomous VI PERil.
;; Viper Is also a Package for Emacs Rebels.
@ -6,9 +6,9 @@
;; Keywords: emulations
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
;; Copyright (C) 1994 -- 1999 Free Software Foundation, Inc.
(defconst viper-version "3.03 (Polyglot) of May 21, 1998"
(defconst viper-version "3.08 of October 31, 1999"
"The current version of Viper")
;; This file is part of GNU Emacs.
@ -30,11 +30,11 @@
;;; Commentary:
;; Viper is a full-featured Vi emulator for Emacs and XEmacs. It emulates and
;; Viper is a full-featured Vi emulator for Emacs and XEmacs. It emulates and
;; improves upon the standard features of Vi and, at the same time, allows
;; full access to all Emacs facilities. Viper supports multiple undo,
;; file name completion, command, file, and search history and it extends
;; Vi in many other ways. Viper is highly customizable through the various
;; Vi in many other ways. Viper is highly customizable through the various
;; hooks, user variables, and keymaps. It is implemented as a collection
;; of minor modes and it is designed to provide full access to all Emacs
;; major and minor modes.
@ -44,11 +44,11 @@
;; Viper is a new name for a package formerly known as VIP-19,
;; which was a successor of VIP version 3.5 by Masahiko Sato
;; <ms@sail.stanford.edu> and VIP version 4.2 by Aamod Sane
;; <sane@cs.uiuc.edu>. Some ideas from vip 4.4.2 by Aamod Sane
;; <sane@cs.uiuc.edu>. Some ideas from vip 4.4.2 by Aamod Sane
;; were also shamelessly plagiarized.
;;
;; Viper maintains some degree of compatibility with these older
;; packages. See the documentation for customization.
;; packages. See the documentation for customization.
;;
;; The main difference between Viper and these older packages are:
;;
@ -82,9 +82,9 @@
;; 9. Viper has Vi-style keyboard macros, which enhances the similar
;; facility in the original Vi.
;; First, one can execute any Emacs command while defining a
;; macro, not just the Vi commands. Second, macros are defined in a
;; macro, not just the Vi commands. Second, macros are defined in a
;; WYSYWYG mode, using an interface to Emacs' WYSIWYG style of defining
;; macros. Third, in Viper, one can define macros that are specific to
;; macros. Third, in Viper, one can define macros that are specific to
;; a given buffer, a given major mode, or macros defined for all buffers.
;; The same macro name can have several different definitions:
;; one global, several definitions for various major modes, and
@ -110,12 +110,12 @@
;;
;; 1. Major modes.
;; In most cases, Viper handles major modes correctly, i.e., they come up
;; in the right state (either vi-state or emacs-state). For instance, text
;; in the right state (either vi-state or emacs-state). For instance, text
;; files come up in vi-state, while, say, Dired appears in emacs-state by
;; default.
;; However, some modes do not appear in the right mode in the beginning,
;; usually because they neglect to follow Emacs conventions (e.g., they don't
;; use kill-all-local-variables when they start). Some major modes
;; use kill-all-local-variables when they start). Some major modes
;; may fail to come up in emacs-state if they call hooks, such as
;; text-hook, for no good reason.
;;
@ -126,7 +126,7 @@
;; or
;; (add-hook 'your-favorite-mode 'viper-change-state-to-emacs)
;;
;; whichever applies. The right thing to do, however, is to complain to the
;; whichever applies. The right thing to do, however, is to complain to the
;; author of the respective package. (Sometimes they also neglect to equip
;; their modes with hooks, which is one more reason for complaining.)
;;
@ -148,47 +148,47 @@
;; the second, which, in turn, overshadows those done to the third, etc.
;;
;; The last viper-vi-basic-minor-mode contains most of the usual Vi bindings
;; in its edit mode. This mode provides access to all Emacs facilities.
;; in its edit mode. This mode provides access to all Emacs facilities.
;; Novice users, however, may want to set their viper-expert-level to 1
;; in their .viper file. This will enable viper-vi-diehard-minor-mode. This
;; in their .viper file. This will enable viper-vi-diehard-minor-mode. This
;; minor mode's bindings make Viper simulate the usual Vi very closely.
;; For instance, C-c will not have its standard Emacs binding
;; and so many of the goodies of Emacs are not available.
;;
;; A skilled user should set viper-expert-level to at least 3. This will
;; A skilled user should set viper-expert-level to at least 3. This will
;; enable `C-c' and many Emacs facilities will become available.
;; In this case, viper-vi-diehard-minor-mode is inactive.
;;
;; Viper gurus should have at least
;; (setq viper-expert-level 4)
;; in their ~/.viper files. This will unsuppress all Emacs keys that are not
;; in their ~/.viper files. This will unsuppress all Emacs keys that are not
;; essential for VI-style editing.
;; Pick-and-choose users may want to put
;; (setq viper-expert-level 5)
;; in ~/.viper. Viper will then leave it up to the user to set the variables
;; in ~/.viper. Viper will then leave it up to the user to set the variables
;; viper-want-* See viper-set-expert-level for details.
;;
;; The very first minor mode, viper-vi-intercept-minor-mode, is of no
;; concern for the user. It is needed to bind Viper's vital keys, such as
;; concern for the user. It is needed to bind Viper's vital keys, such as
;; ESC and C-z.
;;
;; The second mode, viper-vi-local-user-minor-mode, usually has an
;; empty keymap. However, the user can set bindings in this keymap, which
;; empty keymap. However, the user can set bindings in this keymap, which
;; will overshadow the corresponding bindings in the other two minor
;; modes. This is useful, for example, for setting up ZZ in gnus,
;; modes. This is useful, for example, for setting up ZZ in gnus,
;; rmail, mh-e, etc., to send message instead of saving it in a file.
;; Likewise, in Dired mode, you may want to bind ZN and ZP to commands
;; that would visit the next or the previous file in the Dired buffer.
;; Setting local keys is tricky, so don't do it directly. Instead, use
;; Setting local keys is tricky, so don't do it directly. Instead, use
;; viper-add-local-keys function (see its doc).
;;
;; The third minor mode, viper-vi-global-user-minor-mode, is also intended
;; for the users but, unlike viper-vi-local-user-minor-mode, its key
;; bindings are seen in all Viper buffers. This mode keys can be done
;; bindings are seen in all Viper buffers. This mode keys can be done
;; with define-key command.
;;
;; The fourth minor mode, viper-vi-kbd-minor-mode, is used by keyboard
;; macros. Users are NOT supposed to modify this keymap directly.
;; macros. Users are NOT supposed to modify this keymap directly.
;;
;; The fifth mode, viper-vi-state-modifier-minor-mode, can be used to set
;; key bindings that are visible in some major modes but not in others.
@ -212,11 +212,11 @@
;; to be changed by the user.
;;
;; The next mode, viper-insert-local-user-minor-mode, is used to customize
;; bindings in the insert state of Viper. The third mode,
;; bindings in the insert state of Viper. The third mode,
;; viper-insert-global-user-minor-mode is like
;; viper-insert-local-user-minor-mode, except that its bindings are seen in
;; all Viper buffers. As with viper-vi-local-user-minor-mode, its bindings
;; should be done via the function viper-add-local-keys. Bindings for
;; all Viper buffers. As with viper-vi-local-user-minor-mode, its bindings
;; should be done via the function viper-add-local-keys. Bindings for
;; viper-insert-global-user-minor-mode can be set with the define-key command.
;;
;; The next minor mode, viper-insert-kbd-minor-mode,
@ -229,7 +229,7 @@
;; The minor mode viper-insert-diehard-minor-mode is in effect when
;; the user wants a high degree of Vi compatibility (a bad idea, really!).
;; The last minor mode, viper-insert-basic-minor-mode, is always in effect
;; when Viper is in insert state. It binds a small number of keys needed for
;; when Viper is in insert state. It binds a small number of keys needed for
;; Viper's operation.
;;
;; Finally, Viper provides minor modes for overriding bindings set by Emacs
@ -240,24 +240,24 @@
;; viper-emacs-kbd-minor-mode
;; viper-emacs-state-modifier-minor-mode
;;
;; These minor modes are in effect when Viper is in Emacs state. The keymap
;; These minor modes are in effect when Viper is in Emacs state. The keymap
;; associated with viper-emacs-global-user-minor-mode,
;; viper-emacs-global-user-map, overrides the global and local keymaps as
;; well as the minor mode keymaps set by other modes. The keymap of
;; well as the minor mode keymaps set by other modes. The keymap of
;; viper-emacs-local-user-minor-mode, viper-emacs-local-user-map, overrides
;; everything, but it is used on a per buffer basis.
;; The keymap associated with viper-emacs-state-modifier-minor-mode
;; overrides keys on a per-major-mode basis. The mode
;; overrides keys on a per-major-mode basis. The mode
;; viper-emacs-kbd-minor-mode is used to define Vi-style macros in Emacs
;; state.
;;
;; 3. There is also one minor mode that is used when Viper is in its
;; replace-state (used for commands like cw, C, etc.). This mode is
;; replace-state (used for commands like cw, C, etc.). This mode is
;; called
;;
;; viper-replace-minor-mode
;;
;; and its keymap is viper-replace-map. Replace minor mode is always
;; and its keymap is viper-replace-map. Replace minor mode is always
;; used in conjunction with the minor modes for insert-state, and its
;; keymap overshadows the keymaps for insert minor modes.
;;
@ -265,32 +265,32 @@
;; As mentioned before, sometimes, it is convenient to have
;; buffer-specific of mode-specific key bindings in Vi and insert modes.
;; Viper provides a special function, viper-add-local-keys, to do precisely
;; this. For instance, is you need to add couple of mode-specific bindings
;; this. For instance, is you need to add couple of mode-specific bindings
;; to Insert mode, you can put
;;
;; (viper-add-local-keys 'insert-state '((key1 . func1) (key2 .func2)))
;;
;; somewhere in a hook of this major mode. If you put something like this
;; somewhere in a hook of this major mode. If you put something like this
;; in your own elisp function, this will define bindings specific to the
;; buffer that was current at the time of the call to viper-add-local-keys.
;; The only thing to make sure here is that the major mode of this buffer
;; is written according to Emacs conventions, which includes a call to
;; (kill-all-local-variables). See viper-add-local-keys for more details.
;; (kill-all-local-variables). See viper-add-local-keys for more details.
;;
;;
;; TO DO (volunteers?):
;;
;; 1. Some of the code that is inherited from VIP-3.5 is rather
;; convoluted. Instead of viper-command-argument, keymaps should bind the
;; actual commands. E.g., "dw" should be bound to a generic command
;; convoluted. Instead of viper-command-argument, keymaps should bind the
;; actual commands. E.g., "dw" should be bound to a generic command
;; viper-delete that will delete things based on the value of
;; last-command-char. This would greatly simplify the logic and the code.
;; last-command-char. This would greatly simplify the logic and the code.
;;
;; 2. Somebody should venture to write a customization package a la
;; options.el that would allow the user to change values of variables
;; that meet certain specs (e.g., match a regexp) and whose doc string
;; starts with a '*'. Then, the user should be offered to save
;; variables that were changed. This will make user's customization job
;; starts with a '*'. Then, the user should be offered to save
;; variables that were changed. This will make user's customization job
;; much easier.
;;
@ -360,7 +360,7 @@ user decide when to invoke Viper in a major mode."
(defcustom viper-mode (cond (noninteractive nil)
(t 'ask))
"To Viperize or not to Viperize.
If t, viperize emacs. If nil -- don't. If `ask', ask the user.
If t, viperize emacs. If nil -- don't. If `ask', ask the user.
This variable is used primatily when Viper is being loaded.
Must be set in `~/.emacs' before Viper is loaded.
@ -377,22 +377,27 @@ widget."
awk-mode
m4-mode
xrdb-mode
winmgr-mode
autoconf-mode
cvs-edit-mode
html-mode html-helper-mode
emacs-lisp-mode lisp-mode lisp-interaction-mode
java-mode cc-mode c-mode c++-mode
jde-mode java-mode
cc-mode c-mode c++-mode objc-mode
fortran-mode f90-mode
basic-mode
bat-mode
asm-mode
prolog-mode
flora-mode
text-mode indented-text-mode
tex-mode latex-mode bibtex-mode
completion-list-mode
compilation-mode
perl-mode
javascript-mode
@ -421,6 +426,7 @@ widget."
Info-mode
Buffer-menu-mode
compilation-mode
view-mode
vm-mode
@ -428,8 +434,8 @@ widget."
"*A list of major modes that should come up in Emacs state.
Normally, Viper would bring buffers up in Emacs state, unless the corresponding
major mode has been placed on `viper-vi-state-mode-list' or
`viper-insert-state-mode-list'. So, don't place a new mode on this list, unless
it is coming up in a wrong Viper state."
`viper-insert-state-mode-list'. So, don't place a new mode on this list,
unless it is coming up in a wrong Viper state."
:type '(repeat symbol)
:group 'viper-misc)
@ -444,10 +450,9 @@ it is coming up in a wrong Viper state."
(defun viper-apply-major-mode-modifiers (&optional symbol value)
(if symbol
(set symbol value))
(mapcar (function
(lambda (triple)
(viper-modify-major-mode
(nth 0 triple) (nth 1 triple) (eval (nth 2 triple)))))
(mapcar (lambda (triple)
(viper-modify-major-mode
(nth 0 triple) (nth 1 triple) (eval (nth 2 triple))))
viper-major-mode-modifier-list))
(defcustom viper-major-mode-modifier-list
@ -470,12 +475,12 @@ it is coming up in a wrong Viper state."
)
"List specifying how to modify the various major modes to enable some Viperisms.
The list has the structure: ((mode viper-state keymap) (mode viper-state
keymap) ...). If `mode' is on the list, the `kemap' will be made active (on the
minor-mode-map-alist) in the specified viper state.
keymap) ...). If `mode' is on the list, the `kemap' will be made active (on
the minor-mode-map-alist) in the specified viper state.
If you change this list, have to restart emacs for the change to take effect.
However, if you did the change through the customization widget, then emacs
needs to be restarted only if you deleted a triple mode-state-keymap from the
list. No need to restart emacs in case of insertion or modification of an
list. No need to restart emacs in case of insertion or modification of an
existing triple."
:type '(repeat
(list symbol
@ -493,7 +498,7 @@ existing triple."
;;;###autoload
(defun toggle-viper-mode ()
"Toggle Viper on/off.
If Viper is enabled, turn it off. Otherwise, turn it on."
If Viper is enabled, turn it off. Otherwise, turn it on."
(interactive)
(if (eq viper-mode t)
(viper-go-away)
@ -512,9 +517,11 @@ If Viper is enabled, turn it off. Otherwise, turn it on."
(setq viper-mode t)
(load-library "viper"))
(if viper-first-time ; Important check. Prevents mix-up of startup and
(progn ; expert-level msgs when viper-mode recurses
(if viper-first-time ; Important check. Prevents mix-up of startup
(progn ; and expert-level msgs when viper-mode recurses
(setq viper-first-time nil)
(setq viper-vi-state-cursor-color
(viper-get-cursor-color))
(if (not viper-inhibit-startup-message)
(save-window-excursion
(setq viper-inhibit-startup-message t)
@ -530,13 +537,13 @@ Incidentally, Viper emulates Vi under GNU Emacs 20 and XEmacs 20.
It supports all of what is good in Vi and Ex, while extending
and improving upon much of it.
1. Viper supports Vi at several levels. Level 1 is the closest to Vi,
1. Viper supports Vi at several levels. Level 1 is the closest to Vi,
level 5 provides the most flexibility to depart from many Vi conventions.
You will be asked to specify your user level in a following screen.
If you select user level 1 then the keys ^X, ^C, ^Z, and ^G will behave
as in VI, to smooth transition to Viper for the beginners. However, to
as in VI, to smooth transition to Viper for the beginners. However, to
use Emacs productively, you are advised to reach user level 3 or higher.
At user level 2 or higher, ^X and ^C have Emacs, not Vi, bindings;
@ -545,13 +552,13 @@ and improving upon much of it.
2. Vi exit functions (e.g., :wq, ZZ) work on INDIVIDUAL files -- they
do not cause Emacs to quit, except at user level 1 (for a novice).
3. ^X^C EXITS EMACS.
4. Viper supports multiple undo: `u' will undo. Typing `.' will repeat
undo. Another `u' changes direction.
4. Viper supports multiple undo: `u' will undo. Typing `.' will repeat
undo. Another `u' changes direction.
6. Emacs Meta key is `C-\\' (in all modes) or `\\ ESC' (in Vi command mode).
On a window system, the best way is to use the Meta-key on your keyboard.
7. Try \\[keyboard-quit] and \\[abort-recursive-edit] repeatedly,if
something funny happens. This would abort the current editing command.
something funny happens. This would abort the current editing command.
For more information on Viper:
@ -560,7 +567,7 @@ For more information on Viper:
c. Print the Quick Reference, found in ./etc/viperCard.dvi
To submit a bug report or to contact the author, type :submitReport in Vi
command mode. To shoo Viper away and return to pure Emacs (horror!), type:
command mode. To shoo Viper away and return to pure Emacs (horror!), type:
M-x viper-go-away
@ -606,20 +613,19 @@ This startup message appears whenever you load Viper, unless you type `y' now."
;; Remove local value in all existing buffers
;; This doesn't delocalize vars (which would have been desirable)
(defun viper-delocalize-var (symbol)
(mapcar (function (lambda (buf)
(save-excursion
(set-buffer buf)
(kill-local-variable symbol))))
(mapcar (lambda (buf) (save-excursion
(set-buffer buf)
(kill-local-variable symbol)))
(buffer-list)))
(defun viper-go-away ()
"De-Viperize Emacs.
This function tries to do as good a job as possible. However, it may undo some
user customization, unrelated to Viper. For instance, if the user advised
This function tries to do as good a job as possible. However, it may undo some
user customization, unrelated to Viper. For instance, if the user advised
`read-file-name', `describe-key', and some others, then this advice will be
undone.
It also doesn't undo some Viper settings. For instance, `minor-mode-map-alist'
It also doesn't undo some Viper settings. For instance, `minor-mode-map-alist'
remains buffer-local."
(interactive)
@ -740,24 +746,23 @@ remains buffer-local."
;; set appropriate Viper state in buffers that changed major mode
(defun set-viper-state-in-major-mode ()
(mapcar
(function
(lambda (buf)
(if (viper-buffer-live-p buf)
(with-current-buffer buf
(cond ((and (memq major-mode viper-vi-state-mode-list)
(eq viper-current-state 'emacs-state))
(viper-mode))
((memq major-mode viper-emacs-state-mode-list)
;; not checking (eq viper-current-state 'emacs-state)
;; because viper-current-state could have gotten it by
;; default. we need viper-change-state-to-emacs here to have
;; the keymaps take effect.
(viper-change-state-to-emacs))
((and (memq major-mode viper-insert-state-mode-list)
(not (eq viper-current-state 'insert-state)))
(viper-change-state-to-insert))
)) ; with-current-buffer
))) ; function
(lambda (buf)
(if (viper-buffer-live-p buf)
(with-current-buffer buf
(cond ((and (memq major-mode viper-vi-state-mode-list)
(eq viper-current-state 'emacs-state))
(viper-mode))
((memq major-mode viper-emacs-state-mode-list)
;; not checking (eq viper-current-state 'emacs-state)
;; because viper-current-state could have gotten it by
;; default. We need viper-change-state-to-emacs here to have
;; the keymaps take effect.
(viper-change-state-to-emacs))
((and (memq major-mode viper-insert-state-mode-list)
(not (eq viper-current-state 'insert-state)))
(viper-change-state-to-insert))
)) ; with-current-buffer
)) ; function
viper-new-major-mode-buffer-list)
;; clear the list of bufs that changed major mode
(setq viper-new-major-mode-buffer-list nil)
@ -817,7 +822,7 @@ remains buffer-local."
(viper-change-state-to-vi))
;; passwd.el sets up its own buffer, which turns up in Vi mode,
;; thus overriding the local map. We don't need Vi mode here.
;; thus overriding the local map. We don't need Vi mode here.
(eval-after-load
"passwd"
'(defadvice read-passwd-1 (before viper-passwd-ad activate)
@ -913,7 +918,7 @@ remains buffer-local."
;; This var is not local in Emacs, so we make it local. It must be local
;; because although the stack of minor modes can be the same for all buffers,
;; the associated *keymaps* can be different. In Viper,
;; the associated *keymaps* can be different. In Viper,
;; viper-vi-local-user-map, viper-insert-local-user-map, and others can have
;; different keymaps for different buffers. Also, the keymaps associated
;; with viper-vi/insert-state-modifier-minor-mode can be different.
@ -941,7 +946,7 @@ remains buffer-local."
(append '("" viper-mode-string) (cdr global-mode-string))))
(defadvice read-key-sequence (around viper-read-keyseq-ad activate)
"Harness to work for Viper. This advice is harmless---don't worry!"
"Harness to work for Viper. This advice is harmless---don't worry!"
(let (inhibit-quit event keyseq)
(setq keyseq ad-do-it)
(setq event (if viper-xemacs-p
@ -1078,11 +1083,11 @@ These two lines must come in the order given.
(message "")
(kill-buffer " *viper-info*")))
;; If viper-mode is t, then just continue. Viper will kick in.
;; If viper-mode is t, then just continue. Viper will kick in.
((eq viper-mode t))
;; Otherwise, it was asking Viper was not loaded through .emacs
;; In this case, it was either through M-x viper-mode or via something
;; else, like the custom widget. If Viper was loaded through
;; else, like the custom widget. If Viper was loaded through
;; M-x viper-mode, then viper will kick in anyway.
(t (setq viper-mode nil)))
@ -1094,8 +1099,8 @@ These two lines must come in the order given.
;; Get viper standard value of SYMBOL. If symbol is customized, get its
;; standard value. Otherwise, get the value saved in the alist STORAGE. If
;; Get viper standard value of SYMBOL. If symbol is customized, get its
;; standard value. Otherwise, get the value saved in the alist STORAGE. If
;; STORAGE is nil, use viper-saved-user-settings.
(defun viper-standard-value (symbol &optional storage)
(or (eval (car (get symbol 'customized-value)))
@ -1197,6 +1202,7 @@ These two lines must come in the order given.
(viper-harness-minor-mode "view-less")
(viper-harness-minor-mode "view")
(viper-harness-minor-mode "reftex")
(viper-harness-minor-mode "flyspell")
))

6
man/ChangeLog
View file

@ -1,3 +1,9 @@
1999-11-01 Michael Kifer <kifer@cs.sunysb.edu>
* ediff.texi: minor fixes.
* viper.texi: minor fixes.
1999-10-23 Dave Love <fx@gnu.org>
* autotype.texi: New file.

47
man/ediff.texi
View file

@ -217,6 +217,11 @@ multi-file patch, then a session group interface will be used and the user
will be able to patch the files selectively. @xref{Session Groups}, for
more details.
Since the patch might be in a buffer or a file, you will be asked which is
the case. To avoid this extra prompt, you can invoke this command with a
prefix argument. With an odd prefix argument, Ediff assumes the patch
is in a file; with an even argument, a buffer is assumed.
Note that @code{ediff-patch-file} will actually use the @file{patch}
utility to change the the original files on disk. This is not that
dangerous, since you will always have the original contents of the file
@ -246,6 +251,11 @@ This function would refuse to apply a multifile patch to a buffer. Use
@code{ediff-patch-file} for that (and when you want the original file to be
modified by the @file{patch} utility).
Since the patch might be in a buffer or a file, you will be asked which is
the case. To avoid this extra prompt, you can invoke this command with a
prefix argument. With an odd prefix argument, Ediff assumes the patch
is in a file; with an even argument, a buffer is assumed.
@item ediff-merge-files
@itemx ediff-merge
@findex ediff-merge-files
@ -702,7 +712,7 @@ Restores the usual Ediff window setup. This is the quickest way to resume
an Ediff session, but it works only if the control panel of that session is
visible.
@item $
@item $$
While merging with an ancestor file, Ediff is determined to reduce user's
wear and tear by saving him and her much of unproductive, repetitive
typing. If it notices that, say, file A's difference region is identical to
@ -719,7 +729,22 @@ had different ideas on how to do this.
The above command does this for you by skipping the regions where only one
of the variants clashes with the ancestor but the other variant agrees with
it. Typing @kbd{$} again undoes this setting.
it. Typing @kbd{$$} again undoes this setting.
@item $*
When merging files with large number of differences, it is sometimes
convenient to be able to skip the difference regions for which you already
decided which variant is most appropriate. Typing @kbd{$*} will accomplish
precisely this.
To be more precise, this toggles the check for whether the current merge is
identical to its default setting, as originally decided by Ediff. For
instance, if Ediff is merging according to the `combined' policy, then the
merge region is skipped over if it is different from the combination of the
regions in buffers A and B. (Warning: swapping buffers A and B will confuse
things in this respect). If the merge region is marked as `prefer-A' then
this region will be skipped if it differs from the current difference
region in buffer A, etc.
@item /
Displays the ancestor file during merges.
@ -1291,7 +1316,8 @@ the control frame.
To start Ediff with an iconified Control Panel, you should set this
variable to @code{t} and @code{ediff-prefer-long-help-message} to
@code{nil} (@pxref{Quick Help Customization}). This behavior is useful
only if the window manager is TWM or a derivative.
only if icons are allowed to accept keybord input (which depend on the
window manager and other factors).
@end table
@findex ediff-setup-windows
@ -1552,10 +1578,9 @@ faces, you can modify them when Ediff is being loaded using
ediff-current-diff-face-B))))
@end smallexample
@strong{Note:} it is not recommended to use @code{internal-get-face}
when defining Ediff's faces, since this may cause problems when there
are several frames with different font sizes. Instead, use
@code{copy-face} or @code{set/make-face-@dots{}} as shown above.
@strong{Note:} To set Ediff's faces, use only @code{copy-face} or
@code{set/make-face-@dots{}} as shown above. Emacs' low-level
face-manipulation functions should be avoided.
@node Narrowing, Refinement of Difference Regions, Highlighting Difference Regions, Customization
@section Narrowing
@ -1904,7 +1929,7 @@ Ediff lets you automatically ignore the regions where only one of the
buffers A and B disagrees with the ancestor. To do this, set the
variable @code{ediff-show-clashes-only} to non-@code{nil}.
You can toggle this feature interactively by typing @kbd{$}.
You can toggle this feature interactively by typing @kbd{$$}.
Note that this variable affects only the show next/previous difference
commands. You can still jump directly to any difference region directly
@ -2192,6 +2217,7 @@ Without them, Ediff would not be nearly as useful as it is today.
Here is a full list of contributors (I hope I didn't miss anyone):
@example
Adrian Aichner (aichner@@ecf.teradyne.com),
Steve Baur (steve@@xemacs.org),
Neal Becker (neal@@ctd.comsat.com),
E.@: Jay Berkenbilt (ejb@@ql.org),
@ -2206,6 +2232,7 @@ Scott Cummings (cummings@@adc.com),
Albert Dvornik (bert@@mit.edu),
Eric Eide (eeide@@asylum.cs.utah.edu),
Paul Eggert (eggert@@twinsun.com),
Urban Engberg (ue@@cci.dk),
Kevin Esler (esler@@ch.hp.com),
Robert Estes (estes@@ece.ucdavis.edu),
Jay Finger (jayf@@microsoft.com),
@ -2214,8 +2241,10 @@ Eric Freudenthal (freudent@@jan.ultra.nyu.edu),
Job Ganzevoort (Job.Ganzevoort@@cwi.nl),
Boris Goldowsky (boris@@cs.rochester.edu),
Allan Gottlieb (gottlieb@@allan.ultra.nyu.edu),
Aaron Gross (aaron@@bfr.co.il),
Thorbjoern Hansen (thorbjoern.hansen@@mchp.siemens.de),
Xiaoli Huang (hxl@@epic.com),
Andreas Jaeger (aj@@suse.de),
Lars Magne Ingebrigtsen (larsi@@ifi.uio.no),
Larry Gouge (larry@@itginc.com),
Karl Heuer (kwzh@@gnu.org),
@ -2223,6 +2252,7 @@ Karl Heuer (kwzh@@gnu.org),
(jaffe@@chipmunk.cita.utoronto.ca),
David Karr (dkarr@@nmo.gtegsc.com),
Norbert Kiesel (norbert@@i3.informatik.rwth-aachen.de),
Sam Steingold (sds@@goems.com),
Leigh L Klotz (klotz@@adoc.xerox.com),
Fritz Knabe (Fritz.Knabe@@ecrc.de),
Heinz Knutzen (hk@@informatik.uni-kiel.d400.de),
@ -2240,6 +2270,7 @@ Eyvind Ness (Eyvind.Ness@@hrp.no),
Ray Nickson (nickson@@cs.uq.oz.au),
David Petchey (petchey_david@@jpmorgan.com),
Benjamin Pierce (benjamin.pierce@@cl.cam.ac.uk),
Francois Pinard (pinard@@iro.umontreal.ca),
Tibor Polgar (tlp00@@spg.amdahl.com),
David Prince (dave0d@@fegs.co.uk),
Paul Raines (raines@@slac.stanford.edu),

97
man/viper.texi
View file

@ -342,6 +342,12 @@ The location of Viper customization file can be changed by setting the
variable @code{viper-custom-file-name} in @file{.emacs} @emph{prior} to loading
Viper.
The latest versions of Emacs have an interactive customization facility,
which allows you to (mostly) bypass the use of the @file{.emacs} and
@file{.viper} files. You can reach this customization
facility from within Viper's VI state by executing the Ex command
@kbd{:customize}.
Once invoked, Viper will arrange to bring up Emacs buffers in Vi state
whenever this makes sense.
@xref{Packages that Change Keymaps}, to find out when forcing Vi command state
@ -1141,7 +1147,7 @@ under the cursor. You have to turn this on in @file{.viper} either by calling
@noindent
or by setting @code{viper-buffer-search-char} to, say, @kbd{f3}:
@example
(setq viper-buffer-search-char [f3])
(setq viper-buffer-search-char ?g)
@end example
@noindent
@ -1406,9 +1412,9 @@ example is @kbd{gw} to search for the word under the cursor.
@kindex @kbd{C-]}
Quit and Abort Recursive edit. These may be necessary on occasion.
@xref{Vi State}, for a reason.
@item C-c g
@kindex @kbd{C-c g}
Hitting @kbd{C-c} followed by @kbd{g} will display the information on the
@item C-c C-g
@kindex @kbd{C-c C-g}
Hitting @kbd{C-c} followed by @kbd{C-g} will display the information on the
current buffer. This is the same as hitting @kbd{C-g} in Vi, but, as
explained above, @kbd{C-g} is needed for other purposes in Emacs.
@item C-c /
@ -1760,21 +1766,19 @@ before Viper is loaded. Note that you
have to set it as a string inside double quotes.
@item viper-spell-function 'ispell-region
Function used by the command @kbd{#c<move>} to spell.
@item ex-nontrivial-find-file-function
The value of this variable is the function used to find all files that
match a wildcard. This is usually done when the user types @kbd{:e} and
specifies a wildcard in the file name (or if the file name contains unusual
symbols (e.g., a space). Viper provides two functions for this: one for
Unix-like systems (@code{viper-ex-nontrivial-find-file-unix}) and one for
DOS, W95, and NT (@code{viper-ex-nontrivial-find-file-ms}). If the default
function doesn't quite do what you expect or if you prefer to use ``fancy''
shells, you may have to write your own version of this function and make it
into the value of @code{ex-nontrivial-find-file-function}. Use
@code{viper-ex-nontrivial-find-file-unix} and
@code{viper-ex-nontrivial-find-file-ms} as examples.
@vindex @code{ex-nontrivial-find-file-function}.
@findex @code{viper-ex-nontrivial-find-file-ms}
@findex @code{viper-ex-nontrivial-find-file-unix}
@item viper-glob-function
The value of this variable is the function symbol used to expand wildcard
symbols. This is platform-dependent. The default tries to set this variable
to work with most Unix shells, MS Windows, OS/2, etc. However, if it
doesn't work the way you expect, you should write your own.
Use @code{viper-glob-unix-files} and @code{viper-glob-mswindows-files} in
@file{viper-util.el} as examples.
This feature is used to expand wildcards in the Ex command @kbd{:e}.
Note that Viper doesn't support wildcards in the @kbd{:r} and @kbd{:w}
commands, because file completion is a better mechanism.
@findex @code{viper-glob-function}
@item ex-cycle-other-window t
If not @code{nil}, @kbd{:n} and @kbd{:b} will cycle through files in another
window, if one exists.
@ -2638,8 +2642,9 @@ menubar.
@item viper-multiclick-timeout
This variable controls the rate at which double-clicking must occur for the
purpose of mouse search and mouse insert. By default, this is set to
@code{double-click-time}.
@end table
@code{double-click-time} in Emacs and to
@code{mouse-track-multi-click-time} milliseconds in XEmacs.
@end table
@kindex @kbd{S-mouse-1}
@kindex @kbd{S-mouse-2}
@kindex @kbd{meta shift button1up}
@ -3068,8 +3073,11 @@ lines.
@end table
@cindex % (Current file)
Note that @samp{%} is used in Ex commands to mean current file. If you
want a @samp{%} in your command, it must be escaped as @samp{\%}.
Note that @samp{%} is used in Ex commands @kbd{:e} and @kbd{:r <shell-cmd>}
to mean current file. If you want a @samp{%} in your command, it must be
escaped as @samp{\%}. Note that @kbd{:w} and the regular @kbd{:r <file>}
command doesn't support the meta symbols @samp{%} and @samp{#}, because
file history is a better mechanism.
@cindex # (Previous file)
Similarly, @samp{#} expands to the previous file. The previous file is
the first file in @kbd{:args} listing. This defaults to previous window
@ -3415,6 +3423,11 @@ the Emacs mark ring.
Mark the current file and position with the specified letter.
@item m .
Set the Emacs mark (@pxref{Emacs Preliminaries}) at point.
@item m ^
Set the Emacs mark (@xref{Emacs Preliminaries}) back to where it was last
set with the @kbd{m.} command. This is useful when you set the mark with
@kbd{m.}, but then some other command (such as @kbd{L} or @kbd{G}) changes
it in a way that you didn't like.
@item m <
Set the Emacs mark at beginning of buffer.
@item m >
@ -3439,6 +3452,7 @@ Go to specified Viper mark and go to the first CHAR on line.
@kindex @kbd{m>}
@kindex @kbd{m<}
@kindex @kbd{m,}
@kindex @kbd{m^}
@findex @kbd{:mark}
@findex @kbd{:k}
@kindex @kbd{''}
@ -3907,6 +3921,11 @@ In all file handling commands, space should be typed before entering the file
name. If you need to type a modifier, such as @kbd{>>} or @kbd{!}, don't
put any space between the command and the modifier.
Note that many Ex commands, e.g., @kbd{:w}, accept command arguments. The
effect is that the command would start acting on the current region. For
instance, if the current region spans the lines 11 through 22, then if you
type @kbd{1:w} you would see @samp{:11,22w} in the minibuffer.
@table @kbd
@item :q
Quit buffer except if modified.
@ -3984,13 +4003,18 @@ Obsolete
@item :args
List files not shown anywhere with counts for next
@item :n [count] [+<cmd>] [<files>]
Edit <count> file, or edit files. The count comes from @kbd{:args}.
@item :N [count] [+<cmd>] [<files>]
Edit <count> file, or edit files. The count comes from @kbd{:args}.
@item :N [count] [+<cmd>] [<files>]
Like @kbd{:n}, but the meaning of the variable
@var{ex-cycle-other-window} is reversed.
@item :b
Switch to another buffer. If @var{ex-cycle-other-window} is @code{t},
switch in another window. Buffer completion is supported.
The variable @var{viper-read-buffer-function} controls which function is
actually used to read the buffer name. The default is @code{read-buffer},
but better alternatives are also available in Emacs (e.g.,
@code{iswitchb-read-buffer}).
@vindex @var{viper-read-buffer-function}
@item :B
Like @kbd{:b}, but the meaning of @var{ex-cycle-other-window} is reversed.
@item :<address>r <name>
@ -4110,15 +4134,20 @@ Show contents of register.
@cindex % (Current file)
Note that % is used in Ex commands to mean current file. If you want a %
in your command, it must be escaped as @samp{\%}.
@cindex % (Ex address)
However if % is the
first character, it stands as the address for the whole file.
@cindex # (Previous file)
Similarly, @samp{#} expands to the previous file. The previous file is
the first file in @kbd{:args} listing. This defaults
to the previous file in the VI sense if you have one window.@refill
The symbol @samp{%} is used in Ex shell commands to mean current file. If
you want a @samp{%} in your command, it must be escaped as @samp{\%}.
@cindex @samp{%} (Ex address)
However if @samp{%} is the first character, it stands as the address for
the whole file.
@cindex @samp{#} (Previous file)
Similarly, @samp{#} expands to the previous file. The previous file is the
first file in @kbd{:args} listing. This defaults to the previous file in
the VI sense if you have one window.@refill
Symbols @samp{%} and @samp{#} are also used in the Ex commands @kbd{:e} and
@kbd{:r <shell-cmd>}. The commands @kbd{:w} and the regular @kbd{:r
<file>} command don't support these meta symbols, because file history is a
better mechanism.
@cindex shell commands