view lisp/vc-svn.el @ 94414:d86cb59eea9f

2008-04-27 Carsten Dominik <[e-mail]> * org/org.el (org-html-level-start): Always have id's in HTML (org-export-as-html): Use `org-link-protocols' to retrieve the export form of the link. (org-add-link-type): Final parameter renamed from PUBLISH. Better documentation of how it is to be used. Avoid double entries for the same link type. (org-add-link-props): New function. (org-modules-loaded): New variable. (org-load-modules-maybe, org-set-modules): New function. (org-modules): New option. (org-mode, org-cycle, orgstruct-mode, org-run-like-in-org-mode) (orgtbl-mode, org-store-link, org-insert-link-global) (org-open-at-point): Call `org-load-modules-maybe'. (org-search-view): Add more text properties. (org-agenda-schedule, org-agenda-deadline): Allow also in search-type agendas. (org-search-view): Order of arguments has been changed. Interpret prefix-arg as TODO-ONLY. (org-agenda, org-run-agenda-series, org-agenda-manipulate-query): Take new argument order of `org-search-view' into account. (org-todo-only): New variable. (org-search-syntax-table): New variable and function. (org-search-view): Do the search with the special syntax table. (define-obsolete-function-alias): Make work with XEmacs. (org-add-planning-info): Use old date as default when modifying an existing deadline or scheduled item. (org-agenda-compute-time-span): Make argument N optional. (org-agenda-format-date-aligned): Require `cal-iso'. (org-agenda-list): Include week into into agenda heading, don't list it at each date (only on Mondays). (org-read-date-analyze): Define local variable `iso-date'. (org-agenda-format-date-aligned): Remove dependency on `calendar-time-from-absolute'. (org-remember-apply-template, org-go-to-remember-target): Interpret filenames relative to `org-directory'. (org-complete): Silently fail when trying to complete keywords that don't have a default value. (org-get-current-options): Added a #+DATE: option. (org-additional-option-like-keywords): Removed "DATE:" from the list of additional keywords. (org-export-as-html): Removed (current-time) as unnecessary second argument of `format-time-string'. (org-clock-find-position): Handle special case at end of buffer. (org-agenda-day-view): New argument DAY-OF-YEAR, pass it on to `org-agenda-change-time-span'. (org-agenda-week-view): New argument ISO-WEEK, pass it on to `org-agenda-change-time-span'. (org-agenda-month-view): New argument MONTH, pass it on to `org-agenda-change-time-span'. (org-agenda-year-view): New argument YEAR, pass it on to `org-agenda-change-time-span'. (org-agenda-change-time-span): New optional argument N, pass it on to `org-agenda-compute-time-span'. (org-agenda-compute-time-span): New argument N, interpret it by changing the starting day. (org-small-year-to-year): New function. (org-scheduled-past-days): Respect `org-scheduled-past-days'. (org-auto-repeat-maybe): Make sure that repeating dates are pushed into the future, and that the shift is at least one interval, never 0. (org-update-checkbox-count): Fix bug with checkbox counting. (org-add-note): New command. (org-add-log-setup): Renamed from `org-add-log-maybe'. (org-log-note-headings): New entry for plain notes (i.e. notes not related to state changes or clocking). (org-get-org-file): Check for availability of `remember-data-file'. (org-cached-entry-get): Allow a regexp value for `org-use-property-inheritance'. (org-use-property-inheritance): Allow regexp value. Fix bug in customization type. (org-use-tag-inheritance): Allow a list and a regexp value for this variable. (org-scan-tags, org-get-tags-at): Implement selective tag inheritance. (org-entry-get): Respect value `selective' for the INHERIT argument. (org-tag-inherit-p, org-property-inherit-p): New functions. (org-agenda-format-date-aligned): Allow 10 characters for weekday, to acomodate German locale. (org-add-archive-files): New function. (org-agenda-files): New argument `ext', to get archive files as well. (org-tbl-menu): Protect the use of variables that are only available when org-table.el gets loaded. (org-read-agenda-file-list): Error if `org-agenda-files' is a single directory. (org-open-file): Allow a batch process to trigger waiting after executing a system command. (org-store-link): Link to headline when there is not target and no region in an org-mode buffer when creating a link. (org-link-types-re): New variable. (org-make-link-regexps): Compute `org-link-types-re'. (org-make-link-description-function): New option. (org-agenda-date, org-agenda-date-weekend): New faces. (org-archive-sibling-heading): New option. (org-archive-to-archive-sibling): New function. (org-iswitchb): New command. (org-buffer-list): New function. (org-agenda-columns): Also try the #+COLUMNS line in the buffer associated with the entry at point (or with the first entry in the agenda view). (org-modules): Add entry for org-bibtex.el. (org-completion-fallback-command): Moved into `org-completion' group. (org-clock-heading-function): Moved to `org-progress' group. (org-auto-repeat-maybe): Make sure that a note can be enforces if `org-log-repeat' is `note'. (org-modules): Allow additional symbols for external packages. (org-ctrl-c-ctrl-c): Allow for `org-clock-overlays' to be undefined. (org-clock-goto): Hide drawers after showing an entry with `org-clock-goto.' (org-shiftup, org-shiftdown, org-shiftright, org-shiftleft): Try also a clocktable block shift. (org-clocktable-try-shift): New function. (org-columns-hscoll-title): New function. (org-columns-previous-hscroll): New variable. (org-columns-full-header-line-format): New variable. (org-columns-display-here-title, org-columns-remove-overlays): Install `org-columns-hscoll-title' in post-command-hook. * org/org.el: Split into many small files. * org/org-agenda.el: New file, split off from org.el. * org/org-archive.el: New file, split off from org.el. * org/org-bbdb.el: New file. * org/org-bibtex.el: New file, split off from org.el. * org/org-clock.el: New file, split off from org.el. * org/org-colview.el: New file, split off from org.el. * org/org-compat.el: New file, split off from org.el. * org/org-exp.el: New file, split off from org.el. * org/org-faces.el: New file, split off from org.el. * org/org-gnus.el: New file, split off from org.el. * org/org-info.el: New file, split off from org.el. * org/org-infojs.el: New file. * org/org-irc.el: New file. * org/org-macs.el: New file, split off from org.el. * org/org-mew.el: New file. * org/org-mhe.el: New file, split off from org.el. * org/org-publish.el: New file, split off from org.el. * org/org-remember.el: New file, split off from org.el. * org/org-rmail.el: New file, split off from org.el. * org/org-table.el: New file, split off from org.el. * org/org-vm.el: New file, split off from org.el. * org/org-wl.el: New file, split off from org.el. 2008-04-27 Jason Riedy <[e-mail]> * lisp/org-table.el (orgtbl-to-generic): Add a :remove-nil-lines parameter that supresses lines that evaluate to NIL. (orgtbl-get-fmt): New inline function for picking apart formats that may be lists. (orgtbl-apply-fmt): New inline function for applying formats that may be functions. (orgtbl-eval-str): New inline function for strings that may be functions. (orgtbl-format-line, orgtbl-to-generic): Use and document. (orgtbl-to-latex, orgtbl-to-texinfo): Document. (*orgtbl-llfmt*, *orgtbl-llstart*) (*orgtbl-llend*): Dynamic variables for last-line formatting. (orgtbl-format-section): Shift formatting to support detecting the last line and formatting it specially. (orgtbl-to-generic): Document :ll* formats. Set to the non-ll formats unless overridden. (orgtbl-to-latex): Suggest using :llend to suppress the final \\. (*orgtbl-table*, *orgtbl-rtn*): Dynamically bound variables to hold the input collection of lines and output formatted text. (*orgtbl-hline*, *orgtbl-sep*, *orgtbl-fmt*, *orgtbl-efmt*, (*orgtbl-lfmt*, *orgtbl-lstart*, *orgtbl-lend*): Dynamically bound format parameters. (orgtbl-format-line): New function encapsulating formatting for a single line. (orgtbl-format-section): Similar for each section. Rebinding the dynamic vars customizes the formatting for each section. (orgtbl-to-generic): Use orgtbl-format-line and orgtbl-format-section. (org-get-param): Now unused, so delete. (orgtbl-gather-send-defs): New function to gather all the SEND definitions before a table. (orgtbl-send-replace-tbl): New function to find the RECEIVE corresponding to the current name. (orgtbl-send-table): Use the previous two functions and implement multiple destinations for each table. * doc/org.texi (A LaTeX example): Note that fmt may be a one-argument function, and efmt may be a two-argument function. (Radio tables): Document multiple destinations. 2008-04-27 Carsten Dominik <[e-mail]> * org/org-agenda.el (org-add-to-diary-list): New function. (org-prefix-has-effort): New variable. (org-sort-agenda-noeffort-is-high): New option. (org-agenda-columns-show-summaries) (org-agenda-columns-compute-summary-properties): New options. (org-format-agenda-item): Compute the duration of the item. (org-agenda-weekend-days): New variable. (org-agenda-list, org-timeline): Use the proper faces for dates in the agenda and timeline buffers. (org-agenda-archive-to-archive-sibling): New command. (org-agenda-start-with-clockreport-mode): New option. (org-agenda-clockreport-parameter-plist): New option. (org-agenda-clocktable-mode): New variable. (org-agenda-deadline-leaders): Allow a function value for the deadline leader. (org-agenda-get-deadlines): Deal with new function value. * lisp/org-clock.el (org-clock): New customization group. (org-clock-into-drawer, org-clock-out-when-done) (org-clock-in-switch-to-state, org-clock-heading-function): Moved into the new group. (org-clock-out-remove-zero-time-clocks): New option. (org-clock-out): Use `org-clock-out-remove-zero-time-clocks'. (org-dblock-write:clocktable): Allow a Lisp form for the scope parameter. (org-dblock-write:clocktable): Fixed bug with total time calculation. (org-dblock-write:clocktable): Request the unrestricted list of files. (org-get-clocktable): New function. (org-dblock-write:clocktable): Make sure :tstart and :tend can not only be strings but also integers (an absolute day number) and lists (m d y). * org/org-colview.el (org-columns-next-allowed-value) (org-columns-edit-value): Limit the effort for updatig in the agenda to recomputing a single file. (org-columns-compute): Only write property value if it has changed. This avoids raising the buffer-change-flag unnecessarily. (org-agenda-colview-summarize) (org-agenda-colview-compute): New functions. (org-agenda-columns): Call `org-agenda-colview-summarize'. * org/org-exp.el (org-export-run-in-background): New option. (org-export-icalendar): Allow a batch process to trigger waiting after executing a system command. (org-export-preprocess-string): Renamed-from `org-cleaned-string-for-export'. (org-export-html-style): Made target class look like normal text. (org-export-as-html): Make use of the better proprocessing in `org-cleaned-string-for-export'. (org-cleaned-string-for-export): Better treatment of heuristic targets, many more internal links will now work in HTML export. (org-get-current-options): Incorporate LINK_UP, LINK_HOME, and INFOJS. (org-export-inbuffer-options-extra): New variable. (org-export-options-filters): New hook. (org-infile-export-plist): Find also the settings keywords in `org-export-inbuffer-options-extra'. (org-infile-export-plist): Allow multiple #+OPTIONS lines and multiple #+INFOJS_OPT lines. (org-export-html-handle-js-options): New function. (org-export-html-infojs-setup): New option. (org-export-as-html): Call `org-export-html-handle-js-options'. Add autoload to all entry points. (org-skip-comments): Function removed. * org/org-table.el (org-table-make-reference): Extra parenthesis around single fields, to make sure that algebraic formulas get correctly interpreted by calc. (org-table-current-column): No longer interactive. * org/org-export-latex.el (org-export-latex-preprocess): Renamed from `org-export-latex-cleaned-string'. 2008-04-27 Bastien Guerry <[e-mail]> * org/org-publish.el (org-publish-get-base-files-1): New function. (org-publish-get-base-files): Use it. (org-publish-temp-files): New variable. Don't require 'dired-aux anymore. (org-publish-initial-buffer): New variable. (org-publish-org-to, org-publish): Use it. (org-publish-get-base-files-1): Bug fix: get the proper list of files when recursing thru a directory. (org-publish-get-base-files): Use the :exclude property to skip both files and directories.

