mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 04:10:54 -08:00
Code Issues Projects Releases Wiki Activity

*** empty log message ***

Browse source
This commit is contained in:
Michael Kifer 1996-12-28 02:53:04 +00:00
parent 469b44cbf1
commit bf5d92c5e3
11 changed files with 414 additions and 112 deletions
Download patch file Download diff file Expand all files Collapse all files

33
lisp/ediff-hook.el
View file

@ -38,9 +38,24 @@
(defvar epatch-menu)
;; end pacifier
(defun ediff-xemacs-init-menus ()
(if (featurep 'menubar)
(progn
(add-menu-button
'("Tools")
["Use separate frame for Ediff control buffer"
ediff-toggle-multiframe
:style toggle
:selected (eq ediff-window-setup-function 'ediff-setup-windows-multiframe)]
"00-Browser...")
(add-menu-button
'("Tools")
["Use a toolbar with Ediff control buffer"
ediff-menu-toggle-use-toolbar
:style toggle
:selected (ediff-use-toolbar-p)]
"00-Browser...")
(add-submenu
'("Tools") ediff-menu "OO-Browser...")
(add-submenu
@ -128,6 +143,9 @@
;; define ediff-menu
(define-key menu-bar-ediff-menu [ediff-doc]
'("Ediff Manual..." . ediff-documentation))
(define-key menu-bar-ediff-menu [emultiframe]
'("Toggle separate control buffer frame..."
. ediff-toggle-multiframe))
(define-key menu-bar-ediff-menu [eregistry]
'("List Ediff Sessions..." . ediff-show-registry))
(define-key menu-bar-ediff-menu [separator-ediff-manual] '("--"))
@ -165,6 +183,9 @@
;; define merge menu
(define-key menu-bar-ediff-merge-menu [ediff-doc2]
'("Ediff Manual..." . ediff-documentation))
(define-key menu-bar-ediff-merge-menu [emultiframe2]
'("Toggle separate control buffer frame..."
. ediff-toggle-multiframe))
(define-key menu-bar-ediff-merge-menu [eregistry2]
'("List Ediff Sessions..." . ediff-show-registry))
(define-key
@ -204,6 +225,9 @@
;; define epatch menu
(define-key menu-bar-epatch-menu [ediff-doc3]
'("Ediff Manual..." . ediff-documentation))
(define-key menu-bar-epatch-menu [emultiframe3]
'("Toggle separate control buffer frame..."
. ediff-toggle-multiframe))
(define-key menu-bar-epatch-menu [eregistry3]
'("List Ediff Sessions..." . ediff-show-registry))
(define-key menu-bar-epatch-menu [separator-epatch] '("--"))
@ -310,6 +334,15 @@
"ediff"
"Show Ediff's version and last modification date."
t)
(autoload 'ediff-toggle-multiframe
"ediff-util"
"Toggle the use of separate frame for Ediff control buffer."
t)
(if (string-match "XEmacs" emacs-version)
(autoload 'ediff-toggle-use-toolbar
"ediff-tbar"
"Toggle the use of Ediff toolbar."
t))
) ; if purify-flag

19
lisp/ediff-init.el
View file

@ -62,7 +62,7 @@ that Ediff doesn't know about.")
(ediff-force-faces)
(ediff-emacs-p (memq (ediff-device-type) '(pc)))
(ediff-xemacs-p (memq (ediff-device-type) '(tty pc)))))
;; Defines SYMBOL as an advertised local variable.
;; Performs a defvar, then executes `make-variable-buffer-local' on
@ -302,13 +302,18 @@ that Ediff doesn't know about.")
(memq (or metajob ediff-metajob-name)
'(ediff-directories3 ediff-filegroups3)))
(defsubst ediff-barf-if-not-control-buffer (&optional meta-buf)
(or (eq (if meta-buf ediff-meta-buffer ediff-control-buffer)
(current-buffer))
;; with no argument, checks if we are in ediff-control-buffer
;; with argument, checks if we are in ediff-meta-buffer
(defun ediff-in-control-buffer-p (&optional meta-buf-p)
(and (boundp 'ediff-control-buffer)
(eq (if meta-buf-p ediff-meta-buffer ediff-control-buffer)
(current-buffer))))
(defsubst ediff-barf-if-not-control-buffer (&optional meta-buf-p)
(or (ediff-in-control-buffer-p meta-buf-p)
(error "%S: This command runs in Ediff Control Buffer only!"
this-command)))
;; Hook variables
(defvar ediff-before-setup-windows-hook nil
@ -588,7 +593,6 @@ appropriate symbol: `rcs', `pcl-cvs', or `generic-sc' if you so desire.")
(fset 'ediff-delete-overlay (symbol-function 'delete-extent)))
(fset 'ediff-read-event (symbol-function 'read-event))
(fset 'ediff-overlayp (symbol-function 'overlayp))
(fset 'ediff-overlayp (symbol-function 'overlayp))
(fset 'ediff-make-overlay (symbol-function 'make-overlay))
(fset 'ediff-delete-overlay (symbol-function 'delete-overlay)))
@ -831,7 +835,8 @@ appropriate symbol: `rcs', `pcl-cvs', or `generic-sc' if you so desire.")
(ediff-hide-face 'ediff-current-diff-face-Ancestor)
(or (face-differs-from-default-p 'ediff-current-diff-face-Ancestor)
(copy-face
'ediff-current-diff-face-C 'ediff-current-diff-face-Ancestor))))
'ediff-current-diff-face-C 'ediff-current-diff-face-Ancestor))
'ediff-current-diff-face-Ancestor))
"Face for highlighting the selected difference in the ancestor buffer.")
(defvar ediff-fine-diff-pixmap "gray3"

13
lisp/ediff-mult.el
View file

@ -161,6 +161,11 @@ ediff-directories, is run.")
"*Hooks run just after the registry buffer is shown.")
(defvar ediff-show-session-group-hook nil
"*Hooks run just after a session group buffer is shown.")
(defvar ediff-meta-buffer-keymap-setup-hook nil
"*Hooks run just after setting up the ediff-meta-buffer-map.
This keymap controls key bindings in the meta buffer and is a local variable.
This means that you can set different bindings for different kinds of meta
buffers.")
;; buffer holding the multi-file patch. local to the meta buffer
(ediff-defvar-local ediff-meta-patchbufer nil "")
@ -230,7 +235,9 @@ ediff-directories, is run.")
(define-key ediff-meta-buffer-map [mouse-2] ediff-meta-action-function)
(define-key ediff-meta-buffer-map [button2] ediff-meta-action-function))
(use-local-map ediff-meta-buffer-map))
(use-local-map ediff-meta-buffer-map)
;; modify ediff-meta-buffer-map here
(run-hooks 'ediff-meta-buffer-keymap-setup-hook))
(defun ediff-meta-mode ()
"This mode controls all operations on Ediff session groups.
@ -1275,6 +1282,7 @@ all marked sessions must be active."
(setq ediff-merge-store-file
(, (concat
merge-autostore-dir
"mrg_"
(file-name-nondirectory file1))))
;; make ediff-startup pass
;; ediff-control-buffer back to the meta
@ -1291,6 +1299,7 @@ all marked sessions must be active."
(setq ediff-merge-store-file
(, (concat
merge-autostore-dir
"mrg_"
(file-name-nondirectory file1))))
;; make ediff-startup pass
;; ediff-control-buffer back to the meta
@ -1306,6 +1315,7 @@ all marked sessions must be active."
(setq ediff-merge-store-file
(, (concat
merge-autostore-dir
"mrg_"
(file-name-nondirectory file1))))
;; make ediff-startup pass
;; ediff-control-buffer back to the meta
@ -1320,6 +1330,7 @@ all marked sessions must be active."
(setq ediff-merge-store-file
(, (concat
merge-autostore-dir
"mrg_"
(file-name-nondirectory file1))))
(setq ediff-meta-buffer (, (current-buffer)))
;; this arranges that ediff-startup will pass

24
lisp/ediff-ptch.el
View file

@ -462,10 +462,9 @@ Else, read patch file into a new buffer."
(setq file-name-magic-p (not (equal (file-truename true-source-filename)
(file-truename source-filename))))
;; Checkout orig file, if necessary, so that the patched file could be
;; checked back in.
(if (ediff-file-checked-in-p (buffer-file-name buf-to-patch))
(ediff-toggle-read-only buf-to-patch))
;; Checkout orig file, if necessary, so that the patched file
;; could be checked back in.
(ediff-maybe-checkout buf-to-patch)
(ediff-eval-in-buffer patch-diagnostics
(insert-buffer patch-buf)
@ -506,23 +505,28 @@ Else, read patch file into a new buffer."
Patch has failed OR the backup version of the patched file was not created by
the patch program.
A possible reason is that the values of the variables
One reason may be that the values of the variables
ediff-patch-options = %S
ediff-backup-extension = %S
ediff-backup-specs = %S
ediff-patch-options = %S
ediff-backup-extension = %S
ediff-backup-specs = %S
are not appropriate for the program specified in the variable
ediff-patch-program = %S
ediff-patch-program = %S
Another reason could be that the %S program doesn't understand
the format of the patch file you used.
See Ediff on-line manual for more details on these variables.
\(Or use a GNU-compatible patch program and stay out of trouble.\)
Type any key to continue... "
Type any key to continue...
"
ediff-patch-options
ediff-backup-extension
ediff-backup-specs
ediff-patch-program
ediff-patch-program)))
(beep 1)
(if (setq aux-wind (get-buffer-window ediff-msg-buffer))

180
lisp/ediff-util.el
View file

@ -23,10 +23,6 @@
;;; Code:
(require 'ediff-init)
(require 'ediff-help)
(require 'ediff-mult)
;; Pacify compiler and avoid the need in checking for boundp
(defvar ediff-patch-diagnostics nil)
(defvar ediff-patchbufer nil)
@ -37,6 +33,17 @@
(load-file "ediff-help.el"))))
;; end pacifier
(require 'ediff-init)
(require 'ediff-help)
(require 'ediff-mult)
;;(if ediff-xemacs-p
;; (require 'ediff-tbar)
;; (defun ediff-use-toolbar-p () nil))
;;
;; for the time being
(defun ediff-use-toolbar-p () nil)
;;; Functions
@ -489,6 +496,8 @@ to invocation.")
ediff-split-window-function
(ediff-multiframe-setup-p)
ediff-wide-display-p))
(if (not (ediff-multiframe-setup-p))
(ediff-make-bottom-toolbar)) ; checks if toolbar is requested
(goto-char (point-min))
(skip-chars-forward ediff-whitespace)))
@ -954,12 +963,13 @@ of the current buffer."
(setq toggle-ro-cmd 'toggle-read-only)
(beep 1) (beep 1)
(message
"Boy, this is risky! Better don't change this file...")
"Boy, this is risky! Don't modify this file...")
(sit-for 3)))) ; let the user see the warning
(if (and toggle-ro-cmd
(string-match "toggle-read-only" (symbol-name toggle-ro-cmd)))
(save-excursion
(save-window-excursion
(select-window (ediff-get-visible-buffer-window buf))
(command-execute toggle-ro-cmd)))
(error "Don't know how to toggle read-only in buffer %S" buf))
@ -972,33 +982,51 @@ of the current buffer."
(message "Warning: file %s is read-only"
(ediff-abbreviate-file-name file) (beep 1)))
))))
;; This is a simple-minded check for whether a file is under version control
;; and is checked out.
;; checkout if visited file is checked in
(defun ediff-maybe-checkout (buf)
(let ((file (buffer-file-name buf))
(checkout-function (key-binding "\C-x\C-q")))
(if (and (ediff-file-checked-in-p file)
(or (beep 1) t)
(y-or-n-p
(format
"File %s is under version control. Check it out? "
(ediff-abbreviate-file-name file))))
(ediff-eval-in-buffer buf
(command-execute checkout-function)))))
;; This is a simple-minded check for whether a file is under version control.
;; If file,v exists but file doesn't, this file is considered to be not checked
;; in and not checked out for the purpose of patching (since patch won't be
;; able to read such a file anyway).
;; FILE is a string representing file name
(defun ediff-file-under-version-control (file)
(let* ((filedir (file-name-directory file))
(file-nondir (file-name-nondirectory file))
(trial (concat file-nondir ",v"))
(full-trial (concat filedir trial))
(full-rcs-trial (concat filedir "RCS/" trial)))
(and (stringp file)
(file-exists-p file)
(or
(and
(file-exists-p full-trial)
;; in FAT FS, `file,v' and `file' may turn out to be the same!
;; don't be fooled by this!
(not (equal (file-attributes file)
(file-attributes full-trial))))
;; check if a version is in RCS/ directory
(file-exists-p full-rcs-trial)))
))
(defun ediff-file-checked-out-p (file)
(and (stringp file)
(file-exists-p file)
(file-writable-p file)
(or
(file-exists-p (concat file ",v"))
(file-exists-p (concat (file-name-directory file)
"RCS/"
(file-name-nondirectory file)
",v")))
))
(and (ediff-file-under-version-control file)
(file-writable-p file)))
(defun ediff-file-checked-in-p (file)
(and (stringp file)
(file-exists-p file)
(not (file-writable-p file))
(or
(file-exists-p (concat file ",v"))
(file-exists-p (concat "RCS/" file ",v")))
))
(and (ediff-file-under-version-control file)
(not (file-writable-p file))))
(defun ediff-swap-buffers ()
"Rotate the display of buffers A, B, and C."
@ -1132,21 +1160,56 @@ This is especially useful when comparing buffers side-by-side."
(setq ediff-window-B nil) ; force update of window config
(ediff-recenter 'no-rehighlight)))))
;;;###autoload
(defun ediff-toggle-multiframe ()
"Switch from the multiframe display to single-frame display and back.
For a permanent change, set the variable `ediff-window-setup-function',
which see."
(interactive)
(ediff-barf-if-not-control-buffer)
(let (set-func)
(or (ediff-window-display-p)
(error "%sEmacs is not running as a window application"
(if ediff-emacs-p "" "X")))
(setq set-func (if (ediff-in-control-buffer-p) 'setq 'setq-default))
(cond ((eq ediff-window-setup-function 'ediff-setup-windows-multiframe)
(setq ediff-window-setup-function 'ediff-setup-windows-plain))
(eval
(list
set-func
'ediff-window-setup-function ''ediff-setup-windows-plain)))
((eq ediff-window-setup-function 'ediff-setup-windows-plain)
(setq ediff-window-setup-function 'ediff-setup-windows-multiframe)))
(setq ediff-window-B nil)
(ediff-recenter 'no-rehighlight))
(if (ediff-in-control-buffer-p)
(ediff-kill-bottom-toolbar))
(eval
(list
set-func
'ediff-window-setup-function ''ediff-setup-windows-multiframe))))
(if (ediff-in-control-buffer-p)
(progn
(setq ediff-window-B nil)
(ediff-recenter 'no-rehighlight)))))
;; if was using toolbar, kill it
(defun ediff-kill-bottom-toolbar ()
;; Using ctl-buffer or ediff-control-window for LOCALE does not
;; work properly in XEmacs 19.14: we have to use
;;(selected-frame).
;; The problem with this is that any previous bottom-toolbar
;; will not re-appear after our cleanup here. Is there a way
;; to do "push" and "pop" toolbars ? --marcpa
(if (ediff-use-toolbar-p)
(progn
(set-specifier bottom-toolbar (list (selected-frame) nil))
(set-specifier bottom-toolbar-visible-p (list (selected-frame) nil)))))
;; if wants to use toolbar, make it
(defun ediff-make-bottom-toolbar ()
(if (ediff-use-toolbar-p)
(progn
(set-specifier bottom-toolbar (list (selected-frame) ediff-toolbar))
(set-specifier bottom-toolbar-visible-p (list (selected-frame) t))
(set-specifier bottom-toolbar-height (list (selected-frame) 34)))))
;; Merging
@ -2262,6 +2325,10 @@ temporarily reverses the meaning of this variable."
(if (and (ediff-window-display-p) (frame-live-p ctl-frame))
(delete-frame ctl-frame))
;; Hide bottom toolbar. --marcpa
(if (not (ediff-multiframe-setup-p))
(ediff-kill-bottom-toolbar))
(ediff-kill-buffer-carefully ctl-buf)
(delete-other-windows)
@ -2343,8 +2410,9 @@ only if this merge job is part of a group, i.e., was invoked from within
(read-file-name "Save the result of the merge in: "))
(ediff-write-merge-buffer-then-kill
ediff-buffer-C merge-store-file))
((ediff-eval-in-buffer ediff-meta-buffer
(ediff-merge-metajob))
((and (ediff-buffer-live-p ediff-meta-buffer)
(ediff-eval-in-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.
@ -2837,6 +2905,8 @@ Ediff Control Panel to restore highlighting."
(interactive)
(let ((answer "")
(possibilities (list ?A ?B ?C))
(zmacs-regions t)
quit-now
begA begB endA endB bufA bufB)
(cond ((ediff-merge-job)
@ -2849,7 +2919,7 @@ Ediff Control Panel to restore highlighting."
nil)
((equal answer ""))
(t (beep 1)
(message "Valid answers are A or B")
(message "Valid values are A or B")
(sit-for 2)
t))
(let ((cursor-in-echo-area t))
@ -2866,7 +2936,7 @@ Ediff Control Panel to restore highlighting."
((equal answer ""))
(t (beep 1)
(message
"Valid answers are %s"
"Valid values are %s"
(mapconcat 'char-to-string possibilities " or "))
(sit-for 2)
t))
@ -2884,7 +2954,7 @@ Ediff Control Panel to restore highlighting."
((equal answer ""))
(t (beep 1)
(message
"Valid answers are %s"
"Valid values are %s"
(mapconcat 'char-to-string possibilities " or "))
(sit-for 2)
t))
@ -2897,6 +2967,8 @@ Ediff Control Panel to restore highlighting."
bufB ediff-buffer-B)))
(ediff-eval-in-buffer bufA
(or (mark t)
(error "You forgot to specify a region in buffer %s" (buffer-name)))
(setq begA (region-beginning)
endA (region-end))
(goto-char begA)
@ -2907,6 +2979,8 @@ Ediff Control Panel to restore highlighting."
(or (eobp) (forward-char)) ; include the newline char
(setq endA (point)))
(ediff-eval-in-buffer bufB
(or (mark t)
(error "You forgot to specify a region in buffer %s" (buffer-name)))
(setq begB (region-beginning)
endB (region-end))
(goto-char begB)
@ -2921,6 +2995,32 @@ Ediff Control Panel to restore highlighting."
ediff-current-difference 'unselect-only)
(ediff-paint-background-regions 'unhighlight)
(ediff-eval-in-buffer bufA
(goto-char begA)
(set-mark endA)
(narrow-to-region begA endA)
;; (ediff-activate-mark)
)
;; (sit-for 0)
(ediff-eval-in-buffer bufB
(goto-char begB)
(set-mark endB)
(narrow-to-region begB endB)
;; (ediff-activate-mark)
)
;; (sit-for 0)
(or (y-or-n-p
"Please check the selected regions. Continue? ")
(setq quit-now t))
(ediff-eval-in-buffer bufA
(widen))
(ediff-eval-in-buffer bufB
(widen))
(if quit-now
(error "Thank you. Come back another day..."))
(ediff-regions-internal
bufA begA endA bufB begB endB
nil ; startup hook
@ -2930,26 +3030,20 @@ Ediff Control Panel to restore highlighting."
;; will simplify it in due time, when emacs acquires before/after strings
(defun ediff-remove-flags-from-buffer (buffer overlay)
(ediff-eval-in-buffer buffer
(let ((inhibit-read-only t))
(if ediff-xemacs-p
(ediff-overlay-put overlay 'begin-glyph nil)
;; before-string is not yet implemented in emacs.
;; when it will be, I will be able to delete much of the rest of
;; this function
(ediff-overlay-put overlay 'before-string nil))
(if ediff-xemacs-p
(ediff-overlay-put overlay 'end-glyph nil)
;; after-string is not yet implemented in emacs.
(ediff-overlay-put overlay 'after-string nil))
)))
;; will simplify it in due time, when emacs acquires before/after strings
(defun ediff-place-flags-in-buffer (buf-type buffer ctl-buffer diff)
(ediff-eval-in-buffer buffer
(ediff-place-flags-in-buffer1 buf-type ctl-buffer diff)))
@ -3266,6 +3360,10 @@ Mail anyway? (y or n) ")
(if ediff-xemacs-p
(zmacs-deactivate-region)
(deactivate-mark)))
(defun ediff-activate-mark ()
(if ediff-emacs-p
(setq mark-active t)
(zmacs-activate-region)))
(cond ((fboundp 'nuke-selective-display)
;; XEmacs 19.12 has nuke-selective-display

10
lisp/ediff-wind.el
View file

@ -24,6 +24,9 @@
;;; Code:
(require 'ediff-init)
(if ediff-xemacs-p
(require 'ediff-tbar)
(defun ediff-compute-toolbar-width () 0))
;; Compiler pacifier
(defvar icon-title-format)
@ -853,7 +856,8 @@ into icons, regardless of the window manager.")
;; 1 more line for the modeline
(setq lines (1+ (count-lines (point-min) (point-max)))
fheight lines
fwidth (+ (ediff-help-message-line-length) 1)
fwidth (max (+ (ediff-help-message-line-length) 2)
(ediff-compute-toolbar-width))
adjusted-parameters (append (list
;; possibly change surrogate minibuffer
(cons 'minibuffer
@ -876,9 +880,6 @@ into icons, regardless of the window manager.")
(set-specifier bottom-toolbar-height (list ctl-frame 0))
(set-specifier left-toolbar-width (list ctl-frame 0))
(set-specifier right-toolbar-width (list ctl-frame 0))
;; XEmacs needed a redisplay, as it had trouble setting
;; height correctly otherwise.
;;(sit-for 0)
))
;; Under OS/2 (emx) we have to call modify frame parameters twice, in order
@ -893,6 +894,7 @@ into icons, regardless of the window manager.")
(modify-frame-parameters ctl-frame adjusted-parameters)
(make-frame-visible ctl-frame)
(ediff-make-bottom-toolbar) ; no effect if the toolbar is not requested
;; 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

4
lisp/ediff.el
View file

@ -566,7 +566,7 @@ can be used to filter out certain file names."
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."
(interactive
(let* ((dir-A (ediff-get-default-directory-name)))
(let ((dir-A (ediff-get-default-directory-name)))
(list (ediff-read-file-name
"Directory to merge with revisions:" dir-A nil)
(read-string "Filter through regular expression: "
@ -585,7 +585,7 @@ names. Only the files that are under revision control are taken into account."
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."
(interactive
(let* ((dir-A (ediff-get-default-directory-name)))
(let ((dir-A (ediff-get-default-directory-name)))
(list (ediff-read-file-name
"Directory to merge with revisions and ancestors:" dir-A nil)
(read-string "Filter through regular expression: "

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

@ -398,6 +398,7 @@ Useful in some modes, such as Gnus, MH, etc.")
(defvar vip-dired-modifier-map (make-sparse-keymap)
"This map modifies Dired behavior.")
(define-key vip-dired-modifier-map ":" 'vip-ex)
(define-key vip-dired-modifier-map "/" 'vip-search-forward)

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

@ -354,8 +354,10 @@ this command."
vip-mouse-click-search-limit nil)))
(goto-char (match-beginning 0))
(message "Searching for: %s" vip-s-string)
(if (<= arg 1)
(vip-flash-search-pattern))
(if (<= arg 1) ; found the right occurrence of the pattern
(progn
(vip-adjust-window)
(vip-flash-search-pattern)))
)
(error (beep 1)
(if (or (not (string= click-word previous-search-string))

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

@ -249,9 +249,12 @@ that Viper doesn't know about.")
(not (string= color vip-replace-overlay-cursor-color)))
(vip-overlay-put vip-replace-overlay 'vip-cursor-color color)))))
(defsubst vip-restore-cursor-color ()
;; restore cursor color from replace overlay
(defsubst vip-restore-cursor-color-after-replace ()
(vip-change-cursor-color
(vip-overlay-get vip-replace-overlay 'vip-cursor-color)))
(defsubst vip-restore-cursor-color-after-insert ()
(vip-change-cursor-color vip-saved-cursor-color))
;; Check the current version against the major and minor version numbers
@ -789,7 +792,8 @@ to write a custom function, similar to `vip-ex-nontrivial-find-file-unix'."
(defsubst vip-hide-replace-overlay ()
(vip-set-replace-overlay-glyphs nil nil)
(vip-restore-cursor-color)
(vip-restore-cursor-color-after-replace)
(vip-restore-cursor-color-after-insert)
(if (vip-has-face-support-p)
(vip-overlay-put vip-replace-overlay 'face nil)))

228
lisp/emulation/viper.el
View file

@ -479,7 +479,11 @@ it better fits your working style.")
(defvar vip-replace-overlay-cursor-color "Red"
"*Cursor color to use in Replace state")
(defvar vip-insert-state-cursor-color nil
"Cursor color for Viper insert state.")
(put 'vip-insert-state-cursor-color 'permanent-local t)
;; place to save cursor colow when switching to insert mode
(vip-deflocalvar vip-saved-cursor-color nil "")
(vip-deflocalvar vip-replace-overlay nil "")
(put 'vip-replace-overlay 'permanent-local t)
@ -698,10 +702,14 @@ to a new place after repeating previous Vi command.")
(defvar vip-s-forward nil)
(defconst vip-case-fold-search nil
"*If t, search ignores cases.")
"*If not nil, search ignores cases.")
(defconst vip-re-search t
"*If t, search is reg-exp search, otherwise vanilla search.")
"*If not nil, search is reg-exp search, otherwise vanilla search.")
(defvar vip-adjust-window-after-search t
"*If not nil, pull the window up or down, depending on the direction of the
search, if search ends up near the bottom or near the top of the window.")
(defconst vip-re-query-replace t
"*If t then do regexp replace, if nil then do string replace.")
@ -983,6 +991,14 @@ Should be set in `~/.vip' file.")
vip-insert-point
(>= (point) vip-insert-point))
(setq vip-last-posn-while-in-insert-state (point-marker)))
(if (eq vip-current-state 'insert-state)
(progn
(or (stringp vip-saved-cursor-color)
(string= (vip-get-cursor-color) vip-insert-state-cursor-color)
(setq vip-saved-cursor-color (vip-get-cursor-color)))
(if (stringp vip-saved-cursor-color)
(vip-change-cursor-color vip-insert-state-cursor-color))
))
(if (and (eq this-command 'dabbrev-expand)
(integerp vip-pre-command-point)
(> vip-insert-point vip-pre-command-point))
@ -990,6 +1006,11 @@ Should be set in `~/.vip' file.")
)
(defsubst vip-insert-state-pre-command-sentinel ()
(or (memq this-command '(self-insert-command))
(memq (vip-event-key last-command-event)
'(up down left right (meta f) (meta b)
(control n) (control p) (control f) (control b)))
(vip-restore-cursor-color-after-insert))
(if (and (eq this-command 'dabbrev-expand)
(markerp vip-insert-point)
(marker-position vip-insert-point))
@ -1005,7 +1026,7 @@ Should be set in `~/.vip' file.")
(if (and (<= (vip-replace-start) (point))
(<= (point) (vip-replace-end)))
(vip-change-cursor-color vip-replace-overlay-cursor-color)
(vip-restore-cursor-color)
(vip-restore-cursor-color-after-replace)
))
;; to speed up, don't change cursor color before self-insert
@ -1015,7 +1036,7 @@ Should be set in `~/.vip' file.")
(memq (vip-event-key last-command-event)
'(up down left right (meta f) (meta b)
(control n) (control p) (control f) (control b)))
(vip-restore-cursor-color)))
(vip-restore-cursor-color-after-replace)))
(defun vip-replace-state-post-command-sentinel ()
;; Restoring cursor color is needed despite
@ -1029,7 +1050,7 @@ Should be set in `~/.vip' file.")
;; cursor color or, if they terminate replace mode, the color will be changed
;; in vip-finish-change
(or (memq this-command '(self-insert-command))
(vip-restore-cursor-color))
(vip-restore-cursor-color-after-replace))
(cond
((eq vip-current-state 'replace-state)
;; delete characters to compensate for inserted chars.
@ -1148,18 +1169,18 @@ Should be set in `~/.vip' file.")
(if vip-want-ctl-h-help
(progn
(define-key vip-insert-basic-map "\C-h" 'help-command)
(define-key vip-replace-map "\C-h" 'help-command))
(define-key vip-insert-basic-map [(control h)] 'help-command)
(define-key vip-replace-map [(control h)] 'help-command))
(define-key vip-insert-basic-map
"\C-h" 'vip-del-backward-char-in-insert)
[(control h)] 'vip-del-backward-char-in-insert)
(define-key vip-replace-map
"\C-h" 'vip-del-backward-char-in-replace)))
[(control h)] 'vip-del-backward-char-in-replace)))
(t
(t ; Vi state
(setq vip-vi-diehard-minor-mode (not vip-want-emacs-keys-in-vi))
(if vip-want-ctl-h-help
(define-key vip-vi-basic-map "\C-h" 'help-command)
(define-key vip-vi-basic-map "\C-h" 'vip-backward-char)))
(define-key vip-vi-basic-map [(control h)] 'help-command)
(define-key vip-vi-basic-map [(control h)] 'vip-backward-char)))
))
@ -1429,6 +1450,8 @@ This startup message appears whenever you load Viper, unless you type `y' now."
;; keys `,',^ in Vi state, as they will do accents instead of Vi actions.
(if (and (boundp 'iso-accents-mode) iso-accents-mode)
(iso-accents-mode -1))
(vip-restore-cursor-color-after-insert)
;; Protection against user errors in hooks
(condition-case conds
@ -1443,6 +1466,14 @@ This startup message appears whenever you load Viper, unless you type `y' now."
(if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode))
(iso-accents-mode 1)) ; turn iso accents on
(or (stringp vip-saved-cursor-color)
(string= (vip-get-cursor-color) vip-insert-state-cursor-color)
(setq vip-saved-cursor-color (vip-get-cursor-color)))
;; Commented out, because if vip-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 vip-saved-cursor-color)
;;; (vip-change-cursor-color vip-insert-state-cursor-color))
;; Protection against user errors in hooks
(condition-case conds
(run-hooks 'vip-insert-state-hook)
@ -2546,20 +2577,23 @@ Undo previous insertion and inserts new."
;; Tells whether BEG is on the same line as END.
;; If one of the args is nil, it'll return nil.
(defun vip-same-line (beg end)
(let ((selective-display nil))
(cond ((and beg end)
;; This 'if' is needed because Emacs treats the next empty line
;; as part of the previous line.
(if (or (> beg (point-max)) (> end (point-max))) ; out of range
()
(if (and (> end beg) (= (vip-line-pos 'start) end))
(setq end (min (1+ end) (point-max))))
(if (and (> beg end) (= (vip-line-pos 'start) beg))
(setq beg (min (1+ beg) (point-max))))
(<= (count-lines beg end) 1) ))
(t nil))
))
(let ((selective-display nil)
(incr 0)
temp)
(if (and beg end (> beg end))
(setq temp beg
beg end
end temp))
(if (and beg end)
(cond ((or (> beg (point-max)) (> end (point-max))) ; out of range
nil)
(t
;; This 'if' is needed because Emacs treats the next empty line
;; as part of the previous line.
(if (= (vip-line-pos 'start) end)
(setq incr 1))
(<= (+ incr (count-lines beg end)) 1))))
))
;; Check if the string ends with a newline.
@ -3024,7 +3058,7 @@ Undo previous insertion and inserts new."
'vip-replace-state-post-command-sentinel)
(vip-remove-hook
'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel)
(vip-restore-cursor-color)
(vip-restore-cursor-color-after-replace)
(setq vip-sitting-in-replace nil) ; just in case we'll need to know it
(save-excursion
(if (and
@ -3840,6 +3874,32 @@ controlled by the sign of prefix numeric value."
(interactive "p")
(recenter (- (window-height) (1+ arg))))
;; If vip-adjust-window-after-search is t, scroll up or down 1/4 of window
;; height, depending on whether we are at the bottom or at the top of the
;; window. This function is called by vip-search (which is called from
;; vip-search-forward/backward/next)
(defun vip-adjust-window ()
(let ((win-height (if vip-emacs-p
(1- (window-height)) ; adjust for modeline
(window-displayed-height)))
(pt (point))
at-top-p at-bottom-p
min-scroll direction)
(save-excursion
(move-to-window-line 0) ; top
(setq at-top-p (<= (count-lines pt (point)) 2))
(move-to-window-line -1) ; bottom
(setq at-bottom-p (<= (count-lines pt (point)) 2))
)
(cond (at-top-p (setq min-scroll 1
direction 1))
(at-bottom-p (setq min-scroll 2
direction -1)))
(if (and vip-adjust-window-after-search min-scroll)
(recenter
(* (max min-scroll (/ win-height 7)) direction)))
))
;; paren match
;; must correct this to only match ( to ) etc. On the other hand
@ -4091,6 +4151,62 @@ the Emacs binding of `/'."
(setq msg "Search style remains unchanged")))
(prin1 msg t)))
(defun vip-set-vi-search-style-macros (unset)
"Set the macros for toggling the search style in Viper's vi-state.
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. "
(interactive "P")
(or noninteractive
(if (not unset)
(progn
;; toggle case sensitivity in search
(vip-record-kbd-macro
"//" 'vi-state
[1 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return]
't)
;; toggle regexp/vanila search
(vip-record-kbd-macro
"///" 'vi-state
[2 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return]
't)
(if (interactive-p)
(message
"// and /// now toggle case-sensitivity and regexp search.")))
(vip-unrecord-kbd-macro "//" 'vi-state)
(sit-for 2)
(vip-unrecord-kbd-macro "///" 'vi-state))))
(defun vip-set-emacs-search-style-macros (unset &optional arg-majormode)
"Set the macros for toggling the search style in Viper's emacs-state.
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,
the macros are set in the current major mode.
\(When unsetting the macros, the second argument has no effect.\)"
(interactive "P")
(or noninteractive
(if (not unset)
(progn
;; toggle case sensitivity in search
(vip-record-kbd-macro
"//" 'emacs-state
[1 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return]
(or arg-majormode major-mode))
;; toggle regexp/vanila search
(vip-record-kbd-macro
"///" 'emacs-state
[2 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return]
(or arg-majormode major-mode))
(if (interactive-p)
(message
"// and /// now toggle case-sensitivity and regexp search.")))
(vip-unrecord-kbd-macro "//" 'emacs-state)
(sit-for 2)
(vip-unrecord-kbd-macro "///" 'emacs-state))))
(defun vip-search-forward (arg)
"Search a string forward.
@ -4159,9 +4275,6 @@ Null string will repeat previous search."
(re-search-backward string))
(search-forward string nil nil val)
(search-backward string))
;; don't wait and don't flash in macros
(or executing-kbd-macro
(vip-flash-search-pattern))
(if (not (equal start-point (point)))
(push-mark start-point t)))
(search-failed
@ -4186,9 +4299,6 @@ Null string will repeat previous search."
(if vip-re-search
(re-search-backward string nil nil val)
(search-backward string nil nil val))
;; don't wait and don't flash in macros
(or executing-kbd-macro
(vip-flash-search-pattern))
(if (not (equal start-point (point)))
(push-mark start-point t)))
(search-failed
@ -4206,7 +4316,14 @@ Null string will repeat previous search."
(error "`%s': %s not found"
string
(if vip-re-search "Pattern" "String"))
)))))))
))))
;; pull up or down if at top/bottom of window
(vip-adjust-window)
;; highlight the result of search
;; don't wait and don't highlight in macros
(or executing-kbd-macro
(vip-flash-search-pattern))
)))
(defun vip-search-next (arg)
"Repeat previous search."
@ -4412,6 +4529,7 @@ To turn this feature off, set this variable to nil.")
(setq vip-use-register nil)
(if (vip-end-with-a-newline-p text)
(progn
(end-of-line)
(if (eobp)
(insert "\n")
(forward-line 1))
@ -5507,6 +5625,11 @@ Mail anyway (y or n)? ")
(defvar fortran-mode-hook)
(add-hook 'fortran-mode-hook 'vip-mode)
(defvar basic-mode-hook)
(add-hook 'basic-mode-hook 'vip-mode)
(defvar bat-mode-hook)
(add-hook 'bat-mode-hook 'vip-mode)
(defvar text-mode-hook)
(add-hook 'text-mode-hook 'viper-mode)
@ -5567,6 +5690,21 @@ Mail anyway (y or n)? ")
'comint-mode 'insert-state vip-comint-mode-modifier-map)
(vip-modify-major-mode
'comint-mode 'vi-state vip-comint-mode-modifier-map)
(vip-modify-major-mode
'shell-mode 'insert-state vip-comint-mode-modifier-map)
(vip-modify-major-mode
'shell-mode 'vi-state vip-comint-mode-modifier-map)
;; ange-ftp in XEmacs
(vip-modify-major-mode
'ange-ftp-shell-mode 'insert-state vip-comint-mode-modifier-map)
(vip-modify-major-mode
'ange-ftp-shell-mode 'vi-state vip-comint-mode-modifier-map)
;; ange-ftp in Emacs
(vip-modify-major-mode
'internal-ange-ftp-mode 'insert-state vip-comint-mode-modifier-map)
(vip-modify-major-mode
'internal-ange-ftp-mode 'vi-state vip-comint-mode-modifier-map)
;; set hook
(add-hook 'comint-mode-hook 'vip-comint-mode-hook)
;; Shell scripts
@ -5577,18 +5715,26 @@ Mail anyway (y or n)? ")
;; Dired
(vip-modify-major-mode 'dired-mode 'emacs-state vip-dired-modifier-map)
(vip-set-emacs-search-style-macros nil 'dired-mode)
(add-hook 'dired-mode-hook 'vip-change-state-to-emacs)
;; Tar
(vip-modify-major-mode 'tar-mode 'emacs-state vip-slash-and-colon-map)
(vip-set-emacs-search-style-macros nil 'tar-mode)
;; MH-E
(vip-modify-major-mode 'mh-folder-mode 'emacs-state vip-slash-and-colon-map)
(vip-set-emacs-search-style-macros nil 'mh-folder-mode)
;; changing state to emacs is needed so the preceding will take hold
(add-hook 'mh-folder-mode-hook 'vip-change-state-to-emacs)
(add-hook 'mh-show-mode-hook 'viper-mode)
;; Gnus
(vip-modify-major-mode 'gnus-group-mode 'emacs-state vip-slash-and-colon-map)
(vip-set-emacs-search-style-macros nil 'gnus-group-mode)
(vip-modify-major-mode
'gnus-summary-mode 'emacs-state vip-slash-and-colon-map)
(vip-set-emacs-search-style-macros nil 'gnus-summary-mode)
;; changing state to emacs is needed so the preceding will take hold
(add-hook 'gnus-group-mode-hook 'vip-change-state-to-emacs)
(add-hook 'gnus-summary-mode-hook 'vip-change-state-to-emacs)
@ -5596,6 +5742,7 @@ Mail anyway (y or n)? ")
;; Info
(vip-modify-major-mode 'Info-mode 'emacs-state vip-slash-and-colon-map)
(vip-set-emacs-search-style-macros nil 'Info-mode)
;; Switching to emacs is needed so the above will take hold
(defadvice Info-mode (after vip-Info-ad activate)
"Switch to emacs mode."
@ -5604,6 +5751,7 @@ Mail anyway (y or n)? ")
;; Buffer menu
(vip-modify-major-mode
'Buffer-menu-mode 'emacs-state vip-slash-and-colon-map)
(vip-set-emacs-search-style-macros nil 'Buffer-menu-mode)
;; Switching to emacs is needed so the above will take hold
(defadvice Buffer-menu-mode (after vip-Buffer-menu-ad activate)
"Switch to emacs mode."
@ -5652,14 +5800,8 @@ Mail anyway (y or n)? ")
(vector vip-repeat-from-history-key '\2) 'vi-state
[(meta x) v i p - r e p e a t - f r o m - h i s t o r y return] 't)
;; toggle case sensitivity in search
(vip-record-kbd-macro
"//" 'vi-state
[1 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return] 't)
;; toggle regexp/vanila search
(vip-record-kbd-macro
"///" 'vi-state
[2 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return] 't)
;; set the toggle case sensitivity and regexp search macros
(vip-set-vi-search-style-macros nil)
;; ~/.vip is loaded if it exists