summaryrefslogtreecommitdiff
path: root/lisp/vc-git.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/vc-git.el')
-rw-r--r--lisp/vc-git.el291
1 files changed, 202 insertions, 89 deletions
diff --git a/lisp/vc-git.el b/lisp/vc-git.el
index 0d35afa739e..fe7b95cb43a 100644
--- a/lisp/vc-git.el
+++ b/lisp/vc-git.el
@@ -43,64 +43,64 @@
;; beginning of vc.el. The current status is:
;; ("??" means: "figure out what to do about it")
;;
-;; FUNCTION NAME STATUS
+;; FUNCTION NAME STATUS
;; BACKEND PROPERTIES
-;; * revision-granularity OK
+;; * revision-granularity OK
;; STATE-QUERYING FUNCTIONS
-;; * registered (file) OK
-;; * state (file) OK
-;; - state-heuristic (file) NOT NEEDED
-;; * working-revision (file) OK
-;; - latest-on-branch-p (file) NOT NEEDED
-;; * checkout-model (files) OK
-;; - workfile-unchanged-p (file) OK
-;; - mode-line-string (file) OK
+;; * registered (file) OK
+;; * state (file) OK
+;; - state-heuristic (file) NOT NEEDED
+;; * working-revision (file) OK
+;; - latest-on-branch-p (file) NOT NEEDED
+;; * checkout-model (files) OK
+;; - workfile-unchanged-p (file) OK
+;; - mode-line-string (file) OK
;; STATE-CHANGING FUNCTIONS
-;; * create-repo () OK
-;; * register (files &optional rev comment) OK
-;; - init-revision (file) NOT NEEDED
-;; - responsible-p (file) OK
-;; - could-register (file) NOT NEEDED, DEFAULT IS GOOD
-;; - receive-file (file rev) NOT NEEDED
-;; - unregister (file) OK
-;; * checkin (files rev comment) OK
-;; * find-revision (file rev buffer) OK
-;; * checkout (file &optional editable rev) OK
-;; * revert (file &optional contents-done) OK
-;; - rollback (files) COULD BE SUPPORTED
+;; * create-repo () OK
+;; * register (files &optional rev comment) OK
+;; - init-revision (file) NOT NEEDED
+;; - responsible-p (file) OK
+;; - could-register (file) NOT NEEDED, DEFAULT IS GOOD
+;; - receive-file (file rev) NOT NEEDED
+;; - unregister (file) OK
+;; * checkin (files rev comment) OK
+;; * find-revision (file rev buffer) OK
+;; * checkout (file &optional editable rev) OK
+;; * revert (file &optional contents-done) OK
+;; - rollback (files) COULD BE SUPPORTED
;; - merge (file rev1 rev2) It would be possible to merge
;; changes into a single file, but when
;; committing they wouldn't
;; be identified as a merge
;; by git, so it's probably
;; not a good idea.
-;; - merge-news (file) see `merge'
-;; - steal-lock (file &optional revision) NOT NEEDED
+;; - merge-news (file) see `merge'
+;; - steal-lock (file &optional revision) NOT NEEDED
;; HISTORY FUNCTIONS
-;; * print-log (files &optional buffer) OK
-;; - log-view-mode () OK
-;; - show-log-entry (revision) OK
-;; - comment-history (file) ??
-;; - update-changelog (files) COULD BE SUPPORTED
-;; * diff (file &optional rev1 rev2 buffer) OK
-;; - revision-completion-table (files) OK
-;; - annotate-command (file buf &optional rev) OK
-;; - annotate-time () OK
-;; - annotate-current-time () NOT NEEDED
-;; - annotate-extract-revision-at-line () OK
+;; * print-log (files &optional buffer shortlog) OK
+;; - log-view-mode () OK
+;; - show-log-entry (revision) OK
+;; - comment-history (file) ??
+;; - update-changelog (files) COULD BE SUPPORTED
+;; * diff (file &optional rev1 rev2 buffer) OK
+;; - revision-completion-table (files) OK
+;; - annotate-command (file buf &optional rev) OK
+;; - annotate-time () OK
+;; - annotate-current-time () NOT NEEDED
+;; - annotate-extract-revision-at-line () OK
;; TAG SYSTEM
-;; - create-tag (dir name branchp) OK
-;; - retrieve-tag (dir name update) OK, needs to update buffers
+;; - create-tag (dir name branchp) OK
+;; - retrieve-tag (dir name update) OK
;; MISCELLANEOUS
-;; - make-version-backups-p (file) NOT NEEDED
-;; - repository-hostname (dirname) NOT NEEDED
-;; - previous-revision (file rev) OK
-;; - next-revision (file rev) OK
-;; - check-headers () COULD BE SUPPORTED
-;; - clear-headers () NOT NEEDED
-;; - delete-file (file) OK
-;; - rename-file (old new) OK
-;; - find-file-hook () NOT NEEDED
+;; - make-version-backups-p (file) NOT NEEDED
+;; - repository-hostname (dirname) NOT NEEDED
+;; - previous-revision (file rev) OK
+;; - next-revision (file rev) OK
+;; - check-headers () COULD BE SUPPORTED
+;; - clear-headers () NOT NEEDED
+;; - delete-file (file) OK
+;; - rename-file (old new) OK
+;; - find-file-hook () NOT NEEDED
(eval-when-compile
(require 'cl)
@@ -146,7 +146,8 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
"Check whether FILE is registered with git."
(when (vc-git-root file)
(with-temp-buffer
- (let* ((dir (file-name-directory file))
+ (let* (process-file-side-effects
+ (dir (file-name-directory file))
(name (file-relative-name file dir))
(str (ignore-errors
(when dir (cd dir))
@@ -183,9 +184,10 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(defun vc-git-working-revision (file)
"Git-specific version of `vc-working-revision'."
- (let ((str (with-output-to-string
- (with-current-buffer standard-output
- (vc-git--out-ok "symbolic-ref" "HEAD")))))
+ (let* (process-file-side-effects
+ (str (with-output-to-string
+ (with-current-buffer standard-output
+ (vc-git--out-ok "symbolic-ref" "HEAD")))))
(if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
(match-string 2 str)
str)))
@@ -260,7 +262,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(defun vc-git-rename-as-string (state extra)
"Return a string describing the copy or rename associated with INFO, or an empty string if none."
- (let ((rename-state (when extra
+ (let ((rename-state (when extra
(vc-git-extra-fileinfo->rename-state extra))))
(if rename-state
(propertize
@@ -401,21 +403,51 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(let ((str (with-output-to-string
(with-current-buffer standard-output
(vc-git--out-ok "symbolic-ref" "HEAD"))))
- (stash (vc-git-stash-list)))
+ (stash (vc-git-stash-list))
+ branch remote remote-url)
+ (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
+ (progn
+ (setq branch (match-string 2 str))
+ (setq remote
+ (with-output-to-string
+ (with-current-buffer standard-output
+ (vc-git--out-ok "config" (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))))
+ "not (detached HEAD)")
;; FIXME: maybe use a different face when nothing is stashed.
- (when (string= stash "") (setq stash "Nothing stashed"))
(concat
(propertize "Branch : " 'face 'font-lock-type-face)
- (propertize
- (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
- (match-string 2 str)
- "not (detached HEAD)")
- 'face 'font-lock-variable-name-face)
+ (propertize branch
+ 'face 'font-lock-variable-name-face)
+ (when remote
+ (concat
+ "\n"
+ (propertize "Remote : " 'face 'font-lock-type-face)
+ (propertize remote-url
+ 'face 'font-lock-variable-name-face)))
"\n"
- (propertize "Stash : " 'face 'font-lock-type-face)
- (propertize
- stash
- 'face 'font-lock-variable-name-face))))
+ (if stash
+ (concat
+ (propertize "Stash :\n" 'face 'font-lock-type-face)
+ (mapconcat
+ (lambda (x)
+ (propertize x
+ 'face 'font-lock-variable-name-face
+ 'mouse-face 'highlight
+ 'keymap vc-git-stash-map))
+ stash "\n"))
+ (concat
+ (propertize "Stash : " 'face 'font-lock-type-face)
+ (propertize "Nothing stashed"
+ 'face 'font-lock-variable-name-face))))))
;;; STATE-CHANGING FUNCTIONS
@@ -424,8 +456,16 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(vc-git-command nil 0 nil "init"))
(defun vc-git-register (files &optional rev comment)
- "Register FILE into the git version-control system."
- (vc-git-command nil 0 files "update-index" "--add" "--"))
+ "Register FILES into the git version-control system."
+ (let (flist dlist)
+ (dolist (crt files)
+ (if (file-directory-p crt)
+ (push crt dlist)
+ (push crt flist)))
+ (when flist
+ (vc-git-command nil 0 flist "update-index" "--add" "--"))
+ (when dlist
+ (vc-git-command nil 0 dlist "add"))))
(defalias 'vc-git-responsible-p 'vc-git-root)
@@ -439,12 +479,13 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(if vc-git-add-signoff "-s") "-m" comment "--only" "--")))
(defun vc-git-find-revision (file rev buffer)
- (let ((coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
- (fullname (substring
- (vc-git--run-command-string
- file "ls-files" "-z" "--full-name" "--")
- 0 -1)))
+ (let* (process-file-side-effects
+ (coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
+ (fullname (substring
+ (vc-git--run-command-string
+ file "ls-files" "-z" "--full-name" "--")
+ 0 -1)))
(vc-git-command
buffer 0
(concat (if rev rev "HEAD") ":" fullname) "cat-file" "blob")))
@@ -460,7 +501,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
;;; HISTORY FUNCTIONS
-(defun vc-git-print-log (files &optional buffer)
+(defun vc-git-print-log (files &optional buffer shortlog)
"Get change log associated with FILES."
(let ((coding-system-for-read git-commits-coding-system)
;; Support both the old print-log interface that passes a
@@ -474,22 +515,38 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(let ((inhibit-read-only t))
(with-current-buffer
buffer
+ (if shortlog
(vc-git-command buffer 'async files
- "rev-list" "--pretty" "HEAD" "--")))))
+ "log" ;; "--graph"
+ "--date=short" "--pretty=format:%h %ad %s" "--abbrev-commit"
+ "--")
+ (vc-git-command buffer 'async files
+ "rev-list" ;; "--graph"
+ "--pretty" "HEAD" "--"))))))
(defvar log-view-message-re)
(defvar log-view-file-re)
(defvar log-view-font-lock-keywords)
(defvar log-view-per-file-logs)
+;; Dynamically bound.
+(defvar vc-short-log)
+
(define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
(require 'add-log) ;; we need the faces add-log
;; Don't have file markers, so use impossible regexp.
(set (make-local-variable 'log-view-file-re) "\\`a\\`")
(set (make-local-variable 'log-view-per-file-logs) nil)
(set (make-local-variable 'log-view-message-re)
- "^commit *\\([0-9a-z]+\\)")
+ (if vc-short-log
+ "^\\(?:[*/\\| ]+ \\)?\\([0-9a-z]+\\) \\([-a-z0-9]+\\) \\(.*\\)"
+ "^commit *\\([0-9a-z]+\\)"))
(set (make-local-variable 'log-view-font-lock-keywords)
+ (if vc-short-log
+ (append
+ `((,log-view-message-re
+ (1 'change-log-acknowledgement)
+ (2 'change-log-date))))
(append
`((,log-view-message-re (1 'change-log-acknowledgement)))
;; Handle the case:
@@ -510,7 +567,8 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(1 'change-log-acknowledgement)
(2 'change-log-acknowledgement))
("^Date: \\(.+\\)" (1 'change-log-date))
- ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))
+ ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
+
(defun vc-git-show-log-entry (revision)
"Move to the log entry for REVISION.
@@ -528,15 +586,17 @@ or BRANCH^ (where \"^\" can be repeated)."
(defun vc-git-diff (files &optional rev1 rev2 buffer)
"Get a difference report using Git between two revisions of FILES."
- (apply #'vc-git-command (or buffer "*vc-diff*") 1 files
- (if (and rev1 rev2) "diff-tree" "diff-index")
- "--exit-code"
- (append (vc-switches 'git 'diff)
- (list "-p" (or rev1 "HEAD") rev2 "--"))))
+ (let (process-file-side-effects)
+ (apply #'vc-git-command (or buffer "*vc-diff*") 1 files
+ (if (and rev1 rev2) "diff-tree" "diff-index")
+ "--exit-code"
+ (append (vc-switches 'git 'diff)
+ (list "-p" (or rev1 "HEAD") rev2 "--")))))
(defun vc-git-revision-table (files)
;; What about `files'?!? --Stef
- (let ((table (list "HEAD")))
+ (let (process-file-side-effects
+ (table (list "HEAD")))
(with-temp-buffer
(vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
(goto-char (point-min))
@@ -553,7 +613,7 @@ or BRANCH^ (where \"^\" can be repeated)."
(defun vc-git-annotate-command (file buf &optional rev)
(let ((name (file-relative-name file)))
- (vc-git-command buf 'async name "blame" "--date=iso" rev)))
+ (vc-git-command buf 'async name "blame" "--date=iso" rev "--")))
(declare-function vc-annotate-convert-time "vc-annotate" (time))
@@ -649,6 +709,12 @@ or BRANCH^ (where \"^\" can be repeated)."
(define-key map [git-grep]
'(menu-item "Git grep..." vc-git-grep
:help "Run the `git grep' command"))
+ (define-key map [git-st]
+ '(menu-item "Stash..." vc-git-stash
+ :help "Stash away changes"))
+ (define-key map [git-ss]
+ '(menu-item "Show Stash..." vc-git-stash-show
+ :help "Show stash contents"))
(define-key map [git-sig]
'(menu-item "Add Signed-off-by on commit" vc-git-toggle-signoff
:help "Add Add Signed-off-by when commiting (i.e. add the -s flag)"
@@ -659,6 +725,9 @@ or BRANCH^ (where \"^\" can be repeated)."
(defun vc-git-extra-status-menu () vc-git-extra-menu-map)
+(defun vc-git-root (file)
+ (vc-find-root file ".git"))
+
(defun vc-git-toggle-signoff ()
(interactive)
(setq vc-git-add-signoff (not vc-git-add-signoff)))
@@ -717,18 +786,61 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(if (eq next-error-last-buffer (current-buffer))
(setq default-directory dir))))))
+(defun vc-git-stash (name)
+ "Create a stash."
+ (interactive "sStash name: ")
+ (let ((root (vc-git-root default-directory)))
+ (when root
+ (vc-git--call nil "stash" "save" name)
+ (vc-resynch-buffer root t t))))
+
+(defun vc-git-stash-show (name)
+ "Show the contents of stash NAME."
+ (interactive "sStash name: ")
+ (vc-setup-buffer "*vc-git-stash*")
+ (vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name)
+ (set-buffer "*vc-git-stash*")
+ (diff-mode)
+ (setq buffer-read-only t)
+ (pop-to-buffer (current-buffer)))
+
(defun vc-git-stash-list ()
- (replace-regexp-in-string
- "\n" "\n "
- (replace-regexp-in-string
- "^stash@" "" (vc-git--run-command-string nil "stash" "list"))))
+ (delete
+ ""
+ (split-string
+ (replace-regexp-in-string
+ "^stash@" " " (vc-git--run-command-string nil "stash" "list"))
+ "\n")))
+
+(defun vc-git-stash-get-at-point (point)
+ (save-excursion
+ (goto-char point)
+ (beginning-of-line)
+ (if (looking-at "^ +\\({[0-9]+}\\):")
+ (match-string 1)
+ (error "Cannot find stash at point"))))
+
+(defun vc-git-stash-delete-at-point ()
+ (interactive)
+ (let ((stash (vc-git-stash-get-at-point (point))))
+ (when (y-or-n-p (format "Remove stash %s ?" stash))
+ (vc-git--run-command-string nil "stash" "drop" (format "stash@%s" stash))
+ (vc-dir-refresh))))
+
+(defun vc-git-stash-show-at-point ()
+ (interactive)
+ (vc-git-stash-show (format "stash@%s" (vc-git-stash-get-at-point (point)))))
+
+(defvar vc-git-stash-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-k" 'vc-git-stash-delete-at-point)
+ (define-key map "=" 'vc-git-stash-show-at-point)
+ (define-key map "\C-m" 'vc-git-stash-show-at-point)
+ map))
;;; Internal commands
-(defun vc-git-root (file)
- (vc-find-root file ".git"))
-
(defun vc-git-command (buffer okstatus file-or-list &rest flags)
"A wrapper around `vc-do-command' for use in vc-git.el.
The difference to vc-do-command is that this function always invokes `git'."
@@ -736,7 +848,8 @@ The difference to vc-do-command is that this function always invokes `git'."
(defun vc-git--empty-db-p ()
"Check if the git db is empty (no commit done yet)."
- (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD"))))
+ (let (process-file-side-effects)
+ (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD")))))
(defun vc-git--call (buffer command &rest args)
;; We don't need to care the arguments. If there is a file name, it
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-27 09:58:55 +0000