diff options
| author | David Robillard <d@drobilla.net> | 2017-12-09 12:55:53 +0100 |
|---|---|---|
| committer | David Robillard <d@drobilla.net> | 2017-12-09 12:55:53 +0100 |
| commit | ff5b270b741d012b86aeb9d9af2f5997aae9cd3e (patch) | |
| tree | 74bdbaa90e3327212cf297625e986ce5a0994953 /emacs.d/site-lisp | |
| parent | 6fd0fb926ed12208d017389d4a944516f18d89c4 (diff) | |
| download | dotfiles-ff5b270b741d012b86aeb9d9af2f5997aae9cd3e.tar.gz dotfiles-ff5b270b741d012b86aeb9d9af2f5997aae9cd3e.tar.bz2 dotfiles-ff5b270b741d012b86aeb9d9af2f5997aae9cd3e.zip | |
Remove old packages
Diffstat (limited to 'emacs.d/site-lisp')
| -rw-r--r-- | emacs.d/site-lisp/psvn.el | 6555 | ||||
| -rw-r--r-- | emacs.d/site-lisp/window-numbering.el | 244 |
2 files changed, 0 insertions, 6799 deletions
diff --git a/emacs.d/site-lisp/psvn.el b/emacs.d/site-lisp/psvn.el deleted file mode 100644 index b551932..0000000 --- a/emacs.d/site-lisp/psvn.el +++ /dev/null @@ -1,6555 +0,0 @@ -;;; psvn.el --- Subversion interface for emacs -;; Copyright (C) 2002-2012 by Stefan Reichoer - -;; Author: Stefan Reichoer <stefan@xsteve.at> -;; Note: This version is currently not under svn control -;; For the revision date see svn-psvn-revision below - -;; 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 el4, ubuntu 11.10 with svn 1.6.12 - -;; psvn.el needs at least svn 1.1.0 -;; if you upgrade to a higher version, you need to do a fresh checkout - -;; 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' -;; C - svn-status-cp run 'svn cp' -;; D - svn-status-rm run 'svn rm' -;; M-c - svn-status-cleanup run 'svn cleanup' -;; k - svn-status-lock run 'svn lock' -;; K - svn-status-unlock run 'svn unlock' -;; 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 g - svn-status-grep-files -;; S s - svn-status-search-files -;; s - svn-status-show-process-buffer -;; h - svn-status-pop-to-partner-buffer -;; e - svn-status-toggle-edit-cmd-flag -;; ? - svn-status-toggle-hide-unknown -;; _ - svn-status-toggle-hide-unmodified -;; z - svn-status-toggle-hide-externals -;; m - svn-status-set-user-mark -;; u - svn-status-unset-user-mark -;; $ - svn-status-toggle-elide -;; w - svn-status-copy-current-line-info -;; 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 -;; * P - svn-status-mark-modified-properties -;; * D - svn-status-mark-deleted -;; * * - svn-status-mark-changed -;; * . - svn-status-mark-by-file-ext -;; * % - svn-status-mark-filename-regexp -;; * s - svn-status-store-usermarks -;; * l - svn-status-load-usermarks -;; . - svn-status-goto-root-or-return -;; f - svn-status-find-file -;; o - svn-status-find-file-other-window -;; C-o - svn-status-find-file-other-window-noselect -;; 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 X e - svn-status-property-edit-svn-externals -;; P k - svn-status-property-set-keyword-list -;; P K i - svn-status-property-set-keyword-id -;; P K d - svn-status-property-set-keyword-date -;; P y - svn-status-property-set-eol-style -;; P x - svn-status-property-set-executable -;; P m - svn-status-property-set-mime-type -;; H - svn-status-use-history -;; x - svn-status-update-buffer -;; 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 - -;; 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 -;; * 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) implemented -;; * cleanup implemented -;; * commit (ci) implemented -;; * copy (cp) implemented -;; * delete (del, remove, rm) implemented -;; * diff (di) implemented -;; * export implemented -;; * help (?, h) -;; * import used (in svn-admin-create-trunk-directory) -;; * info implemented -;; * list (ls) implemented -;; * lock implemented -;; * log implemented -;; * merge -;; * mkdir implemented -;; * move (mv, rename, ren) implemented -;; * propdel (pdel) implemented -;; * propedit (pedit, pe) not needed -;; * propget (pget, pg) used (in svn-status-property-edit) -;; * proplist (plist, pl) implemented -;; * propset (pset, ps) used (in svn-prop-edit-do-it) -;; * resolved implemented -;; * revert implemented -;; * status (stat, st) implemented -;; * switch (sw) -;; * unlock implemented -;; * 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. - -;; There is also limited support for the web-based software project management and bug/issue tracking system trac -;; Trac ticket links can be enabled in the *svn-log* buffers when using the following: -;; (setq svn-log-link-handlers '(trac-ticket-short)) - -;; --------------------------- -;; Frequently asked questions: -;; --------------------------- - -;; Q1: I need support for user names with blanks/spaces -;; A1: Add the user names to svn-user-names-including-blanks and set the -;; svn-pre-parse-status-hook. -;; The problem is, that the user names and the file names from the svn status -;; output can both contain blanks. Blanks in file names are supported. -;; the svn-user-names-including-blanks list is used to replace the spaces -;; in the user names with - to overcome this problem - -;; Q2: My svn-update command it taking a really long time. How can I -;; see what's going on? -;; A2: In the *svn-status* buffer press "s". - -;; Q3: How do I enter a username and password? -;; A3: In the *svn-status* buffer press "s", switch to the -;; *svn-process* buffer and press enter. You will be prompted for -;; username and password. - -;; Q4: What does "?", "M", and "C" in the first column of the -;; *svn-status* buffer mean? -;; A4: "?" means the file(s) is not under Subversion control -;; "M" means you have a locally modified file -;; "C" means there is a conflict -;; "@$&#!" means someone is saying nasty things to you - - -;; 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: - -(defconst svn-psvn-revision "2012-03-26, 21:23:49" "The revision date of psvn.") - - -(require 'easymenu) - -(eval-when-compile (require 'dired)) -(eval-when-compile (require 'ediff-util)) -(eval-when-compile (require 'ediff-wind)) -(eval-when-compile (require 'vc-hooks)) -(eval-when-compile (require 'elp)) -(eval-when-compile (require 'pp)) - -(condition-case nil - (progn - (require 'diff-mode)) - (error nil)) - - -;;; user setable variables -(defcustom svn-status-verbose t - "*Add '-v' to svn status call. -This can be toggled with \\[svn-status-toggle-svn-verbose-flag]." - :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-name' 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-show-diff-for-commit nil - "*Show the diff being committed when you run `svn-status-commit.'." - :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-log-edit-paragraph-start - "$\\|[ \t]*$\\|##.*$\\|\\*.*:.*$\\|[ \t]+(.+):.*$" - "*Value used for `paragraph-start' in `svn-log-edit-buffer-name' buffer." - :type 'regexp - :group 'psvn) -(defcustom svn-log-edit-paragraph-separate "$\\|##.*$" - "*Value used for `paragraph-separate' in `svn-log-edit-buffer-name' buffer." - :type 'regexp - :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-hide-externals nil - "*Hide external files in `svn-status-buffer-name' buffer. -This can be toggled with \\[svn-status-toggle-hide-externals]." - :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-ediff-delete-temporary-files nil - "*Whether to delete temporary ediff files. If set to ask, ask the user" - :type '(choice (const t) - (const nil) - (const ask)) - :group 'psvn) - -(defcustom svn-status-changelog-style 'changelog - "*The changelog style that is used for `svn-file-add-to-changelog'. -Possible values are: - 'changelog: use `add-change-log-entry-other-window' - 'svn-dev: use commit messages that are used by the svn developers - a function: This function is called to add a new entry to the changelog file. -" - :type '(set (const changelog) - (const svn-dev)) - :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 t - "*Try to preserve the window configuration." - :type 'boolean - :group 'psvn) - -(defcustom svn-status-auto-revert-buffers t - "*Auto revert buffers that have changed on disk." - :type 'boolean - :group 'psvn) - -(defcustom svn-status-fancy-file-state-in-modeline t - "*Show a color dot in the modeline that describes the state of the current file." - :type 'boolean - :group 'psvn) - -(defcustom svn-status-indentation 2 - "*Indenation per directory level in the `svn-status-buffer-name' buffer." - :type 'integer - :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 '("LC_MESSAGES=C" "LC_ALL=") - "*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. - -The default setting is '(\"LC_MESSAGES=C\" \"LC_ALL=\"). This ensures that the svn command -line client does not output localized strings. psvn.el relies on the english -messages." - :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-log-edit-header - "## Lines starting with '## ' will be removed from the log message.\n" - "*Header content of the *svn-log* buffer" - :type 'string - :group 'psvn) - -(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-name' 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-bookmark-list nil "A list of locations for a quick access via `svn-status-via-bookmark'") -;;(setq svn-bookmark-list '(("proj1" . "~/work/proj1") -;; ("doc1" . "~/docs/doc1"))) - -(defvar svn-status-buffer-name "*svn-status*" "Name for the svn status buffer") -(defvar svn-process-buffer-name " *svn-process*" "Name for the svn process buffer") -(defvar svn-log-edit-buffer-name "*svn-log-edit*" "Name for the svn log-edit 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 '("-v") - "*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 '("-x" "--ignore-eol-style") - "*A list of arguments that is passed to the svn diff command. -When the built in diff command is used, -the following options are available: --ignore-eol-style, --ignore-space-change, ---ignore-all-space, --ignore-eol-style. -The following setting ignores eol style changes and all white space changes: -'(\"-x\" \"--ignore-eol-style --ignore-all-space\") - -If you'd like to suppress whitespace changes using the external diff command -use the following value: -'(\"--diff-cmd\" \"diff\" \"-x\" \"-wbBu\") - -" - :type '(repeat string) - :group 'psvn) -(put 'svn-status-default-diff-arguments 'risky-local-variable t) - -(defcustom svn-status-default-status-arguments '() - "*A list of arguments that is passed to the svn status command. -The following options are available: --ignore-externals - -" - :type '(repeat string) - :group 'psvn) -(put 'svn-status-default-status-arguments 'risky-local-variable t) - -(defcustom svn-status-default-blame-arguments '("-x" "--ignore-eol-style") - "*A list of arguments that is passed to the svn blame command. -See `svn-status-default-diff-arguments' for some examples." - :type '(repeat string) - :group 'psvn) - -(put 'svn-status-default-blame-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-branch-list nil - "*A list of known branches for the actual project -This can be set with \\[svn-status-set-branch-list]. - -The list contains full repository paths or shortcuts starting with \# -\# at the beginning is replaced by the repository url. -\#1\# has the special meaning that all paths below the given directory -will be considered for interactive selections. - -A useful setting might be: '\(\"\#trunk\" \"\#1\#tags\" \"\#1\#branches\")") - -(defvar svn-status-load-state-before-svn-status t - "*Whether to automatically restore state from ++psvn.state file before running svn-status.") - -(defvar svn-log-link-handlers nil "A list of link handlers in *svn-log* buffers. -These link handlers must be registered via `svn-log-register-link-handler'") - -;;; hooks -(defvar svn-status-mode-hook nil "Hook run when entering `svn-status-mode'.") -(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-post-process-svn-output-hook 'svn-fixup-tramp-output-maybe "Hook that can be used to preprocess the output from svn. -The function `svn-status-remove-control-M' can be useful for that hook") - -(when (eq system-type 'windows-nt) - (add-hook 'svn-post-process-svn-output-hook 'svn-status-remove-control-M)) - -(defvar svn-status-svn-process-coding-system (when (boundp 'locale-coding-system) locale-coding-system) - "The coding system that is used for the svn command line client. -It is used in svn-run, if it is not nil.") - -(defvar svn-status-svn-file-coding-system 'undecided-unix - "The coding system that is used to save files that are loaded as -parameter or data files via the svn command line client. -It is used in the following functions: `svn-prop-edit-do-it', `svn-log-edit-done'. -You could set it to 'utf-8") - -(defcustom svn-status-use-ido-completion - (fboundp 'ido-completing-read) - "*Use ido completion functionality." - :type 'boolean - :group 'psvn) - -(defvar svn-status-completing-read-function - (if svn-status-use-ido-completion 'ido-completing-read 'completing-read)) - -;;; 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.") - -(defvar svn-status-refresh-info nil "Whether `svn-status-update-buffer' should call `svn-status-parse-info'.") - -;;; 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))) - -(defcustom svn-admin-default-create-directory "~/" - "*The default directory that is suggested for `svn-admin-create'." - :type 'string - :group 'psvn) - -(defvar svn-status-custom-hide-function nil - "A function that receives a line-info and decides whether to hide that line. -See psvn.el for an example function.") -;; (put 'svn-status-custom-hide-function 'risky-local-variable t) -;; already implied by "-function" suffix - - -;; 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 "The property name for the actual svn propset command") -(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-pre-run-mode-line-process nil) -(defvar svn-arg-file-content 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-update-rev-number nil) -(defvar svn-status-operated-on-dot nil) -(defvar svn-status-last-commit-author nil) -(defvar svn-status-elided-list nil) -(defvar svn-status-last-output-buffer-name nil "The buffer name for the buffer that holds the output from the last executed svn command") -(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) -(defvar svn-status-last-diff-options nil) -(defvar svn-status-blame-file-name nil) -(defvar svn-status-blame-revision nil) -(defvar svn-admin-last-repository-dir nil "The last repository url for various operations.") -(defvar svn-last-cmd-ring (make-ring 30) "Ring that holds the last executed svn commands (for debugging purposes)") -(defvar svn-status-cached-version-string nil) -(defvar svn-client-version nil "The version number of the used svn client") -(defvar svn-status-get-line-information-for-file nil) -(defvar svn-status-base-dir-cache (make-hash-table :test 'equal :weakness nil)) -(defvar svn-status-usermark-storage (make-hash-table :test 'equal :weakness nil)) -(defvar svn-log-registered-link-handlers (make-hash-table :test 'eql :weakness nil)) - -(defvar svn-status-partner-buffer nil "The partner buffer for this svn related buffer") -(make-variable-buffer-local 'svn-status-partner-buffer) - -;; 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: -;; Note: For many cases it is a better solution to ignore files or -;; file extensions via the svn-ignore properties (on P i, P I) -;; (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) - -;not based on anything, may be horribly ugly! -(defface svn-status-symlink-face - '((((class color) (background light)) (:foreground "cornflower blue")) - (((class color) (background dark)) (:foreground "cyan"))) - "Face for symlinks in *svn-status* buffers. - -This is the face given to the actual link (i.e., the versioned item), -the target of the link gets either `svn-status-filename-face' or -`svn-status-directory-face'." - :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) - -(if svn-xemacsp - (defface svn-status-blame-highlight-face - '((((type tty) (class color)) (:foreground "green" :weight light)) - (((class color) (background light)) (:foreground "green3")) - (((class color) (background dark)) (:foreground "palegreen2")) - (t (:weight bold))) - "Default face for highlighting a line in svn status blame mode." - :group 'psvn-faces) - (defface svn-status-blame-highlight-face - '((t :inherit highlight)) - "Default face for highlighting a line in svn status blame mode." - :group 'psvn-faces)) - -(if svn-xemacsp - (defface svn-log-partner-highlight-face - '((((type tty) (class color)) (:foreground "yellow" :weight light)) - (((class color) (background light)) (:foreground "gold")) - (((class color) (background dark)) (:foreground "gold")) - (t (:weight bold))) - "Default face for highlighting the partner in svn log mode." - :group 'psvn-faces) - (defface svn-log-partner-highlight-face - '((((class color) (background light)) - (:background "light goldenrod" :weight bold)) - (t (:weight bold))) - "Default face for highlighting the partner in svn log mode." - :group 'psvn-faces)) - -(defface svn-status-blame-rev-number-face - '((((class color) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (background dark)) (:foreground "LightGoldenrod")) - (t (:weight bold :slant italic))) - "Face to highlight revision numbers in the svn-blame mode." - :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)) - -;; emacs 21 -(if (fboundp 'line-number-at-pos) - (defalias 'svn-line-number-at-pos 'line-number-at-pos) - (defun svn-line-number-at-pos (&optional pos) - "Return (narrowed) buffer line number at position POS. -If POS is nil, use current buffer location." - (let ((opoint (or pos (point))) start) - (save-excursion - (goto-char (point-min)) - (setq start (point)) - (goto-char opoint) - (forward-line 0) - (1+ (count-lines start (point))))))) - -(defun svn-substring-no-properties (string &optional from to) - (if (fboundp 'substring-no-properties) - (substring-no-properties string from to) - (substring string (or from 0) to))) - -; 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 doesn't have a function `help-buffer' -(eval-and-compile - (if (fboundp 'help-buffer) - (defalias 'svn-help-buffer 'help-buffer) ; FSF Emacs - (defun svn-help-buffer () - (buffer-name (get-buffer-create (help-buffer-name "SVN")))))) ; XEmacs - - -;; 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)) - -;; process launch functions -(defvar svn-call-process-function (if (fboundp 'process-file) 'process-file 'call-process)) -(defvar svn-start-process-function (if (fboundp 'start-file-process) 'start-file-process 'start-process)) - - -;;; 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 "v") 'svn-status-version) - (define-key svn-global-keymap (kbd "s") 'svn-status-this-directory) - (define-key svn-global-keymap (kbd "b") 'svn-status-via-bookmark) - (define-key svn-global-keymap (kbd "h") 'svn-status-use-history) - (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 "f =") 'svn-file-show-svn-diff) - (define-key svn-global-keymap (kbd "f e") 'svn-file-show-svn-ediff) - (define-key svn-global-keymap (kbd "f l") 'svn-status-show-svn-log) - (define-key svn-global-keymap (kbd "f b") 'svn-status-blame) - (define-key svn-global-keymap (kbd "f a") 'svn-file-add-to-changelog) - (define-key svn-global-keymap (kbd "f r") 'svn-file-revert) - (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) - (define-key svn-global-keymap (kbd "C-k") 'svn-process-kill)) - -(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 [?g] 'revert-buffer) - (define-key svn-status-diff-mode-map [?s] 'svn-status-pop-to-status-buffer) - (define-key svn-status-diff-mode-map [?c] 'svn-status-diff-pop-to-commit-buffer) - (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 "w") 'svn-trac-browse-wiki) - (define-key svn-global-trac-map (kbd "t") 'svn-trac-browse-timeline) - (define-key svn-global-trac-map (kbd "m") 'svn-trac-browse-roadmap) - (define-key svn-global-trac-map (kbd "s") 'svn-trac-browse-source) - (define-key svn-global-trac-map (kbd "r") 'svn-trac-browse-report) - (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-log-edit-file-name (&optional curdir) - "Get the name of the saved log edit file -If curdir, return `svn-log-edit-file-name' -Otherwise position svn-log-edit-file-name in the root directory of this working copy" - (if curdir - svn-log-edit-file-name - (concat (svn-status-base-dir) svn-log-edit-file-name))) - -(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)) - -(defun svn-status-window-line-position (w) - "Return the window line at point for window W, or nil if W is nil." - (svn-status-message 3 "About to count lines; selected window is %s" (selected-window)) - (and w (count-lines (window-start w) (point)))) - -;;;###autoload -(defun svn-checkout (repos-url path) - "Run svn checkout REPOS-URL PATH." - (interactive (list (read-string "Checkout from repository Url: ") - (svn-read-directory-name "Checkout to directory: "))) - (svn-run t t 'checkout "checkout" repos-url (expand-file-name path))) - -;;;###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', which -asks svn to connect to the repository and check to see if there are updates -there. - -If there is no .svn directory, examine if there is CVS 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 - ((psvn-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)) - (let ((default-directory dir)) ;otherwise svn-status-base-dir looks in the wrong place - (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* ((cur-buf (current-buffer)) - (status-buf (get-buffer-create svn-status-buffer-name)) - (proc-buf (get-buffer-create svn-process-buffer-name)) - (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" ""))))) - (save-excursion - (set-buffer status-buf) - (buffer-disable-undo) - (setq default-directory dir) - (set-buffer proc-buf) - (setq default-directory dir - svn-status-remote (when arg t)) - (set-buffer cur-buf) - (if want-edit - (let ((svn-status-edit-svn-command t)) - (svn-run t t 'status "status" svn-status-default-status-arguments status-option)) - (svn-run t t 'status "status" svn-status-default-status-arguments 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 () - "Interactively select a different directory from `svn-status-directory-history'." - (interactive) - (let* ((in-status-buffer (eq major-mode 'svn-status-mode)) - (hist (if in-status-buffer (cdr svn-status-directory-history) svn-status-directory-history)) - (dir (funcall svn-status-completing-read-function "svn-status on directory: " hist)) - (svn-status-buffer (get-buffer svn-status-buffer-name)) - (svn-buffer-available (and svn-status-buffer - (with-current-buffer svn-status-buffer-name (string= default-directory dir))))) - (if (file-directory-p dir) - (if svn-buffer-available - (svn-status-switch-to-status-buffer) - (unless svn-status-refresh-info - (setq svn-status-refresh-info 'once)) - (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-expand-filename-for-remote-access (file-name) - "Convert the given local part of a filename to a full file name to allow accessing remote files" - ;; when running svn on a remote host: expand local file names to get full names to access the file on the remote host via emacs - (if (and (fboundp 'file-remote-p) (file-remote-p default-directory)) - (concat (file-remote-p default-directory) file-name) - file-name)) - -(defun svn-local-filename-for-remote-access (file-name) - "Convert a full file name to a local file name that can be used for a local svn invocation." - (if (and (fboundp 'file-remote-p) (file-remote-p file-name)) - (tramp-file-name-localname (tramp-dissect-file-name file-name)) - file-name)) - -(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-name' 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. - -The hook svn-pre-run-hook allows to monitor/modify the ARGLIST." - (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)) - (run-hooks 'svn-pre-run-hook) - (unless (eq mode-line-process 'svn-status-mode-line-process) - (setq svn-pre-run-mode-line-process mode-line-process) - (setq mode-line-process 'svn-status-mode-line-process)) - (setq svn-status-pre-run-svn-buffer (current-buffer)) - (let* ((pre-run-buffer-default-directory default-directory) - (proc-buf (get-buffer-create svn-process-buffer-name)) - (svn-exe svn-status-svn-executable) - (svn-proc)) - (when (listp (car arglist)) - (setq arglist (car arglist))) - (save-excursion - (set-buffer proc-buf) - (setq default-directory pre-run-buffer-default-directory) - (setq buffer-read-only nil) - (buffer-disable-undo) - (fundamental-mode) - (if clear-process-buffer - (delete-region (point-min) (point-max)) - (goto-char (point-max))) - (setq svn-process-cmd cmdtype) - (setq svn-status-last-commit-author nil) - (setq svn-status-mode-line-process-status (format " running %s" cmdtype)) - (svn-status-update-mode-line) - (save-excursion (sit-for 0.1)) - (ring-insert svn-last-cmd-ring (list (current-time-string) arglist default-directory svn-arg-file-content)) - (setq svn-arg-file-content nil) - (setq svn-process-handle-error-msg nil) - (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 svn-start-process-function "svn" proc-buf svn-exe arglist))) - (when svn-status-svn-process-coding-system - (set-process-coding-system svn-proc svn-status-svn-process-coding-system - svn-status-svn-process-coding-system)) - (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 svn-call-process-function svn-exe nil proc-buf nil arglist)) - (setq svn-status-last-output-buffer-name svn-process-buffer-name) - (run-hooks 'svn-post-process-svn-output-hook) - (setq svn-status-mode-line-process-status "") - (svn-status-update-mode-line) - (when svn-pre-run-mode-line-process - (setq mode-line-process svn-pre-run-mode-line-process) - (setq svn-pre-run-mode-line-process nil)))))) - (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) - "Called after a svn process has finished." - ;;(princ (format "Process: %s had the event `%s'" process event))) - (let ((act-buf (current-buffer))) - (when svn-pre-run-mode-line-process - (with-current-buffer svn-status-pre-run-svn-buffer - (setq mode-line-process svn-pre-run-mode-line-process)) - (setq svn-pre-run-mode-line-process nil)) - (set-buffer (process-buffer process)) - (setq svn-status-mode-line-process-status "") - (svn-status-update-mode-line) - (cond ((string= event "finished\n") - (run-hooks 'svn-post-process-svn-output-hook) - (cond ((eq svn-process-cmd 'status) - ;;(message "svn status finished") - (svn-process-sentinel-fixup-path-seperators) - (svn-parse-status-result) - (svn-status-apply-elide-list) - (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 2) - (unless (looking-at "Changed paths:") - (forward-line 1)) - (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 'diff) - (svn-status-activate-diff-mode) - (message "svn diff 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) - (let ((src-line-number (svn-line-number-at-pos))) - (pop-to-buffer (get-buffer svn-status-last-output-buffer-name)) - (goto-line src-line-number))))) - (with-current-buffer (get-buffer svn-status-last-output-buffer-name) - (svn-status-activate-blame-mode)) - (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)) - (svn-revert-some-buffers) - (run-hooks 'svn-log-edit-done-hook) - (setq svn-status-files-to-commit nil - svn-status-recursive-commit nil) - (if (null svn-status-commit-rev-number) - (message "No revision to commit.") - (message "svn: Committed revision %s." svn-status-commit-rev-number))) - ((eq svn-process-cmd 'update) - (svn-status-show-process-output 'update t) - (setq svn-status-update-list (svn-status-parse-update-output)) - (svn-revert-some-buffers) - (svn-status-update) - (if (car svn-status-update-rev-number) - (message "svn: Updated to revision %s." (cadr svn-status-update-rev-number)) - (message "svn: At revision %s." (cadr svn-status-update-rev-number)))) - ((eq svn-process-cmd 'add) - (svn-status-update-with-command-list (svn-status-parse-ar-output)) - (message "svn add finished")) - ((eq svn-process-cmd 'lock) - (svn-status-update) - (message "svn lock finished")) - ((eq svn-process-cmd 'unlock) - (svn-status-update) - (message "svn unlock 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-revert-some-buffers) - (svn-status-update) - (message "svn revert finished")) - ((eq svn-process-cmd 'resolved) - (svn-status-update) - (message "svn resolved 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 'checkout) - (svn-status default-directory)) - ((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)) - (if (re-search-backward "^svn: " nil t) - (let ((error-strings) - (beginning-of-buffer)) - (while (and (looking-at "^svn: ") (not beginning-of-buffer)) - (setq error-strings (append error-strings (list (buffer-substring-no-properties (+ 5 (svn-point-at-bol)) (svn-point-at-eol))))) - (setq beginning-of-buffer (bobp)) - (forward-line -1)) - (svn-process-handle-error (mapconcat 'identity (reverse error-strings) "\n"))) - (message "svn failed: %s" event))) - (t - (message "svn process had unknown event: %s" event)) - (svn-status-show-process-output nil t)))) - -(defvar svn-process-handle-error-msg nil) -(defvar svn-handle-error-function nil - "A function that will be called with an error string received from the svn client. -When this function resets `svn-process-handle-error-msg' to nil, the default error handling -(just show the error message) is not executed.") -(defun svn-process-handle-error (error-msg) - (setq svn-process-handle-error-msg error-msg) - (when (functionp svn-handle-error-function) - (funcall svn-handle-error-function error-msg)) - (when svn-process-handle-error-msg - (electric-helpify 'svn-process-help-with-error-msg))) - -(defun svn-process-help-with-error-msg () - (interactive) - (let ((help-msg (cadr (assoc svn-process-handle-error-msg - '(("Cannot non-recursively commit a directory deletion" - "Please unmark all files and position point at the directory you would like to remove.\nThen run commit again.")))))) - (if help-msg - (save-excursion - (with-output-to-temp-buffer (svn-help-buffer) - (princ (format "svn failed: %s\n\n%s" svn-process-handle-error-msg help-msg)))) - (message "svn failed:\n%s" svn-process-handle-error-msg)))) - - -(defun svn-process-filter (process str) - "Track the svn process output and ask user questions in the minibuffer when appropriate." - (save-window-excursion - (set-buffer svn-process-buffer-name) - ;;(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-and-newline passwd t))) - (when (looking-at "Username: ") - (let ((user-name (with-local-quit (read-string "Username for svn operation: ")))) - (svn-process-send-string-and-newline user-name))) - (when (looking-at "(R)eject, accept (t)emporarily or accept (p)ermanently") - (svn-status-show-process-buffer) - (let ((answer (with-local-quit (read-string "(R)eject, accept (t)emporarily or accept (p)ermanently? ")))) - (svn-process-send-string (substring answer 0 1))))))) - -(defun svn-revert-some-buffers (&optional tree) - "Reverts all buffers visiting a file in TREE that aren't modified. -To be run after a commit, an update or a merge." - (interactive) - (let ((tree (or (svn-status-base-dir) tree))) - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (not (buffer-modified-p)) - (let ((file (buffer-file-name))) - (when file - (let ((root (svn-status-base-dir (file-name-directory file))) - (point-pos (point))) - (when (and root - (string= root tree) - ;; buffer is modified and in the tree TREE. - svn-status-auto-revert-buffers) - (when svn-status-fancy-file-state-in-modeline - (svn-status-update-modeline)) - ;; (message "svn-revert-some-buffers: %s %s" (buffer-file-name) (verify-visited-file-modtime (current-buffer))) - ;; Keep the buffer if the file doesn't exist - (when (and (file-exists-p file) (not (verify-visited-file-modtime (current-buffer)))) - (revert-buffer t t) - (goto-char point-pos))))))))))) - -(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-info->user-elide'. - -Call `svn-status-line-info->ui-status' to access the whole ui-status -structure." - (list nil nil)) - -(defun svn-status-make-dummy-dirs (dir-list old-ui-information) - "Calculate additionally necessary directories that were not shown in the output -of 'svn status'" - ;; (message "svn-status-make-dummy-dirs %S" dir-list) - (let ((candidate) - (base-dir)) - (dolist (dir dir-list) - (setq base-dir (file-name-directory dir)) - (while base-dir - ;;(message "dir: %S dir-list: %S, base-dir: %S" dir dir-list base-dir) - (setq candidate (replace-regexp-in-string "/+$" "" base-dir)) - (setq base-dir (file-name-directory candidate)) - ;; (message "dir: %S, candidate: %S" dir candidate) - (add-to-list 'dir-list candidate)))) - ;; (message "svn-status-make-dummy-dirs %S" dir-list) - (append (mapcar (lambda (dir) - (svn-status-make-line-info - dir - (gethash dir old-ui-information))) - dir-list) - svn-status-info)) - -(defun svn-status-make-line-info (&optional - path - ui - file-mark prop-mark - local-rev last-change-rev - author - update-mark - locked-mark - with-history-mark - switched-mark - locked-repo-mark - psvn-extra-info) - "Create a new line-info from the given arguments -Anything left nil gets a sensible default. -nb: LOCKED-MARK refers to the kind of locks you get after an error, - LOCKED-REPO-MARK is the kind managed with `svn lock'" - (list (or ui (svn-status-make-ui-status)) - (or file-mark ? ) - (or prop-mark ? ) - (or path "") - (or local-rev ? ) - (or last-change-rev ? ) - (or author "") - update-mark - locked-mark - with-history-mark - switched-mark - locked-repo-mark - psvn-extra-info)) - -(defvar svn-user-names-including-blanks nil "A list of svn user names that include blanks. -To add support for the names \"feng shui\" and \"mister blank\", place the following in your .emacs: - (setq svn-user-names-including-blanks '(\"feng shui\" \"mister blank\")) - (add-hook 'svn-pre-parse-status-hook 'svn-status-parse-fixup-user-names-including-blanks) -") -;;(setq svn-user-names-including-blanks '("feng shui" "mister blank")) -;;(add-hook 'svn-pre-parse-status-hook 'svn-status-parse-fixup-user-names-including-blanks) - -(defun svn-status-parse-fixup-user-names-including-blanks () - "Helper function to allow user names that include blanks. -Add this function to the `svn-pre-parse-status-hook'. The variable -`svn-user-names-including-blanks' must be configured to hold all user names that contain -blanks. This function replaces the blanks with '-' to allow further processing with -the usual parsing functionality in `svn-parse-status-result'." - (when svn-user-names-including-blanks - (goto-char (point-min)) - (let ((search-string (concat " \\(" (mapconcat 'concat svn-user-names-including-blanks "\\|") "\\) "))) - (save-match-data - (save-excursion - (while (re-search-forward search-string (point-max) t) - (replace-match (replace-regexp-in-string " " "-" (match-string 1)) nil nil nil 1))))))) - -(defun svn-parse-status-result () - "Parse the `svn-process-buffer-name' 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)) - (svn-marks) - (svn-file-mark) - (svn-property-mark) - (svn-wc-locked-mark) - (svn-repo-locked-mark) - (svn-with-history-mark) - (svn-switched-mark) - (svn-update-mark) - (local-rev) - (last-change-rev) - (author) - (path) - (dir) - (revision-width svn-status-default-revision-width) - (author-width svn-status-default-author-width) - (svn-marks-length (if svn-status-verbose - (if svn-status-remote - 8 6) - (if svn-status-remote - ;; not verbose - 8 7))) - (dir-set '(".")) - (externals-map (make-hash-table :test 'equal)) - (skip-double-external-dir-entry-name nil)) - (set-buffer svn-process-buffer-name) - (setq svn-status-info nil) - (run-hooks 'svn-pre-parse-status-hook) - (goto-char (point-min)) - (while (< (point) (point-max)) - (cond - ((= (svn-point-at-eol) (svn-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 - ;; [ie the directory in (match-string 1)] - ;; we should parse it, and merge the info with what we have already know - ;; but for now just ignore the line completely - ; (forward-line) - ;; Actually, this seems to not always be the case - ;; I have an example where we are in an svn:external which - ;; is itself inside a svn:external, this need not be true: - ;; the next line is not 'X dir' but just 'dir', so we - ;; actually need to parse that line, or the results will - ;; not contain dir! - ;; so we should merge lines 'X dir' with ' dir', but for now - ;; we just leave both in the results - - ;; My attempt to merge the lines uses skip-double-external-dir-entry-name - ;; and externals-map - (setq skip-double-external-dir-entry-name (svn-match-string-no-properties 1)) - ;; (message "Going to skip %s" skip-double-external-dir-entry-name) - nil) - ((looking-at "--- Changelist") ; skip svn changelist header lines - ;; See: http://svn.collab.net/repos/svn/trunk/notes/changelist-design.txt - nil) - (t - (setq svn-marks (buffer-substring (point) (+ (point) svn-marks-length)) - svn-file-mark (elt svn-marks 0) ; 1st column - M,A,C,D,G,? etc - svn-property-mark (elt svn-marks 1) ; 2nd column - M,C (properties) - svn-wc-locked-mark (elt svn-marks 2) ; 3rd column - L or blank - svn-with-history-mark (elt svn-marks 3) ; 4th column - + or blank - svn-switched-mark (elt svn-marks 4) ; 5th column - S,X or blank - svn-repo-locked-mark (elt svn-marks 5)) ; 6th column - K,O,T,B or blank - (when svn-status-remote - (setq svn-update-mark (elt svn-marks 7))) ; 8th column - * or blank - (when (eq svn-property-mark ?\ ) (setq svn-property-mark nil)) - (when (eq svn-wc-locked-mark ?\ ) (setq svn-wc-locked-mark nil)) - (when (eq svn-with-history-mark ?\ ) (setq svn-with-history-mark nil)) - (when (eq svn-switched-mark ?\ ) (setq svn-switched-mark nil)) - (when (eq svn-update-mark ?\ ) (setq svn-update-mark nil)) - (when (eq svn-repo-locked-mark ?\ ) (setq svn-repo-locked-mark nil)) - (forward-char svn-marks-length) - (skip-chars-forward " ") - ;; (message "after marks: '%s'" (buffer-substring (point) (line-end-position))) - (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 "\\([-?]\\|[0-9]+\\) +\\([^ ]+\\)$") - (setq local-rev (svn-parse-rev-num (match-string 1)) - last-change-rev -1 - author "?" - path (match-string 2))) - ((looking-at "\\(.*\\)") - (setq path (match-string 1) - local-rev -1 - last-change-rev -1 - author (if (eq svn-file-mark ?X) "" "?"))) ;clear author of svn:externals dirs - (t - (error "Unknown status line format"))) - (unless path (setq path ".")) - (setq dir (file-name-directory path)) - (if (and (not svn-status-verbose) dir) - (let ((dirname (directory-file-name dir))) - (if (not (member dirname dir-set)) - (setq dir-set (cons dirname dir-set))))) - (if (and skip-double-external-dir-entry-name (string= skip-double-external-dir-entry-name path)) - ;; merge this entry to a previous saved one - (let ((info (gethash path externals-map))) - ;; (message "skip-double-external-dir-entry-name: %s - path: %s" skip-double-external-dir-entry-name path) - (if info - (progn - (svn-status-line-info->set-localrev info local-rev) - (svn-status-line-info->set-lastchangerev info last-change-rev) - (svn-status-line-info->set-author info author) - (svn-status-message 3 "merging entry for %s to %s" path info) - (setq skip-double-external-dir-entry-name nil)) - (message "psvn: %s not handled correct, please report this case." path))) - (setq svn-status-info - (cons (svn-status-make-line-info path - (gethash path old-ui-information) - svn-file-mark - svn-property-mark - local-rev - last-change-rev - author - svn-update-mark - svn-wc-locked-mark - svn-with-history-mark - svn-switched-mark - svn-repo-locked-mark - nil) ;;psvn-extra-info - svn-status-info))) - (when (eq svn-file-mark ?X) - (svn-puthash (match-string 1) (car svn-status-info) externals-map) - (svn-status-message 3 "found external: %s %S" (match-string 1) (car 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)) - (unless svn-status-verbose - (setq svn-status-info (svn-status-make-dummy-dirs dir-set - old-ui-information))) - (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%%c %%%ds %%%ds %%-%ds" - revision-width - revision-width - author-width)) - (setq svn-status-info (nreverse svn-status-info)) - (when svn-status-sort-status-buffer - (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-name' 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)))))) - -(defun svn-fixup-tramp-exit () - "Helper function to handle tramp connections stopping with an exit output." - (goto-char (point-max)) - (when (eq (svn-point-at-bol) (svn-point-at-eol)) - (forward-line -1)) - (beginning-of-line) - (when (looking-at "exit") - (delete-region (point) (svn-point-at-eol)))) - -(defun svn-fixup-tramp-output-maybe () - "Fixup leftover output when running via tramp" - (when (fboundp 'file-remote-p) - (when (file-remote-p default-directory) - (svn-fixup-tramp-exit)))) - -(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.") -(put 'svn-status-mode-map 'risky-local-variable t) ;for Emacs 20.7 -(defvar svn-status-mode-mark-map () - "Subkeymap used in `svn-status-mode' for mark commands.") -(put 'svn-status-mode-mark-map 'risky-local-variable t) ;for Emacs 20.7 -(defvar svn-status-mode-property-map () - "Subkeymap used in `svn-status-mode' for property commands.") -(put 'svn-status-mode-property-map 'risky-local-variable t) ;for Emacs 20.7 -(defvar svn-status-mode-options-map () - "Subkeymap used in `svn-status-mode' for option commands.") -(put 'svn-status-mode-options-map 'risky-local-variable t) ;for Emacs 20.7 -(defvar svn-status-mode-trac-map () - "Subkeymap used in `svn-status-mode' for trac issue tracker commands.") -(put 'svn-status-mode-trac-map 'risky-local-variable t) ;for Emacs 20.7 -(defvar svn-status-mode-extension-map () - "Subkeymap used in `svn-status-mode' for some seldom used commands.") -(put 'svn-status-mode-extension-map 'risky-local-variable t) ;for Emacs 20.7 -(defvar svn-status-mode-branch-map () - "Subkeymap used in `svn-status-mode' for branching commands.") -(put 'svn-status-mode-extension-map 'risky-local-variable t) ;for Emacs 20.7 -(defvar svn-status-mode-search-map () - "Subkeymap used in `svn-status-mode' for search commands.") -(put 'svn-status-mode-search-map 'risky-local-variable t) ;for Emacs 20.7 - -(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 "<mouse-2>") 'svn-status-mouse-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 "h") 'svn-status-pop-to-partner-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 "C-o") 'svn-status-find-file-other-window-noselect) - (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 "M-s") 'svn-status-update) ;; PCL-CVS compatibility - (define-key svn-status-mode-map (kbd "q") 'svn-status-bury-buffer) - (define-key svn-status-mode-map (kbd "x") 'svn-status-redraw-status-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 "w") 'svn-status-copy-current-line-info) - (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 "V") 'svn-status-svnversion) - (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 "z") 'svn-status-toggle-hide-externals) - (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 "C") 'svn-status-cp) - (define-key svn-status-mode-map (kbd "D") 'svn-status-rm) - (define-key svn-status-mode-map (kbd "c") 'svn-status-commit) - (define-key svn-status-mode-map (kbd "M-c") 'svn-status-cleanup) - (define-key svn-status-mode-map (kbd "k") 'svn-status-lock) - (define-key svn-status-mode-map (kbd "K") 'svn-status-unlock) - (define-key svn-status-mode-map (kbd "U") 'svn-status-update-cmd) - (define-key svn-status-mode-map (kbd "M-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 "n") 'svn-status-next-line) - (define-key svn-status-mode-map (kbd "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) - (define-key svn-status-mode-map (kbd "C-x C-j") 'svn-status-dired-jump) - (define-key svn-status-mode-map [down-mouse-3] 'svn-status-popup-menu)) - -(when (not svn-status-mode-mark-map) - (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 "P") 'svn-status-mark-modified-properties) - (define-key svn-status-mode-mark-map (kbd "D") 'svn-status-mark-deleted) - (define-key svn-status-mode-mark-map (kbd "*") 'svn-status-mark-changed) - (define-key svn-status-mode-mark-map (kbd ".") 'svn-status-mark-by-file-ext) - (define-key svn-status-mode-mark-map (kbd "%") 'svn-status-mark-filename-regexp) - (define-key svn-status-mode-mark-map (kbd "s") 'svn-status-store-usermarks) - (define-key svn-status-mode-mark-map (kbd "l") 'svn-status-load-usermarks) - (define-key svn-status-mode-mark-map (kbd "u") 'svn-status-show-svn-diff-for-marked-files)) - -(when (not svn-status-mode-search-map) - (setq svn-status-mode-search-map (make-sparse-keymap)) - (define-key svn-status-mode-search-map (kbd "g") 'svn-status-grep-files) - (define-key svn-status-mode-search-map (kbd "s") 'svn-status-search-files) - (define-key svn-status-mode-map (kbd "S") svn-status-mode-search-map)) - -(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 "Xe") 'svn-status-property-edit-svn-externals) - (define-key svn-status-mode-property-map (kbd "k") 'svn-status-property-set-keyword-list) - (define-key svn-status-mode-property-map (kbd "Ki") 'svn-status-property-set-keyword-id) - (define-key svn-status-mode-property-map (kbd "Kd") 'svn-status-property-set-keyword-date) - (define-key svn-status-mode-property-map (kbd "y") 'svn-status-property-set-eol-style) - (define-key svn-status-mode-property-map (kbd "x") 'svn-status-property-set-executable) - (define-key svn-status-mode-property-map (kbd "m") 'svn-status-property-set-mime-type) - ;; 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)) -(when (not svn-status-mode-extension-map) - (setq svn-status-mode-extension-map (make-sparse-keymap)) - (define-key svn-status-mode-extension-map (kbd "v") 'svn-status-resolved) - (define-key svn-status-mode-extension-map (kbd "X") 'svn-status-resolve-conflicts) - (define-key svn-status-mode-extension-map (kbd "e") 'svn-status-export) - (define-key svn-status-mode-map (kbd "X") svn-status-mode-extension-map)) -(when (not svn-status-mode-options-map) - (setq svn-status-mode-options-map (make-sparse-keymap)) - (define-key svn-status-mode-options-map (kbd "s") 'svn-status-save-state) - (define-key svn-status-mode-options-map (kbd "l") 'svn-status-load-state) - (define-key svn-status-mode-options-map (kbd "x") 'svn-status-toggle-sort-status-buffer) - (define-key svn-status-mode-options-map (kbd "v") 'svn-status-toggle-svn-verbose-flag) - (define-key svn-status-mode-options-map (kbd "f") 'svn-status-toggle-display-full-path) - (define-key svn-status-mode-options-map (kbd "t") 'svn-status-set-trac-project-root) - (define-key svn-status-mode-options-map (kbd "n") 'svn-status-set-module-name) - (define-key svn-status-mode-options-map (kbd "c") 'svn-status-set-changelog-style) - (define-key svn-status-mode-options-map (kbd "b") 'svn-status-set-branch-list) - (define-key svn-status-mode-map (kbd "O") svn-status-mode-options-map)) -(when (not svn-status-mode-trac-map) - (setq svn-status-mode-trac-map (make-sparse-keymap)) - (define-key svn-status-mode-trac-map (kbd "w") 'svn-trac-browse-wiki) - (define-key svn-status-mode-trac-map (kbd "t") 'svn-trac-browse-timeline) - (define-key svn-status-mode-trac-map (kbd "m") 'svn-trac-browse-roadmap) - (define-key svn-status-mode-trac-map (kbd "r") 'svn-trac-browse-report) - (define-key svn-status-mode-trac-map (kbd "s") 'svn-trac-browse-source) - (define-key svn-status-mode-trac-map (kbd "i") 'svn-trac-browse-ticket) - (define-key svn-status-mode-trac-map (kbd "c") 'svn-trac-browse-changeset) - (define-key svn-status-mode-map (kbd "T") svn-status-mode-trac-map)) -(when (not svn-status-mode-branch-map) - (setq svn-status-mode-branch-map (make-sparse-keymap)) - (define-key svn-status-mode-branch-map (kbd "d") 'svn-branch-diff) - (define-key svn-status-mode-map (kbd "B") svn-status-mode-branch-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 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 resolve conflicts" svn-status-resolve-conflicts] - ) - ("Search" - ["Grep marked files" svn-status-grep-files t] - ["Search marked files" svn-status-search-files t] - ) - ["svn cat ..." svn-status-get-specific-revision t] - ["svn add" svn-status-add-file t] - ["svn add recursively" svn-status-add-file-recursively t] - ["svn mkdir..." svn-status-make-directory t] - ["svn mv..." svn-status-mv t] - ["svn cp..." svn-status-cp t] - ["svn rm..." svn-status-rm t] - ["svn export..." svn-status-export 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] - ["svn lock" svn-status-lock t] - ["svn unlock" svn-status-unlock t] - ["Show Process Buffer" svn-status-show-process-buffer t] - ("Branch" - ["diff" svn-branch-diff t] - ["Set Branch list" svn-status-set-branch-list 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] - "---" - ["Edit svn:externals Property" svn-status-property-edit-svn-externals t] - "---" - ["Edit svn:keywords List" svn-status-property-set-keyword-list t] - ["Add/Remove Id to/from svn:keywords" svn-status-property-set-keyword-id t] - ["Add/Remove Date to/from svn:keywords" svn-status-property-set-keyword-date t] - "---" - ["Select svn:eol-style" svn-status-property-set-eol-style t] - ["Set svn:executable" svn-status-property-set-executable t] - ["Set svn:mime-type" svn-status-property-set-mime-type t] - ) - ("Options" - ["Save Options" svn-status-save-state t] - ["Load Options" svn-status-load-state t] - ["Set Trac project root" svn-status-set-trac-project-root t] - ["Set Short module name" svn-status-set-module-name t] - ["Set Changelog style" svn-status-set-changelog-style t] - ["Set Branch list" svn-status-set-branch-list t] - ["Sort the *svn-status* buffer" svn-status-toggle-sort-status-buffer - :style toggle :selected svn-status-sort-status-buffer] - ["Use -v for svn status calls" svn-status-toggle-svn-verbose-flag - :style toggle :selected svn-status-verbose] - ["Display full path names" svn-status-toggle-display-full-path - :style toggle :selected svn-status-display-full-path] - ) - ("Trac" - ["Browse wiki" svn-trac-browse-wiki t] - ["Browse timeline" svn-trac-browse-timeline t] - ["Browse roadmap" svn-trac-browse-roadmap t] - ["Browse source" svn-trac-browse-source t] - ["Browse report" svn-trac-browse-report t] - ["Browse ticket" svn-trac-browse-ticket t] - ["Browse changeset" svn-trac-browse-changeset t] - ["Set Trac project root" svn-status-set-trac-project-root t] - ) - "---" - ["Edit Next SVN Cmd Line" svn-status-toggle-edit-cmd-flag t] - ["Work Directory History..." svn-status-use-history t] - ("Mark / Unmark" - ["Mark" svn-status-set-user-mark t] - ["Unmark" svn-status-unset-user-mark t] - ["Unmark all" svn-status-unset-all-usermarks t] - "---" - ["Mark/Unmark unknown" svn-status-mark-unknown t] - ["Mark/Unmark modified" svn-status-mark-modified t] - ["Mark/Unmark modified properties" svn-status-mark-modified-properties t] - ["Mark/Unmark added" svn-status-mark-added t] - ["Mark/Unmark deleted" svn-status-mark-deleted t] - ["Mark/Unmark modified/added/deleted" svn-status-mark-changed t] - ["Mark/Unmark filename by extension" svn-status-mark-by-file-ext t] - ["Mark/Unmark filename by regexp" svn-status-mark-filename-regexp t] - ["Store Usermarks" svn-status-store-usermarks t] - ["Load Usermarks" svn-status-load-usermarks 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] - ["Hide Externals" svn-status-toggle-hide-externals - :style toggle :selected svn-status-hide-externals] - ["Show Client versions" svn-status-version t] - ["Prepare bug report" svn-prepare-bug-report t] - )) - -(defvar svn-status-file-popup-menu-list - '(["open" svn-status-find-file-other-window t] - ["svn diff" svn-status-show-svn-diff t] - ["svn commit" svn-status-commit t] - ["svn log" svn-status-show-svn-log t] - ["svn blame" svn-status-blame t] - ["mark" svn-status-set-user-mark t] - ["unmark" svn-status-unset-user-mark t] - ["svn add" svn-status-add-file t] - ["svn add recursively" svn-status-add-file-recursively t] - ["svn mv..." svn-status-mv t] - ["svn rm..." svn-status-rm t] - ["svn lock" svn-status-lock t] - ["svn unlock" svn-status-unlock t] - ["svn info" svn-status-info t] - ) "A list of menu entries for `svn-status-popup-menu'") - -;; extend svn-status-file-popup-menu-list via: -;; (add-to-list 'svn-status-file-popup-menu-list ["commit" svn-status-commit t]) - -(defun svn-status-popup-menu (event) - "Display a file specific popup menu" - (interactive "e") - (mouse-set-point event) - (let* ((line-info (svn-status-get-line-information)) - (name (svn-status-line-info->filename line-info))) - (when line-info - (easy-menu-define svn-status-actual-popup-menu nil nil - (append (list name) svn-status-file-popup-menu-list)) - (svn-status-face-set-temporary-during-popup - 'svn-status-marked-popup-face (svn-point-at-bol) (svn-point-at-eol) - svn-status-actual-popup-menu)))) - -(defun svn-status-face-set-temporary-during-popup (face begin end menu &optional prefix) - "Put FACE on BEGIN and END in the buffer during Popup MENU. -PREFIX is passed to `popup-menu'." - (let (o) - (unwind-protect - (progn - (setq o (make-overlay begin end)) - (overlay-put o 'face face) - (save-excursion (sit-for 0)) - (popup-menu menu prefix)) - (delete-overlay o)))) - -(defun svn-status-mode () - "Major mode used by psvn.el to display the output of \"svn status\". - -The Output has the following format: - 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 - -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) - (run-hooks 'svn-status-mode-hook) - (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 buffers used by psvn.el -Currently this is: - `svn-status-buffer-name' - `svn-process-buffer-name' - `svn-log-edit-buffer-name' - *svn-property-edit* - *svn-log* - *svn-info* -When called with a prefix argument, ARG, 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-buffer-name "*svn-property-edit*" "*svn-log*" "*svn-info*" ,svn-process-buffer-name))) - (while bl - (when (get-buffer (car bl)) - (bury-buffer (car bl))) - (setq bl (cdr bl))) - (when (string= (buffer-name) svn-status-buffer-name) - (bury-buffer)))))) - -(defun svn-status-save-some-buffers (&optional tree) - "Save all buffers visiting a file in TREE. -If TREE is not given, try `svn-status-base-dir' as TREE." - (interactive) - ;; (message "svn-status-save-some-buffers: tree1: %s" tree) - (let ((ok t) - (tree (or (svn-status-base-dir) - tree))) - ;; (message "svn-status-save-some-buffers: tree2: %s" tree) - (unless tree - (error "Not in a svn project tree")) - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (buffer-modified-p) - (let ((file (buffer-file-name))) - (when file - (let ((root (svn-status-base-dir (file-name-directory file)))) - ;; (message "svn-status-save-some-buffers: file: %s, root: %s" file root) - (when (and root - (string= root tree) - ;; buffer is modified and in the tree TREE. - (or (y-or-n-p (concat "Save buffer " (buffer-name) "? ")) - (setq ok nil))) - (save-buffer)))))))) - ok)) - -(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) - (svn-status-ensure-cursor-on-file) - (find-file-other-window (svn-status-line-info->filename - (svn-status-get-line-information)))) - -(defun svn-status-find-file-other-window-noselect () - "Open the file in the other window for editing, but don't select it." - (interactive) - (svn-status-ensure-cursor-on-file) - (display-buffer - (find-file-noselect (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) - (svn-status-ensure-cursor-on-file) - (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) - (svn-status-ensure-cursor-on-file) - (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-mouse-find-file-or-examine-directory (event) - "Move point to where EVENT occurred, and do `svn-status-find-file-or-examine-directory' -EVENT could be \"mouse clicked\" or similar." - (interactive "e") - (mouse-set-point event) - (svn-status-find-file-or-examine-directory)) - -(defun svn-status-line-info->ui-status (line-info) - "Return the ui-status structure of LINE-INFO. -See `svn-status-make-ui-status' for information about the ui-status." - (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." - (let ((l (nth 5 line-info))) - (if (and l (>= l 0)) - l - nil))) -(defun svn-status-line-info->author (line-info) - "Return the last author that changed the item that is represented in LINE-INFO." - (nth 6 line-info)) -(defun svn-status-line-info->update-available (line-info) - "Return whether LINE-INFO is out of date. -In other words, whether there is a newer version available in the -repository than the working copy." - (nth 7 line-info)) -(defun svn-status-line-info->locked (line-info) - "Return whether LINE-INFO represents a locked file. -This is column three of the `svn status' output. -The result will be nil or \"L\". -\(A file becomes locked when an operation is interrupted; run \\[svn-status-cleanup]' -to unlock it.\)" - (nth 8 line-info)) -(defun svn-status-line-info->historymark (line-info) - "Mark from column four of output from `svn status'. -This will be nil unless the file is scheduled for addition with -history, when it will be \"+\"." - (nth 9 line-info)) -(defun svn-status-line-info->switched (line-info) - "Return whether LINE-INFO is switched relative to its parent. -This is column five of the output from `svn status'. -The result will be \"S\", \"X\" or nil." - (nth 10 line-info)) -(defun svn-status-line-info->repo-locked (line-info) - "Return whether LINE-INFO contains some locking information. -This is column six of the output from `svn status'. -The result will be \"K\", \"O\", \"T\", \"B\" or nil." - (nth 11 line-info)) -(defun svn-status-line-info->psvn-extra-info (line-info) - "Return a list of extra information for psvn associated with LINE-INFO. -This list holds currently only one element: -* The action after a commit or update." - (nth 12 line-info)) - -(defun svn-status-line-info->is-visiblep (line-info) - "Return whether the line is visible or not" - (or (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-externals line-info) - (svn-status-line-info->hide-because-custom-hide-function line-info) - (svn-status-line-info->hide-because-user-elide line-info))) - (svn-status-line-info->update-available line-info) ;; show the line, if an update is available - (svn-status-line-info->psvn-extra-info line-info) ;; show the line, if there is some extra info displayed on this line - )) - -(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-externals (line-info) - (and svn-status-hide-externals - (eq (svn-status-line-info->filemark line-info) ?X))) - -(defun svn-status-line-info->hide-because-custom-hide-function (line-info) - (and svn-status-custom-hide-function - (apply svn-status-custom-hide-function (list 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-line-info->set-propmark (line-info value) - (setcar (nthcdr 2 line-info) value)) - -(defun svn-status-line-info->set-localrev (line-info value) - (setcar (nthcdr 4 line-info) value)) - -(defun svn-status-line-info->set-author (line-info value) - (setcar (nthcdr 6 line-info) value)) - -(defun svn-status-line-info->set-lastchangerev (line-info value) - (setcar (nthcdr 5 line-info) value)) - -(defun svn-status-line-info->set-repo-locked (line-info value) - (setcar (nthcdr 11 line-info) value)) - -(defun svn-status-line-info->set-psvn-extra-info (line-info value) - (setcar (nthcdr 12 line-info) value)) - -(defun svn-status-copy-current-line-info (arg) - "Copy the current file name at point, using `svn-status-copy-filename-as-kill'. -If no file is at point, copy everything starting from ':' to the end of line." - (interactive "P") - (if (svn-status-get-line-information) - (svn-status-copy-filename-as-kill arg) - (save-excursion - (goto-char (svn-point-at-bol)) - (when (looking-at ".+?: *\\(.+\\)$") - (kill-new (svn-match-string-no-properties 1)) - (message "Copied: %s" (svn-match-string-no-properties 1)))))) - -(defun svn-status-copy-filename-as-kill (arg) - "Copy the actual file name to the kill-ring. -When called with the prefix argument 0, use the full path name." - (interactive "P") - (let ((str (if (eq arg 0) - (svn-status-line-info->full-path (svn-status-get-line-information)) - (svn-status-line-info->filename (svn-status-get-line-information))))) - (kill-new str) - (message "Copied %s" str))) - -(defun svn-status-get-child-directories (&optional dir) - "Return a list of subdirectories for DIR" - (interactive) - (let ((this-dir (concat (expand-file-name (or dir (svn-status-line-info->filename (svn-status-get-line-information)))) "/")) - (test-dir) - (sub-dir-list)) - ;;(message "this-dir %S" this-dir) - (dolist (line-info svn-status-info) - (when (svn-status-line-info->directory-p line-info) - (setq test-dir (svn-status-line-info->full-path line-info)) - (when (string= (file-name-directory test-dir) this-dir) - (add-to-list 'sub-dir-list (file-relative-name (svn-status-line-info->full-path line-info)) t)))) - sub-dir-list)) - -(defun svn-status-toggle-elide (arg) - "Toggle eliding of the current file or directory. -When called with a prefix argument, toggle the hiding of all subdirectories for the current directory." - (interactive "P") - (if arg - (let ((cur-line (svn-status-line-info->filename (svn-status-get-line-information)))) - (when (svn-status-line-info->user-elide (svn-status-get-line-information)) - (svn-status-toggle-elide nil)) - (dolist (dir-name (svn-status-get-child-directories)) - (svn-status-goto-file-name dir-name) - (svn-status-toggle-elide nil)) - (svn-status-goto-file-name cur-line)) - (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)) - (if (member test svn-status-elided-list) - (setq svn-status-elided-list (delete test svn-status-elided-list)) - (add-to-list 'svn-status-elided-list test)) - (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)) - (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 "Elided 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))) - ;;(message "elide-mark: %S member: %S" elide-mark (member fname svn-status-elided-list)) - (when (and (member fname svn-status-elided-list) (not elide-mark)) - (setq svn-status-elided-list (delete fname svn-status-elided-list))) - (setcar (nthcdr 1 (svn-status-line-info->ui-status (car st-info))) elide-mark)) - (setq st-info (cdr st-info)))) - ;;(message "svn-status-elided-list: %S" svn-status-elided-list) - (svn-status-update-buffer))) - -(defun svn-status-apply-elide-list () - "Elide files/directories according to `svn-status-elided-list'." - (interactive) - (let ((st-info svn-status-info) - (fname) - (len-fname) - (test) - (len-test) - (elided-list) - (elide-mark)) - (when svn-status-elided-list - (while st-info - (setq fname (svn-status-line-info->filename (car st-info))) - (setq len-fname (length fname)) - (setq elided-list svn-status-elided-list) - (setq elide-mark nil) - (while elided-list - (setq test (car elided-list)) - (when (string= test ".") - (setq test "")) - (setq len-test (length test)) - (when (and (>= len-fname len-test) - (string= (substring fname 0 len-test) test)) - (setq elide-mark t) - (when (or (string= fname ".") - (and (= len-fname len-test) (svn-status-line-info->directory-p (car st-info)))) - (setq elide-mark 'directory))) - (setq elided-list (cdr elided-list))) - ;;(message "fname: %s elide-mark: %S" fname elide-mark) - (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-update-with-command-list (cmd-list) - (save-excursion - (set-buffer svn-status-buffer-name) - (let ((st-info) - (found) - (action) - (fname (svn-status-line-info->filename (svn-status-get-line-information))) - (fname-pos (point)) - (column (current-column))) - (setq cmd-list (sort cmd-list '(lambda (item1 item2) (string-lessp (car item1) (car item2))))) - (while cmd-list - (unless st-info (setq st-info svn-status-info)) - ;;(message "%S" (caar cmd-list)) - (setq found nil) - (while (and (not found) st-info) - (setq found (string= (caar cmd-list) (svn-status-line-info->filename (car st-info)))) - ;;(message "found: %S" found) - (unless found (setq st-info (cdr st-info)))) - (unless found - (svn-status-message 3 "psvn: continue to search for %s" (caar cmd-list)) - (setq st-info svn-status-info) - (while (and (not found) st-info) - (setq found (string= (caar cmd-list) (svn-status-line-info->filename (car st-info)))) - (unless found (setq st-info (cdr st-info))))) - (if found - ;;update the info line - (progn - (setq action (cadar cmd-list)) - ;;(message "found %s, action: %S" (caar cmd-list) action) - (svn-status-annotate-status-buffer-entry action (car st-info))) - (svn-status-message 3 "psvn: did not find %s" (caar cmd-list))) - (setq cmd-list (cdr cmd-list))) - (if fname - (progn - (goto-char fname-pos) - (svn-status-goto-file-name fname) - (goto-char (+ column (svn-point-at-bol)))) - (goto-char (+ (next-overlay-change (point-min)) svn-status-default-column)))))) - -(defun svn-status-annotate-status-buffer-entry (action line-info) - (let ((tag-string)) - (svn-status-goto-file-name (svn-status-line-info->filename line-info)) - (when (and (member action '(committed added)) - svn-status-commit-rev-number) - (svn-status-line-info->set-localrev line-info svn-status-commit-rev-number) - (svn-status-line-info->set-lastchangerev line-info svn-status-commit-rev-number)) - (when svn-status-last-commit-author - (svn-status-line-info->set-author line-info svn-status-last-commit-author)) - (svn-status-line-info->set-psvn-extra-info line-info (list action)) - (cond ((equal action 'committed) - (setq tag-string " <committed>") - (when (member (svn-status-line-info->repo-locked line-info) '(?K)) - (svn-status-line-info->set-repo-locked line-info nil))) - ((equal action 'added) - (setq tag-string " <added>")) - ((equal action 'deleted) - (setq tag-string " <deleted>")) - ((equal action 'replaced) - (setq tag-string " <replaced>")) - ((equal action 'updated) - (setq tag-string " <updated>")) - ((equal action 'updated-props) - (setq tag-string " <updated-props>")) - ((equal action 'conflicted) - (setq tag-string " <conflicted>") - (svn-status-line-info->set-filemark line-info ?C)) - ((equal action 'merged) - (setq tag-string " <merged>")) - ((equal action 'propset) - ;;(setq tag-string " <propset>") - (svn-status-line-info->set-propmark line-info svn-status-file-modified-after-save-flag)) - ((equal action 'added-wc) - (svn-status-line-info->set-filemark line-info ?A) - (svn-status-line-info->set-localrev line-info 0)) - ((equal action 'deleted-wc) - (svn-status-line-info->set-filemark line-info ?D)) - (t - (error "Unknown action '%s for %s" action (svn-status-line-info->filename line-info)))) - (when (and tag-string (not (member action '(conflicted merged)))) - (svn-status-line-info->set-filemark line-info ? ) - (svn-status-line-info->set-propmark line-info ? )) - (let ((buffer-read-only nil)) - (delete-region (svn-point-at-bol) (svn-point-at-eol)) - (svn-insert-line-in-status-buffer line-info) - (backward-char 1) - (when tag-string - (insert tag-string)) - (delete-char 1)))) - - - -;; (svn-status-update-with-command-list '(("++ideas" committed) ("a.txt" committed) ("alf"))) -;; (svn-status-update-with-command-list (svn-status-parse-commit-output)) - -(defun svn-status-parse-commit-output () - "Parse the output of svn commit. -Return a list that is suitable for `svn-status-update-with-command-list'" - (save-excursion - (set-buffer svn-process-buffer-name) - (let ((action) - (file-name) - (skip) - (result)) - (goto-char (point-min)) - (setq svn-status-commit-rev-number nil) - (setq skip nil) ; set to t whenever we find a line not about a committed file - (while (< (point) (point-max)) - (cond ((= (svn-point-at-eol) (svn-point-at-bol)) ;skip blank lines - (setq skip t)) - ((looking-at "Sending") - (setq action 'committed)) - ((looking-at "Adding") - (setq action 'added)) - ((looking-at "Deleting") - (setq action 'deleted)) - ((looking-at "Replacing") - (setq action 'replaced)) - ((looking-at "Transmitting file data") - (setq skip t)) - ((looking-at "Committed revision \\([0-9]+\\)") - (setq svn-status-commit-rev-number - (string-to-number (svn-match-string-no-properties 1))) - (setq skip t)) - (t ;; this should never be needed(?) - (setq action 'unknown))) - (unless skip ;found an interesting line - (forward-char 15) - (when svn-status-operated-on-dot - ;; when the commit used . as argument, delete the trailing directory - ;; from the svn output - (search-forward "/" nil t)) - (setq file-name (buffer-substring-no-properties (point) (svn-point-at-eol))) - (unless svn-status-last-commit-author - (setq svn-status-last-commit-author (car (svn-status-info-for-path (expand-file-name (concat default-directory file-name)))))) - (setq result (cons (list file-name action) - result)) - (setq skip nil)) - (forward-line 1)) - result))) -;;(svn-status-parse-commit-output) -;;(svn-status-annotate-status-buffer-entry) - -(defun svn-status-parse-ar-output () - "Parse the output of svn add|remove. -Return a list that is suitable for `svn-status-update-with-command-list'" - (save-excursion - (set-buffer svn-process-buffer-name) - (let ((action) - (name) - (skip) - (result)) - (goto-char (point-min)) - (while (< (point) (point-max)) - (cond ((= (svn-point-at-eol) (svn-point-at-bol)) ;skip blank lines - (setq skip t)) - ((looking-at "A") - (setq action 'added-wc)) - ((looking-at "D") - (setq action 'deleted-wc)) - (t ;; this should never be needed(?) - (setq action 'unknown))) - (unless skip ;found an interesting line - (forward-char 10) - (setq name (buffer-substring-no-properties (point) (svn-point-at-eol))) - (setq result (cons (list name action) - result)) - (setq skip nil)) - (forward-line 1)) - result))) -;; (svn-status-parse-ar-output) -;; (svn-status-update-with-command-list (svn-status-parse-ar-output)) - -(defun svn-status-parse-update-output () - "Parse the output of svn update. -Return a list that is suitable for `svn-status-update-with-command-list'" - (save-excursion - (set-buffer svn-process-buffer-name) - (setq svn-status-update-rev-number nil) - (let ((action) - (name) - (skip) - (result)) - (goto-char (point-min)) - (while (< (point) (point-max)) - (cond ((= (svn-point-at-eol) (svn-point-at-bol)) ;skip blank lines - (setq skip t)) - ((looking-at "Updated to revision \\([0-9]+\\)") - (setq svn-status-update-rev-number - (list t (string-to-number (svn-match-string-no-properties 1)))) - (setq skip t)) - ((looking-at "At revision \\([0-9]+\\)") - (setq svn-status-update-rev-number - (list nil (string-to-number (svn-match-string-no-properties 1)))) - (setq skip t)) - ((looking-at "U") - (setq action 'updated)) - ((looking-at "A") - (setq action 'added)) - ((looking-at "D") - (setq skip t)) - ;;(setq action 'deleted)) ;;deleted files are not displayed in the svn status output. - ((looking-at "C") - (setq action 'conflicted)) - ((looking-at "G") - (setq action 'merged)) - - ((looking-at " U") - (setq action 'updated-props)) - - (t ;; this should never be needed(?) - (setq action (concat "parse-update: '" - (buffer-substring-no-properties (point) (+ 2 (point))) "'")))) - (unless skip ;found an interesting line - (forward-char 3) - (setq name (buffer-substring-no-properties (point) (svn-point-at-eol))) - (setq result (cons (list name action) - result)) - (setq skip nil)) - (forward-line 1)) - result))) -;; (svn-status-parse-update-output) -;; (svn-status-update-with-command-list (svn-status-parse-update-output)) - -(defun svn-status-parse-property-output () - "Parse the output of svn propset. -Return a list that is suitable for `svn-status-update-with-command-list'" - (save-excursion - (set-buffer svn-process-buffer-name) - (let ((result)) - (dolist (line (split-string (buffer-substring-no-properties (point-min) (point-max)) "\n")) - (message "%s" line) - (when (string-match "property '\\(.+\\)' set on '\\(.+\\)'" line) - ;;(message "property %s - file %s" (match-string 1 line) (match-string 2 line)) - (setq result (cons (list (match-string 2 line) 'propset) result)))) - result))) - -;; (svn-status-parse-property-output) -;; (svn-status-update-with-command-list (svn-status-parse-property-output)) - - -(defun svn-status-line-info->symlink-p (line-info) - "Return non-nil if LINE-INFO refers to a symlink, nil otherwise. -The value is the name of the file to which it is linked. \(See -`file-symlink-p'.\) - -On win32 systems this won't work, even though symlinks are supported -by subversion on such systems." - ;; on win32 would need to see how svn does symlinks - (file-symlink-p (svn-status-line-info->filename line-info))) - -(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) "*" " ")) - (update-available (if (svn-status-line-info->update-available line-info) - (svn-add-face (if svn-status-short-mod-flag-p - "** " - " (Update Available)") - 'svn-status-update-available-face) - (if svn-status-short-mod-flag-p " " ""))) - (filename ;; <indentation>file or /path/to/file - (concat - (if (or svn-status-display-full-path - svn-status-hide-unmodified - svn-status-hide-externals) - (svn-add-face - (let ((dir-name (file-name-as-directory - (svn-status-line-info->directory-containing-line-info - line-info nil)))) - (if (and (<= 2 (length dir-name)) - (= ?. (aref dir-name 0)) - (= ?/ (aref dir-name 1))) - (substring dir-name 2) - dir-name)) - 'svn-status-directory-face) - ;; showing all files, so add indentation - (make-string (* svn-status-indentation (svn-status-count-/ - (svn-status-line-info->filename line-info))) - 32)) - ;;symlinks get a different face - (let ((target (svn-status-line-info->symlink-p line-info))) - (if target - ;; name -> trget - ;; name gets symlink-face, target gets file/directory face - (concat - (svn-add-face (svn-status-line-info->filename-nondirectory line-info) - 'svn-status-symlink-face) - " -> " - (svn-status-choose-face-to-add - ;; TODO: could use different faces for - ;; unversioned targets and broken symlinks? - (svn-status-line-info->directory-p line-info) - target - 'svn-status-directory-face - 'svn-status-filename-face)) - ;; else target is not a link - (svn-status-choose-face-to-add - (svn-status-line-info->directory-p 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) " ..." ""))) - (svn-puthash (svn-status-line-info->filename line-info) - (point) - svn-status-filename-to-buffer-position-cache) - (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->historymark 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)) - (when svn-status-short-mod-flag-p update-available) - filename - (unless svn-status-short-mod-flag-p update-available) - (svn-status-maybe-add-string (svn-status-line-info->locked line-info) - " [ LOCKED ]" 'svn-status-locked-face) - (svn-status-maybe-add-string (svn-status-line-info->repo-locked line-info) - (let ((flag (svn-status-line-info->repo-locked line-info))) - (cond ((eq flag ?K) " [ REPO-LOCK-HERE ]") - ((eq flag ?O) " [ REPO-LOCK-OTHER ]") - ((eq flag ?T) " [ REPO-LOCK-STOLEN ]") - ((eq flag ?B) " [ REPO-LOCK-BROKEN ]") - (t " [ REPO-LOCK-UNKNOWN ]"))) - 'svn-status-locked-face) - (svn-status-maybe-add-string (eq (svn-status-line-info->switched line-info) ?S) - " (switched)" 'svn-status-switched-face) - elide-hint) - 'svn-status-marked-face) - "\n"))) - -(defun svn-status-redraw-status-buffer () - "Redraw the `svn-status-buffer-name' buffer. -Additionally clear the psvn-extra-info field in all line-info lists." - (interactive) - (dolist (line-info svn-status-info) - (svn-status-line-info->set-psvn-extra-info line-info nil)) - (svn-status-update-buffer)) - -(defun svn-status-update-buffer () - "Update the `svn-status-buffer-name' buffer, using `svn-status-info'. - This function does not access the repository." - (interactive) - ;(message "buffer-name: %s" (buffer-name)) - (unless (string= (buffer-name) svn-status-buffer-name) - (set-buffer svn-status-buffer-name)) - (svn-status-mode) - (when svn-status-refresh-info - (when (eq svn-status-refresh-info 'once) - (setq svn-status-refresh-info nil)) - (svn-status-parse-info t)) - (let ((st-info svn-status-info) - (buffer-read-only nil) - (start-pos) - (overlay) - (unmodified-count 0) ;how many unmodified files are hidden - (unknown-count 0) ;how many unknown files are hidden - (externals-count 0) ;how many svn:externals files are hidden - (custom-hide-count 0) ;how many files are hidden via svn-status-custom-hide-function - (marked-count 0) ;how many files are elided - (user-elide-count 0) - (first-line t) - (fname (svn-status-line-info->filename (svn-status-get-line-information))) - (fname-pos (point)) - (window-line-pos (svn-status-window-line-position (get-buffer-window (current-buffer)))) - (header-line-string) - (column (current-column))) - (delete-region (point-min) (point-max)) - (insert "\n") - ;; Insert all files and directories - (while st-info - (setq start-pos (point)) - (cond ((or (svn-status-line-info->has-usermark (car st-info)) first-line) - ;; Show a marked file and the "." always - (svn-insert-line-in-status-buffer (car st-info)) - (setq first-line nil)) - ((svn-status-line-info->update-available (car st-info)) - (svn-insert-line-in-status-buffer (car st-info))) - ((and svn-status-custom-hide-function - (apply svn-status-custom-hide-function (list (car st-info)))) - (setq custom-hide-count (1+ custom-hide-count))) - ((svn-status-line-info->hide-because-user-elide (car st-info)) - (setq user-elide-count (1+ user-elide-count))) - ((svn-status-line-info->hide-because-unknown (car st-info)) - (setq unknown-count (1+ unknown-count))) - ((svn-status-line-info->hide-because-unmodified (car st-info)) - (setq unmodified-count (1+ unmodified-count))) - ((svn-status-line-info->hide-because-externals (car st-info)) - (setq externals-count (1+ externals-count))) - (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)) - (overlay-put overlay 'evaporate t) - (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-module-name - (insert (format "Project name: %s\n" svn-status-module-name))) - (when svn-status-branch-list - (insert (format "Branches: %s\n" svn-status-branch-list))) - (when svn-status-base-info - (insert (concat "Repository Root: " (svn-status-base-info->repository-root) "\n")) - (insert (concat "Repository Url: " (svn-status-base-info->url) "\n"))) - (when svn-status-hide-unknown - (insert - (format "%d Unknown file(s) are hidden - press `?' to toggle hiding\n" - unknown-count))) - (when svn-status-hide-unmodified - (insert - (format "%d Unmodified file(s) are hidden - press `_' to toggle hiding\n" - unmodified-count))) - (when svn-status-hide-externals - (insert - (format "%d Externals file(s) are hidden - press `z' to toggle hiding\n" - externals-count))) - (when (> custom-hide-count 0) - (insert - (format "%d file(s) are hidden via the svn-status-custom-hide-function\n" - custom-hide-count))) - (when (> user-elide-count 0) - (insert (format "%d file(s) elided\n" user-elide-count))) - (insert (format "%d file(s) marked\n" marked-count)) - (setq header-line-string (concat (format svn-status-line-format - 70 80 72 "BASE" "CMTD" "Author") - (if svn-status-short-mod-flag-p "em " "") - "File")) - (cond ((eq svn-status-use-header-line t) - (setq header-line-format (concat " " header-line-string))) - ((eq svn-status-use-header-line 'inline) - (insert "\n " header-line-string "\n"))) - (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 (svn-point-at-bol))) - (when window-line-pos - (recenter window-line-pos))) - (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-name' buffer. -When called with the prefix argument 0, reset the information to nil. -This hides the repository information again. - -When ARG is t, don't update the svn status buffer. This is useful for -non-interactive use." - (interactive "P") - (if (eq arg 0) - (setq svn-status-base-info nil) - (let ((svn-process-buffer-name "*svn-info-output*")) - (when (get-buffer svn-process-buffer-name) - (kill-buffer svn-process-buffer-name)) - (svn-run nil t 'parse-info "info" ".") - (svn-status-parse-info-result))) - (unless (eq arg t) - (svn-status-update-buffer))) - -(defun svn-status-parse-info-result () - "Parse the result from the svn info command. -Put the found values in `svn-status-base-info'." - (let ((url) - (repository-root) - (last-changed-author)) - (save-excursion - (set-buffer svn-process-buffer-name) - (goto-char (point-min)) - (let ((case-fold-search t)) - (search-forward "url: ") - (setq url (buffer-substring-no-properties (point) (svn-point-at-eol))) - (when (search-forward "repository root: " nil t) - (setq repository-root (buffer-substring-no-properties (point) (svn-point-at-eol)))) - (when (search-forward "last changed author: " nil t) - (setq last-changed-author (buffer-substring-no-properties (point) (svn-point-at-eol)))))) - (setq svn-status-base-info `((url ,url) (repository-root ,repository-root) (last-changed-author ,last-changed-author))))) - -(defun svn-status-base-info->url () - "Extract the url part from `svn-status-base-info'." - (if svn-status-base-info - (cadr (assoc 'url svn-status-base-info)) - "")) - -(defun svn-status-base-info->repository-root () - "Extract the repository-root part from `svn-status-base-info'." - (if svn-status-base-info - (cadr (assoc 'repository-root svn-status-base-info)) - "")) - -(defun svn-status-checkout-prefix-path () - "When only a part of the svn repository is checked out, return the file path for this checkout." - (interactive) - (svn-status-parse-info t) - (let ((root (svn-status-base-info->repository-root)) - (url (svn-status-base-info->url)) - (p) - (base-dir (svn-status-base-dir)) - (wc-checkout-prefix)) - (setq p (substring url (length root))) - (setq wc-checkout-prefix (file-relative-name default-directory base-dir)) - (when (string= wc-checkout-prefix "./") - (setq wc-checkout-prefix "")) - ;; (message "svn-status-checkout-prefix-path: wc-checkout-prefix: '%s' p: '%s' base-dir: %s" wc-checkout-prefix p base-dir) - (setq p (substring p 0 (- (length p) (length wc-checkout-prefix)))) - (when (interactive-p) - (message "svn-status-checkout-prefix-path: '%s'" p)) - p)) - -(defun svn-status-ls (path &optional synchron) - "Run svn ls PATH." - (interactive "sPath for svn ls: ") - (svn-run (not synchron) t 'ls "ls" path) - (when synchron - (split-string (with-current-buffer svn-process-buffer-name - (buffer-substring-no-properties (point-min) (point-max)))))) - -(defun svn-status-ls-branches () - "Show, which branches exist for the actual working copy. -Note: this command assumes the proposed standard svn repository layout." - (interactive) - (svn-status-parse-info t) - (svn-status-ls (concat (svn-status-base-info->repository-root) "/branches"))) - -(defun svn-status-ls-tags () - "Show, which tags exist for the actual working copy. -Note: this command assumes the proposed standard svn repository layout." - (interactive) - (svn-status-parse-info t) - (svn-status-ls (concat (svn-status-base-info->repository-root) "/tags"))) - -(defun svn-status-toggle-edit-cmd-flag (&optional reset) - "Allow the user to edit the parameters for the next svn command. -This command toggles between -* editing the next command parameters (EditCmd) -* editing all all command parameters (EditCmd#) -* don't edit the command parameters () -The string in parentheses is shown in the status line to show the state." - (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) - "Go to the next line that holds a file information. -When called with a prefix argument advance the given number of lines." - (interactive "p") - (while (progn - (forward-line nr-of-lines) - (and (not (eobp)) - (not (svn-status-get-line-information))))) - (when (svn-status-get-line-information) - (goto-char (+ (svn-point-at-bol) svn-status-default-column)))) - -(defun svn-status-previous-line (nr-of-lines) - "Go to the previous line that holds a file information. -When called with a prefix argument go back the given number of lines." - (interactive "p") - (while (progn - (forward-line (- nr-of-lines)) - (and (not (bobp)) - (not (svn-status-get-line-information))))) - (when (svn-status-get-line-information) - (goto-char (+ (svn-point-at-bol) svn-status-default-column)))) - -(defun svn-status-dired-jump () - "Jump to a dired buffer, containing the file at point." - (interactive) - (let* ((line-info (svn-status-get-line-information)) - (file-full-path (if line-info - (svn-status-line-info->full-path line-info) - default-directory))) - (let ((default-directory - (file-name-as-directory - (expand-file-name (if line-info - (svn-status-line-info->directory-containing-line-info line-info t) - default-directory))))) - (if (fboundp 'dired-jump-back) (dired-jump-back) (dired-jump))) ;; Xemacs uses dired-jump-back - (dired-goto-file file-full-path))) - -(defun svn-status-possibly-negate-meaning-of-arg (arg &optional command) - "Negate arg, if this-command is a member of svn-status-possibly-negate-meaning-of-arg." - (unless command - (setq command this-command)) - (if (member command svn-status-negate-meaning-of-arg-commands) - (not arg) - arg)) - -(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-buffer-name) - (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." - (if (eq major-mode 'svn-status-mode) - (let ((svn-info nil)) - (dolist (overlay (overlays-at (point))) - (setq svn-info (or svn-info - (overlay-get overlay 'svn-info)))) - svn-info) - ;; different mode, means called not from the *svn-status* buffer - (if svn-status-get-line-information-for-file - (svn-status-make-line-info (if (eq svn-status-get-line-information-for-file 'relative) - (file-relative-name (buffer-file-name) (svn-status-base-dir)) - (buffer-file-name))) - (svn-status-make-line-info ".")))) - - -(defun svn-status-get-file-list (use-marked-files) - "Get either the selected files or the file under point. -USE-MARKED-FILES decides which we do. -See `svn-status-marked-files' for what counts as selected." - (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-get-file-information () - "Find out about the file under point. -The result may be parsed with the various `svn-status-line-info->...' functions. -When called from a *svn-status* buffer, do the same as `svn-status-get-line-information'. -When called from a file buffer provide a structure that contains the filename." - (cond ((eq major-mode 'svn-status-mode) - (svn-status-get-line-information)) - (t - ;; a fake structure that contains the buffername for the current buffer - (svn-status-make-line-info (buffer-file-name (current-buffer)))))) - -(defun svn-status-select-line () - "Return information about the file under point. -\(Only used for debugging\)" - (interactive) - (let ((info (svn-status-get-line-information))) - (if info - (message "%S hide-because-unknown: %S hide-because-unmodified: %S hide-because-externals: %S" info - (svn-status-line-info->hide-because-unknown info) - (svn-status-line-info->hide-because-unmodified info) - (svn-status-line-info->hide-because-externals info)) - (message "No file on this line")))) - (defun svn-status-ensure-cursor-on-file () - "Raise an error unless point is on a valid file." - (unless (svn-status-get-line-information) - (error "No file on the current 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) - (svn-status-make-line-info)))) - (file-name-as-directory - (expand-file-name - (svn-status-line-info->directory-containing-line-info line-info allow-self))))) - -(defun svn-status-line-info->directory-containing-line-info (line-info allow-self) - "Find the directory containing for LINE-INFO. - -If ALLOW-SELF is t and LINE-INFO refers to a directory then return the -directory itself, in all other cases find the parent directory" - (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") - (setq arg (svn-status-possibly-negate-meaning-of-arg arg 'svn-status-set-user-mark)) - (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") - (setq arg (svn-status-possibly-negate-meaning-of-arg arg 'svn-status-set-user-mark)) - (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) - (mark-count 0) - (line-info (svn-status-get-line-information)) - (file-name (svn-status-line-info->filename line-info)) - (sub-file-regexp (if (file-directory-p file-name) - (concat "^" (regexp-quote - (file-name-as-directory file-name))) - nil)) - (newcursorpos-fname) - (i-fname) - (first-line t) - (current-line svn-start-of-file-list-line-number)) - (while st-info - (when (or (svn-status-line-info->is-visiblep (car st-info)) first-line) - (setq current-line (1+ current-line)) - (setq first-line nil)) - (setq i-fname (svn-status-line-info->filename (car st-info))) - (when (or (string= file-name i-fname) - (when sub-file-regexp - (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) - (unless (eq (car (svn-status-line-info->ui-status (car st-info))) set-mark) - (setcar (svn-status-line-info->ui-status (car st-info)) set-mark) - (setq mark-count (+ 1 mark-count)) - (save-excursion - (let ((buffer-read-only nil)) - (goto-line current-line) - (delete-region (svn-point-at-bol) (svn-point-at-eol)) - (svn-insert-line-in-status-buffer (car st-info)) - (delete-char 1))) - (message "%s %s" (if set-mark "Marked" "Unmarked") i-fname))))) - (setq st-info (cdr st-info))) - ;;(svn-status-update-buffer) - (svn-status-goto-file-name newcursorpos-fname) - (when (> mark-count 1) - (message "%s %d files" (if set-mark "Marked" "Unmarked") mark-count)))) - -(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 -svn-status-line-info->* functions can be used in the check." - (let ((st-info svn-status-info) - (mark-count 0)) - (while st-info - (when (apply check-function (list (car st-info))) - (unless (eq (svn-status-line-info->has-usermark (car st-info)) set-mark) - (setq mark-count (+ 1 mark-count)) - (message "%s %s" - (if set-mark "Marked" "Unmarked") - (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) - (when (> mark-count 1) - (message "%s %d files" (if set-mark "Marked" "Unmarked") mark-count)))) - -(defun svn-status-mark-unknown (arg) - "Mark all unknown files. -These are the files marked with '?' in the `svn-status-buffer-name' 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-name' 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-name' buffer. -Changed properties are considered. -If the function is called with a prefix ARG, unmark all these files." - (interactive "P") - (svn-status-apply-usermark-checked - '(lambda (info) (or (eq (svn-status-line-info->filemark info) ?M) - (eq (svn-status-line-info->filemark info) - svn-status-file-modified-after-save-flag) - (eq (svn-status-line-info->propmark info) ?M))) - (not arg))) - -(defun svn-status-mark-modified-properties (arg) - "Mark all files and directories with modified properties. -If the function is called with a prefix ARG, unmark all these entries." - (interactive "P") - (svn-status-apply-usermark-checked - '(lambda (info) (or (eq (svn-status-line-info->propmark info) ?M))) - (not arg))) - -(defun svn-status-mark-deleted (arg) - "Mark all files scheduled for deletion. -These are the files marked with 'D' in the `svn-status-buffer-name' 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) ?D)) (not arg))) - -(defun svn-status-mark-changed (arg) - "Mark all files that could be committed. -This means we mark -* all modified files -* all files scheduled for addition -* all files scheduled for deletion -* all files with modified properties - -The last two categories include all copied and moved files. -If called with a prefix ARG, unmark all such files." - (interactive "P") - (svn-status-mark-added arg) - (svn-status-mark-modified arg) - (svn-status-mark-deleted arg) - (svn-status-mark-modified-properties arg)) - -(defun svn-status-unset-all-usermarks () - (interactive) - (svn-status-apply-usermark-checked '(lambda (info) t) nil)) - -(defun svn-status-store-usermarks (arg) - "Store the current usermarks in `svn-status-usermark-storage'. -When called with a prefix argument it is possible to store different sets of marks." - (interactive "P") - (let ((file-list (svn-status-get-file-list-names t))) - (svn-puthash arg file-list svn-status-usermark-storage) - (message "psvn stored %d user marks" (length file-list)))) - -(defun svn-status-load-usermarks (arg) - "Load previously stored user marks from `svn-status-usermark-storage'. -When called with a prefix argument it is possible to store/load different sets of marks." - (interactive "P") - (let ((file-list (gethash arg svn-status-usermark-storage))) - (svn-status-apply-usermark-checked - '(lambda (info) (member (svn-status-line-info->filename info) file-list)) t))) - -(defvar svn-status-regexp-history nil - "History list of regular expressions used in svn status commands.") - -(defun svn-status-read-regexp (prompt) - (read-from-minibuffer prompt nil nil nil 'svn-status-regexp-history)) - -(defun svn-status-mark-filename-regexp (regexp &optional unmark) - "Mark all files matching REGEXP. -If the function is called with a prefix arg, unmark all these files." - (interactive - (list (svn-status-read-regexp (concat (if current-prefix-arg "Unmark" "Mark") - " files (regexp): ")) - (if current-prefix-arg t nil))) - (svn-status-apply-usermark-checked - '(lambda (info) (string-match regexp (svn-status-line-info->filename-nondirectory info))) (not unmark))) - -(defun svn-status-mark-by-file-ext (ext &optional unmark) - "Mark all files matching the given file extension EXT. -If the function is called with a prefix arg, unmark all these files." - (interactive - (list (read-string (concat (if current-prefix-arg "Unmark" "Mark") - " files with extensions: ")) - (if current-prefix-arg t nil))) - (svn-status-apply-usermark-checked - '(lambda (info) (let ((case-fold-search nil)) - (string-match (concat "\\." ext "$") (svn-status-line-info->filename-nondirectory info)))) (not unmark))) - -(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-toggle-hide-externals () - (interactive) - (setq svn-status-hide-externals (not svn-status-hide-externals)) - (svn-status-update-buffer)) - -(defun svn-status-get-file-name-buffer-position (name) - "Find the buffer position for a file. -If the file is not found, return nil." - (let ((start-pos (let ((cached-pos (gethash name - svn-status-filename-to-buffer-position-cache))) - (when cached-pos - (goto-char (previous-overlay-change cached-pos))) - (point))) - (found)) - ;; performance optimization: search from point to end of buffer - (while (and (not found) (< (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)) - (setq found t))) - ;; search from buffer start to point - (goto-char (point-min)) - (while (and (not found) (< (point) start-pos)) - (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)) - (setq found t))) - (and found start-pos))) - -(defun svn-status-goto-file-name (name) - "Move the cursor the the line that displays NAME." - (let ((pos (svn-status-get-file-name-buffer-position name))) - (if pos - (goto-char pos) - (svn-status-message 7 "Note: svn-status-goto-file-name: %s not found" name)))) - -(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." - (if (eq major-mode 'svn-status-mode) - (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))) - ;; different mode, means called not from the *svn-status* buffer - (if svn-status-get-line-information-for-file - (list (svn-status-make-line-info (if (eq svn-status-get-line-information-for-file 'relative) - (file-relative-name (buffer-file-name) (svn-status-base-dir)) - (buffer-file-name)))) - (list (svn-status-make-line-info "."))))) - -(defun svn-status-marked-file-names () - (mapcar 'svn-status-line-info->filename (svn-status-marked-files))) - -(defun svn-status-some-files-marked-p () - "Return non-nil iff a file has been marked by `svn-status-set-user-mark'. -Unlike `svn-status-marked-files', this does not select the file under point -if no files have been marked." - ;; `some' would be shorter but requires cl-seq at runtime. - ;; (Because it accepts both lists and vectors, it is difficult to inline.) - (loop for line-info in svn-status-info - thereis (svn-status-line-info->has-usermark line-info))) - -(defun svn-status-only-dirs-or-nothing-marked-p () - "Return non-nil iff only dirs has been marked by `svn-status-set-user-mark'." - ;; `some' would be shorter but requires cl-seq at runtime. - ;; (Because it accepts both lists and vectors, it is difficult to inline.) - (loop for line-info in svn-status-info - thereis (and (not (svn-status-line-info->directory-p line-info)) - (svn-status-line-info->has-usermark line-info)))) - -(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 - (svn-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-info-list) - "Create an svn client argument file" - ;; create the arg file on the remote host when we will run svn on this host! - (let ((file-name (svn-expand-filename-for-remote-access svn-status-temp-arg-file))) - ;; (message "svn-status-create-arg-file %s: %s" default-directory file-name) - (with-temp-file file-name - (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))) - (setq svn-arg-file-content (buffer-substring-no-properties (point-min) (point-max))))))) - -(defun svn-status-show-process-buffer-internal (&optional scroll-to-top) - (let ((cur-buff (current-buffer))) - (unless svn-status-preserve-window-configuration - (when (string= (buffer-name) svn-status-buffer-name) - (delete-other-windows))) - (pop-to-buffer svn-process-buffer-name) - (svn-process-mode) - (when scroll-to-top - (goto-char (point-min))) - (pop-to-buffer cur-buff))) - -(defun svn-status-show-process-output (cmd &optional scroll-to-top) - "Display the result of a svn command. -Consider svn-status-window-alist to choose the buffer name." - (let ((window-mode (cadr (assoc cmd svn-status-window-alist))) - (process-default-directory)) - (cond ((eq window-mode nil) ;; use *svn-process* buffer - (setq svn-status-last-output-buffer-name svn-process-buffer-name)) - ((eq window-mode t) ;; use *svn-info* buffer - (setq svn-status-last-output-buffer-name "*svn-info*")) - ((eq window-mode 'invisible) ;; don't display the buffer - (setq svn-status-last-output-buffer-name nil)) - (t - (setq svn-status-last-output-buffer-name window-mode))) - (when svn-status-last-output-buffer-name - (if window-mode - (progn - (unless svn-status-preserve-window-configuration - (when (string= (buffer-name) svn-status-buffer-name) - (delete-other-windows))) - (pop-to-buffer svn-process-buffer-name) - (setq process-default-directory default-directory) - (switch-to-buffer (get-buffer-create svn-status-last-output-buffer-name)) - (setq default-directory process-default-directory) - (let ((buffer-read-only nil)) - (delete-region (point-min) (point-max)) - (insert-buffer-substring svn-process-buffer-name) - (when scroll-to-top - (goto-char (point-min)))) - (when (eq window-mode t) ;; *svn-info* buffer - (svn-info-mode)) - (other-window 1)) - (svn-status-show-process-buffer-internal scroll-to-top))))) - -(defun svn-status-svn-log-switches (arg) - (cond ((eq arg 0) '()) - ((or (eq arg -1) (eq arg '-)) '("-q")) - (arg '("-v")) - (t svn-status-default-log-arguments))) - -(defun svn-status-show-svn-log (arg) - "Run `svn log' on selected files. -The output is put into the *svn-log* buffer -The optional prefix argument ARG determines which switches are passed to `svn log': - no prefix --- use whatever is in the list `svn-status-default-log-arguments' - prefix argument of -1: --- use the -q switch (quiet) - prefix argument of 0 --- use no arguments - other prefix arguments: --- use the -v switch (verbose) - -See `svn-status-marked-files' for what counts as selected." - (interactive "P") - (let ((switches (svn-status-svn-log-switches arg)) - (svn-status-get-line-information-for-file t)) - ;; (message "svn-status-show-svn-log %S" arg) - (svn-status-create-arg-file (svn-status-marked-files)) - (svn-run t t 'log "log" "--targets" svn-status-temp-arg-file switches))) - -(defun svn-status-version () - "Show the version numbers for psvn.el and the svn command line client. -The version number of the client is cached in `svn-client-version'." - (interactive) - (let ((window-conf (current-window-configuration)) - (version-string)) - (if (or (interactive-p) (not svn-status-cached-version-string)) - (progn - (svn-run nil t 'version "--version") - (when (interactive-p) - (svn-status-show-process-output 'info t)) - (with-current-buffer svn-status-last-output-buffer-name - (goto-char (point-min)) - (setq svn-client-version - (when (re-search-forward "svn, version \\([0-9\.]+\\)" nil t) - (mapcar 'string-to-number (split-string (match-string 1) "\\.")))) - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (insert (format "psvn.el revision: %s\n\n" svn-psvn-revision))) - (setq version-string (buffer-substring-no-properties (point-min) (point-max)))) - (setq svn-status-cached-version-string version-string)) - (setq version-string svn-status-cached-version-string) - (unless (interactive-p) - (set-window-configuration window-conf) - version-string)))) - -(defun svn-compute-svn-client-version () - "Ensure that svn-client-version is available." - (unless svn-client-version - (svn-status-version))) - -(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-marked-files)) - (svn-run t t 'info "info" "--targets" svn-status-temp-arg-file)) - -(defun svn-status-info-for-path (path) - "Run svn info on the given PATH. -Return some interesting parts of the resulting output. -At the moment a list containing the last changed author is returned." - (let ((svn-process-buffer-name "*svn-info-output*") - (last-changed-author)) - (svn-run nil t 'info "info" path) - (with-current-buffer svn-process-buffer-name - (goto-char (point-min)) - (when (search-forward "last changed author: " nil t) - (setq last-changed-author (buffer-substring-no-properties (point) (svn-point-at-eol))))) - (svn-status-message 7 "last-changed-author for '%s': %s" path last-changed-author) - (list last-changed-author))) - -(defun svn-status-blame (revision &optional file-name) - "Run `svn blame' on the current file. -When called with a prefix argument, ask the user for the REVISION to use. -When called from a file buffer, go to the current line in the resulting blame output." - (interactive "P") - (when current-prefix-arg - (setq revision (svn-status-read-revision-string "Blame for version: " "BASE"))) - (unless revision (setq revision "BASE")) - (setq svn-status-blame-revision revision) - (setq svn-status-blame-file-name (if file-name - file-name - (svn-status-line-info->filename (svn-status-get-file-information)))) - (svn-run t t 'blame "blame" svn-status-default-blame-arguments "-r" revision svn-status-blame-file-name)) - -(defun svn-blame-blame-again (arg) - "Run svn blame again, using the revision before the change at point. -When point is at revision 3472, run it with 3471." - (interactive "P") - (let ((rev (svn-blame-rev-at-point))) - (setq rev (number-to-string (- (string-to-number rev) 1))) - (when current-prefix-arg - (setq rev (svn-status-read-revision-string (format "Svn blame for rev#? ") rev))) - (svn-status-blame rev svn-status-blame-file-name))) - -(defun svn-status-show-svn-diff (arg) - "Run `svn diff' on the current file. -If the current file is a directory, compare it recursively. -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 (unless arg is '-) -When called with a negative prefix argument, do a non recursive diff." - (interactive "P") - (let ((non-recursive (or (and (numberp arg) (< arg 0)) (eq arg '-))) - (revision (if (and (not (eq arg '-)) arg) :ask :auto))) - (svn-status-ensure-cursor-on-file) - (svn-status-show-svn-diff-internal (list (svn-status-get-line-information)) (not non-recursive) - revision))) - -(defun svn-file-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 (list (svn-status-make-line-info buffer-file-name)) nil - (if arg :ask :auto))) - -(defun svn-status-show-svn-diff-for-marked-files (arg) - "Run `svn diff' on all selected files. -If some files have been marked, compare those non-recursively; -this is because marking a directory with \\[svn-status-set-user-mark] -normally marks all of its files as well. -If no files have been marked, compare recursively the file at point. -If ARG then prompt for revision to diff against, else compare working copy with BASE." - (interactive "P") - (svn-status-show-svn-diff-internal (svn-status-marked-files) - (not (svn-status-some-files-marked-p)) - (if arg :ask "BASE"))) - -(defun svn-status-diff-show-changeset (rev &optional user-confirmation rev-against) - "Show the changeset for a given log entry. -When called with a prefix argument, ask the user for the revision." - (let* ((upper-rev (if rev-against rev-against rev)) - (lower-rev (if rev-against rev (number-to-string (- (string-to-number upper-rev) 1)))) - (rev-arg (concat lower-rev ":" upper-rev))) - (when user-confirmation - (setq rev-arg (read-string "Revision for changeset: " rev-arg))) - (svn-run nil t 'diff "diff" svn-status-default-diff-arguments (concat "-r" rev-arg)) - (svn-status-activate-diff-mode))) - -(defun svn-status-show-svn-diff-internal (line-infos recursive revision) - ;; REVISION must be one of: - ;; - a string: whatever the -r option allows. - ;; - `:ask': asks the user to specify the revision, which then becomes - ;; saved in `minibuffer-history' rather than in `command-history'. - ;; - `:auto': use "HEAD" if an update is known to exist, "BASE" otherwise. - ;; In the future, `nil' might mean omit the -r option entirely; - ;; but that currently seems to imply "BASE", so we just use that. - (when (eq revision :ask) - (setq revision (svn-status-read-revision-string - "Diff with files for version: " "PREV"))) - - (setq svn-status-last-diff-options (list line-infos recursive revision)) - - (let ((clear-buf t) - (beginning nil)) - (dolist (line-info line-infos) - (svn-run nil clear-buf 'diff "diff" svn-status-default-diff-arguments - "-r" (if (eq revision :auto) - (if (svn-status-line-info->update-available line-info) - "HEAD" "BASE") - revision) - (unless recursive "--non-recursive") - (svn-status-line-info->filename line-info)) - (setq clear-buf nil) - - ;; "svn diff --non-recursive" skips only subdirectories, not files. - ;; But a non-recursive diff via psvn should skip files too, because - ;; the user would have marked them if he wanted them to be compared. - ;; So we'll look for the "Index: foo" line that marks the first file - ;; in the diff output, and delete it and everything that follows. - ;; This is made more complicated by the fact that `svn-status-activate-diff-mode' - ;; expects the output to be left in the *svn-process* buffer. - (unless recursive - ;; Check `directory-p' relative to the `default-directory' of the - ;; "*svn-status*" buffer, not that of the svn-process-buffer-name buffer. - (let ((directory-p (svn-status-line-info->directory-p line-info))) - (with-current-buffer svn-process-buffer-name - (when directory-p - (goto-char (or beginning (point-min))) - (when (re-search-forward "^Index: " nil t) - (delete-region (match-beginning 0) (point-max)))) - (goto-char (setq beginning (point-max)))))))) - (svn-status-activate-diff-mode)) - -(defun svn-status-diff-save-current-defun-as-kill () - "Copy the function name for the change at point to the kill-ring. -That function uses `add-log-current-defun'" - (interactive) - (let ((func-name (add-log-current-defun))) - (if func-name - (progn - (kill-new func-name) - (message "Copied %S" func-name)) - (message "No current defun detected.")))) - -(defun svn-status-diff-pop-to-commit-buffer () - "Temporary switch to the `svn-status-buffer-name' buffer and start a commit from there." - (interactive) - (let ((window-conf (current-window-configuration))) - (svn-status-switch-to-status-buffer) - (svn-status-commit) - (set-window-configuration window-conf) - (setq svn-status-pre-commit-window-configuration window-conf) - (pop-to-buffer svn-log-edit-buffer-name))) - -(defun svn-status-activate-diff-mode () - "Show the `svn-process-buffer-name' buffer, using the diff-mode." - (svn-status-show-process-output 'diff t) - (let ((working-directory default-directory)) - (save-excursion - (set-buffer svn-status-last-output-buffer-name) - (setq default-directory working-directory) - (svn-status-diff-mode) - (setq buffer-read-only t)))) - -(define-derived-mode svn-status-diff-mode fundamental-mode "svn-diff" - "Major mode to display svn diffs. Derives from `diff-mode'. - -Commands: -\\{svn-status-diff-mode-map} -" - (let ((diff-mode-shared-map (copy-keymap svn-status-diff-mode-map)) - major-mode mode-name) - (diff-mode) - (set (make-local-variable 'revert-buffer-function) 'svn-status-diff-update))) - -(defun svn-status-diff-update (arg noconfirm) - "Rerun the last svn diff command and update the *svn-diff* buffer." - (interactive) - (svn-status-save-some-buffers) - (save-window-excursion - (apply 'svn-status-show-svn-diff-internal svn-status-last-diff-options))) - -(defun svn-status-show-process-buffer () - "Show the content of the `svn-process-buffer-name' buffer" - (interactive) - (svn-status-show-process-output nil)) - -(defun svn-status-pop-to-partner-buffer () - "Pop to the `svn-status-partner-buffer' if that variable is set." - (interactive) - (when svn-status-partner-buffer - (let ((cur-buf (current-buffer))) - (pop-to-buffer svn-status-partner-buffer) - (setq svn-status-partner-buffer cur-buf)))) - -(defun svn-status-pop-to-new-partner-buffer (buffer) - "Call `pop-to-buffer' and register the current buffer as partner buffer for BUFFER." - (let ((cur-buf (current-buffer))) - (pop-to-buffer buffer) - (setq svn-status-partner-buffer cur-buf))) - -(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-get-file-list (not arg))) - (svn-run 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-get-file-list (not arg))) - (svn-run t t 'add "add" "--non-recursive" "--targets" svn-status-temp-arg-file)) - -(defun svn-status-lock (arg) - "Run `svn lock' on all selected files. -See `svn-status-marked-files' for what counts as selected." - (interactive "P") - (message "locking: %S" (svn-status-get-file-list-names t)) - (svn-status-create-arg-file (svn-status-get-file-list t)) - (svn-run t t 'lock "lock" "--targets" svn-status-temp-arg-file)) - -(defun svn-status-unlock (arg) - "Run `svn unlock' on all selected files. -See `svn-status-marked-files' for what counts as selected." - (interactive "P") - (message "unlocking: %S" (svn-status-get-file-list-names t)) - (svn-status-create-arg-file (svn-status-get-file-list t)) - (svn-run t t 'unlock "unlock" "--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 t t 'mkdir "mkdir" "--" dir)) - -(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) - (svn-status-mv-cp "mv" "Rename" "Move" "mv")) - -(defun svn-status-cp () - "See `svn-status-mv'" - (interactive) - (svn-status-mv-cp "cp" "Copy" "Copy" "cp")) - -(defun svn-status-mv-cp (command singleprompt manyprompt fallback) - "Run svn COMMAND on marked files, prompting for destination - -This function acts on `svn-status-marked-files': at the prompt the -user can enter a new file name, or an existing directory: this is used as the argument for svn COMMAND. - COMMAND --- string saying what to do: \"mv\" or \"cp\" - SINGLEPROMPT --- string at start of prompt when one file marked - MANYPROMPT --- string at start of prompt when multiple files marked - FALLBACK --- If any marked file is unversioned, use this instead of 'svn COMMAND'" - (let* ((marked-files (svn-status-marked-files)) - (num-of-files (length marked-files)) - dest) - (if (= 1 num-of-files) - ;; one file to act on: new name, or directory to hold results - (setq dest (read-file-name - (format "%s %s to: " singleprompt - (svn-status-line-info->filename (car marked-files))) - (svn-status-directory-containing-point t) - (svn-status-line-info->full-path (car marked-files)))) - ;;TODO: (when file-exists-p but-no-dir-p dest (error "%s already exists" dest)) - ;;multiple files selected, so prompt for existing directory to mv them into. - (setq dest (svn-read-directory-name - (format "%s %d files to directory: " manyprompt 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")) - (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 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 elided 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)) - (moved nil)) - (cond - ((or (eq original-filemarks ?M) ;local mods: maybe do `svn mv --force' - (eq original-propmarks ?M)) ;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)) - (progn - (svn-status-run-mv-cp command original-name dest t) - (setq moved t)) - (message "Not acting on %s" original-name))) - ((eq original-filemarks ??) ;original is unversioned: use fallback - (if (yes-or-no-p (format "%s is unversioned. Use `%s -i -- %s %s'? " - original-name fallback original-name dest)) - ;; TODO: consider svn-call-process-function here also... - (progn (call-process fallback nil (get-buffer-create svn-process-buffer-name) nil - "-i" "--" original-name dest) - (setq moved t)) - ;;new files created by fallback are not in *svn-status* now, - ;;TODO: so call (svn-status-update) here? - (message "Not acting on %s" original-name))) - - ((eq original-filemarks ?A) ;;`A' (`svn add'ed, but not committed) - (message "Not acting on %s (commit it first)" original-name)) - - ((eq original-filemarks ? ) ;original is unmodified: can proceed - (svn-status-run-mv-cp command original-name dest) - (setq moved t)) - - ;;file has some other mark (eg conflicted) - (t - (if (yes-or-no-p - (format "The status of %s looks scary. Risk moving it anyway? " - original-name)) - (progn - (svn-status-run-mv-cp command original-name dest) - (setq moved t)) - (message "Not acting on %s" original-name)))) - (when moved - (message "psvn: did '%s' from %s to %s" command original-name dest) - ;; Silently rename the visited file of any buffer visiting this file. - (when (get-file-buffer original-name) - (with-current-buffer (get-file-buffer original-name) - (set-visited-file-name dest nil t)))))) - (svn-status-update))) - -(defun svn-status-run-mv-cp (command original destination &optional force) - "Actually run svn mv or svn cp. -This is just to prevent duplication in `svn-status-prompt-and-act-on-files'" - (if force - (svn-run nil t (intern command) command "--force" "--" original destination) - (svn-run nil t (intern command) command "--" original destination)) -;;;TODO: use something like the following instead of calling svn-status-update -;;; at the end of svn-status-mv-cp. -;; (let ((output (svn-status-parse-ar-output)) -;; newfile -;; buffer-read-only) ; otherwise insert-line-in-status-buffer fails -;; (dolist (new-file output) -;; (when (eq (cadr new-file) 'added-wc) -;; ;; files with 'wc-added action do not exist in *svn-status* -;; ;; buffer yet, so give each of them their own line-info -;; ;; TODO: need to insert the new line-info in a sensible place, ie in the correct directory! [svn-status-filename-to-buffer-position-cache might help?] - -;; (svn-insert-line-in-status-buffer -;; (svn-status-make-line-info (car new-file))))) -;; (svn-status-update-with-command-list output)) - ) - -(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-marked-files)) - (svn-run t t 'revert "revert" "--targets" svn-status-temp-arg-file)))) - -(defun svn-file-revert () - "Run `svn revert' on the current file." - (interactive) - (when (y-or-n-p (format "Revert %s? " buffer-file-name)) - (svn-run t t 'revert "revert" buffer-file-name))) - -(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. - -Forcing the deletion can also be used to delete files not under svn control." - (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-marked-files)) - (if force - (save-excursion - (svn-run t t 'rm "rm" "--force" "--targets" svn-status-temp-arg-file) - (dolist (to-delete (svn-status-marked-files)) - (when (eq (svn-status-line-info->filemark to-delete) ??) - (svn-status-goto-file-name (svn-status-line-info->filename to-delete)) - (let ((buffer-read-only nil)) - (delete-region (svn-point-at-bol) (+ 1 (svn-point-at-eol))) - (delete to-delete svn-status-info))))) - (svn-run t t 'rm "rm" "--targets" svn-status-temp-arg-file))))) - -(defun svn-status-update-cmd (arg) - "Run svn update. -When called with a prefix argument, ask the user for the revision to update to. -When called with a negative prefix argument, only update the selected files." - (interactive "P") - (let* ((selective-update (or (and (numberp arg) (< arg 0)) (eq arg '-))) - (update-extra-arg) - (rev (when arg (svn-status-read-revision-string - (if selective-update - (format "Selected entries: Run svn update -r ") - (format "Directory: %s: Run svn update -r " default-directory)) - (if selective-update "HEAD" nil))))) - (svn-compute-svn-client-version) - (if (and (<= (car svn-client-version) 1) (< (cadr svn-client-version) 5)) - (setq update-extra-arg (list "--non-interactive")) ;; svn version < 1.5 - (setq update-extra-arg (list "--accept" "postpone"))) ;; svn version >= 1.5 - (if selective-update - (progn - (message "Running svn-update for %s" (svn-status-marked-file-names)) - (svn-run t t 'update "update" - (when rev (list "-r" rev)) - update-extra-arg - (svn-status-marked-file-names))) - (message "Running svn-update for %s" default-directory) - (svn-run t t 'update "update" - (when rev (list "-r" rev)) - update-extra-arg - (svn-local-filename-for-remote-access (expand-file-name default-directory)))))) - -(defun svn-status-commit () - "Commit selected files. -If some files have been marked, commit those non-recursively; -this is because marking a directory with \\[svn-status-set-user-mark] -normally marks all of its files as well. -If no files have been marked, commit recursively the file at point." - (interactive) - (svn-status-save-some-buffers) - (let* ((selected-files (svn-status-marked-files))) - (setq svn-status-files-to-commit selected-files - svn-status-recursive-commit (not (svn-status-only-dirs-or-nothing-marked-p))) - (svn-log-edit-show-files-to-commit) - (svn-status-pop-to-commit-buffer) - (when svn-log-edit-insert-files-to-commit - (svn-log-edit-insert-files-to-commit)) - (when svn-log-edit-show-diff-for-commit - (svn-log-edit-svn-diff nil)))) - -(defun svn-status-pop-to-commit-buffer () - "Pop to the svn commit buffer. -If a saved log message exists in `svn-log-edit-file-name' insert it in the buffer." - (interactive) - (setq svn-status-pre-commit-window-configuration (current-window-configuration)) - (let* ((use-existing-buffer (get-buffer svn-log-edit-buffer-name)) - (commit-buffer (get-buffer-create svn-log-edit-buffer-name)) - (dir default-directory) - (log-edit-file-name)) - (pop-to-buffer commit-buffer) - (setq default-directory dir) - (setq log-edit-file-name (svn-log-edit-file-name)) - (unless use-existing-buffer - (when (and log-edit-file-name (file-readable-p log-edit-file-name)) - (insert-file-contents log-edit-file-name))) - (svn-log-edit-mode))) - -(defun svn-status-switch-to-status-buffer () - "Switch to the `svn-status-buffer-name' buffer." - (interactive) - (switch-to-buffer svn-status-buffer-name)) - -(defun svn-status-pop-to-status-buffer () - "Pop to the `svn-status-buffer-name' buffer." - (interactive) - (pop-to-buffer svn-status-buffer-name)) - -(defun svn-status-via-bookmark (bookmark) - "Allows a quick selection of a bookmark in `svn-bookmark-list'. -Run `svn-status' on the selected bookmark." - (interactive - (list - (let ((completion-ignore-case t)) - (funcall svn-status-completing-read-function "SVN status bookmark: " svn-bookmark-list)))) - (unless bookmark - (error "No bookmark specified")) - (let ((directory (cdr (assoc bookmark svn-bookmark-list)))) - (if (file-directory-p directory) - (svn-status directory) - (error "%s is not a directory" directory)))) - -(defun svn-status-export () - "Run `svn export' for the current working copy. -Ask the user for the destination path. -`svn-status-default-export-directory' is suggested as export directory." - (interactive) - (let* ((src default-directory) - (dir1-name (nth 1 (nreverse (split-string src "/")))) - (dest (read-file-name (format "Export %s to " src) (concat svn-status-default-export-directory dir1-name)))) - (svn-run t t 'export "export" (expand-file-name src) (expand-file-name dest)) - (message "svn-status-export %s %s" src dest))) - -(defun svn-status-cleanup (arg) - "Run `svn cleanup' on all selected files. -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") - (let ((file-names (svn-status-get-file-list-names (not arg)))) - (if file-names - (progn - (message "svn-status-cleanup %S" file-names) - (svn-run 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-marked-files)) - (svn-run t t 'resolved "resolved" "--targets" svn-status-temp-arg-file)))) - - -(defun svn-status-svnversion () - "Run svnversion on the directory that contains the file at point." - (interactive) - (svn-status-ensure-cursor-on-file) - (let ((simple-path (svn-status-line-info->filename (svn-status-get-line-information))) - (full-path (svn-status-line-info->full-path (svn-status-get-line-information))) - (version)) - (unless (file-directory-p simple-path) - (setq simple-path (or (file-name-directory simple-path) ".")) - (setq full-path (file-name-directory full-path))) - (setq version (shell-command-to-string (concat "svnversion -n " full-path))) - (message "svnversion for '%s': %s" simple-path version) - version)) - -;; -------------------------------------------------------------------------------- -;; Update the `svn-status-buffer-name' buffer, when a file is saved -;; -------------------------------------------------------------------------------- - -(defvar svn-status-file-modified-after-save-flag ?m - "Flag shown whenever a file is modified and saved in Emacs. -The flag is shown in the `svn-status-buffer-name' buffer. -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 (get-buffer svn-status-buffer-name) - 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 "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 "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-window-excursion - (set-buffer svn-status-buffer-name) - (save-excursion - (let ((buffer-read-only nil) - (pos (svn-status-get-file-name-buffer-position i-fname))) - (if pos - (progn - (goto-char pos) - (delete-region (svn-point-at-bol) (svn-point-at-eol)) - (svn-insert-line-in-status-buffer (car st-info)) - (delete-char 1)) - (svn-status-message 3 "psvn: file %s not found, updating %s buffer content..." - i-fname svn-status-buffer-name) - (svn-status-update-buffer)))))) - (setq st-info (cdr st-info)))))) - nil) - -(add-hook 'after-save-hook 'svn-status-after-save-hook) - -;; -------------------------------------------------------------------------------- -;; vc-svn integration -;; -------------------------------------------------------------------------------- -(defvar svn-status-state-mark-modeline t) ; modeline mark display or not -(defvar svn-status-state-mark-tooltip nil) ; modeline tooltip display - -(defun svn-status-state-mark-modeline-dot (color) - (propertize " " - 'help-echo 'svn-status-state-mark-tooltip - 'display - `(image :type xpm - :data ,(format "/* XPM */ -static char * data[] = { -\"18 13 3 1\", -\" c None\", -\"+ c #000000\", -\". c %s\", -\" \", -\" +++++ \", -\" +.....+ \", -\" +.......+ \", -\" +.........+ \", -\" +.........+ \", -\" +.........+ \", -\" +.........+ \", -\" +.........+ \", -\" +.......+ \", -\" +.....+ \", -\" +++++ \", -\" \"};" - color) - :ascent center))) - -(defun svn-status-install-state-mark-modeline (color) - (push `(svn-status-state-mark-modeline - ,(svn-status-state-mark-modeline-dot color)) - mode-line-format) - (force-mode-line-update t)) - -(defun svn-status-uninstall-state-mark-modeline () - (setq mode-line-format - (remove-if #'(lambda (mode) (eq (car-safe mode) - 'svn-status-state-mark-modeline)) - mode-line-format)) - (force-mode-line-update t)) - -(defun svn-status-update-state-mark-tooltip (tooltip) - (setq svn-status-state-mark-tooltip tooltip)) - -(defun svn-status-update-state-mark (color) - (svn-status-uninstall-state-mark-modeline) - (svn-status-install-state-mark-modeline color)) - -(defsubst svn-status-in-vc-mode? () - "Is vc-svn active?" - (cond - ((fboundp 'vc-backend) - (eq 'SVN (vc-backend buffer-file-name))) - ((and (boundp 'vc-mode) vc-mode) - (string-match "^ SVN" (svn-substring-no-properties vc-mode))))) - -(when svn-status-fancy-file-state-in-modeline - (defadvice vc-find-file-hook (after svn-status-vc-svn-find-file-hook activate) - "vc-find-file-hook advice for synchronizing psvn with vc-svn interface" - (when (svn-status-in-vc-mode?) (svn-status-update-modeline))) - - (defadvice vc-after-save (after svn-status-vc-svn-after-save activate) - "vc-after-save advice for synchronizing psvn when saving buffer" - (when (svn-status-in-vc-mode?) (svn-status-update-modeline))) - - (defadvice ediff-refresh-mode-lines - (around svn-modeline-ediff-fixup activate compile) - "Fixup svn file status in the modeline when using ediff" - (ediff-with-current-buffer ediff-buffer-A - (svn-status-uninstall-state-mark-modeline)) - (ediff-with-current-buffer ediff-buffer-B - (svn-status-uninstall-state-mark-modeline)) - ad-do-it - (ediff-with-current-buffer ediff-buffer-A - (svn-status-update-modeline)) - (ediff-with-current-buffer ediff-buffer-B - (svn-status-update-modeline)))) - -(defun svn-status-update-modeline () - "Update modeline state dot mark properly" - (when (and buffer-file-name (svn-status-in-vc-mode?)) - (svn-status-update-state-mark - (svn-status-interprete-state-mode-color - (vc-svn-state buffer-file-name))))) - -(defsubst svn-status-interprete-state-mode-color (stat) - "Interpret vc-svn-state symbol to mode line color" - (case stat - ('edited "tomato" ) - ('up-to-date "GreenYellow" ) - ;; what is missing here?? - ;; ('unknown "gray" ) - ;; ('added "blue" ) - ;; ('deleted "red" ) - ;; ('unmerged "purple" ) - (t "red"))) - -;; -------------------------------------------------------------------------------- -;; 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. -With a prefix argument: get only the actual file." - (interactive "P") - (svn-status-get-specific-revision-internal - (svn-status-get-file-list (not arg)) :ask t)) - -(defun svn-status-get-specific-revision-internal (line-infos revision handle-relative-svn-status-dir) - "Retrieve older revisions of files. -LINE-INFOS is a list of line-info structures (see -`svn-status-get-line-information'). -REVISION is one of: -- a string: whatever the -r option allows. -- `:ask': asks the user to specify the revision, which then becomes - saved in `minibuffer-history' rather than in `command-history'. -- `:auto': Use \"HEAD\" if an update is known to exist, \"BASE\" otherwise. - -After the call, `svn-status-get-revision-file-info' will be an alist -\((WORKING-FILE-NAME . RETRIEVED-REVISION-FILE-NAME) ...). These file -names are relative to the directory where `svn-status' was run." - ;; In `svn-status-show-svn-diff-internal', there is a comment - ;; that REVISION `nil' might mean omitting the -r option entirely. - ;; That doesn't seem like a good idea with svn cat. - - ;; (message "svn-status-get-specific-revision-internal: %S %S" line-infos revision) - - (when (eq revision :ask) - (setq revision (svn-status-read-revision-string - "Get files for version: " "PREV"))) - - (let ((count (length line-infos))) - (if (= count 1) - (let ((line-info (car line-infos))) - (message "Getting revision %s of %s" - (if (eq revision :auto) - (if (svn-status-line-info->update-available line-info) - "HEAD" "BASE") - revision) - (svn-status-line-info->filename line-info))) - ;; We could compute "Getting HEAD of 8 files and BASE of 11 files" - ;; but that'd be more bloat than it's worth. - (message "Getting revision %s of %d files" - (if (eq revision :auto) "HEAD or BASE" revision) - count))) - - (let ((svn-status-get-specific-revision-file-info '())) - (dolist (line-info line-infos) - (let* ((revision (if (eq revision :auto) - (if (svn-status-line-info->update-available line-info) - "HEAD" "BASE") - revision)) ;must be a string by this point - (file-name (svn-status-line-info->filename line-info)) - ;; If REVISION is e.g. "HEAD", should we find out the actual - ;; revision number and save "foo.~123~" rather than "foo.~HEAD~"? - ;; OTOH, `auto-mode-alist' already ignores ".~HEAD~" suffixes, - ;; and if users often want to know the revision numbers of such - ;; files, they can use svn:keywords. - (file-name-with-revision (concat (file-name-nondirectory file-name) ".~" revision "~")) - (default-directory (concat (svn-status-base-dir) - (if handle-relative-svn-status-dir - (file-relative-name default-directory (svn-status-base-dir)) - "") - (file-name-directory file-name)))) - ;; `add-to-list' would unnecessarily check for duplicates. - (push (cons file-name (concat (file-name-directory file-name) file-name-with-revision)) - svn-status-get-specific-revision-file-info) - (svn-status-message 3 "svn-status-get-specific-revision-internal: file: %s, default-directory: %s" - file-name default-directory) - (svn-status-message 3 "svn-status-get-specific-revision-internal: file-name-with-revision: %s %S" - file-name-with-revision (file-exists-p file-name-with-revision)) - (save-excursion - (if (or (not (file-exists-p file-name-with-revision)) ;; file does not exist - (not (string= (number-to-string (string-to-number revision)) revision))) ;; revision is not a number - (progn - (message "Getting revision %s of %s, target: %s" revision file-name - (expand-file-name(concat default-directory file-name-with-revision))) - (svn-compute-svn-client-version) - (let ((content - (with-temp-buffer - (if (and (and (<= (car svn-client-version) 1) (< (cadr svn-client-version) 7)) - (string= revision "BASE")) - ;; Shortcut: Take the file from the file system when using svn client < v1.7 - (insert-file-contents (concat (svn-wc-adm-dir-name) - "/text-base/" - (file-name-nondirectory file-name) - ".svn-base")) - (progn - (svn-run nil t 'cat "cat" "-r" revision - (concat default-directory (file-name-nondirectory 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-buffer-name))) - (buffer-string)))) - (find-file file-name-with-revision) - (setq buffer-read-only nil) - (erase-buffer) ;Widen, because we'll save the whole buffer. - (insert content) - (goto-char (point-min)) - (let ((write-file-functions nil) - (require-final-newline nil)) - (save-buffer)))) - (find-file file-name-with-revision))))) - ;;(message "default-directory: %s revision-file-info: %S" default-directory svn-status-get-specific-revision-file-info) - (nreverse svn-status-get-specific-revision-file-info))) - -(defun svn-status-ediff-with-revision (arg) - "Run ediff on the current file with a different revision. -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") - (let* ((svn-status-get-specific-revision-file-info - (svn-status-get-specific-revision-internal - (list (svn-status-make-line-info - (file-relative-name - (svn-status-line-info->full-path (svn-status-get-line-information)) - (svn-status-base-dir)) - nil nil nil nil nil nil - (svn-status-line-info->update-available (svn-status-get-line-information)))) - (if arg :ask :auto) - nil)) - (ediff-after-quit-destination-buffer (current-buffer)) - (default-directory (svn-status-base-dir)) - (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 my-buffer base-buff)) - (startup-hook '(svn-ediff-startup-hook))) - (ediff-buffers base-buff my-buffer startup-hook))) - -(defun svn-ediff-startup-hook () - ;; (message "svn-ediff-startup-hook: ediff-after-quit-hook-internal: %S" ediff-after-quit-hook-internal) - (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) - ;; (message "svn-ediff-exit-hook: svn-buf: %s, tmp-bufs: %s" 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)) - (file-name (buffer-file-name tb)) - (is-temp-file (numberp (string-match "~\\([0-9]+\\|BASE\\)~" file-name)))) - ;; (message "svn-ediff-exit-hook - is-temp-file: %s, temp-buf:: %s - %s " is-temp-file (current-buffer) file-name) - (when (and win (> (count-windows) 1) - (delete-window win))) - (kill-buffer tb) - (when (and is-temp-file svn-status-ediff-delete-temporary-files) - (when (or (eq svn-status-ediff-delete-temporary-files t) - (y-or-n-p (format "Delete File '%s' ? " file-name))) - (delete-file file-name)))))) - ;; 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)) - -(defun svn-file-show-svn-ediff (arg) - "Run ediff on the current file with a previous revision. -If ARG then prompt for revision to diff against." - (interactive "P") - (let ((svn-status-get-line-information-for-file 'relative) - (default-directory (svn-status-base-dir))) - (svn-status-ediff-with-revision arg))) - -;; -------------------------------------------------------------------------------- -;; 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 &optional send-passwd) - "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-buffer-name) - (goto-char (point-max)) - (let ((buffer-read-only nil)) - (insert (if send-passwd (make-string (length string) ?.) string))) - (set-marker (process-mark (get-process "svn")) (point))) - (process-send-string "svn" string)) - -(defun svn-process-send-string-and-newline (string &optional send-passwd) - "Send a string to the running svn process. -Just call `svn-process-send-string' with STRING and an end of line termination. -When called with a prefix argument, read the data from user as password." - (interactive (let* ((use-passwd current-prefix-arg) - (s (if use-passwd - (read-passwd "Send secret line to svn process: ") - (read-string "Send line to svn process: ")))) - (list s use-passwd))) - (svn-process-send-string (concat string "\n") send-passwd)) - -;; -------------------------------------------------------------------------------- -;; Search interface -;; -------------------------------------------------------------------------------- - -(defun svn-status-grep-files (regexp) - "Run grep on selected file(s). -See `svn-status-marked-files' for what counts as selected." - (interactive "sGrep files for: ") - (unless grep-command - (grep-compute-defaults)) - (grep (format "%s %s %s" grep-command (shell-quote-argument regexp) - (mapconcat 'identity (svn-status-marked-file-names) " ")))) - -(defun svn-status-search-files (search-string) - "Search selected file(s) for a fixed SEARCH-STRING. -See `svn-status-marked-files' for what counts as selected." - (interactive "sSearch files for: ") - (svn-status-grep-files (regexp-quote search-string))) - -;; -------------------------------------------------------------------------------- -;; Property List stuff -;; -------------------------------------------------------------------------------- - -(defun svn-status-property-list () - (interactive) - (let ((file-names (svn-status-marked-file-names))) - (if file-names - (progn - (svn-run t t 'proplist (append (list "proplist" "-v") file-names))) - (message "No valid file selected - No property listing possible")))) - -(defun svn-status-proplist-start () - (svn-status-ensure-cursor-on-file) - (svn-run t t 'proplist-parse "proplist" (svn-status-line-info->filename - (svn-status-get-line-information)))) -(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) - (prop-name) - (prop-value)) - (save-excursion - (set-buffer svn-process-buffer-name) - (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 - (cond ((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-buffer-name) - (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-buffer-name) - (message "Setting property %s := %s for %S" prop-name prop-value - (svn-status-marked-file-names)) - (let ((file-names (svn-status-marked-file-names))) - (when file-names - (svn-run nil t 'propset - (append (list "propset" prop-name prop-value) file-names)) - ) - ) - (message "propset finished.") - ))) - ((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-buffer-name) - (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 t t 'propdel - (append (list "propdel" prop-name) file-names)))))))))) - -(defun svn-status-property-edit (file-info-list prop-name &optional new-prop-value remove-values) - (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 nil t 'propget-parse "propget" prop-name file-name) - (save-excursion - (set-buffer svn-process-buffer-name) - (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) - ;; If the buffer has been narrowed, `svn-prop-edit-done' will use - ;; only the accessible part. So we need not erase the rest here. - (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) - (if remove-values - (message "Remove prop values %S " new-prop-value) - (message "Adding new prop values %S " new-prop-value)) - (while new-prop-value - (goto-char (point-min)) - (if (re-search-forward (concat "^" (regexp-quote (car new-prop-value)) "$") nil t) - (when remove-values - (kill-whole-line 1)) - (unless remove-values - (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-create "*svn-property-edit*")) - ;; If the buffer has been narrowed, `svn-prop-edit-do-it' will use - ;; only the accessible part. So we need not erase the rest here. - (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-edit-svn-externals () - (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:externals") - (message "Edit svn:externals 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-keyword-id (arg) - "Set/Remove Id from the svn:keywords property. -Normally Id is added to the svn:keywords property. - -When called with the prefix arg -, remove Id from the svn:keywords property." - (interactive "P") - (svn-status-property-edit (svn-status-marked-files) "svn:keywords" '("Id") (eq arg '-)) - (svn-prop-edit-do-it nil)) - -(defun svn-status-property-set-keyword-date (arg) - "Set/Remove Date from the svn:keywords property. -Normally Date is added to the svn:keywords property. - -When called with the prefix arg -, remove Date from the svn:keywords property." - (interactive "P") - (svn-status-property-edit (svn-status-marked-files) "svn:keywords" '("Date") (eq arg '-)) - (svn-prop-edit-do-it nil)) - - -(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))) - -(defun svn-status-property-set-executable (&optional unset) - "Set the svn:executable property on the marked files. -When called with a prefix argument: unset the svn:executable property." - (interactive "P") - (if unset - (progn - (svn-run nil t 'propdel (append (list "propdel" "svn:executable") (svn-status-marked-file-names))) - (message "Unset the svn:executable property for %s" (svn-status-marked-file-names)) - (svn-status-update)) - (svn-status-property-set-property (svn-status-marked-files) "svn:executable" "*"))) - -(defun svn-status-property-set-mime-type () - "Set the svn:mime-type property on the marked files." - (interactive) - (require 'mailcap nil t) - (let ((completion-ignore-case t) - (mime-types (when (fboundp 'mailcap-mime-types) - (mailcap-mime-types)))) - (svn-status-property-set-property - (svn-status-marked-files) "svn:mime-type" - (funcall svn-status-completing-read-function "Set svn:mime-type for the marked files: " - (mapcar (lambda (x) (cons x x)) ; for Emacs 21 - (sort mime-types 'string<)))))) - -;; -------------------------------------------------------------------------------- -;; svn-prop-edit-mode: -;; -------------------------------------------------------------------------------- - -(defvar svn-prop-edit-mode-map () "Keymap used in `svn-prop-edit-mode' buffers.") -(put 'svn-prop-edit-mode-map 'risky-local-variable t) ;for Emacs 20.7 - -(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) - "Run svn propset `svn-status-propedit-property-name' with the content of the -*svn-property-edit* buffer." - (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*")) - (when (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system svn-status-svn-file-coding-system nil)) - (let ((svn-propedit-file-name (concat svn-status-temp-dir "svn-prop-edit.txt" svn-temp-suffix))) - (setq svn-status-temp-file-to-remove (svn-expand-filename-for-remote-access svn-propedit-file-name)) - (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-propedit-file-list) - (setq svn-status-propedit-file-list nil) - (svn-run async t 'propset "propset" - svn-status-propedit-property-name - "--targets" svn-status-temp-arg-file - (when (eq svn-status-svn-file-coding-system 'utf-8) - '("--encoding" "UTF-8")) - "-F" svn-propedit-file-name) - (unless async (svn-status-remove-temp-file-maybe))) - (when svn-status-pre-propedit-window-configuration - (set-window-configuration svn-status-pre-propedit-window-configuration))))) - -(defun svn-prop-edit-svn-diff (arg) - (interactive "P") - (set-buffer svn-status-buffer-name) - ;; Because propedit is not recursive in our use, neither is this diff. - (svn-status-show-svn-diff-internal svn-status-propedit-file-list nil - (if arg :ask "BASE"))) - -(defun svn-prop-edit-svn-log (arg) - (interactive "P") - (set-buffer svn-status-buffer-name) - (svn-status-show-svn-log arg)) - -(defun svn-prop-edit-svn-status () - (interactive) - (pop-to-buffer svn-status-buffer-name) - (other-window 1)) - -;; -------------------------------------------------------------------------------- -;; svn-log-edit-mode: -;; -------------------------------------------------------------------------------- - -(defvar svn-log-edit-mode-map () "Keymap used in `svn-log-edit-mode' buffers.") -(put 'svn-log-edit-mode-map 'risky-local-variable t) ;for Emacs 20.7 - -(defvar svn-log-edit-mode-menu) ;really defined with `easy-menu-define' below. - -(defun svn-log-edit-common-setup () - (set (make-local-variable 'paragraph-start) svn-log-edit-paragraph-start) - (set (make-local-variable 'paragraph-separate) svn-log-edit-paragraph-separate)) - -(if svn-log-edit-use-log-edit-mode - (define-derived-mode svn-log-edit-mode log-edit-mode "svn-log-edit" - "Wrapper around `log-edit-mode' for psvn.el" - (easy-menu-add svn-log-edit-mode-menu) - (setq svn-log-edit-update-log-entry nil) - (set (make-local-variable 'log-edit-callback) 'svn-log-edit-done) - (set (make-local-variable 'log-edit-listfun) 'svn-log-edit-files-to-commit) - (set (make-local-variable 'log-edit-initial-files) (log-edit-files)) - (svn-log-edit-common-setup) - (message "Press %s when you are done editing." - (substitute-command-keys "\\[log-edit-done]")) - ) - (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") - (setq svn-log-edit-update-log-entry nil) - (svn-log-edit-common-setup) - (run-hooks 'svn-log-edit-mode-hook))) - -(when (not svn-log-edit-mode-map) - (setq svn-log-edit-mode-map (make-sparse-keymap)) - (unless svn-log-edit-use-log-edit-mode - (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])) -(put 'svn-log-edit-mode-menu 'risky-local-variable t) - -(defun svn-log-edit-abort () - (interactive) - (bury-buffer) - (set-window-configuration svn-status-pre-commit-window-configuration)) - -(defun svn-log-edit-done () - "Finish editing the log message and run svn commit." - (interactive) - (svn-status-save-some-buffers) - (let ((svn-logedit-file-name)) - (save-excursion - (set-buffer (get-buffer svn-log-edit-buffer-name)) - (when svn-log-edit-insert-files-to-commit - (svn-log-edit-remove-comment-lines)) - (when (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system svn-status-svn-file-coding-system nil)) - (when (or svn-log-edit-update-log-entry svn-status-files-to-commit) - (setq svn-log-edit-file-name (concat svn-status-temp-dir "svn-log-edit.txt" svn-temp-suffix)) - (setq svn-status-temp-file-to-remove (svn-expand-filename-for-remote-access svn-log-edit-file-name)) - (write-region (point-min) (point-max) svn-status-temp-file-to-remove nil 1)) - (bury-buffer)) - (if svn-log-edit-update-log-entry - (when (y-or-n-p "Update the log entry? ") - ;; svn propset svn:log --revprop -r11672 -F file - (svn-run nil t 'propset "propset" "svn:log" "--revprop" - (concat "-r" svn-log-edit-update-log-entry) - "-F" svn-log-edit-file-name) - (save-excursion - (set-buffer svn-process-buffer-name) - (message "%s" (buffer-substring (point-min) (- (point-max) 1))))) - (when svn-status-files-to-commit ; there are files to commit - (setq svn-status-operated-on-dot - (and (= 1 (length svn-status-files-to-commit)) - (string= "." (svn-status-line-info->filename (car svn-status-files-to-commit))))) - (svn-status-create-arg-file svn-status-files-to-commit) - (svn-run t t 'commit "commit" - (unless svn-status-recursive-commit "--non-recursive") - "--targets" svn-status-temp-arg-file - "-F" svn-log-edit-file-name - (when (eq svn-status-svn-file-coding-system 'utf-8) - '("--encoding" "UTF-8")) - svn-status-default-commit-arguments)) - (set-window-configuration svn-status-pre-commit-window-configuration) - (message "svn-log editing done")))) - -(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-buffer-name) ; TODO: is this necessary? - ;; This call is very much like `svn-status-show-svn-diff-for-marked-files' - ;; but uses commit-specific variables instead of the current marks. - (svn-status-show-svn-diff-internal svn-status-files-to-commit - svn-status-recursive-commit - (if arg :ask "BASE"))) - -(defun svn-log-edit-svn-log (arg) - (interactive "P") - (set-buffer svn-status-buffer-name) - (svn-status-show-svn-log arg)) - -(defun svn-log-edit-svn-status () - (interactive) - (pop-to-buffer svn-status-buffer-name) - (other-window 1)) - -(defun svn-log-edit-files-to-commit () - (mapcar 'svn-status-line-info->filename svn-status-files-to-commit)) - -(defun svn-log-edit-show-files-to-commit () - (interactive) - (message "Files to commit%s: %S" - (if svn-status-recursive-commit " recursively" "") - (svn-log-edit-files-to-commit))) - -(defun svn-log-edit-save-message () - "Save the current log message to the file `svn-log-edit-file-name'." - (interactive) - (let ((log-edit-file-name (svn-log-edit-file-name))) - (if (string= buffer-file-name log-edit-file-name) - (save-buffer) - (write-region (point-min) (point-max) log-edit-file-name)))) - -(defun svn-log-edit-erase-edit-buffer () - "Delete everything in the `svn-log-edit-buffer-name' buffer." - (interactive) - (set-buffer svn-log-edit-buffer-name) - (erase-buffer)) - -(defun svn-log-edit-insert-files-to-commit () - (interactive) - (svn-log-edit-remove-comment-lines) - (let ((buf-size (- (point-max) (point-min)))) - (save-excursion - (goto-char (point-min)) - (insert svn-log-edit-header) - (insert "## File(s) to commit" - (if svn-status-recursive-commit " recursively" "") ":\n") - (let ((file-list svn-status-files-to-commit)) - (while file-list - (insert (concat "## " (svn-status-line-info->filename (car file-list)) "\n")) - (setq file-list (cdr file-list))))) - (when (= 0 buf-size) - (goto-char (point-max))))) - -(defun svn-log-edit-remove-comment-lines () - (interactive) - (save-excursion - (goto-char (point-min)) - (flush-lines "^## .*"))) - -(defun svn-file-add-to-changelog (prefix-arg) - "Create a changelog entry for the function at point. -The variable `svn-status-changelog-style' allows to select the used changlog style" - (interactive "P") - (cond ((eq svn-status-changelog-style 'changelog) - (svn-file-add-to-log-changelog-style prefix-arg)) - ((eq svn-status-changelog-style 'svn-dev) - (svn-file-add-to-log-svn-dev-style prefix-arg)) - ((fboundp svn-status-changelog-style) - (funcall svn-status-changelog-style prefix-arg)) - (t - (error "Invalid setting for `svn-status-changelog-style'")))) - -(defun svn-file-add-to-log-changelog-style (curdir) - "Create a changelog entry for the function at point. -`add-change-log-entry-other-window' creates the header information. -If CURDIR, save the log file in the current directory, otherwise in the base directory of this working copy." - (interactive "P") - (add-change-log-entry-other-window nil (svn-log-edit-file-name curdir)) - (svn-log-edit-mode)) - -;; taken from svn-dev.el: svn-log-path-derive -(defun svn-dev-log-path-derive (path) - "Derive a relative directory path for absolute PATH, for a log entry." - (save-match-data - (let ((base (file-name-nondirectory path)) - (chop-spot (string-match - "\\(code/\\)\\|\\(src/\\)\\|\\(projects/\\)" - path))) - (if chop-spot - (progn - (setq path (substring path (match-end 0))) - ;; Kluge for Subversion developers. - (if (string-match "subversion/" path) - (substring path (+ (match-beginning 0) 11)) - path)) - (string-match (expand-file-name "~/") path) - (substring path (match-end 0)))))) - -;; taken from svn-dev.el: svn-log-message -(defun svn-file-add-to-log-svn-dev-style (prefix-arg) - "Add to an in-progress log message, based on context around point. -If PREFIX-ARG is negative, then use basenames only in -log messages, otherwise use full paths. The current defun name is -always used. - -If PREFIX-ARG is a list (e.g. by using C-u), save the log file in -the current directory, otherwise in the base directory of this -working copy. - -If the log message already contains material about this defun, then put -point there, so adding to that material is easy. - -Else if the log message already contains material about this file, put -point there, and push onto the kill ring the defun name with log -message dressing around it, plus the raw defun name, so yank and -yank-next are both useful. - -Else if there is no material about this defun nor file anywhere in the -log message, then put point at the end of the message and insert a new -entry for file with defun. -" - (interactive "P") - (let* ((short-file-names (and (numberp prefix-arg) (< prefix-arg 0))) - (curdir (listp prefix-arg)) - (this-file (if short-file-names - (file-name-nondirectory buffer-file-name) - (svn-dev-log-path-derive buffer-file-name))) - (this-defun (or (add-log-current-defun) - (save-excursion - (save-match-data - (if (eq major-mode 'c-mode) - (progn - (if (fboundp 'c-beginning-of-statement-1) - (c-beginning-of-statement-1) - (c-beginning-of-statement)) - (search-forward "(" nil t) - (forward-char -1) - (forward-sexp -1) - (buffer-substring - (point) - (progn (forward-sexp 1) (point))))))))) - (log-file (svn-log-edit-file-name curdir))) - (find-file log-file) - (goto-char (point-min)) - ;; Strip text properties from strings - (set-text-properties 0 (length this-file) nil this-file) - (set-text-properties 0 (length this-defun) nil this-defun) - ;; If log message for defun already in progress, add to it - (if (and - this-defun ;; we have a defun to work with - (search-forward this-defun nil t) ;; it's in the log msg already - (save-excursion ;; and it's about the same file - (save-match-data - (if (re-search-backward ; Ick, I want a real filename regexp! - "^\\*\\s-+\\([a-zA-Z0-9-_.@=+^$/%!?(){}<>]+\\)" nil t) - (string-equal (match-string 1) this-file) - t)))) - (if (re-search-forward ":" nil t) - (if (looking-at " ") (forward-char 1))) - ;; Else no log message for this defun in progress... - (goto-char (point-min)) - ;; But if log message for file already in progress, add to it. - (if (search-forward this-file nil t) - (progn - (if this-defun (progn - (kill-new (format "(%s): " this-defun)) - (kill-new this-defun))) - (search-forward ")" nil t) - (if (looking-at " ") (forward-char 1))) - ;; Found neither defun nor its file, so create new entry. - (goto-char (point-max)) - (if (not (bolp)) (insert "\n")) - (insert (format "\n* %s (%s): " this-file (or this-defun ""))) - ;; Finally, if no derived defun, put point where the user can - ;; type it themselves. - (if (not this-defun) (forward-char -3)))))) - -;; -------------------------------------------------------------------------------- -;; svn-log-view-mode: -;; -------------------------------------------------------------------------------- - -(defvar svn-log-view-mode-map () "Keymap used in `svn-log-view-mode' buffers.") -(put 'svn-log-view-mode-map 'risky-local-variable t) ;for Emacs 20.7 - -(when (not svn-log-view-mode-map) - (setq svn-log-view-mode-map (make-sparse-keymap)) - (suppress-keymap svn-log-view-mode-map) - (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-get-specific-revision) - (define-key svn-log-view-mode-map (kbd "f") 'svn-log-get-specific-revision) - (define-key svn-log-view-mode-map (kbd "E") 'svn-log-ediff-specific-revision) - (define-key svn-log-view-mode-map (kbd "=") 'svn-log-view-diff) - (define-key svn-log-view-mode-map (kbd "#") 'svn-log-mark-partner-revision) - (define-key svn-log-view-mode-map (kbd "x") 'svn-log-exchange-partner-mark-with-point) - (define-key svn-log-view-mode-map (kbd "TAB") 'svn-log-next-link) - (define-key svn-log-view-mode-map [backtab] 'svn-log-prev-link) - (define-key svn-log-view-mode-map (kbd "RET") 'svn-log-find-file-at-point) - (define-key svn-log-view-mode-map (kbd "e") 'svn-log-edit-log-entry) - (define-key svn-log-view-mode-map (kbd "q") 'bury-buffer)) - -(defvar svn-log-view-popup-menu-map () - "Keymap used to show popup menu in `svn-log-view-mode' buffers.") -(put 'svn-log-view-popup-menu-map 'risky-local-variable t) ;for Emacs 20.7 -(when (not svn-log-view-popup-menu-map) - (setq svn-log-view-popup-menu-map (make-sparse-keymap)) - (suppress-keymap svn-log-view-popup-menu-map) - (define-key svn-log-view-popup-menu-map [down-mouse-3] 'svn-log-view-popup-menu)) - -(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] - ["Ediff file at point" svn-log-ediff-specific-revision t] - ["Find file at point" svn-log-find-file-at-point t] - ["Mark as diff against revision" svn-log-mark-partner-revision t] - ["Get older revision for file at point" svn-log-get-specific-revision t] - ["Edit log message" svn-log-edit-log-entry t])) - -(defun svn-log-view-popup-menu (event) - (interactive "e") - (mouse-set-point event) - (let* ((rev (svn-log-revision-at-point))) - (when rev - (svn-status-face-set-temporary-during-popup - 'svn-status-marked-popup-face (svn-point-at-bol) (svn-point-at-eol) - svn-log-view-mode-menu)))) - -(defvar svn-log-view-font-lock-basic-keywords - '(("^r[0-9]+ .+" (0 `(face font-lock-keyword-face - mouse-face highlight - keymap ,svn-log-view-popup-menu-map)))) - "Basic keywords in `svn-log-view-mode'.") -(put 'svn-log-view-font-basic-lock-keywords 'risky-local-variable t) ;for Emacs 20.7 - -(defvar svn-log-view-font-lock-keywords) -(define-derived-mode svn-log-view-mode fundamental-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 'svn-log-view-font-lock-keywords) svn-log-view-font-lock-basic-keywords) - (dolist (lh svn-log-link-handlers) - (add-to-list 'svn-log-view-font-lock-keywords (gethash lh svn-log-registered-link-handlers))) - (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 2) - (unless (looking-at "Changed paths:") - (beginning-of-line 1)))) - -(defun svn-log-view-prev () - (interactive) - (when (re-search-backward "^r[0-9]+" nil t 2) - (beginning-of-line 2) - (unless (looking-at "Changed paths:") - (beginning-of-line 1)))) - -(defun svn-log-mark-partner-revision () - "Mark the revision at point to be used as diff against revision." - (interactive) - (let ((start-pos) - (point-at-partner-rev) - (overlay)) - (dolist (ov (overlays-in (point-min) (point-max))) - (when (overlay-get ov 'svn-log-partner-revision) - (setq point-at-partner-rev (and (>= (point) (overlay-start ov)) - (<= (point) (overlay-end ov)))) - (delete-overlay ov))) - (unless point-at-partner-rev - (save-excursion - (when (re-search-backward "^r[0-9]+" nil t 1) - (setq start-pos (point)) - (re-search-forward "^---------------") - (setq overlay (make-overlay start-pos (line-beginning-position 0))) - (overlay-put overlay 'face 'svn-log-partner-highlight-face) - (overlay-put overlay 'svn-log-partner-revision t)))))) - -(defun svn-log-exchange-partner-mark-with-point () - (interactive) - (let ((cur-pos (point)) - (dest-pos)) - (dolist (ov (overlays-in (point-min) (point-max))) - (when (overlay-get ov 'svn-log-partner-revision) - (setq dest-pos (overlay-start ov)))) - (when dest-pos - (svn-log-mark-partner-revision) - (goto-char dest-pos) - (forward-line 3) - (svn-log-view-prev) - (svn-log-view-next)))) - -(defun svn-log-revision-for-diff () - (let ((rev)) - (dolist (ov (overlays-in (point-min) (point-max))) - (when (overlay-get ov 'svn-log-partner-revision) - (save-excursion - (unless (and (>= (point) (overlay-start ov)) - (<= (point) (overlay-end ov))) - (goto-char (overlay-start ov)) - (setq rev (svn-log-revision-at-point)))))) - rev)) - -(defun svn-log-revision-at-point () - (save-excursion - (end-of-line) - (re-search-backward "^r\\([0-9]+\\)") - (svn-match-string-no-properties 1))) - -(defun svn-log-file-name-at-point (respect-checkout-prefix-path) - (let ((full-file-name) - (file-name) - (checkout-prefix-path (if respect-checkout-prefix-path - (url-unhex-string - (svn-status-checkout-prefix-path)) - ""))) - (save-excursion - (beginning-of-line) - (when (looking-at " [MA] /\\(.+\\)$") - (setq full-file-name (svn-match-string-no-properties 1)))) - (when (string= checkout-prefix-path "") - (setq checkout-prefix-path "/")) - (if (null full-file-name) - (progn - (message "No file at point") - nil) - (setq file-name - (if (eq (string-match (regexp-quote (substring checkout-prefix-path 1)) full-file-name) 0) - (substring full-file-name (- (length checkout-prefix-path) (if (string= checkout-prefix-path "/") 1 0))) - full-file-name)) - ;; (message "svn-log-file-name-at-point %s prefix: '%s', full-file-name: %s" file-name checkout-prefix-path full-file-name) - file-name))) - -(defun svn-log-find-file-at-point () - (interactive) - (let ((file-name (svn-log-file-name-at-point t))) - (when file-name - (let ((default-directory (svn-status-base-dir))) - ;;(message "svn-log-file-name-at-point: %s, default-directory: %s" file-name default-directory) - (find-file file-name))))) - -(defun svn-log-next-link () - "Jump to the next external link in this buffer" - (interactive) - (let ((start-pos (if (get-text-property (point) 'link-handler) - (next-single-property-change (point) 'link-handler) - (point)))) - (goto-char (or (next-single-property-change start-pos 'link-handler) (point))))) - -(defun svn-log-prev-link () - "Jump to the previous external link in this buffer" - (interactive) - (let ((start-pos (if (get-text-property (point) 'link-handler) - (previous-single-property-change (point) 'link-handler) - (point)))) - (goto-char (or (previous-single-property-change (or start-pos (point)) 'link-handler) (point))))) - -(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") - (svn-status-diff-show-changeset (svn-log-revision-at-point) arg (svn-log-revision-for-diff))) - -(defun svn-log-get-specific-revision () - "Get an older revision of the file at point via svn cat." - (interactive) - ;; (message "%S" (svn-status-make-line-info (svn-log-file-name-at-point t))) - (let ((default-directory (svn-status-base-dir)) - (file-name (svn-log-file-name-at-point t))) - (if file-name - (svn-status-get-specific-revision-internal - (list (svn-status-make-line-info file-name)) - (svn-log-revision-at-point) - nil) - (message "No file at point")))) - -(defun svn-log-ediff-specific-revision (&optional user-confirmation) - "Call ediff for the file at point to view a changeset. -When called with a prefix argument, ask the user for the revision." - (interactive "P") - ;; (message "svn-log-ediff-specific-revision: %s" (svn-log-file-name-at-point t)) - (let* ((cur-buf (current-buffer)) - (diff-rev (svn-log-revision-for-diff)) - (upper-rev (if diff-rev - diff-rev - (svn-log-revision-at-point))) - (lower-rev (if diff-rev - (svn-log-revision-at-point) - (number-to-string (- (string-to-number upper-rev) 1)))) - (file-name (svn-log-file-name-at-point t)) - (default-directory (svn-status-base-dir)) - (upper-rev-file-name) - (lower-rev-file-name) - (rev-arg)) - (when user-confirmation - (setq rev-arg (read-string "Revision for changeset: " (concat lower-rev ":" upper-rev))) - (setq lower-rev (car (split-string rev-arg ":"))) - (setq upper-rev (cadr (split-string rev-arg ":")))) - ;;(message "lower-rev: %s, upper-rev: %s" lower-rev upper-rev) - (setq upper-rev-file-name (when file-name - (cdar (svn-status-get-specific-revision-internal - (list (svn-status-make-line-info file-name)) upper-rev nil)))) - (setq lower-rev-file-name (when file-name - (cdar (svn-status-get-specific-revision-internal - (list (svn-status-make-line-info file-name)) lower-rev nil)))) - ;;(message "%S %S" upper-rev-file-name lower-rev-file-name) - (if file-name - (let* ((ediff-after-quit-destination-buffer cur-buf) - (newer-buffer (find-file-noselect upper-rev-file-name)) - (base-buff (find-file-noselect lower-rev-file-name)) - (svn-transient-buffers (list base-buff newer-buffer)) - (startup-hook '(svn-ediff-startup-hook))) - (ediff-buffers base-buff newer-buffer startup-hook)) - (message "No file at point")))) - -(defun svn-log-edit-log-entry () - "Edit the given log entry." - (interactive) - (let ((rev (svn-log-revision-at-point)) - (log-message)) - (svn-run nil t 'propget-parse "propget" "--revprop" (concat "-r" rev) "svn:log") - (save-excursion - (set-buffer svn-process-buffer-name) - (setq log-message (if (> (point-max) 1) - (buffer-substring (point-min) (- (point-max) 1)) - ""))) - (svn-status-pop-to-commit-buffer) - ;; If the buffer has been narrowed, `svn-log-edit-done' will use - ;; only the accessible part. So we need not erase the rest here. - (delete-region (point-min) (point-max)) - (insert log-message) - (goto-char (point-min)) - (setq svn-log-edit-update-log-entry rev))) - - -;; allow additional hyperlinks in log view buffers -(defvar svn-log-link-keymap () - "Keymap used to resolve links `svn-log-view-mode' buffers.") -(put 'svn-log-link-keymap 'risky-local-variable t) ;for Emacs 20.7 -(when (not svn-log-link-keymap) - (setq svn-log-link-keymap (make-sparse-keymap)) - (suppress-keymap svn-log-link-keymap) - (define-key svn-log-link-keymap [mouse-2] 'svn-log-resolve-mouse-link) - (define-key svn-log-link-keymap (kbd "RET") 'svn-log-resolve-link)) - -(defun svn-log-resolve-mouse-link (event) - (interactive "e") - (mouse-set-point event) - (svn-log-resolve-link)) - -(defun svn-log-resolve-link () - (interactive) - (let* ((point-adjustment (if (not (get-text-property (- (point) 1) 'link-handler)) 1 - (if (not (get-text-property (+ (point) 1) 'link-handler)) -1 0))) - (link-name (buffer-substring-no-properties (previous-single-property-change (+ (point) point-adjustment) 'link-handler) - (next-single-property-change (+ (point) point-adjustment) 'link-handler)))) - ;; (message "svn-log-resolve-link '%s'" link-name) - (funcall (get-text-property (point) 'link-handler) link-name))) - -(defun svn-log-register-link-handler (handler-id link-regexp handler-function) - "Register a link handler for external links in *svn-log* buffers -HANDLER-ID is a symbolic name for this handler. The link handler is active when HANDLER-ID -is registered in `svn-log-link-handlers'. -LINK-REGEXP specifies a regular expression that matches the external link. -HANDLER-FUNCTION is called with the match of LINK-REGEXP when the user clicks at the external link." - (let ((font-lock-desc (list link-regexp '(0 `(face font-lock-function-name-face - mouse-face highlight - link-handler invalid-handler-function - keymap ,svn-log-link-keymap))))) - ;; no idea, how to use handler-function in invalid-handler-function above, so set it here - (setcar (nthcdr 5 (nth 1 (nth 1 (nth 1 font-lock-desc)))) handler-function) - (svn-puthash handler-id font-lock-desc svn-log-registered-link-handlers))) - -;; example: add support for ditrack links and handle them via svn-log-resolve-ditrack -;;(svn-log-register-link-handler 'ditrack-issue "i#[0-9]+" 'svn-log-resolve-ditrack) -;;(defun svn-log-resolve-ditrack (link-name) -;; (interactive) -;; (message "svn-log-resolve-ditrack %s" link-name)) - - -(defun svn-log-resolve-trac-ticket-short (link-name) - "Show the trac ticket specified by LINK-NAME via `svn-trac-browse-ticket'." - (interactive) - (let ((ticket-nr (string-to-number (svn-substring-no-properties link-name 1)))) - (svn-trac-browse-ticket ticket-nr))) - -;; register the out of the box provided link handlers -(svn-log-register-link-handler 'trac-ticket-short "#[0-9]+" 'svn-log-resolve-trac-ticket-short) - -;; the actually used link handlers are specified in svn-log-link-handlers - -;; -------------------------------------------------------------------------------- -;; svn-info-mode -;; -------------------------------------------------------------------------------- -(defvar svn-info-mode-map () "Keymap used in `svn-info-mode' buffers.") -(put 'svn-info-mode-map 'risky-local-variable t) ;for Emacs 20.7 - -(when (not svn-info-mode-map) - (setq svn-info-mode-map (make-sparse-keymap)) - (define-key svn-info-mode-map [?s] 'svn-status-pop-to-status-buffer) - (define-key svn-info-mode-map (kbd "h") 'svn-status-pop-to-partner-buffer) - (define-key svn-info-mode-map (kbd "n") 'next-line) - (define-key svn-info-mode-map (kbd "p") 'previous-line) - (define-key svn-info-mode-map (kbd "RET") 'svn-info-show-context) - (define-key svn-info-mode-map [?q] 'bury-buffer)) - -(defun svn-info-mode () - "Major Mode to view informative output from svn." - (interactive) - (kill-all-local-variables) - (use-local-map svn-info-mode-map) - (setq major-mode 'svn-info-mode) - (setq mode-name "svn-info") - (toggle-read-only 1)) - -(defun svn-info-show-context () - "Show the context for a line in the info buffer. -Currently is the output from the svn update command known." - (interactive) - (cond ((save-excursion - (goto-char (point-max)) - (forward-line -1) - (beginning-of-line) - (looking-at "Updated to revision")) - ;; svn-info contains info from an svn update - (let ((cur-pos (point)) - (file-name (buffer-substring-no-properties - (progn (beginning-of-line) (re-search-forward ".. +") (point)) - (line-end-position))) - (pos)) - (when (eq system-type 'windows-nt) - (setq file-name (replace-regexp-in-string "\\\\" "/" file-name))) - (goto-char cur-pos) - (with-current-buffer svn-status-buffer-name - (setq pos (svn-status-get-file-name-buffer-position file-name))) - (when pos - (svn-status-pop-to-new-partner-buffer svn-status-buffer-name) - (goto-char pos)))))) - -;; -------------------------------------------------------------------------------- -;; svn blame minor mode -;; -------------------------------------------------------------------------------- - -(unless (assq 'svn-blame-mode minor-mode-alist) - (setq minor-mode-alist - (cons (list 'svn-blame-mode " SvnBlame") - minor-mode-alist))) - -(defvar svn-blame-mode-map () "Keymap used in `svn-blame-mode' buffers.") -(put 'svn-blame-mode-map 'risky-local-variable t) ;for Emacs 20.7 - -(when (not svn-blame-mode-map) - (setq svn-blame-mode-map (make-sparse-keymap)) - (define-key svn-blame-mode-map [?s] 'svn-status-pop-to-status-buffer) - (define-key svn-blame-mode-map (kbd "n") 'next-line) - (define-key svn-blame-mode-map (kbd "p") 'previous-line) - (define-key svn-blame-mode-map (kbd "RET") 'svn-blame-open-source-file) - (define-key svn-blame-mode-map (kbd "a") 'svn-blame-highlight-author) - (define-key svn-blame-mode-map (kbd "r") 'svn-blame-highlight-revision) - (define-key svn-blame-mode-map (kbd "=") 'svn-blame-show-changeset) - (define-key svn-blame-mode-map (kbd "l") 'svn-blame-show-log) - (define-key svn-blame-mode-map (kbd "b") 'svn-blame-blame-again) - (define-key svn-blame-mode-map (kbd "s") 'svn-blame-show-statistics) - (define-key svn-blame-mode-map [?q] 'bury-buffer)) - -(easy-menu-define svn-blame-mode-menu svn-blame-mode-map -"svn blame minor mode menu" - '("SvnBlame" - ["Jump to source location" svn-blame-open-source-file t] - ["Show changeset" svn-blame-show-changeset t] - ["Show log" svn-blame-show-log t] - ["Show blame again" svn-blame-blame-again t] - ["Show statistics" svn-blame-show-statistics t] - ["Highlight by author" svn-blame-highlight-author t] - ["Highlight by revision" svn-blame-highlight-revision t])) - -(or (assq 'svn-blame-mode minor-mode-map-alist) - (setq minor-mode-map-alist - (cons (cons 'svn-blame-mode svn-blame-mode-map) minor-mode-map-alist))) - -(make-variable-buffer-local 'svn-blame-mode) - -(defun svn-blame-mode (&optional arg) - "Toggle svn blame minor mode. -With ARG, turn svn blame minor mode on if ARG is positive, off otherwise. - -Note: This mode does not yet work on XEmacs... -It is probably because the revisions are in 'before-string properties of overlays - -Key bindings: -\\{svn-blame-mode-map}" - (interactive "P") - (setq svn-blame-mode (if (null arg) - (not svn-blame-mode) - (> (prefix-numeric-value arg) 0))) - (if svn-blame-mode - (progn - (easy-menu-add svn-blame-mode-menu) - (toggle-read-only 1)) - (easy-menu-remove svn-blame-mode-menu)) - (force-mode-line-update)) - -(defun svn-status-activate-blame-mode () - "Activate the svn blame minor in the current buffer. -The current buffer must contain a valid output from svn blame" - (save-excursion - (goto-char (point-min)) - (let ((buffer-read-only nil) - (line (svn-line-number-at-pos)) - (limit (point-max)) - (info-end-col (save-excursion (forward-word 2) (+ (current-column) 1))) - (s) - ov) - ;; remove the old overlays (only for testing) - ;; (dolist (ov (overlays-in (point) limit)) - ;; (when (overlay-get ov 'svn-blame-line-info) - ;; (delete-overlay ov))) - (while (and (not (eobp)) (< (point) limit)) - (setq ov (make-overlay (point) (point))) - (overlay-put ov 'svn-blame-line-info t) - (setq s (buffer-substring-no-properties (svn-point-at-bol) (+ (svn-point-at-bol) info-end-col))) - (overlay-put ov 'before-string (propertize s 'face 'svn-status-blame-rev-number-face)) - (overlay-put ov 'rev-info (delete "" (split-string s " "))) - (delete-region (svn-point-at-bol) (+ (svn-point-at-bol) info-end-col)) - (forward-line) - (setq line (1+ line))))) - (let* ((buf-name (format "*svn-blame: %s <%s>*" - (file-relative-name svn-status-blame-file-name) - svn-status-blame-revision)) - (buffer (get-buffer buf-name))) - (when buffer - (kill-buffer buffer)) - (rename-buffer buf-name)) - ;; use the correct mode for the displayed blame output - (let ((buffer-file-name svn-status-blame-file-name)) - (normal-mode) - (set (make-local-variable 'svn-status-blame-file-name) svn-status-blame-file-name)) - (font-lock-fontify-buffer) - (svn-blame-mode 1)) - -(defun svn-blame-open-source-file () - "Jump to the source file location for the current position in the svn blame buffer" - (interactive) - (let ((src-line-number (svn-line-number-at-pos)) - (src-line-col (current-column))) - (find-file-other-window svn-status-blame-file-name) - (goto-line src-line-number) - (forward-char src-line-col))) - -(defun svn-blame-rev-at-point () - (let ((rev)) - (dolist (ov (overlays-in (svn-point-at-bol) (line-end-position))) - (when (overlay-get ov 'svn-blame-line-info) - (setq rev (car (overlay-get ov 'rev-info))))) - rev)) - -(defun svn-blame-show-changeset (arg) - "Show a diff for the revision at point. -When called with a prefix argument, allow the user to edit the revision." - (interactive "P") - (svn-status-diff-show-changeset (svn-blame-rev-at-point) arg)) - -(defun svn-blame-show-log (arg) - "Show the log for the revision at point. -The output is put into the *svn-log* buffer -The optional prefix argument ARG determines which switches are passed to `svn log': - no prefix --- use whatever is in the list `svn-status-default-log-arguments' - prefix argument of -1: --- use the -q switch (quiet) - prefix argument of 0 --- use no arguments - other prefix arguments: --- use the -v switch (verbose)" - (interactive "P") - (let ((switches (svn-status-svn-log-switches arg)) - (rev (svn-blame-rev-at-point))) - (svn-run t t 'log "log" "--revision" rev switches))) - -(defun svn-blame-highlight-line-maybe (compare-func) - (let ((reference-value) - (is-highlighted) - (consider-this-line) - (hl-ov)) - (dolist (ov (overlays-in (svn-point-at-bol) (line-end-position))) - (when (overlay-get ov 'svn-blame-line-info) - (setq reference-value (funcall compare-func ov))) - (when (overlay-get ov 'svn-blame-highlighted) - (setq is-highlighted t))) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (setq consider-this-line nil) - (dolist (ov (overlays-in (svn-point-at-bol) (line-end-position))) - (when (overlay-get ov 'svn-blame-line-info) - (when (string= reference-value (funcall compare-func ov)) - (setq consider-this-line t)))) - (when consider-this-line - (dolist (ov (overlays-in (svn-point-at-bol) (line-end-position))) - (when (and (overlay-get ov 'svn-blame-highlighted) is-highlighted) - (delete-overlay ov)) - (unless is-highlighted - (setq hl-ov (make-overlay (svn-point-at-bol) (line-end-position))) - (overlay-put hl-ov 'svn-blame-highlighted t) - (overlay-put hl-ov 'face 'svn-status-blame-highlight-face)))) - (forward-line))))) - -(defun svn-blame-show-statistics () - "Show statistics for the current blame buffer." - (interactive) - (let ((author-map (make-hash-table :test 'equal)) - (revision-map (make-hash-table :test 'equal)) - (rev-info) - (author-list) - (author) - (revision-list) - (revision)) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (dolist (ov (overlays-in (svn-point-at-bol) (line-end-position))) - (when (overlay-get ov 'svn-blame-line-info) - (setq rev-info (overlay-get ov 'rev-info)) - (setq author (cadr rev-info)) - (setq revision (string-to-number (car rev-info))) - (svn-puthash author (+ (gethash author author-map 0) 1) author-map) - (svn-puthash revision (+ (gethash revision revision-map 0) 1) revision-map))) - (forward-line)) - (maphash '(lambda (key value) (add-to-list 'author-list (list key value))) author-map) - (maphash '(lambda (key value) (add-to-list 'revision-list (list key value))) revision-map) - (pop-to-buffer (get-buffer-create (replace-regexp-in-string "svn-blame:" "svn-blame-statistics:" (buffer-name)))) - (erase-buffer) - (insert (propertize "Authors:\n" 'face 'font-lock-function-name-face)) - (dolist (line (sort author-list '(lambda (v1 v2) (> (cadr v1) (cadr v2))))) - (insert (format "%s: %s line%s\n" (car line) (cadr line) (if (eq (cadr line) 1) "" "s")))) - (insert (propertize "\nRevisions:\n" 'face 'font-lock-function-name-face)) - (dolist (line (sort revision-list '(lambda (v1 v2) (< (car v1) (car v2))))) - (insert (format "%s: %s line%s\n" (car line) (cadr line) (if (eq (cadr line) 1) "" "s")))) - (goto-char (point-min))))) - -(defun svn-blame-highlight-author-field (ov) - (cadr (overlay-get ov 'rev-info))) - -(defun svn-blame-highlight-author () - "(Un)Highlight all lines with the same author." - (interactive) - (svn-blame-highlight-line-maybe 'svn-blame-highlight-author-field)) - -(defun svn-blame-highlight-revision-field (ov) - (car (overlay-get ov 'rev-info))) - -(defun svn-blame-highlight-revision () - "(Un)Highlight all lines with the same revision." - (interactive) - (svn-blame-highlight-line-maybe 'svn-blame-highlight-revision-field)) - -;; -------------------------------------------------------------------------------- -;; svn-process-mode -;; -------------------------------------------------------------------------------- -(defvar svn-process-mode-map () "Keymap used in `svn-process-mode' buffers.") -(put 'svn-process-mode-map 'risky-local-variable t) ;for Emacs 20.7 - -(when (not svn-process-mode-map) - (setq svn-process-mode-map (make-sparse-keymap)) - (define-key svn-process-mode-map (kbd "RET") 'svn-process-send-string-and-newline) - (define-key svn-process-mode-map [?s] 'svn-process-send-string) - (define-key svn-process-mode-map [?q] 'bury-buffer)) - -(easy-menu-define svn-process-mode-menu svn-process-mode-map -"'svn-process-mode' menu" - '("SvnProcess" - ["Send line to process" svn-process-send-string-and-newline t] - ["Send raw string to process" svn-process-send-string t] - ["Bury process buffer" bury-buffer t])) - -(defun svn-process-mode () - "Major Mode to view process output from svn. - -You can send a new line terminated string to the process via \\[svn-process-send-string-and-newline] -You can send raw data to the process via \\[svn-process-send-string]." - (interactive) - (kill-all-local-variables) - (use-local-map svn-process-mode-map) - (easy-menu-add svn-log-view-mode-menu) - (setq major-mode 'svn-process-mode) - (setq mode-name "svn-process")) - -;; -------------------------------------------------------------------------------- -;; svn status persistent options -;; -------------------------------------------------------------------------------- - -(defun svn-status-repo-for-path (directory) - "Find the repository root for DIRECTORY." - (let ((old-process-default-dir)) - (with-current-buffer (get-buffer-create svn-process-buffer-name) - (setq old-process-default-dir default-directory) - (setq default-directory directory)) ;; update the default-directory for the *svn-process* buffer - (svn-run nil t 'parse-info "info" ".") - (with-current-buffer svn-process-buffer-name - ;; (message "svn-status-repo-for-path: %s: default-directory: %s directory: %s old-process-default-dir: %s" svn-process-buffer-name default-directory directory old-process-default-dir) - (setq default-directory old-process-default-dir) - (goto-char (point-min)) - (let ((case-fold-search t)) - (if (search-forward "repository root: " nil t) - (buffer-substring-no-properties (point) (svn-point-at-eol)) - (when (search-forward "repository uuid: " nil t) - (message "psvn.el: Detected an old svn working copy in '%s'. Please check it out again to get a 'Repository Root' entry in the svn info output." - default-directory) - (concat "Svn Repo UUID: " (buffer-substring-no-properties (point) (svn-point-at-eol))))))))) - -(defun svn-status-base-dir (&optional start-directory) - "Find the svn root directory for the current working copy. -Return nil, if not in a svn working copy." - (let* ((start-dir (expand-file-name (or start-directory default-directory))) - (base-dir (gethash start-dir svn-status-base-dir-cache 'not-found))) - ;;(message "svn-status-base-dir: %S %S" start-dir base-dir) - (if (not (eq base-dir 'not-found)) - base-dir - ;; (message "calculating base-dir for %s" start-dir) - (svn-compute-svn-client-version) - (let* ((base-dir start-dir) - (repository-root (svn-status-repo-for-path base-dir)) - (dot-svn-dir (concat base-dir (svn-wc-adm-dir-name))) - (in-tree (and repository-root (psvn-file-exists-p dot-svn-dir))) - (dir-below (expand-file-name base-dir))) - ;; (message "repository-root: %s start-dir: %s" repository-root start-dir) - (if (and (<= (car svn-client-version) 1) (< (cadr svn-client-version) 3)) - (setq base-dir (svn-status-base-dir-for-ancient-svn-client start-dir)) ;; svn version < 1.3 - (while (when (and dir-below (psvn-file-exists-p dot-svn-dir)) - (setq base-dir (file-name-directory dot-svn-dir)) - (string-match "\\(.+/\\).+/" dir-below) - (setq dir-below - (and (string-match "\\(.*/\\)[^/]+/" dir-below) - (match-string 1 dir-below))) - ;; (message "base-dir: %s, dir-below: %s, dot-svn-dir: %s in-tree: %s" base-dir dir-below dot-svn-dir in-tree) - (when dir-below - (if (string= (svn-status-repo-for-path dir-below) repository-root) - (setq dot-svn-dir (concat dir-below (svn-wc-adm-dir-name))) - (setq dir-below nil))))) - (setq base-dir (and in-tree base-dir))) - (svn-puthash start-dir base-dir svn-status-base-dir-cache) - (svn-status-message 7 "svn-status-base-dir %s => %s" start-dir base-dir) - base-dir)))) - -(defun svn-status-base-dir-for-ancient-svn-client (&optional start-directory) - "Find the svn root directory for the current working copy. -Return nil, if not in a svn working copy. -This function is used for svn clients version 1.2 and below." - (let* ((base-dir (expand-file-name (or start-directory default-directory))) - (dot-svn-dir (concat base-dir (svn-wc-adm-dir-name))) - (in-tree (file-exists-p dot-svn-dir)) - (dir-below (expand-file-name default-directory))) - (while (when (and dir-below (file-exists-p dot-svn-dir)) - (setq base-dir (file-name-directory dot-svn-dir)) - (string-match "\\(.+/\\).+/" dir-below) - (setq dir-below - (and (string-match "\\(.*/\\)[^/]+/" dir-below) - (match-string 1 dir-below))) - (setq dot-svn-dir (concat dir-below (svn-wc-adm-dir-name))))) - (and in-tree base-dir))) - -(defun svn-status-save-state () - "Save psvn persistent options for this working copy to a file." - (interactive) - (let ((buf (find-file (concat (svn-status-base-dir) "++psvn.state")))) - (erase-buffer) ;Widen, because we'll save the whole buffer. - ;; TO CHECK: why is svn-status-options a global variable?? - (setq svn-status-options - (list - (list "svn-trac-project-root" svn-trac-project-root) - (list "sort-status-buffer" svn-status-sort-status-buffer) - (list "elide-list" svn-status-elided-list) - (list "module-name" svn-status-module-name) - (list "branch-list" svn-status-branch-list) - (list "changelog-style" svn-status-changelog-style) - )) - (insert (pp-to-string svn-status-options)) - (save-buffer) - (kill-buffer buf))) - -(defun svn-status-load-state (&optional no-error) - "Load psvn persistent options for this working copy from a file." - (interactive) - (let ((file (concat (svn-status-base-dir) "++psvn.state"))) - (if (file-readable-p file) - (with-temp-buffer - (insert-file-contents file) - (setq svn-status-options (read (current-buffer))) - (setq svn-status-sort-status-buffer - (nth 1 (assoc "sort-status-buffer" svn-status-options))) - (setq svn-trac-project-root - (nth 1 (assoc "svn-trac-project-root" svn-status-options))) - (setq svn-status-elided-list - (nth 1 (assoc "elide-list" svn-status-options))) - (setq svn-status-module-name - (nth 1 (assoc "module-name" svn-status-options))) - (setq svn-status-branch-list - (nth 1 (assoc "branch-list" svn-status-options))) - (setq svn-status-changelog-style - (nth 1 (assoc "changelog-style" svn-status-options))) - (when (and (interactive-p) svn-status-elided-list (svn-status-apply-elide-list))) - (message "psvn.el: loaded %s" file)) - (if no-error - (setq svn-trac-project-root nil - svn-status-elided-list nil - svn-status-module-name nil - svn-status-branch-list nil - svn-status-changelog-style 'changelog) - (error "psvn.el: %s is not readable." file))))) - -(defun svn-status-toggle-sort-status-buffer () - "Toggle sorting of the *svn-status* buffer. - -If you turn off sorting, you can speed up \\[svn-status]. However, -the buffer is not correctly sorted then. This function will be -removed again, when a faster parsing and display routine for -`svn-status' is available." - (interactive) - (setq svn-status-sort-status-buffer (not svn-status-sort-status-buffer)) - (message "The %s buffer will %sbe sorted." svn-status-buffer-name - (if svn-status-sort-status-buffer "" "not "))) - -(defun svn-status-toggle-svn-verbose-flag () - "Toggle `svn-status-verbose'. " - (interactive) - (setq svn-status-verbose (not svn-status-verbose)) - (message "svn status calls will %suse the -v flag." (if svn-status-verbose "" "not "))) - -(defun svn-status-toggle-display-full-path () - "Toggle displaying the full path in the `svn-status-buffer-name' buffer" - (interactive) - (setq svn-status-display-full-path (not svn-status-display-full-path)) - (message "The %s buffer will%s use full path names." svn-status-buffer-name - (if svn-status-display-full-path "" " not")) - (svn-status-update-buffer)) - -(defun svn-status-set-trac-project-root () - (interactive) - (setq svn-trac-project-root - (read-string "Trac project root (e.g.: http://projects.edgewall.com/trac/): " - svn-trac-project-root)) - (when (yes-or-no-p "Save the new setting for svn-trac-project-root to disk? ") - (svn-status-save-state))) - -(defun svn-status-set-module-name () - "Interactively set `svn-status-module-name'." - (interactive) - (setq svn-status-module-name - (read-string "Short Unit Name (e.g.: MyProject): " - svn-status-module-name)) - (when (yes-or-no-p "Save the new setting for svn-status-module-name to disk? ") - (svn-status-save-state))) - -(defun svn-status-set-changelog-style () - "Interactively set `svn-status-changelog-style'." - (interactive) - (setq svn-status-changelog-style - (intern (funcall svn-status-completing-read-function "svn-status on directory: " '("changelog" "svn-dev" "other")))) - (when (string= svn-status-changelog-style 'other) - (setq svn-status-changelog-style (car (find-function-read)))) - (when (yes-or-no-p "Save the new setting for svn-status-changelog-style to disk? ") - (svn-status-save-state))) - -(defun svn-status-set-branch-list () - "Interactively set `svn-status-branch-list'." - (interactive) - (setq svn-status-branch-list - (split-string (read-string "Branch list: " - (mapconcat 'identity svn-status-branch-list " ")))) - (when (yes-or-no-p "Save the new setting for svn-status-branch-list to disk? ") - (svn-status-save-state))) - -(defun svn-browse-url (url) - "Call `browse-url', using `svn-browse-url-function'." - (let ((browse-url-browser-function (or svn-browse-url-function - browse-url-browser-function))) - (browse-url url))) - -;; -------------------------------------------------------------------------------- -;; svn status trac integration -;; -------------------------------------------------------------------------------- -(defun svn-trac-browse-wiki () - "Open the trac wiki view for the current svn repository." - (interactive) - (unless svn-trac-project-root - (svn-status-set-trac-project-root)) - (svn-browse-url (concat svn-trac-project-root "wiki"))) - -(defun svn-trac-browse-timeline () - "Open the trac timeline view for the current svn repository." - (interactive) - (unless svn-trac-project-root - (svn-status-set-trac-project-root)) - (svn-browse-url (concat svn-trac-project-root "timeline"))) - -(defun svn-trac-browse-roadmap () - "Open the trac roadmap view for the current svn repository." - (interactive) - (unless svn-trac-project-root - (svn-status-set-trac-project-root)) - (svn-browse-url (concat svn-trac-project-root "roadmap"))) - -(defun svn-trac-browse-source () - "Open the trac source browser for the current svn repository." - (interactive) - (unless svn-trac-project-root - (svn-status-set-trac-project-root)) - (svn-browse-url (concat svn-trac-project-root "browser"))) - -(defun svn-trac-browse-report (arg) - "Open the trac report view for the current svn repository. -When called with a prefix argument, display the given report number." - (interactive "P") - (unless svn-trac-project-root - (svn-status-set-trac-project-root)) - (svn-browse-url (concat svn-trac-project-root "report" (if (numberp arg) (format "/%s" arg) "")))) - -(defun svn-trac-browse-changeset (changeset-nr) - "Show a changeset in the trac issue tracker." - (interactive (list (read-number "Browse changeset number: " (number-at-point)))) - (unless svn-trac-project-root - (svn-status-set-trac-project-root)) - (svn-browse-url (concat svn-trac-project-root "changeset/" (number-to-string changeset-nr)))) - -(defun svn-trac-browse-ticket (ticket-nr) - "Show a ticket in the trac issue tracker." - (interactive (list (read-number "Browse ticket number: " (number-at-point)))) - (unless svn-trac-project-root - (svn-status-set-trac-project-root)) - (svn-browse-url (concat svn-trac-project-root "ticket/" (number-to-string ticket-nr)))) - -;;;------------------------------------------------------------ -;;; resolve conflicts using ediff -;;;------------------------------------------------------------ -(defun svn-resolve-conflicts-ediff (&optional name-A name-B) - "Invoke ediff to resolve conflicts in the current buffer. -The conflicts must be marked with rcsmerge conflict markers." - (interactive) - (let* ((found nil) - (file-name (file-name-nondirectory buffer-file-name)) - (your-buffer (generate-new-buffer - (concat "*" file-name - " " (or name-A "WORKFILE") "*"))) - (other-buffer (generate-new-buffer - (concat "*" file-name - " " (or name-B "CHECKED-IN") "*"))) - (result-buffer (current-buffer))) - (save-excursion - (set-buffer your-buffer) - (erase-buffer) - (insert-buffer-substring result-buffer) - (goto-char (point-min)) - (while (re-search-forward "^<<<<<<< .\\(mine\\|working\\)\n" nil t) - (setq found t) - (replace-match "") - (if (not (re-search-forward "^=======\n" nil t)) - (error "Malformed conflict marker")) - (replace-match "") - (let ((start (point))) - (if (not (re-search-forward "^>>>>>>> .\\(r[0-9]+\\|merge.*\\)\n" nil t)) - (error "Malformed conflict marker")) - (delete-region start (point)))) - (if (not found) - (progn - (kill-buffer your-buffer) - (kill-buffer other-buffer) - (error "No conflict markers found"))) - (set-buffer other-buffer) - (erase-buffer) - (insert-buffer-substring result-buffer) - (goto-char (point-min)) - (while (re-search-forward "^<<<<<<< .\\(mine\\|working\\)\n" nil t) - (let ((start (match-beginning 0))) - (if (not (re-search-forward "^=======\n" nil t)) - (error "Malformed conflict marker")) - (delete-region start (point)) - (if (not (re-search-forward "^>>>>>>> .\\(r[0-9]+\\|merge.*\\)\n" nil t)) - (error "Malformed conflict marker")) - (replace-match ""))) - (let ((config (current-window-configuration)) - (ediff-default-variant 'default-B)) - - ;; Fire up ediff. - - (set-buffer (ediff-merge-buffers your-buffer other-buffer)) - - ;; Ediff is now set up, and we are in the control buffer. - ;; Do a few further adjustments and take precautions for exit. - - (make-local-variable 'svn-ediff-windows) - (setq svn-ediff-windows config) - (make-local-variable 'svn-ediff-result) - (setq svn-ediff-result result-buffer) - (make-local-variable 'ediff-quit-hook) - (setq ediff-quit-hook - (lambda () - (let ((buffer-A ediff-buffer-A) - (buffer-B ediff-buffer-B) - (buffer-C ediff-buffer-C) - (result svn-ediff-result) - (windows svn-ediff-windows)) - (ediff-cleanup-mess) - (set-buffer result) - (erase-buffer) - (insert-buffer-substring buffer-C) - (kill-buffer buffer-A) - (kill-buffer buffer-B) - (kill-buffer buffer-C) - (set-window-configuration windows) - (message "Conflict resolution finished; you may save the buffer")))) - (message "Please resolve conflicts now; exit ediff when done") - nil)))) - -(defun svn-resolve-conflicts (filename) - (let ((buff (find-file-noselect filename))) - (if buff - (progn (switch-to-buffer buff) - (svn-resolve-conflicts-ediff)) - (error "can not open file %s" filename)))) - -(defun svn-status-resolve-conflicts () - "Resolve conflict in the selected file" - (interactive) - (let ((file-info (svn-status-get-line-information))) - (or (and file-info - (= ?C (svn-status-line-info->filemark file-info)) - (svn-resolve-conflicts - (svn-status-line-info->full-path file-info))) - (error "can not resolve conflicts at this point")))) - - -;; -------------------------------------------------------------------------------- -;; Working with branches -;; -------------------------------------------------------------------------------- - -(defun svn-branch-select (&optional prompt) - "Select a branch interactively from `svn-status-branch-list'" - (interactive) - (unless prompt - (setq prompt "Select branch: ")) - (let* ((branch (funcall svn-status-completing-read-function prompt svn-status-branch-list)) - (directory) - (base-url)) - (when (string-match "#\\(1#\\)?\\(.+\\)" branch) - (setq directory (match-string 2 branch)) - (setq base-url (concat (svn-status-base-info->repository-root) "/" directory)) - (save-match-data - (svn-status-parse-info t)) - (if (eq (length (match-string 1 branch)) 0) - (setq branch base-url) - (let ((svn-status-branch-list (svn-status-ls base-url t))) - (setq branch (concat (svn-status-base-info->repository-root) "/" - directory "/" - (svn-branch-select (format "Select branch from '%s': " directory))))))) - branch)) - -(defun svn-branch-diff (branch1 branch2) - "Show the diff between two svn repository urls. -When called interactively, use `svn-branch-select' to choose two branches from `svn-status-branch-list'." - (interactive - (let* ((branch1 (svn-branch-select "svn diff branch1: ")) - (branch2 (svn-branch-select (format "svn diff %s against: " branch1)))) - (list branch1 branch2))) - (svn-run t t 'diff "diff" svn-status-default-diff-arguments branch1 branch2)) - -;; -------------------------------------------------------------------------------- -;; svnadmin interface -;; -------------------------------------------------------------------------------- -(defun svn-admin-create (dir) - "Run svnadmin create DIR." - (interactive (list (expand-file-name - (svn-read-directory-name "Create a svn repository at: " - svn-admin-default-create-directory nil nil)))) - (shell-command-to-string (concat "svnadmin create " dir)) - (setq svn-admin-last-repository-dir (concat "file://" dir)) - (message "Svn repository created at %s" dir) - (run-hooks 'svn-admin-create-hook)) - -;; - Import an empty directory -;; cd to an empty directory -;; svn import -m "Initial import" . file:///home/stefan/svn_repos/WaldiConfig/trunk -(defun svn-admin-create-trunk-directory () - "Import an empty trunk directory to `svn-admin-last-repository-dir'. -Set `svn-admin-last-repository-dir' to the new created trunk url." - (interactive) - (let ((empty-temp-dir-name (make-temp-name svn-status-temp-dir))) - (make-directory empty-temp-dir-name t) - (setq svn-admin-last-repository-dir (concat svn-admin-last-repository-dir "/trunk")) - (svn-run nil t 'import "import" "-m" "Created trunk directory" - empty-temp-dir-name svn-admin-last-repository-dir) - (delete-directory empty-temp-dir-name))) - -(defun svn-admin-start-import () - "Start to import the current working directory in a subversion repository. -The user is asked to perform the following two steps: -1. Create a local repository -2. Add a trunk directory to that repository - -After that step the empty base directory (either the root directory or -the trunk directory of the selected repository) is checked out in the current -working directory." - (interactive) - (if (y-or-n-p "Create local repository? ") - (progn - (call-interactively 'svn-admin-create) - (when (y-or-n-p "Add a trunk directory? ") - (svn-admin-create-trunk-directory))) - (setq svn-admin-last-repository-dir (read-string "Repository Url: "))) - (svn-checkout svn-admin-last-repository-dir ".")) - -(defun psvn-file-directory-p (dir) - (setq dir (expand-file-name dir)) - (if (file-directory-p dir) - t - (let* ((dir1 (directory-file-name (file-name-directory dir))) - (dir2 (directory-file-name (file-name-directory dir1)))) - (if (equal dir1 dir2) - nil - (psvn-file-directory-p (concat (file-name-as-directory dir2) ".svn")))))) - -(defun psvn-file-exists-p (dir) - (psvn-file-directory-p dir)) - - -;; -------------------------------------------------------------------------------- -;; svn status profiling -;; -------------------------------------------------------------------------------- -;;; Note about profiling psvn: -;; (load-library "elp") -;; M-x elp-reset-all -;; (elp-instrument-package "svn-") -;; M-x svn-status -;; M-x elp-results - -(defun svn-status-elp-init () - (interactive) - (require 'elp) - (elp-reset-all) - (elp-instrument-package "svn-") - (message "Run the desired svn command (e.g. M-x svn-status), then use M-x elp-results.")) - -(defun svn-status-last-commands (&optional string-prefix) - "Return a string with the last executed svn commands" - (interactive) - (unless string-prefix - (setq string-prefix "")) - (with-output-to-string - (dolist (e (ring-elements svn-last-cmd-ring)) - (princ (format "%s%s: svn %s <%s>\n" string-prefix (nth 0 e) (mapconcat 'concat (nth 1 e) " ") (nth 2 e))) - (when (nth 3 e) - (princ (format "%s<arg-file-content>\n" string-prefix)) - (princ (nth 3 e)) - (princ (format "%s</arg-file-content>\n" string-prefix)))))) - -;; -------------------------------------------------------------------------------- -;; reporting bugs -;; -------------------------------------------------------------------------------- -(defun svn-insert-indented-lines (text) - "Helper function to insert TEXT, indented by two characters." - (dolist (line (split-string text "\n")) - (insert (format " %s\n" line)))) - -(defun svn-prepare-bug-report () - "Create the buffer *psvn-bug-report*. This buffer can be useful to debug problems with psvn.el" - (interactive) - (let* ((last-output-buffer-name (or svn-status-last-output-buffer-name svn-process-buffer-name)) - (last-svn-cmd-output (with-current-buffer last-output-buffer-name - (buffer-substring-no-properties (point-min) (point-max))))) - (switch-to-buffer "*psvn-bug-report*") - (delete-region (point-min) (point-max)) - (insert "This buffer holds some debug informations for psvn.el\n") - (insert "Please enter a description of the observed and the wanted behaviour\n") - (insert "and send it to the author (stefan@xsteve.at) to allow easier debugging\n\n") - (insert "Revisions:\n") - (svn-insert-indented-lines (svn-status-version)) - (insert "Language environment:\n") - (dolist (elem (svn-process-environment)) - (when (member (car (split-string elem "=")) '("LC_MESSAGES" "LC_ALL" "LANG")) - (insert (format " %s\n" elem)))) - (when svn-process-handle-error-msg - (insert "\nsvn client error message:\n") - (svn-insert-indented-lines svn-process-handle-error-msg)) - (insert "\nLast svn commands:\n") - (svn-insert-indented-lines (svn-status-last-commands)) - (insert (format "\nContent of the <%s> buffer:\n" last-output-buffer-name)) - (svn-insert-indented-lines last-svn-cmd-output) - (goto-char (point-min)))) - -;; -------------------------------------------------------------------------------- -;; Make it easier to reload psvn, if a distribution has an older version -;; Just add the following to your .emacs: -;; (svn-prepare-for-reload) -;; (load "/path/to/psvn.el") - -;; Note the above will only work, if the loaded psvn.el has already the -;; function svn-prepare-for-reload -;; If this is not the case, do the following: -;; (load "/path/to/psvn.el");;make svn-prepare-for-reload available -;; (svn-prepare-for-reload) -;; (load "/path/to/psvn.el");; update the keybindings -;; -------------------------------------------------------------------------------- - -(defvar svn-prepare-for-reload-dont-touch-list '() "A list of variables that should not be touched by `svn-prepare-for-reload'") -(defvar svn-prepare-for-reload-variables-list '(svn-global-keymap svn-status-diff-mode-map svn-global-trac-map svn-status-mode-map - svn-status-mode-property-map svn-status-mode-extension-map - svn-status-mode-options-map svn-status-mode-trac-map svn-status-mode-branch-map - svn-log-edit-mode-map svn-log-view-mode-map - svn-log-view-popup-menu-map svn-info-mode-map svn-blame-mode-map svn-process-mode-map) - "A list of variables that should be set to nil via M-x `svn-prepare-for-reload'") -(defun svn-prepare-for-reload () - "This function resets some psvn.el variables to nil. -It makes reloading a newer version of psvn.el easier, if for example the used -GNU/Linux distribution uses an older version. - -The variables specified in `svn-prepare-for-reload-variables-list' will be reseted by this function. - -A variable will keep its value, if it is specified in `svn-prepare-for-reload-dont-touch-list'." - (interactive) - (dolist (var svn-prepare-for-reload-variables-list) - (unless (member var svn-prepare-for-reload-dont-touch-list) - (message (format "Resetting value of %s to nil" var))) - (set var nil))) - -(provide 'psvn) - -;; Local Variables: -;; indent-tabs-mode: nil -;; time-stamp-pattern: "300/(defconst svn-psvn-revision \"%:y-%02m-%02d, %02H:%02M:%02S\" \"The revision date of psvn.\")$" -;; End: -;;; psvn.el ends here diff --git a/emacs.d/site-lisp/window-numbering.el b/emacs.d/site-lisp/window-numbering.el deleted file mode 100644 index 702c334..0000000 --- a/emacs.d/site-lisp/window-numbering.el +++ /dev/null @@ -1,244 +0,0 @@ -;;; window-numbering.el --- Numbered window shortcuts -;; -;; Copyright (C) 2006-2007, 2013 Nikolaj Schumacher <bugs * nschum , de> -;; -;; Author: Nikolaj Schumacher <bugs * nschum de> -;; Version: 1.1.2 -;; Keywords: faces, matching -;; URL: http://nschum.de/src/emacs/window-numbering-mode/ -;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x, GNU Emacs 24.x -;; -;; This file is NOT part of GNU Emacs. -;; -;; This program 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 -;; of the License, or (at your option) any later version. -;; -;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>. -;; -;;; Commentary: -;; -;; Enable window-numbering-mode and use M-1 through M-0 to navigate. -;; -;; If you want to affect the numbers, use window-numbering-before-hook or -;; window-numbering-assign-func. -;; For instance, to always assign the calculator window the number 9, add the -;; following to your .emacs: -;; -;; (setq window-numbering-assign-func -;; (lambda () (when (equal (buffer-name) "*Calculator*") 9))) -;; -;;; Changes Log: -;; -;; 2013-03-23 (1.1.2) -;; Fix numbering in terminal mode with menu bar visible. -;; Add face for window number. (thanks to Chen Bin) -;; -;; 2008-04-11 (1.1.1) -;; Added possibility to delete window with prefix arg. -;; Cleaned up code and migrated to `defcustom'. -;; -;; 2007-02-18 (1.1) -;; Added window-numbering-before-hook, window-numbering-assign-func. -;; -;;; Code: - -(eval-when-compile (require 'cl)) - -(push "^No window numbered .$" debug-ignored-errors) - -(defgroup window-numbering nil - "Numbered window shortcuts" - :group 'convenience) - -(defcustom window-numbering-auto-assign-0-to-minibuffer t - "*If non-nil, `window-numbering-mode' assigns 0 to the minibuffer if active." - :group 'window-numbering - :type '(choice (const :tag "Off" nil) - (const :tag "On" t))) - -(defcustom window-numbering-before-hook nil - "*Hook called before `window-numbering-mode' starts assigning numbers. -The number of windows that will be numbered is passed as a parameter. -Use `window-numbering-assign' to manually assign some of them a number. -If you want to assign a number to just one buffer, use -`window-numbering-assign-func' instead." - :group 'window-numbering - :type 'hook) - -(defcustom window-numbering-assign-func nil - "*Function called for each window by `window-numbering-mode'. -This is called before automatic assignment begins. The function should -return a number to have it assigned to the current-window, nil otherwise." - :group 'window-numbering - :type 'function) - -(defconst window-numbering-mode-line-position 1 - "The position in the mode-line `window-numbering-mode' displays the number.") - -(defface window-numbering-face '() - "Face used for the number in the mode-line." - :group 'window-numbering) - -(defvar window-numbering-table nil - "table -> (window vector . number table)") - -(defun select-window-by-number (i &optional arg) - "Select window given number I by `window-numbering-mode'. -If prefix ARG is given, delete the window instead of selecting it." - (interactive "P") - (let ((windows (car (gethash (selected-frame) window-numbering-table))) - window) - (if (and (>= i 0) (< i 10) - (setq window (aref windows i))) - (if arg - (delete-window window) - (select-window window)) - (error "No window numbered %s" i)))) - -;; define interactive functions for keymap -(dotimes (i 10) - (eval `(defun ,(intern (format "select-window-%s" i)) (&optional arg) - ,(format "Select the window with number %i." i) - (interactive "P") - (select-window-by-number ,i arg)))) - -(defun window-numbering-calculate-left (windows) - (let ((i 9) left) - (while (>= i 0) - (let ((window (aref windows i))) - (unless window - (push (% (1+ i) 10) left))) - (decf i)) - left)) - -(defvar window-numbering-windows nil - "A vector listing the window for each number.") -(defvar window-numbering-numbers - "A hash map containing each window's number.") -(defvar window-numbering-left - "A list of unused window numbers.") - -(defun window-numbering-assign (window &optional number) - (if number - (if (aref window-numbering-windows number) - (progn (message "Number %s assigned to two buffers (%s and %s)" - number window (aref window-numbering-windows number)) - nil) - (setf (aref window-numbering-windows number) window) - (puthash window number window-numbering-numbers) - (setq window-numbering-left (delq number window-numbering-left)) - t) - ;; else default adding - (when window-numbering-left - (unless (gethash window window-numbering-numbers) - (let ((number (car window-numbering-left))) - (window-numbering-assign window number) - number))))) - -(defun window-numbering-update () - "Update the window numbering for the current frame. -Optional parameter PREASSIGNED-WINDOWS is a hashmap already mapping some -windows to numbers." - (setq window-numbering-windows (make-vector 10 nil) - window-numbering-numbers (make-hash-table :size 10) - window-numbering-left - (window-numbering-calculate-left window-numbering-windows)) - (puthash (selected-frame) - (cons window-numbering-windows window-numbering-numbers) - window-numbering-table) - (when (and window-numbering-auto-assign-0-to-minibuffer - (active-minibuffer-window)) - (window-numbering-assign (active-minibuffer-window) 0)) - (let ((windows (window-list nil 0 (frame-first-window)))) - (run-hook-with-args 'window-numbering-before-hook windows) - (when window-numbering-assign-func - (mapc `(lambda (window) - (with-selected-window window - (with-current-buffer (window-buffer window) - (let ((num (funcall ,window-numbering-assign-func))) - (when num - (window-numbering-assign window num)))))) - windows)) - (dolist (window windows) - (window-numbering-assign window)))) - -(defun window-numbering-get-number-string (&optional window) - (let ((s (int-to-string (window-numbering-get-number window)))) - (propertize s 'face 'window-numbering-face))) - -(defun window-numbering-get-number (&optional window) - (gethash (or window (selected-window)) - (cdr (gethash (selected-frame) window-numbering-table)))) - -(defvar window-numbering-keymap - (let ((map (make-sparse-keymap))) - (define-key map "\M-0" 'select-window-0) - (define-key map "\M-1" 'select-window-1) - (define-key map "\M-2" 'select-window-2) - (define-key map "\M-3" 'select-window-3) - (define-key map "\M-4" 'select-window-4) - (define-key map "\M-5" 'select-window-5) - (define-key map "\M-6" 'select-window-6) - (define-key map "\M-7" 'select-window-7) - (define-key map "\M-8" 'select-window-8) - (define-key map "\M-9" 'select-window-9) - map) - "Keymap used in by `window-numbering-mode'.") - -;;;###autoload -(define-minor-mode window-numbering-mode - "A minor mode that assigns a number to each window." - nil nil window-numbering-keymap :global t - (if window-numbering-mode - (unless window-numbering-table - (save-excursion - (setq window-numbering-table (make-hash-table :size 16)) - (window-numbering-install-mode-line) - (add-hook 'window-configuration-change-hook - 'window-numbering-update) - (dolist (frame (frame-list)) - (select-frame frame) - (window-numbering-update)))) - (window-numbering-clear-mode-line) - (remove-hook 'window-configuration-change-hook - 'window-numbering-update) - (setq window-numbering-table nil))) - -(defun window-numbering-install-mode-line (&optional position) - "Install the window number from `window-numbering-mode' to the mode-line." - (let ((mode-line (default-value 'mode-line-format)) - (res)) - (dotimes (i (min (or position window-numbering-mode-line-position) - (length mode-line))) - (push (car mode-line) res) - (pop mode-line)) - (push '(:eval (window-numbering-get-number-string)) res) - (while mode-line - (push (car mode-line) res) - (pop mode-line)) - (setq-default mode-line-format (nreverse res))) - (force-mode-line-update t)) - -(defun window-numbering-clear-mode-line () - "Remove the window number of `window-numbering-mode' from the mode-line." - (let ((mode-line (default-value 'mode-line-format)) - (res)) - (while mode-line - (let ((item (car mode-line))) - (unless (equal item '(:eval (window-numbering-get-number-string))) - (push item res))) - (pop mode-line)) - (setq-default mode-line-format (nreverse res))) - (force-mode-line-update t)) - -(provide 'window-numbering) - -;;; window-numbering.el ends here |