/emacs/elisp/psvn.el
Emacs Lisp | 4224 lines | 3346 code | 382 blank | 496 comment | 145 complexity | 90d3eb1b61bff1a0773ff6e4d7dc70ba MD5 | raw file
Large files files are truncated, but you can click here to view the full file
- ;;; psvn.el --- Subversion interface for emacs
- ;; Copyright (C) 2002-2006 by Stefan Reichoer
- ;; Author: Stefan Reichoer, <stefan@xsteve.at>
- ;; $Id: psvn.el 19791 2006-05-23 19:37:33Z 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, red hat el3 with svn 1.2.3
- ;; 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'
- ;; M-x svn-examine (like pcl-cvs cvs-examine) is alias for svn-status
- ;;
- ;; and show the result in the svn-status-buffer-name buffer (normally: *svn-status*).
- ;; If svn-status-verbose is set to nil, only "svn status" without "-v"
- ;; is run. Currently you have to toggle this variable manually.
- ;; This buffer uses svn-status mode in which the following keys are defined:
- ;; g - svn-status-update: run 'svn status -v'
- ;; M-s - 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'
- ;; X v - svn-status-resolved run 'svn resolved'
- ;; U - svn-status-update-cmd run 'svn update'
- ;; M-u - svn-status-update-cmd run 'svn update'
- ;; c - svn-status-commit 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'
- ;; D - svn-status-rm run 'svn rm'
- ;; M-c - svn-status-cleanup run 'svn cleanup'
- ;; b - svn-status-blame run 'svn blame'
- ;; X e - svn-status-export run 'svn export'
- ;; RET - svn-status-find-file-or-examine-directory
- ;; ^ - svn-status-examine-parent
- ;; ~ - svn-status-get-specific-revision
- ;; E - svn-status-ediff-with-revision
- ;; X X - svn-status-resolve-conflicts
- ;; 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
- ;; w - svn-status-copy-filename-as-kill
- ;; 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
- ;; * D - svn-status-mark-deleted
- ;; * * - svn-status-mark-changed
- ;; . - 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
- ;; V - svn-status-svnversion
- ;; 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
- ;; P x - svn-status-property-set-executable
- ;; h - svn-status-use-history
- ;; q - svn-status-bury-buffer
- ;; C-x C-j - svn-status-dired-jump
- ;; The output in the buffer contains this header to ease reading
- ;; of svn output:
- ;; FPH BASE CMTD Author em File
- ;; F = Filemark
- ;; P = Property mark
- ;; H = History mark
- ;; BASE = local base revision
- ;; CMTD = last committed revision
- ;; Author = author of change
- ;; em = "**" or "(Update Available)" [see `svn-status-short-mod-flag-p']
- ;; if file can be updated
- ;; File = path/filename
- ;;
- ;; 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
- ;; * Add repository browser
- ;; * Improve support for svn blame
- ;; * Get rid of all byte-compiler warnings
- ;; * SVK working copy support
- ;; * multiple independent buffers in svn-status-mode
- ;; There are "TODO" comments in other parts of this file as well.
- ;; 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 implemented
- ;; * help (?, h)
- ;; * import
- ;; * info implemented
- ;; * list (ls) implemented
- ;; * lock
- ;; * 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)
- ;; * unlock
- ;; * 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!
- ;; Development notes
- ;; -----------------
- ;; "svn-" is the package prefix used in psvn.el. There are also longer
- ;; prefixes which clarify the code and help symbol completion, but they
- ;; are not intended to prevent name clashes with other packages. All
- ;; interactive commands meant to be used only in a specific mode should
- ;; have names beginning with the name of that mode: for example,
- ;; "svn-status-add-file" in "svn-status-mode". "psvn" should be used
- ;; only in names of files, customization groups, and features. If SVK
- ;; support is ever added, it should use "svn-svk-" when no existing
- ;; prefix is applicable.
- ;; Many of the variables marked as `risky-local-variable' are probably
- ;; impossible to abuse, as the commands that read them are used only in
- ;; buffers that are not visiting any files. Better safe than sorry.
- ;;; Code:
- (require 'easymenu)
- (condition-case nil
- (progn
- (require 'diff-mode))
- (error nil))
- (defconst svn-psvn-revision "$Id: psvn.el 19791 2006-05-23 19:37:33Z xsteve $"
- "The revision number of psvn.")
- ;;; user setable variables
- (defcustom svn-status-verbose t
- "*Add '-v' to svn status call."
- :type 'boolean
- :group 'psvn)
- (defcustom svn-log-edit-file-name "++svn-log++"
- "*Name of a saved log file.
- This can be either absolute, or relative to the default directory
- of the *svn-log-edit* buffer."
- :type 'file
- :group 'psvn)
- (put 'svn-log-edit-file-name 'risky-local-variable t)
- (defcustom svn-log-edit-insert-files-to-commit t
- "*Insert the filelist to commit in the *svn-log* buffer"
- :type 'boolean
- :group 'psvn)
- (defcustom svn-log-edit-use-log-edit-mode
- (and (condition-case nil (require 'log-edit) (error nil)) t)
- "*Use log-edit-mode as base for svn-log-edit-mode
- This variable takes effect only when psvn.el is being loaded."
- :type 'boolean
- :group 'psvn)
- (defcustom svn-status-hide-unknown nil
- "*Hide unknown files in `svn-status-buffer-name' buffer.
- This can be toggled with \\[svn-status-toggle-hide-unknown]."
- :type 'boolean
- :group 'psvn)
- (defcustom svn-status-hide-unmodified nil
- "*Hide unmodified files in `svn-status-buffer-name' buffer.
- This can be toggled with \\[svn-status-toggle-hide-unmodified]."
- :type 'boolean
- :group 'psvn)
- (defcustom svn-status-sort-status-buffer t
- "*Whether to sort the `svn-status-buffer-name' buffer.
- Setting this variable to nil speeds up \[M-x svn-status], however the
- listing may then become incorrect.
- This can be toggled with \\[svn-status-toggle-sort-status-buffer]."
- :type 'boolean
- :group 'psvn)
- (defcustom svn-status-unmark-files-after-list '(commit revert)
- "*List of operations after which all user marks will be removed.
- Possible values are: commit, revert."
- :type '(set (const commit)
- (const revert))
- :group 'psvn)
- (defcustom svn-status-preserve-window-configuration nil
- "*Try to preserve the window configuration."
- :type 'boolean
- :group 'psvn)
- (defcustom svn-status-negate-meaning-of-arg-commands '()
- "*List of operations that should use a negated meaning of the prefix argument.
- The supported functions are `svn-status' and `svn-status-set-user-mark'."
- :type '(set (function-item svn-status)
- (function-item svn-status-set-user-mark))
- :group 'psvn)
- (defcustom svn-status-svn-executable "svn"
- "*The name of the svn executable.
- This can be either absolute or looked up on `exec-path'."
- ;; Don't use (file :must-match t). It doesn't know about `exec-path'.
- :type 'file
- :group 'psvn)
- (put 'svn-status-svn-executable 'risky-local-variable t)
- (defcustom svn-status-default-export-directory "~/" "*The default directory that is suggested svn export."
- :type 'file
- :group 'psvn)
- (defcustom svn-status-svn-environment-var-list '()
- "*A list of environment variables that should be set for that svn process.
- Each element is either a string \"VARIABLE=VALUE\" which will be added to
- the environment when svn is run, or just \"VARIABLE\" which causes that
- variable to be entirely removed from the environment.
- You could set this for example to '(\"LANG=C\")"
- :type '(repeat string)
- :group 'psvn)
- (put 'svn-status-svn-environment-var-list 'risky-local-variable t)
- (defcustom svn-browse-url-function nil
- ;; If the user hasn't changed `svn-browse-url-function', then changing
- ;; `browse-url-browser-function' should affect psvn even after it has
- ;; been loaded.
- "Function to display a Subversion related WWW page in a browser.
- So far, this is used only for \"trac\" issue tracker integration.
- By default, this is nil, which means use `browse-url-browser-function'.
- Any non-nil value overrides that variable, with the same syntax."
- ;; It would be nice to show the full list of browsers supported by
- ;; browse-url, but (custom-variable-type 'browse-url-browser-function)
- ;; returns just `function' if browse-url has not yet been loaded,
- ;; and there seems to be no easy way to autoload browse-url when
- ;; the custom-type of svn-browse-url-function is actually needed.
- ;; So I'll only offer enough choices to cover all supported types.
- :type `(choice (const :tag "Specified by `browse-url-browser-function'" nil)
- (function :value browse-url-default-browser
- ;; In XEmacs 21.4.17, the `function' widget matches
- ;; all objects. Constrain it here so that alists
- ;; fall through to the next choice. Accept either
- ;; a symbol (fbound or not) or a lambda expression.
- :match ,(lambda (widget value)
- (or (symbolp value) (functionp value))))
- (svn-alist :tag "Regexp/function association list"
- :key-type regexp :value-type function
- :value (("." . browse-url-default-browser))))
- :link '(emacs-commentary-link "browse-url")
- :group 'psvn)
- ;; (put 'svn-browse-url-function 'risky-local-variable t)
- ;; already implied by "-function" suffix
- (defcustom svn-status-window-alist
- '((diff "*svn-diff*") (log "*svn-log*") (info t) (blame t) (proplist t) (update t))
- "An alist to specify which windows should be used for svn command outputs.
- The following keys are supported: diff, log, info, blame, proplist, update.
- The following values can be given:
- nil ... show in *svn-process* buffer
- t ... show in dedicated *svn-info* buffer
- invisible ... don't show the buffer (eventually useful for update)
- a string ... show in a buffer named string"
- :type '(svn-alist
- :key-type symbol
- :value-type (group
- (choice
- (const :tag "Show in *svn-process* buffer" nil)
- (const :tag "Show in dedicated *svn-info* buffer" t)
- (const :tag "Don't show the output" invisible)
- (string :tag "Show in a buffer named"))))
- :options '(diff log info blame proplist update)
- :group 'psvn)
- (defcustom svn-status-short-mod-flag-p t
- "*Whether the mark for out of date files is short or long.
- If this variable is is t, and a file is out of date (i.e., there is a newer
- version in the repository than the working copy), then the file will
- be marked by \"**\"
- If this variable is nil, and the file is out of date then the longer phrase
- \"(Update Available)\" is used.
- In either case the mark gets the face
- `svn-status-update-available-face', and will only be visible if
- `\\[svn-status-update]' is run with a prefix argument"
- :type '(choice (const :tag "Short \"**\"" t)
- (const :tag "Long \"(Update Available)\"" nil))
- :group 'psvn)
- (defvar svn-status-debug-level 0 "The psvn.el debugging verbosity level.
- The higher the number, the more debug messages are shown.
- See `svn-status-message' for the meaning of values for that variable.")
- (defvar svn-status-buffer-name "*svn-status*" "Name for the svn status buffer")
- (defcustom svn-status-use-header-line
- (if (boundp 'header-line-format) t 'inline)
- "*Whether a header line should be used.
- When t: Use the emacs header line
- When 'inline: Insert the header line in the `svn-status-buffer-name' buffer
- Otherwise: Don't display a header line"
- :type '(choice (const :tag "Show column titles as a header line" t)
- (const :tag "Insert column titles as text in the buffer" inline)
- (other :tag "No column titles" nil))
- :group 'psvn)
- ;;; default arguments to pass to svn commands
- ;; TODO: When customizing, an option menu or completion might be nice....
- (defcustom svn-status-default-log-arguments '()
- "*List of arguments to pass to svn log.
- \(used in `svn-status-show-svn-log'; override these by giving prefixes\)."
- :type '(repeat string)
- :group 'psvn)
- (put 'svn-status-default-log-arguments 'risky-local-variable t)
- (defcustom svn-status-default-commit-arguments '()
- "*List of arguments to pass to svn commit.
- If you don't like recursive commits, set this value to (\"-N\")
- or mark the directory before committing it.
- Do not put an empty string here, except as an argument of an option:
- Subversion and the operating system may treat that as a file name
- equivalent to \".\", so you would commit more than you intended."
- :type '(repeat string)
- :group 'psvn)
- (put 'svn-status-default-commit-arguments 'risky-local-variable t)
- (defcustom svn-status-default-diff-arguments '()
- "*A list of arguments that is passed to the svn diff command.
- If you'd like to suppress whitespace changes use the following value:
- '(\"--diff-cmd\" \"diff\" \"-x\" \"-wbBu\")"
- :type '(repeat string)
- :group 'psvn)
- (put 'svn-status-default-diff-arguments 'risky-local-variable t)
- (defvar svn-trac-project-root nil
- "Path for an eventual existing trac issue tracker.
- This can be set with \\[svn-status-set-trac-project-root].")
- (defvar svn-status-module-name nil
- "*A short name for the actual project.
- This can be set with \\[svn-status-set-module-name].")
- (defvar svn-status-load-state-before-svn-status t
- "*Whether to automatically restore state from ++psvn.state file before running svn-status.")
- ;;; hooks
- (defvar svn-log-edit-mode-hook nil "Hook run when entering `svn-log-edit-mode'.")
- (defvar svn-log-edit-done-hook nil "Hook run after commiting files via svn.")
- ;; (put 'svn-log-edit-mode-hook 'risky-local-variable t)
- ;; (put 'svn-log-edit-done-hook 'risky-local-variable t)
- ;; already implied by "-hook" suffix
- (defvar svn-status-coding-system nil
- "A special coding system is needed for the output of svn.
- svn-status-coding-system is used in svn-run, if it is not nil.")
- (defcustom svn-status-wash-control-M-in-process-buffers
- (eq system-type 'windows-nt)
- "*Remove any trailing ^M from the *svn-process* buffer."
- :type 'boolean
- :group 'psvn)
- ;;; experimental features
- (defvar svn-status-track-user-input nil "Track user/password queries.
- This feature is implemented via a process filter.
- It is an experimental feature.")
- ;;; 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)))
- (defcustom svn-status-display-full-path nil
- "Specifies how the filenames look like in the listing.
- If t, their full path name will be displayed, else only the filename."
- :type 'boolean
- :group 'psvn)
- (defcustom svn-status-prefix-key [(control x) (meta s)]
- "Prefix key for the psvn commands in the global keymap."
- :type '(choice (const [(control x) ?v ?S])
- (const [(super s)])
- (const [(hyper s)])
- (const [(control x) ?v])
- (const [(control x) ?V])
- (sexp))
- :group 'psvn
- :set (lambda (var value)
- (if (boundp var)
- (global-unset-key (symbol-value var)))
- (set var value)
- (global-set-key (symbol-value var) 'svn-global-keymap)))
- ;; 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-status-directory-history nil "List of visited svn working directories.")
- (defvar svn-process-cmd nil)
- (defvar svn-status-info nil)
- (defvar svn-status-filename-to-buffer-position-cache (make-hash-table :test 'equal :weakness t))
- (defvar svn-status-base-info nil "The parsed result from the svn info command.")
- (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%c %4s %4s %-9s")
- (defvar svn-start-of-file-list-line-number 0)
- (defvar svn-status-files-to-commit nil
- "List of files to commit at `svn-log-edit-done'.
- This is always set together with `svn-status-recursive-commit'.")
- (defvar svn-status-recursive-commit nil
- "Non-nil if the next commit should be recursive.
- This is always set together with `svn-status-files-to-commit'.")
- (defvar svn-log-edit-update-log-entry nil
- "Revision number whose log entry is being edited.
- This is nil if the log entry is for a new commit.")
- (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-pre-run-asynch-recent-keys nil)
- (defvar svn-status-temp-dir
- (expand-file-name
- (or
- (when (boundp 'temporary-file-directory) temporary-file-directory) ;emacs
- ;; XEmacs 21.4.17 can return "/tmp/kalle" from (temp-directory).
- ;; `file-name-as-directory' adds a slash so we can append a file name.
- (when (fboundp 'temp-directory) (file-name-as-directory (temp-directory)))
- "/tmp/")) "The directory that is used to store temporary files for psvn.")
- ;; Because `temporary-file-directory' is not a risky local variable in
- ;; GNU Emacs 22.0.51, we don't mark `svn-status-temp-dir' as such either.
- (defvar svn-temp-suffix (make-temp-name "."))
- (put 'svn-temp-suffix 'risky-local-variable t)
- (defvar svn-status-temp-file-to-remove nil)
- (put 'svn-status-temp-file-to-remove 'risky-local-variable t)
- (defvar svn-status-temp-arg-file (concat svn-status-temp-dir "svn.arg" svn-temp-suffix))
- (put 'svn-status-temp-arg-file 'risky-local-variable t)
- (defvar svn-status-options nil)
- (defvar svn-status-remote)
- (defvar svn-status-commit-rev-number nil)
- (defvar svn-status-operated-on-dot nil)
- (defvar svn-status-elided-list nil)
- (defvar svn-status-custom-hide-function nil)
- ;; (put 'svn-status-custom-hide-function 'risky-local-variable t)
- ;; already implied by "-function" suffix
- (defvar svn-status-get-specific-revision-file-info)
- (defvar svn-status-last-output-buffer-name)
- (defvar svn-status-pre-run-svn-buffer nil)
- (defvar svn-status-update-list nil)
- (defvar svn-transient-buffers)
- (defvar svn-ediff-windows)
- (defvar svn-ediff-result)
- ;; Emacs 21 defines these in ediff-init.el but it seems more robust
- ;; to just declare the variables here than try to load that file.
- ;; It is Ediff's job to declare these as risky-local-variable if needed.
- (defvar ediff-buffer-A)
- (defvar ediff-buffer-B)
- (defvar ediff-buffer-C)
- (defvar ediff-quit-hook)
- ;; Ditto for log-edit.el.
- (defvar log-edit-initial-files)
- (defvar log-edit-callback)
- (defvar log-edit-listfun)
- ;; Ediff does not use this variable in GNU Emacs 20.7, GNU Emacs 21.4,
- ;; nor XEmacs 21.4.17. However, pcl-cvs (a.k.a. pcvs) does.
- ;; TODO: Check if this should be moved into the "svn-" namespace.
- (defvar ediff-after-quit-destination-buffer)
- ;; That is an example for the svn-status-custom-hide-function:
- ;; (setq svn-status-custom-hide-function 'svn-status-hide-pyc-files)
- ;; (defun svn-status-hide-pyc-files (info)
- ;; "Hide all pyc files in the `svn-status-buffer-name' buffer."
- ;; (let* ((fname (svn-status-line-info->filename-nondirectory info))
- ;; (fname-len (length fname)))
- ;; (and (> fname-len 4) (string= (substring fname (- fname-len 4)) ".pyc"))))
- ;;; 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-marked-popup-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 actual file, if a popup menu is activated."
- :group 'psvn-faces)
- (defface svn-status-update-available-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 used to highlight the 'out of date' mark.
- \(i.e., the mark used when there is a newer version in the repository
- than the working copy.\)
- See also `svn-status-short-mod-flag-p'."
- :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)
- ;based on font-lock-warning-face
- (defface svn-status-locked-face
- '((t
- (:weight bold :foreground "Red")))
- "Face for the phrase \"[ LOCKED ]\" `svn-status-buffer-name' buffers."
- :group 'psvn-faces)
- ;based on vhdl-font-lock-directive-face
- (defface svn-status-switched-face
- '((((class color)
- (background light))
- (:foreground "CadetBlue"))
- (((class color)
- (background dark))
- (:foreground "Aquamarine"))
- (t
- (:bold t :italic t)))
- "Face for the phrase \"(switched)\" non-directories in svn status buffers."
- :group 'psvn-faces)
- (defvar svn-highlight t)
- ;; stolen from PCL-CVS
- (defun svn-add-face (str face &optional keymap)
- "Return string STR decorated with the specified FACE.
- If `svn-highlight' is nil then just return STR."
- (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
- mouse-face highlight)
- ;; 18.10.2004: the keymap parameter is not used (yet) in psvn.el
- ;; ,@(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)))
- (defun svn-status-maybe-add-string (condition string face)
- "If CONDITION then return STRING decorated with FACE.
- Otherwise, return \"\"."
- (if condition
- (svn-add-face string face)
- ""))
- ; compatibility
- ; emacs 20
- (defalias 'svn-point-at-eol
- (if (fboundp 'point-at-eol) 'point-at-eol 'line-end-position))
- (defalias 'svn-point-at-bol
- (if (fboundp 'point-at-bol) 'point-at-bol 'line-beginning-position))
- (defalias 'svn-read-directory-name
- (if (fboundp 'read-directory-name) 'read-directory-name 'read-file-name))
- (eval-when-compile
- (if (not (fboundp 'gethash))
- (require 'cl-macs)))
- (defalias 'svn-puthash (if (fboundp 'puthash) 'puthash 'cl-puthash))
- ; xemacs
- ;; Evaluate the defsubst at compile time, so that the byte compiler
- ;; knows the definition and can inline calls. It cannot detect the
- ;; defsubst automatically from within the if form.
- (eval-and-compile
- (if (fboundp 'match-string-no-properties)
- (defalias 'svn-match-string-no-properties 'match-string-no-properties)
- (defsubst svn-match-string-no-properties (match)
- (buffer-substring-no-properties (match-beginning match) (match-end match)))))
- ;; XEmacs 21.4.17 does not have an `alist' widget. Define a replacement.
- ;; To find out whether the `alist' widget exists, we cannot check just
- ;; (get 'alist 'widget-type), because GNU Emacs 21.4 defines it in
- ;; "wid-edit.el", which is not preloaded; it will be autoloaded when
- ;; `widget-create' is called. Instead, we call `widgetp', which is
- ;; also autoloaded from "wid-edit.el". XEmacs 21.4.17 does not have
- ;; `widgetp' either, so we check that first.
- (if (and (fboundp 'widgetp) (widgetp 'alist))
- (define-widget 'svn-alist 'alist
- "An association list.
- Use this instead of `alist', for XEmacs 21.4 compatibility.")
- (define-widget 'svn-alist 'list
- "An association list.
- Use this instead of `alist', for XEmacs 21.4 compatibility."
- :convert-widget 'svn-alist-convert-widget
- :tag "Association List"
- :key-type 'sexp
- :value-type 'sexp)
- (defun svn-alist-convert-widget (widget)
- (let* ((value-type (widget-get widget :value-type))
- (option-widgets (loop for option in (widget-get widget :options)
- collect `(cons :format "%v"
- (const :format "%t: %v\n"
- :tag "Key"
- ,option)
- ,value-type))))
- (widget-put widget :args
- `(,@(when option-widgets
- `((set :inline t :format "%v"
- ,@option-widgets)))
- (editable-list :inline t
- (cons :format "%v"
- ,(widget-get widget :key-type)
- ,value-type)))))
- widget))
- ;;; keymaps
- (defvar svn-global-keymap nil "Global keymap for psvn.el.
- To bind this to a different key, customize `svn-status-prefix-key'.")
- (put 'svn-global-keymap 'risky-local-variable t)
- (when (not svn-global-keymap)
- (setq svn-global-keymap (make-sparse-keymap))
- (define-key svn-global-keymap (kbd "s") 'svn-status-this-directory)
- (define-key svn-global-keymap (kbd "l") 'svn-status-show-svn-log)
- (define-key svn-global-keymap (kbd "u") 'svn-status-update-cmd)
- (define-key svn-global-keymap (kbd "=") 'svn-status-show-svn-diff)
- (define-key svn-global-keymap (kbd "b") 'svn-status-blame)
- (define-key svn-global-keymap (kbd "c") 'svn-status-commit)
- (define-key svn-global-keymap (kbd "S") 'svn-status-switch-to-status-buffer)
- (define-key svn-global-keymap (kbd "o") 'svn-status-pop-to-status-buffer))
- (defvar svn-status-diff-mode-map ()
- "Keymap used in `svn-status-diff-mode' for additional commands that are not defined in diff-mode.")
- (put 'svn-status-diff-mode-map 'risky-local-variable t) ;for Emacs 20.7
- (when (not svn-status-diff-mode-map)
- (setq svn-status-diff-mode-map (copy-keymap diff-mode-shared-map))
- (define-key svn-status-diff-mode-map [?w] 'svn-status-diff-save-current-defun-as-kill))
- (defvar svn-global-trac-map ()
- "Subkeymap used in `svn-global-keymap' for trac issue tracker commands.")
- (put 'svn-global-trac-map 'risky-local-variable t) ;for Emacs 20.7
- (when (not svn-global-trac-map)
- (setq svn-global-trac-map (make-sparse-keymap))
- (define-key svn-global-trac-map (kbd "t") 'svn-trac-browse-timeline)
- (define-key svn-global-trac-map (kbd "i") 'svn-trac-browse-ticket)
- (define-key svn-global-trac-map (kbd "c") 'svn-trac-browse-changeset)
- (define-key svn-global-keymap (kbd "t") svn-global-trac-map))
- ;; The setter of `svn-status-prefix-key' makes a binding in the global
- ;; map refer to the `svn-global-keymap' symbol, rather than directly
- ;; to the keymap. Emacs then implicitly uses the symbol-function.
- ;; This has the advantage that `describe-bindings' (C-h b) can show
- ;; the name of the keymap and link to its documentation.
- (defalias 'svn-global-keymap svn-global-keymap)
- ;; `defalias' of GNU Emacs 21.4 doesn't allow a docstring argument.
- (put 'svn-global-keymap 'function-documentation
- '(documentation-property 'svn-global-keymap 'variable-documentation t))
- ;; named after SVN_WC_ADM_DIR_NAME in svn_wc.h
- (defun svn-wc-adm-dir-name ()
- "Return the name of the \".svn\" subdirectory or equivalent."
- (if (and (eq system-type 'windows-nt)
- (getenv "SVN_ASP_DOT_NET_HACK"))
- "_svn"
- ".svn"))
- (defun svn-status-message (level &rest args)
- "If LEVEL is lower than `svn-status-debug-level' print ARGS using `message'.
- Guideline for numbers:
- 1 - error messages, 3 - non-serious error messages, 5 - messages for things
- that take a long time, 7 - not very important messages on stuff, 9 - messages
- inside loops."
- (if (<= level svn-status-debug-level)
- (apply 'message args)))
- (defun svn-status-flatten-list (list)
- "Flatten any lists within ARGS, so that there are no sublists."
- (loop for item in list
- if (listp item) nconc (svn-status-flatten-list item)
- else collect item))
- ;;;###autoload (defalias 'svn-examine 'svn-status)
- (defalias 'svn-examine 'svn-status)
- ;;;###autoload
- (defun svn-status (dir &optional arg)
- "Examine the status of Subversion working copy in directory DIR.
- If ARG is -, allow editing of the parameters. One could add -N to
- run svn status non recursively to make it faster.
- For every other non nil ARG pass the -u argument to `svn status'.
- If there is no .svn directory, examine if there is SVN and run
- `cvs-examine'. Otherwise ask if to run `dired'."
- (interactive (list (svn-read-directory-name "SVN status directory: "
- nil default-directory nil)
- current-prefix-arg))
- (let ((svn-dir (format "%s%s"
- (file-name-as-directory dir)
- (svn-wc-adm-dir-name)))
- (cvs-dir (format "%sCVS" (file-name-as-directory dir))))
- (cond
- ((file-directory-p svn-dir)
- (setq arg (svn-status-possibly-negate-meaning-of-arg arg 'svn-status))
- (svn-status-1 dir arg))
- ((and (file-directory-p cvs-dir)
- (fboundp 'cvs-examine))
- (cvs-examine dir nil))
- (t
- (when (y-or-n-p
- (format
- (concat
- "%s "
- "is not Subversion controlled (missing %s "
- "directory). "
- "Run dired instead? ")
- dir
- (svn-wc-adm-dir-name)))
- (dired dir))))))
- (defvar svn-status-display-new-status-buffer nil)
- (defun svn-status-1 (dir &optional arg)
- "Examine DIR. See `svn-status' for more information."
- (unless (file-directory-p dir)
- (error "%s is not a directory" dir))
- (setq dir (file-name-as-directory dir))
- (when svn-status-load-state-before-svn-status
- (unless (string= dir (car svn-status-directory-history))
- (svn-status-load-state t)))
- (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-buffer-name)
- (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-buffer-name))
- (proc-buf (get-buffer-create "*svn-process*"))
- (want-edit (eq arg '-))
- (status-option (if want-edit
- (if svn-status-verbose "-v" "")
- (if svn-status-verbose
- (if arg "-uv" "-v")
- (if arg "-u" ""))))
- (svn-status-edit-svn-command
- (or want-edit svn-status-edit-svn-command)))
- (save-excursion
- (set-buffer status-buf)
- (setq default-directory dir)
- (set-buffer proc-buf)
- (setq default-directory dir
- svn-status-remote (when arg t))
- (svn-run t t 'status "status" status-option))))
- (defun svn-status-this-directory (arg)
- "Run `svn-status' for the `default-directory'"
- (interactive "P")
- (svn-status default-directory arg))
- (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)))
- (if (file-directory-p dir)
- (svn-status dir)
- (error "%s is not a directory" dir))))
- (defun svn-had-user-input-since-asynch-run ()
- (not (equal (recent-keys) svn-pre-run-asynch-recent-keys)))
- (defun svn-process-environment ()
- "Construct the environment for the svn process.
- It is a combination of `svn-status-svn-environment-var-list' and
- the usual `process-environment'."
- ;; If there are duplicate elements in `process-environment', then GNU
- ;; Emacs 21.4 guarantees that the first one wins; but GNU Emacs 20.7
- ;; and XEmacs 21.4.17 don't document what happens. We'll just remove
- ;; any duplicates ourselves, then. This also gives us an opportunity
- ;; to handle the "VARIABLE" syntax that none of them supports.
- (loop with found = '()
- for elt in (append svn-status-svn-environment-var-list
- process-environment)
- for has-value = (string-match "=" elt)
- for name = (substring elt 0 has-value)
- unless (member name found)
- do (push name found)
- and when has-value
- collect elt))
- (defun svn-run (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\"\)
- ARGLIST is flattened and any every nil value is discarded.
- If the variable `svn-status-edit-svn-command' is non-nil then the user
- can edit ARGLIST before running svn."
- (setq arglist (svn-status-flatten-list arglist))
- (if (eq (process-status "svn") nil)
- (progn
- (when svn-status-edit-svn-command
- (setq arglist (append
- (list (car arglist))
- (split-string
- (read-from-minibuffer
- (format "svn %s flags: " (car arglist))
- (mapconcat 'identity (cdr arglist) " ")))))
- (when (eq svn-status-edit-svn-command t)
- (svn-status-toggle-edit-cmd-flag t))
- (message "svn-run %s: %S" cmdtype arglist))
- (let* ((proc-buf (get-buffer-create "*svn-process*"))
- (svn-exe svn-status-svn-executable)
- (svn-proc))
- (when (listp (car arglist))
- (setq arglist (car arglist)))
- (save-excursion
- (set-buffer proc-buf)
- (when svn-status-coding-system
- (setq buffer-file-coding-system svn-status-coding-system))
- (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
- ;;(message "running asynchron: %s %S" svn-exe arglist)
- (setq svn-pre-run-asynch-recent-keys (recent-keys))
- (let ((process-environment (svn-process-environment))
- (process-connection-type nil))
- ;; Communicate with the subprocess via pipes rather
- ;; than via a pseudoterminal, so that if the svn+ssh
- ;; scheme is being used, SSH will not ask for a
- ;; passphrase via stdio; psvn.el is currently unable
- ;; to answer such prompts. Instead, SSH will run
- ;; x11-ssh-askpass if possible. If Emacs is being
- ;; run on a TTY without $DISPLAY, this will fail; in
- ;; such cases, the user should start ssh-agent and
- ;; then run ssh-add explicitly.
- (setq svn-proc (apply 'start-process "svn" proc-buf svn-exe arglist)))
- (set-process-sentinel svn-proc 'svn-process-sentinel)
- (when svn-status-track-user-input
- (set-process-filter svn-proc 'svn-process-filter)))
- ;;(message "running synchron: %s %S" svn-exe arglist)
- (let ((process-environment (svn-process-environment)))
- ;; `call-process' ignores `process-connection-type' and
- ;; never opens a pseudoterminal.
- (apply 'call-process svn-exe nil proc-buf nil arglist))
- (setq svn-status-mode-line-process-status "")
- (svn-status-update-mode-line)))
- (setq svn-status-pre-run-svn-buffer (current-buffer))))
- (error "You can only run one svn process at once!")))
- (defun svn-process-sentinel-fixup-path-seperators ()
- "Convert all path separators to UNIX style.
- \(This is a no-op unless `system-type' is windows-nt\)"
- (when (eq system-type 'windows-nt)
- (save-excursion
- (goto-char (point-min))
- (while (search-forward "\\" nil t)
- (replace-match "/")))))
- (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")
- (svn-process-sentinel-fixup-path-seperators)
- (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-update-list
- ;; (message "Using svn-status-update-list: %S" svn-status-update-list)
- (save-excursion
- (svn-status-update-with-command-list svn-status-update-list))
- (setq svn-status-update-list nil))
- (when svn-status-display-new-status-buffer
- (set-window-configuration svn-status-initial-window-configuration)
- (if (svn-had-user-input-since-asynch-run)
- (message "svn status finished")
- (switch-to-buffer svn-status-buffer-name))))
- ((eq svn-process-cmd 'log)
- (svn-status-show-process-output 'log t)
- (pop-to-buffer svn-status-last-output-buffer-name)
- (svn-log-view-mode)
- (forward-line 3)
- (font-lock-fontify-buffer)
- (message "svn log finished"))
- ((eq svn-process-cmd 'info)
- (svn-status-show-process-output 'info t)
- (message "svn info finished"))
- ((eq svn-process-cmd 'ls)
- (svn-status-show-process-output 'info t)
- (message "svn ls finished"))
- ((eq svn-process-cmd 'parse-info)
- (svn-status-parse-info-result))
- ((eq svn-process-cmd 'blame)
- (svn-status-show-process-output 'blame t)
- (when svn-status-pre-run-svn-buffer
- (with-current-buffer svn-status-pre-run-svn-buffer
- (unless (eq major-mode 'svn-status-mode)
- (goto-line (line-number-at-pos) (get-buffer svn-status-last-output-buffer-name)))))
- (message "svn blame finished"))
- ((eq svn-process-cmd 'commit)
- (svn-process-sentinel-fixup-path-seperators)
- (svn-status-remove-temp-file-maybe)
- (when (member 'commit svn-status-unmark-files-after-list)
- (svn-status-unset-all-usermarks))
- (svn-status-update-with-command-list (svn-status-parse-commit-output))
- (run-hooks 'svn-log-edit-done-hook)
- (setq svn-status-files-to-commit nil
- svn-status-recursive-commit nil)
- (message "svn commit finished"))
- ((eq svn-process-cmd 'update)
- (svn-status-show-process-output 'update t)
- (setq svn-status-update-list (svn-status-parse-update-output))
- (svn-status-update)
- (message "svn update finished"))
- ((eq svn-process-cmd 'add)
- (svn-status-update-with-command-list (svn-status-parse-ar-output))
- (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-with-command-list (svn-status-parse-ar-output))
- (message "svn rm finished"))
- ((eq svn-process-cmd 'cleanup)
- (message "svn cleanup finished"))
- ((eq svn-process-cmd 'proplist)
- (svn-status-show-process-output 'proplist 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)
- (if (member svn-status-propedit-property-name '("svn:keywords"))
- (svn-status-update-with-command-list (svn-status-parse-property-output))
- (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-output nil t))))
- (defun svn-process-filter (process str)
- (save-window-excursion
- (set-buffer "*svn-process*")
- ;;(message "svn-process-filter: %s" str)
- (goto-char (point-max))
- (insert str)
- (save-excursion
- (goto-char (svn-point-at-bol))
- (when (looking-at "Password for '\\(.+\\)': ")
- ;(svn-status-show-process-buffer)
- (let ((passwd (read-passwd
- (format "Enter svn password for %s: " (match-string 1)))))
- (svn-process-send-string (concat passwd "\n") t)))
- (when (looking-at "Username: ")
- (let ((user-name (read-string "Username for svn operation: ")))
- (svn-process-send-string (concat user-name "\n")))))))
- (defun svn-parse-rev-num (str)
- (if (and str (stringp str)
- (save-match-data (string-match "^[0-9]+" str)))
- (string-to-number str)
- -1))
- (defsubst svn-status-make-ui-status ()
- "Make a ui-status structure for a file in a svn working copy.
- The initial values in the structure returned by this function
- are good for a file or directory that the user hasn't seen before.
- The ui-status structure keeps track of how the file or directory
- should be displayed in svn-status mode. Updating the svn-status
- buffer from the working copy preserves the ui-status if possible.
- User commands modify this structure; each file or directory must
- thus have its own copy.
- Currently, the ui-status is a list (USER-MARK USER-ELIDE).
- USER-MARK is non-nil iff the user has marked the file or directory,
- typically with `svn-status-set-user-mark'. To read USER-MARK,
- call `svn-status-line-info->has-usermark'.
- USER-ELIDE is non-nil iff the user has elided the file or directory
- from the svn-status buffer, typically with `svn-status-toggle-elide'.
- To read USER-ELIDE, call `svn-status-line-inf…
Large files files are truncated, but you can click here to view the full file