57 |
(defmacro emerge-eval-in-buffer (buffer &rest forms) |
(defmacro emerge-eval-in-buffer (buffer &rest forms) |
58 |
"Macro to switch to BUFFER, evaluate FORMS, returns to original buffer. |
"Macro to switch to BUFFER, evaluate FORMS, returns to original buffer. |
59 |
Differs from `save-excursion' in that it doesn't save the point and mark." |
Differs from `save-excursion' in that it doesn't save the point and mark." |
60 |
(` (let ((StartBuffer (current-buffer))) |
`(let ((StartBuffer (current-buffer))) |
61 |
(unwind-protect |
(unwind-protect |
62 |
(progn |
(progn |
63 |
(set-buffer (, buffer)) |
(set-buffer ,buffer) |
64 |
(,@ forms)) |
,@forms) |
65 |
(set-buffer StartBuffer))))) |
(set-buffer StartBuffer)))) |
66 |
|
|
67 |
(defmacro emerge-defvar-local (var value doc) |
(defmacro emerge-defvar-local (var value doc) |
68 |
"Defines SYMBOL as an advertised variable. |
"Defines SYMBOL as an advertised variable. |
70 |
the variable. Also sets the `preserved' property, so that |
the variable. Also sets the `preserved' property, so that |
71 |
`kill-all-local-variables' (called by major-mode setting commands) |
`kill-all-local-variables' (called by major-mode setting commands) |
72 |
won't destroy Emerge control variables." |
won't destroy Emerge control variables." |
73 |
(` (progn |
`(progn |
74 |
(defvar (, var) (, value) (, doc)) |
(defvar ,var ,value ,doc) |
75 |
(make-variable-buffer-local '(, var)) |
(make-variable-buffer-local ',var) |
76 |
(put '(, var) 'preserved t)))) |
(put ',var 'preserved t))) |
77 |
|
|
78 |
;; Add entries to minor-mode-alist so that emerge modes show correctly |
;; Add entries to minor-mode-alist so that emerge modes show correctly |
79 |
(defvar emerge-minor-modes-list |
(defvar emerge-minor-modes-list |
567 |
;;; Setup functions for two-file mode. |
;;; Setup functions for two-file mode. |
568 |
|
|
569 |
(defun emerge-files-internal (file-A file-B &optional startup-hooks quit-hooks |
(defun emerge-files-internal (file-A file-B &optional startup-hooks quit-hooks |
570 |
output-file) |
output-file) |
571 |
(if (not (file-readable-p file-A)) |
(if (not (file-readable-p file-A)) |
572 |
(error "File `%s' does not exist or is not readable" file-A)) |
(error "File `%s' does not exist or is not readable" file-A)) |
573 |
(if (not (file-readable-p file-B)) |
(if (not (file-readable-p file-B)) |
587 |
(if temp |
(if temp |
588 |
(setq file-A temp |
(setq file-A temp |
589 |
startup-hooks |
startup-hooks |
590 |
(cons (` (lambda () (delete-file (, file-A)))) |
(cons `(lambda () (delete-file ,file-A)) |
591 |
startup-hooks)) |
startup-hooks)) |
592 |
;; Verify that the file matches the buffer |
;; Verify that the file matches the buffer |
593 |
(emerge-verify-file-buffer)))) |
(emerge-verify-file-buffer)))) |
594 |
(emerge-eval-in-buffer |
(emerge-eval-in-buffer |
595 |
buffer-B |
buffer-B |
596 |
(widen) |
(widen) |
598 |
(if temp |
(if temp |
599 |
(setq file-B temp |
(setq file-B temp |
600 |
startup-hooks |
startup-hooks |
601 |
(cons (` (lambda () (delete-file (, file-B)))) |
(cons `(lambda () (delete-file ,file-B)) |
602 |
startup-hooks)) |
startup-hooks)) |
603 |
;; Verify that the file matches the buffer |
;; Verify that the file matches the buffer |
604 |
(emerge-verify-file-buffer)))) |
(emerge-verify-file-buffer)))) |
605 |
(emerge-setup buffer-A file-A buffer-B file-B startup-hooks quit-hooks |
(emerge-setup buffer-A file-A buffer-B file-B startup-hooks quit-hooks |
606 |
output-file))) |
output-file))) |
607 |
|
|
741 |
(if temp |
(if temp |
742 |
(setq file-A temp |
(setq file-A temp |
743 |
startup-hooks |
startup-hooks |
744 |
(cons (` (lambda () (delete-file (, file-A)))) |
(cons `(lambda () (delete-file ,file-A)) |
745 |
startup-hooks)) |
startup-hooks)) |
746 |
;; Verify that the file matches the buffer |
;; Verify that the file matches the buffer |
747 |
(emerge-verify-file-buffer)))) |
(emerge-verify-file-buffer)))) |
748 |
(emerge-eval-in-buffer |
(emerge-eval-in-buffer |
749 |
buffer-B |
buffer-B |
750 |
(widen) |
(widen) |
752 |
(if temp |
(if temp |
753 |
(setq file-B temp |
(setq file-B temp |
754 |
startup-hooks |
startup-hooks |
755 |
(cons (` (lambda () (delete-file (, file-B)))) |
(cons `(lambda () (delete-file ,file-B)) |
756 |
startup-hooks)) |
startup-hooks)) |
757 |
;; Verify that the file matches the buffer |
;; Verify that the file matches the buffer |
758 |
(emerge-verify-file-buffer)))) |
(emerge-verify-file-buffer)))) |
759 |
(emerge-eval-in-buffer |
(emerge-eval-in-buffer |
760 |
buffer-ancestor |
buffer-ancestor |
761 |
(widen) |
(widen) |
763 |
(if temp |
(if temp |
764 |
(setq file-ancestor temp |
(setq file-ancestor temp |
765 |
startup-hooks |
startup-hooks |
766 |
(cons (` (lambda () (delete-file (, file-ancestor)))) |
(cons `(lambda () (delete-file ,file-ancestor)) |
767 |
startup-hooks)) |
startup-hooks)) |
768 |
;; Verify that the file matches the buffer |
;; Verify that the file matches the buffer |
769 |
(emerge-verify-file-buffer)))) |
(emerge-verify-file-buffer)))) |
770 |
(emerge-setup-with-ancestor buffer-A file-A buffer-B file-B |
(emerge-setup-with-ancestor buffer-A file-A buffer-B file-B |
771 |
buffer-ancestor file-ancestor |
buffer-ancestor file-ancestor |
772 |
startup-hooks quit-hooks output-file))) |
startup-hooks quit-hooks output-file))) |
901 |
(emerge-read-file-name "Output file" emerge-last-dir-output |
(emerge-read-file-name "Output file" emerge-last-dir-output |
902 |
f f nil))))) |
f f nil))))) |
903 |
(if file-out |
(if file-out |
904 |
(add-hook 'quit-hooks (` (lambda () (emerge-files-exit (, file-out)))))) |
(add-hook 'quit-hooks `(lambda () (emerge-files-exit ,file-out)))) |
905 |
(emerge-files-internal |
(emerge-files-internal |
906 |
file-A file-B startup-hooks |
file-A file-B startup-hooks |
907 |
quit-hooks |
quit-hooks |
923 |
(emerge-read-file-name "Output file" emerge-last-dir-output |
(emerge-read-file-name "Output file" emerge-last-dir-output |
924 |
f f nil))))) |
f f nil))))) |
925 |
(if file-out |
(if file-out |
926 |
(add-hook 'quit-hooks (` (lambda () (emerge-files-exit (, file-out)))))) |
(add-hook 'quit-hooks `(lambda () (emerge-files-exit ,file-out)))) |
927 |
(emerge-files-with-ancestor-internal |
(emerge-files-with-ancestor-internal |
928 |
file-A file-B file-ancestor startup-hooks |
file-A file-B file-ancestor startup-hooks |
929 |
quit-hooks |
quit-hooks |
951 |
(write-region (point-min) (point-max) emerge-file-B nil 'no-message)) |
(write-region (point-min) (point-max) emerge-file-B nil 'no-message)) |
952 |
(emerge-setup (get-buffer buffer-A) emerge-file-A |
(emerge-setup (get-buffer buffer-A) emerge-file-A |
953 |
(get-buffer buffer-B) emerge-file-B |
(get-buffer buffer-B) emerge-file-B |
954 |
(cons (` (lambda () |
(cons `(lambda () |
955 |
(delete-file (, emerge-file-A)) |
(delete-file ,emerge-file-A) |
956 |
(delete-file (, emerge-file-B)))) |
(delete-file ,emerge-file-B)) |
957 |
startup-hooks) |
startup-hooks) |
958 |
quit-hooks |
quit-hooks |
959 |
nil))) |
nil))) |
960 |
|
|
961 |
;;;###autoload |
;;;###autoload |
962 |
(defun emerge-buffers-with-ancestor (buffer-A buffer-B buffer-ancestor |
(defun emerge-buffers-with-ancestor (buffer-A buffer-B buffer-ancestor |
963 |
&optional startup-hooks |
&optional startup-hooks |
964 |
quit-hooks) |
quit-hooks) |
965 |
"Run Emerge on two buffers, giving another buffer as the ancestor." |
"Run Emerge on two buffers, giving another buffer as the ancestor." |
966 |
(interactive |
(interactive |
967 |
"bBuffer A to merge: \nbBuffer B to merge: \nbAncestor buffer: ") |
"bBuffer A to merge: \nbBuffer B to merge: \nbAncestor buffer: ") |
982 |
(get-buffer buffer-B) emerge-file-B |
(get-buffer buffer-B) emerge-file-B |
983 |
(get-buffer buffer-ancestor) |
(get-buffer buffer-ancestor) |
984 |
emerge-file-ancestor |
emerge-file-ancestor |
985 |
(cons (` (lambda () |
(cons `(lambda () |
986 |
(delete-file (, emerge-file-A)) |
(delete-file ,emerge-file-A) |
987 |
(delete-file (, emerge-file-B)) |
(delete-file ,emerge-file-B) |
988 |
(delete-file |
(delete-file |
989 |
(, emerge-file-ancestor)))) |
,emerge-file-ancestor)) |
990 |
startup-hooks) |
startup-hooks) |
991 |
quit-hooks |
quit-hooks |
992 |
nil))) |
nil))) |
1001 |
(setq command-line-args-left (nthcdr 3 command-line-args-left)) |
(setq command-line-args-left (nthcdr 3 command-line-args-left)) |
1002 |
(emerge-files-internal |
(emerge-files-internal |
1003 |
file-a file-b nil |
file-a file-b nil |
1004 |
(list (` (lambda () (emerge-command-exit (, file-out)))))))) |
(list `(lambda () (emerge-command-exit ,file-out)))))) |
1005 |
|
|
1006 |
;;;###autoload |
;;;###autoload |
1007 |
(defun emerge-files-with-ancestor-command () |
(defun emerge-files-with-ancestor-command () |
1015 |
(setq file-anc (nth 1 command-line-args-left)) |
(setq file-anc (nth 1 command-line-args-left)) |
1016 |
(setq file-out (nth 4 command-line-args-left)) |
(setq file-out (nth 4 command-line-args-left)) |
1017 |
(setq command-line-args-left (nthcdr 5 command-line-args-left))) |
(setq command-line-args-left (nthcdr 5 command-line-args-left))) |
1018 |
;; arguments are "file-a file-b ancestor file-out" |
;; arguments are "file-a file-b ancestor file-out" |
1019 |
(setq file-a (nth 0 command-line-args-left)) |
(setq file-a (nth 0 command-line-args-left)) |
1020 |
(setq file-b (nth 1 command-line-args-left)) |
(setq file-b (nth 1 command-line-args-left)) |
1021 |
(setq file-anc (nth 2 command-line-args-left)) |
(setq file-anc (nth 2 command-line-args-left)) |
1022 |
(setq file-out (nth 3 command-line-args-left)) |
(setq file-out (nth 3 command-line-args-left)) |
1023 |
(setq command-line-args-left (nthcdr 4 command-line-args-left))) |
(setq command-line-args-left (nthcdr 4 command-line-args-left))) |
1024 |
(emerge-files-with-ancestor-internal |
(emerge-files-with-ancestor-internal |
1025 |
file-a file-b file-anc nil |
file-a file-b file-anc nil |
1026 |
(list (` (lambda () (emerge-command-exit (, file-out)))))))) |
(list `(lambda () (emerge-command-exit ,file-out)))))) |
1027 |
|
|
1028 |
(defun emerge-command-exit (file-out) |
(defun emerge-command-exit (file-out) |
1029 |
(emerge-write-and-delete file-out) |
(emerge-write-and-delete file-out) |
1036 |
(setq emerge-file-out file-out) |
(setq emerge-file-out file-out) |
1037 |
(emerge-files-internal |
(emerge-files-internal |
1038 |
file-a file-b nil |
file-a file-b nil |
1039 |
(list (` (lambda () (emerge-remote-exit (, file-out) '(, emerge-exit-func))))) |
(list `(lambda () (emerge-remote-exit ,file-out ',emerge-exit-func))) |
1040 |
file-out) |
file-out) |
1041 |
(throw 'client-wait nil)) |
(throw 'client-wait nil)) |
1042 |
|
|
1045 |
(setq emerge-file-out file-out) |
(setq emerge-file-out file-out) |
1046 |
(emerge-files-with-ancestor-internal |
(emerge-files-with-ancestor-internal |
1047 |
file-a file-b file-anc nil |
file-a file-b file-anc nil |
1048 |
(list (` (lambda () (emerge-remote-exit (, file-out) '(, emerge-exit-func))))) |
(list `(lambda () (emerge-remote-exit ,file-out ',emerge-exit-func))) |
1049 |
file-out) |
file-out) |
1050 |
(throw 'client-wait nil)) |
(throw 'client-wait nil)) |
1051 |
|
|
1070 |
(emerge-revisions-internal |
(emerge-revisions-internal |
1071 |
file revision-A revision-B startup-hooks |
file revision-A revision-B startup-hooks |
1072 |
(if arg |
(if arg |
1073 |
(cons (` (lambda () |
(cons `(lambda () |
1074 |
(shell-command |
(shell-command |
1075 |
(, (format "%s %s" emerge-rcs-ci-program file))))) |
,(format "%s %s" emerge-rcs-ci-program file))) |
1076 |
quit-hooks) |
quit-hooks) |
1077 |
quit-hooks))) |
quit-hooks))) |
1078 |
|
|
1079 |
;;;###autoload |
;;;###autoload |
1080 |
(defun emerge-revisions-with-ancestor (arg file revision-A |
(defun emerge-revisions-with-ancestor (arg file revision-A |
1081 |
revision-B ancestor |
revision-B ancestor |
1082 |
&optional |
&optional |
1083 |
startup-hooks quit-hooks) |
startup-hooks quit-hooks) |
1084 |
"Emerge two RCS revisions of a file, with another revision as ancestor." |
"Emerge two RCS revisions of a file, with another revision as ancestor." |
1085 |
(interactive |
(interactive |
1086 |
(list current-prefix-arg |
(list current-prefix-arg |
1095 |
file revision-A revision-B ancestor startup-hooks |
file revision-A revision-B ancestor startup-hooks |
1096 |
(if arg |
(if arg |
1097 |
(let ((cmd )) |
(let ((cmd )) |
1098 |
(cons (` (lambda () |
(cons `(lambda () |
1099 |
(shell-command |
(shell-command |
1100 |
(, (format "%s %s" emerge-rcs-ci-program file))))) |
,(format "%s %s" emerge-rcs-ci-program file))) |
1101 |
quit-hooks)) |
quit-hooks)) |
1102 |
quit-hooks))) |
quit-hooks))) |
1103 |
|
|
1104 |
(defun emerge-revisions-internal (file revision-A revision-B &optional |
(defun emerge-revisions-internal (file revision-A revision-B &optional |
1105 |
startup-hooks quit-hooks output-file) |
startup-hooks quit-hooks output-file) |
1106 |
(let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A))) |
(let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A))) |
1107 |
(buffer-B (get-buffer-create (format "%s,%s" file revision-B))) |
(buffer-B (get-buffer-create (format "%s,%s" file revision-B))) |
1108 |
(emerge-file-A (emerge-make-temp-file "A")) |
(emerge-file-A (emerge-make-temp-file "A")) |
1127 |
;; Do the merge |
;; Do the merge |
1128 |
(emerge-setup buffer-A emerge-file-A |
(emerge-setup buffer-A emerge-file-A |
1129 |
buffer-B emerge-file-B |
buffer-B emerge-file-B |
1130 |
(cons (` (lambda () |
(cons `(lambda () |
1131 |
(delete-file (, emerge-file-A)) |
(delete-file ,emerge-file-A) |
1132 |
(delete-file (, emerge-file-B)))) |
(delete-file ,emerge-file-B)) |
1133 |
startup-hooks) |
startup-hooks) |
1134 |
(cons (` (lambda () (emerge-files-exit (, file)))) |
(cons `(lambda () (emerge-files-exit ,file)) |
1135 |
quit-hooks) |
quit-hooks) |
1136 |
nil))) |
nil))) |
1137 |
|
|
1138 |
(defun emerge-revision-with-ancestor-internal (file revision-A revision-B |
(defun emerge-revision-with-ancestor-internal (file revision-A revision-B |
1139 |
ancestor |
ancestor |
1140 |
&optional startup-hooks |
&optional startup-hooks |
1141 |
quit-hooks output-file) |
quit-hooks output-file) |
1142 |
(let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A))) |
(let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A))) |
1143 |
(buffer-B (get-buffer-create (format "%s,%s" file revision-B))) |
(buffer-B (get-buffer-create (format "%s,%s" file revision-B))) |
1144 |
(buffer-ancestor (get-buffer-create (format "%s,%s" file ancestor))) |
(buffer-ancestor (get-buffer-create (format "%s,%s" file ancestor))) |
1175 |
(emerge-setup-with-ancestor |
(emerge-setup-with-ancestor |
1176 |
buffer-A emerge-file-A buffer-B emerge-file-B |
buffer-A emerge-file-A buffer-B emerge-file-B |
1177 |
buffer-ancestor emerge-ancestor |
buffer-ancestor emerge-ancestor |
1178 |
(cons (` (lambda () |
(cons `(lambda () |
1179 |
(delete-file (, emerge-file-A)) |
(delete-file ,emerge-file-A) |
1180 |
(delete-file (, emerge-file-B)) |
(delete-file ,emerge-file-B) |
1181 |
(delete-file (, emerge-ancestor)))) |
(delete-file ,emerge-ancestor)) |
1182 |
startup-hooks) |
startup-hooks) |
1183 |
(cons (` (lambda () (emerge-files-exit (, file)))) |
(cons `(lambda () (emerge-files-exit ,file)) |
1184 |
quit-hooks) |
quit-hooks) |
1185 |
output-file))) |
output-file))) |
1186 |
|
|
1225 |
(goto-char (match-end 0)) |
(goto-char (match-end 0)) |
1226 |
;; Store the filename in the right variable |
;; Store the filename in the right variable |
1227 |
(cond |
(cond |
1228 |
((string-equal tag "a") |
((string-equal tag "a") |
1229 |
(if file-A |
(if file-A |
1230 |
(error "This line has two `A' entries")) |
(error "This line has two `A' entries")) |
1231 |
(setq file-A file)) |
(setq file-A file)) |
1232 |
((string-equal tag "b") |
((string-equal tag "b") |
1233 |
(if file-B |
(if file-B |
1234 |
(error "This line has two `B' entries")) |
(error "This line has two `B' entries")) |
1235 |
(setq file-B file)) |
(setq file-B file)) |
1236 |
((or (string-equal tag "anc") (string-equal tag "ancestor")) |
((or (string-equal tag "anc") (string-equal tag "ancestor")) |
1237 |
(if file-ancestor |
(if file-ancestor |
1238 |
(error "This line has two `ancestor' entries")) |
(error "This line has two `ancestor' entries")) |
1239 |
(setq file-ancestor file)) |
(setq file-ancestor file)) |
1240 |
((or (string-equal tag "out") (string-equal tag "output")) |
((or (string-equal tag "out") (string-equal tag "output")) |
1241 |
(if file-out |
(if file-out |
1242 |
(error "This line has two `output' entries")) |
(error "This line has two `output' entries")) |
1243 |
(setq file-out file)) |
(setq file-out file)) |
1244 |
(t |
(t |
1245 |
(error "Unrecognized entry")))) |
(error "Unrecognized entry")))) |
1246 |
;; If the match on the entry pattern failed |
;; If the match on the entry pattern failed |
1247 |
(error "Unparsable entry"))) |
(error "Unparsable entry"))) |
1248 |
;; Make sure that file-A and file-B are present |
;; Make sure that file-A and file-B are present |
1249 |
(if (not (or (and file-A file-B) file-out)) |
(if (not (or (and file-A file-B) file-out)) |
1250 |
(error "Must have both `A' and `B' entries")) |
(error "Must have both `A' and `B' entries")) |
1255 |
(beginning-of-line 2) |
(beginning-of-line 2) |
1256 |
;; Execute the correct command |
;; Execute the correct command |
1257 |
(cond |
(cond |
1258 |
;; Merge of two files with ancestor |
;; Merge of two files with ancestor |
1259 |
((and file-A file-B file-ancestor) |
((and file-A file-B file-ancestor) |
1260 |
(message "Merging %s and %s..." file-A file-B) |
(message "Merging %s and %s..." file-A file-B) |
1261 |
(emerge-files-with-ancestor (not (not file-out)) file-A file-B |
(emerge-files-with-ancestor (not (not file-out)) file-A file-B |
1262 |
file-ancestor file-out |
file-ancestor file-out |
1263 |
nil |
nil |
1264 |
;; When done, return to this buffer. |
;; When done, return to this buffer. |
1265 |
(list |
(list |
1266 |
(` (lambda () |
`(lambda () |
1267 |
(switch-to-buffer (, (current-buffer))) |
(switch-to-buffer ,(current-buffer)) |
1268 |
(message "Merge done.")))))) |
(message "Merge done."))))) |
1269 |
;; Merge of two files without ancestor |
;; Merge of two files without ancestor |
1270 |
((and file-A file-B) |
((and file-A file-B) |
1271 |
(message "Merging %s and %s..." file-A file-B) |
(message "Merging %s and %s..." file-A file-B) |
1272 |
(emerge-files (not (not file-out)) file-A file-B file-out |
(emerge-files (not (not file-out)) file-A file-B file-out |
1273 |
nil |
nil |
1274 |
;; When done, return to this buffer. |
;; When done, return to this buffer. |
1275 |
(list |
(list |
1276 |
(` (lambda () |
`(lambda () |
1277 |
(switch-to-buffer (, (current-buffer))) |
(switch-to-buffer ,(current-buffer)) |
1278 |
(message "Merge done.")))))) |
(message "Merge done."))))) |
1279 |
;; There is an output file (or there would have been an error above), |
;; There is an output file (or there would have been an error above), |
1280 |
;; but only one input file. |
;; but only one input file. |
1281 |
;; The file appears to have been deleted in one version; do nothing. |
;; The file appears to have been deleted in one version; do nothing. |
1282 |
((and file-ancestor emerge-execute-line-deletions) |
((and file-ancestor emerge-execute-line-deletions) |
1283 |
(message "No action.")) |
(message "No action.")) |
1284 |
;; The file should be copied from the version that contains it |
;; The file should be copied from the version that contains it |
1285 |
(t (let ((input-file (or file-A file-B))) |
(t (let ((input-file (or file-A file-B))) |
1286 |
(message "Copying...") |
(message "Copying...") |
1287 |
(copy-file input-file file-out) |
(copy-file input-file file-out) |
1288 |
(message "%s copied to %s." input-file file-out)))))) |
(message "%s copied to %s." input-file file-out)))))) |
1289 |
|
|
1290 |
;;; Sample function for creating information for emerge-execute-line |
;;; Sample function for creating information for emerge-execute-line |
1291 |
|
|