;;; vc-svn.el --- non-resident support for Subversion version-control

;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.

;; Author:      FSF (see vc.el for full credits)
;; Maintainer:  Stefan Monnier <[e-mail]>

;; 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, 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., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; 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))

;;;
;;; Customization options
;;;

(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
  "*Extra switches for registering a file into SVN.
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 "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'.
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)
;;;
;;; 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))))

;;;###autoload
(add-to-list 'completion-ignored-extensions ".svn/")

(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 ((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'."
  (setq localp (or localp (vc-stay-local-p file)))
  (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))

(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)
  (let ((state-map '((?A . added)
                     (?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 (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."
  (vc-svn-command (current-buffer) 'async nil "status")
  (vc-exec-after
   `(vc-svn-after-dir-status (quote ,callback))))

(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))

(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-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 nil 0 "svnadmin" '("create" "SVN"))
  (vc-do-command nil 0 "svn" '(".")
		 "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.

`vc-register-switches' and `vc-svn-register-switches' are passed to
the SVN command (in that order)."
  (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)
  "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."
  (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-call update file editable rev (vc-switches 'SVN 'checkout)))
  (vc-mode-line file)
  (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
	   "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-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 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
      (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
		   nil 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 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")))))

;;;
;;; History functions
;;;

(defun vc-svn-print-log (files &optional buffer)
  "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")
		  (vc-svn-command
		   buffer
		   'async
		   ;; (if (and (= (length files) 1) (vc-stay-local-p file)) 'async 0)
		   (list file)
		   "log"
		   ;; 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"))
	;; 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
       (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 "-x" (mapconcat 'identity (vc-switches nil 'diff) " "))))
	   (async (and (not vc-disable-async-diff)
                       (vc-stay-local-p files)
		       (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)))))

;;;
;;; Snapshot system
;;;

(defun vc-svn-create-snapshot (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)))

(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'.
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.
;; (defalias 'vc-svn-make-version-backups-p 'vc-stay-local-p
;;   "Return non-nil if version backups should be made for FILE.")

(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
;;;

(defcustom vc-svn-program "svn"
  "Name of the SVN executable."
  :type 'string
  :group 'vc)

(defun vc-svn-root (dir)
  (vc-find-root dir vc-svn-admin-directory t))

(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 buffer 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)
	;; `vc-BACKEND-registered' must not set vc-backend,
	;; which is instead set in vc-registered.
	(unless filename (vc-file-setprop file 'vc-backend 'SVN))
	;; 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-patch
             (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))
	  ((eq status ?R)
	   (vc-file-setprop file 'vc-state 'removed))
	  (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
  ;; 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 0 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))

(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))))

(provide 'vc-svn)

;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d
;;; vc-svn.el ends here