[svk-commit] r2338 - in branches/2.0-releng: utils
nobody at bestpractical.com
nobody at bestpractical.com
Wed Mar 14 20:29:50 EDT 2007
Author: clkao
Date: Wed Mar 14 20:29:50 2007
New Revision: 2338
Added:
branches/2.0-releng/utils/vc-svk.el
Modified:
branches/2.0-releng/MANIFEST
Log:
Merge from trunk:
r2336 at trunk: clkao | 2007-03-15 00:23:24 +0000
add vc-svk.el to MANIFEST.
r2299 at trunk: nelhage | 2007-02-12 22:37:51 +0000
Adding a version of vc-svk updated with some fixes
Modified: branches/2.0-releng/MANIFEST
==============================================================================
--- branches/2.0-releng/MANIFEST (original)
+++ branches/2.0-releng/MANIFEST Wed Mar 14 20:29:50 2007
@@ -294,5 +294,6 @@
utils/license_tag
utils/pullyu
utils/svk-ediff.el
+utils/vc-svk.el
utils/verify-mirror
Added: branches/2.0-releng/utils/vc-svk.el
==============================================================================
--- (empty file)
+++ branches/2.0-releng/utils/vc-svk.el Wed Mar 14 20:29:50 2007
@@ -0,0 +1,820 @@
+;; Based upon vc-svn.el
+;; Hack--most things are very slow/may work improperly.
+
+;; Copyright (C) 1995, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+;; Free Software Foundation, Inc.
+
+;; Author: FSF (see vc.el for full credits)
+;; Maintainer:
+
+;; This file is not yet 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 2, 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; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; I created this *only* to allow me to open files and do `vc-diff'.
+;; If anything else even works, it's not my fault. :) This needs a lot
+;; of love before it is a good VC backend, but it will allow you to do
+;; some minimal tasks.
+
+;; I primarily use FSF Emacs 22. It may not work with older Emacsen.
+;; Or it might, thanks to your bug reports.
+
+;; vc-svn commentary:
+;; This is preliminary support for Subversion (http://subversion.tigris.org/).
+;; It started as `sed s/cvs/svk/ vc.cvs.el' (from version 1.56)
+;; and hasn't been completely fixed since.
+
+;; Sync'd with Subversion's vc-svn.el as of revision 5801.
+
+;;; Bugs:
+
+;; - VC-dired is (really) slow.
+;; - (svk) Most other commands are, too.
+
+;;; Changelog:
+;; * 20050707: Yikes! My original was inadvertently posted with two instances of misplaced parens/stale code and didn't work at all!
+;;
+;; * 20050711: Improve handling of files not in the repository.
+;;
+;; * Old bugs on Emacs 21.4 (are these fixed yet?):
+;; 00 (defalias) only takes 2 arguments
+;; 00 While switching to vc-dired-mode from dired mode: "No subdir-alist in lib". vc-directory barfs with "Symbol's function definition is void: vc-stay-local-p".
+;; 00 Loading any file yields "Symbol's definition is void: assoc-string".
+;; 00 hate hate hate.
+;;
+;; * 20050816:
+;; 00 Fixed more problems with added and unknown files.
+;; 00 Fixed the `time-less-p' and `assoc-string' problems on Emacs <22.
+;; 00 Fixed some unsual cases in vc-svk-do-status.
+;; 00 Fixed vc-register (also fixes the defalias problem on Emacs <22).
+;; 00 *May* fix the vc-dired problem. I can't test this, and don't use it.
+;;
+;; * 20050817:
+;; 00 Handle directories correctly in `vc-svk-registered'.
+;; 00 A few more compatibility fixes.
+;;
+;; * 20051006:
+;; 00 Less crashing for subdirectories that aren't registered.
+;; 00 Misc. cleanups.
+;;
+;; * 20051017:
+;; 00 Tweak last fix.
+;;
+;; * 20051025:
+;; 00 Require SVK 1.03, use it to get better status.
+;; 00 Support vc-annotate (C-x v g) (more to be done).
+;;
+;; * 20051026: (The first new features in vc-svk that aren't in vc-svn!)
+;; 00 Accurate coloring in vc-annotate. If you don't like the lag while the cache builds, set `vc-svk-annotate-absolutely' to nil.
+;; 00 vc-annotate works in Emacs 21.
+;;
+;; * 20051102:
+;; 00 One line fix for symlink to one WD inside another.
+;;
+;; * 20060219:
+;; 00 Fix some rare crashes for un-added subtrees.
+;; 00 New feature: `vc-annotate-revision-previous-to-line'
+;;
+;; * 20060207 (Nelson Elhage):
+;; 00 vc-svk-co-paths looks at svk checkout --list, instead of parsing .svk/config, so it works properly with SVK 2.0
+;;
+;; * 20060207 (Nelson Elhage)
+;; 00 Checked into SVK subversion
+;; 00 Modified vc-svk-parse-parse-status to remove all svn-only cruft and fixed vc-svk-status-file-re
+
+
+;;; Code:
+
+(eval-when-compile
+ (require 'vc))
+(require 'cl)
+(require 'time-date)
+
+;; Compatibility with Emacs <22
+
+(if (fboundp 'time-less-p)
+ (defalias 'vc-svk-time-less-p 'time-less-p)
+ (defun vc-svk-time-less-p (t1 t2)
+ "Say whether time value T1 is less than time value T2."
+ (with-decoded-time-value ((high1 low1 micro1 t1)
+ (high2 low2 micro2 t2))
+ (or (< high1 high2)
+ (and (= high1 high2)
+ (or (< low1 low2)
+ (and (= low1 low2)
+ (< micro1 micro2))))))))
+
+(if (fboundp 'assoc-string)
+ (defalias 'vc-svk-assoc-string 'assoc-string)
+ (defun vc-svk-assoc-string (key alist)
+ (assoc-default key alist
+ (lambda (a b)
+ (and (stringp a) (stringp b) (string-equal a b))))))
+
+;; SVK repositories are (almost always? all?) local anyway.
+(defmacro vc-svk-stay-local-p (file) nil)
+
+(if (fboundp 'vc-switches)
+ (defalias 'vc-svk-switches 'vc-switches)
+ (defun vc-svk-switches (backend op)
+ (let ((switches
+ (or (if backend
+ (let ((sym (vc-make-backend-sym
+ backend (intern (concat (symbol-name op)
+ "-switches")))))
+ (if (boundp sym) (symbol-value sym))))
+ (let ((sym (intern (format "vc-%s-switches" (symbol-name op)))))
+ (if (boundp sym) (symbol-value sym)))
+ (cond
+ ((eq op 'diff) diff-switches)))))
+ (if (stringp switches) (list switches)
+ ;; If not a list, return nil.
+ ;; This is so we can set vc-diff-switches to t to override
+ ;; any switches in diff-switches.
+ (if (listp switches) switches)))))
+
+(unless (boundp 'vc-disable-async-diff)
+ ;; pessimistic assumption
+ (setq vc-disable-async-diff t))
+
+(if (boundp 'vc-annotate-parent-file)
+ (defun vc-svk-annotate-parent-file ()
+ vc-annotate-parent-file)
+ (defun vc-svk-annotate-parent-file ()
+ (buffer-file-name vc-parent-buffer)))
+
+(if (< emacs-major-version 22)
+ (defun vc-svk-date-to-day (date)
+ ;; SVN gives e.g. "2005-10-26T05:34:02.209866Z\n" which are
+ ;; rejected by Emacs <22.
+ (let ((i (string-match "T" date)))
+ (date-to-day (if i
+ (concat (substring date 0 i)
+ " "
+ (substring date (1+ i)))
+ date))))
+ (defalias 'vc-svk-date-to-day 'date-to-day))
+
+;;;
+;;; Customization options
+;;;
+
+(defcustom vc-svk-global-switches nil
+ "*Global switches to pass to any SVK command."
+ :type '(choice (const :tag "None" nil)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List"
+ :value ("")
+ string))
+ :version "21.4"
+ :group 'vc)
+
+(defcustom vc-svk-register-switches nil
+ "*Extra switches for registering a file into SVK.
+A string or list of strings passed to the checkin program by
+\\[vc-register]."
+ :type '(choice (const :tag "None" nil)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List"
+ :value ("")
+ string))
+ :version "21.4"
+ :group 'vc)
+
+(defcustom vc-svk-diff-switches
+ t ;`svk' doesn't support common args like -c or -b.
+ "String or list of strings specifying extra switches for svk diff under VC.
+If nil, use the value of `vc-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 "21.4"
+ :group 'vc)
+
+(defcustom vc-svk-header (or (cdr (assoc 'SVK vc-header-alist)) '("\$Id\$"))
+ "*Header keywords to be inserted by `vc-insert-headers'."
+ :version "21.4"
+ :type '(repeat string)
+ :group 'vc)
+
+(defconst vc-svk-use-edit nil
+ ;; Subversion does not provide this feature (yet).
+ "*Non-nil means to use `svk edit' to \"check out\" a file.
+This is only meaningful if you don't use the implicit checkout model
+\(i.e. if you have $SVKREAD set)."
+ ;; :type 'boolean
+ ;; :version "21.4"
+ ;; :group 'vc
+ )
+
+(defconst vc-svk-status-file-re
+ "^[ ADMCI?!~][ MC][ +] +\\([-0-9?]+\\) +\\([0-9?]+\\) +\\([^ ]+\\) +")
+
+;;;
+;;; State-querying functions
+;;;
+
+;;; FIXME
+;;;###autoload (add-to-list 'vc-handled-backends 'SVK)
+;;;###autoload (defun vc-svk-registered (file)
+;;;###autoload (when (string-match
+;;;###autoload "^Checkout Path:"
+;;;###autoload (shell-command-to-string (concat "svk info "
+;;;###autoload (expand-file-name file))))
+;;;###autoload (setq file nil)
+;;;###autoload (load "vc-svk")
+;;;###autoload (vc-svk-registered file)))
+
+(add-to-list 'vc-handled-backends 'SVK)
+(defun vc-svk-registered (file)
+ "Check if FILE is SVK registered."
+
+ (let ((lfile (file-truename file)) ; SVK stores truenames
+ (file-buffer (current-buffer)))
+ (when (vc-svk-co-path-p lfile)
+ (save-window-excursion ; being left in some random buffer
+ ; confuses `vc-find-file-hook'
+ (with-temp-buffer
+ (cd (file-name-directory lfile))
+ (condition-case nil
+ (progn
+ (vc-svk-do-status lfile)
+ (vc-svk-parse-status t (unless (string-equal file lfile)
+ file))
+ (eq 'SVK (vc-file-getprop file 'vc-backend)))
+ ;; We can't find an `svk' executable. We could also deregister SVK.
+ (file-error nil)))))))
+
+(defun vc-svk-state (file &optional localp)
+ "SVK-specific version of `vc-state'."
+ (setq localp (or localp (vc-svk-stay-local-p file)))
+ (with-temp-buffer
+ (cd (file-name-directory file))
+ (vc-svk-do-status file)
+ (vc-svk-parse-status localp)
+ (vc-file-getprop file 'vc-state)))
+
+(defun vc-svk-state-heuristic (file)
+ "SVK-specific state heuristic."
+ (vc-svk-state file 'local))
+
+(defun vc-svk-dir-state (dir &optional localp)
+ "Find the SVK state of all files in DIR."
+ (setq localp (or localp (vc-svk-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
+ (vc-svk-do-status dir)
+ (vc-svk-parse-status localp))))
+
+(defun vc-svk-workfile-version (file)
+ "SVK-specific version of `vc-workfile-version'."
+ ;; There is no need to consult RCS headers under SVK, because we
+ ;; get the workfile version for free when we recognize that a file
+ ;; is registered in SVK.
+ (vc-svk-registered file)
+ (vc-file-getprop file 'vc-workfile-version))
+
+(defun vc-log-version-at-point ()
+ "Extract the revision number at point as a string."
+ (buffer-substring-no-properties (1+ (point))
+ (save-excursion
+ (search-forward ":" nil t)
+ (1- (point)))))
+
+(defun vc-svk-previous-version (file rev)
+ "The greatest revision number string before REV in which FILE was modified."
+ ;; Parse log -q to find it. Non-optimal.
+ (with-temp-buffer
+ (vc-svk-command t 0 file "log" "-q")
+ (goto-char (point-min))
+ ;; If the file was modified in rev we can jump to it exactly.
+ (search-forward-regexp (concat "^r" rev) nil t)
+ (goto-char (match-beginning 0))
+ (let ((revnum (string-to-number rev)))
+ (unless (= revnum (string-to-number (vc-log-version-at-point)))
+ ;; Otherwise, go line-by-line looking for it.
+ (goto-char (point-min))
+ (forward-line 1)
+ (while (and (bolp) (< revnum
+ (string-to-number (vc-log-version-at-point))))
+ (forward-line 2))
+ (forward-line -2))
+ ;; The line with the desired revnum:
+ (forward-line 2)
+ (when (bolp)
+ (vc-log-version-at-point)))))
+
+(defun vc-svk-checkout-model (file)
+ "SVK-specific version of `vc-checkout-model'."
+ ;; It looks like Subversion has no equivalent of CVSREAD.
+ 'implicit)
+
+;; vc-svk-mode-line-string doesn't exist because the default implementation
+;; works just fine.
+
+(defun vc-svk-dired-state-info (file)
+ "SVK-specific version of `vc-dired-state-info'."
+ (let ((svk-state (vc-state file)))
+ (cond ((eq svk-state 'edited)
+ (if (equal (vc-workfile-version file) "0")
+ "(added)" "(modified)"))
+ ((eq svk-state 'needs-patch) "(patch)")
+ ((eq svk-state 'needs-merge) "(merge)"))))
+
+;;;
+;;; State-changing functions
+;;;
+
+(defun vc-svk-register (file &optional rev comment)
+ "Register FILE into the SVK version-control system.
+COMMENT can be used to provide an initial description of FILE.
+
+`vc-register-switches' and `vc-svk-register-switches' are passed to
+the SVK command (in that order)."
+ (apply 'vc-svk-command nil 0 file "add" (vc-svk-switches 'SVK 'register)))
+
+(defun vc-svk-could-register (file)
+ "Return non-nil if FILE could be registered in SVK.
+This is only possible if SVK is responsible for FILE's directory."
+ (and (vc-svk-co-path-of file)
+ (vc-svk-registered (file-name-directory
+ (vc-svk-file-name-no-trailsep file)))))
+
+(defun vc-svk-init-version () "1")
+
+(defun vc-svk-checkin (file rev comment)
+ "SVK-specific version of `vc-backend-checkin'."
+ (let ((status (apply
+ 'vc-svk-command nil 1 file "ci"
+ (nconc (list "-m" comment) (vc-svk-switches 'SVK '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)
+ (vc-file-setprop file 'vc-state 'needs-merge)
+ (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-workfile-version
+ ;; (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
+ ))
+
+(defun vc-svk-find-version (file rev buffer)
+ (apply 'vc-svk-command
+ buffer 0 file
+ "cat"
+ (and rev (not (string= rev ""))
+ (concat "-r" rev))
+ (vc-svk-switches 'SVK 'checkout)))
+
+(defun vc-svk-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-svk-switches 'SVK 'checkout)))
+ (vc-mode-line file)
+ (message "Checking out %s...done" file))
+
+(defun vc-svk-update (file editable rev switches)
+ (if (and (file-exists-p file) (not rev))
+ ;; If no revision was specified, just make the file writable
+ ;; if necessary (using `svk-edit' if requested).
+ (and editable (not (eq (vc-svk-checkout-model file) 'implicit))
+ (if vc-svk-use-edit
+ (vc-svk-command nil 0 file "edit")
+ (set-file-modes file (logior (file-modes file) 128))
+ (if (equal file buffer-file-name) (toggle-read-only -1))))
+ ;; Check out a particular version (or recreate the file).
+ (vc-file-setprop file 'vc-workfile-version nil)
+ (apply 'vc-svk-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)
+ (t (concat "-r" rev)))
+ switches)))
+
+(defun vc-svk-delete-file (file)
+ (vc-svk-command nil 0 file "remove"))
+
+(defun vc-svk-rename-file (old new)
+ (vc-svk-command nil 0 new "move" (file-relative-name old)))
+
+(defun vc-svk-revert (file &optional contents-done)
+ "Revert FILE to the version it was based on."
+ (unless contents-done
+ (vc-svk-command nil 0 file "revert"))
+ (unless (eq (vc-checkout-model file) 'implicit)
+ (if vc-svk-use-edit
+ (vc-svk-command nil 0 file "unedit")
+ ;; Make the file read-only by switching off all w-bits
+ (set-file-modes file (logand (file-modes file) 3950)))))
+
+(defun vc-svk-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-svk-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-svk-merge-news (file)
+ "Merge in any new changes made to FILE."
+ (message "Merging changes into %s..." file)
+ ;; (vc-file-setprop file 'vc-workfile-version nil)
+ (vc-file-setprop file 'vc-checkout-time 0)
+ (vc-svk-command nil 0 file "update")
+ ;; Analyze the merge result reported by SVK, and set
+ ;; file properties accordingly.
+ (with-current-buffer (get-buffer "*vc*")
+ (goto-char (point-min))
+ ;; get new workfile version
+ (if (re-search-forward
+ "^\\(Updated to\\|At\\) revision \\([0-9]+\\)" nil t)
+ (vc-file-setprop file 'vc-workfile-version (match-string 2))
+ (vc-file-setprop file 'vc-workfile-version 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
+ (concat "^\\([CGDU] \\)?"
+ (regexp-quote (file-name-nondirectory file)))
+ nil t)
+ (cond
+ ;; Merge successful, we are in sync with repository now
+ ((string= (match-string 1) "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 1) "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 svk update result")))
+ (message "Merging changes into %s...done" file))))
+
+;;;
+;;; History functions
+;;;
+
+(defun vc-svk-print-log (file &optional buffer)
+ "Get change log associated with FILE."
+ (save-current-buffer
+ (vc-setup-buffer buffer)
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ ;; Add a line to tell log-view-mode what file this is.
+ (insert "Working file: " (file-relative-name file) "\n"))
+ (vc-svk-command
+ buffer
+ (if (and (vc-svk-stay-local-p file) (fboundp 'start-process)) 'async 0)
+ file "log")))
+
+(defun vc-svk-diff (file &optional oldvers newvers buffer)
+ "Get a difference report using SVK between two versions of FILE."
+ (unless buffer (setq buffer "*vc-diff*"))
+ (if (and oldvers (equal oldvers (vc-workfile-version file)))
+ ;; Use nil rather than the current revision because svk handles it
+ ;; better (i.e. locally).
+ (setq oldvers nil))
+ (if (string= (vc-workfile-version file) "0")
+ ;; This file is added but not yet committed; there is no master file.
+ (if (or oldvers newvers)
+ (error "No revisions of %s exist" file)
+ ;; We regard this as "changed".
+ ;; Diff it against /dev/null.
+ ;; Note: this is NOT a "svk diff".
+ (apply 'vc-do-command buffer
+ 1 "diff" file
+ (append (vc-svk-switches nil 'diff) '("/dev/null")))
+ ;; Even if it's empty, it's locally modified.
+ 1)
+ (let* ((switches
+ (if vc-svk-diff-switches
+ (vc-svk-switches 'SVK 'diff)
+ (list "-x" (mapconcat 'identity (vc-svk-switches nil 'diff) " "))))
+ (async (and (not vc-disable-async-diff)
+ (vc-svk-stay-local-p file)
+ (or oldvers newvers) ; Svk diffs those locally.
+ (fboundp 'start-process))))
+ (apply 'vc-svk-command buffer
+ (if async 'async 0)
+ file "diff"
+ (append
+ switches
+ (when oldvers
+ (list "-r" (if newvers (concat oldvers ":" newvers)
+ oldvers)))))
+ (if async 1 ; async diff => pessimistic assumption
+ ;; For some reason `svk diff' does not return a useful
+ ;; status w.r.t whether the diff was empty or not.
+ (buffer-size (get-buffer buffer))))))
+
+(defun vc-svk-diff-tree (dir &optional rev1 rev2)
+ "Diff all files at and below DIR."
+ (vc-svk-diff (file-name-as-directory dir) rev1 rev2))
+
+;;;
+;;; Snapshot system
+;;;
+
+(defun vc-svk-create-snapshot (dir name branchp)
+ "Assign to DIR's current version 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-svk-command nil 0 dir "copy" name)
+ (when branchp (vc-svk-retrieve-snapshot dir name nil)))
+
+(defun vc-svk-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 `svk update'.
+If UPDATE is non-nil, then update (resynch) any affected buffers.
+NAME is assumed to be a URL."
+ (vc-svk-command nil 0 dir "switch" name)
+ ;; FIXME: parse the output and obey `update'.
+ )
+
+;;;
+;;; Annotate
+;;;
+
+(defun vc-svk-annotate-command (file buf &optional rev)
+ (vc-svk-command buf 0 file "annotate" (if rev (concat "-r" rev)))
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (delete-region (point) (line-end-position 3))))
+
+(defvar vc-svk-annotate-absolutely t
+ "Non-nil to ask SVK about each revision's date in `vc-svk-annotate-time'.
+Otherwise date annotations by revision number. There is a delay to get
+the revision dates at first and a little memory to cache them.")
+;; Keys: "<rev num>/depot/"
+(defvar vc-svk-annotate-rev-days (make-hash-table :test 'equal))
+
+(defvar vc-svk-annotate-buffer-depot nil)
+(make-variable-buffer-local 'vc-svk-buffer-depot)
+
+(defun vc-svk-annotate-time-of-rev (rev)
+ (let* ((file (vc-svk-annotate-parent-file))
+ (rev (or rev
+ (vc-workfile-version file)))
+ (key (concat rev
+ (or vc-svk-annotate-buffer-depot
+ (setq vc-svk-annotate-buffer-depot
+ (vc-svk-repository-hostname file))))))
+ (if vc-svk-annotate-absolutely
+ (or (gethash key vc-svk-annotate-rev-days)
+ (setf (gethash key vc-svk-annotate-rev-days)
+ (vc-svk-date-to-day
+ (shell-command-to-string
+ (apply 'concat
+ "svk propget --revprop svn:date -r" rev
+ vc-svk-global-switches)))))
+ ;; Like SVN, arbitrarily assume 10 commmits per day.
+ (/ (string-to-number rev) 10.0))))
+
+(defun vc-svk-annotate-current-time ()
+ (vc-svk-annotate-time-of-rev vc-annotate-parent-rev))
+
+(defun vc-svk-annotate-time ()
+ (vc-svk-annotate-time-of-rev (vc-svk-annotate-extract-revision-at-line)))
+(defun vc-svk-annotate-difference (point)
+ ;; Emacs 21 compatibility.
+ (unless (= point (point-max))
+ (goto-char point)
+ (- (time-to-days (current-time))
+ (vc-svk-annotate-time))))
+
+(defun vc-svk-annotate-extract-revision-at-line ()
+ (save-excursion
+ (beginning-of-line)
+ (if (re-search-forward "^[ ]+\\([0-9]+\\)[ ]+("
+ (line-end-position) t)
+ (match-string-no-properties 1)
+ nil)))
+
+;;;
+;;; Miscellaneous
+;;;
+
+;; Subversion makes backups for us, so don't bother.
+;; (defalias 'vc-svk-make-version-backups-p 'vc-svk-stay-local-p
+;; "Return non-nil if version backups should be made for FILE.")
+
+(defun vc-svk-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-svk-command (buffer okstatus file &rest flags)
+ "A wrapper around `vc-do-command' for use in vc-svk.el.
+The difference to vc-do-command is that this function always invokes `svk',
+and that it passes `vc-svk-global-switches' to it before FLAGS."
+ (if (file-exists-p (expand-file-name "~/.svk/lock"))
+ (error "Another svk might be running; remove ~/.svk/lock if not.")
+ (let ((args (if (stringp vc-svk-global-switches)
+ (cons vc-svk-global-switches flags)
+ (append vc-svk-global-switches
+ flags))))
+ (apply 'vc-do-command buffer okstatus "svk" file
+ args))))
+
+(defun vc-svk-repository-hostname (file)
+ "Ask SVK for the depot of FILE."
+ ;; Used by vc-stay-local-p to make that decision per-hostname/path.
+ ;; Used in vc-svk to get depots.
+ (let ((info (vc-svk-do-info-string file)))
+ (when (string-match "Depot Path: \\(/.*?/\\)" info)
+ (match-string 1 info))))
+
+(defun vc-svk-parse-status (localp &optional linked-file)
+ "Parse output of `vc-svk-do-status' in the current buffer.
+Set file properties accordingly."
+ (let (file status)
+ (goto-char (point-min))
+ (while (re-search-forward vc-svk-status-file-re nil t)
+ (setq file (or linked-file
+ (expand-file-name
+ (buffer-substring (point) (line-end-position)))))
+ (setq status (char-after (line-beginning-position)))
+ (unless (eq status ??)
+ (vc-file-setprop file 'vc-backend 'SVK)
+ ;; Use the last-modified revision, so that searching in vc-print-log
+ ;; output works.
+ (vc-file-setprop file 'vc-workfile-version (match-string 2))
+ (vc-file-setprop
+ file 'vc-state
+ (cond
+ ((eq status ?\ )
+ (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-workfile-version "0")
+ (vc-file-setprop file 'vc-checkout-time 0)
+ 'edited)
+ ((memq status '(?M ?C))
+ 'edited)
+ (t 'edited)))))))
+
+(defun vc-svk-dir-state-heuristic (dir)
+ "Find the SVK state of all files in DIR, using only local information."
+ (vc-svk-dir-state dir 'local))
+
+(defun vc-svk-valid-symbolic-tag-name-p (tag)
+ "Return non-nil if TAG is a valid symbolic tag name."
+ ;; According to the SVK 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-svk-valid-version-number-p (tag)
+ "Return non-nil if TAG is a valid version number."
+ (and (string-match "^[0-9]" tag)
+ (not (string-match "[^0-9]" tag))))
+
+(defun vc-svk-do-status (file)
+ ;; Don't crash if SVK didn't really have the file (e.g. un-added
+ ;; subdir of co path). Each such error message must be parsed
+ ;; equivilient to ? in `vc-svk-parse-status'.
+ (ignore-errors
+ (vc-svk-command t 0 file "status" "-Nv"))
+ ;; SVN always puts file at the top of status output.
+ ;; SVK puts it at the bottom if file is a dir, and additionally may
+ ;; output it as a relative path.
+ (when (file-directory-p file)
+ (save-excursion
+ (previous-line 1)
+ (delete-region (point)
+ (point-min))
+ (delete-region (re-search-forward vc-svk-status-file-re nil t)
+ (line-end-position))
+ (insert file))))
+
+(defsubst vc-svk-do-info-string (file)
+ (shell-command-to-string (concat "svk info "
+ (expand-file-name file))))
+
+(defun vc-svk-file-name-no-trailsep (file)
+ "Return filename minus trailing separators.
+
+Caution! Cheats and onlya removes them when Emacs is known to put
+them and they matter to vc-svk."
+ (let ((end (1- (length file))))
+ (if (and (file-directory-p file)
+ (string-equal (substring file end) "/"))
+ (substring file 0 end)
+ file)))
+
+(defvar vc-svk-co-paths nil)
+(defun vc-svk-co-paths ()
+ (interactive)
+ (let ((config "~/.svk/config")
+ mtime)
+ (when (file-readable-p config)
+ (setq mtime (nth 5 (file-attributes "~/.svk/config")))
+ (unless (and vc-svk-co-paths ; has not it been loaded?
+ (vc-svk-time-less-p mtime ; is it unmodified since?
+ (car vc-svk-co-paths)))
+ ;; (re)load
+ (setq vc-svk-co-paths (list mtime))
+ (with-temp-buffer
+ (vc-svk-command t 0 nil "checkout" "--list")
+ (goto-char (point-min))
+ (when (search-forward "==========\n" nil t)
+ (while (re-search-forward "^ +\\(.+\\) *\t\\(.+\\)$" nil t)
+ (add-to-list 'vc-svk-co-paths
+ (list (match-string-no-properties 2)
+ (match-string-no-properties 1))))))
+ (setq vc-svk-co-paths (nreverse vc-svk-co-paths)))))
+ vc-svk-co-paths)
+
+;; These will often avoid slow calls to `vc-svk-command'.
+(defun vc-svk-co-path-p (file)
+ "Whether SVK manages a parent directory of FILE.
+Note that this does not try to guarantee SVK manages this particular
+subdirectory. That's for the full `vc-svk-registered' to decide."
+ (vc-svk-co-paths)
+ (block nil
+ (unless (file-exists-p file)
+ (return nil))
+ ;; Check file and each parent dir for svk-ness
+ ;; Yeah, this is not the greatest. And it's UNIX-centric.
+ (while (and file (not (string-equal file "/")))
+ ;; For both SVK and file-name-directory, dirnames must not
+ ;; include trailing /
+ (setq file (substring file 0 (string-match "/\\'" file)))
+ (if (vc-svk-assoc-string file vc-svk-co-paths)
+ (return t)
+ (setq file (file-name-directory file))))))
+
+(defun vc-svk-co-path-of (file)
+ "Return the CO path holding FILE, or nil."
+ (car (find-if #'(lambda (codir)
+ (and (stringp codir)
+ (string-match (concat "^" codir) file)))
+ vc-svk-co-paths
+ :key 'first)))
+
+(provide 'vc-svk)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; End:
+;;; vc-svk.el ends here
More information about the svk-commit
mailing list