diff options
Diffstat (limited to 'contrib/emacs')
| -rw-r--r-- | contrib/emacs/git-blame.el | 188 | ||||
| -rw-r--r-- | contrib/emacs/git.el | 41 |
2 files changed, 139 insertions, 90 deletions
diff --git a/contrib/emacs/git-blame.el b/contrib/emacs/git-blame.el index 4fa70c5ad4..e671f6c1c6 100644 --- a/contrib/emacs/git-blame.el +++ b/contrib/emacs/git-blame.el @@ -79,6 +79,58 @@ ;;; 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) @@ -252,7 +304,7 @@ See also function `git-blame-mode'." (defun git-blame-cleanup () "Remove all blame properties" - (mapcar 'delete-overlay git-blame-overlays) + (mapc 'delete-overlay git-blame-overlays) (setq git-blame-overlays nil) (remove-git-blame-text-properties (point-min) (point-max))) @@ -285,16 +337,16 @@ See also function `git-blame-mode'." (defvar in-blame-filter nil) (defun git-blame-filter (proc str) - (save-excursion - (set-buffer (process-buffer proc)) - (goto-char (process-mark proc)) - (insert-before-markers str) - (goto-char 0) - (unless in-blame-filter - (let ((more t) - (in-blame-filter t)) - (while more - (setq more (git-blame-parse))))))) + (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") @@ -302,72 +354,70 @@ See also function `git-blame-mode'." (src-line (string-to-number (match-string 2))) (res-line (string-to-number (match-string 3))) (num-lines (string-to-number (match-string 4)))) - (setq git-blame-current - (if (string= hash "0000000000000000000000000000000000000000") - nil - (git-blame-new-commit - hash src-line res-line num-lines)))) - (delete-region (point) (match-end 0)) - t) - ((looking-at "filename \\(.+\\)\n") - (let ((filename (match-string 1))) - (git-blame-add-info "filename" filename)) - (delete-region (point) (match-end 0)) + (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))) - (git-blame-add-info key value)) - (delete-region (point) (match-end 0)) - t) - ((looking-at "boundary\n") - (setq git-blame-current nil) - (delete-region (point) (match-end 0)) + (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 src-line res-line num-lines) - (save-excursion - (set-buffer git-blame-file) - (let ((info (gethash hash git-blame-cache)) - (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t)) - (when (not info) - ;; 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))) - (setq info (list hash src-line res-line num-lines - (git-describe-commit hash) - (cons 'color color)))) - (puthash hash info git-blame-cache)) - (goto-line res-line) - (while (> num-lines 0) - (if (get-text-property (point) 'git-blame) - (forward-line) - (let* ((start (point)) - (end (progn (forward-line 1) (point))) - (ovl (make-overlay start end))) - (push ovl git-blame-overlays) - (overlay-put ovl 'git-blame info) - (overlay-put ovl 'help-echo hash) - (overlay-put ovl 'face (list :background - (cdr (assq 'color (nthcdr 5 info))))) - ;; the point-entered property doesn't seem to work in overlays - ;;(overlay-put ovl 'point-entered - ;; `(lambda (x y) (git-blame-identify ,hash))) - (let ((modified (buffer-modified-p))) - (put-text-property (if (= start 1) start (1- start)) (1- end) - 'point-entered - `(lambda (x y) (git-blame-identify ,hash))) - (set-buffer-modified-p modified)))) - (setq num-lines (1- num-lines)))))) - -(defun git-blame-add-info (key value) - (if git-blame-current - (nconc git-blame-current (list (cons (intern key) value))))) +(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))) diff --git a/contrib/emacs/git.el b/contrib/emacs/git.el index eace9c18eb..5ffc506f6d 100644 --- a/contrib/emacs/git.el +++ b/contrib/emacs/git.el @@ -429,16 +429,19 @@ Each entry is a cons of (SHORT-NAME . FULL-NAME)." (git-get-string-sha1 (git-call-process-string-display-error "write-tree")))) -(defun git-commit-tree (buffer tree head) - "Call git-commit-tree with buffer as input and return the resulting commit SHA1." +(defun git-commit-tree (buffer tree parent) + "Create a commit and possibly update HEAD. +Create a commit with the message in BUFFER using the tree with hash TREE. +Use PARENT as the parent of the new commit. If PARENT is the current \"HEAD\", +update the \"HEAD\" reference to the new commit." (let ((author-name (git-get-committer-name)) (author-email (git-get-committer-email)) (subject "commit (initial): ") author-date log-start log-end args coding-system-for-write) - (when head + (when parent (setq subject "commit: ") (push "-p" args) - (push head args)) + (push parent args)) (with-current-buffer buffer (goto-char (point-min)) (if @@ -474,7 +477,7 @@ Each entry is a cons of (SHORT-NAME . FULL-NAME)." (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)) + (when commit (git-update-ref "HEAD" commit parent subject)) commit))) (defun git-empty-db-p () @@ -1043,7 +1046,7 @@ The FILES list must be sorted." (defun git-add-file () "Add marked file(s) to the index cache." (interactive) - (let ((files (git-get-filenames (git-marked-files-state 'unknown 'ignored)))) + (let ((files (git-get-filenames (git-marked-files-state 'unknown 'ignored 'unmerged)))) ;; FIXME: add support for directories (unless files (push (file-relative-name (read-file-name "File to add: " nil nil t)) files)) @@ -1116,15 +1119,6 @@ The FILES list must be sorted." (when buffer (with-current-buffer buffer (revert-buffer t t t))))) (git-success-message "Reverted" names)))))) -(defun git-resolve-file () - "Resolve conflicts in marked file(s)." - (interactive) - (let ((files (git-get-filenames (git-marked-files-state 'unmerged)))) - (when files - (when (apply 'git-call-process-display-error "update-index" "--" files) - (git-update-status-files files) - (git-success-message "Resolved" files))))) - (defun git-remove-handled () "Remove handled files from the status list." (interactive) @@ -1316,6 +1310,13 @@ The FILES list must be sorted." (when sign-off (git-append-sign-off committer-name committer-email))) buffer)) +(define-derived-mode git-log-edit-mode log-edit-mode "Git-Log-Edit" + "Major mode for editing git log messages. + +Set up git-specific `font-lock-keywords' for `log-edit-mode'." + (set (make-local-variable 'font-lock-defaults) + '(git-log-edit-font-lock-keywords t t))) + (defun git-commit-file () "Commit the marked file(s), asking for a commit message." (interactive) @@ -1341,9 +1342,9 @@ The FILES list must be sorted." (git-setup-log-buffer buffer (git-get-merge-heads) author-name author-email subject date)) (if (boundp 'log-edit-diff-function) (log-edit 'git-do-commit nil '((log-edit-listfun . git-log-edit-files) - (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)) + (log-edit-diff-function . git-log-edit-diff)) buffer 'git-log-edit-mode) + (log-edit 'git-do-commit nil 'git-log-edit-files buffer + 'git-log-edit-mode)) (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)))) @@ -1553,7 +1554,6 @@ amended version of it." (define-key map "P" 'git-prev-unmerged-file) (define-key map "q" 'git-status-quit) (define-key map "r" 'git-remove-file) - (define-key map "R" 'git-resolve-file) (define-key map "t" toggle-map) (define-key map "T" 'git-toggle-all-marks) (define-key map "u" 'git-unmark-file) @@ -1595,7 +1595,6 @@ amended version of it." ("Merge" ["Next Unmerged File" git-next-unmerged-file t] ["Prev Unmerged File" git-prev-unmerged-file t] - ["Mark as Resolved" git-resolve-file t] ["Interactive Merge File" git-find-file-imerge t] ["Diff Against Common Base File" git-diff-file-base t] ["Diff Combined" git-diff-file-combined t] @@ -1672,7 +1671,7 @@ Commands: "Entry point into git-status mode." (interactive "DSelect directory: ") (setq dir (git-get-top-dir dir)) - (if (file-directory-p (concat (file-name-as-directory dir) ".git")) + (if (file-exists-p (concat (file-name-as-directory dir) ".git")) (let ((buffer (or (and git-reuse-status-buffer (git-find-status-buffer dir)) (create-file-buffer (expand-file-name "*git-status*" dir))))) (switch-to-buffer buffer) |