contrib/client-side/emacs/dsvn.el

   1 ;;; dsvn.el --- Subversion interface
   2
   3 ;; Copyright 2006-2007 Virtutech AB
   4
   5 ;; Author: David Kågedal <david@virtutech.com>
   6 ;;      Mattias Engdegård <mattias@virtutech.com>
   7 ;; Maintainer: David Kågedal <david@virtutech.com>
   8 ;; Created: 27 Jan 2006
   9 ;; Version: 1.5
  10 ;; Keywords: docs
  11
  12 ;; This program is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 2 of the
  15 ;; License, or (at your option) any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program; if not, write to the Free Software
  24 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
  25 ;; USA
  26
  27 ;;; Commentary:
  28 ;;
  29 ;; This is an interface for managing Subversion working copies.  It
  30 ;; can show you an up-to-date view of the current status, and commit
  31 ;; changes. If also helps you do other tasks such as updating,
  32 ;; switching, diffing and more.
  33 ;;
  34 ;; To get you started, add this line to your startup file:
  35 ;;
  36 ;;  (autoload 'svn-status "dsvn" "Run `svn status'." t)
  37 ;;  (autoload 'svn-update "dsvn" "Run `svn update'." t)
  38 ;;
  39 ;; This file integrates well with vc-svn, so you might want to do this
  40 ;; as well:
  41 ;;
  42 ;;   (require 'vc-svn)
  43 ;;
  44 ;; To get the status view, type
  45 ;;
  46 ;;   M-x svn-status
  47 ;;
  48 ;; and select a directory where you have a checked-out Subversion
  49 ;; working copy.  A buffer will be created that shows what files you
  50 ;; have modified, and any unknown files.  The file list corresponds
  51 ;; closely to that produced by "svn status", only slightly
  52 ;; reformatted.
  53 ;;
  54 ;; Navigate through the file list using "n" and "p", for next and
  55 ;; previous file, respectively.
  56 ;;
  57 ;; You can get a summary of available commands by typing "?".
  58 ;;
  59 ;; Some commands operate on files, and can either operate on the file
  60 ;; under point, or on a group of files that have been marked.  The
  61 ;; commands used for marking a file are the following:
  62 ;;
  63 ;;   m      mark and go down
  64 ;;   DEL    unmark and go up
  65 ;;   u      unmark and go down
  66 ;;   SPC    toggle mark
  67 ;;   M-DEL  unmark all
  68 ;;
  69 ;; The commands that operate on files are:
  70 ;;
  71 ;;   f      Visit the file under point (does not use marks)
  72 ;;   o      Visit the file under point in another window (does not use marks)
  73 ;;   =      Show diff of uncommitted changes.  This does not use marks
  74 ;;            unless you give a prefix argument (C-u)
  75 ;;   c      Commit files
  76 ;;   a      Add files
  77 ;;   r      Remove files
  78 ;;   R      Resolve conflicts
  79 ;;   M      Rename/move files
  80 ;;   U      Revert files
  81 ;;   P      View or edit properties of the file or directory under point
  82 ;;            (does not use marks)
  83 ;;
  84 ;; These commands update what is shown in the status buffer:
  85 ;;
  86 ;;   g      Rerun "svn status" to update the list.  Use a prefix
  87 ;;            argument (C-u) to clear the list first to make sure that
  88 ;;            it is correct.
  89 ;;   s      Update status of selected files
  90 ;;   S      Show status of specific file or directory
  91 ;;   x      Expunge unchanged files from the list
  92 ;;
  93 ;; To update the working copy:
  94 ;;
  95 ;;   M-u    Run "svn update".  If a prefix argument is given (C-u),
  96 ;;            you will be prompted for a revision to update to.
  97 ;;   M-s    Switch working copy to another branch.
  98 ;;   M-m    Merge in changes using "svn merge".
  99 ;;
 100 ;; To view the Subversion log type "M-x svn-log".
 101 ;;
 102 ;; Bugs and missing features:
 103 ;;
 104 ;; - Annotate (blame).
 105 ;; - Log, with a useful log mode where the user can easily view any revision
 106 ;;   as a diff or visit a revision of a file in a buffer.
 107 ;; - Integration with ediff or similar to resolve conflicts.
 108
 109 (require 'vc)
 110 (require 'log-edit)
 111
 112 (defconst svn-status-msg-col   1)
 113 (defconst svn-status-flags-col 11)
 114 (defconst svn-status-mark-col  18)
 115 (defconst svn-status-file-col  20)
 116
 117 (defgroup dsvn nil
 118   "Settings for dsvn."
 119   :group 'tools)
 120
 121 (defcustom svn-program "svn"
 122   "*The svn program to run"
 123   :type 'string
 124   :group 'dsvn)
 125
 126 (defun svn-call-process (program buffer &rest args)
 127   "Run svn and wait for it to finish.
 128 Argument PROGRAM is the svn binary to run.
 129 Argument BUFFER is the buffer in which to insert output.
 130 Optional argument ARGS are the arguments to svn."
 131   (let ((proc (apply 'start-process "svn" buffer program args)))
 132     (set-process-coding-system proc 'utf-8)
 133     (set-process-filter proc 'svn-output-filter)
 134     (while (eq (process-status proc) 'run)
 135       (accept-process-output proc 5)
 136       (sit-for 0))))
 137
 138 (defun svn-run-with-output (subcommand &optional args mode)
 139   "Run 'svn' with output to another window.
 140 Argument SUBCOMMAND is the command to execute.
 141 Optional argument ARGS is a list of the arguments to the command.
 142 Optional argument MODE is the major mode to use for the output buffer.
 143
 144 Return non-NIL if there was any output."
 145   (let ((buf (get-buffer-create "*svn output*"))
 146         (dir default-directory)
 147         (inhibit-read-only t))
 148     (save-current-buffer
 149       (set-buffer buf)
 150       (erase-buffer)
 151       (if mode
 152           (funcall mode)
 153         (fundamental-mode))
 154       (setq default-directory dir)
 155       (setq buffer-read-only t)
 156       (let ((cmd `(,svn-program ,subcommand ,@args))
 157             proc)
 158         (setq proc (apply 'start-process "svn" buf cmd))
 159         (set-process-coding-system proc 'utf-8)
 160         (set-process-filter proc 'svn-output-filter)
 161         (while (eq (process-status proc) 'run)
 162           (accept-process-output proc 5)
 163           (sit-for 0)))
 164       (if (= (point-min) (point-max))
 165           nil
 166         (save-selected-window
 167           (select-window (display-buffer buf))
 168           (goto-char (point-min)))
 169         t))))
 170
 171 (defun svn-run-hidden (command args)
 172   "Run 'svn' without showing output.
 173 Argument COMMAND is the command to run.
 174 Optional argument ARGS is a list of arguments."
 175   (let ((buf (get-buffer-create " *svn*"))
 176         (dir default-directory))
 177     (with-current-buffer buf
 178       (erase-buffer)
 179       (setq default-directory dir))
 180     (apply 'call-process svn-program nil buf nil (symbol-name command) args)
 181     buf))
 182
 183 (defun svn-run-predicate (command args)
 184   "Run `svn', discarding output, returning t if it succeeded (exited with
 185 status zero).
 186 Argument COMMAND is the svn subcommand to run.
 187 Optional argument ARGS is a list of arguments."
 188   (zerop
 189    (apply 'call-process svn-program nil nil nil (symbol-name command) args)))
 190
 191 (defun svn-output-filter (proc str)
 192   "Output filter for svn output.
 193 Argument PROC is the process object.
 194 Argument STR is the output string."
 195   (save-excursion
 196     (set-buffer (process-buffer proc))
 197     (goto-char (process-mark proc))
 198     (let ((p (point))
 199           (inhibit-read-only t))
 200       (insert-before-markers str)
 201       (goto-char p)
 202       (while (search-forward "\r" (process-mark proc) t)
 203         (save-excursion
 204           (beginning-of-line)
 205           (delete-region (point) (match-beginning 0))))
 206       (goto-char p))))
 207
 208 (defvar svn-status-buffer nil
 209   "svn-status buffer describing the files that a commit operation applies to")
 210 (make-variable-buffer-local 'svn-status-buffer)
 211
 212 (defvar svn-todo-queue '()
 213   "A queue of commands to run when the current command finishes.")
 214 (make-variable-buffer-local 'svn-todo-queue)
 215
 216 (defun svn-current-url ()
 217   "Get the repository URL."
 218   (with-current-buffer (svn-run-hidden 'info ())
 219     (if (re-search-backward "^URL: \\(.*\\)$" nil t)
 220         (match-string 1)
 221       (error "Couldn't find the current URL"))))
 222
 223 (defun svn-run (command args &optional description)
 224   "Run subversion command COMMAND with ARGS.
 225
 226 Optional third argument DESCRIPTION is a string used in the status
 227 buffer to describe what is going on."
 228   ;; Clean up old output
 229   (let ((inhibit-read-only t))
 230     (delete-region svn-output-marker (point-max)))
 231
 232   (let* ((command-s (symbol-name command))
 233          (filter-func (intern (concat "svn-" command-s "-filter")))
 234          (sentinel-func (intern (concat "svn-" command-s "-sentinel")))
 235          proc)
 236     ;; The command status-v is interpreted as status -v
 237     (when (eq command 'status-v)
 238       (setq command-s "status"
 239             args (cons "-v" args)))
 240     (setq proc (apply 'start-process "svn" (current-buffer)
 241                       svn-program command-s args))
 242     (if (fboundp filter-func)
 243         (set-process-filter proc filter-func)
 244       (set-process-filter proc 'svn-default-filter))
 245     (if (fboundp sentinel-func)
 246         (set-process-sentinel proc sentinel-func)
 247       (set-process-sentinel proc 'svn-default-sentinel))
 248     (setq svn-running (list description proc))
 249     (set-svn-process-status 'running)
 250     proc))
 251
 252 (defun svn-check-running ()
 253   (when (and svn-running
 254              (eq (process-status (cadr svn-running)) 'run))
 255     (error "Can't run two svn processes from the same buffer")))
 256
 257 (defun svn-run-async (command args &optional file-filter)
 258   "Run subversion command COMMAND with ARGS, possibly at a later time.
 259
 260 Optional third argument FILE-FILTER is the file filter to be in effect
 261 during the run."
 262
 263   (if (and svn-running
 264            (eq (process-status (cadr svn-running)) 'run))
 265       (setq svn-todo-queue
 266             (nconc svn-todo-queue
 267                    (list (list command args file-filter))))
 268     (progn
 269       (set (make-local-variable 'svn-file-filter) file-filter)
 270       (svn-run command args))))
 271
 272 ;; This could be used to debug filter functions
 273 (defvar svn-output-queue nil)
 274 (defvar svn-in-output-filter nil)
 275 (defun svn-filter-queue (proc str)
 276   (setq svn-output-queue (nconc svn-output-queue (list str)))
 277   (unless svn-in-output-filter
 278     (let ((svn-in-output-filter t))
 279       (while svn-output-queue
 280         (svn-status-filter proc (car svn-output-queue))
 281         (setq svn-output-queue (cdr svn-output-queue))))))
 282
 283 (defun svn-default-filter (proc str)
 284   (save-excursion
 285     (set-buffer (process-buffer proc))
 286     (let ((inhibit-read-only t))
 287       (goto-char (point-max))
 288       (insert str))))
 289
 290 (defun svn-default-sentinel (proc reason)
 291   (with-current-buffer (process-buffer proc)
 292     (when (and svn-running
 293                (eq proc (cadr svn-running)))
 294       (setq svn-running nil)
 295       (if (/= (process-exit-status proc) 0)
 296           (set-svn-process-status 'failed)
 297         (set-svn-process-status 'finished))
 298       (move-to-column goal-column))
 299     (when svn-todo-queue
 300       (let ((cmd-info (car svn-todo-queue)))
 301         (setq svn-todo-queue (cdr svn-todo-queue))
 302         (let ((command (car cmd-info))
 303               (args (cadr cmd-info))
 304               (file-filter (caddr cmd-info)))
 305           (set (make-local-variable 'svn-file-filter) file-filter)
 306           (svn-run command args))))))
 307
 308 (defun svn-diff (arg)
 309   "Run `svn diff'.
 310 Argument ARG are the command line arguments."
 311   (interactive "ssvn diff arguments: ")
 312   (svn-run-with-output "diff" (split-string arg) 'diff-mode))
 313
 314 (defun svn-commit ()
 315   "Commit changes to one or more files."
 316   (interactive)
 317   (save-some-buffers)
 318   (let ((status-buf (current-buffer))
 319         (commit-buf (get-buffer-create "*svn commit*")))
 320     (switch-to-buffer-other-window commit-buf)
 321     (log-edit 'svn-confirm-commit)
 322     (setq svn-status-buffer status-buf)))
 323
 324 (defun svn-confirm-commit ()
 325   "Commit changes with the current buffer as commit message."
 326   (interactive)
 327   (let ((files (with-current-buffer svn-status-buffer
 328                  (svn-action-files)))
 329         (commit-buf (current-buffer))
 330         (status-buf svn-status-buffer)
 331         ;; XEmacs lacks make-temp-file but has make-temp-name + temp-directory
 332         (msg-file (if (fboundp 'make-temp-file)
 333                       (make-temp-file "svn-commit")
 334                     (make-temp-name (expand-file-name "svn-commit"
 335                                                       (temp-directory))))))
 336     ;; Ensure final newline
 337     (goto-char (point-max))
 338     (unless (bolp)
 339       (newline))
 340     (write-region (point-min) (point-max) msg-file)
 341     (when (boundp 'vc-comment-ring)
 342       ;; insert message into comment ring, unless identical to the previous
 343       (let ((comment (buffer-string)))
 344         (when (or (ring-empty-p vc-comment-ring)
 345                   (not (equal comment (ring-ref vc-comment-ring 0))))
 346           (ring-insert vc-comment-ring comment))))
 347     (kill-buffer commit-buf)
 348     (with-current-buffer status-buf
 349       (make-local-variable 'svn-commit-msg-file)
 350       (make-local-variable 'svn-commit-files)
 351       (setq svn-commit-msg-file msg-file)
 352       (setq svn-commit-files files)
 353       (svn-run 'commit (append (list "-N" "-F" msg-file) files)))))
 354
 355 (defun svn-commit-filter (proc str)
 356   "Output filter function for `svn commit'."
 357   (save-excursion
 358     (set-buffer (process-buffer proc))
 359     (let ((inhibit-read-only t)
 360           (nomore))
 361       (goto-char (point-max))
 362       (insert str)
 363       (goto-char svn-output-marker)
 364       (while (not nomore)
 365         (cond ((looking-at
 366                 "\\(Sending\\|Adding\\|Transmitting file\\|Deleting\\) .*\n")
 367                ;; Ignore these expected and uninteresting messages
 368                (delete-region (match-beginning 0)
 369                               (match-end 0)))
 370               ((looking-at "Committed revision \\([0-9]+\\).\n")
 371                (svn-update-label svn-revision-label (match-string 1))
 372                (forward-line 1))
 373               ((looking-at ".*\n")
 374                ;; Unexpected output is left in the buffer
 375                (forward-line 1))
 376               (t
 377                (setq nomore t)))))))
 378
 379 (defun svn-commit-sentinel (proc reason)
 380   "Sentinel function for `svn commit'."
 381   (with-current-buffer (process-buffer proc)
 382     (setq svn-running nil)
 383     (if (/= (process-exit-status proc) 0)
 384         (set-svn-process-status 'failed)
 385       (set-svn-process-status 'finished)
 386       (while svn-commit-files
 387         (let* ((file (car svn-commit-files))
 388                (path (concat default-directory file))
 389                (pos (svn-file-pos file))
 390                (file-buffer (get-file-buffer path))
 391                (inhibit-read-only t))
 392           (when pos
 393             (svn-update-status-flag pos ?\  ?\ )
 394             (svn-update-status-msg pos "Committed"))
 395           (when (and file-buffer (fboundp 'vc-svn-workfile-version))
 396             (with-current-buffer file-buffer
 397               ;; Use buffer-file-name instead of path to get the
 398               ;; canonical file name used by vc
 399               ;; TODO: use the version number written by the commit command
 400               (vc-file-setprop buffer-file-name 'vc-workfile-version
 401                                (vc-svn-workfile-version buffer-file-name))
 402               (vc-mode-line buffer-file-name))))
 403         (setq svn-commit-files (cdr svn-commit-files))))
 404     (delete-file svn-commit-msg-file)))
 405
 406 ;;; Svn log
 407
 408 (defun svn-log (arg)
 409   "Run `svn log'.
 410 Argument ARG is the command-line arguments, as a string."
 411   (interactive "ssvn log arguments: ")
 412   (svn-run-with-output "log" (split-string arg)
 413                        'svn-log-mode))
 414
 415 (defvar svn-log-mode-map nil
 416   "Keymap for `svn-log-mode'.")
 417 (unless svn-log-mode-map
 418   (setq svn-log-mode-map (make-sparse-keymap))
 419   (define-key svn-log-mode-map "\r" 'svn-log-show-diff)
 420   (define-key svn-log-mode-map "n" 'svn-log-next)
 421   (define-key svn-log-mode-map "p" 'svn-log-prev)
 422   )
 423
 424 (defun svn-log-mode ()
 425   "Major mode for viewing Subversion logs."
 426   (interactive)
 427   (kill-all-local-variables)
 428   (setq major-mode 'svn-log-mode
 429         mode-name "Svn log")
 430   (use-local-map svn-log-mode-map)
 431   (setq paragraph-start "^commit"))
 432
 433
 434 (defun svn-log-current-commit ()
 435   (save-excursion
 436     (end-of-line)
 437     (unless (re-search-forward "^r\\([0-9]+\\) |" nil t)
 438       (error "Found no commit"))
 439     (string-to-number (match-string 1))))
 440
 441 (defun svn-log-show-diff ()
 442   "Show the changes introduced by the changeset under point."
 443   (interactive)
 444   (let ((commit-id (svn-log-current-commit))
 445         (diff-buf (get-buffer-create "*svn diff*"))
 446         (dir default-directory)
 447         (inhibit-read-only t))
 448     (display-buffer diff-buf)
 449     (save-current-buffer
 450       (set-buffer diff-buf)
 451       (diff-mode)
 452       (setq buffer-read-only t)
 453       (erase-buffer)
 454       (setq default-directory dir)
 455       (svn-call-process svn-program diff-buf
 456                         "diff" "-r"
 457                         (format "%d:%d" (1- commit-id) commit-id)))))
 458
 459 (defun svn-log-next ()
 460   "Move to the next changeset in the log."
 461   (interactive)
 462   (end-of-line)
 463   (unless (re-search-forward "^------------------------------------------------------------------------$" nil t)
 464     (error "Found no commit"))
 465   (beginning-of-line)
 466   (svn-log-show-diff))
 467
 468 (defun svn-log-prev ()
 469   "Move to the previous changeset in the log."
 470   (interactive)
 471   (beginning-of-line)
 472   (unless (re-search-backward "^------------------------------------------------------------------------$" nil t)
 473     (error "Found no commit"))
 474   (svn-log-show-diff))
 475
 476 (defun svn-new-label (&optional pos)
 477   (unless pos (setq pos (point)))
 478   (let ((start (make-marker))
 479         (stop (make-marker)))
 480     (set-marker start pos)
 481     (set-marker stop pos)
 482     (list start stop)))
 483
 484 (defun svn-update-label (label str)
 485   (let ((start (car label))
 486         (stop (cadr label))
 487         (inhibit-read-only t))
 488     (delete-region start stop)
 489     (set-marker-insertion-type stop t)
 490     (save-excursion
 491       (goto-char start)
 492       (insert str))))
 493
 494 ;;; Svn propedit
 495
 496 (defun svn-propget (file propname)
 497   "Return the Subversion property PROPNAME of FILE."
 498   (with-current-buffer (svn-run-hidden 'propget (list propname file))
 499     (substring (buffer-string) 0 -1)))  ; trim final newline added by svn
 500
 501 (defun svn-get-props (file)
 502   "Return an alist containing the properties of FILE"
 503   ;; First retrieve the property names, and then the value of each.
 504   ;; We can't use proplist -v because is output is ambiguous when values
 505   ;; consist of multiple lines.
 506   (unless (svn-run-predicate 'ls (list file))
 507     (error "%s is not under version control" file))
 508   (let (propnames)
 509     (with-current-buffer (svn-run-hidden 'proplist (list file))
 510       (goto-char (point-min))
 511       (when (looking-at "Properties on ")
 512         (forward-line 1)
 513         (while (looking-at "  \\(.+\\)$")
 514           (setq propnames (cons (match-string 1) propnames))
 515           (forward-line 1))))
 516     (mapcar (lambda (propname)
 517               (cons propname (svn-propget file propname)))
 518             propnames)))
 519
 520 (defun svn-propedit (file)
 521   "Edit properties of FILE."
 522   (interactive (list (expand-file-name
 523                       (or (svn-getprop (point) 'file)
 524                           (read-file-name "Edit properties of file: "
 525                                           default-directory
 526                                           nil t
 527                                           (svn-getprop (point) 'dir))))))
 528   (let ((local-file (svn-local-file-name file)))
 529     (when (string-equal local-file "")
 530         (setq local-file ".")
 531         (setq file (file-name-as-directory file)))
 532     (svn-check-running)
 533     (let ((buf-name (format "*propedit %s*" local-file)))
 534       (if (get-buffer buf-name)
 535           (kill-buffer buf-name))
 536       (let ((prop-alist (svn-get-props local-file))
 537             (propedit-buf (get-buffer-create buf-name)))
 538         (switch-to-buffer-other-window propedit-buf)
 539         (svn-propedit-mode)
 540         (insert
 541       "# Properties of " local-file "\n"
 542       "#\n"
 543       "# Lines are on the form PROPNAME: VALUE for single-line values,\n"
 544       "# or just PROPNAME: followed by one or more lines starting with > for\n"
 545       "# multi-line values. Lines starting with # are ignored.\n"
 546       "#\n"
 547       "# Change, add, delete or rename properties just by editing this\n"
 548       "# buffer; then press "
 549          (substitute-command-keys "\\[svn-propedit-done]")
 550          " to save changes.\n\n")
 551         (mapc (lambda (prop)
 552                 (let* ((value (cdr prop))
 553                        (lines (split-string value "\n")))
 554                   ;; split-string ignores single leading and trailing
 555                   ;; delimiters, so add them explicitly
 556                   (when (not (equal value ""))
 557                     (when (equal (substring value 0 1) "\n")
 558                       (setq lines (cons "" lines)))
 559                     (when (equal (substring value -1) "\n")
 560                       (setq lines (append lines (list "")))))
 561                   (insert (car prop) ":")
 562                   (if (> (length lines) 1)
 563                       (progn
 564                         (insert "\n")
 565                         (mapc (lambda (line) (insert ">" line "\n"))
 566                               lines))
 567                     (insert " " (or (car lines) "") "\n"))))
 568               (sort prop-alist #'(lambda (a b) (string< (car a) (car b)))))
 569         (make-local-variable 'svn-propedit-file)
 570         (setq svn-propedit-file file)
 571         (setq default-directory (file-name-directory file))
 572         (message
 573          (substitute-command-keys
 574           "Press \\[svn-propedit-done] when you are done editing."))))))
 575
 576 (defvar svn-propedit-mode-map nil
 577   "Keymap for `svn-propedit-mode'.")
 578 (unless svn-propedit-mode-map
 579   (setq svn-propedit-mode-map (make-sparse-keymap))
 580   (define-key svn-propedit-mode-map "\C-c\C-c" 'svn-propedit-done))
 581
 582 (defun svn-propedit-mode ()
 583   "Major mode for editing Subversion properties."
 584   (interactive)
 585   (kill-all-local-variables)
 586   (setq major-mode 'svn-propedit-mode
 587         mode-name "Svn propedit")
 588   (use-local-map svn-propedit-mode-map)
 589   (setq font-lock-defaults
 590         '((("^#.*$"                            ;comment
 591             . 'font-lock-comment-face)
 592            ("^\\([^ \t\n#>][^ \t\n]*\\):"      ;property name
 593             . (1 'bold))
 594            ("^[^ \t\n#>][^ \t\n]*: *\\(.*\\)$" ;property value
 595             . (1 'font-lock-function-name-face))
 596            ("^>"                               ;multi-line marker
 597             . 'bold)
 598            ("^>\\(.*\\)$"                      ;property value (continued)
 599             . (1 'font-lock-function-name-face))
 600            )
 601           nil                           ;keywords-only
 602           nil                           ;case-fold
 603           ;; syntax-alist: don't fontify quotes specially in any way
 604           ((?\" . "."))
 605           nil                           ;syntax-begin
 606           ))
 607   (font-lock-mode))
 608
 609 (defun svn-props-from-buffer ()
 610   "Parse the current propedit buffer and return an alist of the properties."
 611   (save-excursion
 612     (let (prop-alist)
 613       (goto-char (point-min))
 614       (while (not (eobp))
 615         (cond ((looking-at "^\\([^ \t\n#>][^ \t\n]*\\): *\\(.*\\)$")
 616                (let ((prop-name (match-string 1))
 617                      (value (match-string 2)))
 618                  (set-text-properties 0 (length prop-name) nil prop-name)
 619                  (set-text-properties 0 (length value) nil value)
 620                  (when (assoc prop-name prop-alist)
 621                    (error "Duplicated property '%s'" prop-name))
 622                  (setq prop-alist (cons (cons prop-name value) prop-alist))))
 623               ((looking-at "^>\\(.*\\)$")
 624                (let ((extra-line (match-string 1)))
 625                  (set-text-properties 0 (length extra-line) nil extra-line)
 626                  (when (null prop-alist)
 627                    (error "Continued line not preceded by property name"))
 628                  (let ((old-value (cdar prop-alist)))
 629                    (setcdr (car prop-alist)
 630                            (concat old-value "\n" extra-line))))))
 631         (forward-line 1))
 632
 633       ;; Remove the extra leading newline from multi-line values
 634       (mapcar (lambda (prop)
 635                 (let ((name (car prop))
 636                       (value (cdr prop)))
 637                   (if (and (not (equal value ""))
 638                            (equal (substring value 0 1) "\n"))
 639                       (cons name (substring value 1))
 640                     prop)))
 641               prop-alist))))
 642
 643 (defun svn-propdel (file prop-name)
 644   "Delete FILE's property PROP-NAME."
 645   (svn-run-hidden 'propdel (list prop-name file)))
 646
 647 (defun svn-propset (file prop-name prop-value)
 648   "Set FILE's property PROP-NAME to PROP-VALUE."
 649   (svn-run-hidden 'propset (list prop-name prop-value file)))
 650
 651 (defun svn-propedit-done ()
 652   "Apply property changes to the file."
 653   (interactive)
 654   (let ((wc-props (svn-get-props svn-propedit-file))
 655         (new-props (svn-props-from-buffer))
 656         (changes 0))
 657
 658     ;; first remove properties that the user deleted from the buffer
 659     (mapc (lambda (wc-prop)
 660             (let ((prop-name (car wc-prop)))
 661               (when (not (assoc prop-name new-props))
 662                 (message "Deleting property %s" prop-name)
 663                 (svn-propdel svn-propedit-file prop-name)
 664                 (setq changes (1+ changes)))))
 665           wc-props)
 666
 667     ;; then set the properties that have changed or are new
 668     (mapc (lambda (new-prop)
 669             (let* ((prop-name (car new-prop))
 670                    (wc-prop (assoc prop-name wc-props)))
 671               (unless (equal new-prop wc-prop)
 672                 (message "Setting property %s" prop-name)
 673                 (svn-propset svn-propedit-file prop-name (cdr new-prop))
 674                 (setq changes (1+ changes)))))
 675           new-props)
 676     (cond
 677      ((> changes 1) (message "Changed %d properties." changes))
 678      ((= changes 0) (message "No properties changed."))))
 679   (svn-foreach-svn-buffer
 680    svn-propedit-file
 681    (lambda (local-file-name file-pos)
 682      (svn-refresh-item local-file-name nil)))
 683   (kill-buffer (current-buffer)))
 684
 685 ;;; Svn buffer
 686
 687 (defvar svn-files-start nil)
 688 (defvar svn-files-stop nil)
 689 (defvar svn-url-label nil)
 690 (defvar svn-revision-label nil)
 691 (defvar svn-running-label nil)
 692 (defvar svn-output-marker nil)
 693
 694 (defvar svn-running nil)
 695
 696 (defun create-svn-buffer (dir)
 697   "Create a buffer for showing svn status.
 698 Argument DIR is the directory to run svn in."
 699   (let ((status-buf (create-file-buffer (concat dir "*svn*")))
 700         (inhibit-read-only t))
 701     (with-current-buffer status-buf
 702       (svn-status-mode)
 703
 704       (make-local-variable 'svn-url-label)
 705       (make-local-variable 'svn-revision-label)
 706       (make-local-variable 'svn-running-label)
 707       (make-local-variable 'svn-output-marker)
 708
 709       (setq default-directory dir)
 710       (insert "Svn status for " dir) (newline)
 711       (insert "URL: ") (setq svn-url-label (svn-new-label))
 712       (insert " revision " ) (setq svn-revision-label (svn-new-label))
 713       (newline)
 714       (newline)
 715       (insert "---- ") (setq svn-running-label (svn-new-label))
 716       (newline)
 717       (setq svn-files-start (point-marker))
 718       (set-marker-insertion-type svn-files-start nil)
 719       (setq svn-last-inserted-marker (point-marker))
 720       (set-marker-insertion-type svn-last-inserted-marker nil)
 721       (insert "----")
 722       (newline)
 723       (setq svn-output-marker (point-marker))
 724       (set-marker-insertion-type svn-output-marker nil)
 725       ;; Do this after inserting stuff
 726       (setq svn-files-stop (copy-marker svn-files-start t))
 727       (setq buffer-read-only t))
 728     status-buf))
 729
 730 (defun switch-to-svn-buffer (dir)
 731   "Switch to a (possibly new) buffer displaying status for DIR"
 732   (setq dir (file-name-as-directory dir))
 733   (let ((buffers (buffer-list)))
 734     (while (and buffers
 735                 (not (with-current-buffer (car buffers)
 736                        (and (eq major-mode 'svn-status-mode)
 737                             (string= default-directory dir)))))
 738       (setq buffers (cdr buffers)))
 739     (switch-to-buffer (if buffers
 740                           (car buffers)
 741                         (create-svn-buffer dir)))))
 742
 743 (defun svn-in-dir-p (dir file)
 744   "Return non-NIL if FILE is inside DIR"
 745   (let ((l (length dir)))
 746     (and (> (length file) l)
 747          (string= dir (substring file 0 l)))))
 748
 749 ;;; Svn status
 750
 751 (defun svn-status (dir)
 752   "Run `svn status'.
 753 Argument DIR is the directory to run svn status in."
 754   (interactive "DDirectory: \n")
 755   (switch-to-svn-buffer dir)
 756   (let ((proc (svn-run 'info ())))
 757     (while (eq (process-status proc) 'run)
 758       (accept-process-output proc 2 10000)))
 759   (svn-refresh)
 760   (message
 761    (substitute-command-keys
 762     "Welcome to dsvn. Press \\[svn-status-help] for keyboard help summary.")))
 763
 764 (defun svn-refresh (&optional clear)
 765   "Run `svn status'.
 766 If optional argument CLEAR is non-NIL, clear the buffer first."
 767   (interactive "P")
 768   (svn-check-running)
 769   (let ((inhibit-read-only t))
 770     (if clear
 771         (delete-region svn-files-start svn-files-stop)
 772       (put-text-property svn-files-start svn-files-stop 'svn-updated nil))
 773     (setq svn-last-inserted-filename nil)
 774     (svn-run 'status '())))
 775
 776 (defun svn-run-status-v (files recursive)
 777   "Run svn status -v on FILES. If not RECURSIVE, only applies to files and
 778 directories explicitly listed in FILES."
 779
 780   ;; The command 'svn status -N DIR' will process the immediate contents of
 781   ;; DIR as well as DIR itself, but that is not what we want if running
 782   ;; non-recursively. To compensate, filter the status output through a list
 783   ;; of files and directories we are interested in.
 784
 785   (let ((flag (if recursive nil '("-N")))
 786         (file-filter
 787          (if recursive
 788              nil
 789            (mapcar (lambda (file)
 790                      ;; trim trailing slash for directory comparison to work
 791                      (if (equal (substring file -1) "/")
 792                          (substring file 0 -1)
 793                        file))
 794                    files))))
 795     (svn-run-async 'status-v (append flag files) file-filter)))
 796
 797 (defun svn-refresh-file ()
 798   "Run `svn status' on the selected files."
 799   (interactive)
 800   (svn-check-running)
 801   (let ((actions (svn-actions))
 802         (inhibit-read-only t))
 803     (setq svn-last-inserted-filename nil)
 804     (put-text-property svn-files-start svn-files-stop 'svn-updated t)
 805     (mapc (lambda (pos)
 806             (svn-setprop pos 'updated nil))
 807           (mapcar 'cadr actions))
 808     (svn-run-status-v (mapcar 'car actions) t))
 809   (svn-next-file 1))
 810
 811 (defun svn-local-file-name (file)
 812   "Return file name relative the current directory, or raise an error if
 813 outside."
 814   (if (file-directory-p file)
 815       (setq file (file-name-as-directory file)))
 816   (let ((exp-default-dir (expand-file-name default-directory)))
 817     (if (file-name-absolute-p file)
 818         (let ((ddl (length exp-default-dir)))
 819           (if (or (< (length file) ddl)
 820                   (not (string= (substring file 0 ddl)
 821                                 exp-default-dir)))
 822               (error "Outside working copy")
 823             (substring file ddl)))
 824       file)))
 825
 826 (defun svn-refresh-item (file recursive)
 827   "Refresh status for FILE. If RECURSIVE, do it recursively (for directories)."
 828   (svn-check-running)
 829   (let ((inhibit-read-only t))
 830     (setq svn-last-inserted-filename nil)
 831     (let ((local-file (svn-local-file-name file)))
 832       (svn-run-status-v (list local-file) recursive))))
 833
 834 (defun svn-refresh-one (file)
 835   "Run `svn status' on FILE."
 836   (interactive (list (expand-file-name
 837                       (read-file-name "Svn status on file: "
 838                                       default-directory
 839                                       nil t
 840                                       (or (svn-getprop (point) 'file)
 841                                           (svn-getprop (point) 'dir))))))
 842   (svn-refresh-item file t))
 843
 844 (defun svn-cleanup-status ()
 845   (save-excursion
 846     (let ((inhibit-read-only t))
 847       (goto-char svn-files-start)
 848       (while (< (point) svn-files-stop)
 849         (if (or (svn-getprop (point) 'dir)
 850                 (svn-getprop (point) 'updated))
 851             (forward-line)
 852           (svn-update-status-flag (point) ?\  ?\ )
 853           (svn-update-status-msg (point) "")
 854           (forward-line))))))
 855
 856 (defun svn-status-filter (proc str)
 857   (save-excursion
 858     (set-buffer (process-buffer proc))
 859     (let ((inhibit-read-only t))
 860       (goto-char (point-max))
 861       (insert str)
 862       (goto-char svn-output-marker)
 863       (while (looking-at
 864               "\\([ ACDGIMRX?!~][ CM][ L][ +][ S][ KOTB]\\) \\(.*\\)\n")
 865         (let ((status (match-string 1))
 866               (filename (match-string 2)))
 867           (delete-region (match-beginning 0)
 868                          (match-end 0))
 869           (svn-insert-file filename status))))))
 870
 871 (defun svn-status-sentinel (proc reason)
 872   (with-current-buffer (process-buffer proc)
 873     (svn-cleanup-status)
 874     (svn-insert-dirs))
 875   (svn-default-sentinel proc reason))
 876
 877 (defun svn-status-v-filter (proc str)
 878   (save-excursion
 879     (set-buffer (process-buffer proc))
 880     (let ((inhibit-read-only t))
 881       (goto-char (point-max))
 882       (insert str)
 883       (goto-char svn-output-marker)
 884       (while (looking-at
 885               "\\([ ACDGIMRX?!~][ CM][ L][ +][ S][ KOTB]\\) \\([\\* ]\\) \\(........\\) \\(........\\) \\(............\\) \\(.*\\)\n")
 886         (let ((status (match-string 1))
 887               (filename (match-string 6)))
 888           (delete-region (match-beginning 0)
 889                          (match-end 0))
 890           (when (or (not svn-file-filter)
 891                     (member filename svn-file-filter))
 892             (svn-insert-file filename status)))))))
 893
 894 (defun svn-status-v-sentinel (proc reason)
 895   (with-current-buffer (process-buffer proc)
 896     (svn-cleanup-status))
 897   (svn-default-sentinel proc reason))
 898
 899 ;; info
 900
 901 (defun svn-info-filter (proc str)
 902   "Output filter function for `svn info'."
 903   (save-excursion
 904     (set-buffer (process-buffer proc))
 905     (let ((inhibit-read-only t)
 906           (nomore))
 907       (goto-char (point-max))
 908       (insert str)
 909       (goto-char svn-output-marker)
 910       (while (not nomore)
 911         (cond ((looking-at "URL: \\(.*\\)\n")
 912                (svn-update-label svn-url-label (match-string 1))
 913                (forward-line 1))
 914               ((looking-at "Revision: \\([0-9]+\\)\n")
 915                (svn-update-label svn-revision-label (match-string 1))
 916                (forward-line 1))
 917               ((looking-at ".*\n")
 918                ;; Unexpected output is left in the buffer
 919                (forward-line 1))
 920               (t
 921                (setq nomore t)))))))
 922
 923 (defun svn-info-sentinel (proc reason)
 924   (svn-default-sentinel proc reason))
 925
 926 ;; update
 927
 928 (defun svn-update (dir)
 929   "Run `svn update'.
 930 Argument DIR is the directory to run svn status in."
 931   (interactive "DDirectory: \n")
 932   (switch-to-svn-buffer dir)
 933   (svn-update-current))
 934
 935 (defun svn-update-current (&optional revision)
 936   "Run `svn update' in the current buffer.
 937 Update to REVISION, which defaults to HEAD.
 938 With prefix arg, prompt for REVISION."
 939   (interactive (list
 940                 (if current-prefix-arg
 941                     (read-string "update to revision (HEAD): "
 942                                  nil nil "HEAD")
 943                   nil)))
 944   (svn-check-running)
 945   (make-local-variable 'svn-updated-files)
 946   (setq svn-updated-files nil)
 947   (let ((args (if revision
 948                   (list "-r" revision)
 949                 '())))
 950     (svn-run 'update args "Updating")))
 951
 952 (defconst svn-update-flag-name
 953   '((?A . "Added")
 954     (?D . "Deleted")
 955     (?U . "Updated")
 956     (?G . "Merged")
 957     (?C . "Conflict")))
 958
 959 (defvar svn-merging nil)
 960
 961 (defun svn-remap-update-to-status (status-char)
 962   "Map a status character from the svn update command to the resulting status."
 963   (if svn-merging
 964       (cond ((memq status-char '(?U ?G))
 965              ?M)
 966             (t
 967              status-char))
 968     (cond ((memq status-char '(?A ?D ?U))
 969            ?\ )
 970           ((eq status-char ?G)
 971            ?M)
 972           (t
 973            status-char))))
 974
 975 (defun svn-update-filter (proc str)
 976   (save-excursion
 977     (set-buffer (process-buffer proc))
 978     (let ((inhibit-read-only t)
 979           nomore)
 980       (goto-char (point-max))
 981       (insert str)
 982       (goto-char svn-output-marker)
 983       (while (not nomore)
 984         (cond ((looking-at
 985                 "\\([ ADUCG][ ADUCG][ B]\\)  \\(.*\\)\n")
 986                (let* ((status (match-string 1))
 987                       (file-status (elt status 0))
 988                       (prop-status (elt status 1))
 989                       (filename (match-string 2)))
 990                  (delete-region (match-beginning 0)
 991                                 (match-end 0))
 992                  (svn-insert-file
 993                   filename
 994                   ;; Remap A and U to unmodified in file and prop status
 995                   (format "%c%c...."
 996                           (svn-remap-update-to-status file-status)
 997                           (svn-remap-update-to-status prop-status))
 998                   ;; Optimize for some common cases
 999                   (cond ((= prop-status ?\ )
1000                          (cdr (assq file-status svn-update-flag-name)))
1001                         ((= file-status ?\ )
1002                          (let ((s (format "P %s"
1003                                           (cdr (assq prop-status
1004                                                      svn-update-flag-name)))))
1005                            (if (> (length s) 9)
1006                                (substring s 0 9)
1007                              s)))
1008                         (t
1009                          status)))
1010                  (setq svn-updated-files (cons filename svn-updated-files))))
1011               ((looking-at "At revision \\([0-9]+\\)\\.\n")
1012                (svn-update-label svn-revision-label (match-string 1))
1013                (forward-line 1))
1014               ((and (not svn-merging)
1015                     (looking-at "Updated to revision \\([0-9]+\\)\\.\n"))
1016                (svn-update-label svn-revision-label (match-string 1))
1017                (forward-line 1))
1018               ((looking-at ".*\n")
1019                ;; Unexpected output is left in the buffer
1020                (forward-line 1))
1021               (t
1022                (setq nomore t)))))))
1023
1024 (defun svn-update-sentinel (proc reason)
1025   (with-current-buffer (process-buffer proc)
1026     (svn-insert-dirs)
1027     (mapc #'svn-revert-if-needed svn-updated-files))
1028   (svn-default-sentinel proc reason))
1029
1030 (defun svn-revert-if-needed (filename)
1031   "Revert buffer visiting FILENAME if any, because the file is believed to have
1032 been modified."
1033   (let ((buf (find-buffer-visiting filename)))
1034     (when (and buf (not (buffer-modified-p buf)))
1035       (with-current-buffer buf
1036         (let ((was-ro buffer-read-only))
1037           (ignore-errors
1038             (revert-buffer t t))
1039           (when was-ro (toggle-read-only 1)))))))
1040
1041 (defun svn-complete-url (url pred all)
1042   (string-match "\\`\\(.*/\\)\\([^/]*\\)\\'" url)
1043   (let* ((base-url (match-string 1 url))
1044          (match-file (match-string 2 url))
1045          (match-len (length match-file))
1046          (files))
1047     (with-current-buffer (svn-run-hidden 'ls (list base-url))
1048       (goto-char (point-min))
1049       (while (looking-at ".+$")
1050         (let ((file (match-string 0)))
1051           (if (and (>= (length file) match-len)
1052                    (string= match-file (substring file 0 match-len)))
1053               (setq files (cons file files)))
1054           (forward-line 1))))
1055     (setq files (nreverse files))
1056     (cond (all
1057            (mapcar (lambda (f) (concat base-url f))
1058                    files))
1059           ((and (= (length files) 1)
1060                 (string= (car files) match-file))
1061            t)
1062           (t
1063            (try-completion url
1064                            (mapcar (lambda (s) (cons (concat base-url s) nil))
1065                                    files)
1066                            pred)))))
1067
1068 (defvar svn-switch-history nil)
1069
1070 (defun svn-switch (url)
1071   "Run `svn switch'."
1072   (interactive (list (completing-read "Switch to (URL): "
1073                                       'svn-complete-url
1074                                       nil nil
1075                                       (svn-current-url)
1076                                       'svn-switch-history)))
1077   (svn-check-running)
1078   (make-local-variable 'svn-updated-files)
1079   (setq svn-updated-files nil)
1080   (svn-update-label svn-url-label url)
1081   (svn-run 'switch (list url)))
1082
1083 (defun svn-switch-filter (proc str)
1084   "Filter function for 'svn switch' output."
1085   ;; The output is identical(?) to svn update
1086   (svn-update-filter proc str))
1087
1088 (defun svn-switch-sentinel (proc reason)
1089   ;; switch is basically a glorified update
1090   (svn-update-sentinel proc reason))
1091
1092 ;; merge
1093
1094 (defun svn-merge (from-url from-rev to-url to-rev)
1095   "Run `svn merge'."
1096   (interactive (list (completing-read "Merge from (URL): "
1097                                       'svn-complete-url
1098                                       nil nil
1099                                       (svn-current-url)
1100                                       'svn-switch-history)
1101                      (read-string "Merge from revision (HEAD): "
1102                                   nil nil "HEAD")
1103                      (completing-read "Merge to (URL): "
1104                                       'svn-complete-url
1105                                       nil nil
1106                                       (car svn-switch-history)
1107                                       'svn-switch-history)
1108                      (read-string "Merge to revision (HEAD): "
1109                                   nil nil "HEAD")))
1110   (svn-check-running)
1111   (make-local-variable 'svn-updated-files)
1112   (setq svn-updated-files nil)
1113   (svn-run 'merge (list (format "%s@%s" from-url from-rev)
1114                         (format "%s@%s" to-url to-rev))))
1115
1116 (defun svn-merge-filter (proc str)
1117   "Filter function for 'svn merge' output."
1118   ;; The output is similar to svn update
1119   (let ((svn-merging t))
1120     (svn-update-filter proc str)))
1121
1122 (defun svn-merge-sentinel (proc reason)
1123   ;; merge is basically a glorified update
1124   (svn-update-sentinel proc reason))
1125
1126
1127 (defvar svn-last-inserted-filename nil)
1128 (defvar svn-last-inserted-marker nil)
1129
1130 (defsubst svn-file-name< (fn1 fn2)
1131   "Compare two filenames, FN1 and FN2 and decide the sort order"
1132   (let ((dir1 (or (file-name-directory fn1) ""))
1133         (dir2 (or (file-name-directory fn2) "")))
1134     (cond ((and (< (length dir1) (length dir2))
1135                 (string= dir1 (substring dir2 0 (length dir1))))
1136            t)
1137           ((and (> (length dir1) (length dir2))
1138                 (string= dir2 (substring dir1 0 (length dir2))))
1139            nil)
1140           (t
1141            (string< fn1 fn2)))))
1142
1143 (defun svn-insert-file (filename status &optional info)
1144   (save-excursion
1145     (save-restriction
1146       (narrow-to-region (1- svn-files-start) svn-files-stop)
1147       (if svn-last-inserted-filename
1148           (goto-char svn-last-inserted-marker)
1149         ;; Move to the middle of the list and start there
1150         (let ((line-count (count-lines svn-files-start svn-files-stop)))
1151           (goto-char svn-files-start)
1152           (forward-line (/ line-count 2))
1153           (setq svn-last-inserted-filename
1154                 (or (svn-getprop (point) 'file)
1155                     (svn-getprop (point) 'dir)))))
1156       ;; Scan for the place to insert the new file, or replace an
1157       ;; existing line
1158       (cond ((null svn-last-inserted-filename)
1159              nil)
1160             ((svn-file-name< filename svn-last-inserted-filename)
1161              ;;(if (not (bobp))
1162              ;;    (forward-line -1))
1163              (while (and (not (bobp))
1164                          (not (svn-file-name< (or (svn-getprop (point) 'file)
1165                                                   (svn-getprop (point) 'dir))
1166                                               filename)))
1167                (forward-line -1))
1168              (forward-line 1))
1169             (t
1170              (while (and (not (eobp))
1171                          (svn-file-name< (or (svn-getprop (point) 'file)
1172                                              (svn-getprop (point) 'dir))
1173                                          filename))
1174                (forward-line 1))))
1175       (let ((marked nil))
1176         (when (string= filename (svn-getprop (point) 'file))
1177           (setq marked (svn-getprop (point) 'mark))
1178           (delete-region (point) (progn (forward-line 1) (point))))
1179         (set-marker svn-last-inserted-marker (point))
1180         (insert " "
1181                 (if info (format "%-9s " info) "          ")
1182                 status
1183                 (if marked " * " "   ")
1184                 filename)
1185         (newline)
1186         (add-text-properties svn-last-inserted-marker (point)
1187                              (append (list 'svn-file filename
1188                                            'svn-updated t
1189                                            'svn-mark marked)
1190                                      (if marked
1191                                          (list 'face 'svn-mark-face)
1192                                        ()))))))
1193   (setq svn-last-inserted-filename filename))
1194
1195 (defun svn-remove-line (pos)
1196   (save-excursion
1197     (goto-char pos)
1198     (forward-line 1)
1199     (delete-region pos (point))))
1200
1201 (defun svn-insert-dirs ()
1202   (interactive)
1203   (save-excursion
1204     (save-restriction
1205       (narrow-to-region svn-files-start svn-files-stop)
1206       (goto-char (point-min))
1207       (let ((inhibit-read-only t)
1208             (current-dir nil))
1209         (while (not (eobp))
1210           (let ((dir (svn-getprop (point) 'dir)))
1211             (if dir
1212                 (setq current-dir dir)
1213               (let* ((start (point))
1214                      (file (svn-getprop (point) 'file))
1215                      (dir (or (file-name-directory file)
1216                               "")))
1217                 (when (not (string= dir current-dir))
1218                   (setq current-dir dir)
1219                   (if (string= dir "")
1220                       (insert "         Top-level directory:")
1221                     (insert "         Directory " dir ":"))
1222                   (newline)
1223                   ;; Next line only needed on XEmacs
1224                   (remove-text-properties start (point) '(svn-file nil))
1225                   (add-text-properties start (point)
1226                                        (list 'face 'bold
1227                                              'svn-dir dir))))))
1228           (forward-line 1))))))
1229
1230 (defun svn-file-pos (filename)
1231   "Move to the line containing file information for FILENAME."
1232   (let ((pos svn-files-start))
1233     (while (and pos
1234                 (not (string= filename (get-text-property pos 'svn-file))))
1235       (setq pos (next-single-property-change pos 'svn-file)))
1236     pos))
1237
1238 (defun svn-update-file-status (filename status-char)
1239   (let ((inhibit-read-only t))
1240     (save-excursion
1241       (svn-goto-file filename)
1242       (beginning-of-line)
1243       (delete-char 1)
1244       (insert status-char))))
1245
1246 (defun set-svn-process-status (status)
1247   (let ((description (car svn-running)))
1248     (svn-update-label svn-running-label
1249                       (cond ((eq status 'running)
1250                              (format "%s..."
1251                                      (or description "Running")))
1252                             ((eq status 'finished)
1253                              "")        ; "Finished")
1254                             ((eq status 'failed)
1255                              "Failed")
1256                             (t
1257                              ""))))
1258   (cond ((eq status 'running)
1259          (setq mode-line-process ": running"))
1260         (t
1261          (setq mode-line-process nil))))
1262
1263 (defvar svn-status-mode-map nil
1264   "Keymap for `svn-status-mode'.")
1265
1266 (defun svn-status-set-default-mode-map ()
1267   (setq svn-status-mode-map (make-sparse-keymap))
1268   (define-key svn-status-mode-map "a" 'svn-add-file)
1269   (define-key svn-status-mode-map "c" 'svn-commit)
1270   (define-key svn-status-mode-map "f" 'svn-find-file)
1271   (define-key svn-status-mode-map [mouse-2] 'svn-mouse-find-file)
1272   (define-key svn-status-mode-map "\r" 'svn-find-file)
1273   (define-key svn-status-mode-map "g" 'svn-refresh)
1274   (define-key svn-status-mode-map "\M-u" 'svn-update-current)
1275   (define-key svn-status-mode-map " " 'svn-toggle-mark)
1276   (define-key svn-status-mode-map "m" 'svn-mark-forward)
1277   (define-key svn-status-mode-map "\177" 'svn-unmark-backward)
1278   (define-key svn-status-mode-map "u" 'svn-unmark-forward)
1279   (define-key svn-status-mode-map "\M-\177" 'svn-unmark-all)
1280   (define-key svn-status-mode-map "o" 'svn-find-file-other-window)
1281   (define-key svn-status-mode-map "r" 'svn-remove-file)
1282   (define-key svn-status-mode-map "=" 'svn-diff-file)
1283   (define-key svn-status-mode-map "p" 'svn-previous-file)
1284   (define-key svn-status-mode-map "n" 'svn-next-file)
1285   (define-key svn-status-mode-map "s" 'svn-refresh-file)
1286   (define-key svn-status-mode-map "S" 'svn-refresh-one)
1287   (define-key svn-status-mode-map "x" 'svn-expunge)
1288   (define-key svn-status-mode-map "U" 'svn-revert)
1289   (define-key svn-status-mode-map "R" 'svn-resolve)
1290   (define-key svn-status-mode-map "M" 'svn-move)
1291   (define-key svn-status-mode-map "D" 'svn-insert-dirs)
1292   (define-key svn-status-mode-map "\M-s" 'svn-switch)
1293   (define-key svn-status-mode-map "\M-m" 'svn-merge)
1294   (define-key svn-status-mode-map "q" 'bury-buffer)
1295   (define-key svn-status-mode-map "?" 'svn-status-help)
1296   (define-key svn-status-mode-map "P" 'svn-propedit)
1297 )
1298
1299 (unless svn-status-mode-map (svn-status-set-default-mode-map))
1300
1301 (defun svn-status-mode ()
1302   "Major mode for Subversion status buffers.
1303
1304 \\{svn-status-mode-map}"
1305   (interactive)
1306   (kill-all-local-variables)
1307
1308   (make-local-variable 'svn-files-start)
1309   (make-local-variable 'svn-files-stop)
1310   (make-local-variable 'svn-last-inserted-marker)
1311   (make-local-variable 'svn-last-inserted-filename)
1312   (make-local-variable 'svn-running)
1313
1314   (setq major-mode 'svn-status-mode
1315         mode-name "Svn status")
1316   (use-local-map svn-status-mode-map)
1317   (setq goal-column svn-status-mark-col))
1318
1319
1320 (defun svn-goto-file (filename)
1321   (let ((pos (next-single-property-change (point-min) 'svn-file)))
1322     (while (and pos
1323                 (not (string= (svn-getprop pos 'file) filename)))
1324       (setq pos (next-single-property-change pos 'svn-file)))
1325     (if pos
1326         (goto-char pos))))
1327
1328 (defsubst svn-getprop (pos prop)
1329   (get-text-property pos (intern (concat "svn-" (symbol-name prop)))))
1330
1331 (defsubst svn-setprop (pos prop value)
1332   (save-excursion
1333     (goto-char pos)
1334     (beginning-of-line)
1335     (let ((start (point)))
1336       (forward-line)
1337       (put-text-property start (point)
1338                          (intern (concat "svn-" (symbol-name prop)))
1339                          value))))
1340
1341 (defsubst svn-file-status (pos)
1342   "Get the file status for the file at POS."
1343   (char-after (+ pos svn-status-flags-col)))
1344
1345 (defsubst svn-prop-status (pos)
1346   "Get the property status for the file at POS."
1347   (char-after (+ pos svn-status-flags-col 1)))
1348
1349 (defface svn-mark-face
1350   '((((type tty) (class color))
1351      (:background "cyan" :foreground "black"))
1352     (((class color) (background light))
1353      (:background "yellow2"))
1354     (((class color) (background dark))
1355      (:background "darkblue"))
1356     (t (:inverse-video t)))
1357   "Face used to highlight marked files"
1358   :group 'dsvn)
1359
1360 (defun svn-highlight-line (mark)
1361   (save-excursion
1362     (beginning-of-line)
1363     (let ((start (point)))
1364       (forward-line)
1365       (let ((end (point))
1366             (prop (list 'face 'svn-mark-face)))
1367         (if mark
1368             (add-text-properties start end prop)
1369           (remove-text-properties start end prop))))))
1370
1371 (defun svn-set-mark (pos mark)
1372   "Update the mark on the status line at POS.
1373 Set it if MARK is non-NIL, and clear it if MARK is NIL."
1374   (save-excursion
1375     (let ((inhibit-read-only t))
1376       (goto-char (+ pos svn-status-mark-col))
1377       (delete-char 1)
1378       (insert-and-inherit (if mark "*" " "))
1379       (svn-highlight-line mark)
1380       (forward-line 1)
1381       (put-text-property pos (point) 'svn-mark mark))))
1382
1383 (defun svn-actions (&optional pred)
1384   "Return a list of lists (FILE POS) to act on.
1385 Optional argument PRED is a predicate function that is called with POS as
1386 argument."
1387   (let ((files ())
1388         (pos (next-single-property-change (point-min) 'svn-file)))
1389     (while pos
1390       (when (and (get-text-property pos 'svn-mark)
1391                  (or (not pred)
1392                      (funcall pred pos)))
1393         (setq files (cons (list (get-text-property pos 'svn-file)
1394                                 pos)
1395                           files)))
1396       (setq pos (next-single-property-change pos 'svn-file)))
1397     (if (null files)
1398         (let ((file (svn-getprop (point) 'file)))
1399           (unless file
1400             (error "No file on this line"))
1401           (when (and pred
1402                      (not (funcall pred (line-beginning-position))))
1403             (error "Invalid file"))
1404           (list (list file
1405                       (save-excursion
1406                         (beginning-of-line)
1407                         (point)))))
1408       (reverse files))))
1409
1410 (defun svn-action-files (&optional pred)
1411   "Return a list of file names to act on.
1412 Optional argument PRED is a predicate function that is called with POS as
1413 argument."
1414   (mapcar 'car (svn-actions pred)))
1415
1416 (defun svn-find-file (pos)
1417   "Find the file under point."
1418   (interactive "d")
1419   (let ((filename (or (svn-getprop pos 'file)
1420                       (svn-getprop pos 'dir))))
1421     (if filename
1422         (find-file filename)
1423       (error "No file on this line"))))
1424
1425 (defun svn-mouse-find-file (ev)
1426   "Find the file clicked on."
1427   (interactive "e")
1428   (svn-find-file (posn-point (event-start ev))))
1429
1430 (defun svn-find-file-other-window ()
1431   "Find the file under point."
1432   (interactive)
1433   (let ((filename (or (svn-getprop (point) 'file)
1434                       (svn-getprop (point) 'dir))))
1435     (if filename
1436         (find-file-other-window filename)
1437       (error "No file on this line"))))
1438
1439 (defun svn-add-file ()
1440   "Add the selected files to version control."
1441   (interactive)
1442   (let ((actions (svn-action-files
1443                   (lambda (pos)
1444                     (or (eq (svn-file-status pos) ?\?)
1445                         (error "%s is already under version control"
1446                                (svn-getprop pos 'file)))))))
1447     (svn-run 'add actions "Adding files")))
1448
1449 (defun svn-add-filter (proc str)
1450   "Output filter function for `svn add'."
1451   ;; This filter is shared with the delete command
1452   (save-excursion
1453     (set-buffer (process-buffer proc))
1454     (let ((inhibit-read-only t))
1455       (goto-char (point-max))
1456       (insert str)
1457       (goto-char svn-output-marker)
1458       (while (looking-at
1459               ;; What format is this, really?
1460               "\\([AD]  \\).....  \\(.*\\)\n")
1461         (let ((status (concat (match-string 1) "   "))
1462               (filename (match-string 2)))
1463           (delete-region (match-beginning 0)
1464                          (match-end 0))
1465           (svn-insert-file filename status))))))
1466
1467 (defun svn-add-sentinel (proc reason)
1468   (with-current-buffer (process-buffer proc)
1469     (setq svn-running nil)
1470     (set-svn-process-status 'finished))
1471   (svn-default-sentinel proc reason))
1472
1473 (defun svn-can-undo-deletion-p (actions)
1474   "Whether all marked files/directories can be deleted undoably"
1475   (or (null actions)
1476       (and (let* ((fp (car actions))
1477                   (pos (cadr fp)))
1478              ;; We can safely remove unmodified files under version control,
1479              ;; and idempotently already deleted files.
1480              (memq (svn-file-status pos) '(?\  ?D)))
1481            (svn-can-undo-deletion-p (cdr actions)))))
1482
1483 (defun svn-remove-file ()
1484   "Remove the selected files."
1485   (interactive)
1486   (let ((actions (svn-actions))
1487         (inhibit-read-only t))
1488     (when (or (svn-can-undo-deletion-p actions)
1489               (y-or-n-p (format "Really remove %d %s? "
1490                                 (length actions)
1491                                 (if (> (length actions) 1)
1492                                     "files"
1493                                   "file"))))
1494       (let ((svn-files ()))
1495         (mapc (lambda (fp)
1496                 (let ((file (car fp))
1497                       (pos (cadr fp)))
1498                   (if (/= (svn-file-status pos) ?\?)
1499                       (setq svn-files (cons file svn-files))
1500                     (delete-file file)
1501                     (svn-remove-line pos))))
1502               ;; traverse the list backwards, to keep buffer positions of
1503               ;; remaining files valid
1504               (reverse actions))
1505         (when svn-files
1506           (svn-run 'delete (cons "--force" svn-files) "Removing files"))))))
1507
1508 (defun svn-delete-filter (proc str)
1509   (svn-add-filter proc str))
1510
1511 (defun svn-revert ()
1512   "Revert the selected files."
1513   (interactive)
1514   (let ((files (svn-action-files
1515                 (lambda (pos)
1516                   (or (memq (svn-file-status pos) '(?D ?A ?M ?C ?!))
1517                       (memq (svn-prop-status pos) '(?D ?A ?M ?C ?!))
1518                       (error "%s has no local changes"
1519                              (svn-getprop pos 'file)))))))
1520     (when (y-or-n-p (format "Really revert %d %s? "
1521                             (length files)
1522                             (if (> (length files) 1)
1523                                 "files"
1524                               "file")))
1525       (make-local-variable 'svn-reverted-files)
1526       (setq svn-reverted-files files)
1527       (svn-run 'revert files "Reverting files"))))
1528
1529 (defun svn-revert-sentinel (proc reason)
1530   (svn-default-sentinel proc reason)
1531   (if (= (process-exit-status proc) 0)
1532       (with-current-buffer (process-buffer proc)
1533         (let ((inhibit-read-only t))
1534           (svn-run-status-v svn-reverted-files nil))))
1535   (mapc #'svn-revert-if-needed svn-reverted-files))
1536
1537 (defun svn-resolve ()
1538   "Mark the selected files as resolved."
1539   (interactive)
1540   (let ((files (svn-action-files
1541                 (lambda (pos)
1542                   (or (= (svn-file-status pos) ?C)
1543                       (= (svn-prop-status pos) ?C)
1544                       (error "%s has no conflicts"
1545                              (svn-getprop pos 'file)))))))
1546     (make-local-variable 'svn-resolved-files)
1547     (setq svn-resolved-files files)
1548     (svn-run 'resolved files "Marking resolved files")))
1549
1550 (defun svn-resolved-sentinel (proc reason)
1551   (svn-default-sentinel proc reason)
1552   (if (= (process-exit-status proc) 0)
1553       (with-current-buffer (process-buffer proc)
1554         (let ((inhibit-read-only t))
1555           (svn-run-status-v svn-resolved-files nil)))))
1556
1557 (defun svn-move ()
1558   "Move/rename the selected file."
1559   (interactive)
1560   (let ((files (svn-action-files)))
1561     (if (/= (length files) 1)
1562         (error "Can only rename one file at a time"))
1563     (when (file-directory-p (car files))
1564       (error "Can only move files"))
1565     (let* ((src (car files))
1566            (dir (file-name-directory src))
1567            (dst (completing-read "Move to: "
1568                                  'svn-complete-url
1569                                  nil nil
1570                                  dir
1571                                  'svn-switch-history)))
1572       (svn-run 'move (list src dst) "Moving file"))))
1573
1574 (defun svn-move-filter (proc str)
1575   (save-excursion
1576     (set-buffer (process-buffer proc))
1577     (let ((inhibit-read-only t))
1578       (goto-char (point-max))
1579       (insert str)
1580       (goto-char svn-output-marker)
1581       (while (looking-at
1582               "\\([AD]     \\)    \\(.*\\)\n")
1583         (let ((status (match-string 1))
1584               (filename (match-string 2)))
1585           (if (string= status "A     ")
1586               (setq status "A  +  "))
1587           (delete-region (match-beginning 0)
1588                          (match-end 0))
1589           (svn-insert-file filename status))))))
1590
1591 (defun svn-toggle-file-mark ()
1592   "Toggle the mark for the file under point."
1593   (let ((mark (svn-getprop (point) 'mark)))
1594     (svn-set-mark (line-beginning-position) (not mark))))
1595
1596 (defun svn-toggle-mark ()
1597   "Toggle the mark for the file under point, or files in the dir under point."
1598   (interactive)
1599   (cond ((svn-getprop (point) 'file)
1600          (svn-toggle-file-mark))
1601         ((svn-getprop (point) 'dir)
1602          (let ((dir (svn-getprop (point) 'dir))
1603                file)
1604            (save-excursion
1605              (forward-line 1)
1606              (setq file (svn-getprop (point) 'file))
1607              (while (and file
1608                          (svn-in-dir-p dir file))
1609                (svn-toggle-file-mark)
1610                (forward-line 1)
1611                (setq file (svn-getprop (point) 'file))))))))
1612
1613 (defun svn-change-mark-forward (mark)
1614   "Set or clear the mark for the file under point and move to next line."
1615   (cond ((svn-getprop (point) 'file)
1616          (svn-set-mark (line-beginning-position) mark)
1617          (let (pos (svn-next-file-pos))
1618            (if pos
1619                (svn-next-file 1)
1620              (next-line 1))))
1621         ((svn-getprop (point) 'dir)
1622          (let ((dir (svn-getprop (point) 'dir))
1623                file)
1624            (forward-line 1)
1625            (setq file (svn-getprop (point) 'file))
1626            (while (and file
1627                        (svn-in-dir-p dir file))
1628              (svn-set-mark (point) mark)
1629              (forward-line 1)
1630              (setq file (svn-getprop (point) 'file)))
1631            (move-to-column goal-column)))
1632         (t
1633          (error "No file on line"))))
1634
1635 (defun svn-mark-forward ()
1636   "Set the mark for the file under point and move to next line."
1637   (interactive)
1638   (svn-change-mark-forward t))
1639
1640 (defun svn-mark-backward ()
1641   "Set the mark for the file under point and move to next line."
1642   (interactive)
1643   (svn-previous-file 1)
1644   (svn-set-mark (line-beginning-position) t))
1645
1646 (defun svn-unmark-forward ()
1647   "Unset the mark for the file on the previous line."
1648   (interactive)
1649   (svn-change-mark-forward nil))
1650
1651 (defun svn-unmark-backward ()
1652   "Unset the mark for the file on the previous line."
1653   (interactive)
1654   (svn-previous-file 1)
1655   (svn-set-mark (line-beginning-position) nil))
1656
1657 (defun svn-unmark-all ()
1658   "Unset the mark for the file on the previous line."
1659   (interactive)
1660   (let ((pos-list (mapcar 'cadr (svn-actions))))
1661     (while pos-list
1662       (svn-set-mark (car pos-list) nil)
1663       (setq pos-list (cdr pos-list)))))
1664
1665 (defun svn-diff-file (all)
1666   "Show diff for the file under point.
1667 If the prefix argument ALL is non-NIL, show diff for all selected
1668 files instead."
1669   (interactive "P")
1670   (let ((files (if all
1671                    (svn-action-files)
1672                  (list (or (svn-getprop (point) 'file)
1673                            (svn-getprop (point) 'dir)
1674                            (error "No file on line"))))))
1675     (unless (svn-run-with-output "diff" files 'diff-mode)
1676       (message "No difference found"))))
1677
1678 (defun svn-previous-file (arg)
1679   "Move to the ARGth previous line containing file information."
1680   (interactive "p")
1681   (let ((pos (previous-single-property-change (point) 'svn-file)))
1682     (if (not pos)
1683         (error "No previous file"))
1684
1685     ;; Usually we have just found the beginning of the current line
1686     (when (string= (get-text-property pos 'svn-file)
1687                    (svn-getprop (point) 'file))
1688       (setq pos (previous-single-property-change pos 'svn-file))
1689       (if (not pos)
1690           (error "No previous file")))
1691
1692     ;; Skip lines that don't contain file info
1693     (when (null (get-text-property pos 'svn-file))
1694       (setq pos (previous-single-property-change pos 'svn-file))
1695       (if (not pos)
1696           (error "No previous file")))
1697
1698     (goto-char (+ pos goal-column))
1699     (if (> arg 1)
1700         (svn-previous-file (1- arg)))))
1701
1702 (defun svn-next-file-pos ()
1703   (let ((pos (next-single-property-change (point) 'svn-file)))
1704     (and pos
1705          ;; Skip lines that don't contain file info
1706          (if (null (get-text-property pos 'svn-file))
1707              (next-single-property-change pos 'svn-file)
1708            pos))))
1709
1710 (defun svn-next-file (arg)
1711   "Move to the ARGth next line containing file information."
1712   (interactive "p")
1713   (let ((pos (svn-next-file-pos)))
1714     (if pos
1715         (goto-char (+ pos goal-column))
1716       ;; Allow stepping past last file
1717       (if (< (point) svn-files-stop)
1718           (next-line 1)
1719         (error "No next file")))
1720
1721     (if (> arg 1)
1722         (svn-next-file (1- arg)))))
1723
1724 (defun svn-expunge ()
1725   "Remove entried for unmodified files."
1726   (interactive)
1727   (save-excursion
1728     (let ((inhibit-read-only t)
1729           (last-dir "/"))
1730       (goto-char svn-files-stop)
1731       (forward-line -1)
1732       (while (>= (point) svn-files-start)
1733         (let ((dir (svn-getprop (point) 'dir)))
1734           (if dir
1735               (progn
1736                 (when last-dir
1737                   ;; If this is a superdirectory, leave it
1738                   (unless (and (> (length dir) (length last-dir))
1739                                (string= (substring dir 0 (length last-dir))
1740                                         last-dir))
1741                     (svn-remove-line (point))))
1742                 (setq last-dir dir))
1743             (let ((file-status (svn-file-status (point)))
1744                   (prop-status (svn-prop-status (point))))
1745               (if (and (memq file-status '(?\  ?I ?X))
1746                        (eq prop-status ?\ ))
1747                   (svn-remove-line (point))
1748                 (setq last-dir nil)))))
1749         (forward-line -1))))
1750   (move-to-column goal-column)
1751   (setq svn-last-inserted-filename nil))
1752
1753
1754 (defun svn-format-help-column (table)
1755   (mapcar (lambda (cmd-desc)
1756                (let ((cmd (car cmd-desc))
1757                      (desc (cadr cmd-desc)))
1758                  (format "%-4s %s"
1759                          (key-description (car (where-is-internal cmd)))
1760                          desc)))
1761              table))
1762
1763 (defun svn-merge-columns-list (columns fmt)
1764   (let ((first-lines (mapcar #'car columns)))
1765     (and (eval `(or ',@first-lines))
1766          (cons (mapconcat (lambda (str) (format fmt (or str "")))
1767                           first-lines " | ")
1768                (svn-merge-columns-list (mapcar #'cdr columns) fmt)))))
1769
1770 (defun svn-merge-columns (columns width)
1771   (mapconcat #'identity
1772              (svn-merge-columns-list columns (format "%%-%ds" width))
1773              "\n"))
1774
1775 (defun svn-status-help ()
1776   "Display keyboard help for svn status buffer."
1777   (interactive)
1778   (let* ((buf (get-buffer-create "*svn-keyboard-help*"))
1779          (help-text
1780           (svn-merge-columns
1781            (list (svn-format-help-column
1782                   '((svn-commit "commit marked files")
1783                     (svn-add-file "add marked files")
1784                     (svn-remove-file "remove marked files")
1785                     (svn-revert "revert marked files")
1786                     (svn-update-current "update working copy")
1787                     (svn-resolve "resolve conflicts")
1788                     (svn-move "rename/move files")
1789                     (svn-switch "switch working tree")
1790                     (svn-merge "merge into WC")
1791                     (svn-propedit "edit properties")))
1792                  (svn-format-help-column
1793                   '((svn-mark-forward "mark and go down")
1794                     (svn-unmark-backward "go up and unmark")
1795                     (svn-unmark-forward  "unmark and go down")
1796                     (svn-toggle-mark "toggle mark")
1797                     (svn-unmark-all "unmark all")))
1798                  (svn-format-help-column
1799                   '((svn-find-file "visit file")
1800                     (svn-find-file-other-window "visit file other win")
1801                     (svn-diff-file "show file diff")
1802                     (svn-refresh "refresh all files")
1803                     (svn-refresh-file "refresh marked files")
1804                     (svn-refresh-one "refresh named file")
1805                     (svn-expunge "expunge unchanged"))))
1806            24)))
1807     (with-current-buffer buf
1808       (setq buffer-read-only t)
1809       (let ((inhibit-read-only t))
1810         (erase-buffer)
1811         (insert help-text)
1812         (goto-char 1))
1813       (set-buffer-modified-p nil))
1814     (unless (get-buffer-window buf)
1815       (let ((nlines (with-current-buffer buf
1816                       (count-lines 1 (buffer-size)))))
1817         (set-window-buffer
1818          (split-window-vertically (- 0 nlines 1))
1819          buf)))))
1820
1821 ;;; Hooks
1822
1823 (defun svn-buffer-list ()
1824   "Return a list of svn status buffers."
1825   (let ((buffers ())
1826         (all-buffers (buffer-list)))
1827     (while all-buffers
1828       (let ((buf (car all-buffers)))
1829         (if (eq (with-current-buffer buf major-mode)
1830                 'svn-status-mode)
1831             (setq buffers (cons buf buffers))))
1832       (setq all-buffers (cdr all-buffers)))
1833     buffers))
1834
1835 (defun svn-update-status-flag (pos flag &optional prop-flag)
1836   "Update the status flag column for file at position POS.
1837 Argument FLAG is the character to use."
1838   (save-excursion
1839     (goto-char (+ pos svn-status-flags-col))
1840     (insert-and-inherit flag)
1841     (delete-char 1)
1842     (when prop-flag
1843       (insert-and-inherit prop-flag)
1844       (delete-char 1))))
1845
1846 (defun svn-update-status-msg (pos msg)
1847   "Update the message column for file at position POS.
1848 Argument MSG is the character to use."
1849   (save-excursion
1850     (goto-char (+ pos svn-status-msg-col))
1851     (delete-char 9)
1852     (insert-and-inherit (format "%9s" msg))))
1853
1854 (defun svn-foreach-svn-buffer (file-name function)
1855   "Call FUNCTION for each svn status buffer that contains FILE-NAME.
1856 The current buffer will be the svn status buffer, and the arguments to
1857 the function is the local form of the filename and the buffer position
1858 where the file information is."
1859   (let* ((svn-buffers (svn-buffer-list))
1860          (inhibit-read-only t)
1861          (file-path (file-truename file-name)))
1862     (while svn-buffers
1863       (with-current-buffer (car svn-buffers)
1864         (let ((dir (file-truename default-directory)))
1865           (when (and (>= (length file-path) (length dir))
1866                      (string= dir (substring file-path 0 (length dir))))
1867             (let* ((local-file-name (substring file-path (length dir)))
1868                    (file-pos (svn-file-pos local-file-name)))
1869               (funcall function local-file-name file-pos)))))
1870       (setq svn-buffers (cdr svn-buffers)))))
1871
1872 (defun svn-after-save ()
1873   "Update svn status buffer when saving a file."
1874   (svn-foreach-svn-buffer
1875    (buffer-file-name)
1876    (lambda (local-file-name file-pos)
1877      (if file-pos
1878          (let ((old-status (svn-file-status file-pos)))
1879            (when (= old-status ?\ )
1880              (svn-update-status-flag file-pos ?M))
1881            (svn-update-status-msg file-pos ""))
1882        (svn-run-status-v (list local-file-name) nil))))
1883   nil)
1884
1885 (add-hook 'after-save-hook 'svn-after-save)
1886
1887 (defun svn-after-commit ()
1888   "Update svn status buffer when committing a file from `vc-mode'."
1889   (svn-foreach-svn-buffer
1890    (buffer-file-name)
1891    (lambda (local-file-name file-pos)
1892      (if file-pos
1893          (progn
1894            (svn-update-status-flag file-pos ?\ )
1895            (svn-update-status-msg file-pos "Committed"))
1896        (svn-insert-file local-file-name "      " "Committed"))))
1897   nil)
1898
1899 (add-hook 'vc-checkin-hook 'svn-after-commit)
1900
1901 (defadvice vc-svn-register (after svn-vc-svn-register activate)
1902   (svn-foreach-svn-buffer
1903    (buffer-file-name)
1904    (lambda (local-file-name file-pos)
1905      (svn-refresh-item local-file-name t))))
1906
1907 ;;; To get reasonable uniquify behaviour, tell it what path to use
1908 ;;; for the status buffers.
1909 (defadvice uniquify-buffer-file-name (after svn-uniquify activate)
1910   (unless ad-return-value
1911     ;; buffer is not visiting any file
1912     (with-current-buffer (ad-get-arg 0)
1913       (when (eq major-mode 'svn-status-mode)
1914         (setq ad-return-value (expand-file-name "*svn*"))))))
1915
1916 (provide 'dsvn)
1917
1918 ;;; dsvn.el ends here