├── .gitignore ├── Makefile ├── docs ├── branch1.png ├── branch10.png ├── branch11.png ├── branch2.png ├── branch3.png ├── branch4.png ├── branch5.png ├── branch6.png ├── branch7.png ├── branch8.png ├── branch9.png ├── clone0.png ├── clone1.png ├── clone2.png ├── clone3.png ├── clone4.png ├── clone5.png ├── commit1.png ├── commit2.png ├── commit3.png ├── commit4.png ├── config-init.png ├── config-init2.png ├── delete1.png ├── delete2.png ├── diff1.png ├── diff2.png ├── diff3.png ├── diff4.png ├── diff5.png ├── git-blame.el.html ├── git-emacs.el.html ├── git-emacs.html ├── git-emacs.muse ├── git-modeline.el.html ├── history1.png ├── history2.png ├── init-archive1.png ├── init-archive2.png ├── init-archive3.png ├── init-archive4.png ├── init-archive5.png ├── init-archive6.png ├── init-archive7.png ├── merge1.png ├── merge2.png ├── merge3.png ├── merge4.png ├── merge5.png ├── regexp-select1.png ├── regexp-select2.png ├── status-ignore.png ├── status-ignore1.png ├── status-summary.png ├── status1.png ├── status2.png ├── status3.png ├── status4.png ├── status5.png ├── status6.png ├── status7.png ├── status8.png ├── tag1.png ├── tag2.png ├── tag3.png ├── tag4.png ├── tag5.png ├── tag6.png ├── tag7.png ├── tag8.png └── tag9.png ├── git--test.el ├── git-blamed.el ├── git-emacs-autoloads.el ├── git-emacs.el ├── git-global-keys.el ├── git-load.el.sample ├── git-log.el ├── git-modeline.el └── git-status.el /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.elc 3 | .#* 4 | TAGS 5 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Simple makefile. We make no particular effort to optimize dependencies, 2 | # since compiling all files in a run is very fast anyway. 3 | 4 | # This might not be needed on newer emacs versions, but it doesn't hurt. 5 | # Note: newer git doesn't ship vc-git since it's been included in emacs, 6 | # but that's only v23+. Oops. If that's your situation, add a path to 7 | # your vc-git.el here (I store mine in .emacs.d now). 8 | VC_GIT_PATH="-L /usr/share/doc/git-core/contrib/emacs -L ~/.emacs.d/" 9 | 10 | EMACS_BATCH=emacs -Q --batch "$(VC_GIT_PATH)" -L . 11 | 12 | .PHONY: all compile dev tags test clean 13 | 14 | all: compile 15 | 16 | dev: tags test 17 | 18 | compile: *.el 19 | @echo; echo ">>> Compiling" 20 | rm -f *.elc 21 | $(EMACS_BATCH) -f batch-byte-compile *.el 22 | 23 | tags: *.el 24 | @echo; echo ">>> Updating tags" 25 | etags *.el 26 | 27 | test: *.el 28 | @echo; echo ">>> Running tests" 29 | $(EMACS_BATCH) -l git--test.el -f git-regression 30 | @echo; echo "Testing autoloads..." 31 | $(EMACS_BATCH) --eval "(require 'git-emacs-autoloads)" \ 32 | --visit "Makefile" \ 33 | --eval "(unless (functionp 'git-diff-baseline) (error \"autoload malfunctioned\"))" 34 | 35 | clean: 36 | rm -f *.elc 37 | -------------------------------------------------------------------------------- /docs/branch1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/branch1.png -------------------------------------------------------------------------------- /docs/branch10.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/branch10.png -------------------------------------------------------------------------------- /docs/branch11.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/branch11.png -------------------------------------------------------------------------------- /docs/branch2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/branch2.png -------------------------------------------------------------------------------- /docs/branch3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/branch3.png -------------------------------------------------------------------------------- /docs/branch4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/branch4.png -------------------------------------------------------------------------------- /docs/branch5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/branch5.png -------------------------------------------------------------------------------- /docs/branch6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/branch6.png -------------------------------------------------------------------------------- /docs/branch7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/branch7.png -------------------------------------------------------------------------------- /docs/branch8.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/branch8.png -------------------------------------------------------------------------------- /docs/branch9.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/branch9.png -------------------------------------------------------------------------------- /docs/clone0.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/clone0.png -------------------------------------------------------------------------------- /docs/clone1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/clone1.png -------------------------------------------------------------------------------- /docs/clone2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/clone2.png -------------------------------------------------------------------------------- /docs/clone3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/clone3.png -------------------------------------------------------------------------------- /docs/clone4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/clone4.png -------------------------------------------------------------------------------- /docs/clone5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/clone5.png -------------------------------------------------------------------------------- /docs/commit1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/commit1.png -------------------------------------------------------------------------------- /docs/commit2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/commit2.png -------------------------------------------------------------------------------- /docs/commit3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/commit3.png -------------------------------------------------------------------------------- /docs/commit4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/commit4.png -------------------------------------------------------------------------------- /docs/config-init.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/config-init.png -------------------------------------------------------------------------------- /docs/config-init2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/config-init2.png -------------------------------------------------------------------------------- /docs/delete1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/delete1.png -------------------------------------------------------------------------------- /docs/delete2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/delete2.png -------------------------------------------------------------------------------- /docs/diff1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/diff1.png -------------------------------------------------------------------------------- /docs/diff2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/diff2.png -------------------------------------------------------------------------------- /docs/diff3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/diff3.png -------------------------------------------------------------------------------- /docs/diff4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/diff4.png -------------------------------------------------------------------------------- /docs/diff5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/diff5.png -------------------------------------------------------------------------------- /docs/git-blame.el.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | git-blame.el 6 | 77 | 78 | 79 |
 80 | ;;; git-blame.el --- Minor mode for incremental blame for Git  -*- coding: utf-8 -*-
 81 | ;;
 82 | ;; Copyright (C) 2007  David Kågedal
 83 | ;;
 84 | ;; Authors:    David Kågedal <davidk@lysator.liu.se>
 85 | ;; Created:    31 Jan 2007
 86 | ;; Message-ID: <87iren2vqx.fsf@morpheus.local>
 87 | ;; License:    GPL
 88 | ;; Keywords:   git, version control, release management
 89 | ;;
 90 | ;; Compatibility: Emacs21, Emacs22 and EmacsCVS
 91 | ;;                Git 1.5 and up
 92 | 
 93 | ;; This file is *NOT* part of GNU Emacs.
 94 | ;; This file is distributed under the same terms as GNU Emacs.
 95 | 
 96 | ;; This program is free software; you can redistribute it and/or
 97 | ;; modify it under the terms of the GNU General Public License as
 98 | ;; published by the Free Software Foundation; either version 2 of
 99 | ;; the License, or (at your option) any later version.
