/[emacs]/emacs/lisp/emerge.el
ViewVC logotype

Diff of /emacs/lisp/emerge.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.43 by pj, Mon Jul 16 12:22:58 2001 UTC revision 1.44 by sds, Tue Nov 27 15:52:52 2001 UTC
# Line 57  Line 57 
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.  
# Line 70  Performs a defvar, then executes `make-v Line 70  Performs a defvar, then executes `make-v
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
# Line 567  This is *not* a user option, since Emerg Line 567  This is *not* a user option, since Emerg
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))
# Line 587  This is *not* a user option, since Emerg Line 587  This is *not* a user option, since Emerg
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)
# Line 598  This is *not* a user option, since Emerg Line 598  This is *not* a user option, since Emerg
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    
# Line 741  This is *not* a user option, since Emerg Line 741  This is *not* a user option, since Emerg
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)
# Line 752  This is *not* a user option, since Emerg Line 752  This is *not* a user option, since Emerg
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)
# Line 763  This is *not* a user option, since Emerg Line 763  This is *not* a user option, since Emerg
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)))
# Line 901  This is *not* a user option, since Emerg Line 901  This is *not* a user option, since Emerg
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
# Line 923  This is *not* a user option, since Emerg Line 923  This is *not* a user option, since Emerg
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
# Line 951  This is *not* a user option, since Emerg Line 951  This is *not* a user option, since Emerg
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: ")
# Line 982  This is *not* a user option, since Emerg Line 982  This is *not* a user option, since Emerg
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)))
# Line 1001  This is *not* a user option, since Emerg Line 1001  This is *not* a user option, since Emerg
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 ()
# Line 1015  This is *not* a user option, since Emerg Line 1015  This is *not* a user option, since Emerg
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)
# Line 1036  This is *not* a user option, since Emerg Line 1036  This is *not* a user option, since Emerg
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    
# Line 1045  This is *not* a user option, since Emerg Line 1045  This is *not* a user option, since Emerg
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    
# Line 1070  This is *not* a user option, since Emerg Line 1070  This is *not* a user option, since Emerg
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
# Line 1095  This is *not* a user option, since Emerg Line 1095  This is *not* a user option, since Emerg
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"))
# Line 1127  This is *not* a user option, since Emerg Line 1127  This is *not* a user option, since Emerg
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)))
# Line 1175  This is *not* a user option, since Emerg Line 1175  This is *not* a user option, since Emerg
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    
# Line 1225  Otherwise, the A or B file present is co Line 1225  Otherwise, the A or B file present is co
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"))
# Line 1255  Otherwise, the A or B file present is co Line 1255  Otherwise, the A or B file present is co
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    

Legend:
Removed from v.1.43  
changed lines
  Added in v.1.44

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26