Mercurial > emacs
comparison lisp/vc-svn.el @ 91367:c70e45a7acfd
Merge from emacs--devo--0
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-324
author | Miles Bader <miles@gnu.org> |
---|---|
date | Wed, 30 Jan 2008 07:57:28 +0000 |
parents | 606f2d163a64 5d58981e6690 |
children |
comparison
equal
deleted
inserted
replaced
91366:86f3a8f0a3a6 | 91367:c70e45a7acfd |
---|---|
130 ;; the process is run on a remote host via Tramp, the error | 130 ;; the process is run on a remote host via Tramp, the error |
131 ;; is only reported via the exit status which is turned into | 131 ;; is only reported via the exit status which is turned into |
132 ;; an `error' by vc-do-command. | 132 ;; an `error' by vc-do-command. |
133 (error nil)))) | 133 (error nil)))) |
134 (when (eq 0 status) | 134 (when (eq 0 status) |
135 (vc-svn-parse-status file)))))) | 135 (let ((parsed (vc-svn-parse-status file))) |
136 (and parsed (not (memq parsed '(ignored unregistered)))))))))) | |
136 | 137 |
137 (defun vc-svn-state (file &optional localp) | 138 (defun vc-svn-state (file &optional localp) |
138 "SVN-specific version of `vc-state'." | 139 "SVN-specific version of `vc-state'." |
139 (setq localp (or localp (vc-stay-local-p file))) | 140 (setq localp (or localp (vc-stay-local-p file))) |
140 (with-temp-buffer | 141 (with-temp-buffer |
154 ;; enough. Otherwise it might fail with remote repositories. | 155 ;; enough. Otherwise it might fail with remote repositories. |
155 (with-temp-buffer | 156 (with-temp-buffer |
156 (buffer-disable-undo) ;; Because these buffers can get huge | 157 (buffer-disable-undo) ;; Because these buffers can get huge |
157 (vc-svn-command t 0 nil "status" (if localp "-v" "-u")) | 158 (vc-svn-command t 0 nil "status" (if localp "-v" "-u")) |
158 (vc-svn-parse-status)))) | 159 (vc-svn-parse-status)))) |
160 | |
161 (defun vc-svn-after-dir-status (callback buffer) | |
162 (let ((state-map '((?A . added) | |
163 (?C . edited) | |
164 (?D . removed) | |
165 (?I . ignored) | |
166 (?M . edited) | |
167 (?R . removed) | |
168 (?? . unregistered) | |
169 ;; This is what vc-svn-parse-status does. | |
170 (?~ . edited))) | |
171 result) | |
172 (goto-char (point-min)) | |
173 (while (re-search-forward "^\\(.\\)..... \\(.*\\)$" nil t) | |
174 (let ((state (cdr (assq (aref (match-string 1) 0) state-map))) | |
175 (filename (match-string 2))) | |
176 (when state | |
177 (setq result (cons (cons filename state) result))))) | |
178 (funcall callback result buffer))) | |
179 | |
180 (defun vc-svn-dir-status (dir callback buffer) | |
181 "Run 'svn status' for DIR and update BUFFER via CALLBACK. | |
182 CALLBACK is called as (CALLBACK RESULT BUFFER), where | |
183 RESULT is a list of conses (FILE . STATE) for directory DIR." | |
184 (with-current-buffer (get-buffer-create | |
185 (generate-new-buffer-name " *vc svn status*")) | |
186 (vc-svn-command (current-buffer) 'async nil "status") | |
187 (vc-exec-after | |
188 `(vc-svn-after-dir-status (quote ,callback) ,buffer)))) | |
159 | 189 |
160 (defun vc-svn-working-revision (file) | 190 (defun vc-svn-working-revision (file) |
161 "SVN-specific version of `vc-working-revision'." | 191 "SVN-specific version of `vc-working-revision'." |
162 ;; There is no need to consult RCS headers under SVN, because we | 192 ;; There is no need to consult RCS headers under SVN, because we |
163 ;; get the workfile version for free when we recognize that a file | 193 ;; get the workfile version for free when we recognize that a file |
535 | 565 |
536 (defun vc-svn-resolve-when-done () | 566 (defun vc-svn-resolve-when-done () |
537 "Call \"svn resolved\" if the conflict markers have been removed." | 567 "Call \"svn resolved\" if the conflict markers have been removed." |
538 (save-excursion | 568 (save-excursion |
539 (goto-char (point-min)) | 569 (goto-char (point-min)) |
540 (if (not (re-search-forward "^<<<<<<< " nil t)) | 570 (unless (re-search-forward "^<<<<<<< " nil t) |
541 (vc-svn-command nil 0 buffer-file-name "resolved")))) | 571 (vc-svn-command nil 0 buffer-file-name "resolved") |
572 ;; Remove the hook so that it is not called multiple times. | |
573 (remove-hook 'after-save-hook 'vc-svn-resolve-when-done t)))) | |
542 | 574 |
543 ;; Inspired by vc-arch-find-file-hook. | 575 ;; Inspired by vc-arch-find-file-hook. |
544 (defun vc-svn-find-file-hook () | 576 (defun vc-svn-find-file-hook () |
545 (when (eq ?C (vc-file-getprop buffer-file-name 'vc-svn-status)) | 577 (when (eq ?C (vc-file-getprop buffer-file-name 'vc-svn-status)) |
546 ;; If the file is marked as "conflicted", then we should try and call | 578 ;; If the file is marked as "conflicted", then we should try and call |
548 (if (save-excursion | 580 (if (save-excursion |
549 (goto-char (point-min)) | 581 (goto-char (point-min)) |
550 (re-search-forward "^<<<<<<< " nil t)) | 582 (re-search-forward "^<<<<<<< " nil t)) |
551 ;; There are conflict markers. | 583 ;; There are conflict markers. |
552 (progn | 584 (progn |
553 (smerge-mode 1) | 585 (smerge-start-session) |
554 (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t)) | 586 (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t)) |
555 ;; There are no conflict markers. This is problematic: maybe it means | 587 ;; There are no conflict markers. This is problematic: maybe it means |
556 ;; the conflict has been resolved and we should immediately call "svn | 588 ;; the conflict has been resolved and we should immediately call "svn |
557 ;; resolved", or it means that the file's type does not allow Svn to | 589 ;; resolved", or it means that the file's type does not allow Svn to |
558 ;; use conflict markers in which case we don't really know what to do. | 590 ;; use conflict markers in which case we don't really know what to do. |