100 | 
101 | ;; This program is distributed in the hope that it will be
102 | ;; useful, but WITHOUT ANY WARRANTY; without even the implied
103 | ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
104 | ;; PURPOSE.  See the GNU General Public License for more details.
105 | 
106 | ;; You should have received a copy of the GNU General Public
107 | ;; License along with this program; if not, write to the Free
108 | ;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
109 | ;; MA 02111-1307 USA
110 | 
111 | ;; http://www.fsf.org/copyleft/gpl.html
112 | 
113 | 
114 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
115 | ;;
116 | ;;; Commentary:
117 | ;;
118 | ;; Here is an Emacs implementation of incremental git-blame.  When you
119 | ;; turn it on while viewing a file, the editor buffer will be updated by
120 | ;; setting the background of individual lines to a color that reflects
121 | ;; which commit it comes from.  And when you move around the buffer, a
122 | ;; one-line summary will be shown in the echo area.
123 | 
124 | ;;; Installation:
125 | ;;
126 | ;; To use this package, put it somewhere in `load-path' (or add
127 | ;; directory with git-blame.el to `load-path'), and add the following
128 | ;; line to your .emacs:
129 | ;;
130 | ;;    (require 'git-blame)
131 | ;;
132 | ;; If you do not want to load this package before it is necessary, you
133 | ;; can make use of the `autoload' feature, e.g. by adding to your .emacs
134 | ;; the following lines
135 | ;;
136 | ;;    (autoload 'git-blame-mode "git-blame"
137 | ;;              "Minor mode for incremental blame for Git." t)
138 | ;;
139 | ;; Then first use of `M-x git-blame-mode' would load the package.
140 | 
141 | ;;; Compatibility:
142 | ;;
143 | ;; It requires GNU Emacs 21 or later and Git 1.5.0 and up
144 | ;;
145 | ;; If you'are using Emacs 20, try changing this:
146 | ;;
147 | ;;            (overlay-put ovl 'face (list :background
148 | ;;                                         (cdr (assq 'color (cddddr info)))))
149 | ;;
150 | ;; to
151 | ;;
152 | ;;            (overlay-put ovl 'face (cons 'background-color
153 | ;;                                         (cdr (assq 'color (cddddr info)))))
154 | 
155 | 
156 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
157 | ;;
158 | ;;; Code:
159 | 
160 | (eval-when-compile (require 'cl))                 ; to use `push', `pop'
161 | 
162 | 
163 | (defun git-blame-color-scale (&rest elements)
164 |   "Given a list, returns a list of triples formed with each
165 | elements of the list.
166 | 
167 | a b => bbb bba bab baa abb aba aaa aab"
168 |   (let (result)
169 |     (dolist (a elements)
170 |       (dolist (b elements)
171 |         (dolist (c elements)
172 |           (setq result (cons (format "#%s%s%s" a b c) result)))))
173 |     result))
174 | 
175 | ;; (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c") =>
176 | ;; ("#3c3c3c" "#3c3c14" "#3c3c34" "#3c3c2c" "#3c3c1c" "#3c3c24"
177 | ;; "#3c3c04" "#3c3c0c" "#3c143c" "#3c1414" "#3c1434" "#3c142c" ...)
178 | 
179 | (defmacro git-blame-random-pop (l)
180 |   "Select a random element from L and returns it. Also remove
181 | selected element from l."
182 |   ;; only works on lists with unique elements
183 |   `(let ((e (elt ,l (random (length ,l)))))
184 |      (setq ,l (remove e ,l))
185 |      e))
186 | 
187 | (defvar git-blame-dark-colors
188 |   (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c")
189 |   "*List of colors (format #RGB) to use in a dark environment.
190 | 
191 | To check out the list, evaluate (list-colors-display git-blame-dark-colors).")
192 | 
193 | (defvar git-blame-light-colors
194 |   (git-blame-color-scale "c4" "d4" "cc" "dc" "f4" "e4" "fc" "ec")
195 |   "*List of colors (format #RGB) to use in a light environment.
196 | 
197 | To check out the list, evaluate (list-colors-display git-blame-light-colors).")
198 | 
199 | (defvar git-blame-colors '()
200 |   "Colors used by git-blame. The list is built once when activating git-blame
201 | minor mode.")
202 | 
203 | (defvar git-blame-ancient-color "dark green"
204 |   "*Color to be used for ancient commit.")
205 | 
206 | (defvar git-blame-autoupdate t
207 |   "*Automatically update the blame display while editing")
208 | 
209 | (defvar git-blame-proc nil
210 |   "The running git-blame process")
211 | (make-variable-buffer-local 'git-blame-proc)
212 | 
213 | (defvar git-blame-overlays nil
214 |   "The git-blame overlays used in the current buffer.")
215 | (make-variable-buffer-local 'git-blame-overlays)
216 | 
217 | (defvar git-blame-cache nil
218 |   "A cache of git-blame information for the current buffer")
219 | (make-variable-buffer-local 'git-blame-cache)
220 | 
221 | (defvar git-blame-idle-timer nil
222 |   "An idle timer that updates the blame")
223 | (make-variable-buffer-local 'git-blame-cache)
224 | 
225 | (defvar git-blame-update-queue nil
226 |   "A queue of update requests")
227 | (make-variable-buffer-local 'git-blame-update-queue)
228 | 
229 | ;; FIXME: docstrings
230 | (defvar git-blame-file nil)
231 | (defvar git-blame-current nil)
232 | 
233 | (defvar git-blame-mode nil)
234 | (make-variable-buffer-local 'git-blame-mode)
235 | 
236 | (defvar git-blame-mode-line-string " blame"
237 |   "String to display on the mode line when git-blame is active.")
238 | 
239 | (or (assq 'git-blame-mode minor-mode-alist)
240 |     (setq minor-mode-alist
241 |       (cons '(git-blame-mode git-blame-mode-line-string) minor-mode-alist)))
242 | 
243 | ;;;###autoload
244 | (defun git-blame-mode (&optional arg)
245 |   "Toggle minor mode for displaying Git blame
246 | 
247 | With prefix ARG, turn the mode on if ARG is positive."
248 |   (interactive "P")
249 |   (cond
250 |    ((null arg)
251 |     (if git-blame-mode (git-blame-mode-off) (git-blame-mode-on)))
252 |    ((> (prefix-numeric-value arg) 0) (git-blame-mode-on))
253 |    (t (git-blame-mode-off))))
254 | 
255 | (defun git-blame-mode-on ()
256 |   "Turn on git-blame mode.
257 | 
258 | See also function `git-blame-mode'."
259 |   (make-local-variable 'git-blame-colors)
260 |   (if git-blame-autoupdate
261 |       (add-hook 'after-change-functions 'git-blame-after-change nil t)
262 |     (remove-hook 'after-change-functions 'git-blame-after-change t))
263 |   (git-blame-cleanup)
264 |   (let ((bgmode (cdr (assoc 'background-mode (frame-parameters)))))
265 |     (if (eq bgmode 'dark)
266 |     (setq git-blame-colors git-blame-dark-colors)
267 |       (setq git-blame-colors git-blame-light-colors)))
268 |   (setq git-blame-cache (make-hash-table :test 'equal))
269 |   (setq git-blame-mode t)
270 |   (git-blame-run))
271 | 
272 | (defun git-blame-mode-off ()
273 |   "Turn off git-blame mode.
274 | 
275 | See also function `git-blame-mode'."
276 |   (git-blame-cleanup)
277 |   (if git-blame-idle-timer (cancel-timer git-blame-idle-timer))
278 |   (setq git-blame-mode nil))
279 | 
280 | ;;;###autoload
281 | (defun git-reblame ()
282 |   "Recalculate all blame information in the current buffer"
283 |   (interactive)
284 |   (unless git-blame-mode
285 |     (error "Git-blame is not active"))
286 | 
287 |   (git-blame-cleanup)
288 |   (git-blame-run))
289 | 
290 | (defun git-blame-run (&optional startline endline)
291 |   (if git-blame-proc
292 |       ;; Should maybe queue up a new run here
293 |       (message "Already running git blame")
294 |     (let ((display-buf (current-buffer))
295 |           (blame-buf (get-buffer-create
296 |                       (concat " git blame for " (buffer-name))))
297 |           (args '("--incremental" "--contents" "-")))
298 |       (if startline
299 |           (setq args (append args
300 |                              (list "-L" (format "%d,%d" startline endline)))))
301 |       (setq args (append args
302 |                          (list (file-name-nondirectory buffer-file-name))))
303 |       (setq git-blame-proc
304 |             (apply 'start-process
305 |                    "git-blame" blame-buf
306 |                    "git" "blame"
307 |                    args))
308 |       (with-current-buffer blame-buf
309 |         (erase-buffer)
310 |         (make-local-variable 'git-blame-file)
311 |         (make-local-variable 'git-blame-current)
312 |         (setq git-blame-file display-buf)
313 |         (setq git-blame-current nil))
314 |       (set-process-filter git-blame-proc 'git-blame-filter)
315 |       (set-process-sentinel git-blame-proc 'git-blame-sentinel)
316 |       (process-send-region git-blame-proc (point-min) (point-max))
317 |       (process-send-eof git-blame-proc))))
318 | 
319 | (defun remove-git-blame-text-properties (start end)
320 |   (let ((modified (buffer-modified-p))
321 |         (inhibit-read-only t))
322 |     (remove-text-properties start end '(point-entered nil))
323 |     (set-buffer-modified-p modified)))
324 | 
325 | (defun git-blame-cleanup ()
326 |   "Remove all blame properties"
327 |     (mapcar 'delete-overlay git-blame-overlays)
328 |     (setq git-blame-overlays nil)
329 |     (remove-git-blame-text-properties (point-min) (point-max)))
330 | 
331 | (defun git-blame-update-region (start end)
332 |   "Rerun blame to get updates between START and END"
333 |   (let ((overlays (overlays-in start end)))
334 |     (while overlays
335 |       (let ((overlay (pop overlays)))
336 |         (if (< (overlay-start overlay) start)
337 |             (setq start (overlay-start overlay)))
338 |         (if (> (overlay-end overlay) end)
339 |             (setq end (overlay-end overlay)))
340 |         (setq git-blame-overlays (delete overlay git-blame-overlays))
341 |         (delete-overlay overlay))))
342 |   (remove-git-blame-text-properties start end)
343 |   ;; We can be sure that start and end are at line breaks
344 |   (git-blame-run (1+ (count-lines (point-min) start))
345 |                  (count-lines (point-min) end)))
346 | 
347 | (defun git-blame-sentinel (proc status)
348 |   (with-current-buffer (process-buffer proc)
349 |     (with-current-buffer git-blame-file
350 |       (setq git-blame-proc nil)
351 |       (if git-blame-update-queue
352 |           (git-blame-delayed-update))))
353 |   ;;(kill-buffer (process-buffer proc))
354 |   ;;(message "git blame finished")
355 |   )
356 | 
357 | (defvar in-blame-filter nil)
358 | 
359 | (defun git-blame-filter (proc str)
360 |   (save-excursion
361 |     (set-buffer (process-buffer proc))
362 |     (goto-char (process-mark proc))
363 |     (insert-before-markers str)
364 |     (goto-char 0)
365 |     (unless in-blame-filter
366 |       (let ((more t)
367 |             (in-blame-filter t))
368 |         (while more
369 |           (setq more (git-blame-parse)))))))
370 | 
371 | (defun git-blame-parse ()
372 |   (cond ((looking-at "\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)\n")
373 |          (let ((hash (match-string 1))
374 |                (src-line (string-to-number (match-string 2)))
375 |                (res-line (string-to-number (match-string 3)))
376 |                (num-lines (string-to-number (match-string 4))))
377 |            (setq git-blame-current
378 |                  (if (string= hash "0000000000000000000000000000000000000000")
379 |                      nil
380 |                    (git-blame-new-commit
381 |                     hash src-line res-line num-lines))))
382 |          (delete-region (point) (match-end 0))
383 |          t)
384 |         ((looking-at "filename \\(.+\\)\n")
385 |          (let ((filename (match-string 1)))
386 |            (git-blame-add-info "filename" filename))
387 |          (delete-region (point) (match-end 0))
388 |          t)
389 |         ((looking-at "\\([a-z-]+\\) \\(.+\\)\n")
390 |          (let ((key (match-string 1))
391 |                (value (match-string 2)))
392 |            (git-blame-add-info key value))
393 |          (delete-region (point) (match-end 0))
394 |          t)
395 |         ((looking-at "boundary\n")
396 |          (setq git-blame-current nil)
397 |          (delete-region (point) (match-end 0))
398 |          t)
399 |         (t
400 |          nil)))
401 | 
402 | (defun git-blame-new-commit (hash src-line res-line num-lines)
403 |   (save-excursion
404 |     (set-buffer git-blame-file)
405 |     (let ((info (gethash hash git-blame-cache))
406 |           (inhibit-point-motion-hooks t)
407 |           (inhibit-modification-hooks t))
408 |       (when (not info)
409 |     ;; Assign a random color to each new commit info
410 |     ;; Take care not to select the same color multiple times
411 |     (let ((color (if git-blame-colors
412 |              (git-blame-random-pop git-blame-colors)
413 |                git-blame-ancient-color)))
414 |           (setq info (list hash src-line res-line num-lines
415 |                            (git-describe-commit hash)
416 |                            (cons 'color color))))
417 |         (puthash hash info git-blame-cache))
418 |       (goto-line res-line)
419 |       (while (> num-lines 0)
420 |         (if (get-text-property (point) 'git-blame)
421 |             (forward-line)
422 |           (let* ((start (point))
423 |                  (end (progn (forward-line 1) (point)))
424 |                  (ovl (make-overlay start end)))
425 |             (push ovl git-blame-overlays)
426 |             (overlay-put ovl 'git-blame info)
427 |             (overlay-put ovl 'help-echo hash)
428 |             (overlay-put ovl 'face (list :background
429 |                                          (cdr (assq 'color (nthcdr 5 info)))))
430 |             ;; the point-entered property doesn't seem to work in overlays
431 |             ;;(overlay-put ovl 'point-entered
432 |             ;;             `(lambda (x y) (git-blame-identify ,hash)))
433 |             (let ((modified (buffer-modified-p)))
434 |               (put-text-property (if (= start 1) start (1- start)) (1- end)
435 |                                  'point-entered
436 |                                  `(lambda (x y) (git-blame-identify ,hash)))
437 |               (set-buffer-modified-p modified))))
438 |         (setq num-lines (1- num-lines))))))
439 | 
440 | (defun git-blame-add-info (key value)
441 |   (if git-blame-current
442 |       (nconc git-blame-current (list (cons (intern key) value)))))
443 | 
444 | (defun git-blame-current-commit ()
445 |   (let ((info (get-char-property (point) 'git-blame)))
446 |     (if info
447 |         (car info)
448 |       (error "No commit info"))))
449 | 
450 | (defun git-describe-commit (hash)
451 |   (with-temp-buffer
452 |     (call-process "git" nil t nil
453 |                   "log" "-1" "--pretty=oneline"
454 |                   hash)
455 |     (buffer-substring (point-min) (1- (point-max)))))
456 | 
457 | (defvar git-blame-last-identification nil)
458 | (make-variable-buffer-local 'git-blame-last-identification)
459 | (defun git-blame-identify (&optional hash)
460 |   (interactive)
461 |   (let ((info (gethash (or hash (git-blame-current-commit)) git-blame-cache)))
462 |     (when (and info (not (eq info git-blame-last-identification)))
463 |       (message "%s" (nth 4 info))
464 |       (setq git-blame-last-identification info))))
465 | 
466 | ;; (defun git-blame-after-save ()
467 | ;;   (when git-blame-mode
468 | ;;     (git-blame-cleanup)
469 | ;;     (git-blame-run)))
470 | ;; (add-hook 'after-save-hook 'git-blame-after-save)
471 | 
472 | (defun git-blame-after-change (start end length)
473 |   (when git-blame-mode
474 |     (git-blame-enq-update start end)))
475 | 
476 | (defvar git-blame-last-update nil)
477 | (make-variable-buffer-local 'git-blame-last-update)
478 | (defun git-blame-enq-update (start end)
479 |   "Mark the region between START and END as needing blame update"
480 |   ;; Try to be smart and avoid multiple callouts for sequential
481 |   ;; editing
482 |   (cond ((and git-blame-last-update
483 |               (= start (cdr git-blame-last-update)))
484 |          (setcdr git-blame-last-update end))
485 |         ((and git-blame-last-update
486 |               (= end (car git-blame-last-update)))
487 |          (setcar git-blame-last-update start))
488 |         (t
489 |          (setq git-blame-last-update (cons start end))
490 |          (setq git-blame-update-queue (nconc git-blame-update-queue
491 |                                              (list git-blame-last-update)))))
492 |   (unless (or git-blame-proc git-blame-idle-timer)
493 |     (setq git-blame-idle-timer
494 |           (run-with-idle-timer 0.5 nil 'git-blame-delayed-update))))
495 | 
496 | (defun git-blame-delayed-update ()
497 |   (setq git-blame-idle-timer nil)
498 |   (if git-blame-update-queue
499 |       (let ((first (pop git-blame-update-queue))
500 |             (inhibit-point-motion-hooks t))
501 |         (git-blame-update-region (car first) (cdr first)))))
502 | 
503 | (provide 'git-blame)
504 | 
505 | ;;; git-blame.el ends here
506 | 
507 | 508 | 509 | -------------------------------------------------------------------------------- /docs/git-emacs.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | A Guided Tour of emacs-git (by TSKim) 5 | 6 | 8 | 9 | 10 |

A Guided Tour of emacs-git (by TSKim)

11 | 12 |
13 |
14 |
15 | Installation 16 |
17 |
18 | Configuration 19 |
20 |
21 | Cloning 22 |
23 |
24 |
25 |
26 | 1. Run 'git-clone' 27 |
28 |
29 | 2. Select local directory 30 |
31 |
32 | 3. Select repository 33 |
34 |
35 | 4. All things done 36 |
37 |
38 |
39 |
40 | Importing 41 |
42 |
43 |
44 |
45 | 1. run 'git-init-from-archive' 46 |
47 |
48 | 2. Select archive file 49 |
50 |
51 | 3. If necessary, set config user.name and user.email 52 |
53 |
54 | 4. Initial commit 55 |
56 |
57 | 5. Commited result 58 |
59 |
60 |
61 |
62 | Making changes 63 |
64 |
65 |
66 |
67 | 1. Open the file which is under the git 68 |
69 |
70 | 2. Editing sources and saving the changes 71 |
72 |
73 | 3. Commit your changes with 'C-x v v' key or 'git-commit-all' 74 |
75 |
76 | 4. All things done 77 |
78 |
79 |
80 |
81 | Viewing project history 82 |
83 |
84 |
85 |
86 | 1. Run 'git-history' for project or 'git-log' for each file 87 |
88 |
89 | 2. 'vc-log' history browser with fancy color 90 |
91 |
92 |
93 |
94 | Managing Branches 95 |
96 |
97 |
98 |
99 | 1. Show branchs with 'git-branch' 100 |
101 |
102 | 2. Create new branch with 'c' in git-branch buffer 103 |
104 |
105 | 3. Select the base branch 106 |
107 |
108 | 4. All things done 109 |
110 |
111 | 5. Topic : Switch to other branch 112 |
113 |
114 | 6. Topic : Delete branches 115 |
116 |
117 | 7. Topic : gitk 118 |
119 |
120 |
121 |
122 | Tagging 123 |
124 |
125 |
126 |
127 | 1. Create new tag 'git-tag' or 'git-snapshot' 128 |
129 |
130 | 2. Input the tag 131 |
132 |
133 | 3. All things done 134 |
135 |
136 | 4. Checking out 137 |
138 |
139 | 5. Checking out to new branch 140 |
141 |
142 |
143 |
144 | Diffing 145 |
146 |
147 |
148 |
149 | 1. Run 'git-diff' 150 |
151 |
152 | 2. Select diffing target 153 |
154 |
155 | 3. Select diffing revision 156 |
157 |
158 | 4. Ediff 159 |
160 |
161 |
162 |
163 | Merging 164 |
165 |
166 |
167 |
168 | 1. Try to merge from other branch with 'git-merge' 169 |
170 |
171 | 2. Select target branch 172 |
173 |
174 | 3. After merge 175 |
176 |
177 | 4. 3 way merge 178 |
179 |
180 | 5. After resolving conflicts 181 |
182 |
183 |
184 |
185 | Checking the status of the project 186 |
187 |
188 |
189 |
190 | Run 'git-status' 191 |
192 |
193 | Inspecting Directory 194 |
195 |
196 | Naive command on git with '.' 197 |
198 |
199 | Rename with 'r' 200 |
201 |
202 | Marking with '*' 203 |
204 |
205 | Add .gitignore with 'i' 206 |
207 |
208 | Switching branch with 'b' 209 |
210 |
211 | Sarcastic blame! with '?' 212 |
213 |
214 | Summary mode with 's' 215 |
216 |
217 |
218 |
219 |
220 | 221 | 222 |

223 | Installation

224 | 225 | 231 | 232 |
 233 | (add-to-list 'load-path "/home/tsgates/Skills/git/git-emacs-1.0")
 234 | (require 'git-emacs)
 235 | 
236 | 237 | 238 |

239 | Configuration

240 | 241 | 242 | 243 | 244 |
git-config-init command
git-config-init command
245 | 246 | 247 | 248 | 249 |
Automatically set current user.name & user.email
Automatically set current user.name & user.email
250 | 251 | 255 | 256 | 257 |

258 | Cloning

259 | 260 |

261 | 1. Run 'git-clone'

262 | 263 | 264 | 265 | 266 |
Run 'git-clone'
Run 'git-clone'
267 | 268 | 271 | 272 | 273 |

274 | 2. Select local directory

275 | 276 | 277 | 278 | 279 |
Move directory
Move directory
280 | 281 | 282 | 283 | 284 |
Select the directory to be cloned
Select the directory to be cloned
285 | 286 | 290 | 291 | 292 |

293 | 3. Select repository

294 | 295 | 296 | 297 | 298 |
Select repository
Select repository
299 | 300 | 303 | 304 | 305 |

306 | 4. All things done

307 | 308 | 309 | 310 | 311 |
Start to clone from repository
Start to clone from repository
312 | 313 | 314 | 315 | 316 |
All things done
All things done
317 | 318 | 322 | 323 | 324 | 325 |

326 | Importing

327 | 328 |

329 | 1. run 'git-init-from-archive'

330 | 331 | 332 | 333 | 334 |
Init from archive
Init from archive
335 | 336 | 339 | 340 | 341 |

342 | 2. Select archive file

343 | 344 | 345 | 346 | 347 |
Selecting archive file
Selecting archive file
348 | 349 | 353 | 354 | 355 |

356 | 3. If necessary, set config user.name and user.email

357 | 358 | 359 | 360 | 361 |
Then, setting config user.name and user.email
Then, setting config user.name and user.email
362 | 363 | 366 | 367 | 368 |

369 | 4. Initial commit

370 | 371 | 372 | 373 | 374 |
Inital commit log
Inital commit log
375 | 376 | 379 | 380 | 381 |

382 | 5. Commited result

383 | 384 | 385 | 386 | 387 |
After commiting
After commiting
388 | 389 | 390 | 391 |

392 | Making changes

393 | 394 |

395 | 1. Open the file which is under the git

396 | 397 | 398 | 399 | 400 |
Open the file
Open the file
401 | 402 | 408 | 409 | 410 |

411 | 2. Editing sources and saving the changes

412 | 413 | 414 | 415 | 416 |
After saving the changes
After saving the changes
417 | 418 | 422 | 423 | 424 |

425 | 3. Commit your changes with 'C-x v v' key or 'git-commit-all'

426 | 427 | 428 | 429 | 430 |
Commit your changes after editing log
Commit your changes after editing log
431 | 432 | 440 | 441 | 442 |

443 | 4. All things done

444 | 445 |
446 |

   447 | 448 | 449 |
After commit
After commit

450 |
451 | 452 | 455 | 456 | 457 | 458 |

459 | Viewing project history

460 | 461 |

462 | 1. Run 'git-history' for project or 'git-log' for each file

463 | 464 | 465 | 466 | 467 |
History view
History view
468 | 469 | 472 | 473 | 474 |

475 | 2. 'vc-log' history browser with fancy color

476 | 477 | 478 | 479 | 480 |
History browsing
History browsing
481 | 482 | 487 | 488 | 489 | 490 |

491 | Managing Branches

492 | 493 |

494 | 1. Show branchs with 'git-branch'

495 | 496 | 497 | 498 | 499 |
Display branch list
Display branch list
500 | 501 | 505 | 506 | 507 |

508 | 2. Create new branch with 'c' in git-branch buffer

509 | 510 | 511 | 512 | 513 |
After pressing 'c', input the new name of the branch
After pressing 'c', input the new name of the branch
514 | 515 | 518 | 519 | 520 |

521 | 3. Select the base branch

522 | 523 | 524 | 525 | 526 |
Select the branch you want to base on
Select the branch you want to base on
527 | 528 | 531 | 532 | 533 |

534 | 4. All things done

535 | 536 | 537 | 538 | 539 |
Reload current buffer
Reload current buffer
540 | 541 | 542 | 543 | 544 |
Check see if switched to the new branch
Check see if switched to the new branch
545 | 546 | 549 | 550 | 551 |

552 | 5. Topic : Switch to other branch

553 | 554 |
555 |

   556 | 557 | 558 |
Switch to other branch after selecting branch
Switch to other branch after selecting branch

559 |
560 | 561 |
562 |

   563 | 564 | 565 |
Generate automatic commit log
Generate automatic commit log

566 |
567 | 568 |
569 |

   570 | 571 | 572 |
Finally switched to 'mater'
Finally switched to 'mater'

573 |
574 | 575 | 579 | 580 | 581 |

582 | 6. Topic : Delete branches

583 | 584 |
585 |

   586 | 587 | 588 |
Delete 'new-branch' in 'git-branch'
Delete 'new-branch' in 'git-branch'

589 |
590 | 591 |
592 |

   593 | 594 | 595 |
Finally delete a 'new-branch'
Finally delete a 'new-branch'

596 |
597 | 598 | 601 | 602 | 603 |

604 | 7. Topic : gitk

605 | 606 |
607 |

   608 | 609 | 610 |
Launching gitk in emacs
Launching gitk in emacs

611 |
612 | 613 | 616 | 617 | 618 | 619 |

620 | Tagging

621 | 622 |

623 | 1. Create new tag 'git-tag' or 'git-snapshot'

624 | 625 | 626 | 627 | 628 |
Create new tag
Create new tag
629 | 630 | 633 | 634 | 635 |

636 | 2. Input the tag

637 | 638 | 639 | 640 | 641 |
Input tag name
Input tag name
642 | 643 | 646 | 647 | 648 |

649 | 3. All things done

650 | 651 | 652 | 653 | 654 |
All things done
All things done
655 | 656 | 659 | 660 | 661 |

662 | 4. Checking out

663 | 664 | 665 | 666 | 667 |
Checking out
Checking out
668 | 669 | 670 | 671 | 672 |
Checking out to new branch
Checking out to new branch
673 | 674 | 678 | 679 | 680 |

681 | 5. Checking out to new branch

682 | 683 | 684 | 685 | 686 |
Checking out to new branch
Checking out to new branch
687 | 688 | 689 | 690 | 691 |
Input the new branch name
Input the new branch name
692 | 693 | 694 | 695 | 696 |
Based on what?
Based on what?
697 | 698 | 699 | 700 | 701 |
Ok on new 'wild-idea' branch
Ok on new 'wild-idea' branch
702 | 703 | 706 | 707 | 708 | 709 |

710 | Diffing

711 | 712 |

713 | 1. Run 'git-diff'

714 | 715 | 716 | 717 | 718 |
Run 'git-diff'
Run 'git-diff'
719 | 720 | 723 | 724 | 725 |

726 | 2. Select diffing target

727 | 728 | 729 | 730 | 731 |
Select diffing target
Select diffing target
732 | 733 | 736 | 737 | 738 |

739 | 3. Select diffing revision

740 | 741 | 742 | 743 | 744 |
Select revision
Select revision
745 | 746 | 750 | 751 | 752 |

753 | 4. Ediff

754 | 755 | 756 | 757 | 758 |
Diffing with ediff
Diffing with ediff
759 | 760 | 761 | 762 | 763 |
Diffing against HEAD~2
Diffing against HEAD~2
764 | 765 | 769 | 770 | 771 | 772 |

773 | Merging

774 | 775 |

776 | 1. Try to merge from other branch with 'git-merge'

777 | 778 | 779 | 780 | 781 |
Run 'git-merge'
Run 'git-merge'
782 | 783 | 786 | 787 | 788 |

789 | 2. Select target branch

790 | 791 | 792 | 793 | 794 |
Select the branch to be merged
Select the branch to be merged
795 | 796 | 799 | 800 | 801 |

802 | 3. After merge

803 | 804 | 805 | 806 | 807 |
After merge, it will launch git-status mode
After merge, it will launch git-status mode
808 | 809 | 813 | 814 | 815 |

816 | 4. 3 way merge

817 | 818 | 819 | 820 | 821 |
3 way merge similar to famous 'psvn.el'
3 way merge similar to famous 'psvn.el'
822 | 823 | 826 | 827 | 828 |

829 | 5. After resolving conflicts

830 | 831 | 832 | 833 | 834 |
Return to the merged 'test.c'
Return to the merged 'test.c'
835 | 836 | 841 | 842 | 843 | 844 |

845 | Checking the status of the project

846 | 847 |

848 | Run 'git-status'

849 | 850 | 851 | 852 | 853 |
Git cloned directory right after cloning
Git cloned directory right after cloning
854 | 855 | 859 | 860 | 861 |

862 | Inspecting Directory

863 | 864 | 865 | 866 | 867 |
Expanding tree or open file
Expanding tree or open file
868 | 869 | 884 | 885 | 886 |

887 | Naive command on git with '.'

888 | 889 |
890 |

   891 | 892 | 893 |
Git naive command
Git naive command
894 |

897 | 898 | 899 | 900 |

901 | Rename with 'r'

902 | 903 | 904 | 905 | 906 |
Rename on marks or current item
Rename on marks or current item
907 | 908 | 909 | 910 | 911 |
After renaming all!
After renaming all!
912 | 913 | 917 | 918 | 919 |

920 | Marking with '*'

921 | 922 | 923 | 924 | 925 |
Regular expression marking
Regular expression marking
926 | 927 | 928 | 929 | 930 |
After marking with regexp "RegNotes.*"
After marking with regexp "RegNotes.*"
931 | 932 | 935 | 936 | * Deleting with 'd' 937 | 938 | 939 | 940 |
Delete the selected files
Delete the selected files
941 | 942 | 943 | 944 | 945 |
After deleting
After deleting
946 | 947 | 950 | 951 | 952 |

953 | Add .gitignore with 'i'

954 | 955 | 956 | 957 | 958 |
Select files you want to ignore
Select files you want to ignore
959 | 960 | 961 | 962 | 963 |
After ignoring
After ignoring
964 | 965 | 969 | 970 | 971 |

972 | Switching branch with 'b'

973 | 974 | 975 | 976 | 977 |
Switching branch
Switching branch
978 | 979 | 980 | 981 | 982 |
After switching branch
After switching branch
983 | 984 | 987 | 988 | 989 |

990 | Sarcastic blame! with '?'

991 | 992 | 993 | 994 | 995 |
Open in blame mode
Open in blame mode
996 | 997 | 1000 | 1001 | 1002 |

1003 | Summary mode with 's'

1004 | 1005 | 1006 | 1007 | 1008 |
Summary the view
Summary the view
1009 | 1010 | 1014 | 1015 | 1016 | 1017 | 1018 | 1019 | 1020 | 1021 | -------------------------------------------------------------------------------- /docs/git-emacs.muse: -------------------------------------------------------------------------------- 1 | #created 2008-03-23 [22:34] 2 | #date 2008-03-24 [21:24] 3 | #title A Guided Tour of emacs-git 4 | #author TSKim 5 | 6 | 7 | 8 | * Installation 9 | - [[./git-emacs-1.0.tar.gz][Download git-emacs-1.0.tar.gz]] 10 | - [[./git-emacs.el.html][git-emacs.el]]/[[./git-emacs.el][raw]] 11 | - [[./git-modeline.el.html][git-modeline.el]]/[[./git-modeline.el][raw]] 12 | - [[./git-blame.el.html][git-blame.el]]/[[./git-blame.el][raw]] 13 | 14 | 15 | (add-to-list 'load-path "/home/tsgates/Skills/git/git-emacs-1.0") 16 | (require 'git-emacs) 17 | 18 | 19 | * Configuration 20 | 21 | [[./config-init.png][git-config-init command]] 22 | 23 | [[./config-init2.png][Automatically set current user.name & user.email]] 24 | 25 | - Set _user.name_ & _user.email_ if it is not set yet 26 | - But, git-emacs recommends the _full name_ and _email address_ of the _user logged in_ 27 | 28 | * Cloning 29 | 30 | ** 1. Run 'git-clone' 31 | [[./clone0.png][Run 'git-clone']] 32 | 33 | - Run 'git-clone' 34 | 35 | ** 2. Select local directory 36 | [[./clone1.png][Move directory]] 37 | 38 | [[./clone2.png][Select the directory to be cloned]] 39 | 40 | - With *'ido'* interface, you can change directory 41 | - Create directory with *'C-m'* (*'M-n'*, *'M-p'* to search history, reference to *'ido'*) 42 | 43 | ** 3. Select repository 44 | [[./clone3.png][Select repository]] 45 | 46 | - Select repositories from _history_ and your _bookmarks_ or type new one 47 | 48 | ** 4. All things done 49 | [[./clone4.png][Start to clone from repository]] 50 | 51 | [[./clone5.png][All things done]] 52 | 53 | - Support _asynchronous_ downloading from the repository 54 | - All things ok, you can see message *"Cloned"*! 55 | 56 | * Importing 57 | 58 | ** 1. run 'git-init-from-archive' 59 | [[./init-archive1.png][Init from archive]] 60 | 61 | - Run 'git-init-from-archive' 62 | 63 | ** 2. Select archive file 64 | [[./init-archive2.png][Selecting archive file]] 65 | 66 | - Select the project file 67 | - And then create git repository 68 | 69 | ** 3. If necessary, set config user.name and user.email 70 | [[./init-archive3.png][Then, setting config user.name and user.email]] 71 | 72 | - It comes from OS user information 73 | 74 | ** 4. Initial commit 75 | [[./init-archive4.png][Inital commit log]] 76 | 77 | - *'C-cC-c'* to actually commit the revisions 78 | 79 | ** 5. Commited result 80 | [[./init-archive5.png][After commiting]] 81 | 82 | * Making changes 83 | 84 | ** 1. Open the file which is under the git 85 | [[./commit1.png][Open the file]] 86 | 87 | - The **green** dot in the modeline indicates the state of this source file is _uptodate_ 88 | (**gray** : _unknown_, **tomato** : _modified_, **red** : _deleted_, **purple** : _unmerged_) 89 | 90 | - As you saw in the *modeline*, *'vc-git'* is still working also 91 | 92 | ** 2. Editing sources and saving the changes 93 | [[./commit2.png][After saving the changes]] 94 | 95 | - After saving the changes, the state of the file also change from _uptodate_ to _modified_ 96 | (**tomato** dot in the modeline) 97 | 98 | ** 3. Commit your changes with **'C-x v v'** key or **'git-commit-all'** 99 | [[./commit3.png][Commit your changes after editing log]] 100 | 101 | - Of course **'C-x v v'** key is well-known ***'next action'*** in *vc-mode* in emacs 102 | - It works depending on the state of the file you are editing 103 | ("_modified_ -> commmit" & "_unmerged_ -> merge" & "_unknown_ -> add", etc) 104 | - Edit your log and then press *'C-c C-c'* in ***git-log*** buffer 105 | 106 | ** 4. All things done 107 | [[./commit4.png][After commit]] 108 | 109 | - The state of the buffer turns to _uptodate_ also 110 | 111 | * Viewing project history 112 | 113 | ** 1. Run 'git-history' for project or 'git-log' for each file 114 | [[./history1.png][History view]] 115 | 116 | - Run *'git-history'* 117 | 118 | ** 2. 'vc-log' history browser with fancy color 119 | [[./history2.png][History browsing]] 120 | 121 | - Actually, it is *'vc-log'* with fancy *advises* 122 | - *'p'*, *'n'* with a convenient per log up/down moving 123 | - *'q'* with a simple quit 124 | 125 | * Managing Branches 126 | ** 1. Show branchs with 'git-branch' 127 | [[./branch1.png][Display branch list]] 128 | 129 | - Since we did not create any buffers, we are simply in the ***master*** branch (marked with a asterisk, '*') 130 | - If you want simply checkout only, run *'git-checkout'* instead 131 | 132 | ** 2. Create new branch with 'c' in *git-branch* buffer 133 | [[./branch2.png][After pressing 'c', input the new name of the branch]] 134 | 135 | - run *'git-create-branch'* or *'git-checkout-to-new-branch'* if you are not in ***'git branch'*** buffer 136 | 137 | ** 3. Select the base branch 138 | [[./branch3.png][Select the branch you want to base on]] 139 | 140 | - Only **master** branch exists 141 | 142 | ** 4. All things done 143 | [[./branch4.png][Reload current buffer]] 144 | 145 | [[./branch5.png][Check see if switched to the new branch]] 146 | 147 | - Everything seems to be fine, and *modeline* in the "test.c" also changed to *'new-branch'*! 148 | 149 | ** 5. Topic : Switch to other branch 150 | 151 | [[./branch6.png][Switch to other branch after selecting branch]] 152 | 153 | [[./branch7.png][Generate automatic commit log]] 154 | 155 | [[./branch8.png][Finally switched to 'mater']] 156 | 157 | - With a *'RET'* key in **'git-branch'**, you can switch to selected other branch 158 | - If this buffer is not _uptodate_, commit with a _automatically generated log_ 159 | 160 | ** 6. Topic : Delete branches 161 | [[./branch9.png][Delete 'new-branch' in 'git-branch']] 162 | 163 | [[./branch10.png][Finally delete a 'new-branch']] 164 | 165 | - Isn't it simple? 166 | 167 | ** 7. Topic : gitk 168 | [[./branch11.png][Launching gitk in emacs]] 169 | 170 | - Run *gitk* with a *'gitk'* command in the buffer! 171 | 172 | * Tagging 173 | 174 | ** 1. Create new tag 'git-tag' or 'git-snapshot' 175 | [[./tag1.png][Create new tag]] 176 | 177 | - Run *'git-tag'* or *'git-snapshot'* 178 | 179 | ** 2. Input the tag 180 | [[./tag2.png][Input tag name]] 181 | 182 | - Input new tag name 183 | 184 | ** 3. All things done 185 | [[./tag3.png][All things done]] 186 | 187 | - ok 188 | 189 | ** 4. Checking out 190 | [[./tag4.png][Checking out]] 191 | 192 | [[./tag5.png][Checking out to new branch]] 193 | 194 | - Checking out may cause the branch to be dangle 195 | - Better to checkout to new branch 196 | 197 | ** 5. Checking out to new branch 198 | [[./tag6.png][Checking out to new branch]] 199 | 200 | [[./tag7.png][Input the new branch name]] 201 | 202 | [[./tag8.png][Based on what?]] 203 | 204 | [[./tag9.png][Ok on new 'wild-idea' branch]] 205 | 206 | - You can make new branch based on tags and other branches! 207 | 208 | * Diffing 209 | 210 | ** 1. Run 'git-diff' 211 | [[./diff1.png][Run 'git-diff']] 212 | 213 | - Run 'git-diff' 214 | 215 | ** 2. Select diffing target 216 | [[./diff2.png][Select diffing target]] 217 | 218 | - Select the target 219 | 220 | ** 3. Select diffing revision 221 | [[./diff3.png][Select revision]] 222 | 223 | - **HEAD** means diffing against _HEAD_ vs _cached file_ you selected at step 2 224 | - **HEAD~2** means diffing against _second parent of HEAD_ (referencing to git manual) 225 | 226 | ** 4. Ediff 227 | [[./diff4.png][Diffing with ediff]] 228 | 229 | [[./diff5.png][Diffing against HEAD~2]] 230 | 231 | - Move with *'p'*, *'n'* keys to the next/previous different region 232 | - Of course *'q'* to quit and restore previous windows 233 | 234 | * Merging 235 | 236 | ** 1. Try to merge from other branch with 'git-merge' 237 | [[./merge1.png][Run 'git-merge']] 238 | 239 | - Run 'git-merge' 240 | 241 | ** 2. Select target branch 242 | [[./merge2.png][Select the branch to be merged]] 243 | 244 | - In *'git-merge'*, you can easily select with a *'ido'* interface you may be familiar 245 | 246 | ** 3. After merge 247 | [[./merge3.png][After merge, it will launch git-status mode]] 248 | 249 | - As you see in above, there is a _conflict_ in 'test.c' 250 | - Try to resolve conflict(merged) with *'!'* key 251 | 252 | ** 4. 3 way merge 253 | [[./merge4.png][3 way merge similar to famous 'psvn.el']] 254 | 255 | - ediff-merge works fantastically 256 | 257 | ** 5. After resolving conflicts 258 | [[./merge5.png][Return to the merged 'test.c']] 259 | 260 | - But, as you know, you have to commit to reflect your changes with *'C-x v v'* 261 | (_purple_ dot in modeline indicates 'test.c' is unmerged(conflict)) 262 | - _Submit the commit log_ to complete the job 263 | 264 | * Checking the status of the project 265 | 266 | ** Run 'git-status' 267 | [[./status1.png][Git cloned directory right after cloning]] 268 | 269 | - Display current status of tree! 270 | - *'m'*, *'u'* for selecting(marking) and unselecting and *'SPACE'* to toggle mark 271 | 272 | ** Inspecting Directory 273 | [[./status4.png][Expanding tree or open file]] 274 | 275 | - *'q'* : quit status mode 276 | - *'RET'* : open file/expand tree 277 | - *'v'* : view file 278 | - *'n'* : next item 279 | - *'p'* : previous item 280 | - *'N'* : next meaningful item 281 | - *'P'* : previous meaningful item 282 | - '<' : first item 283 | - '>' : last item 284 | - 'g' : refresh 285 | - *'='* : diffing (ref.Diffing) 286 | - *'!'* : resolving conflict (ref.Merging) 287 | - *'k'* : gitk (ref. gitk) 288 | 289 | ** Naive command on git with '.' 290 | [[./status5.png][Git naive command]] 291 | - *'.'* : git command 292 | 293 | ** Rename with 'r' 294 | [[./status7.png][Rename on marks or current item]] 295 | 296 | [[./status8.png][After renaming all!]] 297 | 298 | - You can see the _newly added_ test2.c 299 | - In order to reflect the changes the repository, commit! 300 | 301 | ** Marking with '*' 302 | [[./regexp-select1.png][Regular expression marking]] 303 | 304 | [[./regexp-select2.png][After marking with regexp "RegNotes.*"]] 305 | 306 | - Support regular expression marking with '*' 307 | 308 | ** Deleting with 'd' 309 | [[./delete1.png][Delete the selected files]] 310 | 311 | [[./delete2.png][After deleting]] 312 | 313 | - Select the files to be deleted with *'d'* 314 | 315 | ** Add .gitignore with 'i' 316 | [[./status-ignore.png][Select files you want to ignore]] 317 | 318 | [[./status-ignore1.png][After ignoring]] 319 | 320 | - _Select the files_ that you want to ignore 321 | - Add the selected files or ask you the pattern to be ignored 322 | 323 | ** Switching branch with 'b' 324 | [[./status2.png][Switching branch]] 325 | 326 | [[./status3.png][After switching branch]] 327 | 328 | - You can switch to other branch with 'b' key 329 | 330 | ** Sarcastic blame! with '?' 331 | [[./status6.png][Open in blame mode]] 332 | 333 | - Git blame! from official git-blame.el(David Kågedal) 334 | 335 | ** Summary mode with 's' 336 | [[./status-summary.png][Summary the view]] 337 | 338 | - Summary with *'Occur'* 339 | - Iterate with 'next-error and 'previous-error key binding 340 | 341 | -------------------------------------------------------------------------------- /docs/git-modeline.el.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | git-modeline.el 6 | 68 | 69 | 70 |
 71 | ;; 
 72 | ;; ref. "test-runner-image.el" posted at
 73 | ;; "http://nschum.de/src/emacs/test-runner/"
 74 | ;;
 75 | 
 76 | (provide 'git-modeline)
 77 | 
 78 | (defvar git--state-mark-modeline t)     ; modeline mark display or not
 79 | (defvar git--state-mark-tooltip nil)    ; modeline tooltip display
 80 | 
 81 | (defun git--state-mark-modeline-dot (color)
 82 |   (propertize "    "
 83 |               'help-echo 'git--state-mark-tooltip
 84 |               'display
 85 |               `(image :type xpm
 86 |                       :data ,(format "/* XPM */
 87 | static char * data[] = {
 88 | \"18 13 3 1\",
 89 | \"  c None\",
 90 | \"+ c #000000\",
 91 | \". c %s\",
 92 | \"                  \",
 93 | \"       +++++      \",
 94 | \"      +.....+     \",
 95 | \"     +.......+    \",
 96 | \"    +.........+   \",
 97 | \"    +.........+   \",
 98 | \"    +.........+   \",
 99 | \"    +.........+   \",
100 | \"    +.........+   \",
101 | \"     +.......+    \",
102 | \"      +.....+     \",
103 | \"       +++++      \",
104 | \"                  \"};"
105 |                                      color)
106 |                       :ascent center)))
107 | 
108 | (defun git--install-state-mark-modeline (color)
109 |   (push `(git--state-mark-modeline
110 |           ,(git--state-mark-modeline-dot color))
111 |         mode-line-format)
112 |   (force-mode-line-update t))
113 | 
114 | (defun git--uninstall-state-mark-modeline ()
115 |   (setq mode-line-format
116 |         (remove-if #'(lambda (mode) (eq (car-safe mode)
117 |                                         'git--state-mark-modeline))
118 |                    mode-line-format))
119 |   (force-mode-line-update t))
120 | 
121 | (defun git--update-state-mark-tooltip (tooltip)
122 |   (setq git--state-mark-tooltip tooltip))
123 | 
124 | (defun git--update-state-mark (color)
125 |   (git--uninstall-state-mark-modeline)
126 |   (git--install-state-mark-modeline color))
127 | 
128 | ;; 
129 | ;; example on state-modeline-mark
130 | ;; 
131 | ;; (git--install-state-mark-modeline "red")
132 | ;; (git--uninstall-state-mark-modeline)
133 | ;; (setq git--state-mark-tooltip "testsetset")
134 | 135 | 136 | -------------------------------------------------------------------------------- /docs/history1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/history1.png -------------------------------------------------------------------------------- /docs/history2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/history2.png -------------------------------------------------------------------------------- /docs/init-archive1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/init-archive1.png -------------------------------------------------------------------------------- /docs/init-archive2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/init-archive2.png -------------------------------------------------------------------------------- /docs/init-archive3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/init-archive3.png -------------------------------------------------------------------------------- /docs/init-archive4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/init-archive4.png -------------------------------------------------------------------------------- /docs/init-archive5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/init-archive5.png -------------------------------------------------------------------------------- /docs/init-archive6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/init-archive6.png -------------------------------------------------------------------------------- /docs/init-archive7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/init-archive7.png -------------------------------------------------------------------------------- /docs/merge1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/merge1.png -------------------------------------------------------------------------------- /docs/merge2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/merge2.png -------------------------------------------------------------------------------- /docs/merge3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/merge3.png -------------------------------------------------------------------------------- /docs/merge4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/merge4.png -------------------------------------------------------------------------------- /docs/merge5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/merge5.png -------------------------------------------------------------------------------- /docs/regexp-select1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/regexp-select1.png -------------------------------------------------------------------------------- /docs/regexp-select2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/regexp-select2.png -------------------------------------------------------------------------------- /docs/status-ignore.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/status-ignore.png -------------------------------------------------------------------------------- /docs/status-ignore1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/status-ignore1.png -------------------------------------------------------------------------------- /docs/status-summary.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/status-summary.png -------------------------------------------------------------------------------- /docs/status1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/status1.png -------------------------------------------------------------------------------- /docs/status2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/status2.png -------------------------------------------------------------------------------- /docs/status3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/status3.png -------------------------------------------------------------------------------- /docs/status4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/status4.png -------------------------------------------------------------------------------- /docs/status5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/status5.png -------------------------------------------------------------------------------- /docs/status6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/status6.png -------------------------------------------------------------------------------- /docs/status7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/status7.png -------------------------------------------------------------------------------- /docs/status8.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/status8.png -------------------------------------------------------------------------------- /docs/tag1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/tag1.png -------------------------------------------------------------------------------- /docs/tag2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/tag2.png -------------------------------------------------------------------------------- /docs/tag3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/tag3.png -------------------------------------------------------------------------------- /docs/tag4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/tag4.png -------------------------------------------------------------------------------- /docs/tag5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/tag5.png -------------------------------------------------------------------------------- /docs/tag6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/tag6.png -------------------------------------------------------------------------------- /docs/tag7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/tag7.png -------------------------------------------------------------------------------- /docs/tag8.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/tag8.png -------------------------------------------------------------------------------- /docs/tag9.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tsgates/git-emacs/cef196abf398e2dd11f775d1e6cd8690567408aa/docs/tag9.png -------------------------------------------------------------------------------- /git--test.el: -------------------------------------------------------------------------------- 1 | ;; See git-emacs.el for license and versioning. 2 | 3 | (require 'git-emacs) 4 | (require 'git-status) 5 | (require 'dired) 6 | 7 | (defun git--test-with-temp-repo (function) 8 | "Run FUNCTION inside a temporary git repository" 9 | ;; DO NOT REASSIGN the temp dir variable below under any circumstances. We 10 | ;; wouldn't want to remove recursively some arbitrary dir. 11 | (let* ((git--test-tmp-dir-DONT-REASSIGN (make-temp-file "git-emacs-test-" t)) 12 | (git--test-tmp-dir git--test-tmp-dir-DONT-REASSIGN) ; Here, change this 13 | (default-directory ; or this 14 | (file-name-as-directory git--test-tmp-dir))) 15 | (unwind-protect 16 | (progn 17 | (message "Created temporary test dir %s" default-directory) 18 | (git-init default-directory) ; part of the suite, kind of 19 | (funcall function)) 20 | (dired-delete-file git--test-tmp-dir-DONT-REASSIGN 'always) 21 | (message "Deleted temporary test dir %s" 22 | git--test-tmp-dir-DONT-REASSIGN)))) 23 | 24 | (defun git--test-typical-repo-ops () 25 | ;; git exec 26 | (assert (string= "\n" (git--exec-string "rev-parse" "--show-cdup"))) 27 | (assert (string= (expand-file-name "./") (git--get-top-dir "."))) 28 | (assert (string= (expand-file-name "./") 29 | (git--get-top-dir "./nO/sUCH/dIrectory/Exists"))) 30 | 31 | ;; Create a file, and commit something. 32 | (with-temp-buffer 33 | (insert "sample text") 34 | (write-file "f1")) 35 | (assert (eq nil (git--status-file "f1"))) 36 | (let ((fi (git--ls-files "--others"))) 37 | (assert (eq 1 (length fi))) 38 | (assert (eq 'unknown (git--fileinfo->stat (car fi)))) 39 | (assert (string= "f1" (git--fileinfo->name (car fi))))) 40 | 41 | (git--add "f1") 42 | (git--commit "test commit 1") 43 | (assert (eq 'uptodate (git--status-file "f1"))) 44 | 45 | ;; create status buffer 46 | (assert (string= (buffer-name (git--create-status-buffer ".")) 47 | (git--status-buffer-name "."))) 48 | 49 | ;; open status buffer 50 | (assert (string= (buffer-name (git--create-status-buffer ".")) 51 | (git--status-buffer-name "."))) 52 | 53 | (git--kill-status-buffer ".") 54 | 55 | ;; tag stuff 56 | (assert (null (git-tag "at-first-commit"))) 57 | (assert (stringp (git-tag "at-first-commit"))) 58 | 59 | ;; test some of the buffer handling functions 60 | (with-temp-buffer 61 | (insert-file-contents "f1" t) ; visit 62 | (vc-find-file-hook) 63 | (assert (equal (list (current-buffer)) (git--find-buffers-in-dir "."))) 64 | (assert (equal (list (current-buffer)) 65 | (git--find-buffers-from-file-list '("f1")))) 66 | (assert (eq 0 (git--maybe-ask-save))) 67 | (git--require-buffer-in-git) 68 | (git--if-in-status-mode (error "guess again")) 69 | 70 | (insert "something else") 71 | (save-buffer) 72 | ) 73 | 74 | (assert (eq 'modified (git--status-file "f1"))) 75 | 76 | ;; Try some gui commits 77 | (let ((git--commit-log-buffer "*git commit for unittest*") 78 | (first-commit-id (git--rev-parse "at-first-commit")) 79 | (second-commit-id nil)) 80 | (unwind-protect 81 | (progn 82 | (condition-case err 83 | (progn (git-commit) (error "Expected error not raised")) 84 | (error 85 | (unless (string-match "^Nothing to commit" 86 | (error-message-string err)) 87 | (signal (car err) (cdr err))))) 88 | (git-commit-all) 89 | (assert (equal '("-a") git--commit-args)) 90 | (insert "another test commit") 91 | (git--commit-buffer) 92 | (assert (not (buffer-live-p (get-buffer git--commit-log-buffer)))) 93 | (assert (eq 'uptodate (git--status-file "f1"))) 94 | (assert (string-match "^[0-9a-f.]* *another test commit" 95 | (git--last-log-short))) 96 | ;; Should be one above last commit 97 | (setq second-commit-id (git--rev-parse "HEAD")) 98 | (assert (equal first-commit-id (git--rev-parse "HEAD^1"))) 99 | ;; Do an amend commit 100 | (git-commit t) 101 | (assert (equal '("--amend") git--commit-args)) 102 | (insert "Now amended") 103 | (git--commit-buffer) 104 | (assert (eq 'uptodate (git--status-file "f1"))) 105 | ;; Unfortunately, git 1.6 has taken to mangling messages according 106 | ;; to the subject/body distinctions. This stinks and we'll need to 107 | ;; fix it; but there is simply no good way to do this now. 108 | (assert (equal "another test commit Now amended " 109 | (replace-regexp-in-string "\n" " " 110 | (git--last-log-message)))) 111 | (assert (not (equal second-commit-id (git--rev-parse "HEAD")))) 112 | ;; Should still be one commit above the first 113 | (assert (equal first-commit-id (git--rev-parse "HEAD^1")))) 114 | (ignore-errors (kill-buffer git--commit-log-buffer)))) 115 | 116 | ;; Some baseline testing. The usual suspects (git-svn, origin), won't exist. 117 | (let ((git-baseline-candidates '("git-svn" "origin" "at-first-commit")) 118 | git--test-func-was-called git-baseline-alist) 119 | (assert (equal "at-first-commit" (git-baseline))) 120 | ;; Now add a couple of functions into the mix 121 | (flet ((git--test-baseline-not-ok () 122 | (setq git--test-func-was-called t) 123 | nil) 124 | (git--test-baseline-ok () "some-commit") 125 | (git--select-revision (&rest args) (error "%S" args))) 126 | (add-to-list 'git-baseline-candidates 'git--test-baseline-not-ok) 127 | (setcar (last git-baseline-candidates) 'git--test-baseline-ok) 128 | (assert (equal "some-commit" (git-baseline))) 129 | (assert git--test-func-was-called) 130 | ;; Now test interactive call. Fake some interactive functions 131 | (add-to-list 'git-baseline-candidates "at-first-commit" t) 132 | (flet ((git--select-revision 133 | (prompt prepend except) 134 | (assert (equal '("(git--test-baseline-ok)" "at-first-commit") 135 | prepend)) 136 | (assert (equal prepend except)) 137 | "(git--test-baseline-ok)") 138 | (y-or-n-p (prompt) t) 139 | (customize-save-variable 140 | (symbol value) 141 | (assert (eq 'git-baseline-alist symbol)) 142 | (assert (equal git-baseline-alist value)))) 143 | (setq git--test-func-was-called nil) 144 | (assert (equal "some-commit" (call-interactively 'git-baseline))) 145 | (assert git--test-func-was-called) 146 | (assert (equal (list (cons default-directory 'git--test-baseline-ok)) 147 | git-baseline-alist)) 148 | ;; if we call again (non-interactively), the value should be cached 149 | (setq git--test-func-was-called nil) 150 | (fset 'git--select-revision 'error) 151 | (assert (equal "some-commit" (git-baseline))) 152 | (assert (not git--test-func-was-called)) 153 | )) 154 | ) 155 | 156 | ;; Try a new branch. 157 | (flet ((git--select-revision (ignored-prompt prepend-choices excepts) 158 | (assert (equal '("master") prepend-choices)) 159 | (assert (equal '("master") excepts)) 160 | "master")) 161 | (let (seen-checkout-func-args) 162 | (git-checkout-to-new-branch "newbranch" "master" 163 | (lambda (&rest args) 164 | (setq seen-checkout-func-args args)) 165 | "arg1" nil 'arg2) 166 | (assert (equal '("arg1" nil arg2) seen-checkout-func-args))) 167 | (let* ((branch-list-and-current (git--branch-list)) 168 | (sorted-branch-list (sort (car branch-list-and-current) 'string<))) 169 | (assert (equal '("master" "newbranch") sorted-branch-list)) 170 | (assert (equal "newbranch" (cdr branch-list-and-current)))) 171 | ;; git--current-branch should return the same result. 172 | (assert (equal "newbranch" (git--current-branch)))) 173 | 174 | ;; Check git-stash. 175 | (with-temp-buffer 176 | (insert "contents for stash") 177 | (write-file "f1")) 178 | (assert (eq 'modified (git--status-file "f1"))) 179 | (let (saved-suggested-cmd cmd-to-return) 180 | (flet ((read-string (ignored-prompt suggested &rest ignored) 181 | (setq saved-suggested-cmd suggested) 182 | cmd-to-return) 183 | (sleep-for (&rest args) t)) 184 | (setq cmd-to-return "save") 185 | (call-interactively 'git-stash) 186 | (message "suggested: %s" saved-suggested-cmd) 187 | (assert (equal "save" saved-suggested-cmd)) 188 | (assert (eq 'uptodate (git--status-file "f1"))) 189 | ;; Now it should suggest popping the stash. 190 | (setq cmd-to-return "pop") 191 | (call-interactively 'git-stash) 192 | (assert (equal "pop" saved-suggested-cmd)) 193 | (assert (eq 'modified (git--status-file "f1"))) 194 | ;; Contents should be restored too. 195 | (assert (string= "contents for stash" 196 | (git--trim-string 197 | (with-temp-buffer 198 | (insert-file-contents "f1") 199 | (buffer-string))))) 200 | )) 201 | ;; Check that git-stash buffer is deleted on error exit 202 | (let (saved-buffer) 203 | (flet ((read-string (&rest ignored) 204 | (setq saved-buffer (current-buffer)) 205 | (error "test error"))) 206 | (ignore-errors (call-interactively 'git-stash))) 207 | (assert saved-buffer) 208 | (assert (not (buffer-live-p saved-buffer)))) 209 | 210 | ;; Do some more fun stuff here... 211 | 212 | ) 213 | 214 | (defun git--test-standalone-functions () 215 | ;; Human-readable size 216 | (require 'git-status) 217 | (assert (equal "8" (git--status-human-readable-size 8))) 218 | (assert (equal "1023" (git--status-human-readable-size 1023))) 219 | (assert (equal "1.0K" (git--status-human-readable-size 1024))) 220 | (assert (equal "25K" (git--status-human-readable-size 25902))) 221 | (assert (equal "382K" (git--status-human-readable-size 391475))) 222 | (assert (equal "1.0M" (git--status-human-readable-size (* 1023 1024)))) 223 | (assert (equal "2.5M" (git--status-human-readable-size (* 2570 1024)))) 224 | 225 | ;; Some tests of fileinfo-lessp 226 | (flet ((check-compare (name1 type1 name2 type2 isless12 isless21) 227 | (let ((info1 (git--create-fileinfo name1 type1)) 228 | (info2 (git--create-fileinfo name2 type2))) 229 | (assert (eq isless12 (git--fileinfo-lessp info1 info2))) 230 | (assert (eq isless21 (git--fileinfo-lessp info2 info1)))))) 231 | (check-compare "abc" 'blob "def" 'blob t nil) 232 | (check-compare "abc" 'tree "def" 'tree t nil) 233 | (check-compare "abc" 'blob "abc" 'blob nil nil) 234 | 235 | (check-compare "abc" 'blob "def/foo" 'blob nil t) 236 | (check-compare "def/foo" 'blob "def/foo" 'blob nil nil) 237 | (check-compare "abc/foo" 'blob "def" 'blob t nil) 238 | (check-compare "abc/def" 'tree "abc/def/aaa" 'blob t nil) 239 | (check-compare "abc/def" 'tree "abc/def/aaa" 'tree t nil) 240 | ;; This is the situation where an Unknown file comes in low in the tree 241 | (check-compare "abc/def" 'tree "abc/def/aaa/bbb" 'blob t nil) 242 | (check-compare "abc/hij" 'tree "abc/def/aaa/bbb" 'blob nil t) 243 | ) 244 | 245 | ) 246 | 247 | (defun git--test-branch-mode () 248 | ;; Virtualize git repo functions. 249 | (flet ((git--branch-list () '(("aa" "master" "foobar") . "master"))) 250 | ;; Get rid of user hooks. 251 | (let (git--branch-mode-hook git-branch-annotator-functions) 252 | (unwind-protect 253 | (save-window-excursion 254 | (git-branch) 255 | (assert (looking-at "master")) 256 | (assert (string= (buffer-string) " aa\n * master\n foobar\n")) 257 | (assert (equal "master" (git-branch-mode-selected))) 258 | (forward-line) ;; next-line errors out in batch for some reason 259 | (assert (equal "foobar" (git-branch-mode-selected))) 260 | ;; Let's try some annotations 261 | (setq git-branch-annotator-functions 262 | (list (lambda (branch-list) 263 | (assert (equal branch-list '("aa" "master" "foobar"))) 264 | '(("aa" . "an-aa-1"))) 265 | (lambda (branch-list) 266 | (assert (equal branch-list '("aa" "master" "foobar"))) 267 | '(("aa" . "an-aa-2") ("foobar" . "an-foobar-1"))))) 268 | (flet ((window-width () 80)) (git--branch-mode-refresh)) 269 | ;; Point should stay the same 270 | (assert (looking-at "foobar")) 271 | (assert (string= (buffer-string) 272 | (concat " aa - an-aa-1 an-aa-2\n" 273 | " * master\n" 274 | " foobar - an-foobar-1\n"))) 275 | ) 276 | (kill-buffer "*git-branch*")) 277 | ))) 278 | ;; (git--test-branch-mode) 279 | 280 | (defun git-regression () 281 | (interactive) 282 | ;; (setq debug-on-error t) ;; uncomment to debug test run from make 283 | (message "Running unittest suite...") 284 | (git--test-standalone-functions) 285 | (save-window-excursion ; some bufs might pop up, e.g. commit 286 | (git--test-with-temp-repo #'git--test-typical-repo-ops)) 287 | (git--test-branch-mode) 288 | 289 | (message "git-regression passed")) 290 | -------------------------------------------------------------------------------- /git-blamed.el: -------------------------------------------------------------------------------- 1 | ;;; git-blamed.el --- Minor mode for incremental blame for Git -*- coding: utf-8 -*- 2 | ;; 3 | ;; Copyright (C) 2007 David Kågedal 4 | ;; 5 | ;; Authors: David Kågedal 6 | ;; Created: 31 Jan 2007 7 | ;; Message-ID: <87iren2vqx.fsf@morpheus.local> 8 | ;; License: GPL 9 | ;; Keywords: git, version control, release management 10 | ;; 11 | ;; Compatibility: Emacs21, Emacs22 and EmacsCVS 12 | ;; Git 1.5 and up 13 | 14 | ;; This file is *NOT* part of GNU Emacs. 15 | ;; This file is distributed under the same terms as GNU Emacs. 16 | 17 | ;; This program is free software; you can redistribute it and/or 18 | ;; modify it under the terms of the GNU General Public License as 19 | ;; published by the Free Software Foundation; either version 2 of 20 | ;; the License, or (at your option) any later version. 21 | 22 | ;; This program is distributed in the hope that it will be 23 | ;; useful, but WITHOUT ANY WARRANTY; without even the implied 24 | ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 25 | ;; PURPOSE. See the GNU General Public License for more details. 26 | 27 | ;; You should have received a copy of the GNU General Public 28 | ;; License along with this program; if not, write to the Free 29 | ;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, 30 | ;; MA 02111-1307 USA 31 | 32 | ;; http://www.fsf.org/copyleft/gpl.html 33 | 34 | 35 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 36 | ;; 37 | ;;; Commentary: 38 | ;; 39 | ;; Here is an Emacs implementation of incremental git-blame. When you 40 | ;; turn it on while viewing a file, the editor buffer will be updated by 41 | ;; setting the background of individual lines to a color that reflects 42 | ;; which commit it comes from. And when you move around the buffer, a 43 | ;; one-line summary will be shown in the echo area. 44 | 45 | ;;; Installation: 46 | ;; 47 | ;; To use this package, put it somewhere in `load-path' (or add 48 | ;; directory with git-blamed.el to `load-path'), and add the following 49 | ;; line to your .emacs: 50 | ;; 51 | ;; (require 'git-blamed) 52 | ;; 53 | ;; If you do not want to load this package before it is necessary, you 54 | ;; can make use of the `autoload' feature, e.g. by adding to your .emacs 55 | ;; the following lines 56 | ;; 57 | ;; (autoload 'git-blamed-mode "git-blamed" 58 | ;; "Minor mode for incremental blame for Git." t) 59 | ;; 60 | ;; Then first use of `M-x git-blamed-mode' would load the package. 61 | 62 | ;;; Compatibility: 63 | ;; 64 | ;; It requires GNU Emacs 21 or later and Git 1.5.0 and up 65 | ;; 66 | ;; If you'are using Emacs 20, try changing this: 67 | ;; 68 | ;; (overlay-put ovl 'face (list :background 69 | ;; (cdr (assq 'color (cddddr info))))) 70 | ;; 71 | ;; to 72 | ;; 73 | ;; (overlay-put ovl 'face (cons 'background-color 74 | ;; (cdr (assq 'color (cddddr info))))) 75 | 76 | 77 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 78 | ;; 79 | ;;; Code: 80 | 81 | (eval-when-compile (require 'cl)) ; to use `push', `pop' 82 | 83 | 84 | (defun git-blamed-color-scale (&rest elements) 85 | "Given a list, returns a list of triples formed with each 86 | elements of the list. 87 | 88 | a b => bbb bba bab baa abb aba aaa aab" 89 | (let (result) 90 | (dolist (a elements) 91 | (dolist (b elements) 92 | (dolist (c elements) 93 | (setq result (cons (format "#%s%s%s" a b c) result))))) 94 | result)) 95 | 96 | ;; (git-blamed-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c") => 97 | ;; ("#3c3c3c" "#3c3c14" "#3c3c34" "#3c3c2c" "#3c3c1c" "#3c3c24" 98 | ;; "#3c3c04" "#3c3c0c" "#3c143c" "#3c1414" "#3c1434" "#3c142c" ...) 99 | 100 | (defmacro git-blamed-random-pop (l) 101 | "Select a random element from L and returns it. Also remove 102 | selected element from l." 103 | ;; only works on lists with unique elements 104 | `(let ((e (elt ,l (random (length ,l))))) 105 | (setq ,l (remove e ,l)) 106 | e)) 107 | 108 | (defvar git-blamed-dark-colors 109 | (git-blamed-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c") 110 | "*List of colors (format #RGB) to use in a dark environment. 111 | 112 | To check out the list, evaluate (list-colors-display git-blamed-dark-colors).") 113 | 114 | (defvar git-blamed-light-colors 115 | (git-blamed-color-scale "c4" "d4" "cc" "dc" "f4" "e4" "fc" "ec") 116 | "*List of colors (format #RGB) to use in a light environment. 117 | 118 | To check out the list, evaluate (list-colors-display git-blamed-light-colors).") 119 | 120 | (defvar git-blamed-colors '() 121 | "Colors used by git-blamed. The list is built once when activating git-blamed 122 | minor mode.") 123 | 124 | (defvar git-blamed-ancient-color "dark green" 125 | "*Color to be used for ancient commit.") 126 | 127 | (defvar git-blamed-autoupdate t 128 | "*Automatically update the blame display while editing") 129 | 130 | (defvar git-blamed-proc nil 131 | "The running git-blamed process") 132 | (make-variable-buffer-local 'git-blamed-proc) 133 | 134 | (defvar git-blamed-overlays nil 135 | "The git-blamed overlays used in the current buffer.") 136 | (make-variable-buffer-local 'git-blamed-overlays) 137 | 138 | (defvar git-blamed-cache nil 139 | "A cache of git-blamed information for the current buffer") 140 | (make-variable-buffer-local 'git-blamed-cache) 141 | 142 | (defvar git-blamed-idle-timer nil 143 | "An idle timer that updates the blame") 144 | (make-variable-buffer-local 'git-blamed-cache) 145 | 146 | (defvar git-blamed-update-queue nil 147 | "A queue of update requests") 148 | (make-variable-buffer-local 'git-blamed-update-queue) 149 | 150 | ;; FIXME: docstrings 151 | (defvar git-blamed-file nil) 152 | (defvar git-blamed-current nil) 153 | 154 | (defvar git-blamed-mode nil) 155 | (make-variable-buffer-local 'git-blamed-mode) 156 | 157 | (defvar git-blamed-mode-line-string " blame" 158 | "String to display on the mode line when git-blamed is active.") 159 | 160 | (or (assq 'git-blamed-mode minor-mode-alist) 161 | (setq minor-mode-alist 162 | (cons '(git-blamed-mode git-blamed-mode-line-string) minor-mode-alist))) 163 | 164 | ;;;###autoload 165 | (defun git-blamed-mode (&optional arg) 166 | "Toggle minor mode for displaying Git blame 167 | 168 | With prefix ARG, turn the mode on if ARG is positive." 169 | (interactive "P") 170 | (cond 171 | ((null arg) 172 | (if git-blamed-mode (git-blamed-mode-off) (git-blamed-mode-on))) 173 | ((> (prefix-numeric-value arg) 0) (git-blamed-mode-on)) 174 | (t (git-blamed-mode-off)))) 175 | 176 | (defun git-blamed-mode-on () 177 | "Turn on git-blamed mode. 178 | 179 | See also function `git-blamed-mode'." 180 | (make-local-variable 'git-blamed-colors) 181 | (if git-blamed-autoupdate 182 | (add-hook 'after-change-functions 'git-blamed-after-change nil t) 183 | (remove-hook 'after-change-functions 'git-blamed-after-change t)) 184 | (git-blamed-cleanup) 185 | (let ((bgmode (cdr (assoc 'background-mode (frame-parameters))))) 186 | (if (eq bgmode 'dark) 187 | (setq git-blamed-colors git-blamed-dark-colors) 188 | (setq git-blamed-colors git-blamed-light-colors))) 189 | (setq git-blamed-cache (make-hash-table :test 'equal)) 190 | (setq git-blamed-mode t) 191 | (git-blamed-run)) 192 | 193 | (defun git-blamed-mode-off () 194 | "Turn off git-blamed mode. 195 | 196 | See also function `git-blamed-mode'." 197 | (git-blamed-cleanup) 198 | (if git-blamed-idle-timer (cancel-timer git-blamed-idle-timer)) 199 | (setq git-blamed-mode nil)) 200 | 201 | ;;;###autoload 202 | (defun git-reblame () 203 | "Recalculate all blame information in the current buffer" 204 | (interactive) 205 | (unless git-blamed-mode 206 | (error "git-blamed is not active")) 207 | 208 | (git-blamed-cleanup) 209 | (git-blamed-run)) 210 | 211 | (defun git-blamed-run (&optional startline endline) 212 | (if git-blamed-proc 213 | ;; Should maybe queue up a new run here 214 | (message "Already running git blame") 215 | (let ((display-buf (current-buffer)) 216 | (blame-buf (get-buffer-create 217 | (concat " git blame for " (buffer-name)))) 218 | (args '("--incremental" "--contents" "-"))) 219 | (if startline 220 | (setq args (append args 221 | (list "-L" (format "%d,%d" startline endline))))) 222 | (setq args (append args 223 | (list (file-name-nondirectory buffer-file-name)))) 224 | (setq git-blamed-proc 225 | (apply 'start-process 226 | "git-blamed" blame-buf 227 | "git" "blame" 228 | args)) 229 | (with-current-buffer blame-buf 230 | (erase-buffer) 231 | (make-local-variable 'git-blamed-file) 232 | (make-local-variable 'git-blamed-current) 233 | (setq git-blamed-file display-buf) 234 | (setq git-blamed-current nil)) 235 | (set-process-filter git-blamed-proc 'git-blamed-filter) 236 | (set-process-sentinel git-blamed-proc 'git-blamed-sentinel) 237 | (process-send-region git-blamed-proc (point-min) (point-max)) 238 | (process-send-eof git-blamed-proc)))) 239 | 240 | (defun remove-git-blamed-text-properties (start end) 241 | (let ((modified (buffer-modified-p)) 242 | (inhibit-read-only t)) 243 | (remove-text-properties start end '(point-entered nil)) 244 | (set-buffer-modified-p modified))) 245 | 246 | (defun git-blamed-cleanup () 247 | "Remove all blame properties" 248 | (mapc 'delete-overlay git-blamed-overlays) 249 | (setq git-blamed-overlays nil) 250 | (remove-git-blamed-text-properties (point-min) (point-max))) 251 | 252 | (defun git-blamed-update-region (start end) 253 | "Rerun blame to get updates between START and END" 254 | (let ((overlays (overlays-in start end))) 255 | (while overlays 256 | (let ((overlay (pop overlays))) 257 | (if (< (overlay-start overlay) start) 258 | (setq start (overlay-start overlay))) 259 | (if (> (overlay-end overlay) end) 260 | (setq end (overlay-end overlay))) 261 | (setq git-blamed-overlays (delete overlay git-blamed-overlays)) 262 | (delete-overlay overlay)))) 263 | (remove-git-blamed-text-properties start end) 264 | ;; We can be sure that start and end are at line breaks 265 | (git-blamed-run (1+ (count-lines (point-min) start)) 266 | (count-lines (point-min) end))) 267 | 268 | (defun git-blamed-sentinel (proc status) 269 | (with-current-buffer (process-buffer proc) 270 | (with-current-buffer git-blamed-file 271 | (setq git-blamed-proc nil) 272 | (if git-blamed-update-queue 273 | (git-blamed-delayed-update)))) 274 | ;;(kill-buffer (process-buffer proc)) 275 | ;;(message "git blame finished") 276 | ) 277 | 278 | (defvar in-blame-filter nil) 279 | 280 | (defun git-blamed-filter (proc str) 281 | (save-excursion 282 | (set-buffer (process-buffer proc)) 283 | (goto-char (process-mark proc)) 284 | (insert-before-markers str) 285 | (goto-char 0) 286 | (unless in-blame-filter 287 | (let ((more t) 288 | (in-blame-filter t)) 289 | (while more 290 | (setq more (git-blamed-parse))))))) 291 | 292 | (defun git-blamed-parse () 293 | (cond ((looking-at "\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)\n") 294 | (let ((hash (match-string 1)) 295 | (src-line (string-to-number (match-string 2))) 296 | (res-line (string-to-number (match-string 3))) 297 | (num-lines (string-to-number (match-string 4)))) 298 | (setq git-blamed-current 299 | (if (string= hash "0000000000000000000000000000000000000000") 300 | nil 301 | (git-blamed-new-commit 302 | hash src-line res-line num-lines)))) 303 | (delete-region (point) (match-end 0)) 304 | t) 305 | ((looking-at "filename \\(.+\\)\n") 306 | (let ((filename (match-string 1))) 307 | (git-blamed-add-info "filename" filename)) 308 | (delete-region (point) (match-end 0)) 309 | t) 310 | ((looking-at "\\([a-z-]+\\) \\(.+\\)\n") 311 | (let ((key (match-string 1)) 312 | (value (match-string 2))) 313 | (git-blamed-add-info key value)) 314 | (delete-region (point) (match-end 0)) 315 | t) 316 | ((looking-at "boundary\n") 317 | (setq git-blamed-current nil) 318 | (delete-region (point) (match-end 0)) 319 | t) 320 | (t 321 | nil))) 322 | 323 | (defun git-blamed-new-commit (hash src-line res-line num-lines) 324 | (save-excursion 325 | (set-buffer git-blamed-file) 326 | (let ((info (gethash hash git-blamed-cache)) 327 | (inhibit-point-motion-hooks t) 328 | (inhibit-modification-hooks t)) 329 | (when (not info) 330 | ;; Assign a random color to each new commit info 331 | ;; Take care not to select the same color multiple times 332 | (let ((color (if git-blamed-colors 333 | (git-blamed-random-pop git-blamed-colors) 334 | git-blamed-ancient-color))) 335 | (setq info (list hash src-line res-line num-lines 336 | (git-describe-commit hash) 337 | (cons 'color color)))) 338 | (puthash hash info git-blamed-cache)) 339 | (goto-line res-line) 340 | (while (> num-lines 0) 341 | (if (get-text-property (point) 'git-blamed) 342 | (forward-line) 343 | (let* ((start (point)) 344 | (end (progn (forward-line 1) (point))) 345 | (ovl (make-overlay start end))) 346 | (push ovl git-blamed-overlays) 347 | (overlay-put ovl 'git-blamed info) 348 | (overlay-put ovl 'help-echo hash) 349 | (overlay-put ovl 'face (list :background 350 | (cdr (assq 'color (nthcdr 5 info))))) 351 | ;; the point-entered property doesn't seem to work in overlays 352 | ;;(overlay-put ovl 'point-entered 353 | ;; `(lambda (x y) (git-blamed-identify ,hash))) 354 | (let ((modified (buffer-modified-p))) 355 | (put-text-property (if (= start 1) start (1- start)) (1- end) 356 | 'point-entered 357 | `(lambda (x y) (git-blamed-identify ,hash))) 358 | (set-buffer-modified-p modified)))) 359 | (setq num-lines (1- num-lines)))))) 360 | 361 | (defun git-blamed-add-info (key value) 362 | (if git-blamed-current 363 | (nconc git-blamed-current (list (cons (intern key) value))))) 364 | 365 | (defun git-blamed-current-commit () 366 | (let ((info (get-char-property (point) 'git-blamed))) 367 | (if info 368 | (car info) 369 | (error "No commit info")))) 370 | 371 | (defun git-describe-commit (hash) 372 | (with-temp-buffer 373 | (call-process "git" nil t nil 374 | "log" "-1" "--pretty=format:\"%H %an -- %s\"" 375 | hash) 376 | (buffer-substring (point-min) (1- (point-max))))) 377 | 378 | (defvar git-blamed-last-identification nil) 379 | (make-variable-buffer-local 'git-blamed-last-identification) 380 | (defun git-blamed-identify (&optional hash) 381 | (interactive) 382 | (let ((info (gethash (or hash (git-blamed-current-commit)) git-blamed-cache))) 383 | (when (and info (not (eq info git-blamed-last-identification))) 384 | (message "%s" (nth 4 info)) 385 | (setq git-blamed-last-identification info)))) 386 | 387 | ;; (defun git-blamed-after-save () 388 | ;; (when git-blamed-mode 389 | ;; (git-blamed-cleanup) 390 | ;; (git-blamed-run))) 391 | ;; (add-hook 'after-save-hook 'git-blamed-after-save) 392 | 393 | (defun git-blamed-after-change (start end length) 394 | (when git-blamed-mode 395 | (git-blamed-enq-update start end))) 396 | 397 | (defvar git-blamed-last-update nil) 398 | (make-variable-buffer-local 'git-blamed-last-update) 399 | (defun git-blamed-enq-update (start end) 400 | "Mark the region between START and END as needing blame update" 401 | ;; Try to be smart and avoid multiple callouts for sequential 402 | ;; editing 403 | (cond ((and git-blamed-last-update 404 | (= start (cdr git-blamed-last-update))) 405 | (setcdr git-blamed-last-update end)) 406 | ((and git-blamed-last-update 407 | (= end (car git-blamed-last-update))) 408 | (setcar git-blamed-last-update start)) 409 | (t 410 | (setq git-blamed-last-update (cons start end)) 411 | (setq git-blamed-update-queue (nconc git-blamed-update-queue 412 | (list git-blamed-last-update))))) 413 | (unless (or git-blamed-proc git-blamed-idle-timer) 414 | (setq git-blamed-idle-timer 415 | (run-with-idle-timer 0.5 nil 'git-blamed-delayed-update)))) 416 | 417 | (defun git-blamed-delayed-update () 418 | (setq git-blamed-idle-timer nil) 419 | (if git-blamed-update-queue 420 | (let ((first (pop git-blamed-update-queue)) 421 | (inhibit-point-motion-hooks t)) 422 | (git-blamed-update-region (car first) (cdr first))))) 423 | 424 | (provide 'git-blamed) 425 | 426 | ;;; git-blamed.el ends here 427 | -------------------------------------------------------------------------------- /git-emacs-autoloads.el: -------------------------------------------------------------------------------- 1 | ;; See git-emacs.el for project and license information. 2 | 3 | ;; Autoloads for git-emacs. 4 | ;; 5 | ;; Loads git-emacs in the following situations: 6 | ;; 7 | ;; 1) git-init 8 | ;; 2) git-status 9 | ;; 3) git-log-from-cmdline 10 | ;; 4) opening a git-controlled file 11 | 12 | (eval-when-compile (require 'vc)) 13 | (eval-when-compile (require 'vc-git)) 14 | (add-to-list 'vc-handled-backends 'git) 15 | 16 | (autoload 'git-status "git-status" 17 | "Launch git-emacs's status mode on the specified directory." t) 18 | (autoload 'git-init "git-emacs" 19 | "Initialize a git repository." t) 20 | (autoload 'git-log-from-cmdline "git-log" 21 | "Launch a git log view from emacs --eval or gnuclient --eval") 22 | (autoload 'git--update-modeline "git-emacs") 23 | 24 | ;; A couple of functions are needed to support autoload on opening a git file. 25 | (defsubst git--in-vc-mode? () 26 | "Returns true if the current buffer is under vc-git." 27 | 28 | (and vc-mode (string-match "^ Git" (substring-no-properties vc-mode)))) 29 | 30 | (defvar git-emacs-loaded nil) 31 | 32 | ;; vc-hook to check whether to load git-emacs or not 33 | (defadvice vc-find-file-hook (after git--vc-git-find-file-hook activate) 34 | "vc-find-file-hook advice for synchronizing with vc-git interface" 35 | 36 | (when git-emacs-loaded 37 | (git--uninstall-state-mark-modeline)) 38 | 39 | (when (git--in-vc-mode?) 40 | (setq git-emacs-loaded t) 41 | (git--update-modeline))) 42 | 43 | (provide 'git-emacs-autoloads) 44 | -------------------------------------------------------------------------------- /git-global-keys.el: -------------------------------------------------------------------------------- 1 | ;; Global keys for git-emacs. 2 | ;; 3 | ;; See git-emacs.el for license and versioning. 4 | 5 | (require 'easymenu) 6 | 7 | (defcustom git-keyboard-prefix "\C-xg" 8 | "Keyboard prefix to use for global git keyboard commands." 9 | :type 'string 10 | :group 'git-emacs) 11 | 12 | (define-prefix-command 'git-global-map) 13 | (define-key global-map git-keyboard-prefix 'git-global-map) 14 | 15 | (define-key git-global-map "a" 'git-add) 16 | (define-key git-global-map "b" 'git-branch) 17 | 18 | (define-prefix-command 'git--commit-map nil "Commit") 19 | (define-key git-global-map "c" 'git--commit-map) 20 | (define-key git--commit-map "f" '("[f]ile" . git-commit-file)) 21 | (define-key git--commit-map "i" '("[i]ndex" . git-commit)) 22 | (define-key git--commit-map "a" '("[a]ll" . git-commit-all)) 23 | (define-key git--commit-map (kbd "RET") 'git-commit-all) 24 | 25 | (define-prefix-command 'git--diff-buffer-map nil "Diff against") 26 | (define-key git-global-map "d" 'git--diff-buffer-map) 27 | (define-key git--diff-buffer-map "o" '("[o]ther" . git-diff-other)) 28 | (define-key git--diff-buffer-map "i" '("[i]ndex" . git-diff-index)) 29 | (define-key git--diff-buffer-map "b" '("[b]aseline" . git-diff-baseline)) 30 | (define-key git--diff-buffer-map "h" '("[H]ead" . git-diff-head)) 31 | (define-key git--diff-buffer-map (kbd "RET") 'git-diff-head) 32 | 33 | (define-prefix-command 'git--diff-all-map nil "Diff repo against") 34 | (define-key git-global-map "D" 'git--diff-all-map) 35 | (define-key git--diff-all-map "o" '("[o]ther" . git-diff-all-other)) 36 | (define-key git--diff-all-map "i" '("[i]ndex" . git-diff-all-index)) 37 | (define-key git--diff-all-map "b" '("[b]aseline" . git-diff-all-baseline)) 38 | (define-key git--diff-all-map "h" '("[H]ead" . git-diff-all-head)) 39 | (define-key git--diff-all-map (kbd "RET") 'git-diff-all-head) 40 | 41 | (define-key git-global-map "g" 'git-grep) 42 | (define-key git-global-map "h" 'git-stash) 43 | (define-key git-global-map "i" 'git-add-interactively) 44 | 45 | (define-key git-global-map "l" 'git-log) 46 | (define-key git-global-map "L" 'git-log-files) 47 | (define-key git-global-map "\C-l" 'git-log-other) 48 | 49 | (define-key git-global-map "m" 'git-merge-next-action) 50 | 51 | (define-key git-global-map "R" 'git-reset) 52 | 53 | (define-key git-global-map "s" 'git-status) 54 | (define-key git-global-map "." 'git-cmd) 55 | 56 | (easy-menu-add-item nil '("tools" "vc") "---") 57 | (easy-menu-add-item nil '("tools" "vc") 58 | `("Git" 59 | ("Add to Index" 60 | ["Current File" git-add t] 61 | ["Select Changes in Current File..." git-add-interactively t] 62 | ["New Files..." git-add-new t]) 63 | ("Commit" 64 | ["All Changes" git-commit-all t] 65 | ["Index" git-commit t] 66 | ["Current File" git-commit-file t]) 67 | ("Diff Current Buffer against" 68 | ["HEAD" git-diff-head t] 69 | ["Index" git-diff-index t] 70 | ["Baseline" git-diff-baseline t] 71 | ["Other..." git-diff-other t] 72 | ) 73 | ("Diff Repository against" 74 | ["HEAD" git-diff-all-head t] 75 | ["Index" git-diff-all-index t] 76 | ["Baseline" git-diff-all-baseline t] 77 | ["Other..." git-diff-all-other t]) 78 | ["Log for Entire Project" git-log t] 79 | ["Log for Current File" git-log-files t] 80 | ["Log for Branch or Tag..." git-log-other t] 81 | ["Branch List" git-branch t] 82 | ["Merge (start or continue)..." git-merge-next-action t] 83 | ["Reset..." git-reset t] 84 | ["Stash..." git-stash t] 85 | ["Status" git-status t] 86 | ["Grep..." git-grep t] 87 | ["Git Command..." git-cmd t])) 88 | 89 | 90 | (provide 'git-global-keys) 91 | -------------------------------------------------------------------------------- /git-load.el.sample: -------------------------------------------------------------------------------- 1 | ;;============================================================ 2 | ;; git-emacs mode 3 | ;;------------------------------------------------------------ 4 | (eval-when-compile (require 'soo-load)) 5 | (setq git-state-modeline-decoration 'git-state-decoration-large-dot) 6 | (require 'git-emacs-autoloads) 7 | ;;------------------------------------------------------------ 8 | 9 | -------------------------------------------------------------------------------- /git-log.el: -------------------------------------------------------------------------------- 1 | ;; Git log mode support, part of git-emacs 2 | ;; 3 | ;; See git-emacs.el for license information 4 | 5 | (require 'log-view) 6 | (require 'git-emacs) 7 | 8 | ;; Based off of log-view-mode, which has some nice functionality, like 9 | ;; moving between comits 10 | (define-derived-mode git-log-view-mode 11 | log-view-mode "Git-Log" "Major mode for viewing git logs" 12 | :group 'git 13 | ;; Customize log-view-message-re to be the git commits 14 | (set (make-local-variable 'log-view-message-re) 15 | "^[Cc]ommit[: ]*\\([0-9a-f]+\\)") 16 | ;; As for the file re, there is no such thing -- make it impossible 17 | (set (make-local-variable 'log-view-file-re) 18 | "^No_such_text_really$") 19 | (set (make-local-variable 'font-lock-defaults) 20 | (list 'git-log-view-font-lock-keywords t)) 21 | (set (make-local-variable 'transient-mark-mode) t) 22 | 23 | ;; A long git log might still be running when we die. Avoid "deleted buffer". 24 | (add-hook 'kill-buffer-hook 25 | #'(lambda() 26 | (let ((proc (get-buffer-process (current-buffer)))) 27 | (when proc (delete-process proc)))) 28 | nil t) ; prepend, local 29 | ) 30 | 31 | 32 | ;; Highlighting. We could allow customizable faces, but that's a little 33 | ;; much right now. 34 | (defvar git-log-view-font-lock-keywords 35 | '(("^\\([Cc]ommit\\|[Mm]erge\\):?\\(.*\\)$" 36 | (1 font-lock-keyword-face prepend) 37 | (2 font-lock-function-name-face prepend)) 38 | ("^\\(Author\\):?\\(.*?\\([^<( \t]+@[^>) \t]+\\).*\\)$" 39 | (1 font-lock-keyword-face prepend) (2 font-lock-constant-face prepend) 40 | (3 font-lock-variable-name-face prepend)) 41 | ("^\\(Date\\):?\\(.*\\)$" 42 | (1 font-lock-keyword-face prepend) (2 font-lock-doc-face prepend)) 43 | ) 44 | "Font lock expressions for git log view mode") 45 | ;; (makunbound 'git-log-view-font-lock-keywords) ; <-- C-x C-e to reset 46 | 47 | 48 | ;; Keys 49 | (let ((map git-log-view-mode-map)) 50 | (define-key map "N" 'git-log-view-interesting-commit-next) 51 | (define-key map "P" 'git-log-view-interesting-commit-prev) 52 | 53 | (define-key map "m" 'set-mark-command) ; came with log-view-mode, nice idea 54 | (define-key map "d" 'git-log-view-diff-preceding) 55 | (define-key map "D" 'git-log-view-diff-current) 56 | 57 | (define-key map "c" 'git-log-view-cherry-pick) 58 | (define-key map "k" 'git-log-view-checkout) 59 | (define-key map "r" 'git-log-view-reset) 60 | (define-key map "v" 'git-log-view-revert) 61 | (define-key map "t" 'git-log-view-tag) 62 | 63 | (define-key map "g" 'git-log-view-refresh) 64 | (define-key map "q" 'git--quit-buffer)) 65 | 66 | 67 | ;; Menu 68 | (easy-menu-define 69 | git-log-view-menu git-log-view-mode-map 70 | "Git" 71 | `("Git-Log" 72 | ["Next Commit" log-view-msg-next t] 73 | ["Previous Commit" log-view-msg-prev t] 74 | ["Next Interesting Commit" git-log-view-interesting-commit-next t] 75 | ["Previous Interesting Commit" git-log-view-interesting-commit-prev t] 76 | "---" 77 | ["Mark Commits for Diff" set-mark-command t] 78 | ["Diff Commit(s)" git-log-view-diff-preceding t] 79 | ["Diff against Current" git-log-view-diff-current t] 80 | "---" 81 | ["Reset Branch to Commit" git-log-view-reset t] 82 | ["Checkout" git-log-view-checkout t] 83 | ["Cherry-pick" git-log-view-cherry-pick t] 84 | ["Revert Commit" git-log-view-revert t] 85 | ["Tag this Commit..." git-log-view-tag t] 86 | "---" 87 | ["Refresh" git-log-view-refresh t] 88 | ["Quit" git--quit-buffer t])) 89 | 90 | 91 | ;; Extra navigation 92 | ;; Right now this just moves between merges, but it would be nice to move 93 | ;; to the next/prev commit by a different author. But it's harder than a 94 | ;; simple RE. 95 | (defvar git-log-view-interesting-commit-re "^Merge[: ]?" 96 | "Regular expression defining \"interesting commits\" for easy navigation") 97 | (easy-mmode-define-navigation 98 | git-log-view-interesting-commit git-log-view-interesting-commit-re 99 | "interesting commit") 100 | 101 | 102 | ;; Implementation 103 | (defvar git-log-view-filenames nil 104 | "List of filenames that this log is about, nil if the whole repository.") 105 | (defvar git-log-view-qualifier nil 106 | "A short string representation of `git-log-view-filenames', e.g. \"2 files\"") 107 | (defvar git-log-view-start-commit nil 108 | "Records the starting commit (e.g. branch name) of the current log view") 109 | 110 | 111 | (defun git--log-view (&optional files start-commit dont-pop-buffer logs-count) 112 | "Show a log window for the given FILES; if none, the whole 113 | repository. If START-COMMIT is nil, use the current branch, otherwise the 114 | given commit. Assumes it is being run from a buffer whose 115 | default-directory is inside the repo." 116 | (let* ((rel-filenames (mapcar #'file-relative-name files)) 117 | (log-qualifier (case (length files) 118 | (0 (abbreviate-file-name (git--get-top-dir))) 119 | (1 (first rel-filenames)) 120 | (t (format "%d files" (length files))))) 121 | (log-buffer-name (format "*git log: %s%s*" 122 | log-qualifier 123 | (if start-commit (format " from %s" 124 | start-commit) 125 | ""))) 126 | (buffer (get-buffer-create log-buffer-name)) 127 | (saved-default-directory default-directory)) 128 | (with-current-buffer buffer 129 | ;; Subtle: a previous git process might still be running 130 | (let ((proc (get-buffer-process (current-buffer)))) 131 | (when proc (delete-process proc))) 132 | (buffer-disable-undo) 133 | (let ((buffer-read-only nil)) (erase-buffer)) 134 | (git-log-view-mode) 135 | ;; Tell git-log-view-mode what this log is all about 136 | (set (make-local-variable 'git-log-view-qualifier) log-qualifier) 137 | (set (make-local-variable 'git-log-view-start-commit) start-commit) 138 | (set (make-local-variable 'git-log-view-filenames) rel-filenames) 139 | ;; Subtle: the buffer may already exist and have the wrong directory 140 | (cd saved-default-directory) 141 | ;; Set the logs-count while it's omitted 142 | (if (or (equal "" logs-count) (equal nil logs-count)) 143 | (setq logs-count "50")) 144 | ;; vc-do-command does almost everything right. Beware, it misbehaves 145 | ;; if not called with current buffer (undoes our setup) 146 | (apply #'vc-do-command buffer 'async "git" nil "log" (format "-%s" logs-count) 147 | (append (when start-commit (list start-commit)) 148 | (list "--") 149 | rel-filenames)) 150 | ;; vc sometimes goes to the end of the buffer, for unknown reasons 151 | (vc-exec-after `(goto-char (point-min)))) 152 | (if dont-pop-buffer 153 | buffer 154 | (pop-to-buffer buffer)))) 155 | 156 | ;; Entry points 157 | (defun git-log-files () 158 | "Launch the git log view for the current file, or the selected files in 159 | git-status-mode." 160 | (interactive) 161 | (git--require-buffer-in-git) 162 | (git--log-view (git--if-in-status-mode 163 | (git--status-view-marked-or-file) 164 | (list buffer-file-name)))) 165 | 166 | (defun git-log (&optional logs-count) 167 | "Launch the git log view for the whole repository" 168 | (interactive "slogs count: ") 169 | ;; TODO: maybe ask user for a git repo if they're not in one 170 | (git--log-view nil nil nil logs-count)) 171 | 172 | (defun git-log-other (&optional commit) 173 | "Launch the git log view for another COMMIT, which is prompted for if 174 | unspecified. You can then cherrypick commits from e.g. another branch 175 | using the `git-log-view-cherrypick'." 176 | (interactive (list (git--select-revision "View log for: "))) 177 | (git--log-view nil commit)) 178 | 179 | ;; Take advantage of the nice git-log-view from the command line. 180 | ;; Recipes: 181 | ;; function gl() { gnuclient --batch --eval "(git-log-from-cmdline \"$DISPLAY\" \"$(pwd)\" \"$1\")"; } 182 | ;; 183 | ;; If you prefer a separate emacs instance: 184 | ;; function gl() { emacs -l ~/.emacs --eval "(git-log-from-cmdline nil nil \"$1\")"; } 185 | ;; 186 | ;; Then you can just run "gl" or "gl another-branch", for example. 187 | (defun git-log-from-cmdline (&optional display directory start-commit) 188 | "Launch a git log view from emacs --eval or gnuclient --eval. If DISPLAY 189 | is specified, create a frame on the specified display. If DIRECTORY is 190 | specified, do git log for that directory (a good idea in gnuclient) 191 | . If START-COMMIT if specified, log starting backwards from that commit, e.g. 192 | a branch." 193 | (let ((default-directory (or directory default-directory)) 194 | (frame (when display (select-frame (make-frame-on-display display))))) 195 | (switch-to-buffer 196 | (git--log-view nil (when (> (length start-commit) 0) start-commit) t)) 197 | (when display 198 | ;; Delete the frame on quit if we created it and nothing else displayed 199 | (add-hook 'kill-buffer-hook 200 | (lexical-let ((git-log-gnuserv-frame frame)) 201 | #'(lambda() 202 | (dolist (window (get-buffer-window-list (current-buffer))) 203 | (when (and (eq (next-window window) window) 204 | (eq (window-frame window) 205 | git-log-gnuserv-frame)) 206 | (delete-frame (window-frame window)))))) 207 | t t)) ; hook is append, local 208 | "")) 209 | 210 | ;; Actions 211 | (defun git-log-view-checkout () 212 | "Checkout the commit that the mark is currently in." 213 | (interactive) 214 | (let ((commit (substring-no-properties (log-view-current-tag)))) 215 | (when (y-or-n-p (format "Checkout %s from %s? " 216 | git-log-view-qualifier commit)) 217 | (if git-log-view-filenames 218 | (progn 219 | (apply #'git--exec-string "checkout" commit "--" 220 | git-log-view-filenames) 221 | (git-after-working-dir-change git-log-view-filenames)) 222 | (git-checkout commit))))) ;special handling for whole-tree checkout 223 | 224 | (defun git-log-view-cherry-pick () 225 | "Cherry-pick the commit that the cursor is currently in on top of the current 226 | branch." 227 | (interactive) 228 | (let ((commit (substring-no-properties (log-view-current-tag))) 229 | (current-branch (git--current-branch))) 230 | (when (y-or-n-p (format "Cherry-pick commit %s on top of %s? " 231 | commit (git--bold-face current-branch))) 232 | (git--exec-string "cherry-pick" commit "--") 233 | (git-after-working-dir-change)))) 234 | 235 | (defun git-log-view-reset () 236 | "Reset the current branch to the commit that the cursor is currently in." 237 | (interactive) 238 | (let ((commit (substring-no-properties (log-view-current-tag))) 239 | (current-branch (ignore-errors (git--current-branch)))) 240 | (when (y-or-n-p (format "Reset %s to commit %s? " 241 | (if current-branch (git--bold-face current-branch) 242 | "current state") 243 | (git--abbrev-commit commit))) 244 | (git-reset commit)))) 245 | 246 | (defun git-log-view-diff-preceding () 247 | "Diff the commit the cursor is currently on against the preceding commits. 248 | If a region is active, diff the first and last commits in the region." 249 | (interactive) 250 | (let* ((commit (git--abbrev-commit 251 | (log-view-current-tag (when mark-active (region-beginning))))) 252 | (preceding-commit 253 | (git--abbrev-commit 254 | (save-excursion 255 | (when mark-active 256 | (goto-char (region-end)) 257 | ;; Go back one to get before the lowest commit, then 258 | ;; msg-next will find it properly. Unless the region is empty. 259 | (unless (equal (region-beginning) (region-end)) 260 | (backward-char 1))) 261 | (log-view-msg-next) 262 | (log-view-current-tag))))) 263 | ;; TODO: ediff if single file, but git--ediff does not allow revisions 264 | ;; for both files 265 | (git--diff-many git-log-view-filenames preceding-commit commit t))) 266 | 267 | (defun git-log-view-diff-current () 268 | "Diff the commit the cursor is currently on against the current state of 269 | the working dir." 270 | (interactive) 271 | (let* ((commit (git--abbrev-commit (log-view-current-tag)))) 272 | (if (eq 1 (length git-log-view-filenames)) 273 | (git--diff (first git-log-view-filenames) 274 | (concat commit ":" )) 275 | (git--diff-many git-log-view-filenames commit nil)))) 276 | 277 | (defun git-log-view-revert () 278 | "Revert the commit that the cursor is currently on" 279 | (interactive) 280 | (let ((commit (substring-no-properties (log-view-current-tag)))) 281 | (when (y-or-n-p (format "Revert %s? " commit)) 282 | (git-revert commit)))) 283 | 284 | (defun git-log-view-refresh () 285 | "Refresh log view" 286 | (interactive) 287 | (unless (boundp 'git-log-view-start-commit) (error "Not in git log view")) 288 | (git--log-view git-log-view-filenames git-log-view-start-commit)) 289 | 290 | (defun git-log-view-tag (&optional tag-name) 291 | "Create a new tag for commit that the cursor is on." 292 | 293 | (interactive) 294 | (git-tag tag-name (git--abbrev-commit (log-view-current-tag)))) 295 | 296 | (provide 'git-log) 297 | -------------------------------------------------------------------------------- /git-modeline.el: -------------------------------------------------------------------------------- 1 | ;; Mode line decoration support, part of git-emacs. 2 | ;; 3 | ;; See git-emacs.el for license and versioning. 4 | ;; 5 | ;; ref. "test-runner-image.el" posted at 6 | ;; "http://nschum.de/src/emacs/test-runner/" 7 | 8 | (require 'git-emacs) 9 | 10 | ;; Modeline decoration customization 11 | (defcustom git-state-modeline-decoration 12 | 'git-state-decoration-large-dot 13 | "How to indicate the status of files in the modeline. The value 14 | must be a function that takes a single arg: a symbol denoting file status, 15 | e.g. 'unmerged. The return value of the function will be added at the beginning 16 | of mode-line-format." 17 | :type '(choice (function-item :tag "Small colored dot" 18 | git-state-decoration-small-dot) 19 | (function-item :tag "Large colored dot" 20 | git-state-decoration-large-dot) 21 | (function-item :tag "Status letter" 22 | git-state-decoration-letter) 23 | (function-item :tag "Colored status letter" 24 | git-state-decoration-colored-letter) 25 | (const :tag "No decoration" nil) 26 | (function :tag "Other")) 27 | :group 'git-emacs 28 | ) 29 | 30 | (defun git--interpret-state-mode-color (stat) 31 | "Return a mode line status color appropriate for STAT (a state symbol)." 32 | (case stat 33 | ('modified "tomato" ) 34 | ('unknown "gray" ) 35 | ('added "blue" ) 36 | ('deleted "red" ) 37 | ('unmerged "purple" ) 38 | ('uptodate "GreenYellow" ) 39 | ('staged "yellow" ) 40 | (t "red"))) 41 | 42 | 43 | ;; Modeline decoration options 44 | (defun git-state-decoration-small-dot(stat) 45 | (git--state-mark-modeline-dot 46 | (git--interpret-state-mode-color stat) stat 47 | "/* XPM */ 48 | static char * data[] = { 49 | \"14 7 3 1\", 50 | \" c None\", 51 | \"+ c #202020\", 52 | \". c %s\", 53 | \" +++ \", 54 | \" +...+ \", 55 | \" +.....+ \", 56 | \" +.....+ \", 57 | \" +.....+ \", 58 | \" +...+ \", 59 | \" +++ \"};")) 60 | 61 | (defun git-state-decoration-large-dot(stat) 62 | (git--state-mark-modeline-dot 63 | (git--interpret-state-mode-color stat) stat 64 | "/* XPM */ 65 | static char * data[] = { 66 | \"18 13 3 1\", 67 | \" c None\", 68 | \"+ c #000000\", 69 | \". c %s\", 70 | \" \", 71 | \" +++++ \", 72 | \" +.....+ \", 73 | \" +.......+ \", 74 | \" +.........+ \", 75 | \" +.........+ \", 76 | \" +.........+ \", 77 | \" +.........+ \", 78 | \" +.........+ \", 79 | \" +.......+ \", 80 | \" +.....+ \", 81 | \" +++++ \", 82 | \" \"};")) 83 | 84 | (defun git--interpret-state-mode-letter(stat) 85 | (case stat 86 | ('modified "M") 87 | ('unknown "?") 88 | ('added "A") 89 | ('deleted "D") 90 | ('unmerged "!") 91 | ('uptodate "U") 92 | ('staged "S") 93 | (t ""))) 94 | 95 | (defsubst git--state-mark-tooltip(stat) 96 | (format "File status in git: %s" stat)) 97 | 98 | (defun git-state-decoration-letter(stat) 99 | (propertize 100 | (concat (git--interpret-state-mode-letter stat) " ") 101 | 'help-echo (git--state-mark-tooltip stat))) 102 | 103 | (defun git-state-decoration-colored-letter(stat) 104 | (propertize 105 | (concat 106 | (propertize 107 | (git--interpret-state-mode-letter stat) 108 | 'face (list ':foreground (git--interpret-state-mode-color stat))) 109 | " ") 110 | 'help-echo (git--state-mark-tooltip stat))) 111 | 112 | ;; Modeline decoration implementation 113 | (defvar git--state-mark-modeline t) ; marker for our entry in mode-line-fmt 114 | 115 | (defun git--state-mark-modeline-dot (color stat img) 116 | (propertize " " 117 | 'help-echo (git--state-mark-tooltip stat) 118 | 'display 119 | `(image :type xpm 120 | :data ,(format img color) 121 | :ascent center))) 122 | 123 | (defun git--state-decoration-dispatch(stat) 124 | (if (functionp git-state-modeline-decoration) 125 | (funcall git-state-modeline-decoration stat))) 126 | 127 | (defun git--install-state-mark-modeline (stat) 128 | (push `(git--state-mark-modeline 129 | ,(git--state-decoration-dispatch stat)) 130 | mode-line-format) 131 | ) 132 | 133 | (defun git--uninstall-state-mark-modeline () 134 | (setq mode-line-format 135 | (delq nil (mapcar #'(lambda (mode) 136 | (unless (eq (car-safe mode) 137 | 'git--state-mark-modeline) 138 | mode)) 139 | mode-line-format))) 140 | ) 141 | 142 | ;; autoload entry point 143 | (defun git--update-state-mark (stat) 144 | (git--uninstall-state-mark-modeline) 145 | (git--install-state-mark-modeline stat)) 146 | 147 | ;; autoload entry point 148 | (defun git--update-all-state-marks (&optional repo-or-filelist) 149 | "Updates the state marks of all the buffers visiting the REPO-OR-FILELIST, 150 | which is a repository dir or a list of files. This is more efficient than 151 | doing update--state-mark for each buffer." 152 | 153 | (git--uninstall-state-mark-modeline) 154 | (let ((buffers (git--find-buffers repo-or-filelist))) 155 | (when (and buffers git-state-modeline-decoration) 156 | ;; Use a hash table to find buffers after status-index and ls-files. 157 | ;; There could be many, and we're doing all these ops with no user 158 | ;; intervention. The hash table is filename -> (buffer . stat). 159 | (let ((file-index (make-hash-table :test #'equal :size (length buffers))) 160 | (default-directory 161 | (git--get-top-dir 162 | (if repo-or-filelist 163 | (file-name-directory (first repo-or-filelist)) 164 | default-directory))) 165 | (all-relative-names nil)) 166 | (dolist (buffer buffers) 167 | (let ((relative-name 168 | (file-relative-name (buffer-file-name buffer) 169 | default-directory))) 170 | (puthash relative-name (cons buffer nil) file-index) 171 | (push relative-name all-relative-names))) 172 | ;; Execute status-index to find out the changed files 173 | (dolist (fi (apply #'git--status-index all-relative-names)) 174 | (setcdr (gethash (git--fileinfo->name fi) file-index) 175 | (git--fileinfo->stat fi))) 176 | ;; The remaining files are probably unchanged, do ls-files 177 | (let (remaining-files) 178 | (maphash #'(lambda (filename buffer-stat) 179 | (unless (cdr buffer-stat) 180 | (push filename remaining-files))) 181 | file-index) 182 | (when remaining-files 183 | (dolist (fi (apply #'git--ls-files remaining-files)) 184 | (setcdr (gethash (git--fileinfo->name fi) file-index) 185 | (git--fileinfo->stat fi))))) 186 | ;; Now set all stats 187 | (maphash #'(lambda (filename buffer-stat) 188 | (when (cdr buffer-stat) 189 | (with-current-buffer (car buffer-stat) 190 | (git--update-state-mark (cdr buffer-stat))))) 191 | file-index))))) 192 | 193 | ;; example on state-modeline-mark 194 | ;; 195 | ;;(git--install-state-mark-modeline 'modified) 196 | ;; (git--uninstall-state-mark-modeline) 197 | ;; (git--update-all-state-marks) 198 | 199 | (provide 'git-modeline) 200 | -------------------------------------------------------------------------------- /git-status.el: -------------------------------------------------------------------------------- 1 | ;; Git status buffer support, part of git-emacs. 2 | ;; 3 | ;; See git-emacs.el for license and versioning. 4 | 5 | (require 'git-emacs) ; main module 6 | (require 'ewoc) ; view 7 | 8 | ;;----------------------------------------------------------------------------- 9 | ;; Variables and utility functions 10 | ;;----------------------------------------------------------------------------- 11 | 12 | (defvar git-status-mode-hook nil 13 | "Hooks to run upon entering git-status-mode") 14 | (defvar git-status-mode-map nil 15 | "Keymap for git-status-mode") 16 | (defvar git--status-view nil 17 | "EWOC for git-status-mode") 18 | 19 | 20 | (defconst git--status-header-format " %-2s %-10s %-5s %4s %s") 21 | (defconst git--status-line-column 32) 22 | 23 | (defsubst git--status-header () 24 | ;; Put spaces above the scrollbar and the fringe 25 | (format 26 | (concat (make-string (+ (scroll-bar-columns 'left) (fringe-columns 'left)) 27 | ? ) 28 | git--status-header-format) 29 | "M" "STATUS" "PERM" "SIZE" "FILE")) 30 | 31 | (defun git--refresh-desc () 32 | "Refresh the git-status-mode header description" 33 | (ewoc-set-hf 34 | git--status-view 35 | (concat (git--bold-face "Directory") " : " default-directory "\n" 36 | (git--bold-face "Branch ") " : " 37 | (or (git--current-branch) "") "\n" 38 | (git--bold-face "Last Log ") " : " (git--last-log-short) "\n") 39 | "")) 40 | 41 | (defsubst git--status-buffer-name (dir) 42 | (format "*git-status on %s*" (abbreviate-file-name (expand-file-name dir)))) 43 | 44 | (defsubst git--create-status-buffer (dir) 45 | (let* ((status-buffer-name (git--status-buffer-name dir)) 46 | (status-buffer (get-buffer status-buffer-name))) 47 | (or status-buffer (get-buffer-create status-buffer-name)))) 48 | 49 | (defsubst git--kill-status-buffer (dir) 50 | (kill-buffer (git--status-buffer-name dir))) 51 | 52 | ;;----------------------------------------------------------------------------- 53 | ;; faces 54 | ;;----------------------------------------------------------------------------- 55 | 56 | (defmacro git--face (name fore1 prop1 fore2 prop2) 57 | `(defface ,(intern (concat "git--" (symbol-name name) "-face")) 58 | '((((class color) (background light)) (:foreground ,fore1 ,@prop1)) 59 | (((class color) (background dark)) (:foreground ,fore2 ,@prop2))) 60 | ,(concat "git " (symbol-name name) " face in status buffer mode") 61 | :group 'git-emacs-faces)) 62 | 63 | (git--face mark "red" (:bold t) "tomato" (:bold t)) 64 | (git--face mark-tree "blue" (:bold t) "yellow" (:bold t)) 65 | (git--face mark-blob "black" () "white" ()) 66 | (git--face mark-submodule "cyan" () "cyan" ()) 67 | (git--face unknown "black" (:bold t) "white" (:bold t)) 68 | (git--face ignored "gray" (:bold t) "gray" (:bold t)) 69 | (git--face modified "tomato" (:bold t) "tomato" (:bold t)) 70 | (git--face unmerged "red" (:bold t) "magenta" (:bold t)) 71 | (git--face uptodate "gray" (:bold t) "green" ()) 72 | (git--face added "tomato" (:bold t) "cyan" (:bold t)) 73 | (git--face deleted "red" (:bold t) "red" (:bold t)) 74 | (git--face staged "yellow" (:bold t) "yellow" (:bold t)) 75 | (git--face log-line "gray" (:bold t :italic t) "gray"(:bold t :italic t)) 76 | 77 | 78 | ;;----------------------------------------------------------------------------- 79 | ;; status view rendering 80 | ;;----------------------------------------------------------------------------- 81 | 82 | ;; status view on one node 83 | ;; +-> perm +-> name 84 | ;; M STATUS PERM SIZE FILE 85 | ;; +-> mark +-> size 86 | ;; +-> stat 87 | ;; 88 | ;; * Modified 100644 4564 |test.c 89 | ;; * New 100644 4564 test.c 90 | 91 | 92 | (defsubst git--status-node-mark (info) 93 | "Render status view node mark" 94 | (propertize (if (git--fileinfo->marked info) "*" " ") 95 | 'face 96 | 'git--mark-face)) 97 | 98 | (defsubst git--status-node-stat (info) 99 | "Render status view node state" 100 | (let ((stat (git--fileinfo->stat info))) 101 | (propertize (capitalize (symbol-name stat)) 102 | 'face 103 | (case stat 104 | ('modified 'git--modified-face ) 105 | ('uptodate 'git--uptodate-face ) 106 | ('unknown 'git--unknown-face ) 107 | ('added 'git--added-face ) 108 | ('deleted 'git--deleted-face ) 109 | ('unmerged 'git--unmerged-face ) 110 | ('staged 'git--staged-face ) 111 | (t nil))))) 112 | 113 | (defsubst git--status-node-perm (info) 114 | "Render status view node permission" 115 | (or (git--fileinfo->perm info) "------")) 116 | 117 | (defun git--status-human-readable-size (size) 118 | "Given a size in bytes, returns a string size of at most four chars, similar 119 | to ls -sh; e.g. 29152 -> 28K." 120 | (if (< size 1024) 121 | (format "%d" size) 122 | (let ((suffixes "KMGT") (i 0)) 123 | (while (and (< i (length suffixes)) 124 | (>= size 1000)) ; 1023K would be 5 chars 125 | (setq size (/ size 1024.0)) 126 | (incf i)) 127 | (format (if (< size 10) "%.1f%c" "%.0f%c") 128 | size (elt suffixes (- i 1)))))) 129 | 130 | (defsubst git--status-node-size (info) 131 | "Render status view node size" 132 | (let ((size (git--fileinfo->size info))) 133 | (if (not size) "" 134 | (git--status-human-readable-size size)))) 135 | 136 | (defsubst git--status-node-name (info) 137 | "Render status view node name" 138 | (let ((name (git--fileinfo->name info)) 139 | (type (git--fileinfo->type info))) 140 | 141 | (setq name (replace-regexp-in-string "[^/]+/" " " name)) 142 | (format 143 | (if (eq type 'commit) "%s [submodule>]" "%s") 144 | (propertize name 'face 145 | (case type 146 | ('tree 'git--mark-tree-face) 147 | ('blob 'git--mark-blob-face) 148 | ('commit 'git--mark-submodule-face) 149 | (t (error "Unknown node type: %S" type))))))) 150 | 151 | (defun git--render-file-status (info) 152 | "Render status view node, call in order 153 | mark : 'git--status-node-mark 154 | state : 'git--status-node-stat 155 | permission : 'git--status-node-perm 156 | size : 'git--status-node-size 157 | name : 'git--status-node-name" 158 | 159 | (insert (format git--status-header-format 160 | (git--status-node-mark info) 161 | (git--status-node-stat info) 162 | (git--status-node-perm info) 163 | (git--status-node-size info) 164 | (git--status-node-name info)))) 165 | 166 | ;;----------------------------------------------------------------------------- 167 | ;; status mode definition 168 | ;;----------------------------------------------------------------------------- 169 | 170 | (defun git-status-mode () 171 | "Major mode for viewing and editing the state of a git directory." 172 | 173 | (kill-all-local-variables) 174 | (buffer-disable-undo) 175 | 176 | ;; set major mode 177 | (setq mode-name "git status") 178 | (setq major-mode 'git-status-mode) 179 | 180 | (use-local-map git-status-mode-map) 181 | 182 | (setq buffer-read-only t) 183 | (setq header-line-format (git--status-header)) 184 | 185 | ;; create ewoc for current git-status buffer 186 | (set (make-local-variable 'git--status-view) 187 | (ewoc-create 'git--render-file-status "" "")) 188 | 189 | (set (make-local-variable 'revert-buffer-function) 190 | 'git-status-mode-revert-buffer) 191 | 192 | (run-hooks 'git-status-mode-hook)) 193 | 194 | (defun git-status-mode-revert-buffer (ignore-auto noconfirm) 195 | "Refresh status information." 196 | 197 | (let* ((current-node (ewoc-locate git--status-view)) 198 | (current-fi (when current-node (ewoc-data current-node))) 199 | new-current) 200 | (git--please-wait "Reading git status" (git--status-new)) 201 | (when current-fi 202 | (git--status-view-update-expand-tree (list current-fi) t) 203 | (setq new-current 204 | (git--status-map (ewoc-nth git--status-view 0) 205 | (lambda (node data) 206 | (or (string= (git--fileinfo->name data) 207 | (git--fileinfo->name current-fi)) 208 | (git--fileinfo-lessp current-fi data)))))) 209 | (if (not new-current) 210 | (git--status-view-first-line) 211 | (ewoc-goto-node git--status-view new-current) 212 | (move-to-column git--status-line-column)))) 213 | 214 | 215 | ;; autoloaded entry point 216 | (defun git-status (dir) 217 | "Launch git-status-mode on the specified directory. With a prefix 218 | argument (C-u), always prompts." 219 | (interactive (list (git--get-top-dir-or-prompt 220 | "Select directory: " (when current-prefix-arg t)))) 221 | 222 | (setq dir (git--get-top-dir dir)) 223 | (if (file-directory-p (git--expand-to-repository-dir dir)) 224 | (progn 225 | (switch-to-buffer (git--create-status-buffer dir)) 226 | (cd dir) 227 | (git-status-mode) 228 | (git--please-wait "Reading git status" 229 | (git--status-new)) 230 | (git--status-view-first-line)) 231 | ;; (add-hook 'after-save-hook 'git-update-saved-file))) 232 | (message "%s is not a git working tree." dir))) 233 | 234 | ;;----------------------------------------------------------------------------- 235 | ;; git-status-view features 236 | ;;----------------------------------------------------------------------------- 237 | 238 | (defsubst git--clear-status () 239 | "Clear the git-status-view" 240 | (ewoc-filter git--status-view #'(lambda (info) nil)) 241 | (ewoc-refresh git--status-view) 242 | (let ((buffer-read-only nil)) (erase-buffer))) 243 | 244 | (defsubst git--status-tree () (git--ls-tree "HEAD")) 245 | 246 | (defsubst git--status-map (node pred) 247 | "Iterate over git--status-view nodes by using 'ewoc-next. Stops 248 | when PRED returns t and returns that node. The predicate function 249 | should get 'node and 'data arguments and it should return t or 250 | nil. If predicate returned nil we continue to scan, otherwise 251 | stop and return the node." 252 | (let ((data nil) 253 | (cont t)) 254 | 255 | (while (and node cont) 256 | (setq data (ewoc-data node)) 257 | (setq cont (not (funcall pred node data))) 258 | (when cont (setq node (ewoc-next git--status-view node)))) 259 | 260 | node)) 261 | 262 | (defun git--status-view-dumb-update-element (fi) 263 | "Add updated fileinfo FI to `git--status-view'. Slow, right now." 264 | 265 | (unless (git--status-map (ewoc-nth git--status-view 0) 266 | #'(lambda (node data) 267 | (when (git--fileinfo-lessp fi data) 268 | (ewoc-enter-before git--status-view node fi)))) 269 | (ewoc-enter-last git--status-view fi))) 270 | 271 | (defun git--status-view-update-state (fileinfos) 272 | "Update the state of the status view nodes corresponding to FILEINFOS." 273 | 274 | (let ((hashed-info (make-hash-table :test 'equal :size (length fileinfos)))) 275 | (dolist (fi fileinfos) 276 | (puthash (git--fileinfo->name fi) fi hashed-info)) 277 | 278 | (ewoc-collect git--status-view 279 | #'(lambda (node) 280 | (let* ((name (git--fileinfo->name node)) 281 | (fi (gethash name hashed-info))) 282 | (when fi 283 | (setf (git--fileinfo->stat node) 284 | (git--fileinfo->stat fi)) 285 | (remhash name hashed-info))))) 286 | 287 | (maphash #'(lambda (k v) (git--status-view-dumb-update-element v)) hashed-info))) 288 | 289 | (defun git--status-view-update-expand-tree (fileinfos 290 | &optional dont-add-unknown-dirs) 291 | "Expand the tree nodes containing one of FILEINFOS, which must be sorted. 292 | Does not add unknown files within the expanded dirs, that must be 293 | an additional merge step. If DONT-ADD-UNKNOWN-DIRS is specified, 294 | does not add additional directories to accommodate fileinfos that 295 | are very deep (used when repositioning mark on refresh)." 296 | (let ((node (ewoc-nth git--status-view 0)) 297 | (last-path-expanded '())) 298 | (dolist (fi fileinfos) 299 | (let* ((components (nbutlast 300 | (split-string (git--fileinfo->name fi) "/"))) 301 | (paths-to-expand components) ; advancing pointer inside components 302 | (matched-name nil) (cont-iteration t)) 303 | 304 | (while (and paths-to-expand last-path-expanded 305 | (string= (car paths-to-expand) (car last-path-expanded))) 306 | (setq paths-to-expand (cdr paths-to-expand)) 307 | (setq last-path-expanded (cdr last-path-expanded))) 308 | 309 | (setq last-path-expanded components) 310 | 311 | ;; Paths inside root or an expanded path are already handled. 312 | (when paths-to-expand 313 | (let ((remaining-paths (cdr paths-to-expand))) 314 | (setcdr paths-to-expand nil) ; splice off beginning path 315 | (setq matched-name (git--join components "/")) 316 | (setcdr paths-to-expand remaining-paths) ; relink last-path-expanded 317 | (setq paths-to-expand remaining-paths)) 318 | 319 | (while cont-iteration 320 | (let ((data (ewoc-data node)) (found-it nil)) 321 | (if (and (git--fileinfo-is-dir data) 322 | (string= (git--fileinfo->name data) matched-name)) 323 | (progn 324 | (unless (git--fileinfo->expanded data) 325 | (git--expand-tree node t)) 326 | (setq found-it t)) 327 | ;; Have we passed our insertion point? This can happen when 328 | ;; merging unknown files in unknown subdirs. 329 | (when (git--fileinfo-lessp fi data) 330 | (if dont-add-unknown-dirs 331 | (setq cont-iteration nil) 332 | ;; Add the subdir we were looking for here. Don't advance. 333 | (setq node (ewoc-enter-before 334 | git--status-view node 335 | (git--create-fileinfo 336 | matched-name 'tree nil nil nil 'unknown))) 337 | ;; This new node is being expanded as we speak. 338 | (setf (git--fileinfo->expanded (ewoc-data node)) t) 339 | (setq found-it t)))) 340 | (if found-it 341 | ;; Do we need to expand even lower? 342 | (if paths-to-expand 343 | (progn 344 | (setq matched-name 345 | (concat matched-name "/" 346 | (car paths-to-expand))) 347 | (setq paths-to-expand (cdr paths-to-expand)) 348 | ;; Continue iteration from next node 349 | (setq node (ewoc-next git--status-view node))) 350 | (setq cont-iteration nil)) ;; No, stop at this node. 351 | (setq node (ewoc-next git--status-view node))) ;; advance 352 | )) 353 | ;; This was very useful while debugging. Please leave it in. 354 | ;; (message "node: %s paths-to-expand %S matched-name %S fi-name %S" (when node (git--fileinfo->name (ewoc-data node))) paths-to-expand matched-name (git--fileinfo->name fi)) 355 | ))))) 356 | 357 | 358 | (defun git--status-view-update () 359 | "Update the state of all changed files." 360 | 361 | (let ((fileinfos (sort (git--status-index) #'git--fileinfo-lessp))) 362 | (git--status-view-update-expand-tree fileinfos) 363 | (git--status-view-update-state fileinfos))) 364 | 365 | (defsubst git--status-refresh () 366 | (let ((pos (point))) 367 | (ewoc-refresh git--status-view) 368 | (goto-char pos))) 369 | 370 | (defun git--status-add-size (fileinfo) 371 | "Fill in the size field of a fileinfo" 372 | (let ((attrs (file-attributes (git--fileinfo->name fileinfo)))) 373 | (when (and attrs (not (first attrs))) 374 | (setf (git--fileinfo->size fileinfo) (elt attrs 7))))) 375 | 376 | (defun git--status-new () 377 | "Create new status-view buffer in current buffer" 378 | 379 | (git--clear-status) 380 | (git--refresh-desc) 381 | 382 | ;; add new file infos 383 | (dolist (info (git--status-tree)) 384 | (git--status-add-size info) 385 | (ewoc-enter-last git--status-view info)) 386 | 387 | ;; add modified/renamed etc file infos 388 | (git--status-view-update) 389 | 390 | ;; add unknown file 391 | (let ((fileinfo (git--ls-files "-o" "--exclude-standard"))) 392 | (git--status-view-update-expand-tree fileinfo) 393 | 394 | ;; Use the file sorting to merge into the list. 395 | (let ((iter (ewoc-nth git--status-view 0))) 396 | (dolist (fi fileinfo) 397 | (git--status-add-size fi) 398 | ;; Find the lowest node that's larger, or enter at the end. 399 | (let (enter-before) 400 | (git--status-map 401 | iter 402 | (lambda (node data) 403 | (when (git--fileinfo-lessp fi data) 404 | (setq enter-before node)))) 405 | (if enter-before 406 | (setq iter (ewoc-enter-before git--status-view enter-before fi)) 407 | (setq iter (ewoc-enter-last git--status-view fi))))))) 408 | 409 | (git--status-refresh)) 410 | 411 | (defsubst git--status-delete (node) 412 | 413 | (let ((buffer-read-only nil)) 414 | (ewoc-delete git--status-view node))) 415 | 416 | (defun git--status-delete-after-regex (node regex) 417 | (while node 418 | (let ((next-node (ewoc-next git--status-view node)) 419 | (node-data (ewoc-data node))) 420 | 421 | (if (string-match regex (git--fileinfo->name node-data)) 422 | (git--status-delete node) 423 | ;; finish if not matched 424 | (setq next-node nil)) 425 | 426 | (setq node next-node))) 427 | (git--status-refresh)) 428 | 429 | ;;----------------------------------------------------------------------------- 430 | ;; key/menu map 431 | ;;----------------------------------------------------------------------------- 432 | 433 | (let ((map (make-keymap))) 434 | (suppress-keymap map) 435 | 436 | (define-key map "n" 'git--status-view-next-line) 437 | (define-key map "p" 'git--status-view-prev-line) 438 | (define-key map "N" 'git--status-view-next-meaningful-line) 439 | (define-key map "P" 'git--status-view-prev-meaningful-line) 440 | (define-key map "l" 'git-log) 441 | (define-key map "m" 'git--status-view-mark-and-next) 442 | (define-key map "u" 'git--status-view-unmark-and-next) 443 | (define-key map " " 'git--status-view-toggle-and-next) 444 | (define-key map "q" 'git--status-view-quit) 445 | (define-key map "<" 'git--status-view-first-line) 446 | (define-key map ">" 'git--status-view-last-line) 447 | 448 | (define-key map "e" 'git--status-view-expand-tree-toggle) 449 | (define-key map "v" 'git--status-view-view-file) 450 | (define-key map "o" 'git--status-view-open-file) 451 | ;; Use the sub-maps from git-global-keys for diffs. 452 | (define-key map "d" (copy-keymap git--diff-buffer-map)) 453 | (define-key map "D" (copy-keymap git--diff-all-map)) 454 | (define-key map "b" 'git-switch-branch) 455 | (define-key map "!" 'git--status-view-resolve-merge) 456 | (define-key map "." 'git-cmd) 457 | (define-key map "k" 'gitk) 458 | (define-key map "L" 'git-log-files) 459 | (define-key map "g" 'git--status-view-refresh) 460 | (define-key map "a" 'git--status-view-add) 461 | (define-key map "i" 'git--status-view-add-ignore) 462 | (define-key map "r" 'git--status-view-rename) 463 | (define-key map "?" 'git--status-view-blame) 464 | (define-key map (kbd "") 'git--status-view-rm) 465 | (define-key map "*" 'git--status-view-mark-reg) 466 | (define-key map "s" 'git--status-view-summary) 467 | (define-key map "z" 'git-branch) 468 | 469 | (define-key map "c" (copy-keymap git--commit-map)) 470 | (define-key map "R" 'git-reset) 471 | 472 | (define-key map "\C-m" 'git--status-view-open-or-expand) 473 | 474 | (setq git-status-mode-map map)) 475 | 476 | (easy-menu-define gitemacs-menu git-status-mode-map 477 | "Git" 478 | `("Git-Emacs" 479 | ["Refresh" git--status-view-refresh t] 480 | ["First Line" git--status-view-first-line t] 481 | ["Last Line" git--status-view-last-line t] 482 | ["Next Line" git--status-view-next-line t] 483 | ["Previous Line" git--status-view-prev-line t] 484 | ["Next Meaningful Line" git--status-view-next-meaningful-line t] 485 | ["Previous Meaningful Line" git--status-view-prev-meaningful-line t] 486 | ["Expand Tree" git--status-view-expand-tree-toggle] 487 | "----" 488 | ["Add File" git--status-view-add t] 489 | ["Ignore File" git--status-view-add-ignore t] 490 | ["Rename File" git--status-view-rename t] 491 | ["Open File" git--status-view-open-file t] 492 | ["View File" git--status-view-view-file t] 493 | ("Diff File against" 494 | ;; We want the short keys to appear here rather than the global keys 495 | ["HEAD" git-diff-head :keys "d RET" :active t] 496 | ["Index" git-diff-index :keys "d i" :active t] 497 | ["Baseline" git-diff-baseline :keys "d b" :active t] 498 | ["Other..." git-diff-other :keys "d o" :active t]) 499 | ("Diff Repository against" 500 | ["HEAD" git-diff-all-head :keys "D RET" :active t] 501 | ["Index" git-diff-all-index :keys "D i" :active t] 502 | ["Baseline" git-diff-all-baseline :keys "D b" :active t] 503 | ["Other..." git-diff-all-other :keys "D o" :active t]) 504 | ["Delete File" git--status-view-rm] 505 | ["View Summary" git--status-view-summary t] 506 | ["Log for Selected File(s)" git-log-files :keys "L" :active t] 507 | ["Mark" git--status-view-mark-and-next t] 508 | ["Unmark" git--status-view-unmark-and-next t] 509 | "----" 510 | ["Branch Mode" git-branch t] 511 | ["Switch to Branch..." git-switch-branch t] 512 | ("Commit" 513 | ["All Changes" git-commit-all :keys "c RET" :active t] 514 | ["Index" git-commit :keys "c i" :active t] 515 | ["Selected File(s)" git-commit-file :keys "c f" :active t]) 516 | ["Reset..." git-reset :keys "R" :active t] 517 | ["Resolve Merge" git--status-view-resolve-merge t] 518 | ["Merge..." git-merge t] 519 | ["Revert" git-revert t] 520 | ["Log for Project" git-log t] 521 | "----" 522 | ["Git Command" git-cmd t] 523 | ["GitK" gitk t] 524 | "----" 525 | ["Quit" git--status-view-quit t])) 526 | 527 | 528 | ;;----------------------------------------------------------------------------- 529 | ;; status view tree expanding 530 | ;;----------------------------------------------------------------------------- 531 | 532 | (defun git--expand-tree (node &optional dont-add-unknown) 533 | "Expand 'node' in 'git--status-view'. node->type should be 'tree. If 534 | DONT-ADD-UNKOWN is true, does not add unknown files (if we're about to merge 535 | them)." 536 | 537 | (let* ((data (ewoc-data node)) 538 | (name (git--fileinfo->name data)) 539 | (type (git--fileinfo->type data)) 540 | (tree-sha1 (git--fileinfo->sha1 data)) 541 | ;; We need some duplicate removal later on. Hashtable? not now. 542 | (known-subdirs '()) 543 | (massage-fileinfo 544 | (lambda (fi) 545 | (let ((subfname (git--fileinfo->name fi))) 546 | (setf (git--fileinfo->name fi) 547 | (git--concat-path-only name subfname)) 548 | (when (git--fileinfo-is-dir fi) (push subfname known-subdirs))) 549 | fi)) 550 | ;; The node may or may not be in git (e.g. unknown files onl) 551 | (fileinfos 552 | (sort (append 553 | (when tree-sha1 554 | (let ((fileinfos (git--ls-tree tree-sha1))) 555 | (mapc massage-fileinfo fileinfos) ; modify them 556 | fileinfos)) 557 | ;; Add unknown files, but just at the top-level. Note 558 | ;; that git would give them to us *with* name, if we 559 | ;; didn't cd. 560 | (unless dont-add-unknown 561 | (let ((unknown-files 562 | (let ((default-directory 563 | (concat default-directory "/" 564 | (file-name-as-directory name)))) 565 | (git--ls-files "-o" "--exclude-standard"))) 566 | (filtered-unknown '())) 567 | (dolist (fi unknown-files) 568 | (let* ((subfname (git--fileinfo->name fi)) 569 | (components (split-string subfname "/" t))) 570 | (if (eq 1 (length components)) 571 | (push (funcall massage-fileinfo fi) 572 | filtered-unknown) 573 | ;; insert just the first component, if not seen 574 | (unless (member (car components) known-subdirs) 575 | (push 576 | (funcall massage-fileinfo 577 | (git--create-fileinfo 578 | (car components) 579 | 'tree nil nil nil 'unknown)) 580 | filtered-unknown))))) 581 | filtered-unknown))) 582 | #'git--fileinfo-lessp))) 583 | 584 | (unless (eq type 'tree) (error "type should be 'tree")) 585 | 586 | (unless (git--fileinfo->expanded data) 587 | 588 | (dolist (fi fileinfos) 589 | (git--status-add-size fi) 590 | (setq node (ewoc-enter-after git--status-view node fi))) 591 | 592 | (setf (git--fileinfo->expanded data) t)))) 593 | 594 | (defun git--shrink-tree (node) 595 | "Shrink 'node' in 'git--status-view'. node->type should be 'tree" 596 | (let* ((data (ewoc-data node)) 597 | (name (git--fileinfo->name data))) 598 | (unless (git--fileinfo-is-dir data) (error "type should be 'tree")) 599 | (when (git--fileinfo->expanded data) 600 | ;; make regexp "node->name/" 601 | (git--status-delete-after-regex 602 | (ewoc-next git--status-view node) 603 | (concat "^" (regexp-quote (file-name-as-directory name)))) 604 | (setf (git--fileinfo->expanded data) nil)))) 605 | 606 | 607 | (defun git--status-view-expand-tree-toggle () 608 | "Expand if tree is not expanded otherwise close the tree" 609 | (interactive) 610 | (let* ((node (ewoc-locate git--status-view)) 611 | (node-info (ewoc-data node))) 612 | (when (and node node-info 613 | (eq (git--fileinfo->type node-info) 'tree)) 614 | (if (git--fileinfo->expanded node-info) 615 | (git--shrink-tree node) 616 | (git--expand-tree node))))) 617 | 618 | ;;----------------------------------------------------------------------------- 619 | ;; status view moving 620 | ;;----------------------------------------------------------------------------- 621 | 622 | (defun git--status-view-forward-line (n) 623 | "Move forward by N lines in the status view." 624 | 625 | (interactive "p") 626 | 627 | (let ((dir (/ n (abs n)))) 628 | (forward-line n) 629 | 630 | (while (or (looking-at "^[\n\t ]+$") 631 | (looking-at "^[^ ]")) 632 | (forward-line dir))) 633 | 634 | (move-to-column git--status-line-column)) 635 | 636 | (defun git--status-view-first-line () 637 | "Move to the first item in the status view." 638 | 639 | (interactive) 640 | (goto-char (point-min)) 641 | (git--status-view-forward-line 1)) 642 | 643 | (defun git--status-view-last-line () 644 | "Move to the last item in the status view." 645 | 646 | (interactive) 647 | (goto-char (point-max)) 648 | (git--status-view-forward-line -1)) 649 | 650 | (defun git--forward-meaningful-line (move) 651 | "Call MOVE until we end up on a meaningful line (i.e. one with updates)." 652 | 653 | (let ((start-node (ewoc-locate git--status-view))) 654 | (funcall move 1) 655 | 656 | (while (and (eq 'uptodate 657 | (git--fileinfo->stat (ewoc-data (ewoc-locate git--status-view)))) 658 | (not (eq start-node (ewoc-locate git--status-view)))) 659 | (funcall move 1)))) 660 | 661 | (defun git--status-view-next-line (&optional n) 662 | "Move to the next line in the status view." 663 | (interactive "p") 664 | (if (eql (ewoc-locate git--status-view) 665 | (ewoc-nth git--status-view -1)) 666 | (git--status-view-first-line) 667 | (git--status-view-forward-line 1))) 668 | 669 | (defun git--status-view-next-meaningful-line () 670 | "Move to the next meaningful line in the status view." 671 | (interactive) 672 | (git--forward-meaningful-line 'git--status-view-next-line)) 673 | 674 | (defun git--status-view-prev-line (&optional n) 675 | "Move to the previous line in the status view." 676 | (interactive "p") 677 | (if (eql (ewoc-locate git--status-view) 678 | (ewoc-nth git--status-view 0)) 679 | (git--status-view-last-line) 680 | (git--status-view-forward-line -1))) 681 | 682 | (defun git--status-view-prev-meaningful-line () 683 | "Move to the previous meaningful line in the status view." 684 | (interactive) 685 | (git--forward-meaningful-line 'git--status-view-prev-line)) 686 | 687 | ;;----------------------------------------------------------------------------- 688 | ;; Marking. 689 | ;;----------------------------------------------------------------------------- 690 | 691 | (defun git--mark-line (marked) 692 | "Sets the mark flag of the current line to MARK. Updates the view." 693 | 694 | (let ((node (ewoc-locate git--status-view))) 695 | (setf (git--fileinfo->marked (ewoc-data node)) marked) 696 | (ewoc-invalidate git--status-view node))) 697 | 698 | (defun git--status-view-mark-and-next () 699 | "Mark and go to the next line." 700 | (interactive) 701 | (git--mark-line t) 702 | (git--status-view-next-line)) 703 | 704 | (defun git--status-view-unmark-and-next () 705 | "Unmark and go to the next line." 706 | (interactive) 707 | (git--mark-line nil) 708 | (git--status-view-next-line)) 709 | 710 | (defun git--toggle-line () 711 | "Toggles the marked state of the current line." 712 | (let* ((node (ewoc-locate git--status-view)) 713 | (data (ewoc-data node)) 714 | (mark (git--fileinfo->marked data))) 715 | (setf (git--fileinfo->marked data) (not mark)) 716 | (ewoc-invalidate git--status-view node))) 717 | 718 | (defun git--status-view-toggle-and-next () 719 | "Toggle the marked state of the current line and move to the next." 720 | (interactive) 721 | (git--toggle-line) 722 | (git--status-view-next-line)) 723 | 724 | ;;----------------------------------------------------------------------------- 725 | ;; Commands 726 | ;;----------------------------------------------------------------------------- 727 | 728 | (defun git--status-view-quit () 729 | "Quit the git status buffer." 730 | (interactive) 731 | (kill-buffer (current-buffer))) 732 | 733 | (defun git--status-view-refresh () 734 | "Refresh git status buffer." 735 | (interactive) 736 | (git--please-wait "Reading git status" (revert-buffer))) 737 | 738 | (defun git--status-view-mark-reg (reg) 739 | "Prompt for a regular expression, mark the files that match." 740 | 741 | (interactive "sRegexp >> ") 742 | (ewoc-collect git--status-view 743 | #'(lambda (data) 744 | (when (string-match reg (git--fileinfo->name data)) 745 | (setf (git--fileinfo->marked data) t)))) 746 | 747 | (ewoc-refresh git--status-view) 748 | (git--status-view-first-line) 749 | (git--status-view-next-meaningful-line)) 750 | 751 | (defun git--status-view-summary () 752 | "Pops up an 'occur' summary of the changed files." 753 | (interactive) 754 | (occur "[\t* ]+\\(Deleted\\|Modified\\|Unknown\\|Added\\|Staged\\)") 755 | (message "Move with 'next-error and 'previous-error")) 756 | 757 | ;;----------------------------------------------------------------------------- 758 | ;; Operations on single files. 759 | ;;----------------------------------------------------------------------------- 760 | 761 | (defsubst git--status-view-select-filename () 762 | "Return the filename of the current status view item." 763 | (let ((filename (git--fileinfo->name (ewoc-data (ewoc-locate git--status-view))))) 764 | (when (file-directory-p filename) 765 | (error "Not a file")) 766 | filename)) 767 | 768 | (defsubst git--status-view-select-type () 769 | "Return the type of the current view item." 770 | (git--fileinfo->type (ewoc-data (ewoc-locate git--status-view)))) 771 | 772 | (defun git--status-view-view-file () 773 | "View the selected file." 774 | (interactive) 775 | (view-file (git--status-view-select-filename))) 776 | 777 | (defun git--status-view-open-file () 778 | "Open the selected file." 779 | (interactive) 780 | (find-file (git--status-view-select-filename))) 781 | 782 | (defun git--status-view-descend-submodule () 783 | "Opens a status view on the selected submodule." 784 | (let ((submodule-dir (git--fileinfo->name 785 | (ewoc-data (ewoc-locate git--status-view))))) 786 | (git-status submodule-dir) 787 | (message "Viewing submodule \"%s\", close buffer to return" 788 | submodule-dir))) 789 | 790 | (defun git--status-view-resolve-merge () 791 | "Resolve merge conflicts in the currently selected file (must be unmerged)." 792 | (interactive) 793 | (let ((file (git--status-view-select-filename))) 794 | (if (eq 'unmerged (git--status-file file)) 795 | (progn 796 | (find-file (git--status-view-select-filename)) 797 | (git--resolve-merge-buffer)) 798 | (error "File is not unmerged")))) 799 | 800 | (defun git--status-view-open-or-expand () 801 | "Open or expands the current file / directory / submodule." 802 | (interactive) 803 | (case (git--status-view-select-type) 804 | ('tree (git--status-view-expand-tree-toggle)) 805 | ('blob (git--status-view-open-file)) 806 | ('commit (git--status-view-descend-submodule)) 807 | (t (error "Not supported type")))) 808 | 809 | (defun git--status-view-blame () 810 | "Open the current file and enable blame mode." 811 | (interactive) 812 | (when (eq (git--status-view-select-type) 'blob) 813 | (find-file (git--status-view-select-filename)) 814 | (git-blame-mode t))) 815 | 816 | ;;----------------------------------------------------------------------------- 817 | ;; status view for all marked files or selected 818 | ;;----------------------------------------------------------------------------- 819 | 820 | (defsubst git--status-view-marked-files () 821 | "Return a list of the marked files. Usually, 822 | `git--status-view-marked-or-file' is what you want instead." 823 | (let (files) 824 | (ewoc-collect git--status-view 825 | #'(lambda (node) 826 | (when (git--fileinfo->marked node) 827 | (push (git--fileinfo->name node) files)))) 828 | files)) 829 | 830 | (defsubst git--status-view-marked-or-file () 831 | "Return a list of the marked files, or if none, the file on the 832 | current line. You can think of this as the \"selected files\"." 833 | (let ((files (git--status-view-marked-files))) 834 | (when (null files) 835 | (setq files (list (git--status-view-select-filename)))) 836 | files)) 837 | 838 | (defun git--status-view-rm () 839 | "Delete the selected files." 840 | (interactive) 841 | (let* ((files (git--status-view-marked-or-file)) 842 | ;; We can't afford to use stale fileinfos here, the warnings 843 | ;; are crucial. 844 | (fresh-fileinfos (append (apply #'git--status-index files) 845 | (apply #'git--ls-files "-o" "--" files))) 846 | (untracked-files nil) (pending-files nil)) 847 | (dolist (fi fresh-fileinfos) 848 | (let ((stat (git--fileinfo->stat fi)) (name (git--fileinfo->name fi))) 849 | (if (member stat '(unknown ignored)) ;although ignored aren't really vis 850 | (push name untracked-files) 851 | (unless (eq stat 'uptodate) (push name pending-files))))) 852 | ;; We really have to be careful about this -- elaborate warning message 853 | (let* ((untracked-warn (git--bold-face "untracked")) 854 | (pending-warn (concat "with " (git--bold-face "pending changes"))) 855 | (status-warning 856 | (cond 857 | ((eq (length files) (length untracked-files)) untracked-warn) 858 | ((eq (length files) (length pending-files)) pending-warn) 859 | (t (git--join 860 | (delq nil 861 | (list (when untracked-files 862 | (format "%d %s" 863 | (length untracked-files) untracked-warn)) 864 | (when pending-files 865 | (format "%d %s" 866 | (length pending-files) pending-warn)))) 867 | ", ")))) 868 | (status-warning-include (if (> (length status-warning) 0) 869 | (format " (%s)" status-warning) 870 | "")) 871 | (msg (if (eq 1 (length files)) 872 | (format "%s%s" (first files) status-warning-include) 873 | (format "%s files%s" (length files) status-warning-include)))) 874 | (unless (y-or-n-p (format "Really %s %s? " 875 | (git--bold-face "delete") 876 | msg)) 877 | (error "Aborted deletion")) 878 | 879 | ;; do git rm -f on all the tracked files 880 | (let ((tracked-files 881 | (delq nil (mapcar #'(lambda(file) 882 | (unless (member file untracked-files) file)) 883 | files))) 884 | (num-deleted 0)) 885 | (when tracked-files 886 | (apply #'git--exec-string "rm" "-f" "--" tracked-files)) 887 | (incf num-deleted (length tracked-files)) 888 | ;; Remove other files directly 889 | (unwind-protect 890 | (dolist (file untracked-files) 891 | (delete-file file) 892 | (incf num-deleted)) 893 | (message "Deleted %d files" num-deleted))))) 894 | 895 | (revert-buffer)) 896 | 897 | (defun git--status-view-rename () 898 | "Rename the selected file(s)." 899 | (interactive) 900 | (let ((files (git--status-view-marked-or-file))) 901 | (dolist (src files) 902 | (let ((msg (format "%s '%s' to >> " (git--bold-face "Rename") src))) 903 | (git--mv src (file-relative-name (read-from-minibuffer msg src)))))) 904 | (revert-buffer)) 905 | 906 | (defun git--status-view-add () 907 | "Add the selected file(s) to the index." 908 | (interactive) 909 | (git--add (git--status-view-marked-or-file)) 910 | (revert-buffer)) 911 | 912 | (defun git--status-view-add-ignore () 913 | "Add the selected file(s) to .gitignore" 914 | (interactive) 915 | (let ((files (git--status-view-marked-or-file))) 916 | (dolist (file files) 917 | (git-ignore file))) 918 | (revert-buffer)) 919 | 920 | ;;----------------------------------------------------------------------------- 921 | 922 | (provide 'git-status) 923 | --------------------------------------------------------------------------------