Mercurial > emacs
diff lisp/ediff-util.el @ 16248:b2fae8abc5b0
*** empty log message ***
author | Michael Kifer <kifer@cs.stonybrook.edu> |
---|---|
date | Fri, 20 Sep 1996 01:10:05 +0000 |
parents | 43a3308fcf61 |
children | beb94a5271e2 |
line wrap: on
line diff
--- a/lisp/ediff-util.el Fri Sep 20 01:08:36 1996 +0000 +++ b/lisp/ediff-util.el Fri Sep 20 01:10:05 1996 +0000 @@ -24,11 +24,17 @@ ;;; 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) +(and noninteractive + (eval-when-compile + (let ((load-path (cons (expand-file-name ".") load-path))) + (load-file "ediff-init.el") + (load-file "ediff-help.el")))) ;; end pacifier @@ -100,6 +106,10 @@ (setq ediff-mode-map (make-sparse-keymap)) (suppress-keymap ediff-mode-map) + (define-key ediff-mode-map + (if ediff-emacs-p [mouse-2] [button2]) 'ediff-help-for-quick-help) + (define-key ediff-mode-map "\C-m" 'ediff-help-for-quick-help) + (define-key ediff-mode-map "p" 'ediff-previous-difference) (define-key ediff-mode-map "\C-?" 'ediff-previous-difference) (define-key ediff-mode-map [backspace] 'ediff-previous-difference) @@ -183,6 +193,7 @@ (define-key ediff-mode-map "wa" 'ediff-save-buffer) (define-key ediff-mode-map "wb" 'ediff-save-buffer) (define-key ediff-mode-map "wd" 'ediff-save-buffer) + (define-key ediff-mode-map "=" 'ediff-inferior-compare-regions) (if (fboundp 'ediff-show-patch-diagnostics) (define-key ediff-mode-map "P" 'ediff-show-patch-diagnostics)) (if ediff-3way-job @@ -210,10 +221,13 @@ ;; It now returns control buffer so other functions can do post-processing (defun ediff-setup (buffer-A file-A buffer-B file-B buffer-C file-C startup-hooks setup-parameters) - (setq file-A (expand-file-name file-A)) - (setq file-B (expand-file-name file-B)) + ;; ediff-convert-standard-filename puts file names in the form appropriate + ;; for the OS at hand. + (setq file-A (ediff-convert-standard-filename (expand-file-name file-A))) + (setq file-B (ediff-convert-standard-filename (expand-file-name file-B))) (if (stringp file-C) - (setq file-C (expand-file-name file-C))) + (setq file-C + (ediff-convert-standard-filename (expand-file-name file-C)))) (let* ((control-buffer-name (ediff-unique-buffer-name "*Ediff Control Panel" "*")) (control-buffer (ediff-eval-in-buffer buffer-A @@ -461,6 +475,8 @@ (shrink-window-if-larger-than-buffer) (or (ediff-multiframe-setup-p) (ediff-indent-help-message)) + (ediff-set-help-overlays) + (set-buffer-modified-p nil) (ediff-refresh-mode-lines) (setq ediff-control-window (selected-window)) @@ -476,72 +492,7 @@ (goto-char (point-min)) (skip-chars-forward ediff-whitespace))) -;; assuming we are in control window, calculate length of the first line in -;; help message -(defun ediff-help-message-line-length () - (save-excursion - (goto-char (point-min)) - (if ediff-use-long-help-message - (next-line 1)) - (end-of-line) - (current-column))) - -(defun ediff-indent-help-message () - (let* ((shift (/ (max 0 (- (window-width (selected-window)) - (ediff-help-message-line-length))) - 2)) - (str (make-string shift ?\ ))) - (save-excursion - (goto-char (point-min)) - (while (< (point) (point-max)) - (insert str) - (beginning-of-line) - (forward-line 1))))) - - -(defun ediff-set-help-message () - (setq ediff-long-help-message - (cond ((and ediff-long-help-message-function - (or (symbolp ediff-long-help-message-function) - (consp ediff-long-help-message-function))) - (funcall ediff-long-help-message-function)) - (ediff-word-mode - (concat ediff-long-help-message-head - ediff-long-help-message-word-mode - ediff-long-help-message-tail)) - (ediff-narrow-job - (concat ediff-long-help-message-head - ediff-long-help-message-narrow2 - ediff-long-help-message-tail)) - (ediff-merge-job - (concat ediff-long-help-message-head - ediff-long-help-message-merge - ediff-long-help-message-tail)) - (ediff-diff3-job - (concat ediff-long-help-message-head - ediff-long-help-message-compare3 - ediff-long-help-message-tail)) - (t - (concat ediff-long-help-message-head - ediff-long-help-message-compare2 - ediff-long-help-message-tail)))) - (setq ediff-brief-help-message - (cond ((and ediff-brief-help-message-function - (or (symbolp ediff-brief-help-message-function) - (consp ediff-brief-help-message-function))) - (funcall ediff-brief-help-message-function)) - ((stringp ediff-brief-help-message-function) - ediff-brief-help-message-function) - ((ediff-multiframe-setup-p) ediff-brief-message-string) - (t ; long brief msg, not multiframe --- put in the middle - ediff-brief-message-string) - )) - (setq ediff-help-message (if ediff-use-long-help-message - ediff-long-help-message - ediff-brief-help-message)) - (run-hooks 'ediff-display-help-hook)) - ;;; Commands for working with Ediff @@ -770,8 +721,9 @@ control-frame (eq this-command 'ediff-quit)))) )) - (ediff-eval-in-buffer control-buf - (ediff-refresh-mode-lines)) + + (ediff-restore-highlighting) + (ediff-eval-in-buffer control-buf (ediff-refresh-mode-lines)) )) ;; this function returns to the window it was called from @@ -881,12 +833,13 @@ ediff-highlight-all-diffs t))) (if (and ediff-use-faces ediff-highlight-all-diffs) - (ediff-color-background-regions) - (ediff-color-background-regions 'unhighlight)) + (ediff-paint-background-regions) + (ediff-paint-background-regions 'unhighlight)) (ediff-unselect-and-select-difference ediff-current-difference 'select-only)) ) + (defun ediff-toggle-autorefine () "Toggle auto-refine mode." @@ -1033,7 +986,10 @@ (file-writable-p file) (or (file-exists-p (concat file ",v")) - (file-exists-p (concat "RCS/" file ",v"))) + (file-exists-p (concat (file-name-directory file) + "RCS/" + (file-name-nondirectory file) + ",v"))) )) (defun ediff-file-checked-in-p (file) (and (stringp file) @@ -2188,10 +2144,17 @@ (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)) + (meta-buffer ediff-meta-buffer) + ;; suitable working frame + (warp-frame (if (and (ediff-window-display-p) (eq ediff-grab-mouse t)) + (cond ((window-live-p ediff-window-A) + (window-frame ediff-window-A)) + ((window-live-p ediff-window-B) + (window-frame ediff-window-B)) + (t (next-frame)))))) (condition-case nil (ediff-eval-in-buffer ediff-buffer-A (setq ediff-this-buffer-ediff-sessions @@ -2233,6 +2196,14 @@ (ediff-update-registry) ;; restore state of buffers to what it was before ediff (ediff-restore-protected-variables) + + ;; If the user interrupts (canceling saving the merge buffer), continue + ;; normally. + (condition-case nil + (if (ediff-merge-job) + (run-hooks 'ediff-quit-merge-hook)) + (quit)) + ;; good place to kill buffers A/B/C (run-hooks 'ediff-cleanup-hook) (let ((ediff-keep-variants ediff-keep-variants)) @@ -2242,6 +2213,20 @@ (run-hooks 'ediff-quit-hook) (ediff-cleanup-meta-buffer meta-buffer) + + ;; warp mouse into a working window + (setq warp-frame ; if mouse is over a reasonable frame, use it + (cond ((and ediff-xemacs-p (window-live-p (car (mouse-position)))) + (window-frame (car (mouse-position)))) + ((frame-live-p (car (mouse-position))) + (car (mouse-position))) + (t warp-frame))) + (if (frame-live-p warp-frame) + (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)) )) @@ -2290,7 +2275,7 @@ (or (ediff-get-visible-buffer-window buff-A) (progn (if (ediff-get-visible-buffer-window buff-B) - (split-window-vertically)) + (funcall ediff-split-window-function)) (switch-to-buffer buff-A))) (error)) (if three-way-job @@ -2299,7 +2284,7 @@ (progn (if (or (ediff-get-visible-buffer-window buff-A) (ediff-get-visible-buffer-window buff-B)) - (split-window-vertically)) + (funcall ediff-split-window-function)) (switch-to-buffer buff-C) (balance-windows))) (error))) @@ -2337,6 +2322,52 @@ (buffer-name ediff-buffer-C))))) (ediff-kill-buffer-carefully ediff-buffer-C)))) +(defun ediff-maybe-save-and-delete-merge () + "Default hook to run on quitting a merge job. +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 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 +`ediff-merge-directories', `ediff-merge-directory-revisions', and such." + (let ((merge-store-file ediff-merge-store-file)) + (if ediff-autostore-merges + (cond ((stringp ediff-merge-store-file) + ;; store, ask to delete + (ediff-write-merge-buffer-then-kill + ediff-buffer-C merge-store-file 'show-file)) + ((eq ediff-autostore-merges t) + ;; ask for file name + (setq merge-store-file + (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)) + ;; 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 "The result of the merge goes into: ")) + (ediff-write-merge-buffer-then-kill + ediff-buffer-C merge-store-file)))) + )) + +(defun ediff-write-merge-buffer-then-kill (buf file &optional show-file) + (ediff-eval-in-buffer buf + (if (or (not (file-exists-p file)) + (y-or-n-p (format "File %s exists, overwrite? " file))) + (progn + (write-region (point-min) (point-max) file) + (if show-file + (progn + (message "Merge buffer saved in: %s" file) + (sit-for 2))) + (if (y-or-n-p "Merge buffer saved in file. Now kill the buffer? ") + (ediff-kill-buffer-carefully buf)))))) + ;; The default way of suspending Ediff. ;; Buries Ediff buffers, kills all windows. (defun ediff-default-suspend-function () @@ -2583,8 +2614,7 @@ (setq ediff-current-difference n) ) ; end protected section - (ediff-eval-in-buffer control-buf - (ediff-refresh-mode-lines)) + (ediff-eval-in-buffer control-buf (ediff-refresh-mode-lines)) ))) @@ -2618,7 +2648,6 @@ prompt (cond (default-file (concat " (default " default-file "):")) - ;;((string-match "[?:!,;][ \t]*$" prompt) "") (t (concat " (default " default-dir "):")))) default-dir (or default-file default-dir) @@ -2673,7 +2702,7 @@ nil ; don't append---erase 'no-message) (set-file-modes f ediff-temp-file-mode) - f))) + (ediff-convert-standard-filename (expand-file-name f))))) ;; Quote metacharacters (using \) when executing diff in Unix, but not in ;; EMX OS/2 @@ -2796,6 +2825,108 @@ (ediff-reset-mouse ediff-control-frame)) (if (window-live-p ediff-control-window) (select-window ediff-control-window))) + + +(defun ediff-inferior-compare-regions () + "Compare regions in an active Ediff session. +Like ediff-regions-linewise but is called from under an active Ediff session on +the files that belong to that session. + +After quitting the session invoked via this function, type C-l to the parent +Ediff Control Panel to restore highlighting." + (interactive) + (let ((answer "") + (possibilities (list ?A ?B ?C)) + begA begB endA endB bufA bufB) + + (cond ((ediff-merge-job) + (setq bufB ediff-buffer-C) + (while (cond ((memq answer '(?A ?a)) + (setq bufA ediff-buffer-A) + nil) + ((memq answer '(?B ?b)) + (setq bufA ediff-buffer-B) + nil) + ((equal answer "")) + (t (beep 1) + (message "Valid answers are A or B") + (sit-for 2) + t)) + (let ((cursor-in-echo-area t)) + (message "Which buffer to compare to the merge buffer (A/B)? ") + (setq answer (read-char-exclusive))))) + + ((ediff-3way-comparison-job) + (while (cond ((memq answer possibilities) + (setq possibilities (delq answer possibilities)) + (setq bufA + (eval + (intern (format "ediff-buffer-%c" answer)))) + nil) + ((equal answer "")) + (t (beep 1) + (message + "Valid answers are %s" + (mapconcat 'char-to-string possibilities " or ")) + (sit-for 2) + t)) + (let ((cursor-in-echo-area t)) + (message "Enter the 1st buffer you want to compare (%s): " + (mapconcat 'char-to-string possibilities "/")) + (setq answer (capitalize (read-char-exclusive))))) + (setq answer "") ; silence error msg + (while (cond ((memq answer possibilities) + (setq possibilities (delq answer possibilities)) + (setq bufB + (eval + (intern (format "ediff-buffer-%c" answer)))) + nil) + ((equal answer "")) + (t (beep 1) + (message + "Valid answers are %s" + (mapconcat 'char-to-string possibilities " or ")) + (sit-for 2) + t)) + (let ((cursor-in-echo-area t)) + (message "Enter the 2nd buffer you want to compare (%s): " + (mapconcat 'char-to-string possibilities "/")) + (setq answer (capitalize (read-char-exclusive)))))) + (t ; 2way comparison + (setq bufA ediff-buffer-A + bufB ediff-buffer-B))) + + (ediff-eval-in-buffer bufA + (setq begA (region-beginning) + endA (region-end)) + (goto-char begA) + (beginning-of-line) + (setq begA (point)) + (goto-char endA) + (end-of-line) + (or (eobp) (forward-char)) ; include the newline char + (setq endA (point))) + (ediff-eval-in-buffer bufB + (setq begB (region-beginning) + endB (region-end)) + (goto-char begB) + (beginning-of-line) + (setq begB (point)) + (goto-char endB) + (end-of-line) + (or (eobp) (forward-char)) ; include the newline char + (setq endB (point))) + + (ediff-unselect-and-select-difference + ediff-current-difference 'unselect-only) + (ediff-paint-background-regions 'unhighlight) + + (ediff-regions-internal + bufA begA endA bufB begB endB + nil ; startup hook + 'ediff-regions-linewise ; job name + nil) ; no word mode + )) @@ -2893,68 +3024,16 @@ )) - -(defun ediff-highlight-diff-in-one-buffer (n buf-type) - (if (ediff-buffer-live-p (ediff-get-buffer buf-type)) - (let* ((buff (ediff-get-buffer buf-type)) - (last (ediff-eval-in-buffer buff (point-max))) - (begin (ediff-get-diff-posn buf-type 'beg n)) - (end (ediff-get-diff-posn buf-type 'end n)) - (xtra (if (equal begin end) 1 0)) - (end-hilit (min last (+ end xtra))) - (current-diff-overlay - (symbol-value - (intern (format "ediff-current-diff-overlay-%S" buf-type)))) - ) - - (if ediff-xemacs-p - (ediff-move-overlay current-diff-overlay begin end-hilit) - (ediff-move-overlay current-diff-overlay begin end-hilit buff)) - ;; giving priority of 0 and then changing it may look funny, but - ;; this overcomes an obscure Emacs bug. - (ediff-overlay-put current-diff-overlay 'priority 0) - (ediff-overlay-put current-diff-overlay 'priority - (ediff-highest-priority begin end-hilit buff)) - (ediff-overlay-put current-diff-overlay 'ediff-diff-num n) - - ;; unhighlight the background overlay for diff n so it won't - ;; interfere with the current diff overlay - (ediff-set-overlay-face (ediff-get-diff-overlay n buf-type) nil) - ))) - +;; Restore highlighting to what it should be according to ediff-use-faces, +;; ediff-highlighting-style, and ediff-highlight-all-diffs variables. +(defun ediff-restore-highlighting (&optional ctl-buf) + (ediff-eval-in-buffer (or ctl-buf (current-buffer)) + (if (and (ediff-has-face-support-p) + ediff-use-faces + ediff-highlight-all-diffs) + (ediff-paint-background-regions)) + (ediff-select-difference ediff-current-difference))) -(defun ediff-unhighlight-diff-in-one-buffer (buf-type) - (if (ediff-buffer-live-p (ediff-get-buffer buf-type)) - (let ((current-diff-overlay - (symbol-value - (intern (format "ediff-current-diff-overlay-%S" buf-type)))) - (overlay - (ediff-get-diff-overlay ediff-current-difference buf-type)) - ) - - (ediff-move-overlay current-diff-overlay 1 1) - - ;; rehighlight the overlay in the background of the - ;; current difference region - (ediff-set-overlay-face - overlay - (if (and (ediff-has-face-support-p) - ediff-use-faces ediff-highlight-all-diffs) - (ediff-background-face buf-type ediff-current-difference))) - ))) - -(defun ediff-unhighlight-diffs-totally-in-one-buffer (buf-type) - (ediff-unselect-and-select-difference -1) - (if (and (ediff-has-face-support-p) ediff-use-faces) - (let* ((inhibit-quit t) - (current-diff-overlay-var - (intern (format "ediff-current-diff-overlay-%S" buf-type))) - (current-diff-overlay (symbol-value current-diff-overlay-var))) - (ediff-color-background-regions 'unhighlight) - (if (ediff-overlayp current-diff-overlay) - (ediff-delete-overlay current-diff-overlay)) - (set current-diff-overlay-var nil) - ))) ;; null out difference overlays so they won't slow down future @@ -2973,58 +3052,10 @@ ;; allow them to be garbage collected (set vec-var nil)) -(defun ediff-color-background-regions (&optional unhighlight) - (ediff-color-background-regions-in-one-buffer - 'A unhighlight) - (ediff-color-background-regions-in-one-buffer - 'B unhighlight) - (ediff-color-background-regions-in-one-buffer - 'C unhighlight) - (ediff-color-background-regions-in-one-buffer - 'Ancestor unhighlight)) - -(defun ediff-color-background-regions-in-one-buffer (buf-type unhighlight) - (let ((diff-vector - (eval (intern (format "ediff-difference-vector-%S" buf-type)))) - 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)) - (ediff-set-overlay-face - overl - (if (not unhighlight) - (ediff-background-face buf-type diff-num)) - ))) - diff-vector))) ;;; Misc -;; These two functions are here to neutralize XEmacs unwillingless to -;; handle overlays whose buffers were deleted. -(defun ediff-move-overlay (overlay beg end &optional buffer) - "Calls `move-overlay' in Emacs and `set-extent-endpoints' in Lemacs. -Checks if overlay's buffer exists before actually doing the move." - (let ((buf (and overlay (ediff-overlay-buffer overlay)))) - (if (ediff-buffer-live-p buf) - (if ediff-xemacs-p - (set-extent-endpoints overlay beg end) - (move-overlay overlay beg end buffer)) - ;; buffer's dead - (if overlay - (ediff-delete-overlay overlay))))) - -(defun ediff-overlay-put (overlay prop value) - "Calls `overlay-put' or `set-extent-property' depending on Emacs version. -Checks if overlay's buffer exists." - (if (ediff-buffer-live-p (ediff-overlay-buffer overlay)) - (if ediff-xemacs-p - (set-extent-property overlay prop value) - (overlay-put overlay prop value)) - (ediff-delete-overlay overlay))) - - ;; 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. @@ -3462,6 +3493,7 @@ ;;; Local Variables: ;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) ;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1) +;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body)) ;;; End: (provide 'ediff-util)