1 ;;; psvn.el --- Subversion interface for emacs
2 ;; Copyright (C) 2002-2004 by Stefan Reichoer
4 ;; Author: Stefan Reichoer, <stefan@xsteve.at>
5 ;; $Id: psvn.el 10983 2004-09-15 18:38:26Z xsteve $
7 ;; psvn.el is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; psvn.el is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to
19 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 ;; Boston, MA 02111-1307, USA.
24 ;; psvn.el is tested with GNU Emacs 21.3 on windows, debian linux,
25 ;; freebsd5 with svn 1.05
27 ;; psvn.el is an interface for the revision control tool subversion
28 ;; (see http://subversion.tigris.org)
29 ;; psvn.el provides a similar interface for subversion as pcl-cvs for cvs.
30 ;; At the moment the following commands are implemented:
31 ;; M-x svn-status: run 'svn -status -v'
32 ;; and show the result in the *svn-status* buffer. This buffer uses
33 ;; svn-status mode in which the following keys are defined:
34 ;; g - svn-status-update: run 'svn status -v'
35 ;; C-u g - svn-status-update: run 'svn status -vu'
36 ;; = - svn-status-show-svn-diff run 'svn diff'
37 ;; l - svn-status-show-svn-log run 'svn log'
38 ;; i - svn-status-info run 'svn info'
39 ;; r - svn-status-revert run 'svn revert'
40 ;; V - svn-status-resolved run 'svn resolved'
41 ;; U - svn-status-update-cmd run 'svn update'
42 ;; c - svn-status-commit-file run 'svn commit'
43 ;; a - svn-status-add-file run 'svn add --non-recursive'
44 ;; A - svn-status-add-file-recursively run 'svn add'
45 ;; + - svn-status-make-directory run 'svn mkdir'
46 ;; R - svn-status-mv run 'svn mv'
47 ;; C-d - svn-status-rm run 'svn rm'
48 ;; M-c - svn-status-cleanup run 'svn cleanup'
49 ;; b - svn-status-blame run 'svn blame'
50 ;; RET - svn-status-find-file-or-examine-directory
51 ;; ^ - svn-status-examine-parent
52 ;; ~ - svn-status-get-specific-revision
53 ;; E - svn-status-ediff-with-revision
54 ;; s - svn-status-show-process-buffer
55 ;; e - svn-status-toggle-edit-cmd-flag
56 ;; ? - svn-status-toggle-hide-unknown
57 ;; _ - svn-status-toggle-hide-unmodified
58 ;; m - svn-status-set-user-mark
59 ;; u - svn-status-unset-user-mark
60 ;; $ - svn-status-toggle-elide
61 ;; DEL - svn-status-unset-user-mark-backwards
62 ;; * ! - svn-status-unset-all-usermarks
63 ;; * ? - svn-status-mark-unknown
64 ;; * A - svn-status-mark-added
65 ;; * M - svn-status-mark-modified
66 ;; . - svn-status-goto-root-or-return
67 ;; f - svn-status-find-file
68 ;; o - svn-status-find-file-other-window
69 ;; v - svn-status-view-file-other-window
70 ;; I - svn-status-parse-info
71 ;; P l - svn-status-property-list
72 ;; P s - svn-status-property-set
73 ;; P d - svn-status-property-delete
74 ;; P e - svn-status-property-edit-one-entry
75 ;; P i - svn-status-property-ignore-file
76 ;; P I - svn-status-property-ignore-file-extension
77 ;; P C-i - svn-status-property-edit-svn-ignore
78 ;; P k - svn-status-property-set-keyword-list
79 ;; P y - svn-status-property-set-eol-style
80 ;; h - svn-status-use-history
81 ;; q - svn-status-bury-buffer
83 ;; To use psvn.el put the following line in your .emacs:
85 ;; Start the svn interface with M-x svn-status
87 ;; The latest version of psvn.el can be found at:
88 ;; http://www.xsteve.at/prg/emacs/psvn.el
89 ;; Or you can check it out from the subversion repository:
90 ;; svn co http://svn.collab.net/repos/svn/trunk/contrib/client-side/psvn psvn
93 ;; * shortcut for svn propset svn:keywords "Date" psvn.el
94 ;; * docstrings for the functions
95 ;; * perhaps shortcuts for ranges, dates
96 ;; * when editing the command line - offer help from the svn client
97 ;; * finish svn-status-property-set
98 ;; * eventually use the customize interface
99 ;; * interactive svn-status should complete existing directories only;
100 ;; unfortunately `read-directory-name' doesn't exist in Emacs 21.3
101 ;; * Add repository browser
102 ;; * Improve support for svn blame
103 ;; * Support for editing the log file entries, e.g.:
104 ;; svn propedit --revprop -r9821 svn:log
105 ;; * Better logview mode (allow to show the changeset for a given entry)
107 ;; Overview over the implemented/not (yet) implemented svn sub-commands:
109 ;; * blame implemented
112 ;; * cleanup implemented
113 ;; * commit (ci) implemented
115 ;; * delete (del, remove, rm) implemented
116 ;; * diff (di) implemented
120 ;; * info implemented
124 ;; * mkdir implemented
125 ;; * move (mv, rename, ren) implemented
126 ;; * propdel (pdel) implemented
127 ;; * propedit (pedit, pe) not needed
128 ;; * propget (pget, pg) used
129 ;; * proplist (plist, pl) implemented
130 ;; * propset (pset, ps) used
131 ;; * resolved implemented
132 ;; * revert implemented
133 ;; * status (stat, st) implemented
135 ;; * update (up) implemented
137 ;; For the not yet implemented commands you should use the command line
138 ;; svn client. If there are user requests for any missing commands I will
139 ;; probably implement them.
141 ;; Comments / suggestions and bug reports are welcome!
145 ;;; user setable variables
146 (defvar svn-log-edit-file-name "++svn-log++" "*Name of a saved log file.")
147 (defvar svn-status-hide-unknown nil "*Hide unknown files in *svn-status* buffer.")
148 (defvar svn-status-hide-unmodified nil "*Hide unmodified files in *svn-status* buffer.")
149 (defvar svn-status-directory-history nil "*List of visited svn working directories.")
151 (defvar svn-status-unmark-files-after-list '(commit revert)
152 "*List of operations after which all user marks will be removed.
153 Possible values are: commit, revert.")
155 ;;; default arguments to pass to svn commands
156 (defvar svn-status-default-log-arguments ""
157 "*Arguments to pass to svn log.
158 \(used in `svn-status-show-svn-log'; override these by giving prefixes\).")
161 (defvar svn-log-edit-mode-hook nil "Hook run when entering `svn-log-edit-mode'.")
163 (defvar svn-status-wash-control-M-in-process-buffers
164 (eq system-type 'windows-nt)
165 "*Remove any trailing ^M from the *svn-process* buffer.")
169 "Subversion interface for Emacs."
172 (defgroup psvn-faces nil
179 (defconst svn-xemacsp (featurep 'xemacs))
182 (require 'overlay nil t)))
184 ;; Use the normally used mode for files ending in .~HEAD~, .~BASE~, ...
185 (add-to-list 'auto-mode-alist '("\\.~?\\(HEAD\\|BASE\\|PREV\\)~?\\'" ignore t))
187 ;;; internal variables
188 (defvar svn-process-cmd nil)
189 (defvar svn-status-info nil)
190 (defvar svn-status-base-info nil)
191 (defvar svn-status-initial-window-configuration nil)
192 (defvar svn-status-default-column 23)
193 (defvar svn-status-default-revision-width 4)
194 (defvar svn-status-default-author-width 9)
195 (defvar svn-status-line-format " %c%c %4s %4s %-9s")
196 (defvar svn-status-short-mod-flag-p t)
197 (defvar svn-start-of-file-list-line-number 0)
198 (defvar svn-status-files-to-commit nil)
199 (defvar svn-status-pre-commit-window-configuration nil)
200 (defvar svn-status-pre-propedit-window-configuration nil)
201 (defvar svn-status-head-revision nil)
202 (defvar svn-status-root-return-info nil)
203 (defvar svn-status-property-edit-must-match-flag nil)
204 (defvar svn-status-propedit-property-name nil)
205 (defvar svn-status-propedit-file-list nil)
206 (defvar svn-status-mode-line-process "")
207 (defvar svn-status-mode-line-process-status "")
208 (defvar svn-status-mode-line-process-edit-flag "")
209 (defvar svn-status-edit-svn-command nil)
210 (defvar svn-status-update-previous-process-output nil)
211 (defvar svn-status-temp-dir
213 (when (boundp 'temporary-file-directory) temporary-file-directory) ;emacs
214 (when (boundp 'temp-directory) temp-directory) ;xemacs
216 (defvar svn-temp-suffix (make-temp-name "."))
217 (defvar svn-status-temp-file-to-remove nil)
218 (defvar svn-status-temp-arg-file (concat svn-status-temp-dir "svn.arg" svn-temp-suffix))
221 (defface svn-status-marked-face
222 '((((type tty) (class color)) (:foreground "green" :weight light))
223 (((class color) (background light)) (:foreground "green3"))
224 (((class color) (background dark)) (:foreground "palegreen2"))
226 "Face to highlight the mark for user marked files in svn status buffers."
229 (defface svn-status-modified-external-face
230 '((((type tty) (class color)) (:foreground "magenta" :weight light))
231 (((class color) (background light)) (:foreground "magenta"))
232 (((class color) (background dark)) (:foreground "yellow"))
234 "Face to highlight the phrase \"externally modified\" in *svn-status* buffers."
237 ;based on cvs-filename-face
238 (defface svn-status-directory-face
239 '((((type tty) (class color)) (:foreground "lightblue" :weight light))
240 (((class color) (background light)) (:foreground "blue4"))
241 (((class color) (background dark)) (:foreground "lightskyblue1"))
243 "Face for directories in svn status buffers.
244 See `svn-status--line-info->directory-p' for what counts as a directory."
247 ;based on font-lock-comment-face
248 (defface svn-status-filename-face
249 '((((class color) (background light)) (:foreground "chocolate"))
250 (((class color) (background dark)) (:foreground "beige")))
251 "Face for non-directories in svn status buffers.
252 See `svn-status--line-info->directory-p' for what counts as a directory."
255 (defvar svn-highlight t)
256 ;; stolen from PCL-CVS
257 (defun svn-add-face (str face &optional keymap)
259 ;; Do not use `list*'; cl.el might not have been loaded. We could
260 ;; put (require 'cl) at the top but let's try to manage without.
261 (add-text-properties 0 (length str)
264 `(mouse-face highlight
269 (defun svn-status-maybe-add-face (condition text face)
270 "If CONDITION then add FACE to TEXT.
271 Else return TEXT unchanged."
273 (svn-add-face text face)
276 (defun svn-status-choose-face-to-add (condition text face1 face2)
277 "If CONDITION then add FACE1 to TEXT, else add FACE2 to TEXT."
279 (svn-add-face text face1)
280 (svn-add-face text face2)))
284 (unless (fboundp 'point-at-eol) (defalias 'point-at-eol 'line-end-position))
285 (unless (fboundp 'point-at-bol) (defalias 'point-at-bol 'line-beginning-position))
286 (unless (functionp 'read-directory-name) (defalias 'read-directory-name 'read-file-name))
289 (if (not (fboundp 'gethash))
291 (if (not (fboundp 'puthash))
292 (defalias 'puthash 'cl-puthash))
294 (defvar svn-status-display-new-status-buffer nil)
296 (defun svn-status (dir &optional arg)
297 "Examine the status of Subversion working copy in directory DIR.
298 If ARG then pass the -u argument to `svn status'."
299 (interactive (list (read-directory-name "SVN status directory: "
300 nil default-directory nil)))
301 (unless (file-directory-p dir)
302 (error "%s is not a directory" dir))
303 (if (not (file-exists-p (concat dir "/.svn/")))
306 " does not seem to be a Subversion working copy (no .svn directory). "
307 "Run dired instead? "))
309 (setq dir (file-name-as-directory dir))
310 (setq svn-status-directory-history (delete dir svn-status-directory-history))
311 (add-to-list 'svn-status-directory-history dir)
312 (if (string= (buffer-name) "*svn-status*")
313 (setq svn-status-display-new-status-buffer nil)
314 (setq svn-status-display-new-status-buffer t)
315 ;;(message "psvn: Saving initial window configuration")
316 (setq svn-status-initial-window-configuration (current-window-configuration)))
317 (let* ((status-buf (get-buffer-create "*svn-status*"))
318 (proc-buf (get-buffer-create "*svn-process*")))
320 (set-buffer status-buf)
321 (setq default-directory dir)
322 (set-buffer proc-buf)
323 (setq default-directory dir)
325 (svn-run-svn t t 'status "status" "-vu")
326 (svn-run-svn t t 'status "status" "-v"))))))
328 (defun svn-status-use-history ()
330 (let* ((hist svn-status-directory-history)
331 (dir (read-from-minibuffer "svn-status on directory: "
332 (cadr svn-status-directory-history)
334 (when (file-directory-p dir)
337 (defun svn-run-svn (run-asynchron clear-process-buffer cmdtype &rest arglist)
338 "Run svn with arguments ARGLIST.
340 If RUN-ASYNCHRON is t then run svn asynchronously.
342 If CLEAR-PROCESS-BUFFER is t then erase the contents of the
343 *svn-process* buffer before commencing.
345 CMDTYPE is a symbol such as 'mv, 'revert, or 'add, representing the
348 ARGLIST is a list of arguments \(which must include the command name,
349 for example: '(\"revert\" \"file1\"\)"
350 (if (eq (process-status "svn") nil)
352 (when svn-status-edit-svn-command
353 (setq arglist (append arglist
355 (read-from-minibuffer
356 (format "svn %s %S " cmdtype arglist)))))
357 (when (eq svn-status-edit-svn-command t)
358 (svn-status-toggle-edit-cmd-flag t))
359 (message "svn-run-svn %s: %S" cmdtype arglist))
360 (let* ((proc-buf (get-buffer-create "*svn-process*"))
362 (when (listp (car arglist))
363 (setq arglist (car arglist)))
365 (set-buffer proc-buf)
366 (setq buffer-read-only nil)
368 (if clear-process-buffer
369 (delete-region (point-min) (point-max))
370 (goto-char (point-max)))
371 (setq svn-process-cmd cmdtype)
372 (setq svn-status-mode-line-process-status (format " running %s" cmdtype))
373 (svn-status-update-mode-line)
377 (setq svn-proc (apply 'start-process "svn" proc-buf "svn" arglist))
378 (set-process-sentinel svn-proc 'svn-process-sentinel))
379 ;;(message "running synchron: svn %S" arglist)
380 (apply 'call-process "svn" nil proc-buf nil arglist)
381 (setq svn-status-mode-line-process-status "")
382 (svn-status-update-mode-line)))))
383 (error "You can only run one svn process at once!")))
385 (defun svn-process-sentinel (process event)
386 ;;(princ (format "Process: %s had the event `%s'" process event)))
388 (let ((act-buf (current-buffer)))
389 (set-buffer (process-buffer process))
390 (setq svn-status-mode-line-process-status "")
391 (svn-status-update-mode-line)
392 (cond ((string= event "finished\n")
393 (cond ((eq svn-process-cmd 'status)
394 ;;(message "svn status finished")
395 (if (eq system-type 'windows-nt)
396 ;; convert path separator as UNIX style
398 (goto-char (point-min))
399 (while (search-forward "\\" nil t)
400 (replace-match "/"))))
401 (svn-parse-status-result)
403 (svn-status-update-buffer)
404 (when svn-status-update-previous-process-output
405 (set-buffer (process-buffer process))
406 (delete-region (point-min) (point-max))
407 (insert "Output from svn command:\n")
408 (insert svn-status-update-previous-process-output)
409 (goto-char (point-min))
410 (setq svn-status-update-previous-process-output nil))
411 (when svn-status-display-new-status-buffer
412 (set-window-configuration svn-status-initial-window-configuration)
413 (switch-to-buffer "*svn-status*")))
414 ((eq svn-process-cmd 'log)
415 (svn-status-show-process-buffer-internal t)
416 (pop-to-buffer "*svn-process*")
417 (switch-to-buffer (get-buffer-create "*svn-log*"))
418 (let ((buffer-read-only nil))
419 (delete-region (point-min) (point-max))
420 (insert-buffer-substring "*svn-process*"))
422 (goto-char (point-min))
424 (font-lock-fontify-buffer)
425 (message "svn log finished"))
426 ((eq svn-process-cmd 'info)
427 (svn-status-show-process-buffer-internal t)
428 (message "svn info finished"))
429 ((eq svn-process-cmd 'parse-info)
430 (svn-status-parse-info-result))
431 ((eq svn-process-cmd 'blame)
432 (svn-status-show-process-buffer-internal t)
433 (message "svn blame finished"))
434 ((eq svn-process-cmd 'commit)
435 (svn-status-remove-temp-file-maybe)
436 (svn-status-show-process-buffer-internal t)
437 (when (member 'commit svn-status-unmark-files-after-list)
438 (svn-status-unset-all-usermarks))
440 (message "svn commit finished"))
441 ((eq svn-process-cmd 'update)
442 (svn-status-show-process-buffer-internal t)
444 (message "svn update finished"))
445 ((eq svn-process-cmd 'add)
447 (message "svn add finished"))
448 ((eq svn-process-cmd 'mkdir)
450 (message "svn mkdir finished"))
451 ((eq svn-process-cmd 'revert)
452 (when (member 'revert svn-status-unmark-files-after-list)
453 (svn-status-unset-all-usermarks))
455 (message "svn revert finished"))
456 ((eq svn-process-cmd 'resolved)
458 (message "svn resolved finished"))
459 ((eq svn-process-cmd 'mv)
461 (message "svn mv finished"))
462 ((eq svn-process-cmd 'rm)
464 (message "svn rm finished"))
465 ((eq svn-process-cmd 'cleanup)
466 (message "svn cleanup finished"))
467 ((eq svn-process-cmd 'proplist)
468 (svn-status-show-process-buffer-internal t)
469 (message "svn proplist finished"))
470 ((eq svn-process-cmd 'proplist-parse)
471 (svn-status-property-parse-property-names))
472 ((eq svn-process-cmd 'propset)
473 (svn-status-remove-temp-file-maybe)
475 ((eq svn-process-cmd 'propdel)
476 (svn-status-update))))
477 ((string= event "killed\n")
478 (message "svn process killed"))
479 ((string-match "exited abnormally" event)
480 (while (accept-process-output process 0 100))
481 ;; find last error message and show it.
482 (goto-char (point-max))
483 (message "svn failed: %s"
484 (if (re-search-backward "^svn: \\(.*\\)" nil t)
488 (message "svn process had unknown event: %s" event))
489 (svn-status-show-process-buffer-internal t))))
491 (defun svn-parse-rev-num (str)
492 (if (and str (stringp str)
493 (save-match-data (string-match "^[0-9]+" str)))
494 (string-to-number str)
498 (defun svn-parse-status-result ()
499 "Parse the *svn-process* buffer.
500 The results are used to build the `svn-status-info' variable."
501 (setq svn-status-head-revision nil)
503 (let ((old-ui-information (svn-status-ui-information-hash-table))
515 (ui-status '(nil nil)) ; contains (user-mark user-elide)
516 (revision-width svn-status-default-revision-width)
517 (author-width svn-status-default-author-width))
518 (set-buffer "*svn-process*")
519 (setq svn-status-info nil)
520 (goto-char (point-min))
521 (while (< (point) (point-max))
523 ((= (point-at-eol) (point-at-bol)) ;skip blank lines
525 ((looking-at "Status against revision:[ ]+\\([0-9]+\\)")
526 ;; the above message appears for the main listing plus once for each svn:externals entry
527 (unless svn-status-head-revision
528 (setq svn-status-head-revision (match-string 1))))
529 ((looking-at "Performing status on external item at '\(.*\)'")
530 ;; The *next* line has info about the directory named in svn:externals
531 ;; we should parse it, and merge the info with what we have already know
532 ;; but for now just ignore the line completely
536 (setq svn-marks (buffer-substring (point) (+ (point) 8))
537 svn-file-mark (elt svn-marks 0) ; 1st column
538 svn-property-mark (elt svn-marks 1) ; 2nd column
539 ;;svn-locked-mark (elt svn-marks 2) ; 3rd column
540 ;;svn-added-with-history-mark (elt svn-marks 3); 4th column
541 ;;svn-switched-mark (elt svn-marks 4) ; 5th column
542 svn-update-mark (elt svn-marks 7)) ; 8th column
544 (when (eq svn-property-mark ?\ ) (setq svn-property-mark nil))
545 (when (eq svn-update-mark ?\ ) (setq svn-update-mark nil))
547 (skip-chars-forward " ")
549 ((looking-at "\\([-?]\\|[0-9]+\\) +\\([-?]\\|[0-9]+\\) +\\([^ ]+\\) *\\(.+\\)")
550 (setq local-rev (svn-parse-rev-num (match-string 1))
551 last-change-rev (svn-parse-rev-num (match-string 2))
552 author (match-string 3)
553 path (match-string 4)))
554 ((looking-at "\\(.*\\)")
555 (setq path (match-string 1)
558 author (if (eq svn-file-mark 88) "" "?"))) ;clear author of svn:externals dirs
560 (error "Unknown status line format")))
561 (unless path (setq path "."))
562 (setq ui-status (or (gethash path old-ui-information) (list user-mark user-elide)))
563 (setq svn-status-info (cons (list ui-status
572 (setq revision-width (max revision-width
573 (length (number-to-string local-rev))
574 (length (number-to-string last-change-rev))))
575 (setq author-width (max author-width (length author)))))
577 ;; With subversion 0.29.0 and above, `svn -u st' returns files in
578 ;; a random order (especially if we have a mixed revision wc)
579 (setq svn-status-default-column
580 (+ 6 revision-width revision-width author-width
581 (if svn-status-short-mod-flag-p 3 0)))
582 (setq svn-status-line-format (format " %%c%%c %%%ds %%%ds %%-%ds"
586 (setq svn-status-info (sort svn-status-info 'svn-status-sort-predicate)))))
588 ;;(string-lessp "." "%") => nil
589 ;(svn-status-sort-predicate '(t t t ".") '(t t t "%")) => t
590 (defun svn-status-sort-predicate (a b)
591 "Return t if A should appear before B in the *svn-status* buffer.
592 A and B must be line-info's."
593 (string-lessp (concat (svn-status-line-info->full-path a) "/")
594 (concat (svn-status-line-info->full-path b) "/")))
596 (defun svn-status-remove-temp-file-maybe ()
597 "Remove any (no longer required) temporary files created by psvn.el."
598 (when svn-status-temp-file-to-remove
599 (when (file-exists-p svn-status-temp-file-to-remove)
600 (delete-file svn-status-temp-file-to-remove))
601 (when (file-exists-p svn-status-temp-arg-file)
602 (delete-file svn-status-temp-arg-file))
603 (setq svn-status-temp-file-to-remove nil)))
605 (defun svn-status-remove-control-M ()
606 "Remove ^M at end of line in the whole buffer."
608 (let ((buffer-read-only nil))
611 (goto-char (point-min))
612 (while (re-search-forward "\r$" (point-max) t)
613 (replace-match "" nil nil))))))
616 ;;(easy-menu-add-item nil '("tools") ["SVN Status" svn-status t] "PCL-CVS")
617 (easy-menu-add-item nil '("tools") ["SVN Status" svn-status t])
618 (error (message "psvn: could not install menu")))
620 (defvar svn-status-mode-map () "Keymap used in `svn-status-mode' buffers.")
621 (defvar svn-status-mode-property-map ()
622 "Subkeymap used in `svn-status-mode' for property commands.")
624 (when (not svn-status-mode-map)
625 (setq svn-status-mode-map (make-sparse-keymap))
626 (suppress-keymap svn-status-mode-map)
627 ;; Don't use (kbd "<return>"); it's unreachable with GNU Emacs 21.3 on a TTY.
628 (define-key svn-status-mode-map (kbd "RET") 'svn-status-find-file-or-examine-directory)
629 (define-key svn-status-mode-map (kbd "^") 'svn-status-examine-parent)
630 (define-key svn-status-mode-map (kbd "s") 'svn-status-show-process-buffer)
631 (define-key svn-status-mode-map (kbd "f") 'svn-status-find-files)
632 (define-key svn-status-mode-map (kbd "o") 'svn-status-find-file-other-window)
633 (define-key svn-status-mode-map (kbd "v") 'svn-status-view-file-other-window)
634 (define-key svn-status-mode-map (kbd "e") 'svn-status-toggle-edit-cmd-flag)
635 (define-key svn-status-mode-map (kbd "g") 'svn-status-update)
636 (define-key svn-status-mode-map (kbd "q") 'svn-status-bury-buffer)
637 (define-key svn-status-mode-map (kbd "h") 'svn-status-use-history)
638 (define-key svn-status-mode-map (kbd "m") 'svn-status-set-user-mark)
639 (define-key svn-status-mode-map (kbd "u") 'svn-status-unset-user-mark)
640 ;; This matches a binding of `dired-unmark-all-files' in `dired-mode-map'
641 ;; of both GNU Emacs and XEmacs. It seems unreachable with XEmacs on
642 ;; TTY, but if that's a problem then its Dired needs fixing too.
643 ;; Or you could just use "*!".
644 (define-key svn-status-mode-map "\M-\C-?" 'svn-status-unset-all-usermarks)
645 ;; The key that normally deletes characters backwards should here
646 ;; instead unmark files backwards. In GNU Emacs, that would be (kbd
647 ;; "DEL") aka [?\177], but XEmacs treats those as [(delete)] and
648 ;; would bind a key that normally deletes forwards. [(backspace)]
649 ;; is unreachable with GNU Emacs on a tty. Try to recognize the
650 ;; dialect and act accordingly.
652 ;; XEmacs has a `delete-forward-p' function that checks the
653 ;; `delete-key-deletes-forward' option. We don't use those, for two
654 ;; reasons: psvn.el may be loaded before user customizations, and
655 ;; XEmacs allows simultaneous connections to multiple devices with
656 ;; different keyboards.
657 (define-key svn-status-mode-map
658 (if (member (kbd "DEL") '([(delete)] [delete]))
659 [(backspace)] ; XEmacs
660 (kbd "DEL")) ; GNU Emacs
661 'svn-status-unset-user-mark-backwards)
662 (define-key svn-status-mode-map (kbd "$") 'svn-status-toggle-elide)
663 (define-key svn-status-mode-map (kbd ".") 'svn-status-goto-root-or-return)
664 (define-key svn-status-mode-map (kbd "I") 'svn-status-parse-info)
665 (define-key svn-status-mode-map (kbd "?") 'svn-status-toggle-hide-unknown)
666 (define-key svn-status-mode-map (kbd "_") 'svn-status-toggle-hide-unmodified)
667 (define-key svn-status-mode-map (kbd "a") 'svn-status-add-file)
668 (define-key svn-status-mode-map (kbd "A") 'svn-status-add-file-recursively)
669 (define-key svn-status-mode-map (kbd "+") 'svn-status-make-directory)
670 (define-key svn-status-mode-map (kbd "R") 'svn-status-mv)
671 (define-key svn-status-mode-map (kbd "D") 'svn-status-rm)
672 (define-key svn-status-mode-map (kbd "c") 'svn-status-commit-file)
673 (define-key svn-status-mode-map (kbd "M-c") 'svn-status-cleanup)
674 (define-key svn-status-mode-map (kbd "U") 'svn-status-update-cmd)
675 (define-key svn-status-mode-map (kbd "r") 'svn-status-revert)
676 (define-key svn-status-mode-map (kbd "l") 'svn-status-show-svn-log)
677 (define-key svn-status-mode-map (kbd "i") 'svn-status-info)
678 (define-key svn-status-mode-map (kbd "b") 'svn-status-blame)
679 (define-key svn-status-mode-map (kbd "=") 'svn-status-show-svn-diff)
680 ;; [(control ?=)] is unreachable on TTY, but you can use "*u" instead.
681 ;; (Is the "u" mnemonic for something?)
682 (define-key svn-status-mode-map (kbd "C-=") 'svn-status-show-svn-diff-for-marked-files)
683 (define-key svn-status-mode-map (kbd "~") 'svn-status-get-specific-revision)
684 (define-key svn-status-mode-map (kbd "E") 'svn-status-ediff-with-revision)
685 (define-key svn-status-mode-map (kbd "C-n") 'svn-status-next-line)
686 (define-key svn-status-mode-map (kbd "C-p") 'svn-status-previous-line)
687 (define-key svn-status-mode-map (kbd "<down>") 'svn-status-next-line)
688 (define-key svn-status-mode-map (kbd "<up>") 'svn-status-previous-line)
689 (setq svn-status-mode-mark-map (make-sparse-keymap))
690 (define-key svn-status-mode-map (kbd "*") svn-status-mode-mark-map)
691 (define-key svn-status-mode-mark-map (kbd "!") 'svn-status-unset-all-usermarks)
692 (define-key svn-status-mode-mark-map (kbd "?") 'svn-status-mark-unknown)
693 (define-key svn-status-mode-mark-map (kbd "A") 'svn-status-mark-added)
694 (define-key svn-status-mode-mark-map (kbd "M") 'svn-status-mark-modified)
695 (define-key svn-status-mode-mark-map (kbd "V") 'svn-status-resolved)
696 (define-key svn-status-mode-mark-map (kbd "u") 'svn-status-show-svn-diff-for-marked-files))
697 (when (not svn-status-mode-property-map)
698 (setq svn-status-mode-property-map (make-sparse-keymap))
699 (define-key svn-status-mode-property-map (kbd "l") 'svn-status-property-list)
700 (define-key svn-status-mode-property-map (kbd "s") 'svn-status-property-set)
701 (define-key svn-status-mode-property-map (kbd "d") 'svn-status-property-delete)
702 (define-key svn-status-mode-property-map (kbd "e") 'svn-status-property-edit-one-entry)
703 (define-key svn-status-mode-property-map (kbd "i") 'svn-status-property-ignore-file)
704 (define-key svn-status-mode-property-map (kbd "I") 'svn-status-property-ignore-file-extension)
705 ;; XEmacs 21.4.15 on TTY (vt420) converts `C-i' to `TAB',
706 ;; which [(control ?i)] won't match. Handle it separately.
707 ;; On GNU Emacs, the following two forms bind the same key,
708 ;; reducing clutter in `where-is'.
709 (define-key svn-status-mode-property-map [(control ?i)] 'svn-status-property-edit-svn-ignore)
710 (define-key svn-status-mode-property-map (kbd "TAB") 'svn-status-property-edit-svn-ignore)
711 (define-key svn-status-mode-property-map (kbd "k") 'svn-status-property-set-keyword-list)
712 (define-key svn-status-mode-property-map (kbd "y") 'svn-status-property-set-eol-style)
713 (define-key svn-status-mode-property-map (kbd "p") 'svn-status-property-parse)
714 ;; TODO: Why is `svn-status-select-line' in `svn-status-mode-property-map'?
715 (define-key svn-status-mode-property-map (kbd "RET") 'svn-status-select-line)
716 (define-key svn-status-mode-map (kbd "P") svn-status-mode-property-map))
719 (easy-menu-define svn-status-mode-menu svn-status-mode-map
720 "'svn-status-mode' menu"
722 ["svn status" svn-status-update t]
723 ["svn update" svn-status-update-cmd t]
724 ["svn commit" svn-status-commit-file t]
725 ["svn log" svn-status-show-svn-log t]
726 ["svn info" svn-status-info t]
727 ["svn blame" svn-status-blame t]
729 ["svn diff current file" svn-status-show-svn-diff t]
730 ["svn diff marked files" svn-status-show-svn-diff-for-marked-files t]
731 ["svn ediff current file" svn-status-ediff-with-revision t]
733 ["svn cat ..." svn-status-get-specific-revision t]
734 ["svn add" svn-status-add-file t]
735 ["svn mkdir..." svn-status-make-directory t]
736 ["svn mv..." svn-status-mv t]
737 ["svn rm..." svn-status-rm t]
738 ["Up Directory" svn-status-examine-parent t]
739 ["Elide Directory" svn-status-toggle-elide t]
740 ["svn revert" svn-status-revert t]
741 ["svn resolved" svn-status-resolved t]
742 ["svn cleanup" svn-status-cleanup t]
743 ["Show Process Buffer" svn-status-show-process-buffer t]
745 ["svn proplist" svn-status-property-list t]
746 ["Set Multiple Properties..." svn-status-property-set t]
747 ["Edit One Property..." svn-status-property-edit-one-entry t]
748 ["svn propdel..." svn-status-property-delete t]
750 ["svn:ignore File..." svn-status-property-ignore-file t]
751 ["svn:ignore File Extension..." svn-status-property-ignore-file-extension t]
752 ["Edit svn:ignore Property" svn-status-property-edit-svn-ignore t]
754 ["Set svn:keywords List" svn-status-property-set-keyword-list t]
755 ["Set svn:eol-style" svn-status-property-set-eol-style t]
758 ["Edit Next SVN Cmd Line" svn-status-toggle-edit-cmd-flag t]
759 ["Work Directory History..." svn-status-use-history t]
760 ["Mark" svn-status-set-user-mark t]
761 ["Unmark" svn-status-unset-user-mark t]
763 ["Unmark all" svn-status-unset-all-usermarks t]
764 ["Mark/Unmark unknown" svn-status-mark-unknown t]
765 ["Mark/Unmark added" svn-status-mark-added t]
766 ["Mark/Unmark modified" svn-status-mark-modified t]
768 ["Hide Unknown" svn-status-toggle-hide-unknown
769 :style toggle :selected svn-status-hide-unknown]
770 ["Hide Unmodified" svn-status-toggle-hide-unmodified
771 :style toggle :selected svn-status-hide-unmodified]
774 (defun svn-status-mode ()
775 "Major mode used by psvn.el to process the output of \"svn status\".
777 psvn.el is an interface for the revision control tool subversion
778 \(see http://subversion.tigris.org).
779 psvn.el provides a similar interface for subversion as pcl-cvs does for cvs.
780 At the moment the following commands are implemented:
781 M-x svn-status: run 'svn -status -v'
782 and show the result in the *svn-status* buffer, this buffer uses the
783 svn-status mode. In this mode the following keys are defined:
784 \\{svn-status-mode-map}"
786 (kill-all-local-variables)
788 (use-local-map svn-status-mode-map)
789 (easy-menu-add svn-status-mode-menu)
791 (setq major-mode 'svn-status-mode)
792 (setq mode-name "svn-status")
793 (setq mode-line-process 'svn-status-mode-line-process)
794 (let ((view-read-only nil))
795 (toggle-read-only 1)))
797 (defun svn-status-update-mode-line ()
798 (setq svn-status-mode-line-process
799 (concat svn-status-mode-line-process-edit-flag svn-status-mode-line-process-status))
800 (force-mode-line-update))
802 (defun svn-status-bury-buffer (arg)
803 "Bury the *svn-status* buffer.
804 When called with a prefix argument, switch back to the window configuration that was
805 in use before `svn-status' was called."
808 (when svn-status-initial-window-configuration
809 (set-window-configuration svn-status-initial-window-configuration)))
811 (let ((bl '("*svn-log-edit*" "*svn-property-edit*" "*svn-process*")))
813 (when (get-buffer (car bl))
814 (bury-buffer (car bl)))
816 (when (string= (buffer-name) "*svn-status*")
819 (defun svn-status-find-files ()
820 "Open selected file(s) for editing.
821 See `svn-status-marked-files' for what counts as selected."
823 (let ((fnames (mapcar 'svn-status-line-info->full-path (svn-status-marked-files))))
824 (mapc 'find-file fnames)))
827 (defun svn-status-find-file-other-window ()
828 "Open the file in the other window for editing."
830 (find-file-other-window (svn-status-line-info->filename
831 (svn-status-get-line-information))))
833 (defun svn-status-view-file-other-window ()
834 "Open the file in the other window for viewing."
836 (view-file-other-window (svn-status-line-info->filename
837 (svn-status-get-line-information))))
839 (defun svn-status-find-file-or-examine-directory ()
840 "If point is on a directory, run `svn-status' on that directory.
841 Otherwise run `find-file'."
843 (let ((line-info (svn-status-get-line-information)))
844 (if (svn-status-line-info->directory-p line-info)
845 (svn-status (svn-status-line-info->full-path line-info))
846 (find-file (svn-status-line-info->filename line-info)))))
848 (defun svn-status-examine-parent ()
849 "Run `svn-status' on the parent of the current directory."
851 (svn-status (expand-file-name "../")))
853 (defun svn-status-line-info->ui-status (line-info) (nth 0 line-info))
855 (defun svn-status-line-info->has-usermark (line-info) (nth 0 (nth 0 line-info)))
856 (defun svn-status-line-info->user-elide (line-info) (nth 1 (nth 0 line-info)))
858 (defun svn-status-line-info->filemark (line-info) (nth 1 line-info))
859 (defun svn-status-line-info->propmark (line-info) (nth 2 line-info))
860 (defun svn-status-line-info->filename (line-info) (nth 3 line-info))
861 (defun svn-status-line-info->filename-nondirectory (line-info)
862 (file-name-nondirectory (svn-status-line-info->filename line-info)))
863 (defun svn-status-line-info->localrev (line-info)
864 (if (>= (nth 4 line-info) 0)
867 (defun svn-status-line-info->lastchangerev (line-info)
868 "Return the last revision in which LINE-INFO was modified."
869 (if (>= (nth 5 line-info) 0)
872 (defun svn-status-line-info->author (line-info) (nth 6 line-info))
873 (defun svn-status-line-info->modified-external (line-info) (nth 7 line-info))
875 (defun svn-status-line-info->is-visiblep (line-info)
876 (not (or (svn-status-line-info->hide-because-unknown line-info)
877 (svn-status-line-info->hide-because-unmodified line-info)
878 (svn-status-line-info->hide-because-user-elide line-info))))
880 (defun svn-status-line-info->hide-because-unknown (line-info)
881 (and svn-status-hide-unknown
882 (eq (svn-status-line-info->filemark line-info) ??)))
884 (defun svn-status-line-info->hide-because-unmodified (line-info)
885 ;;(message " %S %S %S %S - %s" svn-status-hide-unmodified (svn-status-line-info->propmark line-info) ?_
886 ;; (svn-status-line-info->filemark line-info) (svn-status-line-info->filename line-info))
887 (and svn-status-hide-unmodified
888 (and (or (eq (svn-status-line-info->filemark line-info) ?_)
889 (eq (svn-status-line-info->filemark line-info) ? ))
890 (or (eq (svn-status-line-info->propmark line-info) ?_)
891 (eq (svn-status-line-info->propmark line-info) ? )
892 (eq (svn-status-line-info->propmark line-info) nil)))))
894 (defun svn-status-line-info->hide-because-user-elide (line-info)
895 (eq (svn-status-line-info->user-elide line-info) t))
897 (defun svn-status-line-info->show-user-elide-continuation (line-info)
898 (eq (svn-status-line-info->user-elide line-info) 'directory))
900 ;; modify the line-info
901 (defun svn-status-line-info->set-filemark (line-info value)
902 (setcar (nthcdr 1 line-info) value))
904 (defun svn-status-toggle-elide ()
906 (let ((st-info svn-status-info)
908 (test (svn-status-line-info->filename (svn-status-get-line-information)))
913 (when (string= test ".")
915 (setq len-test (length test))
917 (setq fname (svn-status-line-info->filename (car st-info)))
918 (setq len-fname (length fname))
919 (when (and (>= len-fname len-test)
920 (string= (substring fname 0 len-test) test))
921 ;;(message "elide: %s %s" fname (svn-status-line-info->user-elide (car st-info)))
922 (setq elide-mark new-elide-mark)
923 (when (or (string= fname ".")
924 (and (= len-fname len-test) (svn-status-line-info->directory-p (car st-info))))
925 (message "Elide directory %s and all its files." fname)
926 (setq new-elide-mark (not (svn-status-line-info->user-elide (car st-info))))
927 (setq elide-mark (if new-elide-mark 'directory nil)))
928 (setcar (nthcdr 1 (svn-status-line-info->ui-status (car st-info))) elide-mark))
929 (setq st-info (cdr st-info))))
930 (svn-status-update-buffer))
933 (defun svn-status-line-info->directory-p (line-info)
934 "Return t if LINE-INFO refers to a directory, nil otherwise.
935 Symbolic links to directories count as directories (see `file-directory-p')."
936 (file-directory-p (svn-status-line-info->filename line-info)))
938 (defun svn-status-line-info->full-path (line-info)
939 "Return the full path of the file represented by LINE-INFO."
941 (svn-status-line-info->filename line-info)))
943 ;;Not convinced that this is the fastest way, but...
944 (defun svn-status-count-/ (string)
945 "Return number of \"/\"'s in STRING."
948 (while (setq last (string-match "/" string (1+ last)))
952 (defun svn-insert-line-in-status-buffer (line-info)
953 "Format LINE-INFO and insert the result in the current buffer."
954 (let ((usermark (if (svn-status-line-info->has-usermark line-info) "*" " "))
955 (external (if (svn-status-line-info->modified-external line-info)
956 (svn-add-face (if svn-status-short-mod-flag-p
958 " (modified external)")
959 'svn-status-modified-external-face)
960 (if svn-status-short-mod-flag-p " " "")))
961 ;; To add indentation based on the
962 ;; directory that the file is in, we just insert 2*(number of "/" in
963 ;; filename) spaces, which is rather hacky (but works)!
964 (filename (svn-status-choose-face-to-add
965 (svn-status-line-info->directory-p line-info)
967 (* 2 (svn-status-count-/
968 (svn-status-line-info->filename line-info)))
970 (if svn-status-hide-unmodified
971 (svn-status-line-info->filename line-info)
972 (svn-status-line-info->filename-nondirectory line-info)))
973 'svn-status-directory-face
974 'svn-status-filename-face))
975 (elide-hint (if (svn-status-line-info->show-user-elide-continuation line-info) " ..." "")))
976 (insert (svn-status-maybe-add-face
977 (svn-status-line-info->has-usermark line-info)
979 (format svn-status-line-format
980 (svn-status-line-info->filemark line-info)
981 (or (svn-status-line-info->propmark line-info) ? )
982 (or (svn-status-line-info->localrev line-info) "")
983 (or (svn-status-line-info->lastchangerev line-info) "")
984 (svn-status-line-info->author line-info)))
985 'svn-status-marked-face)
986 (if svn-status-short-mod-flag-p external filename)
987 (if svn-status-short-mod-flag-p filename external)
991 (defun svn-status-update-buffer ()
993 ;(message (format "buffer-name: %s" (buffer-name)))
994 (unless (string= (buffer-name) "*svn-status*")
995 (delete-other-windows)
996 (split-window-vertically)
997 (switch-to-buffer "*svn-status*"))
999 (let ((st-info svn-status-info)
1000 (buffer-read-only nil)
1003 (unmodified-count 0)
1006 (fname (svn-status-line-info->filename (svn-status-get-line-information)))
1008 (column (current-column)))
1009 (delete-region (point-min) (point-max))
1011 ;; Insert all files and directories
1013 (setq start-pos (point))
1014 (cond ((svn-status-line-info->has-usermark (car st-info))
1015 ;; Show a marked file always
1016 (svn-insert-line-in-status-buffer (car st-info)))
1017 ((svn-status-line-info->hide-because-user-elide (car st-info))
1018 );(message "user wanted to hide %s" (svn-status-line-info->filename (car st-info))))
1019 ((svn-status-line-info->hide-because-unknown (car st-info))
1020 (setq unknown-count (+ unknown-count 1)))
1021 ((svn-status-line-info->hide-because-unmodified (car st-info))
1022 (setq unmodified-count (+ unmodified-count 1)))
1024 (svn-insert-line-in-status-buffer (car st-info))))
1025 (when (svn-status-line-info->has-usermark (car st-info))
1026 (setq marked-count (+ marked-count 1)))
1027 (setq overlay (make-overlay start-pos (point)))
1028 (overlay-put overlay 'svn-info (car st-info))
1029 (setq st-info (cdr st-info)))
1030 ;; Insert status information at the buffer beginning
1031 (goto-char (point-min))
1032 (insert (format "svn status for directory %s%s\n"
1034 (if svn-status-head-revision (format " (status against revision: %s)"
1035 svn-status-head-revision)
1037 (when svn-status-base-info
1038 (insert (concat "Repository: " (svn-status-base-info->url) "\n")))
1039 (when svn-status-hide-unknown
1041 (format "%d Unknown files are hidden - press ? to toggle hiding\n"
1043 (when svn-status-hide-unmodified
1045 (format "%d Unmodified files are hidden - press _ to toggle hiding\n"
1047 (insert (format "%d files marked\n" marked-count))
1048 (setq svn-start-of-file-list-line-number (+ (count-lines (point-min) (point)) 1))
1051 (goto-char fname-pos)
1052 (svn-status-goto-file-name fname)
1053 (goto-char (+ column (point-at-bol))))
1054 (goto-char (+ (next-overlay-change (point-min)) svn-status-default-column)))))
1056 (defun svn-status-parse-info (arg)
1057 "Parse the svn info output for the base directory.
1058 Show the repository url after this call in the *svn-status* buffer.
1059 When called with the prefix argument 0, reset the information to nil.
1060 This hides the repository information again."
1063 (setq svn-status-base-info nil)
1064 (svn-run-svn nil t 'parse-info "info" ".")
1065 (svn-status-parse-info-result))
1066 (svn-status-update-buffer))
1068 (defun svn-status-parse-info-result ()
1071 (set-buffer "*svn-process*")
1072 (goto-char (point-min))
1073 (search-forward "Url: ")
1074 (setq url (buffer-substring-no-properties (point) (point-at-eol))))
1075 (setq svn-status-base-info `((url ,url)))))
1077 (defun svn-status-base-info->url ()
1078 (if svn-status-base-info
1079 (cadr (assoc 'url svn-status-base-info))
1082 (defun svn-status-toggle-edit-cmd-flag (&optional reset)
1084 (cond ((or reset (eq svn-status-edit-svn-command 'sticky))
1085 (setq svn-status-edit-svn-command nil))
1086 ((eq svn-status-edit-svn-command nil)
1087 (setq svn-status-edit-svn-command t))
1088 ((eq svn-status-edit-svn-command t)
1089 (setq svn-status-edit-svn-command 'sticky)))
1090 (cond ((eq svn-status-edit-svn-command t)
1091 (setq svn-status-mode-line-process-edit-flag " EditCmd"))
1092 ((eq svn-status-edit-svn-command 'sticky)
1093 (setq svn-status-mode-line-process-edit-flag " EditCmd#"))
1095 (setq svn-status-mode-line-process-edit-flag "")))
1096 (svn-status-update-mode-line))
1098 (defun svn-status-goto-root-or-return ()
1099 "Bounce point between the root (\".\") and the current line."
1101 (if (string= (svn-status-line-info->filename (svn-status-get-line-information)) ".")
1102 (when svn-status-root-return-info
1103 (svn-status-goto-file-name
1104 (svn-status-line-info->filename svn-status-root-return-info)))
1105 (setq svn-status-root-return-info (svn-status-get-line-information))
1106 (svn-status-goto-file-name ".")))
1108 (defun svn-status-next-line (nr-of-lines)
1110 (next-line nr-of-lines)
1111 (when (svn-status-get-line-information)
1112 (goto-char (+ (point-at-bol) svn-status-default-column))))
1114 (defun svn-status-previous-line (nr-of-lines)
1116 (previous-line nr-of-lines)
1117 (when (svn-status-get-line-information)
1118 (goto-char (+ (point-at-bol) svn-status-default-column))))
1120 (defun svn-status-update (&optional arg)
1121 "Run 'svn status -v'.
1122 When called with a prefix argument run 'svn status -vu'."
1124 (unless (interactive-p)
1126 (set-buffer "*svn-process*")
1127 (setq svn-status-update-previous-process-output (buffer-substring (point-min) (point-max)))))
1128 (svn-status default-directory arg))
1130 (defun svn-status-get-line-information ()
1131 "Find out about the file under point.
1132 The result may be parsed with the various `svn-status-line-info->...' functions."
1133 (let ((overlay (car (overlays-at (point)))))
1135 (overlay-get overlay 'svn-info))))
1137 (defun svn-status-get-file-list (use-marked-files)
1138 "Get either the marked files or the files, where the cursor is on."
1139 (if use-marked-files
1140 (svn-status-marked-files)
1141 (list (svn-status-get-line-information))))
1143 (defun svn-status-get-file-list-names (use-marked-files)
1144 (mapcar 'svn-status-line-info->filename (svn-status-get-file-list use-marked-files)))
1146 (defun svn-status-select-line ()
1148 (let ((info (svn-status-get-line-information)))
1150 (message "%S %S %S" info (svn-status-line-info->hide-because-unknown info)
1151 (svn-status-line-info->hide-because-unmodified info))
1152 (message "No file on this line"))))
1154 (defun svn-status-directory-containing-point (allow-self)
1155 "Find the (full path of) directory containing the file under point.
1157 If ALLOW-SELF and the file is a directory, return that directory,
1158 otherwise return the directory containing the file under point."
1159 ;;the first `or' below is because s-s-g-l-i returns `nil' if
1160 ;;point was outside the file list, but we need
1161 ;;s-s-l-i->f to return a string to add to `default-directory'.
1162 (let ((line-info (or (svn-status-get-line-information)
1163 '(nil nil nil ""))))
1164 (file-name-as-directory
1166 (if (and allow-self (svn-status-line-info->directory-p line-info))
1167 (svn-status-line-info->filename line-info)
1168 ;;The next `or' is because (file-name-directory "file") returns nil
1169 (or (file-name-directory (svn-status-line-info->filename line-info))
1172 (defun svn-status-set-user-mark (arg)
1173 "Set a user mark on the current file or directory.
1174 If the cursor is on a file this file is marked and the cursor advances to the next line.
1175 If the cursor is on a directory all files in this directory are marked.
1177 If this function is called with a prefix argument, only the current line is
1178 marked, even if it is a directory."
1180 (let ((info (svn-status-get-line-information)))
1183 (svn-status-apply-usermark t arg)
1184 (svn-status-next-line 1))
1185 (message "No file on this line - cannot set a mark"))))
1187 (defun svn-status-unset-user-mark (arg)
1188 "Remove a user mark on the current file or directory.
1189 If the cursor is on a file, this file is unmarked and the cursor advances to the next line.
1190 If the cursor is on a directory, all files in this directory are unmarked.
1192 If this function is called with a prefix argument, only the current line is
1193 unmarked, even if is a directory."
1195 (let ((info (svn-status-get-line-information)))
1198 (svn-status-apply-usermark nil arg)
1199 (svn-status-next-line 1))
1200 (message "No file on this line - cannot unset a mark"))))
1202 (defun svn-status-unset-user-mark-backwards ()
1203 "Remove a user mark from the previous file.
1204 Then move to that line."
1205 ;; This is consistent with `dired-unmark-backward' and
1206 ;; `cvs-mode-unmark-up'.
1208 (let ((info (save-excursion
1209 (svn-status-next-line -1)
1210 (svn-status-get-line-information))))
1213 (svn-status-next-line -1)
1214 (svn-status-apply-usermark nil t))
1215 (message "No file on previous line - cannot unset a mark"))))
1217 (defun svn-status-apply-usermark (set-mark only-this-line)
1218 "Do the work for the various marking/unmarking functions."
1219 (let* ((st-info svn-status-info)
1220 (line-info (svn-status-get-line-information))
1221 (file-name (svn-status-line-info->filename line-info))
1222 (sub-file-regexp (concat "^" (regexp-quote
1223 (file-name-as-directory file-name))))
1224 (newcursorpos-fname)
1226 (current-line svn-start-of-file-list-line-number))
1228 (when (svn-status-line-info->is-visiblep (car st-info))
1229 (setq current-line (1+ current-line)))
1230 (setq i-fname (svn-status-line-info->filename (car st-info)))
1231 (when (or (string= file-name i-fname)
1232 (string-match sub-file-regexp i-fname))
1233 (when (svn-status-line-info->is-visiblep (car st-info))
1234 (when (or (not only-this-line) (string= file-name i-fname))
1235 (setq newcursorpos-fname i-fname)
1237 (message "marking: %s" i-fname)
1238 (message "unmarking: %s" i-fname))
1239 ;;(message "ui-status: %S" (svn-status-line-info->ui-status (car st-info)))
1240 (setcar (svn-status-line-info->ui-status (car st-info)) set-mark)
1242 (let ((buffer-read-only nil))
1243 (goto-line current-line)
1244 (delete-region (point-at-bol) (point-at-eol))
1245 (svn-insert-line-in-status-buffer (car st-info))
1246 (delete-char 1))))))
1247 (setq st-info (cdr st-info)))
1248 ;;(svn-status-update-buffer)
1249 (svn-status-goto-file-name newcursorpos-fname)))
1251 (defun svn-status-apply-usermark-checked (check-function set-mark)
1252 "Mark or unmark files, whether a given function returns t.
1253 The function is called with the line information. Therefore the svnstatus-line-info->* functions can be
1255 (let ((st-info svn-status-info))
1257 (when (apply check-function (list (car st-info)))
1259 (when (not (svn-status-line-info->has-usermark (car st-info)))
1260 (message "marking: %s" (svn-status-line-info->filename (car st-info))))
1261 (when (svn-status-line-info->has-usermark (car st-info))
1262 (message "unmarking: %s" (svn-status-line-info->filename (car st-info)))))
1263 (setcar (svn-status-line-info->ui-status (car st-info)) set-mark))
1264 (setq st-info (cdr st-info)))
1265 (svn-status-update-buffer)))
1267 (defun svn-status-mark-unknown (arg)
1268 "Mark all unknown files.
1269 These are the files marked with '?' in the *svn-status* buffer.
1270 If the function is called with a prefix arg, unmark all these files."
1272 (svn-status-apply-usermark-checked '(lambda (info) (eq (svn-status-line-info->filemark info) ??)) (not arg)))
1274 (defun svn-status-mark-added (arg)
1275 "Mark all added files.
1276 These are the files marked with 'A' in the *svn-status* buffer.
1277 If the function is called with a prefix arg, unmark all these files."
1279 (svn-status-apply-usermark-checked '(lambda (info) (eq (svn-status-line-info->filemark info) ?A)) (not arg)))
1281 (defun svn-status-mark-modified (arg)
1282 "Mark all modified files.
1283 These are the files marked with 'M' in the *svn-status* buffer.
1284 If the function is called with a prefix arg, unmark all these files."
1286 (svn-status-apply-usermark-checked '(lambda (info) (eq (svn-status-line-info->filemark info) ?M)) (not arg)))
1288 (defun svn-status-unset-all-usermarks ()
1290 (svn-status-apply-usermark-checked '(lambda (info) t) nil))
1292 (defun svn-status-toggle-hide-unknown ()
1294 (setq svn-status-hide-unknown (not svn-status-hide-unknown))
1295 (svn-status-update-buffer))
1297 (defun svn-status-toggle-hide-unmodified ()
1299 (setq svn-status-hide-unmodified (not svn-status-hide-unmodified))
1300 (svn-status-update-buffer))
1302 (defun svn-status-goto-file-name (name)
1303 ;; (message "svn-status-goto-file-name: %s %d" name (point))
1304 (let ((start-pos (point)))
1305 (goto-char (point-min))
1306 (while (< (point) (point-max))
1307 (goto-char (next-overlay-change (point)))
1308 (when (string= name (svn-status-line-info->filename
1309 (svn-status-get-line-information)))
1310 (setq start-pos (+ (point) svn-status-default-column))))
1311 (goto-char start-pos)))
1313 (defun svn-status-find-info-for-file-name (name)
1314 (let* ((st-info svn-status-info)
1317 (when (string= name (svn-status-line-info->filename (car st-info)))
1318 (setq info (car st-info))
1319 (setq st-info nil)) ; terminate loop
1320 (setq st-info (cdr st-info)))
1323 (defun svn-status-marked-files ()
1324 "Return all files marked by `svn-status-set-user-mark',
1325 or (if no files were marked) the file under point."
1326 (let* ((st-info svn-status-info)
1329 (when (svn-status-line-info->has-usermark (car st-info))
1330 (setq file-list (append file-list (list (car st-info)))))
1331 (setq st-info (cdr st-info)))
1333 (if (svn-status-get-line-information)
1334 (list (svn-status-get-line-information))
1337 (defun svn-status-marked-file-names ()
1338 (mapcar 'svn-status-line-info->filename (svn-status-marked-files)))
1340 (defun svn-status-ui-information-hash-table ()
1341 (let ((st-info svn-status-info)
1342 (svn-status-ui-information (make-hash-table :test 'equal)))
1344 (puthash (svn-status-line-info->filename (car st-info))
1345 (svn-status-line-info->ui-status (car st-info))
1346 svn-status-ui-information)
1347 (setq st-info (cdr st-info)))
1348 svn-status-ui-information))
1351 (defun svn-status-create-arg-file (file-name prefix file-info-list postfix)
1352 (with-temp-file file-name
1354 (let ((st-info file-info-list))
1356 (insert (svn-status-line-info->filename (car st-info)))
1358 (setq st-info (cdr st-info)))
1362 (defun svn-status-show-process-buffer-internal (&optional scroll-to-top)
1363 (when (eq (current-buffer) "*svn-status*")
1364 (delete-other-windows))
1365 (pop-to-buffer "*svn-process*")
1366 (when svn-status-wash-control-M-in-process-buffers
1367 (svn-status-remove-control-M))
1369 (goto-char (point-min)))
1372 (defun svn-status-show-svn-log (arg)
1373 "Run `svn log' on selected files.
1374 When called with a prefix argument add the following command switches:
1375 no prefix: use whatever is in the string `svn-status-default-log-arguments'
1376 prefix argument of -1: use no arguments
1377 prefix argument of 0: use the -q switch (quiet)
1378 other prefix arguments: use the -v switch (verbose)
1380 See `svn-status-marked-files' for what counts as selected."
1382 (let ((switch (cond ((eq arg 0) "-q")
1385 (t svn-status-default-log-arguments))))
1386 ;;(message "show log info for: %S" (svn-status-marked-files))
1387 (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "")
1388 (if (> (length switch) 0)
1389 (svn-run-svn t t 'log "log" "--targets" svn-status-temp-arg-file switch)
1390 (svn-run-svn t t 'log "log" "--targets" svn-status-temp-arg-file))
1392 (set-buffer "*svn-process*")
1393 (svn-log-view-mode))))
1395 (defun svn-status-info ()
1396 "Run `svn info' on all selected files.
1397 See `svn-status-marked-files' for what counts as selected."
1399 (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "")
1400 (svn-run-svn t t 'info "info" "--targets" svn-status-temp-arg-file))
1402 ;; Todo: add possiblity to specify the revision
1403 (defun svn-status-blame ()
1404 "Run `svn blame' on the current file."
1406 ;;(svn-run-svn t t 'blame "blame" "-r" "BASE" (svn-status-line-info->filename (svn-status-get-line-information))))
1407 (svn-run-svn t t 'blame "blame" (svn-status-line-info->filename (svn-status-get-line-information))))
1409 (defun svn-status-show-svn-diff (arg)
1410 "Run `svn diff' on the current file.
1411 If there is a newer revision in the repository, the diff is done against HEAD, otherwise
1412 compare the working copy with BASE.
1413 If ARG then prompt for revision to diff against."
1415 (svn-status-show-svn-diff-internal arg nil))
1417 (defun svn-status-show-svn-diff-for-marked-files (arg)
1418 "Run `svn diff' on all selected files.
1419 See `svn-status-marked-files' for what counts as selected.
1420 If ARG then prompt for revision to diff against, else compare working copy with BASE."
1422 (svn-status-show-svn-diff-internal arg t))
1424 (defun svn-status-show-svn-diff-internal (arg &optional use-all-marked-files)
1425 (let* ((fl (if use-all-marked-files
1426 (svn-status-marked-files)
1427 (list (svn-status-get-line-information))))
1430 (svn-status-read-revision-string "Diff with files for version: " "PREV")
1431 (if use-all-marked-files
1433 (if (svn-status-line-info->modified-external (car fl)) "HEAD" "BASE")))))
1435 (svn-run-svn nil clear-buf 'diff "diff" "-r" revision (svn-status-line-info->filename (car fl)))
1436 (setq clear-buf nil)
1437 (setq fl (cdr fl))))
1438 (svn-status-show-process-buffer-internal t)
1440 (set-buffer "*svn-process*")
1442 (font-lock-fontify-buffer)))
1444 (defun svn-status-show-process-buffer ()
1446 (svn-status-show-process-buffer-internal))
1448 (defun svn-status-add-file-recursively (arg)
1449 "Run `svn add' on all selected files.
1450 When a directory is added, add files recursively.
1451 See `svn-status-marked-files' for what counts as selected.
1452 When this function is called with a prefix argument, use the actual file instead."
1454 (message "adding: %S" (svn-status-get-file-list-names (not arg)))
1455 (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-get-file-list (not arg)) "")
1456 (svn-run-svn t t 'add "add" "--targets" svn-status-temp-arg-file))
1458 (defun svn-status-add-file (arg)
1459 "Run `svn add' on all selected files.
1460 When a directory is added, don't add the files of the directory
1461 (svn add --non-recursive <file-list> is called).
1462 See `svn-status-marked-files' for what counts as selected.
1463 When this function is called with a prefix argument, use the actual file instead."
1465 (message "adding: %S" (svn-status-get-file-list-names (not arg)))
1466 (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-get-file-list (not arg)) "")
1467 (svn-run-svn t t 'add "add" "--non-recursive" "--targets" svn-status-temp-arg-file))
1469 (defun svn-status-make-directory (dir)
1470 "Run `svn mkdir DIR'."
1471 ;; TODO: Allow entering a URI interactively.
1472 ;; Currently, `read-file-name' corrupts it.
1473 (interactive (list (read-file-name "Make directory: "
1474 (svn-status-directory-containing-point t))))
1475 (unless (string-match "^[^:/]+://" dir) ; Is it a URI?
1476 (setq dir (file-relative-name dir)))
1477 (svn-run-svn t t 'mkdir "mkdir" "--" dir))
1479 ;;TODO: write a svn-status-cp similar to this---maybe a common
1480 ;;function to do both?
1481 (defun svn-status-mv ()
1482 "Prompt for a destination, and `svn mv' selected files there.
1483 See `svn-status-marked-files' for what counts as `selected'.
1485 If one file was selected then the destination DEST should be a
1486 filename to rename the selected file to, or a directory to move the
1487 file into; if multiple files were selected then DEST should be a
1488 directory to move the selected files into.
1490 The default DEST is the directory containing point.
1492 BUG: If we've marked some directory containging a file as well as the
1493 file itself, then we should just mv the directory, but this implementation
1494 doesn't check for that.
1495 SOLUTION: for each dir, umark all its contents (but not the dir
1496 itself) before running mv."
1498 (let* ((marked-files (svn-status-marked-files))
1499 (num-of-files (length marked-files))
1502 (if (= 1 num-of-files)
1503 ;; one file to rename, prompt for new name, or directory to move the
1505 (setq dest (read-file-name (format "Rename %s to: "
1506 (svn-status-line-info->filename (car marked-files)))
1507 (svn-status-directory-containing-point t)))
1508 ;;multiple files selected, so prompt for existing directory to mv them into.
1509 (setq dest (read-directory-name (format "Move %d files to directory: " num-of-files)
1510 (svn-status-directory-containing-point t) nil t))
1511 (unless (file-directory-p dest)
1512 (error "%s is not a directory" dest)))
1513 (when (string= dest "")
1514 (error "No destination entered; no files moved"))
1515 (unless (string-match "^[^:/]+://" dest) ; Is it a URI?
1516 (setq dest (file-relative-name dest)))
1518 ;;do the move: svn mv only lets us move things once at a time, so
1519 ;;we need to run svn mv once for each file (hence second arg to
1520 ;;svn-run-svn is nil.)
1522 ;;TODO: before doing any moving, For every marked directory,
1523 ;;ensure none of its contents are also marked, since we dont want
1524 ;;to move both file *and* its parent...
1525 ;; what about hidden files?? what if user marks a dir+contents, then presses `_' ??
1527 ;; (dolist (original marked-files)
1528 ;; (when (svn-status-line-info->directory-p original)
1529 ;; ;; run svn-status-goto-file-name to move point to line of file
1530 ;; ;; run svn-status-unset-user-mark to unmark dir+all contents
1531 ;; ;; run svn-status-set-user-mark to remark dir
1532 ;; ;; maybe check for local mods here, and unmark if user does't say --force?
1534 (dolist (original marked-files)
1535 (let ((original-name (svn-status-line-info->filename original))
1536 (original-filemarks (svn-status-line-info->filemark original))
1537 (original-propmarks (svn-status-line-info->propmark original)))
1539 ((or (eq original-filemarks 77) ;;original has local mods: maybe do `svn mv --force'
1540 (eq original-propmarks 77)) ;;original has local prop mods: maybe do `svn mv --force'
1541 (if (yes-or-no-p (format "%s has local modifications; use `--force' to really move it? "
1543 (svn-run-svn nil t 'mv "mv" "--force" "--" original-name dest)
1544 (message "Not moving %s" original-name)))
1545 ((eq original-filemarks 63) ;;original is unversioned: maybe do plain `mv'
1546 (if (yes-or-no-p (format "%s is unversioned. Use plain `mv -i %s %s'? "
1547 original-name original-name dest))
1548 (call-process "mv" nil (get-buffer-create "*svn-process*") nil "-i" original-name dest)
1549 (message "Not moving %s" original-name)))
1551 ((eq original-filemarks 65) ;;original has `A' mark (eg it was `svn add'ed, but not committed)
1552 (message "Not moving %s (try committing it first)" original-name))
1554 ((eq original-filemarks 32) ;;original is unmodified: can use `svn mv'
1555 (svn-run-svn nil t 'mv "mv" "--" original-name dest))
1557 ;;file is conflicted in some way?
1559 (if (yes-or-no-p (format "The status of %s looks scary. Risk moving it anyway? " original-name))
1560 (svn-run-svn nil t 'mv "mv" "--" original-name dest)
1561 (message "Not moving %s" original-name))))))
1562 (svn-status-update)))
1564 (defun svn-status-revert ()
1565 "Run `svn revert' on all selected files.
1566 See `svn-status-marked-files' for what counts as selected."
1568 (let* ((marked-files (svn-status-marked-files))
1569 (num-of-files (length marked-files)))
1571 (if (= 1 num-of-files)
1572 (format "Revert %s? " (svn-status-line-info->filename (car marked-files)))
1573 (format "Revert %d files? " num-of-files)))
1574 (message "reverting: %S" (svn-status-marked-file-names))
1575 (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "")
1576 (svn-run-svn t t 'revert "revert" "--targets" svn-status-temp-arg-file))))
1578 (defun svn-status-rm (force)
1579 "Run `svn rm' on all selected files.
1580 See `svn-status-marked-files' for what counts as selected.
1581 When called with a prefix argument add the command line switch --force."
1583 (let* ((marked-files (svn-status-marked-files))
1584 (num-of-files (length marked-files)))
1586 (if (= 1 num-of-files)
1587 (format "%sRemove %s? " (if force "Force " "") (svn-status-line-info->filename (car marked-files)))
1588 (format "%sRemove %d files? " (if force "Force " "") num-of-files)))
1589 (message "removing: %S" (svn-status-marked-file-names))
1590 (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "")
1592 (svn-run-svn t t 'rm "rm" "--force" "--targets" svn-status-temp-arg-file)
1593 (svn-run-svn t t 'rm "rm" "--targets" svn-status-temp-arg-file)))))
1595 (defun svn-status-update-cmd ()
1597 ;TODO: use file names also
1598 (svn-run-svn t t 'update "update"))
1600 (defun svn-status-commit-file ()
1602 (let* ((marked-files (svn-status-marked-files)))
1603 (setq svn-status-files-to-commit marked-files)
1604 (svn-log-edit-show-files-to-commit)
1605 (svn-status-pop-to-commit-buffer)))
1607 (defun svn-status-pop-to-commit-buffer ()
1609 (setq svn-status-pre-commit-window-configuration (current-window-configuration))
1610 (let* ((use-existing-buffer (get-buffer "*svn-log-edit*"))
1611 (commit-buffer (get-buffer-create "*svn-log-edit*"))
1612 (dir default-directory))
1613 (pop-to-buffer commit-buffer)
1614 (setq default-directory dir)
1615 (unless use-existing-buffer
1616 (when (and svn-log-edit-file-name (file-readable-p svn-log-edit-file-name))
1617 (insert-file svn-log-edit-file-name)))
1618 (svn-log-edit-mode)))
1620 (defun svn-status-cleanup ()
1622 (let ((file-names (svn-status-marked-file-names)))
1625 ;(message "svn-status-cleanup %S" file-names))
1626 (svn-run-svn t t 'cleanup (append (list "cleanup") file-names)))
1627 (message "No valid file selected - No status cleanup possible"))))
1629 (defun svn-status-resolved ()
1630 "Run `svn resolved' on all selected files.
1631 See `svn-status-marked-files' for what counts as selected."
1633 (let* ((marked-files (svn-status-marked-files))
1634 (num-of-files (length marked-files)))
1636 (if (= 1 num-of-files)
1637 (format "Resolve %s? " (svn-status-line-info->filename (car marked-files)))
1638 (format "Resolve %d files? " num-of-files)))
1639 (message "resolving: %S" (svn-status-marked-file-names))
1640 (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "")
1641 (svn-run-svn t t 'resolved "resolved" "--targets" svn-status-temp-arg-file))))
1643 ;; --------------------------------------------------------------------------------
1644 ;; Update the *svn-status* buffer, when a file is saved
1645 ;; --------------------------------------------------------------------------------
1647 (defvar svn-status-file-modified-after-save-flag ?m
1648 "The flag, that is shown, in the *svn-status* buffer, after
1649 a file is changed and saved in emacs.
1650 Recommended values are ?m or ?M.")
1651 (defun svn-status-after-save-hook ()
1652 "Set a modified indication, when a file is saved from a svn working copy."
1653 (let* ((svn-dir (car-safe svn-status-directory-history))
1654 (svn-dir (when svn-dir (expand-file-name svn-dir)))
1655 (file-dir (file-name-directory (buffer-file-name)))
1656 (svn-dir-len (length (or svn-dir "")))
1657 (file-dir-len (length file-dir))
1660 (>= file-dir-len svn-dir-len)
1661 (string= (substring file-dir 0 svn-dir-len) svn-dir))
1662 (setq file-name (substring (buffer-file-name) svn-dir-len))
1663 ;;(message (format "In svn-status directory %S" file-name))
1664 (let ((st-info svn-status-info)
1667 (setq i-fname (svn-status-line-info->filename (car st-info)))
1668 ;;(message (format "i-fname=%S" i-fname))
1669 (when (and (string= file-name i-fname)
1670 (not (eq (svn-status-line-info->filemark (car st-info)) ??)))
1671 (svn-status-line-info->set-filemark (car st-info)
1672 svn-status-file-modified-after-save-flag)
1674 (set-buffer "*svn-status*")
1675 (svn-status-goto-file-name i-fname)
1676 (let ((buffer-read-only nil))
1677 (delete-region (point-at-bol) (point-at-eol))
1678 (svn-insert-line-in-status-buffer (car st-info))
1680 (setq st-info (cdr st-info))))))
1683 (add-hook 'after-save-hook 'svn-status-after-save-hook)
1685 ;; --------------------------------------------------------------------------------
1686 ;; Getting older revisions
1687 ;; --------------------------------------------------------------------------------
1689 (defun svn-status-get-specific-revision (arg)
1690 "Retrieve older revisions.
1691 The older revisions are stored in backup files named F.~REVISION~.
1693 When the function is called without a prefix argument: get all marked files.
1694 Otherwise get only the actual file."
1696 (svn-status-get-specific-revision-internal (not arg) t))
1698 (defun svn-status-get-specific-revision-internal (&optional only-actual-file arg)
1699 (let* ((file-names (if only-actual-file
1700 (list (svn-status-line-info->filename (svn-status-get-line-information)))
1701 (svn-status-marked-file-names)))
1702 (revision (if arg (svn-status-read-revision-string "Get files for version: " "PREV") "BASE"))
1704 (file-name-with-revision))
1705 (message "Getting revision %s for %S" revision file-names)
1706 (setq svn-status-get-specific-revision-file-info nil)
1708 (setq file-name (car file-names))
1709 (setq file-name-with-revision (concat file-name ".~" revision "~"))
1710 (add-to-list 'svn-status-get-specific-revision-file-info
1711 (cons file-name file-name-with-revision))
1713 (find-file file-name-with-revision)
1714 (setq buffer-read-only nil)
1715 (delete-region (point-min) (point-max))
1716 (svn-run-svn nil t 'cat (append (list "cat" "-r" revision) (list file-name)))
1717 ;;todo: error processing
1718 ;;svn: Filesystem has no item
1719 ;;svn: file not found: revision `15', path `/trunk/file.txt'
1720 (insert-buffer-substring "*svn-process*")
1722 (setq file-names (cdr file-names)))
1723 (setq svn-status-get-specific-revision-file-info
1724 (nreverse svn-status-get-specific-revision-file-info))
1725 (message "svn-status-get-specific-revision-file-info: %S"
1726 svn-status-get-specific-revision-file-info)))
1729 (defun svn-status-ediff-with-revision (arg)
1730 "Run ediff on the current file with a previous revision.
1731 If ARG then prompt for revision to diff against."
1733 (svn-status-get-specific-revision-internal t arg)
1734 (let* ((ediff-after-quit-destination-buffer (current-buffer))
1735 (my-buffer (find-file-noselect (caar svn-status-get-specific-revision-file-info)))
1736 (base-buff (find-file-noselect (cdar svn-status-get-specific-revision-file-info)))
1737 (svn-transient-buffers (list base-buff ))
1738 (startup-hook '(svn-ediff-startup-hook)))
1739 (ediff-buffers my-buffer base-buff startup-hook)))
1741 (defun svn-ediff-startup-hook ()
1742 (add-hook 'ediff-after-quit-hook-internal
1744 (svn-ediff-exit-hook
1745 ',ediff-after-quit-destination-buffer ',svn-transient-buffers))
1748 (defun svn-ediff-exit-hook (svn-buf tmp-bufs)
1749 ;; kill the temp buffers (and their associated windows)
1750 (dolist (tb tmp-bufs)
1751 (when (and tb (buffer-live-p tb) (not (buffer-modified-p tb)))
1752 (let ((win (get-buffer-window tb t)))
1753 (when win (delete-window win))
1755 ;; switch back to the *svn* buffer
1756 (when (and svn-buf (buffer-live-p svn-buf)
1757 (not (get-buffer-window svn-buf t)))
1758 (ignore-errors (switch-to-buffer svn-buf))))
1761 (defun svn-status-read-revision-string (prompt &optional default-value)
1762 "Prompt the user for a svn revision number."
1764 (read-string prompt default-value))
1766 ;; --------------------------------------------------------------------------------
1767 ;; SVN process handling
1768 ;; --------------------------------------------------------------------------------
1770 (defun svn-process-kill ()
1771 "Kill the current running svn process."
1773 (let ((process (get-process "svn")))
1775 (delete-process process)
1776 (message "No running svn process"))))
1778 (defun svn-process-send-string (string)
1779 "Send a string to the running svn process.
1780 This is useful, if the running svn process asks the user a question.
1781 Note: use C-q C-j to send a line termination character."
1782 (interactive "sSend string to svn process: ")
1784 (set-buffer "*svn-process*")
1785 (let ((buffer-read-only nil))
1787 (set-marker (process-mark (get-process "svn")) (point)))
1788 (process-send-string "svn" string))
1790 ;; --------------------------------------------------------------------------------
1791 ;; Property List stuff
1792 ;; --------------------------------------------------------------------------------
1794 (defun svn-status-property-list ()
1796 (let ((file-names (svn-status-marked-file-names)))
1799 (svn-run-svn t t 'proplist (append (list "proplist" "-v") file-names)))
1800 (message "No valid file selected - No property listing possible"))))
1802 (defun svn-status-proplist-start ()
1803 (svn-run-svn t t 'proplist-parse "proplist" (svn-status-line-info->filename
1804 (svn-status-get-line-information))))
1806 (defun svn-status-property-parse ()
1808 (svn-status-proplist-start))
1810 (defun svn-status-property-edit-one-entry (arg)
1812 When called with a prefix argument, it is possible to enter a new property."
1814 (setq svn-status-property-edit-must-match-flag (not arg))
1815 (svn-status-proplist-start))
1817 (defun svn-status-property-set ()
1819 (setq svn-status-property-edit-must-match-flag nil)
1820 (svn-status-proplist-start))
1822 (defun svn-status-property-delete ()
1824 (setq svn-status-property-edit-must-match-flag t)
1825 (svn-status-proplist-start))
1827 (defun svn-status-property-parse-property-names ()
1828 ;(svn-status-show-process-buffer-internal t)
1829 (message "svn-status-property-parse-property-names")
1835 (set-buffer "*svn-process*")
1836 (goto-char (point-min))
1838 (while (looking-at " \\(.+\\)")
1839 (setq pl (append pl (list (match-string 1))))
1841 ;(cond last-command: svn-status-property-set, svn-status-property-edit-one-entry
1842 ;svn-status-property-parse:
1843 (cond ((eq last-command 'svn-status-property-parse)
1844 ;(message "%S %S" pl last-command)
1846 (svn-run-svn nil t 'propget-parse "propget" (car pl)
1847 (svn-status-line-info->filename
1848 (svn-status-get-line-information)))
1850 (set-buffer "*svn-process*")
1851 (setq pfl (append pfl (list
1855 (point-min) (- (point-max) 1)))))))
1857 (message "%S" pfl)))
1858 ((eq last-command 'svn-status-property-edit-one-entry)
1859 ;;(message "svn-status-property-edit-one-entry")
1861 (completing-read "Set Property - Name: " (mapcar 'list pl)
1862 nil svn-status-property-edit-must-match-flag))
1863 (unless (string= prop-name "")
1865 (set-buffer "*svn-status*")
1866 (svn-status-property-edit (list (svn-status-get-line-information))
1868 ((eq last-command 'svn-status-property-set)
1869 (message "svn-status-property-set")
1871 (completing-read "Set Property - Name: " (mapcar 'list pl) nil nil))
1872 (setq prop-value (read-from-minibuffer "Property value: "))
1873 (unless (string= prop-name "")
1875 (set-buffer "*svn-status*")
1876 (message "setting property %s := %s for %S" prop-name prop-value
1877 (svn-status-marked-files)))))
1878 ((eq last-command 'svn-status-property-delete)
1880 (completing-read "Delete Property - Name: " (mapcar 'list pl) nil t))
1881 (unless (string= prop-name "")
1883 (set-buffer "*svn-status*")
1884 (let ((file-names (svn-status-marked-file-names)))
1886 (message "Going to delete prop %s for %s" prop-name file-names)
1887 (svn-run-svn t t 'propdel
1888 (append (list "propdel" prop-name) file-names))))))))))
1890 (defun svn-status-property-edit (file-info-list prop-name &optional new-prop-value)
1891 (let* ((commit-buffer (get-buffer-create "*svn-property-edit*"))
1892 (dir default-directory)
1893 ;; now only one file is implemented ...
1894 (file-name (svn-status-line-info->filename (car file-info-list)))
1896 (message "Edit property %s for file %s" prop-name file-name)
1897 (svn-run-svn nil t 'propget-parse "propget" prop-name file-name)
1899 (set-buffer "*svn-process*")
1900 (setq prop-value (if (> (point-max) 1)
1901 (buffer-substring (point-min) (- (point-max) 1))
1903 (setq svn-status-propedit-property-name prop-name)
1904 (setq svn-status-propedit-file-list file-info-list)
1905 (setq svn-status-pre-propedit-window-configuration (current-window-configuration))
1906 (pop-to-buffer commit-buffer)
1907 (delete-region (point-min) (point-max))
1908 (setq default-directory dir)
1910 (svn-status-remove-control-M)
1911 (when new-prop-value
1912 (when (listp new-prop-value)
1913 (message "Adding new prop values %S " new-prop-value)
1914 (while new-prop-value
1915 (goto-char (point-min))
1916 (unless (re-search-forward
1917 (concat "^" (regexp-quote (car new-prop-value)) "$") nil t)
1918 (goto-char (point-max))
1919 (when (> (current-column) 0) (insert "\n"))
1920 (insert (car new-prop-value)))
1921 (setq new-prop-value (cdr new-prop-value)))))
1922 (svn-prop-edit-mode)))
1924 (defun svn-status-property-set-property (file-info-list prop-name prop-value)
1925 "Set a property on a given file list."
1927 (set-buffer (get-buffer "*svn-property-edit*"))
1928 (delete-region (point-min) (point-max))
1929 (insert prop-value))
1930 (setq svn-status-propedit-file-list (svn-status-marked-files))
1931 (setq svn-status-propedit-property-name prop-name)
1932 (svn-prop-edit-do-it nil)
1933 (svn-status-update))
1936 (defun svn-status-get-directory (line-info)
1937 (let* ((file-name (svn-status-line-info->filename line-info))
1938 (file-dir (file-name-directory file-name)))
1939 ;;(message "file-dir: %S" file-dir)
1941 (substring file-dir 0 (- (length file-dir) 1))
1944 (defun svn-status-get-file-list-per-directory (files)
1945 ;;(message "%S" files)
1946 (let ((dir-list nil)
1951 (setq dir (svn-status-get-directory (car i)))
1952 (setq j (assoc dir dir-list))
1955 ;;(message "dir already present %S %s" j dir)
1956 (setcdr j (append (cdr j) (list (car i)))))
1957 (setq dir-list (append dir-list (list (list dir (car i))))))
1959 ;;(message "svn-status-get-file-list-per-directory: %S" dir-list)
1962 (defun svn-status-property-ignore-file ()
1964 (let ((d-list (svn-status-get-file-list-per-directory (svn-status-marked-files)))
1969 (setq dir (caar d-list))
1970 (setq f-info (cdar d-list))
1971 (setq ext-list (mapcar '(lambda (i)
1972 (svn-status-line-info->filename-nondirectory i)) f-info))
1973 ;;(message "ignore in dir %s: %S" dir f-info)
1974 (save-window-excursion
1975 (when (y-or-n-p (format "Ignore %S for %s? " ext-list dir))
1976 (svn-status-property-edit
1977 (list (svn-status-find-info-for-file-name dir)) "svn:ignore" ext-list)
1978 (svn-prop-edit-do-it nil))) ; synchronous
1979 (setq d-list (cdr d-list)))
1980 (svn-status-update)))
1982 (defun svn-status-property-ignore-file-extension ()
1984 (let ((d-list (svn-status-get-file-list-per-directory (svn-status-marked-files)))
1989 (setq dir (caar d-list))
1990 (setq f-info (cdar d-list))
1991 ;;(message "ignore in dir %s: %S" dir f-info)
1994 (add-to-list 'ext-list (concat "*."
1995 (file-name-extension
1996 (svn-status-line-info->filename (car f-info)))))
1997 (setq f-info (cdr f-info)))
1998 ;;(message "%S" ext-list)
1999 (save-window-excursion
2000 (when (y-or-n-p (format "Ignore %S for %s? " ext-list dir))
2001 (svn-status-property-edit
2002 (list (svn-status-find-info-for-file-name dir)) "svn:ignore"
2004 (svn-prop-edit-do-it nil)))
2005 (setq d-list (cdr d-list)))
2006 (svn-status-update)))
2008 (defun svn-status-property-edit-svn-ignore ()
2010 (let* ((line-info (svn-status-get-line-information))
2011 (dir (if (svn-status-line-info->directory-p line-info)
2012 (svn-status-line-info->filename line-info)
2013 (svn-status-get-directory line-info))))
2014 (svn-status-property-edit
2015 (list (svn-status-find-info-for-file-name dir)) "svn:ignore")
2016 (message "Edit svn:ignore on %s" dir)))
2019 (defun svn-status-property-set-keyword-list ()
2020 "Edit the svn:keywords property on the marked files."
2022 ;;(message "Set svn:keywords for %S" (svn-status-marked-file-names))
2023 (svn-status-property-edit (svn-status-marked-files) "svn:keywords"))
2025 (defun svn-status-property-set-eol-style ()
2026 "Edit the svn:eol-style property on the marked files."
2028 (svn-status-property-set-property
2029 (svn-status-marked-files) "svn:eol-style"
2030 (completing-read "Set svn:eol-style for the marked files: "
2031 (mapcar 'list '("native" "CRLF" "LF" "CR"))
2034 ;; --------------------------------------------------------------------------------
2035 ;; svn-prop-edit-mode:
2036 ;; --------------------------------------------------------------------------------
2038 (defvar svn-prop-edit-mode-map () "Keymap used in `svn-prop-edit-mode' buffers.")
2040 (when (not svn-prop-edit-mode-map)
2041 (setq svn-prop-edit-mode-map (make-sparse-keymap))
2042 (define-key svn-prop-edit-mode-map [(control ?c) (control ?c)] 'svn-prop-edit-done)
2043 (define-key svn-prop-edit-mode-map [(control ?c) (control ?d)] 'svn-prop-edit-svn-diff)
2044 (define-key svn-prop-edit-mode-map [(control ?c) (control ?s)] 'svn-prop-edit-svn-status)
2045 (define-key svn-prop-edit-mode-map [(control ?c) (control ?l)] 'svn-prop-edit-svn-log)
2046 (define-key svn-prop-edit-mode-map [(control ?c) (control ?q)] 'svn-prop-edit-abort))
2048 (easy-menu-define svn-prop-edit-mode-menu svn-prop-edit-mode-map
2049 "'svn-prop-edit-mode' menu"
2051 ["Commit" svn-prop-edit-done t]
2052 ["Show Diff" svn-prop-edit-svn-diff t]
2053 ["Show Status" svn-prop-edit-svn-status t]
2054 ["Show Log" svn-prop-edit-svn-log t]
2055 ["Abort" svn-prop-edit-abort t]))
2057 (defun svn-prop-edit-mode ()
2058 "Major Mode to edit file properties of files under svn control.
2060 \\{svn-prop-edit-mode-map}"
2062 (kill-all-local-variables)
2063 (use-local-map svn-prop-edit-mode-map)
2064 (easy-menu-add svn-prop-edit-mode-menu)
2065 (setq major-mode 'svn-prop-edit-mode)
2066 (setq mode-name "svn-prop-edit"))
2068 (defun svn-prop-edit-abort ()
2071 (set-window-configuration svn-status-pre-propedit-window-configuration))
2073 (defun svn-prop-edit-done ()
2075 (svn-prop-edit-do-it t))
2077 (defun svn-prop-edit-do-it (async)
2078 (message "svn propset %s on %s"
2079 svn-status-propedit-property-name
2080 (mapcar 'svn-status-line-info->filename svn-status-propedit-file-list))
2082 (set-buffer (get-buffer "*svn-property-edit*"))
2083 (set-buffer-file-coding-system 'undecided-unix nil)
2084 (setq svn-status-temp-file-to-remove
2085 (concat svn-status-temp-dir "svn-prop-edit.txt" svn-temp-suffix))
2086 (write-region (point-min) (point-max) svn-status-temp-file-to-remove nil 1))
2087 (when svn-status-propedit-file-list ; there are files to change properties
2088 (svn-status-create-arg-file svn-status-temp-arg-file ""
2089 svn-status-propedit-file-list "")
2090 (setq svn-status-propedit-file-list nil)
2091 (svn-run-svn async t 'propset "propset"
2092 svn-status-propedit-property-name
2093 "--targets" svn-status-temp-arg-file
2094 "-F" (concat svn-status-temp-dir "svn-prop-edit.txt" svn-temp-suffix))
2095 (unless async (svn-status-remove-temp-file-maybe)))
2096 (set-window-configuration svn-status-pre-propedit-window-configuration))
2098 (defun svn-prop-edit-svn-diff (arg)
2100 (set-buffer "*svn-status*")
2101 (svn-status-show-svn-diff-for-marked-files arg))
2103 (defun svn-prop-edit-svn-log (arg)
2105 (set-buffer "*svn-status*")
2106 (svn-status-show-svn-log arg))
2108 (defun svn-prop-edit-svn-status ()
2110 (pop-to-buffer "*svn-status*")
2113 ;; --------------------------------------------------------------------------------
2114 ;; svn-log-edit-mode:
2115 ;; --------------------------------------------------------------------------------
2117 (defvar svn-log-edit-mode-map () "Keymap used in `svn-log-edit-mode' buffers.")
2119 (when (not svn-log-edit-mode-map)
2120 (setq svn-log-edit-mode-map (make-sparse-keymap))
2121 (define-key svn-log-edit-mode-map (kbd "C-c C-c") 'svn-log-edit-done)
2122 (define-key svn-log-edit-mode-map (kbd "C-c C-d") 'svn-log-edit-svn-diff)
2123 (define-key svn-log-edit-mode-map (kbd "C-c C-s") 'svn-log-edit-save-message)
2124 (define-key svn-log-edit-mode-map (kbd "C-c C-i") 'svn-log-edit-svn-status)
2125 (define-key svn-log-edit-mode-map (kbd "C-c C-l") 'svn-log-edit-svn-log)
2126 (define-key svn-log-edit-mode-map (kbd "C-c C-?") 'svn-log-edit-show-files-to-commit)
2127 (define-key svn-log-edit-mode-map (kbd "C-c C-z") 'svn-log-edit-erase-edit-buffer)
2128 (define-key svn-log-edit-mode-map (kbd "C-c C-q") 'svn-log-edit-abort))
2130 (easy-menu-define svn-log-edit-mode-menu svn-log-edit-mode-map
2131 "'svn-log-edit-mode' menu"
2133 ["Save to disk" svn-log-edit-save-message t]
2134 ["Commit" svn-log-edit-done t]
2135 ["Show Diff" svn-log-edit-svn-diff t]
2136 ["Show Status" svn-log-edit-svn-status t]
2137 ["Show Log" svn-log-edit-svn-log t]
2138 ["Show files to commit" svn-log-edit-show-files-to-commit t]
2139 ["Erase buffer" svn-log-edit-erase-edit-buffer]
2140 ["Abort" svn-log-edit-abort t]))
2142 (defun svn-log-edit-mode ()
2143 "Major Mode to edit svn log messages.
2145 \\{svn-log-edit-mode-map}"
2147 (kill-all-local-variables)
2148 (use-local-map svn-log-edit-mode-map)
2149 (easy-menu-add svn-log-edit-mode-menu)
2150 (setq major-mode 'svn-log-edit-mode)
2151 (setq mode-name "svn-log-edit")
2152 (run-hooks 'svn-log-edit-mode-hook))
2154 (defun svn-log-edit-abort ()
2157 (set-window-configuration svn-status-pre-commit-window-configuration))
2159 (defun svn-log-edit-done ()
2161 (message "svn-log editing done")
2163 (set-buffer (get-buffer "*svn-log-edit*"))
2164 (set-buffer-file-coding-system 'undecided-unix nil)
2165 (write-region (point-min) (point-max)
2166 (concat svn-status-temp-dir "svn-log-edit.txt" svn-temp-suffix) nil 1))
2167 (when svn-status-files-to-commit ; there are files to commit
2168 (svn-status-create-arg-file svn-status-temp-arg-file ""
2169 svn-status-files-to-commit "")
2170 (setq svn-status-files-to-commit nil)
2171 (setq svn-status-temp-file-to-remove (concat svn-status-temp-dir "svn-log-edit.txt" svn-temp-suffix))
2172 (svn-run-svn t t 'commit "commit" "--targets" svn-status-temp-arg-file
2173 "-F" svn-status-temp-file-to-remove))
2174 (set-window-configuration svn-status-pre-commit-window-configuration))
2176 (defun svn-log-edit-svn-diff (arg)
2177 "Show the diff we are about to commit.
2178 If ARG then show diff between some other version of the selected files."
2180 (set-buffer "*svn-status*")
2181 (svn-status-show-svn-diff-for-marked-files arg))
2183 (defun svn-log-edit-svn-log (arg)
2185 (set-buffer "*svn-status*")
2186 (svn-status-show-svn-log arg))
2188 (defun svn-log-edit-svn-status ()
2190 (pop-to-buffer "*svn-status*")
2193 (defun svn-log-edit-show-files-to-commit ()
2195 (message "Files to commit: %S"
2196 (mapcar 'svn-status-line-info->filename svn-status-files-to-commit)))
2198 (defun svn-log-edit-save-message ()
2199 "Save the current log message to the file `svn-log-edit-file-name'."
2201 (write-region (point-min) (point-max) svn-log-edit-file-name))
2203 (defun svn-log-edit-erase-edit-buffer ()
2204 "Delete everything in the *svn-log-edit* buffer."
2206 (set-buffer "*svn-log-edit*")
2210 ;; --------------------------------------------------------------------------------
2211 ;; svn-log-view-mode:
2212 ;; --------------------------------------------------------------------------------
2214 (defvar svn-log-view-mode-map () "Keymap used in `svn-log-view-mode' buffers.")
2216 (when (not svn-log-view-mode-map)
2217 (setq svn-log-view-mode-map (make-sparse-keymap))
2218 (define-key svn-log-view-mode-map (kbd "p") 'svn-log-view-prev)
2219 (define-key svn-log-view-mode-map (kbd "n") 'svn-log-view-next)
2220 (define-key svn-log-view-mode-map (kbd "=") 'svn-log-view-diff)
2221 (define-key svn-log-view-mode-map (kbd "q") 'bury-buffer))
2222 (easy-menu-define svn-log-view-mode-menu svn-log-view-mode-map
2223 "'svn-log-view-mode' menu"
2225 ["Show Changeset" svn-log-view-diff t]))
2227 (defvar svn-log-view-font-lock-keywords
2228 '(("^r.+" . font-lock-keyword-face)
2229 "Keywords in svn-log-view-mode."))
2231 (define-derived-mode svn-log-view-mode log-view-mode "svn-log-view"
2232 "Major Mode to show the output from svn log.
2234 \\{svn-log-view-mode-map}
2236 (use-local-map svn-log-view-mode-map)
2237 (easy-menu-add svn-log-view-mode-menu)
2238 (set (make-local-variable 'font-lock-defaults) '(svn-log-view-font-lock-keywords t)))
2240 (defun svn-log-view-next ()
2242 (when (re-search-forward "^r[0-9]+" nil t)
2243 (beginning-of-line 3)))
2245 (defun svn-log-view-prev ()
2247 (when (re-search-backward "^r[0-9]+" nil t 2)
2248 (beginning-of-line 3)))
2250 (defun svn-log-revision-at-point ()
2252 (re-search-backward "^r\\([0-9]+\\)")
2253 (match-string-no-properties 1)))
2255 (defun svn-log-view-diff (arg)
2256 "Show the changeset for a given log entry.
2257 When called with a prefix argument, ask the user for the revision."
2259 (let* ((upper-rev (svn-log-revision-at-point))
2260 (lower-rev (number-to-string (- (string-to-number upper-rev) 1)))
2261 (rev-arg (concat lower-rev ":" upper-rev)))
2263 (setq rev-arg (read-string "Revision for changeset: " rev-arg)))
2264 (svn-run-svn nil t 'diff "diff" (concat "-r" rev-arg))
2265 (svn-status-show-process-buffer-internal t)
2267 (set-buffer "*svn-process*")
2269 (font-lock-fontify-buffer))))
2273 ;;; psvn.el ends here