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