X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c880b9d57d31ec0c4bb8138a2d72e73438781941..4e0299e5780136c89f9286cbb101e2208b8eb5fe:/lisp/emerge.el diff --git a/lisp/emerge.el b/lisp/emerge.el index f3a7b25f6b..447e45f14f 100644 --- a/lisp/emerge.el +++ b/lisp/emerge.el @@ -2,7 +2,9 @@ ;;; The author has placed this file in the public domain. -;; Author: Dale R. Worley +;; This file is part of GNU Emacs. + +;; Author: Dale R. Worley ;; Version: 5fsf ;; Keywords: unix, tools @@ -19,57 +21,63 @@ ;; LOST DATA OR LOST PROFITS, OR FOR ANY SPECIAL, INCIDENTAL OR CONSEQUENTIAL ;; DAMAGES. +;;; Commentary: + ;;; Code: ;;;###autoload (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] - '("Merge Directories ..." . emerge-merge-directories)) -;;;###autoload -(define-key menu-bar-emerge-menu [emerge-revisions-with-ancestor] - '("Revisions with Ancestor ..." . emerge-revisions-with-ancestor)) -;;;###autoload -(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)) +;;;###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)) + +;; There aren't really global variables, just dynamic bindings +(defvar A-begin) +(defvar A-end) +(defvar B-begin) +(defvar B-end) +(defvar diff) +(defvar diff-vector) +(defvar merge-begin) +(defvar merge-end) +(defvar template) +(defvar valid-diff) ;;; 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 @@ -113,80 +121,117 @@ When called interactively, displays the version." ;;; 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.") @@ -246,29 +291,26 @@ depend on the flags." ;; 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 (or (getenv "TMPDIR") - (getenv "TMP") - (getenv "TEMP"))) - 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 @@ -276,7 +318,9 @@ The template is inserted as a string, with the following interpolations: %% 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 @@ -298,9 +342,11 @@ Makes Emerge commands directly available.") (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. @@ -358,10 +404,8 @@ Must be set before Emerge is loaded.") ;; 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)) @@ -525,7 +569,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") ;;; 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)) @@ -538,17 +582,17 @@ This is *not* a user option, since Emerge uses it for its own processing.") (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) @@ -556,10 +600,10 @@ This is *not* a user option, since Emerge uses it for its own processing.") (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))) @@ -625,20 +669,20 @@ This is *not* a user option, since Emerge uses it for its own processing.") diff-buffer (goto-char (point-min)) (while (re-search-forward emerge-match-diff-line nil t) - (let* ((a-begin (string-to-int (buffer-substring (match-beginning 1) - (match-end 1)))) + (let* ((a-begin (string-to-number (buffer-substring (match-beginning 1) + (match-end 1)))) (a-end (let ((b (match-beginning 3)) (e (match-end 3))) (if b - (string-to-int (buffer-substring b e)) + (string-to-number (buffer-substring b e)) a-begin))) (diff-type (buffer-substring (match-beginning 4) (match-end 4))) - (b-begin (string-to-int (buffer-substring (match-beginning 5) - (match-end 5)))) + (b-begin (string-to-number (buffer-substring (match-beginning 5) + (match-end 5)))) (b-end (let ((b (match-beginning 7)) (e (match-end 7))) (if b - (string-to-int (buffer-substring b e)) + (string-to-number (buffer-substring b e)) b-begin)))) ;; fix the beginning and end numbers, because diff is somewhat ;; strange about how it numbers lines @@ -699,10 +743,10 @@ This is *not* a user option, since Emerge uses it for its own processing.") (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) @@ -710,10 +754,10 @@ This is *not* a user option, since Emerge uses it for its own processing.") (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) @@ -721,10 +765,10 @@ This is *not* a user option, since Emerge uses it for its own processing.") (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))) @@ -802,7 +846,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") ;; 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")) @@ -830,16 +874,16 @@ This is *not* a user option, since Emerge uses it for its own processing.") ;; it is a "c" group (if (match-beginning 2) ;; it has two numbers - (list (string-to-int + (list (string-to-number (buffer-substring (match-beginning 1) (match-end 1))) - (1+ (string-to-int + (1+ (string-to-number (buffer-substring (match-beginning 3) (match-end 3))))) ;; it has one number - (let ((x (string-to-int + (let ((x (string-to-number (buffer-substring (match-beginning 1) (match-end 1))))) (list x (1+ x)))) ;; it is an "a" group - (let ((x (1+ (string-to-int + (let ((x (1+ (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))))) (list x x))))) @@ -853,17 +897,16 @@ This is *not* a user option, since Emerge uses it for its own processing.") (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 @@ -874,19 +917,18 @@ This is *not* a user option, since Emerge uses it for its own processing.") (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. @@ -911,17 +953,17 @@ This is *not* a user option, since Emerge uses it for its own processing.") (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: ") @@ -942,11 +984,11 @@ This is *not* a user option, since Emerge uses it for its own processing.") (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))) @@ -961,7 +1003,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") (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 () @@ -975,16 +1017,16 @@ This is *not* a user option, since Emerge uses it for its own processing.") (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))) @@ -996,7 +1038,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") (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)) @@ -1005,7 +1047,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") (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)) @@ -1030,17 +1072,17 @@ This is *not* a user option, since Emerge uses it for its own processing.") (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 @@ -1055,14 +1097,14 @@ This is *not* a user option, since Emerge uses it for its own processing.") 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")) @@ -1087,18 +1129,18 @@ This is *not* a user option, since Emerge uses it for its own processing.") ;; 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))) @@ -1135,12 +1177,12 @@ This is *not* a user option, since Emerge uses it for its own processing.") (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))) @@ -1185,26 +1227,26 @@ Otherwise, the A or B file present is copied to the 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")) @@ -1215,46 +1257,48 @@ Otherwise, the A or B file present is copied to the output file." (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) @@ -1390,10 +1434,8 @@ Otherwise, the A or B file present is copied to the output file." (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)) @@ -1424,7 +1466,7 @@ These characteristics are restored by `emerge-restore-buffer-characteristics'." 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 @@ -1501,7 +1543,7 @@ These characteristics are restored by `emerge-restore-buffer-characteristics'." ;; 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) @@ -1625,7 +1667,7 @@ the height of the merge window. `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 '-))) @@ -1741,7 +1783,7 @@ to the left margin, if they are in windows." ;; 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. @@ -1868,7 +1910,7 @@ buffer after this will cause serious problems." (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 @@ -1980,8 +2022,7 @@ need not be prefixed with \\\\[emerge-basic-keymap]." (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. @@ -1994,8 +2035,7 @@ must be prefixed with \\\\[emerge-basic-keymap]." (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. @@ -2010,8 +2050,7 @@ With a negative argument, turn off Auto-Advance mode." (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. @@ -2026,8 +2065,7 @@ With a negative argument, turn off Skip-Prefers mode." (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." @@ -2148,7 +2186,10 @@ Use C-u l to reset the windows afterward." (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. @@ -2542,15 +2583,15 @@ been edited." (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)))) @@ -2734,7 +2775,7 @@ keymap. Leaves merge in fast mode." ;; 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 @@ -2762,7 +2803,7 @@ keymap. Leaves merge in fast mode." 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) @@ -2771,7 +2812,7 @@ keymap. Leaves merge in fast mode." ;; 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 @@ -2779,7 +2820,7 @@ keymap. Leaves merge in fast mode." ;; 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 @@ -2800,8 +2841,7 @@ keymap. Leaves merge in fast mode." (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) @@ -2812,7 +2852,7 @@ keymap. Leaves merge in fast mode." (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)))) @@ -2827,7 +2867,7 @@ keymap. Leaves merge in fast mode." 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))) @@ -2849,7 +2889,7 @@ keymap. Leaves merge in fast mode." ;; 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) @@ -2871,10 +2911,12 @@ keymap. Leaves merge in fast mode." ;; 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. @@ -2989,6 +3031,9 @@ If some prefix of KEY has a non-prefix definition, it is redefined." ;; 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. @@ -3065,16 +3110,19 @@ SPC, it is ignored; if it is anything else, it is processed as a command." (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: @@ -3155,9 +3203,11 @@ See also `auto-save-file-name-p'." ;; 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) @@ -3171,4 +3221,5 @@ More precisely, a [...] regexp to match any one such character.") (provide 'emerge) +;;; arch-tag: a575f092-6e44-400e-b8a2-4124e9377585 ;;; emerge.el ends here