diff --git a/psvn.el b/psvn.el index 8993276..351e9b5 100644 --- a/psvn.el +++ b/psvn.el @@ -1,8 +1,8 @@ ;;; psvn.el --- Subversion interface for emacs -;; Copyright (C) 2002-2004 by Stefan Reichoer +;; Copyright (C) 2002-2005 by Stefan Reichoer ;; Author: Stefan Reichoer, -;; $Id: psvn.el 11062 2004-09-21 20:12:42Z xsteve $ +;; $Id: psvn.el 16070 2005-09-05 19:40:02Z xsteve $ ;; psvn.el is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -22,24 +22,27 @@ ;;; Commentary ;; psvn.el is tested with GNU Emacs 21.3 on windows, debian linux, -;; freebsd5 with svn 1.05 +;; freebsd5, red hat el3 with svn 1.1.1 ;; psvn.el is an interface for the revision control tool subversion ;; (see http://subversion.tigris.org) ;; psvn.el provides a similar interface for subversion as pcl-cvs for cvs. ;; At the moment the following commands are implemented: ;; M-x svn-status: run 'svn -status -v' -;; and show the result in the *svn-status* buffer. This buffer uses -;; svn-status mode in which the following keys are defined: +;; 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' -;; V - svn-status-resolved run 'svn resolved' +;; X v - svn-status-resolved run 'svn resolved' ;; U - svn-status-update-cmd run 'svn update' -;; c - svn-status-commit-file run 'svn commit' +;; 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' @@ -51,6 +54,7 @@ ;; ^ - svn-status-examine-parent ;; ~ - svn-status-get-specific-revision ;; E - svn-status-ediff-with-revision +;; X X - svn-status-resolve-conflicts ;; s - svn-status-show-process-buffer ;; e - svn-status-toggle-edit-cmd-flag ;; ? - svn-status-toggle-hide-unknown @@ -58,16 +62,20 @@ ;; m - svn-status-set-user-mark ;; u - svn-status-unset-user-mark ;; $ - svn-status-toggle-elide +;; w - svn-status-copy-filename-as-kill ;; DEL - svn-status-unset-user-mark-backwards ;; * ! - svn-status-unset-all-usermarks ;; * ? - svn-status-mark-unknown ;; * A - svn-status-mark-added ;; * M - svn-status-mark-modified +;; * D - svn-status-mark-deleted +;; * * - svn-status-mark-changed ;; . - svn-status-goto-root-or-return ;; f - svn-status-find-file ;; o - svn-status-find-file-other-window ;; v - svn-status-view-file-other-window ;; I - svn-status-parse-info +;; V - svn-status-svnversion ;; P l - svn-status-property-list ;; P s - svn-status-property-set ;; P d - svn-status-property-delete @@ -77,9 +85,26 @@ ;; P C-i - svn-status-property-edit-svn-ignore ;; P k - svn-status-property-set-keyword-list ;; P y - svn-status-property-set-eol-style +;; P x - svn-status-property-set-executable ;; h - svn-status-use-history ;; q - svn-status-bury-buffer +;; C-x C-j - svn-status-dired-jump + +;; The output in the buffer contains this header to ease reading +;; of svn output: +;; FPH BASE CMTD Author em File +;; F = Filemark +;; P = Property mark +;; H = History mark +;; BASE = local base revision +;; CMTD = last committed revision +;; Author = author of change +;; em = "**" or "(Update Available)" [see `svn-status-short-mod-flag-p'] +;; if file can be updated +;; File = path/filename +;; + ;; To use psvn.el put the following line in your .emacs: ;; (require 'psvn) ;; Start the svn interface with M-x svn-status @@ -100,9 +125,6 @@ ;; unfortunately `read-directory-name' doesn't exist in Emacs 21.3 ;; * Add repository browser ;; * Improve support for svn blame -;; * Support for editing the log file entries, e.g.: -;; svn propedit --revprop -r9821 svn:log -;; * Better logview mode (allow to show the changeset for a given entry) ;; Overview over the implemented/not (yet) implemented svn sub-commands: ;; * add implemented @@ -142,13 +164,20 @@ ;;; Code: +(require 'easymenu) + ;;; user setable variables +(defvar svn-status-verbose t "*Add '-v' to svn status call.") (defvar svn-log-edit-file-name "++svn-log++" "*Name of a saved log file.") (defvar svn-log-edit-insert-files-to-commit t "*Insert the filelist to commit in the *svn-log* buffer") -(defvar svn-status-hide-unknown nil "*Hide unknown files in *svn-status* buffer.") -(defvar svn-status-hide-unmodified nil "*Hide unmodified files in *svn-status* buffer.") -(defvar svn-status-directory-history nil "*List of visited svn working directories.") -(defvar svn-status-sort-status-buffer t "Sort the *svn-status* buffer. +(defvar 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") +(defvar svn-status-hide-unknown nil + "*Hide unknown files in `svn-status-buffer-name' buffer. +This can be toggled with \[svn-status-toggle-hide-unknown].") +(defvar svn-status-hide-unmodified nil + "*Hide unmodified files in `svn-status-buffer-name' buffer. +This can be toggled with \[svn-status-toggle-hide-unmodified].") +(defvar svn-status-sort-status-buffer t "Sort the `svn-status-buffer-name' buffer. Setting this variable to nil speeds up M-x svn-status. However, it is possible, that the sorting is wrong in this case.") @@ -156,18 +185,100 @@ However, it is possible, that the sorting is wrong in this case.") "*List of operations after which all user marks will be removed. Possible values are: commit, revert.") +(defvar svn-status-negate-meaning-of-arg-commands nil + "*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'.") + +(defvar svn-status-svn-executable "svn" "*The name of the svn executable.") + +;; TODO: bind `process-environment' instead of running env? +;; That would probably work more reliably in Windows. +(defvar svn-status-svn-environment-var-list nil + "*A list of environment variables that should be set for that svn process. +If you set that variable, svn is called with that environment variables set. +That is done via the env program. + +You could set it for example to '(\"LANG=C\")") + +(defvar 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.") + +(defvar svn-status-window-alist + '((diff "*svn-diff*") (log "*svn-log*") (info t) (blame t) (proplist t) (update t)) + "An alist to specify which windows should be used for svn command outputs. +The following keys are supported: diff, log, info, blame, proplist, update. +The following values can be given: +nil ... show in *svn-process* buffer +t ... show in dedicated *svn-info* buffer +invisible ... don't show the buffer (eventually useful for update) +a string ... show in a buffer named string") + +(defvar 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") + +(defvar svn-status-debug-level 0 "The psvn.el debugging verbosity level. +The higher the number, the more debug messages are shown. + +See `svn-status-message' for the meaning of values for that variable.") + +(defvar svn-status-buffer-name "*svn-status*" "Name for the svn status buffer") + +(defvar svn-status-use-header-line t + "*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") + ;;; default arguments to pass to svn commands (defvar svn-status-default-log-arguments "" "*Arguments to pass to svn log. \(used in `svn-status-show-svn-log'; override these by giving prefixes\).") +(defvar svn-status-default-diff-arguments nil + "*A list of arguments that is passed to the svn diff command. + If you'd like to supress whitespace changes use the following value: + '(\"--diff-cmd\" \"diff\" \"-x\" \"-wbBu\")") + +(defvar svn-trac-project-root nil "Path for an eventual existing trac issue tracker.") + +(defvar svn-status-module-name nil "A nice short name for the actual project.") + +(defvar svn-status-load-state-before-svn-status t "Load the ++psvn.state file, before running svn-status") + ;;; hooks (defvar svn-log-edit-mode-hook nil "Hook run when entering `svn-log-edit-mode'.") +(defvar svn-log-edit-done-hook nil "Hook run after commiting files via svn.") + +(defvar svn-status-coding-system nil + "A special coding system is needed for the output of svn. +svn-status-coding-system is used in svn-run-svn, if it is not nil.") (defvar svn-status-wash-control-M-in-process-buffers (eq system-type 'windows-nt) "*Remove any trailing ^M from the *svn-process* buffer.") +;;; experimental features +(defvar svn-status-track-user-input nil "Track user/password queries. +This feature is implemented via a process filter. +It is an experimental feature.") + ;;; Customize group (defgroup psvn nil "Subversion interface for Emacs." @@ -185,19 +296,41 @@ Possible values are: commit, revert.") (require 'overlay) (require 'overlay nil t))) +(defcustom svn-status-display-full-path nil + "Specifies how the filenames look like in the listing. +If t, their full path name will be displayed, else only the filename." + :type 'boolean + :group 'psvn) + +(defcustom svn-status-prefix-key [(control x) (meta s)] + "Prefix key for the psvn commands in the global keymap." + :type '(choice (const [(control x) ?v ?S]) + (const [(super s)]) + (const [(hyper s)]) + (const [(control x) ?v]) + (const [(control x) ?V]) + (sexp)) + :group 'psvn + :set (lambda (var value) + (if (boundp var) + (global-unset-key (symbol-value var))) + (set var value) + (global-set-key (symbol-value var) 'svn-global-keymap))) + ;; Use the normally used mode for files ending in .~HEAD~, .~BASE~, ... (add-to-list 'auto-mode-alist '("\\.~?\\(HEAD\\|BASE\\|PREV\\)~?\\'" ignore t)) ;;; internal variables +(defvar svn-status-directory-history nil "List of visited svn working directories.") (defvar svn-process-cmd nil) (defvar svn-status-info nil) +(defvar svn-status-filename-to-buffer-position-cache (make-hash-table :test 'equal :weakness t)) (defvar svn-status-base-info nil) (defvar svn-status-initial-window-configuration nil) (defvar svn-status-default-column 23) (defvar svn-status-default-revision-width 4) (defvar svn-status-default-author-width 9) -(defvar svn-status-line-format " %c%c %4s %4s %-9s") -(defvar svn-status-short-mod-flag-p t) +(defvar svn-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) (defvar svn-status-pre-commit-window-configuration nil) @@ -213,14 +346,27 @@ Possible values are: commit, revert.") (defvar svn-status-edit-svn-command nil) (defvar svn-status-update-previous-process-output nil) (defvar svn-status-temp-dir - (or - (when (boundp 'temporary-file-directory) temporary-file-directory) ;emacs - (when (boundp 'temp-directory) temp-directory) ;xemacs - "/tmp/")) + (expand-file-name + (or + (when (boundp 'temporary-file-directory) temporary-file-directory) ;emacs + (when (fboundp 'temp-directory) (temp-directory)) ;xemacs + "/tmp/")) "The directory that is used to store temporary files for psvn.") (defvar svn-temp-suffix (make-temp-name ".")) (defvar svn-status-temp-file-to-remove nil) (defvar svn-status-temp-arg-file (concat svn-status-temp-dir "svn.arg" svn-temp-suffix)) (defvar svn-status-options nil) +(defvar svn-status-commit-rev-number nil) +(defvar svn-status-operated-on-dot nil) +(defvar svn-status-elided-list nil) +(defvar svn-status-custom-hide-function nil) + +;; That is an example for the svn-status-custom-hide-function: +;; (setq svn-status-custom-hide-function 'svn-status-hide-pyc-files) +;; (defun svn-status-hide-pyc-files (info) +;; "Hide all pyc files in the `svn-status-buffer-name' buffer." +;; (let* ((fname (svn-status-line-info->filename-nondirectory info)) +;; (fname-len (length fname))) +;; (and (> fname-len 4) (string= (substring fname (- fname-len 4)) ".pyc")))) ;;; faces (defface svn-status-marked-face @@ -231,12 +377,24 @@ Possible values are: commit, revert.") "Face to highlight the mark for user marked files in svn status buffers." :group 'psvn-faces) -(defface svn-status-modified-external-face +(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 to highlight the phrase \"externally modified\" in *svn-status* buffers." + "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 @@ -257,17 +415,41 @@ See `svn-status--line-info->directory-p' for what counts as a directory." See `svn-status--line-info->directory-p' for what counts as a directory." :group 'psvn-faces) +;based on font-lock-warning-face +(defface svn-status-locked-face + '((t + (:weight bold :foreground "Red"))) + "Face for the phrase \"[ LOCKED ]\" `svn-status-buffer-name' buffers." + :group 'psvn-faces) + +;based on vhdl-font-lock-directive-face +(defface svn-status-switched-face + '((((class color) + (background light)) + (:foreground "CadetBlue")) + (((class color) + (background dark)) + (:foreground "Aquamarine")) + (t + (:bold t :italic t))) + "Face for the phrase \"(switched)\" non-directories in svn status buffers." + :group 'psvn-faces) + (defvar svn-highlight t) ;; stolen from PCL-CVS (defun svn-add-face (str face &optional keymap) + "Return string STR decorated with the specified FACE. +If `svn-highlight' is nil then just return STR." (when svn-highlight ;; Do not use `list*'; cl.el might not have been loaded. We could ;; put (require 'cl) at the top but let's try to manage without. (add-text-properties 0 (length str) `(face ,face - ,@(when keymap - `(mouse-face highlight - local-map ,keymap))) + 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) @@ -284,6 +466,13 @@ Else return TEXT unchanged." (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 (unless (fboundp 'point-at-eol) (defalias 'point-at-eol 'line-end-position)) @@ -296,13 +485,67 @@ Else return TEXT unchanged." (if (not (fboundp 'puthash)) (defalias 'puthash 'cl-puthash)) +; xemacs +(if (fboundp 'match-string-no-properties) + nil ;; great + (defsubst match-string-no-properties (match) + (buffer-substring-no-properties (match-beginning match) (match-end match)))) + +(defvar svn-global-keymap nil "Global keymap for psvn.el. +To bind this to a different key, customize `svn-status-prefix-key'.") +(when (not svn-global-keymap) + (setq svn-global-keymap (make-sparse-keymap)) + (define-key svn-global-keymap (kbd "s") 'svn-status-this-directory) + (define-key svn-global-keymap (kbd "l") 'svn-status-show-svn-log) + (define-key svn-global-keymap (kbd "u") 'svn-status-update-cmd) + (define-key svn-global-keymap (kbd "=") 'svn-status-show-svn-diff) + (define-key svn-global-keymap (kbd "c") 'svn-status-commit)) + +(defvar svn-global-trac-map () + "Subkeymap used in `svn-global-keymap' for trac issue tracker commands.") +(when (not svn-global-trac-map) + (setq svn-global-trac-map (make-sparse-keymap)) + (define-key svn-global-trac-map (kbd "t") 'svn-trac-browse-timeline) + (define-key svn-global-trac-map (kbd "i") 'svn-trac-browse-ticket) + (define-key svn-global-trac-map (kbd "c") 'svn-trac-browse-changeset) + (define-key svn-global-keymap (kbd "t") svn-global-trac-map)) + +;; The setter of `svn-status-prefix-key' makes a binding in the global +;; map refer to the `svn-global-keymap' symbol, rather than directly +;; to the keymap. Emacs then implicitly uses the symbol-function. +;; This has the advantage that `describe-bindings' (C-h b) can show +;; the name of the keymap and link to its documentation. +(defalias 'svn-global-keymap svn-global-keymap) +;; `defalias' of GNU Emacs 21.4 doesn't allow a docstring argument. +(put 'svn-global-keymap 'function-documentation + '(documentation-property 'svn-global-keymap 'variable-documentation t)) + + +(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)) + (defvar svn-status-display-new-status-buffer nil) ;;;###autoload (defun svn-status (dir &optional arg) "Examine the status of Subversion working copy in directory DIR. If ARG then pass the -u argument to `svn status'." (interactive (list (read-directory-name "SVN status directory: " - nil default-directory nil))) + nil default-directory nil) + current-prefix-arg)) + (setq arg (svn-status-possibly-negate-meaning-of-arg arg 'svn-status)) (unless (file-directory-p dir) (error "%s is not a directory" dir)) (if (not (file-exists-p (concat dir "/.svn/"))) @@ -312,23 +555,33 @@ If ARG then pass the -u argument to `svn status'." "Run dired instead? ")) (dired dir)) (setq dir (file-name-as-directory dir)) + (when svn-status-load-state-before-svn-status + (unless (string= dir (car svn-status-directory-history)) + (svn-status-load-state t))) (setq svn-status-directory-history (delete dir svn-status-directory-history)) (add-to-list 'svn-status-directory-history dir) - (if (string= (buffer-name) "*svn-status*") + (if (string= (buffer-name) svn-status-buffer-name) (setq svn-status-display-new-status-buffer nil) (setq svn-status-display-new-status-buffer t) ;;(message "psvn: Saving initial window configuration") (setq svn-status-initial-window-configuration (current-window-configuration))) - (let* ((status-buf (get-buffer-create "*svn-status*")) - (proc-buf (get-buffer-create "*svn-process*"))) + (let* ((status-buf (get-buffer-create svn-status-buffer-name)) + (proc-buf (get-buffer-create "*svn-process*")) + (status-option (if svn-status-verbose + (if arg "-uv" "-v") + (if arg "-u" "")))) (save-excursion (set-buffer status-buf) (setq default-directory dir) (set-buffer proc-buf) - (setq default-directory dir) - (if arg - (svn-run-svn t t 'status "status" "-vu") - (svn-run-svn t t 'status "status" "-v")))))) + (setq default-directory dir + svn-status-remote (when arg t)) + (svn-run-svn t t 'status "status" status-option))))) + +(defun svn-status-this-directory (arg) + "Run `svn-status' for the `default-directory'" + (interactive "P") + (svn-status default-directory arg)) (defun svn-status-use-history () (interactive) @@ -336,8 +589,9 @@ If ARG then pass the -u argument to `svn status'." (dir (read-from-minibuffer "svn-status on directory: " (cadr svn-status-directory-history) nil nil 'hist))) - (when (file-directory-p dir) - (svn-status dir)))) + (if (file-directory-p dir) + (svn-status dir) + (error "%s is not a directory" dir)))) (defun svn-run-svn (run-asynchron clear-process-buffer cmdtype &rest arglist) "Run svn with arguments ARGLIST. @@ -351,23 +605,32 @@ 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\"\)" +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 +is prompted for give extra arguments, which are appended to ARGLIST." + (setq arglist (svn-status-flatten-list arglist)) (if (eq (process-status "svn") nil) (progn (when svn-status-edit-svn-command (setq arglist (append arglist (split-string (read-from-minibuffer - (format "svn %s %S " cmdtype arglist))))) + (format "Run `svn %s' with extra arguments: " + (mapconcat 'identity arglist " ")))))) (when (eq svn-status-edit-svn-command t) (svn-status-toggle-edit-cmd-flag t)) (message "svn-run-svn %s: %S" cmdtype arglist)) (let* ((proc-buf (get-buffer-create "*svn-process*")) + (svn-exe svn-status-svn-executable) (svn-proc)) (when (listp (car arglist)) (setq arglist (car arglist))) (save-excursion (set-buffer proc-buf) + (when svn-status-coding-system + (setq buffer-file-coding-system svn-status-coding-system)) (setq buffer-read-only nil) (fundamental-mode) (if clear-process-buffer @@ -377,16 +640,32 @@ for example: '(\"revert\" \"file1\"\)" (setq svn-status-mode-line-process-status (format " running %s" cmdtype)) (svn-status-update-mode-line) (sit-for 0.1) + (when svn-status-svn-environment-var-list + (setq arglist (append svn-status-svn-environment-var-list + (list svn-status-svn-executable) + arglist)) + (setq svn-exe "env")) (if run-asynchron (progn - (setq svn-proc (apply 'start-process "svn" proc-buf "svn" arglist)) - (set-process-sentinel svn-proc 'svn-process-sentinel)) - ;;(message "running synchron: svn %S" arglist) - (apply 'call-process "svn" nil proc-buf nil arglist) + ;;(message "running asynchron: %s %S" svn-exe arglist) + (setq svn-proc (apply 'start-process "svn" proc-buf svn-exe arglist)) + (set-process-sentinel svn-proc 'svn-process-sentinel) + (when svn-status-track-user-input + (set-process-filter svn-proc 'svn-process-filter))) + ;;(message "running synchron: %s %S" svn-exe arglist) + (apply 'call-process svn-exe nil proc-buf nil arglist) (setq svn-status-mode-line-process-status "") (svn-status-update-mode-line))))) (error "You can only run one svn process at once!"))) +(defun svn-process-sentinel-fixup-path-seperators() + (when (eq system-type 'windows-nt) + ;; convert path separator to UNIX style + (save-excursion + (goto-char (point-min)) + (while (search-forward "\\" nil t) + (replace-match "/"))))) + (defun svn-process-sentinel (process event) ;;(princ (format "Process: %s had the event `%s'" process event))) ;;(save-excursion @@ -397,12 +676,7 @@ for example: '(\"revert\" \"file1\"\)" (cond ((string= event "finished\n") (cond ((eq svn-process-cmd 'status) ;;(message "svn status finished") - (if (eq system-type 'windows-nt) - ;; convert path separator as UNIX style - (save-excursion - (goto-char (point-min)) - (while (search-forward "\\" nil t) - (replace-match "/")))) + (svn-process-sentinel-fixup-path-seperators) (svn-parse-status-result) (set-buffer act-buf) (svn-status-update-buffer) @@ -415,40 +689,37 @@ for example: '(\"revert\" \"file1\"\)" (setq svn-status-update-previous-process-output nil)) (when svn-status-display-new-status-buffer (set-window-configuration svn-status-initial-window-configuration) - (switch-to-buffer "*svn-status*"))) + (switch-to-buffer svn-status-buffer-name))) ((eq svn-process-cmd 'log) - (svn-status-show-process-buffer-internal t) - (pop-to-buffer "*svn-process*") - (switch-to-buffer (get-buffer-create "*svn-log*")) - (let ((buffer-read-only nil)) - (delete-region (point-min) (point-max)) - (insert-buffer-substring "*svn-process*")) + (svn-status-show-process-output 'log t) + (pop-to-buffer svn-status-last-output-buffer-name) (svn-log-view-mode) - (goto-char (point-min)) (forward-line 3) (font-lock-fontify-buffer) (message "svn log finished")) ((eq svn-process-cmd 'info) - (svn-status-show-process-buffer-internal t) + (svn-status-show-process-output 'info t) (message "svn info finished")) ((eq svn-process-cmd 'parse-info) (svn-status-parse-info-result)) ((eq svn-process-cmd 'blame) - (svn-status-show-process-buffer-internal t) + (svn-status-show-process-output 'blame t) (message "svn blame finished")) ((eq svn-process-cmd 'commit) + (svn-process-sentinel-fixup-path-seperators) (svn-status-remove-temp-file-maybe) - (svn-status-show-process-buffer-internal t) (when (member 'commit svn-status-unmark-files-after-list) (svn-status-unset-all-usermarks)) - (svn-status-update) + (svn-status-update-with-command-list (svn-status-parse-commit-output)) + (run-hooks 'svn-log-edit-done-hook) + (setq svn-status-files-to-commit nil) (message "svn commit finished")) ((eq svn-process-cmd 'update) - (svn-status-show-process-buffer-internal t) + (svn-status-show-process-output 'update t) (svn-status-update) (message "svn update finished")) ((eq svn-process-cmd 'add) - (svn-status-update) + (svn-status-update-with-command-list (svn-status-parse-ar-output)) (message "svn add finished")) ((eq svn-process-cmd 'mkdir) (svn-status-update) @@ -465,12 +736,12 @@ for example: '(\"revert\" \"file1\"\)" (svn-status-update) (message "svn mv finished")) ((eq svn-process-cmd 'rm) - (svn-status-update) + (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-buffer-internal t) + (svn-status-show-process-output 'proplist t) (message "svn proplist finished")) ((eq svn-process-cmd 'proplist-parse) (svn-status-property-parse-property-names)) @@ -491,7 +762,24 @@ for example: '(\"revert\" \"file1\"\)" event))) (t (message "svn process had unknown event: %s" event)) - (svn-status-show-process-buffer-internal t)))) + (svn-status-show-process-output nil t)))) + +(defun svn-process-filter (process str) + (save-window-excursion + (set-buffer "*svn-process*") + ;;(message "svn-process-filter: %s" str) + (goto-char (point-max)) + (insert str) + (save-excursion + (goto-char (line-beginning-position)) + (when (looking-at "Password for '\\(.+\\)': ") + ;(svn-status-show-process-buffer) + (let ((passwd (read-passwd + (format "Enter svn password for %s: " (match-string 1))))) + (svn-process-send-string (concat passwd "\n") t))) + (when (looking-at "Username: ") + (let ((user-name (read-string "Username for svn operation: "))) + (svn-process-send-string (concat user-name "\n"))))))) (defun svn-parse-rev-num (str) (if (and str (stringp str) @@ -500,6 +788,14 @@ for example: '(\"revert\" \"file1\"\)" -1)) +(defun svn-status-make-dummy-dirs (dir-list old-ui-information) + (append (mapcar (lambda (dir) + (list (or (gethash dir old-ui-information) (list nil nil)) + 32 nil dir -1 -1 "?" nil nil nil nil)) + dir-list) + svn-status-info)) + + (defun svn-parse-status-result () "Parse the *svn-process* buffer. The results are used to build the `svn-status-info' variable." @@ -511,15 +807,22 @@ The results are used to build the `svn-status-info' variable." (svn-marks) (svn-file-mark) (svn-property-mark) + (svn-locked-mark) + (svn-with-history-mark) + (svn-switched-mark) (svn-update-mark) (local-rev) (last-change-rev) (author) (path) + (dir) (user-elide nil) (ui-status '(nil nil)) ; contains (user-mark user-elide) (revision-width svn-status-default-revision-width) - (author-width svn-status-default-author-width)) + (author-width svn-status-default-author-width) + (svn-marks-length (if (and svn-status-verbose svn-status-remote) + 8 5)) + (dir-set '("."))) (set-buffer "*svn-process*") (setq svn-status-info nil) (goto-char (point-min)) @@ -531,31 +834,40 @@ The results are used to build the `svn-status-info' variable." ;; 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 '\(.*\)'") + ((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) ) (t - (setq svn-marks (buffer-substring (point) (+ (point) 8)) - svn-file-mark (elt svn-marks 0) ; 1st column - svn-property-mark (elt svn-marks 1) ; 2nd column - ;;svn-locked-mark (elt svn-marks 2) ; 3rd column - ;;svn-added-with-history-mark (elt svn-marks 3); 4th column - ;;svn-switched-mark (elt svn-marks 4) ; 5th column - svn-update-mark (elt svn-marks 7)) ; 8th column - - (when (eq svn-property-mark ?\ ) (setq svn-property-mark nil)) - (when (eq svn-update-mark ?\ ) (setq svn-update-mark nil)) - (forward-char 8) + (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-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 or blank + (if (and svn-status-verbose 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-locked-mark ?\ ) (setq svn-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)) + (forward-char svn-marks-length) (skip-chars-forward " ") (cond - ((looking-at "\\([-?]\\|[0-9]+\\) +\\([-?]\\|[0-9]+\\) +\\([^ ]+\\) *\\(.+\\)") + ((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 @@ -564,6 +876,11 @@ The results are used to build the `svn-status-info' variable." (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))))) (setq ui-status (or (gethash path old-ui-information) (list user-mark user-elide))) (setq svn-status-info (cons (list ui-status svn-file-mark @@ -572,29 +889,34 @@ The results are used to build the `svn-status-info' variable." local-rev last-change-rev author - svn-update-mark) + svn-update-mark + svn-locked-mark + svn-with-history-mark + svn-switched-mark) svn-status-info)) (setq revision-width (max revision-width (length (number-to-string local-rev)) (length (number-to-string last-change-rev)))) (setq author-width (max author-width (length author))))) (forward-line 1)) - ;; With subversion 0.29.0 and above, `svn -u st' returns files in - ;; a random order (especially if we have a mixed revision wc) + (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 %%%ds %%%ds %%-%ds" + (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. + "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) "/"))) @@ -628,12 +950,17 @@ A and B must be line-info's." "Subkeymap used in `svn-status-mode' for property commands.") (defvar svn-status-mode-options-map () "Subkeymap used in `svn-status-mode' for option commands.") +(defvar svn-status-mode-trac-map () + "Subkeymap used in `svn-status-mode' for trac issue tracker commands.") +(defvar svn-status-mode-extension-map () + "Subkeymap used in `svn-status-mode' for some seldom used commands.") (when (not svn-status-mode-map) (setq svn-status-mode-map (make-sparse-keymap)) (suppress-keymap svn-status-mode-map) ;; Don't use (kbd ""); it's unreachable with GNU Emacs 21.3 on a TTY. (define-key svn-status-mode-map (kbd "RET") 'svn-status-find-file-or-examine-directory) + (define-key svn-status-mode-map (kbd "") 'svn-status-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 "f") 'svn-status-find-files) @@ -641,6 +968,7 @@ A and B must be line-info's." (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 "h") 'svn-status-use-history) (define-key svn-status-mode-map (kbd "m") 'svn-status-set-user-mark) @@ -668,8 +996,10 @@ A and B must be line-info's." (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-filename-as-kill) (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 "a") 'svn-status-add-file) @@ -677,7 +1007,7 @@ A and B must be line-info's." (define-key svn-status-mode-map (kbd "+") 'svn-status-make-directory) (define-key svn-status-mode-map (kbd "R") 'svn-status-mv) (define-key svn-status-mode-map (kbd "D") 'svn-status-rm) - (define-key svn-status-mode-map (kbd "c") 'svn-status-commit-file) + (define-key svn-status-mode-map (kbd "c") 'svn-status-commit) (define-key svn-status-mode-map (kbd "M-c") 'svn-status-cleanup) (define-key svn-status-mode-map (kbd "U") 'svn-status-update-cmd) (define-key svn-status-mode-map (kbd "r") 'svn-status-revert) @@ -690,17 +1020,21 @@ A and B must be line-info's." (define-key svn-status-mode-map (kbd "C-=") 'svn-status-show-svn-diff-for-marked-files) (define-key svn-status-mode-map (kbd "~") 'svn-status-get-specific-revision) (define-key svn-status-mode-map (kbd "E") 'svn-status-ediff-with-revision) + (define-key svn-status-mode-map (kbd "C-n") 'svn-status-next-line) (define-key svn-status-mode-map (kbd "C-p") 'svn-status-previous-line) (define-key svn-status-mode-map (kbd "") 'svn-status-next-line) (define-key svn-status-mode-map (kbd "") '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) (setq svn-status-mode-mark-map (make-sparse-keymap)) (define-key svn-status-mode-map (kbd "*") svn-status-mode-mark-map) (define-key svn-status-mode-mark-map (kbd "!") 'svn-status-unset-all-usermarks) (define-key svn-status-mode-mark-map (kbd "?") 'svn-status-mark-unknown) (define-key svn-status-mode-mark-map (kbd "A") 'svn-status-mark-added) (define-key svn-status-mode-mark-map (kbd "M") 'svn-status-mark-modified) - (define-key svn-status-mode-mark-map (kbd "V") 'svn-status-resolved) + (define-key svn-status-mode-mark-map (kbd "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 "u") 'svn-status-show-svn-diff-for-marked-files)) (when (not svn-status-mode-property-map) (setq svn-status-mode-property-map (make-sparse-keymap)) @@ -718,23 +1052,35 @@ A and B must be line-info's." (define-key svn-status-mode-property-map (kbd "TAB") 'svn-status-property-edit-svn-ignore) (define-key svn-status-mode-property-map (kbd "k") 'svn-status-property-set-keyword-list) (define-key svn-status-mode-property-map (kbd "y") 'svn-status-property-set-eol-style) - (define-key svn-status-mode-property-map (kbd "p") 'svn-status-property-parse) + (define-key svn-status-mode-property-map (kbd "x") 'svn-status-property-set-executable) ;; 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-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 "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-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 "t") 'svn-trac-browse-timeline) + (define-key svn-status-mode-map (kbd "T") svn-status-mode-trac-map)) (easy-menu-define svn-status-mode-menu svn-status-mode-map "'svn-status-mode' menu" '("SVN" ["svn status" svn-status-update t] ["svn update" svn-status-update-cmd t] - ["svn commit" svn-status-commit-file t] + ["svn 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] @@ -742,9 +1088,11 @@ A and B must be line-info's." ["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] ) ["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 rm..." svn-status-rm t] @@ -764,25 +1112,37 @@ A and B must be line-info's." ["svn:ignore File Extension..." svn-status-property-ignore-file-extension t] ["Edit svn:ignore Property" svn-status-property-edit-svn-ignore t] "---" - ["Set svn:keywords List" svn-status-property-set-keyword-list t] - ["Set svn:eol-style" svn-status-property-set-eol-style t] + ["Edit svn:keywords List" svn-status-property-set-keyword-list t] + ["Select svn:eol-style" svn-status-property-set-eol-style t] + ["Set svn:executable" svn-status-property-set-executable 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] ["Toggle sorting of *svn-status* buffer" svn-status-toggle-sort-status-buffer :style toggle :selected svn-status-sort-status-buffer] + ["Toggle display of full path names" svn-status-toggle-display-full-path + :style toggle :selected svn-status-display-full-path] + ) + ("Trac" + ["Browse timeline" svn-trac-browse-timeline 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" svn-status-set-user-mark t] - ["Unmark" svn-status-unset-user-mark 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 added" svn-status-mark-added t] ["Mark/Unmark modified" svn-status-mark-modified t] + ["Mark/Unmark deleted" svn-status-mark-deleted t] + ["Mark/Unmark modified/added/deleted" svn-status-mark-changed t] ) ["Hide Unknown" svn-status-toggle-hide-unknown :style toggle :selected svn-status-hide-unknown] @@ -790,16 +1150,52 @@ A and B must be line-info's." :style toggle :selected svn-status-hide-unmodified] )) + +(defun svn-status-popup-menu (event) + (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 + (list name + ["svn diff" svn-status-show-svn-diff 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])) + (svn-status-face-set-temporary-during-popup + 'svn-status-marked-popup-face (line-beginning-position) (line-end-position) + 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) + (sit-for 0) + (popup-menu menu prefix)) + (delete-overlay o)))) + (defun svn-status-mode () - "Major mode used by psvn.el to process the output of \"svn status\". - -psvn.el is an interface for the revision control tool subversion -\(see http://subversion.tigris.org). -psvn.el provides a similar interface for subversion as pcl-cvs does for cvs. -At the moment the following commands are implemented: - M-x svn-status: run 'svn -status -v' - and show the result in the *svn-status* buffer, this buffer uses the - svn-status mode. In this mode the following keys are defined: + "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) @@ -819,20 +1215,26 @@ At the moment the following commands are implemented: (force-mode-line-update)) (defun svn-status-bury-buffer (arg) - "Bury the *svn-status* buffer. -When called with a prefix argument, switch back to the window configuration that was + "Bury the buffers used by psvn.el +Currently this is: + `svn-status-buffer-name' + *svn-log-edit* + *svn-property-edit* + *svn-log* + *svn-process* +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*" "*svn-property-edit*" "*svn-process*"))) + (let ((bl '("*svn-log-edit*" "*svn-property-edit*" "*svn-log*" "*svn-process*"))) (while bl (when (get-buffer (car bl)) (bury-buffer (car bl))) (setq bl (cdr bl))) - (when (string= (buffer-name) "*svn-status*") + (when (string= (buffer-name) svn-status-buffer-name) (bury-buffer)))))) (defun svn-status-find-files () @@ -846,12 +1248,14 @@ See `svn-status-marked-files' for what counts as selected." (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-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)))) @@ -859,6 +1263,7 @@ See `svn-status-marked-files' for what counts as selected." "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)) @@ -869,6 +1274,13 @@ Otherwise run `find-file'." (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) (nth 0 line-info)) (defun svn-status-line-info->has-usermark (line-info) (nth 0 (nth 0 line-info))) @@ -885,11 +1297,33 @@ Otherwise run `find-file'." nil)) (defun svn-status-line-info->lastchangerev (line-info) "Return the last revision in which LINE-INFO was modified." - (if (>= (nth 5 line-info) 0) - (nth 5 line-info) - nil)) + (let ((l (nth 5 line-info))) + (if (and l (>= l 0)) + l + nil))) (defun svn-status-line-info->author (line-info) (nth 6 line-info)) -(defun svn-status-line-info->modified-external (line-info) (nth 7 line-info)) +(defun svn-status-line-info->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 interupted; 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 nil or \"S\"." + (nth 10 line-info)) (defun svn-status-line-info->is-visiblep (line-info) (not (or (svn-status-line-info->hide-because-unknown line-info) @@ -920,6 +1354,25 @@ Otherwise run `find-file'." (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-lastchangerev (line-info value) + (setcar (nthcdr 5 line-info) value)) + +(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-toggle-elide () (interactive) (let ((st-info svn-status-info) @@ -929,6 +1382,9 @@ Otherwise run `find-file'." (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)) @@ -937,17 +1393,201 @@ Otherwise run `find-file'." (setq len-fname (length fname)) (when (and (>= len-fname len-test) (string= (substring fname 0 len-test) test)) - ;;(message "elide: %s %s" fname (svn-status-line-info->user-elide (car st-info))) (setq elide-mark new-elide-mark) (when (or (string= fname ".") (and (= len-fname len-test) (svn-status-line-info->directory-p (car st-info)))) - (message "Elide directory %s and all its files." fname) + (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)) + (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 + (message "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))) + (message "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 (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)) + (cond ((equal action 'committed) + (setq tag-string " ")) + ((equal action 'added) + (setq tag-string " ")) + ((equal action 'deleted) + (setq tag-string " ")) + ((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 tag-string + (svn-status-line-info->set-filemark line-info ? ) + (svn-status-line-info->set-propmark line-info ? )) + (let ((buffer-read-only nil)) + (delete-region (point-at-bol) (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*") + (let ((action) + (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 ((= (point-at-eol) (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 "Transmitting file data") + (setq skip t)) + ((looking-at "Committed revision \\([0-9]+\\)") + (setq svn-status-commit-rev-number + (string-to-number (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 name (buffer-substring-no-properties (point) (point-at-eol))) + (setq result (cons (list 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*") + (let ((action) + (name) + (skip) + (result)) + (goto-char (point-min)) + (while (< (point) (point-max)) + (cond ((= (point-at-eol) (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) (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-line-info->directory-p (line-info) "Return t if LINE-INFO refers to a directory, nil otherwise. @@ -971,59 +1611,78 @@ Symbolic links to directories count as directories (see `file-directory-p')." (defun svn-insert-line-in-status-buffer (line-info) "Format LINE-INFO and insert the result in the current buffer." (let ((usermark (if (svn-status-line-info->has-usermark line-info) "*" " ")) - (external (if (svn-status-line-info->modified-external line-info) - (svn-add-face (if svn-status-short-mod-flag-p - "** " - " (modified external)") - 'svn-status-modified-external-face) - (if svn-status-short-mod-flag-p " " ""))) - ;; To add indentation based on the - ;; directory that the file is in, we just insert 2*(number of "/" in - ;; filename) spaces, which is rather hacky (but works)! - (filename (svn-status-choose-face-to-add - (svn-status-line-info->directory-p line-info) - (concat (make-string - (* 2 (svn-status-count-/ - (svn-status-line-info->filename line-info))) - 32) - (if svn-status-hide-unmodified - (svn-status-line-info->filename line-info) - (svn-status-line-info->filename-nondirectory line-info))) - 'svn-status-directory-face - 'svn-status-filename-face)) + (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 ;; file or /path/to/file + (concat + (if (or svn-status-display-full-path + svn-status-hide-unmodified) + (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 (* 2 (svn-status-count-/ + (svn-status-line-info->filename line-info))) + 32)) + (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) " ..." ""))) + (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))) + (svn-status-line-info->author line-info)) + (if svn-status-short-mod-flag-p update-available filename) + (if svn-status-short-mod-flag-p filename 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->switched line-info) + " (switched)" 'svn-status-switched-face) + elide-hint) 'svn-status-marked-face) - (if svn-status-short-mod-flag-p external filename) - (if svn-status-short-mod-flag-p filename external) - elide-hint "\n"))) (defun svn-status-update-buffer () + "Update the `svn-status-buffer-name' buffer, using `svn-status-info'." (interactive) - ;(message (format "buffer-name: %s" (buffer-name))) - (unless (string= (buffer-name) "*svn-status*") - (delete-other-windows) - (split-window-vertically) - (switch-to-buffer "*svn-status*")) + ;(message "buffer-name: %s" (buffer-name)) + (unless (string= (buffer-name) svn-status-buffer-name) + (set-buffer svn-status-buffer-name)) (svn-status-mode) (let ((st-info svn-status-info) (buffer-read-only nil) (start-pos) (overlay) - (unmodified-count 0) - (unknown-count 0) - (marked-count 0) + (unmodified-count 0) ;how many unmodified files are hidden + (unknown-count 0) ;how many unknown 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) (fname (svn-status-line-info->filename (svn-status-get-line-information))) (fname-pos (point)) + (header-line-string) (column (current-column))) (delete-region (point-min) (point-max)) (insert "\n") @@ -1033,12 +1692,17 @@ Symbolic links to directories count as directories (see `file-directory-p')." (cond ((svn-status-line-info->has-usermark (car st-info)) ;; Show a marked file always (svn-insert-line-in-status-buffer (car st-info))) + ((svn-status-line-info->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)) - );(message "user wanted to hide %s" (svn-status-line-info->filename (car st-info)))) + (setq user-elide-count (1+ user-elide-count))) ((svn-status-line-info->hide-because-unknown (car st-info)) - (setq unknown-count (+ unknown-count 1))) + (setq unknown-count (1+ unknown-count))) ((svn-status-line-info->hide-because-unmodified (car st-info)) - (setq unmodified-count (+ unmodified-count 1))) + (setq unmodified-count (1+ unmodified-count))) (t (svn-insert-line-in-status-buffer (car st-info)))) (when (svn-status-line-info->has-usermark (car st-info)) @@ -1053,17 +1717,33 @@ Symbolic links to directories count as directories (see `file-directory-p')." (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-base-info (insert (concat "Repository: " (svn-status-base-info->url) "\n"))) (when svn-status-hide-unknown (insert - (format "%d Unknown files are hidden - press ? to toggle hiding\n" + (format "%d Unknown file(s) are hidden - press `?' to toggle hiding\n" unknown-count))) (when svn-status-hide-unmodified (insert - (format "%d Unmodified files are hidden - press _ to toggle hiding\n" + (format "%d Unmodified file(s) are hidden - press `_' to toggle hiding\n" unmodified-count))) - (insert (format "%d files marked\n" marked-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 @@ -1074,22 +1754,27 @@ Symbolic links to directories count as directories (see `file-directory-p')." (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. +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." +This hides the repository information again. + +When ARG is t, don't update the svn status buffer. This useful for +non-interactive use." (interactive "P") (if (eq arg 0) (setq svn-status-base-info nil) (svn-run-svn nil t 'parse-info "info" ".") (svn-status-parse-info-result)) - (svn-status-update-buffer)) + (unless (eq arg t) + (svn-status-update-buffer))) (defun svn-status-parse-info-result () (let ((url)) (save-excursion (set-buffer "*svn-process*") (goto-char (point-min)) - (search-forward "Url: ") + (let ((case-fold-search t)) + (search-forward "url: ")) (setq url (buffer-substring-no-properties (point) (point-at-eol)))) (setq svn-status-base-info `((url ,url))))) @@ -1136,6 +1821,25 @@ This hides the repository information again." (when (svn-status-get-line-information) (goto-char (+ (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 (svn-status-line-info->full-path line-info))) + (let ((default-directory + (file-name-as-directory + (expand-file-name (svn-status-line-info->directory-containing-line-info line-info t))))) + (dired-jump)) + (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'." @@ -1143,15 +1847,22 @@ When called with a prefix argument run 'svn status -vu'." (unless (interactive-p) (save-excursion (set-buffer "*svn-process*") - (setq svn-status-update-previous-process-output (buffer-substring (point-min) (point-max))))) + (setq svn-status-update-previous-process-output + (buffer-substring (point-min) (point-max))))) (svn-status default-directory arg)) (defun svn-status-get-line-information () "Find out about the file under point. The result may be parsed with the various `svn-status-line-info->...' functions." - (let ((overlay (car (overlays-at (point))))) - (when overlay - (overlay-get overlay 'svn-info)))) + (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 + '((nil nil) 32 nil "." 0 0 "" nil nil nil nil))) + (defun svn-status-get-file-list (use-marked-files) "Get either the marked files or the files, where the cursor is on." @@ -1170,6 +1881,10 @@ The result may be parsed with the various `svn-status-line-info->...' functions. (svn-status-line-info->hide-because-unmodified info)) (message "No file on this line")))) +(defun svn-status-ensure-cursor-on-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. @@ -1182,11 +1897,18 @@ otherwise return the directory containing the file under point." '(nil nil nil "")))) (file-name-as-directory (expand-file-name - (if (and allow-self (svn-status-line-info->directory-p line-info)) - (svn-status-line-info->filename line-info) - ;;The next `or' is because (file-name-directory "file") returns nil - (or (file-name-directory (svn-status-line-info->filename line-info)) - ".")))))) + (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. @@ -1196,6 +1918,7 @@ 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 @@ -1211,6 +1934,7 @@ 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 @@ -1236,10 +1960,11 @@ Then move to that line." (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 (concat "^" (regexp-quote - (file-name-as-directory file-name)))) + (sub-file-regexp (concat "^" (regexp-quote + (file-name-as-directory file-name)))) (newcursorpos-fname) (i-fname) (current-line svn-start-of-file-list-line-number)) @@ -1248,61 +1973,93 @@ Then move to that line." (setq current-line (1+ current-line))) (setq i-fname (svn-status-line-info->filename (car st-info))) (when (or (string= file-name i-fname) - (string-match sub-file-regexp i-fname)) + (string-match sub-file-regexp i-fname)) (when (svn-status-line-info->is-visiblep (car st-info)) (when (or (not only-this-line) (string= file-name i-fname)) (setq newcursorpos-fname i-fname) - (if set-mark - (message "marking: %s" i-fname) - (message "unmarking: %s" i-fname)) - ;;(message "ui-status: %S" (svn-status-line-info->ui-status (car st-info))) - (setcar (svn-status-line-info->ui-status (car st-info)) set-mark) - (save-excursion - (let ((buffer-read-only nil)) - (goto-line current-line) - (delete-region (point-at-bol) (point-at-eol)) - (svn-insert-line-in-status-buffer (car st-info)) - (delete-char 1)))))) + (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 (point-at-bol) (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))) + (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 svnstatus-line-info->* functions can be -used in the check." - (let ((st-info svn-status-info)) +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))) - (if set-mark - (when (not (svn-status-line-info->has-usermark (car st-info))) - (message "marking: %s" (svn-status-line-info->filename (car st-info)))) - (when (svn-status-line-info->has-usermark (car st-info)) - (message "unmarking: %s" (svn-status-line-info->filename (car st-info))))) + (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))) + (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. +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))) + (svn-status-apply-usermark-checked + '(lambda (info) (eq (svn-status-line-info->filemark info) ??)) (not arg))) (defun svn-status-mark-added (arg) "Mark all added files. -These are the files marked with 'A' in the *svn-status* buffer. -If the function is called with a prefix arg, unmark all these files." +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))) + (svn-status-apply-usermark-checked + '(lambda (info) (eq (svn-status-line-info->filemark info) ?A)) (not arg))) (defun svn-status-mark-modified (arg) "Mark all modified files. -These are the files marked with 'M' in the *svn-status* buffer. -If the function is called with a prefix arg, unmark all these files." +These are the files marked with 'M' 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) (or (eq (svn-status-line-info->filemark info) ?M) + (eq (svn-status-line-info->filemark info) + svn-status-file-modified-after-save-flag))) + (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) ?M)) (not arg))) + (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 + +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)) (defun svn-status-unset-all-usermarks () (interactive) @@ -1318,16 +2075,38 @@ If the function is called with a prefix arg, unmark all these files." (setq svn-status-hide-unmodified (not svn-status-hide-unmodified)) (svn-status-update-buffer)) -(defun svn-status-goto-file-name (name) - ;; (message "svn-status-goto-file-name: %s %d" name (point)) - (let ((start-pos (point))) +(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 (< (point) (point-max)) + (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)))) - (goto-char start-pos))) + (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) @@ -1379,7 +2158,7 @@ or (if no files were marked) the file under point." (insert postfix)))) (defun svn-status-show-process-buffer-internal (&optional scroll-to-top) - (when (eq (current-buffer) "*svn-status*") + (when (eq (current-buffer) svn-status-buffer-name) (delete-other-windows)) (pop-to-buffer "*svn-process*") (when svn-status-wash-control-M-in-process-buffers @@ -1388,13 +2167,42 @@ or (if no files were marked) the file under point." (goto-char (point-min))) (other-window 1)) +(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)))) + (cond ((eq window-mode nil) ;; use *svn-process* buffer + (setq svn-status-last-output-buffer-name "*svn-process*")) + ((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 + (when (string= (buffer-name) svn-status-buffer-name) + (delete-other-windows)) + (pop-to-buffer "*svn-process*") + (switch-to-buffer (get-buffer-create svn-status-last-output-buffer-name)) + (let ((buffer-read-only nil)) + (delete-region (point-min) (point-max)) + (insert-buffer-substring "*svn-process*") + (when scroll-to-top + (goto-char (point-min)))) + (other-window 1)) + (svn-status-show-process-buffer-internal scroll-to-top))))) + + (defun svn-status-show-svn-log (arg) "Run `svn log' on selected files. -When called with a prefix argument add the following command switches: - no prefix: use whatever is in the string `svn-status-default-log-arguments' - prefix argument of -1: use no arguments - prefix argument of 0: use the -q switch (quiet) - other prefix arguments: use the -v switch (verbose) +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 string `svn-status-default-log-arguments' + prefix argument of -1 --- use no arguments + prefix argument of 0: --- use the -q switch (quiet) + other prefix arguments: --- use the -v switch (verbose) See `svn-status-marked-files' for what counts as selected." (interactive "P") @@ -1402,7 +2210,6 @@ See `svn-status-marked-files' for what counts as selected." ((eq arg -1) "") (arg "-v") (t svn-status-default-log-arguments)))) - ;;(message "show log info for: %S" (svn-status-marked-files)) (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "") (if (> (length switch) 0) (svn-run-svn t t 'log "log" "--targets" svn-status-temp-arg-file switch) @@ -1431,6 +2238,7 @@ If there is a newer revision in the repository, the diff is done against HEAD, o compare the working copy with BASE. If ARG then prompt for revision to diff against." (interactive "P") + (svn-status-ensure-cursor-on-file) (svn-status-show-svn-diff-internal arg nil)) (defun svn-status-show-svn-diff-for-marked-files (arg) @@ -1449,20 +2257,27 @@ If ARG then prompt for revision to diff against, else compare working copy with (svn-status-read-revision-string "Diff with files for version: " "PREV") (if use-all-marked-files "BASE" - (if (svn-status-line-info->modified-external (car fl)) "HEAD" "BASE"))))) + (if (svn-status-line-info->update-available (car fl)) "HEAD" "BASE"))))) (while fl - (svn-run-svn nil clear-buf 'diff "diff" "-r" revision (svn-status-line-info->filename (car fl))) + (svn-run-svn nil clear-buf 'diff "diff" svn-status-default-diff-arguments + "-r" revision (svn-status-line-info->filename (car fl))) (setq clear-buf nil) (setq fl (cdr fl)))) - (svn-status-show-process-buffer-internal t) + (svn-status-diff-mode)) + +(defun svn-status-diff-mode () + "Show the *svn-process* buffer, using the diff-mode." + (svn-status-show-process-output 'diff t) (save-excursion - (set-buffer "*svn-process*") + (set-buffer svn-status-last-output-buffer-name) (diff-mode) - (font-lock-fontify-buffer))) + (font-lock-fontify-buffer) + (setq buffer-read-only t))) (defun svn-status-show-process-buffer () + "Show the content of the *svn-process* buffer" (interactive) - (svn-status-show-process-buffer-internal)) + (svn-status-show-process-output nil)) (defun svn-status-add-file-recursively (arg) "Run `svn add' on all selected files. @@ -1612,11 +2427,15 @@ When called with a prefix argument add the command line switch --force." (svn-run-svn t t 'rm "rm" "--targets" svn-status-temp-arg-file))))) (defun svn-status-update-cmd () + "Run svn update." (interactive) + (message "Running svn-update for %s" default-directory) ;TODO: use file names also (svn-run-svn t t 'update "update")) -(defun svn-status-commit-file () +(defun svn-status-commit () + "Commit selected files. +See `svn-status-marked-files' for what counts as selected." (interactive) (let* ((marked-files (svn-status-marked-files))) (setq svn-status-files-to-commit marked-files) @@ -1638,12 +2457,15 @@ When called with a prefix argument add the command line switch --force." (insert-file svn-log-edit-file-name))) (svn-log-edit-mode))) -(defun svn-status-cleanup () - (interactive) - (let ((file-names (svn-status-marked-file-names))) +(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)) + (message "svn-status-cleanup %S" file-names) (svn-run-svn t t 'cleanup (append (list "cleanup") file-names))) (message "No valid file selected - No status cleanup possible")))) @@ -1661,13 +2483,28 @@ See `svn-status-marked-files' for what counts as selected." (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "") (svn-run-svn t t 'resolved "resolved" "--targets" svn-status-temp-arg-file)))) + +(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, when a file is saved +;; Update the `svn-status-buffer-name' buffer, when a file is saved ;; -------------------------------------------------------------------------------- (defvar svn-status-file-modified-after-save-flag ?m - "The flag, that is shown, in the *svn-status* buffer, after -a file is changed and saved in emacs. + "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." @@ -1677,27 +2514,35 @@ Recommended values are ?m or ?M.") (svn-dir-len (length (or svn-dir ""))) (file-dir-len (length file-dir)) (file-name)) - (when (and svn-dir + (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 (format "In svn-status directory %S" file-name)) + ;;(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 (format "i-fname=%S" i-fname)) + ;;(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-excursion - (set-buffer "*svn-status*") - (svn-status-goto-file-name i-fname) - (let ((buffer-read-only nil)) - (delete-region (point-at-bol) (point-at-eol)) - (svn-insert-line-in-status-buffer (car st-info)) - (delete-char 1)))) + (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 (point-at-bol) (point-at-eol)) + (svn-insert-line-in-status-buffer (car st-info)) + (delete-char 1)) + (message "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) @@ -1731,15 +2576,25 @@ Otherwise get only the actual file." (add-to-list 'svn-status-get-specific-revision-file-info (cons file-name file-name-with-revision)) (save-excursion - (find-file file-name-with-revision) - (setq buffer-read-only nil) - (delete-region (point-min) (point-max)) - (svn-run-svn nil t 'cat (append (list "cat" "-r" revision) (list file-name))) - ;;todo: error processing - ;;svn: Filesystem has no item - ;;svn: file not found: revision `15', path `/trunk/file.txt' - (insert-buffer-substring "*svn-process*") - (save-buffer)) + (let ((content + (with-temp-buffer + (if (string= revision "BASE") + (insert-file-contents (concat (file-name-directory file-name) + ".svn/text-base/" + (file-name-nondirectory file-name) + ".svn-base")) + (progn + (svn-run-svn nil t 'cat (append (list "cat" "-r" revision) (list file-name))) + ;;todo: error processing + ;;svn: Filesystem has no item + ;;svn: file not found: revision `15', path `/trunk/file.txt' + (insert-buffer-substring "*svn-process*"))) + (buffer-string)))) + (find-file file-name-with-revision) + (setq buffer-read-only nil) + (delete-region (point-min) (point-max)) + (insert content) + (save-buffer))) (setq file-names (cdr file-names))) (setq svn-status-get-specific-revision-file-info (nreverse svn-status-get-specific-revision-file-info)) @@ -1757,7 +2612,7 @@ If ARG then prompt for revision to diff against." (base-buff (find-file-noselect (cdar svn-status-get-specific-revision-file-info))) (svn-transient-buffers (list base-buff )) (startup-hook '(svn-ediff-startup-hook))) - (ediff-buffers my-buffer base-buff startup-hook))) + (ediff-buffers base-buff my-buffer startup-hook))) (defun svn-ediff-startup-hook () (add-hook 'ediff-after-quit-hook-internal @@ -1796,15 +2651,16 @@ If ARG then prompt for revision to diff against." (delete-process process) (message "No running svn process")))) -(defun svn-process-send-string (string) +(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*") + (goto-char (point-max)) (let ((buffer-read-only nil)) - (insert string)) + (insert (if send-passwd (make-string (length string) ?.) string))) (set-marker (process-mark (get-process "svn")) (point))) (process-send-string "svn" string)) @@ -1823,11 +2679,6 @@ Note: use C-q C-j to send a line termination character." (defun svn-status-proplist-start () (svn-run-svn t t 'proplist-parse "proplist" (svn-status-line-info->filename (svn-status-get-line-information)))) - -(defun svn-status-property-parse () - (interactive) - (svn-status-proplist-start)) - (defun svn-status-property-edit-one-entry (arg) "Edit a property. When called with a prefix argument, it is possible to enter a new property." @@ -1860,30 +2711,14 @@ When called with a prefix argument, it is possible to enter a new property." (setq pl (append pl (list (match-string 1)))) (forward-line 1))) ;(cond last-command: svn-status-property-set, svn-status-property-edit-one-entry - ;svn-status-property-parse: - (cond ((eq last-command 'svn-status-property-parse) - ;(message "%S %S" pl last-command) - (while pl - (svn-run-svn nil t 'propget-parse "propget" (car pl) - (svn-status-line-info->filename - (svn-status-get-line-information))) - (save-excursion - (set-buffer "*svn-process*") - (setq pfl (append pfl (list - (list - (car pl) - (buffer-substring - (point-min) (- (point-max) 1))))))) - (setq pl (cdr pl)) - (message "%S" pfl))) - ((eq last-command 'svn-status-property-edit-one-entry) + (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*") + (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) @@ -1893,15 +2728,23 @@ When called with a prefix argument, it is possible to enter a new property." (setq prop-value (read-from-minibuffer "Property value: ")) (unless (string= prop-name "") (save-excursion - (set-buffer "*svn-status*") - (message "setting property %s := %s for %S" prop-name prop-value - (svn-status-marked-files))))) + (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-svn 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*") + (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) @@ -1945,7 +2788,7 @@ When called with a prefix argument, it is possible to enter a new property." (defun svn-status-property-set-property (file-info-list prop-name prop-value) "Set a property on a given file list." (save-excursion - (set-buffer (get-buffer "*svn-property-edit*")) + (set-buffer (get-buffer-create "*svn-property-edit*")) (delete-region (point-min) (point-max)) (insert prop-value)) (setq svn-status-propedit-file-list (svn-status-marked-files)) @@ -2052,6 +2895,11 @@ When called with a prefix argument, it is possible to enter a new property." (mapcar 'list '("native" "CRLF" "LF" "CR")) nil t))) +(defun svn-status-property-set-executable () + "Set the svn:executable property on the marked files." + (interactive) + (svn-status-property-set-property (svn-status-marked-files) "svn:executable" "*")) + ;; -------------------------------------------------------------------------------- ;; svn-prop-edit-mode: ;; -------------------------------------------------------------------------------- @@ -2101,7 +2949,8 @@ Commands: (mapcar 'svn-status-line-info->filename svn-status-propedit-file-list)) (save-excursion (set-buffer (get-buffer "*svn-property-edit*")) - (set-buffer-file-coding-system 'undecided-unix nil) + (when (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system 'undecided-unix nil)) (setq svn-status-temp-file-to-remove (concat svn-status-temp-dir "svn-prop-edit.txt" svn-temp-suffix)) (write-region (point-min) (point-max) svn-status-temp-file-to-remove nil 1)) @@ -2114,21 +2963,22 @@ Commands: "--targets" svn-status-temp-arg-file "-F" (concat svn-status-temp-dir "svn-prop-edit.txt" svn-temp-suffix)) (unless async (svn-status-remove-temp-file-maybe))) - (set-window-configuration svn-status-pre-propedit-window-configuration)) + (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*") + (set-buffer svn-status-buffer-name) (svn-status-show-svn-diff-for-marked-files arg)) (defun svn-prop-edit-svn-log (arg) (interactive "P") - (set-buffer "*svn-status*") + (set-buffer svn-status-buffer-name) (svn-status-show-svn-log arg)) (defun svn-prop-edit-svn-status () (interactive) - (pop-to-buffer "*svn-status*") + (pop-to-buffer svn-status-buffer-name) (other-window 1)) ;; -------------------------------------------------------------------------------- @@ -2137,9 +2987,35 @@ Commands: (defvar svn-log-edit-mode-map () "Keymap used in `svn-log-edit-mode' buffers.") +(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) + (run-hooks 'svn-log-edit-mode-hook) + (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)) + (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) + (run-hooks 'svn-log-edit-mode-hook))) + (when (not svn-log-edit-mode-map) (setq svn-log-edit-mode-map (make-sparse-keymap)) - (define-key svn-log-edit-mode-map (kbd "C-c C-c") 'svn-log-edit-done) + (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) @@ -2160,18 +3036,6 @@ Commands: ["Erase buffer" svn-log-edit-erase-edit-buffer] ["Abort" svn-log-edit-abort t])) -(defun svn-log-edit-mode () - "Major Mode to edit svn log messages. -Commands: -\\{svn-log-edit-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map svn-log-edit-mode-map) - (easy-menu-add svn-log-edit-mode-menu) - (setq major-mode 'svn-log-edit-mode) - (setq mode-name "svn-log-edit") - (run-hooks 'svn-log-edit-mode-hook)) - (defun svn-log-edit-abort () (interactive) (bury-buffer) @@ -2179,44 +3043,59 @@ Commands: (defun svn-log-edit-done () (interactive) - (message "svn-log editing done") (save-excursion (set-buffer (get-buffer "*svn-log-edit*")) (when svn-log-edit-insert-files-to-commit (svn-log-edit-remove-comment-lines)) - (set-buffer-file-coding-system 'undecided-unix nil) - (write-region (point-min) (point-max) - (concat svn-status-temp-dir "svn-log-edit.txt" svn-temp-suffix) nil 1)) - (when svn-status-files-to-commit ; there are files to commit - (svn-status-create-arg-file svn-status-temp-arg-file "" - svn-status-files-to-commit "") - (setq svn-status-files-to-commit nil) - (setq svn-status-temp-file-to-remove (concat svn-status-temp-dir "svn-log-edit.txt" svn-temp-suffix)) - (svn-run-svn t t 'commit "commit" "--targets" svn-status-temp-arg-file - "-F" svn-status-temp-file-to-remove)) - (set-window-configuration svn-status-pre-commit-window-configuration)) + (when (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system 'undecided-unix nil)) + (when (or svn-log-edit-update-log-entry svn-status-files-to-commit) + (setq svn-status-temp-file-to-remove + (concat svn-status-temp-dir "svn-log-edit.txt" svn-temp-suffix)) + (write-region (point-min) (point-max) svn-status-temp-file-to-remove nil 1))) + (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-svn nil t 'propset "propset" "svn:log" "--revprop" + (concat "-r" svn-log-edit-update-log-entry) + "-F" svn-status-temp-file-to-remove) + (save-excursion + (set-buffer "*svn-process*") + (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-temp-arg-file "" + svn-status-files-to-commit "") + (svn-run-svn t t 'commit "commit" "--targets" svn-status-temp-arg-file + "-F" svn-status-temp-file-to-remove)) + (set-window-configuration svn-status-pre-commit-window-configuration) + (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*") + (set-buffer svn-status-buffer-name) (svn-status-show-svn-diff-for-marked-files arg)) (defun svn-log-edit-svn-log (arg) (interactive "P") - (set-buffer "*svn-status*") + (set-buffer svn-status-buffer-name) (svn-status-show-svn-log arg)) (defun svn-log-edit-svn-status () (interactive) - (pop-to-buffer "*svn-status*") + (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" - (mapcar 'svn-status-line-info->filename svn-status-files-to-commit))) + (message "Files to commit: %S" (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'." @@ -2259,20 +3138,25 @@ If ARG then show diff between some other version of the selected files." (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-view-diff) + (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)) + (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])) + ["Show Changeset" svn-log-view-diff t] + ["Edit log message" svn-log-edit-log-entry t])) (defvar svn-log-view-font-lock-keywords '(("^r.+" . font-lock-keyword-face) "Keywords in svn-log-view-mode.")) -(define-derived-mode svn-log-view-mode log-view-mode "svn-log-view" + +(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} @@ -2306,22 +3190,35 @@ When called with a prefix argument, ask the user for the revision." (when arg (setq rev-arg (read-string "Revision for changeset: " rev-arg))) (svn-run-svn nil t 'diff "diff" (concat "-r" rev-arg)) - (svn-status-show-process-buffer-internal t) + (svn-status-diff-mode))) + +(defun svn-log-edit-log-entry () + "Edit the given log entry." + (interactive) + (let ((rev (svn-log-revision-at-point)) + (log-message)) + (svn-run-svn nil t 'propget-parse "propget" "--revprop" (concat "-r" rev) "svn:log") (save-excursion (set-buffer "*svn-process*") - (diff-mode) - (font-lock-fontify-buffer)))) + (setq log-message (if (> (point-max) 1) + (buffer-substring (point-min) (- (point-max) 1)) + ""))) + (svn-status-pop-to-commit-buffer) + (delete-region (point-min) (point-max)) + (insert log-message) + (goto-char (point-min)) + (setq svn-log-edit-update-log-entry rev))) ;; -------------------------------------------------------------------------------- ;; svn status persistent options ;; -------------------------------------------------------------------------------- (defun svn-status-base-dir () - (let ((base-dir default-directory) + (let ((base-dir (expand-file-name default-directory)) (dot-svn-dir) - (dir-below default-directory)) + (dir-below (expand-file-name default-directory))) (setq dot-svn-dir (concat base-dir ".svn")) - (while (when (file-exists-p dot-svn-dir) + (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 (match-string 1 dir-below)) @@ -2334,12 +3231,15 @@ When called with a prefix argument, ask the user for the revision." (delete-region (point-min) (point-max)) (setq svn-status-options (list - (list "sort-status-buffer" svn-status-sort-status-buffer))) + (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))) (insert (pp-to-string svn-status-options)) (save-buffer) (kill-buffer buf))) -(defun svn-status-load-state () +(defun svn-status-load-state (&optional no-error) (interactive) (let ((file (concat (svn-status-base-dir) "++psvn.state"))) (if (file-readable-p file) @@ -2347,9 +3247,16 @@ When called with a prefix argument, ask the user for the revision." (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)))) - (error "%s is not readable." file)) - (message "Loaded %s" file))) + (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))) + (when (and (interactive-p) svn-status-elided-list (svn-status-apply-elide-list))) + (message "psvn.el: loaded %s" file)) + (unless no-error (error "psvn.el: %s is not readable." file))))) (defun svn-status-toggle-sort-status-buffer () "If you turn off sorting, you can speed up M-x svn-status. @@ -2358,9 +3265,179 @@ 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 (concat "The *svn-status* buffer will be" - (if svn-status-sort-status-buffer "" " not") - " sorted."))) + (message "The %s buffer will be%s sorted." svn-status-buffer-name + (if svn-status-sort-status-buffer "" " 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)) + +(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-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-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-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 result-buffer) + (goto-char (point-min)) + (while (re-search-forward "^<<<<<<< .mine\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]+\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 result-buffer) + (goto-char (point-min)) + (while (re-search-forward "^<<<<<<< .mine\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]+\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 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")))) + +;; -------------------------------------------------------------------------------- +;; 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.")) (provide 'psvn) diff --git a/subversion.spec b/subversion.spec index 1b2cb2d..16bfc32 100644 --- a/subversion.spec +++ b/subversion.spec @@ -252,6 +252,7 @@ rm -rf ${RPM_BUILD_ROOT} %changelog * Thu Sep 8 2005 Joe Orton 1.2.3-3 - update to 1.2.3 +- update to psvn.el r16070 from Stefan Reichoer - merge subversion.conf changes from RHEL4 - merge filter-requires.sh changes from FC4 updates