+++ /dev/null
-;;; psvn.el --- Subversion interface for emacs
-;; Copyright (C) 2002-2004 by Stefan Reichoer
-
-;; Author: Stefan Reichoer, <stefan@xsteve.at>
-;; $Id: psvn.el 10983 2004-09-15 18:38:26Z xsteve $
-
-;; psvn.el is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; psvn.el is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary
-
-;; psvn.el is tested with GNU Emacs 21.3 on windows, debian linux,
-;; freebsd5 with svn 1.05
-
-;; psvn.el is an interface for the revision control tool subversion
-;; (see http://subversion.tigris.org)
-;; psvn.el provides a similar interface for subversion as pcl-cvs for cvs.
-;; At the moment the following commands are implemented:
-;; M-x svn-status: run 'svn -status -v'
-;; and show the result in the *svn-status* buffer. This buffer uses
-;; svn-status mode in which the following keys are defined:
-;; g - svn-status-update: run 'svn status -v'
-;; C-u g - svn-status-update: run 'svn status -vu'
-;; = - svn-status-show-svn-diff run 'svn diff'
-;; l - svn-status-show-svn-log run 'svn log'
-;; i - svn-status-info run 'svn info'
-;; r - svn-status-revert run 'svn revert'
-;; V - svn-status-resolved run 'svn resolved'
-;; U - svn-status-update-cmd run 'svn update'
-;; c - svn-status-commit-file run 'svn commit'
-;; a - svn-status-add-file run 'svn add --non-recursive'
-;; A - svn-status-add-file-recursively run 'svn add'
-;; + - svn-status-make-directory run 'svn mkdir'
-;; R - svn-status-mv run 'svn mv'
-;; C-d - svn-status-rm run 'svn rm'
-;; M-c - svn-status-cleanup run 'svn cleanup'
-;; b - svn-status-blame run 'svn blame'
-;; RET - svn-status-find-file-or-examine-directory
-;; ^ - svn-status-examine-parent
-;; ~ - svn-status-get-specific-revision
-;; E - svn-status-ediff-with-revision
-;; s - svn-status-show-process-buffer
-;; e - svn-status-toggle-edit-cmd-flag
-;; ? - svn-status-toggle-hide-unknown
-;; _ - svn-status-toggle-hide-unmodified
-;; m - svn-status-set-user-mark
-;; u - svn-status-unset-user-mark
-;; $ - svn-status-toggle-elide
-;; DEL - svn-status-unset-user-mark-backwards
-;; * ! - svn-status-unset-all-usermarks
-;; * ? - svn-status-mark-unknown
-;; * A - svn-status-mark-added
-;; * M - svn-status-mark-modified
-;; . - svn-status-goto-root-or-return
-;; f - svn-status-find-file
-;; o - svn-status-find-file-other-window
-;; v - svn-status-view-file-other-window
-;; I - svn-status-parse-info
-;; P l - svn-status-property-list
-;; P s - svn-status-property-set
-;; P d - svn-status-property-delete
-;; P e - svn-status-property-edit-one-entry
-;; P i - svn-status-property-ignore-file
-;; P I - svn-status-property-ignore-file-extension
-;; P C-i - svn-status-property-edit-svn-ignore
-;; P k - svn-status-property-set-keyword-list
-;; P y - svn-status-property-set-eol-style
-;; h - svn-status-use-history
-;; q - svn-status-bury-buffer
-
-;; To use psvn.el put the following line in your .emacs:
-;; (require 'psvn)
-;; Start the svn interface with M-x svn-status
-
-;; The latest version of psvn.el can be found at:
-;; http://www.xsteve.at/prg/emacs/psvn.el
-;; Or you can check it out from the subversion repository:
-;; svn co http://svn.collab.net/repos/svn/trunk/contrib/client-side/psvn psvn
-
-;; TODO:
-;; * shortcut for svn propset svn:keywords "Date" psvn.el
-;; * docstrings for the functions
-;; * perhaps shortcuts for ranges, dates
-;; * when editing the command line - offer help from the svn client
-;; * finish svn-status-property-set
-;; * eventually use the customize interface
-;; * interactive svn-status should complete existing directories only;
-;; unfortunately `read-directory-name' doesn't exist in Emacs 21.3
-;; * Add repository browser
-;; * Improve support for svn blame
-;; * Support for editing the log file entries, e.g.:
-;; svn propedit --revprop -r9821 svn:log
-;; * Better logview mode (allow to show the changeset for a given entry)
-
-;; Overview over the implemented/not (yet) implemented svn sub-commands:
-;; * add implemented
-;; * blame implemented
-;; * cat implemented
-;; * checkout (co)
-;; * cleanup implemented
-;; * commit (ci) implemented
-;; * copy (cp)
-;; * delete (del, remove, rm) implemented
-;; * diff (di) implemented
-;; * export
-;; * help (?, h)
-;; * import
-;; * info implemented
-;; * list (ls)
-;; * log implemented
-;; * merge
-;; * mkdir implemented
-;; * move (mv, rename, ren) implemented
-;; * propdel (pdel) implemented
-;; * propedit (pedit, pe) not needed
-;; * propget (pget, pg) used
-;; * proplist (plist, pl) implemented
-;; * propset (pset, ps) used
-;; * resolved implemented
-;; * revert implemented
-;; * status (stat, st) implemented
-;; * switch (sw)
-;; * update (up) implemented
-
-;; For the not yet implemented commands you should use the command line
-;; svn client. If there are user requests for any missing commands I will
-;; probably implement them.
-
-;; Comments / suggestions and bug reports are welcome!
-
-;;; Code:
-
-;;; user setable variables
-(defvar svn-log-edit-file-name "++svn-log++" "*Name of a saved log file.")
-(defvar svn-status-hide-unknown nil "*Hide unknown files in *svn-status* buffer.")
-(defvar svn-status-hide-unmodified nil "*Hide unmodified files in *svn-status* buffer.")
-(defvar svn-status-directory-history nil "*List of visited svn working directories.")
-
-(defvar svn-status-unmark-files-after-list '(commit revert)
- "*List of operations after which all user marks will be removed.
-Possible values are: commit, revert.")
-
-;;; default arguments to pass to svn commands
-(defvar svn-status-default-log-arguments ""
- "*Arguments to pass to svn log.
-\(used in `svn-status-show-svn-log'; override these by giving prefixes\).")
-
-;;; hooks
-(defvar svn-log-edit-mode-hook nil "Hook run when entering `svn-log-edit-mode'.")
-
-(defvar svn-status-wash-control-M-in-process-buffers
- (eq system-type 'windows-nt)
- "*Remove any trailing ^M from the *svn-process* buffer.")
-
-;;; Customize group
-(defgroup psvn nil
- "Subversion interface for Emacs."
- :group 'tools)
-
-(defgroup psvn-faces nil
- "psvn faces."
- :group 'psvn)
-
-
-(eval-and-compile
- (require 'cl)
- (defconst svn-xemacsp (featurep 'xemacs))
- (if svn-xemacsp
- (require 'overlay)
- (require 'overlay nil t)))
-
-;; Use the normally used mode for files ending in .~HEAD~, .~BASE~, ...
-(add-to-list 'auto-mode-alist '("\\.~?\\(HEAD\\|BASE\\|PREV\\)~?\\'" ignore t))
-
-;;; internal variables
-(defvar svn-process-cmd nil)
-(defvar svn-status-info nil)
-(defvar svn-status-base-info nil)
-(defvar svn-status-initial-window-configuration nil)
-(defvar svn-status-default-column 23)
-(defvar svn-status-default-revision-width 4)
-(defvar svn-status-default-author-width 9)
-(defvar svn-status-line-format " %c%c %4s %4s %-9s")
-(defvar svn-status-short-mod-flag-p t)
-(defvar svn-start-of-file-list-line-number 0)
-(defvar svn-status-files-to-commit nil)
-(defvar svn-status-pre-commit-window-configuration nil)
-(defvar svn-status-pre-propedit-window-configuration nil)
-(defvar svn-status-head-revision nil)
-(defvar svn-status-root-return-info nil)
-(defvar svn-status-property-edit-must-match-flag nil)
-(defvar svn-status-propedit-property-name nil)
-(defvar svn-status-propedit-file-list nil)
-(defvar svn-status-mode-line-process "")
-(defvar svn-status-mode-line-process-status "")
-(defvar svn-status-mode-line-process-edit-flag "")
-(defvar svn-status-edit-svn-command nil)
-(defvar svn-status-update-previous-process-output nil)
-(defvar svn-status-temp-dir
- (or
- (when (boundp 'temporary-file-directory) temporary-file-directory) ;emacs
- (when (boundp 'temp-directory) temp-directory) ;xemacs
- "/tmp/"))
-(defvar svn-temp-suffix (make-temp-name "."))
-(defvar svn-status-temp-file-to-remove nil)
-(defvar svn-status-temp-arg-file (concat svn-status-temp-dir "svn.arg" svn-temp-suffix))
-
-;;; faces
-(defface svn-status-marked-face
- '((((type tty) (class color)) (:foreground "green" :weight light))
- (((class color) (background light)) (:foreground "green3"))
- (((class color) (background dark)) (:foreground "palegreen2"))
- (t (:weight bold)))
- "Face to highlight the mark for user marked files in svn status buffers."
- :group 'psvn-faces)
-
-(defface svn-status-modified-external-face
- '((((type tty) (class color)) (:foreground "magenta" :weight light))
- (((class color) (background light)) (:foreground "magenta"))
- (((class color) (background dark)) (:foreground "yellow"))
- (t (:weight bold)))
- "Face to highlight the phrase \"externally modified\" in *svn-status* buffers."
- :group 'psvn-faces)
-
-;based on cvs-filename-face
-(defface svn-status-directory-face
- '((((type tty) (class color)) (:foreground "lightblue" :weight light))
- (((class color) (background light)) (:foreground "blue4"))
- (((class color) (background dark)) (:foreground "lightskyblue1"))
- (t (:weight bold)))
- "Face for directories in svn status buffers.
-See `svn-status--line-info->directory-p' for what counts as a directory."
- :group 'psvn-faces)
-
-;based on font-lock-comment-face
-(defface svn-status-filename-face
- '((((class color) (background light)) (:foreground "chocolate"))
- (((class color) (background dark)) (:foreground "beige")))
- "Face for non-directories in svn status buffers.
-See `svn-status--line-info->directory-p' for what counts as a directory."
- :group 'psvn-faces)
-
-(defvar svn-highlight t)
-;; stolen from PCL-CVS
-(defun svn-add-face (str face &optional keymap)
- (when svn-highlight
- ;; Do not use `list*'; cl.el might not have been loaded. We could
- ;; put (require 'cl) at the top but let's try to manage without.
- (add-text-properties 0 (length str)
- `(face ,face
- ,@(when keymap
- `(mouse-face highlight
- local-map ,keymap)))
- str))
- str)
-
-(defun svn-status-maybe-add-face (condition text face)
- "If CONDITION then add FACE to TEXT.
-Else return TEXT unchanged."
- (if condition
- (svn-add-face text face)
- text))
-
-(defun svn-status-choose-face-to-add (condition text face1 face2)
- "If CONDITION then add FACE1 to TEXT, else add FACE2 to TEXT."
- (if condition
- (svn-add-face text face1)
- (svn-add-face text face2)))
-
-; compatibility
-; emacs 20
-(unless (fboundp 'point-at-eol) (defalias 'point-at-eol 'line-end-position))
-(unless (fboundp 'point-at-bol) (defalias 'point-at-bol 'line-beginning-position))
-(unless (functionp 'read-directory-name) (defalias 'read-directory-name 'read-file-name))
-
-(eval-when-compile
- (if (not (fboundp 'gethash))
- (require 'cl-macs)))
-(if (not (fboundp 'puthash))
- (defalias 'puthash 'cl-puthash))
-
-(defvar svn-status-display-new-status-buffer nil)
-;;;###autoload
-(defun svn-status (dir &optional arg)
- "Examine the status of Subversion working copy in directory DIR.
-If ARG then pass the -u argument to `svn status'."
- (interactive (list (read-directory-name "SVN status directory: "
- nil default-directory nil)))
- (unless (file-directory-p dir)
- (error "%s is not a directory" dir))
- (if (not (file-exists-p (concat dir "/.svn/")))
- (when (y-or-n-p
- (concat dir
- " does not seem to be a Subversion working copy (no .svn directory). "
- "Run dired instead? "))
- (dired dir))
- (setq dir (file-name-as-directory dir))
- (setq svn-status-directory-history (delete dir svn-status-directory-history))
- (add-to-list 'svn-status-directory-history dir)
- (if (string= (buffer-name) "*svn-status*")
- (setq svn-status-display-new-status-buffer nil)
- (setq svn-status-display-new-status-buffer t)
- ;;(message "psvn: Saving initial window configuration")
- (setq svn-status-initial-window-configuration (current-window-configuration)))
- (let* ((status-buf (get-buffer-create "*svn-status*"))
- (proc-buf (get-buffer-create "*svn-process*")))
- (save-excursion
- (set-buffer status-buf)
- (setq default-directory dir)
- (set-buffer proc-buf)
- (setq default-directory dir)
- (if arg
- (svn-run-svn t t 'status "status" "-vu")
- (svn-run-svn t t 'status "status" "-v"))))))
-
-(defun svn-status-use-history ()
- (interactive)
- (let* ((hist svn-status-directory-history)
- (dir (read-from-minibuffer "svn-status on directory: "
- (cadr svn-status-directory-history)
- nil nil 'hist)))
- (when (file-directory-p dir)
- (svn-status dir))))
-
-(defun svn-run-svn (run-asynchron clear-process-buffer cmdtype &rest arglist)
- "Run svn with arguments ARGLIST.
-
-If RUN-ASYNCHRON is t then run svn asynchronously.
-
-If CLEAR-PROCESS-BUFFER is t then erase the contents of the
-*svn-process* buffer before commencing.
-
-CMDTYPE is a symbol such as 'mv, 'revert, or 'add, representing the
-command to run.
-
-ARGLIST is a list of arguments \(which must include the command name,
-for example: '(\"revert\" \"file1\"\)"
- (if (eq (process-status "svn") nil)
- (progn
- (when svn-status-edit-svn-command
- (setq arglist (append arglist
- (split-string
- (read-from-minibuffer
- (format "svn %s %S " cmdtype arglist)))))
- (when (eq svn-status-edit-svn-command t)
- (svn-status-toggle-edit-cmd-flag t))
- (message "svn-run-svn %s: %S" cmdtype arglist))
- (let* ((proc-buf (get-buffer-create "*svn-process*"))
- (svn-proc))
- (when (listp (car arglist))
- (setq arglist (car arglist)))
- (save-excursion
- (set-buffer proc-buf)
- (setq buffer-read-only nil)
- (fundamental-mode)
- (if clear-process-buffer
- (delete-region (point-min) (point-max))
- (goto-char (point-max)))
- (setq svn-process-cmd cmdtype)
- (setq svn-status-mode-line-process-status (format " running %s" cmdtype))
- (svn-status-update-mode-line)
- (sit-for 0.1)
- (if run-asynchron
- (progn
- (setq svn-proc (apply 'start-process "svn" proc-buf "svn" arglist))
- (set-process-sentinel svn-proc 'svn-process-sentinel))
- ;;(message "running synchron: svn %S" arglist)
- (apply 'call-process "svn" nil proc-buf nil arglist)
- (setq svn-status-mode-line-process-status "")
- (svn-status-update-mode-line)))))
- (error "You can only run one svn process at once!")))
-
-(defun svn-process-sentinel (process event)
- ;;(princ (format "Process: %s had the event `%s'" process event)))
- ;;(save-excursion
- (let ((act-buf (current-buffer)))
- (set-buffer (process-buffer process))
- (setq svn-status-mode-line-process-status "")
- (svn-status-update-mode-line)
- (cond ((string= event "finished\n")
- (cond ((eq svn-process-cmd 'status)
- ;;(message "svn status finished")
- (if (eq system-type 'windows-nt)
- ;; convert path separator as UNIX style
- (save-excursion
- (goto-char (point-min))
- (while (search-forward "\\" nil t)
- (replace-match "/"))))
- (svn-parse-status-result)
- (set-buffer act-buf)
- (svn-status-update-buffer)
- (when svn-status-update-previous-process-output
- (set-buffer (process-buffer process))
- (delete-region (point-min) (point-max))
- (insert "Output from svn command:\n")
- (insert svn-status-update-previous-process-output)
- (goto-char (point-min))
- (setq svn-status-update-previous-process-output nil))
- (when svn-status-display-new-status-buffer
- (set-window-configuration svn-status-initial-window-configuration)
- (switch-to-buffer "*svn-status*")))
- ((eq svn-process-cmd 'log)
- (svn-status-show-process-buffer-internal t)
- (pop-to-buffer "*svn-process*")
- (switch-to-buffer (get-buffer-create "*svn-log*"))
- (let ((buffer-read-only nil))
- (delete-region (point-min) (point-max))
- (insert-buffer-substring "*svn-process*"))
- (svn-log-view-mode)
- (goto-char (point-min))
- (forward-line 3)
- (font-lock-fontify-buffer)
- (message "svn log finished"))
- ((eq svn-process-cmd 'info)
- (svn-status-show-process-buffer-internal t)
- (message "svn info finished"))
- ((eq svn-process-cmd 'parse-info)
- (svn-status-parse-info-result))
- ((eq svn-process-cmd 'blame)
- (svn-status-show-process-buffer-internal t)
- (message "svn blame finished"))
- ((eq svn-process-cmd 'commit)
- (svn-status-remove-temp-file-maybe)
- (svn-status-show-process-buffer-internal t)
- (when (member 'commit svn-status-unmark-files-after-list)
- (svn-status-unset-all-usermarks))
- (svn-status-update)
- (message "svn commit finished"))
- ((eq svn-process-cmd 'update)
- (svn-status-show-process-buffer-internal t)
- (svn-status-update)
- (message "svn update finished"))
- ((eq svn-process-cmd 'add)
- (svn-status-update)
- (message "svn add finished"))
- ((eq svn-process-cmd 'mkdir)
- (svn-status-update)
- (message "svn mkdir finished"))
- ((eq svn-process-cmd 'revert)
- (when (member 'revert svn-status-unmark-files-after-list)
- (svn-status-unset-all-usermarks))
- (svn-status-update)
- (message "svn revert finished"))
- ((eq svn-process-cmd 'resolved)
- (svn-status-update)
- (message "svn resolved finished"))
- ((eq svn-process-cmd 'mv)
- (svn-status-update)
- (message "svn mv finished"))
- ((eq svn-process-cmd 'rm)
- (svn-status-update)
- (message "svn rm finished"))
- ((eq svn-process-cmd 'cleanup)
- (message "svn cleanup finished"))
- ((eq svn-process-cmd 'proplist)
- (svn-status-show-process-buffer-internal t)
- (message "svn proplist finished"))
- ((eq svn-process-cmd 'proplist-parse)
- (svn-status-property-parse-property-names))
- ((eq svn-process-cmd 'propset)
- (svn-status-remove-temp-file-maybe)
- (svn-status-update))
- ((eq svn-process-cmd 'propdel)
- (svn-status-update))))
- ((string= event "killed\n")
- (message "svn process killed"))
- ((string-match "exited abnormally" event)
- (while (accept-process-output process 0 100))
- ;; find last error message and show it.
- (goto-char (point-max))
- (message "svn failed: %s"
- (if (re-search-backward "^svn: \\(.*\\)" nil t)
- (match-string 1)
- event)))
- (t
- (message "svn process had unknown event: %s" event))
- (svn-status-show-process-buffer-internal t))))
-
-(defun svn-parse-rev-num (str)
- (if (and str (stringp str)
- (save-match-data (string-match "^[0-9]+" str)))
- (string-to-number str)
- -1))
-
-
-(defun svn-parse-status-result ()
- "Parse the *svn-process* buffer.
-The results are used to build the `svn-status-info' variable."
- (setq svn-status-head-revision nil)
- (save-excursion
- (let ((old-ui-information (svn-status-ui-information-hash-table))
- (line-string)
- (user-mark)
- (svn-marks)
- (svn-file-mark)
- (svn-property-mark)
- (svn-update-mark)
- (local-rev)
- (last-change-rev)
- (author)
- (path)
- (user-elide nil)
- (ui-status '(nil nil)) ; contains (user-mark user-elide)
- (revision-width svn-status-default-revision-width)
- (author-width svn-status-default-author-width))
- (set-buffer "*svn-process*")
- (setq svn-status-info nil)
- (goto-char (point-min))
- (while (< (point) (point-max))
- (cond
- ((= (point-at-eol) (point-at-bol)) ;skip blank lines
- nil)
- ((looking-at "Status against revision:[ ]+\\([0-9]+\\)")
- ;; the above message appears for the main listing plus once for each svn:externals entry
- (unless svn-status-head-revision
- (setq svn-status-head-revision (match-string 1))))
- ((looking-at "Performing status on external item at '\(.*\)'")
- ;; The *next* line has info about the directory named in svn:externals
- ;; we should parse it, and merge the info with what we have already know
- ;; but for now just ignore the line completely
- (forward-line)
- )
- (t
- (setq svn-marks (buffer-substring (point) (+ (point) 8))
- svn-file-mark (elt svn-marks 0) ; 1st column
- svn-property-mark (elt svn-marks 1) ; 2nd column
- ;;svn-locked-mark (elt svn-marks 2) ; 3rd column
- ;;svn-added-with-history-mark (elt svn-marks 3); 4th column
- ;;svn-switched-mark (elt svn-marks 4) ; 5th column
- svn-update-mark (elt svn-marks 7)) ; 8th column
-
- (when (eq svn-property-mark ?\ ) (setq svn-property-mark nil))
- (when (eq svn-update-mark ?\ ) (setq svn-update-mark nil))
- (forward-char 8)
- (skip-chars-forward " ")
- (cond
- ((looking-at "\\([-?]\\|[0-9]+\\) +\\([-?]\\|[0-9]+\\) +\\([^ ]+\\) *\\(.+\\)")
- (setq local-rev (svn-parse-rev-num (match-string 1))
- last-change-rev (svn-parse-rev-num (match-string 2))
- author (match-string 3)
- path (match-string 4)))
- ((looking-at "\\(.*\\)")
- (setq path (match-string 1)
- local-rev -1
- last-change-rev -1
- author (if (eq svn-file-mark 88) "" "?"))) ;clear author of svn:externals dirs
- (t
- (error "Unknown status line format")))
- (unless path (setq path "."))
- (setq ui-status (or (gethash path old-ui-information) (list user-mark user-elide)))
- (setq svn-status-info (cons (list ui-status
- svn-file-mark
- svn-property-mark
- path
- local-rev
- last-change-rev
- author
- svn-update-mark)
- svn-status-info))
- (setq revision-width (max revision-width
- (length (number-to-string local-rev))
- (length (number-to-string last-change-rev))))
- (setq author-width (max author-width (length author)))))
- (forward-line 1))
- ;; With subversion 0.29.0 and above, `svn -u st' returns files in
- ;; a random order (especially if we have a mixed revision wc)
- (setq svn-status-default-column
- (+ 6 revision-width revision-width author-width
- (if svn-status-short-mod-flag-p 3 0)))
- (setq svn-status-line-format (format " %%c%%c %%%ds %%%ds %%-%ds"
- revision-width
- revision-width
- author-width))
- (setq svn-status-info (sort svn-status-info 'svn-status-sort-predicate)))))
-
-;;(string-lessp "." "%") => nil
-;(svn-status-sort-predicate '(t t t ".") '(t t t "%")) => t
-(defun svn-status-sort-predicate (a b)
- "Return t if A should appear before B in the *svn-status* buffer.
-A and B must be line-info's."
- (string-lessp (concat (svn-status-line-info->full-path a) "/")
- (concat (svn-status-line-info->full-path b) "/")))
-
-(defun svn-status-remove-temp-file-maybe ()
- "Remove any (no longer required) temporary files created by psvn.el."
- (when svn-status-temp-file-to-remove
- (when (file-exists-p svn-status-temp-file-to-remove)
- (delete-file svn-status-temp-file-to-remove))
- (when (file-exists-p svn-status-temp-arg-file)
- (delete-file svn-status-temp-arg-file))
- (setq svn-status-temp-file-to-remove nil)))
-
-(defun svn-status-remove-control-M ()
- "Remove ^M at end of line in the whole buffer."
- (interactive)
- (let ((buffer-read-only nil))
- (save-match-data
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "\r$" (point-max) t)
- (replace-match "" nil nil))))))
-
-(condition-case nil
- ;;(easy-menu-add-item nil '("tools") ["SVN Status" svn-status t] "PCL-CVS")
- (easy-menu-add-item nil '("tools") ["SVN Status" svn-status t])
- (error (message "psvn: could not install menu")))
-
-(defvar svn-status-mode-map () "Keymap used in `svn-status-mode' buffers.")
-(defvar svn-status-mode-property-map ()
- "Subkeymap used in `svn-status-mode' for property commands.")
-
-(when (not svn-status-mode-map)
- (setq svn-status-mode-map (make-sparse-keymap))
- (suppress-keymap svn-status-mode-map)
- ;; Don't use (kbd "<return>"); it's unreachable with GNU Emacs 21.3 on a TTY.
- (define-key svn-status-mode-map (kbd "RET") 'svn-status-find-file-or-examine-directory)
- (define-key svn-status-mode-map (kbd "^") 'svn-status-examine-parent)
- (define-key svn-status-mode-map (kbd "s") 'svn-status-show-process-buffer)
- (define-key svn-status-mode-map (kbd "f") 'svn-status-find-files)
- (define-key svn-status-mode-map (kbd "o") 'svn-status-find-file-other-window)
- (define-key svn-status-mode-map (kbd "v") 'svn-status-view-file-other-window)
- (define-key svn-status-mode-map (kbd "e") 'svn-status-toggle-edit-cmd-flag)
- (define-key svn-status-mode-map (kbd "g") 'svn-status-update)
- (define-key svn-status-mode-map (kbd "q") 'svn-status-bury-buffer)
- (define-key svn-status-mode-map (kbd "h") 'svn-status-use-history)
- (define-key svn-status-mode-map (kbd "m") 'svn-status-set-user-mark)
- (define-key svn-status-mode-map (kbd "u") 'svn-status-unset-user-mark)
- ;; This matches a binding of `dired-unmark-all-files' in `dired-mode-map'
- ;; of both GNU Emacs and XEmacs. It seems unreachable with XEmacs on
- ;; TTY, but if that's a problem then its Dired needs fixing too.
- ;; Or you could just use "*!".
- (define-key svn-status-mode-map "\M-\C-?" 'svn-status-unset-all-usermarks)
- ;; The key that normally deletes characters backwards should here
- ;; instead unmark files backwards. In GNU Emacs, that would be (kbd
- ;; "DEL") aka [?\177], but XEmacs treats those as [(delete)] and
- ;; would bind a key that normally deletes forwards. [(backspace)]
- ;; is unreachable with GNU Emacs on a tty. Try to recognize the
- ;; dialect and act accordingly.
- ;;
- ;; XEmacs has a `delete-forward-p' function that checks the
- ;; `delete-key-deletes-forward' option. We don't use those, for two
- ;; reasons: psvn.el may be loaded before user customizations, and
- ;; XEmacs allows simultaneous connections to multiple devices with
- ;; different keyboards.
- (define-key svn-status-mode-map
- (if (member (kbd "DEL") '([(delete)] [delete]))
- [(backspace)] ; XEmacs
- (kbd "DEL")) ; GNU Emacs
- 'svn-status-unset-user-mark-backwards)
- (define-key svn-status-mode-map (kbd "$") 'svn-status-toggle-elide)
- (define-key svn-status-mode-map (kbd ".") 'svn-status-goto-root-or-return)
- (define-key svn-status-mode-map (kbd "I") 'svn-status-parse-info)
- (define-key svn-status-mode-map (kbd "?") 'svn-status-toggle-hide-unknown)
- (define-key svn-status-mode-map (kbd "_") 'svn-status-toggle-hide-unmodified)
- (define-key svn-status-mode-map (kbd "a") 'svn-status-add-file)
- (define-key svn-status-mode-map (kbd "A") 'svn-status-add-file-recursively)
- (define-key svn-status-mode-map (kbd "+") 'svn-status-make-directory)
- (define-key svn-status-mode-map (kbd "R") 'svn-status-mv)
- (define-key svn-status-mode-map (kbd "D") 'svn-status-rm)
- (define-key svn-status-mode-map (kbd "c") 'svn-status-commit-file)
- (define-key svn-status-mode-map (kbd "M-c") 'svn-status-cleanup)
- (define-key svn-status-mode-map (kbd "U") 'svn-status-update-cmd)
- (define-key svn-status-mode-map (kbd "r") 'svn-status-revert)
- (define-key svn-status-mode-map (kbd "l") 'svn-status-show-svn-log)
- (define-key svn-status-mode-map (kbd "i") 'svn-status-info)
- (define-key svn-status-mode-map (kbd "b") 'svn-status-blame)
- (define-key svn-status-mode-map (kbd "=") 'svn-status-show-svn-diff)
- ;; [(control ?=)] is unreachable on TTY, but you can use "*u" instead.
- ;; (Is the "u" mnemonic for something?)
- (define-key svn-status-mode-map (kbd "C-=") 'svn-status-show-svn-diff-for-marked-files)
- (define-key svn-status-mode-map (kbd "~") 'svn-status-get-specific-revision)
- (define-key svn-status-mode-map (kbd "E") 'svn-status-ediff-with-revision)
- (define-key svn-status-mode-map (kbd "C-n") 'svn-status-next-line)
- (define-key svn-status-mode-map (kbd "C-p") 'svn-status-previous-line)
- (define-key svn-status-mode-map (kbd "<down>") 'svn-status-next-line)
- (define-key svn-status-mode-map (kbd "<up>") 'svn-status-previous-line)
- (setq svn-status-mode-mark-map (make-sparse-keymap))
- (define-key svn-status-mode-map (kbd "*") svn-status-mode-mark-map)
- (define-key svn-status-mode-mark-map (kbd "!") 'svn-status-unset-all-usermarks)
- (define-key svn-status-mode-mark-map (kbd "?") 'svn-status-mark-unknown)
- (define-key svn-status-mode-mark-map (kbd "A") 'svn-status-mark-added)
- (define-key svn-status-mode-mark-map (kbd "M") 'svn-status-mark-modified)
- (define-key svn-status-mode-mark-map (kbd "V") 'svn-status-resolved)
- (define-key svn-status-mode-mark-map (kbd "u") 'svn-status-show-svn-diff-for-marked-files))
-(when (not svn-status-mode-property-map)
- (setq svn-status-mode-property-map (make-sparse-keymap))
- (define-key svn-status-mode-property-map (kbd "l") 'svn-status-property-list)
- (define-key svn-status-mode-property-map (kbd "s") 'svn-status-property-set)
- (define-key svn-status-mode-property-map (kbd "d") 'svn-status-property-delete)
- (define-key svn-status-mode-property-map (kbd "e") 'svn-status-property-edit-one-entry)
- (define-key svn-status-mode-property-map (kbd "i") 'svn-status-property-ignore-file)
- (define-key svn-status-mode-property-map (kbd "I") 'svn-status-property-ignore-file-extension)
- ;; XEmacs 21.4.15 on TTY (vt420) converts `C-i' to `TAB',
- ;; which [(control ?i)] won't match. Handle it separately.
- ;; On GNU Emacs, the following two forms bind the same key,
- ;; reducing clutter in `where-is'.
- (define-key svn-status-mode-property-map [(control ?i)] 'svn-status-property-edit-svn-ignore)
- (define-key svn-status-mode-property-map (kbd "TAB") 'svn-status-property-edit-svn-ignore)
- (define-key svn-status-mode-property-map (kbd "k") 'svn-status-property-set-keyword-list)
- (define-key svn-status-mode-property-map (kbd "y") 'svn-status-property-set-eol-style)
- (define-key svn-status-mode-property-map (kbd "p") 'svn-status-property-parse)
- ;; TODO: Why is `svn-status-select-line' in `svn-status-mode-property-map'?
- (define-key svn-status-mode-property-map (kbd "RET") 'svn-status-select-line)
- (define-key svn-status-mode-map (kbd "P") svn-status-mode-property-map))
-
-
-(easy-menu-define svn-status-mode-menu svn-status-mode-map
- "'svn-status-mode' menu"
- '("SVN"
- ["svn status" svn-status-update t]
- ["svn update" svn-status-update-cmd t]
- ["svn commit" svn-status-commit-file t]
- ["svn log" svn-status-show-svn-log t]
- ["svn info" svn-status-info t]
- ["svn blame" svn-status-blame t]
- ("Diff"
- ["svn diff current file" svn-status-show-svn-diff t]
- ["svn diff marked files" svn-status-show-svn-diff-for-marked-files t]
- ["svn ediff current file" svn-status-ediff-with-revision t]
- )
- ["svn cat ..." svn-status-get-specific-revision t]
- ["svn add" svn-status-add-file t]
- ["svn mkdir..." svn-status-make-directory t]
- ["svn mv..." svn-status-mv t]
- ["svn rm..." svn-status-rm t]
- ["Up Directory" svn-status-examine-parent t]
- ["Elide Directory" svn-status-toggle-elide t]
- ["svn revert" svn-status-revert t]
- ["svn resolved" svn-status-resolved t]
- ["svn cleanup" svn-status-cleanup t]
- ["Show Process Buffer" svn-status-show-process-buffer t]
- ("Property"
- ["svn proplist" svn-status-property-list t]
- ["Set Multiple Properties..." svn-status-property-set t]
- ["Edit One Property..." svn-status-property-edit-one-entry t]
- ["svn propdel..." svn-status-property-delete t]
- "---"
- ["svn:ignore File..." svn-status-property-ignore-file t]
- ["svn:ignore File Extension..." svn-status-property-ignore-file-extension t]
- ["Edit svn:ignore Property" svn-status-property-edit-svn-ignore t]
- "---"
- ["Set svn:keywords List" svn-status-property-set-keyword-list t]
- ["Set svn:eol-style" svn-status-property-set-eol-style t]
- )
- "---"
- ["Edit Next SVN Cmd Line" svn-status-toggle-edit-cmd-flag t]
- ["Work Directory History..." svn-status-use-history t]
- ["Mark" svn-status-set-user-mark t]
- ["Unmark" svn-status-unset-user-mark t]
- ("Mark / Unmark"
- ["Unmark all" svn-status-unset-all-usermarks t]
- ["Mark/Unmark unknown" svn-status-mark-unknown t]
- ["Mark/Unmark added" svn-status-mark-added t]
- ["Mark/Unmark modified" svn-status-mark-modified t]
- )
- ["Hide Unknown" svn-status-toggle-hide-unknown
- :style toggle :selected svn-status-hide-unknown]
- ["Hide Unmodified" svn-status-toggle-hide-unmodified
- :style toggle :selected svn-status-hide-unmodified]
- ))
-
-(defun svn-status-mode ()
- "Major mode used by psvn.el to process the output of \"svn status\".
-
-psvn.el is an interface for the revision control tool subversion
-\(see http://subversion.tigris.org).
-psvn.el provides a similar interface for subversion as pcl-cvs does for cvs.
-At the moment the following commands are implemented:
- M-x svn-status: run 'svn -status -v'
- and show the result in the *svn-status* buffer, this buffer uses the
- svn-status mode. In this mode the following keys are defined:
-\\{svn-status-mode-map}"
- (interactive)
- (kill-all-local-variables)
-
- (use-local-map svn-status-mode-map)
- (easy-menu-add svn-status-mode-menu)
-
- (setq major-mode 'svn-status-mode)
- (setq mode-name "svn-status")
- (setq mode-line-process 'svn-status-mode-line-process)
- (let ((view-read-only nil))
- (toggle-read-only 1)))
-
-(defun svn-status-update-mode-line ()
- (setq svn-status-mode-line-process
- (concat svn-status-mode-line-process-edit-flag svn-status-mode-line-process-status))
- (force-mode-line-update))
-
-(defun svn-status-bury-buffer (arg)
- "Bury the *svn-status* buffer.
-When called with a prefix argument, switch back to the window configuration that was
-in use before `svn-status' was called."
- (interactive "P")
- (cond (arg
- (when svn-status-initial-window-configuration
- (set-window-configuration svn-status-initial-window-configuration)))
- (t
- (let ((bl '("*svn-log-edit*" "*svn-property-edit*" "*svn-process*")))
- (while bl
- (when (get-buffer (car bl))
- (bury-buffer (car bl)))
- (setq bl (cdr bl)))
- (when (string= (buffer-name) "*svn-status*")
- (bury-buffer))))))
-
-(defun svn-status-find-files ()
- "Open selected file(s) for editing.
-See `svn-status-marked-files' for what counts as selected."
- (interactive)
- (let ((fnames (mapcar 'svn-status-line-info->full-path (svn-status-marked-files))))
- (mapc 'find-file fnames)))
-
-
-(defun svn-status-find-file-other-window ()
- "Open the file in the other window for editing."
- (interactive)
- (find-file-other-window (svn-status-line-info->filename
- (svn-status-get-line-information))))
-
-(defun svn-status-view-file-other-window ()
- "Open the file in the other window for viewing."
- (interactive)
- (view-file-other-window (svn-status-line-info->filename
- (svn-status-get-line-information))))
-
-(defun svn-status-find-file-or-examine-directory ()
- "If point is on a directory, run `svn-status' on that directory.
-Otherwise run `find-file'."
- (interactive)
- (let ((line-info (svn-status-get-line-information)))
- (if (svn-status-line-info->directory-p line-info)
- (svn-status (svn-status-line-info->full-path line-info))
- (find-file (svn-status-line-info->filename line-info)))))
-
-(defun svn-status-examine-parent ()
- "Run `svn-status' on the parent of the current directory."
- (interactive)
- (svn-status (expand-file-name "../")))
-
-(defun svn-status-line-info->ui-status (line-info) (nth 0 line-info))
-
-(defun svn-status-line-info->has-usermark (line-info) (nth 0 (nth 0 line-info)))
-(defun svn-status-line-info->user-elide (line-info) (nth 1 (nth 0 line-info)))
-
-(defun svn-status-line-info->filemark (line-info) (nth 1 line-info))
-(defun svn-status-line-info->propmark (line-info) (nth 2 line-info))
-(defun svn-status-line-info->filename (line-info) (nth 3 line-info))
-(defun svn-status-line-info->filename-nondirectory (line-info)
- (file-name-nondirectory (svn-status-line-info->filename line-info)))
-(defun svn-status-line-info->localrev (line-info)
- (if (>= (nth 4 line-info) 0)
- (nth 4 line-info)
- nil))
-(defun svn-status-line-info->lastchangerev (line-info)
- "Return the last revision in which LINE-INFO was modified."
- (if (>= (nth 5 line-info) 0)
- (nth 5 line-info)
- nil))
-(defun svn-status-line-info->author (line-info) (nth 6 line-info))
-(defun svn-status-line-info->modified-external (line-info) (nth 7 line-info))
-
-(defun svn-status-line-info->is-visiblep (line-info)
- (not (or (svn-status-line-info->hide-because-unknown line-info)
- (svn-status-line-info->hide-because-unmodified line-info)
- (svn-status-line-info->hide-because-user-elide line-info))))
-
-(defun svn-status-line-info->hide-because-unknown (line-info)
- (and svn-status-hide-unknown
- (eq (svn-status-line-info->filemark line-info) ??)))
-
-(defun svn-status-line-info->hide-because-unmodified (line-info)
- ;;(message " %S %S %S %S - %s" svn-status-hide-unmodified (svn-status-line-info->propmark line-info) ?_
- ;; (svn-status-line-info->filemark line-info) (svn-status-line-info->filename line-info))
- (and svn-status-hide-unmodified
- (and (or (eq (svn-status-line-info->filemark line-info) ?_)
- (eq (svn-status-line-info->filemark line-info) ? ))
- (or (eq (svn-status-line-info->propmark line-info) ?_)
- (eq (svn-status-line-info->propmark line-info) ? )
- (eq (svn-status-line-info->propmark line-info) nil)))))
-
-(defun svn-status-line-info->hide-because-user-elide (line-info)
- (eq (svn-status-line-info->user-elide line-info) t))
-
-(defun svn-status-line-info->show-user-elide-continuation (line-info)
- (eq (svn-status-line-info->user-elide line-info) 'directory))
-
-;; modify the line-info
-(defun svn-status-line-info->set-filemark (line-info value)
- (setcar (nthcdr 1 line-info) value))
-
-(defun svn-status-toggle-elide ()
- (interactive)
- (let ((st-info svn-status-info)
- (fname)
- (test (svn-status-line-info->filename (svn-status-get-line-information)))
- (len-test)
- (len-fname)
- (new-elide-mark t)
- (elide-mark))
- (when (string= test ".")
- (setq test ""))
- (setq len-test (length test))
- (while st-info
- (setq fname (svn-status-line-info->filename (car st-info)))
- (setq len-fname (length fname))
- (when (and (>= len-fname len-test)
- (string= (substring fname 0 len-test) test))
- ;;(message "elide: %s %s" fname (svn-status-line-info->user-elide (car st-info)))
- (setq elide-mark new-elide-mark)
- (when (or (string= fname ".")
- (and (= len-fname len-test) (svn-status-line-info->directory-p (car st-info))))
- (message "Elide directory %s and all its files." fname)
- (setq new-elide-mark (not (svn-status-line-info->user-elide (car st-info))))
- (setq elide-mark (if new-elide-mark 'directory nil)))
- (setcar (nthcdr 1 (svn-status-line-info->ui-status (car st-info))) elide-mark))
- (setq st-info (cdr st-info))))
- (svn-status-update-buffer))
-
-
-(defun svn-status-line-info->directory-p (line-info)
- "Return t if LINE-INFO refers to a directory, nil otherwise.
-Symbolic links to directories count as directories (see `file-directory-p')."
- (file-directory-p (svn-status-line-info->filename line-info)))
-
-(defun svn-status-line-info->full-path (line-info)
- "Return the full path of the file represented by LINE-INFO."
- (expand-file-name
- (svn-status-line-info->filename line-info)))
-
-;;Not convinced that this is the fastest way, but...
-(defun svn-status-count-/ (string)
- "Return number of \"/\"'s in STRING."
- (let ((n 0)
- (last 0))
- (while (setq last (string-match "/" string (1+ last)))
- (setq n (1+ n)))
- n))
-
-(defun svn-insert-line-in-status-buffer (line-info)
- "Format LINE-INFO and insert the result in the current buffer."
- (let ((usermark (if (svn-status-line-info->has-usermark line-info) "*" " "))
- (external (if (svn-status-line-info->modified-external line-info)
- (svn-add-face (if svn-status-short-mod-flag-p
- "** "
- " (modified external)")
- 'svn-status-modified-external-face)
- (if svn-status-short-mod-flag-p " " "")))
- ;; To add indentation based on the
- ;; directory that the file is in, we just insert 2*(number of "/" in
- ;; filename) spaces, which is rather hacky (but works)!
- (filename (svn-status-choose-face-to-add
- (svn-status-line-info->directory-p line-info)
- (concat (make-string
- (* 2 (svn-status-count-/
- (svn-status-line-info->filename line-info)))
- 32)
- (if svn-status-hide-unmodified
- (svn-status-line-info->filename line-info)
- (svn-status-line-info->filename-nondirectory line-info)))
- 'svn-status-directory-face
- 'svn-status-filename-face))
- (elide-hint (if (svn-status-line-info->show-user-elide-continuation line-info) " ..." "")))
- (insert (svn-status-maybe-add-face
- (svn-status-line-info->has-usermark line-info)
- (concat usermark
- (format svn-status-line-format
- (svn-status-line-info->filemark line-info)
- (or (svn-status-line-info->propmark line-info) ? )
- (or (svn-status-line-info->localrev line-info) "")
- (or (svn-status-line-info->lastchangerev line-info) "")
- (svn-status-line-info->author line-info)))
- 'svn-status-marked-face)
- (if svn-status-short-mod-flag-p external filename)
- (if svn-status-short-mod-flag-p filename external)
- elide-hint
- "\n")))
-
-(defun svn-status-update-buffer ()
- (interactive)
- ;(message (format "buffer-name: %s" (buffer-name)))
- (unless (string= (buffer-name) "*svn-status*")
- (delete-other-windows)
- (split-window-vertically)
- (switch-to-buffer "*svn-status*"))
- (svn-status-mode)
- (let ((st-info svn-status-info)
- (buffer-read-only nil)
- (start-pos)
- (overlay)
- (unmodified-count 0)
- (unknown-count 0)
- (marked-count 0)
- (fname (svn-status-line-info->filename (svn-status-get-line-information)))
- (fname-pos (point))
- (column (current-column)))
- (delete-region (point-min) (point-max))
- (insert "\n")
- ;; Insert all files and directories
- (while st-info
- (setq start-pos (point))
- (cond ((svn-status-line-info->has-usermark (car st-info))
- ;; Show a marked file always
- (svn-insert-line-in-status-buffer (car st-info)))
- ((svn-status-line-info->hide-because-user-elide (car st-info))
- );(message "user wanted to hide %s" (svn-status-line-info->filename (car st-info))))
- ((svn-status-line-info->hide-because-unknown (car st-info))
- (setq unknown-count (+ unknown-count 1)))
- ((svn-status-line-info->hide-because-unmodified (car st-info))
- (setq unmodified-count (+ unmodified-count 1)))
- (t
- (svn-insert-line-in-status-buffer (car st-info))))
- (when (svn-status-line-info->has-usermark (car st-info))
- (setq marked-count (+ marked-count 1)))
- (setq overlay (make-overlay start-pos (point)))
- (overlay-put overlay 'svn-info (car st-info))
- (setq st-info (cdr st-info)))
- ;; Insert status information at the buffer beginning
- (goto-char (point-min))
- (insert (format "svn status for directory %s%s\n"
- default-directory
- (if svn-status-head-revision (format " (status against revision: %s)"
- svn-status-head-revision)
- "")))
- (when svn-status-base-info
- (insert (concat "Repository: " (svn-status-base-info->url) "\n")))
- (when svn-status-hide-unknown
- (insert
- (format "%d Unknown files are hidden - press ? to toggle hiding\n"
- unknown-count)))
- (when svn-status-hide-unmodified
- (insert
- (format "%d Unmodified files are hidden - press _ to toggle hiding\n"
- unmodified-count)))
- (insert (format "%d files marked\n" marked-count))
- (setq svn-start-of-file-list-line-number (+ (count-lines (point-min) (point)) 1))
- (if fname
- (progn
- (goto-char fname-pos)
- (svn-status-goto-file-name fname)
- (goto-char (+ column (point-at-bol))))
- (goto-char (+ (next-overlay-change (point-min)) svn-status-default-column)))))
-
-(defun svn-status-parse-info (arg)
- "Parse the svn info output for the base directory.
-Show the repository url after this call in the *svn-status* buffer.
-When called with the prefix argument 0, reset the information to nil.
-This hides the repository information again."
- (interactive "P")
- (if (eq arg 0)
- (setq svn-status-base-info nil)
- (svn-run-svn nil t 'parse-info "info" ".")
- (svn-status-parse-info-result))
- (svn-status-update-buffer))
-
-(defun svn-status-parse-info-result ()
- (let ((url))
- (save-excursion
- (set-buffer "*svn-process*")
- (goto-char (point-min))
- (search-forward "Url: ")
- (setq url (buffer-substring-no-properties (point) (point-at-eol))))
- (setq svn-status-base-info `((url ,url)))))
-
-(defun svn-status-base-info->url ()
- (if svn-status-base-info
- (cadr (assoc 'url svn-status-base-info))
- ""))
-
-(defun svn-status-toggle-edit-cmd-flag (&optional reset)
- (interactive)
- (cond ((or reset (eq svn-status-edit-svn-command 'sticky))
- (setq svn-status-edit-svn-command nil))
- ((eq svn-status-edit-svn-command nil)
- (setq svn-status-edit-svn-command t))
- ((eq svn-status-edit-svn-command t)
- (setq svn-status-edit-svn-command 'sticky)))
- (cond ((eq svn-status-edit-svn-command t)
- (setq svn-status-mode-line-process-edit-flag " EditCmd"))
- ((eq svn-status-edit-svn-command 'sticky)
- (setq svn-status-mode-line-process-edit-flag " EditCmd#"))
- (t
- (setq svn-status-mode-line-process-edit-flag "")))
- (svn-status-update-mode-line))
-
-(defun svn-status-goto-root-or-return ()
- "Bounce point between the root (\".\") and the current line."
- (interactive)
- (if (string= (svn-status-line-info->filename (svn-status-get-line-information)) ".")
- (when svn-status-root-return-info
- (svn-status-goto-file-name
- (svn-status-line-info->filename svn-status-root-return-info)))
- (setq svn-status-root-return-info (svn-status-get-line-information))
- (svn-status-goto-file-name ".")))
-
-(defun svn-status-next-line (nr-of-lines)
- (interactive "p")
- (next-line nr-of-lines)
- (when (svn-status-get-line-information)
- (goto-char (+ (point-at-bol) svn-status-default-column))))
-
-(defun svn-status-previous-line (nr-of-lines)
- (interactive "p")
- (previous-line nr-of-lines)
- (when (svn-status-get-line-information)
- (goto-char (+ (point-at-bol) svn-status-default-column))))
-
-(defun svn-status-update (&optional arg)
- "Run 'svn status -v'.
-When called with a prefix argument run 'svn status -vu'."
- (interactive "P")
- (unless (interactive-p)
- (save-excursion
- (set-buffer "*svn-process*")
- (setq svn-status-update-previous-process-output (buffer-substring (point-min) (point-max)))))
- (svn-status default-directory arg))
-
-(defun svn-status-get-line-information ()
- "Find out about the file under point.
-The result may be parsed with the various `svn-status-line-info->...' functions."
- (let ((overlay (car (overlays-at (point)))))
- (when overlay
- (overlay-get overlay 'svn-info))))
-
-(defun svn-status-get-file-list (use-marked-files)
- "Get either the marked files or the files, where the cursor is on."
- (if use-marked-files
- (svn-status-marked-files)
- (list (svn-status-get-line-information))))
-
-(defun svn-status-get-file-list-names (use-marked-files)
- (mapcar 'svn-status-line-info->filename (svn-status-get-file-list use-marked-files)))
-
-(defun svn-status-select-line ()
- (interactive)
- (let ((info (svn-status-get-line-information)))
- (if info
- (message "%S %S %S" info (svn-status-line-info->hide-because-unknown info)
- (svn-status-line-info->hide-because-unmodified info))
- (message "No file on this line"))))
-
-(defun svn-status-directory-containing-point (allow-self)
- "Find the (full path of) directory containing the file under point.
-
-If ALLOW-SELF and the file is a directory, return that directory,
-otherwise return the directory containing the file under point."
- ;;the first `or' below is because s-s-g-l-i returns `nil' if
- ;;point was outside the file list, but we need
- ;;s-s-l-i->f to return a string to add to `default-directory'.
- (let ((line-info (or (svn-status-get-line-information)
- '(nil nil nil ""))))
- (file-name-as-directory
- (expand-file-name
- (if (and allow-self (svn-status-line-info->directory-p line-info))
- (svn-status-line-info->filename line-info)
- ;;The next `or' is because (file-name-directory "file") returns nil
- (or (file-name-directory (svn-status-line-info->filename line-info))
- "."))))))
-
-(defun svn-status-set-user-mark (arg)
- "Set a user mark on the current file or directory.
-If the cursor is on a file this file is marked and the cursor advances to the next line.
-If the cursor is on a directory all files in this directory are marked.
-
-If this function is called with a prefix argument, only the current line is
-marked, even if it is a directory."
- (interactive "P")
- (let ((info (svn-status-get-line-information)))
- (if info
- (progn
- (svn-status-apply-usermark t arg)
- (svn-status-next-line 1))
- (message "No file on this line - cannot set a mark"))))
-
-(defun svn-status-unset-user-mark (arg)
- "Remove a user mark on the current file or directory.
-If the cursor is on a file, this file is unmarked and the cursor advances to the next line.
-If the cursor is on a directory, all files in this directory are unmarked.
-
-If this function is called with a prefix argument, only the current line is
-unmarked, even if is a directory."
- (interactive "P")
- (let ((info (svn-status-get-line-information)))
- (if info
- (progn
- (svn-status-apply-usermark nil arg)
- (svn-status-next-line 1))
- (message "No file on this line - cannot unset a mark"))))
-
-(defun svn-status-unset-user-mark-backwards ()
- "Remove a user mark from the previous file.
-Then move to that line."
- ;; This is consistent with `dired-unmark-backward' and
- ;; `cvs-mode-unmark-up'.
- (interactive)
- (let ((info (save-excursion
- (svn-status-next-line -1)
- (svn-status-get-line-information))))
- (if info
- (progn
- (svn-status-next-line -1)
- (svn-status-apply-usermark nil t))
- (message "No file on previous line - cannot unset a mark"))))
-
-(defun svn-status-apply-usermark (set-mark only-this-line)
- "Do the work for the various marking/unmarking functions."
- (let* ((st-info svn-status-info)
- (line-info (svn-status-get-line-information))
- (file-name (svn-status-line-info->filename line-info))
- (sub-file-regexp (concat "^" (regexp-quote
- (file-name-as-directory file-name))))
- (newcursorpos-fname)
- (i-fname)
- (current-line svn-start-of-file-list-line-number))
- (while st-info
- (when (svn-status-line-info->is-visiblep (car st-info))
- (setq current-line (1+ current-line)))
- (setq i-fname (svn-status-line-info->filename (car st-info)))
- (when (or (string= file-name i-fname)
- (string-match sub-file-regexp i-fname))
- (when (svn-status-line-info->is-visiblep (car st-info))
- (when (or (not only-this-line) (string= file-name i-fname))
- (setq newcursorpos-fname i-fname)
- (if set-mark
- (message "marking: %s" i-fname)
- (message "unmarking: %s" i-fname))
- ;;(message "ui-status: %S" (svn-status-line-info->ui-status (car st-info)))
- (setcar (svn-status-line-info->ui-status (car st-info)) set-mark)
- (save-excursion
- (let ((buffer-read-only nil))
- (goto-line current-line)
- (delete-region (point-at-bol) (point-at-eol))
- (svn-insert-line-in-status-buffer (car st-info))
- (delete-char 1))))))
- (setq st-info (cdr st-info)))
- ;;(svn-status-update-buffer)
- (svn-status-goto-file-name newcursorpos-fname)))
-
-(defun svn-status-apply-usermark-checked (check-function set-mark)
- "Mark or unmark files, whether a given function returns t.
-The function is called with the line information. Therefore the svnstatus-line-info->* functions can be
-used in the check."
- (let ((st-info svn-status-info))
- (while st-info
- (when (apply check-function (list (car st-info)))
- (if set-mark
- (when (not (svn-status-line-info->has-usermark (car st-info)))
- (message "marking: %s" (svn-status-line-info->filename (car st-info))))
- (when (svn-status-line-info->has-usermark (car st-info))
- (message "unmarking: %s" (svn-status-line-info->filename (car st-info)))))
- (setcar (svn-status-line-info->ui-status (car st-info)) set-mark))
- (setq st-info (cdr st-info)))
- (svn-status-update-buffer)))
-
-(defun svn-status-mark-unknown (arg)
- "Mark all unknown files.
-These are the files marked with '?' in the *svn-status* buffer.
-If the function is called with a prefix arg, unmark all these files."
- (interactive "P")
- (svn-status-apply-usermark-checked '(lambda (info) (eq (svn-status-line-info->filemark info) ??)) (not arg)))
-
-(defun svn-status-mark-added (arg)
- "Mark all added files.
-These are the files marked with 'A' in the *svn-status* buffer.
-If the function is called with a prefix arg, unmark all these files."
- (interactive "P")
- (svn-status-apply-usermark-checked '(lambda (info) (eq (svn-status-line-info->filemark info) ?A)) (not arg)))
-
-(defun svn-status-mark-modified (arg)
- "Mark all modified files.
-These are the files marked with 'M' in the *svn-status* buffer.
-If the function is called with a prefix arg, unmark all these files."
- (interactive "P")
- (svn-status-apply-usermark-checked '(lambda (info) (eq (svn-status-line-info->filemark info) ?M)) (not arg)))
-
-(defun svn-status-unset-all-usermarks ()
- (interactive)
- (svn-status-apply-usermark-checked '(lambda (info) t) nil))
-
-(defun svn-status-toggle-hide-unknown ()
- (interactive)
- (setq svn-status-hide-unknown (not svn-status-hide-unknown))
- (svn-status-update-buffer))
-
-(defun svn-status-toggle-hide-unmodified ()
- (interactive)
- (setq svn-status-hide-unmodified (not svn-status-hide-unmodified))
- (svn-status-update-buffer))
-
-(defun svn-status-goto-file-name (name)
- ;; (message "svn-status-goto-file-name: %s %d" name (point))
- (let ((start-pos (point)))
- (goto-char (point-min))
- (while (< (point) (point-max))
- (goto-char (next-overlay-change (point)))
- (when (string= name (svn-status-line-info->filename
- (svn-status-get-line-information)))
- (setq start-pos (+ (point) svn-status-default-column))))
- (goto-char start-pos)))
-
-(defun svn-status-find-info-for-file-name (name)
- (let* ((st-info svn-status-info)
- (info))
- (while st-info
- (when (string= name (svn-status-line-info->filename (car st-info)))
- (setq info (car st-info))
- (setq st-info nil)) ; terminate loop
- (setq st-info (cdr st-info)))
- info))
-
-(defun svn-status-marked-files ()
- "Return all files marked by `svn-status-set-user-mark',
-or (if no files were marked) the file under point."
- (let* ((st-info svn-status-info)
- (file-list))
- (while st-info
- (when (svn-status-line-info->has-usermark (car st-info))
- (setq file-list (append file-list (list (car st-info)))))
- (setq st-info (cdr st-info)))
- (or file-list
- (if (svn-status-get-line-information)
- (list (svn-status-get-line-information))
- nil))))
-
-(defun svn-status-marked-file-names ()
- (mapcar 'svn-status-line-info->filename (svn-status-marked-files)))
-
-(defun svn-status-ui-information-hash-table ()
- (let ((st-info svn-status-info)
- (svn-status-ui-information (make-hash-table :test 'equal)))
- (while st-info
- (puthash (svn-status-line-info->filename (car st-info))
- (svn-status-line-info->ui-status (car st-info))
- svn-status-ui-information)
- (setq st-info (cdr st-info)))
- svn-status-ui-information))
-
-
-(defun svn-status-create-arg-file (file-name prefix file-info-list postfix)
- (with-temp-file file-name
- (insert prefix)
- (let ((st-info file-info-list))
- (while st-info
- (insert (svn-status-line-info->filename (car st-info)))
- (insert "\n")
- (setq st-info (cdr st-info)))
-
- (insert postfix))))
-
-(defun svn-status-show-process-buffer-internal (&optional scroll-to-top)
- (when (eq (current-buffer) "*svn-status*")
- (delete-other-windows))
- (pop-to-buffer "*svn-process*")
- (when svn-status-wash-control-M-in-process-buffers
- (svn-status-remove-control-M))
- (when scroll-to-top
- (goto-char (point-min)))
- (other-window 1))
-
-(defun svn-status-show-svn-log (arg)
- "Run `svn log' on selected files.
-When called with a prefix argument add the following command switches:
- no prefix: use whatever is in the string `svn-status-default-log-arguments'
- prefix argument of -1: use no arguments
- prefix argument of 0: use the -q switch (quiet)
- other prefix arguments: use the -v switch (verbose)
-
-See `svn-status-marked-files' for what counts as selected."
- (interactive "P")
- (let ((switch (cond ((eq arg 0) "-q")
- ((eq arg -1) "")
- (arg "-v")
- (t svn-status-default-log-arguments))))
- ;;(message "show log info for: %S" (svn-status-marked-files))
- (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "")
- (if (> (length switch) 0)
- (svn-run-svn t t 'log "log" "--targets" svn-status-temp-arg-file switch)
- (svn-run-svn t t 'log "log" "--targets" svn-status-temp-arg-file))
- (save-excursion
- (set-buffer "*svn-process*")
- (svn-log-view-mode))))
-
-(defun svn-status-info ()
- "Run `svn info' on all selected files.
-See `svn-status-marked-files' for what counts as selected."
- (interactive)
- (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "")
- (svn-run-svn t t 'info "info" "--targets" svn-status-temp-arg-file))
-
-;; Todo: add possiblity to specify the revision
-(defun svn-status-blame ()
- "Run `svn blame' on the current file."
- (interactive)
- ;;(svn-run-svn t t 'blame "blame" "-r" "BASE" (svn-status-line-info->filename (svn-status-get-line-information))))
- (svn-run-svn t t 'blame "blame" (svn-status-line-info->filename (svn-status-get-line-information))))
-
-(defun svn-status-show-svn-diff (arg)
- "Run `svn diff' on the current file.
-If there is a newer revision in the repository, the diff is done against HEAD, otherwise
-compare the working copy with BASE.
-If ARG then prompt for revision to diff against."
- (interactive "P")
- (svn-status-show-svn-diff-internal arg nil))
-
-(defun svn-status-show-svn-diff-for-marked-files (arg)
- "Run `svn diff' on all selected files.
-See `svn-status-marked-files' for what counts as selected.
-If ARG then prompt for revision to diff against, else compare working copy with BASE."
- (interactive "P")
- (svn-status-show-svn-diff-internal arg t))
-
-(defun svn-status-show-svn-diff-internal (arg &optional use-all-marked-files)
- (let* ((fl (if use-all-marked-files
- (svn-status-marked-files)
- (list (svn-status-get-line-information))))
- (clear-buf t)
- (revision (if arg
- (svn-status-read-revision-string "Diff with files for version: " "PREV")
- (if use-all-marked-files
- "BASE"
- (if (svn-status-line-info->modified-external (car fl)) "HEAD" "BASE")))))
- (while fl
- (svn-run-svn nil clear-buf 'diff "diff" "-r" revision (svn-status-line-info->filename (car fl)))
- (setq clear-buf nil)
- (setq fl (cdr fl))))
- (svn-status-show-process-buffer-internal t)
- (save-excursion
- (set-buffer "*svn-process*")
- (diff-mode)
- (font-lock-fontify-buffer)))
-
-(defun svn-status-show-process-buffer ()
- (interactive)
- (svn-status-show-process-buffer-internal))
-
-(defun svn-status-add-file-recursively (arg)
- "Run `svn add' on all selected files.
-When a directory is added, add files recursively.
-See `svn-status-marked-files' for what counts as selected.
-When this function is called with a prefix argument, use the actual file instead."
- (interactive "P")
- (message "adding: %S" (svn-status-get-file-list-names (not arg)))
- (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-get-file-list (not arg)) "")
- (svn-run-svn t t 'add "add" "--targets" svn-status-temp-arg-file))
-
-(defun svn-status-add-file (arg)
- "Run `svn add' on all selected files.
-When a directory is added, don't add the files of the directory
- (svn add --non-recursive <file-list> is called).
-See `svn-status-marked-files' for what counts as selected.
-When this function is called with a prefix argument, use the actual file instead."
- (interactive "P")
- (message "adding: %S" (svn-status-get-file-list-names (not arg)))
- (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-get-file-list (not arg)) "")
- (svn-run-svn t t 'add "add" "--non-recursive" "--targets" svn-status-temp-arg-file))
-
-(defun svn-status-make-directory (dir)
- "Run `svn mkdir DIR'."
- ;; TODO: Allow entering a URI interactively.
- ;; Currently, `read-file-name' corrupts it.
- (interactive (list (read-file-name "Make directory: "
- (svn-status-directory-containing-point t))))
- (unless (string-match "^[^:/]+://" dir) ; Is it a URI?
- (setq dir (file-relative-name dir)))
- (svn-run-svn t t 'mkdir "mkdir" "--" dir))
-
-;;TODO: write a svn-status-cp similar to this---maybe a common
-;;function to do both?
-(defun svn-status-mv ()
- "Prompt for a destination, and `svn mv' selected files there.
-See `svn-status-marked-files' for what counts as `selected'.
-
-If one file was selected then the destination DEST should be a
-filename to rename the selected file to, or a directory to move the
-file into; if multiple files were selected then DEST should be a
-directory to move the selected files into.
-
-The default DEST is the directory containing point.
-
-BUG: If we've marked some directory containging a file as well as the
-file itself, then we should just mv the directory, but this implementation
-doesn't check for that.
-SOLUTION: for each dir, umark all its contents (but not the dir
-itself) before running mv."
- (interactive)
- (let* ((marked-files (svn-status-marked-files))
- (num-of-files (length marked-files))
- original
- dest)
- (if (= 1 num-of-files)
- ;; one file to rename, prompt for new name, or directory to move the
- ;; file into.
- (setq dest (read-file-name (format "Rename %s to: "
- (svn-status-line-info->filename (car marked-files)))
- (svn-status-directory-containing-point t)))
- ;;multiple files selected, so prompt for existing directory to mv them into.
- (setq dest (read-directory-name (format "Move %d files to directory: " num-of-files)
- (svn-status-directory-containing-point t) nil t))
- (unless (file-directory-p dest)
- (error "%s is not a directory" dest)))
- (when (string= dest "")
- (error "No destination entered; no files moved"))
- (unless (string-match "^[^:/]+://" dest) ; Is it a URI?
- (setq dest (file-relative-name dest)))
-;
- ;;do the move: svn mv only lets us move things once at a time, so
- ;;we need to run svn mv once for each file (hence second arg to
- ;;svn-run-svn is nil.)
-
- ;;TODO: before doing any moving, For every marked directory,
- ;;ensure none of its contents are also marked, since we dont want
- ;;to move both file *and* its parent...
- ;; what about hidden files?? what if user marks a dir+contents, then presses `_' ??
-;; ;one solution:
-;; (dolist (original marked-files)
-;; (when (svn-status-line-info->directory-p original)
-;; ;; run svn-status-goto-file-name to move point to line of file
-;; ;; run svn-status-unset-user-mark to unmark dir+all contents
-;; ;; run svn-status-set-user-mark to remark dir
-;; ;; maybe check for local mods here, and unmark if user does't say --force?
-;; ))
- (dolist (original marked-files)
- (let ((original-name (svn-status-line-info->filename original))
- (original-filemarks (svn-status-line-info->filemark original))
- (original-propmarks (svn-status-line-info->propmark original)))
- (cond
- ((or (eq original-filemarks 77) ;;original has local mods: maybe do `svn mv --force'
- (eq original-propmarks 77)) ;;original has local prop mods: maybe do `svn mv --force'
- (if (yes-or-no-p (format "%s has local modifications; use `--force' to really move it? "
- original-name))
- (svn-run-svn nil t 'mv "mv" "--force" "--" original-name dest)
- (message "Not moving %s" original-name)))
- ((eq original-filemarks 63) ;;original is unversioned: maybe do plain `mv'
- (if (yes-or-no-p (format "%s is unversioned. Use plain `mv -i %s %s'? "
- original-name original-name dest))
- (call-process "mv" nil (get-buffer-create "*svn-process*") nil "-i" original-name dest)
- (message "Not moving %s" original-name)))
-
- ((eq original-filemarks 65) ;;original has `A' mark (eg it was `svn add'ed, but not committed)
- (message "Not moving %s (try committing it first)" original-name))
-
- ((eq original-filemarks 32) ;;original is unmodified: can use `svn mv'
- (svn-run-svn nil t 'mv "mv" "--" original-name dest))
-
- ;;file is conflicted in some way?
- (t
- (if (yes-or-no-p (format "The status of %s looks scary. Risk moving it anyway? " original-name))
- (svn-run-svn nil t 'mv "mv" "--" original-name dest)
- (message "Not moving %s" original-name))))))
- (svn-status-update)))
-
-(defun svn-status-revert ()
- "Run `svn revert' on all selected files.
-See `svn-status-marked-files' for what counts as selected."
- (interactive)
- (let* ((marked-files (svn-status-marked-files))
- (num-of-files (length marked-files)))
- (when (yes-or-no-p
- (if (= 1 num-of-files)
- (format "Revert %s? " (svn-status-line-info->filename (car marked-files)))
- (format "Revert %d files? " num-of-files)))
- (message "reverting: %S" (svn-status-marked-file-names))
- (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "")
- (svn-run-svn t t 'revert "revert" "--targets" svn-status-temp-arg-file))))
-
-(defun svn-status-rm (force)
- "Run `svn rm' on all selected files.
-See `svn-status-marked-files' for what counts as selected.
-When called with a prefix argument add the command line switch --force."
- (interactive "P")
- (let* ((marked-files (svn-status-marked-files))
- (num-of-files (length marked-files)))
- (when (yes-or-no-p
- (if (= 1 num-of-files)
- (format "%sRemove %s? " (if force "Force " "") (svn-status-line-info->filename (car marked-files)))
- (format "%sRemove %d files? " (if force "Force " "") num-of-files)))
- (message "removing: %S" (svn-status-marked-file-names))
- (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "")
- (if force
- (svn-run-svn t t 'rm "rm" "--force" "--targets" svn-status-temp-arg-file)
- (svn-run-svn t t 'rm "rm" "--targets" svn-status-temp-arg-file)))))
-
-(defun svn-status-update-cmd ()
- (interactive)
- ;TODO: use file names also
- (svn-run-svn t t 'update "update"))
-
-(defun svn-status-commit-file ()
- (interactive)
- (let* ((marked-files (svn-status-marked-files)))
- (setq svn-status-files-to-commit marked-files)
- (svn-log-edit-show-files-to-commit)
- (svn-status-pop-to-commit-buffer)))
-
-(defun svn-status-pop-to-commit-buffer ()
- (interactive)
- (setq svn-status-pre-commit-window-configuration (current-window-configuration))
- (let* ((use-existing-buffer (get-buffer "*svn-log-edit*"))
- (commit-buffer (get-buffer-create "*svn-log-edit*"))
- (dir default-directory))
- (pop-to-buffer commit-buffer)
- (setq default-directory dir)
- (unless use-existing-buffer
- (when (and svn-log-edit-file-name (file-readable-p svn-log-edit-file-name))
- (insert-file svn-log-edit-file-name)))
- (svn-log-edit-mode)))
-
-(defun svn-status-cleanup ()
- (interactive)
- (let ((file-names (svn-status-marked-file-names)))
- (if file-names
- (progn
- ;(message "svn-status-cleanup %S" file-names))
- (svn-run-svn t t 'cleanup (append (list "cleanup") file-names)))
- (message "No valid file selected - No status cleanup possible"))))
-
-(defun svn-status-resolved ()
- "Run `svn resolved' on all selected files.
-See `svn-status-marked-files' for what counts as selected."
- (interactive)
- (let* ((marked-files (svn-status-marked-files))
- (num-of-files (length marked-files)))
- (when (yes-or-no-p
- (if (= 1 num-of-files)
- (format "Resolve %s? " (svn-status-line-info->filename (car marked-files)))
- (format "Resolve %d files? " num-of-files)))
- (message "resolving: %S" (svn-status-marked-file-names))
- (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "")
- (svn-run-svn t t 'resolved "resolved" "--targets" svn-status-temp-arg-file))))
-
-;; --------------------------------------------------------------------------------
-;; Update the *svn-status* buffer, when a file is saved
-;; --------------------------------------------------------------------------------
-
-(defvar svn-status-file-modified-after-save-flag ?m
- "The flag, that is shown, in the *svn-status* buffer, after
-a file is changed and saved in emacs.
-Recommended values are ?m or ?M.")
-(defun svn-status-after-save-hook ()
- "Set a modified indication, when a file is saved from a svn working copy."
- (let* ((svn-dir (car-safe svn-status-directory-history))
- (svn-dir (when svn-dir (expand-file-name svn-dir)))
- (file-dir (file-name-directory (buffer-file-name)))
- (svn-dir-len (length (or svn-dir "")))
- (file-dir-len (length file-dir))
- (file-name))
- (when (and svn-dir
- (>= file-dir-len svn-dir-len)
- (string= (substring file-dir 0 svn-dir-len) svn-dir))
- (setq file-name (substring (buffer-file-name) svn-dir-len))
- ;;(message (format "In svn-status directory %S" file-name))
- (let ((st-info svn-status-info)
- (i-fname))
- (while st-info
- (setq i-fname (svn-status-line-info->filename (car st-info)))
- ;;(message (format "i-fname=%S" i-fname))
- (when (and (string= file-name i-fname)
- (not (eq (svn-status-line-info->filemark (car st-info)) ??)))
- (svn-status-line-info->set-filemark (car st-info)
- svn-status-file-modified-after-save-flag)
- (save-excursion
- (set-buffer "*svn-status*")
- (svn-status-goto-file-name i-fname)
- (let ((buffer-read-only nil))
- (delete-region (point-at-bol) (point-at-eol))
- (svn-insert-line-in-status-buffer (car st-info))
- (delete-char 1))))
- (setq st-info (cdr st-info))))))
- nil)
-
-(add-hook 'after-save-hook 'svn-status-after-save-hook)
-
-;; --------------------------------------------------------------------------------
-;; Getting older revisions
-;; --------------------------------------------------------------------------------
-
-(defun svn-status-get-specific-revision (arg)
- "Retrieve older revisions.
-The older revisions are stored in backup files named F.~REVISION~.
-
-When the function is called without a prefix argument: get all marked files.
-Otherwise get only the actual file."
- (interactive "P")
- (svn-status-get-specific-revision-internal (not arg) t))
-
-(defun svn-status-get-specific-revision-internal (&optional only-actual-file arg)
- (let* ((file-names (if only-actual-file
- (list (svn-status-line-info->filename (svn-status-get-line-information)))
- (svn-status-marked-file-names)))
- (revision (if arg (svn-status-read-revision-string "Get files for version: " "PREV") "BASE"))
- (file-name)
- (file-name-with-revision))
- (message "Getting revision %s for %S" revision file-names)
- (setq svn-status-get-specific-revision-file-info nil)
- (while file-names
- (setq file-name (car file-names))
- (setq file-name-with-revision (concat file-name ".~" revision "~"))
- (add-to-list 'svn-status-get-specific-revision-file-info
- (cons file-name file-name-with-revision))
- (save-excursion
- (find-file file-name-with-revision)
- (setq buffer-read-only nil)
- (delete-region (point-min) (point-max))
- (svn-run-svn nil t 'cat (append (list "cat" "-r" revision) (list file-name)))
- ;;todo: error processing
- ;;svn: Filesystem has no item
- ;;svn: file not found: revision `15', path `/trunk/file.txt'
- (insert-buffer-substring "*svn-process*")
- (save-buffer))
- (setq file-names (cdr file-names)))
- (setq svn-status-get-specific-revision-file-info
- (nreverse svn-status-get-specific-revision-file-info))
- (message "svn-status-get-specific-revision-file-info: %S"
- svn-status-get-specific-revision-file-info)))
-
-
-(defun svn-status-ediff-with-revision (arg)
- "Run ediff on the current file with a previous revision.
-If ARG then prompt for revision to diff against."
- (interactive "P")
- (svn-status-get-specific-revision-internal t arg)
- (let* ((ediff-after-quit-destination-buffer (current-buffer))
- (my-buffer (find-file-noselect (caar svn-status-get-specific-revision-file-info)))
- (base-buff (find-file-noselect (cdar svn-status-get-specific-revision-file-info)))
- (svn-transient-buffers (list base-buff ))
- (startup-hook '(svn-ediff-startup-hook)))
- (ediff-buffers my-buffer base-buff startup-hook)))
-
-(defun svn-ediff-startup-hook ()
- (add-hook 'ediff-after-quit-hook-internal
- `(lambda ()
- (svn-ediff-exit-hook
- ',ediff-after-quit-destination-buffer ',svn-transient-buffers))
- nil 'local))
-
-(defun svn-ediff-exit-hook (svn-buf tmp-bufs)
- ;; kill the temp buffers (and their associated windows)
- (dolist (tb tmp-bufs)
- (when (and tb (buffer-live-p tb) (not (buffer-modified-p tb)))
- (let ((win (get-buffer-window tb t)))
- (when win (delete-window win))
- (kill-buffer tb))))
- ;; switch back to the *svn* buffer
- (when (and svn-buf (buffer-live-p svn-buf)
- (not (get-buffer-window svn-buf t)))
- (ignore-errors (switch-to-buffer svn-buf))))
-
-
-(defun svn-status-read-revision-string (prompt &optional default-value)
- "Prompt the user for a svn revision number."
- (interactive)
- (read-string prompt default-value))
-
-;; --------------------------------------------------------------------------------
-;; SVN process handling
-;; --------------------------------------------------------------------------------
-
-(defun svn-process-kill ()
- "Kill the current running svn process."
- (interactive)
- (let ((process (get-process "svn")))
- (if process
- (delete-process process)
- (message "No running svn process"))))
-
-(defun svn-process-send-string (string)
- "Send a string to the running svn process.
-This is useful, if the running svn process asks the user a question.
-Note: use C-q C-j to send a line termination character."
- (interactive "sSend string to svn process: ")
- (save-excursion
- (set-buffer "*svn-process*")
- (let ((buffer-read-only nil))
- (insert string))
- (set-marker (process-mark (get-process "svn")) (point)))
- (process-send-string "svn" string))
-
-;; --------------------------------------------------------------------------------
-;; Property List stuff
-;; --------------------------------------------------------------------------------
-
-(defun svn-status-property-list ()
- (interactive)
- (let ((file-names (svn-status-marked-file-names)))
- (if file-names
- (progn
- (svn-run-svn t t 'proplist (append (list "proplist" "-v") file-names)))
- (message "No valid file selected - No property listing possible"))))
-
-(defun svn-status-proplist-start ()
- (svn-run-svn t t 'proplist-parse "proplist" (svn-status-line-info->filename
- (svn-status-get-line-information))))
-
-(defun svn-status-property-parse ()
- (interactive)
- (svn-status-proplist-start))
-
-(defun svn-status-property-edit-one-entry (arg)
- "Edit a property.
-When called with a prefix argument, it is possible to enter a new property."
- (interactive "P")
- (setq svn-status-property-edit-must-match-flag (not arg))
- (svn-status-proplist-start))
-
-(defun svn-status-property-set ()
- (interactive)
- (setq svn-status-property-edit-must-match-flag nil)
- (svn-status-proplist-start))
-
-(defun svn-status-property-delete ()
- (interactive)
- (setq svn-status-property-edit-must-match-flag t)
- (svn-status-proplist-start))
-
-(defun svn-status-property-parse-property-names ()
- ;(svn-status-show-process-buffer-internal t)
- (message "svn-status-property-parse-property-names")
- (let ((pl)
- (pfl)
- (prop-name)
- (prop-value))
- (save-excursion
- (set-buffer "*svn-process*")
- (goto-char (point-min))
- (forward-line 1)
- (while (looking-at " \\(.+\\)")
- (setq pl (append pl (list (match-string 1))))
- (forward-line 1)))
- ;(cond last-command: svn-status-property-set, svn-status-property-edit-one-entry
- ;svn-status-property-parse:
- (cond ((eq last-command 'svn-status-property-parse)
- ;(message "%S %S" pl last-command)
- (while pl
- (svn-run-svn nil t 'propget-parse "propget" (car pl)
- (svn-status-line-info->filename
- (svn-status-get-line-information)))
- (save-excursion
- (set-buffer "*svn-process*")
- (setq pfl (append pfl (list
- (list
- (car pl)
- (buffer-substring
- (point-min) (- (point-max) 1)))))))
- (setq pl (cdr pl))
- (message "%S" pfl)))
- ((eq last-command 'svn-status-property-edit-one-entry)
- ;;(message "svn-status-property-edit-one-entry")
- (setq prop-name
- (completing-read "Set Property - Name: " (mapcar 'list pl)
- nil svn-status-property-edit-must-match-flag))
- (unless (string= prop-name "")
- (save-excursion
- (set-buffer "*svn-status*")
- (svn-status-property-edit (list (svn-status-get-line-information))
- prop-name))))
- ((eq last-command 'svn-status-property-set)
- (message "svn-status-property-set")
- (setq prop-name
- (completing-read "Set Property - Name: " (mapcar 'list pl) nil nil))
- (setq prop-value (read-from-minibuffer "Property value: "))
- (unless (string= prop-name "")
- (save-excursion
- (set-buffer "*svn-status*")
- (message "setting property %s := %s for %S" prop-name prop-value
- (svn-status-marked-files)))))
- ((eq last-command 'svn-status-property-delete)
- (setq prop-name
- (completing-read "Delete Property - Name: " (mapcar 'list pl) nil t))
- (unless (string= prop-name "")
- (save-excursion
- (set-buffer "*svn-status*")
- (let ((file-names (svn-status-marked-file-names)))
- (when file-names
- (message "Going to delete prop %s for %s" prop-name file-names)
- (svn-run-svn t t 'propdel
- (append (list "propdel" prop-name) file-names))))))))))
-
-(defun svn-status-property-edit (file-info-list prop-name &optional new-prop-value)
- (let* ((commit-buffer (get-buffer-create "*svn-property-edit*"))
- (dir default-directory)
- ;; now only one file is implemented ...
- (file-name (svn-status-line-info->filename (car file-info-list)))
- (prop-value))
- (message "Edit property %s for file %s" prop-name file-name)
- (svn-run-svn nil t 'propget-parse "propget" prop-name file-name)
- (save-excursion
- (set-buffer "*svn-process*")
- (setq prop-value (if (> (point-max) 1)
- (buffer-substring (point-min) (- (point-max) 1))
- "")))
- (setq svn-status-propedit-property-name prop-name)
- (setq svn-status-propedit-file-list file-info-list)
- (setq svn-status-pre-propedit-window-configuration (current-window-configuration))
- (pop-to-buffer commit-buffer)
- (delete-region (point-min) (point-max))
- (setq default-directory dir)
- (insert prop-value)
- (svn-status-remove-control-M)
- (when new-prop-value
- (when (listp new-prop-value)
- (message "Adding new prop values %S " new-prop-value)
- (while new-prop-value
- (goto-char (point-min))
- (unless (re-search-forward
- (concat "^" (regexp-quote (car new-prop-value)) "$") nil t)
- (goto-char (point-max))
- (when (> (current-column) 0) (insert "\n"))
- (insert (car new-prop-value)))
- (setq new-prop-value (cdr new-prop-value)))))
- (svn-prop-edit-mode)))
-
-(defun svn-status-property-set-property (file-info-list prop-name prop-value)
- "Set a property on a given file list."
- (save-excursion
- (set-buffer (get-buffer "*svn-property-edit*"))
- (delete-region (point-min) (point-max))
- (insert prop-value))
- (setq svn-status-propedit-file-list (svn-status-marked-files))
- (setq svn-status-propedit-property-name prop-name)
- (svn-prop-edit-do-it nil)
- (svn-status-update))
-
-
-(defun svn-status-get-directory (line-info)
- (let* ((file-name (svn-status-line-info->filename line-info))
- (file-dir (file-name-directory file-name)))
- ;;(message "file-dir: %S" file-dir)
- (if file-dir
- (substring file-dir 0 (- (length file-dir) 1))
- ".")))
-
-(defun svn-status-get-file-list-per-directory (files)
- ;;(message "%S" files)
- (let ((dir-list nil)
- (i files)
- (j)
- (dir))
- (while i
- (setq dir (svn-status-get-directory (car i)))
- (setq j (assoc dir dir-list))
- (if j
- (progn
- ;;(message "dir already present %S %s" j dir)
- (setcdr j (append (cdr j) (list (car i)))))
- (setq dir-list (append dir-list (list (list dir (car i))))))
- (setq i (cdr i)))
- ;;(message "svn-status-get-file-list-per-directory: %S" dir-list)
- dir-list))
-
-(defun svn-status-property-ignore-file ()
- (interactive)
- (let ((d-list (svn-status-get-file-list-per-directory (svn-status-marked-files)))
- (dir)
- (f-info)
- (ext-list))
- (while d-list
- (setq dir (caar d-list))
- (setq f-info (cdar d-list))
- (setq ext-list (mapcar '(lambda (i)
- (svn-status-line-info->filename-nondirectory i)) f-info))
- ;;(message "ignore in dir %s: %S" dir f-info)
- (save-window-excursion
- (when (y-or-n-p (format "Ignore %S for %s? " ext-list dir))
- (svn-status-property-edit
- (list (svn-status-find-info-for-file-name dir)) "svn:ignore" ext-list)
- (svn-prop-edit-do-it nil))) ; synchronous
- (setq d-list (cdr d-list)))
- (svn-status-update)))
-
-(defun svn-status-property-ignore-file-extension ()
- (interactive)
- (let ((d-list (svn-status-get-file-list-per-directory (svn-status-marked-files)))
- (dir)
- (f-info)
- (ext-list))
- (while d-list
- (setq dir (caar d-list))
- (setq f-info (cdar d-list))
- ;;(message "ignore in dir %s: %S" dir f-info)
- (setq ext-list nil)
- (while f-info
- (add-to-list 'ext-list (concat "*."
- (file-name-extension
- (svn-status-line-info->filename (car f-info)))))
- (setq f-info (cdr f-info)))
- ;;(message "%S" ext-list)
- (save-window-excursion
- (when (y-or-n-p (format "Ignore %S for %s? " ext-list dir))
- (svn-status-property-edit
- (list (svn-status-find-info-for-file-name dir)) "svn:ignore"
- ext-list)
- (svn-prop-edit-do-it nil)))
- (setq d-list (cdr d-list)))
- (svn-status-update)))
-
-(defun svn-status-property-edit-svn-ignore ()
- (interactive)
- (let* ((line-info (svn-status-get-line-information))
- (dir (if (svn-status-line-info->directory-p line-info)
- (svn-status-line-info->filename line-info)
- (svn-status-get-directory line-info))))
- (svn-status-property-edit
- (list (svn-status-find-info-for-file-name dir)) "svn:ignore")
- (message "Edit svn:ignore on %s" dir)))
-
-
-(defun svn-status-property-set-keyword-list ()
- "Edit the svn:keywords property on the marked files."
- (interactive)
- ;;(message "Set svn:keywords for %S" (svn-status-marked-file-names))
- (svn-status-property-edit (svn-status-marked-files) "svn:keywords"))
-
-(defun svn-status-property-set-eol-style ()
- "Edit the svn:eol-style property on the marked files."
- (interactive)
- (svn-status-property-set-property
- (svn-status-marked-files) "svn:eol-style"
- (completing-read "Set svn:eol-style for the marked files: "
- (mapcar 'list '("native" "CRLF" "LF" "CR"))
- nil t)))
-
-;; --------------------------------------------------------------------------------
-;; svn-prop-edit-mode:
-;; --------------------------------------------------------------------------------
-
-(defvar svn-prop-edit-mode-map () "Keymap used in `svn-prop-edit-mode' buffers.")
-
-(when (not svn-prop-edit-mode-map)
- (setq svn-prop-edit-mode-map (make-sparse-keymap))
- (define-key svn-prop-edit-mode-map [(control ?c) (control ?c)] 'svn-prop-edit-done)
- (define-key svn-prop-edit-mode-map [(control ?c) (control ?d)] 'svn-prop-edit-svn-diff)
- (define-key svn-prop-edit-mode-map [(control ?c) (control ?s)] 'svn-prop-edit-svn-status)
- (define-key svn-prop-edit-mode-map [(control ?c) (control ?l)] 'svn-prop-edit-svn-log)
- (define-key svn-prop-edit-mode-map [(control ?c) (control ?q)] 'svn-prop-edit-abort))
-
-(easy-menu-define svn-prop-edit-mode-menu svn-prop-edit-mode-map
-"'svn-prop-edit-mode' menu"
- '("SVN-PropEdit"
- ["Commit" svn-prop-edit-done t]
- ["Show Diff" svn-prop-edit-svn-diff t]
- ["Show Status" svn-prop-edit-svn-status t]
- ["Show Log" svn-prop-edit-svn-log t]
- ["Abort" svn-prop-edit-abort t]))
-
-(defun svn-prop-edit-mode ()
- "Major Mode to edit file properties of files under svn control.
-Commands:
-\\{svn-prop-edit-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map svn-prop-edit-mode-map)
- (easy-menu-add svn-prop-edit-mode-menu)
- (setq major-mode 'svn-prop-edit-mode)
- (setq mode-name "svn-prop-edit"))
-
-(defun svn-prop-edit-abort ()
- (interactive)
- (bury-buffer)
- (set-window-configuration svn-status-pre-propedit-window-configuration))
-
-(defun svn-prop-edit-done ()
- (interactive)
- (svn-prop-edit-do-it t))
-
-(defun svn-prop-edit-do-it (async)
- (message "svn propset %s on %s"
- svn-status-propedit-property-name
- (mapcar 'svn-status-line-info->filename svn-status-propedit-file-list))
- (save-excursion
- (set-buffer (get-buffer "*svn-property-edit*"))
- (set-buffer-file-coding-system 'undecided-unix nil)
- (setq svn-status-temp-file-to-remove
- (concat svn-status-temp-dir "svn-prop-edit.txt" svn-temp-suffix))
- (write-region (point-min) (point-max) svn-status-temp-file-to-remove nil 1))
- (when svn-status-propedit-file-list ; there are files to change properties
- (svn-status-create-arg-file svn-status-temp-arg-file ""
- svn-status-propedit-file-list "")
- (setq svn-status-propedit-file-list nil)
- (svn-run-svn async t 'propset "propset"
- svn-status-propedit-property-name
- "--targets" svn-status-temp-arg-file
- "-F" (concat svn-status-temp-dir "svn-prop-edit.txt" svn-temp-suffix))
- (unless async (svn-status-remove-temp-file-maybe)))
- (set-window-configuration svn-status-pre-propedit-window-configuration))
-
-(defun svn-prop-edit-svn-diff (arg)
- (interactive "P")
- (set-buffer "*svn-status*")
- (svn-status-show-svn-diff-for-marked-files arg))
-
-(defun svn-prop-edit-svn-log (arg)
- (interactive "P")
- (set-buffer "*svn-status*")
- (svn-status-show-svn-log arg))
-
-(defun svn-prop-edit-svn-status ()
- (interactive)
- (pop-to-buffer "*svn-status*")
- (other-window 1))
-
-;; --------------------------------------------------------------------------------
-;; svn-log-edit-mode:
-;; --------------------------------------------------------------------------------
-
-(defvar svn-log-edit-mode-map () "Keymap used in `svn-log-edit-mode' buffers.")
-
-(when (not svn-log-edit-mode-map)
- (setq svn-log-edit-mode-map (make-sparse-keymap))
- (define-key svn-log-edit-mode-map (kbd "C-c C-c") 'svn-log-edit-done)
- (define-key svn-log-edit-mode-map (kbd "C-c C-d") 'svn-log-edit-svn-diff)
- (define-key svn-log-edit-mode-map (kbd "C-c C-s") 'svn-log-edit-save-message)
- (define-key svn-log-edit-mode-map (kbd "C-c C-i") 'svn-log-edit-svn-status)
- (define-key svn-log-edit-mode-map (kbd "C-c C-l") 'svn-log-edit-svn-log)
- (define-key svn-log-edit-mode-map (kbd "C-c C-?") 'svn-log-edit-show-files-to-commit)
- (define-key svn-log-edit-mode-map (kbd "C-c C-z") 'svn-log-edit-erase-edit-buffer)
- (define-key svn-log-edit-mode-map (kbd "C-c C-q") 'svn-log-edit-abort))
-
-(easy-menu-define svn-log-edit-mode-menu svn-log-edit-mode-map
-"'svn-log-edit-mode' menu"
- '("SVN-Log"
- ["Save to disk" svn-log-edit-save-message t]
- ["Commit" svn-log-edit-done t]
- ["Show Diff" svn-log-edit-svn-diff t]
- ["Show Status" svn-log-edit-svn-status t]
- ["Show Log" svn-log-edit-svn-log t]
- ["Show files to commit" svn-log-edit-show-files-to-commit t]
- ["Erase buffer" svn-log-edit-erase-edit-buffer]
- ["Abort" svn-log-edit-abort t]))
-
-(defun svn-log-edit-mode ()
- "Major Mode to edit svn log messages.
-Commands:
-\\{svn-log-edit-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map svn-log-edit-mode-map)
- (easy-menu-add svn-log-edit-mode-menu)
- (setq major-mode 'svn-log-edit-mode)
- (setq mode-name "svn-log-edit")
- (run-hooks 'svn-log-edit-mode-hook))
-
-(defun svn-log-edit-abort ()
- (interactive)
- (bury-buffer)
- (set-window-configuration svn-status-pre-commit-window-configuration))
-
-(defun svn-log-edit-done ()
- (interactive)
- (message "svn-log editing done")
- (save-excursion
- (set-buffer (get-buffer "*svn-log-edit*"))
- (set-buffer-file-coding-system 'undecided-unix nil)
- (write-region (point-min) (point-max)
- (concat svn-status-temp-dir "svn-log-edit.txt" svn-temp-suffix) nil 1))
- (when svn-status-files-to-commit ; there are files to commit
- (svn-status-create-arg-file svn-status-temp-arg-file ""
- svn-status-files-to-commit "")
- (setq svn-status-files-to-commit nil)
- (setq svn-status-temp-file-to-remove (concat svn-status-temp-dir "svn-log-edit.txt" svn-temp-suffix))
- (svn-run-svn t t 'commit "commit" "--targets" svn-status-temp-arg-file
- "-F" svn-status-temp-file-to-remove))
- (set-window-configuration svn-status-pre-commit-window-configuration))
-
-(defun svn-log-edit-svn-diff (arg)
- "Show the diff we are about to commit.
-If ARG then show diff between some other version of the selected files."
- (interactive "P")
- (set-buffer "*svn-status*")
- (svn-status-show-svn-diff-for-marked-files arg))
-
-(defun svn-log-edit-svn-log (arg)
- (interactive "P")
- (set-buffer "*svn-status*")
- (svn-status-show-svn-log arg))
-
-(defun svn-log-edit-svn-status ()
- (interactive)
- (pop-to-buffer "*svn-status*")
- (other-window 1))
-
-(defun svn-log-edit-show-files-to-commit ()
- (interactive)
- (message "Files to commit: %S"
- (mapcar 'svn-status-line-info->filename svn-status-files-to-commit)))
-
-(defun svn-log-edit-save-message ()
- "Save the current log message to the file `svn-log-edit-file-name'."
- (interactive)
- (write-region (point-min) (point-max) svn-log-edit-file-name))
-
-(defun svn-log-edit-erase-edit-buffer ()
- "Delete everything in the *svn-log-edit* buffer."
- (interactive)
- (set-buffer "*svn-log-edit*")
- (erase-buffer))
-
-
-;; --------------------------------------------------------------------------------
-;; svn-log-view-mode:
-;; --------------------------------------------------------------------------------
-
-(defvar svn-log-view-mode-map () "Keymap used in `svn-log-view-mode' buffers.")
-
-(when (not svn-log-view-mode-map)
- (setq svn-log-view-mode-map (make-sparse-keymap))
- (define-key svn-log-view-mode-map (kbd "p") 'svn-log-view-prev)
- (define-key svn-log-view-mode-map (kbd "n") 'svn-log-view-next)
- (define-key svn-log-view-mode-map (kbd "=") 'svn-log-view-diff)
- (define-key svn-log-view-mode-map (kbd "q") 'bury-buffer))
-(easy-menu-define svn-log-view-mode-menu svn-log-view-mode-map
-"'svn-log-view-mode' menu"
- '("SVN-LogView"
- ["Show Changeset" svn-log-view-diff t]))
-
-(defvar svn-log-view-font-lock-keywords
- '(("^r.+" . font-lock-keyword-face)
- "Keywords in svn-log-view-mode."))
-
-(define-derived-mode svn-log-view-mode log-view-mode "svn-log-view"
- "Major Mode to show the output from svn log.
-Commands:
-\\{svn-log-view-mode-map}
-"
- (use-local-map svn-log-view-mode-map)
- (easy-menu-add svn-log-view-mode-menu)
- (set (make-local-variable 'font-lock-defaults) '(svn-log-view-font-lock-keywords t)))
-
-(defun svn-log-view-next ()
- (interactive)
- (when (re-search-forward "^r[0-9]+" nil t)
- (beginning-of-line 3)))
-
-(defun svn-log-view-prev ()
- (interactive)
- (when (re-search-backward "^r[0-9]+" nil t 2)
- (beginning-of-line 3)))
-
-(defun svn-log-revision-at-point ()
- (save-excursion
- (re-search-backward "^r\\([0-9]+\\)")
- (match-string-no-properties 1)))
-
-(defun svn-log-view-diff (arg)
- "Show the changeset for a given log entry.
-When called with a prefix argument, ask the user for the revision."
- (interactive "P")
- (let* ((upper-rev (svn-log-revision-at-point))
- (lower-rev (number-to-string (- (string-to-number upper-rev) 1)))
- (rev-arg (concat lower-rev ":" upper-rev)))
- (when arg
- (setq rev-arg (read-string "Revision for changeset: " rev-arg)))
- (svn-run-svn nil t 'diff "diff" (concat "-r" rev-arg))
- (svn-status-show-process-buffer-internal t)
- (save-excursion
- (set-buffer "*svn-process*")
- (diff-mode)
- (font-lock-fontify-buffer))))
-
-(provide 'psvn)
-
-;;; psvn.el ends here
projects / lib.git / commitdiff