;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Properties of the backend
-(defun vc-svn-revision-granularity ()
- 'repository)
+(defun vc-svn-revision-granularity () 'repository)
+(defun vc-svn-checkout-model (files) 'implicit)
+
;;;
;;; State-querying functions
;;;
"SVN-specific state heuristic."
(vc-svn-state file 'local))
-(defun vc-svn-dir-state (dir &optional localp)
- "Find the SVN state of all files in DIR and its subdirectories."
- (setq localp (or localp (vc-stay-local-p dir)))
- (let ((default-directory dir))
- ;; Don't specify DIR in this command, the default-directory is
- ;; enough. Otherwise it might fail with remote repositories.
- (with-temp-buffer
- (buffer-disable-undo) ;; Because these buffers can get huge
- (vc-svn-command t 0 nil "status" (if localp "-v" "-u"))
- (vc-svn-parse-status))))
-
-(defun vc-svn-after-dir-status (callback buffer)
+(defun vc-svn-after-dir-status (callback)
(let ((state-map '((?A . added)
- (?C . edited)
- (?D . removed)
- (?I . ignored)
- (?M . edited)
- (?R . removed)
- (?? . unregistered)
- ;; This is what vc-svn-parse-status does.
- (?~ . edited)))
+ (?C . conflict)
+ (?D . removed)
+ (?I . ignored)
+ (?M . edited)
+ (?R . removed)
+ (?? . unregistered)
+ ;; This is what vc-svn-parse-status does.
+ (?~ . edited)))
result)
(goto-char (point-min))
(while (re-search-forward "^\\(.\\)..... \\(.*\\)$" nil t)
(let ((state (cdr (assq (aref (match-string 1) 0) state-map)))
(filename (match-string 2)))
(when state
- (setq result (cons (cons filename state) result)))))
- (funcall callback result buffer)))
+ (setq result (cons (list filename state) result)))))
+ (funcall callback result)))
-(defun vc-svn-dir-status (dir callback buffer)
+(defun vc-svn-dir-status (dir callback)
"Run 'svn status' for DIR and update BUFFER via CALLBACK.
CALLBACK is called as (CALLBACK RESULT BUFFER), where
RESULT is a list of conses (FILE . STATE) for directory DIR."
- (with-current-buffer (get-buffer-create
- (generate-new-buffer-name " *vc svn status*"))
- (vc-svn-command (current-buffer) 'async nil "status")
- (vc-exec-after
- `(vc-svn-after-dir-status (quote ,callback) ,buffer))))
+ (vc-svn-command (current-buffer) 'async nil "status")
+ (vc-exec-after
+ `(vc-svn-after-dir-status (quote ,callback))))
+
+(defun vc-svn-status-extra-headers (dir)
+ "Generate extra status headers for a Subversion working copy."
+ (vc-svn-command "*vc*" 0 nil "info")
+ (let ((repo
+ (save-excursion
+ (and (progn
+ (set-buffer "*vc*")
+ (goto-char (point-min))
+ (re-search-forward "Repository Root: *\\(.*\\)" nil t))
+ (match-string 1)))))
+ (concat
+ (cond (repo
+ (concat
+ (propertize "Repository : " 'face 'font-lock-type-face)
+ (propertize repo 'face 'font-lock-variable-name-face)))
+ (t "")))))
(defun vc-svn-working-revision (file)
"SVN-specific version of `vc-working-revision'."
(vc-svn-registered file)
(vc-file-getprop file 'vc-working-revision))
-(defun vc-svn-checkout-model (file)
- "SVN-specific version of `vc-checkout-model'."
- ;; It looks like Subversion has no equivalent of CVSREAD.
- 'implicit)
-
;; vc-svn-mode-line-string doesn't exist because the default implementation
;; works just fine.
-(defun vc-svn-dired-state-info (file)
- "SVN-specific version of `vc-dired-state-info'."
- (let ((svn-state (vc-state file)))
- (cond ((eq svn-state 'edited)
- (if (equal (vc-working-revision file) "0")
- "(added)" "(modified)"))
- (t
- ;; fall back to the default VC representation
- (vc-default-dired-state-info 'SVN file)))))
-
-
(defun vc-svn-previous-revision (file rev)
(let ((newrev (1- (string-to-number rev))))
(when (< 0 newrev)
(defun vc-svn-create-repo ()
"Create a new SVN repository."
- (vc-do-command nil 0 "svnadmin" '("create" "SVN"))
- (vc-do-command nil 0 "svn" '(".")
+ (vc-do-command "*vc*" 0 "svnadmin" '("create" "SVN"))
+ (vc-do-command "*vc*" 0 "svn" '(".")
"checkout" (concat "file://" default-directory "SVN")))
(defun vc-svn-register (files &optional rev comment)
(defun vc-svn-checkin (files rev comment)
"SVN-specific version of `vc-backend-checkin'."
- (if rev (error "Committing to a specific revision is unsupported in SVN."))
+ (if rev (error "Committing to a specific revision is unsupported in SVN"))
(let ((status (apply
'vc-svn-command nil 1 files "ci"
(nconc (list "-m" comment) (vc-switches 'SVN 'checkin)))))
(defun vc-svn-checkout (file &optional editable rev)
(message "Checking out %s..." file)
(with-current-buffer (or (get-file-buffer file) (current-buffer))
- (vc-call update file editable rev (vc-switches 'SVN 'checkout)))
+ (vc-svn-update file editable rev (vc-switches 'SVN 'checkout)))
(vc-mode-line file)
(message "Checking out %s...done" file))
(vc-file-setprop file 'vc-working-revision nil)
(apply 'vc-svn-command nil 0 file
"update"
- ;; default for verbose checkout: clear the sticky tag so
- ;; that the actual update will get the head of the trunk
(cond
((null rev) "-rBASE")
((or (eq rev t) (equal rev "")) nil)
(defun vc-svn-modify-change-comment (files rev comment)
"Modify the change comments for a specified REV.
You must have ssh access to the repository host, and the directory Emacs
-uses locally for temp files must also be writeable by you on that host."
- (vc-do-command nil 0 "svn" nil "info")
- (set-buffer "*vc*")
- (goto-char (point-min))
- (unless (re-search-forward "Repository Root: svn\\+ssh://\\([^/]+\\)\\(/.*\\)" nil t)
- (error "Repository information is unavailable."))
- (let* ((tempfile (make-temp-file user-mail-address))
- (host (match-string 1))
- (directory (match-string 2))
- (remotefile (concat host ":" tempfile)))
+uses locally for temp files must also be writeable by you on that host.
+This is only supported if the repository access method is either file://
+or svn+ssh://."
+ (let (tempfile host remotefile directory fileurl-p)
(with-temp-buffer
- (insert comment)
- (write-region (point-min) (point-max) tempfile))
- (unless (vc-do-command nil 0 "scp" nil "-q" tempfile remotefile)
- (error "Copy of comment to %s failed" remotefile))
- (unless (vc-do-command nil 0 "ssh" nil
- "-q" host
- (format "svnadmin setlog --bypass-hooks %s -r %s %s; rm %s"
- directory rev tempfile tempfile))
- (error "Log edit failed"))
- ))
+ (vc-do-command (current-buffer) 0 "svn" nil "info")
+ (goto-char (point-min))
+ (unless (re-search-forward "Repository Root: \\(file://\\(/.*\\)\\)\\|\\(svn\\+ssh://\\([^/]+\\)\\(/.*\\)\\)" nil t)
+ (error "Repository information is unavailable"))
+ (if (match-string 1)
+ (progn
+ (setq fileurl-p t)
+ (setq directory (match-string 2)))
+ (setq host (match-string 4))
+ (setq directory (match-string 5))
+ (setq remotefile (concat host ":" tempfile))))
+ (with-temp-file (setq tempfile (make-temp-file user-mail-address))
+ (insert comment))
+ (if fileurl-p
+ ;; Repository Root is a local file.
+ (progn
+ (unless (vc-do-command
+ "*vc*" 0 "svnadmin" nil
+ "setlog" "--bypass-hooks" directory
+ "-r" rev (format "%s" tempfile))
+ (error "Log edit failed"))
+ (delete-file tempfile))
+
+ ;; Remote repository, using svn+ssh.
+ (unless (vc-do-command "*vc*" 0 "scp" nil "-q" tempfile remotefile)
+ (error "Copy of comment to %s failed" remotefile))
+ (unless (vc-do-command
+ "*vc*" 0 "ssh" nil "-q" host
+ (format "svnadmin setlog --bypass-hooks %s -r %s %s; rm %s"
+ directory rev tempfile tempfile))
+ (error "Log edit failed")))))
;;;
;;; History functions
;;;
+(define-derived-mode vc-svn-log-view-mode log-view-mode "SVN-Log-View"
+ (require 'add-log)
+ (set (make-local-variable 'log-view-per-file-logs) nil))
+
(defun vc-svn-print-log (files &optional buffer)
"Get change log(s) associated with FILES."
(save-current-buffer
;; Dump log for the entire directory.
(vc-svn-command buffer 0 nil "log" "-rHEAD:0")))))
-(defun vc-svn-wash-log ()
- "Remove all non-comment information from log output."
- ;; FIXME: not implemented for SVN
- nil)
-
(defun vc-svn-diff (files &optional oldvers newvers buffer)
"Get a difference report using SVN between two revisions of fileset FILES."
(and oldvers
(buffer-size (get-buffer buffer)))))
;;;
-;;; Snapshot system
+;;; Tag system
;;;
-(defun vc-svn-create-snapshot (dir name branchp)
+(defun vc-svn-create-tag (dir name branchp)
"Assign to DIR's current revision a given NAME.
If BRANCHP is non-nil, the name is created as a branch (and the current
workspace is immediately moved to that new branch).
NAME is assumed to be a URL."
(vc-svn-command nil 0 dir "copy" name)
- (when branchp (vc-svn-retrieve-snapshot dir name nil)))
+ (when branchp (vc-svn-retrieve-tag dir name nil)))
-(defun vc-svn-retrieve-snapshot (dir name update)
- "Retrieve a snapshot at and below DIR.
-NAME is the name of the snapshot; if it is empty, do a `svn update'.
+(defun vc-svn-retrieve-tag (dir name update)
+ "Retrieve a tag at and below DIR.
+NAME is the name of the tag; if it is empty, do a `svn update'.
If UPDATE is non-nil, then update (resynch) any affected buffers.
NAME is assumed to be a URL."
(vc-svn-command nil 0 dir "switch" name)
;;;
(defcustom vc-svn-program "svn"
- "Name of the svn executable."
+ "Name of the SVN executable."
:type 'string
:group 'vc)
"A wrapper around `vc-do-command' for use in vc-svn.el.
The difference to vc-do-command is that this function always invokes `svn',
and that it passes `vc-svn-global-switches' to it before FLAGS."
- (apply 'vc-do-command buffer okstatus vc-svn-program file-or-list
+ (apply 'vc-do-command (or buffer "*vc*") okstatus vc-svn-program file-or-list
(if (stringp vc-svn-global-switches)
(cons vc-svn-global-switches flags)
(append vc-svn-global-switches
(cond
((eq status ?\ )
(if (eq (char-after (match-beginning 1)) ?*)
- 'needs-patch
+ 'needs-update
(vc-file-setprop file 'vc-checkout-time
(nth 5 (file-attributes file)))
'up-to-date))
(vc-file-setprop file 'vc-working-revision "0")
(vc-file-setprop file 'vc-checkout-time 0)
'added)
- ((memq status '(?M ?C))
+ ((eq status ?C)
+ (vc-file-setprop file 'vc-state 'conflict))
+ ((eq status '?M)
(if (eq (char-after (match-beginning 1)) ?*)
'needs-merge
'edited))
(t 'edited)))))
(if filename (vc-file-getprop filename 'vc-state))))
-(defun vc-svn-dir-state-heuristic (dir)
- "Find the SVN state of all files in DIR, using only local information."
- (vc-svn-dir-state dir 'local))
-
(defun vc-svn-valid-symbolic-tag-name-p (tag)
"Return non-nil if TAG is a valid symbolic tag name."
;; According to the SVN manual, a valid symbolic tag must start with
HCoop / bpt / emacs.git / blobdiff