diff options
| -rw-r--r-- | contrib/emacs/.gitignore | 1 | ||||
| -rw-r--r-- | contrib/emacs/Makefile | 21 | ||||
| -rw-r--r-- | contrib/emacs/README | 32 | ||||
| -rw-r--r-- | contrib/emacs/git-blame.el | 489 | ||||
| -rw-r--r-- | contrib/emacs/git.el | 1710 |
5 files changed, 25 insertions, 2228 deletions
diff --git a/contrib/emacs/.gitignore b/contrib/emacs/.gitignore deleted file mode 100644 index c531d9867f..0000000000 --- a/contrib/emacs/.gitignore +++ /dev/null @@ -1 +0,0 @@ -*.elc diff --git a/contrib/emacs/Makefile b/contrib/emacs/Makefile deleted file mode 100644 index 24d9312941..0000000000 --- a/contrib/emacs/Makefile +++ /dev/null @@ -1,21 +0,0 @@ -## Build and install stuff - -EMACS = emacs - -ELC = git.elc git-blame.elc -INSTALL ?= install -INSTALL_ELC = $(INSTALL) -m 644 -prefix ?= $(HOME) -emacsdir = $(prefix)/share/emacs/site-lisp -RM ?= rm -f - -all: $(ELC) - -install: all - $(INSTALL) -d $(DESTDIR)$(emacsdir) - $(INSTALL_ELC) $(ELC:.elc=.el) $(ELC) $(DESTDIR)$(emacsdir) - -%.elc: %.el - $(EMACS) -batch -f batch-byte-compile $< - -clean:; $(RM) $(ELC) diff --git a/contrib/emacs/README b/contrib/emacs/README index 82368bdbff..977a16f1e3 100644 --- a/contrib/emacs/README +++ b/contrib/emacs/README @@ -1,30 +1,24 @@ -This directory contains various modules for Emacs support. +This directory used to contain various modules for Emacs support. -To make the modules available to Emacs, you should add this directory -to your load-path, and then require the modules you want. This can be -done by adding to your .emacs something like this: +These were added shortly after Git was first released. Since then +Emacs's own support for Git got better than what was offered by these +modes. There are also popular 3rd-party Git modes such as Magit which +offer replacements for these. - (add-to-list 'load-path ".../git/contrib/emacs") - (require 'git) - (require 'git-blame) - - -The following modules are available: +The following modules were available, and can be dug up from the Git +history: * git.el: - Status manager that displays the state of all the files of the - project, and provides easy access to the most frequently used git - commands. The user interface is as far as possible compatible with - the pcl-cvs mode. It can be started with `M-x git-status'. + Wrapper for "git status" that provided access to other git commands. + + Modern alternatives to this include Magit, and VC mode that ships + with Emacs. * git-blame.el: - Emacs implementation of incremental git-blame. When you turn it on - while viewing a file, the editor buffer will be updated by setting - the background of individual lines to a color that reflects which - commit it comes from. And when you move around the buffer, a - one-line summary will be shown in the echo area. + A wrapper for "git blame" written before Emacs's own vc-annotate + mode learned to invoke git-blame, which can be done via C-x v g. * vc-git.el: diff --git a/contrib/emacs/git-blame.el b/contrib/emacs/git-blame.el index 510e0f7103..6a8a2b8ff1 100644 --- a/contrib/emacs/git-blame.el +++ b/contrib/emacs/git-blame.el @@ -1,483 +1,6 @@ -;;; git-blame.el --- Minor mode for incremental blame for Git -*- coding: utf-8 -*- -;; -;; Copyright (C) 2007 David Kågedal -;; -;; Authors: David Kågedal <davidk@lysator.liu.se> -;; Created: 31 Jan 2007 -;; Message-ID: <87iren2vqx.fsf@morpheus.local> -;; License: GPL -;; Keywords: git, version control, release management -;; -;; Compatibility: Emacs21, Emacs22 and EmacsCVS -;; Git 1.5 and up - -;; This file is *NOT* part of GNU Emacs. -;; This file is distributed under the same terms as GNU Emacs. - -;; 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, see -;; <http://www.gnu.org/licenses/>. - -;; http://www.fsf.org/copyleft/gpl.html - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; Here is an Emacs implementation of incremental git-blame. When you -;; turn it on while viewing a file, the editor buffer will be updated by -;; setting the background of individual lines to a color that reflects -;; which commit it comes from. And when you move around the buffer, a -;; one-line summary will be shown in the echo area. - -;;; Installation: -;; -;; To use this package, put it somewhere in `load-path' (or add -;; directory with git-blame.el to `load-path'), and add the following -;; line to your .emacs: -;; -;; (require 'git-blame) -;; -;; If you do not want to load this package before it is necessary, you -;; can make use of the `autoload' feature, e.g. by adding to your .emacs -;; the following lines -;; -;; (autoload 'git-blame-mode "git-blame" -;; "Minor mode for incremental blame for Git." t) -;; -;; Then first use of `M-x git-blame-mode' would load the package. - -;;; Compatibility: -;; -;; It requires GNU Emacs 21 or later and Git 1.5.0 and up -;; -;; If you'are using Emacs 20, try changing this: -;; -;; (overlay-put ovl 'face (list :background -;; (cdr (assq 'color (cddddr info))))) -;; -;; to -;; -;; (overlay-put ovl 'face (cons 'background-color -;; (cdr (assq 'color (cddddr info))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Code: - -(eval-when-compile (require 'cl)) ; to use `push', `pop' -(require 'format-spec) - -(defface git-blame-prefix-face - '((((background dark)) (:foreground "gray" - :background "black")) - (((background light)) (:foreground "gray" - :background "white")) - (t (:weight bold))) - "The face used for the hash prefix." - :group 'git-blame) - -(defgroup git-blame nil - "A minor mode showing Git blame information." - :group 'git - :link '(function-link git-blame-mode)) - - -(defcustom git-blame-use-colors t - "Use colors to indicate commits in `git-blame-mode'." - :type 'boolean - :group 'git-blame) - -(defcustom git-blame-prefix-format - "%h %20A:" - "The format of the prefix added to each line in `git-blame' -mode. The format is passed to `format-spec' with the following format keys: - - %h - the abbreviated hash - %H - the full hash - %a - the author name - %A - the author email - %c - the committer name - %C - the committer email - %s - the commit summary -" - :group 'git-blame) - -(defcustom git-blame-mouseover-format - "%h %a %A: %s" - "The format of the description shown when pointing at a line in -`git-blame' mode. The format string is passed to `format-spec' -with the following format keys: - - %h - the abbreviated hash - %H - the full hash - %a - the author name - %A - the author email - %c - the committer name - %C - the committer email - %s - the commit summary -" - :group 'git-blame) - - -(defun git-blame-color-scale (&rest elements) - "Given a list, returns a list of triples formed with each -elements of the list. - -a b => bbb bba bab baa abb aba aaa aab" - (let (result) - (dolist (a elements) - (dolist (b elements) - (dolist (c elements) - (setq result (cons (format "#%s%s%s" a b c) result))))) - result)) - -;; (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c") => -;; ("#3c3c3c" "#3c3c14" "#3c3c34" "#3c3c2c" "#3c3c1c" "#3c3c24" -;; "#3c3c04" "#3c3c0c" "#3c143c" "#3c1414" "#3c1434" "#3c142c" ...) - -(defmacro git-blame-random-pop (l) - "Select a random element from L and returns it. Also remove -selected element from l." - ;; only works on lists with unique elements - `(let ((e (elt ,l (random (length ,l))))) - (setq ,l (remove e ,l)) - e)) - -(defvar git-blame-log-oneline-format - "format:[%cr] %cn: %s" - "*Formatting option used for describing current line in the minibuffer. - -This option is used to pass to git log --pretty= command-line option, -and describe which commit the current line was made.") - -(defvar git-blame-dark-colors - (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c") - "*List of colors (format #RGB) to use in a dark environment. - -To check out the list, evaluate (list-colors-display git-blame-dark-colors).") - -(defvar git-blame-light-colors - (git-blame-color-scale "c4" "d4" "cc" "dc" "f4" "e4" "fc" "ec") - "*List of colors (format #RGB) to use in a light environment. - -To check out the list, evaluate (list-colors-display git-blame-light-colors).") - -(defvar git-blame-colors '() - "Colors used by git-blame. The list is built once when activating git-blame -minor mode.") - -(defvar git-blame-ancient-color "dark green" - "*Color to be used for ancient commit.") - -(defvar git-blame-autoupdate t - "*Automatically update the blame display while editing") - -(defvar git-blame-proc nil - "The running git-blame process") -(make-variable-buffer-local 'git-blame-proc) - -(defvar git-blame-overlays nil - "The git-blame overlays used in the current buffer.") -(make-variable-buffer-local 'git-blame-overlays) - -(defvar git-blame-cache nil - "A cache of git-blame information for the current buffer") -(make-variable-buffer-local 'git-blame-cache) - -(defvar git-blame-idle-timer nil - "An idle timer that updates the blame") -(make-variable-buffer-local 'git-blame-cache) - -(defvar git-blame-update-queue nil - "A queue of update requests") -(make-variable-buffer-local 'git-blame-update-queue) - -;; FIXME: docstrings -(defvar git-blame-file nil) -(defvar git-blame-current nil) - -(defvar git-blame-mode nil) -(make-variable-buffer-local 'git-blame-mode) - -(defvar git-blame-mode-line-string " blame" - "String to display on the mode line when git-blame is active.") - -(or (assq 'git-blame-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(git-blame-mode git-blame-mode-line-string) minor-mode-alist))) - -;;;###autoload -(defun git-blame-mode (&optional arg) - "Toggle minor mode for displaying Git blame - -With prefix ARG, turn the mode on if ARG is positive." - (interactive "P") - (cond - ((null arg) - (if git-blame-mode (git-blame-mode-off) (git-blame-mode-on))) - ((> (prefix-numeric-value arg) 0) (git-blame-mode-on)) - (t (git-blame-mode-off)))) - -(defun git-blame-mode-on () - "Turn on git-blame mode. - -See also function `git-blame-mode'." - (make-local-variable 'git-blame-colors) - (if git-blame-autoupdate - (add-hook 'after-change-functions 'git-blame-after-change nil t) - (remove-hook 'after-change-functions 'git-blame-after-change t)) - (git-blame-cleanup) - (let ((bgmode (cdr (assoc 'background-mode (frame-parameters))))) - (if (eq bgmode 'dark) - (setq git-blame-colors git-blame-dark-colors) - (setq git-blame-colors git-blame-light-colors))) - (setq git-blame-cache (make-hash-table :test 'equal)) - (setq git-blame-mode t) - (git-blame-run)) - -(defun git-blame-mode-off () - "Turn off git-blame mode. - -See also function `git-blame-mode'." - (git-blame-cleanup) - (if git-blame-idle-timer (cancel-timer git-blame-idle-timer)) - (setq git-blame-mode nil)) - -;;;###autoload -(defun git-reblame () - "Recalculate all blame information in the current buffer" - (interactive) - (unless git-blame-mode - (error "Git-blame is not active")) - - (git-blame-cleanup) - (git-blame-run)) - -(defun git-blame-run (&optional startline endline) - (if git-blame-proc - ;; Should maybe queue up a new run here - (message "Already running git blame") - (let ((display-buf (current-buffer)) - (blame-buf (get-buffer-create - (concat " git blame for " (buffer-name)))) - (args '("--incremental" "--contents" "-"))) - (if startline - (setq args (append args - (list "-L" (format "%d,%d" startline endline))))) - (setq args (append args - (list (file-name-nondirectory buffer-file-name)))) - (setq git-blame-proc - (apply 'start-process - "git-blame" blame-buf - "git" "blame" - args)) - (with-current-buffer blame-buf - (erase-buffer) - (make-local-variable 'git-blame-file) - (make-local-variable 'git-blame-current) - (setq git-blame-file display-buf) - (setq git-blame-current nil)) - (set-process-filter git-blame-proc 'git-blame-filter) - (set-process-sentinel git-blame-proc 'git-blame-sentinel) - (process-send-region git-blame-proc (point-min) (point-max)) - (process-send-eof git-blame-proc)))) - -(defun remove-git-blame-text-properties (start end) - (let ((modified (buffer-modified-p)) - (inhibit-read-only t)) - (remove-text-properties start end '(point-entered nil)) - (set-buffer-modified-p modified))) - -(defun git-blame-cleanup () - "Remove all blame properties" - (mapc 'delete-overlay git-blame-overlays) - (setq git-blame-overlays nil) - (remove-git-blame-text-properties (point-min) (point-max))) - -(defun git-blame-update-region (start end) - "Rerun blame to get updates between START and END" - (let ((overlays (overlays-in start end))) - (while overlays - (let ((overlay (pop overlays))) - (if (< (overlay-start overlay) start) - (setq start (overlay-start overlay))) - (if (> (overlay-end overlay) end) - (setq end (overlay-end overlay))) - (setq git-blame-overlays (delete overlay git-blame-overlays)) - (delete-overlay overlay)))) - (remove-git-blame-text-properties start end) - ;; We can be sure that start and end are at line breaks - (git-blame-run (1+ (count-lines (point-min) start)) - (count-lines (point-min) end))) - -(defun git-blame-sentinel (proc status) - (with-current-buffer (process-buffer proc) - (with-current-buffer git-blame-file - (setq git-blame-proc nil) - (if git-blame-update-queue - (git-blame-delayed-update)))) - ;;(kill-buffer (process-buffer proc)) - ;;(message "git blame finished") - ) - -(defvar in-blame-filter nil) - -(defun git-blame-filter (proc str) - (with-current-buffer (process-buffer proc) - (save-excursion - (goto-char (process-mark proc)) - (insert-before-markers str) - (goto-char (point-min)) - (unless in-blame-filter - (let ((more t) - (in-blame-filter t)) - (while more - (setq more (git-blame-parse)))))))) - -(defun git-blame-parse () - (cond ((looking-at "\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)\n") - (let ((hash (match-string 1)) - (src-line (string-to-number (match-string 2))) - (res-line (string-to-number (match-string 3))) - (num-lines (string-to-number (match-string 4)))) - (delete-region (point) (match-end 0)) - (setq git-blame-current (list (git-blame-new-commit hash) - src-line res-line num-lines))) - t) - ((looking-at "\\([a-z-]+\\) \\(.+\\)\n") - (let ((key (match-string 1)) - (value (match-string 2))) - (delete-region (point) (match-end 0)) - (git-blame-add-info (car git-blame-current) key value) - (when (string= key "filename") - (git-blame-create-overlay (car git-blame-current) - (caddr git-blame-current) - (cadddr git-blame-current)) - (setq git-blame-current nil))) - t) - (t - nil))) - -(defun git-blame-new-commit (hash) - (with-current-buffer git-blame-file - (or (gethash hash git-blame-cache) - ;; Assign a random color to each new commit info - ;; Take care not to select the same color multiple times - (let* ((color (if git-blame-colors - (git-blame-random-pop git-blame-colors) - git-blame-ancient-color)) - (info `(,hash (color . ,color)))) - (puthash hash info git-blame-cache) - info)))) - -(defun git-blame-create-overlay (info start-line num-lines) - (with-current-buffer git-blame-file - (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-modification-hooks t)) - (goto-char (point-min)) - (forward-line (1- start-line)) - (let* ((start (point)) - (end (progn (forward-line num-lines) (point))) - (ovl (make-overlay start end)) - (hash (car info)) - (spec `((?h . ,(substring hash 0 6)) - (?H . ,hash) - (?a . ,(git-blame-get-info info 'author)) - (?A . ,(git-blame-get-info info 'author-mail)) - (?c . ,(git-blame-get-info info 'committer)) - (?C . ,(git-blame-get-info info 'committer-mail)) - (?s . ,(git-blame-get-info info 'summary))))) - (push ovl git-blame-overlays) - (overlay-put ovl 'git-blame info) - (overlay-put ovl 'help-echo - (format-spec git-blame-mouseover-format spec)) - (if git-blame-use-colors - (overlay-put ovl 'face (list :background - (cdr (assq 'color (cdr info)))))) - (overlay-put ovl 'line-prefix - (propertize (format-spec git-blame-prefix-format spec) - 'face 'git-blame-prefix-face))))))) - -(defun git-blame-add-info (info key value) - (nconc info (list (cons (intern key) value)))) - -(defun git-blame-get-info (info key) - (cdr (assq key (cdr info)))) - -(defun git-blame-current-commit () - (let ((info (get-char-property (point) 'git-blame))) - (if info - (car info) - (error "No commit info")))) - -(defun git-describe-commit (hash) - (with-temp-buffer - (call-process "git" nil t nil - "log" "-1" - (concat "--pretty=" git-blame-log-oneline-format) - hash) - (buffer-substring (point-min) (point-max)))) - -(defvar git-blame-last-identification nil) -(make-variable-buffer-local 'git-blame-last-identification) -(defun git-blame-identify (&optional hash) - (interactive) - (let ((info (gethash (or hash (git-blame-current-commit)) git-blame-cache))) - (when (and info (not (eq info git-blame-last-identification))) - (message "%s" (nth 4 info)) - (setq git-blame-last-identification info)))) - -;; (defun git-blame-after-save () -;; (when git-blame-mode -;; (git-blame-cleanup) -;; (git-blame-run))) -;; (add-hook 'after-save-hook 'git-blame-after-save) - -(defun git-blame-after-change (start end length) - (when git-blame-mode - (git-blame-enq-update start end))) - -(defvar git-blame-last-update nil) -(make-variable-buffer-local 'git-blame-last-update) -(defun git-blame-enq-update (start end) - "Mark the region between START and END as needing blame update" - ;; Try to be smart and avoid multiple callouts for sequential - ;; editing - (cond ((and git-blame-last-update - (= start (cdr git-blame-last-update))) - (setcdr git-blame-last-update end)) - ((and git-blame-last-update - (= end (car git-blame-last-update))) - (setcar git-blame-last-update start)) - (t - (setq git-blame-last-update (cons start end)) - (setq git-blame-update-queue (nconc git-blame-update-queue - (list git-blame-last-update))))) - (unless (or git-blame-proc git-blame-idle-timer) - (setq git-blame-idle-timer - (run-with-idle-timer 0.5 nil 'git-blame-delayed-update)))) - -(defun git-blame-delayed-update () - (setq git-blame-idle-timer nil) - (if git-blame-update-queue - (let ((first (pop git-blame-update-queue)) - (inhibit-point-motion-hooks t)) - (git-blame-update-region (car first) (cdr first))))) - -(provide 'git-blame) - -;;; git-blame.el ends here +(error "git-blame.el no longer ships with git. It's recommended +to replace its use with Emacs's own vc-annotate. See +contrib/emacs/README in git's +sources (https://github.com/git/git/blob/master/contrib/emacs/README) +for more info on suggested alternatives and for why this +happened.") diff --git a/contrib/emacs/git.el b/contrib/emacs/git.el index 97919f2d73..03f926281f 100644 --- a/contrib/emacs/git.el +++ b/contrib/emacs/git.el @@ -1,1704 +1,6 @@ -;;; git.el --- A user interface for git - -;; Copyright (C) 2005, 2006, 2007, 2008, 2009 Alexandre Julliard <julliard@winehq.org> - -;; Version: 1.0 - -;; 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, see -;; <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This file contains an interface for the git version control -;; system. It provides easy access to the most frequently used git -;; commands. The user interface is as far as possible identical to -;; that of the PCL-CVS mode. -;; -;; To install: put this file on the load-path and place the following -;; in your .emacs file: -;; -;; (require 'git) -;; -;; To start: `M-x git-status' -;; -;; TODO -;; - diff against other branch -;; - renaming files from the status buffer -;; - creating tags -;; - fetch/pull -;; - revlist browser -;; - git-show-branch browser -;; - -;;; 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)) -(require 'ewoc) -(require 'log-edit) -(require 'easymenu) - - -;;;; Customizations -;;;; ------------------------------------------------------------ - -(defgroup git nil - "A user interface for the git versioning system." - :group 'tools) - -(defcustom git-committer-name nil - "User name to use for commits. -The default is to fall back to the repository config, -then to `add-log-full-name' and then to `user-full-name'." - :group 'git - :type '(choice (const :tag "Default" nil) - (string :tag "Name"))) - -(defcustom git-committer-email nil - "Email address to use for commits. -The default is to fall back to the git repository config, -then to `add-log-mailing-address' and then to `user-mail-address'." - :group 'git - :type '(choice (const :tag "Default" nil) - (string :tag "Email"))) - -(defcustom git-commits-coding-system nil - "Default coding system for the log message of git commits." - :group 'git - :type '(choice (const :tag "From repository config" nil) - (coding-system))) - -(defcustom git-append-signed-off-by nil - "Whether to append a Signed-off-by line to the commit message before editing." - :group 'git - :type 'boolean) - -(defcustom git-reuse-status-buffer t - "Whether `git-status' should try to reuse an existing buffer -if there is already one that displays the same directory." - :group 'git - :type 'boolean) - -(defcustom git-per-dir-ignore-file ".gitignore" - "Name of the per-directory ignore file." - :group 'git - :type 'string) - -(defcustom git-show-uptodate nil - "Whether to display up-to-date files." - :group 'git - :type 'boolean) - -(defcustom git-show-ignored nil - "Whether to display ignored files." - :group 'git - :type 'boolean) - -(defcustom git-show-unknown t - "Whether to display unknown files." - :group 'git - :type 'boolean) - - -(defface git-status-face - '((((class color) (background light)) (:foreground "purple")) - (((class color) (background dark)) (:foreground "salmon"))) - "Git mode face used to highlight added and modified files." - :group 'git) - -(defface git-unmerged-face - '((((class color) (background light)) (:foreground "red" :bold t)) - (((class color) (background dark)) (:foreground "red" :bold t))) - "Git mode face used to highlight unmerged files." - :group 'git) - -(defface git-unknown-face - '((((class color) (background light)) (:foreground "goldenrod" :bold t)) - (((class color) (background dark)) (:foreground "goldenrod" :bold t))) - "Git mode face used to highlight unknown files." - :group 'git) - -(defface git-uptodate-face - '((((class color) (background light)) (:foreground "grey60")) - (((class color) (background dark)) (:foreground "grey40"))) - "Git mode face used to highlight up-to-date files." - :group 'git) - -(defface git-ignored-face - '((((class color) (background light)) (:foreground "grey60")) - (((class color) (background dark)) (:foreground "grey40"))) - "Git mode face used to highlight ignored files." - :group 'git) - -(defface git-mark-face - '((((class color) (background light)) (:foreground "red" :bold t)) - (((class color) (background dark)) (:foreground "tomato" :bold t))) - "Git mode face used for the file marks." - :group 'git) - -(defface git-header-face - '((((class color) (background light)) (:foreground "blue")) - (((class color) (background dark)) (:foreground "blue"))) - "Git mode face used for commit headers." - :group 'git) - -(defface git-separator-face - '((((class color) (background light)) (:foreground "brown")) - (((class color) (background dark)) (:foreground "brown"))) - "Git mode face used for commit separator." - :group 'git) - -(defface git-permission-face - '((((class color) (background light)) (:foreground "green" :bold t)) - (((class color) (background dark)) (:foreground "green" :bold t))) - "Git mode face used for permission changes." - :group 'git) - - -;;;; Utilities -;;;; ------------------------------------------------------------ - -(defconst git-log-msg-separator "--- log message follows this line ---") - -(defvar git-log-edit-font-lock-keywords - `(("^\\(Author:\\|Date:\\|Merge:\\|Signed-off-by:\\)\\(.*\\)$" - (1 font-lock-keyword-face) - (2 font-lock-function-name-face)) - (,(concat "^\\(" (regexp-quote git-log-msg-separator) "\\)$") - (1 font-lock-comment-face)))) - -(defun git-get-env-strings (env) - "Build a list of NAME=VALUE strings from a list of environment strings." - (mapcar (lambda (entry) (concat (car entry) "=" (cdr entry))) env)) - -(defun git-call-process (buffer &rest args) - "Wrapper for call-process that sets environment strings." - (apply #'call-process "git" nil buffer nil args)) - -(defun git-call-process-display-error (&rest args) - "Wrapper for call-process that displays error messages." - (let* ((dir default-directory) - (buffer (get-buffer-create "*Git Command Output*")) - (ok (with-current-buffer buffer - (let ((default-directory dir) - (buffer-read-only nil)) - (erase-buffer) - (eq 0 (apply #'git-call-process (list buffer t) args)))))) - (unless ok (display-message-or-buffer buffer)) - ok)) - -(defun git-call-process-string (&rest args) - "Wrapper for call-process that returns the process output as a string, -or nil if the git command failed." - (with-temp-buffer - (and (eq 0 (apply #'git-call-process t args)) - (buffer-string)))) - -(defun git-call-process-string-display-error (&rest args) - "Wrapper for call-process that displays error message and returns -the process output as a string, or nil if the git command failed." - (with-temp-buffer - (if (eq 0 (apply #'git-call-process (list t t) args)) - (buffer-string) - (display-message-or-buffer (current-buffer)) - nil))) - -(defun git-run-process-region (buffer start end program args) - "Run a git process with a buffer region as input." - (let ((output-buffer (current-buffer)) - (dir default-directory)) - (with-current-buffer buffer - (cd dir) - (apply #'call-process-region start end program - 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." - (let ((dir default-directory) - (buffer (get-buffer-create buffer-name))) - (message "Running git %s..." (car args)) - (with-current-buffer buffer - (let ((default-directory dir) - (buffer-read-only nil)) - (erase-buffer) - (apply #'git-call-process buffer args))) - (message "Running git %s...done" (car args)) - buffer)) - -(defun git-run-command-region (buffer start end env &rest args) - "Run a git command with specified buffer region as input." - (with-temp-buffer - (if (eq 0 (if env - (git-run-process-region - 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." - (let ((dir default-directory) - (hook-name (expand-file-name (concat ".git/hooks/" hook)))) - (or (not (file-executable-p hook-name)) - (let (status (buffer (get-buffer-create "*Git Hook Output*"))) - (with-current-buffer buffer - (erase-buffer) - (cd dir) - (setq status - (if env - (apply #'call-process "env" nil (list buffer t) nil - (append (git-get-env-strings env) (list hook-name) args)) - (apply #'call-process hook-name nil (list buffer t) nil args)))) - (display-message-or-buffer buffer) - (eq 0 status))))) - -(defun git-get-string-sha1 (string) - "Read a SHA1 from the specified string." - (and string - (string-match "[0-9a-f]\\{40\\}" string) - (match-string 0 string))) - -(defun git-get-committer-name () - "Return the name to use as GIT_COMMITTER_NAME." - ; copied from log-edit - (or git-committer-name - (git-config "user.name") - (and (boundp 'add-log-full-name) add-log-full-name) - (and (fboundp 'user-full-name) (user-full-name)) - (and (boundp 'user-full-name) user-full-name))) - -(defun git-get-committer-email () - "Return the email address to use as GIT_COMMITTER_EMAIL." - ; copied from log-edit - (or git-committer-email - (git-config "user.email") - (and (boundp 'add-log-mailing-address) add-log-mailing-address) - (and (fboundp 'user-mail-address) (user-mail-address)) - (and (boundp 'user-mail-address) user-mail-address))) - -(defun git-get-commits-coding-system () - "Return the coding system to use for commits." - (let ((repo-config (git-config "i18n.commitencoding"))) - (or git-commits-coding-system - (and repo-config - (fboundp 'locale-charset-to-coding-system) - (locale-charset-to-coding-system repo-config)) - 'utf-8))) - -(defun git-get-logoutput-coding-system () - "Return the coding system used for git-log output." - (let ((repo-config (or (git-config "i18n.logoutputencoding") - (git-config "i18n.commitencoding")))) - (or git-commits-coding-system - (and repo-config - (fboundp 'locale-charset-to-coding-system) - (locale-charset-to-coding-system repo-config)) - 'utf-8))) - -(defun git-escape-file-name (name) - "Escape a file name if necessary." - (if (string-match "[\n\t\"\\]" name) - (concat "\"" - (mapconcat (lambda (c) - (case c - (?\n "\\n") - (?\t "\\t") - (?\\ "\\\\") - (?\" "\\\"") - (t (char-to-string c)))) - name "") - "\"") - name)) - -(defun git-success-message (text files) - "Print a success message after having handled FILES." - (let ((n (length files))) - (if (equal n 1) - (message "%s %s" text (car files)) - (message "%s %d files" text n)))) - -(defun git-get-top-dir (dir) - "Retrieve the top-level directory of a git tree." - (let ((cdup (with-output-to-string - (with-current-buffer standard-output - (cd dir) - (unless (eq 0 (git-call-process t "rev-parse" "--show-cdup")) - (error "cannot find top-level git tree for %s." dir)))))) - (expand-file-name (concat (file-name-as-directory dir) - (car (split-string cdup "\n")))))) - -;stolen from pcl-cvs -(defun git-append-to-ignore (file) - "Add a file name to the ignore file in its directory." - (let* ((fullname (expand-file-name file)) - (dir (file-name-directory fullname)) - (name (file-name-nondirectory fullname)) - (ignore-name (expand-file-name git-per-dir-ignore-file dir)) - (created (not (file-exists-p ignore-name)))) - (save-window-excursion - (set-buffer (find-file-noselect ignore-name)) - (goto-char (point-max)) - (unless (zerop (current-column)) (insert "\n")) - (insert "/" name "\n") - (sort-lines nil (point-min) (point-max)) - (save-buffer)) - (when created - (git-call-process nil "update-index" "--add" "--" (file-relative-name ignore-name))) - (git-update-status-files (list (file-relative-name ignore-name))))) - -; propertize definition for XEmacs, stolen from erc-compat -(eval-when-compile - (unless (fboundp 'propertize) - (defun propertize (string &rest props) - (let ((string (copy-sequence string))) - (while props - (put-text-property 0 (length string) (nth 0 props) (nth 1 props) string) - (setq props (cddr props))) - string)))) - -;;;; Wrappers for basic git commands -;;;; ------------------------------------------------------------ - -(defun git-rev-parse (rev) - "Parse a revision name and return its SHA1." - (git-get-string-sha1 - (git-call-process-string "rev-parse" rev))) - -(defun git-config (key) - "Retrieve the value associated to KEY in the git repository config file." - (let ((str (git-call-process-string "config" key))) - (and str (car (split-string str "\n"))))) - -(defun git-symbolic-ref (ref) - "Wrapper for the git-symbolic-ref command." - (let ((str (git-call-process-string "symbolic-ref" ref))) - (and str (car (split-string str "\n"))))) - -(defun git-update-ref (ref newval &optional oldval reason) - "Update a reference by calling git-update-ref." - (let ((args (and oldval (list oldval)))) - (when newval (push newval args)) - (push ref args) - (when reason - (push reason args) - (push "-m" args)) - (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 - (append (and index-file (list (concat "GIT_INDEX_FILE=" index-file))) process-environment))) - (apply 'git-call-process-display-error "read-tree" (if tree (list tree))))) - -(defun git-write-tree (&optional index-file) - "Call git-write-tree and return the resulting tree SHA1 as a string." - (let ((process-e |