update to 1.9.6 (#1467890)

update to latest upstream psvn.el
Resolves: rhbz#1467890
This commit is contained in:
Joe Orton 2017-07-06 12:27:22 +01:00
parent 684d60f4c9
commit f4b58f8836
2 changed files with 106 additions and 85 deletions

189
psvn.el
View File

@ -1,5 +1,5 @@
;;; psvn.el --- Subversion interface for emacs ;;; psvn.el --- Subversion interface for emacs
;; Copyright (C) 2002-2012 by Stefan Reichoer ;; Copyright (C) 2002-2015 by Stefan Reichoer
;; Author: Stefan Reichoer <stefan@xsteve.at> ;; Author: Stefan Reichoer <stefan@xsteve.at>
;; Note: This version is currently not under svn control ;; Note: This version is currently not under svn control
@ -241,7 +241,7 @@
;;; Code: ;;; Code:
(defconst svn-psvn-revision "2012-03-26, 21:23:49" "The revision date of psvn.") (defconst svn-psvn-revision "2015-07-20, 21:42:00" "The revision date of psvn.")
(require 'easymenu) (require 'easymenu)
@ -671,7 +671,7 @@ See psvn.el for an example function.")
(defvar svn-process-cmd nil) (defvar svn-process-cmd nil)
(defvar svn-status-info nil) (defvar svn-status-info nil)
(defvar svn-status-filename-to-buffer-position-cache (make-hash-table :test 'equal :weakness t)) (defvar svn-status-filename-to-buffer-position-cache (make-hash-table :test 'equal :weakness t))
(defvar svn-status-base-info nil "The parsed result from the svn info command.") (defvar svn-status-base-info nil "The parsed result from the svn info command as a plist.")
(defvar svn-status-initial-window-configuration nil) (defvar svn-status-initial-window-configuration nil)
(defvar svn-status-default-column 23) (defvar svn-status-default-column 23)
(defvar svn-status-default-revision-width 4) (defvar svn-status-default-revision-width 4)
@ -703,13 +703,14 @@ This is nil if the log entry is for a new commit.")
(defvar svn-pre-run-mode-line-process nil) (defvar svn-pre-run-mode-line-process nil)
(defvar svn-arg-file-content nil) (defvar svn-arg-file-content nil)
(defvar svn-status-temp-dir (defvar svn-status-temp-dir
(expand-file-name (file-name-as-directory
(or (expand-file-name
(when (boundp 'temporary-file-directory) temporary-file-directory) ;emacs (or
;; XEmacs 21.4.17 can return "/tmp/kalle" from (temp-directory). (when (boundp 'temporary-file-directory) temporary-file-directory) ;emacs
;; `file-name-as-directory' adds a slash so we can append a file name. ;; XEmacs 21.4.17 can return "/tmp/kalle" from (temp-directory).
(when (fboundp 'temp-directory) (file-name-as-directory (temp-directory))) ;; `file-name-as-directory' adds a slash so we can append a file name.
"/tmp/")) "The directory that is used to store temporary files for psvn.") (when (fboundp 'temp-directory) (temp-directory))
"/tmp/"))) "The directory that is used to store temporary files for psvn.")
;; Because `temporary-file-directory' is not a risky local variable in ;; Because `temporary-file-directory' is not a risky local variable in
;; GNU Emacs 22.0.51, we don't mark `svn-status-temp-dir' as such either. ;; GNU Emacs 22.0.51, we don't mark `svn-status-temp-dir' as such either.
(defvar svn-temp-suffix (make-temp-name ".")) (defvar svn-temp-suffix (make-temp-name "."))
@ -1118,12 +1119,18 @@ inside loops."
(defun svn-checkout (repos-url path) (defun svn-checkout (repos-url path)
"Run svn checkout REPOS-URL PATH." "Run svn checkout REPOS-URL PATH."
(interactive (list (read-string "Checkout from repository Url: ") (interactive (list (read-string "Checkout from repository Url: ")
(svn-read-directory-name "Checkout to directory: "))) (expand-file-name
(svn-read-directory-name "Checkout to directory: "))))
(svn-run t t 'checkout "checkout" repos-url (expand-file-name path))) (svn-run t t 'checkout "checkout" repos-url (expand-file-name path)))
;;;###autoload (defalias 'svn-examine 'svn-status) ;;;###autoload (defalias 'svn-examine 'svn-status)
(defalias 'svn-examine 'svn-status) (defalias 'svn-examine 'svn-status)
;;;###autoload
(defun svn-version-controlled-dir-p (dir)
"Return t if DIR is part of a Subversion workarea."
(= 0 (call-process svn-status-svn-executable nil nil nil "info" dir)))
;;;###autoload ;;;###autoload
(defun svn-status (dir &optional arg) (defun svn-status (dir &optional arg)
"Examine the status of Subversion working copy in directory DIR. "Examine the status of Subversion working copy in directory DIR.
@ -1133,20 +1140,17 @@ For every other non nil ARG pass the -u argument to `svn status', which
asks svn to connect to the repository and check to see if there are updates asks svn to connect to the repository and check to see if there are updates
there. there.
If there is no .svn directory, examine if there is CVS and run If DIR is not an SVN working copy, examine if there is CVS and run
`cvs-examine'. Otherwise ask if to run `dired'." `cvs-examine'. Otherwise ask if to run `dired'."
(interactive (list (svn-read-directory-name "SVN status directory: " (interactive (list (expand-file-name
nil default-directory nil) (svn-read-directory-name "SVN status directory: "
nil default-directory nil))
current-prefix-arg)) current-prefix-arg))
(let ((svn-dir (format "%s%s"
(file-name-as-directory dir)
(svn-wc-adm-dir-name)))
(cvs-dir (format "%sCVS" (file-name-as-directory dir))))
(cond (cond
((file-directory-p svn-dir) ((svn-version-controlled-dir-p (expand-file-name dir))
(setq arg (svn-status-possibly-negate-meaning-of-arg arg 'svn-status)) (setq arg (svn-status-possibly-negate-meaning-of-arg arg 'svn-status))
(svn-status-1 dir arg)) (svn-status-1 dir arg))
((and (file-directory-p cvs-dir) ((and (file-directory-p (concat (file-name-as-directory dir) "CVS"))
(fboundp 'cvs-examine)) (fboundp 'cvs-examine))
(cvs-examine dir nil)) (cvs-examine dir nil))
(t (t
@ -1159,7 +1163,7 @@ If there is no .svn directory, examine if there is CVS and run
"Run dired instead? ") "Run dired instead? ")
dir dir
(svn-wc-adm-dir-name))) (svn-wc-adm-dir-name)))
(dired dir)))))) (dired dir)))))
(defvar svn-status-display-new-status-buffer nil) (defvar svn-status-display-new-status-buffer nil)
(defun svn-status-1 (dir &optional arg) (defun svn-status-1 (dir &optional arg)
@ -1195,7 +1199,6 @@ If there is no .svn directory, examine if there is CVS and run
(set-buffer proc-buf) (set-buffer proc-buf)
(setq default-directory dir (setq default-directory dir
svn-status-remote (when arg t)) svn-status-remote (when arg t))
(set-buffer cur-buf)
(if want-edit (if want-edit
(let ((svn-status-edit-svn-command t)) (let ((svn-status-edit-svn-command t))
(svn-run t t 'status "status" svn-status-default-status-arguments status-option)) (svn-run t t 'status "status" svn-status-default-status-arguments status-option))
@ -3089,32 +3092,27 @@ non-interactive use."
(defun svn-status-parse-info-result () (defun svn-status-parse-info-result ()
"Parse the result from the svn info command. "Parse the result from the svn info command.
Put the found values in `svn-status-base-info'." Put the found values in `svn-status-base-info'."
(let ((url) (save-excursion
(repository-root) (setq svn-status-base-info ())
(last-changed-author)) (set-buffer svn-process-buffer-name)
(save-excursion (goto-char (point-min))
(set-buffer svn-process-buffer-name) (let ((case-fold-search t)
(goto-char (point-min)) (key)
(let ((case-fold-search t)) (val))
(search-forward "url: ") (loop while (looking-at "\\(.*?\\)\\s-*:\\s-*\\(.*\\)$")
(setq url (buffer-substring-no-properties (point) (svn-point-at-eol))) do (setq key (intern (concat ":" (downcase (subst-char-in-string ?\ ?- (match-string 1))))))
(when (search-forward "repository root: " nil t) (setq val (match-string 2))
(setq repository-root (buffer-substring-no-properties (point) (svn-point-at-eol)))) (setq svn-status-base-info (plist-put svn-status-base-info
(when (search-forward "last changed author: " nil t) key val))
(setq last-changed-author (buffer-substring-no-properties (point) (svn-point-at-eol)))))) until (< 0 (forward-line))))))
(setq svn-status-base-info `((url ,url) (repository-root ,repository-root) (last-changed-author ,last-changed-author)))))
(defun svn-status-base-info->url () (defun svn-status-base-info->url ()
"Extract the url part from `svn-status-base-info'." "Extract the url part from `svn-status-base-info'."
(if svn-status-base-info (plist-get svn-status-base-info :url))
(cadr (assoc 'url svn-status-base-info))
""))
(defun svn-status-base-info->repository-root () (defun svn-status-base-info->repository-root ()
"Extract the repository-root part from `svn-status-base-info'." "Extract the repository-root part from `svn-status-base-info'."
(if svn-status-base-info (plist-get svn-status-base-info :repository-root))
(cadr (assoc 'repository-root svn-status-base-info))
""))
(defun svn-status-checkout-prefix-path () (defun svn-status-checkout-prefix-path ()
"When only a part of the svn repository is checked out, return the file path for this checkout." "When only a part of the svn repository is checked out, return the file path for this checkout."
@ -4057,9 +4055,10 @@ user can enter a new file name, or an existing directory: this is used as the ar
(svn-status-line-info->full-path (car marked-files)))) (svn-status-line-info->full-path (car marked-files))))
;;TODO: (when file-exists-p but-no-dir-p dest (error "%s already exists" dest)) ;;TODO: (when file-exists-p but-no-dir-p dest (error "%s already exists" dest))
;;multiple files selected, so prompt for existing directory to mv them into. ;;multiple files selected, so prompt for existing directory to mv them into.
(setq dest (svn-read-directory-name (setq dest (expand-file-name
(format "%s %d files to directory: " manyprompt num-of-files) (svn-read-directory-name
(svn-status-directory-containing-point t) nil t)) (format "%s %d files to directory: " manyprompt num-of-files)
(svn-status-directory-containing-point t) nil t)))
(unless (file-directory-p dest) (unless (file-directory-p dest)
(error "%s is not a directory" dest))) (error "%s is not a directory" dest)))
(when (string= dest "") (when (string= dest "")
@ -5813,9 +5812,6 @@ Currently is the output from the svn update command known."
"Toggle svn blame minor mode. "Toggle svn blame minor mode.
With ARG, turn svn blame minor mode on if ARG is positive, off otherwise. With ARG, turn svn blame minor mode on if ARG is positive, off otherwise.
Note: This mode does not yet work on XEmacs...
It is probably because the revisions are in 'before-string properties of overlays
Key bindings: Key bindings:
\\{svn-blame-mode-map}" \\{svn-blame-mode-map}"
(interactive "P") (interactive "P")
@ -5845,12 +5841,12 @@ The current buffer must contain a valid output from svn blame"
;; (when (overlay-get ov 'svn-blame-line-info) ;; (when (overlay-get ov 'svn-blame-line-info)
;; (delete-overlay ov))) ;; (delete-overlay ov)))
(while (and (not (eobp)) (< (point) limit)) (while (and (not (eobp)) (< (point) limit))
(setq s (buffer-substring-no-properties (svn-point-at-bol) (+ (svn-point-at-bol) info-end-col)))
(delete-region (svn-point-at-bol) (+ (svn-point-at-bol) info-end-col))
(setq ov (make-overlay (point) (point))) (setq ov (make-overlay (point) (point)))
(overlay-put ov 'svn-blame-line-info t) (overlay-put ov 'svn-blame-line-info t)
(setq s (buffer-substring-no-properties (svn-point-at-bol) (+ (svn-point-at-bol) info-end-col)))
(overlay-put ov 'before-string (propertize s 'face 'svn-status-blame-rev-number-face)) (overlay-put ov 'before-string (propertize s 'face 'svn-status-blame-rev-number-face))
(overlay-put ov 'rev-info (delete "" (split-string s " "))) (overlay-put ov 'rev-info (delete "" (split-string s " ")))
(delete-region (svn-point-at-bol) (+ (svn-point-at-bol) info-end-col))
(forward-line) (forward-line)
(setq line (1+ line))))) (setq line (1+ line)))))
(let* ((buf-name (format "*svn-blame: %s <%s>*" (let* ((buf-name (format "*svn-blame: %s <%s>*"
@ -6020,18 +6016,12 @@ You can send raw data to the process via \\[svn-process-send-string]."
(with-current-buffer (get-buffer-create svn-process-buffer-name) (with-current-buffer (get-buffer-create svn-process-buffer-name)
(setq old-process-default-dir default-directory) (setq old-process-default-dir default-directory)
(setq default-directory directory)) ;; update the default-directory for the *svn-process* buffer (setq default-directory directory)) ;; update the default-directory for the *svn-process* buffer
(svn-run nil t 'parse-info "info" ".") (svn-status-parse-info t)
(with-current-buffer svn-process-buffer-name (or (plist-get svn-status-base-info :repository-root)
;; (message "svn-status-repo-for-path: %s: default-directory: %s directory: %s old-process-default-dir: %s" svn-process-buffer-name default-directory directory old-process-default-dir) (if (plist-get svn-status-base-info :repository-uuid)
(setq default-directory old-process-default-dir) (concat "Svn Repo UUID: " (plist-get svn-status-base-info :repository-uuid))
(goto-char (point-min))
(let ((case-fold-search t))
(if (search-forward "repository root: " nil t)
(buffer-substring-no-properties (point) (svn-point-at-eol))
(when (search-forward "repository uuid: " nil t)
(message "psvn.el: Detected an old svn working copy in '%s'. Please check it out again to get a 'Repository Root' entry in the svn info output." (message "psvn.el: Detected an old svn working copy in '%s'. Please check it out again to get a 'Repository Root' entry in the svn info output."
default-directory) default-directory)))))
(concat "Svn Repo UUID: " (buffer-substring-no-properties (point) (svn-point-at-eol)))))))))
(defun svn-status-base-dir (&optional start-directory) (defun svn-status-base-dir (&optional start-directory)
"Find the svn root directory for the current working copy. "Find the svn root directory for the current working copy.
@ -6043,29 +6033,60 @@ Return nil, if not in a svn working copy."
base-dir base-dir
;; (message "calculating base-dir for %s" start-dir) ;; (message "calculating base-dir for %s" start-dir)
(svn-compute-svn-client-version) (svn-compute-svn-client-version)
(let* ((base-dir start-dir) ;; (message "repository-root: %s start-dir: %s" repository-root start-dir)
(repository-root (svn-status-repo-for-path base-dir)) (cond
(dot-svn-dir (concat base-dir (svn-wc-adm-dir-name))) ((and (<= (car svn-client-version) 1) (< (cadr svn-client-version) 3))
(in-tree (and repository-root (file-exists-p dot-svn-dir))) (setq base-dir (svn-status-base-dir-for-ancient-svn-client start-dir))) ;; svn version < 1.3
(dir-below (expand-file-name base-dir))) ((and (<= (car svn-client-version) 1) (< (cadr svn-client-version) 7))
;; (message "repository-root: %s start-dir: %s" repository-root start-dir) (setq base-dir (svn-status-base-dir-for-old-svn-client start-dir))) ;; svn version < 1.7
(if (and (<= (car svn-client-version) 1) (< (cadr svn-client-version) 3)) (t
(setq base-dir (svn-status-base-dir-for-ancient-svn-client start-dir)) ;; svn version < 1.3 (setq base-dir (svn-status-base-dir-1 start-dir))))
(while (when (and dir-below (file-exists-p dot-svn-dir)) (when base-dir
(setq base-dir (file-name-directory dot-svn-dir)) (svn-puthash start-dir base-dir svn-status-base-dir-cache))
(string-match "\\(.+/\\).+/" dir-below) (svn-status-message 7 "svn-status-base-dir %s => %s" start-dir base-dir)
(setq dir-below base-dir)))
(and (string-match "\\(.*/\\)[^/]+/" dir-below)
(match-string 1 dir-below))) (defun svn-status-base-dir-1 (&optional start-directory)
;; (message "base-dir: %s, dir-below: %s, dot-svn-dir: %s in-tree: %s" base-dir dir-below dot-svn-dir in-tree) "Find the svn root directory for the current working copy.
(when dir-below Return nil, if not in a svn working copy.
(if (string= (svn-status-repo-for-path dir-below) repository-root) This function is used for svn clients version 1.7 and up."
(setq dot-svn-dir (concat dir-below (svn-wc-adm-dir-name))) (let ((default-directory (if start-directory
(setq dir-below nil))))) (expand-file-name start-directory)
(setq base-dir (and in-tree base-dir))) (symbol-value 'default-directory)))
(svn-puthash start-dir base-dir svn-status-base-dir-cache) parent
(svn-status-message 7 "svn-status-base-dir %s => %s" start-dir base-dir) wc-root)
base-dir)))) (when (svn-version-controlled-dir-p default-directory)
(svn-status-parse-info t)
(setq wc-root (file-name-as-directory (plist-get svn-status-base-info :working-copy-root-path)))
(when wc-root
;; traversing up the hierarchy shortens the path name. Stop if
;; it doesn't, e.g we reached / already.
(setq parent (expand-file-name (concat wc-root "..")))
(or (and (< (length parent) (length wc-root))
(svn-status-base-dir-1 (expand-file-name (concat wc-root ".."))))
wc-root)))))
(defun svn-status-base-dir-for-old-svn-client (&optional start-directory)
"Find the svn root directory for the current working copy.
Return nil, if not in a svn working copy.
This function is used for svn clients version 1.6 and below."
(let* ((base-dir (expand-file-name (or start-directory default-directory)))
(repository-root (svn-status-repo-for-path base-dir))
(dot-svn-dir (concat base-dir (svn-wc-adm-dir-name)))
(in-tree (and repository-root (file-exists-p dot-svn-dir)))
(dir-below (expand-file-name base-dir)))
(while (when (and dir-below (file-exists-p dot-svn-dir))
(setq base-dir (file-name-directory dot-svn-dir))
(string-match "\\(.+/\\).+/" dir-below)
(setq dir-below
(and (string-match "\\(.*/\\)[^/]+/" dir-below)
(match-string 1 dir-below)))
;; (message "base-dir: %s, dir-below: %s, dot-svn-dir: %s in-tree: %s" base-dir dir-below dot-svn-dir in-tree)
(when dir-below
(if (string= (svn-status-repo-for-path dir-below) repository-root)
(setq dot-svn-dir (concat dir-below (svn-wc-adm-dir-name)))
(setq dir-below nil)))))
(and in-tree base-dir)))
(defun svn-status-base-dir-for-ancient-svn-client (&optional start-directory) (defun svn-status-base-dir-for-ancient-svn-client (&optional start-directory)
"Find the svn root directory for the current working copy. "Find the svn root directory for the current working copy.

View File

@ -1 +1 @@
SHA512 (subversion-1.9.5.tar.bz2) = ff7241ffae2506e97f40011242b5d5c6fa665f5463743f9acc52136b59ad84b6db00b60e70c44a9060579db49b818db06da1d1352aaee78e5bfe6ce56f32a2cf SHA512 (subversion-1.9.6.tar.bz2) = bdca362ff45a7f028e2123efbc9bfd41a07e6ebdfcf62627ce24f413e0304b45011bbac1f142ceb1c031a07622c06786982f86cd9109065cae5e26fd689fc11e