summaryrefslogtreecommitdiff
path: root/lisp/vc
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/vc')
-rw-r--r--lisp/vc/diff-mode.el6
-rw-r--r--lisp/vc/ediff-init.el36
-rw-r--r--lisp/vc/ediff-mult.el9
-rw-r--r--lisp/vc/ediff-ptch.el2
-rw-r--r--lisp/vc/ediff-util.el11
-rw-r--r--lisp/vc/ediff-vers.el25
-rw-r--r--lisp/vc/ediff-wind.el21
-rw-r--r--lisp/vc/pcvs-parse.el2
-rw-r--r--lisp/vc/smerge-mode.el15
-rw-r--r--lisp/vc/vc-bzr.el9
-rw-r--r--lisp/vc/vc-dir.el94
-rw-r--r--lisp/vc/vc-dispatcher.el3
-rw-r--r--lisp/vc/vc-git.el39
-rw-r--r--lisp/vc/vc-hg.el10
-rw-r--r--lisp/vc/vc-hooks.el8
-rw-r--r--lisp/vc/vc-rcs.el2
-rw-r--r--lisp/vc/vc-svn.el9
-rw-r--r--lisp/vc/vc.el82
18 files changed, 247 insertions, 136 deletions
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 8171a585158..d194d6c0a0e 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -484,7 +484,7 @@ and the face `diff-added' for added lines.")
;; Prefer second name as first is most likely to be a backup or
;; version-control name. The [\t\n] at the end of the unidiff pattern
;; catches Debian source diff files (which lack the trailing date).
- '((nil "\\+\\+\\+\\ \\([^\t\n]+\\)[\t\n]" 1) ; unidiffs
+ '((nil "\\+\\+\\+ \\([^\t\n]+\\)[\t\n]" 1) ; unidiffs
(nil "^--- \\([^\t\n]+\\)\t.*\n\\*" 1))) ; context diffs
;;;;
@@ -2720,7 +2720,9 @@ hunk text is not found in the source file."
;; When initialization is requested, we should be in a brand new
;; temp buffer.
(cl-assert (null buffer-file-name))
- (let ((enable-local-variables :safe) ;; to find `mode:'
+ ;; Use `:safe' to find `mode:'. In case of hunk-only, use nil because
+ ;; Local Variables list might be incomplete when context is truncated.
+ (let ((enable-local-variables (unless hunk-only :safe))
(buffer-file-name file))
;; Don't run hooks that might assume buffer-file-name
;; really associates buffer with a file (bug#39190).
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index fb1f25b6c6d..da6509b7cbe 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -452,6 +452,8 @@ For each buffer, the hooks are run with that buffer made current."
"Hook run after Ediff is loaded. Can be used to change defaults."
:type 'hook
:group 'ediff-hook)
+(make-obsolete-variable 'ediff-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom ediff-mode-hook nil
"Hook run just after ediff-mode is set up in the control buffer.
@@ -1255,22 +1257,8 @@ Instead, C-h would jump to previous difference."
:type 'boolean
:group 'ediff)
-;; This is the same as temporary-file-directory from Emacs 20.3.
-;; Copied over here because XEmacs doesn't have this variable.
-(defcustom ediff-temp-file-prefix
- (file-name-as-directory
- (cond ((boundp 'temporary-file-directory) temporary-file-directory)
- ((fboundp 'temp-directory) (temp-directory))
- (t "/tmp/")))
-;;; (file-name-as-directory
-;;; (cond ((memq system-type '(ms-dos windows-nt))
-;;; (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
-;;; (t
-;;; (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
- "Prefix to put on Ediff temporary file names.
-Do not start with `~/' or `~USERNAME/'."
- :type 'string
- :group 'ediff)
+(define-obsolete-variable-alias 'ediff-temp-file-prefix
+ 'temporary-file-directory "28.1")
(defcustom ediff-temp-file-mode 384 ; u=rw only
"Mode for Ediff temporary files."
@@ -1282,11 +1270,11 @@ Do not start with `~/' or `~USERNAME/'."
(defcustom ediff-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]"
"Regexp that matches characters that must be quoted with `\\' in shell command line.
This default should work without changes."
- :type 'string
+ :type 'regexp
:group 'ediff)
-;; needed to simulate frame-char-width in XEmacs.
-(defvar ediff-H-glyph (if (featurep 'xemacs) (make-glyph "H")))
+(defvar ediff-H-glyph nil)
+(make-obsolete-variable 'ediff-H-glyph nil "28.1")
;; Temporary file used for refining difference regions in buffer A.
@@ -1522,16 +1510,6 @@ This default should work without changes."
(setq dir (substring dir 0 pos)))
(ediff-abbreviate-file-name (file-name-directory dir))))
-(defun ediff-truncate-string-left (str newlen)
- ;; leave space for ... on the left
- (let ((len (length str))
- substr)
- (if (<= len newlen)
- str
- (setq newlen (max 0 (- newlen 3)))
- (setq substr (substring str (max 0 (- len 1 newlen))))
- (concat "..." substr))))
-
(defsubst ediff-nonempty-string-p (string)
(and (stringp string) (not (string= string ""))))
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index fee87e8352e..2b1b07927f8 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -113,7 +113,6 @@
(require 'ediff-wind)
(require 'ediff-util)
-
;; meta-buffer
(ediff-defvar-local ediff-meta-buffer nil "")
(ediff-defvar-local ediff-parent-meta-buffer nil "")
@@ -1172,7 +1171,7 @@ behavior."
;; abbreviate the file name, if file exists
(if (and (not (stringp fname)) (< file-size -1))
"-------" ; file doesn't exist
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name fname)
max-filename-width)))))))
@@ -1266,7 +1265,7 @@ Useful commands:
(if (= (mod membership-code ediff-membership-code1) 0) ; dir1
(let ((beg (point)))
(insert (format "%-27s"
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir1 file))
(file-name-as-directory file)
@@ -1281,7 +1280,7 @@ Useful commands:
(if (= (mod membership-code ediff-membership-code2) 0) ; dir2
(let ((beg (point)))
(insert (format "%-26s"
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir2 file))
(file-name-as-directory file)
@@ -1295,7 +1294,7 @@ Useful commands:
(if (= (mod membership-code ediff-membership-code3) 0) ; dir3
(let ((beg (point)))
(insert (format " %-25s"
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir3 file))
(file-name-as-directory file)
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index cb0ae6ff6e1..f6af5a45550 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -119,7 +119,7 @@ patch. So, don't change these variables, unless the default doesn't work."
(defcustom ediff-context-diff-label-regexp
(let ((stuff "\\([^ \t\n]+\\)"))
(concat "\\(" ; context diff 2-liner
- "^\\*\\*\\* +" stuff "[^*]+[\t ]*\n--- +" stuff
+ "^\\*\\*\\* +" stuff "[^*]+\n--- +" stuff
"\\|" ; unified format diff 2-liner
"^--- +" stuff ".*\n\\+\\+\\+ +" stuff
"\\)"))
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index a8af9ba37a2..4a84c1ecd9c 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -131,7 +131,6 @@ to invocation.")
(define-key ediff-mode-map [delete] 'ediff-previous-difference)
(define-key ediff-mode-map "\C-h" (if ediff-no-emacs-help-in-control-buffer
'ediff-previous-difference nil))
- ;; must come after C-h, or else C-h wipes out backspace's binding in XEmacs
(define-key ediff-mode-map [backspace] 'ediff-previous-difference)
(define-key ediff-mode-map [?\S-\ ] 'ediff-previous-difference)
(define-key ediff-mode-map "n" 'ediff-next-difference)
@@ -1540,10 +1539,10 @@ the width of the A/B/C windows."
;; hscrolling.
(if (= last-command-event ?<)
(lambda (arg)
- (let ((prefix-arg arg))
+ (let ((current-prefix-arg arg))
(call-interactively #'scroll-left)))
(lambda (arg)
- (let ((prefix-arg arg))
+ (let ((current-prefix-arg arg))
(call-interactively #'scroll-right))))
;; calculate argument to scroll-left/right
;; if there is an explicit argument
@@ -3144,8 +3143,8 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(> (length p) 2))
(setq short-p (substring p 0 2)))
- (setq f (concat ediff-temp-file-prefix p)
- short-f (concat ediff-temp-file-prefix short-p)
+ (setq f (concat temporary-file-directory p)
+ short-f (concat temporary-file-directory short-p)
f (cond (given-file)
((find-file-name-handler f 'insert-file-contents)
;; to thwart file name handlers in write-region,
@@ -3449,7 +3448,6 @@ Without an argument, it saves customized diff argument, if available
(declare-function ediff-regions-internal "ediff"
(buffer-a beg-a end-a buffer-b beg-b end-b
startup-hooks job-name word-mode setup-parameters))
-(defvar zmacs-regions) ;;XEmacs'ism.
(defun ediff-inferior-compare-regions ()
"Compare regions in an active Ediff session.
@@ -3461,7 +3459,6 @@ Ediff Control Panel to restore highlighting."
(interactive)
(let ((answer "")
(possibilities (list ?A ?B ?C))
- (zmacs-regions t)
use-current-diff-p
begA begB endA endB bufA bufB)
diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el
index a95606fad5e..4ee7ee5c1f5 100644
--- a/lisp/vc/ediff-vers.el
+++ b/lisp/vc/ediff-vers.el
@@ -49,15 +49,10 @@ comparison or merge operations are being performed."
:group 'ediff-vers
)
-(defalias 'ediff-vc-revision-other-window
- (if (fboundp 'vc-revision-other-window)
- 'vc-revision-other-window
- 'vc-version-other-window))
-
-(defalias 'ediff-vc-working-revision
- (if (fboundp 'vc-working-revision)
- 'vc-working-revision
- 'vc-workfile-version))
+(define-obsolete-function-alias 'ediff-vc-revision-other-window
+ #'vc-revision-other-window "28.1")
+(define-obsolete-function-alias 'ediff-vc-working-revision
+ #'vc-working-revision "28.1")
;; VC.el support
@@ -88,12 +83,12 @@ comparison or merge operations are being performed."
(setq rev1 (ediff-vc-latest-version (buffer-file-name))))
(save-window-excursion
(save-excursion
- (ediff-vc-revision-other-window rev1)
+ (vc-revision-other-window rev1)
(setq rev1buf (current-buffer)
file1 (buffer-file-name)))
(save-excursion
(or (string= rev2 "") ; use current buffer
- (ediff-vc-revision-other-window rev2))
+ (vc-revision-other-window rev2))
(setq rev2buf (current-buffer)
file2 (buffer-file-name)))
(push (lambda ()
@@ -165,18 +160,18 @@ comparison or merge operations are being performed."
(let (buf1 buf2 ancestor-buf)
(save-window-excursion
(save-excursion
- (ediff-vc-revision-other-window rev1)
+ (vc-revision-other-window rev1)
(setq buf1 (current-buffer)))
(save-excursion
(or (string= rev2 "")
- (ediff-vc-revision-other-window rev2))
+ (vc-revision-other-window rev2))
(setq buf2 (current-buffer)))
(if ancestor-rev
(save-excursion
(if (string= ancestor-rev "")
- (setq ancestor-rev (ediff-vc-working-revision
+ (setq ancestor-rev (vc-working-revision
buffer-file-name)))
- (ediff-vc-revision-other-window ancestor-rev)
+ (vc-revision-other-window ancestor-rev)
(setq ancestor-buf (current-buffer))))
(push (let ((f1 (buffer-file-name buf1))
(f2 (unless (string= rev2 "") (buffer-file-name buf2)))
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 7b2e1109c87..a23d72070ab 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -156,12 +156,10 @@ In this case, Ediff will use those frames to display these buffers."
'(name . "Ediff")
;;'(unsplittable . t)
'(minibuffer . nil)
- '(user-position . t) ; Emacs only
- '(vertical-scroll-bars . nil) ; Emacs only
- '(scrollbar-width . 0) ; XEmacs only
- '(scrollbar-height . 0) ; XEmacs only
- '(menu-bar-lines . 0) ; Emacs only
- '(tool-bar-lines . 0) ; Emacs 21+ only
+ '(user-position . t)
+ '(vertical-scroll-bars . nil)
+ '(menu-bar-lines . 0)
+ '(tool-bar-lines . 0)
'(left-fringe . 0)
'(right-fringe . 0)
;; don't lower but auto-raise
@@ -260,10 +258,9 @@ the frame used for the wide display.")
This has effect only on a windowing system.
If t, hitting `?' to toggle control panel off iconifies it.
-This is only useful in Emacs and only for certain kinds of window managers,
-such as TWM and its derivatives, since the window manager must permit
-keyboard input to go into icons. XEmacs completely ignores keyboard input
-into icons, regardless of the window manager."
+This is only useful for certain kinds of window managers, such as
+TWM and its derivatives, since the window manager must permit
+keyboard input to go into icons."
:type 'boolean)
;;; Functions
@@ -952,8 +949,7 @@ create a new splittable frame if none is found."
;; just a precaution--we should be in ctl-buffer already
(with-current-buffer ctl-buffer
(make-local-variable 'frame-title-format)
- (make-local-variable 'frame-icon-title-format) ; XEmacs
- (make-local-variable 'icon-title-format)) ; Emacs
+ (make-local-variable 'icon-title-format))
(ediff-setup-control-buffer ctl-buffer)
(setq dont-iconify-ctl-frame
@@ -1098,6 +1094,7 @@ create a new splittable frame if none is found."
)))
(defun ediff-xemacs-select-frame-hook ()
+ (declare (obsolete nil "28.1"))
(if (and (equal (selected-frame) ediff-control-frame)
(not ediff-use-long-help-message))
(raise-frame ediff-control-frame)))
diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el
index 466c621311f..dd56aec94a0 100644
--- a/lisp/vc/pcvs-parse.el
+++ b/lisp/vc/pcvs-parse.el
@@ -472,7 +472,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
;; Let's not get all worked up if the format changes a bit
(cvs-match " *Working revision:.*$"))
(cvs-or
- (cvs-match " *RCS Version:[ \t]*\\([0-9.]+\\)[ \t]*.*$" (head-rev 1))
+ (cvs-match " *RCS Version:[ \t]*\\([0-9.]+\\).*$" (head-rev 1))
(cvs-match " *Repository revision:[ \t]*\\([0-9.]+\\)[ \t]*\\(.*\\)$"
(head-rev 1))
(cvs-match " *Repository revision:.*"))
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 85868b91ecc..d0a83fd7c49 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -1429,15 +1429,16 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict."
(smerge-remove-props (point-min) (point-max))))
;;;###autoload
-(defun smerge-start-session ()
+(defun smerge-start-session (&optional interactively)
"Turn on `smerge-mode' and move point to first conflict marker.
If no conflict maker is found, turn off `smerge-mode'."
- (interactive)
- (smerge-mode 1)
- (condition-case nil
- (unless (looking-at smerge-begin-re)
- (smerge-next))
- (error (smerge-auto-leave))))
+ (interactive "p")
+ (when (or (null smerge-mode) interactively)
+ (smerge-mode 1)
+ (condition-case nil
+ (unless (looking-at smerge-begin-re)
+ (smerge-next))
+ (error (smerge-auto-leave)))))
(defcustom smerge-change-buffer-confirm t
"If non-nil, request confirmation before moving to another buffer."
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index e5d307e7ede..f98730ed221 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -1316,6 +1316,15 @@ stream. Standard error output is discarded."
vc-bzr-revision-keywords))
string pred)))))
+(defun vc-bzr-repository-url (file-or-dir &optional _remote-name)
+ (let ((default-directory (vc-bzr-root file-or-dir)))
+ (with-temp-buffer
+ (vc-bzr-command "info" (current-buffer) 0 nil)
+ (goto-char (point-min))
+ (if (re-search-forward "parent branch: \\(.*\\)$" nil t)
+ (match-string 1)
+ (error "Cannot determine Bzr repository URL")))))
+
(provide 'vc-bzr)
;;; vc-bzr.el ends here
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 38b4937e854..cdf8ab984e8 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -147,6 +147,12 @@ See `run-hooks'."
'(menu-item "Unmark Previous " vc-dir-unmark-file-up
:help "Move to the previous line and unmark the file"))
+ (define-key map [mark-unregistered]
+ '(menu-item "Mark Unregistered" vc-dir-mark-unregistered-files
+ :help "Mark all files in the unregistered state"))
+ (define-key map [mark-registered]
+ '(menu-item "Mark Registered" vc-dir-mark-registered-files
+ :help "Mark all files in the state edited, added or removed"))
(define-key map [mark-all]
'(menu-item "Mark All" vc-dir-mark-all-files
:help "Mark all files that are in the same state as the current file\
@@ -310,6 +316,10 @@ See `run-hooks'."
(define-key branch-map "l" 'vc-print-branch-log)
(define-key branch-map "s" 'vc-retrieve-tag))
+ (let ((mark-map (make-sparse-keymap)))
+ (define-key map "*" mark-map)
+ (define-key mark-map "r" 'vc-dir-mark-registered-files))
+
;; Hook up the menu.
(define-key map [menu-bar vc-dir-mode]
`(menu-item
@@ -696,6 +706,38 @@ share the same state."
(vc-dir-mark-file crt)))
(setq crt (ewoc-next vc-ewoc crt))))))))
+(defun vc-dir-mark-files (mark-files)
+ "Mark files specified by file names in the argument MARK-FILES.
+MARK-FILES should be a list of absolute filenames."
+ (ewoc-map
+ (lambda (filearg)
+ (when (member (expand-file-name (vc-dir-fileinfo->name filearg))
+ mark-files)
+ (setf (vc-dir-fileinfo->marked filearg) t)
+ t))
+ vc-ewoc))
+
+(defun vc-dir-mark-state-files (states)
+ "Mark files that are in the state specified by the list in STATES."
+ (unless (listp states)
+ (setq states (list states)))
+ (ewoc-map
+ (lambda (filearg)
+ (when (memq (vc-dir-fileinfo->state filearg) states)
+ (setf (vc-dir-fileinfo->marked filearg) t)
+ t))
+ vc-ewoc))
+
+(defun vc-dir-mark-registered-files ()
+ "Mark files that are in one of registered state: edited, added or removed."
+ (interactive)
+ (vc-dir-mark-state-files '(edited added removed)))
+
+(defun vc-dir-mark-unregistered-files ()
+ "Mark files that are in unregistered state."
+ (interactive)
+ (vc-dir-mark-state-files 'unregistered))
+
(defun vc-dir-unmark-file ()
;; Unmark the current file and move to the next line.
(let* ((crt (ewoc-locate vc-ewoc))
@@ -1064,6 +1106,7 @@ the *vc-dir* buffer.
(set (make-local-variable 'vc-dir-backend) use-vc-backend)
(set (make-local-variable 'desktop-save-buffer)
'vc-dir-desktop-buffer-misc-data)
+ (setq-local bookmark-make-record-function #'vc-dir-bookmark-make-record)
(setq buffer-read-only t)
(when (boundp 'tool-bar-map)
(set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map))
@@ -1193,7 +1236,8 @@ Throw an error if another update process is in progress."
(if remaining
(vc-dir-refresh-files
(mapcar 'vc-dir-fileinfo->name remaining))
- (setq mode-line-process nil))))))))))))
+ (setq mode-line-process nil)
+ (run-hooks 'vc-dir-refresh-hook))))))))))))
(defun vc-dir-show-fileentry (file)
"Insert an entry for a specific file into the current *VC-dir* listing.
@@ -1287,6 +1331,16 @@ state of item at point, if any."
(list vc-dir-backend files only-files-list state model)))
;;;###autoload
+(defun vc-dir-root ()
+ "Run `vc-dir' in the repository root directory without prompt.
+If the default directory of the current buffer is
+not under version control, prompt for a directory."
+ (interactive)
+ (let ((root-dir (vc-root-dir)))
+ (if root-dir (vc-dir root-dir)
+ (call-interactively 'vc-dir))))
+
+;;;###autoload
(defun vc-dir (dir &optional backend)
"Show the VC status for \"interesting\" files in and below DIR.
This allows you to mark files and perform VC operations on them.
@@ -1309,7 +1363,7 @@ These are the commands available for use in the file status buffer:
;; When you hit C-x v d in a visited VC file,
;; the *vc-dir* buffer visits the directory under its truename;
;; therefore it makes sense to always do that.
- ;; Otherwise if you do C-x v d -> C-x C-f -> C-c v d
+ ;; Otherwise if you do C-x v d -> C-x C-f -> C-x v d
;; you may get a new *vc-dir* buffer, different from the original
(file-truename (read-directory-name "VC status for directory: "
(vc-root-dir) nil t
@@ -1413,6 +1467,42 @@ These are the commands available for use in the file status buffer:
'(vc-dir-mode . vc-dir-restore-desktop-buffer))
+;;; Support for bookmark.el (adapted from what info.el does).
+
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+(declare-function bookmark-default-handler "bookmark" (bmk))
+(declare-function bookmark-get-bookmark-record "bookmark" (bmk))
+
+(defun vc-dir-bookmark-make-record ()
+ "Make record used to bookmark a `vc-dir' buffer.
+This implements the `bookmark-make-record-function' type for
+`vc-dir' buffers."
+ (let* ((bookmark-name
+ (concat "(" (symbol-name vc-dir-backend) ") "
+ (file-name-nondirectory
+ (directory-file-name default-directory))))
+ (defaults (list bookmark-name default-directory)))
+ `(,bookmark-name
+ ,@(bookmark-make-record-default 'no-file)
+ (filename . ,default-directory)
+ (handler . vc-dir-bookmark-jump)
+ (defaults . ,defaults))))
+
+;;;###autoload
+(defun vc-dir-bookmark-jump (bmk)
+ "Provides the bookmark-jump behavior for a `vc-dir' buffer.
+This implements the `handler' function interface for the record
+type returned by `vc-dir-bookmark-make-record'."
+ (let* ((file (bookmark-prop-get bmk 'filename))
+ (buf (progn ;; Don't use save-window-excursion (bug#39722)
+ (vc-dir file)
+ (current-buffer))))
+ (bookmark-default-handler
+ `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk)))))
+
+
(provide 'vc-dir)
;;; vc-dir.el ends here
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 5ae300bf09b..4a04c9365a5 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -746,7 +746,8 @@ the buffer contents as a comment."
(defun vc-dispatcher-browsing ()
"Are we in a directory browser buffer?"
- (derived-mode-p 'vc-dir-mode))
+ (or (derived-mode-p 'vc-dir-mode)
+ (derived-mode-p 'dired-mode)))
;; These are unused.
;; (defun vc-dispatcher-in-fileset-p (fileset)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 61e6c642d1f..e0cf9e79595 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -72,6 +72,7 @@
;; by git, so it's probably
;; not a good idea.
;; - merge-news (file) see `merge-file'
+;; - mark-resolved (file) OK
;; - steal-lock (file &optional revision) NOT NEEDED
;; HISTORY FUNCTIONS
;; * print-log (files buffer &optional shortlog start-revision limit) OK
@@ -100,6 +101,7 @@
;; - rename-file (old new) OK
;; - find-file-hook () OK
;; - conflicted-files OK
+;; - repository-url (file-or-dir) OK
;;; Code:
@@ -166,7 +168,7 @@ format string (which is passed to \"git log\" via the argument
\"--pretty=tformat:FORMAT\"), REGEXP is a regular expression
matching the resulting Git log output, and KEYWORDS is a list of
`font-lock-keywords' for highlighting the Log View buffer."
- :type '(list string string (repeat sexp))
+ :type '(list string regexp (repeat sexp))
:version "24.1")
(defcustom vc-git-commits-coding-system 'utf-8
@@ -733,6 +735,7 @@ or an empty string if none."
(with-current-buffer standard-output
(vc-git--out-ok "symbolic-ref" "HEAD"))))
(stash-list (vc-git-stash-list))
+ (default-directory dir)
branch remote remote-url stash-button stash-string)
(if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
@@ -745,14 +748,8 @@ or an empty string if none."
(concat "branch." branch ".remote")))))
(when (string-match "\\([^\n]+\\)" remote)
(setq remote (match-string 1 remote)))
- (when remote
- (setq remote-url
- (with-output-to-string
- (with-current-buffer standard-output
- (vc-git--out-ok "config"
- (concat "remote." remote ".url"))))))
- (when (string-match "\\([^\n]+\\)" remote-url)
- (setq remote-url (match-string 1 remote-url))))
+ (when (> (length remote) 0)
+ (setq remote-url (vc-git-repository-url dir remote))))
(setq branch "not (detached HEAD)"))
(when stash-list
(let* ((len (length stash-list))
@@ -807,7 +804,7 @@ or an empty string if none."
(propertize "Branch : " 'face 'font-lock-type-face)
(propertize branch
'face 'font-lock-variable-name-face)
- (when remote
+ (when remote-url
(concat
"\n"
(propertize "Remote : " 'face 'font-lock-type-face)
@@ -819,10 +816,10 @@ or an empty string if none."
(when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root dir)))
(propertize "\nRebase : in progress" 'face 'font-lock-warning-face))
(if stash-list
- (concat
- (propertize "\nStash : " 'face 'font-lock-type-face)
- stash-button
- stash-string)
+ (concat
+ (propertize "\nStash : " 'face 'font-lock-type-face)
+ stash-button
+ stash-string)
(concat
(propertize "\nStash : " 'face 'font-lock-type-face)
(propertize "Nothing stashed"
@@ -1081,6 +1078,13 @@ This prompts for a branch to merge from."
"DU" "AA" "UU"))
(push (expand-file-name file directory) files)))))))
+(defun vc-git-repository-url (file-or-dir &optional remote-name)
+ (let ((default-directory (vc-git-root file-or-dir)))
+ (with-temp-buffer
+ (vc-git-command (current-buffer) 0 nil "remote" "get-url"
+ (or remote-name "origin"))
+ (buffer-substring-no-properties (point-min) (1- (point-max))))))
+
;; Everywhere but here, follows vc-git-command, which uses vc-do-command
;; from vc-dispatcher.
(autoload 'vc-resynch-buffer "vc-dispatcher")
@@ -1233,7 +1237,7 @@ log entries."
(set (make-local-variable 'log-view-message-re)
(if (not (memq vc-log-view-type '(long log-search with-diff)))
(cadr vc-git-root-log-format)
- "^commit *\\([0-9a-z]+\\)"))
+ "^commit +\\([0-9a-z]+\\)"))
;; Allow expanding short log entries.
(when (memq vc-log-view-type '(short log-outgoing log-incoming mergebase))
(setq truncate-lines t)
@@ -1262,7 +1266,7 @@ log entries."
("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
(1 'change-log-acknowledgment)
(2 'change-log-acknowledgment))
- ("^Date: \\(.+\\)" (1 'change-log-date))
+ ("^\\(?:Date: \\|AuthorDate: \\)\\(.+\\)" (1 'change-log-date))
("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
@@ -1530,6 +1534,9 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(defun vc-git-rename-file (old new)
(vc-git-command nil 0 (list old new) "mv" "-f" "--"))
+(defun vc-git-mark-resolved (files)
+ (vc-git-command nil 0 files "add"))
+
(defvar vc-git-extra-menu-map
(let ((map (make-sparse-keymap)))
(define-key map [git-grep]
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index d00b69c0d08..95ced7b8d09 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -182,7 +182,7 @@ is the \"--template\" argument string to pass to Mercurial,
REGEXP is a regular expression matching the resulting Mercurial
output, and KEYWORDS is a list of `font-lock-keywords' for
highlighting the Log View buffer."
- :type '(list string string (repeat sexp))
+ :type '(list string regexp (repeat sexp))
:group 'vc-hg
:version "24.5")
@@ -1525,6 +1525,14 @@ This function differs from vc-do-command in that it invokes
(defun vc-hg-root (file)
(vc-find-root file ".hg"))
+(defun vc-hg-repository-url (file-or-dir &optional remote-name)
+ (let ((default-directory (vc-hg-root file-or-dir)))
+ (with-temp-buffer
+ (vc-hg-command (current-buffer) 0 nil
+ "config"
+ (concat "paths." (or remote-name "default")))
+ (buffer-substring-no-properties (point-min) (1- (point-max))))))
+
(provide 'vc-hg)
;;; vc-hg.el ends here
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 345a28d3f1d..ce72a49b955 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -498,7 +498,7 @@ status of this file. Otherwise, the value returned is one of:
"Return the repository version from which FILE was checked out.
If FILE is not registered, this function always returns nil."
(or (vc-file-getprop file 'vc-working-revision)
- (progn
+ (let ((default-directory (file-name-directory file)))
(setq backend (or backend (vc-backend file)))
(when backend
(vc-file-setprop file 'vc-working-revision
@@ -972,9 +972,9 @@ In the latter case, VC mode is deactivated for this buffer."
(bindings--define-key map [vc-ignore]
'(menu-item "Ignore File..." vc-ignore
:help "Ignore a file under current version control system"))
- (bindings--define-key map [vc-dir]
- '(menu-item "VC Dir" vc-dir
- :help "Show the VC status of files in a directory"))
+ (bindings--define-key map [vc-dir-root]
+ '(menu-item "VC Dir" vc-dir-root
+ :help "Show the VC status of the repository"))
map))
(defalias 'vc-menu-map vc-menu-map)
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 273f37c10d6..23f088b0cff 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -312,7 +312,7 @@ whether to remove it."
(and (string= (file-name-nondirectory (directory-file-name dir)) "RCS")
;; check whether RCS dir is empty, i.e. it does not
;; contain any files except "." and ".."
- (not (directory-files dir nil (rx (or (not ".") "..."))))
+ (not (directory-files dir nil directory-files-no-dot-files-regexp))
(yes-or-no-p (format "Directory %s is empty; remove it? " dir))
(delete-directory dir)))))
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index d039bf3c6a3..e108b3a340f 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -816,7 +816,14 @@ Set file properties accordingly. If FILENAME is non-nil, return its status."
(push (match-string 1 loglines) vc-svn-revisions)
(setq start (+ start (match-end 0)))
(setq loglines (buffer-substring-no-properties start (point-max)))))
- vc-svn-revisions)))
+ vc-svn-revisions)))
+
+(defun vc-svn-repository-url (file-or-dir &optional _remote-name)
+ (let ((default-directory (vc-svn-root file-or-dir)))
+ (with-temp-buffer
+ (vc-svn-command (current-buffer) 0 nil
+ "info" "--show-item" "repos-root-url")
+ (buffer-substring-no-properties (point-min) (1- (point-max))))))
(provide 'vc-svn)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index fe666413168..65775f8e46e 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -553,6 +553,13 @@
;; Return the list of files where conflict resolution is needed in
;; the project that contains DIR.
;; FIXME: what should it do with non-text conflicts?
+;;
+;; - repository-url (file-or-dir &optional remote-name)
+;;
+;; Returns the URL of the repository of the current checkout
+;; containing FILE-OR-DIR. The optional REMOTE-NAME specifies the
+;; remote (in Git parlance) whose URL is to be returned. It has
+;; only a meaning for distributed VCS and is ignored otherwise.
;;; Changes from the pre-25.1 API:
;;
@@ -957,7 +964,7 @@ use."
(throw 'found bk))))
;;;###autoload
-(defun vc-responsible-backend (file)
+(defun vc-responsible-backend (file &optional no-error)
"Return the name of a backend system that is responsible for FILE.
If FILE is already registered, return the
@@ -967,7 +974,10 @@ responsible for FILE is returned.
Note that if FILE is a symbolic link, it will not be resolved --
the responsible backend system for the symbolic link itself will
-be reported."
+be reported.
+
+If NO-ERROR is nil, signal an error that no VC backend is
+responsible for the given file."
(or (and (not (file-directory-p file)) (vc-backend file))
(catch 'found
;; First try: find a responsible backend. If this is for registration,
@@ -975,7 +985,8 @@ be reported."
(dolist (backend vc-handled-backends)
(and (vc-call-backend backend 'responsible-p file)
(throw 'found backend))))
- (error "No VC backend is responsible for %s" file)))
+ (unless no-error
+ (error "No VC backend is responsible for %s" file))))
(defun vc-expand-dirs (file-or-dir-list backend)
"Expands directories in a file list specification.
@@ -1006,35 +1017,47 @@ Within directories, only files already under version control are noticed."
(declare-function vc-dir-current-file "vc-dir" ())
(declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files))
+(declare-function dired-vc-deduce-fileset "dired-aux" (&optional state-model-only-files not-state-changing))
-(defun vc-deduce-fileset (&optional observer allow-unregistered
+(defun vc-deduce-fileset (&optional not-state-changing
+ allow-unregistered
state-model-only-files)
"Deduce a set of files and a backend to which to apply an operation.
-Return (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL).
+Return a list of the form:
+
+ (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL)
-If we're in VC-dir mode, FILESET is the list of marked files,
-or the directory if no files are marked.
-Otherwise, if in a buffer visiting a version-controlled file,
-FILESET is a single-file fileset containing that file.
+where the last 3 members are optional, and must be present only if
+STATE-MODEL-ONLY-FILES is non-nil.
+
+NOT-STATE-CHANGING, if non-nil, means that the operation
+requesting the fileset doesn't intend to change the VC state,
+such as when printing the log or showing the diffs.
+
+If the current buffer is in `vc-dir' or Dired mode, FILESET is the
+list of marked files, or the current directory if no files are
+marked.
+Otherwise, if the current buffer is visiting a version-controlled
+file, FILESET is a single-file list containing that file's name.
Otherwise, if ALLOW-UNREGISTERED is non-nil and the visited file
-is unregistered, FILESET is a single-file fileset containing it.
+is unregistered, FILESET is a single-file list containing the
+name of the visited file.
Otherwise, throw an error.
-STATE-MODEL-ONLY-FILES if non-nil, means that the caller needs
-the FILESET-ONLY-FILES STATE and MODEL info. Otherwise, that
-part may be skipped.
+STATE-MODEL-ONLY-FILES, if non-nil, means that the caller needs
+the FILESET-ONLY-FILES, STATE, and CHECKOUT-MODEL info, where
+FILESET-ONLY-FILES means only files in similar VC states,
+possible values of STATE are explained in `vc-state', and MODEL in
+`vc-checkout-model'. Otherwise, these 3 members may be omitted from
+the returned list.
BEWARE: this function may change the current buffer."
- ;; FIXME: OBSERVER is unused. The name is not intuitive and is not
- ;; documented. It's set to t when called from diff and print-log.
(let (backend)
(cond
((derived-mode-p 'vc-dir-mode)
(vc-dir-deduce-fileset state-model-only-files))
((derived-mode-p 'dired-mode)
- (if observer
- (vc-dired-deduce-fileset)
- (error "State changing VC operations not supported in `dired-mode'")))
+ (dired-vc-deduce-fileset state-model-only-files not-state-changing))
((setq backend (vc-backend buffer-file-name))
(if state-model-only-files
(list backend (list buffer-file-name)
@@ -1046,15 +1069,14 @@ BEWARE: this function may change the current buffer."
;; FIXME: Why this test? --Stef
(or (buffer-file-name vc-parent-buffer)
(with-current-buffer vc-parent-buffer
- (derived-mode-p 'vc-dir-mode))))
+ (or (derived-mode-p 'vc-dir-mode)
+ (derived-mode-p 'dired-mode)))))
(progn ;FIXME: Why not `with-current-buffer'? --Stef.
(set-buffer vc-parent-buffer)
- (vc-deduce-fileset observer allow-unregistered state-model-only-files)))
- ((and (derived-mode-p 'log-view-mode)
+ (vc-deduce-fileset not-state-changing allow-unregistered state-model-only-files)))
+ ((and (not buffer-file-name)
(setq backend (vc-responsible-backend default-directory)))
(list backend nil))
- ((not buffer-file-name)
- (error "Buffer %s is not associated with a file" (buffer-name)))
((and allow-unregistered (not (vc-registered buffer-file-name)))
(if state-model-only-files
(list (vc-backend-for-registration (buffer-file-name))
@@ -1066,10 +1088,6 @@ BEWARE: this function may change the current buffer."
(list buffer-file-name))))
(t (error "File is not under version control")))))
-(defun vc-dired-deduce-fileset ()
- (list (vc-responsible-backend default-directory)
- (dired-map-over-marks (dired-get-filename nil t) nil)))
-
(defun vc-ensure-vc-buffer ()
"Make sure that the current buffer visits a version-controlled file."
(cond
@@ -2537,15 +2555,17 @@ with its diffs (if the underlying VCS supports that)."
;;;###autoload
(defun vc-print-branch-log (branch)
- "Show the change log for BRANCH in a window."
+ "Show the change log for BRANCH root in a window."
(interactive
(list
(vc-read-revision "Branch to log: ")))
(when (equal branch "")
(error "No branch specified"))
- (vc-print-log-internal (vc-responsible-backend default-directory)
- (list default-directory) branch t
- (when (> vc-log-show-limit 0) vc-log-show-limit)))
+ (let* ((backend (vc-responsible-backend default-directory))
+ (rootdir (vc-call-backend backend 'root default-directory)))
+ (vc-print-log-internal backend
+ (list rootdir) branch t
+ (when (> vc-log-show-limit 0) vc-log-show-limit))))
;;;###autoload
(defun vc-log-incoming (&optional remote-location)
generated by cgit v1.2.3 (git 2.39.1) at 2025-05-16 03:08:57 +0000