diff options
Diffstat (limited to 'contrib/emacs')
| -rw-r--r-- | contrib/emacs/Makefile | 2 | ||||
| -rw-r--r-- | contrib/emacs/git.el | 170 | ||||
| -rw-r--r-- | contrib/emacs/vc-git.el | 216 |
3 files changed, 133 insertions, 255 deletions
diff --git a/contrib/emacs/Makefile b/contrib/emacs/Makefile index a48540a92b..24d9312941 100644 --- a/contrib/emacs/Makefile +++ b/contrib/emacs/Makefile @@ -2,7 +2,7 @@ EMACS = emacs -ELC = git.elc vc-git.elc git-blame.elc +ELC = git.elc git-blame.elc INSTALL ?= install INSTALL_ELC = $(INSTALL) -m 644 prefix ?= $(HOME) diff --git a/contrib/emacs/git.el b/contrib/emacs/git.el index 09e8bae3a4..fcbe2d9cf5 100644 --- a/contrib/emacs/git.el +++ b/contrib/emacs/git.el @@ -1,6 +1,6 @@ ;;; git.el --- A user interface for git -;; Copyright (C) 2005, 2006, 2007 Alexandre Julliard <julliard@winehq.org> +;; Copyright (C) 2005, 2006, 2007, 2008, 2009 Alexandre Julliard <julliard@winehq.org> ;; Version: 1.0 @@ -34,15 +34,21 @@ ;; To start: `M-x git-status' ;; ;; TODO -;; - portability to XEmacs ;; - diff against other branch ;; - renaming files from the status buffer ;; - creating tags ;; - fetch/pull -;; - switching branches ;; - revlist browser ;; - git-show-branch browser -;; - menus +;; + +;;; Compatibility: +;; +;; This file works on GNU Emacs 21 or later. It may work on older +;; versions but this is not guaranteed. +;; +;; It may work on XEmacs 21, provided that you first install the ewoc +;; and log-edit packages. ;; (eval-when-compile (require 'cl)) @@ -222,7 +228,7 @@ the process output as a string, or nil if the git command failed." (with-current-buffer buffer (cd dir) (apply #'call-process-region start end program - nil (list output-buffer nil) nil args)))) + nil (list output-buffer t) nil args)))) (defun git-run-command-buffer (buffer-name &rest args) "Run a git command, sending the output to a buffer named BUFFER-NAME." @@ -239,13 +245,15 @@ the process output as a string, or nil if the git command failed." (defun git-run-command-region (buffer start end env &rest args) "Run a git command with specified buffer region as input." - (unless (eq 0 (if env - (git-run-process-region - buffer start end "env" - (append (git-get-env-strings env) (list "git") args)) + (with-temp-buffer + (if (eq 0 (if env (git-run-process-region - buffer start end "git" args))) - (error "Failed to run \"git %s\":\n%s" (mapconcat (lambda (x) x) args " ") (buffer-string)))) + buffer start end "env" + (append (git-get-env-strings env) (list "git") args)) + (git-run-process-region buffer start end "git" args))) + (buffer-string) + (display-message-or-buffer (current-buffer)) + nil))) (defun git-run-hook (hook env &rest args) "Run a git hook and display its output if any." @@ -397,6 +405,17 @@ the process output as a string, or nil if the git command failed." (unless newval (push "-d" args)) (apply 'git-call-process-display-error "update-ref" args))) +(defun git-for-each-ref (&rest specs) + "Return a list of refs using git-for-each-ref. +Each entry is a cons of (SHORT-NAME . FULL-NAME)." + (let (refs) + (with-temp-buffer + (apply #'git-call-process t "for-each-ref" "--format=%(refname)" specs) + (goto-char (point-min)) + (while (re-search-forward "^[^/\n]+/[^/\n]+/\\(.+\\)$" nil t) + (push (cons (match-string 1) (match-string 0)) refs))) + (nreverse refs))) + (defun git-read-tree (tree &optional index-file) "Read a tree into the index file." (let ((process-environment @@ -447,18 +466,16 @@ the process output as a string, or nil if the git command failed." (setq coding-system-for-write buffer-file-coding-system)) (let ((commit (git-get-string-sha1 - (with-output-to-string - (with-current-buffer standard-output - (let ((env `(("GIT_AUTHOR_NAME" . ,author-name) - ("GIT_AUTHOR_EMAIL" . ,author-email) - ("GIT_COMMITTER_NAME" . ,(git-get-committer-name)) - ("GIT_COMMITTER_EMAIL" . ,(git-get-committer-email))))) - (when author-date (push `("GIT_AUTHOR_DATE" . ,author-date) env)) - (apply #'git-run-command-region - buffer log-start log-end env - "commit-tree" tree (nreverse args)))))))) - (and (git-update-ref "HEAD" commit head subject) - commit)))) + (let ((env `(("GIT_AUTHOR_NAME" . ,author-name) + ("GIT_AUTHOR_EMAIL" . ,author-email) + ("GIT_COMMITTER_NAME" . ,(git-get-committer-name)) + ("GIT_COMMITTER_EMAIL" . ,(git-get-committer-email))))) + (when author-date (push `("GIT_AUTHOR_DATE" . ,author-date) env)) + (apply #'git-run-command-region + buffer log-start log-end env + "commit-tree" tree (nreverse args)))))) + (when commit (git-update-ref "HEAD" commit head subject)) + commit))) (defun git-empty-db-p () "Check if the git db is empty (no commit done yet)." @@ -562,29 +579,29 @@ the process output as a string, or nil if the git command failed." (let* ((old-type (lsh (or old-perm 0) -9)) (new-type (lsh (or new-perm 0) -9)) (str (case new-type - (?\100 ;; file + (64 ;; file (case old-type - (?\100 nil) - (?\120 " (type change symlink -> file)") - (?\160 " (type change subproject -> file)"))) - (?\120 ;; symlink + (64 nil) + (80 " (type change symlink -> file)") + (112 " (type change subproject -> file)"))) + (80 ;; symlink (case old-type - (?\100 " (type change file -> symlink)") - (?\160 " (type change subproject -> symlink)") + (64 " (type change file -> symlink)") + (112 " (type change subproject -> symlink)") (t " (symlink)"))) - (?\160 ;; subproject + (112 ;; subproject (case old-type - (?\100 " (type change file -> subproject)") - (?\120 " (type change symlink -> subproject)") + (64 " (type change file -> subproject)") + (80 " (type change symlink -> subproject)") (t " (subproject)"))) - (?\110 nil) ;; directory (internal, not a real git state) - (?\000 ;; deleted or unknown + (72 nil) ;; directory (internal, not a real git state) + (0 ;; deleted or unknown (case old-type - (?\120 " (symlink)") - (?\160 " (subproject)"))) + (80 " (symlink)") + (112 " (subproject)"))) (t (format " (unknown type %o)" new-type))))) (cond (str (propertize str 'face 'git-status-face)) - ((eq new-type ?\110) "/") + ((eq new-type 72) "/") (t "")))) (defun git-rename-as-string (info) @@ -1320,6 +1337,7 @@ Return the list of files that haven't been handled." (log-edit-diff-function . git-log-edit-diff)) buffer) (log-edit 'git-do-commit nil 'git-log-edit-files buffer)) (setq font-lock-keywords (font-lock-compile-keywords git-log-edit-font-lock-keywords)) + (setq paragraph-separate (concat (regexp-quote git-log-msg-separator) "$\\|Author: \\|Date: \\|Merge: \\|Signed-off-by: \\|\f\\|[ ]*$")) (setq buffer-file-coding-system coding-system) (re-search-forward (regexp-quote (concat git-log-msg-separator "\n")) nil t)))) @@ -1356,6 +1374,36 @@ Return the list of files that haven't been handled." (push (match-string 1) files))) files)) +(defun git-read-commit-name (prompt &optional default) + "Ask for a commit name, with completion for local branch, remote branch and tag." + (completing-read prompt + (list* "HEAD" "ORIG_HEAD" "FETCH_HEAD" (mapcar #'car (git-for-each-ref))) + nil nil nil nil default)) + +(defun git-checkout (branch &optional merge) + "Checkout a branch, tag, or any commit. +Use a prefix arg if git should merge while checking out." + (interactive + (list (git-read-commit-name "Checkout: ") + current-prefix-arg)) + (unless git-status (error "Not in git-status buffer.")) + (let ((args (list branch "--"))) + (when merge (push "-m" args)) + (when (apply #'git-call-process-display-error "checkout" args) + (git-update-status-files)))) + +(defun git-branch (branch) + "Create a branch from the current HEAD and switch to it." + (interactive (list (git-read-commit-name "Branch: "))) + (unless git-status (error "Not in git-status buffer.")) + (if (git-rev-parse (concat "refs/heads/" branch)) + (if (yes-or-no-p (format "Branch %s already exists, replace it? " branch)) + (and (git-call-process-display-error "branch" "-f" branch) + (git-call-process-display-error "checkout" branch)) + (message "Canceled.")) + (git-call-process-display-error "checkout" "-b" branch)) + (git-refresh-ewoc-hf git-status)) + (defun git-amend-commit () "Undo the last commit on HEAD, and set things up to commit an amended version of it." @@ -1372,6 +1420,44 @@ amended version of it." (git-setup-commit-buffer commit) (git-commit-file)))) +(defun git-cherry-pick-commit (arg) + "Cherry-pick a commit." + (interactive (list (git-read-commit-name "Cherry-pick commit: "))) + (unless git-status (error "Not in git-status buffer.")) + (let ((commit (git-rev-parse (concat arg "^0")))) + (unless commit (error "Not a valid commit '%s'." arg)) + (when (git-rev-parse (concat commit "^2")) + (error "Cannot cherry-pick a merge commit.")) + (let ((files (git-get-commit-files commit)) + (ok (git-call-process-display-error "cherry-pick" "-n" commit))) + (git-update-status-files files ok) + (with-current-buffer (git-setup-commit-buffer commit) + (goto-char (point-min)) + (if (re-search-forward "^\n*Signed-off-by:" nil t 1) + (goto-char (match-beginning 0)) + (goto-char (point-max))) + (insert "(cherry picked from commit " commit ")\n")) + (when ok (git-commit-file))))) + +(defun git-revert-commit (arg) + "Revert a commit." + (interactive (list (git-read-commit-name "Revert commit: "))) + (unless git-status (error "Not in git-status buffer.")) + (let ((commit (git-rev-parse (concat arg "^0")))) + (unless commit (error "Not a valid commit '%s'." arg)) + (when (git-rev-parse (concat commit "^2")) + (error "Cannot revert a merge commit.")) + (let ((files (git-get-commit-files commit)) + (subject (git-get-commit-description commit)) + (ok (git-call-process-display-error "revert" "-n" commit))) + (git-update-status-files files ok) + (when (string-match "^[0-9a-f]+ - \\(.*\\)$" subject) + (setq subject (match-string 1 subject))) + (git-setup-log-buffer (get-buffer-create "*git-commit*") + (git-get-merge-heads) nil nil (format "Revert \"%s\"" subject) nil + (format "This reverts commit %s.\n" commit)) + (when ok (git-commit-file))))) + (defun git-find-file () "Visit the current file in its own buffer." (interactive) @@ -1471,6 +1557,10 @@ amended version of it." (define-key map "\M-\C-?" 'git-unmark-all) ; the commit submap (define-key commit-map "\C-a" 'git-amend-commit) + (define-key commit-map "\C-b" 'git-branch) + (define-key commit-map "\C-o" 'git-checkout) + (define-key commit-map "\C-p" 'git-cherry-pick-commit) + (define-key commit-map "\C-v" 'git-revert-commit) ; the diff submap (define-key diff-map "b" 'git-diff-file-base) (define-key diff-map "c" 'git-diff-file-combined) @@ -1491,6 +1581,10 @@ amended version of it." `("Git" ["Refresh" git-refresh-status t] ["Commit" git-commit-file t] + ["Checkout..." git-checkout t] + ["New Branch..." git-branch t] + ["Cherry-pick Commit..." git-cherry-pick-commit t] + ["Revert Commit..." git-revert-commit t] ("Merge" ["Next Unmerged File" git-next-unmerged-file t] ["Prev Unmerged File" git-prev-unmerged-file t] diff --git a/contrib/emacs/vc-git.el b/contrib/emacs/vc-git.el deleted file mode 100644 index b8f6be5c0a..0000000000 --- a/contrib/emacs/vc-git.el +++ /dev/null @@ -1,216 +0,0 @@ -;;; vc-git.el --- VC backend for the git version control system - -;; Copyright (C) 2006 Alexandre Julliard - -;; This program 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 of -;; the License, or (at your option) any later version. -;; -;; This program 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 this program; if not, write to the Free -;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, -;; MA 02111-1307 USA - -;;; Commentary: - -;; This file contains a VC backend for the git version control -;; system. -;; -;; To install: put this file on the load-path and add GIT to the list -;; of supported backends in `vc-handled-backends'; the following line, -;; placed in your ~/.emacs, will accomplish this: -;; -;; (add-to-list 'vc-handled-backends 'GIT) -;; -;; TODO -;; - changelog generation -;; - working with revisions other than HEAD -;; - -(eval-when-compile (require 'cl)) - -(defvar git-commits-coding-system 'utf-8 - "Default coding system for git commits.") - -(defun vc-git--run-command-string (file &rest args) - "Run a git command on FILE and return its output as string." - (let* ((ok t) - (str (with-output-to-string - (with-current-buffer standard-output - (unless (eq 0 (apply #'call-process "git" nil '(t nil) nil - (append args (list (file-relative-name file))))) - (setq ok nil)))))) - (and ok str))) - -(defun vc-git--run-command (file &rest args) - "Run a git command on FILE, discarding any output." - (let ((name (file-relative-name file))) - (eq 0 (apply #'call-process "git" nil (get-buffer "*Messages") nil (append args (list name)))))) - -(defun vc-git-registered (file) - "Check whether FILE is registered with git." - (with-temp-buffer - (let* ((dir (file-name-directory file)) - (name (file-relative-name file dir))) - (and (ignore-errors - (when dir (cd dir)) - (eq 0 (call-process "git" nil '(t nil) nil "ls-files" "-c" "-z" "--" name))) - (let ((str (buffer-string))) - (and (> (length str) (length name)) - (string= (substring str 0 (1+ (length name))) (concat name "\0")))))))) - -(defun vc-git-state (file) - "git-specific version of `vc-state'." - (let ((diff (vc-git--run-command-string file "diff-index" "-z" "HEAD" "--"))) - (if (and diff (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} [ADMU]\0[^\0]+\0" diff)) - 'edited - 'up-to-date))) - -(defun vc-git-workfile-version (file) - "git-specific version of `vc-workfile-version'." - (let ((str (with-output-to-string - (with-current-buffer standard-output - (call-process "git" nil '(t nil) nil "symbolic-ref" "HEAD"))))) - (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) - (match-string 2 str) - str))) - -(defun vc-git-symbolic-commit (commit) - "Translate COMMIT string into symbolic form. -Returns nil if not possible." - (and commit - (with-temp-buffer - (and - (zerop - (call-process "git" nil '(t nil) nil "name-rev" - "--name-only" "--tags" - commit)) - (goto-char (point-min)) - (= (forward-line 2) 1) - (bolp) - (buffer-substring-no-properties (point-min) (1- (point-max))))))) - -(defun vc-git-previous-version (file rev) - "git-specific version of `vc-previous-version'." - (let ((default-directory (file-name-directory (expand-file-name file))) - (file (file-name-nondirectory file))) - (vc-git-symbolic-commit - (with-temp-buffer - (and - (zerop - (call-process "git" nil '(t nil) nil "rev-list" - "-2" rev "--" file)) - (goto-char (point-max)) - (bolp) - (zerop (forward-line -1)) - (not (bobp)) - (buffer-substring-no-properties - (point) - (1- (point-max)))))))) - -(defun vc-git-next-version (file rev) - "git-specific version of `vc-next-version'." - (let* ((default-directory (file-name-directory - (expand-file-name file))) - (file (file-name-nondirectory file)) - (current-rev - (with-temp-buffer - (and - (zerop - (call-process "git" nil '(t nil) nil "rev-list" - "-1" rev "--" file)) - (goto-char (point-max)) - (bolp) - (zerop (forward-line -1)) - (bobp) - (buffer-substring-no-properties - (point) - (1- (point-max))))))) - (and current-rev - (vc-git-symbolic-commit - (with-temp-buffer - (and - (zerop - (call-process "git" nil '(t nil) nil "rev-list" - "HEAD" "--" file)) - (goto-char (point-min)) - (search-forward current-rev nil t) - (zerop (forward-line -1)) - (buffer-substring-no-properties - (point) - (progn (forward-line 1) (1- (point)))))))))) - -(defun vc-git-revert (file &optional contents-done) - "Revert FILE to the version stored in the git repository." - (if contents-done - (vc-git--run-command file "update-index" "--") - (vc-git--run-command file "checkout" "HEAD"))) - -(defun vc-git-checkout-model (file) - 'implicit) - -(defun vc-git-workfile-unchanged-p (file) - (let ((sha1 (vc-git--run-command-string file "hash-object" "--")) - (head (vc-git--run-command-string file "ls-tree" "-z" "HEAD" "--"))) - (and head - (string-match "[0-7]\\{6\\} blob \\([0-9a-f]\\{40\\}\\)\t[^\0]+\0" head) - (string= (car (split-string sha1 "\n")) (match-string 1 head))))) - -(defun vc-git-register (file &optional rev comment) - "Register FILE into the git version-control system." - (vc-git--run-command file "update-index" "--add" "--")) - -(defun vc-git-print-log (file &optional buffer) - (let ((name (file-relative-name file)) - (coding-system-for-read git-commits-coding-system)) - (vc-do-command buffer 'async "git" name "rev-list" "--pretty" "HEAD" "--"))) - -(defun vc-git-diff (file &optional rev1 rev2 buffer) - (let ((name (file-relative-name file)) - (buf (or buffer "*vc-diff*"))) - (if (and rev1 rev2) - (vc-do-command buf 0 "git" name "diff-tree" "-p" rev1 rev2 "--") - (vc-do-command buf 0 "git" name "diff-index" "-p" (or rev1 "HEAD") "--")) - ; git-diff-index doesn't set exit status like diff does - (if (vc-git-workfile-unchanged-p file) 0 1))) - -(defun vc-git-checkin (file rev comment) - (let ((coding-system-for-write git-commits-coding-system)) - (vc-git--run-command file "commit" "-m" comment "--only" "--"))) - -(defun vc-git-checkout (file &optional editable rev destfile) - (if destfile - (let ((fullname (substring - (vc-git--run-command-string file "ls-files" "-z" "--full-name" "--") - 0 -1)) - (coding-system-for-read 'no-conversion) - (coding-system-for-write 'no-conversion)) - (with-temp-file destfile - (eq 0 (call-process "git" nil t nil "cat-file" "blob" - (concat (or rev "HEAD") ":" fullname))))) - (vc-git--run-command file "checkout" (or rev "HEAD")))) - -(defun vc-git-annotate-command (file buf &optional rev) - ; FIXME: rev is ignored - (let ((name (file-relative-name file))) - (call-process "git" nil buf nil "blame" name))) - -(defun vc-git-annotate-time () - (and (re-search-forward "[0-9a-f]+ (.* \\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) \\([-+0-9]+\\) +[0-9]+)" nil t) - (vc-annotate-convert-time - (apply #'encode-time (mapcar (lambda (match) (string-to-number (match-string match))) '(6 5 4 3 2 1 7)))))) - -;; Not really useful since we can't do anything with the revision yet -;;(defun vc-annotate-extract-revision-at-line () -;; (save-excursion -;; (move-beginning-of-line 1) -;; (and (looking-at "[0-9a-f]+") -;; (buffer-substring (match-beginning 0) (match-end 0))))) - -(provide 'vc-git) |