;;; The author has placed this file in the public domain.
-;; Author: Dale R. Worley <drw@math.mit.edu>
+;; This file is part of GNU Emacs.
+
+;; Author: Dale R. Worley <worley@world.std.com>
;; Version: 5fsf
;; Keywords: unix, tools
;; LOST DATA OR LOST PROFITS, OR FOR ANY SPECIAL, INCIDENTAL OR CONSEQUENTIAL
;; DAMAGES.
-;;; Code:
+;;; Commentary:
-;;;###autoload
-(defvar menu-bar-emerge-menu (make-sparse-keymap "menu-bar-emerge-map"))
-;;;###autoload
-(fset 'menu-bar-emerge-menu (symbol-value 'menu-bar-emerge-menu))
+;;; Code:
;;;###autoload
-(define-key menu-bar-emerge-menu [emerge-merge-directories]
- '("Merge Directories ..." . emerge-merge-directories))
-;;;###autoload
-(define-key menu-bar-emerge-menu [emerge-revisions-with-ancestor]
- '("Revisions with Ancestor ..." . emerge-revisions-with-ancestor))
-(define-key menu-bar-emerge-menu [emerge-revisions]
- '("Revisions ..." . emerge-revisions))
-;;;###autoload
-(define-key menu-bar-emerge-menu [emerge-files-with-ancestor]
- '("Files with Ancestor ..." . emerge-files-with-ancestor))
-;;;###autoload
-(define-key menu-bar-emerge-menu [emerge-files]
- '("Files ..." . emerge-files))
-;;;###autoload
-(define-key menu-bar-emerge-menu [emerge-buffers-with-ancestor]
- '("Buffers with Ancestor ..." . emerge-buffers-with-ancestor))
-;;;###autoload
-(define-key menu-bar-emerge-menu [emerge-buffers]
- '("Buffers ..." . emerge-buffers))
+(defvar menu-bar-emerge-menu (make-sparse-keymap "Emerge"))
+;;;###autoload (fset 'menu-bar-emerge-menu (symbol-value 'menu-bar-emerge-menu))
+
+;;;###autoload (define-key menu-bar-emerge-menu [emerge-merge-directories]
+;;;###autoload '("Merge Directories..." . emerge-merge-directories))
+;;;###autoload (define-key menu-bar-emerge-menu [emerge-revisions-with-ancestor]
+;;;###autoload '("Revisions with Ancestor..." . emerge-revisions-with-ancestor))
+;;;###autoload (define-key menu-bar-emerge-menu [emerge-revisions]
+;;;###autoload '("Revisions..." . emerge-revisions))
+;;;###autoload (define-key menu-bar-emerge-menu [emerge-files-with-ancestor]
+;;;###autoload '("Files with Ancestor..." . emerge-files-with-ancestor))
+;;;###autoload (define-key menu-bar-emerge-menu [emerge-files]
+;;;###autoload '("Files..." . emerge-files))
+;;;###autoload (define-key menu-bar-emerge-menu [emerge-buffers-with-ancestor]
+;;;###autoload '("Buffers with Ancestor..." . emerge-buffers-with-ancestor))
+;;;###autoload (define-key menu-bar-emerge-menu [emerge-buffers]
+;;;###autoload '("Buffers..." . emerge-buffers))
;;; Macros
(defmacro emerge-eval-in-buffer (buffer &rest forms)
"Macro to switch to BUFFER, evaluate FORMS, returns to original buffer.
Differs from `save-excursion' in that it doesn't save the point and mark."
- (` (let ((StartBuffer (current-buffer)))
+ `(let ((StartBuffer (current-buffer)))
(unwind-protect
- (progn
- (set-buffer (, buffer))
- (,@ forms))
- (set-buffer StartBuffer)))))
+ (progn
+ (set-buffer ,buffer)
+ ,@forms)
+ (set-buffer StartBuffer))))
-(defmacro emerge-defvar-local (var value doc)
- "Defines SYMBOL as an advertised variable.
+(defmacro emerge-defvar-local (var value doc)
+ "Defines SYMBOL as an advertised variable.
Performs a defvar, then executes `make-variable-buffer-local' on
the variable. Also sets the `preserved' property, so that
-`kill-all-local-variables' (called by major-mode setting commands)
+`kill-all-local-variables' (called by major-mode setting commands)
won't destroy Emerge control variables."
- (` (progn
- (defvar (, var) (, value) (, doc))
- (make-variable-buffer-local '(, var))
- (put '(, var) 'preserved t))))
+ `(progn
+ (defvar ,var ,value ,doc)
+ (make-variable-buffer-local ',var)
+ (put ',var 'preserved t)))
;; Add entries to minor-mode-alist so that emerge modes show correctly
(defvar emerge-minor-modes-list
;;; Emerge configuration variables
+(defgroup emerge nil
+ "Merge diffs under Emacs control."
+ :group 'tools)
+
;; Commands that produce difference files
;; All that can be configured is the name of the programs to execute
;; (emerge-diff-program and emerge-diff3-program) and the options
;; to be provided (emerge-diff-options). The order in which the file names
;; are given is fixed.
;; The file names are always expanded (see expand-file-name) before being
-;; passed to diff, thus they need not be invoked under a shell that
+;; passed to diff, thus they need not be invoked under a shell that
;; understands `~'.
;; The code which processes the diff/diff3 output depends on all the
;; finicky details of their output, including the somewhat strange
;; way they number lines of a file.
-(defvar emerge-diff-program "diff"
- "*Name of the program which compares two files.")
-(defvar emerge-diff3-program "diff3"
+(defcustom emerge-diff-program "diff"
+ "*Name of the program which compares two files."
+ :type 'string
+ :group 'emerge)
+(defcustom emerge-diff3-program "diff3"
"*Name of the program which compares three files.
-Its arguments are the ancestor file and the two variant files.")
-(defvar emerge-diff-options ""
- "*Options to pass to `emerge-diff-program' and `emerge-diff3-program'.")
-(defvar emerge-match-diff-line (let ((x "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)"))
- (concat "^" x "\\([acd]\\)" x "$"))
+Its arguments are the ancestor file and the two variant files."
+ :type 'string
+ :group 'emerge)
+(defcustom emerge-diff-options ""
+ "*Options to pass to `emerge-diff-program' and `emerge-diff3-program'."
+ :type 'string
+ :group 'emerge)
+(defcustom emerge-match-diff-line
+ (let ((x "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)"))
+ (concat "^" x "\\([acd]\\)" x "$"))
"*Pattern to match lines produced by diff that describe differences.
-This is as opposed to lines from the source files.")
-(defvar emerge-diff-ok-lines-regexp
+This is as opposed to lines from the source files."
+ :type 'regexp
+ :group 'emerge)
+(defcustom emerge-diff-ok-lines-regexp
"^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\)"
"*Regexp that matches normal output lines from `emerge-diff-program'.
-Lines that do not match are assumed to be error messages.")
-(defvar emerge-diff3-ok-lines-regexp
+Lines that do not match are assumed to be error messages."
+ :type 'regexp
+ :group 'emerge)
+(defcustom emerge-diff3-ok-lines-regexp
"^\\([1-3]:\\|====\\| \\)"
"*Regexp that matches normal output lines from `emerge-diff3-program'.
-Lines that do not match are assumed to be error messages.")
-
-(defvar emerge-rcs-ci-program "ci"
- "*Name of the program that checks in RCS revisions.")
-(defvar emerge-rcs-co-program "co"
- "*Name of the program that checks out RCS revisions.")
-
-(defvar emerge-process-local-variables nil
+Lines that do not match are assumed to be error messages."
+ :type 'regexp
+ :group 'emerge)
+
+(defcustom emerge-rcs-ci-program "ci"
+ "*Name of the program that checks in RCS revisions."
+ :type 'string
+ :group 'emerge)
+(defcustom emerge-rcs-co-program "co"
+ "*Name of the program that checks out RCS revisions."
+ :type 'string
+ :group 'emerge)
+
+(defcustom emerge-process-local-variables nil
"*Non-nil if Emerge should process local-variables lists in merge buffers.
\(You can explicitly request processing the local-variables
-by executing `(hack-local-variables)'.)")
-(defvar emerge-execute-line-deletions nil
+by executing `(hack-local-variables)'.)"
+ :type 'boolean
+ :group 'emerge)
+(defcustom emerge-execute-line-deletions nil
"*If non-nil: `emerge-execute-line' makes no output if an input was deleted.
It concludes that an input version has been deleted when an ancestor entry
is present, only one A or B entry is present, and an output entry is present.
If nil: In such circumstances, the A or B file that is present will be
-copied to the designated output file.")
+copied to the designated output file."
+ :type 'boolean
+ :group 'emerge)
-(defvar emerge-before-flag "vvvvvvvvvvvvvvvvvvvv\n"
+(defcustom emerge-before-flag "vvvvvvvvvvvvvvvvvvvv\n"
"*Flag placed above the highlighted block of code. Must end with newline.
Must be set before Emerge is loaded, or emerge-new-flags must be run
-after setting.")
-(defvar emerge-after-flag "^^^^^^^^^^^^^^^^^^^^\n"
+after setting."
+ :type 'string
+ :group 'emerge)
+(defcustom emerge-after-flag "^^^^^^^^^^^^^^^^^^^^\n"
"*Flag placed below the highlighted block of code. Must end with newline.
Must be set before Emerge is loaded, or emerge-new-flags must be run
-after setting.")
+after setting."
+ :type 'string
+ :group 'emerge)
;; Hook variables
-(defvar emerge-startup-hook nil
- "*Hook to run in the merge buffer after the merge has been set up.")
-(defvar emerge-select-hook nil
+(defcustom emerge-startup-hook nil
+ "*Hook to run in the merge buffer after the merge has been set up."
+ :type 'hook
+ :group 'emerge)
+(defcustom emerge-select-hook nil
"*Hook to run after a difference has been selected.
-The variable `n' holds the (internal) number of the difference.")
-(defvar emerge-unselect-hook nil
+The variable `n' holds the (internal) number of the difference."
+ :type 'hook
+ :group 'emerge)
+(defcustom emerge-unselect-hook nil
"*Hook to run after a difference has been unselected.
-The variable `n' holds the (internal) number of the difference.")
+The variable `n' holds the (internal) number of the difference."
+ :type 'hook
+ :group 'emerge)
;; Variables to control the default directories of the arguments to
;; Emerge commands.
-(defvar emerge-default-last-directories nil
+(defcustom emerge-default-last-directories nil
"*If nil, default dir for filenames in emerge is `default-directory'.
If non-nil, filenames complete in the directory of the last argument of the
-same type to an `emerge-files...' command.")
+same type to an `emerge-files...' command."
+ :type 'boolean
+ :group 'emerge)
(defvar emerge-last-dir-A nil
"Last directory for the first file of an `emerge-files...' command.")
;; Calculate dependent variables
(emerge-new-flags)
-(defvar emerge-min-visible-lines 3
+(defcustom emerge-min-visible-lines 3
"*Number of lines that we want to show above and below the flags when we are
-displaying a difference.")
-
-(defvar emerge-temp-file-prefix
- (let ((env (getenv "TMPDIR"))
- d)
- (setq d (if (and env (> (length env) 0))
- env
- "/tmp"))
- (if (= (aref d (1- (length d))) ?/)
- (setq d (substring d 0 -1)))
- (concat d "/emerge"))
+displaying a difference."
+ :type 'integer
+ :group 'emerge)
+
+(defcustom emerge-temp-file-prefix
+ (expand-file-name "emerge" temporary-file-directory)
"*Prefix to put on Emerge temporary file names.
-Do not start with `~/' or `~user-name/'.")
+Do not start with `~/' or `~USERNAME/'."
+ :type 'string
+ :group 'emerge)
-(defvar emerge-temp-file-mode 384 ; u=rw only
- "*Mode for Emerge temporary files.")
+(defcustom emerge-temp-file-mode 384 ; u=rw only
+ "*Mode for Emerge temporary files."
+ :type 'integer
+ :group 'emerge)
-(defvar emerge-combine-versions-template
- "#ifdef NEW\n%b#else /* NEW */\n%a#endif /* NEW */\n"
+(defcustom emerge-combine-versions-template
+ "#ifdef NEW\n%b#else /* not NEW */\n%a#endif /* not NEW */\n"
"*Template for `emerge-combine-versions' to combine the two versions.
The template is inserted as a string, with the following interpolations:
%a the A version of the difference
%% the character `%'
Don't forget to end the template with a newline.
Note that this variable can be made local to a particular merge buffer by
-giving a prefix argument to `emerge-set-combine-versions-template'.")
+giving a prefix argument to `emerge-set-combine-versions-template'."
+ :type 'string
+ :group 'emerge)
;; Build keymaps
(defvar emerge-move-menu
(make-sparse-keymap "Move"))
-(defvar emerge-command-prefix "\C-c\C-c"
+(defcustom emerge-command-prefix "\C-c\C-c"
"*Command prefix for Emerge commands in `edit' mode.
-Must be set before Emerge is loaded.")
+Must be set before Emerge is loaded."
+ :type 'string
+ :group 'emerge)
;; This function sets up the fixed keymaps. It is executed when the first
;; Emerge is done to allow the user maximum time to set up the global keymap.
;; Allow emerge-fast-keymap to be referenced indirectly
(fset 'emerge-fast-keymap emerge-fast-keymap)
;; Suppress write-file and save-buffer
- (substitute-key-definition 'write-file 'emerge-query-write-file
- emerge-fast-keymap (current-global-map))
- (substitute-key-definition 'save-buffer 'emerge-query-save-buffer
- emerge-fast-keymap (current-global-map))
+ (define-key emerge-fast-keymap [remap write-file] 'emerge-query-write-file)
+ (define-key emerge-fast-keymap [remap save-buffer] 'emerge-query-save-buffer)
(define-key emerge-basic-keymap [menu-bar] (make-sparse-keymap))
;;; Setup functions for two-file mode.
(defun emerge-files-internal (file-A file-B &optional startup-hooks quit-hooks
- output-file)
+ output-file)
(if (not (file-readable-p file-A))
(error "File `%s' does not exist or is not readable" file-A))
(if (not (file-readable-p file-B))
(if output-file
(setq emerge-last-dir-output (file-name-directory output-file)))
;; Make sure the entire files are seen, and they reflect what is on disk
- (emerge-eval-in-buffer
+ (emerge-eval-in-buffer
buffer-A
(widen)
(let ((temp (file-local-copy file-A)))
(if temp
(setq file-A temp
startup-hooks
- (cons (` (lambda () (delete-file (, file-A))))
+ (cons `(lambda () (delete-file ,file-A))
startup-hooks))
- ;; Verify that the file matches the buffer
- (emerge-verify-file-buffer))))
+ ;; Verify that the file matches the buffer
+ (emerge-verify-file-buffer))))
(emerge-eval-in-buffer
buffer-B
(widen)
(if temp
(setq file-B temp
startup-hooks
- (cons (` (lambda () (delete-file (, file-B))))
+ (cons `(lambda () (delete-file ,file-B))
startup-hooks))
- ;; Verify that the file matches the buffer
- (emerge-verify-file-buffer))))
+ ;; Verify that the file matches the buffer
+ (emerge-verify-file-buffer))))
(emerge-setup buffer-A file-A buffer-B file-B startup-hooks quit-hooks
output-file)))
(if temp
(setq file-A temp
startup-hooks
- (cons (` (lambda () (delete-file (, file-A))))
+ (cons `(lambda () (delete-file ,file-A))
startup-hooks))
- ;; Verify that the file matches the buffer
- (emerge-verify-file-buffer))))
+ ;; Verify that the file matches the buffer
+ (emerge-verify-file-buffer))))
(emerge-eval-in-buffer
buffer-B
(widen)
(if temp
(setq file-B temp
startup-hooks
- (cons (` (lambda () (delete-file (, file-B))))
+ (cons `(lambda () (delete-file ,file-B))
startup-hooks))
- ;; Verify that the file matches the buffer
- (emerge-verify-file-buffer))))
+ ;; Verify that the file matches the buffer
+ (emerge-verify-file-buffer))))
(emerge-eval-in-buffer
buffer-ancestor
(widen)
(if temp
(setq file-ancestor temp
startup-hooks
- (cons (` (lambda () (delete-file (, file-ancestor))))
+ (cons `(lambda () (delete-file ,file-ancestor))
startup-hooks))
- ;; Verify that the file matches the buffer
- (emerge-verify-file-buffer))))
+ ;; Verify that the file matches the buffer
+ (emerge-verify-file-buffer))))
(emerge-setup-with-ancestor buffer-A file-A buffer-B file-B
buffer-ancestor file-ancestor
startup-hooks quit-hooks output-file)))
;; if the A and B files are the same, ignore the difference
(if (not (string-equal agreement "2"))
(setq list
- (cons
+ (cons
(let (group-1 group-3 pos)
(setq pos (point))
(setq group-1 (emerge-get-diff3-group "1"))
(let (f)
(list current-prefix-arg
(setq f (emerge-read-file-name "File A to merge" emerge-last-dir-A
- nil nil))
- (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f)
+ nil nil t))
+ (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f t)
(and current-prefix-arg
(emerge-read-file-name "Output file" emerge-last-dir-output
- f f)))))
+ f f nil)))))
+ (if file-out
+ (add-hook 'quit-hooks `(lambda () (emerge-files-exit ,file-out))))
(emerge-files-internal
file-A file-B startup-hooks
- (if file-out
- (cons (` (lambda () (emerge-files-exit (, file-out))))
- quit-hooks)
- quit-hooks)
+ quit-hooks
file-out))
;;;###autoload
(let (f)
(list current-prefix-arg
(setq f (emerge-read-file-name "File A to merge" emerge-last-dir-A
- nil nil))
- (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f)
+ nil nil t))
+ (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f t)
(emerge-read-file-name "Ancestor file" emerge-last-dir-ancestor
- nil f)
+ nil f t)
(and current-prefix-arg
(emerge-read-file-name "Output file" emerge-last-dir-output
- f f)))))
+ f f nil)))))
+ (if file-out
+ (add-hook 'quit-hooks `(lambda () (emerge-files-exit ,file-out))))
(emerge-files-with-ancestor-internal
file-A file-B file-ancestor startup-hooks
- (if file-out
- (cons (` (lambda () (emerge-files-exit (, file-out))))
- quit-hooks)
- quit-hooks)
+ quit-hooks
file-out))
;; Write the merge buffer out in place of the file the A buffer is visiting.
(write-region (point-min) (point-max) emerge-file-B nil 'no-message))
(emerge-setup (get-buffer buffer-A) emerge-file-A
(get-buffer buffer-B) emerge-file-B
- (cons (` (lambda ()
- (delete-file (, emerge-file-A))
- (delete-file (, emerge-file-B))))
+ (cons `(lambda ()
+ (delete-file ,emerge-file-A)
+ (delete-file ,emerge-file-B))
startup-hooks)
quit-hooks
nil)))
;;;###autoload
(defun emerge-buffers-with-ancestor (buffer-A buffer-B buffer-ancestor
- &optional startup-hooks
- quit-hooks)
+ &optional startup-hooks
+ quit-hooks)
"Run Emerge on two buffers, giving another buffer as the ancestor."
(interactive
"bBuffer A to merge: \nbBuffer B to merge: \nbAncestor buffer: ")
(get-buffer buffer-B) emerge-file-B
(get-buffer buffer-ancestor)
emerge-file-ancestor
- (cons (` (lambda ()
- (delete-file (, emerge-file-A))
- (delete-file (, emerge-file-B))
- (delete-file
- (, emerge-file-ancestor))))
+ (cons `(lambda ()
+ (delete-file ,emerge-file-A)
+ (delete-file ,emerge-file-B)
+ (delete-file
+ ,emerge-file-ancestor))
startup-hooks)
quit-hooks
nil)))
(setq command-line-args-left (nthcdr 3 command-line-args-left))
(emerge-files-internal
file-a file-b nil
- (list (` (lambda () (emerge-command-exit (, file-out))))))))
+ (list `(lambda () (emerge-command-exit ,file-out))))))
;;;###autoload
(defun emerge-files-with-ancestor-command ()
(setq file-anc (nth 1 command-line-args-left))
(setq file-out (nth 4 command-line-args-left))
(setq command-line-args-left (nthcdr 5 command-line-args-left)))
- ;; arguments are "file-a file-b ancestor file-out"
- (setq file-a (nth 0 command-line-args-left))
- (setq file-b (nth 1 command-line-args-left))
- (setq file-anc (nth 2 command-line-args-left))
- (setq file-out (nth 3 command-line-args-left))
- (setq command-line-args-left (nthcdr 4 command-line-args-left)))
+ ;; arguments are "file-a file-b ancestor file-out"
+ (setq file-a (nth 0 command-line-args-left))
+ (setq file-b (nth 1 command-line-args-left))
+ (setq file-anc (nth 2 command-line-args-left))
+ (setq file-out (nth 3 command-line-args-left))
+ (setq command-line-args-left (nthcdr 4 command-line-args-left)))
(emerge-files-with-ancestor-internal
file-a file-b file-anc nil
- (list (` (lambda () (emerge-command-exit (, file-out))))))))
-
+ (list `(lambda () (emerge-command-exit ,file-out))))))
+
(defun emerge-command-exit (file-out)
(emerge-write-and-delete file-out)
(kill-emacs (if emerge-prefix-argument 1 0)))
(setq emerge-file-out file-out)
(emerge-files-internal
file-a file-b nil
- (list (` (lambda () (emerge-remote-exit (, file-out) '(, emerge-exit-func)))))
+ (list `(lambda () (emerge-remote-exit ,file-out ',emerge-exit-func)))
file-out)
(throw 'client-wait nil))
(setq emerge-file-out file-out)
(emerge-files-with-ancestor-internal
file-a file-b file-anc nil
- (list (` (lambda () (emerge-remote-exit (, file-out) '(, emerge-exit-func)))))
+ (list `(lambda () (emerge-remote-exit ,file-out ',emerge-exit-func)))
file-out)
(throw 'client-wait nil))
;;; Functions to start Emerge on RCS versions
+;;;###autoload
(defun emerge-revisions (arg file revision-A revision-B
&optional startup-hooks quit-hooks)
"Emerge two RCS revisions of a file."
(emerge-revisions-internal
file revision-A revision-B startup-hooks
(if arg
- (cons (` (lambda ()
- (shell-command
- (, (format "%s %s" emerge-rcs-ci-program file)))))
+ (cons `(lambda ()
+ (shell-command
+ ,(format "%s %s" emerge-rcs-ci-program file)))
quit-hooks)
- quit-hooks)))
+ quit-hooks)))
+;;;###autoload
(defun emerge-revisions-with-ancestor (arg file revision-A
- revision-B ancestor
- &optional
- startup-hooks quit-hooks)
+ revision-B ancestor
+ &optional
+ startup-hooks quit-hooks)
"Emerge two RCS revisions of a file, with another revision as ancestor."
(interactive
(list current-prefix-arg
file revision-A revision-B ancestor startup-hooks
(if arg
(let ((cmd ))
- (cons (` (lambda ()
- (shell-command
- (, (format "%s %s" emerge-rcs-ci-program file)))))
+ (cons `(lambda ()
+ (shell-command
+ ,(format "%s %s" emerge-rcs-ci-program file)))
quit-hooks))
- quit-hooks)))
+ quit-hooks)))
(defun emerge-revisions-internal (file revision-A revision-B &optional
- startup-hooks quit-hooks output-file)
+ startup-hooks quit-hooks output-file)
(let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A)))
(buffer-B (get-buffer-create (format "%s,%s" file revision-B)))
(emerge-file-A (emerge-make-temp-file "A"))
;; Do the merge
(emerge-setup buffer-A emerge-file-A
buffer-B emerge-file-B
- (cons (` (lambda ()
- (delete-file (, emerge-file-A))
- (delete-file (, emerge-file-B))))
+ (cons `(lambda ()
+ (delete-file ,emerge-file-A)
+ (delete-file ,emerge-file-B))
startup-hooks)
- (cons (` (lambda () (emerge-files-exit (, file))))
+ (cons `(lambda () (emerge-files-exit ,file))
quit-hooks)
nil)))
(defun emerge-revision-with-ancestor-internal (file revision-A revision-B
- ancestor
- &optional startup-hooks
- quit-hooks output-file)
+ ancestor
+ &optional startup-hooks
+ quit-hooks output-file)
(let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A)))
(buffer-B (get-buffer-create (format "%s,%s" file revision-B)))
(buffer-ancestor (get-buffer-create (format "%s,%s" file ancestor)))
(emerge-setup-with-ancestor
buffer-A emerge-file-A buffer-B emerge-file-B
buffer-ancestor emerge-ancestor
- (cons (` (lambda ()
- (delete-file (, emerge-file-A))
- (delete-file (, emerge-file-B))
- (delete-file (, emerge-ancestor))))
+ (cons `(lambda ()
+ (delete-file ,emerge-file-A)
+ (delete-file ,emerge-file-B)
+ (delete-file ,emerge-ancestor))
startup-hooks)
- (cons (` (lambda () (emerge-files-exit (, file))))
+ (cons `(lambda () (emerge-files-exit ,file))
quit-hooks)
output-file)))
(goto-char (match-end 0))
;; Store the filename in the right variable
(cond
- ((string-equal tag "a")
- (if file-A
- (error "This line has two `A' entries"))
- (setq file-A file))
- ((string-equal tag "b")
- (if file-B
- (error "This line has two `B' entries"))
- (setq file-B file))
- ((or (string-equal tag "anc") (string-equal tag "ancestor"))
- (if file-ancestor
- (error "This line has two `ancestor' entries"))
- (setq file-ancestor file))
- ((or (string-equal tag "out") (string-equal tag "output"))
- (if file-out
- (error "This line has two `output' entries"))
- (setq file-out file))
- (t
- (error "Unrecognized entry"))))
- ;; If the match on the entry pattern failed
- (error "Unparsable entry")))
+ ((string-equal tag "a")
+ (if file-A
+ (error "This line has two `A' entries"))
+ (setq file-A file))
+ ((string-equal tag "b")
+ (if file-B
+ (error "This line has two `B' entries"))
+ (setq file-B file))
+ ((or (string-equal tag "anc") (string-equal tag "ancestor"))
+ (if file-ancestor
+ (error "This line has two `ancestor' entries"))
+ (setq file-ancestor file))
+ ((or (string-equal tag "out") (string-equal tag "output"))
+ (if file-out
+ (error "This line has two `output' entries"))
+ (setq file-out file))
+ (t
+ (error "Unrecognized entry"))))
+ ;; If the match on the entry pattern failed
+ (error "Unparsable entry")))
;; Make sure that file-A and file-B are present
(if (not (or (and file-A file-B) file-out))
(error "Must have both `A' and `B' entries"))
(beginning-of-line 2)
;; Execute the correct command
(cond
- ;; Merge of two files with ancestor
- ((and file-A file-B file-ancestor)
- (message "Merging %s and %s..." file-A file-B)
- (emerge-files-with-ancestor (not (not file-out)) file-A file-B
- file-ancestor file-out
- nil
- ;; When done, return to this buffer.
- (list
- (` (lambda ()
- (switch-to-buffer (, (current-buffer)))
- (message "Merge done."))))))
- ;; Merge of two files without ancestor
- ((and file-A file-B)
- (message "Merging %s and %s..." file-A file-B)
- (emerge-files (not (not file-out)) file-A file-B file-out
- nil
- ;; When done, return to this buffer.
- (list
- (` (lambda ()
- (switch-to-buffer (, (current-buffer)))
- (message "Merge done."))))))
- ;; There is an output file (or there would have been an error above),
- ;; but only one input file.
- ;; The file appears to have been deleted in one version; do nothing.
- ((and file-ancestor emerge-execute-line-deletions)
- (message "No action."))
- ;; The file should be copied from the version that contains it
- (t (let ((input-file (or file-A file-B)))
- (message "Copying...")
- (copy-file input-file file-out)
- (message "%s copied to %s." input-file file-out))))))
+ ;; Merge of two files with ancestor
+ ((and file-A file-B file-ancestor)
+ (message "Merging %s and %s..." file-A file-B)
+ (emerge-files-with-ancestor (not (not file-out)) file-A file-B
+ file-ancestor file-out
+ nil
+ ;; When done, return to this buffer.
+ (list
+ `(lambda ()
+ (switch-to-buffer ,(current-buffer))
+ (message "Merge done.")))))
+ ;; Merge of two files without ancestor
+ ((and file-A file-B)
+ (message "Merging %s and %s..." file-A file-B)
+ (emerge-files (not (not file-out)) file-A file-B file-out
+ nil
+ ;; When done, return to this buffer.
+ (list
+ `(lambda ()
+ (switch-to-buffer ,(current-buffer))
+ (message "Merge done.")))))
+ ;; There is an output file (or there would have been an error above),
+ ;; but only one input file.
+ ;; The file appears to have been deleted in one version; do nothing.
+ ((and file-ancestor emerge-execute-line-deletions)
+ (message "No action."))
+ ;; The file should be copied from the version that contains it
+ (t (let ((input-file (or file-A file-B)))
+ (message "Copying...")
+ (copy-file input-file file-out)
+ (message "%s copied to %s." input-file file-out))))))
;;; Sample function for creating information for emerge-execute-line
-(defvar emerge-merge-directories-filename-regexp "[^.]"
- "Regexp describing files to be processed by `emerge-merge-directories'.")
+(defcustom emerge-merge-directories-filename-regexp "[^.]"
+ "Regexp describing files to be processed by `emerge-merge-directories'."
+ :type 'regexp
+ :group 'emerge)
+;;;###autoload
(defun emerge-merge-directories (a-dir b-dir ancestor-dir output-dir)
- (interactive
+ (interactive
(list
(read-file-name "A directory: " nil nil 'confirm)
(read-file-name "B directory: " nil nil 'confirm)
(substitute-key-definition 'save-buffer
'emerge-query-save-buffer
emerge-edit-keymap)
- (substitute-key-definition 'write-file 'emerge-query-write-file
- emerge-edit-keymap (current-global-map))
- (substitute-key-definition 'save-buffer 'emerge-query-save-buffer
- emerge-edit-keymap (current-global-map))
+ (define-key emerge-edit-keymap [remap write-file] 'emerge-query-write-file)
+ (define-key emerge-edit-keymap [remap save-buffer] 'emerge-query-save-buffer)
(use-local-map emerge-fast-keymap)
(setq emerge-edit-mode nil)
(setq emerge-fast-mode t))
emerge-merging-values)))))
(defun emerge-restore-buffer-characteristics ()
- "Restores characteristics saved by `emerge-remember-buffer-characteristics'."
+ "Restore characteristics saved by `emerge-remember-buffer-characteristics'."
(let ((A-values emerge-A-buffer-values)
(B-values emerge-B-buffer-values))
(emerge-eval-in-buffer emerge-A-buffer
(emerge-restore-variables emerge-saved-variables
B-values))))
+;; Move to line DESIRED-LINE assuming we are at line CURRENT-LINE.
+;; Return DESIRED-LINE.
+(defun emerge-goto-line (desired-line current-line)
+ (forward-line (- desired-line current-line))
+ desired-line)
+
(defun emerge-convert-diffs-to-markers (A-buffer
B-buffer
merge-buffer
(let* (marker-list
(A-point-min (emerge-eval-in-buffer A-buffer (point-min)))
(offset (1- A-point-min))
- (A-hidden-lines (emerge-eval-in-buffer
- A-buffer
- (save-restriction
- (widen)
- (count-lines 1 A-point-min))))
(B-point-min (emerge-eval-in-buffer B-buffer (point-min)))
- (B-hidden-lines (emerge-eval-in-buffer
- B-buffer
- (save-restriction
- (widen)
- (count-lines 1 B-point-min)))))
+ ;; Record current line number in each buffer
+ ;; so we don't have to count from the beginning.
+ (a-line 1)
+ (b-line 1))
+ (emerge-eval-in-buffer A-buffer (goto-char (point-min)))
+ (emerge-eval-in-buffer B-buffer (goto-char (point-min)))
(while lineno-list
(let* ((list-element (car lineno-list))
a-begin-marker
;; place markers at the appropriate places in the buffers
(emerge-eval-in-buffer
A-buffer
- (goto-line (+ a-begin A-hidden-lines))
+ (setq a-line (emerge-goto-line a-begin a-line))
(setq a-begin-marker (point-marker))
- (goto-line (+ a-end A-hidden-lines))
+ (setq a-line (emerge-goto-line a-end a-line))
(setq a-end-marker (point-marker)))
(emerge-eval-in-buffer
B-buffer
- (goto-line (+ b-begin B-hidden-lines))
+ (setq b-line (emerge-goto-line b-begin b-line))
(setq b-begin-marker (point-marker))
- (goto-line (+ b-end B-hidden-lines))
+ (setq b-line (emerge-goto-line b-end b-line))
(setq b-end-marker (point-marker)))
(setq merge-begin-marker (set-marker
(make-marker)
;; fast access
(setq emerge-difference-list (apply 'vector (nreverse marker-list)))))
-;; If we have an ancestor, select all B variants that we prefer
+;; If we have an ancestor, select all B variants that we prefer
(defun emerge-select-prefer-Bs ()
(let ((n 0))
(while (< n emerge-number-of-differences)
(let* ((merge-buffer emerge-merge-buffer)
(buffer-A emerge-A-buffer)
(buffer-B emerge-B-buffer)
- (window-A (get-buffer-window buffer-A))
- (window-B (get-buffer-window buffer-B))
+ (window-A (get-buffer-window buffer-A 'visible))
+ (window-B (get-buffer-window buffer-B 'visible))
(merge-window (get-buffer-window merge-buffer))
(diff-vector
(aref emerge-difference-list emerge-current-difference)))
(let* ((merge-buffer emerge-merge-buffer)
(buffer-A emerge-A-buffer)
(buffer-B emerge-B-buffer)
- (window-A (get-buffer-window buffer-A))
- (window-B (get-buffer-window buffer-B))
+ (window-A (get-buffer-window buffer-A 'visible))
+ (window-B (get-buffer-window buffer-B 'visible))
(merge-window (get-buffer-window merge-buffer)))
(if window-A (progn
(select-window window-A)
`C-u -' alone as argument scrolls half the height of the merge window."
(interactive "P")
(emerge-operate-on-windows
- 'scroll-up
+ 'scroll-up
;; calculate argument to scroll-up
;; if there is an explicit argument
(if (and arg (not (equal arg '-)))
;; If there are min-lines lines above and below the region, then don't do
;; anything.
;; If not, recenter the region to make it so.
-;; If that isn't possible, remove context lines balancedly from top and botton
+;; If that isn't possible, remove context lines balancedly from top and bottom
;; so the entire region shows.
;; If that isn't possible, show the top of the region.
;; BEG must be at the beginning of a line.
(run-hooks 'emerge-quit-hook)))
(defun emerge-select-A (&optional force)
- "Select the A variant of this difference.
+ "Select the A variant of this difference.
Refuses to function if this difference has been edited, i.e., if it
is neither the A nor the B variant.
A prefix argument forces the variant to be selected
(setq emerge-fast-mode t)
(setq emerge-edit-mode nil)
(message "Fast mode set")
- ;; force mode line redisplay
- (set-buffer-modified-p (buffer-modified-p)))
+ (force-mode-line-update))
(defun emerge-edit-mode ()
"Set edit mode, for Emerge.
(setq emerge-fast-mode nil)
(setq emerge-edit-mode t)
(message "Edit mode set")
- ;; force mode line redisplay
- (set-buffer-modified-p (buffer-modified-p)))
+ (force-mode-line-update))
(defun emerge-auto-advance (arg)
"Toggle Auto-Advance mode, for Emerge.
(setq emerge-auto-advance (if (null arg)
(not emerge-auto-advance)
(> (prefix-numeric-value arg) 0)))
- (message (if emerge-skip-prefers
+ (message (if emerge-auto-advance
"Auto-advance set"
"Auto-advance cleared"))
- ;; force mode line redisplay
- (set-buffer-modified-p (buffer-modified-p)))
+ (force-mode-line-update))
(defun emerge-skip-prefers (arg)
"Toggle Skip-Prefers mode, for Emerge.
(message (if emerge-skip-prefers
"Skip-prefers set"
"Skip-prefers cleared"))
- ;; force mode line redisplay
- (set-buffer-modified-p (buffer-modified-p)))
+ (force-mode-line-update))
(defun emerge-copy-as-kill-A ()
"Put the A variant of this difference in the kill ring."
(princ "Ancestor buffer is: ")
(princ (buffer-name))))
(princ "\n")))
- (princ emerge-output-description))))
+ (princ emerge-output-description)
+ (save-excursion
+ (set-buffer standard-output)
+ (help-mode)))))
(defun emerge-join-differences (arg)
"Join the selected difference with the following one.
(if (= c ?%)
(progn
(setq i (1+ i))
- (setq c
+ (setq c
(condition-case nil
(aref template i)
(error ?%)))
(cond ((= c ?a)
(insert-buffer-substring emerge-A-buffer A-begin A-end))
- ((= c ?b)
+ ((= c ?b)
(insert-buffer-substring emerge-B-buffer B-begin B-end))
- ((= c ?%)
+ ((= c ?%)
(insert ?%))
(t
(insert c))))
;; Read a file name, handling all of the various defaulting rules.
(defun emerge-read-file-name (prompt alternative-default-dir default-file
- A-file)
+ A-file must-match)
;; `prompt' should not have trailing ": ", so that it can be modified
;; according to context.
;; If alternative-default-dir is non-nil, it should be used as the default
alternative-default-dir
(concat alternative-default-dir
(file-name-nondirectory A-file))
- 'confirm))
+ (and must-match 'confirm)))
;; If there is a default file, use it.
(default-file
(read-file-name (format "%s (default %s): " prompt default-file)
;; Emerge as the default for this argument.
(and emerge-default-last-directories
alternative-default-dir)
- default-file 'confirm))
+ default-file (and must-match 'confirm)))
(t
(read-file-name (concat prompt ": ")
;; If emerge-default-last-directories is set, use the
;; Emerge as the default for this argument.
(and emerge-default-last-directories
alternative-default-dir)
- nil 'confirm))))
+ nil (and must-match 'confirm)))))
;; Revise the mode line to display which difference we have selected
(prefer-B . " - B*")
(combined . " - comb"))))
""))))
- ;; Force mode-line redisplay
- (set-buffer-modified-p (buffer-modified-p)))
+ (force-mode-line-update))
;; compare two regions in two buffers for containing the same text
(defun emerge-compare-buffers (buffer-x x-begin x-end buffer-y y-begin y-end)
(while (< x-begin x-end)
;; bite off and compare no more than 1000 characters at a time
(let* ((compare-length (min (- x-end x-begin) 1000))
- (x-string (emerge-eval-in-buffer
+ (x-string (emerge-eval-in-buffer
buffer-x
(buffer-substring x-begin
(+ x-begin compare-length))))
t)))
;; Construct a unique buffer name.
-;; The first one tried is prefixsuffix, then prefix<2>suffix,
+;; The first one tried is prefixsuffix, then prefix<2>suffix,
;; prefix<3>suffix, etc.
(defun emerge-unique-buffer-name (prefix suffix)
(if (null (get-buffer (concat prefix suffix)))
;; a list of variables. The argument is a list of symbols (the names of
;; the variables). A list element can also be a list of two functions,
;; the first of which (when called with no arguments) gets the value, and
-;; the second (when called with a value as an argment) sets the value.
+;; the second (when called with a value as an argument) sets the value.
;; A "function" is anything that funcall can handle as an argument.
(defun emerge-save-variables (vars)
;; Make a temporary file that only we have access to.
;; PREFIX is appended to emerge-temp-file-prefix to make the filename prefix.
(defun emerge-make-temp-file (prefix)
- (let ((f (make-temp-name (concat emerge-temp-file-prefix prefix))))
- ;; create the file
- (write-region (point-min) (point-min) f nil 'no-message)
- (set-file-modes f emerge-temp-file-mode)
+ (let (f (old-modes (default-file-modes)))
+ (unwind-protect
+ (progn
+ (set-default-file-modes emerge-temp-file-mode)
+ (setq f (make-temp-file (concat emerge-temp-file-prefix prefix))))
+ (set-default-file-modes old-modes))
f))
;;; Functions that query the user before he can write out the current buffer.
;; minor-mode indicator))
;; (princ (documentation minor-mode)))))
;; (setq minor-modes (cdr minor-modes))))
+;; (save-excursion
+;; (set-buffer standard-output)
+;; (help-mode))
;; (print-help-return-message)))
;; This goes with the redefinition of describe-mode.
(setq name "Buffer has no file name."))
(save-window-excursion
(select-window (minibuffer-window))
- (erase-buffer)
- (insert name)
- (if (not (pos-visible-in-window-p))
- (let ((echo-keystrokes 0))
- (while (and (not (pos-visible-in-window-p))
- (> (1- (screen-height)) (window-height)))
- (enlarge-window 1))
- (let ((c (read-event)))
+ (unwind-protect
+ (progn
+ (erase-buffer)
+ (insert name)
+ (if (not (pos-visible-in-window-p))
+ (while (and (not (pos-visible-in-window-p))
+ (> (1- (frame-height)) (window-height)))
+ (enlarge-window 1)))
+ (let* ((echo-keystrokes 0)
+ (c (read-event)))
(if (not (eq c 32))
- (setq unread-command-events (list c)))))))))
+ (setq unread-command-events (list c)))))
+ (erase-buffer)))))
;; Improved auto-save file names.
;; This function fixes many problems with the standard auto-save file names:
;; Metacharacters that have to be protected from the shell when executing
;; a diff/diff3 command.
-(defvar emerge-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]"
+(defcustom emerge-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]"
"Characters that must be quoted with \\ when used in a shell command line.
-More precisely, a [...] regexp to match any one such character.")
+More precisely, a [...] regexp to match any one such character."
+ :type 'regexp
+ :group 'emerge)
;; Quote metacharacters (using \) when executing a diff/diff3 command.
(defun emerge-protect-metachars (s)
(provide 'emerge)
+;;; arch-tag: a575f092-6e44-400e-b8a2-4124e9377585
;;; emerge.el ends here