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