diff options
| author | Juri Linkov <juri@jurta.org> | 2010-06-11 21:51:00 +0300 |
|---|---|---|
| committer | Juri Linkov <juri@jurta.org> | 2010-06-11 21:51:00 +0300 |
| commit | 56b2854f302ee88e9adb03c196e6643841220440 (patch) | |
| tree | a535a76c71fd92513ba9bf694e7b6a121397d19e /lisp/vc-svn.el | |
| parent | 6534e58a57f60d338491ca97db605cbb116f0c2f (diff) | |
| download | emacs-56b2854f302ee88e9adb03c196e6643841220440.tar.gz | |
Move version control related files to the "vc" subdirectory.
* add-log.el, cvs-status.el, diff.el, diff-mode.el, ediff-diff.el,
* ediff.el, ediff-help.el, ediff-hook.el, ediff-init.el,
* ediff-merg.el, ediff-mult.el, ediff-ptch.el, ediff-util.el,
* ediff-vers.el, ediff-wind.el, emerge.el, log-edit.el, log-view.el,
* pcvs-defs.el, pcvs.el, pcvs-info.el, pcvs-parse.el, pcvs-util.el,
* smerge-mode.el, vc-annotate.el, vc-arch.el, vc-bzr.el, vc-cvs.el,
* vc-dav.el, vc-dir.el, vc-dispatcher.el, vc.el, vc-git.el,
* vc-hg.el, vc-hooks.el, vc-mtn.el, vc-rcs.el, vc-sccs.el, vc-svn.el:
Move files to the "vc" subdirectory.
Diffstat (limited to 'lisp/vc-svn.el')
| -rw-r--r-- | lisp/vc-svn.el | 747 |
1 files changed, 0 insertions, 747 deletions
diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el deleted file mode 100644 index cd43d425af1..00000000000 --- a/lisp/vc-svn.el +++ /dev/null @@ -1,747 +0,0 @@ -;;; vc-svn.el --- non-resident support for Subversion version-control - -;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. - -;; Author: FSF (see vc.el for full credits) -;; Maintainer: Stefan Monnier <monnier@gnu.org> - -;; This file is part of GNU Emacs. - -;; 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 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Sync'd with Subversion's vc-svn.el as of revision 5801. but this version -;; has been extensively modified since to handle filesets. - -;;; Code: - -(eval-when-compile - (require 'vc)) - -;; Clear up the cache to force vc-call to check again and discover -;; new functions when we reload this file. -(put 'SVN 'vc-functions nil) - -;;; -;;; Customization options -;;; - -;; FIXME there is also svnadmin. -(defcustom vc-svn-program "svn" - "Name of the SVN executable." - :type 'string - :group 'vc) - -(defcustom vc-svn-global-switches nil - "Global switches to pass to any SVN command." - :type '(choice (const :tag "None" nil) - (string :tag "Argument String") - (repeat :tag "Argument List" - :value ("") - string)) - :version "22.1" - :group 'vc) - -(defcustom vc-svn-register-switches nil - "Switches for registering a file into SVN. -A string or list of strings passed to the checkin program by -\\[vc-register]. If nil, use the value of `vc-register-switches'. -If t, use no switches." - :type '(choice (const :tag "Unspecified" nil) - (const :tag "None" t) - (string :tag "Argument String") - (repeat :tag "Argument List" :value ("") string)) - :version "22.1" - :group 'vc) - -(defcustom vc-svn-diff-switches - t ;`svn' doesn't support common args like -c or -b. - "String or list of strings specifying extra switches for svn diff under VC. -If nil, use the value of `vc-diff-switches' (or `diff-switches'), -together with \"-x --diff-cmd=diff\" (since svn diff does not -support the default \"-c\" value of `diff-switches'). If you -want to force an empty list of arguments, use t." - :type '(choice (const :tag "Unspecified" nil) - (const :tag "None" t) - (string :tag "Argument String") - (repeat :tag "Argument List" - :value ("") - string)) - :version "22.1" - :group 'vc) - -(defcustom vc-svn-header (or (cdr (assoc 'SVN vc-header-alist)) '("\$Id\$")) - "Header keywords to be inserted by `vc-insert-headers'." - :version "22.1" - :type '(repeat string) - :group 'vc) - -;; We want to autoload it for use by the autoloaded version of -;; vc-svn-registered, but we want the value to be compiled at startup, not -;; at dump time. -;; ;;;###autoload -(defconst vc-svn-admin-directory - (cond ((and (memq system-type '(cygwin windows-nt ms-dos)) - (getenv "SVN_ASP_DOT_NET_HACK")) - "_svn") - (t ".svn")) - "The name of the \".svn\" subdirectory or its equivalent.") - -;;; Properties of the backend - -(defun vc-svn-revision-granularity () 'repository) -(defun vc-svn-checkout-model (files) 'implicit) - -;;; -;;; State-querying functions -;;; - -;;; vc-svn-admin-directory is generally not defined when the -;;; autoloaded function is called. - -;;;###autoload (defun vc-svn-registered (f) -;;;###autoload (let ((admin-dir (cond ((and (eq system-type 'windows-nt) -;;;###autoload (getenv "SVN_ASP_DOT_NET_HACK")) -;;;###autoload "_svn") -;;;###autoload (t ".svn")))) -;;;###autoload (when (file-readable-p (expand-file-name -;;;###autoload (concat admin-dir "/entries") -;;;###autoload (file-name-directory f))) -;;;###autoload (load "vc-svn") -;;;###autoload (vc-svn-registered f)))) - -(defun vc-svn-registered (file) - "Check if FILE is SVN registered." - (when (file-readable-p (expand-file-name (concat vc-svn-admin-directory - "/entries") - (file-name-directory file))) - (with-temp-buffer - (cd (file-name-directory file)) - (let* (process-file-side-effects - (status - (condition-case nil - ;; Ignore all errors. - (vc-svn-command t t file "status" "-v") - ;; Some problem happened. E.g. We can't find an `svn' - ;; executable. We used to only catch `file-error' but when - ;; the process is run on a remote host via Tramp, the error - ;; is only reported via the exit status which is turned into - ;; an `error' by vc-do-command. - (error nil)))) - (when (eq 0 status) - (let ((parsed (vc-svn-parse-status file))) - (and parsed (not (memq parsed '(ignored unregistered)))))))))) - -(defun vc-svn-state (file &optional localp) - "SVN-specific version of `vc-state'." - (let (process-file-side-effects) - (setq localp (or localp (vc-stay-local-p file 'SVN))) - (with-temp-buffer - (cd (file-name-directory file)) - (vc-svn-command t 0 file "status" (if localp "-v" "-u")) - (vc-svn-parse-status file)))) - -(defun vc-svn-state-heuristic (file) - "SVN-specific state heuristic." - (vc-svn-state file 'local)) - -;; FIXME it would be better not to have the "remote" argument, -;; but to distinguish the two output formats based on content. -(defun vc-svn-after-dir-status (callback &optional remote) - (let ((state-map '((?A . added) - (?C . conflict) - (?I . ignored) - (?M . edited) - (?D . removed) - (?R . removed) - (?? . unregistered) - ;; This is what vc-svn-parse-status does. - (?~ . edited))) - (re (if remote "^\\(.\\)...... \\([ *]\\) +\\(?:[-0-9]+\\)? \\(.*\\)$" - ;; Subexp 2 is a dummy in this case, so the numbers match. - "^\\(.\\)....\\(.\\) \\(.*\\)$")) - result) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (let ((state (cdr (assq (aref (match-string 1) 0) state-map))) - (filename (match-string 3))) - (and remote (string-equal (match-string 2) "*") - ;; FIXME are there other possible combinations? - (cond ((eq state 'edited) (setq state 'needs-merge)) - ((not state) (setq state 'needs-update)))) - (when (and state (not (string= "." filename))) - (setq result (cons (list filename state) result))))) - (funcall callback result))) - -(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." - ;; FIXME should this rather be all the files in dir? - ;; FIXME: the vc-stay-local-p logic below is disabled, it ends up - ;; calling synchronously (vc-svn-registered DIR) => calling svn status -v DIR - ;; which is VERY SLOW for big trees and it makes emacs - ;; completely unresponsive during that time. - (let* ((local (and nil (vc-stay-local-p dir 'SVN))) - (remote (or t (not local) (eq local 'only-file)))) - (vc-svn-command (current-buffer) 'async nil "status" - (if remote "-u")) - (vc-exec-after - `(vc-svn-after-dir-status (quote ,callback) ,remote)))) - -(defun vc-svn-dir-status-files (dir files default-state callback) - (apply 'vc-svn-command (current-buffer) 'async nil "status" files) - (vc-exec-after - `(vc-svn-after-dir-status (quote ,callback)))) - -(defun vc-svn-dir-extra-headers (dir) - "Generate extra status headers for a Subversion working copy." - (let (process-file-side-effects) - (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'." - ;; There is no need to consult RCS headers under SVN, because we - ;; get the workfile version for free when we recognize that a file - ;; is registered in SVN. - (vc-svn-registered file) - (vc-file-getprop file 'vc-working-revision)) - -;; vc-svn-mode-line-string doesn't exist because the default implementation -;; works just fine. - -(defun vc-svn-previous-revision (file rev) - (let ((newrev (1- (string-to-number rev)))) - (when (< 0 newrev) - (number-to-string newrev)))) - -(defun vc-svn-next-revision (file rev) - (let ((newrev (1+ (string-to-number rev)))) - ;; The "working revision" is an uneasy conceptual fit under Subversion; - ;; we use it as the upper bound until a better idea comes along. If the - ;; workfile version W coincides with the tree's latest revision R, then - ;; this check prevents a "no such revision: R+1" error. Otherwise, it - ;; inhibits showing of W+1 through R, which could be considered anywhere - ;; from gracious to impolite. - (unless (< (string-to-number (vc-file-getprop file 'vc-working-revision)) - newrev) - (number-to-string newrev)))) - - -;;; -;;; State-changing functions -;;; - -(defun vc-svn-create-repo () - "Create a new SVN repository." - (vc-do-command "*vc*" 0 "svnadmin" '("create" "SVN")) - (vc-do-command "*vc*" 0 vc-svn-program '(".") - "checkout" (concat "file://" default-directory "SVN"))) - -(defun vc-svn-register (files &optional rev comment) - "Register FILES into the SVN version-control system. -The COMMENT argument is ignored This does an add but not a commit. -Passes either `vc-svn-register-switches' or `vc-register-switches' -to the SVN command." - (apply 'vc-svn-command nil 0 files "add" (vc-switches 'SVN 'register))) - -(defun vc-svn-responsible-p (file) - "Return non-nil if SVN thinks it is responsible for FILE." - (file-directory-p (expand-file-name vc-svn-admin-directory - (if (file-directory-p file) - file - (file-name-directory file))))) - -(defalias 'vc-svn-could-register 'vc-svn-responsible-p - "Return non-nil if FILE could be registered in SVN. -This is only possible if SVN is responsible for FILE's directory.") - -(defun vc-svn-checkin (files rev comment &optional extra-args-ignored) - "SVN-specific version of `vc-backend-checkin'." - (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))))) - (set-buffer "*vc*") - (goto-char (point-min)) - (unless (equal status 0) - ;; Check checkin problem. - (cond - ((search-forward "Transaction is out of date" nil t) - (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge)) - files) - (error (substitute-command-keys - (concat "Up-to-date check failed: " - "type \\[vc-next-action] to merge in changes")))) - (t - (pop-to-buffer (current-buffer)) - (goto-char (point-min)) - (shrink-window-if-larger-than-buffer) - (error "Check-in failed")))) - ;; Update file properties - ;; (vc-file-setprop - ;; file 'vc-working-revision - ;; (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2)) - )) - -(defun vc-svn-find-revision (file rev buffer) - "SVN-specific retrieval of a specified version into a buffer." - (let (process-file-side-effects) - (apply 'vc-svn-command - buffer 0 file - "cat" - (and rev (not (string= rev "")) - (concat "-r" rev)) - (vc-switches 'SVN 'checkout)))) - -(defun vc-svn-checkout (file &optional editable rev) - (message "Checking out %s..." file) - (with-current-buffer (or (get-file-buffer file) (current-buffer)) - (vc-svn-update file editable rev (vc-switches 'SVN 'checkout))) - (vc-mode-line file 'SVN) - (message "Checking out %s...done" file)) - -(defun vc-svn-update (file editable rev switches) - (if (and (file-exists-p file) (not rev)) - ;; If no revision was specified, there's nothing to do. - nil - ;; Check out a particular version (or recreate the file). - (vc-file-setprop file 'vc-working-revision nil) - (apply 'vc-svn-command nil 0 file - "--non-interactive" ; bug#4280 - "update" - (cond - ((null rev) "-rBASE") - ((or (eq rev t) (equal rev "")) nil) - (t (concat "-r" rev))) - switches))) - -(defun vc-svn-delete-file (file) - (vc-svn-command nil 0 file "remove")) - -(defun vc-svn-rename-file (old new) - (vc-svn-command nil 0 new "move" (file-relative-name old))) - -(defun vc-svn-revert (file &optional contents-done) - "Revert FILE to the version it was based on." - (unless contents-done - (vc-svn-command nil 0 file "revert"))) - -(defun vc-svn-merge (file first-version &optional second-version) - "Merge changes into current working copy of FILE. -The changes are between FIRST-VERSION and SECOND-VERSION." - (vc-svn-command nil 0 file - "merge" - "-r" (if second-version - (concat first-version ":" second-version) - first-version)) - (vc-file-setprop file 'vc-state 'edited) - (with-current-buffer (get-buffer "*vc*") - (goto-char (point-min)) - (if (looking-at "C ") - 1 ; signal conflict - 0))) ; signal success - -(defun vc-svn-merge-news (file) - "Merge in any new changes made to FILE." - (message "Merging changes into %s..." file) - ;; (vc-file-setprop file 'vc-working-revision nil) - (vc-file-setprop file 'vc-checkout-time 0) - (vc-svn-command nil 0 file "update") - ;; Analyze the merge result reported by SVN, and set - ;; file properties accordingly. - (with-current-buffer (get-buffer "*vc*") - (goto-char (point-min)) - ;; get new working revision - (if (re-search-forward - "^\\(Updated to\\|At\\) revision \\([0-9]+\\)" nil t) - (vc-file-setprop file 'vc-working-revision (match-string 2)) - (vc-file-setprop file 'vc-working-revision nil)) - ;; get file status - (goto-char (point-min)) - (prog1 - (if (looking-at "At revision") - 0 ;; there were no news; indicate success - (if (re-search-forward - ;; Newer SVN clients have 3 columns of chars (one for the - ;; file's contents, then second for its properties, and the - ;; third for lock-grabbing info), before the 2 spaces. - ;; We also used to match the filename in column 0 without any - ;; meta-info before it, but I believe this can never happen. - (concat "^\\(\\([ACGDU]\\)\\(.[B ]\\)? \\)" - (regexp-quote (file-name-nondirectory file))) - nil t) - (cond - ;; Merge successful, we are in sync with repository now - ((string= (match-string 2) "U") - (vc-file-setprop file 'vc-state 'up-to-date) - (vc-file-setprop file 'vc-checkout-time - (nth 5 (file-attributes file))) - 0);; indicate success to the caller - ;; Merge successful, but our own changes are still in the file - ((string= (match-string 2) "G") - (vc-file-setprop file 'vc-state 'edited) - 0);; indicate success to the caller - ;; Conflicts detected! - (t - (vc-file-setprop file 'vc-state 'edited) - 1);; signal the error to the caller - ) - (pop-to-buffer "*vc*") - (error "Couldn't analyze svn update result"))) - (message "Merging changes into %s...done" file)))) - -(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 writable 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 - (vc-do-command (current-buffer) 0 vc-svn-program 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 -;;; - -(defvar log-view-per-file-logs) - -(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 buffer &optional shortlog start-revision limit) - "Get change log(s) associated with FILES." - (save-current-buffer - (vc-setup-buffer buffer) - (let ((inhibit-read-only t)) - (goto-char (point-min)) - (if files - (dolist (file files) - (insert "Working file: " file "\n") - (apply - 'vc-svn-command - buffer - 'async - ;; (if (and (= (length files) 1) (vc-stay-local-p file 'SVN)) 'async 0) - (list file) - "log" - (append - (list - (if start-revision - (format "-r%s" start-revision) - ;; By default Subversion only shows the log up to the - ;; working revision, whereas we also want the log of the - ;; subsequent commits. At least that's what the - ;; vc-cvs.el code does. - "-rHEAD:0")) - (when limit (list "--limit" (format "%s" limit)))))) - ;; Dump log for the entire directory. - (apply 'vc-svn-command buffer 0 nil "log" - (append - (list - (if start-revision (format "-r%s" start-revision) "-rHEAD:0")) - (when limit (list "--limit" (format "%s" limit))))))))) - -(defun vc-svn-diff (files &optional oldvers newvers buffer) - "Get a difference report using SVN between two revisions of fileset FILES." - (and oldvers - (not newvers) - files - (catch 'no - (dolist (f files) - (or (equal oldvers (vc-working-revision f)) - (throw 'no nil))) - t) - ;; Use nil rather than the current revision because svn handles - ;; it better (i.e. locally). Note that if _any_ of the files - ;; has a different revision, we fetch the lot, which is - ;; obviously sub-optimal. - (setq oldvers nil)) - (let* ((switches - (if vc-svn-diff-switches - (vc-switches 'SVN 'diff) - (list "--diff-cmd=diff" "-x" - (mapconcat 'identity (vc-switches nil 'diff) " ")))) - (async (and (not vc-disable-async-diff) - (vc-stay-local-p files 'SVN) - (or oldvers newvers)))) ; Svn diffs those locally. - (apply 'vc-svn-command buffer - (if async 'async 0) - files "diff" - (append - switches - (when oldvers - (list "-r" (if newvers (concat oldvers ":" newvers) - oldvers))))) - (if async 1 ; async diff => pessimistic assumption - ;; For some reason `svn diff' does not return a useful - ;; status w.r.t whether the diff was empty or not. - (buffer-size (get-buffer buffer))))) - -;;; -;;; Tag system -;;; - -(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-tag dir name nil))) - -(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) - ;; FIXME: parse the output and obey `update'. - ) - -;;; -;;; Miscellaneous -;;; - -;; Subversion makes backups for us, so don't bother. -;; (defun vc-svn-make-version-backups-p (file) -;; "Return non-nil if version backups should be made for FILE." -;; (vc-stay-local-p file 'SVN)) - -(defun vc-svn-check-headers () - "Check if the current file has any headers in it." - (save-excursion - (goto-char (point-min)) - (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\ -\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t))) - - -;;; -;;; Internal functions -;;; - -(defun vc-svn-command (buffer okstatus file-or-list &rest flags) - "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 (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 - flags)))) - -(defun vc-svn-repository-hostname (dirname) - (with-temp-buffer - (let ((coding-system-for-read - (or file-name-coding-system - default-file-name-coding-system))) - (vc-insert-file (expand-file-name (concat vc-svn-admin-directory - "/entries") - dirname))) - (goto-char (point-min)) - (when (re-search-forward - ;; Old `svn' used name="svn:this_dir", newer use just name="". - (concat "name=\"\\(?:svn:this_dir\\)?\"[\n\t ]*" - "\\(?:[-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?" - "url=\"\\(?1:[^\"]+\\)\"" - ;; Yet newer ones don't use XML any more. - "\\|^\ndir\n[0-9]+\n\\(?1:.*\\)") nil t) - ;; This is not a hostname but a URL. This may actually be considered - ;; as a feature since it allows vc-svn-stay-local to specify different - ;; behavior for different modules on the same server. - (match-string 1)))) - -(defun vc-svn-resolve-when-done () - "Call \"svn resolved\" if the conflict markers have been removed." - (save-excursion - (goto-char (point-min)) - (unless (re-search-forward "^<<<<<<< " nil t) - (vc-svn-command nil 0 buffer-file-name "resolved") - ;; Remove the hook so that it is not called multiple times. - (remove-hook 'after-save-hook 'vc-svn-resolve-when-done t)))) - -;; Inspired by vc-arch-find-file-hook. -(defun vc-svn-find-file-hook () - (when (eq ?C (vc-file-getprop buffer-file-name 'vc-svn-status)) - ;; If the file is marked as "conflicted", then we should try and call - ;; "svn resolved" when applicable. - (if (save-excursion - (goto-char (point-min)) - (re-search-forward "^<<<<<<< " nil t)) - ;; There are conflict markers. - (progn - (smerge-start-session) - (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t)) - ;; There are no conflict markers. This is problematic: maybe it means - ;; the conflict has been resolved and we should immediately call "svn - ;; resolved", or it means that the file's type does not allow Svn to - ;; use conflict markers in which case we don't really know what to do. - ;; So let's just punt for now. - nil) - (message "There are unresolved conflicts in this file"))) - -(defun vc-svn-parse-status (&optional filename) - "Parse output of \"svn status\" command in the current buffer. -Set file properties accordingly. Unless FILENAME is non-nil, parse only -information about FILENAME and return its status." - (let (file status) - (goto-char (point-min)) - (while (re-search-forward - ;; Ignore the files with status X. - "^\\(?:\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t) - ;; If the username contains spaces, the output format is ambiguous, - ;; so don't trust the output's filename unless we have to. - (setq file (or filename - (expand-file-name - (buffer-substring (point) (line-end-position))))) - (setq status (char-after (line-beginning-position))) - (if (eq status ??) - (vc-file-setprop file 'vc-state 'unregistered) - ;; Use the last-modified revision, so that searching in vc-print-log - ;; output works. - (vc-file-setprop file 'vc-working-revision (match-string 3)) - ;; Remember Svn's own status. - (vc-file-setprop file 'vc-svn-status status) - (vc-file-setprop - file 'vc-state - (cond - ((eq status ?\ ) - (if (eq (char-after (match-beginning 1)) ?*) - 'needs-update - (vc-file-setprop file 'vc-checkout-time - (nth 5 (file-attributes file))) - 'up-to-date)) - ((eq status ?A) - ;; If the file was actually copied, (match-string 2) is "-". - (vc-file-setprop file 'vc-working-revision "0") - (vc-file-setprop file 'vc-checkout-time 0) - 'added) - ((eq status ?C) - (vc-file-setprop file 'vc-state 'conflict)) - ((eq status '?M) - (if (eq (char-after (match-beginning 1)) ?*) - 'needs-merge - 'edited)) - ((eq status ?I) - (vc-file-setprop file 'vc-state 'ignored)) - ((memq status '(?D ?R)) - (vc-file-setprop file 'vc-state 'removed)) - (t 'edited))))) - (when filename (vc-file-getprop filename 'vc-state)))) - -(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 - ;; an uppercase or lowercase letter and can contain uppercase and - ;; lowercase letters, digits, `-', and `_'. - (and (string-match "^[a-zA-Z]" tag) - (not (string-match "[^a-z0-9A-Z-_]" tag)))) - -(defun vc-svn-valid-revision-number-p (tag) - "Return non-nil if TAG is a valid revision number." - (and (string-match "^[0-9]" tag) - (not (string-match "[^0-9]" tag)))) - -;; Support for `svn annotate' - -(defun vc-svn-annotate-command (file buf &optional rev) - (vc-svn-command buf 'async file "annotate" (if rev (concat "-r" rev)))) - -(defun vc-svn-annotate-time-of-rev (rev) - ;; Arbitrarily assume 10 commmits per day. - (/ (string-to-number rev) 10.0)) - -(defvar vc-annotate-parent-rev) - -(defun vc-svn-annotate-current-time () - (vc-svn-annotate-time-of-rev vc-annotate-parent-rev)) - -(defconst vc-svn-annotate-re "[ \t]*\\([0-9]+\\)[ \t]+[^\t ]+ ") - -(defun vc-svn-annotate-time () - (when (looking-at vc-svn-annotate-re) - (goto-char (match-end 0)) - (vc-svn-annotate-time-of-rev (match-string 1)))) - -(defun vc-svn-annotate-extract-revision-at-line () - (save-excursion - (beginning-of-line) - (if (looking-at vc-svn-annotate-re) (match-string 1)))) - -(defun vc-svn-revision-table (files) - (let ((vc-svn-revisions '())) - (with-current-buffer "*vc*" - (vc-svn-command nil 0 files "log" "-q") - (goto-char (point-min)) - (forward-line) - (let ((start (point-min)) - (loglines (buffer-substring-no-properties (point-min) - (point-max)))) - (while (string-match "^r\\([0-9]+\\) " loglines) - (push (match-string 1 loglines) vc-svn-revisions) - (setq start (+ start (match-end 0))) - (setq loglines (buffer-substring-no-properties start (point-max))))) - vc-svn-revisions))) - -(provide 'vc-svn) - -;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d -;;; vc-svn.el ends here |
